source: LMDZ5/trunk/libf/phymar/rrtm_taumol5.F90 @ 3406

Last change on this file since 3406 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR


Integration of MAR physics

File size: 5.7 KB
RevLine 
[2089]1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL5 (KLEV,TAU,WX,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
4  &COLH2O,COLCO2, COLO3,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
7
8! Modifications
9!
10!     D Salmond 2000-05-15 speed-up
11
12
13#include "tsmbkind.h"
14
15USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,JPXSEC , NGS4
16USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
17USE YOERRTA5 , ONLY : NG5    ,ABSA   ,ABSB   ,CCL4   , FRACREFA, FRACREFB,&
18            &KA       ,KB     ,SELFREF,STRRAT1, STRRAT2
19
20!  Input
21!#include "yoeratm.h"
22
23!      REAL TAUAER(JPLAY)
24
25
26IMPLICIT NONE
27
28REAL_B ::     WX(JPXSEC,JPLAY)       ! Amount of trace gases
29!  Output
30REAL_B :: TAU   (JPGPT,JPLAY)
31
32!     DUMMY INTEGER SCALARS
33INTEGER_M :: KLEV
34
35!- from AER
36REAL_B :: TAUAERL(JPLAY,JPBAND)
37
38!- from INTFAC     
39REAL_B :: FAC00(JPLAY)
40REAL_B :: FAC01(JPLAY)
41REAL_B :: FAC10(JPLAY)
42REAL_B :: FAC11(JPLAY)
43REAL_B :: FORFAC(JPLAY)
44
45!- from INTIND
46INTEGER_M :: JP(JPLAY)
47INTEGER_M :: JT(JPLAY)
48INTEGER_M :: JT1(JPLAY)
49
50!- from PRECISE             
51REAL_B :: ONEMINUS
52
53!- from PROFDATA             
54REAL_B :: COLH2O(JPLAY)
55REAL_B :: COLCO2(JPLAY)
56REAL_B :: COLO3 (JPLAY)
57INTEGER_M :: LAYTROP
58
59!- from SELF             
60REAL_B :: SELFFAC(JPLAY)
61REAL_B :: SELFFRAC(JPLAY)
62INTEGER_M :: INDSELF(JPLAY)
63
64!- from SP             
65REAL_B :: PFRAC(JPGPT,JPLAY)
66
67INTEGER_M :: IJS(JPLAY)
68REAL_B :: ZFS(JPLAY),SPECCOMB(JPLAY)
69INTEGER_M :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY)
70
71!     LOCAL INTEGER SCALARS
72INTEGER_M :: IG, JS, LAY
73
74!     LOCAL REAL SCALARS
75REAL_B :: FAC000, FAC001, FAC010, FAC011, FAC100, FAC101,&
76          &FAC110, FAC111, FS, SPECMULT, SPECPARM
77
78
79!      EQUIVALENCE (TAUAERL(1,5),TAUAER)
80
81!     Compute the optical depth by interpolating in ln(pressure),
82!     temperature, and appropriate species.  Below LAYTROP, the water
83!     vapor self-continuum is interpolated (in temperature) separately. 
84
85DO LAY = 1, LAYTROP
86  SPECCOMB(LAY) = COLH2O(LAY) + STRRAT1*COLCO2(LAY)
87  SPECPARM = COLH2O(LAY)/SPECCOMB(LAY)
88  SPECPARM=MIN(ONEMINUS,SPECPARM)
89  SPECMULT = 8._JPRB*(SPECPARM)
90  JS = 1 + INT(SPECMULT)
91  FS = MOD(SPECMULT,_ONE_)
92  IND0(LAY) = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(5) + JS
93  IND1(LAY) = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(5) + JS
94  INDS(LAY) = INDSELF(LAY)
95
96  ZFS(LAY)=FS
97  IJS(LAY)=JS
98
99ENDDO
100
101!-- DS_000515
102DO IG = 1, NG5
103  DO LAY = 1, LAYTROP
104!-- DS_000515
105
106    FS=ZFS(LAY)
107    JS=IJS(LAY)
108!---jjm
109!    FAC000 = (_ONE_ - FS) * FAC00(LAY)
110!    FAC010 = (_ONE_ - FS) * FAC10(LAY)
111!    FAC100 = FS * FAC00(LAY)
112!    FAC110 = FS * FAC10(LAY)
113!    FAC001 = (_ONE_ - FS) * FAC01(LAY)
114!    FAC011 = (_ONE_ - FS) * FAC11(LAY)
115!    FAC101 = FS * FAC01(LAY)
116!    FAC111 = FS * FAC11(LAY)
117!-----         
118
119    TAU (NGS4+IG,LAY) = SPECCOMB(LAY) *   &
120!-- DS_000515
121     &( (1. - FS) *(FAC00(LAY) * ABSA(IND0(LAY)   ,IG) +   &
122     &              FAC10(LAY) * ABSA(IND0(LAY)+ 9,IG) +   &
123     &              FAC01(LAY) * ABSA(IND1(LAY)   ,IG) +   &
124     &              FAC11(LAY) * ABSA(IND1(LAY)+ 9,IG))+   &
125     &     FS     *(FAC00(LAY) * ABSA(IND0(LAY)+ 1,IG) +   &
126     &              FAC10(LAY) * ABSA(IND0(LAY)+10,IG) +   &
127     &              FAC01(LAY) * ABSA(IND1(LAY)+ 1,IG) +   &
128     &              FAC11(LAY) * ABSA(IND1(LAY)+10,IG))) + &
129!     &(FAC000 * ABSA(IND0(LAY)   ,IG) +&
130!     & FAC100 * ABSA(IND0(LAY)+ 1,IG) +&
131!     & FAC010 * ABSA(IND0(LAY)+ 9,IG) +&
132!     & FAC110 * ABSA(IND0(LAY)+10,IG) +&
133!     & FAC001 * ABSA(IND1(LAY)   ,IG) +&
134!     & FAC101 * ABSA(IND1(LAY)+ 1,IG) +&
135!     & FAC011 * ABSA(IND1(LAY)+ 9,IG) +&
136!     & FAC111 * ABSA(IND1(LAY)+10,IG))+&
137!-- DS_000515
138     &COLH2O(LAY) * &
139     &SELFFAC(LAY) * (SELFREF(INDS(LAY),IG) + &
140     &SELFFRAC(LAY) *&
141     &(SELFREF(INDS(LAY)+1,IG) - SELFREF(INDS(LAY),IG)))&
142     &+ WX(1,LAY) * CCL4(IG)&
143     &+ TAUAERL(LAY,5)
144    PFRAC(NGS4+IG,LAY) = FRACREFA(IG,JS) + FS *&
145     &(FRACREFA(IG,JS+1) - FRACREFA(IG,JS))
146  ENDDO
147ENDDO
148
149DO LAY = LAYTROP+1, KLEV
150  SPECCOMB(LAY) = COLO3(LAY) + STRRAT2*COLCO2(LAY)
151  SPECPARM = COLO3(LAY)/SPECCOMB(LAY)
152  SPECPARM=MIN(ONEMINUS,SPECPARM)
153  SPECMULT = 4._JPRB*(SPECPARM)
154  JS = 1 + INT(SPECMULT)
155  FS = MOD(SPECMULT,_ONE_)
156  IND0(LAY) = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(5) + JS
157  IND1(LAY) = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(5) + JS
158  ZFS(LAY)=FS
159  IJS(LAY)=JS
160ENDDO
161
162DO LAY = LAYTROP+1, KLEV
163  FS=ZFS(LAY)
164  JS=IJS(LAY)
165!----jjm         
166!  FAC000 = (_ONE_ - FS) * FAC00(LAY)
167!  FAC010 = (_ONE_ - FS) * FAC10(LAY)
168!  FAC100 = FS * FAC00(LAY)
169!  FAC110 = FS * FAC10(LAY)
170!  FAC001 = (_ONE_ - FS) * FAC01(LAY)
171!  FAC011 = (_ONE_ - FS) * FAC11(LAY)
172!  FAC101 = FS * FAC01(LAY)
173!  FAC111 = FS * FAC11(LAY)
174!----         
175  DO IG = 1, NG5
176!-- DS_000515
177    TAU (NGS4+IG,LAY) = SPECCOMB(LAY) *   &
178     &( (1. - FS) *(FAC00(LAY) * ABSB(IND0(LAY)  ,IG) +   &
179     &              FAC10(LAY) * ABSB(IND0(LAY)+5,IG) +   &
180     &              FAC01(LAY) * ABSB(IND1(LAY)  ,IG) +   &
181     &              FAC11(LAY) * ABSB(IND1(LAY)+5,IG))+   &
182     &     FS     *(FAC00(LAY) * ABSB(IND0(LAY)+1,IG) +   &
183     &              FAC10(LAY) * ABSB(IND0(LAY)+6,IG) +   &
184     &              FAC01(LAY) * ABSB(IND1(LAY)+1,IG) +   &
185     &              FAC11(LAY) * ABSB(IND1(LAY)+6,IG)))   &
186!     &(FAC000 * ABSB(IND0(LAY)  ,IG) +&
187!     & FAC100 * ABSB(IND0(LAY)+1,IG) +&
188!     & FAC010 * ABSB(IND0(LAY)+5,IG) +&
189!     & FAC110 * ABSB(IND0(LAY)+6,IG) +&
190!     & FAC001 * ABSB(IND1(LAY)  ,IG) +&
191!     & FAC101 * ABSB(IND1(LAY)+1,IG) +&
192!     & FAC011 * ABSB(IND1(LAY)+5,IG) +&
193!     & FAC111 * ABSB(IND1(LAY)+6,IG))&
194!-- DS_000515
195     &+ WX(1,LAY) * CCL4(IG)&
196     &+ TAUAERL(LAY,5)
197    PFRAC(NGS4+IG,LAY) = FRACREFB(IG,JS) + FS *&
198     &(FRACREFB(IG,JS+1) - FRACREFB(IG,JS))
199  ENDDO
200ENDDO
201
202RETURN
203END SUBROUTINE RRTM_TAUMOL5
Note: See TracBrowser for help on using the repository browser.