File: C:\NOAA\NEMS_11731\src\atmos\gfs\phys\gfs_physics_start_time_get_mod.f
1 subroutine gfs_physics_start_time_get( &
2 & yy, mm, dd, hh, mns, sec, kfhour, fhini,n1,cfile, rc)
3
4
5
6
7
8
9
10
11
12
13
14
15
16 use esmf_mod, only: esmf_success
17 use machine, only: kind_io4, kind_evod
18 use date_def, only: idate,idate7
19 use sfcio_module
20 use module_nemsio
21
22 implicit none
23
24
25
26
27
28 integer, intent(out) :: yy, mm, dd, hh, mns, sec
29 integer, intent(out) :: n1
30 integer, intent(out) :: kfhour
31 real(kind = kind_evod), intent(out) :: fhini
32 integer, intent(out) :: rc
33 character (len=*),intent(in) :: cfile
34
35 integer :: rc1 = esmf_success
36 real(kind = kind_evod) :: fhour
37 real(kind = kind_io4) :: fhour4
38 type(sfcio_head) head
39 type(nemsio_gfile) nfile
40 integer iret, khour
41
42 n1 = 13
43
44 call sfcio_sropen(n1,cfile,iret)
45 call sfcio_srhead(n1,head,iret)
46 print *,'sfcio_srhead, iret=',iret
47 if(iret==0) then
48 call sfcio_sclose(n1,iret)
49
50 fhour = head%fhour
51 idate = head%idate
52 fhini=fhour
53
54 yy = idate(4)
55 mm = idate(2)
56 dd = idate(3)
57 hh = idate(1)
58 mns = 0
59 sec = 0
60
61
62 rc = rc1
63 else
64 call sfcio_sclose(n1,iret)
65
66 call nemsio_init()
67 call nemsio_open(nfile,trim(cfile),'read',iret=iret)
68 print *,'in start time,after nemsio_open,iret=',iret
69 call nemsio_getheadvar(nfile,'idate',idate7,iret=iret)
70 call nemsio_getheadvar(nfile,'fhour',fhour4,iret=iret)
71 if(iret==0) then
72 fhour=fhour4
73 fhini=fhour4
74 else
75 call nemsio_getheadvar(nfile,'fhour',fhour,iret=iret)
76 fhini=fhour
77 endif
78
79 print *,'after nemsio,idate=',idate7,'fhour=',fhour,iret
80 call nemsio_close(nfile)
81 call nemsio_finalize()
82 idate(1)=idate7(4)
83 idate(2:3)=idate7(2:3)
84 idate(4)=idate7(1)
85 yy = idate7(1)
86 mm = idate7(2)
87 dd = idate7(3)
88 hh = idate7(4)
89 mns = idate7(5)
90 if(idate7(7)/=0) then
91 sec = idate7(6)*1./idate7(7)
92 else
93 sec = 0
94 endif
95
96 endif
97
98 print *,' fhour=',fhour,' idate=',idate7,' iret=',iret
99 if (iret .ne. 0) call mpi_quit(5555)
100 kfhour = nint(fhour)
101 print *,' idate=',idate,' fhour=',fhour,' kfhour=',kfhour
102
103 end subroutine gfs_physics_start_time_get
104