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.
! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/diag.f90,v $ $Revision: 1.3.2.4.2.4.2.5.2.6.2.3.2.6 $ $Date: 2015/11/26 14:55:02 $
6
7
8
9
10
11
12
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
!-----------------------------------------------------------------
! ############
PROGRAM DIAG
! ############
!
!!****
!!
!! PURPOSE
!! -------
!
!!** METHOD
!! ------
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! MODD_DYN
!! MODD_CONF
!! MODD_PARAMETERS
!! MODD_CONF_n
!! MODD_DYN_n
!! MODD_DIM_n
!! MODD_ADV_n
!! MODD_FIELD_n
!! MODD_GRID_n
!! MODD_LBC_n
!! MODD_PARAM_n
!! MODD_REF_n
!! MODD_LUNIT_n
!! MODD_OUT_n
!! MODD_TIME_n
!! MODD_TURB_n
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! E. Richard * LA *
!!
!! MODIFICATIONS
!! -------------
!!
!! 15/03/99 (V. Masson) call to PHYS_PARAM1 and new PGD fields
!! 08/06/01 (F. Meleux) call to diagnostics for chemistry
!! 13/07/01 (J Stein) trajectory computation
!! 15/10/01 (I.Mallet) allow namelists in different orders
!! 05/02/02 (G.Jaubert) aircraft and balloon computation
!! 15/03/02 (F Solmon) replace NMODE by NRAD_DIAG
!! 29/11/02 (J.-P. Pinty) add C3R5, ICE2, ICE4, ELEC
!! 15/04/03 (J.-P. Chaboureau) add LRAD_SUBG_COND
!! 01/2004 (Masson) surface externalization
!! 19/03/2008 (J.Escobar) rename INIT to INIT_MNH --> grib problem
!! 04/2008 (O. Caumont) radar simulator
!! 10/2009 (C.Lac) Correction on FIT temporal scheme for variables
!! advected with PPM
!! 03/2010 (G.Tanguy) Clean up of unuseful variables
!! 05/2010 Add lidar
!!! 03/2012 (S. Bielli) Add NAM_NCOUT for netcdf output (removed 11/07/2016)
!! 03/2013 (O.Caumont) Modif call aircraft_balloon
!! 03/2013 (C. Augros) Add variables for radar simulator in NAMELIST:
!! NBAZIM,LSNRT,XSNRMIN
!! D.Ricard 2015 : add LMOIST_ES
!! July, 2015 (O.Nuissier/F.Duffourg) Add microphysics diagnostic for

Gaelle Tanguy
committed
!! aircraft, ballon and profiler
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! P.Tulet : 11/2015 : new diagnostic for aerosol
!! 09/2015 (S. Bielli) Add netcdf call for phys_param
!! 04/2016 (G.Delautier) replace print by write in OUTPUT LISTING
!! 11/07/2016 (P.Wautelet) removed MNH_NCWRIT define
!! 10/2016 (C.LAC) add LVISI

Gaelle DELAUTIER
committed
!! 10/2016 (F Brosse) Add prod/loss terms computation for chemistry

Gaelle DELAUTIER
committed
!! 10/2017 (G.Delautier) New boundary layer height : replace LBLTOP by CBLTOP
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_VAR_ll
!
USE MODD_DYN
USE MODD_CONF
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_LUNIT
USE MODD_PARAMETERS
!
USE MODD_DIAG_FLAG
USE MODD_STO_FILE
!
USE MODD_CONF_n
USE MODD_DIM_n
USE MODD_DYN_n
USE MODD_ADV_n
USE MODD_DEEP_CONVECTION_n
USE MODD_FIELD_n
USE MODD_GRID_n

WAUTELET Philippe
committed
USE MODD_IO_ll, ONLY: NIO_VERB,NVERB_DEBUG
USE MODD_LBC_n
USE MODD_PARAM_n
USE MODD_PARAM_KAFR_n
USE MODD_PARAM_RAD_n
USE MODD_RADIATIONS_n
USE MODD_TURB_n
USE MODD_PARAM_MFSHALL_n
USE MODD_REF_n
USE MODD_LUNIT_n
USE MODD_OUT_n
USE MODD_TIME_n
USE MODD_NESTING, ONLY: CDAD_NAME
USE MODD_NSV
USE MODD_AIRCRAFT_BALLOON
USE MODD_TIME
USE MODD_GR_FIELD_n
USE MODD_LES
USE MODD_LES_BUDGET
USE MODD_BUDGET
USE MODD_RADAR

