source: LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/ecrad/rrtm_gas_optical_depth.F90 @ 4038

Last change on this file since 4038 was 3880, checked in by idelkadi, 4 years ago

Online implementation of the radiative transfer code ECRAD in LMDZ.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
  • Adaptation of compilation scripts (CPP_ECRAD keys)
  • Call of ecrad in radlwsw_m.F90 under the logical key iflag_rrtm = 2
File size: 9.6 KB
Line 
1!option! -pvctl no_on_adb
2!option! -pvctl nocollapse
3SUBROUTINE RRTM_GAS_OPTICAL_DEPTH(KIDIA,KFDIA,KLEV,POD,PAVEL, PCOLDRY,PCOLBRD,PWX,&
4 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
5 & PCOLH2O,PCOLCO2,PCOLO3,PCOLN2O,PCOLCH4,PCOLO2,P_CO2MULT,&
6 & KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
7 & KINDMINOR,PSCALEMINOR,PSCALEMINORN2,PMINORFRAC,&
8 &  PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1, &
9 &  PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1, &
10 &  PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) 
11
12! R. J. Hogan   20160831  Adapted from rrtm_gasabs1a_140gp.F90
13
14USE PARKIND1  ,ONLY : JPIM     ,JPRB
15USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
16
17USE PARRRTM  , ONLY : JPBAND   ,JPXSEC
18USE YOERRTM  , ONLY : JPGPT
19USE YOERRTAB , ONLY : TRANS    ,BPADE
20
21
22IMPLICIT NONE
23
24INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
25INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
26INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
27REAL(KIND=JPRB)   ,INTENT(OUT)   :: POD(JPGPT,KLEV,KIDIA:KFDIA) ! Optical depth: note different orientation
28REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) ! Layer pressures (Pa)
29REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLDRY(KIDIA:KFDIA,KLEV)
30REAL(KIND=JPRB)   ,INTENT(IN)    :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
31REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
32REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC00(KIDIA:KFDIA,KLEV)
33REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC01(KIDIA:KFDIA,KLEV)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC10(KIDIA:KFDIA,KLEV)
35REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC11(KIDIA:KFDIA,KLEV)
36INTEGER(KIND=JPIM),INTENT(IN)    :: KJP(KIDIA:KFDIA,KLEV)
37INTEGER(KIND=JPIM),INTENT(IN)    :: KJT(KIDIA:KFDIA,KLEV)
38INTEGER(KIND=JPIM),INTENT(IN)    :: KJT1(KIDIA:KFDIA,KLEV)
39REAL(KIND=JPRB)   ,INTENT(IN)    :: PONEMINUS
40
41REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLH2O(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCO2(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO3(KIDIA:KFDIA,KLEV)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLN2O(KIDIA:KFDIA,KLEV)
45REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCH4(KIDIA:KFDIA,KLEV)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO2(KIDIA:KFDIA,KLEV)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(KIDIA:KFDIA,KLEV)
48INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYTROP(KIDIA:KFDIA)
49INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYSWTCH(KIDIA:KFDIA)
50INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYLOW(KIDIA:KFDIA)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFAC(KIDIA:KFDIA,KLEV)
52REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFRAC(KIDIA:KFDIA,KLEV)
53INTEGER(KIND=JPIM),INTENT(IN)    :: KINDSELF(KIDIA:KFDIA,KLEV)
54REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
55REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFAC(KIDIA:KFDIA,KLEV)
56REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFRAC(KIDIA:KFDIA,KLEV)
57INTEGER(KIND=JPIM),INTENT(IN)    :: KINDFOR(KIDIA:KFDIA,KLEV)
58REAL(KIND=JPRB)   ,INTENT(IN)    :: PMINORFRAC(KIDIA:KFDIA,KLEV)
59REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
60REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINORN2(KIDIA:KFDIA,KLEV)
61INTEGER(KIND=JPIM),INTENT(IN)    :: KINDMINOR(KIDIA:KFDIA,KLEV)
62REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLBRD(KIDIA:KFDIA,KLEV) 
63REAL(KIND=JPRB)  , INTENT(IN) :: &                  !
64                    &   PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
65                    &   PRAT_H2OO3(KIDIA:KFDIA,KLEV),PRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & !    DIMENSIONS: (NLAYERS)
66                    &   PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
67                    &   PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
68                    &   PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
69                    &   PRAT_O3CO2(KIDIA:KFDIA,KLEV),PRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
70           
71REAL(KIND=JPRB) :: ZTAU   (KIDIA:KFDIA,JPGPT,KLEV)
72REAL(KIND=JPRB) :: ZTF
73
74INTEGER(KIND=JPIM) :: JI, ITR, JLEV
75INTEGER(KIND=JPIM) :: JLON
76
77REAL(KIND=JPRB) :: ZHOOK_HANDLE
78
79#include "rrtm_taumol1.intfb.h"
80#include "rrtm_taumol10.intfb.h"
81#include "rrtm_taumol11.intfb.h"
82#include "rrtm_taumol12.intfb.h"
83#include "rrtm_taumol13.intfb.h"
84#include "rrtm_taumol14.intfb.h"
85#include "rrtm_taumol15.intfb.h"
86#include "rrtm_taumol16.intfb.h"
87#include "rrtm_taumol2.intfb.h"
88#include "rrtm_taumol3.intfb.h"
89#include "rrtm_taumol4.intfb.h"
90#include "rrtm_taumol5.intfb.h"
91#include "rrtm_taumol6.intfb.h"
92#include "rrtm_taumol7.intfb.h"
93#include "rrtm_taumol8.intfb.h"
94#include "rrtm_taumol9.intfb.h"
95
96!CDIR DUPLICATE(TRANS,256)
97
98ASSOCIATE(NFLEVG=>KLEV)
99IF (LHOOK) CALL DR_HOOK('RRTM_GAS_OPTICAL_DEPTH',0,ZHOOK_HANDLE)
100
101CALL RRTM_TAUMOL1  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,&
102 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
103 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, PMINORFRAC, &
104 & KINDMINOR,PSCALEMINORN2,PCOLBRD) 
105CALL RRTM_TAUMOL2  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,PCOLDRY,&
106 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
107 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
108CALL RRTM_TAUMOL3  (KIDIA,KFDIA,KLEV,ZTAU,&
109 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
110 & PCOLH2O,PCOLCO2,PCOLN2O,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
111 & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR) 
112CALL RRTM_TAUMOL4  (KIDIA,KFDIA,KLEV,ZTAU,&
113 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
114 & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
115 & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) 
116CALL RRTM_TAUMOL5  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
117 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
118 & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
119 & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1,PMINORFRAC,KINDMINOR)   
120CALL RRTM_TAUMOL6  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
121 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
122 & PCOLH2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR) 
123CALL RRTM_TAUMOL7  (KIDIA,KFDIA,KLEV,ZTAU,&
124 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
125 & PCOLH2O,PCOLO3,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
126 & PRAT_H2OO3, PRAT_H2OO3_1,PMINORFRAC,KINDMINOR) 
127CALL RRTM_TAUMOL8  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
128 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
129 & PCOLH2O,PCOLO3,PCOLN2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
130 & PMINORFRAC,KINDMINOR) 
131CALL RRTM_TAUMOL9  (KIDIA,KFDIA,KLEV,ZTAU,&
132 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
133 & PCOLH2O,PCOLN2O,PCOLCH4,PCOLDRY,KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
134 & PRAT_H2OCH4,PRAT_H2OCH4_1,PMINORFRAC,KINDMINOR) 
135CALL RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,ZTAU,&
136 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
137 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
138CALL RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,ZTAU,&
139 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
140 & PCOLH2O,PCOLO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR,PSCALEMINOR) 
141CALL RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,ZTAU,&
142 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
143 & PCOLH2O,PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
144 & PRAT_H2OCO2, PRAT_H2OCO2_1) 
145CALL RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,ZTAU,&
146 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
147 & PCOLH2O,PCOLN2O,PCOLCO2,PCOLO3,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
148 & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR) 
149CALL RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,ZTAU,&
150 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
151 & PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
152CALL RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,ZTAU,&
153 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
154 & PCOLH2O,PCOLCO2,PCOLN2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
155 & PRAT_N2OCO2, PRAT_N2OCO2_1,PMINORFRAC,KINDMINOR,PSCALEMINOR,PCOLBRD) 
156CALL RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,ZTAU,&
157 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
158 & PCOLH2O,PCOLCH4,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
159 & PRAT_H2OCH4,PRAT_H2OCH4_1)   
160
161!TO CHECK TOTAL OD FOR EACH BAND
162    ! print*,'ZTAU2= ',sum(ZTAU(:,11:22,:),2)
163    ! print*,'ZTAU3= ',sum(ZTAU(:,23:38,:),2)
164    ! print*,'ZTAU4= ',sum(ZTAU(:,39:52,:),2)
165    ! print*,'ZTAU5= ',sum(ZTAU(:,53:68,:),2)
166    ! print*,'ZTAU6= ',sum(ZTAU(:,69:76,:),2)
167    ! print*,'ZTAU7= ',sum(ZTAU(:,77:88,:),2)
168    ! print*,'ZTAU8= ',sum(ZTAU(:,89:96,:),2)
169    ! print*,'ZTAU9= ',sum(ZTAU(:,97:108,:),2)
170    ! print*,'ZTAU10= ',sum(ZTAU(:,109:114,:),2)
171    ! print*,'ZTAU11= ',sum(ZTAU(:,115:122,:),2)
172    ! print*,'ZTAU12= ',sum(ZTAU(:,123:130,:),2)
173    ! print*,'ZTAU13= ',sum(ZTAU(:,131:134,:),2)
174    ! print*,'ZTAU14= ',sum(ZTAU(:,135:136,:),2)
175    ! print*,'ZTAU15= ',sum(ZTAU(:,137:138,:),2)
176    ! print*,'ZTAU16= ',sum(ZTAU(:,139:140,:),2)
177
178
179!- Loop over g-channels.
180DO JLEV = 1, KLEV
181!cdir unroll=4
182  DO JI = 1, JPGPT
183    DO JLON = KIDIA, KFDIA
184      POD(JI,JLEV,JLON) = ZTAU(JLON,JI,JLEV)
185
186!      ZTF = ZTAU(JLON,JI,JLEV)*1.66_jprb/(BPADE+ZTAU(JLON,JI,JLEV)*1.66_jprb)
187!      ITR=INT(5.E+03_JPRB*ZTF+0.5_JPRB)
188!      write(37,*) pod(ji,jlev,jlon), 1.0_JPRB - TRANS(ITR), ztf
189
190    ENDDO
191  ENDDO
192ENDDO
193!     -----------------------------------------------------------------
194
195IF (LHOOK) CALL DR_HOOK('RRTM_GAS_OPTICAL_DEPTH',1,ZHOOK_HANDLE)
196END ASSOCIATE
197END SUBROUTINE RRTM_GAS_OPTICAL_DEPTH
Note: See TracBrowser for help on using the repository browser.