module_diffusion_em_tl.F
References to this file elsewhere.
1 ! DISCLAIMER
2 !
3 ! This file was generated by TAF version 1.7.18
4 !
5 ! FASTOPT DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED,
6 ! INCLUDING (WITHOUT LIMITATION) ALL IMPLIED WARRANTIES OF
7 ! MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, WITH
8 ! RESPECT TO THE SOFTWARE AND USER PROGRAMS. IN NO EVENT
9 ! SHALL FASTOPT BE LIABLE FOR ANY LOST OR ANTICIPATED PROF-
10 ! ITS, OR ANY INDIRECT, INCIDENTAL, EXEMPLARY, SPECIAL, OR
11 ! CONSEQUENTIAL DAMAGES, WHETHER OR NOT FASTOPT WAS ADVISED
12 ! OF THE POSSIBILITY OF SUCH DAMAGES.
13 !
14 ! Haftungsbeschraenkung
15 ! FastOpt gibt ausdruecklich keine Gewaehr, explizit oder indirekt,
16 ! bezueglich der Brauchbarkeit der Software fuer einen bestimmten
17 ! Zweck. Unter keinen Umstaenden ist FastOpt haftbar fuer
18 ! irgendeinen Verlust oder nicht eintretenden erwarteten Gewinn und
19 ! allen indirekten, zufaelligen, exemplarischen oder speziellen
20 ! Schaeden oder Folgeschaeden unabhaengig von einer eventuellen
21 ! Mitteilung darueber an FastOpt.
22 !
23 module g_module_diffusion_em
24 !******************************************************************
25 !******************************************************************
26 !** This routine was generated by Automatic differentiation. **
27 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
28 !******************************************************************
29 !******************************************************************
30 !==============================================
31 ! referencing used modules
32 !==============================================
33 use module_configure
34 use module_bc
35 use g_module_bc
36 use module_state_description
37 use module_big_step_utilities_em
38 use g_module_big_step_utilities_em
39 use module_model_constants
40 use module_wrf_error
41 use module_diffusion_em
42
43 !==============================================
44 ! all entries are defined explicitly
45 !==============================================
46 implicit none
47
48 contains
49 subroutine g_cal_dampkm( xkmhd, g_xkmhd, xkmh, xkhh, xkmv, xkhv, dx, dt, dampcoef, rdz, rdzw, zdamp, ide, jde, kde, ims, ime, jms, &
50 &jme, kms, kme, its, ite, jts, jte, kts, kte )
51 !******************************************************************
52 !******************************************************************
53 !** This routine was generated by Automatic differentiation. **
54 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
55 !******************************************************************
56 !******************************************************************
57 !==============================================
58 ! all entries are defined explicitly
59 !==============================================
60 implicit none
61
62 !==============================================
63 ! declare arguments
64 !==============================================
65 real, intent(in) :: dampcoef
66 real, intent(in) :: dt
67 real, intent(in) :: dx
68 integer, intent(in) :: ime
69 integer, intent(in) :: ims
70 integer, intent(in) :: jme
71 integer, intent(in) :: jms
72 integer, intent(in) :: kme
73 integer, intent(in) :: kms
74 real, intent(inout) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
75 integer, intent(in) :: ide
76 integer, intent(in) :: ite
77 integer, intent(in) :: its
78 integer, intent(in) :: jde
79 integer, intent(in) :: jte
80 integer, intent(in) :: jts
81 integer, intent(in) :: kde
82 integer, intent(in) :: kte
83 integer, intent(in) :: kts
84 real, intent(in) :: rdz(ims:ime,kms:kme,jms:jme)
85 real, intent(in) :: rdzw(ims:ime,kms:kme,jms:jme)
86 real, intent(inout) :: xkhh(ims:ime,kms:kme,jms:jme)
87 real, intent(inout) :: xkhv(ims:ime,kms:kme,jms:jme)
88 real, intent(inout) :: xkmh(ims:ime,kms:kme,jms:jme)
89 real, intent(inout) :: xkmhd(ims:ime,kms:kme,jms:jme)
90 real, intent(inout) :: xkmv(ims:ime,kms:kme,jms:jme)
91 real, intent(in) :: zdamp
92
93 !==============================================
94 ! declare local variables
95 !==============================================
96 real dampk(its:ite,kts:kte,jts:jte)
97 real degrad90
98 real deltaz(its:ite)
99 real dz
100 integer i
101 integer i_end
102 integer i_start
103 integer j
104 integer j_end
105 integer j_start
106 integer k
107 real kmmax
108 integer ktf
109 integer ktfm1
110 real tmp
111
112 !----------------------------------------------
113 ! TANGENT LINEAR AND FUNCTION STATEMENTS
114 !----------------------------------------------
115 ktf = min(kte,kde-1)
116 ktfm1 = ktf-1
117 i_start = its
118 i_end = min(ite,ide-1)
119 j_start = jts
120 j_end = min(jte,jde-1)
121 kmmax = dx*dx/dt
122 degrad90 = degrad*90.
123 do j = j_start, j_end
124 k = ktf
125 do i = i_start, i_end
126 dz = 1./rdzw(i,k,j)
127 deltaz(i) = 0.5*dz
128 tmp = min(deltaz(i)/zdamp,1.)
129 dampk(i,k,j) = cos(degrad90*tmp)*kmmax*dampcoef
130 end do
131 do k = ktfm1, kts, -1
132 do i = i_start, i_end
133 dz = 1./rdz(i,k,j)
134 deltaz(i) = deltaz(i)+dz
135 tmp = min(deltaz(i)/zdamp,1.)
136 dampk(i,k,j) = cos(degrad90*tmp)*kmmax*dampcoef
137 end do
138 end do
139 end do
140 do j = j_start, j_end
141 do k = kts, ktf
142 do i = i_start, i_end
143 g_xkmhd(i,k,j) = g_xkmhd(i,k,j)*(0.5+sign(0.5,xkmhd(i,k,j)-dampk(i,k,j)))
144 xkmhd(i,k,j) = max(xkmhd(i,k,j),dampk(i,k,j))
145 end do
146 end do
147 end do
148
149 end subroutine g_cal_dampkm
150
151
152 subroutine g_calc_l_scale( tke, bn2, g_bn2, l_scale, g_l_scale, i_start, i_end, ktf, j_start, j_end, dx, dy, rdzw, ims, ime, jms, &
153 &jme, kms, kme, its, ite, jts, jte, kts, kte )
154 !******************************************************************
155 !******************************************************************
156 !** This routine was generated by Automatic differentiation. **
157 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
158 !******************************************************************
159 !******************************************************************
160 !==============================================
161 ! all entries are defined explicitly
162 !==============================================
163 implicit none
164
165 !==============================================
166 ! declare arguments
167 !==============================================
168 integer, intent(in) :: ime
169 integer, intent(in) :: ims
170 integer, intent(in) :: jme
171 integer, intent(in) :: jms
172 integer, intent(in) :: kme
173 integer, intent(in) :: kms
174 real, intent(in) :: bn2(ims:ime,kms:kme,jms:jme)
175 real, intent(in) :: dx
176 real, intent(in) :: dy
177 real, intent(in) :: g_bn2(ims:ime,kms:kme,jms:jme)
178 integer, intent(in) :: ite
179 integer, intent(in) :: its
180 integer, intent(in) :: jte
181 integer, intent(in) :: jts
182 integer, intent(in) :: kte
183 integer, intent(in) :: kts
184 real, intent(out) :: g_l_scale(its:ite,kts:kte,jts:jte)
185 integer, intent(in) :: i_end
186 integer, intent(in) :: i_start
187 integer, intent(in) :: j_end
188 integer, intent(in) :: j_start
189 integer, intent(in) :: ktf
190 real, intent(out) :: l_scale(its:ite,kts:kte,jts:jte)
191 real, intent(in) :: rdzw(ims:ime,kms:kme,jms:jme)
192 real, intent(in) :: tke(ims:ime,kms:kme,jms:jme)
193
194 !==============================================
195 ! declare local variables
196 !==============================================
197 real deltas
198 integer i
199 integer j
200 integer k
201 real tmp
202
203 !----------------------------------------------
204 ! TANGENT LINEAR AND FUNCTION STATEMENTS
205 !----------------------------------------------
206 do j = j_start, j_end
207 do k = kts, ktf
208 do i = i_start, i_end
209 deltas = (dx*dy/rdzw(i,k,j))**0.33333333
210 g_l_scale(i,k,j) = 0.
211 l_scale(i,k,j) = deltas
212 if (bn2(i,k,j) .gt. 1.e-6) then
213 tmp = sqrt(max(tke(i,k,j),1.e-6))
214 g_l_scale(i,k,j) = -(g_bn2(i,k,j)*(0.76*tmp*(1./(2.*sqrt(bn2(i,k,j))))/(sqrt(bn2(i,k,j))*sqrt(bn2(i,k,j)))))
215 l_scale(i,k,j) = 0.76*tmp/sqrt(bn2(i,k,j))
216 g_l_scale(i,k,j) = g_l_scale(i,k,j)*(0.5+sign(0.5,deltas-l_scale(i,k,j)))
217 l_scale(i,k,j) = min(l_scale(i,k,j),deltas)
218 g_l_scale(i,k,j) = g_l_scale(i,k,j)*(0.5+sign(0.5,l_scale(i,k,j)-0.001*deltas))
219 l_scale(i,k,j) = max(l_scale(i,k,j),0.001*deltas)
220 endif
221 end do
222 end do
223 end do
224
225 end subroutine g_calc_l_scale
226
227
228 subroutine g_calculate_km_kh( config_flags, dt, dampcoef, zdamp, damp_opt, xkmh, xkmhd, g_xkmhd, xkmv, xkhh, xkhv, bn2, g_bn2, &
229 &khdif, defor11, defor22, defor33, defor12, defor13, defor23, tke, p8w, g_p8w, t8w, g_t8w, theta, g_theta, t, g_t, p, g_p, moist, &
230 &g_moist, dx, dy, rdz, rdzw, n_moist, cf1, cf2, cf3, kh_tke_upper_bound, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, &
231 &its, ite, jts, jte, kts, kte )
232 !******************************************************************
233 !******************************************************************
234 !** This routine was generated by Automatic differentiation. **
235 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
236 !******************************************************************
237 !******************************************************************
238 !==============================================
239 ! all entries are defined explicitly
240 !==============================================
241 implicit none
242
243 !==============================================
244 ! declare arguments
245 !==============================================
246 integer, intent(in) :: ime
247 integer, intent(in) :: ims
248 integer, intent(in) :: jme
249 integer, intent(in) :: jms
250 integer, intent(in) :: kme
251 integer, intent(in) :: kms
252 real, intent(inout) :: bn2(ims:ime,kms:kme,jms:jme)
253 real, intent(in) :: cf1
254 real, intent(in) :: cf2
255 real, intent(in) :: cf3
256 type (grid_config_rec_type), intent(in) :: config_flags
257 integer, intent(in) :: damp_opt
258 real, intent(in) :: dampcoef
259 real, intent(in) :: defor11(ims:ime,kms:kme,jms:jme)
260 real, intent(in) :: defor12(ims:ime,kms:kme,jms:jme)
261 real, intent(in) :: defor13(ims:ime,kms:kme,jms:jme)
262 real, intent(in) :: defor22(ims:ime,kms:kme,jms:jme)
263 real, intent(in) :: defor23(ims:ime,kms:kme,jms:jme)
264 real, intent(in) :: defor33(ims:ime,kms:kme,jms:jme)
265 real, intent(in) :: dt
266 real, intent(in) :: dx
267 real, intent(in) :: dy
268 real, intent(inout) :: g_bn2(ims:ime,kms:kme,jms:jme)
269 integer, intent(in) :: n_moist
270 real, intent(inout) :: g_moist(ims:ime,kms:kme,jms:jme,n_moist)
271 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
272 real, intent(in) :: g_p8w(ims:ime,kms:kme,jms:jme)
273 real, intent(in) :: g_t(ims:ime,kms:kme,jms:jme)
274 real, intent(in) :: g_t8w(ims:ime,kms:kme,jms:jme)
275 real, intent(in) :: g_theta(ims:ime,kms:kme,jms:jme)
276 real, intent(inout) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
277 integer, intent(in) :: ide
278 integer, intent(in) :: ids
279 integer, intent(in) :: ite
280 integer, intent(in) :: its
281 integer, intent(in) :: jde
282 integer, intent(in) :: jds
283 integer, intent(in) :: jte
284 integer, intent(in) :: jts
285 integer, intent(in) :: kde
286 real, intent(in) :: kh_tke_upper_bound
287 real, intent(in) :: khdif
288 integer, intent(in) :: kte
289 integer, intent(in) :: kts
290 real, intent(inout) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
291 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
292 real, intent(in) :: p8w(ims:ime,kms:kme,jms:jme)
293 real, intent(in) :: rdz(ims:ime,kms:kme,jms:jme)
294 real, intent(in) :: rdzw(ims:ime,kms:kme,jms:jme)
295 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
296 real, intent(in) :: t8w(ims:ime,kms:kme,jms:jme)
297 real, intent(in) :: theta(ims:ime,kms:kme,jms:jme)
298 real, intent(inout) :: tke(ims:ime,kms:kme,jms:jme)
299 real, intent(inout) :: xkhh(ims:ime,kms:kme,jms:jme)
300 real, intent(inout) :: xkhv(ims:ime,kms:kme,jms:jme)
301 real, intent(inout) :: xkmh(ims:ime,kms:kme,jms:jme)
302 real, intent(inout) :: xkmhd(ims:ime,kms:kme,jms:jme)
303 real, intent(inout) :: xkmv(ims:ime,kms:kme,jms:jme)
304 real, intent(in) :: zdamp
305
306 !==============================================
307 ! declare local variables
308 !==============================================
309 real g_xkmhh(ims:ime,kms:kme,jms:jme)
310 real g_xkmhi(ims:ime,kms:kme,jms:jme)
311 real g_xkmhj(ims:ime,kms:kme,jms:jme)
312
313 !----------------------------------------------
314 ! TANGENT LINEAR AND FUNCTION STATEMENTS
315 !----------------------------------------------
316 call g_calculate_n2( config_flags,bn2,g_bn2,moist,g_moist,theta,g_theta,t,g_t,p,g_p,p8w,g_p8w,t8w,g_t8w,rdz,rdzw,n_moist,cf1,cf2,&
317 &cf3,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
318 km_coeg: select case ( config_flags%km_opt )
319 case (1) km_coeg
320 call g_isotropic_km( xkmh,xkmhd,g_xkmhd,xkmv,xkhh,xkhv,khdif,ide,jde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
321 case (2) km_coeg
322 call g_tke_km( config_flags,xkmh,g_xkmhh,xkmhd,g_xkmhd,xkmv,xkhh,xkhv,bn2,g_bn2,tke,rdzw,dx,dy,kh_tke_upper_bound,ids,ide,jds,&
323 &jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
324 case (3) km_coeg
325 call g_smag_km( config_flags,xkmh,g_xkmhi,xkmhd,g_xkmhd,xkmv,xkhh,xkhv,bn2,g_bn2,defor11,defor22,defor33,defor12,defor13,defor23,&
326 &rdzw,dx,dy,ids,ide,jds,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
327 case (4) km_coeg
328 call g_smag2d_km( config_flags,xkmh,g_xkmhj,xkmhd,g_xkmhd,xkmv,xkhh,xkhv,defor11,defor22,defor12,dx,dy,ids,ide,jds,jde,kde,ims,&
329 &ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte )
330 end select km_coeg
331 if (damp_opt .eq. 1) then
332 call g_cal_dampkm( xkmhd,g_xkmhd,xkmh,xkhh,xkmv,xkhv,dx,dt,dampcoef,rdz,rdzw,zdamp,ide,jde,kde,ims,ime,jms,jme,kms,kme,its,ite,&
333 &jts,jte,kts,kte )
334 endif
335
336 end subroutine g_calculate_km_kh
337
338
339 subroutine g_calculate_n2( config_flags, bn2, g_bn2, moist, g_moist, theta, g_theta, t, g_t, p, g_p, p8w, g_p8w, t8w, g_t8w, rdz, &
340 &rdzw, n_moist, cf1, cf2, cf3, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
341 !******************************************************************
342 !******************************************************************
343 !** This routine was generated by Automatic differentiation. **
344 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
345 !******************************************************************
346 !******************************************************************
347 !==============================================
348 ! all entries are defined explicitly
349 !==============================================
350 implicit none
351
352 !==============================================
353 ! declare arguments
354 !==============================================
355 integer, intent(in) :: ime
356 integer, intent(in) :: ims
357 integer, intent(in) :: jme
358 integer, intent(in) :: jms
359 integer, intent(in) :: kme
360 integer, intent(in) :: kms
361 real, intent(inout) :: bn2(ims:ime,kms:kme,jms:jme)
362 real, intent(in) :: cf1
363 real, intent(in) :: cf2
364 real, intent(in) :: cf3
365 type (grid_config_rec_type), intent(in) :: config_flags
366 real, intent(inout) :: g_bn2(ims:ime,kms:kme,jms:jme)
367 integer, intent(in) :: n_moist
368 real, intent(inout) :: g_moist(ims:ime,kms:kme,jms:jme,n_moist)
369 real, intent(in) :: g_p(ims:ime,kms:kme,jms:jme)
370 real, intent(in) :: g_p8w(ims:ime,kms:kme,jms:jme)
371 real, intent(in) :: g_t(ims:ime,kms:kme,jms:jme)
372 real, intent(in) :: g_t8w(ims:ime,kms:kme,jms:jme)
373 real, intent(in) :: g_theta(ims:ime,kms:kme,jms:jme)
374 integer, intent(in) :: ide
375 integer, intent(in) :: ids
376 integer, intent(in) :: ite
377 integer, intent(in) :: its
378 integer, intent(in) :: jde
379 integer, intent(in) :: jds
380 integer, intent(in) :: jte
381 integer, intent(in) :: jts
382 integer, intent(in) :: kde
383 integer, intent(in) :: kte
384 integer, intent(in) :: kts
385 real, intent(inout) :: moist(ims:ime,kms:kme,jms:jme,n_moist)
386 real, intent(in) :: p(ims:ime,kms:kme,jms:jme)
387 real, intent(in) :: p8w(ims:ime,kms:kme,jms:jme)
388 real, intent(in) :: rdz(ims:ime,kms:kme,jms:jme)
389 real, intent(in) :: rdzw(ims:ime,kms:kme,jms:jme)
390 real, intent(in) :: t(ims:ime,kms:kme,jms:jme)
391 real, intent(in) :: t8w(ims:ime,kms:kme,jms:jme)
392 real, intent(in) :: theta(ims:ime,kms:kme,jms:jme)
393
394 !==============================================
395 ! declare local variables
396 !==============================================
397 real coefa
398 real es
399 real g_coefa
400 real g_es
401 real g_qctmp(its:ite,kts:kte,jts:jte)
402 real g_qvs(its:ite,kts:kte,jts:jte)
403 real g_qvsfc
404 real g_tc
405 real g_thetaem1
406 real g_thetaep1
407 real g_thetaesfc
408 real g_thetasfc
409 real g_tmp1(its:ite,kts:kte,jts:jte)
410 real g_tmp1sfc(its:ite,jts:jte)
411 real g_xlvqv
412 integer i
413 integer i_end
414 integer i_start
415 integer ispe
416 integer j
417 integer j_end
418 integer j_start
419 integer k
420 integer ktf
421 real qc_cr
422 real qctmp(its:ite,kts:kte,jts:jte)
423 real qvs(its:ite,kts:kte,jts:jte)
424 real qvsfc
425 real tc
426 real thetaem1
427 real thetaep1
428 real thetaesfc
429 real thetasfc
430 real tmp1(its:ite,kts:kte,jts:jte)
431 real tmp1sfc(its:ite,jts:jte)
432 real tmpdz
433 real xlvqv
434
435 !----------------------------------------------
436 ! TANGENT LINEAR AND FUNCTION STATEMENTS
437 !----------------------------------------------
438 qc_cr = 0.00001
439 ktf = min(kte,kde-1)
440 i_start = its
441 i_end = min(ite,ide-1)
442 j_start = jts
443 j_end = min(jte,jde-1)
444 if (config_flags%open_xs .or. config_flags%specified .or. config_flags%nested) then
445 i_start = max(ids+1,its)
446 endif
447 if (config_flags%open_xe .or. config_flags%specified .or. config_flags%nested) then
448 i_end = min(ide-2,ite)
449 endif
450 if (config_flags%open_ys .or. config_flags%specified .or. config_flags%nested) then
451 j_start = max(jds+1,jts)
452 endif
453 if (config_flags%open_ye .or. config_flags%specified .or. config_flags%nested) then
454 j_end = min(jde-2,jte)
455 endif
456 if (p_qc .gt. param_first_scalar) then
457 do j = j_start, j_end
458 do k = kts, ktf
459 do i = i_start, i_end
460 g_qctmp(i,k,j) = g_moist(i,k,j,p_qc)
461 qctmp(i,k,j) = moist(i,k,j,p_qc)
462 end do
463 end do
464 end do
465 else
466 do j = j_start, j_end
467 do k = kts, ktf
468 do i = i_start, i_end
469 g_qctmp(i,k,j) = 0.
470 qctmp(i,k,j) = 0.
471 end do
472 end do
473 end do
474 endif
475 do j = jts, jte
476 do k = kts, kte
477 do i = its, ite
478 g_tmp1(i,k,j) = 0.
479 tmp1(i,k,j) = 0.
480 end do
481 end do
482 end do
483 do j = jts, jte
484 do i = its, ite
485 g_tmp1sfc(i,j) = 0.
486 tmp1sfc(i,j) = 0.
487 end do
488 end do
489 do ispe = param_first_scalar, n_moist
490 if (ispe .eq. p_qv .or. ispe .eq. p_qc .or. ispe .eq. p_qi) then
491 do j = j_start, j_end
492 do k = kts, ktf
493 do i = i_start, i_end
494 g_tmp1(i,k,j) = g_moist(i,k,j,ispe)+g_tmp1(i,k,j)
495 tmp1(i,k,j) = tmp1(i,k,j)+moist(i,k,j,ispe)
496 end do
497 end do
498 end do
499 do j = j_start, j_end
500 do i = i_start, i_end
501 g_tmp1sfc(i,j) = g_moist(i,3,j,ispe)*cf3+g_moist(i,2,j,ispe)*cf2+g_moist(i,1,j,ispe)*cf1+g_tmp1sfc(i,j)
502 tmp1sfc(i,j) = tmp1sfc(i,j)+cf1*moist(i,1,j,ispe)+cf2*moist(i,2,j,ispe)+cf3*moist(i,3,j,ispe)
503 end do
504 end do
505 endif
506 end do
507 do j = j_start, j_end
508 do k = kts, ktf
509 do i = i_start, i_end
510 g_tc = g_t(i,k,j)
511 tc = t(i,k,j)-svpt0
512 g_es = (-(1000.*g_t(i,k,j)*svp1*(svp2*tc/((t(i,k,j)-svp3)*(t(i,k,j)-svp3)))*exp(svp2*tc/(t(i,k,j)-svp3))))+1000.*g_tc*svp1*&
513 &(svp2/(t(i,k,j)-svp3))*exp(svp2*tc/(t(i,k,j)-svp3))
514 es = 1000.*svp1*exp(svp2*tc/(t(i,k,j)-svp3))
515 g_qvs(i,k,j) = g_es*(ep_2/(p(i,k,j)-es)+ep_2*es/((p(i,k,j)-es)*(p(i,k,j)-es)))-g_p(i,k,j)*(ep_2*es/((p(i,k,j)-es)*(p(i,k,j)-&
516 &es)))
517 qvs(i,k,j) = ep_2*es/(p(i,k,j)-es)
518 end do
519 end do
520 end do
521 do j = j_start, j_end
522 do k = kts+1, ktf-1
523 do i = i_start, i_end
524 tmpdz = 1./rdz(i,k,j)+1./rdz(i,k+1,j)
525 if (moist(i,k,j,p_qv) .ge. qvs(i,k,j) .or. qctmp(i,k,j) .ge. qc_cr) then
526 g_xlvqv = g_moist(i,k,j,p_qv)*xlv
527 xlvqv = xlv*moist(i,k,j,p_qv)
528 g_coefa = g_t(i,k,j)*(((-(xlvqv/r_d/(t(i,k,j)*t(i,k,j))/(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))))+(1.+xlvqv/r_d/t(i,k,j))*&
529 &(xlv*xlvqv/cp/r_v/(t(i,k,j)*t(i,k,j))/t(i,k,j)+xlv*xlvqv/cp/r_v/t(i,k,j)/(t(i,k,j)*t(i,k,j)))/((1.+xlv*xlvqv/cp/r_v/t(i,k,&
530 &j)/t(i,k,j))*(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))))/theta(i,k,j))-g_theta(i,k,j)*((1.+xlvqv/r_d/t(i,k,j))/(1.+xlv*&
531 &xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))/(theta(i,k,j)*theta(i,k,j)))+g_xlvqv*((1/r_d/t(i,k,j)/(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,&
532 &j))-(1.+xlvqv/r_d/t(i,k,j))*(xlv/cp/r_v/t(i,k,j)/t(i,k,j))/((1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))*(1.+xlv*xlvqv/cp/r_v/&
533 &t(i,k,j)/t(i,k,j))))/theta(i,k,j))
534 coefa = (1.+xlvqv/r_d/t(i,k,j))/(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))/theta(i,k,j)
535 g_thetaep1 = g_qvs(i,k+1,j)*theta(i,k+1,j)*(xlv/cp/t(i,k+1,j))-g_t(i,k+1,j)*theta(i,k+1,j)*(xlv*qvs(i,k+1,j)/cp/(t(i,k+1,j)&
536 &*t(i,k+1,j)))+g_theta(i,k+1,j)*(1+xlv*qvs(i,k+1,j)/cp/t(i,k+1,j))
537 thetaep1 = theta(i,k+1,j)*(1.+xlv*qvs(i,k+1,j)/cp/t(i,k+1,j))
538 g_thetaem1 = g_qvs(i,k-1,j)*theta(i,k-1,j)*(xlv/cp/t(i,k-1,j))-g_t(i,k-1,j)*theta(i,k-1,j)*(xlv*qvs(i,k-1,j)/cp/(t(i,k-1,j)&
539 &*t(i,k-1,j)))+g_theta(i,k-1,j)*(1+xlv*qvs(i,k-1,j)/cp/t(i,k-1,j))
540 thetaem1 = theta(i,k-1,j)*(1.+xlv*qvs(i,k-1,j)/cp/t(i,k-1,j))
541 g_bn2(i,k,j) = g_coefa*g*((thetaep1-thetaem1)/tmpdz)-g_thetaem1*g*(coefa/tmpdz)+g_thetaep1*g*(coefa/tmpdz)+g_tmp1(i,k-1,j)*&
542 &(g/tmpdz)-g_tmp1(i,k+1,j)*(g/tmpdz)
543 bn2(i,k,j) = g*(coefa*(thetaep1-thetaem1)/tmpdz-(tmp1(i,k+1,j)-tmp1(i,k-1,j))/tmpdz)
544 else
545 g_bn2(i,k,j) = g_moist(i,k-1,j,p_qv)*g*((-1.61)/tmpdz)+g_moist(i,k+1,j,p_qv)*g*(1.61/tmpdz)+g_theta(i,k-1,j)*g*((-1)/&
546 &theta(i,k,j)/tmpdz)+g_theta(i,k+1,j)*g*(1/theta(i,k,j)/tmpdz)-g_theta(i,k,j)*g*((theta(i,k+1,j)-theta(i,k-1,j))/(theta(i,&
547 &k,j)*theta(i,k,j))/tmpdz)+g_tmp1(i,k-1,j)*(g/tmpdz)-g_tmp1(i,k+1,j)*(g/tmpdz)
548 bn2(i,k,j) = g*((theta(i,k+1,j)-theta(i,k-1,j))/theta(i,k,j)/tmpdz+1.61*(moist(i,k+1,j,p_qv)-moist(i,k-1,j,p_qv))/tmpdz-&
549 &(tmp1(i,k+1,j)-tmp1(i,k-1,j))/tmpdz)
550 endif
551 end do
552 end do
553 end do
554 k = kts
555 do j = j_start, j_end
556 do i = i_start, i_end
557 tmpdz = 1./rdz(i,k+1,j)+0.5/rdzw(i,k,j)
558 g_thetasfc = (-(g_p8w(i,k,j)*(t8w(i,kts,j)/p1000mb*r_d/cp*(p8w(i,k,j)/p1000mb)**(r_d/cp-1)/((p8w(i,k,j)/p1000mb)**(r_d/cp)*&
559 &(p8w(i,k,j)/p1000mb)**(r_d/cp)))))+g_t8w(i,kts,j)/(p8w(i,k,j)/p1000mb)**(r_d/cp)
560 thetasfc = t8w(i,kts,j)/(p8w(i,k,j)/p1000mb)**(r_d/cp)
561 if (moist(i,k,j,p_qv) .ge. qvs(i,k,j) .or. qctmp(i,k,j) .ge. qc_cr) then
562 g_qvsfc = g_qvs(i,3,j)*cf3+g_qvs(i,2,j)*cf2+g_qvs(i,1,j)*cf1
563 qvsfc = cf1*qvs(i,1,j)+cf2*qvs(i,2,j)+cf3*qvs(i,3,j)
564 g_xlvqv = g_moist(i,k,j,p_qv)*xlv
565 xlvqv = xlv*moist(i,k,j,p_qv)
566 g_coefa = g_t(i,k,j)*(((-(xlvqv/r_d/(t(i,k,j)*t(i,k,j))/(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))))+(1.+xlvqv/r_d/t(i,k,j))*&
567 &(xlv*xlvqv/cp/r_v/(t(i,k,j)*t(i,k,j))/t(i,k,j)+xlv*xlvqv/cp/r_v/t(i,k,j)/(t(i,k,j)*t(i,k,j)))/((1.+xlv*xlvqv/cp/r_v/t(i,k,j)&
568 &/t(i,k,j))*(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))))/theta(i,k,j))-g_theta(i,k,j)*((1.+xlvqv/r_d/t(i,k,j))/(1.+xlv*xlvqv/cp/&
569 &r_v/t(i,k,j)/t(i,k,j))/(theta(i,k,j)*theta(i,k,j)))+g_xlvqv*((1/r_d/t(i,k,j)/(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))-(1.+&
570 &xlvqv/r_d/t(i,k,j))*(xlv/cp/r_v/t(i,k,j)/t(i,k,j))/((1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))*(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/&
571 &t(i,k,j))))/theta(i,k,j))
572 coefa = (1.+xlvqv/r_d/t(i,k,j))/(1.+xlv*xlvqv/cp/r_v/t(i,k,j)/t(i,k,j))/theta(i,k,j)
573 g_thetaep1 = g_qvs(i,k+1,j)*theta(i,k+1,j)*(xlv/cp/t(i,k+1,j))-g_t(i,k+1,j)*theta(i,k+1,j)*(xlv*qvs(i,k+1,j)/cp/(t(i,k+1,j)*&
574 &t(i,k+1,j)))+g_theta(i,k+1,j)*(1+xlv*qvs(i,k+1,j)/cp/t(i,k+1,j))
575 thetaep1 = theta(i,k+1,j)*(1.+xlv*qvs(i,k+1,j)/cp/t(i,k+1,j))
576 g_thetaesfc = g_qvsfc*thetasfc*(xlv/cp/t8w(i,kts,j))-g_t8w(i,kts,j)*thetasfc*(xlv*qvsfc/cp/(t8w(i,kts,j)*t8w(i,kts,j)))+&
577 &g_thetasfc*(1+xlv*qvsfc/cp/t8w(i,kts,j))
578 thetaesfc = thetasfc*(1.+xlv*qvsfc/cp/t8w(i,kts,j))
579 g_bn2(i,k,j) = g_coefa*g*((thetaep1-thetaesfc)/tmpdz)+g_thetaep1*g*(coefa/tmpdz)-g_thetaesfc*g*(coefa/tmpdz)-g_tmp1(i,k+1,j)*&
580 &(g/tmpdz)+g_tmp1sfc(i,j)*(g/tmpdz)
581 bn2(i,k,j) = g*(coefa*(thetaep1-thetaesfc)/tmpdz-(tmp1(i,k+1,j)-tmp1sfc(i,j))/tmpdz)
582 else
583 g_qvsfc = g_moist(i,3,j,p_qv)*cf3+g_moist(i,2,j,p_qv)*cf2+g_moist(i,1,j,p_qv)*cf1
584 qvsfc = cf1*moist(i,1,j,p_qv)+cf2*moist(i,2,j,p_qv)+cf3*moist(i,3,j,p_qv)
585 tmpdz = 1./rdzw(i,k,j)
586 g_bn2(i,k,j) = g_moist(i,k+1,j,p_qv)*g*(1.61/tmpdz)+g_qvsfc*g*((-1.61)/tmpdz)+g_theta(i,k+1,j)*g*(1/theta(i,k,j)/tmpdz)+&
587 &g_theta(i,k,j)*g*(((-1)/theta(i,k,j)-(theta(i,k+1,j)-theta(i,k,j))/(theta(i,k,j)*theta(i,k,j)))/tmpdz)-g_tmp1(i,k+1,j)*(g/&
588 &tmpdz)+g_tmp1sfc(i,j)*(g/tmpdz)
589 bn2(i,k,j) = g*((theta(i,k+1,j)-theta(i,k,j))/theta(i,k,j)/tmpdz+1.61*(moist(i,k+1,j,p_qv)-qvsfc)/tmpdz-(tmp1(i,k+1,j)-&
590 &tmp1sfc(i,j))/tmpdz)
591 endif
592 end do
593 end do
594 do j = j_start, j_end
595 do i = i_start, i_end
596 g_bn2(i,ktf,j) = g_bn2(i,ktf-1,j)
597 bn2(i,ktf,j) = bn2(i,ktf-1,j)
598 end do
599 end do
600
601 end subroutine g_calculate_n2
602
603
604 subroutine g_isotropic_km( xkmh, xkmhd, g_xkmhd, xkmv, xkhh, xkhv, khdif, ide, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
605 &jte, kts, kte )
606 !******************************************************************
607 !******************************************************************
608 !** This routine was generated by Automatic differentiation. **
609 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
610 !******************************************************************
611 !******************************************************************
612 !==============================================
613 ! all entries are defined explicitly
614 !==============================================
615 implicit none
616
617 !==============================================
618 ! declare arguments
619 !==============================================
620 integer, intent(in) :: ime
621 integer, intent(in) :: ims
622 integer, intent(in) :: jme
623 integer, intent(in) :: jms
624 integer, intent(in) :: kme
625 integer, intent(in) :: kms
626 real, intent(inout) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
627 integer, intent(in) :: ide
628 integer, intent(in) :: ite
629 integer, intent(in) :: its
630 integer, intent(in) :: jde
631 integer, intent(in) :: jte
632 integer, intent(in) :: jts
633 real, intent(in) :: khdif
634 integer, intent(in) :: kte
635 integer, intent(in) :: kts
636 real, intent(inout) :: xkhh(ims:ime,kms:kme,jms:jme)
637 real, intent(inout) :: xkhv(ims:ime,kms:kme,jms:jme)
638 real, intent(inout) :: xkmh(ims:ime,kms:kme,jms:jme)
639 real, intent(inout) :: xkmhd(ims:ime,kms:kme,jms:jme)
640 real, intent(inout) :: xkmv(ims:ime,kms:kme,jms:jme)
641
642 !==============================================
643 ! declare local variables
644 !==============================================
645 integer i
646 integer i_end
647 integer i_start
648 integer j
649 integer j_end
650 integer j_start
651 integer k
652 integer ktf
653
654 !----------------------------------------------
655 ! TANGENT LINEAR AND FUNCTION STATEMENTS
656 !----------------------------------------------
657 ktf = kte
658 i_start = its
659 i_end = min(ite,ide-1)
660 j_start = jts
661 j_end = min(jte,jde-1)
662 do j = j_start, j_end
663 do k = kts, ktf
664 do i = i_start, i_end
665 g_xkmhd(i,k,j) = 0.
666 xkmhd(i,k,j) = khdif
667 end do
668 end do
669 end do
670
671 end subroutine g_isotropic_km
672
673
674 subroutine g_smag2d_km( config_flags, xkmh, g_xkmh, xkmhd, g_xkmhd, xkmv, xkhh, xkhv, defor11, defor22, defor12, dx, dy, ids, ide, &
675 &jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
676 !******************************************************************
677 !******************************************************************
678 !** This routine was generated by Automatic differentiation. **
679 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
680 !******************************************************************
681 !******************************************************************
682 !==============================================
683 ! all entries are defined explicitly
684 !==============================================
685 implicit none
686
687 !==============================================
688 ! declare arguments
689 !==============================================
690 type (grid_config_rec_type), intent(in) :: config_flags
691 integer, intent(in) :: ime
692 integer, intent(in) :: ims
693 integer, intent(in) :: jme
694 integer, intent(in) :: jms
695 integer, intent(in) :: kme
696 integer, intent(in) :: kms
697 real, intent(in) :: defor11(ims:ime,kms:kme,jms:jme)
698 real, intent(in) :: defor12(ims:ime,kms:kme,jms:jme)
699 real, intent(in) :: defor22(ims:ime,kms:kme,jms:jme)
700 real, intent(in) :: dx
701 real, intent(in) :: dy
702 real, intent(inout) :: g_xkmh(ims:ime,kms:kme,jms:jme)
703 real, intent(inout) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
704 integer, intent(in) :: ide
705 integer, intent(in) :: ids
706 integer, intent(in) :: ite
707 integer, intent(in) :: its
708 integer, intent(in) :: jde
709 integer, intent(in) :: jds
710 integer, intent(in) :: jte
711 integer, intent(in) :: jts
712 integer, intent(in) :: kde
713 integer, intent(in) :: kte
714 integer, intent(in) :: kts
715 real, intent(inout) :: xkhh(ims:ime,kms:kme,jms:jme)
716 real, intent(inout) :: xkhv(ims:ime,kms:kme,jms:jme)
717 real, intent(inout) :: xkmh(ims:ime,kms:kme,jms:jme)
718 real, intent(inout) :: xkmhd(ims:ime,kms:kme,jms:jme)
719 real, intent(inout) :: xkmv(ims:ime,kms:kme,jms:jme)
720
721 !==============================================
722 ! declare local variables
723 !==============================================
724 real def2(its:ite,kts:kte,jts:jte)
725 integer i
726 integer i_end
727 integer i_start
728 integer j
729 integer j_end
730 integer j_start
731 integer k
732 integer ktf
733 real mlen_h
734 real tmp
735
736 !----------------------------------------------
737 ! TANGENT LINEAR AND FUNCTION STATEMENTS
738 !----------------------------------------------
739 ktf = min(kte,kde-1)
740 i_start = its
741 i_end = min(ite,ide-1)
742 j_start = jts
743 j_end = min(jte,jde-1)
744 if (config_flags%open_xs .or. config_flags%specified .or. config_flags%nested) then
745 i_start = max(ids+1,its)
746 endif
747 if (config_flags%open_xe .or. config_flags%specified .or. config_flags%nested) then
748 i_end = min(ide-2,ite)
749 endif
750 if (config_flags%open_ys .or. config_flags%specified .or. config_flags%nested) then
751 j_start = max(jds+1,jts)
752 endif
753 if (config_flags%open_ye .or. config_flags%specified .or. config_flags%nested) then
754 j_end = min(jde-2,jte)
755 endif
756 do j = j_start, j_end
757 do k = kts, ktf
758 do i = i_start, i_end
759 def2(i,k,j) = 0.25*(defor11(i,k,j)-defor22(i,k,j))**2+defor12(i,k,j)*defor12(i,k,j)
760 end do
761 end do
762 end do
763 mlen_h = sqrt(dx*dy)
764 do j = j_start, j_end
765 do k = kts, ktf
766 do i = i_start, i_end
767 tmp = def2(i,k,j)**0.5
768 g_xkmh(i,k,j) = 0.
769 xkmh(i,k,j) = c_s*c_s*mlen_h*mlen_h*tmp
770 g_xkmh(i,k,j) = g_xkmh(i,k,j)*(0.5+sign(0.5,10.*mlen_h-xkmh(i,k,j)))
771 xkmh(i,k,j) = min(xkmh(i,k,j),10.*mlen_h)
772 g_xkmhd(i,k,j) = g_xkmh(i,k,j)
773 xkmhd(i,k,j) = xkmh(i,k,j)
774 end do
775 end do
776 end do
777
778 end subroutine g_smag2d_km
779
780
781 subroutine g_smag_km( config_flags, xkmh, g_xkmh, xkmhd, g_xkmhd, xkmv, xkhh, xkhv, bn2, g_bn2, defor11, defor22, defor33, defor12,&
782 & defor13, defor23, rdzw, dx, dy, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
783 !******************************************************************
784 !******************************************************************
785 !** This routine was generated by Automatic differentiation. **
786 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
787 !******************************************************************
788 !******************************************************************
789 !==============================================
790 ! all entries are defined explicitly
791 !==============================================
792 implicit none
793
794 !==============================================
795 ! declare arguments
796 !==============================================
797 integer, intent(in) :: ime
798 integer, intent(in) :: ims
799 integer, intent(in) :: jme
800 integer, intent(in) :: jms
801 integer, intent(in) :: kme
802 integer, intent(in) :: kms
803 real, intent(in) :: bn2(ims:ime,kms:kme,jms:jme)
804 type (grid_config_rec_type), intent(in) :: config_flags
805 real, intent(in) :: defor11(ims:ime,kms:kme,jms:jme)
806 real, intent(in) :: defor12(ims:ime,kms:kme,jms:jme)
807 real, intent(in) :: defor13(ims:ime,kms:kme,jms:jme)
808 real, intent(in) :: defor22(ims:ime,kms:kme,jms:jme)
809 real, intent(in) :: defor23(ims:ime,kms:kme,jms:jme)
810 real, intent(in) :: defor33(ims:ime,kms:kme,jms:jme)
811 real, intent(in) :: dx
812 real, intent(in) :: dy
813 real, intent(in) :: g_bn2(ims:ime,kms:kme,jms:jme)
814 real, intent(inout) :: g_xkmh(ims:ime,kms:kme,jms:jme)
815 real, intent(inout) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
816 integer, intent(in) :: ide
817 integer, intent(in) :: ids
818 integer, intent(in) :: ite
819 integer, intent(in) :: its
820 integer, intent(in) :: jde
821 integer, intent(in) :: jds
822 integer, intent(in) :: jte
823 integer, intent(in) :: jts
824 integer, intent(in) :: kde
825 integer, intent(in) :: kte
826 integer, intent(in) :: kts
827 real, intent(in) :: rdzw(ims:ime,kms:kme,jms:jme)
828 real, intent(inout) :: xkhh(ims:ime,kms:kme,jms:jme)
829 real, intent(inout) :: xkhv(ims:ime,kms:kme,jms:jme)
830 real, intent(inout) :: xkmh(ims:ime,kms:kme,jms:jme)
831 real, intent(inout) :: xkmhd(ims:ime,kms:kme,jms:jme)
832 real, intent(inout) :: xkmv(ims:ime,kms:kme,jms:jme)
833
834 !==============================================
835 ! declare local variables
836 !==============================================
837 real cr_len
838 real def2(its:ite,kts:kte,jts:jte)
839 real deltas
840 real g_tmp
841 integer i
842 integer i_end
843 integer i_start
844 integer j
845 integer j_end
846 integer j_start
847 integer k
848 integer ktf
849 real mlen_h
850 real pr
851 real tmp
852
853 !----------------------------------------------
854 ! TANGENT LINEAR AND FUNCTION STATEMENTS
855 !----------------------------------------------
856 ktf = min(kte,kde-1)
857 i_start = its
858 i_end = min(ite,ide-1)
859 j_start = jts
860 j_end = min(jte,jde-1)
861 if (config_flags%open_xs .or. config_flags%specified .or. config_flags%nested) then
862 i_start = max(ids+1,its)
863 endif
864 if (config_flags%open_xe .or. config_flags%specified .or. config_flags%nested) then
865 i_end = min(ide-2,ite)
866 endif
867 if (config_flags%open_ys .or. config_flags%specified .or. config_flags%nested) then
868 j_start = max(jds+1,jts)
869 endif
870 if (config_flags%open_ye .or. config_flags%specified .or. config_flags%nested) then
871 j_end = min(jde-2,jte)
872 endif
873 pr = 1./3.
874 do j = j_start, j_end
875 do k = kts, ktf
876 do i = i_start, i_end
877 def2(i,k,j) = 0.5*(defor11(i,k,j)*defor11(i,k,j)+defor22(i,k,j)*defor22(i,k,j)+defor33(i,k,j)*defor33(i,k,j))
878 end do
879 end do
880 end do
881 do j = j_start, j_end
882 do k = kts, ktf
883 do i = i_start, i_end
884 g_tmp = 0.
885 tmp = 0.25*(defor12(i,k,j)+defor12(i,k,j+1)+defor12(i+1,k,j)+defor12(i+1,k,j+1))
886 def2(i,k,j) = def2(i,k,j)+0.5*tmp*tmp
887 end do
888 end do
889 end do
890 do j = j_start, j_end
891 do k = kts, ktf
892 do i = i_start, i_end
893 g_tmp = 0.
894 tmp = 0.25*(defor13(i,k+1,j)+defor13(i,k,j)+defor13(i+1,k+1,j)+defor13(i+1,k,j))
895 def2(i,k,j) = def2(i,k,j)+0.5*tmp*tmp
896 end do
897 end do
898 end do
899 do j = j_start, j_end
900 do k = kts, ktf
901 do i = i_start, i_end
902 g_tmp = 0.
903 tmp = 0.25*(defor23(i,k+1,j)+defor23(i,k,j)+defor23(i,k+1,j+1)+defor23(i,k,j+1))
904 def2(i,k,j) = def2(i,k,j)+0.5*tmp*tmp
905 end do
906 end do
907 end do
908 cr_len = dx+1.
909 if (dx .gt. cr_len) then
910 mlen_h = sqrt(dx*dy)
911 do j = j_start, j_end
912 do k = kts, ktf
913 do i = i_start, i_end
914 g_tmp = -(g_bn2(i,k,j)*((0.5-sign(0.5,0.-(def2(i,k,j)-bn2(i,k,j)/pr)))/pr))
915 tmp = max(0.,def2(i,k,j)-bn2(i,k,j)/pr)
916 g_tmp = 0.5*g_tmp*tmp**(-0.5)
917 tmp = tmp**0.5
918 g_xkmh(i,k,j) = g_tmp*(0.5+sign(0.5,c_s*c_s*mlen_h*mlen_h*tmp-1.e-6*mlen_h*mlen_h))*c_s*c_s*mlen_h*mlen_h
919 xkmh(i,k,j) = max(c_s*c_s*mlen_h*mlen_h*tmp,1.e-6*mlen_h*mlen_h)
920 g_xkmh(i,k,j) = g_xkmh(i,k,j)*(0.5+sign(0.5,10.*mlen_h-xkmh(i,k,j)))
921 xkmh(i,k,j) = min(xkmh(i,k,j),10.*mlen_h)
922 g_xkmhd(i,k,j) = g_xkmh(i,k,j)
923 xkmhd(i,k,j) = xkmh(i,k,j)
924 end do
925 end do
926 end do
927 else
928 do j = j_start, j_end
929 do k = kts, ktf
930 do i = i_start, i_end
931 deltas = (dx*dy/rdzw(i,k,j))**0.33333333
932 g_tmp = -(g_bn2(i,k,j)*((0.5-sign(0.5,0.-(def2(i,k,j)-bn2(i,k,j)/pr)))/pr))
933 tmp = max(0.,def2(i,k,j)-bn2(i,k,j)/pr)
934 g_tmp = 0.5*g_tmp*tmp**(-0.5)
935 tmp = tmp**0.5
936 g_xkmh(i,k,j) = g_tmp*(0.5+sign(0.5,c_s*c_s*deltas*deltas*tmp-1.e-6*deltas*deltas))*c_s*c_s*deltas*deltas
937 xkmh(i,k,j) = max(c_s*c_s*deltas*deltas*tmp,1.e-6*deltas*deltas)
938 g_xkmh(i,k,j) = g_xkmh(i,k,j)*(0.5+sign(0.5,10.*deltas-xkmh(i,k,j)))
939 xkmh(i,k,j) = min(xkmh(i,k,j),10.*deltas)
940 g_xkmhd(i,k,j) = g_xkmh(i,k,j)
941 xkmhd(i,k,j) = xkmh(i,k,j)
942 end do
943 end do
944 end do
945 endif
946
947 end subroutine g_smag_km
948
949
950 subroutine g_tke_km( config_flags, xkmh, g_xkmh, xkmhd, g_xkmhd, xkmv, xkhh, xkhv, bn2, g_bn2, tke, rdzw, dx, dy, &
951 &kh_tke_upper_bound, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
952 !******************************************************************
953 !******************************************************************
954 !** This routine was generated by Automatic differentiation. **
955 !** FastOpt: Transformation of Algorithm in Fortran, TAF 1.7.18 **
956 !******************************************************************
957 !******************************************************************
958 !==============================================
959 ! all entries are defined explicitly
960 !==============================================
961 implicit none
962
963 !==============================================
964 ! declare parameters
965 !==============================================
966 real epsilon
967 parameter ( epsilon = 1.e-10 )
968 real tke_seed_value
969 parameter ( tke_seed_value = 1.e-6 )
970
971 !==============================================
972 ! declare arguments
973 !==============================================
974 integer, intent(in) :: ime
975 integer, intent(in) :: ims
976 integer, intent(in) :: jme
977 integer, intent(in) :: jms
978 integer, intent(in) :: kme
979 integer, intent(in) :: kms
980 real, intent(in) :: bn2(ims:ime,kms:kme,jms:jme)
981 type (grid_config_rec_type), intent(in) :: config_flags
982 real, intent(in) :: dx
983 real, intent(in) :: dy
984 real, intent(in) :: g_bn2(ims:ime,kms:kme,jms:jme)
985 real, intent(inout) :: g_xkmh(ims:ime,kms:kme,jms:jme)
986 real, intent(inout) :: g_xkmhd(ims:ime,kms:kme,jms:jme)
987 integer, intent(in) :: ide
988 integer, intent(in) :: ids
989 integer, intent(in) :: ite
990 integer, intent(in) :: its
991 integer, intent(in) :: jde
992 integer, intent(in) :: jds
993 integer, intent(in) :: jte
994 integer, intent(in) :: jts
995 integer, intent(in) :: kde
996 real, intent(in) :: kh_tke_upper_bound
997 integer, intent(in) :: kte
998 integer, intent(in) :: kts
999 real, intent(in) :: rdzw(ims:ime,kms:kme,jms:jme)
1000 real, intent(in) :: tke(ims:ime,kms:kme,jms:jme)
1001 real, intent(inout) :: xkhh(ims:ime,kms:kme,jms:jme)
1002 real, intent(inout) :: xkhv(ims:ime,kms:kme,jms:jme)
1003 real, intent(inout) :: xkmh(ims:ime,kms:kme,jms:jme)
1004 real, intent(inout) :: xkmhd(ims:ime,kms:kme,jms:jme)
1005 real, intent(inout) :: xkmv(ims:ime,kms:kme,jms:jme)
1006
1007 !==============================================
1008 ! declare local variables
1009 !==============================================
1010 real cr_len
1011 real g_l_scale(its:ite,kts:kte,jts:jte)
1012 integer i
1013 integer i_end
1014 integer i_start
1015 integer j
1016 integer j_end
1017 integer j_start
1018 integer k
1019 integer ktf
1020 real l_scale(its:ite,kts:kte,jts:jte)
1021 real mlen_h
1022 real tke_seed
1023 real tmp
1024
1025 !----------------------------------------------
1026 ! TANGENT LINEAR AND FUNCTION STATEMENTS
1027 !----------------------------------------------
1028 ktf = min(kte,kde-1)
1029 i_start = its
1030 i_end = min(ite,ide-1)
1031 j_start = jts
1032 j_end = min(jte,jde-1)
1033 if (config_flags%open_xs .or. config_flags%specified .or. config_flags%nested) then
1034 i_start = max(ids+1,its)
1035 endif
1036 if (config_flags%open_xe .or. config_flags%specified .or. config_flags%nested) then
1037 i_end = min(ide-2,ite)
1038 endif
1039 if (config_flags%open_ys .or. config_flags%specified .or. config_flags%nested) then
1040 j_start = max(jds+1,jts)
1041 endif
1042 if (config_flags%open_ye .or. config_flags%specified .or. config_flags%nested) then
1043 j_end = min(jde-2,jte)
1044 endif
1045 tke_seed = tke_seed_value
1046 if (config_flags%tke_drag_coefficient .gt. epsilon .or. config_flags%tke_heat_flux .gt. epsilon) then
1047 tke_seed = 0.
1048 endif
1049 cr_len = dx+1.
1050 if (dx .gt. cr_len) then
1051 mlen_h = sqrt(dx*dy)
1052 do j = j_start, j_end
1053 do k = kts, ktf
1054 do i = i_start, i_end
1055 tmp = sqrt(max(tke(i,k,j),tke_seed))
1056 g_xkmh(i,k,j) = 0.
1057 xkmh(i,k,j) = max(c_k*tmp*mlen_h,1.e-6*mlen_h*mlen_h)
1058 g_xkmh(i,k,j) = g_xkmh(i,k,j)*(0.5+sign(0.5,10.*mlen_h-xkmh(i,k,j)))
1059 xkmh(i,k,j) = min(xkmh(i,k,j),10.*mlen_h)
1060 g_xkmhd(i,k,j) = g_xkmh(i,k,j)
1061 xkmhd(i,k,j) = xkmh(i,k,j)
1062 end do
1063 end do
1064 end do
1065 else
1066 call g_calc_l_scale( tke,bn2,g_bn2,l_scale,g_l_scale,i_start,i_end,ktf,j_start,j_end,dx,dy,rdzw,ims,ime,jms,jme,kms,kme,its,ite,&
1067 &jts,jte,kts,kte )
1068 do j = j_start, j_end
1069 do k = kts, ktf
1070 do i = i_start, i_end
1071 tmp = sqrt(max(tke(i,k,j),tke_seed))
1072 g_xkmh(i,k,j) = g_l_scale(i,k,j)*c_k*tmp
1073 xkmh(i,k,j) = c_k*tmp*l_scale(i,k,j)
1074 g_xkmh(i,k,j) = g_xkmh(i,k,j)*(0.5-sign(0.5,xkmh(i,k,j)-kh_tke_upper_bound))
1075 xkmh(i,k,j) = min(kh_tke_upper_bound,xkmh(i,k,j))
1076 g_xkmhd(i,k,j) = g_xkmh(i,k,j)
1077 xkmhd(i,k,j) = xkmh(i,k,j)
1078 end do
1079 end do
1080 end do
1081 endif
1082
1083 end subroutine g_tke_km
1084
1085
1086 end module g_module_diffusion_em
1087
1088