WAUTELET Philippe
committed
USE MODD_IO_ll, ONLY: LIOCDF4,LLFIOUT,TFILEDATA,TFILE_SURFEX
!
USE MODN_DIAG_BLANK
!
USE MODI_PHYS_PARAM_n
USE MODI_WRITE_LFIFM1_FOR_DIAG
USE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
USE MODI_COMPUTE_R00
USE MODI_WRITE_LFIFMN_FORDIACHRO_n
USE MODI_AIRCRAFT_BALLOON
USE MODI_WRITE_AIRCRAFT_BALLOON
!
USE MODE_POS
USE MODE_TIME
USE MODE_FM
USE MODE_FMWRIT, ONLY : IO_WRITE_HEADER

WAUTELET Philippe
committed
USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_ADD2LIST,IO_FILE_PRINT_LIST
USE MODE_ll
USE MODE_MODELN_HANDLER

WAUTELET Philippe
committed
USE MODE_MSG
!
USE MODD_AIRCRAFT_BALLOON
USE MODD_PROFILER_n
USE MODD_STATION_n
USE MODE_MNH_TIMING
USE MODE_FMREAD
USE MODN_CONFZ
!
USE MODI_MNHGET_SURF_PARAM_n
!
USE MODI_VERSION
USE MODI_INIT_MNH
USE MODI_MENU_DIACHRO
USE MODI_WRITE_SURF_ATM_N
USE MODI_DIAG_SURF_ATM_N
USE MODI_WRITE_DIAG_SURF_ATM_N
USE MODD_MNH_SURFEX_n
USE MODN_CONF, ONLY : JPHEXT , NHALO

WAUTELET Philippe
committed
USE MODN_CONFIO, ONLY : NAM_CONFIO
IMPLICIT NONE
!
!* 0.1 declarations of local variables
!
TYPE(DATE_TIME) :: TXDTBAL ! current time and date for BALLOON and AIRCRAFT trajectories
CHARACTER (LEN=28), DIMENSION(1) :: YINIFILE ! names of the INPUT FM-file
CHARACTER (LEN=28), DIMENSION(1) :: YINIFILEPGD ! names of the INPUT FM-file
CHARACTER (LEN=5) :: YSUFFIX ! character string for the OUTPUT FM-file number
CHARACTER (LEN=4) :: YRAD ! initial flag to call to radiation schemes
CHARACTER (LEN=4) :: YDCONV ! initial flag to call to deep convection schemes
CHARACTER (LEN=4) :: YSCONV ! initial flag to call to shallow convection schemes
CHARACTER (LEN=4) :: YTURB ! initial flag to call to turbulence schemes
CHARACTER (LEN=40) :: YFMT,YFMT2! format for cpu analysis printing
INTEGER :: IRESP ! return code in FM routines
INTEGER :: ILUOUT0 ! Logical unit number for the output listing
REAL*8,DIMENSION(2) :: ZTIME0,ZTIME1,ZTIME2,ZRAD,ZDCONV,ZSHADOWS,ZGROUND, &
ZTRACER,ZDRAG,ZTURB,ZMAFL,ZCHEM,ZTIME_BU ! CPU time
REAL*8,DIMENSION(2) :: ZSTART,ZINIT,ZWRIT,ZBALL,ZPHYS,ZSURF,ZWRITS,ZTRAJ ! storing variables
INTEGER(KIND=LFI_INT) :: INPRAR ! number of articles predicted in the LFIFM file
LOGICAL :: GCLOSE_OUT = .FALSE. ! conditional closure of the OUTPUT FM-file
INTEGER :: ISTEPBAL ! loop indice for balloons and aircraft
INTEGER :: ILUNAM ! Logical unit numbers for the namelist file
! and for output_listing file
CHARACTER (LEN=9) :: YNAM ! name of the namelist file
INTEGER :: JF =0 ! loop index
LOGICAL :: GFOUND ! Return code when searching namelist
LOGICAL, DIMENSION(:,:),ALLOCATABLE :: GMASKkids ! kids domains mask
LOGICAL:: GCLOUD_ONLY ! conditionnal radiation computations for
! the only cloudy columns
!
INTEGER :: IIU, IJU, IKU
INTEGER :: IINFO_ll ! return code for _ll routines
REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA,ZTOWN
REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZWETDEPAER

