source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/srtm_taumol21.F90 @ 5450

Last change on this file since 5450 was 4773, checked in by idelkadi, 13 months ago
  • Update of Ecrad in LMDZ The same organization of the Ecrad offline version is retained in order to facilitate the updating of Ecrad in LMDZ and the comparison between online and offline results. version 1.6.1 of Ecrad (​https://github.com/lguez/ecrad.git)
  • Implementation of the double call of Ecrad in LMDZ


File size: 8.9 KB
Line 
1SUBROUTINE SRTM_TAUMOL21 &
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_COLCO2 , P_COLMOL,&
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 21:  6150-7700 cm-1 (low - H2O,CO2; high - H2O,CO2)
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, JPHOOK
23USE PARSRTM  , ONLY : JPG
24USE YOESRTM  , ONLY : NG21
25USE YOESRTA21, 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_COLCO2(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(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 
68REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
69
70IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL21',0,ZHOOK_HANDLE)
71
72I_NLAYERS = KLEV
73
74!     Compute the optical depth by interpolating in ln(pressure),
75!     temperature, and appropriate species.  Below LAYTROP, the water
76!     vapor self-continuum is interpolated (in temperature) separately. 
77
78I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
79
80DO I_LAY = 1, I_NLAYERS
81  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
82  DO IPLON = KIDIA, KFDIA
83    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
84      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
85        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
86         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON)) 
87        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY)
88        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB
89        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
90        Z_SPECMULT = 8.*(Z_SPECPARM)
91        JS = 1 + INT(Z_SPECMULT)
92        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
93        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
94        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
95        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
96        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
97        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
98        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
99        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
100        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
101        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(21) + JS
102        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(21) + JS
103        INDS = K_INDSELF(IPLON,I_LAY)
104        INDF = K_INDFOR(IPLON,I_LAY)
105        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
106
107        !  DO IG = 1, NG(21)
108!CDIR UNROLL=NG21
109        DO IG = 1 , NG21
110          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
111           !    & (Z_FAC000 * ABSA(IND0,IG) + &
112           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
113           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
114           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
115           !    & Z_FAC001 * ABSA(IND1,IG) + &
116           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
117           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
118           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
119           & (&
120           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
121           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
122           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
123           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
124           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
125           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
126           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
127           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
128           & ) + &
129           & P_COLH2O(IPLON,I_LAY) * &
130           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
131           & P_SELFFRAC(IPLON,I_LAY) * &
132           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
133           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
134           & P_FORFRAC(IPLON,I_LAY) * &
135           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) 
136          !     &           + TAURAY
137          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
138          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
139           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS)) 
140          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
141        ENDDO
142      ENDIF
143    ENDIF
144  ENDDO
145ENDDO
146
147DO I_LAY = 1, I_NLAYERS
148  DO IPLON = KIDIA, KFDIA
149    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
150      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
151        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + STRRAT*P_COLCO2(IPLON,I_LAY)
152        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB
153        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
154        Z_SPECMULT = 4.*(Z_SPECPARM)
155        JS = 1 + INT(Z_SPECMULT)
156        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
157        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
158        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
159        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
160        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
161        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
162        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
163        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
164        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
165        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(21) + JS
166        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(21) + JS
167        INDF = K_INDFOR(IPLON,I_LAY)
168        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
169
170        !  DO IG = 1, NG(21)
171!CDIR UNROLL=NG21
172        DO IG = 1 , NG21
173          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
174           !    & (Z_FAC000 * ABSB(IND0,IG) + &
175           !    & Z_FAC100 * ABSB(IND0+1,IG) + &
176           !    & Z_FAC010 * ABSB(IND0+5,IG) + &
177           !    & Z_FAC110 * ABSB(IND0+6,IG) + &
178           !    & Z_FAC001 * ABSB(IND1,IG) + &
179           !    & Z_FAC101 * ABSB(IND1+1,IG) + &
180           !    & Z_FAC011 * ABSB(IND1+5,IG) + &
181           !    & Z_FAC111 * ABSB(IND1+6,IG)) + &
182           & (&
183           & (1. - Z_FS) * ( ABSB(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
184           &                 ABSB(IND0+5,IG) * P_FAC10(IPLON,I_LAY) + &
185           &                 ABSB(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
186           &                 ABSB(IND1+5,IG) * P_FAC11(IPLON,I_LAY) ) + &
187           & Z_FS        * ( ABSB(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
188           &                 ABSB(IND0+6,IG) * P_FAC10(IPLON,I_LAY) + &
189           &                 ABSB(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
190           &                 ABSB(IND1+6,IG) * P_FAC11(IPLON,I_LAY) ) &
191           & ) + &
192           & P_COLH2O(IPLON,I_LAY) * &
193           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
194           & P_FORFRAC(IPLON,I_LAY) * &
195           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))) 
196          !     &           + TAURAY
197          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
198          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
199        ENDDO
200      ENDIF
201    ENDIF
202  ENDDO
203ENDDO
204
205!-----------------------------------------------------------------------
206IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL21',1,ZHOOK_HANDLE)
207
208END SUBROUTINE SRTM_TAUMOL21
Note: See TracBrowser for help on using the repository browser.