FV3 Bundle
cloudradcouple.F90
Go to the documentation of this file.
1 module cloudradcouple
2 
3 IMPLICIT NONE
4 
5 PRIVATE
6 PUBLIC :: radcouple, radcouple_d, radcouple_b
7 
8 contains
9 
10 subroutine radcouple( TE, &
11  PL, &
12  CF, &
13  AF, &
14  QClLS, &
15  QCiLS, &
16  QClAN, &
17  QCiAN, &
18  RAD_QL, &
19  RAD_QI, &
20  RAD_CF, &
21  RAD_RL, &
22  RAD_RI, &
23  TEMPOR )
24 
25  IMPLICIT NONE
26 
27  !Inputs
28  real(8), intent(in ) :: te, pl, tempor
29  real(8), intent(in ) :: af, cf, qclan, qcian, qclls, qcils
30 ! real(8), intent(in ) :: QRN_ALL, QSN_ALL
31 
32  !Outputs
33  real(8), intent(out) :: rad_ql,rad_qi,rad_cf,rad_rl,rad_ri
34 ! real(8), intent(out) :: RAD_QR,RAD_QS
35 
36  !Locals
37  real(8) :: ss, rad_ri_an, afx, alph
38 
39  real(8), parameter :: min_ri = 20.e-6, max_ri = 40.e-6, ri_anv = 30.e-6
40 
41  !Initialize outputs
42  rad_ql = 0.0
43  rad_qi = 0.0
44  rad_cf = 0.0
45  rad_rl = 0.0
46  rad_ri = 0.0
47  !RAD_QR = 0.0
48  !RAD_QS = 0.0
49 
50  ! Adjust Anvil fractions for warm clouds
51  alph = 0.1
52  ss = (280.-te)/20.
53  ss = min( 1.0 , ss )
54  ss = max( 0.0 , ss )
55 
56  ss = alph + (ss**3) * ( 1.0 - alph )
57 
58  afx = af * ss * 0.5
59 
60  !Total cloud fraction
61  rad_cf = min( cf + afx, 1.00 )
62 
63  !Total In-cloud liquid
64  if ( rad_cf > 10.0e-8 ) then !0 -> 10e-8 FOR LINEARIZATION PROTECTION
65  rad_ql = ( qclls + qclan ) / rad_cf
66  else
67  rad_ql = 0.0
68  end if
69  rad_ql = min( rad_ql, 0.01 )
70 
71  ! Total In-cloud ice
72  if ( rad_cf > 10.0e-8 ) then !0 -> 10e-8 FOR LINEARIZATION PROTECTION
73  rad_qi = ( qcils + qcian ) / rad_cf
74  else
75  rad_qi = 0.0
76  end if
77  rad_qi = min( rad_qi, 0.01 )
78 
79  ! Total In-cloud precipitation
80 ! if ( RAD_CF >0. ) then
81 ! RAD_QR = ( QRN_ALL ) / RAD_CF
82 ! RAD_QS = ( QSN_ALL ) / RAD_CF
83 ! else
84 ! RAD_QR = 0.0
85 ! RAD_QS = 0.0
86 ! end if
87 ! RAD_QR = MIN( RAD_QR, 0.01 )
88 ! RAD_QS = MIN( RAD_QS, 0.01 )
89 
90  if (pl < 150. ) then
91  rad_ri = max_ri
92  end if
93  if (pl >= 150. ) then
94  rad_ri = max_ri*150./pl
95  end if
96 
97  ! Weigh in a separate R_ice for Anvil Ice according to
98  rad_ri_an = rad_ri
99 
100  if ( ( qcils + qcian ) > 0.0 ) then
101  if (qcils/rad_ri+qcian/ri_anv .gt. 10e-8) then !LINEARIZATION PROTECTION
102  rad_ri_an = ( qcils + qcian ) / ( (qcils/rad_ri) + (qcian/ri_anv) )
103  endif
104  end if
105 
106  rad_ri = min( rad_ri, rad_ri_an )
107  rad_ri = max( rad_ri, min_ri )
108 
109  ! Implement ramps for gradual change in effective radius
110  if (pl < 300. ) then
111  rad_rl = 21.e-6
112  end if
113  if (pl >= 300. ) then
114  rad_rl = 21.e-6*300./pl
115  end if
116  rad_rl = max( rad_rl, 10.e-6 )
117 
118  ! Thicken low high lat clouds
119  if ( pl .GE. 775. .AND. te .LE. 275. .AND. (tempor.eq.1.) ) then
120  rad_rl = max(min(-0.1 * pl + 87.5, 10.),5.)*1.e-6
121  end if
122  if ( pl .GE. 825. .AND. te .LE. 282. .AND. (tempor.eq.1.) ) then
123  rad_rl = max(0.71 * te - 190.25, 5.)*1.e-6
124  end if
125  if ( pl .GE. 775. .AND. pl .LT. 825. .AND. te .LE. 282. .AND. te .GT. 275. .AND. (tempor.eq.1.) ) then
126  rad_rl = min(-0.1*pl + 0.71 * te - 107.75, 10.)*1.e-6
127  end if
128  if ( pl .GE. 825. .AND. te .LE. 275. .AND. (tempor.eq.1.) ) then
129  rad_rl = 5.*1.e-6
130  end if
131 
132  ! Thin low tropical clouds
133  if ( pl .GE. 950. .AND. te .GE. 285. ) then
134  rad_rl = min(2.2 * te - 617., 21.)*1.e-6
135  end if
136  if ( pl .GE. 925. .AND. te .GE. 290. ) then
137  rad_rl = min(0.44 * pl - 397., 21.)*1.e-6
138  end if
139  if ( pl .GE. 925. .AND. pl .LT. 950. .AND. te .GT. 285. .AND. te .LT. 290.) then
140  rad_rl = max(min(0.44*pl + 2.2 * te - 1035., 21.),10.)*1.e-6
141  end if
142  if ( pl .GE. 950. .AND. te .GE. 290. ) then
143  rad_rl = 21.*1.e-6
144  end if
145 
146  if ( rad_cf < 1.e-5 ) then
147  rad_ql = 0.
148  rad_qi = 0.
149  rad_cf = 0.
150  !RAD_QR = 0.
151  !RAD_QS = 0.
152  end if
153 
154 end subroutine radcouple
155 
156 SUBROUTINE radcouple_d(te, ted, pl, cf, cfd, af, afd, qclls, qcllsd, &
157 & qcils, qcilsd, qclan, qcland, qcian, qciand, rad_ql, rad_qld, rad_qi, &
158 & rad_qid, rad_cf, rad_cfd, rad_rl, rad_rld, rad_ri, rad_rid, tempor)
159  IMPLICIT NONE
160 !Inputs
161  REAL*8, INTENT(IN) :: te, pl, tempor
162  REAL*8, INTENT(IN) :: ted
163  REAL*8, INTENT(IN) :: af, cf, qclan, qcian, qclls, qcils
164  REAL*8, INTENT(IN) :: afd, cfd, qcland, qciand, qcllsd, qcilsd
165 ! real(8), intent(in ) :: QRN_ALL, QSN_ALL
166 !Outputs
167  REAL*8, INTENT(OUT) :: rad_ql, rad_qi, rad_cf, rad_rl, rad_ri
168  REAL*8, INTENT(OUT) :: rad_qld, rad_qid, rad_cfd, rad_rld, rad_rid
169 ! real(8), intent(out) :: RAD_QR,RAD_QS
170 !Locals
171  REAL*8 :: ss, rad_ri_an, afx, alph
172  REAL*8 :: ssd, rad_ri_and, afxd
173  REAL*8, PARAMETER :: min_ri=20.e-6, max_ri=40.e-6, ri_anv=30.e-6
174  INTRINSIC min
175  INTRINSIC max
176  REAL*8 :: max2d
177  REAL*8 :: min3
178  REAL*8 :: min2
179  REAL*8 :: min1
180  REAL*8 :: min1d
181  REAL*8 :: x2
182  REAL*8 :: x2d
183  REAL*8 :: x1
184  REAL*8 :: max3d
185  REAL*8 :: max3
186  REAL*8 :: max2
187  REAL*8 :: max1
188  REAL*8 :: min2d
189 !Initialize outputs
190  rad_ql = 0.0
191  rad_qi = 0.0
192  rad_cf = 0.0
193  rad_rl = 0.0
194  rad_ri = 0.0
195 !RAD_QR = 0.0
196 !RAD_QS = 0.0
197 ! Adjust Anvil fractions for warm clouds
198  alph = 0.1
199  ssd = (-ted)/20.
200  ss = (280.-te)/20.
201  IF (1.0 .GT. ss) THEN
202  ss = ss
203  ELSE
204  ss = 1.0
205  ssd = 0.0_8
206  END IF
207  IF (0.0 .LT. ss) THEN
208  ss = ss
209  ELSE
210  ss = 0.0
211  ssd = 0.0_8
212  END IF
213  ssd = (1.0-alph)*3*ss**2*ssd
214  ss = alph + ss**3*(1.0-alph)
215  afxd = 0.5*(afd*ss+af*ssd)
216  afx = af*ss*0.5
217  IF (cf + afx .GT. 1.00) THEN
218  rad_cf = 1.00
219  rad_cfd = 0.0_8
220  ELSE
221  rad_cfd = cfd + afxd
222  rad_cf = cf + afx
223  END IF
224 !Total In-cloud liquid
225  IF (rad_cf .GT. 10.0e-8) THEN
226 !0 -> 10e-8 FOR LINEARIZATION PROTECTION
227  rad_qld = ((qcllsd+qcland)*rad_cf-(qclls+qclan)*rad_cfd)/rad_cf**2
228  rad_ql = (qclls+qclan)/rad_cf
229  ELSE
230  rad_ql = 0.0
231  rad_qld = 0.0_8
232  END IF
233  IF (rad_ql .GT. 0.01) THEN
234  rad_ql = 0.01
235  rad_qld = 0.0_8
236  ELSE
237  rad_ql = rad_ql
238  END IF
239 ! Total In-cloud ice
240  IF (rad_cf .GT. 10.0e-8) THEN
241 !0 -> 10e-8 FOR LINEARIZATION PROTECTION
242  rad_qid = ((qcilsd+qciand)*rad_cf-(qcils+qcian)*rad_cfd)/rad_cf**2
243  rad_qi = (qcils+qcian)/rad_cf
244  ELSE
245  rad_qi = 0.0
246  rad_qid = 0.0_8
247  END IF
248  IF (rad_qi .GT. 0.01) THEN
249  rad_qi = 0.01
250  rad_qid = 0.0_8
251  ELSE
252  rad_qi = rad_qi
253  END IF
254 ! Total In-cloud precipitation
255 ! if ( RAD_CF >0. ) then
256 ! RAD_QR = ( QRN_ALL ) / RAD_CF
257 ! RAD_QS = ( QSN_ALL ) / RAD_CF
258 ! else
259 ! RAD_QR = 0.0
260 ! RAD_QS = 0.0
261 ! end if
262 ! RAD_QR = MIN( RAD_QR, 0.01 )
263 ! RAD_QS = MIN( RAD_QS, 0.01 )
264  IF (pl .LT. 150.) rad_ri = max_ri
265  IF (pl .GE. 150.) rad_ri = max_ri*150./pl
266 ! Weigh in a separate R_ice for Anvil Ice according to
267  rad_ri_an = rad_ri
268  IF (qcils + qcian .GT. 0.0) THEN
269  IF (qcils/rad_ri + qcian/ri_anv .GT. 10e-8) THEN
270 !LINEARIZATION PROTECTION
271  rad_ri_and = ((qcilsd+qciand)*(qcils/rad_ri+qcian/ri_anv)-(qcils+&
272 & qcian)*(qcilsd/rad_ri+qciand/ri_anv))/(qcils/rad_ri+qcian/ri_anv&
273 & )**2
274  rad_ri_an = (qcils+qcian)/(qcils/rad_ri+qcian/ri_anv)
275  ELSE
276  rad_ri_and = 0.0_8
277  END IF
278  ELSE
279  rad_ri_and = 0.0_8
280  END IF
281  IF (rad_ri .GT. rad_ri_an) THEN
282  rad_rid = rad_ri_and
283  rad_ri = rad_ri_an
284  ELSE
285  rad_ri = rad_ri
286  rad_rid = 0.0_8
287  END IF
288  IF (rad_ri .LT. min_ri) THEN
289  rad_ri = min_ri
290  rad_rid = 0.0_8
291  ELSE
292  rad_ri = rad_ri
293  END IF
294 ! Implement ramps for gradual change in effective radius
295  IF (pl .LT. 300.) rad_rl = 21.e-6
296  IF (pl .GE. 300.) rad_rl = 21.e-6*300./pl
297  IF (rad_rl .LT. 10.e-6) THEN
298  rad_rl = 10.e-6
299  ELSE
300  rad_rl = rad_rl
301  END IF
302 ! Thicken low high lat clouds
303  IF (pl .GE. 775. .AND. te .LE. 275. .AND. tempor .EQ. 1.) THEN
304  IF (-(0.1*pl) + 87.5 .GT. 10.) THEN
305  x1 = 10.
306  ELSE
307  x1 = -(0.1*pl) + 87.5
308  END IF
309  IF (x1 .LT. 5.) THEN
310  max1 = 5.
311  ELSE
312  max1 = x1
313  END IF
314  rad_rl = max1*1.e-6
315  END IF
316  IF (pl .GE. 825. .AND. te .LE. 282. .AND. tempor .EQ. 1.) THEN
317  IF (0.71*te - 190.25 .LT. 5.) THEN
318  max2 = 5.
319  max2d = 0.0_8
320  ELSE
321  max2d = 0.71*ted
322  max2 = 0.71*te - 190.25
323  END IF
324  rad_rld = 1.e-6*max2d
325  rad_rl = max2*1.e-6
326  ELSE
327  rad_rld = 0.0_8
328  END IF
329  IF (pl .GE. 775. .AND. pl .LT. 825. .AND. te .LE. 282. .AND. te .GT. &
330 & 275. .AND. tempor .EQ. 1.) THEN
331  IF (-(0.1*pl) + 0.71*te - 107.75 .GT. 10.) THEN
332  min1 = 10.
333  min1d = 0.0_8
334  ELSE
335  min1d = 0.71*ted
336  min1 = -(0.1*pl) + 0.71*te - 107.75
337  END IF
338  rad_rld = 1.e-6*min1d
339  rad_rl = min1*1.e-6
340  END IF
341  IF (pl .GE. 825. .AND. te .LE. 275. .AND. tempor .EQ. 1.) THEN
342  rad_rld = 0.0_8
343  rad_rl = 5.*1.e-6
344  END IF
345 ! Thin low tropical clouds
346  IF (pl .GE. 950. .AND. te .GE. 285.) THEN
347  IF (2.2*te - 617. .GT. 21.) THEN
348  min2 = 21.
349  min2d = 0.0_8
350  ELSE
351  min2d = 2.2*ted
352  min2 = 2.2*te - 617.
353  END IF
354  rad_rld = 1.e-6*min2d
355  rad_rl = min2*1.e-6
356  END IF
357  IF (pl .GE. 925. .AND. te .GE. 290.) THEN
358  IF (0.44*pl - 397. .GT. 21.) THEN
359  min3 = 21.
360  ELSE
361  min3 = 0.44*pl - 397.
362  END IF
363  rad_rl = min3*1.e-6
364  rad_rld = 0.0_8
365  END IF
366  IF (pl .GE. 925. .AND. pl .LT. 950. .AND. te .GT. 285. .AND. te .LT. &
367 & 290.) THEN
368  IF (0.44*pl + 2.2*te - 1035. .GT. 21.) THEN
369  x2 = 21.
370  x2d = 0.0_8
371  ELSE
372  x2d = 2.2*ted
373  x2 = 0.44*pl + 2.2*te - 1035.
374  END IF
375  IF (x2 .LT. 10.) THEN
376  max3 = 10.
377  max3d = 0.0_8
378  ELSE
379  max3d = x2d
380  max3 = x2
381  END IF
382  rad_rld = 1.e-6*max3d
383  rad_rl = max3*1.e-6
384  END IF
385  IF (pl .GE. 950. .AND. te .GE. 290.) THEN
386  rad_rld = 0.0_8
387  rad_rl = 21.*1.e-6
388  END IF
389  IF (rad_cf .LT. 1.e-5) THEN
390  rad_ql = 0.
391  rad_qi = 0.
392  rad_cf = 0.
393 !RAD_QR = 0.
394 !RAD_QS = 0.
395  rad_cfd = 0.0_8
396  rad_qid = 0.0_8
397  rad_qld = 0.0_8
398  END IF
399 END SUBROUTINE radcouple_d
400 
401 SUBROUTINE radcouple_b(te, teb, pl, cf, cfb, af, afb, qclls, qcllsb, &
402 & qcils, qcilsb, qclan, qclanb, qcian, qcianb, rad_ql, rad_qlb, rad_qi, &
403 & rad_qib, rad_cf, rad_cfb, rad_rl, rad_rlb, rad_ri, rad_rib, tempor)
404  IMPLICIT NONE
405 !Inputs
406  REAL*8, INTENT(IN) :: te, pl, tempor
407  REAL*8 :: teb
408  REAL*8, INTENT(IN) :: af, cf, qclan, qcian, qclls, qcils
409  REAL*8 :: afb, cfb, qclanb, qcianb, qcllsb, qcilsb
410 ! real(8), intent(in ) :: QRN_ALL, QSN_ALL
411 !Outputs
412  REAL*8 :: rad_ql, rad_qi, rad_cf, rad_rl, rad_ri
413  REAL*8 :: rad_qlb, rad_qib, rad_cfb, rad_rlb, rad_rib
414 ! real(8), intent(out) :: RAD_QR,RAD_QS
415 !Locals
416  REAL*8 :: ss, rad_ri_an, afx, alph
417  REAL*8 :: ssb, rad_ri_anb, afxb
418  REAL*8, PARAMETER :: min_ri=20.e-6, max_ri=40.e-6, ri_anv=30.e-6
419  INTRINSIC min
420  INTRINSIC max
421  INTEGER :: branch
422  REAL*8 :: min3
423  REAL*8 :: min2
424  REAL*8 :: max2b
425  REAL*8 :: min1
426  REAL*8 :: tempb2
427  REAL*8 :: tempb1
428  REAL*8 :: tempb0
429  REAL*8 :: min1b
430  REAL*8 :: x2
431  REAL*8 :: x1
432  REAL*8 :: x2b
433  REAL*8 :: tempb
434  REAL*8 :: max3b
435  REAL*8 :: temp
436  REAL*8 :: max3
437  REAL*8 :: max2
438  REAL*8 :: max1
439  REAL*8 :: min2b
440 !Initialize outputs
441  rad_ri = 0.0
442 !RAD_QR = 0.0
443 !RAD_QS = 0.0
444 ! Adjust Anvil fractions for warm clouds
445  alph = 0.1
446  ss = (280.-te)/20.
447  IF (1.0 .GT. ss) THEN
448  CALL pushcontrol1b(0)
449  ss = ss
450  ELSE
451  ss = 1.0
452  CALL pushcontrol1b(1)
453  END IF
454  IF (0.0 .LT. ss) THEN
455  CALL pushcontrol1b(0)
456  ss = ss
457  ELSE
458  ss = 0.0
459  CALL pushcontrol1b(1)
460  END IF
461  CALL pushreal8(ss)
462  ss = alph + ss**3*(1.0-alph)
463  afx = af*ss*0.5
464  IF (cf + afx .GT. 1.00) THEN
465  rad_cf = 1.00
466  CALL pushcontrol1b(0)
467  ELSE
468  rad_cf = cf + afx
469  CALL pushcontrol1b(1)
470  END IF
471 !Total In-cloud liquid
472  IF (rad_cf .GT. 10.0e-8) THEN
473 !0 -> 10e-8 FOR LINEARIZATION PROTECTION
474  rad_ql = (qclls+qclan)/rad_cf
475  CALL pushcontrol1b(1)
476  ELSE
477  CALL pushcontrol1b(0)
478  rad_ql = 0.0
479  END IF
480  IF (rad_ql .GT. 0.01) THEN
481  CALL pushcontrol1b(0)
482  ELSE
483  CALL pushcontrol1b(1)
484  END IF
485 ! Total In-cloud ice
486  IF (rad_cf .GT. 10.0e-8) THEN
487 !0 -> 10e-8 FOR LINEARIZATION PROTECTION
488  rad_qi = (qcils+qcian)/rad_cf
489  CALL pushcontrol1b(1)
490  ELSE
491  CALL pushcontrol1b(0)
492  rad_qi = 0.0
493  END IF
494  IF (rad_qi .GT. 0.01) THEN
495  CALL pushcontrol1b(0)
496  ELSE
497  CALL pushcontrol1b(1)
498  END IF
499 ! Total In-cloud precipitation
500 ! if ( RAD_CF >0. ) then
501 ! RAD_QR = ( QRN_ALL ) / RAD_CF
502 ! RAD_QS = ( QSN_ALL ) / RAD_CF
503 ! else
504 ! RAD_QR = 0.0
505 ! RAD_QS = 0.0
506 ! end if
507 ! RAD_QR = MIN( RAD_QR, 0.01 )
508 ! RAD_QS = MIN( RAD_QS, 0.01 )
509  IF (pl .LT. 150.) rad_ri = max_ri
510  IF (pl .GE. 150.) rad_ri = max_ri*150./pl
511 ! Weigh in a separate R_ice for Anvil Ice according to
512  rad_ri_an = rad_ri
513  IF (qcils + qcian .GT. 0.0) THEN
514  IF (qcils/rad_ri + qcian/ri_anv .GT. 10e-8) THEN
515 !LINEARIZATION PROTECTION
516  rad_ri_an = (qcils+qcian)/(qcils/rad_ri+qcian/ri_anv)
517  CALL pushcontrol2b(2)
518  ELSE
519  CALL pushcontrol2b(1)
520  END IF
521  ELSE
522  CALL pushcontrol2b(0)
523  END IF
524  IF (rad_ri .GT. rad_ri_an) THEN
525  CALL pushreal8(rad_ri)
526  rad_ri = rad_ri_an
527  CALL pushcontrol1b(0)
528  ELSE
529  CALL pushreal8(rad_ri)
530  rad_ri = rad_ri
531  CALL pushcontrol1b(1)
532  END IF
533  IF (rad_ri .LT. min_ri) THEN
534  CALL pushcontrol1b(0)
535  ELSE
536  CALL pushcontrol1b(1)
537  END IF
538  IF (pl .GE. 825. .AND. te .LE. 282. .AND. tempor .EQ. 1.) THEN
539  IF (0.71*te - 190.25 .LT. 5.) THEN
540  CALL pushcontrol1b(0)
541  ELSE
542  CALL pushcontrol1b(1)
543  END IF
544  CALL pushcontrol1b(0)
545  ELSE
546  CALL pushcontrol1b(1)
547  END IF
548  IF (pl .GE. 775. .AND. pl .LT. 825. .AND. te .LE. 282. .AND. te .GT. &
549 & 275. .AND. tempor .EQ. 1.) THEN
550  IF (-(0.1*pl) + 0.71*te - 107.75 .GT. 10.) THEN
551  CALL pushcontrol1b(0)
552  ELSE
553  CALL pushcontrol1b(1)
554  END IF
555  CALL pushcontrol1b(0)
556  ELSE
557  CALL pushcontrol1b(1)
558  END IF
559  IF (pl .GE. 825. .AND. te .LE. 275. .AND. tempor .EQ. 1.) THEN
560  CALL pushcontrol1b(0)
561  ELSE
562  CALL pushcontrol1b(1)
563  END IF
564 ! Thin low tropical clouds
565  IF (pl .GE. 950. .AND. te .GE. 285.) THEN
566  IF (2.2*te - 617. .GT. 21.) THEN
567  CALL pushcontrol1b(0)
568  ELSE
569  CALL pushcontrol1b(1)
570  END IF
571  CALL pushcontrol1b(0)
572  ELSE
573  CALL pushcontrol1b(1)
574  END IF
575  IF (pl .GE. 925. .AND. te .GE. 290.) THEN
576  CALL pushcontrol1b(0)
577  ELSE
578  CALL pushcontrol1b(1)
579  END IF
580  IF (pl .GE. 925. .AND. pl .LT. 950. .AND. te .GT. 285. .AND. te .LT. &
581 & 290.) THEN
582  IF (0.44*pl + 2.2*te - 1035. .GT. 21.) THEN
583  CALL pushcontrol1b(0)
584  x2 = 21.
585  ELSE
586  x2 = 0.44*pl + 2.2*te - 1035.
587  CALL pushcontrol1b(1)
588  END IF
589  IF (x2 .LT. 10.) THEN
590  CALL pushcontrol1b(0)
591  ELSE
592  CALL pushcontrol1b(1)
593  END IF
594  CALL pushcontrol1b(0)
595  ELSE
596  CALL pushcontrol1b(1)
597  END IF
598  IF (pl .GE. 950. .AND. te .GE. 290.) THEN
599  CALL pushcontrol1b(0)
600  ELSE
601  CALL pushcontrol1b(1)
602  END IF
603  IF (rad_cf .LT. 1.e-5) THEN
604  rad_cfb = 0.0_8
605  rad_qib = 0.0_8
606  rad_qlb = 0.0_8
607  END IF
608  CALL popcontrol1b(branch)
609  IF (branch .EQ. 0) rad_rlb = 0.0_8
610  CALL popcontrol1b(branch)
611  IF (branch .EQ. 0) THEN
612  max3b = 1.e-6*rad_rlb
613  CALL popcontrol1b(branch)
614  IF (branch .EQ. 0) THEN
615  x2b = 0.0_8
616  ELSE
617  x2b = max3b
618  END IF
619  CALL popcontrol1b(branch)
620  IF (branch .NE. 0) teb = teb + 2.2*x2b
621  rad_rlb = 0.0_8
622  END IF
623  CALL popcontrol1b(branch)
624  IF (branch .EQ. 0) rad_rlb = 0.0_8
625  CALL popcontrol1b(branch)
626  IF (branch .EQ. 0) THEN
627  min2b = 1.e-6*rad_rlb
628  CALL popcontrol1b(branch)
629  IF (branch .NE. 0) teb = teb + 2.2*min2b
630  rad_rlb = 0.0_8
631  END IF
632  CALL popcontrol1b(branch)
633  IF (branch .EQ. 0) rad_rlb = 0.0_8
634  CALL popcontrol1b(branch)
635  IF (branch .EQ. 0) THEN
636  min1b = 1.e-6*rad_rlb
637  CALL popcontrol1b(branch)
638  IF (branch .NE. 0) teb = teb + 0.71*min1b
639  rad_rlb = 0.0_8
640  END IF
641  CALL popcontrol1b(branch)
642  IF (branch .EQ. 0) THEN
643  max2b = 1.e-6*rad_rlb
644  CALL popcontrol1b(branch)
645  IF (branch .NE. 0) teb = teb + 0.71*max2b
646  END IF
647  CALL popcontrol1b(branch)
648  IF (branch .EQ. 0) rad_rib = 0.0_8
649  CALL popcontrol1b(branch)
650  IF (branch .EQ. 0) THEN
651  CALL popreal8(rad_ri)
652  rad_ri_anb = rad_rib
653  ELSE
654  CALL popreal8(rad_ri)
655  rad_ri_anb = 0.0_8
656  END IF
657  CALL popcontrol2b(branch)
658  IF (branch .NE. 0) THEN
659  IF (branch .NE. 1) THEN
660  temp = qcils/rad_ri + qcian/ri_anv
661  tempb1 = rad_ri_anb/temp
662  tempb2 = -((qcils+qcian)*tempb1/temp)
663  qcilsb = qcilsb + tempb2/rad_ri + tempb1
664  qcianb = qcianb + tempb2/ri_anv + tempb1
665  END IF
666  END IF
667  CALL popcontrol1b(branch)
668  IF (branch .EQ. 0) rad_qib = 0.0_8
669  CALL popcontrol1b(branch)
670  IF (branch .NE. 0) THEN
671  tempb0 = rad_qib/rad_cf
672  qcilsb = qcilsb + tempb0
673  qcianb = qcianb + tempb0
674  rad_cfb = rad_cfb - (qcils+qcian)*tempb0/rad_cf
675  END IF
676  CALL popcontrol1b(branch)
677  IF (branch .EQ. 0) rad_qlb = 0.0_8
678  CALL popcontrol1b(branch)
679  IF (branch .NE. 0) THEN
680  tempb = rad_qlb/rad_cf
681  qcllsb = qcllsb + tempb
682  qclanb = qclanb + tempb
683  rad_cfb = rad_cfb - (qclls+qclan)*tempb/rad_cf
684  END IF
685  CALL popcontrol1b(branch)
686  IF (branch .EQ. 0) THEN
687  afxb = 0.0_8
688  ELSE
689  cfb = cfb + rad_cfb
690  afxb = rad_cfb
691  END IF
692  afb = afb + 0.5*ss*afxb
693  ssb = 0.5*af*afxb
694  CALL popreal8(ss)
695  ssb = (1.0-alph)*3*ss**2*ssb
696  CALL popcontrol1b(branch)
697  IF (branch .NE. 0) ssb = 0.0_8
698  CALL popcontrol1b(branch)
699  IF (branch .NE. 0) ssb = 0.0_8
700  teb = teb - ssb/20.
701 END SUBROUTINE radcouple_b
702 
703 end module cloudradcouple
popcontrol2b
subroutine popcontrol2b(cc)
Definition: adBuffer.f:146
cloudradcouple::radcouple
subroutine, public radcouple(TE, PL, CF, AF, QClLS, QCiLS, QClAN, QCiAN, RAD_QL, RAD_QI, RAD_CF, RAD_RL, RAD_RI, TEMPOR)
Definition: cloudradcouple.F90:24
cloudradcouple::radcouple_d
subroutine, public radcouple_d(te, ted, pl, cf, cfd, af, afd, qclls, qcllsd, qcils, qcilsd, qclan, qcland, qcian, qciand, rad_ql, rad_qld, rad_qi, rad_qid, rad_cf, rad_cfd, rad_rl, rad_rld, rad_ri, rad_rid, tempor)
Definition: cloudradcouple.F90:159
pushcontrol1b
subroutine pushcontrol1b(cc)
Definition: adBuffer.f:115
pushcontrol2b
subroutine pushcontrol2b(cc)
Definition: adBuffer.f:140
popreal8
subroutine popreal8(x)
Definition: adBuffer.f:820
cloudradcouple::radcouple_b
subroutine, public radcouple_b(te, teb, pl, cf, cfb, af, afb, qclls, qcllsb, qcils, qcilsb, qclan, qclanb, qcian, qcianb, rad_ql, rad_qlb, rad_qi, rad_qib, rad_cf, rad_cfb, rad_rl, rad_rlb, rad_ri, rad_rib, tempor)
Definition: cloudradcouple.F90:404
pushreal8
subroutine pushreal8(x)
Definition: adBuffer.f:763
popcontrol1b
subroutine popcontrol1b(cc)
Definition: adBuffer.f:120
max
#define max(a, b)
Definition: mosaic_util.h:33
min
#define min(a, b)
Definition: mosaic_util.h:32