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