source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol11.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: 6.1 KB
Line 
1!******************************************************************************
2SUBROUTINE RRTM_TAUMOL11 (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_COLH2O,P_COLO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC,P_MINORFRAC,KINDMINOR,PSCALEMINOR) 
5
6!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)
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 updated to rrtmg v4.85
18!     band 11:  1480-1800 cm-1 (low - h2o; low minor - o2)
19!                              (high key - h2o; high minor - o2)
20! ---------------------------------------------------------------------------
21
22USE PARKIND1  ,ONLY : JPIM     ,JPRB
23USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
24
25USE PARRRTM  , ONLY : JPBAND
26USE YOERRTM  , ONLY : JPGPT  ,NG11  ,NGS10
27USE YOERRTWN , ONLY :      NSPA   ,NSPB
28USE YOERRTA11, ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,FORREF, &
29                     & KA_MO2, KB_MO2
30
31IMPLICIT NONE
32
33INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
34INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
35INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
36REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
39REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
42INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
43INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
44INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
45REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO2(KIDIA:KFDIA,KLEV)
47INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
50INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
51REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
52
53INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
54REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV)
55REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
56REAL(KIND=JPRB)   ,INTENT(IN)   :: P_MINORFRAC(KIDIA:KFDIA,KLEV)
57INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
58REAL(KIND=JPRB)   ,INTENT(IN)   :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
59! ---------------------------------------------------------------------------
60
61INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV)
62INTEGER(KIND=JPIM) :: INDS(KLEV),INDF(KLEV),INDM(KLEV)
63
64INTEGER(KIND=JPIM) :: IG, JLAY
65INTEGER(KIND=JPIM) :: JLON
66REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZSCALEO2, ZTAUO2
67REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
68
69! Minor gas mapping level :
70!     lower - o2, p = 706.2720 mbar, t = 278.94 k
71!     upper - o2, p = 4.758820 mbarm t = 250.85 k
72
73!     Compute the optical depth by interpolating in ln(pressure) and
74!     temperature.  Below LAYTROP, the water vapor self-continuum and foreign continuum
75!     is interpolated (in temperature) separately.
76 
77ASSOCIATE(NFLEVG=>KLEV)
78IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL11',0,ZHOOK_HANDLE)
79
80DO JLAY = 1, KLEV
81  DO JLON = KIDIA, KFDIA
82    IF (JLAY <= K_LAYTROP(JLON)) THEN
83      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(11) + 1
84      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(11) + 1
85      INDS(JLAY) = K_INDSELF(JLON,JLAY)
86      INDF(JLAY) = K_INDFOR(JLON,JLAY)
87      INDM(JLAY) = KINDMINOR(JLON,JLAY)
88      ZSCALEO2 = P_COLO2(JLON,JLAY)*PSCALEMINOR(JLON,JLAY)
89!-- DS_000515 
90!CDIR UNROLL=NG11
91      DO IG = 1, NG11
92!-- DS_000515 
93        ZTAUSELF = P_SELFFAC(JLON,JLAY) * (SELFREF(INDS(JLAY),IG) + &
94     &           P_SELFFRAC(JLON,JLAY) * &
95     &           (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
96
97        ZTAUFOR =  P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
98     &           P_FORFRAC(JLON,JLAY) * (FORREF(INDF(JLAY)+1,IG) - &
99     &           FORREF(INDF(JLAY),IG))) 
100        ZTAUO2 = ZSCALEO2*(KA_MO2(INDM(JLAY),IG) +   &
101     &           P_MINORFRAC(JLON,JLAY) * &
102     &           (KA_MO2(INDM(JLAY)+1,IG) - KA_MO2(INDM(JLAY),IG)))
103
104        P_TAU(JLON,NGS10+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
105         & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY)  ,IG) +&
106         & P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) +&
107         & P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY)  ,IG) +&
108         & P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) +&
109         & ZTAUSELF + ZTAUFOR + ZTAUO2 &
110         & + P_TAUAERL(JLON,JLAY,11) 
111        PFRAC(JLON,NGS10+IG,JLAY) = FRACREFA(IG)
112      ENDDO
113    ENDIF
114
115    IF (JLAY > K_LAYTROP(JLON)) THEN
116      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(11) + 1
117      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(11) + 1
118      INDF(JLAY) = K_INDFOR(JLON,JLAY)
119      INDM(JLAY) = KINDMINOR(JLON,JLAY)
120      ZSCALEO2 = P_COLO2(JLON,JLAY) * PSCALEMINOR(JLON,JLAY)
121!-- JJM_000517
122!CDIR UNROLL=NG11
123      DO IG = 1, NG11
124!-- JJM_000517
125        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + &
126     &           P_FORFRAC(JLON,JLAY) * &
127     &           (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
128
129        ZTAUO2 = ZSCALEO2*(KB_MO2(INDM(JLAY),IG) +  &
130     &           P_MINORFRAC(JLON,JLAY) * &
131     &           (KB_MO2(INDM(JLAY)+1,IG) - KB_MO2(INDM(JLAY),IG)))
132
133
134        P_TAU(JLON,NGS10+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
135         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
136         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
137         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
138         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) +&
139         & ZTAUFOR + ZTAUO2 + P_TAUAERL(JLON,JLAY,11) 
140        PFRAC(JLON,NGS10+IG,JLAY) = FRACREFB(IG)
141      ENDDO
142    ENDIF
143  ENDDO
144ENDDO
145
146IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL11',1,ZHOOK_HANDLE)
147
148END ASSOCIATE
149END SUBROUTINE RRTM_TAUMOL11
Note: See TracBrowser for help on using the repository browser.