source: LMDZ6/trunk/libf/phylmdiso/rrtm/rrtm_taumol9.F90 @ 3927

Last change on this file since 3927 was 3927, checked in by Laurent Fairhead, 3 years ago

Initial import of the physics wih isotopes from Camille Risi
CR
File size: 6.8 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL9 (KLEV,P_TAU,&
3 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
4 & P_COLH2O,P_COLN2O,P_COLCH4,K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
5
6!     BAND 9:  1180-1390 cm-1 (low - H2O,CH4; high - CH4)
7
8! Modifications
9!        M.Hamrud      01-Oct-2003 CY28 Cleaning
10
11!     D Salmond   2000-05-15 speed-up
12!     JJMorcrette 2000-05-17 speed-up
13
14USE PARKIND1  ,ONLY : JPIM     ,JPRB
15USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
16
17USE PARRRTM  , ONLY : JPLAY  ,JPBAND ,JPGPT  ,NG9   ,NGS8
18USE YOERRTWN , ONLY :      NSPA   ,NSPB
19USE YOERRTA9 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,ABSN2O  , CH4REF  ,&
20 & ETAREF  , H2OREF ,N2OREF ,STRRAT 
21
22!  Input
23!#include "yoeratm.h"
24
25IMPLICIT NONE
26
27!  Output
28INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
29REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(JPGPT,JPLAY)
30REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(JPLAY,JPBAND)
31REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(JPLAY)
32REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(JPLAY)
33REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(JPLAY)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(JPLAY)
35INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(JPLAY)
36INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(JPLAY)
37INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(JPLAY)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
39REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(JPLAY)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(JPLAY)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(JPLAY)
42INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP
43INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYSWTCH
44INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYLOW
45REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(JPLAY)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(JPLAY)
47INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(JPLAY)
48REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(JPGPT,JPLAY)
49!- from AER
50!- from INTFAC     
51!- from INTIND
52!- from PRECISE             
53!- from PROFDATA             
54!- from SELF             
55!- from SP             
56INTEGER(KIND=JPIM) :: JFRAC(JPLAY)
57REAL(KIND=JPRB) :: Z_FFRAC(JPLAY),ZFS(JPLAY),Z_SPECCOMB(JPLAY)
58INTEGER(KIND=JPIM) :: IND0(JPLAY),IND1(JPLAY),INDS(JPLAY),IIOFF(JPLAY)
59
60!      REAL TAUAER(JPLAY)
61REAL(KIND=JPRB) :: Z_N2OMULT(JPLAY)
62
63INTEGER(KIND=JPIM) :: IG, IOFF, JS, I_LAY, I_NS
64
65REAL(KIND=JPRB) :: Z_COLREF1, Z_COLREF2, Z_CURRN2O, Z_FAC000, Z_FAC001,&
66 & Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101, Z_FAC110, Z_FAC111, &
67 & Z_FP, Z_FS, Z_RATIO, Z_SPECMULT, Z_SPECPARM, Z_WCOMB1, &
68 & Z_WCOMB2 
69REAL(KIND=JPRB) :: ZHOOK_HANDLE
70
71!      EQUIVALENCE (TAUAERL(1,9),TAUAER)
72
73IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL9',0,ZHOOK_HANDLE)
74IOFF = 0
75
76!     Compute the optical depth by interpolating in ln(pressure),
77!     temperature, and appropriate species.  Below LAYTROP, the water
78!     vapor self-continuum is interpolated (in temperature) separately.
79 
80DO I_LAY = 1, K_LAYTROP
81  Z_SPECCOMB(I_LAY) = P_COLH2O(I_LAY) + STRRAT*P_COLCH4(I_LAY)
82  Z_SPECPARM = P_COLH2O(I_LAY)/Z_SPECCOMB(I_LAY)
83  Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
84  Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
85  JS = 1 + INT(Z_SPECMULT)
86  JFRAC(I_LAY) = JS
87  Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
88  Z_FFRAC(I_LAY) = Z_FS
89  IF (JS  ==  8) THEN
90    IF (Z_FS <= 0.68_JPRB) THEN
91      Z_FS = Z_FS/0.68_JPRB
92    ELSEIF (Z_FS  <=  0.92_JPRB) THEN
93      JS = JS + 1
94      Z_FS = (Z_FS-0.68_JPRB)/0.24_JPRB
95    ELSE
96      JS = JS + 2
97      Z_FS = (Z_FS-0.92_JPRB)/0.08_JPRB
98    ENDIF
99  ELSEIF (JS  == 9) THEN
100    JS = 10
101    Z_FS = 1.0_JPRB
102    JFRAC(I_LAY) = 8
103    Z_FFRAC(I_LAY) = 1.0_JPRB
104  ENDIF
105  Z_FP = P_FAC01(I_LAY) + P_FAC11(I_LAY)
106  I_NS = JS + INT(Z_FS + 0.5_JPRB)
107  IND0(I_LAY) = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(9) + JS
108  IND1(I_LAY) = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(9) + JS
109  INDS(I_LAY) = K_INDSELF(I_LAY)
110  IF (I_LAY  ==  K_LAYLOW) IOFF = NG9
111  IF (I_LAY  ==  K_LAYSWTCH) IOFF = 2*NG9
112  Z_COLREF1 = N2OREF(K_JP(I_LAY))
113  Z_COLREF2 = N2OREF(K_JP(I_LAY)+1)
114  IF (I_NS  ==  11) THEN
115    Z_WCOMB1 = 1.0_JPRB/H2OREF(K_JP(I_LAY))
116    Z_WCOMB2 = 1.0_JPRB/H2OREF(K_JP(I_LAY)+1)
117  ELSE
118    Z_WCOMB1 = (1.0_JPRB-ETAREF(I_NS))/(STRRAT * CH4REF(K_JP(I_LAY)))
119    Z_WCOMB2 = (1.0_JPRB-ETAREF(I_NS))/(STRRAT * CH4REF(K_JP(I_LAY)+1))
120  ENDIF
121  Z_RATIO = (Z_COLREF1*Z_WCOMB1)+Z_FP*((Z_COLREF2*Z_WCOMB2)-(Z_COLREF1*Z_WCOMB1))
122  Z_CURRN2O = Z_SPECCOMB(I_LAY) * Z_RATIO
123  Z_N2OMULT(I_LAY) = P_COLN2O(I_LAY) - Z_CURRN2O
124
125  ZFS(I_LAY)=Z_FS
126  IIOFF(I_LAY)=IOFF
127
128ENDDO
129
130!-- DS_000515
131DO IG = 1, NG9
132  DO I_LAY = 1, K_LAYTROP
133!-- DS_000515
134
135    Z_FS=ZFS(I_LAY)
136    IOFF=IIOFF(I_LAY)
137!---jjm
138!    FAC000 = (_ONE_ - FS) * FAC00(LAY)
139!    FAC010 = (_ONE_ - FS) * FAC10(LAY)
140!    FAC100 = FS * FAC00(LAY)
141!    FAC110 = FS * FAC10(LAY)
142!    FAC001 = (_ONE_ - FS) * FAC01(LAY)
143!    FAC011 = (_ONE_ - FS) * FAC11(LAY)
144!    FAC101 = FS * FAC01(LAY)
145!    FAC111 = FS * FAC11(LAY)
146!------         
147
148    P_TAU (NGS8+IG,I_LAY) = Z_SPECCOMB(I_LAY) *&
149     !-- DS_000515
150     !     &(Z_FAC000 * ABSA(IND0(I_LAY)   ,IG) +&
151     !     & Z_FAC100 * ABSA(IND0(I_LAY)+ 1,IG) +&
152     !     & Z_FAC010 * ABSA(IND0(I_LAY)+11,IG) +&
153     !     & Z_FAC110 * ABSA(IND0(I_LAY)+12,IG) +&
154     !     & Z_FAC001 * ABSA(IND1(I_LAY)   ,IG) +&
155     !     & Z_FAC101 * ABSA(IND1(I_LAY)+ 1,IG) +&
156     !     & Z_FAC011 * ABSA(IND1(I_LAY)+11,IG) +&
157     !     & Z_FAC111 * ABSA(IND1(I_LAY)+12,IG))+&
158     & ( (1. - Z_FS) *(P_FAC00(I_LAY) * ABSA(IND0(I_LAY)   ,IG) +   &
159     & P_FAC10(I_LAY) * ABSA(IND0(I_LAY)+11,IG) +   &
160     & P_FAC01(I_LAY) * ABSA(IND1(I_LAY)   ,IG) +   &
161     & P_FAC11(I_LAY) * ABSA(IND1(I_LAY)+11,IG))+   &
162     & Z_FS     *(P_FAC00(I_LAY) * ABSA(IND0(I_LAY)+ 1,IG) +   &
163     & P_FAC10(I_LAY) * ABSA(IND0(I_LAY)+12,IG) +   &
164     & P_FAC01(I_LAY) * ABSA(IND1(I_LAY)+ 1,IG) +   &
165     & P_FAC11(I_LAY) * ABSA(IND1(I_LAY)+12,IG))) + &
166     !-- DS_000515
167     & P_COLH2O(I_LAY) * &
168     & P_SELFFAC(I_LAY) * (SELFREF(INDS(I_LAY),IG) + &
169     & P_SELFFRAC(I_LAY) *&
170     & (SELFREF(INDS(I_LAY)+1,IG) - SELFREF(INDS(I_LAY),IG)))&
171     & + Z_N2OMULT(I_LAY) * ABSN2O(IG+IOFF)&
172     & + P_TAUAERL(I_LAY,9) 
173    PFRAC(NGS8+IG,I_LAY) = FRACREFA(IG,JFRAC(I_LAY)) + Z_FFRAC(I_LAY) *&
174     & (FRACREFA(IG,JFRAC(I_LAY)+1) - FRACREFA(IG,JFRAC(I_LAY))) 
175  ENDDO
176ENDDO
177
178DO I_LAY = K_LAYTROP+1, KLEV
179  IND0(I_LAY) = ((K_JP(I_LAY)-13)*5+(K_JT(I_LAY)-1))*NSPB(9) + 1
180  IND1(I_LAY) = ((K_JP(I_LAY)-12)*5+(K_JT1(I_LAY)-1))*NSPB(9) + 1
181ENDDO
182
183!-- JJM_000517
184DO IG = 1, NG9
185  DO I_LAY = K_LAYTROP+1, KLEV
186!-- JJM_000517
187    P_TAU (NGS8+IG,I_LAY) = P_COLCH4(I_LAY) *&
188     & (P_FAC00(I_LAY) * ABSB(IND0(I_LAY)  ,IG) +&
189     & P_FAC10(I_LAY) * ABSB(IND0(I_LAY)+1,IG) +&
190     & P_FAC01(I_LAY) * ABSB(IND1(I_LAY)  ,IG) +&
191     & P_FAC11(I_LAY) * ABSB(IND1(I_LAY)+1,IG))&
192     & + P_TAUAERL(I_LAY,9) 
193    PFRAC(NGS8+IG,I_LAY) = FRACREFB(IG)
194  ENDDO
195ENDDO
196
197IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL9',1,ZHOOK_HANDLE)
198END SUBROUTINE RRTM_TAUMOL9
Note: See TracBrowser for help on using the repository browser.