source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol14.F90 @ 5423

Last change on this file since 5423 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: 4.7 KB
Line 
1!******************************************************************************
2SUBROUTINE RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,P_TAU,&
3 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,&
4 & P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC) 
5
6!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)
7
8!     AUTHOR.
9!     -------
10!      JJMorcrette, ECMWF
11
12!     MODIFICATIONS.
13!     --------------
14!        M.Hamrud      01-Oct-2003 CY28 Cleaning
15!        NEC           25-Oct-2007 Optimisations
16!        JJMorcrette 20110613 flexible number of g-points
17!        ABozzo 201306 updated to rrtmg v4.85
18! ---------------------------------------------------------------------------
19
20USE PARKIND1  ,ONLY : JPIM     ,JPRB
21USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
22
23USE PARRRTM  , ONLY : JPBAND
24USE YOERRTM  , ONLY : JPGPT  ,NGS13  ,NG14
25USE YOERRTWN , ONLY : NSPA   ,NSPB
26USE YOERRTA14, ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,FORREF
27
28IMPLICIT NONE
29
30INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
31INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
32INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
33REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
39INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
40INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
41INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(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(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
48
49INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV)
51REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
52! ---------------------------------------------------------------------------
53
54INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JLAY
55INTEGER(KIND=JPIM) :: JLON
56REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF
57REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
58
59! Compute the optical depth by interpolating in ln(pressure) and
60! temperature.  Below laytrop, the water vapor self-continuum
61! and foreign continuum is interpolated (in temperature) separately. 
62
63ASSOCIATE(NFLEVG=>KLEV)
64IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL14',0,ZHOOK_HANDLE)
65
66DO JLAY = 1, KLEV
67  DO JLON = KIDIA, KFDIA
68    IF (JLAY <= K_LAYTROP(JLON)) THEN
69      IND0 = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(14) + 1
70      IND1 = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(14) + 1
71      INDS = K_INDSELF(JLON,JLAY)
72      INDF = K_INDFOR(JLON,JLAY)
73
74!-- DS_990714 
75!-- jjm20110728 re-establishing the loop instead of specified IG to allow a flexible number of NG14
76      DO IG = 1, NG14
77!      IG=1
78        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS,IG) + P_SELFFRAC(JLON,JLAY) * &
79          &       (SELFREF(INDS+1,IG) - SELFREF(INDS,IG)))
80        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF,IG) + P_FORFRAC(JLON,JLAY) * &
81          &       (FORREF(INDF+1,IG) - FORREF(INDF,IG)))
82
83        P_TAU(JLON,NGS13+IG,JLAY) = P_COLCO2(JLON,JLAY) *&
84         & (P_FAC00(JLON,JLAY) * ABSA(IND0  ,IG) +&
85         & P_FAC10(JLON,JLAY) * ABSA(IND0+1,IG) +&
86         & P_FAC01(JLON,JLAY) * ABSA(IND1  ,IG) +&
87         & P_FAC11(JLON,JLAY) * ABSA(IND1+1,IG)) &
88         & + ZTAUSELF + ZTAUFOR &
89         & + P_TAUAERL(JLON,JLAY,14) 
90        PFRAC(JLON,NGS13+IG,JLAY) = FRACREFA(IG)
91      ENDDO
92!-- jjm20110728
93!-- DS_990714 
94    ENDIF
95
96    IF (JLAY > K_LAYTROP(JLON)) THEN
97      IND0 = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(14) + 1
98      IND1 = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(14) + 1
99!-- DS_990714 
100!-- jjm20110728 re-establishing the loop instead of specified IG to allow a flexible number of NG14
101      DO IG = 1, NG14
102!      IG=1
103        P_TAU(JLON,NGS13+IG,JLAY) = P_COLCO2(JLON,JLAY) *&
104         & (P_FAC00(JLON,JLAY) * ABSB(IND0  ,IG) +&
105         & P_FAC10(JLON,JLAY) * ABSB(IND0+1,IG) +&
106         & P_FAC01(JLON,JLAY) * ABSB(IND1  ,IG) +&
107         & P_FAC11(JLON,JLAY) * ABSB(IND1+1,IG)) &
108         & + P_TAUAERL(JLON,JLAY,14) 
109        PFRAC(JLON,NGS13+IG,JLAY) = FRACREFB(IG)
110      ENDDO
111!-- jjm20110728
112!-- DS_990714 
113    ENDIF
114  ENDDO
115ENDDO
116
117
118IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL14',1,ZHOOK_HANDLE)
119
120END ASSOCIATE
121END SUBROUTINE RRTM_TAUMOL14
Note: See TracBrowser for help on using the repository browser.