source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/srtm_taumol22.F90 @ 4773

Last change on this file since 4773 was 4773, checked in by idelkadi, 6 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: 7.7 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, JPHOOK
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=JPHOOK) :: ZHOOK_HANDLE
69
70IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',0,ZHOOK_HANDLE)
71
72I_NLAYERS = KLEV
73
74!     The following factor is the ratio of total O2 band intensity (lines
75!     and Mate continuum) to O2 band intensity (line only).  It is needed
76!     to adjust the optical depths since the k's include only lines.
77Z_O2ADJ = 1.6_JPRB
78
79!     Compute the optical depth by interpolating in ln(pressure),
80!     temperature, and appropriate species.  Below LAYTROP, the water
81!     vapor self-continuum is interpolated (in temperature) separately. 
82
83I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
84
85DO I_LAY = 1, I_NLAYERS
86  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
87  DO IPLON = KIDIA, KFDIA
88    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
89      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
90        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
91         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON)) 
92        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
93        Z_SPECCOMB = P_COLH2O(IPLON,I_LAY) + Z_O2ADJ*STRRAT*P_COLO2(IPLON,I_LAY)
94        Z_SPECPARM = P_COLH2O(IPLON,I_LAY)/Z_SPECCOMB
95        IF (Z_SPECPARM >= P_ONEMINUS(IPLON)) Z_SPECPARM = P_ONEMINUS(IPLON)
96        Z_SPECMULT = 8.*(Z_SPECPARM)
97        !         ODADJ = SPECPARM + O2ADJ * (1. - SPECPARM)
98        JS = 1 + INT(Z_SPECMULT)
99        Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
100        ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
101        ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
102        ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
103        ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
104        ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
105        ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
106        ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
107        ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
108        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(22) + JS
109        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(22) + JS
110        INDS = K_INDSELF(IPLON,I_LAY)
111        INDF = K_INDFOR(IPLON,I_LAY)
112        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
113
114        !  DO IG = 1, NG(22)
115!CDIR UNROLL=NG22
116        DO IG = 1 , NG22
117          P_TAUG(IPLON,I_LAY,IG) = Z_SPECCOMB * &
118           !    & (Z_FAC000 * ABSA(IND0,IG) + &
119           !    & Z_FAC100 * ABSA(IND0+1,IG) + &
120           !    & Z_FAC010 * ABSA(IND0+9,IG) + &
121           !    & Z_FAC110 * ABSA(IND0+10,IG) + &
122           !    & Z_FAC001 * ABSA(IND1,IG) + &
123           !    & Z_FAC101 * ABSA(IND1+1,IG) + &
124           !    & Z_FAC011 * ABSA(IND1+9,IG) + &
125           !    & Z_FAC111 * ABSA(IND1+10,IG)) + &
126           & (&
127           & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(IPLON,I_LAY) + &
128           &                 ABSA(IND0+9,IG) * P_FAC10(IPLON,I_LAY) + &
129           &                 ABSA(IND1,IG) * P_FAC01(IPLON,I_LAY) + &
130           &                 ABSA(IND1+9,IG) * P_FAC11(IPLON,I_LAY) ) + &
131           & Z_FS        * ( ABSA(IND0+1,IG) * P_FAC00(IPLON,I_LAY) + &
132           &                 ABSA(IND0+10,IG) * P_FAC10(IPLON,I_LAY) + &
133           &                 ABSA(IND1+1,IG) * P_FAC01(IPLON,I_LAY) + &
134           &                 ABSA(IND1+10,IG) * P_FAC11(IPLON,I_LAY) ) &
135           & ) + &
136           & P_COLH2O(IPLON,I_LAY) * &
137           & (P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
138           & P_SELFFRAC(IPLON,I_LAY) * &
139           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
140           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
141           & P_FORFRAC(IPLON,I_LAY) * &
142           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
143           & + Z_O2CONT 
144          !     &          + TAURAY
145          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
146          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG,JS) &
147           & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS)) 
148          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
149        ENDDO
150      ENDIF
151    ENDIF
152  ENDDO
153ENDDO
154
155DO I_LAY = 1, I_NLAYERS
156  DO IPLON = KIDIA, KFDIA
157    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
158      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
159        Z_O2CONT = 4.35e-4*P_COLO2(IPLON,I_LAY)/(350.0*2.0)
160        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(22) + 1
161        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(22) + 1
162        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
163
164        !  DO IG = 1, NG(22)
165!CDIR UNROLL=NG22
166        DO IG = 1 , NG22
167          P_TAUG(IPLON,I_LAY,IG) = P_COLO2(IPLON,I_LAY) * Z_O2ADJ * &
168           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
169           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
170           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
171           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG)) + &
172           & Z_O2CONT 
173          !     &           + TAURAY
174          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
175          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
176        ENDDO
177      ENDIF
178    ENDIF
179  ENDDO
180ENDDO
181
182!-----------------------------------------------------------------------
183IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL22',1,ZHOOK_HANDLE)
184
185END SUBROUTINE SRTM_TAUMOL22
Note: See TracBrowser for help on using the repository browser.