source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol8.F90 @ 5097

Last change on this file since 5097 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: 8.1 KB
RevLine 
[4773]1!*******************************************************************************
2SUBROUTINE RRTM_TAUMOL8 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
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_COLO3,P_COLN2O,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
5 & PMINORFRAC,KINDMINOR) 
6
7!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
8
9!     AUTHOR.
10!     -------
11!      JJMorcrette, ECMWF
12
13!     MODIFICATIONS.
14!     --------------
15!      M.Hamrud      01-Oct-2003 CY28 Cleaning
16!      NEC           25-Oct-2007 Optimisations
17!      JJMorcrette 20110613 flexible number of g-points
18!      ABozzo 201306 updated to rrtmg v4.85
19!     band 8:  1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o)
20!                             (high key - o3; high minor - co2, n2o)
21! ---------------------------------------------------------------------------
22
23USE PARKIND1  ,ONLY : JPIM     ,JPRB
24USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
25
26USE PARRRTM  , ONLY : JPBAND ,JPXSEC
27USE YOERRTM  , ONLY : JPGPT  ,NG8   ,NGS7
28USE YOERRTWN , ONLY : NSPA   ,NSPB
29USE YOERRTA8 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,SELFREF,KA_MCO2 ,KB_MCO2  ,&
30 & KA_MN2O , KB_MN2O,KA_MO3,CFC12  ,CFC22ADJ,FORREF 
31USE YOERRTRF, ONLY : CHI_MLS
32
33IMPLICIT NONE
34
35INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
36INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
37INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
38REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
39REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
45INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
46INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
47INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(KIDIA:KFDIA,KLEV)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV)
52REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV)
53INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
55REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
56INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
57REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
58
59INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
60REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
61REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV)
62REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
63INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
64
65! ---------------------------------------------------------------------------
66
67INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
68
69INTEGER(KIND=JPIM) :: IG, JLAY
70INTEGER(KIND=JPIM) :: JLON
71
72REAL(KIND=JPRB) :: ZCHI_CO2, ZRATCO2, ZADJFAC, ZADJCOLCO2(KIDIA:KFDIA,KLEV)
73REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF, ZABSO3, ZABSCO2, ZABSN2O
74REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
75
76! Minor gas mapping level:
77!     lower - co2, p = 1053.63 mb, t = 294.2 k
78!     lower - o3,  p = 317.348 mb, t = 240.77 k
79!     lower - n2o, p = 706.2720 mb, t= 278.94 k
80!     lower - cfc12,cfc11
81!     upper - co2, p = 35.1632 mb, t = 223.28 k
82!     upper - n2o, p = 8.716e-2 mb, t = 226.03 k
83
84! Compute the optical depth by interpolating in ln(pressure) and
85! temperature, and appropriate species.  Below laytrop, the water vapor
86! self-continuum and foreign continuum is interpolated (in temperature)
87! separately.
88
89ASSOCIATE(NFLEVG=>KLEV)
90IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL8',0,ZHOOK_HANDLE)
91
92DO JLAY = 1, KLEV
93  DO JLON = KIDIA, KFDIA
94    IF (JLAY <= K_LAYTROP(JLON)) THEN
95! In atmospheres where the amount of CO2 is too great to be considered
96! a minor species, adjust the column amount of CO2 by an empirical factor
97! to obtain the proper contribution.
98      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
99      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
100      IF (ZRATCO2 > 3.0_JPRB) THEN
101         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.65_JPRB
102         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
103      ELSE
104         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
105      ENDIF
106
107   
108      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(8) + 1
109      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(8) + 1
110      INDS(JLAY) = K_INDSELF(JLON,JLAY)
111      INDF(JLAY) = K_INDFOR(JLON,JLAY)
112      INDM(JLAY) = KINDMINOR(JLON,JLAY)
113     
114!-- DS_000515
115!CDIR UNROLL=NG8
116      DO IG = 1, NG8
117!-- DS_000515
118         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
119           &      (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
120         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
121           &      (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
122         ZABSCO2 =  (KA_MCO2(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
123           &      (KA_MCO2(INDM(JLAY)+1,IG) - KA_MCO2(INDM(JLAY),IG)))
124         ZABSO3 =  (KA_MO3(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
125           &      (KA_MO3(INDM(JLAY)+1,IG) - KA_MO3(INDM(JLAY),IG)))
126         ZABSN2O =  (KA_MN2O(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
127           &      (KA_MN2O(INDM(JLAY)+1,IG) - KA_MN2O(INDM(JLAY),IG)))
128
129        P_TAU(JLON,NGS7+IG,JLAY) = P_COLH2O(JLON,JLAY) *&
130         & (P_FAC00(JLON,JLAY) * ABSA(IND0(JLAY)  ,IG) +&
131         & P_FAC10(JLON,JLAY) * ABSA(IND0(JLAY)+1,IG) +&
132         & P_FAC01(JLON,JLAY) * ABSA(IND1(JLAY)  ,IG) +&
133         & P_FAC11(JLON,JLAY) * ABSA(IND1(JLAY)+1,IG)) &
134         & + ZTAUSELF + ZTAUFOR &
135         & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
136         & + P_COLO3(JLON,JLAY)*ZABSO3 &
137         & + P_COLN2O(JLON,JLAY)*ZABSN2O &
138         & + P_WX(JLON,3,JLAY) * CFC12(IG)&
139         & + P_WX(JLON,4,JLAY) * CFC22ADJ(IG)&
140         & + P_TAUAERL(JLON,JLAY,8) 
141        PFRAC(JLON,NGS7+IG,JLAY) = FRACREFA(IG)
142      ENDDO
143    ENDIF
144
145    IF (JLAY > K_LAYTROP(JLON)) THEN
146
147! In atmospheres where the amount of CO2 is too great to be considered
148! a minor species, adjust the column amount of CO2 by an empirical factor
149! to obtain the proper contribution.
150      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
151      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
152      IF (ZRATCO2 > 3.0_JPRB) THEN
153         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.65_JPRB
154         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
155      ELSE
156         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
157      ENDIF
158
159
160      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(8) + 1
161      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(8) + 1
162      INDM(JLAY) = KINDMINOR(JLON,JLAY)
163!-- JJM_000517
164!CDIR UNROLL=NG8
165      DO IG = 1, NG8
166!-- JJM_000517
167        ZABSCO2 =  (KB_MCO2(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
168         &        (KB_MCO2(INDM(JLAY)+1,IG) - KB_MCO2(INDM(JLAY),IG)))
169        ZABSN2O =  (KB_MN2O(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
170         &        (KB_MN2O(INDM(JLAY)+1,IG) - KB_MN2O(INDM(JLAY),IG)))
171        P_TAU(JLON,NGS7+IG,JLAY) = P_COLO3(JLON,JLAY) *&
172         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
173         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
174         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
175         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG)) &
176         & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
177         & + P_COLN2O(JLON,JLAY)*ZABSN2O &
178         & + P_WX(JLON,3,JLAY) * CFC12(IG)&
179         & + P_WX(JLON,4,JLAY) * CFC22ADJ(IG)&
180         & + P_TAUAERL(JLON,JLAY,8) 
181        PFRAC(JLON,NGS7+IG,JLAY) = FRACREFB(IG)
182      ENDDO
183    ENDIF
184  ENDDO
185ENDDO
186
187IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL8',1,ZHOOK_HANDLE)
188
189END ASSOCIATE
190END SUBROUTINE RRTM_TAUMOL8
Note: See TracBrowser for help on using the repository browser.