WAUTELET Philippe
committed
!
NAMELIST/NAM_DIAG/ CISO, LVAR_RS, LVAR_LS, &
NCONV_KF, NRAD_3D, CRAD_SAT, NRTTOVINFO, LRAD_SUBG_COND, &
LVAR_TURB,LTURBFLX,LTURBDIAG,LMFFLX,XDTSTEP, &
LVAR_MRW, LVAR_MRSV, LVAR_FRC, &
LTPZH, LMOIST_V, LMOIST_E,LMOIST_ES, LCOREF, &
LVORT, LDIV, LMEAN_POVO, XMEAN_POVO, &
LGEO, LAGEO, LWIND_ZM, LMSLP, LTHW, &
LCLD_COV, LVAR_PR, LTOTAL_PR, LMEAN_PR, XMEAN_PR, &

Gaelle DELAUTIER
committed
NCAPE, LBV_FR, LRADAR, CBLTOP, LTRAJ, &
LDIAG,XDIAG,LCHEMDIAG,LCHAQDIAG,XCHEMLAT,XCHEMLON,&

Gaelle DELAUTIER
committed
CSPEC_BU_DIAG,CSPEC_DIAG,LAIRCRAFT_BALLOON,NTIME_AIRCRAFT_BALLOON,&
XSTEP_AIRCRAFT_BALLOON,&
XLAT_BALLOON,XLON_BALLOON,XALT_BALLOON,&
LC2R2, LC3R5, LELECDIAG, CAERDIAG, &
NGPS,XLAT_GPS,XLON_GPS,XZS_GPS,CNAM_GPS,XDIFFORO, &
NVERSION_RAD, NCURV_INTERPOL, LCART_RAD, CARF,LREFR,LDNDZ,&
XLON_RAD,XLAT_RAD,XALT_RAD,CNAME_RAD,XLAM_RAD,XDT_RAD, &
NDIFF,LATT,NPTS_GAULAG,NPTS_H,NPTS_V,XSTEP_RAD,NBSTEPMAX,NBAZIM, &
XGRID,NBELEV,XELEV,NBRAD,LQUAD,LFALL,LWBSCS,LWREFL,&
XREFLMIN,XREFLVDOPMIN,LSNRT,XSNRMIN,&
LLIDAR,CVIEW_LIDAR,XALT_LIDAR,XWVL_LIDAR,&
LISOPR,XISOPR,LISOTH,XISOTH, LHU_FLX,LVISI, LLIMA_DIAG
!
NAMELIST/NAM_DIAG_FILE/ YINIFILE,YINIFILEPGD, YSUFFIX
NAMELIST/NAM_STO_FILE/ CFILES, NSTART_SUPP
NAMELIST/NAM_CONF_DIAG/JPHEXT, NHALO
!
!-------------------------------------------------------------------------------
!
!* 0.0 Initializations
! ---------------
!
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
!
CALL GOTO_MODEL(1)
!
CALL VERSION
CPROGRAM='DIAG '
!
CALL INITIO_ll()
CALL SECOND_MNH2(ZTIME1)
ZTIME0=ZTIME1
!
! initialization of logical for the diagnostics
!
CISO='PREVTK'
LVAR_RS=.TRUE.
LVAR_LS=.FALSE.
NCONV_KF=-1
NRAD_3D=-1
CRAD_SAT=' '
LRAD_SUBG_COND=.TRUE.
NRTTOVINFO(:,:)=NUNDEF
LVAR_TURB=.FALSE.
LTURBFLX=.FALSE.
LTURBDIAG=.FALSE.
LMFFLX=.FALSE.
XDTSTEP=XUNDEF
LVAR_MRW=.FALSE.
LVAR_MRSV=.FALSE.
LTPZH=.FALSE.
LMOIST_V=.FALSE.
LMOIST_E=.FALSE.
LCOREF=.FALSE.
LVORT=.FALSE.
LDIV=.FALSE.
LMEAN_POVO=.FALSE.
XMEAN_POVO(1)=15000
XMEAN_POVO(2)=50000
LGEO=.FALSE.
LAGEO=.FALSE.
LWIND_ZM=.FALSE.
LMSLP=.FALSE.
LTHW=.FALSE.
LCLD_COV=.FALSE.
LVAR_PR=.FALSE.
LTOTAL_PR=.FALSE.
LHU_FLX=.FALSE.
LMEAN_PR=.FALSE.
XMEAN_PR(1:2)=1.
NCAPE=-1
LBV_FR=.FALSE.
LRADAR=.FALSE.

