source: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad.v1.5.1/rrtm_init_140gp.F90 @ 5097

Last change on this file since 5097 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: 4.8 KB
Line 
1!***************************************************************************
2SUBROUTINE RRTM_INIT_140GP(DIRECTORY)
3!***************************************************************************
4!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
5
6!     JJMorcrette 20110613 flexible number of g-points
7
8! Parameters
9USE PARKIND1  ,ONLY : JPIM     ,JPRB
10USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
11
12USE PARRRTM  , ONLY : JPBAND   ,JPG
13USE YOERRTM  , ONLY : JPGPT
14USE YOERRTWN , ONLY : NG       
15USE YOERRTFTR, ONLY : NGC      ,NGN      ,NGM     , WT
16! Output
17USE YOERRTBG2, ONLY : CORR1    ,CORR2
18USE YOERRTRWT, ONLY : FREFA    ,FREFB    ,FREFADF  ,FREFBDF   ,RWGT
19!USE YOMLUN   , ONLY : NULOUT
20
21IMPLICIT NONE
22
23CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
24
25REAL(KIND=JPRB) :: ZWTSM(JPG)
26
27INTEGER(KIND=JPIM) :: I, IBND, IG, IGC, IGCSM, IND, IPR, IPRSM, IPT
28
29REAL(KIND=JPRB) :: ZFP, ZRTFP, ZWTSUM
30REAL(KIND=JPRB) :: ZHOOK_HANDLE
31
32!#include "surrtmcf.intfb.h"
33#include "surrtftr.intfb.h"
34
35#include "rrtm_kgb1.intfb.h"
36#include "rrtm_kgb10.intfb.h"
37#include "rrtm_kgb11.intfb.h"
38#include "rrtm_kgb12.intfb.h"
39#include "rrtm_kgb13.intfb.h"
40#include "rrtm_kgb14.intfb.h"
41#include "rrtm_kgb15.intfb.h"
42#include "rrtm_kgb16.intfb.h"
43#include "rrtm_kgb2.intfb.h"
44#include "rrtm_kgb3.intfb.h"
45#include "rrtm_kgb4.intfb.h"
46#include "rrtm_kgb5.intfb.h"
47#include "rrtm_kgb6.intfb.h"
48#include "rrtm_kgb7.intfb.h"
49#include "rrtm_kgb8.intfb.h"
50#include "rrtm_kgb9.intfb.h"
51
52#include "rrtm_cmbgb1.intfb.h"
53#include "rrtm_cmbgb10.intfb.h"
54#include "rrtm_cmbgb11.intfb.h"
55#include "rrtm_cmbgb12.intfb.h"
56#include "rrtm_cmbgb13.intfb.h"
57#include "rrtm_cmbgb14.intfb.h"
58#include "rrtm_cmbgb15.intfb.h"
59#include "rrtm_cmbgb16.intfb.h"
60#include "rrtm_cmbgb2.intfb.h"
61#include "rrtm_cmbgb3.intfb.h"
62#include "rrtm_cmbgb4.intfb.h"
63#include "rrtm_cmbgb5.intfb.h"
64#include "rrtm_cmbgb6.intfb.h"
65#include "rrtm_cmbgb7.intfb.h"
66#include "rrtm_cmbgb8.intfb.h"
67#include "rrtm_cmbgb9.intfb.h"
68
69IF (LHOOK) CALL DR_HOOK('RRTM_INIT_140GP',0,ZHOOK_HANDLE)
70
71!CALL SURRTMCF
72CALL SURRTFTR
73
74! Read the absorption-related coefficients over the 16 x 16 g-points
75
76CALL RRTM_KGB1(DIRECTORY)
77CALL RRTM_KGB2
78CALL RRTM_KGB3
79CALL RRTM_KGB4
80CALL RRTM_KGB5
81CALL RRTM_KGB6
82CALL RRTM_KGB7
83CALL RRTM_KGB8
84CALL RRTM_KGB9
85CALL RRTM_KGB10
86CALL RRTM_KGB11
87CALL RRTM_KGB12
88CALL RRTM_KGB13
89CALL RRTM_KGB14
90CALL RRTM_KGB15
91CALL RRTM_KGB16
92
93!  Calculate lookup tables for functions needed in routine TAUMOL (TAUGB2)
94
95CORR1(0) = 1.0_JPRB
96CORR1(200) = 1.0_JPRB
97CORR2(0) = 1.0_JPRB
98CORR2(200) = 1.0_JPRB
99DO I = 1,199
100  ZFP = 0.005_JPRB*REAL(I)
101  ZRTFP = SQRT(ZFP)
102  CORR1(I) = ZRTFP/ZFP
103  CORR2(I) = (1.0_JPRB-ZRTFP)/(1.0_JPRB-ZFP)
104ENDDO
105
106!  Perform g-point reduction from 16 per band (256 total points) to
107!  a band dependant number (140 total points) for all absorption
108!  coefficient input data and Planck fraction input data.
109!  Compute relative weighting for new g-point combinations.
110
111IGCSM = 0
112!WRITE(NULOUT,9001) JPBAND,JPG,JPGPT
1139001 format(1x,'rrtm_init JPBAND=',I3,' JPG=',I3,' JPGPT=',I3)
114DO IBND = 1,JPBAND
115  IPRSM = 0
116!  WRITE(NULOUT,9002) IBND,NGC(IBND)
1179002 format(1x,'rrtm_init NGC(',I3,')=',I3)
118  IF (NGC(IBND) < 16) THEN
119    DO IGC = 1,NGC(IBND)
120      IGCSM = IGCSM + 1
121      ZWTSUM = 0.0_JPRB
122!      WRITE(NULOUT,9003) IGC,IGCSM,NGN(IGCSM)
1239003  format(1x,'rrtm_init IGC=',I3,' NGN(',I3,')=',I3)
124      DO IPR = 1, NGN(IGCSM)
125        IPRSM = IPRSM + 1
126!        WRITE(NULOUT,9004) IPR,IPRSM,WT(IPRSM)
1279004    format(1x,'rrtm_init IPR=',I3,' WT(',I3,')=',E14.7)
128        ZWTSUM = ZWTSUM + WT(IPRSM)
129      ENDDO
130!      WRITE(NULOUT,9005) IGC,ZWTSUM
1319005  format(1x,'rrtm_init WTSM(',I3,')=',E14.7)
132      ZWTSM(IGC) = ZWTSUM
133    ENDDO
134
135!    WRITE(NULOUT,9006) IBND,NG(IBND)
1369006 format(1x,'rrtm_init NG(',I3,')=',I3)
137    DO IG = 1,NG(IBND)
138      IND = (IBND-1)*16 + IG
139      RWGT(IND) = WT(IG)/ZWTSM(NGM(IND))
140!      WRITE(NULOUT,9007) IND,NGM(IND),IG,WT(IG),ZWTSM(NGM(IND)),IND,RWGT(IND)
1419007 format(1x,'rrtm_init NGM(',I3,')=',I3,' WT(',I3,')=',E13.7,' WTSM=',E13.7,' RWGT(',I3,')=',E13.7)
142    ENDDO
143  ELSE
144    DO IG = 1,NG(IBND)
145      IGCSM = IGCSM + 1
146      IND = (IBND-1)*16 + IG
147      RWGT(IND) = 1.0_JPRB
148    ENDDO
149  ENDIF
150ENDDO
151
152!  Initialize arrays for combined Planck fraction data.
153
154DO IPT = 1,13
155  DO IPR = 1, JPGPT
156    FREFA(IPR,IPT) = 0.0_JPRB
157    FREFADF(IPR,IPT) = 0.0_JPRB
158  ENDDO
159ENDDO
160DO IPT = 1,6
161  DO IPR = 1, JPGPT
162    FREFB(IPR,IPT) = 0.0_JPRB
163    FREFBDF(IPR,IPT) = 0.0_JPRB
164  ENDDO
165ENDDO
166
167!  Reduce g-points for relevant data in each LW spectral band.
168
169CALL RRTM_CMBGB1
170CALL RRTM_CMBGB2
171CALL RRTM_CMBGB3
172CALL RRTM_CMBGB4
173CALL RRTM_CMBGB5
174CALL RRTM_CMBGB6
175CALL RRTM_CMBGB7
176CALL RRTM_CMBGB8
177CALL RRTM_CMBGB9
178CALL RRTM_CMBGB10
179CALL RRTM_CMBGB11
180CALL RRTM_CMBGB12
181CALL RRTM_CMBGB13
182CALL RRTM_CMBGB14
183CALL RRTM_CMBGB15
184CALL RRTM_CMBGB16
185
186IF (LHOOK) CALL DR_HOOK('RRTM_INIT_140GP',1,ZHOOK_HANDLE)
187END SUBROUTINE RRTM_INIT_140GP
Note: See TracBrowser for help on using the repository browser.