source: LMDZ6/branches/cirrus/libf/phylmd/ecrad/ifsrrtm/srtm_taumol29.F90

Last change on this file was 4773, checked in by idelkadi, 12 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.5 KB
Line 
1SUBROUTINE SRTM_TAUMOL29 &
2 & ( KIDIA   , KFDIA    , KLEV,&
3 & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
4 & K_JP      , K_JT     , K_JT1,&
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 29:  820-2600 cm-1 (low - H2O; high - CO2)
13
14! Modifications
15!        M.Hamrud      01-Oct-2003 CY28 Cleaning
16
17!     JJMorcrette 2002-10-03 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 : NG29
25USE YOESRTA29, ONLY : ABSA, ABSB, FORREFC, SELFREFC, SFLUXREFC, &
26 & ABSH2OC, ABSCO2C, RAYL, LAYREFFR 
27USE YOESRTWN , ONLY : NSPA, NSPB
28
29IMPLICIT NONE
30
31!-- Output
32INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA, KFDIA
33INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
38INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
39INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
40INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
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             
61!-- from FOREIGN
62INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
63
64REAL(KIND=JPRB) ::  &
65 & Z_TAURAY 
66REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
67
68IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL29',0,ZHOOK_HANDLE)
69
70I_NLAYERS = KLEV
71
72! Compute the optical depth by interpolating in ln(pressure),
73! temperature, and appropriate species.  Below LAYTROP, the water
74! vapor self-continuum is interpolated (in temperature) separately. 
75
76DO I_LAY = 1, I_NLAYERS
77  DO IPLON = KIDIA, KFDIA
78    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
79      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
80        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(29) + 1
81        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(29) + 1
82        INDS = K_INDSELF(IPLON,I_LAY)
83        INDF = K_INDFOR(IPLON,I_LAY)
84        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
85
86        !  DO IG = 1, NG(29)
87!CDIR UNROLL=NG29
88        DO IG = 1, NG29
89          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
90           & ((P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
91           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
92           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
93           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG)) + &
94           & P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
95           & P_SELFFRAC(IPLON,I_LAY) * &
96           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
97           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) +  &
98           & P_FORFRAC(IPLON,I_LAY) * &
99           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG)))) &
100           & + P_COLCO2(IPLON,I_LAY) * ABSCO2C(IG)   
101          !     &           + TAURAY &
102          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
103          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
104        ENDDO
105      ENDIF
106    ENDIF
107  ENDDO
108ENDDO
109
110I_LAYSOLFR(:) = I_NLAYERS
111
112DO I_LAY = 1, I_NLAYERS
113  DO IPLON = KIDIA, KFDIA
114    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
115      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
116        IF (K_JP(IPLON,I_LAY-1) < LAYREFFR .AND. K_JP(IPLON,I_LAY) >= LAYREFFR) &
117         & I_LAYSOLFR(IPLON) = I_LAY 
118        IND0 = ((K_JP(IPLON,I_LAY)-13)*5+(K_JT(IPLON,I_LAY)-1))*NSPB(29) + 1
119        IND1 = ((K_JP(IPLON,I_LAY)-12)*5+(K_JT1(IPLON,I_LAY)-1))*NSPB(29) + 1
120        Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYL
121
122        !  DO IG = 1, NG(29)
123!CDIR UNROLL=NG29
124        DO IG = 1 , NG29
125          P_TAUG(IPLON,I_LAY,IG) = P_COLCO2(IPLON,I_LAY) * &
126           & (P_FAC00(IPLON,I_LAY) * ABSB(IND0,IG) + &
127           & P_FAC10(IPLON,I_LAY) * ABSB(IND0+1,IG) + &
128           & P_FAC01(IPLON,I_LAY) * ABSB(IND1,IG) + &
129           & P_FAC11(IPLON,I_LAY) * ABSB(IND1+1,IG))   &
130           & + P_COLH2O(IPLON,I_LAY) * ABSH2OC(IG)   
131          !     &           + TAURAY
132          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
133          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG)
134          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
135        ENDDO
136      ENDIF
137    ENDIF
138  ENDDO
139ENDDO
140
141!-----------------------------------------------------------------------
142IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL29',1,ZHOOK_HANDLE)
143
144END SUBROUTINE SRTM_TAUMOL29
Note: See TracBrowser for help on using the repository browser.