Gaelle DELAUTIER
committed
CBLTOP='NONE'
LVAR_FRC=.FALSE.
LCHEMDIAG=.FALSE.
LCHAQDIAG=.FALSE.
XCHEMLAT(:)=XUNDEF
XCHEMLON(:)=XUNDEF

Gaelle DELAUTIER
committed
CSPEC_BU_DIAG=''
CSPEC_DIAG=''
!
LAIRCRAFT_BALLOON=.FALSE.
NTIME_AIRCRAFT_BALLOON=NUNDEF
XSTEP_AIRCRAFT_BALLOON=XUNDEF
XLAT_BALLOON(:)=XUNDEF
XLON_BALLOON(:)=XUNDEF
XALT_BALLOON(:)=XUNDEF
!
NGPS=-1
CNAM_GPS(:)=''
XLAT_GPS(:)=XUNDEF
XLON_GPS(:)=XUNDEF
XZS_GPS(:)=-999.0
XDIFFORO=150.0
!! initialization of radar parameters
NVERSION_RAD=1
XSTEP_RAD=XUNDEF
NCURV_INTERPOL=0
LCART_RAD=.TRUE.
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
XLON_RAD(:)=XUNDEF
XLAT_RAD(:)=XUNDEF
XALT_RAD(:)=XUNDEF
CNAME_RAD(:)="UNDEF"
XLAM_RAD(:)=XUNDEF
XDT_RAD(:)=XUNDEF
XELEV(:,:)=XUNDEF
NBSTEPMAX=-1
LATT=.FALSE.
LQUAD=.FALSE.
NPTS_H=1
NPTS_V=1
CARF="PB70"
LREFR=.FALSE.
LDNDZ=.FALSE.
NCURV_INTERPOL=0
LCART_RAD=.TRUE.
NDIFF=0
NPTS_GAULAG=7
XGRID=2000.
LQUAD=.FALSE.
NDGS=2
LFALL=.FALSE.
LWREFL=.FALSE.
LWBSCS=.FALSE.
XREFLMIN=-30.
XREFLVDOPMIN=-990.
LSNRT=.TRUE.
XSNRMIN=0
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
!
LDIAG(:)=.FALSE.
XDIAG(:)=XUNDEF
!
YINIFILE(:) = ' '
YINIFILEPGD(:) = ' '
YSUFFIX='_DIAG'
!
CFILES(:) = ' '
NSTART_SUPP(:) = NUNDEF
!
LLIDAR=.FALSE.
CVIEW_LIDAR='NADIR'
XALT_LIDAR=0
XWVL_LIDAR=0.532E-6
!
LISOPR=.FALSE.
XISOPR(:)=0.
LISOTH=.FALSE.
XISOTH(:)=0.
!
!-------------------------------------------------------------------------------
!
!* 1.0 Namelist reading
! ----------------
!
YNAM = 'DIAG1.nam'
CALL OPEN_ll (UNIT=ILUNAM,FILE=YNAM,IOSTAT=IRESP,STATUS="OLD",ACTION='READ', &

WAUTELET Philippe
committed
FORM="FORMATTED",POSITION="REWIND",MODE='GLOBAL')
!
!
CALL POSNAM(ILUNAM,'NAM_DIAG',GFOUND)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_DIAG)
END IF
!
CALL POSNAM(ILUNAM,'NAM_DIAG_BLANK',GFOUND)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_DIAG_BLANK)
END IF
!
CALL POSNAM(ILUNAM,'NAM_DIAG_FILE',GFOUND)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_DIAG_FILE)
END IF
!
CALL POSNAM(ILUNAM,'NAM_STO_FILE',GFOUND)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_STO_FILE)
END IF
CALL POSNAM(ILUNAM,'NAM_CONFZ',GFOUND)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_CONFZ)
END IF
CALL POSNAM(ILUNAM,'NAM_CONFIO',GFOUND)
IF (GFOUND) THEN
READ(UNIT=ILUNAM,NML=NAM_CONFIO)
END IF

