source: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/rrtm_gasabs1a_140gp.F90 @ 5157

Last change on this file since 5157 was 3908, checked in by idelkadi, 3 years ago

Online implementation of the radiative transfer code ECRAD in the LMDZ model.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
    • interface routine : radiation_scheme.F90
  • Adaptation of compilation scripts :
    • compilation under CPP key CPP_ECRAD
    • compilation with option "-rad ecard" or "-ecard true"
    • The "-rad old/rtm/ecran" build option will need to replace the "-rrtm true" and "-ecrad true" options in the future.
  • Runing LMDZ simulations with ecrad, you need :
    • logical key iflag_rrtm = 2 in physiq.def
    • namelist_ecrad (DefLists?)
    • the directory "data" containing the configuration files is temporarily placed in ../libfphylmd/ecrad/
  • Compilation and execution are tested in the 1D case. The repository under svn would allow to continue the implementation work: tests, verification of the results, ...
File size: 10.7 KB
Line 
1!option! -pvctl no_on_adb
2!option! -pvctl nocollapse
3SUBROUTINE RRTM_GASABS1A_140GP (KIDIA,KFDIA,KLEV,PATR1,POD,PTF1,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!        NEC/FC        05-Oct-2009 Optimisation
13!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
14!        NEC           25-Oct-2007 Optimisations
15!        D. Salmond    11-Dec-2007 Optimizations
16!     JJMorcrette 20110613 flexible number of g-points
17!     ABozzo  201306 update to rrtmg-lw v4.85
18
19USE PARKIND1  ,ONLY : JPIM     ,JPRB
20USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
21
22USE PARRRTM  , ONLY : JPBAND   ,JPXSEC
23USE YOERRTM  , ONLY : JPGPT
24USE YOERRTAB , ONLY : TRANS    ,BPADE
25
26
27IMPLICIT NONE
28
29INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
30INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
31INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
32REAL(KIND=JPRB)   ,INTENT(OUT)   :: PATR1(KIDIA:KFDIA,JPGPT,KLEV)
33REAL(KIND=JPRB)   ,INTENT(OUT)   :: POD(KIDIA:KFDIA,JPGPT,KLEV)
34REAL(KIND=JPRB)   ,INTENT(IN)    :: PAVEL(KIDIA:KFDIA,KLEV) ! Layer pressures (Pa)
35REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTF1(KIDIA:KFDIA,JPGPT,KLEV)
36REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLDRY(KIDIA:KFDIA,KLEV)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
38REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
39REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC00(KIDIA:KFDIA,KLEV)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC01(KIDIA:KFDIA,KLEV)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC10(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: PFAC11(KIDIA:KFDIA,KLEV)
43INTEGER(KIND=JPIM),INTENT(IN)    :: KJP(KIDIA:KFDIA,KLEV)
44INTEGER(KIND=JPIM),INTENT(IN)    :: KJT(KIDIA:KFDIA,KLEV)
45INTEGER(KIND=JPIM),INTENT(IN)    :: KJT1(KIDIA:KFDIA,KLEV)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: PONEMINUS
47
48REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLH2O(KIDIA:KFDIA,KLEV)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCO2(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO3(KIDIA:KFDIA,KLEV)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLN2O(KIDIA:KFDIA,KLEV)
52REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLCH4(KIDIA:KFDIA,KLEV)
53REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLO2(KIDIA:KFDIA,KLEV)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(KIDIA:KFDIA,KLEV)
55INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYTROP(KIDIA:KFDIA)
56INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYSWTCH(KIDIA:KFDIA)
57INTEGER(KIND=JPIM),INTENT(IN)    :: KLAYLOW(KIDIA:KFDIA)
58REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFAC(KIDIA:KFDIA,KLEV)
59REAL(KIND=JPRB)   ,INTENT(IN)    :: PSELFFRAC(KIDIA:KFDIA,KLEV)
60INTEGER(KIND=JPIM),INTENT(IN)    :: KINDSELF(KIDIA:KFDIA,KLEV)
61REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
62REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFAC(KIDIA:KFDIA,KLEV)
63REAL(KIND=JPRB)   ,INTENT(IN)    :: PFORFRAC(KIDIA:KFDIA,KLEV)
64INTEGER(KIND=JPIM),INTENT(IN)    :: KINDFOR(KIDIA:KFDIA,KLEV)
65REAL(KIND=JPRB)   ,INTENT(IN)    :: PMINORFRAC(KIDIA:KFDIA,KLEV)
66REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINOR(KIDIA:KFDIA,KLEV)
67REAL(KIND=JPRB)   ,INTENT(IN)    :: PSCALEMINORN2(KIDIA:KFDIA,KLEV)
68INTEGER(KIND=JPIM),INTENT(IN)    :: KINDMINOR(KIDIA:KFDIA,KLEV)
69REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOLBRD(KIDIA:KFDIA,KLEV) 
70REAL(KIND=JPRB)  , INTENT(IN) :: &                  !
71                    &   PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
72                    &   PRAT_H2OO3(KIDIA:KFDIA,KLEV),PRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & !    DIMENSIONS: (NLAYERS)
73                    &   PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
74                    &   PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
75                    &   PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
76                    &   PRAT_O3CO2(KIDIA:KFDIA,KLEV),PRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
77!- from AER
78!- from INTFAC     
79!- from INTIND
80!- from PRECISE             
81!- from PROFDATA             
82!- from SELF             
83!- from SP             
84REAL(KIND=JPRB) :: ZTAU   (KIDIA:KFDIA,JPGPT,KLEV)
85
86INTEGER(KIND=JPIM) :: JI, ITR, JLEV
87INTEGER(KIND=JPIM) :: JLON
88
89REAL(KIND=JPRB) :: ZODEPTH, ZSECANG, ZTF
90REAL(KIND=JPRB) :: ZHOOK_HANDLE
91
92#include "rrtm_taumol1.intfb.h"
93#include "rrtm_taumol10.intfb.h"
94#include "rrtm_taumol11.intfb.h"
95#include "rrtm_taumol12.intfb.h"
96#include "rrtm_taumol13.intfb.h"
97#include "rrtm_taumol14.intfb.h"
98#include "rrtm_taumol15.intfb.h"
99#include "rrtm_taumol16.intfb.h"
100#include "rrtm_taumol2.intfb.h"
101#include "rrtm_taumol3.intfb.h"
102#include "rrtm_taumol4.intfb.h"
103#include "rrtm_taumol5.intfb.h"
104#include "rrtm_taumol6.intfb.h"
105#include "rrtm_taumol7.intfb.h"
106#include "rrtm_taumol8.intfb.h"
107#include "rrtm_taumol9.intfb.h"
108
109!CDIR DUPLICATE(TRANS,256)
110
111!- SECANG is equal to the secant of the diffusivity angle.
112ASSOCIATE(NFLEVG=>KLEV)
113IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',0,ZHOOK_HANDLE)
114ZSECANG = 1.66_JPRB
115
116CALL RRTM_TAUMOL1  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,&
117 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
118 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, PMINORFRAC, &
119 & KINDMINOR,PSCALEMINORN2,PCOLBRD) 
120CALL RRTM_TAUMOL2  (KIDIA,KFDIA,KLEV,ZTAU,PAVEL,PCOLDRY,&
121 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
122 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
123CALL RRTM_TAUMOL3  (KIDIA,KFDIA,KLEV,ZTAU,&
124 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
125 & PCOLH2O,PCOLCO2,PCOLN2O,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
126 & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR) 
127CALL RRTM_TAUMOL4  (KIDIA,KFDIA,KLEV,ZTAU,&
128 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
129 & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
130 & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) 
131CALL RRTM_TAUMOL5  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
132 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
133 & PCOLH2O,PCOLCO2,PCOLO3,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
134 & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1,PMINORFRAC,KINDMINOR)   
135CALL RRTM_TAUMOL6  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
136 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
137 & PCOLH2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR) 
138CALL RRTM_TAUMOL7  (KIDIA,KFDIA,KLEV,ZTAU,&
139 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
140 & PCOLH2O,PCOLO3,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
141 & PRAT_H2OO3, PRAT_H2OO3_1,PMINORFRAC,KINDMINOR) 
142CALL RRTM_TAUMOL8  (KIDIA,KFDIA,KLEV,ZTAU,PWX,&
143 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
144 & PCOLH2O,PCOLO3,PCOLN2O,PCOLCO2,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
145 & PMINORFRAC,KINDMINOR) 
146CALL RRTM_TAUMOL9  (KIDIA,KFDIA,KLEV,ZTAU,&
147 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
148 & PCOLH2O,PCOLN2O,PCOLCH4,PCOLDRY,KLAYTROP,KLAYSWTCH,KLAYLOW,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
149 & PRAT_H2OCH4,PRAT_H2OCH4_1,PMINORFRAC,KINDMINOR) 
150CALL RRTM_TAUMOL10 (KIDIA,KFDIA,KLEV,ZTAU,&
151 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
152 & PCOLH2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
153CALL RRTM_TAUMOL11 (KIDIA,KFDIA,KLEV,ZTAU,&
154 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
155 & PCOLH2O,PCOLO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC,PMINORFRAC,KINDMINOR,PSCALEMINOR) 
156CALL RRTM_TAUMOL12 (KIDIA,KFDIA,KLEV,ZTAU,&
157 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
158 & PCOLH2O,PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
159 & PRAT_H2OCO2, PRAT_H2OCO2_1) 
160CALL RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,ZTAU,&
161 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
162 & PCOLH2O,PCOLN2O,PCOLCO2,PCOLO3,PCOLDRY,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
163 & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR) 
164CALL RRTM_TAUMOL14 (KIDIA,KFDIA,KLEV,ZTAU,&
165 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,&
166 & PCOLCO2,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC) 
167CALL RRTM_TAUMOL15 (KIDIA,KFDIA,KLEV,ZTAU,&
168 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
169 & PCOLH2O,PCOLCO2,PCOLN2O,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
170 & PRAT_N2OCO2, PRAT_N2OCO2_1,PMINORFRAC,KINDMINOR,PSCALEMINOR,PCOLBRD) 
171CALL RRTM_TAUMOL16 (KIDIA,KFDIA,KLEV,ZTAU,&
172 & PTAUAERL,PFAC00,PFAC01,PFAC10,PFAC11,PFORFAC,PFORFRAC,KINDFOR,KJP,KJT,KJT1,PONEMINUS,&
173 & PCOLH2O,PCOLCH4,KLAYTROP,PSELFFAC,PSELFFRAC,KINDSELF,PFRAC, &
174 & PRAT_H2OCH4,PRAT_H2OCH4_1)   
175
176!TO CHECK TOTAL OD FOR EACH BAND
177    ! print*,'ZTAU2= ',sum(ZTAU(:,11:22,:),2)
178    ! print*,'ZTAU3= ',sum(ZTAU(:,23:38,:),2)
179    ! print*,'ZTAU4= ',sum(ZTAU(:,39:52,:),2)
180    ! print*,'ZTAU5= ',sum(ZTAU(:,53:68,:),2)
181    ! print*,'ZTAU6= ',sum(ZTAU(:,69:76,:),2)
182    ! print*,'ZTAU7= ',sum(ZTAU(:,77:88,:),2)
183    ! print*,'ZTAU8= ',sum(ZTAU(:,89:96,:),2)
184    ! print*,'ZTAU9= ',sum(ZTAU(:,97:108,:),2)
185    ! print*,'ZTAU10= ',sum(ZTAU(:,109:114,:),2)
186    ! print*,'ZTAU11= ',sum(ZTAU(:,115:122,:),2)
187    ! print*,'ZTAU12= ',sum(ZTAU(:,123:130,:),2)
188    ! print*,'ZTAU13= ',sum(ZTAU(:,131:134,:),2)
189    ! print*,'ZTAU14= ',sum(ZTAU(:,135:136,:),2)
190    ! print*,'ZTAU15= ',sum(ZTAU(:,137:138,:),2)
191    ! print*,'ZTAU16= ',sum(ZTAU(:,139:140,:),2)
192
193
194DO JLEV = 1, KLEV
195!cdir unroll=4
196  DO JI = 1, JPGPT
197    DO JLON = KIDIA, KFDIA
198      IF (ZTAU(JLON,JI,JLEV) < 0._JPRB) THEN
1999101    FORMAT(1X,'GASABS JLEV,JI,JLON=',I3,I5,I9,' SECANG=',F9.6,' ZTAU=',E12.6)
200      ENDIF
201    ENDDO
202  ENDDO
203ENDDO
204
205
206!- Loop over g-channels.
207DO JLEV = 1, KLEV
208!cdir unroll=4
209  DO JI = 1, JPGPT
210    DO JLON = KIDIA, KFDIA
211      ZODEPTH = ZSECANG * ZTAU(JLON,JI,JLEV)
212      POD(JLON,JI,JLEV) = ZODEPTH
213      ZODEPTH=0.5D0*(ABS(ZODEPTH)+ZODEPTH)
214
215!-- revised code to get the pre-computed transmission
216!          IF (ODEPTH.LE.0.) PRINT*, 'ODEPTH = ',ODEPTH
217!!  IF (ODEPTH <= _ZERO_)THEN
218!!    ATR1(JI,LAY) = _ONE_ - TRANS(0)
219!!    TF1(JI,LAY) = _ZERO_
220!!  ELSE
221
222      ZTF = ZODEPTH/(BPADE+ZODEPTH)
223
224      ITR=INT(5.E+03_JPRB*ZTF+0.5_JPRB)
225      PATR1(JLON,JI,JLEV) = 1.0_JPRB - TRANS(ITR)
226      PTF1(JLON,JI,JLEV) = ZTF
227!!  ENDIF
228    ENDDO
229  ENDDO
230ENDDO
231!     -----------------------------------------------------------------
232
233IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',1,ZHOOK_HANDLE)
234END ASSOCIATE
235END SUBROUTINE RRTM_GASABS1A_140GP
Note: See TracBrowser for help on using the repository browser.