source: LMDZ6/trunk/libf/phylmd/ecrad/srtm_kgb25.F90 @ 3981

Last change on this file since 3981 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: 3.7 KB
Line 
1SUBROUTINE SRTM_KGB25
2
3!     Originally by J.Delamere, Atmospheric & Environmental Research.
4!     Revision: 2.4
5!     BAND 25: 16000-22650 cm-1 (low - H2O; high - nothing)
6!     Reformatted for F90 by JJMorcrette, ECMWF
7!     G.Mozdzynski March 2011 read constants from files
8!     T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
9!     ------------------------------------------------------------------
10
11USE PARKIND1  , ONLY : JPRB
12USE YOMHOOK   , ONLY : LHOOK, DR_HOOK
13USE YOMLUN    , ONLY : NULRAD
14USE YOMMP0    , ONLY : NPROC, MYPROC
15USE MPL_MODULE, ONLY : MPL_BROADCAST
16USE YOMTAG    , ONLY : MTAGRAD
17USE YOESRTA25 , ONLY : KA, KA_D,SFLUXREF, RAYL, ABSO3A, ABSO3B, LAYREFFR 
18
19!     ------------------------------------------------------------------
20
21IMPLICIT NONE
22
23! KURUCZ
24REAL(KIND=JPRB) :: ZHOOK_HANDLE
25
26#include "abor1.intfb.h"
27
28IF (LHOOK) CALL DR_HOOK('SRTM_KGB25',0,ZHOOK_HANDLE)
29
30IF( MYPROC==1 )THEN
31  READ(NULRAD,ERR=1001) KA_D
32    KA = REAL(KA_D,JPRB)
33ENDIF
34IF( NPROC>1 )THEN
35  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB25:')
36ENDIF
37
38SFLUXREF = (/ &
39 & 42.6858_JPRB , 45.7720_JPRB, 44.9872_JPRB, 45.9662_JPRB    , &
40 & 46.5458_JPRB , 41.6926_JPRB, 32.2893_JPRB, 24.0928_JPRB    , &
41 & 16.7686_JPRB , 1.86048_JPRB, 1.54057_JPRB, 1.23503_JPRB    , &
42 & 0.915085_JPRB,0.590099_JPRB,0.218622_JPRB, 3.21287E-02_JPRB /) 
43
44!     Rayleigh extinction coefficient at v = 2925 cm-1.
45RAYL = (/ &
46 & 9.81132E-07_JPRB,8.25605E-07_JPRB,6.71302E-07_JPRB,5.53556E-07_JPRB,  &
47 & 3.97383E-07_JPRB,3.68206E-07_JPRB,4.42379E-07_JPRB,4.57799E-07_JPRB, &
48 & 4.22683E-07_JPRB,3.87113E-07_JPRB,3.79810E-07_JPRB,3.63192E-07_JPRB, &
49 & 3.51921E-07_JPRB,3.34231E-07_JPRB,3.34294E-07_JPRB,3.32673E-07_JPRB /) 
50     
51ABSO3A = (/ &
52 & 2.32664E-02_JPRB,5.76154E-02_JPRB,0.125389_JPRB,0.250158_JPRB, &
53 & 0.378756_JPRB   ,0.402196_JPRB   ,0.352026_JPRB,0.352036_JPRB, &
54 & 0.386253_JPRB   ,0.414598_JPRB   ,0.420079_JPRB,0.435471_JPRB, &
55 & 0.445487_JPRB   ,0.459549_JPRB   ,0.452920_JPRB,0.456838_JPRB /) 
56
57ABSO3B = (/      &
58 & 1.76917E-02_JPRB,4.64185E-02_JPRB,1.03640E-01_JPRB,0.189469_JPRB, &
59 & 0.303858_JPRB   ,0.400248_JPRB   ,0.447357_JPRB   ,0.470009_JPRB, &
60 & 0.498673_JPRB   ,0.515696_JPRB   ,0.517053_JPRB   ,0.517930_JPRB, &
61 & 0.518345_JPRB   ,0.524952_JPRB   ,0.508244_JPRB   ,0.468981_JPRB /) 
62
63LAYREFFR = 2
64
65!     ------------------------------------------------------------------
66
67!     The array KA contains absorption coefs at the 16 chosen g-values
68!     for a range of pressure levels> ~100mb, temperatures, and binary
69!     species parameters (see taumol.f for definition).  The first
70!     index in the array, JS, runs from 1 to 9, and corresponds to
71!     different values of the binary species parameter.  For instance,
72!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8,
73!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
74!     in the array, JT, which runs from 1 to 5, corresponds to different
75!     temperatures.  More specifically, JT = 3 means that the data are for
76!     the reference temperature TREF for this  pressure level, JT = 2 refers
77!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
78!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
79!     to the JPth reference pressure level (see taumol.f for these levels
80!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
81!     which g-interval the absorption coefficients are for.
82!     -----------------------------------------------------------------
83 
84!     -----------------------------------------------------------------
85IF (LHOOK) CALL DR_HOOK('SRTM_KGB25',1,ZHOOK_HANDLE)
86RETURN
87
881001 CONTINUE
89CALL ABOR1("SRTM_KGB25:ERROR READING FILE RADSRTM")
90
91END SUBROUTINE SRTM_KGB25
Note: See TracBrowser for help on using the repository browser.