WAUTELET Philippe
committed
CALL SET_CONFIO_ll()
!
CALL CLOSE_ll(YNAM)
!
CINIFILE = YINIFILE(1)
CINIFILEPGD = YINIFILEPGD(1)
!!
IF (LTRAJ) THEN
JF=1
DO WHILE (LEN_TRIM(CFILES(JF))/=0)
JF=JF+1
END DO
!
IF (JF/=1) THEN
IF (CINIFILE==CFILES(JF-1)) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','DIAG','initial file not treated')
END IF
END IF
!
END IF
!
!
!-------------------------------------------------------------------------------
!
!* 2.0 MESONH file
! -----------
!
IF ( LEN_TRIM(CINIFILE)==0 ) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','DIAG','LEN_TRIM(CINIFILE)==0')
ENDIF
!
INPRAR = 24 +2*(4+NRR+NSV)

WAUTELET Philippe
committed
COUTFMFILE=TRIM(CINIFILE)//YSUFFIX

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(TINIFILE,TRIM(CINIFILE)//YSUFFIX,'DIAG','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)

WAUTELET Philippe
committed
!
CALL IO_FILE_OPEN_ll(TINIFILE)

WAUTELET Philippe
committed
!
CALL SECOND_MNH2(ZTIME2)
ZSTART=ZTIME2-ZTIME1
ZTIME1=ZTIME2
!-------------------------------------------------------------------------------
!
!* 3.0 Fields initialization
!
CALL INIT_MNH
!
!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) '****************************************'
WRITE(ILUOUT0,*) 'Treatment of file: ',CINIFILE
WRITE(ILUOUT0,*) '****************************************'
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=NKMAX+2*JPVEXT
!
!* allocation of variables used
!
ALLOCATE(GMASKkids (IIU,IJU))
ALLOCATE(ZWETDEPAER (IIU,IJU,IKU,NSV_AER))
GMASKkids(:,:)=.FALSE.
!
CALL INI_DIAG_IN_RUN(IIU,IJU,IKU,LFLYER,LSTATION,LPROFILER)
!
CALL SECOND_MNH2(ZTIME2)
ZINIT =ZTIME2-ZTIME1
ZTIME1=ZTIME2
!
IF (LRADAR .AND. NVERSION_RAD==2 .AND. NPROC/=1) THEN
PRINT*, '***************************************'
PRINT*, ' WITH NVERSION_RAD=2, DIAG HAS TO BE &
& PERFORMED WITH MONOPROCESSOR MODE '
PRINT*, '-> JOB ABORTED'
PRINT*, '***************************************'
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','DIAG','')
ENDIF
!-------------------------------------------------------------------------------
!
!* 4.0 Stores the fields in MESONH files if necessary
!

