Directory: | ./ |
---|---|
File: | rad/suecrad.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 176 | 678 | 26.0% |
Branches: | 48 | 1017 | 4.7% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | ! | ||
2 | ! $Id: suecrad.F90 3115 2017-12-07 14:45:01Z emillour $ | ||
3 | ! | ||
4 | 5 | SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH ) | |
5 | |||
6 | !**** *SUECRAD* - INITIALIZE COMMONS YOERxx CONTROLLING RADIATION | ||
7 | |||
8 | ! PURPOSE. | ||
9 | ! -------- | ||
10 | ! INITIALIZE YOERAD, THE COMMON THAT CONTROLS THE | ||
11 | ! RADIATION OF THE MODEL, AND YOERDU THAT INCLUDES | ||
12 | ! ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS | ||
13 | |||
14 | !** INTERFACE. | ||
15 | ! ---------- | ||
16 | ! CALL *SUECRAD* FROM *SUPHEC* | ||
17 | ! ------- ------ | ||
18 | |||
19 | ! EXPLICIT ARGUMENTS : | ||
20 | ! -------------------- | ||
21 | ! NONE | ||
22 | |||
23 | ! IMPLICIT ARGUMENTS : | ||
24 | ! -------------------- | ||
25 | ! COMMONS YOERAD, YOERDU | ||
26 | |||
27 | ! METHOD. | ||
28 | ! ------- | ||
29 | ! SEE DOCUMENTATION | ||
30 | |||
31 | ! EXTERNALS. | ||
32 | ! ---------- | ||
33 | ! SUAER, SUAERH, SUAERV, SULW, SUSW, SUOCST, SUSAT | ||
34 | ! SUAERL, SUAERSN, SUSRTAER, SRTM_INIT, SUSRTCOP | ||
35 | |||
36 | ! REFERENCE. | ||
37 | ! ---------- | ||
38 | ! ECMWF Research Department documentation of the IFS | ||
39 | |||
40 | ! AUTHOR. | ||
41 | ! ------- | ||
42 | ! JEAN-JACQUES MORCRETTE *ECMWF* | ||
43 | |||
44 | ! MODIFICATIONS. | ||
45 | ! -------------- | ||
46 | ! ORIGINAL : 88-12-15 | ||
47 | ! P.COURTIER AND M.HAMRUD NAME SURAD ALREADY USED | ||
48 | ! Modified 93-11-15 by Ph. Dandin : FMR scheme with MF | ||
49 | ! Modified 95-12 by PhD : Cloud overlapping hypothesis for FMR | ||
50 | ! 980317 JJMorcrette clean-up (NRAD, NFLUX) | ||
51 | ! 000118 JJMorcrette variable concentr. uniformly mixed gases | ||
52 | ! 990525 JJMorcrette GISS volcanic and new tropospheric aerosols | ||
53 | ! 990831 JJMorcrette RRTM | ||
54 | ! R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU | ||
55 | ! 010129 JJMorcrette clean-up LERAD1H, NLNGR1H | ||
56 | ! 011105 GMozdzynski support new radiation grid | ||
57 | ! 011005 JJMorcrette CCN --> Re Water clouds | ||
58 | ! R. El Khatib 01-02-02 LRRTM=lecmwf by default | ||
59 | ! 020909 GMozdzynski support NRADRES to specify radiation grid | ||
60 | ! 021001 GMozdzynski support on-demand radiation communications | ||
61 | ! 030422 GMozdzynski automatic min-halo | ||
62 | ! 030501 JJMorcrette new radiation grid on, new aerosols on (default) | ||
63 | ! 030513 JJMorcrette progn. O3 / radiation interactions off (default) | ||
64 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
65 | ! 050315 JJMorcrette prog.aerosols v1 | ||
66 | ! 041214 JJMorcrette SRTM | ||
67 | ! 050111 JJMorcrette new cloud optical properties | ||
68 | ! 050415 GMozdzynski Reduced halo support for radiation interpolation | ||
69 | ! 051004 JJMorcrette UV surface radiation processor | ||
70 | ! 051220 JJMorcrette SRTM112g+LWSCAT+UVprocessor+(bgfx:swclr, radaca) | ||
71 | ! 060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse) | ||
72 | ! 060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse) | ||
73 | ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation | ||
74 | ! 060625 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse) | ||
75 | ! 060726 JJMorcrette McICA default operational configuration | ||
76 | ! ------------------------------------------------------------------ | ||
77 | |||
78 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
79 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
80 | |||
81 | USE PARDIM , ONLY : JPMXGL | ||
82 | USE PARRRTM , ONLY : JPLAY | ||
83 | USE PARSRTM , ONLY : JPGPT | ||
84 | USE YOMCT0 , ONLY : LOUTPUT ,NPRINTLEV,LALLOPR,& | ||
85 | & NPROC ,N_REGIONS_NS ,N_REGIONS_EW | ||
86 | USE YOMDIM , ONLY : NDLON ,NSMAX ,NDGENL ,& | ||
87 | & NDGSAL ,NDGLG ,NDGSAG ,NDGENG ,NDSUR1 ,& | ||
88 | & NDLSUR ,NDGSUR ,NGPBLKS ,NFLEVG ,NPROMA | ||
89 | USE YOMCT0B , ONLY : LECMWF | ||
90 | USE YOMDYN , ONLY : TSTEP | ||
91 | ! Ce qui concerne NULRAD commente par MPL le 15.04.09 | ||
92 | !USE YOMLUN , ONLY : NULNAM ,NULRAD ,NULOUT | ||
93 | USE YOMLUN , ONLY : NULRAD ,NULOUT | ||
94 | USE YOMCST , ONLY : RDAY ,RG ,RCPD ,RPI ,RI0 | ||
95 | USE YOMPHY , ONLY : LMPHYS, LRAYFM ,LRAYFM15 | ||
96 | USE YOEPHY , ONLY : LEPHYS ,LERADI, LE4ALB | ||
97 | USE YOERDI , ONLY : RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC | ||
98 | USE YOERAD , ONLY : NAER , NOZOCL ,& | ||
99 | & NRADFR ,NRADPFR ,NRADPLA ,NRINT ,& | ||
100 | & NRADNFR ,NRADSFR ,NOVLP ,NRPROMA ,& | ||
101 | !& NLW ,NSW ,NTSW ,NCSRADF ,& | ||
102 | ! NSW mis dans .def MPL 20140211 | ||
103 | & NLW ,NTSW ,NCSRADF ,& | ||
104 | & NMODE ,NLNGR1H ,NSWNL ,NSWTL ,NUV ,& | ||
105 | & LERAD1H ,LERADHS ,LEPO3RA ,LRADLB ,LONEWSW ,& | ||
106 | & LCCNL ,LCCNO ,& | ||
107 | & LECSRAD ,LHVOLCA ,LNEWAER ,LRRTM ,LSRTM ,LDIFFC ,& | ||
108 | & NRADINT ,NRADRES ,CRTABLEDIR,CRTABLEFIL ,& | ||
109 | & NICEOPT ,NLIQOPT ,NRADIP ,NRADLP ,NINHOM ,NLAYINH ,& | ||
110 | & LRAYL ,LOPTRPROMA,& | ||
111 | & RCCNLND ,RCCNSEA ,RLWINHF ,RSWINHF ,RRe2De ,& | ||
112 | & RPERTOZ ,NPERTOZ ,NMCICA ,& | ||
113 | & LNOTROAER,NPERTAER ,LECO2VAR ,LHGHG ,NHINCSOL,NSCEN ,& | ||
114 | & LEDBUG | ||
115 | USE YOERDU , ONLY : NUAER ,NTRAER ,RCDAY ,R10E ,& | ||
116 | & REPLOG ,REPSC ,REPSCO ,REPSCQ ,REPSCT ,& | ||
117 | & REPSCW ,DIFF | ||
118 | USE YOEAERD , ONLY : CVDAES ,CVDAEL ,CVDAEU ,CVDAED ,& | ||
119 | & RCAEOPS ,RCAEOPL ,RCAEOPU ,RCAEOPD ,RCTRBGA ,& | ||
120 | & RCVOBGA ,RCSTBGA ,RCTRPT ,RCAEADM ,RCAEROS , & | ||
121 | & RCAEADK | ||
122 | USE YOE_UVRAD, ONLY : JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV | ||
123 | |||
124 | USE YOMMP , ONLY : MYPROC ,NPRCIDS ,LSPLIT ,NAPSETS ,& | ||
125 | & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,& | ||
126 | & NSTA,NONL,NPTRFRSTLAT,NFRSTLAT,NLSTLAT ,& | ||
127 | & MY_REGION_NS ,MY_REGION_EW ,NGLOBALINDEX ,& | ||
128 | & NRISTA ,NRIONL ,NRIOFF ,NRIEXT ,NRICORE ,& | ||
129 | & NRISENDPOS ,NRIRECVPOS ,NRISENDPTR ,NRIRECVPTR ,& | ||
130 | & NARIB1 ,NRIPROCS ,NRIMPBUFSZ,NRISPT ,NRIRPT ,& | ||
131 | & NRICOMM ,& | ||
132 | & NROSTA ,NROONL ,NROOFF ,NROEXT ,NROCORE ,& | ||
133 | & NROSENDPOS ,NRORECVPOS ,NROSENDPTR ,NRORECVPTR ,& | ||
134 | & NAROB1 ,NROPROCS ,NROMPBUFSZ,NROSPT ,NRORPT ,& | ||
135 | & NROCOMM | ||
136 | USE YOMGC , ONLY : GELAT ,GELAM | ||
137 | USE YOMLEG , ONLY : RMU ,RSQM2 | ||
138 | USE YOMSC2 , ONLY : & | ||
139 | & NRIWIDEN ,NRIWIDES ,NRIWIDEW ,NRIWIDEE,& | ||
140 | & NROWIDEN ,NROWIDES ,NROWIDEW ,NROWIDEE | ||
141 | USE YOMGEM , ONLY : NGPTOT ,NGPTOTG ,NGPTOTMX ,NLOENG | ||
142 | USE YOMTAG , ONLY : MTAGRAD | ||
143 | USE YOMPRAD , ONLY : LODBGRADI,LODBGRADL ,RADGRID ,& | ||
144 | & LRADONDEM | ||
145 | USE YOMRADF , ONLY : EMTD ,TRSW ,EMTC ,TRSC ,& | ||
146 | & SRSWD ,SRLWD ,SRSWDCS ,SRLWDCS ,SRSWDV ,& | ||
147 | & SRSWDUV ,EDRO ,SRSWPAR ,SRSWUVB ,SRSWPARC, SRSWTINC,& | ||
148 | & EMTU, RMOON | ||
149 | ! Commente par MPL 26.11.08 | ||
150 | !USE YOPHNC , ONLY : LERADN2 | ||
151 | ! MPLefebvre 6-11-08 commente tout ce qui concerne MPL_MODULE | ||
152 | !USE MPL_MODULE , ONLY : MPL_BROADCAST, MPL_SEND, MPL_RECV | ||
153 | USE YOM_YGFL , ONLY : YO3 | ||
154 | !!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90 | ||
155 | USE YOMDYN , ONLY : NDLNPR | ||
156 | |||
157 | IMPLICIT NONE | ||
158 | |||
159 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
160 | INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT | ||
161 | REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1) | ||
162 | ! LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID) | ||
163 | INTEGER(KIND=JPIM) :: NRGRI(JPMXGL) | ||
164 | |||
165 | INTEGER(KIND=JPIM) :: IDGL,INBLW,IRADFR,IST1HR,ISTNHR,IDIR,IFIL | ||
166 | INTEGER(KIND=JPIM) :: IRIRPTSUR,IRISPTSUR,IRIMAPLEN | ||
167 | INTEGER(KIND=JPIM) :: JLON,JGLAT,JGL,JGLSUR,IDLSUR,IOFF,ILAT,ISTLON,IENDLON | ||
168 | INTEGER(KIND=JPIM) :: IRORPTSUR,IROSPTSUR,IROMAPLEN | ||
169 | INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI,IGLGLO,IDUM,IU | ||
170 | INTEGER(KIND=JPIM) :: J,JROC,IGPTOT | ||
171 | INTEGER(KIND=JPIM) :: IROWIDEMAXN,IROWIDEMAXS,IROWIDEMAXW,IROWIDEMAXE | ||
172 | INTEGER(KIND=JPIM) :: IRIWIDEMAXN,IRIWIDEMAXS,IRIWIDEMAXW,IRIWIDEMAXE | ||
173 | INTEGER(KIND=JPIM) :: IARIB1MAX,IAROB1MAX | ||
174 | INTEGER(KIND=JPIM) :: IWIDE(10) | ||
175 | INTEGER(KIND=JPIM) :: ILATS_DIFF_F,ILATS_DIFF_C | ||
176 | INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5 | ||
177 | INTEGER(KIND=JPIM) :: ISW,JUV,IDAYUV | ||
178 | |||
179 | LOGICAL :: LLINEAR_GRID | ||
180 | LOGICAL :: LLDEBUG,LLP | ||
181 | |||
182 | REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6 | ||
183 | REAL(KIND=JPRB) :: ZMINRADLAT,ZMAXRADLAT,ZMINRADLON,ZMAXRADLON | ||
184 | REAL(KIND=JPRB) :: ZMINMDLLAT,ZMAXMDLLAT,ZMINMDLLON,ZMAXMDLLON | ||
185 | REAL(KIND=JPRB) :: ZLAT | ||
186 | !REAL(KIND=JPRB) :: RLATVOL, RLONVOL | ||
187 | |||
188 | CHARACTER (LEN = 300) :: CLFN | ||
189 | INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1 | ||
190 | |||
191 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPOS(:) | ||
192 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPOS(:) | ||
193 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPTR(:) | ||
194 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPTR(:) | ||
195 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRICOMM(:) | ||
196 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRIMAP(:,:) | ||
197 | INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPOS(:) | ||
198 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPOS(:) | ||
199 | INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPTR(:) | ||
200 | INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPTR(:) | ||
201 | INTEGER(KIND=JPIM), ALLOCATABLE :: IROCOMM(:) | ||
202 | INTEGER(KIND=JPIM), ALLOCATABLE :: IROMAP(:,:) | ||
203 | INTEGER(KIND=JPIM), ALLOCATABLE :: IGLOBALINDEX(:) | ||
204 | |||
205 | REAL(KIND=JPRB),ALLOCATABLE :: ZLATX(:) | ||
206 | REAL(KIND=JPRB),ALLOCATABLE :: ZLONX(:) | ||
207 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
208 | |||
209 | INTERFACE | ||
210 | SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KLOEN,LDLINEAR_GRID,LDSPLIT,& | ||
211 | &KAPSETS,KTMAX,KRESOL) | ||
212 | |||
213 | !**** *SETUP_TRANS* - Setup transform package for specific resolution | ||
214 | |||
215 | ! Purpose. | ||
216 | ! -------- | ||
217 | ! To setup for making spectral transforms. Each call to this routine | ||
218 | ! creates a new resolution up to a maximum of NMAX_RESOL set up in | ||
219 | ! SETUP_TRANS0. You need to call SETUP_TRANS0 before this routine can | ||
220 | ! be called. | ||
221 | |||
222 | !** Interface. | ||
223 | ! ---------- | ||
224 | ! CALL SETUP_TRANS(...) | ||
225 | |||
226 | ! Explicit arguments : KLOEN,LDLINEAR_GRID,LDSPLIT,KAPSETS are optional arguments | ||
227 | ! -------------------- | ||
228 | ! KSMAX - spectral truncation required | ||
229 | ! KDGL - number of Gaussian latitudes | ||
230 | ! KLOEN(:) - number of points on each Gaussian latitude [2*KDGL] | ||
231 | ! LDSPLIT - true if split latitudes in grid-point space [false] | ||
232 | ! LDLINEAR_GRID - true if linear grid | ||
233 | ! KAPSETS - Number of apple sets in the distribution [0] | ||
234 | ! KTMAX - truncation order for tendencies? | ||
235 | ! KRESOL - the resolution identifier | ||
236 | |||
237 | ! KSMAX,KDGL,KTMAX and KLOEN are GLOBAL variables desribing the resolution | ||
238 | ! in spectral and grid-point space | ||
239 | |||
240 | ! LDSPLIT and KAPSETS describe the distribution among processors of | ||
241 | ! grid-point data and has no relevance if you are using a single processor | ||
242 | |||
243 | ! Method. | ||
244 | ! ------- | ||
245 | |||
246 | ! Externals. SET_RESOL - set resolution | ||
247 | ! ---------- SETUP_DIMS - setup distribution independent dimensions | ||
248 | ! SUMP_TRANS_PRELEG - first part of setup of distr. environment | ||
249 | ! SULEG - Compute Legandre polonomial and Gaussian | ||
250 | ! Latitudes and Weights | ||
251 | ! SETUP_GEOM - Compute arrays related to grid-point geometry | ||
252 | ! SUMP_TRANS - Second part of setup of distributed environment | ||
253 | ! SUFFT - setup for FFT | ||
254 | |||
255 | ! Author. | ||
256 | ! ------- | ||
257 | ! Mats Hamrud *ECMWF* | ||
258 | |||
259 | ! Modifications. | ||
260 | ! -------------- | ||
261 | ! Original : 00-03-03 | ||
262 | |||
263 | ! ------------------------------------------------------------------ | ||
264 | |||
265 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
266 | |||
267 | IMPLICIT NONE | ||
268 | |||
269 | ! Dummy arguments | ||
270 | |||
271 | INTEGER(KIND=JPIM) ,INTENT(IN) :: KSMAX,KDGL | ||
272 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KLOEN(:) | ||
273 | LOGICAL ,OPTIONAL,INTENT(IN) :: LDLINEAR_GRID | ||
274 | LOGICAL ,OPTIONAL,INTENT(IN) :: LDSPLIT | ||
275 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KAPSETS | ||
276 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KTMAX | ||
277 | INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT):: KRESOL | ||
278 | |||
279 | |||
280 | END SUBROUTINE SETUP_TRANS | ||
281 | |||
282 | |||
283 | SUBROUTINE TRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,& | ||
284 | &KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,& | ||
285 | &KMYMS,KASM0,KUMPP,KPOSSP,KPTRMS,KALLMS,KDIM0G,& | ||
286 | &KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,& | ||
287 | &KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,KSTA,KONL,& | ||
288 | &KULTPP,KPTRLS,& | ||
289 | &LDSPLITLAT,& | ||
290 | &PMU,PGW,PRPNM,KLEI3,KSPOLEGL,KPMS) | ||
291 | |||
292 | !**** *TRANS_INQ* - Extract information from the transform package | ||
293 | |||
294 | ! Purpose. | ||
295 | ! -------- | ||
296 | ! Interface routine for extracting information from the T.P. | ||
297 | |||
298 | !** Interface. | ||
299 | ! ---------- | ||
300 | ! CALL TRANS_INQ(...) | ||
301 | ! Explicit arguments : All arguments are optional. | ||
302 | ! -------------------- | ||
303 | ! KRESOL - resolution tag for which info is required ,default is the | ||
304 | ! first defined resulution (input) | ||
305 | |||
306 | ! SPECTRAL SPACE | ||
307 | ! KSPEC - number of complex spectral coefficients on this PE | ||
308 | ! KSPEC2 - 2*KSPEC | ||
309 | ! KSPEC2G - global KSPEC2 | ||
310 | ! KSPEC2MX - maximun KSPEC2 among all PEs | ||
311 | ! KNUMP - Number of spectral waves handled by this PE | ||
312 | ! KGPTOT - Total number of grid columns on this PE | ||
313 | ! KGPTOTG - Total number of grid columns on the Globe | ||
314 | ! KGPTOTMX - Maximum number of grid columns on any of the PEs | ||
315 | ! KGPTOTL - Number of grid columns one each PE (dimension NPRGPNS:NPRGPEW) | ||
316 | ! KMYMS - This PEs spectral zonal wavenumbers | ||
317 | ! KASM0 - Address in a spectral array of (m, n=m) | ||
318 | ! KUMPP - No. of wave numbers each wave set is responsible for | ||
319 | ! KPOSSP - Defines partitioning of global spectral fields among PEs | ||
320 | ! KPTRMS - Pointer to the first wave number of a given a-set | ||
321 | ! KALLMS - Wave numbers for all wave-set concatenated together | ||
322 | ! to give all wave numbers in wave-set order | ||
323 | ! KDIM0G - Defines partitioning of global spectral fields among PEs | ||
324 | |||
325 | ! GRIDPOINT SPACE | ||
326 | ! KFRSTLAT - First latitude of each a-set in grid-point space | ||
327 | ! KLSTTLAT - Last latitude of each a-set in grid-point space | ||
328 | ! KFRSTLOFF - Offset for first lat of own a-set in grid-point space | ||
329 | ! KPTRLAT - Pointer to the start of each latitude | ||
330 | ! KPTRFRSTLAT - Pointer to the first latitude of each a-set in | ||
331 | ! NSTA and NONL arrays | ||
332 | ! KPTRLSTLAT - Pointer to the last latitude of each a-set in | ||
333 | ! NSTA and NONL arrays | ||
334 | ! KPTRFLOFF - Offset for pointer to the first latitude of own a-set | ||
335 | ! NSTA and NONL arrays, i.e. nptrfrstlat(myseta)-1 | ||
336 | ! KSTA - Position of first grid column for the latitudes on a | ||
337 | ! processor. The information is available for all processors. | ||
338 | ! The b-sets are distinguished by the last dimension of | ||
339 | ! nsta().The latitude band for each a-set is addressed by | ||
340 | ! nptrfrstlat(jaset),nptrlstlat(jaset), and | ||
341 | ! nptrfloff=nptrfrstlat(myseta) on this processors a-set. | ||
342 | ! Each split latitude has two entries in nsta(,:) which | ||
343 | ! necessitates the rather complex addressing of nsta(,:) | ||
344 | ! and the overdimensioning of nsta by nprgpns. | ||
345 | ! KONL - Number of grid columns for the latitudes on a processor. | ||
346 | ! Similar to nsta() in data structure. | ||
347 | ! LDSPLITLAT - TRUE if latitude is split in grid point space over | ||
348 | ! two a-sets | ||
349 | |||
350 | ! FOURIER SPACE | ||
351 | ! KULTPP - number of latitudes for which each a-set is calculating | ||
352 | ! the FFT's. | ||
353 | ! KPTRLS - pointer to first global latitude of each a-set for which | ||
354 | ! it performs the Fourier calculations | ||
355 | |||
356 | ! LEGENDRE | ||
357 | ! PMU - sin(Gaussian latitudes) | ||
358 | ! PGW - Gaussian weights | ||
359 | ! PRPNM - Legendre polynomials | ||
360 | ! KLEI3 - First dimension of Legendre polynomials | ||
361 | ! KSPOLEGL - Second dimension of Legendre polynomials | ||
362 | ! KPMS - Adress for legendre polynomial for given M (NSMAX) | ||
363 | |||
364 | ! Method. | ||
365 | ! ------- | ||
366 | |||
367 | ! Externals. SET_RESOL - set resolution | ||
368 | ! ---------- | ||
369 | |||
370 | ! Author. | ||
371 | ! ------- | ||
372 | ! Mats Hamrud *ECMWF* | ||
373 | |||
374 | ! Modifications. | ||
375 | ! -------------- | ||
376 | ! Original : 00-03-03 | ||
377 | ! M. Hortal : 2001-03-05 Dimensions of the Legendre polynomials | ||
378 | |||
379 | ! ------------------------------------------------------------------ | ||
380 | |||
381 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
382 | |||
383 | |||
384 | IMPLICIT NONE | ||
385 | |||
386 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL | ||
387 | |||
388 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC | ||
389 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2 | ||
390 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2G | ||
391 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2MX | ||
392 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNUMP | ||
393 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOT | ||
394 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTG | ||
395 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTMX | ||
396 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTL(:,:) | ||
397 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLOFF | ||
398 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFLOFF | ||
399 | |||
400 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYMS(:) | ||
401 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KASM0(0:) | ||
402 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KUMPP(:) | ||
403 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPOSSP(:) | ||
404 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRMS(:) | ||
405 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KALLMS(:) | ||
406 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDIM0G(0:) | ||
407 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLAT(:) | ||
408 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLSTLAT(:) | ||
409 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLAT(:) | ||
410 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFRSTLAT(:) | ||
411 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLSTLAT(:) | ||
412 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSTA(:,:) | ||
413 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KONL(:,:) | ||
414 | LOGICAL ,OPTIONAL, INTENT(OUT) :: LDSPLITLAT(:) | ||
415 | |||
416 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KULTPP(:) | ||
417 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLS(:) | ||
418 | |||
419 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PMU(:) | ||
420 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGW(:) | ||
421 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRPNM(:,:) | ||
422 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLEI3 | ||
423 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPOLEGL | ||
424 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPMS(0:) | ||
425 | |||
426 | |||
427 | END SUBROUTINE TRANS_INQ | ||
428 | |||
429 | |||
430 | |||
431 | |||
432 | |||
433 | |||
434 | END INTERFACE | ||
435 | |||
436 | INTERFACE | ||
437 | SUBROUTINE ABOR1(CDTEXT) | ||
438 | CHARACTER(LEN=*) :: CDTEXT | ||
439 | END SUBROUTINE ABOR1 | ||
440 | END INTERFACE | ||
441 | INTERFACE | ||
442 | SUBROUTINE POSNAM(KULNAM,CDNAML) | ||
443 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
444 | INTEGER(KIND=JPIM),INTENT(IN) :: KULNAM | ||
445 | CHARACTER(LEN=*) ,INTENT(IN) :: CDNAML | ||
446 | END SUBROUTINE POSNAM | ||
447 | END INTERFACE | ||
448 | INTERFACE | ||
449 | SUBROUTINE RRTM_INIT_140GP | ||
450 | END SUBROUTINE RRTM_INIT_140GP | ||
451 | END INTERFACE | ||
452 | |||
453 | INTERFACE | ||
454 | SUBROUTINE RDCSET(CDSL,KSLWIDEN,KSLWIDES,KSLWIDEW,KSLWIDEE,& | ||
455 | & KSLRPTSUR,KSLSPTSUR,& | ||
456 | & KDGLG,KDLON,KDGSAG,KDGENG,KDGUXL,KDGUXG,KDGSAL,KDGENL,& | ||
457 | & KDSUR1,KDLSUR,KDGSUR,KGPTOT,KGPTOT_CAP,& | ||
458 | & KPTRFLOFF,KFRSTLOFF,KYFRSTACTLAT,KYLSTACTLAT,& | ||
459 | & KSTA,KONL,KLOENG,KPTRFRSTLAT,KFRSTLAT,KLSTLAT,& | ||
460 | & PMU,PSQM2,& | ||
461 | & KSLSTA,KSLONL,KSLOFF,KSLEXT,KSLCORE,KASLB1,& | ||
462 | & KSLPROCS,KSLMPBUFSZ,KSLRPT,KSLSPT,& | ||
463 | & KSLSENDPOS,KSLRECVPOS,KSENDPTR,KRECVPTR,KSLCOMM,KMAP,KMAPLEN) | ||
464 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
465 | USE YOMCT0 , ONLY : NPROC ,NPRINTLEV,LOUTPUT ,LMPDIAG ,LALLOPR ,& | ||
466 | & LELAM ,N_REGIONS_NS ,N_REGIONS_EW | ||
467 | INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDEN | ||
468 | INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDES | ||
469 | INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDEW | ||
470 | INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDEE | ||
471 | INTEGER(KIND=JPIM),INTENT(IN) :: KSLRPTSUR | ||
472 | INTEGER(KIND=JPIM),INTENT(IN) :: KSLSPTSUR | ||
473 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGLG | ||
474 | INTEGER(KIND=JPIM),INTENT(IN) :: KDLON | ||
475 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGSAG | ||
476 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGENG | ||
477 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGSAL | ||
478 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGENL | ||
479 | INTEGER(KIND=JPIM),INTENT(IN) :: KGPTOT | ||
480 | CHARACTER(LEN=2) ,INTENT(IN) :: CDSL | ||
481 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGUXL | ||
482 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGUXG | ||
483 | INTEGER(KIND=JPIM),INTENT(IN) :: KDSUR1 | ||
484 | INTEGER(KIND=JPIM),INTENT(IN) :: KDLSUR | ||
485 | INTEGER(KIND=JPIM),INTENT(IN) :: KDGSUR | ||
486 | INTEGER(KIND=JPIM),INTENT(IN) :: KGPTOT_CAP | ||
487 | INTEGER(KIND=JPIM),INTENT(IN) :: KPTRFLOFF | ||
488 | INTEGER(KIND=JPIM),INTENT(IN) :: KFRSTLOFF | ||
489 | INTEGER(KIND=JPIM),INTENT(IN) :: KYFRSTACTLAT | ||
490 | INTEGER(KIND=JPIM),INTENT(IN) :: KYLSTACTLAT | ||
491 | INTEGER(KIND=JPIM),INTENT(IN) :: KSTA(KDGSAG:KDGENG+N_REGIONS_NS-1,N_REGIONS_EW) | ||
492 | INTEGER(KIND=JPIM),INTENT(IN) :: KONL(KDGSAG:KDGENG+N_REGIONS_NS-1,N_REGIONS_EW) | ||
493 | INTEGER(KIND=JPIM),INTENT(IN) :: KLOENG(KDGSAG:KDGENG) | ||
494 | INTEGER(KIND=JPIM),INTENT(IN) :: KPTRFRSTLAT(N_REGIONS_NS) | ||
495 | INTEGER(KIND=JPIM),INTENT(IN) :: KFRSTLAT(N_REGIONS_NS) | ||
496 | INTEGER(KIND=JPIM),INTENT(IN) :: KLSTLAT(N_REGIONS_NS) | ||
497 | REAL(KIND=JPRB) ,INTENT(IN) :: PMU(KDGSAG:KDGENG) | ||
498 | REAL(KIND=JPRB) ,INTENT(IN) :: PSQM2(KDGSAG:KDGENG) | ||
499 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLSTA(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES) | ||
500 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLONL(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES) | ||
501 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLOFF(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES) | ||
502 | INTEGER(KIND=JPIM),INTENT(OUT) :: KSLEXT(1-KDLON:KDLON+KDLON,1-KSLWIDEN:KDGENL+KSLWIDES) | ||
503 | INTEGER(KIND=JPIM),INTENT(OUT) :: KSLCORE(KGPTOT) | ||
504 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KASLB1 | ||
505 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLPROCS | ||
506 | INTEGER(KIND=JPIM),INTENT(OUT) :: KSLMPBUFSZ | ||
507 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLRPT | ||
508 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLSPT | ||
509 | INTEGER(KIND=JPIM),INTENT(OUT) :: KSLSENDPOS(KSLSPTSUR) | ||
510 | INTEGER(KIND=JPIM),INTENT(OUT) :: KSLRECVPOS(KSLRPTSUR) | ||
511 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSENDPTR(NPROC+1) | ||
512 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KRECVPTR(NPROC+1) | ||
513 | INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLCOMM(NPROC) | ||
514 | INTEGER(KIND=JPIM),INTENT(OUT) :: KMAP(4,KDGLG) | ||
515 | INTEGER(KIND=JPIM),INTENT(OUT) :: KMAPLEN | ||
516 | END SUBROUTINE RDCSET | ||
517 | END INTERFACE | ||
518 | INTERFACE | ||
519 | SUBROUTINE SUAERH | ||
520 | END SUBROUTINE SUAERH | ||
521 | END INTERFACE | ||
522 | INTERFACE | ||
523 | SUBROUTINE SUAERL | ||
524 | END SUBROUTINE SUAERL | ||
525 | END INTERFACE | ||
526 | INTERFACE | ||
527 | SUBROUTINE SUAERSN (KTSW, KSW) | ||
528 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
529 | INTEGER(KIND=JPIM),INTENT(IN) :: KTSW | ||
530 | INTEGER(KIND=JPIM),INTENT(IN) :: KSW | ||
531 | END SUBROUTINE SUAERSN | ||
532 | END INTERFACE | ||
533 | INTERFACE | ||
534 | SUBROUTINE SUAERV& | ||
535 | & ( KLEV , PETAH,& | ||
536 | & PVDAES, PVDAEL, PVDAEU, PVDAED,& | ||
537 | & PTRBGA, PVOBGA, PSTBGA, PAEOPS, PAEOPL, PAEOPU,& | ||
538 | & PAEOPD, PTRPT , PAEADK, PAEADM, PAEROS& | ||
539 | & ) | ||
540 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
541 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
542 | REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1) | ||
543 | REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAES(KLEV+1) | ||
544 | REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAEL(KLEV+1) | ||
545 | REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAEU(KLEV+1) | ||
546 | REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAED(KLEV+1) | ||
547 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRBGA | ||
548 | REAL(KIND=JPRB) ,INTENT(OUT) :: PVOBGA | ||
549 | REAL(KIND=JPRB) ,INTENT(OUT) :: PSTBGA | ||
550 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPS | ||
551 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPL | ||
552 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPU | ||
553 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPD | ||
554 | REAL(KIND=JPRB) ,INTENT(OUT) :: PTRPT | ||
555 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAEADK(3) | ||
556 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAEADM | ||
557 | REAL(KIND=JPRB) ,INTENT(OUT) :: PAEROS | ||
558 | END SUBROUTINE SUAERV | ||
559 | END INTERFACE | ||
560 | INTERFACE | ||
561 | SUBROUTINE SUCLOPN (KTSW, KSW, KLEV) | ||
562 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
563 | INTEGER(KIND=JPIM),INTENT(IN) :: KTSW | ||
564 | INTEGER(KIND=JPIM),INTENT(IN) :: KSW | ||
565 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
566 | END SUBROUTINE SUCLOPN | ||
567 | END INTERFACE | ||
568 | INTERFACE | ||
569 | SUBROUTINE SUECRADI | ||
570 | END SUBROUTINE SUECRADI | ||
571 | END INTERFACE | ||
572 | INTERFACE | ||
573 | SUBROUTINE SUECRADL | ||
574 | !USE MPL_MODULE | ||
575 | END SUBROUTINE SUECRADL | ||
576 | END INTERFACE | ||
577 | INTERFACE | ||
578 | SUBROUTINE SULWN | ||
579 | END SUBROUTINE SULWN | ||
580 | END INTERFACE | ||
581 | INTERFACE | ||
582 | SUBROUTINE SULWNEUR(KLEV) | ||
583 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
584 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
585 | END SUBROUTINE SULWNEUR | ||
586 | END INTERFACE | ||
587 | INTERFACE | ||
588 | SUBROUTINE SUOVLP ( KLEV ) | ||
589 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
590 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
591 | END SUBROUTINE SUOVLP | ||
592 | END INTERFACE | ||
593 | INTERFACE | ||
594 | SUBROUTINE SURDI | ||
595 | END SUBROUTINE SURDI | ||
596 | END INTERFACE | ||
597 | INTERFACE | ||
598 | SUBROUTINE SURRTAB | ||
599 | END SUBROUTINE SURRTAB | ||
600 | END INTERFACE | ||
601 | INTERFACE | ||
602 | SUBROUTINE SURRTFTR | ||
603 | END SUBROUTINE SURRTFTR | ||
604 | END INTERFACE | ||
605 | INTERFACE | ||
606 | SUBROUTINE SURRTPK | ||
607 | END SUBROUTINE SURRTPK | ||
608 | END INTERFACE | ||
609 | INTERFACE | ||
610 | SUBROUTINE SURRTRF | ||
611 | END SUBROUTINE SURRTRF | ||
612 | END INTERFACE | ||
613 | INTERFACE | ||
614 | SUBROUTINE SUSAT | ||
615 | END SUBROUTINE SUSAT | ||
616 | END INTERFACE | ||
617 | INTERFACE | ||
618 | SUBROUTINE SUSWN (KTSW, KSW) | ||
619 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
620 | INTEGER(KIND=JPIM),INTENT(IN) :: KTSW | ||
621 | INTEGER(KIND=JPIM),INTENT(IN) :: KSW | ||
622 | END SUBROUTINE SUSWN | ||
623 | END INTERFACE | ||
624 | INTERFACE | ||
625 | SUBROUTINE SUSRTAER | ||
626 | END SUBROUTINE SUSRTAER | ||
627 | END INTERFACE | ||
628 | INTERFACE | ||
629 | SUBROUTINE SRTM_INIT | ||
630 | END SUBROUTINE SRTM_INIT | ||
631 | END INTERFACE | ||
632 | INTERFACE | ||
633 | SUBROUTINE SUSRTCOP | ||
634 | END SUBROUTINE SUSRTCOP | ||
635 | END INTERFACE | ||
636 | INTERFACE | ||
637 | SUBROUTINE SU_AERW | ||
638 | END SUBROUTINE SU_AERW | ||
639 | END INTERFACE | ||
640 | INTERFACE | ||
641 | SUBROUTINE SU_UVRAD ( KUV ) | ||
642 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
643 | INTEGER(KIND=JPIM),INTENT(IN) :: KUV | ||
644 | END SUBROUTINE SU_UVRAD | ||
645 | END INTERFACE | ||
646 | INTERFACE | ||
647 | SUBROUTINE SU_MCICA | ||
648 | END SUBROUTINE SU_MCICA | ||
649 | END INTERFACE | ||
650 | |||
651 | ! ---------------------------------------------------------------- | ||
652 | |||
653 | ! ----------------------------------------------------------------- | ||
654 | NAMELIST/NAERAD/& | ||
655 | & LERAD1H, LERADHS, LEPO3RA, LRADLB , LONEWSW & | ||
656 | &, LCCNL , LCCNO , LECSRAD, LRAYL , LRRTM , LSRTM & | ||
657 | &, LHVOLCA, LNEWAER, LDIFFC , LNOTROAER & | ||
658 | &, LRADONDEM & | ||
659 | &, NICEOPT, NLIQOPT, NMCICA , NRADIP , NRADLP & | ||
660 | &, NAER , NMODE , NOZOCL , NINHOM , NLAYINH & | ||
661 | &, NOVLP , NLW , NSW , NRADFR , NLNGR1H & | ||
662 | &, NRADPFR, NRADPLA, NRINT , NRPROMA, NCSRADF & | ||
663 | &, NRADINT, NRADRES, CRTABLEDIR, CRTABLEFIL & | ||
664 | &, RCCNSEA, RCCNLND, NPERTAER, NPERTOZ & | ||
665 | &, RPERTOZ, RLWINHF, RSWINHF, RRe2De & | ||
666 | &, RCCO2 , RCCH4 , RCN2O , RCCFC11, RCCFC12 & | ||
667 | &, NHINCSOL,LECO2VAR,LHGHG , NSCEN & | ||
668 | &, LEDBUG & | ||
669 | &, LUVPROC, LUVTDEP, LUVDBG , NUV , NUVTIM , NRADUV , RUVLAM, RMUZUV | ||
670 | ! ----------------------------------------------------------------- | ||
671 | |||
672 | |||
673 | |||
674 | !----------------------------------------------------------------------------- | ||
675 | |||
676 | NAMELIST/NAMRGRI/NRGRI | ||
677 | |||
678 | !----------------------------------------------------------------------------- | ||
679 | |||
680 | !MPL/IM 20160915 on prend GES de phylmd | ||
681 | ! $Id: clesphys.h 3435 2019-01-22 15:21:59Z fairhead $ | ||
682 | ! | ||
683 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
684 | ! veillez \`a n'utiliser que des ! pour les commentaires | ||
685 | ! et \`a bien positionner les & des lignes de continuation | ||
686 | ! (les placer en colonne 6 et en colonne 73) | ||
687 | ! | ||
688 | !..include cles_phys.h | ||
689 | ! | ||
690 | INTEGER iflag_cycle_diurne | ||
691 | LOGICAL soil_model,new_oliq,ok_orodr,ok_orolf | ||
692 | LOGICAL ok_limitvrai | ||
693 | LOGICAL ok_all_xml | ||
694 | LOGICAL ok_lwoff | ||
695 | INTEGER nbapp_rad, iflag_con, nbapp_cv, nbapp_wk, iflag_ener_conserv | ||
696 | REAL co2_ppm, co2_ppm0, solaire | ||
697 | !FC | ||
698 | REAL Cd_frein | ||
699 | LOGICAL ok_suntime_rrtm | ||
700 | REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12 | ||
701 | REAL(kind=8) RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act | ||
702 | REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt | ||
703 | !IM ajout CFMIP2/CMIP5 | ||
704 | REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per | ||
705 | REAL(kind=8) CH4_ppb_per,N2O_ppb_per,CFC11_ppt_per,CFC12_ppt_per | ||
706 | |||
707 | !OM ---> correction du bilan d'eau global | ||
708 | !OM Correction sur precip KE | ||
709 | REAL cvl_corr | ||
710 | !OM Fonte calotte dans bilan eau | ||
711 | LOGICAL ok_lic_melt | ||
712 | !OB Depot de vapeur d eau sur la calotte pour le bilan eau | ||
713 | LOGICAL ok_lic_cond | ||
714 | |||
715 | !IM simulateur ISCCP | ||
716 | INTEGER top_height, overlap | ||
717 | !IM seuils cdrm, cdrh | ||
718 | REAL cdmmax, cdhmax | ||
719 | !IM param. stabilite s/ terres et en dehors | ||
720 | REAL ksta, ksta_ter, f_ri_cd_min | ||
721 | !IM ok_kzmin : clef calcul Kzmin dans la CL de surface cf FH | ||
722 | LOGICAL ok_kzmin | ||
723 | !IM, MAFo fmagic, pmagic : parametres - additionnel et multiplicatif - | ||
724 | ! pour regler l albedo sur ocean | ||
725 | REAL pbl_lmixmin_alpha | ||
726 | REAL fmagic, pmagic | ||
727 | ! Hauteur (imposee) du contenu en eau du sol | ||
728 | REAL qsol0,albsno0,evap0 | ||
729 | ! Frottement au sol (Cdrag) | ||
730 | Real f_cdrag_ter,f_cdrag_oce | ||
731 | REAL min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce | ||
732 | REAL z0m_seaice,z0h_seaice | ||
733 | INTEGER iflag_gusts,iflag_z0_oce | ||
734 | |||
735 | ! Rugoro | ||
736 | Real f_rugoro,z0min | ||
737 | |||
738 | ! tau_gl : constante de rappel de la temperature a la surface de la glace | ||
739 | REAL tau_gl | ||
740 | |||
741 | !IM lev_histhf : niveau sorties 6h | ||
742 | !IM lev_histday : niveau sorties journalieres | ||
743 | !IM lev_histmth : niveau sorties mensuelles | ||
744 | !IM lev_histdayNMC : on peut sortir soit sur 8 (comme AR5) ou bien | ||
745 | ! sur 17 niveaux de pression | ||
746 | INTEGER lev_histhf, lev_histday, lev_histmth | ||
747 | INTEGER lev_histdayNMC | ||
748 | Integer lev_histins, lev_histLES | ||
749 | !IM ok_histNMC : sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC) | ||
750 | !IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC) | ||
751 | !IM freq_calNMC : frequences de calcul fis. hist*NMC.nc | ||
752 | LOGICAL ok_histNMC(3) | ||
753 | INTEGER levout_histNMC(3) | ||
754 | REAL freq_outNMC(3) , freq_calNMC(3) | ||
755 | CHARACTER(len=4) type_run | ||
756 | ! aer_type: pour utiliser un fichier constant dans readaerosol | ||
757 | CHARACTER(len=8) :: aer_type | ||
758 | LOGICAL ok_regdyn | ||
759 | REAL lonmin_ins, lonmax_ins, latmin_ins, latmax_ins | ||
760 | REAL ecrit_ins, ecrit_hf, ecrit_day | ||
761 | REAL ecrit_mth, ecrit_tra, ecrit_reg | ||
762 | REAL ecrit_LES | ||
763 | REAL freq_ISCCP, ecrit_ISCCP | ||
764 | REAL freq_COSP, freq_AIRS | ||
765 | LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP | ||
766 | LOGICAL :: ok_airs | ||
767 | INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo | ||
768 | LOGICAL :: ok_chlorophyll | ||
769 | LOGICAL :: ok_strato | ||
770 | LOGICAL :: ok_hines, ok_gwd_rando | ||
771 | LOGICAL :: ok_qch4 | ||
772 | LOGICAL :: ok_conserv_q | ||
773 | LOGICAL :: adjust_tropopause | ||
774 | LOGICAL :: ok_daily_climoz | ||
775 | ! flag to bypass or not the phytrac module | ||
776 | INTEGER :: iflag_phytrac | ||
777 | |||
778 | COMMON/clesphys/ & | ||
779 | ! REAL FIRST | ||
780 | & co2_ppm, solaire & | ||
781 | & , RCO2, RCH4, RN2O, RCFC11, RCFC12 & | ||
782 | & , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act & | ||
783 | & , RCO2_per, RCH4_per, RN2O_per, RCFC11_per, RCFC12_per & | ||
784 | & , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt & | ||
785 | & , CH4_ppb_per, N2O_ppb_per, CFC11_ppt_per, CFC12_ppt_per & | ||
786 | & , cdmmax,cdhmax,ksta,ksta_ter,f_ri_cd_min,pbl_lmixmin_alpha & | ||
787 | & , fmagic, pmagic & | ||
788 | & , f_cdrag_ter,f_cdrag_oce,f_rugoro,z0min,tau_gl & | ||
789 | & , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce & | ||
790 | & , z0m_seaice,z0h_seaice & | ||
791 | & , freq_outNMC, freq_calNMC & | ||
792 | & , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins & | ||
793 | & , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS & | ||
794 | & , cvl_corr & | ||
795 | & , qsol0,albsno0,evap0 & | ||
796 | & , co2_ppm0 & | ||
797 | !FC | ||
798 | & , Cd_frein & | ||
799 | & , ecrit_LES & | ||
800 | & , ecrit_ins, ecrit_hf, ecrit_day & | ||
801 | & , ecrit_mth, ecrit_tra, ecrit_reg & | ||
802 | ! THEN INTEGER AND LOGICALS | ||
803 | & , top_height & | ||
804 | & , iflag_cycle_diurne, soil_model, new_oliq & | ||
805 | & , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad & | ||
806 | & , iflag_con, nbapp_cv, nbapp_wk & | ||
807 | & , iflag_ener_conserv & | ||
808 | & , ok_suntime_rrtm & | ||
809 | & , overlap & | ||
810 | & , ok_kzmin & | ||
811 | & , lev_histhf, lev_histday, lev_histmth & | ||
812 | & , lev_histins, lev_histLES, lev_histdayNMC, levout_histNMC & | ||
813 | & , ok_histNMC & | ||
814 | & , type_run, ok_regdyn, ok_cosp, ok_airs & | ||
815 | & , ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP & | ||
816 | & , ip_ebil_phy & | ||
817 | & , iflag_gusts ,iflag_z0_oce & | ||
818 | & , ok_lic_melt, ok_lic_cond, aer_type & | ||
819 | & , iflag_rrtm, ok_strato,ok_hines, ok_qch4 & | ||
820 | & , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo & | ||
821 | & , ok_chlorophyll,ok_conserv_q, adjust_tropopause & | ||
822 | & , ok_daily_climoz, ok_all_xml, ok_lwoff & | ||
823 | & , iflag_phytrac | ||
824 | |||
825 | save /clesphys/ | ||
826 | !$OMP THREADPRIVATE(/clesphys/) | ||
827 | |||
828 | !* 1. INITIALIZE NEUROFLUX LONGWAVE RADIATION | ||
829 | ! --------------------------------------- | ||
830 | |||
831 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUECRAD',0,ZHOOK_HANDLE) |
832 | !CALL GSTATS(1818,0) MPL 2.12.08 | ||
833 | !IF (LERADN2) THEN | ||
834 | ! CALL SULWNEUR(KLEV) | ||
835 | !ENDIF | ||
836 | |||
837 | !* 2. SET DEFAULT VALUES. | ||
838 | ! ------------------- | ||
839 | |||
840 | !* 2.1 PRESET INDICES IN *YOERAD* | ||
841 | ! -------------------------- | ||
842 | |||
843 | 1 | LERAD1H=.FALSE. | |
844 | 1 | NLNGR1H=6 | |
845 | |||
846 | 1 | LERADHS=.TRUE. | |
847 | 1 | LONEWSW=.TRUE. | |
848 | 1 | LECSRAD=.FALSE. | |
849 | |||
850 | !LE4ALB=.FALSE. | ||
851 | !This is read from SU0PHY in NAEPHY and put in YOEPHY | ||
852 | |||
853 | !- default setting of cloud optical properties | ||
854 | ! liquid water cloud 0: Fouquart (SW), Smith-Shi (LW) | ||
855 | ! 1: Slingo (SW), Savijarvi (LW) | ||
856 | ! 2: Slingo (SW), Lindner-Li (LW) | ||
857 | ! ice water cloud 0: Ebert-Curry (SW), Smith-Shi (LW) | ||
858 | ! 1: Ebert-Curry (SW), Ebert-Curry (LW) | ||
859 | ! 2: Fu-Liou'93 (SW), Fu-Liou'93 (LW) | ||
860 | ! 3: Fu'96 (SW), Fu et al'98 (LW) | ||
861 | 1 | NLIQOPT=2 ! before 3?R1 default=0 2 | |
862 | 1 | NICEOPT=3 ! before 3?R1 default=1 3 | |
863 | |||
864 | !- default setting of cloud effective radius/diameter | ||
865 | ! liquid water cloud 0: f(P) 10 to 45 | ||
866 | ! 1: 13: ocean; 10: land | ||
867 | ! 2: Martin et al. CCN 50 over ocean, 900 over land | ||
868 | ! ice water cloud 0: 40 microns | ||
869 | ! 1: f(T) 40 to 130 microns | ||
870 | ! 2: f(T) 30 to 60 | ||
871 | ! 3: f(T,IWC) Sun'01: 22.5 to 175 microns | ||
872 | ! conversion factor between effective radius and particle size for ice | ||
873 | 1 | NRADIP=3 ! before 3?R1 default=2 3 | |
874 | 1 | NRADLP=2 ! before 3?R1 default=2 2 | |
875 | 1 | print *,'SUECRAD: NRADLP, NRADIP=',NRADLP,NRADIP | |
876 | 1 | RRe2De=0.64952_JPRB ! before 3?R1 default=0.5_JPRB | |
877 | |||
878 | !- RRTM as LW scheme | ||
879 | 1 | LRRTM = .FALSE. | |
880 | 1 | LECMWF = .FALSE. | |
881 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (iflag_rrtm.EQ.1) THEN |
882 | 1 | LRRTM = .TRUE. | |
883 | 1 | LECMWF = .TRUE. | |
884 | ! LRRTM = .FALSE. ! Utiliser pour faire tourner le "vieux" rayonnement | ||
885 | ! LECMWF = .FALSE. | ||
886 | ENDIF | ||
887 | |||
888 | !LRRTM = .FALSE. | ||
889 | |||
890 | !- SRTM as SW scheme | ||
891 | !!!!! A REVOIR (MPL) verifier signification de LSRTM | ||
892 | 1 | LSRTM = .FALSE. ! before 3?R1 default was .FALSE. true | |
893 | |||
894 | ! -- McICA treatment of cloud-radiation interactions | ||
895 | ! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA) | ||
896 | 1 | NMcICA = 2 ! 2 for generalized overlap | |
897 | |||
898 | !- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns) | ||
899 | 1 | NINHOM = 0 ! before 3?R1 default=1 | |
900 | 1 | NLAYINH= 0 | |
901 | 1 | RLWINHF = 1.0_JPRB ! before 3?R1 default=0.7 | |
902 | 1 | RSWINHF = 1.0_JPRB ! before 3?R1 default=0.7 | |
903 | !- Diffusivity correction a la Savijarvi | ||
904 | 1 | LDIFFC = .FALSE. ! before 31R1 default=.FALSE. | |
905 | |||
906 | !- history of volcanic aerosols | ||
907 | 1 | LHVOLCA=.FALSE. | |
908 | !- monthly climatol. of tropospheric aerosols from Tegen et al. (1997) | ||
909 | 1 | LNEWAER=.TRUE. | |
910 | !!! cpl LNOTROAER=.FALSE. | ||
911 | 1 | LNOTROAER=.TRUE. | |
912 | 1 | NPERTAER=0 | |
913 | |||
914 | !- New Rayleigh formulation | ||
915 | 1 | LRAYL=.TRUE. | |
916 | |||
917 | !- Number concentration of aerosols if specified | ||
918 | 1 | LCCNL=.TRUE. ! before 3?R1 default=.FALSE. true | |
919 | 1 | LCCNO=.TRUE. ! before 3?R1 default=.FALSE. true | |
920 | 1 | RCCNLND=900._JPRB ! before 3?R1 default=900. now irrelevant | |
921 | 1 | RCCNSEA=50._JPRB ! before 3?R1 default=50. now irrelevant | |
922 | |||
923 | !- interaction radiation / prognostic O3 off by default | ||
924 | 1 | LEPO3RA=.FALSE. | |
925 | 1 | print *,'SUECRAD-0' | |
926 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (.NOT.YO3%LGP) THEN |
927 | 1 | LEPO3RA=.FALSE. | |
928 | ENDIF | ||
929 | 1 | RPERTOZ=0._JPRB | |
930 | 1 | NPERTOZ=0 | |
931 | |||
932 | !NAER: CONFIGURATION INDEX FOR AEROSOLS | ||
933 | !!!!! A REVOIR (MPL) a mettre dans un fichier .def | ||
934 | 1 | NAER =1 | |
935 | 1 | NMODE =0 | |
936 | 1 | NOZOCL =1 | |
937 | 1 | NRADFR =-3 | |
938 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (NSMAX >= 511) NRADFR =-1 |
939 | 1 | NRADPFR=0 | |
940 | 1 | NRADPLA=15 | |
941 | |||
942 | ! -- UV diagnostic of surface fluxes over the 280-400 nm interval | ||
943 | ! with up-to 24 values (5 nm wide spectral intervals) | ||
944 | 1 | LUVPROC=.FALSE. | |
945 | 1 | LUVTDEP=.TRUE. | |
946 | 1 | LUVDBG =.FALSE. | |
947 | 1 | NRADUV =-3 | |
948 | 1 | NUVTIM = 0 | |
949 | 1 | NUV = 24 | |
950 | 1 | RMUZUV = 1.E-01_JPRB | |
951 |
2/2✓ Branch 0 taken 24 times.
✓ Branch 1 taken 1 times.
|
25 | DO JUV=1,NUV |
952 | 25 | RUVLAM(JUV)=280._JPRB+(JUV-1)*5._JPRB | |
953 | ENDDO | ||
954 | |||
955 | !- radiation interpolation (George M's grid on by default) | ||
956 | LLDEBUG=.TRUE. | ||
957 | 1 | LEDBUG=.FALSE. | |
958 | 1 | NRADINT=3 | |
959 | 1 | NRADRES=0 | |
960 | |||
961 | 1 | NRINT =4 | |
962 | |||
963 | 1 | LRADLB=.TRUE. | |
964 | 1 | CRTABLEDIR='./' | |
965 | 1 | CRTABLEFIL='not set' | |
966 | 1 | LRADONDEM=.TRUE. | |
967 | !GM Temporary as per trans/external/setup_trans.F90 | ||
968 | 1 | LLINEAR_GRID=NSMAX > (NDLON+3)/3 | |
969 | IF( LLDEBUG )THEN | ||
970 | 1 | WRITE(NULOUT,'("SUECRAD: NSMAX=",I6)')NSMAX | |
971 | 1 | WRITE(NULOUT,'("SUECRAD: NDLON=",I6)')NDLON | |
972 | 1 | WRITE(NULOUT,'("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID | |
973 | ENDIF | ||
974 | |||
975 | 1 | NUAER = 24 | |
976 | 1 | NTRAER = 15 | |
977 | ! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH) | ||
978 | ! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415) | ||
979 | ✗ | SELECT CASE (overlap) | |
980 | CASE (:1) | ||
981 | ✗ | NOVLP = 2 | |
982 | CASE (2) | ||
983 | ✗ | NOVLP = 3 | |
984 | CASE (3:) | ||
985 |
1/3✗ Branch 0 not taken.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
|
1 | NOVLP = 1 |
986 | END SELECT | ||
987 | 1 | print *,'SUECRAD: NOVLP=',NOVLP | |
988 | 1 | NLW = 16 | |
989 | 1 | NTSW = 14 | |
990 | !NSW = 6 !!!!! Maintenant dans config.def (MPL 20140213) | ||
991 | 1 | NSWNL = 6 | |
992 | 1 | NSWTL = 2 | |
993 | 1 | NCSRADF= 1 | |
994 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF(NSMAX >= 106) THEN |
995 | ✗ | NRPROMA = 80 | |
996 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | ELSEIF(NSMAX == 63) THEN |
997 | ✗ | NRPROMA=48 | |
998 | ELSE | ||
999 | 1 | NRPROMA=64 | |
1000 | ENDIF | ||
1001 | |||
1002 | !* 2.3 SET SECURITY PARAMETERS | ||
1003 | ! ----------------------- | ||
1004 | |||
1005 | 1 | REPSC = 1.E-04_JPRB | |
1006 | 1 | REPSCO = 1.E-12_JPRB | |
1007 | 1 | REPSCQ = 1.E-12_JPRB | |
1008 | 1 | REPSCT = 1.E-12_JPRB | |
1009 | 1 | REPSCW = 1.E-12_JPRB | |
1010 | 1 | REPLOG = 1.E-12_JPRB | |
1011 | |||
1012 | |||
1013 | !* 2.4 BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990) | ||
1014 | ! ----------------------------------------------- | ||
1015 | |||
1016 | 1 | LECO2VAR=.FALSE. | |
1017 | 1 | LHGHG =.FALSE. | |
1018 | 1 | NHINCSOL= 0 | |
1019 | 1 | NSCEN = 1 | |
1020 | 1 | RSOLINC = RI0 | |
1021 | |||
1022 | ! Valeurs d origine MPL 18052010 | ||
1023 | !RCCO2 = 353.E-06_JPRB | ||
1024 | !RCCH4 = 1.72E-06_JPRB | ||
1025 | !RCN2O = 310.E-09_JPRB | ||
1026 | !RCCFC11 = 280.E-12_JPRB | ||
1027 | !RCCFC12 = 484.E-12_JPRB | ||
1028 | |||
1029 | ! Valeurs LMDZ (physiq.def) MPL 18052010 | ||
1030 | !RCCO2 = 348.E-06_JPRB | ||
1031 | !RCCH4 = 1.65E-06_JPRB | ||
1032 | !RCN2O = 306.E-09_JPRB | ||
1033 | !RCCFC11 = 280.E-12_JPRB | ||
1034 | !RCCFC12 = 484.E-12_JPRB | ||
1035 | |||
1036 | !MPL/IM 20160915 on prend GES de phylmd | ||
1037 | 1 | RCCO2 = CO2_ppm * 1.0e-06 | |
1038 | 1 | RCCH4 = CH4_ppb * 1.0e-09 | |
1039 | 1 | RCN2O = N2O_ppb * 1.0e-09 | |
1040 | 1 | RCCFC11 = CFC11_ppt * 1.0e-12 | |
1041 | 1 | RCCFC12 = CFC12_ppt * 1.0e-12 | |
1042 | !print *,'LMDZSUECRAD-1 RCCO2=',RCCO2 | ||
1043 | !print *,'LMDZSUECRAD-1 RCCH4=',RCCH4 | ||
1044 | !print *,'LMDZSUECRAD-1 RCN2O=',RCN2O | ||
1045 | !print *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11 | ||
1046 | !print *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12 | ||
1047 | ! ------------------------------------------------------------------ | ||
1048 | |||
1049 | !* 3. READ VALUES OF RADIATION CONFIGURATION | ||
1050 | ! -------------------------------------- | ||
1051 | |||
1052 | !CALL POSNAM(NULNAM,'NAERAD') | ||
1053 | !READ (NULNAM,NAERAD) | ||
1054 | 1 | print *,'SUECRAD-2' | |
1055 | |||
1056 | !CALL POSNAM(NULNAM,'NAEAER') | ||
1057 | !READ (NULNAM,NAEAER) | ||
1058 | |||
1059 | !IF (NTYPAER(9) /= 0) THEN | ||
1060 | ! RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB | ||
1061 | ! RGELAV=RLONVOL*RPI/180._JPRB | ||
1062 | ! RCLONV=COS(RGELAV) | ||
1063 | ! RSLONV=SIN(RGELAV) | ||
1064 | ! DO J=1,NGPTOT-1 | ||
1065 | ! IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. & | ||
1066 | ! & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN | ||
1067 | ! RDGMUV=ABS( RMU(J+1) - RMU(J)) | ||
1068 | ! RDGLAV=ABS( GELAM(J+1)-GELAM(J) ) | ||
1069 | ! RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) ) | ||
1070 | ! RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) ) | ||
1071 | ! END IF | ||
1072 | ! END DO | ||
1073 | !END IF | ||
1074 | |||
1075 | !- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration) | ||
1076 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (.NOT.LSRTM) THEN |
1077 | 1 | NMcICA = 0 | |
1078 | 1 | LCCNL = .FALSE. | |
1079 | 1 | LCCNO = .FALSE. | |
1080 | 1 | LDIFFC = .FALSE. | |
1081 | 1 | NICEOPT= 1 | |
1082 | 1 | NLIQOPT= 0 | |
1083 | 1 | NRADIP = 4 | |
1084 | 1 | NRADLP = 3 | |
1085 | 1 | RRe2De = 0.5_JPRB | |
1086 | 1 | NINHOM = 1 | |
1087 | 1 | RLWINHF= 0.7_JPRB | |
1088 | 1 | RSWINHF= 0.7_JPRB | |
1089 | ENDIF | ||
1090 | 1 | print *,'SUECRAD-3' | |
1091 | |||
1092 | !- for McICA computations, make sure these parameters are as follows ... | ||
1093 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (NMCICA /= 0) THEN |
1094 | ✗ | NINHOM = 0 | |
1095 | ✗ | RLWINHF= 1.0_JPRB | |
1096 | ✗ | RSWINHF= 1.0_JPRB | |
1097 | !-- read the XCW values for Raisanen-Cole-Barker cloud generator | ||
1098 | ✗ | CALL SU_McICA | |
1099 | ENDIF | ||
1100 | 1 | print *,'SUECRAD-4' | |
1101 | |||
1102 | |||
1103 | |||
1104 | IF( LLDEBUG )THEN | ||
1105 | 1 | WRITE(NULOUT,'("SUECRAD: NRADINT=",I2)')NRADINT | |
1106 | 1 | WRITE(NULOUT,'("SUECRAD: NRADRES=",I4)')NRADRES | |
1107 | ENDIF | ||
1108 | |||
1109 | ! DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA | ||
1110 | |||
1111 | 1 | LOPTRPROMA=NRPROMA > 0 | |
1112 | 1 | NRPROMA=ABS(NRPROMA) | |
1113 | |||
1114 |
2/4✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
|
1 | IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN |
1115 | 1 | WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")') | |
1116 | 1 | NRADINT=0 | |
1117 | ENDIF | ||
1118 | |||
1119 |
1/8✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
|
1 | IF( NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA )THEN |
1120 | ! This combination is not supported as aerosol data would be | ||
1121 | ! required to be interpolated (see radintg) | ||
1122 | WRITE(NULOUT,'("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",& | ||
1123 | ✗ | & " NRADRES RESET TO NSMAX (NO INTERPOLATION)")') | |
1124 | ✗ | NRADRES=NSMAX | |
1125 | ENDIF | ||
1126 | !CALL GSTATS(1818,1) MPL 2.12.08 | ||
1127 | |||
1128 | 100 CONTINUE | ||
1129 | |||
1130 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF( LERADI )THEN ! START OF LERADI BLOCK |
1131 | |||
1132 | ✗ | IF( NRADINT == -1 )THEN | |
1133 | |||
1134 | ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION | ||
1135 | |||
1136 | ✗ | LODBGRADI=.FALSE. | |
1137 | ✗ | CALL SUECRADI | |
1138 | |||
1139 | ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID | ||
1140 | ! LOAD BALANCING | ||
1141 | |||
1142 | ✗ | LODBGRADL=.FALSE. | |
1143 | ! CALL SUECRADL ! MPL 1.12.08 | ||
1144 | ✗ | CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE') | |
1145 | |||
1146 | ✗ | ELSEIF( NRADINT == 0 )THEN | |
1147 | |||
1148 | ✗ | IF( NRADRES /= NSMAX )THEN | |
1149 | ✗ | WRITE(NULOUT,'("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")') | |
1150 | ✗ | NRADRES=NSMAX | |
1151 | ENDIF | ||
1152 | ✗ | RADGRID%NGPTOT=NGPTOT | |
1153 | |||
1154 | ✗ | NARIB1=0 | |
1155 | ✗ | NAROB1=0 | |
1156 | |||
1157 | ✗ | ELSEIF( NRADINT >=1 .AND. NRADINT <= 3 )THEN | |
1158 | |||
1159 | ✗ | NARIB1=0 | |
1160 | ✗ | NAROB1=0 | |
1161 | |||
1162 | ! set the default radiation grid resolution for the current model resolution | ||
1163 | ! if not already specified | ||
1164 | ✗ | IF( NRADRES == 0 )THEN | |
1165 | ✗ | IF( LLINEAR_GRID )THEN ! RATIO OF GRID-POINTS (MODEL/RAD) | |
1166 | ✗ | IF( NSMAX == 63 )THEN | |
1167 | ✗ | NRADRES=21 ! 3.62 | |
1168 | ✗ | LLINEAR_GRID=.FALSE. | |
1169 | ENDIF | ||
1170 | ✗ | IF( NSMAX == 95 ) NRADRES= 95 ! 1.00 | |
1171 | ✗ | IF( NSMAX == 159 ) NRADRES= 63 ! 5.84 | |
1172 | ✗ | IF( NSMAX == 255 ) NRADRES= 95 ! 6.69 | |
1173 | ✗ | IF( NSMAX == 319 ) NRADRES= 159 ! 3.87 | |
1174 | ✗ | IF( NSMAX == 399 ) NRADRES= 159 ! 5.99 | |
1175 | ✗ | IF( NSMAX == 511 ) NRADRES= 255 ! 3.92 | |
1176 | ✗ | IF( NSMAX == 639 ) NRADRES= 319 ! 3.92 | |
1177 | ✗ | IF( NSMAX == 799 ) NRADRES= 399 ! 3.94 | |
1178 | ✗ | IF( NSMAX == 1023 ) NRADRES= 511 ! 3.94 | |
1179 | ✗ | IF( NSMAX == 1279 ) NRADRES= 639 ! | |
1180 | ✗ | IF( NSMAX == 2047 ) NRADRES= 1023 ! | |
1181 | ELSE ! NOT LINEAR GRID | ||
1182 | ✗ | IF( NSMAX == 21 ) NRADRES= 21 ! 1.00 | |
1183 | ✗ | IF( NSMAX == 42 ) NRADRES= 21 ! 3.62 | |
1184 | ✗ | IF( NSMAX == 63 ) NRADRES= 42 ! 2.17 | |
1185 | ✗ | IF( NSMAX == 106 ) NRADRES= 63 ! 2.69 | |
1186 | ✗ | IF( NSMAX == 170 ) NRADRES= 63 ! 6.69 | |
1187 | ✗ | IF( NSMAX == 213 ) NRADRES= 106 ! 3.87 | |
1188 | ✗ | IF( NSMAX == 266 ) NRADRES= 106 ! 5.99 | |
1189 | ✗ | IF( NSMAX == 341 ) NRADRES= 170 ! 3.92 | |
1190 | ✗ | IF( NSMAX == 426 ) NRADRES= 213 ! 3.92 | |
1191 | ✗ | IF( NSMAX == 533 ) NRADRES= 266 ! 3.94 | |
1192 | ✗ | IF( NSMAX == 682 ) NRADRES= 341 ! 3.94 | |
1193 | ENDIF | ||
1194 | ENDIF | ||
1195 | ✗ | print *,'SUECRAD-5' | |
1196 | |||
1197 | ! test if radiation grid resolution has been set | ||
1198 | ✗ | IF( NRADRES == 0 )THEN | |
1199 | ✗ | WRITE(NULOUT,'("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX | |
1200 | ✗ | CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND') | |
1201 | ENDIF | ||
1202 | |||
1203 | ! test if no interpolation is required | ||
1204 | ✗ | IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN | |
1205 | ✗ | WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")') | |
1206 | ✗ | NRADINT=0 | |
1207 | ✗ | GOTO 100 | |
1208 | ENDIF | ||
1209 | |||
1210 | ! CALL GSTATS(1818,0) MPL 2.12.08 | ||
1211 | ✗ | IF( CRTABLEFIL == 'not set' )THEN | |
1212 | ✗ | IF( LLINEAR_GRID )THEN | |
1213 | ✗ | IF( NRADRES < 1000 )THEN | |
1214 | ✗ | WRITE(CRTABLEFIL,'("rtablel_2",I3.3)')NRADRES | |
1215 | ELSE | ||
1216 | ✗ | WRITE(CRTABLEFIL,'("rtablel_2",I4.4)')NRADRES | |
1217 | ENDIF | ||
1218 | ELSE | ||
1219 | ✗ | IF( NRADRES < 1000 )THEN | |
1220 | ✗ | WRITE(CRTABLEFIL,'("rtable_2" ,I3.3)')NRADRES | |
1221 | ELSE | ||
1222 | ✗ | WRITE(CRTABLEFIL,'("rtable_2" ,I4.4)')NRADRES | |
1223 | ENDIF | ||
1224 | ENDIF | ||
1225 | ENDIF | ||
1226 | ! CALL GSTATS(1818,1) MPL 2.12.08 | ||
1227 | |||
1228 | ✗ | RADGRID%NSMAX=NRADRES | |
1229 | |||
1230 | ✗ | IF( MYPROC == JPIOMASTER )THEN | |
1231 | ✗ | IDIR=LEN_TRIM(CRTABLEDIR) | |
1232 | ✗ | IFIL=LEN_TRIM(CRTABLEFIL) | |
1233 | ✗ | CLFN=CRTABLEDIR(1:IDIR)//CRTABLEFIL(1:IFIL) | |
1234 | ! Ce qui concerne NULRAD commente par MPL le 15.04.09 | ||
1235 | ! OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999) | ||
1236 | ! GOTO 1000 | ||
1237 | ! 999 CONTINUE | ||
1238 | ! WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN | ||
1239 | ! CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE') | ||
1240 | ! 1000 CONTINUE | ||
1241 | ✗ | NRGRI(:)=0 | |
1242 | ! Ce qui concerne NAMRGRI commente par MPL le 15.04.09 | ||
1243 | ! CALL POSNAM(NULRAD,'NAMRGRI') | ||
1244 | ! READ (NULRAD,NAMRGRI) | ||
1245 | IDGL=1 | ||
1246 | DO WHILE( NRGRI(IDGL)>0 ) | ||
1247 | IF( LLDEBUG )THEN | ||
1248 | WRITE(NULOUT,'("SUECRAD: NRGRI(",I4,")=",I4)')IDGL,NRGRI(IDGL) | ||
1249 | ENDIF | ||
1250 | IDGL=IDGL+1 | ||
1251 | ENDDO | ||
1252 | ✗ | IDGL=IDGL-1 | |
1253 | ✗ | RADGRID%NDGLG=IDGL | |
1254 | IF( LLDEBUG )THEN | ||
1255 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG | |
1256 | ENDIF | ||
1257 | ! CLOSE(NULRAD) | ||
1258 | ENDIF | ||
1259 | ! CALL GSTATS(667,0) MPL 2.12.08 | ||
1260 | ✗ | IF( NPROC > 1 )THEN | |
1261 | ✗ | stop 'Pas pret pour proc > 1' | |
1262 | ! CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:') | ||
1263 | ENDIF | ||
1264 | ✗ | ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG)) | |
1265 | ✗ | IF( MYPROC == JPIOMASTER )THEN | |
1266 | ✗ | RADGRID%NRGRI(1:RADGRID%NDGLG)=NRGRI(1:RADGRID%NDGLG) | |
1267 | ENDIF | ||
1268 | ✗ | IF( NPROC > 1 )THEN | |
1269 | ✗ | stop 'Pas pret pour proc > 1' | |
1270 | ! CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:') | ||
1271 | ENDIF | ||
1272 | ! CALL GSTATS(667,1) MPL 2.12.08 | ||
1273 | |||
1274 | ! CALL GSTATS(1818,0) MPL 2.12.08 | ||
1275 | ✗ | IF ( NRADINT == 1 )THEN | |
1276 | ✗ | WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")') | |
1277 | ✗ | RADGRID%NDGSUR=0 | |
1278 | ✗ | NRIWIDEN=0 | |
1279 | ✗ | NRIWIDES=0 | |
1280 | ✗ | NRIWIDEW=0 | |
1281 | ✗ | NRIWIDEE=0 | |
1282 | ✗ | NROWIDEN=0 | |
1283 | ✗ | NROWIDES=0 | |
1284 | ✗ | NROWIDEW=0 | |
1285 | ✗ | NROWIDEE=0 | |
1286 | ✗ | ELSEIF( NRADINT == 2 )THEN | |
1287 | ✗ | WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 4 POINT")') | |
1288 | ✗ | RADGRID%NDGSUR=2 | |
1289 | ✗ | ELSEIF( NRADINT == 3 )THEN | |
1290 | ✗ | WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 12 POINT")') | |
1291 | ✗ | RADGRID%NDGSUR=2 | |
1292 | ENDIF | ||
1293 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSUR =",I8)')RADGRID%NDGSUR | |
1294 | |||
1295 | ✗ | RADGRID%NDGSAG=1-RADGRID%NDGSUR | |
1296 | ✗ | RADGRID%NDGENG=RADGRID%NDGLG+RADGRID%NDGSUR | |
1297 | ✗ | RADGRID%NDLON=RADGRID%NRGRI(RADGRID%NDGLG/2) | |
1298 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAG =",I8)')RADGRID%NDGSAG | |
1299 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENG =",I8)')RADGRID%NDGENG | |
1300 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG =",I8)')RADGRID%NDGLG | |
1301 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDLON =",I8)')RADGRID%NDLON | |
1302 | ✗ | CALL FLUSH(NULOUT) | |
1303 | |||
1304 | ✗ | ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG)) | |
1305 | ✗ | RADGRID%NLOENG(1:RADGRID%NDGLG)=RADGRID%NRGRI(1:RADGRID%NDGLG) | |
1306 | ✗ | IF(RADGRID%NDGSUR >= 1)THEN | |
1307 | ✗ | DO JGLSUR=1,RADGRID%NDGSUR | |
1308 | ✗ | RADGRID%NLOENG(1-JGLSUR)=RADGRID%NLOENG(JGLSUR) | |
1309 | ENDDO | ||
1310 | ✗ | DO JGLSUR=1,RADGRID%NDGSUR | |
1311 | ✗ | RADGRID%NLOENG(RADGRID%NDGLG+JGLSUR)=RADGRID%NLOENG(RADGRID%NDGLG+1-JGLSUR) | |
1312 | ENDDO | ||
1313 | ENDIF | ||
1314 | ! CALL GSTATS(1818,1) MPL 2.12.08 | ||
1315 | |||
1316 | ! Setup the transform package for the radiation grid | ||
1317 | CALL SETUP_TRANS (KSMAX=RADGRID%NSMAX, & | ||
1318 | & KDGL=RADGRID%NDGLG, & | ||
1319 | & KLOEN=RADGRID%NLOENG(1:RADGRID%NDGLG), & | ||
1320 | & LDLINEAR_GRID=LLINEAR_GRID, & | ||
1321 | & LDSPLIT=LSPLIT, & | ||
1322 | & KAPSETS=NAPSETS, & | ||
1323 | ✗ | & KRESOL=RADGRID%NRESOL_ID) | |
1324 | |||
1325 | ✗ | ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW)) | |
1326 | ✗ | ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW)) | |
1327 | ✗ | ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS)) | |
1328 | ✗ | ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS)) | |
1329 | ✗ | ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS)) | |
1330 | ✗ | ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG)) | |
1331 | ✗ | ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG)) | |
1332 | ✗ | ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG)) | |
1333 | |||
1334 | ! Interrogate the transform package for the radiation grid | ||
1335 | ! CALL GSTATS(1818,0) MPL 2.12.08 | ||
1336 | CALL TRANS_INQ (KRESOL =RADGRID%NRESOL_ID, & | ||
1337 | & KSPEC2 =RADGRID%NSPEC2, & | ||
1338 | & KNUMP =RADGRID%NUMP, & | ||
1339 | & KGPTOT =RADGRID%NGPTOT, & | ||
1340 | & KGPTOTG =RADGRID%NGPTOTG, & | ||
1341 | & KGPTOTMX =RADGRID%NGPTOTMX, & | ||
1342 | & KPTRFRSTLAT=RADGRID%NPTRFRSTLAT, & | ||
1343 | & KFRSTLAT =RADGRID%NFRSTLAT, & | ||
1344 | & KLSTLAT =RADGRID%NLSTLAT, & | ||
1345 | & KFRSTLOFF =RADGRID%NFRSTLOFF, & | ||
1346 | & KSTA =RADGRID%NSTA(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), & | ||
1347 | & KONL =RADGRID%NONL(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), & | ||
1348 | & KPTRFLOFF =RADGRID%NPTRFLOFF, & | ||
1349 | ✗ | & PMU =RADGRID%RMU(1:) ) | |
1350 | |||
1351 | ✗ | IF( NRADINT == 2 .OR. NRADINT == 3 )THEN | |
1352 | ✗ | DO JGL=1,RADGRID%NDGLG | |
1353 | ✗ | RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL)*RADGRID%RMU(JGL)) | |
1354 | ✗ | RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL)) | |
1355 | ! WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')& | ||
1356 | ! & JGL,RADGRID%RLATIG(JGL) | ||
1357 | ENDDO | ||
1358 | ✗ | IF(RADGRID%NDGSUR >= 1)THEN | |
1359 | ✗ | DO JGLSUR=1,RADGRID%NDGSUR | |
1360 | ✗ | RADGRID%RMU(1-JGLSUR)=RADGRID%RMU(JGLSUR) | |
1361 | ✗ | RADGRID%RSQM2(1-JGLSUR)=RADGRID%RSQM2(JGLSUR) | |
1362 | ✗ | RADGRID%RLATIG(1-JGLSUR)=RPI-RADGRID%RLATIG(JGLSUR) | |
1363 | ENDDO | ||
1364 | ✗ | DO JGLSUR=1,RADGRID%NDGSUR | |
1365 | ✗ | RADGRID%RMU(RADGRID%NDGLG+JGLSUR)=RADGRID%RMU(RADGRID%NDGLG+1-JGLSUR) | |
1366 | ✗ | RADGRID%RSQM2(RADGRID%NDGLG+JGLSUR)=RADGRID%RSQM2(RADGRID%NDGLG+1-JGLSUR) | |
1367 | ✗ | RADGRID%RLATIG(RADGRID%NDGLG+JGLSUR)=-RPI-RADGRID%RLATIG(RADGRID%NDGLG+1-JGLSUR) | |
1368 | ENDDO | ||
1369 | ENDIF | ||
1370 | ENDIF | ||
1371 | |||
1372 | ✗ | RADGRID%NDGSAL=1 | |
1373 | ✗ | RADGRID%NDGENL=RADGRID%NLSTLAT(MY_REGION_NS)-RADGRID%NFRSTLOFF | |
1374 | ✗ | RADGRID%NDSUR1=3-MOD(RADGRID%NDLON,2) | |
1375 | ✗ | IDLSUR=MAX(RADGRID%NDLON,2*RADGRID%NSMAX+1) | |
1376 | ✗ | RADGRID%NDLSUR=IDLSUR+RADGRID%NDSUR1 | |
1377 | ✗ | RADGRID%MYFRSTACTLAT=RADGRID%NFRSTLAT(MY_REGION_NS) | |
1378 | ✗ | RADGRID%MYLSTACTLAT=RADGRID%NLSTLAT(MY_REGION_NS) | |
1379 | |||
1380 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NRESOL_ID =",I8)')RADGRID%NRESOL_ID | |
1381 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NSMAX =",I8)')RADGRID%NSMAX | |
1382 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NSPEC2 =",I8)')RADGRID%NSPEC2 | |
1383 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOT =",I8)')RADGRID%NGPTOT | |
1384 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOTG =",I8)')RADGRID%NGPTOTG | |
1385 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAL =",I8)')RADGRID%NDGSAL | |
1386 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENL =",I8)')RADGRID%NDGENL | |
1387 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDSUR1 =",I8)')RADGRID%NDSUR1 | |
1388 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDLSUR =",I8)')RADGRID%NDLSUR | |
1389 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT | |
1390 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%MYLSTACTLAT =",I8)')RADGRID%MYLSTACTLAT | |
1391 | ✗ | CALL FLUSH(NULOUT) | |
1392 | |||
1393 | ✗ | ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2)) | |
1394 | ✗ | ALLOCATE(RADGRID%MYMS(RADGRID%NUMP)) | |
1395 | CALL TRANS_INQ (KRESOL =RADGRID%NRESOL_ID, & | ||
1396 | & KASM0 =RADGRID%NASM0, & | ||
1397 | ✗ | & KMYMS =RADGRID%MYMS ) | |
1398 | |||
1399 | ✗ | ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT)) | |
1400 | ✗ | ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT)) | |
1401 | ✗ | ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT)) | |
1402 | ✗ | ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT)) | |
1403 | ✗ | ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT)) | |
1404 | |||
1405 | IOFF=0 | ||
1406 | ✗ | ILAT=RADGRID%NPTRFLOFF | |
1407 | ✗ | DO JGLAT=RADGRID%NFRSTLAT(MY_REGION_NS), & | |
1408 | ✗ | & RADGRID%NLSTLAT(MY_REGION_NS) | |
1409 | ✗ | ZGEMU=RADGRID%RMU(JGLAT) | |
1410 | ✗ | ILAT=ILAT+1 | |
1411 | ✗ | ISTLON = RADGRID%NSTA(ILAT,MY_REGION_EW) | |
1412 | ✗ | IENDLON = ISTLON-1 + RADGRID%NONL(ILAT,MY_REGION_EW) | |
1413 | |||
1414 | ✗ | DO JLON=ISTLON,IENDLON | |
1415 | ZLON= REAL(JLON-1,JPRB)*2.0_JPRB*RPI & | ||
1416 | ✗ | & /REAL(RADGRID%NLOENG(JGLAT),JPRB) | |
1417 | ✗ | IOFF=IOFF+1 | |
1418 | ✗ | RADGRID%GELAM(IOFF) = ZLON | |
1419 | ✗ | RADGRID%GELAT(IOFF) = ASIN(ZGEMU) | |
1420 | ✗ | RADGRID%GESLO(IOFF) = SIN(ZLON) | |
1421 | ✗ | RADGRID%GECLO(IOFF) = COS(ZLON) | |
1422 | ✗ | RADGRID%GEMU (IOFF) = ZGEMU | |
1423 | ENDDO | ||
1424 | ENDDO | ||
1425 | |||
1426 | ✗ | IF( NRADINT == 2 .OR. NRADINT == 3 )THEN | |
1427 | |||
1428 | ! For grid point interpolations we need to calculate the halo size | ||
1429 | ! required by each processor | ||
1430 | |||
1431 | ✗ | ALLOCATE(ZLATX(RADGRID%NGPTOTMX)) | |
1432 | ✗ | ALLOCATE(ZLONX(RADGRID%NGPTOTMX)) | |
1433 | ✗ | DO J=1,RADGRID%NGPTOT | |
1434 | ✗ | ZLATX(J)=RADGRID%GELAT(J)/RPI*2.0_JPRB*90.0 | |
1435 | ✗ | ZLONX(J)=(RADGRID%GELAM(J)-RPI)/RPI*180.0 | |
1436 | ENDDO | ||
1437 | ✗ | ZMINRADLAT=MINVAL(ZLATX(1:RADGRID%NGPTOT)) | |
1438 | ✗ | ZMAXRADLAT=MAXVAL(ZLATX(1:RADGRID%NGPTOT)) | |
1439 | ✗ | ZMINRADLON=MINVAL(ZLONX(1:RADGRID%NGPTOT)) | |
1440 | ✗ | ZMAXRADLON=MAXVAL(ZLONX(1:RADGRID%NGPTOT)) | |
1441 | IF( LLDEBUG )THEN | ||
1442 | ✗ | WRITE(NULOUT,'("RADGRID,BEGIN")') | |
1443 | ✗ | IF( MYPROC /= 1 )THEN | |
1444 | ✗ | stop 'Pas pret pour proc > 1' | |
1445 | ! CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R') | ||
1446 | ! CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R') | ||
1447 | ! CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R') | ||
1448 | ENDIF | ||
1449 | IF( MYPROC == 1 )THEN | ||
1450 | ✗ | DO JROC=1,NPROC | |
1451 | ✗ | IF( JROC == MYPROC )THEN | |
1452 | ✗ | DO J=1,RADGRID%NGPTOT | |
1453 | ✗ | WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),MYPROC | |
1454 | ENDDO | ||
1455 | ELSE | ||
1456 | ✗ | stop 'Pas pret pour proc > 1' | |
1457 | ! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M') | ||
1458 | ! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M') | ||
1459 | ! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M') | ||
1460 | DO J=1,IGPTOT | ||
1461 | WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),JROC | ||
1462 | ENDDO | ||
1463 | ENDIF | ||
1464 | ENDDO | ||
1465 | ENDIF | ||
1466 | ✗ | WRITE(NULOUT,'("RADGRID,END")') | |
1467 | ENDIF | ||
1468 | ✗ | DEALLOCATE(ZLATX) | |
1469 | ✗ | DEALLOCATE(ZLONX) | |
1470 | |||
1471 | ✗ | ALLOCATE(ZLATX(NGPTOTMX)) | |
1472 | ✗ | ALLOCATE(ZLONX(NGPTOTMX)) | |
1473 | ✗ | DO J=1,NGPTOT | |
1474 | ✗ | ZLATX(J)=GELAT(J)/RPI*2.0_JPRB*90.0 | |
1475 | ✗ | ZLONX(J)=(GELAM(J)-RPI)/RPI*180.0 | |
1476 | ENDDO | ||
1477 | ✗ | ZMINMDLLAT=MINVAL(ZLATX(1:NGPTOT)) | |
1478 | ✗ | ZMAXMDLLAT=MAXVAL(ZLATX(1:NGPTOT)) | |
1479 | ✗ | ZMINMDLLON=MINVAL(ZLONX(1:NGPTOT)) | |
1480 | ✗ | ZMAXMDLLON=MAXVAL(ZLONX(1:NGPTOT)) | |
1481 | IF( LLDEBUG )THEN | ||
1482 | ✗ | WRITE(NULOUT,'("MODELGRID,BEGIN")') | |
1483 | ✗ | IF( MYPROC /= 1 )THEN | |
1484 | ✗ | stop 'Pas pret pour proc > 1' | |
1485 | ! CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD') | ||
1486 | ! CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD') | ||
1487 | ! CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD') | ||
1488 | ! CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD') | ||
1489 | ENDIF | ||
1490 | IF( MYPROC == 1 )THEN | ||
1491 | ✗ | DO JROC=1,NPROC | |
1492 | ✗ | IF( JROC == MYPROC )THEN | |
1493 | ✗ | DO J=1,NGPTOT | |
1494 | ✗ | WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),MYPROC,NGLOBALINDEX(J) | |
1495 | ENDDO | ||
1496 | ELSE | ||
1497 | ✗ | stop 'Pas pret pour proc > 1' | |
1498 | ! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD') | ||
1499 | ! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD') | ||
1500 | ! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD') | ||
1501 | ALLOCATE(IGLOBALINDEX(1:IGPTOT)) | ||
1502 | ! CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD') | ||
1503 | DO J=1,IGPTOT | ||
1504 | WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),JROC,IGLOBALINDEX(J) | ||
1505 | ENDDO | ||
1506 | DEALLOCATE(IGLOBALINDEX) | ||
1507 | ENDIF | ||
1508 | ENDDO | ||
1509 | ENDIF | ||
1510 | ✗ | WRITE(NULOUT,'("MODELGRID,END")') | |
1511 | ENDIF | ||
1512 | ✗ | DEALLOCATE(ZLATX) | |
1513 | ✗ | DEALLOCATE(ZLONX) | |
1514 | |||
1515 | IF( LLDEBUG )THEN | ||
1516 | ✗ | WRITE(NULOUT,'("ZMINRADLAT=",F10.2)')ZMINRADLAT | |
1517 | ✗ | WRITE(NULOUT,'("ZMINMDLLAT=",F10.2)')ZMINMDLLAT | |
1518 | ✗ | WRITE(NULOUT,'("ZMAXRADLAT=",F10.2)')ZMAXRADLAT | |
1519 | ✗ | WRITE(NULOUT,'("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT | |
1520 | ✗ | WRITE(NULOUT,'("ZMINRADLON=",F10.2)')ZMINRADLON | |
1521 | ✗ | WRITE(NULOUT,'("ZMINMDLLON=",F10.2)')ZMINMDLLON | |
1522 | ✗ | WRITE(NULOUT,'("ZMAXRADLON=",F10.2)')ZMAXRADLON | |
1523 | ✗ | WRITE(NULOUT,'("ZMAXMDLLON=",F10.2)')ZMAXMDLLON | |
1524 | ENDIF | ||
1525 | |||
1526 | ✗ | ZLAT=NDGLG/180. | |
1527 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) | |
1528 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) | |
1529 | ✗ | IF( ZMINRADLAT < ZMINMDLLAT )THEN | |
1530 | ✗ | NRIWIDES=JP_MIN_HALO+ILATS_DIFF_C | |
1531 | ELSE | ||
1532 | ✗ | NRIWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1533 | ENDIF | ||
1534 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) | |
1535 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) | |
1536 | ✗ | IF( ZMAXRADLAT < ZMAXMDLLAT )THEN | |
1537 | ✗ | NRIWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1538 | ELSE | ||
1539 | ✗ | NRIWIDEN=JP_MIN_HALO+ILATS_DIFF_C | |
1540 | ENDIF | ||
1541 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) | |
1542 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) | |
1543 | ✗ | IF( ZMINRADLON < ZMINMDLLON )THEN | |
1544 | ✗ | NRIWIDEW=JP_MIN_HALO+ILATS_DIFF_C | |
1545 | ELSE | ||
1546 | ✗ | NRIWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1547 | ENDIF | ||
1548 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) | |
1549 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) | |
1550 | ✗ | IF( ZMAXRADLON < ZMAXMDLLON )THEN | |
1551 | ✗ | NRIWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1552 | ELSE | ||
1553 | ✗ | NRIWIDEE=JP_MIN_HALO+ILATS_DIFF_C | |
1554 | ENDIF | ||
1555 | |||
1556 | ✗ | ZLAT=RADGRID%NDGLG/180. | |
1557 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) | |
1558 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT) | |
1559 | ✗ | IF( ZMINMDLLAT < ZMINRADLAT )THEN | |
1560 | ✗ | NROWIDES=JP_MIN_HALO+ILATS_DIFF_C | |
1561 | ELSE | ||
1562 | ✗ | NROWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1563 | ENDIF | ||
1564 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) | |
1565 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT) | |
1566 | ✗ | IF( ZMAXMDLLAT < ZMAXRADLAT )THEN | |
1567 | ✗ | NROWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1568 | ELSE | ||
1569 | ✗ | NROWIDEN=JP_MIN_HALO+ILATS_DIFF_C | |
1570 | ENDIF | ||
1571 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) | |
1572 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT) | |
1573 | ✗ | IF( ZMINMDLLON < ZMINRADLON )THEN | |
1574 | ✗ | NROWIDEW=JP_MIN_HALO+ILATS_DIFF_C | |
1575 | ELSE | ||
1576 | ✗ | NROWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1577 | ENDIF | ||
1578 | ✗ | ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) | |
1579 | ✗ | ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT) | |
1580 | ✗ | IF( ZMAXMDLLON < ZMAXRADLON )THEN | |
1581 | ✗ | NROWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F) | |
1582 | ELSE | ||
1583 | ✗ | NROWIDEE=JP_MIN_HALO+ILATS_DIFF_C | |
1584 | ENDIF | ||
1585 | |||
1586 | ENDIF | ||
1587 | |||
1588 | RADGRID%NDGSAH=MAX(RADGRID%NDGSAG,& | ||
1589 | ✗ | & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF | |
1590 | RADGRID%NDGENH=MIN(RADGRID%NDGENG,& | ||
1591 | ✗ | & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF | |
1592 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAH =",I8)')RADGRID%NDGSAH | |
1593 | ✗ | WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENH =",I8)')RADGRID%NDGENH | |
1594 | |||
1595 | ✗ | IF( NRADINT == 2 .OR. NRADINT == 3 )THEN | |
1596 | |||
1597 | ILBRLATI = MAX(RADGRID%NDGSAG,& | ||
1598 | ✗ | & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF | |
1599 | IUBRLATI = MIN(RADGRID%NDGENG,& | ||
1600 | ✗ | & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF | |
1601 | ✗ | ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI)) | |
1602 | ✗ | ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI)) | |
1603 | ✗ | ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI)) | |
1604 | ✗ | ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI)) | |
1605 | |||
1606 | ✗ | DO JGL= ILBRLATI,IUBRLATI | |
1607 | ✗ | IGLGLO=JGL+RADGRID%NFRSTLOFF | |
1608 | ✗ | IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN | |
1609 | ✗ | ZD1=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO) | |
1610 | ✗ | ZD2=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+1) | |
1611 | ✗ | ZD3=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+2) | |
1612 | ✗ | ZD4=RADGRID%RLATIG(IGLGLO )-RADGRID%RLATIG(IGLGLO+1) | |
1613 | ✗ | ZD5=RADGRID%RLATIG(IGLGLO )-RADGRID%RLATIG(IGLGLO+2) | |
1614 | ✗ | ZD6=RADGRID%RLATIG(IGLGLO+1)-RADGRID%RLATIG(IGLGLO+2) | |
1615 | ✗ | RADGRID%RIPI0(JGL)=-1.0_JPRB/(ZD1*ZD4*ZD5) | |
1616 | ✗ | RADGRID%RIPI1(JGL)= 1.0_JPRB/(ZD2*ZD4*ZD6) | |
1617 | ✗ | RADGRID%RIPI2(JGL)=-1.0_JPRB/(ZD3*ZD5*ZD6) | |
1618 | ENDIF | ||
1619 | ✗ | RADGRID%RLATI(JGL)=RADGRID%RLATIG(IGLGLO) | |
1620 | ENDDO | ||
1621 | |||
1622 | ✗ | IF( NPROC > 1 )THEN | |
1623 | ✗ | IRIRPTSUR=NGPTOTG | |
1624 | ✗ | IRISPTSUR=2*NGPTOTG | |
1625 | ELSE | ||
1626 | IRIRPTSUR=0 | ||
1627 | IRISPTSUR=0 | ||
1628 | ENDIF | ||
1629 | |||
1630 | ✗ | ALLOCATE(NRISTA(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES)) | |
1631 | ✗ | ALLOCATE(NRIONL(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES)) | |
1632 | ✗ | ALLOCATE(NRIOFF(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES)) | |
1633 | ✗ | ALLOCATE(NRIEXT(1-NDLON:NDLON+NDLON,1-NRIWIDEN:NDGENL+NRIWIDES)) | |
1634 | ✗ | ALLOCATE(NRICORE(NGPTOT)) | |
1635 | ✗ | ALLOCATE(IRISENDPOS(IRISPTSUR)) | |
1636 | ✗ | ALLOCATE(IRIRECVPOS(IRIRPTSUR)) | |
1637 | ✗ | ALLOCATE(IRISENDPTR(NPROC+1)) | |
1638 | ✗ | ALLOCATE(IRIRECVPTR(NPROC+1)) | |
1639 | ✗ | ALLOCATE(IRICOMM(NPROC)) | |
1640 | ✗ | ALLOCATE(IRIMAP(4,NDGLG)) | |
1641 | ! MPL 1.12.08 | ||
1642 | ! CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,& | ||
1643 | ! & IRIRPTSUR,IRISPTSUR,& | ||
1644 | ! & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,& | ||
1645 | ! & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,& | ||
1646 | ! & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,& | ||
1647 | ! & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,& | ||
1648 | ! & RMU,RSQM2,& | ||
1649 | ! & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,& | ||
1650 | ! & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,& | ||
1651 | ! & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN) | ||
1652 | ✗ | CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE') | |
1653 | ✗ | WRITE(NULOUT,'("SUECRAD: NARIB1=",I12)')NARIB1 | |
1654 | ✗ | ALLOCATE(NRISENDPOS(NRISPT)) | |
1655 | ✗ | ALLOCATE(NRIRECVPOS(NRIRPT)) | |
1656 | ✗ | ALLOCATE(NRISENDPTR(NRIPROCS+1)) | |
1657 | ✗ | ALLOCATE(NRIRECVPTR(NRIPROCS+1)) | |
1658 | ✗ | ALLOCATE(NRICOMM(NRIPROCS)) | |
1659 | ✗ | NRISENDPOS(1:NRISPT)=IRISENDPOS(1:NRISPT) | |
1660 | ✗ | NRIRECVPOS(1:NRIRPT)=IRIRECVPOS(1:NRIRPT) | |
1661 | ✗ | NRISENDPTR(1:NRIPROCS+1)=IRISENDPTR(1:NRIPROCS+1) | |
1662 | ✗ | NRIRECVPTR(1:NRIPROCS+1)=IRIRECVPTR(1:NRIPROCS+1) | |
1663 | ✗ | NRICOMM(1:NRIPROCS)=IRICOMM(1:NRIPROCS) | |
1664 | ✗ | DEALLOCATE(IRISENDPOS) | |
1665 | ✗ | DEALLOCATE(IRIRECVPOS) | |
1666 | ✗ | DEALLOCATE(IRISENDPTR) | |
1667 | ✗ | DEALLOCATE(IRIRECVPTR) | |
1668 | ✗ | DEALLOCATE(IRICOMM) | |
1669 | ✗ | DEALLOCATE(IRIMAP) | |
1670 | |||
1671 | ✗ | IF( NPROC > 1 )THEN | |
1672 | ✗ | IRORPTSUR=RADGRID%NGPTOTG | |
1673 | ✗ | IROSPTSUR=2*RADGRID%NGPTOTG | |
1674 | ELSE | ||
1675 | IRORPTSUR=0 | ||
1676 | IROSPTSUR=0 | ||
1677 | ENDIF | ||
1678 | |||
1679 | ✗ | ALLOCATE(NROSTA(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES)) | |
1680 | ✗ | ALLOCATE(NROONL(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES)) | |
1681 | ✗ | ALLOCATE(NROOFF(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES)) | |
1682 | ✗ | ALLOCATE(NROEXT(1-RADGRID%NDLON:RADGRID%NDLON+RADGRID%NDLON,& | |
1683 | ✗ | & 1-NROWIDEN:RADGRID%NDGENL+NROWIDES)) | |
1684 | ✗ | ALLOCATE(NROCORE(RADGRID%NGPTOT)) | |
1685 | ✗ | ALLOCATE(IROSENDPOS(IROSPTSUR)) | |
1686 | ✗ | ALLOCATE(IRORECVPOS(IRORPTSUR)) | |
1687 | ✗ | ALLOCATE(IROSENDPTR(NPROC+1)) | |
1688 | ✗ | ALLOCATE(IRORECVPTR(NPROC+1)) | |
1689 | ✗ | ALLOCATE(IROCOMM(NPROC)) | |
1690 | ✗ | ALLOCATE(IROMAP(4,RADGRID%NDGLG)) | |
1691 | ! MPL 1.12.08 | ||
1692 | ! CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,& | ||
1693 | ! & IRORPTSUR,IROSPTSUR,& | ||
1694 | ! & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,& | ||
1695 | ! & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,& | ||
1696 | ! & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,& | ||
1697 | ! & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,& | ||
1698 | ! & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,& | ||
1699 | ! & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,& | ||
1700 | ! & RADGRID%RMU,RADGRID%RSQM2,& | ||
1701 | ! & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,& | ||
1702 | ! & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,& | ||
1703 | ! & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN) | ||
1704 | ✗ | CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE') | |
1705 | ✗ | WRITE(NULOUT,'("SUECRAD: NAROB1=",I12)')NAROB1 | |
1706 | ✗ | ALLOCATE(NROSENDPOS(NROSPT)) | |
1707 | ✗ | ALLOCATE(NRORECVPOS(NRORPT)) | |
1708 | ✗ | ALLOCATE(NROSENDPTR(NROPROCS+1)) | |
1709 | ✗ | ALLOCATE(NRORECVPTR(NROPROCS+1)) | |
1710 | ✗ | ALLOCATE(NROCOMM(NROPROCS)) | |
1711 | ✗ | NROSENDPOS(1:NROSPT)=IROSENDPOS(1:NROSPT) | |
1712 | ✗ | NRORECVPOS(1:NRORPT)=IRORECVPOS(1:NRORPT) | |
1713 | ✗ | NROSENDPTR(1:NROPROCS+1)=IROSENDPTR(1:NROPROCS+1) | |
1714 | ✗ | NRORECVPTR(1:NROPROCS+1)=IRORECVPTR(1:NROPROCS+1) | |
1715 | ✗ | NROCOMM(1:NROPROCS)=IROCOMM(1:NROPROCS) | |
1716 | ✗ | DEALLOCATE(IROSENDPOS) | |
1717 | ✗ | DEALLOCATE(IRORECVPOS) | |
1718 | ✗ | DEALLOCATE(IROSENDPTR) | |
1719 | ✗ | DEALLOCATE(IRORECVPTR) | |
1720 | ✗ | DEALLOCATE(IROCOMM) | |
1721 | ✗ | DEALLOCATE(IROMAP) | |
1722 | |||
1723 | IF( LLDEBUG )THEN | ||
1724 | ✗ | WRITE(NULOUT,'("")') | |
1725 | ✗ | IRIWIDEMAXN=0 | |
1726 | ✗ | IRIWIDEMAXS=0 | |
1727 | ✗ | IRIWIDEMAXW=0 | |
1728 | ✗ | IRIWIDEMAXE=0 | |
1729 | ✗ | IROWIDEMAXN=0 | |
1730 | ✗ | IROWIDEMAXS=0 | |
1731 | ✗ | IROWIDEMAXW=0 | |
1732 | ✗ | IROWIDEMAXE=0 | |
1733 | ✗ | IARIB1MAX=0 | |
1734 | ✗ | IAROB1MAX=0 | |
1735 | ✗ | IWIDE(1)=NRIWIDEN | |
1736 | ✗ | IWIDE(2)=NRIWIDES | |
1737 | ✗ | IWIDE(3)=NRIWIDEW | |
1738 | ✗ | IWIDE(4)=NRIWIDEE | |
1739 | ✗ | IWIDE(5)=NROWIDEN | |
1740 | ✗ | IWIDE(6)=NROWIDES | |
1741 | ✗ | IWIDE(7)=NROWIDEW | |
1742 | ✗ | IWIDE(8)=NROWIDEE | |
1743 | ✗ | IWIDE(9)=NARIB1 | |
1744 | ✗ | IWIDE(10)=NAROB1 | |
1745 | ✗ | IF( MYPROC /= 1 )THEN | |
1746 | ✗ | stop 'Pas pret pour proc > 1' | |
1747 | ! CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W') | ||
1748 | ENDIF | ||
1749 | IF( MYPROC == 1 )THEN | ||
1750 | ✗ | DO JROC=1,NPROC | |
1751 | ✗ | IF( JROC /= MYPROC )THEN | |
1752 | ✗ | stop 'Pas pret pour proc > 1' | |
1753 | ! CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W') | ||
1754 | ENDIF | ||
1755 | WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')& | ||
1756 | ✗ | & JROC,IWIDE(1),IWIDE(5) | |
1757 | WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')& | ||
1758 | ✗ | & JROC,IWIDE(2),IWIDE(6) | |
1759 | WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')& | ||
1760 | ✗ | & JROC,IWIDE(3),IWIDE(7) | |
1761 | WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')& | ||
1762 | ✗ | & JROC,IWIDE(4),IWIDE(8) | |
1763 | WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')& | ||
1764 | ✗ | & JROC,IWIDE(9),IWIDE(10) | |
1765 | ✗ | WRITE(NULOUT,'("")') | |
1766 | ✗ | IF( IWIDE(1) > IRIWIDEMAXN ) IRIWIDEMAXN=IWIDE(1) | |
1767 | ✗ | IF( IWIDE(2) > IRIWIDEMAXS ) IRIWIDEMAXS=IWIDE(2) | |
1768 | ✗ | IF( IWIDE(3) > IRIWIDEMAXW ) IRIWIDEMAXW=IWIDE(3) | |
1769 | ✗ | IF( IWIDE(4) > IRIWIDEMAXE ) IRIWIDEMAXE=IWIDE(4) | |
1770 | ✗ | IF( IWIDE(5) > IROWIDEMAXN ) IROWIDEMAXN=IWIDE(5) | |
1771 | ✗ | IF( IWIDE(6) > IROWIDEMAXS ) IROWIDEMAXS=IWIDE(6) | |
1772 | ✗ | IF( IWIDE(7) > IROWIDEMAXW ) IROWIDEMAXW=IWIDE(7) | |
1773 | ✗ | IF( IWIDE(8) > IROWIDEMAXE ) IROWIDEMAXE=IWIDE(8) | |
1774 | ✗ | IF( IWIDE(9) > IARIB1MAX ) IARIB1MAX =IWIDE(9) | |
1775 | ✗ | IF( IWIDE(10) > IAROB1MAX ) IAROB1MAX =IWIDE(10) | |
1776 | ENDDO | ||
1777 | ✗ | WRITE(NULOUT,'("")') | |
1778 | ✗ | WRITE(NULOUT,'("SUECRAD: NRIWIDEN(MAX) =",I8)')IRIWIDEMAXN | |
1779 | ✗ | WRITE(NULOUT,'("SUECRAD: NRIWIDES(MAX) =",I8)')IRIWIDEMAXS | |
1780 | ✗ | WRITE(NULOUT,'("SUECRAD: NRIWIDEW(MAX) =",I8)')IRIWIDEMAXW | |
1781 | ✗ | WRITE(NULOUT,'("SUECRAD: NRIWIDEE(MAX) =",I8)')IRIWIDEMAXE | |
1782 | ✗ | WRITE(NULOUT,'("SUECRAD: NROWIDEN(MAX) =",I8)')IROWIDEMAXN | |
1783 | ✗ | WRITE(NULOUT,'("SUECRAD: NROWIDES(MAX) =",I8)')IROWIDEMAXS | |
1784 | ✗ | WRITE(NULOUT,'("SUECRAD: NROWIDEW(MAX) =",I8)')IROWIDEMAXW | |
1785 | ✗ | WRITE(NULOUT,'("SUECRAD: NROWIDEE(MAX) =",I8)')IROWIDEMAXE | |
1786 | ✗ | WRITE(NULOUT,'("SUECRAD: NARIB1(MAX) =",I10)')IARIB1MAX | |
1787 | ✗ | WRITE(NULOUT,'("SUECRAD: NAROB1(MAX) =",I10)')IAROB1MAX | |
1788 | ✗ | WRITE(NULOUT,'("")') | |
1789 | ENDIF | ||
1790 | ✗ | CALL FLUSH(NULOUT) | |
1791 | ENDIF | ||
1792 | |||
1793 | ENDIF | ||
1794 | ! CALL GSTATS(1818,1) MPL 2.12.08 | ||
1795 | |||
1796 | ELSE | ||
1797 | |||
1798 | ✗ | WRITE(NULOUT,'("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT | |
1799 | ✗ | CALL ABOR1('SUECRAD: NRADINT INVALID') | |
1800 | |||
1801 | ENDIF | ||
1802 | |||
1803 | ENDIF ! END OF LERADI BLOCK | ||
1804 | |||
1805 | ! ---------------------------------------------------------------- | ||
1806 | |||
1807 | !* 4. INITIALIZE RADIATION COEFFICIENTS. | ||
1808 | ! ---------------------------------- | ||
1809 | |||
1810 | 1 | RCDAY = RDAY * RG / RCPD | |
1811 | 1 | DIFF = 1.66_JPRB | |
1812 | 1 | R10E = 0.4342945_JPRB | |
1813 | |||
1814 | ! CALL GSTATS(1818,0) MPL 2.12.08 | ||
1815 | 1 | CALL SURDI | |
1816 | |||
1817 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (NINHOM == 0) THEN |
1818 | ✗ | RLWINHF=1._JPRB | |
1819 | ✗ | RSWINHF=1._JPRB | |
1820 | ENDIF | ||
1821 | |||
1822 | ! ---------------------------------------------------------------- | ||
1823 | |||
1824 | !* 5. INITIALIZE RADIATION ABSORPTION COEFFICIENTS | ||
1825 | ! -------------------------------------------- | ||
1826 | |||
1827 | !* 5.1. Initialization routine for RRTM | ||
1828 | ! ------------------------------- | ||
1829 | |||
1830 | 1 | CALL SURRTAB | |
1831 | 1 | CALL SURRTPK | |
1832 | 1 | CALL SURRTRF | |
1833 | 1 | CALL SURRTFTR | |
1834 | |||
1835 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LRRTM) THEN |
1836 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (KLEV > JPLAY) THEN |
1837 | WRITE(UNIT=KULOUT,& | ||
1838 | & FMT='('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',& | ||
1839 | ✗ | & '' CALL ABORT'')') | |
1840 | ✗ | CALL ABOR1(' ABOR1 CALLED SUECRAD') | |
1841 | ENDIF | ||
1842 | |||
1843 | ! Read the absorption coefficient data and reduce from 256 to 140 g-points | ||
1844 | |||
1845 | 1 | CALL RRTM_INIT_140GP | |
1846 | |||
1847 | 1 | INBLW=16 | |
1848 | |||
1849 | ELSE | ||
1850 | ✗ | INBLW=6 | |
1851 | |||
1852 | ENDIF | ||
1853 | |||
1854 | 1 | CALL SULWN | |
1855 | 1 | CALL SUSWN (NTSW, NSW) | |
1856 | 1 | CALL SUCLOPN (NTSW, NSW, KLEV) | |
1857 | |||
1858 | !-- routines specific to SRTM | ||
1859 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (LSRTM) THEN |
1860 | ✗ | NTSW=14 | |
1861 | ✗ | ISW =14 | |
1862 | ✗ | CALL SRTM_INIT | |
1863 | ✗ | CALL SUSRTAER | |
1864 | ✗ | CALL SUSRTCOP | |
1865 | ✗ | WRITE(UNIT=KULOUT,FMT='(''SRTM Configuration'',L8,3I4)')LSRTM,NTSW,ISW,JPGPT | |
1866 | |||
1867 | ELSE | ||
1868 |
3/6✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
|
1 | IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6)) ) THEN |
1869 | ✗ | WRITE(UNIT=KULOUT,FMT='(''Wrong SW Configuration'',L8,I3)')LONEWSW,NSW | |
1870 | ENDIF | ||
1871 | |||
1872 | 1 | CALL SUSWN (NTSW,NSW) | |
1873 | 1 | CALL SUAERSN (NTSW,NSW) | |
1874 | ENDIF | ||
1875 | 1 | WRITE(UNIT=KULOUT,FMT='('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW,NTSW,NSW | |
1876 | |||
1877 | |||
1878 | !-- routine specific to the UV processor | ||
1879 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (LUVPROC) THEN |
1880 | ✗ | NUVTIM = NUVTIM * 86400 | |
1881 | ✗ | CALL SU_UVRAD ( NUV ) | |
1882 | ENDIF | ||
1883 | |||
1884 | ! ---------------------------------------------------------------- | ||
1885 | |||
1886 | !* 6. INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION | ||
1887 | ! ------------------------------------------------------ | ||
1888 | |||
1889 | !- LW optical properties | ||
1890 | 1 | CALL SUAERL | |
1891 | !- SW optical properties moved above | ||
1892 | !CALL SUAERSN (NTSW,NSW) | ||
1893 | |||
1894 | !- horizontal distribution | ||
1895 | 1 | CALL SUAERH | |
1896 | |||
1897 | !- vertical distribution | ||
1898 | CALL SUAERV ( KLEV , PETAH,& | ||
1899 | & CVDAES , CVDAEL , CVDAEU , CVDAED,& | ||
1900 | & RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU,& | ||
1901 | & RCAEOPD, RCTRPT , RCAEADK, RCAEADM, RCAEROS & | ||
1902 | 1 | & ) | |
1903 | |||
1904 | !-- Overlap function (only used if NOVLP=4) | ||
1905 | ! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise | ||
1906 | ! sinon il faudrait calculer le geopotentiel STZ | ||
1907 | !CALL SUOVLP ( KLEV ) | ||
1908 | |||
1909 | !-- parameters for prognostic aerosols | ||
1910 | 1 | CALL SU_AERW | |
1911 | |||
1912 | ! ---------------------------------------------------------------- | ||
1913 | |||
1914 | !* 7. INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS | ||
1915 | ! ------------------------------------------------------- | ||
1916 | |||
1917 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
1 | IF (LEPHYS .AND. NMODE > 1) THEN |
1918 | ✗ | CALL SUSAT | |
1919 | ENDIF | ||
1920 | !CALL GSTATS(1818,1) MPL 2.12.08 | ||
1921 | |||
1922 | ! ---------------------------------------------------------------- | ||
1923 | |||
1924 | !* 8. INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION | ||
1925 | ! -------------------------------------------- | ||
1926 | ! (not done here!!! called from APLPAR as it depends | ||
1927 | ! on model pressure levels!) | ||
1928 | |||
1929 | ! ---------------------------------------------------------------- | ||
1930 | |||
1931 | !* 9. SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION | ||
1932 | ! ------------------------------------------------------- | ||
1933 | |||
1934 | 1 | ZTSTEP=MAX(TSTEP,1.0_JPRB) | |
1935 | 1 | ZSTPHR=3600._JPRB/ZTSTEP | |
1936 | 1 | IRADFR=NRADFR | |
1937 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF(NRADFR < 0) THEN |
1938 | 1 | NRADFR=-NRADFR*ZSTPHR+0.5_JPRB | |
1939 | ENDIF | ||
1940 | 1 | NRADPFR=NRADPFR*NRADFR | |
1941 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
1 | IF (MOD(NRADPLA,2) == 0.AND. NRADPLA /= 0) THEN |
1942 | ✗ | NRADPLA=NRADPLA+1 | |
1943 | ENDIF | ||
1944 | |||
1945 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF(NRADUV < 0) THEN |
1946 | 1 | NRADUV=-NRADUV*ZSTPHR+0.5_JPRB | |
1947 | ENDIF | ||
1948 | |||
1949 | 1 | IST1HR=ZSTPHR+0.05_JPRB | |
1950 | 1 | ISTNHR= NLNGR1H *ZSTPHR+0.05_JPRB | |
1951 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN |
1952 | 801 CONTINUE | ||
1953 | ✗ | IST1HR=IST1HR+1 | |
1954 | ✗ | IF (MOD(ISTNHR,IST1HR) /= 0) GO TO 801 | |
1955 | ENDIF | ||
1956 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (NRADFR == 1) THEN |
1957 | ✗ | NRADSFR=NRADFR | |
1958 | ELSE | ||
1959 | 1 | NRADSFR=IST1HR | |
1960 | ENDIF | ||
1961 | 1 | NRADNFR=NRADFR | |
1962 | |||
1963 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF(LRAYFM) THEN |
1964 | ✗ | NRPROMA=NDLON+6+(1-MOD(NDLON,2)) | |
1965 | ENDIF | ||
1966 | |||
1967 | ! ---------------------------------------------------------------- | ||
1968 | |||
1969 | !* 10. ALLOCATE WORK ARRAYS | ||
1970 | ! -------------------- | ||
1971 | |||
1972 | 1 | IU = NULOUT | |
1973 |
2/4✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
|
1 | LLP = NPRINTLEV >= 1.OR. LALLOPR |
1974 | |||
1975 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (LEPHYS) THEN |
1976 | ✗ | ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS)) | |
1977 | ✗ | IF(LLP)WRITE(IU,9) 'EMTD ',SIZE(EMTD ),SHAPE(EMTD ) | |
1978 | ✗ | ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS)) | |
1979 | ✗ | IF(LLP)WRITE(IU,9) 'TRSW ',SIZE(TRSW ),SHAPE(TRSW ) | |
1980 | ✗ | ALLOCATE(EMTC(NPROMA,NFLEVG+1,NGPBLKS)) | |
1981 | ✗ | IF(LLP)WRITE(IU,9) 'EMTC ',SIZE(EMTC ),SHAPE(EMTC ) | |
1982 | ✗ | ALLOCATE(TRSC(NPROMA,NFLEVG+1,NGPBLKS)) | |
1983 | ✗ | IF(LLP)WRITE(IU,9) 'TRSC ',SIZE(TRSC ),SHAPE(TRSC ) | |
1984 | ✗ | ALLOCATE(SRSWD(NPROMA,NGPBLKS)) | |
1985 | ✗ | IF(LLP)WRITE(IU,9) 'SRSWD ',SIZE(SRSWD ),SHAPE(SRSWD ) | |
1986 | ✗ | ALLOCATE(SRLWD(NPROMA,NGPBLKS)) | |
1987 | ✗ | IF(LLP)WRITE(IU,9) 'SRLWD ',SIZE(SRLWD ),SHAPE(SRLWD ) | |
1988 | ✗ | ALLOCATE(SRSWDCS(NPROMA,NGPBLKS)) | |
1989 | ✗ | IF(LLP)WRITE(IU,9) 'SRSWDCS ',SIZE(SRSWDCS ),SHAPE(SRSWDCS ) | |
1990 | ✗ | ALLOCATE(SRLWDCS(NPROMA,NGPBLKS)) | |
1991 | ✗ | IF(LLP)WRITE(IU,9) 'SRLWDCS ',SIZE(SRLWDCS ),SHAPE(SRLWDCS ) | |
1992 | ✗ | ALLOCATE(SRSWDV(NPROMA,NGPBLKS)) | |
1993 | ✗ | IF(LLP)WRITE(IU,9) 'SRSWDV ',SIZE(SRSWDV ),SHAPE(SRSWDV ) | |
1994 | ✗ | ALLOCATE(SRSWDUV(NPROMA,NGPBLKS)) | |
1995 | ✗ | IF(LLP)WRITE(IU,9) 'SRSWDUV ',SIZE(SRSWDUV ),SHAPE(SRSWDUV ) | |
1996 | ✗ | ALLOCATE(EDRO(NPROMA,NGPBLKS)) | |
1997 | ✗ | IF(LLP)WRITE(IU,9) 'EDRO ',SIZE(EDRO ),SHAPE(EDRO ) | |
1998 | ✗ | ALLOCATE(SRSWPAR(NPROMA,NGPBLKS)) | |
1999 | ✗ | IF(LLP)WRITE(IU,9) 'SRSWPAR ',SIZE(SRSWPAR ),SHAPE(SRSWPAR ) | |
2000 | ✗ | ALLOCATE(SRSWUVB(NPROMA,NGPBLKS)) | |
2001 | ✗ | IF(LLP)WRITE(IU,9) 'SRSWUVB ',SIZE(SRSWUVB ),SHAPE(SRSWUVB ) | |
2002 | |||
2003 |
1/6✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
|
1 | ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN |
2004 | ✗ | ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS)) | |
2005 | ✗ | IF(LLP)WRITE(IU,9) 'EMTD ',SIZE(EMTD ),SHAPE(EMTD ) | |
2006 | ✗ | ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS)) | |
2007 | ✗ | IF(LLP)WRITE(IU,9) 'TRSW ',SIZE(TRSW ),SHAPE(TRSW ) | |
2008 | ✗ | ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS)) | |
2009 | ✗ | IF(LLP)WRITE(IU,9) 'EMTC ',SIZE(EMTU ),SHAPE(EMTU ) | |
2010 | ✗ | ALLOCATE(RMOON(NPROMA,NGPBLKS)) | |
2011 | ✗ | IF(LLP)WRITE(IU,9) 'RMOON ',SIZE(RMOON ),SHAPE(RMOON ) | |
2012 | ENDIF | ||
2013 |
5/10✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
|
2 | ALLOCATE(SRSWPARC(NPROMA,NGPBLKS)) |
2014 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
|
1 | IF(LLP)WRITE(IU,9) 'SRSWPARC ',SIZE(SRSWPARC ),SHAPE(SRSWPARC ) |
2015 |
5/10✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
|
2 | ALLOCATE(SRSWTINC(NPROMA,NGPBLKS)) |
2016 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
|
1 | IF(LLP)WRITE(IU,9) 'SRSWTINC ',SIZE(SRSWTINC ),SHAPE(SRSWTINC ) |
2017 | |||
2018 | 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) | ||
2019 | |||
2020 | ! ---------------------------------------------------------------- | ||
2021 | |||
2022 | !* 10. PRINT FINAL VALUES. | ||
2023 | ! ------------------- | ||
2024 | |||
2025 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (LOUTPUT) THEN |
2026 | ✗ | WRITE(UNIT=KULOUT,FMT='('' COMMON YOERAD '')') | |
2027 | WRITE(UNIT=KULOUT,FMT='('' LERADI = '',L5 & | ||
2028 | & ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 & | ||
2029 | & ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')& | ||
2030 | ✗ | & LERADI,LERAD1H,LECO2VAR,LHGHG,NLNGR1H,NRADSFR | |
2031 | ✗ | WRITE(UNIT=KULOUT,FMT='('' LEPO3RA = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA,YO3%LGP | |
2032 | WRITE(UNIT=KULOUT,FMT='('' NRADFR = '',I2 & | ||
2033 | & ,'' NRADPFR = '',I3 & | ||
2034 | & ,'' NRADPLA = '',I2 & | ||
2035 | & ,'' NRINT = '',I1 & | ||
2036 | & ,'' NRPROMA = '',I5 & | ||
2037 | & )')& | ||
2038 | ✗ | & NRADFR,NRADPFR,NRADPLA,NRINT, NRPROMA | |
2039 | WRITE(UNIT=KULOUT,FMT='('' LERADHS= '',L5 & | ||
2040 | & ,'' LRRTM = '',L5 & | ||
2041 | & ,'' LSRTM = '',L5 & | ||
2042 | & ,'' NMODE = '',I1 & | ||
2043 | & ,'' NOZOCL= '',I1 & | ||
2044 | & ,'' NAER = '',I1 & | ||
2045 | & ,'' NHINCSOL='',I2 & | ||
2046 | & )')& | ||
2047 | ✗ | & LERADHS,LRRTM,LSRTM,NMODE,NOZOCL,NAER,NHINCSOL | |
2048 | ✗ | IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT=KULOUT,FMT='('' RCCO2= '',E10.3 & | |
2049 | &,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 & | ||
2050 | &)')& | ||
2051 | ✗ | & RCCO2,RCCH4,RCN2O,RCCFC11,RCCFC12 | |
2052 | WRITE(UNIT=KULOUT,FMT='('' NINHOM = '',I1 & | ||
2053 | & ,'' NLAYINH='',I1 & | ||
2054 | & ,'' RLWINHF='',F4.2 & | ||
2055 | & ,'' RSWINHF='',F4.2 & | ||
2056 | & )')& | ||
2057 | ✗ | & NINHOM,NLAYINH,RLWINHF,RSWINHF | |
2058 | ✗ | IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN | |
2059 | WRITE(UNIT=KULOUT,FMT='('' NPERTAER= '',I2 & | ||
2060 | & ,'' LNOTROAER='',L5 & | ||
2061 | & ,'' NPERTOZ = '',I1 & | ||
2062 | & ,'' RPERTOZ = '',F5.0 & | ||
2063 | & )')& | ||
2064 | ✗ | & NPERTAER,LNOTROAER,NPERTOZ,RPERTOZ | |
2065 | ENDIF | ||
2066 | ✗ | WRITE(UNIT=KULOUT,FMT='('' NRADINT = '',I2)')NRADINT | |
2067 | ✗ | WRITE(UNIT=KULOUT,FMT='('' NRADRES = '',I4)')NRADRES | |
2068 | ✗ | WRITE(UNIT=KULOUT,FMT='('' LRADONDEM = '',L5)')LRADONDEM | |
2069 | ✗ | IF( NRADINT > 0 )THEN | |
2070 | ✗ | IDIR=LEN_TRIM(CRTABLEDIR) | |
2071 | ✗ | IFIL=LEN_TRIM(CRTABLEFIL) | |
2072 | WRITE(UNIT=KULOUT,FMT='('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')& | ||
2073 | ✗ | & CRTABLEDIR(1:IDIR),CRTABLEFIL(1:IFIL) | |
2074 | ENDIF | ||
2075 | WRITE(UNIT=KULOUT,FMT='('' LCCNL = '',L5 & | ||
2076 | & ,'' LCCNO = '',L5 & | ||
2077 | & ,'' RCCNLND= '',F5.0 & | ||
2078 | & ,'' RCCNSEA= '',F5.0 & | ||
2079 | & ,'' LE4ALB = '',L5 & | ||
2080 | &)')& | ||
2081 | ✗ | & LCCNL,LCCNO,RCCNLND,RCCNSEA,LE4ALB | |
2082 | ✗ | IF (LHVOLCA) THEN | |
2083 | ✗ | WRITE(UNIT=KULOUT,FMT='('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA | |
2084 | ENDIF | ||
2085 | WRITE(UNIT=KULOUT,FMT='('' LONEWSW= '',L5 & | ||
2086 | & ,'' NRADIP = '',I1 & | ||
2087 | & ,'' NRADLP = '',I1 & | ||
2088 | & ,'' NICEOPT= '',I1 & | ||
2089 | & ,'' NLIQOPT= '',I1 & | ||
2090 | & ,'' LDIFFC = '',L5 & | ||
2091 | & )')& | ||
2092 | ✗ | & LONEWSW,NRADIP,NRADLP,NICEOPT,NLIQOPT,LDIFFC | |
2093 | WRITE(UNIT=KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPT. IS''& | ||
2094 | & ,'' NOVLP = '',I2 & | ||
2095 | & )')& | ||
2096 | ✗ | & NOVLP | |
2097 | ✗ | IF (LUVPROC) THEN | |
2098 | ✗ | IDAYUV=NUVTIM/86400 | |
2099 | WRITE(UNIT=KULOUT,FMT='('' LUVPROC = '',L5 & | ||
2100 | & ,'' LUVTDEP= '',L5 & | ||
2101 | & ,'' NRADUV = '',I2 & | ||
2102 | & ,'' NUV = '',I2 & | ||
2103 | & ,'' NDAYUV = '',I5 & | ||
2104 | & ,'' RMUZUV = '',E9.3 & | ||
2105 | & )')& | ||
2106 | ✗ | & LUVPROC,LUVTDEP,NRADUV,NUV,IDAYUV,RMUZUV | |
2107 | ✗ | WRITE(UNIT=KULOUT,FMT='('' RUVLAM = '',24F6.1)') (RUVLAM(JUV),JUV=1,NUV) | |
2108 | ✗ | WRITE(UNIT=KULOUT,FMT='('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV),JUV=1,NUV) | |
2109 | ENDIF | ||
2110 | WRITE(UNIT=KULOUT,FMT='('' NMCICA= '',I2 & | ||
2111 | & )')& | ||
2112 | ✗ | & NMCICA | |
2113 | ENDIF | ||
2114 | |||
2115 | ! ------------------------------------------------------------------ | ||
2116 | |||
2117 | |||
2118 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE) |
2119 | 1 | END SUBROUTINE SUECRAD | |
2120 |