source: LMDZ6/branches/DYNAMICO-conv-GC/libf/phymar/rrtm_taumol2.F90

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 4.3 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL2 (KLEV,TAU,COLDRY,&
3  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,&
4  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
5
6!     BAND 2:  250-500 cm-1 (low - H2O; high - H2O)
7
8! Modifications
9!
10!     D Salmond   2000-05-15 speed-up
11!     JJMorcrette 2000-05-17 speed-up
12!     JJMorcrette 2000-07-14 bugfix
13
14
15#include "tsmbkind.h"
16
17USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,JPXSEC  , NGS1
18USE YOERRTWN , ONLY : NG     ,NSPA   ,NSPB
19USE YOERRTA2 , ONLY : NG2    ,ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
20            &FORREF   ,KA     ,KB     ,SELFREF , REFPARAM
21USE YOERRTBG2, ONLY : CORR1  ,CORR2
22
23!  Input
24!#include "yoeratm.h"
25
26
27IMPLICIT NONE
28
29REAL_B :: COLDRY(JPLAY)
30
31!  Output
32REAL_B :: TAU   (JPGPT,JPLAY)
33
34!     DUMMY INTEGER SCALARS
35INTEGER_M :: KLEV
36
37!- from AER
38REAL_B :: TAUAERL(JPLAY,JPBAND)
39
40!- from INTFAC     
41REAL_B :: FAC00(JPLAY)
42REAL_B :: FAC01(JPLAY)
43REAL_B :: FAC10(JPLAY)
44REAL_B :: FAC11(JPLAY)
45REAL_B :: FORFAC(JPLAY)
46
47!- from INTIND
48INTEGER_M :: JP(JPLAY)
49INTEGER_M :: JT(JPLAY)
50INTEGER_M :: JT1(JPLAY)
51
52!- from PROFDATA             
53REAL_B :: COLH2O(JPLAY)
54INTEGER_M :: LAYTROP
55
56!- from SELF             
57REAL_B :: SELFFAC(JPLAY)
58REAL_B :: SELFFRAC(JPLAY)
59INTEGER_M :: INDSELF(JPLAY)
60
61!- from SP             
62REAL_B :: PFRAC(JPGPT,JPLAY)
63
64REAL_B :: FC00(JPLAY),FC01(JPLAY),FC10(JPLAY),FC11(JPLAY)
65!      REAL TAUAER(JPLAY)
66REAL_B :: FRACINT(JPLAY)
67INTEGER_M :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY), INDEX(JPLAY)
68
69!     LOCAL INTEGER SCALARS
70INTEGER_M :: IFP, IFRAC, IG, JFRAC, LAY
71
72!     LOCAL REAL SCALARS
73REAL_B :: FP, H2OPARAM, WATER
74
75!      EQUIVALENCE (TAUAERL(1,2),TAUAER)
76
77!     Compute the optical depth by interpolating in ln(pressure) and
78!     temperature.  Below LAYTROP, the water vapor self-continuum is
79!     interpolated (in temperature) separately.
80
81DO LAY = 1, LAYTROP
82  WATER = 1.E20_JPRB * COLH2O(LAY) / COLDRY(LAY)
83  H2OPARAM = WATER/(WATER +.002_JPRB)
84 
85!  DO IFRAC = 2, 12
86!    IF (H2OPARAM  >=  REFPARAM(IFRAC)) GO TO 1900
87!  ENDDO
88!  1900 CONTINUE
89!  FRACINT(LAY) = (H2OPARAM-REFPARAM(IFRAC))/&
90!   &(REFPARAM(IFRAC-1)-REFPARAM(IFRAC))
91
92  IF (H2OPARAM >= REFPARAM(2)) THEN
93    INDEX(LAY)=2
94  ELSE
95    DO JFRAC = 2, 12
96      IF (H2OPARAM < REFPARAM(JFRAC)) THEN
97        INDEX(LAY)=JFRAC+1
98      END IF 
99    ENDDO
100  ENDIF 
101 
102!---- JJM_000714
103  IFRAC=INDEX(LAY)
104  FRACINT(LAY) = (H2OPARAM-REFPARAM(IFRAC))/&
105   &(REFPARAM(IFRAC-1)-REFPARAM(IFRAC))
106ENDDO
107
108DO LAY = 1, LAYTROP
109
110  FP = FAC11(LAY) + FAC01(LAY)
111  IFP = 2.E2_JPRB*FP+_HALF_
112
113!---MI 981104       
114!       IF (IFP.LE.0) IFP=0
115
116  IFP=MAX(0,INT(IFP))
117
118  FC00(LAY) = FAC00(LAY) * CORR2(IFP)
119  FC10(LAY) = FAC10(LAY) * CORR2(IFP)
120  FC01(LAY) = FAC01(LAY) * CORR1(IFP)
121  FC11(LAY) = FAC11(LAY) * CORR1(IFP)
122  IND0(LAY) = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(2) + 1
123  IND1(LAY) = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(2) + 1
124  INDS(LAY) = INDSELF(LAY)
125ENDDO
126
127!-- DS_000515 
128DO IG = 1, NG2
129  DO LAY = 1, LAYTROP
130!-- JJM_000714
131    IFRAC=INDEX(LAY) 
132!-- DS_000515 
133    TAU (NGS1+IG,LAY) = COLH2O(LAY) *&
134     &(FC00(LAY) * ABSA(IND0(LAY)  ,IG) +&
135     & FC10(LAY) * ABSA(IND0(LAY)+1,IG) +&
136     & FC01(LAY) * ABSA(IND1(LAY)  ,IG) +&
137     & FC11(LAY) * ABSA(IND1(LAY)+1,IG) +&
138     &SELFFAC(LAY) * (SELFREF(INDS(LAY),IG) + &
139     &SELFFRAC(LAY) *&
140     &(SELFREF(INDS(LAY)+1,IG) - SELFREF(INDS(LAY),IG)))&
141     &+ FORFAC(LAY) * FORREF(IG) ) &
142     &+ TAUAERL(LAY,2)
143    PFRAC(NGS1+IG,LAY) = FRACREFA(IG,IFRAC) + FRACINT(LAY) *&
144     &(FRACREFA(IG,IFRAC-1)-FRACREFA(IG,IFRAC))
145  ENDDO
146ENDDO
147
148DO LAY = LAYTROP+1, KLEV
149  FP = FAC11(LAY) + FAC01(LAY)
150  IFP = 2.E2_JPRB*FP+_HALF_
151
152!---MI 981104       
153  IF (IFP <= 0) IFP=0
154
155  FC00(LAY) = FAC00(LAY) * CORR2(IFP)
156  FC10(LAY) = FAC10(LAY) * CORR2(IFP)
157  FC01(LAY) = FAC01(LAY) * CORR1(IFP)
158  FC11(LAY) = FAC11(LAY) * CORR1(IFP)
159  IND0(LAY) = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(2) + 1
160  IND1(LAY) = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(2) + 1
161ENDDO
162
163!-- JJM_000517
164DO IG = 1, NG2
165  DO LAY = LAYTROP+1, KLEV
166!-- JJM_000517
167    TAU (NGS1+IG,LAY) = COLH2O(LAY) *&
168     &(FC00(LAY) * ABSB(IND0(LAY)  ,IG) +&
169     & FC10(LAY) * ABSB(IND0(LAY)+1,IG) +&
170     & FC01(LAY) * ABSB(IND1(LAY)  ,IG) +&
171     & FC11(LAY) * ABSB(IND1(LAY)+1,IG)&
172     &+ FORFAC(LAY) * FORREF(IG) ) &
173     &+ TAUAERL(LAY,2)
174    PFRAC(NGS1+IG,LAY) = FRACREFB(IG)
175  ENDDO
176ENDDO
177
178RETURN
179END SUBROUTINE RRTM_TAUMOL2
Note: See TracBrowser for help on using the repository browser.