WAUTELET Philippe
committed
CALL WRITE_LFIFM1_FOR_DIAG(TINIFILE,CDAD_NAME(1))
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER WRITE_LFIFM1_FOR_DIAG'
WRITE(ILUOUT0,*) ' '
!
CALL SECOND_MNH2(ZTIME2)
ZWRIT =ZTIME2-ZTIME1
ZTIME1=ZTIME2
!-------------------------------------------------------------------------------
!
!* 4.1 BALLOON and AIRCRAFT
!
IF ( LAIRCRAFT_BALLOON ) THEN
!
CALL IO_FILE_ADD2LIST(TZDIACFILE,TRIM(CINIFILE)//'BAL','DIACHRONIC','WRITE',KLFINPRAR=INPRAR,KLFITYPE=1,KLFIVERB=NVERB)
!
CALL IO_FILE_OPEN_ll(TZDIACFILE)
!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER OPEN DIACHRONIC FILE'
WRITE(ILUOUT0,*) ' '
!
TXDTBAL%TDATE%YEAR = TDTCUR%TDATE%YEAR
TXDTBAL%TDATE%MONTH = TDTCUR%TDATE%MONTH
TXDTBAL%TDATE%DAY = TDTCUR%TDATE%DAY
TXDTBAL%TIME = TDTCUR%TIME - NTIME_AIRCRAFT_BALLOON/2.
CALL SUBTRACT_TO_DATE(TXDTBAL%TDATE%YEAR, &
TXDTBAL%TDATE%MONTH,&
TXDTBAL%TDATE%DAY, &
TXDTBAL%TIME )
!
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ZSEA(:,:) = 0.
ZTOWN(:,:)= 0.
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
DO ISTEPBAL=1,NTIME_AIRCRAFT_BALLOON,INT(XSTEP_AIRCRAFT_BALLOON)
!
CALL AIRCRAFT_BALLOON(CLUOUT,XSTEP_AIRCRAFT_BALLOON, &
TDTEXP, TDTMOD, TDTCUR, TXDTBAL, &
XXHAT, XYHAT, XZZ, XMAP, XLONORI, XLATORI, &
XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, &
!
!-----------------------------
!
TXDTBAL%TIME=TXDTBAL%TIME + XSTEP_AIRCRAFT_BALLOON
CALL ADD_FORECAST_TO_DATE(TXDTBAL%TDATE%YEAR, &
TXDTBAL%TDATE%MONTH,&
TXDTBAL%TDATE%DAY, &
TXDTBAL%TIME )
ENDDO

WAUTELET Philippe
committed
CALL IO_WRITE_HEADER(TZDIACFILE)
CALL WRITE_LFIFMN_FORDIACHRO_n(TZDIACFILE)
CALL WRITE_AIRCRAFT_BALLOON(TZDIACFILE)
CALL MENU_DIACHRO(TZDIACFILE,CLUOUT,'END')
CALL IO_FILE_CLOSE_ll(TZDIACFILE)
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER CLOSE DIACHRONIC FILE'
WRITE(ILUOUT0,*) ' '
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
584
585
586
587
588
589
590
591
592
593
594
END IF
!
CALL SECOND_MNH2(ZTIME2)
ZBALL =ZTIME2-ZTIME1
ZTIME1=ZTIME2
!-------------------------------------------------------------------------------
!
!* 5.0 Call to physics
!
!* initialise the source terms
!
XRUS (:,:,:) = 0.
XRVS (:,:,:) = 0.
XRWS (:,:,:) = 0.
XRTHS(:,:,:) = 0.
IF (NRR>=1) XRRS (:,:,:,:) = 0.
IF (NSV>=1) XRSVS (:,:,:,:) = 0.
IF (CTURB /= 'NONE') XRTKES(:,:,:) = 0.
!
!* stores the initial flags
!
YTURB = CTURB
YDCONV = CDCONV
YSCONV = CSCONV
YRAD = CRAD
!
!* turbulence scheme
!
LTURB_DIAG=LTURBDIAG
LTURB_FLX =LTURBFLX
LMF_FLX =LMFFLX
! no need to recompute the turbulent tendencies.
IF ( .NOT. LTURB_FLX .AND. .NOT. LTURB_DIAG .AND. &
.NOT. LMF_FLX ) THEN
CTURB = 'NONE'
END IF
! no way to compute the turbulent tendencies.
!IF ( ( LTURB_FLX .OR. LTURB_DIAG .OR. LMF_FLX ) &
! .AND. CSTORAGE_TYPE/='MT' ) THEN
! CTURB = 'NONE'
! PRINT*, '******************* WARNING in DIAG ***********************'
! PRINT*, ' '
! PRINT*, 'You wanted to compute turbulence fluxes or diagnostics,'
! PRINT*, 'But the initial file comes from PREP_REAL_CASE.'
! PRINT*, 'Therefore, the boundary layer turbulence is meaningless.'
! PRINT*, 'Turbulence fluxes and diagnostics will NOT be computed'
! PRINT*, 'Please make your turbulence diagnostics from a meso-NH file'
! PRINT*, 'coming from a MESO-NH simulation.'
!END IF
!
!* convective scheme
!
IF (NCONV_KF == -1) CDCONV = 'NONE'
!
IF (NCONV_KF >= 0 ) THEN
CALL SM_PRINT_TIME(TDTCUR,CLUOUT0,'CURRENT TIME ')
CALL SM_PRINT_TIME(TDTDCONV,CLUOUT0,'LAST CONVECTION CALL')
CDCONV='KAFR'
LDIAGCONV= .TRUE.
TDTDCONV=TDTCUR
END IF
!
!* radiation scheme
!
IF (NRAD_3D == -1) CRAD = 'NONE'
!
IF (NRAD_3D >= 0) THEN
IF (YRAD=='ECMW') THEN
! radiative fields are already initialized by INIT
CRAD = 'NONE'
ELSE
CRAD = 'ECMW'
ENDIF
IF (NRAD_3D >= 1) THEN
NRAD_DIAG = NRAD_3D
CRAD = 'ECMW' ! radiation scheme is called to compute extra diags
END IF
END IF
!
IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. YRAD/='ECMW') THEN
CRAD = 'ECMW'
END IF
!
!
IF ( CTURB /= 'NONE' .OR. CDCONV /= 'NONE' .OR. CSCONV /= 'NONE' &
.OR. CRAD /= 'NONE' ) THEN
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) '******************* WARNING in DIAG ***********************'
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'You asked for diagnostics that need to call the physics monitor:'
WRITE(ILUOUT0,*) ' be aware of the time step used'
WRITE(ILUOUT0,*) 'you can modify it with XDTSTEP in namelist NAM_DIAG'
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*)' XTSTEP= ', XTSTEP
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG BEFORE PHYS_PARAM1: CTURB=',CTURB,' CDCONV=',CDCONV, &
' CSCONV=',CSCONV,' CRAD=',CRAD
END IF
!
!* call to physics monitor
!
GCLOSE_OUT=.TRUE.
ZRAD=0.
ZSHADOWS=0.
ZDCONV=0.
ZGROUND=0.
ZTRACER=0.
ZTURB=0.
ZDRAG=0.
ZMAFL=0.
ZCHEM=0.
XTIME_LES=0.
XTIME_LES_BU_PROCESS=0.
XTIME_BU_PROCESS=0.

