source: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/ifsrrtm/srtm_taumol23.F90

Last change on this file was 4773, checked in by idelkadi, 11 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.0 KB
Line 
1SUBROUTINE SRTM_TAUMOL23 &
2 & ( KIDIA   , KFDIA    , KLEV,&
3 & P_FAC00   , P_FAC01  , P_FAC10   , P_FAC11,&
4 & K_JP      , K_JT     , K_JT1,&
5 & P_COLH2O  , 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 23:  8050-12850 cm-1 (low - H2O; high - nothing)
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 : NG23
25USE YOESRTA23, ONLY : ABSA, FORREFC, SELFREFC, SFLUXREFC, RAYLC, LAYREFFR, GIVFAC   
26USE YOESRTWN , ONLY : NSPA
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_COLMOL(KIDIA:KFDIA,KLEV)
42INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
45INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(KIDIA:KFDIA,KLEV)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFRAC(KIDIA:KFDIA,KLEV)
48INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDFOR(KIDIA:KFDIA,KLEV)
49
50REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SFLUXZEN(KIDIA:KFDIA,JPG)
51REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUG(KIDIA:KFDIA,KLEV,JPG)
52REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAUR(KIDIA:KFDIA,KLEV,JPG)
53REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KIDIA:KFDIA)
54!- from INTFAC     
55!- from INTIND
56!- from PRECISE             
57!- from PROFDATA             
58!- from SELF             
59INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR(KIDIA:KFDIA), I_NLAYERS, IPLON
60
61INTEGER(KIND=JPIM) :: I_LAY_NEXT
62
63REAL(KIND=JPRB) :: Z_TAURAY 
64REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
65
66IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL23',0,ZHOOK_HANDLE)
67
68I_NLAYERS = KLEV
69
70!     Compute the optical depth by interpolating in ln(pressure),
71!     temperature, and appropriate species.  Below LAYTROP, the water
72!     vapor self-continuum is interpolated (in temperature) separately. 
73
74I_LAYSOLFR(KIDIA:KFDIA) = K_LAYTROP(KIDIA:KFDIA)
75
76DO I_LAY = 1, I_NLAYERS
77  I_LAY_NEXT = MIN(I_NLAYERS, I_LAY+1)
78  DO IPLON = KIDIA, KFDIA
79    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
80      IF (I_LAY <= K_LAYTROP(IPLON)) THEN
81        IF (K_JP(IPLON,I_LAY) < LAYREFFR .AND. K_JP(IPLON,I_LAY_NEXT) >= LAYREFFR) &
82         & I_LAYSOLFR(IPLON) = MIN(I_LAY+1,K_LAYTROP(IPLON)) 
83        IND0 = ((K_JP(IPLON,I_LAY)-1)*5+(K_JT(IPLON,I_LAY)-1))*NSPA(23) + 1
84        IND1 = (K_JP(IPLON,I_LAY)*5+(K_JT1(IPLON,I_LAY)-1))*NSPA(23) + 1
85        INDS = K_INDSELF(IPLON,I_LAY)
86        INDF = K_INDFOR(IPLON,I_LAY)
87
88        !  DO IG = 1, NG(23)
89!CDIR UNROLL=NG23
90        DO IG = 1 , NG23
91          Z_TAURAY = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
92          P_TAUG(IPLON,I_LAY,IG) = P_COLH2O(IPLON,I_LAY) * &
93           & (GIVFAC * (P_FAC00(IPLON,I_LAY) * ABSA(IND0,IG) + &
94           & P_FAC10(IPLON,I_LAY) * ABSA(IND0+1,IG) + &
95           & P_FAC01(IPLON,I_LAY) * ABSA(IND1,IG) + &
96           & P_FAC11(IPLON,I_LAY) * ABSA(IND1+1,IG)) + &
97           & P_SELFFAC(IPLON,I_LAY) * (SELFREFC(INDS,IG) + &
98           & P_SELFFRAC(IPLON,I_LAY) * &
99           & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
100           & P_FORFAC(IPLON,I_LAY) * (FORREFC(INDF,IG) + &
101           & P_FORFRAC(IPLON,I_LAY) * &
102           & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))   
103          !     &          + TAURAY
104          !    SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
105          IF (I_LAY == I_LAYSOLFR(IPLON)) P_SFLUXZEN(IPLON,IG) = SFLUXREFC(IG)
106          P_TAUR(IPLON,I_LAY,IG) = Z_TAURAY
107        ENDDO
108      ENDIF
109    ENDIF
110  ENDDO
111ENDDO
112
113DO I_LAY = 1, I_NLAYERS
114  DO IPLON = KIDIA, KFDIA
115    IF (PRMU0(IPLON) > 0.0_JPRB) THEN
116      IF (I_LAY >= K_LAYTROP(IPLON)+1) THEN
117        !  DO IG = 1, NG(23)
118!CDIR UNROLL=NG23
119        DO IG = 1 , NG23
120          !    TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
121          !    SSA(LAY,IG) = 1.0
122          P_TAUG(IPLON,I_LAY,IG) = 0.0_JPRB
123          P_TAUR(IPLON,I_LAY,IG) = P_COLMOL(IPLON,I_LAY) * RAYLC(IG)
124        ENDDO
125      ENDIF
126    ENDIF
127  ENDDO
128ENDDO
129
130!-----------------------------------------------------------------------
131IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL23',1,ZHOOK_HANDLE)
132
133END SUBROUTINE SRTM_TAUMOL23
Note: See TracBrowser for help on using the repository browser.