source: LMDZ6/branches/contrails/libf/phylmd/ecrad/ifsrrtm/srtm_kgb23.F90 @ 5440

Last change on this file since 5440 was 4773, checked in by idelkadi, 12 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: 8.4 KB
Line 
1SUBROUTINE SRTM_KGB23
2
3!     Originally by J.Delamere, Atmospheric & Environmental Research.
4!     Revision: 2.4
5!     BAND 16:  8050-12850 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!      F. Vana  05-Mar-2015  Support for single precision
10!     ------------------------------------------------------------------
11
12USE PARKIND1  , ONLY : JPRB
13USE YOMHOOK   , ONLY : LHOOK, DR_HOOK, JPHOOK
14USE YOMLUN    , ONLY : NULRAD
15USE YOMMP0    , ONLY : NPROC, MYPROC
16USE MPL_MODULE, ONLY : MPL_BROADCAST
17USE YOMTAG    , ONLY : MTAGRAD
18USE YOESRTA23 , ONLY : KA, SELFREF, FORREF, SFLUXREF, RAYL, GIVFAC, LAYREFFR  ,&
19   &   KA_D
20
21!     ------------------------------------------------------------------
22
23IMPLICIT NONE
24
25! KURUCZ
26REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
27
28#include "abor1.intfb.h"
29
30IF (LHOOK) CALL DR_HOOK('SRTM_KGB23',0,ZHOOK_HANDLE)
31
32IF( MYPROC==1 )THEN
33  READ(NULRAD,ERR=1001) KA_D
34  KA = REAL(KA_D,JPRB)
35ENDIF
36IF( NPROC>1 )THEN
37  CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB23:')
38ENDIF
39
40SFLUXREF = (/ &
41 & 53.2101_JPRB , 51.4143_JPRB, 49.3348_JPRB, 45.4612_JPRB    , &
42 & 40.8294_JPRB , 35.1801_JPRB, 28.6947_JPRB, 21.5751_JPRB    , &
43 & 14.6388_JPRB , 1.59111_JPRB, 1.31860_JPRB, 1.04018_JPRB    , &
44 & 0.762140_JPRB,0.484214_JPRB,0.182275_JPRB, 2.54948E-02_JPRB /) 
45
46!     Rayleigh extinction coefficient at all v
47RAYL = (/ &
48 & 5.94837E-08_JPRB,5.70593E-08_JPRB,6.27845E-08_JPRB,5.56602E-08_JPRB, &
49 & 5.25571E-08_JPRB,4.73388E-08_JPRB,4.17466E-08_JPRB,3.98097E-08_JPRB, &
50 & 4.00786E-08_JPRB,3.67478E-08_JPRB,3.45186E-08_JPRB,3.46156E-08_JPRB, &
51 & 3.32155E-08_JPRB,3.23642E-08_JPRB,2.72590E-08_JPRB,2.96813E-08_JPRB /) 
52
53!     Average Giver et al. correction factor for this band.
54GIVFAC = 1.029_JPRB
55
56LAYREFFR = 6
57
58!     ------------------------------------------------------------------
59
60!     The array KA contains absorption coefs at the 16 chosen g-values
61!     for a range of pressure levels> ~100mb, temperatures, and binary
62!     species parameters (see taumol.f for definition).  The first
63!     index in the array, JS, runs from 1 to 9, and corresponds to
64!     different values of the binary species parameter.  For instance,
65!     JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8,
66!     JS = 3 corresponds to the parameter value 2/8, etc.  The second index
67!     in the array, JT, which runs from 1 to 5, corresponds to different
68!     temperatures.  More specifically, JT = 3 means that the data are for
69!     the reference temperature TREF for this  pressure level, JT = 2 refers
70!     to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
71!     is for TREF+30.  The third index, JP, runs from 1 to 13 and refers
72!     to the JPth reference pressure level (see taumol.f for these levels
73!     in mb).  The fourth index, IG, goes from 1 to 16, and indicates
74!     which g-interval the absorption coefficients are for.
75!     -----------------------------------------------------------------
76
77FORREF(:, 1) = (/ 0.315770E-07_JPRB, 0.671978E-07_JPRB, 0.440649E-06_JPRB /)
78FORREF(:, 2) = (/ 0.313674E-06_JPRB, 0.285252E-06_JPRB, 0.421024E-05_JPRB /)
79FORREF(:, 3) = (/ 0.135818E-05_JPRB, 0.145071E-05_JPRB, 0.611285E-05_JPRB /)
80FORREF(:, 4) = (/ 0.534065E-05_JPRB, 0.586268E-05_JPRB, 0.933970E-05_JPRB /)
81FORREF(:, 5) = (/ 0.964007E-05_JPRB, 0.107110E-04_JPRB, 0.104486E-04_JPRB /)
82FORREF(:, 6) = (/ 0.302775E-04_JPRB, 0.357530E-04_JPRB, 0.340724E-04_JPRB /)
83FORREF(:, 7) = (/ 0.102437E-03_JPRB, 0.108475E-03_JPRB, 0.105245E-03_JPRB /)
84FORREF(:, 8) = (/ 0.146054E-03_JPRB, 0.141490E-03_JPRB, 0.133071E-03_JPRB /)
85FORREF(:, 9) = (/ 0.163978E-03_JPRB, 0.150208E-03_JPRB, 0.142864E-03_JPRB /)
86FORREF(:,10) = (/ 0.220412E-03_JPRB, 0.182943E-03_JPRB, 0.150941E-03_JPRB /)
87FORREF(:,11) = (/ 0.228877E-03_JPRB, 0.197679E-03_JPRB, 0.163220E-03_JPRB /)
88FORREF(:,12) = (/ 0.234177E-03_JPRB, 0.217734E-03_JPRB, 0.185038E-03_JPRB /)
89FORREF(:,13) = (/ 0.257187E-03_JPRB, 0.241570E-03_JPRB, 0.221178E-03_JPRB /)
90FORREF(:,14) = (/ 0.272455E-03_JPRB, 0.270637E-03_JPRB, 0.256269E-03_JPRB /)
91FORREF(:,15) = (/ 0.339445E-03_JPRB, 0.300268E-03_JPRB, 0.286574E-03_JPRB /)
92FORREF(:,16) = (/ 0.338841E-03_JPRB, 0.355428E-03_JPRB, 0.353794E-03_JPRB /)
93
94!     -----------------------------------------------------------------
95!     The array SELFREF contains the coefficient of the water vapor
96!     self-continuum (including the energy term).  The first index
97!     refers to temperature in 7.2 degree increments.  For instance,
98!     JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
99!     etc.  The second index runs over the g-channel (1 to 16).
100
101SELFREF(:, 1) = (/ &
102 & 0.100945E-04_JPRB, 0.801113E-05_JPRB, 0.635771E-05_JPRB, 0.504554E-05_JPRB, 0.400419E-05_JPRB, &
103 & 0.317777E-05_JPRB, 0.252191E-05_JPRB, 0.200141E-05_JPRB, 0.158834E-05_JPRB, 0.126052E-05_JPRB /) 
104SELFREF(:, 2) = (/ &
105 & 0.107573E-04_JPRB, 0.999809E-05_JPRB, 0.929245E-05_JPRB, 0.863661E-05_JPRB, 0.802706E-05_JPRB, &
106 & 0.746053E-05_JPRB, 0.693399E-05_JPRB, 0.644460E-05_JPRB, 0.598976E-05_JPRB, 0.556702E-05_JPRB /) 
107SELFREF(:, 3) = (/ &
108 & 0.350389E-04_JPRB, 0.319234E-04_JPRB, 0.290850E-04_JPRB, 0.264989E-04_JPRB, 0.241428E-04_JPRB, &
109 & 0.219962E-04_JPRB, 0.200404E-04_JPRB, 0.182586E-04_JPRB, 0.166351E-04_JPRB, 0.151560E-04_JPRB /) 
110SELFREF(:, 4) = (/ &
111 & 0.122993E-03_JPRB, 0.110885E-03_JPRB, 0.999691E-04_JPRB, 0.901277E-04_JPRB, 0.812551E-04_JPRB, &
112 & 0.732559E-04_JPRB, 0.660443E-04_JPRB, 0.595426E-04_JPRB, 0.536809E-04_JPRB, 0.483963E-04_JPRB /) 
113SELFREF(:, 5) = (/ &
114 & 0.206434E-03_JPRB, 0.187435E-03_JPRB, 0.170185E-03_JPRB, 0.154522E-03_JPRB, 0.140301E-03_JPRB, &
115 & 0.127388E-03_JPRB, 0.115664E-03_JPRB, 0.105019E-03_JPRB, 0.953540E-04_JPRB, 0.865783E-04_JPRB /) 
116SELFREF(:, 6) = (/ &
117 & 0.590645E-03_JPRB, 0.533109E-03_JPRB, 0.481177E-03_JPRB, 0.434305E-03_JPRB, 0.391998E-03_JPRB, &
118 & 0.353812E-03_JPRB, 0.319346E-03_JPRB, 0.288238E-03_JPRB, 0.260160E-03_JPRB, 0.234817E-03_JPRB /) 
119SELFREF(:, 7) = (/ &
120 & 0.163029E-02_JPRB, 0.148773E-02_JPRB, 0.135763E-02_JPRB, 0.123891E-02_JPRB, 0.113057E-02_JPRB, &
121 & 0.103170E-02_JPRB, 0.941483E-03_JPRB, 0.859153E-03_JPRB, 0.784023E-03_JPRB, 0.715462E-03_JPRB /) 
122SELFREF(:, 8) = (/ &
123 & 0.204528E-02_JPRB, 0.189258E-02_JPRB, 0.175128E-02_JPRB, 0.162053E-02_JPRB, 0.149954E-02_JPRB, &
124 & 0.138758E-02_JPRB, 0.128398E-02_JPRB, 0.118812E-02_JPRB, 0.109941E-02_JPRB, 0.101733E-02_JPRB /) 
125SELFREF(:, 9) = (/ &
126 & 0.210589E-02_JPRB, 0.197078E-02_JPRB, 0.184434E-02_JPRB, 0.172601E-02_JPRB, 0.161528E-02_JPRB, &
127 & 0.151164E-02_JPRB, 0.141466E-02_JPRB, 0.132390E-02_JPRB, 0.123896E-02_JPRB, 0.115947E-02_JPRB /) 
128SELFREF(:,10) = (/ &
129 & 0.245098E-02_JPRB, 0.233745E-02_JPRB, 0.222918E-02_JPRB, 0.212592E-02_JPRB, 0.202745E-02_JPRB, &
130 & 0.193353E-02_JPRB, 0.184397E-02_JPRB, 0.175856E-02_JPRB, 0.167710E-02_JPRB, 0.159941E-02_JPRB /) 
131SELFREF(:,11) = (/ &
132 & 0.267460E-02_JPRB, 0.253325E-02_JPRB, 0.239936E-02_JPRB, 0.227255E-02_JPRB, 0.215244E-02_JPRB, &
133 & 0.203868E-02_JPRB, 0.193093E-02_JPRB, 0.182888E-02_JPRB, 0.173222E-02_JPRB, 0.164067E-02_JPRB /) 
134SELFREF(:,12) = (/ &
135 & 0.304510E-02_JPRB, 0.283919E-02_JPRB, 0.264720E-02_JPRB, 0.246820E-02_JPRB, 0.230130E-02_JPRB, &
136 & 0.214568E-02_JPRB, 0.200059E-02_JPRB, 0.186531E-02_JPRB, 0.173918E-02_JPRB, 0.162157E-02_JPRB /) 
137SELFREF(:,13) = (/ &
138 & 0.338445E-02_JPRB, 0.314719E-02_JPRB, 0.292655E-02_JPRB, 0.272139E-02_JPRB, 0.253060E-02_JPRB, &
139 & 0.235319E-02_JPRB, 0.218822E-02_JPRB, 0.203482E-02_JPRB, 0.189217E-02_JPRB, 0.175952E-02_JPRB /) 
140SELFREF(:,14) = (/ &
141 & 0.388649E-02_JPRB, 0.357018E-02_JPRB, 0.327961E-02_JPRB, 0.301269E-02_JPRB, 0.276750E-02_JPRB, &
142 & 0.254226E-02_JPRB, 0.233535E-02_JPRB, 0.214528E-02_JPRB, 0.197068E-02_JPRB, 0.181029E-02_JPRB /) 
143SELFREF(:,15) = (/ &
144 & 0.412547E-02_JPRB, 0.387413E-02_JPRB, 0.363810E-02_JPRB, 0.341646E-02_JPRB, 0.320831E-02_JPRB, &
145 & 0.301285E-02_JPRB, 0.282930E-02_JPRB, 0.265693E-02_JPRB, 0.249506E-02_JPRB, 0.234305E-02_JPRB /) 
146SELFREF(:,16) = (/ &
147 & 0.534327E-02_JPRB, 0.482967E-02_JPRB, 0.436544E-02_JPRB, 0.394583E-02_JPRB, 0.356655E-02_JPRB, &
148 & 0.322373E-02_JPRB, 0.291387E-02_JPRB, 0.263378E-02_JPRB, 0.238062E-02_JPRB, 0.215179E-02_JPRB /) 
149     
150!     -----------------------------------------------------------------
151IF (LHOOK) CALL DR_HOOK('SRTM_KGB23',1,ZHOOK_HANDLE)
152RETURN
153
1541001 CONTINUE
155CALL ABOR1("SRTM_KGB23:ERROR READING FILE RADSRTM")
156
157END SUBROUTINE SRTM_KGB23
Note: See TracBrowser for help on using the repository browser.