WAUTELET Philippe
committed
CALL PHYS_PARAM_n(1,TINIFILE,GCLOSE_OUT, &

WAUTELET Philippe
committed
ZRAD,ZSHADOWS,ZDCONV,ZGROUND,ZMAFL,ZDRAG, &
ZTURB,ZTRACER, ZTIME_BU,ZWETDEPAER,GMASKkids,GCLOUD_ONLY)
WRITE(ILUOUT0,*) 'DIAG AFTER PHYS_PARAM1'
IF (LCHEMDIAG) THEN
CALL CH_MONITOR_n(ZWETDEPAER,1,XTSTEP, ILUOUT0, NVERB)
END IF
!
!* restores the initial flags
!
CTURB = YTURB
CDCONV = YDCONV
CRAD = YRAD
!
CALL SECOND_MNH2(ZTIME2)
ZPHYS =ZTIME2-ZTIME1
ZTIME1=ZTIME2
!-------------------------------------------------------------------------------
!
!* 6.0 Surface diagnostics
!
IF (CSURF=='EXTE') THEN

WAUTELET Philippe
committed
TFILE_SURFEX => TINIFILE
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
CALL DIAG_SURF_ATM_n(YSURF_CUR%IM%DGEI, YSURF_CUR%FM%DGF, YSURF_CUR%DGL, YSURF_CUR%IM%DGI, &
YSURF_CUR%SM%DGS, YSURF_CUR%DGU, YSURF_CUR%TM%DGT, YSURF_CUR%WM%DGW, &
YSURF_CUR%U, YSURF_CUR%USS,'MESONH')
CALL WRITE_DIAG_SURF_ATM_n(YSURF_CUR,'MESONH','ALL')

WAUTELET Philippe
committed
NULLIFY(TFILE_SURFEX)
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER WRITE_DIAG_SURF_ATM_n'
ENDIF
!
CALL SECOND_MNH2(ZTIME2)
ZSURF =ZTIME2-ZTIME1
ZTIME1=ZTIME2
!
!-------------------------------------------------------------------------------
!
!* 7.0 Stores other fields in MESONH files if necessary
!

WAUTELET Philippe
committed
CALL WRITE_LFIFM1_FOR_DIAG_SUPP(TINIFILE)
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER WRITE_LFIFM1_FOR_DIAG_SUPP'
!
CALL SECOND_MNH2(ZTIME2)
ZWRITS=ZTIME2-ZTIME1
ZTIME1=ZTIME2
!-------------------------------------------------------------------------------
!
!* 8.0 Initial positions computation (back into simulation segments)
!

