source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_gas_optical_depth.F90 @ 4791

Last change on this file since 4791 was 4773, checked in by idelkadi, 9 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: 9.4 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, JPHOOK
16
17USE PARRRTM  , ONLY : JPBAND   ,JPXSEC
18USE YOERRTM  , ONLY : JPGPT
19
20IMPLICIT NONE
21
22INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
23INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
24INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
25REAL(KIND=JPRB)   ,INTENT(OUT)   :: POD(JPGPT,KLEV,KIDIA:KFDIA) ! Optical depth: note different orientation
26REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) ! Layer pressures (Pa)
27REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLDRY(KIDIA:KFDIA,KLEV)
28REAL(KIND=JPRB)   ,INTENT(IN)    :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
29REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
30REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC00(KIDIA:KFDIA,KLEV)
31REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC01(KIDIA:KFDIA,KLEV)
32REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC10(KIDIA:KFDIA,KLEV)
33REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC11(KIDIA:KFDIA,KLEV)
34INTEGER(KIND=JPIM),INTENT(IN)    :: KJP(KIDIA:KFDIA,KLEV)
35INTEGER(KIND=JPIM),INTENT(IN)    :: KJT(KIDIA:KFDIA,KLEV)
36INTEGER(KIND=JPIM),INTENT(IN)    :: KJT1(KIDIA:KFDIA,KLEV)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: PONEMINUS
38
39REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLH2O(KIDIA:KFDIA,KLEV)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCO2(KIDIA:KFDIA,KLEV)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO3(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLN2O(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCH4(KIDIA:KFDIA,KLEV)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO2(KIDIA:KFDIA,KLEV)
45REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(KIDIA:KFDIA,KLEV)
46INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYTROP(KIDIA:KFDIA)
47INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYSWTCH(KIDIA:KFDIA)
48INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYLOW(KIDIA:KFDIA)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFAC(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFRAC(KIDIA:KFDIA,KLEV)
51INTEGER(KIND=JPIM),INTENT(IN)    :: KINDSELF(KIDIA:KFDIA,KLEV)
52REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
53REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFAC(KIDIA:KFDIA,KLEV)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFRAC(KIDIA:KFDIA,KLEV)
55INTEGER(KIND=JPIM),INTENT(IN)    :: KINDFOR(KIDIA:KFDIA,KLEV)
56REAL(KIND=JPRB)   ,INTENT(IN)    :: PMINORFRAC(KIDIA:KFDIA,KLEV)
57REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
58REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINORN2(KIDIA:KFDIA,KLEV)
59INTEGER(KIND=JPIM),INTENT(IN)    :: KINDMINOR(KIDIA:KFDIA,KLEV)
60REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLBRD(KIDIA:KFDIA,KLEV) 
61REAL(KIND=JPRB)  , INTENT(IN) :: &                  !
62                    &   PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
63                    &   PRAT_H2OO3(KIDIA:KFDIA,KLEV),PRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & !    DIMENSIONS: (NLAYERS)
64                    &   PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
65                    &   PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
66                    &   PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
67                    &   PRAT_O3CO2(KIDIA:KFDIA,KLEV),PRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
68           
69REAL(KIND=JPRB) :: ZTAU   (KIDIA:KFDIA,JPGPT,KLEV)
70
71INTEGER(KIND=JPIM) :: JI, JLEV
72INTEGER(KIND=JPIM) :: JLON
73
74REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
75
76#include "rrtm_taumol1.intfb.h"
77#include "rrtm_taumol10.intfb.h"
78#include "rrtm_taumol11.intfb.h"
79#include "rrtm_taumol12.intfb.h"
80#include "rrtm_taumol13.intfb.h"
81#include "rrtm_taumol14.intfb.h"
82#include "rrtm_taumol15.intfb.h"
83#include "rrtm_taumol16.intfb.h"
84#include "rrtm_taumol2.intfb.h"
85#include "rrtm_taumol3.intfb.h"
86#include "rrtm_taumol4.intfb.h"
87#include "rrtm_taumol5.intfb.h"
88#include "rrtm_taumol6.intfb.h"
89#include "rrtm_taumol7.intfb.h"
90#include "rrtm_taumol8.intfb.h"
91#include "rrtm_taumol9.intfb.h"
92
93IF (LHOOK) CALL DR_HOOK('RRTM_GAS_OPTICAL_DEPTH',0,ZHOOK_HANDLE)
94
95ASSOCIATE(NFLEVG=>KLEV)
96
97CALL RRTM_TAUMOL1  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,&
98 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
99 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, PMINORFRAC, &
100 & KINDMINOR,PSCALEMINORN2,PCOLBRD) 
101CALL RRTM_TAUMOL2  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,PCOLDRY,&
102 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
103 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
104CALL RRTM_TAUMOL3  (KIDIA,KFDIA,KLEV,ZTAU,&
105 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
106 & PCOLH2O,PCOLCO2,PCOLN2O,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
107 & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR) 
108CALL RRTM_TAUMOL4  (KIDIA,KFDIA,KLEV,ZTAU,&
109 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
110 & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
111 & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) 
112CALL RRTM_TAUMOL5  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
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,PMINORFRAC,KINDMINOR)   
116CALL RRTM_TAUMOL6  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
117 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
118 & PCOLH2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR) 
119CALL RRTM_TAUMOL7  (KIDIA,KFDIA,KLEV,ZTAU,&
120 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
121 & PCOLH2O,PCOLO3,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
122 & PRAT_H2OO3, PRAT_H2OO3_1,PMINORFRAC,KINDMINOR) 
123CALL RRTM_TAUMOL8  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
124 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
125 & PCOLH2O,PCOLO3,PCOLN2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
126 & PMINORFRAC,KINDMINOR) 
127CALL RRTM_TAUMOL9  (KIDIA,KFDIA,KLEV,ZTAU,&
128 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
129 & PCOLH2O,PCOLN2O,PCOLCH4,PCOLDRY,KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
130 & PRAT_H2OCH4,PRAT_H2OCH4_1,PMINORFRAC,KINDMINOR) 
131CALL RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,ZTAU,&
132 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
133 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
134CALL RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,ZTAU,&
135 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
136 & PCOLH2O,PCOLO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR,PSCALEMINOR) 
137CALL RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,ZTAU,&
138 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
139 & PCOLH2O,PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
140 & PRAT_H2OCO2, PRAT_H2OCO2_1) 
141CALL RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,ZTAU,&
142 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
143 & PCOLH2O,PCOLN2O,PCOLCO2,PCOLO3,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
144 & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR) 
145CALL RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,ZTAU,&
146 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
147 & PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
148CALL RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,ZTAU,&
149 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
150 & PCOLH2O,PCOLCO2,PCOLN2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
151 & PRAT_N2OCO2, PRAT_N2OCO2_1,PMINORFRAC,KINDMINOR,PSCALEMINOR,PCOLBRD) 
152CALL RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,ZTAU,&
153 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
154 & PCOLH2O,PCOLCH4,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
155 & PRAT_H2OCH4,PRAT_H2OCH4_1)   
156
157!TO CHECK TOTAL OD FOR EACH BAND
158    ! print*,'ZTAU2= ',sum(ZTAU(:,11:22,:),2)
159    ! print*,'ZTAU3= ',sum(ZTAU(:,23:38,:),2)
160    ! print*,'ZTAU4= ',sum(ZTAU(:,39:52,:),2)
161    ! print*,'ZTAU5= ',sum(ZTAU(:,53:68,:),2)
162    ! print*,'ZTAU6= ',sum(ZTAU(:,69:76,:),2)
163    ! print*,'ZTAU7= ',sum(ZTAU(:,77:88,:),2)
164    ! print*,'ZTAU8= ',sum(ZTAU(:,89:96,:),2)
165    ! print*,'ZTAU9= ',sum(ZTAU(:,97:108,:),2)
166    ! print*,'ZTAU10= ',sum(ZTAU(:,109:114,:),2)
167    ! print*,'ZTAU11= ',sum(ZTAU(:,115:122,:),2)
168    ! print*,'ZTAU12= ',sum(ZTAU(:,123:130,:),2)
169    ! print*,'ZTAU13= ',sum(ZTAU(:,131:134,:),2)
170    ! print*,'ZTAU14= ',sum(ZTAU(:,135:136,:),2)
171    ! print*,'ZTAU15= ',sum(ZTAU(:,137:138,:),2)
172    ! print*,'ZTAU16= ',sum(ZTAU(:,139:140,:),2)
173
174
175!- Loop over g-channels.
176DO JLEV = 1, KLEV
177!cdir unroll=4
178  DO JI = 1, JPGPT
179    DO JLON = KIDIA, KFDIA
180      POD(JI,JLEV,JLON) = ZTAU(JLON,JI,JLEV)
181    ENDDO
182  ENDDO
183ENDDO
184
185!     -----------------------------------------------------------------
186
187END ASSOCIATE
188
189IF (LHOOK) CALL DR_HOOK('RRTM_GAS_OPTICAL_DEPTH',1,ZHOOK_HANDLE)
190
191END SUBROUTINE RRTM_GAS_OPTICAL_DEPTH
Note: See TracBrowser for help on using the repository browser.