CCPP SciDoc v7.0.0  v7.0.0
Common Community Physics Package Developed at DTC
 
Loading...
Searching...
No Matches
GFS_time_vary_pre.fv3.F90
1
3
5
6 use funcphys, only: gfuncphys
7
8 implicit none
9
10 private
11
13
14 logical :: is_initialized = .false.
15
16 contains
17
24 subroutine gfs_time_vary_pre_init (errmsg, errflg)
25
26 implicit none
27
28 character(len=*), intent(out) :: errmsg
29 integer, intent(out) :: errflg
30
31 ! Initialize CCPP error handling variables
32 errmsg = ''
33 errflg = 0
34
35 if (is_initialized) return
36
37 !--- Call gfuncphys (funcphys.f) to compute all physics function tables.
38 call gfuncphys ()
39
40 is_initialized = .true.
41
42 end subroutine gfs_time_vary_pre_init
43
44
48 subroutine gfs_time_vary_pre_finalize(errmsg, errflg)
49
50 implicit none
51
52 character(len=*), intent(out) :: errmsg
53 integer, intent(out) :: errflg
54
55 ! Initialize CCPP error handling variables
56 errmsg = ''
57 errflg = 0
58
59 if (.not. is_initialized) return
60
61 ! DH* this is the place to deallocate whatever is allocated by gfuncphys() in GFS_time_vary_pre_init
62
63 is_initialized = .false.
64
65 end subroutine gfs_time_vary_pre_finalize
66
67
71 subroutine gfs_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, &
72 nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, &
73 kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg)
74
75 use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec
76
77 implicit none
78
79 integer, intent(in) :: idate(:)
80 integer, intent(in) :: jdat(:), idat(:)
81 integer, intent(in) :: nsswr, nslwr, me, &
82 master, nscyc, nhfrad
83 logical, intent(in) :: debug
84 real(kind=kind_phys), intent(in) :: dtp
85
86 integer, intent(out) :: kdt, yearlen, ipt
87 logical, intent(out) :: lprnt, lssav, lsswr, &
88 lslwr
89 real(kind=kind_phys), intent(out) :: sec, phour, zhour, &
90 fhour, julian, solhr
91
92 character(len=*), intent(out) :: errmsg
93 integer, intent(out) :: errflg
94
95 real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys
96 real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys
97 real(kind=kind_dbl_prec) :: rinc8(5)
98
99 integer :: iw3jdn
100 integer :: jd0, jd1
101 real :: fjd
102
103 ! Initialize CCPP error handling variables
104 errmsg = ''
105 errflg = 0
106
107 ! Check initialization status
108 if (.not.is_initialized) then
109 write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called before GFS_time_vary_pre_init"
110 errflg = 1
111 return
112 end if
113
114 !--- jdat is being updated directly inside of FV3GFS_cap.F90
115 !--- update calendars and triggers
116 rinc8(1:5) = 0
117 call w3difdat(jdat,idat,4,rinc8)
118 sec = rinc8(4)
119 phour = sec/con_hr
120 !--- set current bucket hour
121 zhour = phour
122 fhour = (sec + dtp)/con_hr
123 kdt = nint((sec + dtp)/dtp)
124
125 !GJF* These calculations were originally in GFS_physics_driver.F90 for
126 ! NoahMP. They were moved to this routine since they only depend
127 ! on time (not space). Note that this code is included as-is from
128 ! GFS_physics_driver.F90, but it may be simplified by using more
129 ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day
130 ! of year and W3DIFDAT to determine the integer number of days in
131 ! a given year). *GJF
132 ! Julian day calculation (fcst day of the year)
133 ! we need yearln and julian to
134 ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1
135 ! jdat is changing
136 !
137
138 jd1 = iw3jdn(jdat(1),jdat(2),jdat(3))
139 jd0 = iw3jdn(jdat(1),1,1)
140 fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0
141
142 julian = float(jd1-jd0) + fjd
143
144 !
145 ! Year length
146 !
147 ! what if the integration goes from one year to another?
148 ! iyr or jyr ? from 365 to 366 or from 366 to 365
149 !
150 ! is this against model's noleap yr assumption?
151 if (mod(jdat(1),4) == 0) then
152 yearlen = 366
153 if (mod(jdat(1),100) == 0) then
154 yearlen = 365
155 if (mod(jdat(1),400) == 0) then
156 yearlen = 366
157 endif
158 endif
159 endif
160
161 ipt = 1
162 lprnt = .false.
163 lssav = .true.
164
165 !--- radiation triggers
166 lsswr = (mod(kdt, nsswr) == 1)
167 lslwr = (mod(kdt, nslwr) == 1)
168 !--- allow for radiation to be called on every physics time step, if needed
169 if (nsswr == 1) lsswr = .true.
170 if (nslwr == 1) lslwr = .true.
171 !--- allow for radiation to be called on every physics time step
172 ! for the first nhfrad timesteps (for spinup, coldstarts only)
173 if (kdt <= nhfrad) then
174 lsswr = .true.
175 lslwr = .true.
176 end if
177
178 !--- set the solar hour based on a combination of phour and time initial hour
179 solhr = mod(phour+idate(1),con_24)
180
181 if ((debug) .and. (me == master)) then
182 print *,' sec ', sec
183 print *,' kdt ', kdt
184 print *,' nsswr ', nsswr
185 print *,' nslwr ', nslwr
186 print *,' nscyc ', nscyc
187 print *,' lsswr ', lsswr
188 print *,' lslwr ', lslwr
189 print *,' fhour ', fhour
190 print *,' phour ', phour
191 print *,' solhr ', solhr
192 endif
193
196 end module gfs_time_vary_pre
subroutine, public gfs_time_vary_pre_init(errmsg, errflg)
subroutine, public gfs_time_vary_pre_timestep_init(jdat, idat, dtp, nsswr, nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg)
subroutine, public gfs_time_vary_pre_finalize(errmsg, errflg)
This module provides an Application Program Interface (API) for computing basic thermodynamic physics...
Definition funcphys.f90:26