WAUTELET Philippe
committed
IF (LTRAJ .AND. JF/=1) CALL COMPUTE_R00(TINIFILE)
!
CALL SECOND_MNH2(ZTIME2)
ZTRAJ =ZTIME2-ZTIME1
ZTIME1=ZTIME2
!-------------------------------------------------------------------------------
!
!* 9.0 Closes the FM files
!
DEALLOCATE(ZWETDEPAER)
IF (GCLOSE_OUT) THEN
GCLOSE_OUT=.FALSE.
CALL IO_FILE_CLOSE_ll(TINIFILE)
!
CALL SECOND_MNH2(ZTIME2)
ZTIME2=ZTIME2-ZTIME0
!-------------------------------------------------------------------------------
!
!WRITE(ILUOUT0,*) '+--------------------------------------------------------------+'
!WRITE(ILUOUT0,*) '| |'
!WRITE(ILUOUT0,*) '| COMPUTING TIME ANALYSIS in DIAG |'
!WRITE(ILUOUT0,*) '| |'
!WRITE(ILUOUT0,*) '|--------------------------------------------------------------|'
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
!WRITE(ILUOUT0,*) '| | | |'
!WRITE(ILUOUT0,*) '| ROUTINE NAME | CPU-TIME | PERCENTAGE % |'
!WRITE(ILUOUT0,*) '| | | |'
!WRITE(ILUOUT0,*) '|---------------------| -------------------|-------------------|'
!WRITE(ILUOUT0,*) '| | | |'
!YFMT='(A,F9.3,A,F9.3,A)'
!YFMT2='(A,A4,A,F9.3)'
!WRITE(ILUOUT0,YFMT) '| START | ',ZSTART,' | ',100.*ZSTART/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| INIT | ',ZINIT,' | ',100.*ZINIT/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| WRIT | ',ZWRIT,' | ',100.*ZWRIT/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| BALL | ',ZBALL,' | ',100.*ZBALL/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| PHYS | ',ZPHYS,' | ',100.*ZPHYS/ZTIME2,' |'
!IF (ZRAD>0.) &
! WRITE(ILUOUT0,YFMT2) '| ',CRAD,' | ',ZRAD
!IF (ZDCONV>0.) &
! WRITE(ILUOUT0,YFMT2) '| ',CDCONV,' | ',ZDCONV
!IF (ZGROUND>0.) &
! WRITE(ILUOUT0,YFMT2) '| ',CSURF,' | ',ZGROUND
!IF (ZTRACER>0.) &
! WRITE(ILUOUT0,YFMT2) '| LCONDSAMP and LPASPOL | ',ZTRACER
!IF (ZMAFL>0.) &
! WRITE(ILUOUT0,YFMT2) '| ',CSCONV,' | ',ZMAFL
!IF (ZDRAG>0.) &
! WRITE(ILUOUT0,YFMT2) '| DRAGTREE | ',ZDRAG
!IF (ZTURB>0.) &
! WRITE(ILUOUT0,YFMT2) '| ',CTURB,' | ',ZTURB
!IF (ZCHEM>0.) &
! WRITE(ILUOUT0,'(A,F9.3)') '| CHEM | ',ZCHEM
!WRITE(ILUOUT0,YFMT) '| SURF | ',ZSURF,' | ',100.*ZSURF/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| WRITS | ',ZWRITS,' | ',100.*ZWRITS/ZTIME2,' |'
!WRITE(ILUOUT0,YFMT) '| TRAJ | ',ZTRAJ,' | ',100.*ZTRAJ/ZTIME2,' |'
!WRITE(ILUOUT0,*) '| | | |'
!WRITE(ILUOUT0,*) '|---------------------| -------------------|-------------------|'
!
!

WAUTELET Philippe
committed
IF(NIO_VERB>=NVERB_DEBUG) CALL IO_FILE_PRINT_LIST()
!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) '***************************** **************'
WRITE(ILUOUT0,*) '* EXIT DIAG CORRECTLY *'
WRITE(ILUOUT0,*) '**************************** ***************'
!WRITE(ILUOUT0,*) ' (see time analysis in ',TRIM(TLUOUT0%CNAME),' )'
WRITE(ILUOUT0,*) ' '

WAUTELET Philippe
committed
!
!-------------------------------------------------------------------------------
!
!* 10. FINALIZE THE PARALLEL SESSION
! -----------------------------
!
CALL END_PARA_ll(IINFO_ll)
!
!-------------------------------------------------------------------------------
END PROGRAM DIAG