LMDZ
rrtm_taumol13.F90
Go to the documentation of this file.
1 !----------------------------------------------------------------------------
2 SUBROUTINE rrtm_taumol13 (KLEV,TAU,&
3  &tauaerl,fac00,fac01,fac10,fac11,jp,jt,jt1,oneminus,&
4  &colh2o,coln2o,laytrop,selffac,selffrac,indself,pfrac)
5 
6 ! BAND 13: 2080-2250 cm-1 (low - H2O,N2O; high - nothing)
7 
8 ! Modifications
9 !
10 ! D Salmond 2000-05-15 speed-up
11 
12 
13 #include "tsmbkind.h"
14 
15 USE parrrtm , ONLY : jplay ,jpband ,jpgpt ,jpxsec,ngs12
16 USE yoerrtwn , ONLY : ng ,nspa ,nspb
18 
19 ! Input
20 !#include "yoeratm.h"
21 
22 ! REAL TAUAER(JPLAY)
23 
24 
25 IMPLICIT NONE
26 
27 ! Output
28 real_b :: tau(jpgpt,jplay)
29 
30 ! DUMMY INTEGER SCALARS
31 integer_m :: klev
32 
33 !- from AER
34 real_b :: tauaerl(jplay,jpband)
35 
36 !- from INTFAC
37 real_b :: fac00(jplay)
38 real_b :: fac01(jplay)
39 real_b :: fac10(jplay)
40 real_b :: fac11(jplay)
41 
42 !- from INTIND
43 integer_m :: jp(jplay)
44 integer_m :: jt(jplay)
45 integer_m :: jt1(jplay)
46 
47 !- from PRECISE
48 real_b :: oneminus
49 
50 !- from PROFDATA
51 real_b :: colh2o(jplay)
52 real_b :: coln2o(jplay)
53 integer_m :: laytrop
54 
55 !- from SELF
56 real_b :: selffac(jplay)
57 real_b :: selffrac(jplay)
58 integer_m :: indself(jplay)
59 
60 !- from SP
61 real_b :: pfrac(jpgpt,jplay)
62 
63 integer_m :: ijs(jplay)
64 real_b :: zfs(jplay),speccomb(jplay)
65 integer_m :: ind0(jplay),ind1(jplay),inds(jplay)
66 
67 ! LOCAL INTEGER SCALARS
68 integer_m :: ig, js, lay
69 
70 ! LOCAL REAL SCALARS
71 real_b :: fac000, fac001, fac010, fac011, fac100, fac101,&
72  &fac110, fac111, fs, specmult, specparm
73 
74 
75 ! EQUIVALENCE (TAUAERL(1,13),TAUAER)
76 
77 ! Compute the optical depth by interpolating in ln(pressure),
78 ! temperature, and appropriate species. Below LAYTROP, the water
79 ! vapor self-continuum is interpolated (in temperature) separately.
80 
81 DO lay = 1, laytrop
82  speccomb(lay) = colh2o(lay) + strrat*coln2o(lay)
83  specparm = colh2o(lay)/speccomb(lay)
84  specparm=min(oneminus,specparm)
85  specmult = 8._jprb*(specparm)
86  js = 1 + int(specmult)
87  fs = mod(specmult,_one_)
88  ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(13) + js
89  ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(13) + js
90  inds(lay) = indself(lay)
91 
92  zfs(lay)=fs
93  ijs(lay)=js
94 
95 ENDDO
96 
97 !-- DS_000515
98 DO ig = 1, ng13
99  DO lay = 1, laytrop
100 !-- DS_000515
101 
102  fs=zfs(lay)
103  js=ijs(lay)
104 !---jjm
105 ! FAC000 = (_ONE_ - FS) * FAC00(LAY)
106 ! FAC010 = (_ONE_ - FS) * FAC10(LAY)
107 ! FAC100 = FS * FAC00(LAY)
108 ! FAC110 = FS * FAC10(LAY)
109 ! FAC001 = (_ONE_ - FS) * FAC01(LAY)
110 ! FAC011 = (_ONE_ - FS) * FAC11(LAY)
111 ! FAC101 = FS * FAC01(LAY)
112 ! FAC111 = FS * FAC11(LAY)
113 !----
114  tau(ngs12+ig,lay) = speccomb(lay) *&
115 !-- DS_000515
116  &( (1. - fs) *( fac00(lay) * absa(ind0(lay) ,ig) + &
117  & fac10(lay) * absa(ind0(lay)+ 9,ig) + &
118  & fac01(lay) * absa(ind1(lay) ,ig) + &
119  & fac11(lay) * absa(ind1(lay)+ 9,ig))+ &
120  & fs *( fac00(lay) * absa(ind0(lay)+ 1,ig) + &
121  & fac10(lay) * absa(ind0(lay)+10,ig) + &
122  & fac01(lay) * absa(ind1(lay)+ 1,ig) + &
123  & fac11(lay) * absa(ind1(lay)+10,ig))) + &
124 ! &(FAC000 * ABSA(IND0(LAY) ,IG) +&
125 ! & FAC100 * ABSA(IND0(LAY)+ 1,IG) +&
126 ! & FAC010 * ABSA(IND0(LAY)+ 9,IG) +&
127 ! & FAC110 * ABSA(IND0(LAY)+10,IG) +&
128 ! & FAC001 * ABSA(IND1(LAY) ,IG) +&
129 ! & FAC101 * ABSA(IND1(LAY)+ 1,IG) +&
130 ! & FAC011 * ABSA(IND1(LAY)+ 9,IG) +&
131 ! & FAC111 * ABSA(IND1(LAY)+10,IG))+&
132 !-- DS_000515
133  &colh2o(lay) * &
134  &selffac(lay) * (selfref(inds(lay),ig) + &
135  &selffrac(lay) *&
136  &(selfref(inds(lay)+1,ig) - selfref(inds(lay),ig)))&
137  &+ tauaerl(lay,13)
138  pfrac(ngs12+ig,lay) = fracrefa(ig,js) + fs *&
139  &(fracrefa(ig,js+1) - fracrefa(ig,js))
140  ENDDO
141 ENDDO
142 
143 !-- JJM_000517
144 DO ig = 1, ng13
145  DO lay = laytrop+1, klev
146 !-- JJM_000517
147  tau(ngs12+ig,lay) = tauaerl(lay,13)
148  pfrac(ngs12+ig,lay) = _zero_
149  ENDDO
150 ENDDO
151 
152 RETURN
153 END SUBROUTINE rrtm_taumol13
real(kind=jprb), dimension(9, 5, 13, ng13) ka
Definition: yoerrta13.F90:18
subroutine rrtm_taumol13(KLEV, P_TAU, P_TAUAERL, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLN2O, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, PFRAC)
integer, save klev
Definition: dimphy.F90:7
real(kind=jprb), dimension(ng13, 9) fracrefa
Definition: yoerrta13.F90:16
integer(kind=jpim), parameter jpgpt
Definition: parrrtm.F90:21
integer(kind=jpim), parameter jpband
Definition: parrrtm.F90:18
real(kind=jprb), dimension(10, ng13) selfref
Definition: yoerrta13.F90:19
integer(kind=jpim), parameter ngs12
Definition: parrrtm.F90:51
integer(kind=jpim), dimension(16) nspb
Definition: yoerrtwn.F90:13
integer(kind=jpim), dimension(16) ng
Definition: yoerrtwn.F90:11
integer(kind=jpim), parameter ng13
Definition: yoerrta13.F90:14
integer(kind=jpim), dimension(16) nspa
Definition: yoerrtwn.F90:12
real(kind=jprb), dimension(585, ng13) absa
Definition: yoerrta13.F90:18
integer(kind=jpim), parameter jplay
Definition: parrrtm.F90:15
real(kind=jprb) strrat
Definition: yoerrta13.F90:20
integer(kind=jpim), parameter jpxsec
Definition: parrrtm.F90:19