source: LMDZ6/trunk/libf/phylmd/ecrad/srtm_init.F90 @ 4629

Last change on this file since 4629 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.2 KB
RevLine 
[3908]1SUBROUTINE SRTM_INIT(DIRECTORY)
2
3!-- read in the basic coefficients to configure RRTM_SW
4!- creates module YOESRTWN with BG, NSPA, NSPB, WAVENUM1, WAVENUM2,
5!  DELWAVE, PREF, PREFLOG, TREF
6
7USE PARKIND1  ,ONLY : JPIM , JPRB
8USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK
9
10USE PARSRTM  , ONLY : JPG, JPSW
11USE YOESRTM  , ONLY : NGN
12USE YOESRTWN , ONLY : NG, NGM, WT, NGC, RWGT, WTSM
13!USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM
14!USE YOMLUN   , ONLY : NULOUT
15
16IMPLICIT NONE
17
18CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
19
20! Local variables
21INTEGER(KIND=JPIM) :: IGC, IGCSM, IBND, IG, IND, IPR, IPRSM
22REAL(KIND=JPRB)    :: ZWTSUM
23
24REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26!#include "susrtmcf.intfb.h"
27#include "susrtm.intfb.h"
28#include "srtm_kgb16.intfb.h"
29#include "srtm_kgb17.intfb.h"
30#include "srtm_kgb18.intfb.h"
31#include "srtm_kgb19.intfb.h"
32#include "srtm_kgb20.intfb.h"
33#include "srtm_kgb21.intfb.h"
34#include "srtm_kgb22.intfb.h"
35#include "srtm_kgb23.intfb.h"
36#include "srtm_kgb24.intfb.h"
37#include "srtm_kgb25.intfb.h"
38#include "srtm_kgb26.intfb.h"
39#include "srtm_kgb27.intfb.h"
40#include "srtm_kgb28.intfb.h"
41#include "srtm_kgb29.intfb.h"
42!#include "susrtop.intfb.h"
43
44#include "srtm_cmbgb16.intfb.h"
45#include "srtm_cmbgb17.intfb.h"
46#include "srtm_cmbgb18.intfb.h"
47#include "srtm_cmbgb19.intfb.h"
48#include "srtm_cmbgb20.intfb.h"
49#include "srtm_cmbgb21.intfb.h"
50#include "srtm_cmbgb22.intfb.h"
51#include "srtm_cmbgb23.intfb.h"
52#include "srtm_cmbgb24.intfb.h"
53#include "srtm_cmbgb25.intfb.h"
54#include "srtm_cmbgb26.intfb.h"
55#include "srtm_cmbgb27.intfb.h"
56#include "srtm_cmbgb28.intfb.h"
57#include "srtm_cmbgb29.intfb.h"
58
59IF (LHOOK) CALL DR_HOOK('SRTM_INIT',0,ZHOOK_HANDLE)
60
61!CALL SUSRTMCF
62CALL SUSRTM
63
64!-- read in the molecular absorption coefficients
65
66CALL SRTM_KGB16(DIRECTORY)
67CALL SRTM_KGB17
68CALL SRTM_KGB18
69CALL SRTM_KGB19
70CALL SRTM_KGB20
71CALL SRTM_KGB21
72CALL SRTM_KGB22
73CALL SRTM_KGB23
74CALL SRTM_KGB24
75CALL SRTM_KGB25
76CALL SRTM_KGB26
77CALL SRTM_KGB27
78CALL SRTM_KGB28
79CALL SRTM_KGB29
80
81!-- read in the cloud optical properties
82!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1,
83!  EXTICE3, SSAICE3, ASYICE3, FDLICE3 
84
85!-- RRTM_SW cloud optical properties are not used
86!   SRTM_CLDPROP is not called
87!   no need to call SUSRTOP
88
89!CALL SUSRTOP ( -1 )
90
91
92!Mike Iacono 20050804
93!-- Perform g-point reduction from 16 per band (224 total points) to
94!-- a band dependent number (112 total points) for all absorption
95!-- coefficient input data and Planck fraction input data.
96!-- Compute relative weighting for new g-point combinations.
97
98IGCSM = 0
99!WRITE(NULOUT,9001) JPSW,JPG
1009001 format(1x,'srtm_init JPSW=',I3,' JPG=',I3)
101DO IBND = 1,JPSW
102  IPRSM = 0
103!  WRITE(NULOUT,9002) IBND,NGC(IBND)
1049002 format(1x,'srtm_init NGC(',I3,')=',I3)
105  IF (NGC(IBND) < JPG) THEN
106    DO IGC = 1,NGC(IBND)
107      IGCSM = IGCSM + 1
108      ZWTSUM = 0.
109!      WRITE(NULOUT,9003) IGC,IGCSM,NGN(IGCSM)
1109003  format(1x,'srtm_init IGC=',I3,' NGN(',I3,')=',I3)
111      DO IPR = 1, NGN(IGCSM)
112        IPRSM = IPRSM + 1
113!        WRITE(NULOUT,9004) IPR,IPRSM,WT(IPRSM)
1149004    format(1x,'srtm_init IPR=',I3,' WT(',I3,')=',E14.7)
115        ZWTSUM = ZWTSUM + WT(IPRSM)
116      ENDDO
117!      WRITE(NULOUT,9005) IGC,ZWTSUM
1189005  format(1x,'srtm_init WTSM(',I3,')=',E14.7)
119      WTSM(IGC) = ZWTSUM
120    ENDDO
121
122!    WRITE(NULOUT,9006) IBND+15,NG(IBND+15)
1239006 format(1x,'srtm_init NG(',I3,')=',I3)
124    DO IG = 1,NG(IBND+15)
125      IND = (IBND-1)*JPG + IG
126!!      WRITE(NULOUT,9007) IND,NGM(IND), IG,WT(IG), WTSM(NGM(IND)), IND,RWGT(IND)
1279007 format(1x,'srtm_init NGM(',I3,')=',I3,' WT(',I3,')=',E13.7,' WTSM=',E13.7,' RWGT(',I3,')=',E13.7)
128      RWGT(IND) = WT(IG)/WTSM(NGM(IND))
129!      WRITE(NULOUT,9007) IND,NGM(IND),IG,WT(IG),WTSM(NGM(IND)),IND,RWGT(IND)
130    ENDDO
131  ELSE
132    DO IG = 1,NG(IBND+15)
133      IGCSM = IGCSM + 1
134      IND = (IBND-1)*JPG + IG
135      RWGT(IND) = 1.0
136    ENDDO
137  ENDIF
138ENDDO
139
140CALL SRTM_CMBGB16
141CALL SRTM_CMBGB17
142CALL SRTM_CMBGB18
143CALL SRTM_CMBGB19
144CALL SRTM_CMBGB20
145CALL SRTM_CMBGB21
146CALL SRTM_CMBGB22
147CALL SRTM_CMBGB23
148CALL SRTM_CMBGB24
149CALL SRTM_CMBGB25
150CALL SRTM_CMBGB26
151CALL SRTM_CMBGB27
152CALL SRTM_CMBGB28
153CALL SRTM_CMBGB29
154
155!-----------------------------------------------------------------------
156IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE)
157END SUBROUTINE SRTM_INIT
158
Note: See TracBrowser for help on using the repository browser.