source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/srtm_taumol20.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: 5.8 KB
Line 
1SUBROUTINE SRTM_TAUMOL20 &
2 & ( KIDIA   , KFDIA    , KLEV,&
3 & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
4 & K_JP      , K_JT     , K_JT1,&
5 & P_COLH2O  , P_COLCH4 , 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 20:  5150-6150 cm-1 (low - H2O; high - H2O)
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 : NG20
25USE YOESRTA20, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, ABSCH4C, RAYL, LAYREFFR 
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_COLH2O(KIDIA:KFDIA,KLEV)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLMOL(KIDIA:KFDIA,KLEV)
43INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
45REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
46INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV)
49INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
50
51REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
52REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
53REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
55!- from INTFAC     
56!- from INTIND
57!- from PRECISE             
58!- from PROFDATA             
59!- from SELF             
60INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
61
62INTEGER(KIND=JPIM) :: I_LAY_NEXT
63
64REAL(KIND=JPRB) :: Z_TAURAY 
65REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
66
67IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL20',0,ZHOOK_HANDLE)
68
69I_NLAYERS = KLEV
70
71!     Compute the optical depth by interpolating in ln(pressure),
72!     temperature, and appropriate species.  Below LAYTROP, the water
73!     vapor self-continuum is interpolated (in temperature) separately. 
74
75I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
76
77DO I_LAY = 1, I_NLAYERS
78  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
79  DO IPLON = KIDIA, KFDIA
80    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
81      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
82        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
83         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON)) 
84        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(20) + 1
85        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(20) + 1
86        INDS = K_INDSELF(IPLON,I_LAY)
87        INDF = K_INDFOR(IPLON,I_LAY)
88        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
89
90        !  DO IG = 1, NG(20)
91!CDIR UNROLL=NG20
92        DO IG = 1 , NG20
93          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
94           & ((P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
95           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
96           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
97           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG)) + &
98           & P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) +  &
99           & P_SELFFRAC(IPLON,I_LAY) * &
100           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
101           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
102           & P_FORFRAC(IPLON,I_LAY) * &
103           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
104           & + P_COLCH4(IPLON,I_LAY) * ABSCH4C(IG) 
105          !     &           + TAURAY &
106          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
107          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
108          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG)
109        ENDDO
110      ENDIF
111    ENDIF
112  ENDDO
113ENDDO
114
115DO I_LAY = 1, I_NLAYERS
116  DO IPLON = KIDIA, KFDIA
117    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
118      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
119        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(20) + 1
120        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(20) + 1
121        INDF = K_INDFOR(IPLON,I_LAY)
122        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
123
124        !  DO IG = 1, NG(20)
125!CDIR UNROLL=NG20
126        DO IG = 1 , NG20
127          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
128           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
129           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
130           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
131           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG) + &
132           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
133           & P_FORFRAC(IPLON,I_LAY) * &
134           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) + &
135           & P_COLCH4(IPLON,I_LAY) * ABSCH4C(IG) 
136          !     &           TAURAY + &
137          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
138          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
139        ENDDO
140      ENDIF
141    ENDIF
142  ENDDO
143ENDDO
144
145!-----------------------------------------------------------------------
146IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL20',1,ZHOOK_HANDLE)
147
148END SUBROUTINE SRTM_TAUMOL20
Note: See TracBrowser for help on using the repository browser.