Newer
Older
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
!-----------------------------------------------------------------
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
!
INTERFACE
!
SUBROUTINE MODEL_n(KTCOUNT,OEXIT)
!
INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop index of model KMODEL
LOGICAL, INTENT(INOUT):: OEXIT ! switch for the end of the temporal loop
!
END SUBROUTINE MODEL_n
!
END INTERFACE
!
END MODULE MODI_MODEL_n
! ###################################
SUBROUTINE MODEL_n(KTCOUNT, OEXIT)
! ###################################
!
!!**** *MODEL_n * -monitor of the model version _n
!!
!! PURPOSE
!! -------
! The purpose of this routine is to build up a typical model version
! by sequentially calling the specialized routines.
!
!!** METHOD
!! ------
!! Some preliminary initializations are performed in the first section.
!! Then, specialized routines are called to update the guess of the future
!! instant XRxxS of the variable xx by adding the effects of all the
!! different sources of evolution.
!!
!! (guess of xx at t+dt) * Rhod_ref * Jacobian
!! XRxxS = -------------------------------------------
!! 2 dt
!!
!! At this level, the informations are transferred with a USE association
!! from the INIT step, where the modules have been previously filled. The
!! transfer to the subroutines computing each source term is performed by
!! argument in order to avoid repeated compilations of these subroutines.
!! This monitor model_n, must therefore be duplicated for each model,
!! model1 corresponds in this case to the outermost model, model2 is used
!! for the first level of gridnesting,....
!! The effect of all parameterizations is computed in PHYS_PARAM_n, which
!! is itself a monitor. This is due to a possible large number of
!! parameterizations, which can be activated and therefore, will require a
!! very large list of arguments. To circumvent this problem, we transfer by
!! a USE association, the necessary informations in this monitor, which will
!! dispatch the pertinent information to every parametrization.
!! Some elaborated diagnostics, LES tools, budget storages are also called
!! at this level because they require informations about the fields at every
!! timestep.
!!
!!
!! EXTERNAL
!! --------
!! Subroutine FMLOOK: to recover the logical unit number linked to a FMfile
!! Subroutine FMOPEN: to open a FMfile
!! Subroutine WRITE_DESFM: to write the descriptive part of a FMfile
!! Subroutine WRITE_LFIFM: to write the binary part of a FMfile
!! Subroutine SET_MASK : to compute all the masks selected for budget
!! computations
!! Subroutine BOUNDARIES : set the fields at the marginal points in every
!! directions according the selected boundary conditions
!! Subroutine INITIAL_GUESS: initializes the guess of the future instant
!! Subroutine LES_FLX_SPECTRA: computes the resolved fluxes and the
!! spectra of some quantities when running in LES mode.
!! Subroutine ADVECTION: computes the advection terms.
!! Subroutine DYN_SOURCES: computes the curvature, Coriolis, gravity terms.
!! Subroutine NUM_DIFF: applies the fourth order numerical diffusion.
!! Subroutine RELAXATION: performs the relaxation to Larger Scale fields
!! in the upper levels and outermost vertical planes
!! Subroutine PHYS_PARAM_n : computes the parameterized physical terms
!! Subroutine RAD_BOUND: prepares the velocity normal components for the bc.
!! Subroutine RESOLVED_CLOUD : computes the sources terms for water in any
!! form
!! Subroutine PRESSURE : computes the pressure gradient term and the
!! absolute pressure
!! Subroutine EXCHANGE : updates the halo of each subdomains
!! Subroutine ENDSTEP : advances in time the fields.
!! Subroutines UVW_LS_COUPLING and SCALAR_LS_COUPLING:
!! compute the large scale fields, used to
!! couple Model_n with outer informations.
!! Subroutine ENDSTEP_BUDGET: writes the budget informations.
!! Subroutine FMCLOS : closes a FM file
!! Subroutine ADD_FORECAST_TO_DATE : transform the current time in GMT
!! Subroutine FORCING : computes forcing terms
!! Subroutine ADD3DFIELD_ll : add a field to 3D-list
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! MODD_DYN
!! MODD_CONF
!! MODD_NESTING
!! MODD_BUDGET
!! MODD_PARAMETERS
!! MODD_CONF_n
!! MODD_CURVCOR_n
!! MODD_DYN_n
!! MODD_DIM_n
!! MODD_ADV_n
!! MODD_FIELD_n
!! MODD_LSFIELD_n
!! MODD_GRID_n
!! MODD_METRICS_n
!! MODD_LBC_n
!! MODD_PARAM_n
!! MODD_REF_n
!! MODD_LUNIT_n
!! MODD_OUT_n
!! MODD_TIME_n
!! MODD_TURB_n
!! MODD_CLOUDPAR_n
!! MODD_TIME
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! J.-P. Pinty * LA *
!!
!! MODIFICATIONS
!! -------------
!! Original 15/09/94
!! Modification 20/10/94 (J.Stein) for the outputs and abs_layers routines
!! Modification 10/11/94 (J.Stein) change ABS_LAYER_FIELDS call
!! Modification 16/11/94 (J.Stein) add call to the renormalization
!! Modification 17/11/94 (J.-P. Lafore and J.-P. Pinty) call NUM_DIFF
!! Modification 08/12/94 (J.Stein) cleaning + remove (RENORM + ABS_LAYER..
!! ..) + add RELAXATION + LS fiels in the arguments
!! Modification 19/12/94 (J.Stein) switch for the num diff
!! Modification 22/12/94 (J.Stein) update tdtcur + change dyn_source call
!! Modification 05/01/95 (J.Stein) add the parameterization monitor
!! Modification 09/01/95 (J.Stein) add the 1D switch
!! Modification 10/01/95 (J.Stein) displace the TDTCUR computation
!! Modification 03/01/95 (J.-P. Lafore) Absolute pressure diagnosis
!! Modification Jan 19, 1995 (J. Cuxart) Shunt the DYN_SOURCES in 1D cases.
!! Modification Jan 24, 1995 (J. Stein) Interchange Boundaries and
!! Initial_guess to correct a bug in 2D configuration
!! Modification Feb 02, 1995 (I.Mallet) update BOUNDARIES and RAD_BOUND
!! calls
!! Modification Mar 10, 1995 (I.Mallet) add call to SET_COUPLING
!! March,21, 1995 (J. Stein) remove R from the historical var.
!! March,26, 1995 (J. Stein) add the EPS variable
!! April 18, 1995 (J. Cuxart) add the LES call
!! Sept 20,1995 (Lafore) coupling for the dry mass Md
!! Nov 2,1995 (Stein) displace the temporal counter increase
!! Jan 2,1996 (Stein) rm the test on the temporal counter
!! Modification Feb 5,1996 (J. Vila) implementation new advection
!! schemes for scalars
!! Modification Feb 20,1996 (J.Stein) doctor norm
!! Dec95 - Jul96 (Georgelin, Pinty, Mari, Suhre) FORCING
!! June 17,1996 (Vincent, Lafore, Jabouille)
!! statistics of computing time
!! Aug 8, 1996 (K. Suhre) add chemistry
!! October 12, 1996 (J. Stein) save the PSRC value
!! Sept 05,1996 (V.Masson) print of loop index for debugging
!! purposes
!! July 22,1996 (Lafore) improve write of computing time statistics
!! July 29,1996 (Lafore) nesting introduction
!! Aug. 1,1996 (Lafore) synchronization between models
!! Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING
!! now splitted in 2 routines
!! (UVW_LS_COUPLING and SCALAR_LS_COUPLING)
!! Sept 5,1996 (V.Masson) print of loop index for debugging
!! purposes
!! Sept 25,1996 (V.Masson) test for coupling performed here
!! Oct. 29,1996 (Lafore) one-way nesting implementation
!! Oct. 12,1996 (J. Stein) save the PSRC value
!! Dec. 12,1996 (Lafore) change call to RAD_BOUND
!! Dec. 21,1996 (Lafore) two-way nesting implementation
!! Mar. 12,1997 (Lafore) introduction of "surfacic" LS fields
!! Nov 18, 1996 (J.-P. Pinty) FORCING revisited (translation)
!! Dec 04, 1996 (J.-P. Pinty) include mixed-phase clouds
!! Dec 20, 1996 (J.-P. Pinty) update the budgets
!! Dec 23, 1996 (J.-P. Pinty) add the diachronic file control
!! Jan 11, 1997 (J.-P. Pinty) add the deep convection control
!! Dec 20,1996 (V.Masson) call boundaries before the writing
!! Fev 25, 1997 (P.Jabouille) modify the LES tools
!! April 3,1997 (Lafore) merging of the nesting
!! developments on MASTER3
!! Jul. 8,1997 (Lafore) print control for nesting (NVERB>=7)
!! Jul. 28,1997 (Masson) supress LSTEADY_DMASS
!! Aug. 19,1997 (Lafore) full Clark's formulation introduction
!! Sept 26,1997 (Lafore) LS source calculation at restart
!! (temporarily test to have LS at instant t)
!! Jan. 28,1998 (Bechtold) add SST forcing
!! fev. 10,1998 (Lafore) RHODJ computation and storage for budget
!! Jul. 10,1998 (Stein ) sequentiel loop for nesting
!! Apr. 07,1999 (Stein ) cleaning of the nesting subroutines
!! oct. 20,1998 (Jabouille) //
!! oct. 20,2000 (J.-P. Pinty) add the C2R2 scheme
!! fev. 01,2001 (D.Gazen) add module MODD_NSV for NSV variables
!! mar, 4,2002 (V.Ducrocq) call to temporal series
!! mar, 8, 2001 (V. Masson) advection of perturbation of theta in neutral cases.
!! Nov, 6, 2002 (V. Masson) time counters for budgets & LES
!! mars 20,2001 (Pinty) add ICE4 and C3R5 options
!! jan. 2004 (Masson) surface externalization
!! sept 2004 (M. Tomasini) Cloud mixing length modification
!! june 2005 (P. Tulet) add aerosols / dusts
!! Jul. 2005 (N. Asencio) two_way and phys_param calls:
!! Add the surface parameters : precipitating
!! hydrometeors, Short and Long Wave , MASKkids array
!! Fev. 2006 (M. Leriche) add aqueous phase chemistry
!! april 2006 (T.Maric) Add halo related to 4th order advection scheme
!! May 2006 Remove KEPS
!! Oct 2008 (C.Lac) FIT for variables advected with PPM
!! July 2009 : Displacement of surface diagnostics call to be
!! coherent with surface diagnostics obtained with DIAG
!! 10/11/2009 (P. Aumond) Add mean moments
!! Nov, 12, 2009 (C. Barthe) add cloud electrification and lightning flashes
!! July 2010 (M. Leriche) add ice phase chemical species
!! April 2011 (C.Lac) : Remove instant M
!! April 2011 (C.Lac, V.Masson) : Time splitting for advection
ESCOBAR MUNOZ Juan
committed
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
Gaelle Tanguy
committed
!! P. Tulet Nov 2014 accumulated moles of aqueous species that fall at the surface
!! Dec 2014 (C.Lac) : For reproducibility START/RESTA
!! J.Escobar 20/04/2015: missing UPDATE_HALO before UPDATE_HALO2
Gaelle Tanguy
committed
!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for
!! aircraft, ballon and profiler
!! C.Lac 11/09/2015: correction of the budget due to FIT temporal scheme
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Sep 2015 (S. Bielli) : Remove YDADFILE from argument call
ESCOBAR MUNOZ Juan
committed
!! of write_phys_param
!! J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
!! M.Mazoyer : 04/2016 DTHRAD used for radiative cooling when LACTIT
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODE_ll
USE MODE_IO_ll
USE MODE_ELEC_ll
!
USE MODE_FM
!
USE MODD_TIME
USE MODD_DYN
USE MODD_DYNZD
USE MODD_CONF
USE MODD_NESTING
USE MODD_FMOUT
USE MODD_BUDGET
USE MODD_PARAMETERS
USE MODD_PARAM_ICE, ONLY : LWARM,LSEDIC,LCONVHG
USE MODD_FRC
USE MODD_AIRCRAFT_BALLOON
USE MODD_STATION_n
USE MODD_PROFILER_n
USE MODD_PARAM_C2R2, ONLY : LSEDC, LRAIN, LACTIT
USE MODD_PARAM_C1R3, ONLY : LSEDI, LHHONI
USE MODD_LES
USE MODD_LES_BUDGET
USE MODD_LUNIT
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_SERIES, ONLY: LSERIES
USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
!
USE MODD_SUB_MODEL_n
USE MODD_GET_n
USE MODD_CONF_n
USE MODD_CURVCOR_n
USE MODD_DIM_n
USE MODD_DYN_n
USE MODD_DYNZD_n
USE MODD_ADV_n
USE MODD_FIELD_n
USE MODD_MEAN_FIELD_n
USE MODD_MEAN_FIELD
USE MODD_LSFIELD_n
USE MODD_GRID_n
USE MODD_METRICS_n
USE MODD_LBC_n
USE MODD_PARAM_n
USE MODD_REF_n
USE MODD_FRC_n
USE MODD_LUNIT_n
USE MODD_OUT_n
USE MODD_TIME_n
USE MODD_TURB_n
USE MODD_CLOUDPAR_n
USE MODD_PRECIP_n
USE MODD_BIKHARDT_n
USE MODD_DEEP_CONVECTION_n
USE MODD_NSV
USE MODD_RADIATIONS_n, ONLY : XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
USE MODD_SERIES_n, ONLY: NFREQSERIES
USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
LCH_INIT_FIELD
Gaelle Tanguy
committed
USE MODD_CH_PH_n
USE MODD_CST, ONLY: XMD
USE MODD_NUDGING_n
USE MODD_PARAM_MFSHALL_n
USE MODD_ELEC_DESCR
!
USE MODD_CLOUD_MF_n
USE MODI_INITIAL_GUESS
USE MODI_MEAN_FIELD
USE MODI_BOUNDARIES
USE MODI_ADVECTION_METSV
USE MODI_ADVECTION_UVW
USE MODI_ADVECTION_UVW_CEN
USE MODI_GRAVITY_IMPL
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
USE MODI_DYN_SOURCES
USE MODI_RELAXATION
USE MODI_NUM_DIFF
USE MODI_PHYS_PARAM_n
USE MODI_RAD_BOUND
USE MODI_PRESSUREZ
USE MODI_ENDSTEP
USE MODI_EXCHANGE
USE MODI_RESOLVED_CLOUD
USE MODI_RESOLVED_ELEC_n
USE MODI_RELAX2FW_ION
USE MODI_LS_COUPLING
USE MODI_WRITE_DESFM_n
USE MODI_WRITE_LFIFM_n
USE MODI_MNHWRITE_ZS_DUMMY_n
USE MODI_ENDSTEP_BUDGET
USE MODI_BUDGET_FLAGS
USE MODI_ADD_FORECAST_TO_DATE
USE MODI_FORCING
USE MODI_ADV_FORCING_n
USE MODI_REL_FORCING_n
USE MODI_NUDGING
USE MODI_TEMPORAL_DIST
USE MODI_WRITE_LFIFMN_FORDIACHRO_n
USE MODI_MENU_DIACHRO
USE MODI_MASK_COMPRESS
USE MODI_CART_COMPRESS
USE MODI_SHUMAN
USE MODI_ONE_WAY_n
USE MODI_TWO_WAY
USE MODI_SPAWN_LS_n
USE MODI_LES_INI_TIMESTEP_n
USE MODI_WRITE_LES_n
USE MODI_AIRCRAFT_BALLOON
USE MODI_WRITE_AIRCRAFT_BALLOON
USE MODI_UPDATE_NSV
USE MODI_PROFILER_n
USE MODI_STATION_n
USE MODI_WRITE_SERIES_n
USE MODI_WRITE_PROFILER_n
USE MODI_WRITE_STATION_n
USE MODI_MNHGET_SURF_PARAM_n
USE MODI_INI_DIAG_IN_RUN
USE MODI_END_DIAG_IN_RUN
USE MODI_TURB_CLOUD_INDEX
USE MODI_INI_LG
USE MODI_INI_MEAN_FIELD
!
USE MODE_MODELN_HANDLER
!
USE MODD_2D_FRC
USE MODD_TIMEZ
USE MODE_MNH_TIMING
!
USE MODI_SETLB_LG
USE MODI_GOTO_SURFEX
USE MODI_WRITE_SURF_ATM_N
USE MODI_SET_MASK
USE MODI_DIAG_SURF_ATM_N
USE MODI_WRITE_DIAG_SURF_ATM_N
USE MODI_SERIES_N
USE MODI_LES_N
!
#ifdef MNH_NCWRIT
USE MODN_NCOUT
USE MODE_UTIL
#endif
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
!
!
INTEGER, INTENT(IN) :: KTCOUNT
LOGICAL, INTENT(INOUT):: OEXIT
!
!* 0.2 declarations of local variables
!
INTEGER :: ILUOUT ! Logical unit number for the output listing
INTEGER :: IIU,IJU,IKU ! array size in first, second and third dimensions
INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
CHARACTER (LEN=28) :: YFMFILE ! name of the OUTPUT FM-file
CHARACTER (LEN=28) :: YDADFILE ! name of the corresponding DAD model OUTPUT FM-file
CHARACTER (LEN=4) :: YNUMBER ! character string for the OUTPUT FM-file number
CHARACTER (LEN=4) :: YDADNUMBER! character string for the DAD model OUTPUT FM-file number
CHARACTER (LEN=32) :: YDESFM ! name of the desfm part of this FM-file
INTEGER :: INBVAR ! number of HALO2_lls to allocate
INTEGER :: IRESP ! return code in FM routines
INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: INPRAR ! number of articles predicted in
! the LFIFM file
INTEGER :: ININAR ! number of articles present in
! the LFIFM file
INTEGER :: ITYPE ! type of file (cpio or not)
INTEGER :: JOUT ! loop index on the output instant list
INTEGER :: IOUTDAD ! numero of the OUTPUT FM-file of DAD model
INTEGER :: JOUTDAD ! loop index on the output instant list for DAD model
LOGICAL :: GSTEADY_DMASS ! conditional call to mass computation
!
! for computing time analysis
REAL*8,DIMENSION(2) :: ZTIME,ZTIME1,ZTIME2,ZEND,ZTOT,ZALL,ZTOT_PT
!
REAL*8,DIMENSION(2) :: ZTIME_STEP,ZTIME_STEP_PTS
CHARACTER :: YMI
INTEGER :: IPOINTS
CHARACTER(len=12) :: YTCOUNT,YPOINTS
REAL :: ZSTAT_CSTORE,ZSTAT_CBOUND,ZSTAT_CGUESS,ZSTAT_CADV,ZSTAT_CSOURCES
REAL :: ZSTAT_CDIFF,ZSTAT_CRELAX,ZSTAT_CPARAM
REAL :: ZSTAT_CSPECTRA,ZSTAT_CRAD_BOUND,ZSTAT_CPRESS
REAL :: ZSTAT_CCLOUD,ZSTAT_CSTEP_SWA,ZSTAT_CSTEP_MISC
REAL :: ZSTAT_CCOUPL,ZSTAT_CSTEP_BUD,ZSTAT_CSTEP_CDRAG
REAL :: ZSTAT_CSTEP_CTRACER,ZSTAT_CSTEP_CELEC
REAL :: SCONV_CTURB,ZSTAT_C1WAY,ZSTAT_C2WAY,ZSTAT_CMAFL
REAL :: ZSTAT_CRAD,ZSTAT_CDCONV,ZSTAT_CGROUND,ZSTAT_CHALO
REAL :: ZSTAT_CFORCING,ZSTAT_CNUDGING,ZSTAT_CCHEM
!
REAL :: ZPERCALL,ZPRICE
REAL :: ZPERCSTORE,ZPERCBOUND,ZPERCGUESS,ZPERCADV,ZPERCSOURCES,ZPERCDRAG
REAL :: ZPERCDIFF,ZPERCRELAX,ZPERCPARAM
REAL :: ZPERCSPECTRA,ZPERCRAD_BOUND,ZPERCPRESS
REAL :: ZPERCCLOUD,ZPERCSTEP_SWA,ZPERCSTEP_MISC
REAL :: ZPERCELEC
REAL :: ZPERCCOUPL,ZPERCSTEP_BUD
REAL :: ZPERCTURB,ZPERC1WAY,ZPERC2WAY
REAL :: ZPERCRAD,ZPERCSHADOWS,ZPERCKAFR,ZPERCGROUND,ZPERCHALO,ZPERCMAFL,ZPERTRACER
REAL :: ZPERCFORCING,ZPERCNUDGING,ZPERCCHEM
REAL :: ZTSTEP_UVW ! Double timestep except for cold start (single)
REAL :: ZTSTEP_MET,ZTSTEP_SV ! Effective time step for advection
!
INTEGER :: ISYNCHRO ! model synchronic index relative to its father
! = 1 for the first time step in phase with DAD
! = 0 for the last time step (out of phase)
INTEGER :: IMI ! Current model index
REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA
REAL, DIMENSION(:,:),ALLOCATABLE :: ZTOWN
! Dummy pointers needed to correct an ifort Bug
REAL, DIMENSION(:), POINTER :: DPTR_XZHAT
REAL, DIMENSION(:), POINTER :: DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4
REAL, DIMENSION(:), POINTER :: DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4
REAL, DIMENSION(:), POINTER :: DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4
REAL, DIMENSION(:), POINTER :: DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4
CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_NKLIN_LBXV,DPTR_NKLIN_LBYV
INTEGER, DIMENSION(:,:,:), POINTER :: DPTR_NKLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_NKLIN_LBXM,DPTR_NKLIN_LBYM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXU,DPTR_XCOEFLIN_LBYU
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXV,DPTR_XCOEFLIN_LBYV
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXW,DPTR_XCOEFLIN_LBYW
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XCOEFLIN_LBXM,DPTR_XCOEFLIN_LBYM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWM,DPTR_XLBYWM,DPTR_XLBXTHM,DPTR_XLBYTHM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKEM,DPTR_XLBYTKEM
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXSVM,DPTR_XLBYSVM
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRM,DPTR_XLBYRM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XZZ
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM,DPTR_XLSTHM,DPTR_XLSRVM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS,DPTR_XLSTHS,DPTR_XLSRVS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXWS,DPTR_XLBYWS,DPTR_XLBXTHS,DPTR_XLBYTHS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XLBXTKES,DPTR_XLBYTKES
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS
!
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRHODJ,DPTR_XUM,DPTR_XVM,DPTR_XWM,DPTR_XTHM
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XTKEM,DPTR_XRUS,DPTR_XRVS,DPTR_XRWS,DPTR_XRTHS
REAL, DIMENSION(:,:,:), POINTER :: DPTR_XRTKES,DPTR_XDIRFLASWD,DPTR_XSCAFLASWD,DPTR_XDIRSRFSWD
REAL, DIMENSION(:,:,:,:), POINTER :: DPTR_XRM,DPTR_XSVM,DPTR_XRRS,DPTR_XRSVS
REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRC,DPTR_XINPRR,DPTR_XINPRS,DPTR_XINPRG
REAL, DIMENSION(:,:), POINTER :: DPTR_XINPRH,DPTR_XPRCONV,DPTR_XPRSCONV
LOGICAL, DIMENSION(:,:),POINTER :: DPTR_GMASKkids
Gaelle Tanguy
committed
!
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDC
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDR
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDS
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDG
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZSPEEDH
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRC3D
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRS3D
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRG3D
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZINPRH3D
!
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZRUS,ZRVS,ZRWS
!
! for various testing
INTEGER :: IK
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2),SIZE(XTHT,3)) :: ZTMP
!
TYPE(LIST_ll), POINTER :: TZFIELDC_ll ! list of fields to exchange
TYPE(HALO2LIST_ll), POINTER :: TZHALO2C_ll ! list of fields to exchange
!
!-------------------------------------------------------------------------------
!
!* 1 PRELIMINARY
! ------------
ITYPE = 1
IMI = GET_CURRENT_MODEL_INDEX()
!
!* 1.0 update NSV_* variables for current model
! ----------------------------------------
!
CALL UPDATE_NSV(IMI)
!
!* 1.1 RECOVER THE LOGICAL UNIT NUMBER FOR THE OUTPUT PRINTS
!
CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
!
!* 1.2 SET ARRAY SIZE
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=NKMAX+2*JPVEXT
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB=1+JPVEXT
IKE=IKU-JPVEXT
!
IF (IMI==1) THEN
GSTEADY_DMASS=LSTEADYLS
ELSE
GSTEADY_DMASS=.FALSE.
END IF
!
!* 1.3 OPEN THE DIACHRONIC FILE
!
IF (KTCOUNT == 1) THEN
!
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
NULLIFY(TZFIELDSC_ll)
!
ALLOCATE(ZWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
!
! initialization of the FM file output number
IOUT=0
!
INPRAR = 50
CALL FMOPEN_ll(CFMDIAC,'WRITE',CLUOUT,INPRAR,ITYPE,NVERB,ININAR,IRESP)
YDESFM=ADJUSTL(ADJUSTR(CFMDIAC)//'.des')
CALL WRITE_DESFM_n(IMI,YDESFM,CLUOUT)
#ifdef MNH_NCWRIT
NC_WRITE = LNETCDF
NC_FILE=''
CALL WRITE_LFIFMN_FORDIACHRO_n(CFMDIAC)
IF ( LNETCDF ) THEN
DEF_NC=.FALSE.
CALL WRITE_LFIFMN_FORDIACHRO_n(CFMDIAC)
DEF_NC=.TRUE.
END IF
NC_WRITE = .FALSE.
#else
CALL WRITE_LFIFMN_FORDIACHRO_n(CFMDIAC)
#endif
!
!* 1.4 Initialization of the list of fields for the halo updates
!
! a) Sources terms
!
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRUS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRVS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRWS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRTHS)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRUS_PRES)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRVS_PRES)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRWS_PRES)
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRTHS_CLD)
IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDS_ll, XRTKES)
DO JRR=1,NRR
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRRS(:,:,:,JRR))
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRRS_CLD(:,:,:,JRR))
ENDDO
DO JSV=1,NSV
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRSVS(:,:,:,JSV))
CALL ADD3DFIELD_ll(TZFIELDS_ll, XRSVS_CLD(:,:,:,JSV))
IF (SIZE(XSRCT,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDS_ll, XSRCT)
ESCOBAR MUNOZ Juan
committed
IF ((LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV) ) THEN
!
! b) LS fields
!
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSUM)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSVM)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSWM)
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSTHM)
IF (NRR >= 1) THEN
CALL ADD3DFIELD_ll(TZLSFIELD_ll, XLSRVM)
ENDIF
!
CALL ADD3DFIELD_ll(TZFIELDT_ll, XUT)
CALL ADD3DFIELD_ll(TZFIELDT_ll, XVT)
CALL ADD3DFIELD_ll(TZFIELDT_ll, XWT)
CALL ADD3DFIELD_ll(TZFIELDT_ll, XTHT)
IF (SIZE(XRTKES,1) /= 0) CALL ADD3DFIELD_ll(TZFIELDT_ll, XTKET)
CALL ADD3DFIELD_ll(TZFIELDT_ll, XRT(:,:,:,JRR))
CALL ADD3DFIELD_ll(TZFIELDT_ll, XSVT(:,:,:,JSV))
ENDDO
!
!* 1.5 Initialize the list of fields for the halo updates (2nd layer)
!
INBVAR = 4+NRR+NSV
IF (SIZE(XRTKES,1) /= 0) INBVAR=INBVAR+1
ESCOBAR MUNOZ Juan
committed
CALL INIT_HALO2_ll(TZHALO2T_ll,INBVAR,IIU,IJU,IKU)
CALL INIT_HALO2_ll(TZLSHALO2_ll,4+MIN(1,NRR),IIU,IJU,IKU)
!
!* 1.6 Initialise the 2nd layer of the halo of the LS fields
!
IF ( LSTEADYLS ) THEN
CALL UPDATE_HALO_ll(TZLSFIELD_ll, IINFO_ll)
CALL UPDATE_HALO2_ll(TZLSFIELD_ll, TZLSHALO2_ll, IINFO_ll)
END IF
END IF
!
!
!
XT_START = 0.0
!
XT_STORE = 0.0
XT_BOUND = 0.0
XT_GUESS = 0.0
XT_FORCING = 0.0
XT_NUDGING = 0.0
XT_ADV = 0.0
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
XT_SOURCES = 0.0
!
XT_DIFF = 0.0
XT_RELAX = 0.0
XT_PARAM = 0.0
XT_SPECTRA = 0.0
XT_HALO = 0.0
XT_RAD_BOUND = 0.0
XT_PRESS = 0.0
!
XT_CLOUD = 0.0
XT_STEP_SWA = 0.0
XT_STEP_MISC = 0.0
XT_COUPL = 0.0
XT_1WAY = 0.0
XT_STEP_BUD = 0.0
!
XT_RAD = 0.0
XT_DCONV = 0.0
XT_GROUND = 0.0
XT_TURB = 0.0
XT_MAFL = 0.0
XT_DRAG = 0.0
XT_TRACER = 0.0
XT_SHADOWS = 0.0
XT_ELEC = 0.0
XT_CHEM = 0.0
XT_2WAY = 0.0
!
END IF
!
!* 1.7 Allocation of arrays for observation diagnostics
!
CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
!
!
CALL SECOND_MNH2(ZEND)
!
!-------------------------------------------------------------------------------
!
!* 2. ONE-WAY NESTING AND LARGE SCALE FIELD REFRESH
! ---------------------------------------------
!
!
CALL SECOND_MNH2(ZTIME1)
!
ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation
!
IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
!
! Use dummy pointers to correct an ifort BUG
DPTR_XBMX1=>XBMX1
DPTR_XBMX2=>XBMX2
DPTR_XBMX3=>XBMX3
DPTR_XBMX4=>XBMX4
DPTR_XBMY1=>XBMY1
DPTR_XBMY2=>XBMY2
DPTR_XBMY3=>XBMY3
DPTR_XBMY4=>XBMY4
DPTR_XBFX1=>XBFX1
DPTR_XBFX2=>XBFX2
DPTR_XBFX3=>XBFX3
DPTR_XBFX4=>XBFX4
DPTR_XBFY1=>XBFY1
DPTR_XBFY2=>XBFY2
DPTR_XBFY3=>XBFY3
DPTR_XBFY4=>XBFY4
DPTR_CLBCX=>CLBCX
DPTR_CLBCY=>CLBCY
!
DPTR_XZZ=>XZZ
DPTR_XZHAT=>XZHAT
DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
DPTR_XLSTHM=>XLSTHM
DPTR_XLSRVM=>XLSRVM
DPTR_XLSUM=>XLSUM
DPTR_XLSVM=>XLSVM
DPTR_XLSWM=>XLSWM
DPTR_XLSTHS=>XLSTHS
DPTR_XLSRVS=>XLSRVS
DPTR_XLSUS=>XLSUS
DPTR_XLSVS=>XLSVS
DPTR_XLSWS=>XLSWS
!
IF ( LSTEADYLS ) THEN
NCPL_CUR=0
ELSE
IF (NCPL_CUR/=1) THEN
IF ( KTCOUNT+1 == NCPL_TIMES(NCPL_CUR-1,IMI) ) THEN
!
! LS sources are interpolated from the LS field
! values of model DAD(IMI)
CALL SPAWN_LS_n(NDAD(IMI),XTSTEP,IMI, &
DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI), &
DPTR_CLBCX,DPTR_CLBCY,DPTR_XZZ,DPTR_XZHAT,LSLEVE,XLEN1,XLEN2,DPTR_XCOEFLIN_LBXM, &
DPTR_XLSTHM,DPTR_XLSRVM,DPTR_XLSUM,DPTR_XLSVM,DPTR_XLSWM, &
DPTR_XLSTHS,DPTR_XLSRVS,DPTR_XLSUS,DPTR_XLSVS,DPTR_XLSWS )
END IF
END IF
!
END IF
!
DPTR_NKLIN_LBXU=>NKLIN_LBXU
DPTR_XCOEFLIN_LBXU=>XCOEFLIN_LBXU
DPTR_NKLIN_LBYU=>NKLIN_LBYU
DPTR_XCOEFLIN_LBYU=>XCOEFLIN_LBYU
DPTR_NKLIN_LBXV=>NKLIN_LBXV
DPTR_XCOEFLIN_LBXV=>XCOEFLIN_LBXV
DPTR_NKLIN_LBYV=>NKLIN_LBYV
DPTR_XCOEFLIN_LBYV=>XCOEFLIN_LBYV
DPTR_NKLIN_LBXW=>NKLIN_LBXW
DPTR_XCOEFLIN_LBXW=>XCOEFLIN_LBXW
DPTR_NKLIN_LBYW=>NKLIN_LBYW
DPTR_XCOEFLIN_LBYW=>XCOEFLIN_LBYW
!
DPTR_NKLIN_LBXM=>NKLIN_LBXM
DPTR_XCOEFLIN_LBXM=>XCOEFLIN_LBXM
DPTR_NKLIN_LBYM=>NKLIN_LBYM
DPTR_XCOEFLIN_LBYM=>XCOEFLIN_LBYM
!
DPTR_XLBXUM=>XLBXUM
DPTR_XLBYUM=>XLBYUM
DPTR_XLBXVM=>XLBXVM
DPTR_XLBYVM=>XLBYVM
DPTR_XLBXWM=>XLBXWM
DPTR_XLBYWM=>XLBYWM
DPTR_XLBXTHM=>XLBXTHM
DPTR_XLBYTHM=>XLBYTHM
DPTR_XLBXTKEM=>XLBXTKEM
DPTR_XLBYTKEM=>XLBYTKEM
DPTR_XLBXRM=>XLBXRM
DPTR_XLBYRM=>XLBYRM
DPTR_XLBXSVM=>XLBXSVM
DPTR_XLBYSVM=>XLBYSVM
!
DPTR_XLBXUS=>XLBXUS
DPTR_XLBYUS=>XLBYUS
DPTR_XLBXVS=>XLBXVS
DPTR_XLBYVS=>XLBYVS
DPTR_XLBXWS=>XLBXWS
DPTR_XLBYWS=>XLBYWS
DPTR_XLBXTHS=>XLBXTHS
DPTR_XLBYTHS=>XLBYTHS
DPTR_XLBXTKES=>XLBXTKES
DPTR_XLBYTKES=>XLBYTKES
DPTR_XLBXRS=>XLBXRS
DPTR_XLBYRS=>XLBYRS
DPTR_XLBXSVS=>XLBXSVS
DPTR_XLBYSVS=>XLBYSVS
!
CALL ONE_WAY_n(NDAD(IMI),CLUOUT,XTSTEP,IMI,KTCOUNT, &
DPTR_XBMX1,DPTR_XBMX2,DPTR_XBMX3,DPTR_XBMX4,DPTR_XBMY1,DPTR_XBMY2,DPTR_XBMY3,DPTR_XBMY4, &
DPTR_XBFX1,DPTR_XBFX2,DPTR_XBFX3,DPTR_XBFX4,DPTR_XBFY1,DPTR_XBFY2,DPTR_XBFY3,DPTR_XBFY4, &
NDXRATIO_ALL(IMI),NDYRATIO_ALL(IMI),NDTRATIO(IMI), &
DPTR_CLBCX,DPTR_CLBCY,NRIMX,NRIMY, &
DPTR_NKLIN_LBXU,DPTR_XCOEFLIN_LBXU,DPTR_NKLIN_LBYU,DPTR_XCOEFLIN_LBYU, &
DPTR_NKLIN_LBXV,DPTR_XCOEFLIN_LBXV,DPTR_NKLIN_LBYV,DPTR_XCOEFLIN_LBYV, &
DPTR_NKLIN_LBXW,DPTR_XCOEFLIN_LBXW,DPTR_NKLIN_LBYW,DPTR_XCOEFLIN_LBYW, &
DPTR_NKLIN_LBXM,DPTR_XCOEFLIN_LBXM,DPTR_NKLIN_LBYM,DPTR_XCOEFLIN_LBYM, &
GSTEADY_DMASS,CCLOUD,LUSECHAQ,LUSECHIC, &
DPTR_XLBXUM,DPTR_XLBYUM,DPTR_XLBXVM,DPTR_XLBYVM,DPTR_XLBXWM,DPTR_XLBYWM, &
DPTR_XLBXTHM,DPTR_XLBYTHM, &
DPTR_XLBXTKEM,DPTR_XLBYTKEM, &
DPTR_XLBXRM,DPTR_XLBYRM,DPTR_XLBXSVM,DPTR_XLBYSVM, &
XDRYMASST,XDRYMASSS, &
DPTR_XLBXUS,DPTR_XLBYUS,DPTR_XLBXVS,DPTR_XLBYVS,DPTR_XLBXWS,DPTR_XLBYWS, &
DPTR_XLBXTHS,DPTR_XLBYTHS, &
DPTR_XLBXTKES,DPTR_XLBYTKES, &
DPTR_XLBXRS,DPTR_XLBYRS,DPTR_XLBXSVS,DPTR_XLBYSVS )
!
END IF
!
CALL SECOND_MNH2(ZTIME2)
XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
!* 3. LATERAL BOUNDARY CONDITIONS EXCEPT FOR NORMAL VELOCITY
! ------------------------------------------------------
!
ZTIME1=ZTIME2
!
!* 3.1 Set the lagragian variables values at the LB
!
IF( LLG .AND. IMI==1 ) CALL SETLB_LG
!
IF (CCONF == "START" .OR. (CCONF == "RESTA" .AND. KTCOUNT /= 1 )) THEN
CALL MPPDB_CHECK3DM("before BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
& XUT, XVT, XWT, XTHT, XTKET)
CALL BOUNDARIES ( &
XTSTEP,CLBCX,CLBCY,NRR,NSV,KTCOUNT, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
XRHODJ, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
CALL MPPDB_CHECK3DM("after BOUNDARIES:XUT, XVT, XWT, XTHT, XTKET",PRECISION,&
& XUT, XVT, XWT, XTHT, XTKET)
END IF
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
!
CALL SECOND_MNH2(ZTIME2)
!
XT_BOUND = XT_BOUND + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!* initializes surface number
IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI,.TRUE.)
!-------------------------------------------------------------------------------
!
!* 4. STORAGE IN A SYNCHRONOUS FILE
! -----------------------------
!
ZTIME1 = ZTIME2
!
YFMFILE=' '
DO JOUT = 1,NOUT_NUMB
IF (KTCOUNT == NOUT_TIMES(JOUT)) THEN
IOUT=IOUT+1
GCLOSE_OUT=.TRUE.
INPRAR = 22 +2*(4+NRR+NSV)
WRITE (YNUMBER,FMT="('.',I3.3)") IOUT
YFMFILE=ADJUSTL(ADJUSTR(COUTFILE)//YNUMBER)
!
! search for the corresponding Output of the DAD model
!
IF (NDAD(IMI) == IMI .OR. IMI == 1) THEN
YDADFILE=YFMFILE
ELSE
IOUTDAD=0
DO JOUTDAD =1,JPOUTMAX
IF ( XFMOUT(NDAD(IMI),JOUTDAD) /= XUNDEF .AND. &
XFMOUT(NDAD(IMI),JOUTDAD) <= (XFMOUT(IMI,JOUT)+1.E-10) ) &
IOUTDAD=IOUTDAD+1
END DO
IF(IOUTDAD>0) THEN
WRITE (YDADNUMBER,FMT="('.',I3.3)") IOUTDAD
YDADFILE=ADJUSTL(ADJUSTR(CDAD_NAME(IMI))//YDADNUMBER)
ELSE
WRITE (YDADFILE,FMT="('NO_DAD_FILE')")
END IF
END IF
!
CALL FMOPEN_ll(YFMFILE,'WRITE',CLUOUT,INPRAR,ITYPE,NVERB,ININAR,IRESP)
YDESFM=ADJUSTL(ADJUSTR(YFMFILE)//'.des')
!
CALL WRITE_DESFM_n(IMI,YDESFM,CLUOUT)
#ifdef MNH_NCWRIT
NC_WRITE = LNETCDF
NC_FILE = ''
CALL WRITE_LFIFM_n(YFMFILE,YDADFILE)
COUTFMFILE = YFMFILE
CALL MNHWRITE_ZS_DUMMY_n(CPROGRAM)
IF ( LNETCDF ) THEN
DEF_NC=.FALSE.
CALL WRITE_LFIFM_n(YFMFILE,YDADFILE)
COUTFMFILE = YFMFILE
CALL MNHWRITE_ZS_DUMMY_n(CPROGRAM)
DEF_NC=.TRUE.
END IF
NC_WRITE = .FALSE.
#else
CALL WRITE_LFIFM_n(YFMFILE,YDADFILE)
COUTFMFILE = YFMFILE
CALL MNHWRITE_ZS_DUMMY_n(CPROGRAM)
#endif
IF (CSURF=='EXTE') THEN
CALL GOTO_SURFEX(IMI,.TRUE.)
#ifdef MNH_NCWRIT
NC_WRITE = LNETCDF
NC_FILE = 'sf1'
CALL WRITE_SURF_ATM_n('MESONH','ALL',.FALSE.)
IF ( LNETCDF ) THEN
DEF_NC=.FALSE.
CALL WRITE_SURF_ATM_n('MESONH','ALL',.FALSE.)
DEF_NC=.TRUE.
END IF
#else
CALL WRITE_SURF_ATM_n('MESONH','ALL',.FALSE.)
#endif
END IF
!
! Reinitialize Lagragian variables at every model output
IF (LLG .AND. LINIT_LG .AND. CINIT_LG=='FMOUT') THEN
CALL INI_LG(XXHAT,XYHAT,XZZ,XSVT,XLBXSVM,XLBYSVM)
IF (NVERB>=5) THEN
WRITE(UNIT=ILUOUT,FMT=*) '************************************'
WRITE(UNIT=ILUOUT,FMT=*) '*** Lagrangian variables refreshed after ',TRIM(YFMFILE),' output'
WRITE(UNIT=ILUOUT,FMT=*) '************************************'
END IF
END IF
! Reinitialise mean variables
IF (LMEAN_FIELD) THEN
CALL INI_MEAN_FIELD
END IF
!
END IF
!
END DO
!
CALL SECOND_MNH2(ZTIME2)
!
XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
!* 5. INITIALIZATION OF THE BUDGET VARIABLES
! --------------------------------------
!
IF (NBUMOD==IMI) THEN
LBU_ENABLE = CBUTYPE /='NONE'.AND. CBUTYPE /='SKIP'
ELSE
LBU_ENABLE = .FALSE.
END IF
!
IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
CALL SET_MASK
IF (LBU_RU) XBURHODJU(:,NBUTIME,:) = XBURHODJU(:,NBUTIME,:) &
+ MASK_COMPRESS(MXM(XRHODJ))
IF (LBU_RV) XBURHODJV(:,NBUTIME,:) = XBURHODJV(:,NBUTIME,:) &
+ MASK_COMPRESS(MYM(XRHODJ))
IF (LBU_RW) XBURHODJW(:,NBUTIME,:) = XBURHODJW(:,NBUTIME,:) &
+ MASK_COMPRESS(MZM(1,IKU,1,XRHODJ))
IF (ALLOCATED(XBURHODJ)) &
XBURHODJ (:,NBUTIME,:) = XBURHODJ (:,NBUTIME,:) &
+ MASK_COMPRESS(XRHODJ)
IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
IF (LBU_RU) XBURHODJU(:,:,:) = XBURHODJU(:,:,:) &
+ CART_COMPRESS(MXM(XRHODJ))
IF (LBU_RV) XBURHODJV(:,:,:) = XBURHODJV(:,:,:) &
+ CART_COMPRESS(MYM(XRHODJ))
IF (LBU_RW) XBURHODJW(:,:,:) = XBURHODJW(:,:,:) &
+ CART_COMPRESS(MZM(1,IKU,1,XRHODJ))
IF (ALLOCATED(XBURHODJ)) &
XBURHODJ (:,:,:) = XBURHODJ (:,:,:) &
+ CART_COMPRESS(XRHODJ)
END IF
!
CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
LUSERI, LUSERS, LUSERG, LUSERH )
!
XTIME_BU = 0.0
!