source: LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/ecrad/srtm_taumol22.F90 @ 3880

Last change on this file since 3880 was 3880, checked in by idelkadi, 3 years ago

Online implementation of the radiative transfer code ECRAD in LMDZ.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
  • Adaptation of compilation scripts (CPP_ECRAD keys)
  • Call of ecrad in radlwsw_m.F90 under the logical key iflag_rrtm = 2
File size: 7.8 KB
Line 
1SUBROUTINE SRTM_TAUMOL22 &
2 & ( KIDIA   , KFDIA    , KLEV,&
3 & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
4 & K_JP      , K_JT     , K_JT1     , P_ONEMINUS,&
5 & P_COLH2O  , P_COLMOL , P_COLO2,&
6 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF  , P_FORFAC, P_FORFRAC, K_INDFOR,&
7 & P_SFLUXZEN, P_TAUG   , P_TAUR    , PRMU0   &
8 & ) 
9
10!     Written by Eli J. Mlawer, Atmospheric & Environmental Research.
11
12!     BAND 22:  7700-8050 cm-1 (low - H2O,O2; high - O2)
13
14! Modifications
15!        M.Hamrud      01-Oct-2003 CY28 Cleaning
16
17!     JJMorcrette 2003-02-24 adapted to ECMWF environment
18!        D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
19!     JJMorcrette 20110610 Flexible configuration for number of g-points
20
21USE PARKIND1 , ONLY : JPIM, JPRB
22USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
23USE PARSRTM  , ONLY : JPG
24USE YOESRTM  , ONLY : NG22
25USE YOESRTA22, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, RAYL, LAYREFFR, STRRAT 
26USE YOESRTWN , ONLY : NSPA, NSPB
27
28IMPLICIT NONE
29
30!-- Output
31INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA
32INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
33REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
37INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
38INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
39INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS(KIDIA:KFDIA)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(KIDIA:KFDIA,KLEV)
44INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
45REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
47INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV)
50INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
51
52REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
53REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
54REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
55REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
56!- from INTFAC     
57!- from INTIND
58!- from PRECISE             
59!- from PROFDATA             
60!- from SELF             
61INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
62
63INTEGER(KIND=JPIM) :: I_LAY_NEXT
64
65REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
66 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
67 & Z_TAURAY, Z_O2ADJ , Z_O2CONT 
68REAL(KIND=JPRB) :: ZHOOK_HANDLE
69
70ASSOCIATE(NFLEVG=>KLEV)
71IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',0,ZHOOK_HANDLE)
72
73I_NLAYERS = KLEV
74
75!     The following factor is the ratio of total O2 band intensity (lines
76!     and Mate continuum) to O2 band intensity (line only).  It is needed
77!     to adjust the optical depths since the k's include only lines.
78Z_O2ADJ = 1.6_JPRB
79
80!     Compute the optical depth by interpolating in ln(pressure),
81!     temperature, and appropriate species.  Below LAYTROP, the water
82!     vapor self-continuum is interpolated (in temperature) separately. 
83
84I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
85
86DO I_LAY = 1, I_NLAYERS
87  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
88  DO IPLON = KIDIA, KFDIA
89    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
90      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
91        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
92         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON)) 
93        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
94        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + Z_O2ADJ*STRRAT*P_COLO2(IPLON,I_LAY)
95        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB
96        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
97        Z_SPECMULT = 8.*(Z_SPECPARM)
98        !         ODADJ = SPECPARM + O2ADJ * (1. - SPECPARM)
99        JS = 1 + INT(Z_SPECMULT)
100        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
101        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
102        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
103        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
104        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
105        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
106        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
107        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
108        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
109        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(22) + JS
110        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(22) + JS
111        INDS = K_INDSELF(IPLON,I_LAY)
112        INDF = K_INDFOR(IPLON,I_LAY)
113        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
114
115        !  DO IG = 1, NG(22)
116!CDIR UNROLL=NG22
117        DO IG = 1 , NG22
118          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
119           !    & (Z_FAC000 * ABSA(IND0,IG) + &
120           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
121           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
122           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
123           !    & Z_FAC001 * ABSA(IND1,IG) + &
124           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
125           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
126           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
127           & (&
128           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
129           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
130           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
131           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
132           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
133           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
134           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
135           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
136           & ) + &
137           & P_COLH2O(IPLON,I_LAY) * &
138           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
139           & P_SELFFRAC(IPLON,I_LAY) * &
140           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
141           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
142           & P_FORFRAC(IPLON,I_LAY) * &
143           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
144           & + Z_O2CONT 
145          !     &          + TAURAY
146          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
147          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
148           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS)) 
149          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
150        ENDDO
151      ENDIF
152    ENDIF
153  ENDDO
154ENDDO
155
156DO I_LAY = 1, I_NLAYERS
157  DO IPLON = KIDIA, KFDIA
158    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
159      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
160        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
161        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(22) + 1
162        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(22) + 1
163        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
164
165        !  DO IG = 1, NG(22)
166!CDIR UNROLL=NG22
167        DO IG = 1 , NG22
168          P_TAUG(IPLON,I_LAY,IG) = P_COLO2(IPLON,I_LAY) * Z_O2ADJ * &
169           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
170           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
171           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
172           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG)) + &
173           & Z_O2CONT 
174          !     &           + TAURAY
175          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
176          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
177        ENDDO
178      ENDIF
179    ENDIF
180  ENDDO
181ENDDO
182
183!-----------------------------------------------------------------------
184IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',1,ZHOOK_HANDLE)
185END ASSOCIATE
186END SUBROUTINE SRTM_TAUMOL22
Note: See TracBrowser for help on using the repository browser.