Skip to content
Snippets Groups Projects
write_profilern.f90 22 KiB
Newer Older
  • Learn to ignore specific revisions
  • !MNH_LIC Copyright 2002-2021 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.
    
    !-----------------------------------------------------------------
    !      ###########################
    MODULE MODI_WRITE_PROFILER_n
    !      ###########################
    !
    INTERFACE
    !
    
          SUBROUTINE WRITE_PROFILER_n(TPDIAFILE)
    
    !
    TYPE(TFILEDATA),  INTENT(IN) :: TPDIAFILE ! diachronic file to write
    
    !
    END SUBROUTINE WRITE_PROFILER_n
    !
    END INTERFACE
    !
    END MODULE MODI_WRITE_PROFILER_n
    !
    !     ##########################################
    
          SUBROUTINE WRITE_PROFILER_n(TPDIAFILE)
    
    !     ##########################################
    !
    !
    !!****  *WRITE_PROFILER* - write the balloon and aircraft trajectories and records
    !!                      in the diachronic file
    !!
    !!    PURPOSE
    !!    -------
    !
    !
    !!**  METHOD
    !!    ------
    !!    
    !!
    !!
    !!
    !!
    !!    EXTERNAL
    !!    --------
    !!
    !!    IMPLICIT ARGUMENTS
    !!    ------------------
    !!
    !!    REFERENCE
    !!    ---------
    !!
    !!    AUTHOR
    !!    ------
    !!      Pierre TULET             * Meteo-France *
    !!
    !!    MODIFICATIONS
    !!    -------------
    !!     Original 15/02/2002
    
    !  G. Delautier      2016: LIMA
    !  C. Lac         10/2016: add visibility diagnostics for fog
    !  P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
    !  J. Escobar  16/08/2018: From Pierre & Maud , correction use CNAMES(JSV-NSV_CHEMBEG+1)
    
    !  P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
    
    !  P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
    
    !  P. Wautelet 03/03/2021: budgets: add tbudiachrometadata type (useful to pass more information to Write_diachro)
    
    !  P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
    
    ! --------------------------------------------------------------------------
    !
    
    !*      0. DECLARATIONS
    !          ------------
    !
    USE MODD_CST
    
    USE MODD_LUNIT
    USE MODD_PARAMETERS
    !
    USE MODD_TYPE_PROFILER
    USE MODD_PROFILER_n
    USE MODD_CH_M9_n,         ONLY: CNAMES
    USE MODD_CH_AEROSOL,      ONLY: CAERONAMES, LORILAM, JPMODE
    USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
    USE MODD_ICE_C1R3_DESCR,  ONLY: C1R3NAMES
    USE MODD_ELEC_DESCR,      ONLY: CELECNAMES
    USE MODD_LG,              ONLY: CLGNAMES
    USE MODD_DUST,            ONLY: CDUSTNAMES, LDUST, NMODE_DST
    USE MODD_SALT,            ONLY: CSALTNAMES, LSALT
    USE MODD_NSV
    
    USE MODD_DIAG_IN_RUN
    
    !
    USE MODE_AERO_PSD
    
    use mode_write_diachro,   only: Write_diachro
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
    USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
    USE MODD_PARAM_LIMA     , ONLY: NINDICE_CCN_IMM,NMOD_CCN,NMOD_IFN,NMOD_IMM
    
    !
    IMPLICIT NONE
    !
    !
    !*      0.1  declarations of arguments
    !
    
    TYPE(TFILEDATA),  INTENT(IN) :: TPDIAFILE ! diachronic file to write
    
    !
    !-------------------------------------------------------------------------------
    !
    !       0.2  declaration of local variables
    !
    INTEGER     ::  II  ! loop
    !
    !----------------------------------------------------------------------------
    !
    DO II=1,NUMBPROFILER
      CALL PROFILER_DIACHRO_n(TPROFILER, II)
    ENDDO
    !
    !----------------------------------------------------------------------------
    !----------------------------------------------------------------------------
    !
    CONTAINS
    !
    !----------------------------------------------------------------------------
    !----------------------------------------------------------------------------
    !
    !----------------------------------------------------------------------------
    SUBROUTINE PROFILER_DIACHRO_n(TPROFILER,II)
    
    use modd_budget, only: tbudiachrometadata
    use modd_field,  only: NMNHDIM_LEVEL, NMNHDIM_PROFILER_TIME, NMNHDIM_PROFILER_PROC, NMNHDIM_UNUSED, &
    
    TYPE(PROFILER),     INTENT(IN)       :: TPROFILER
    INTEGER,            INTENT(IN)       :: II
    !
    !*      0.2  declaration of local variables for diachro
    !
    REAL,    DIMENSION(:,:,:,:,:,:),  ALLOCATABLE :: ZWORK6   ! contains temporal serie
    REAL,    DIMENSION(:,:,:,:,:,:),  ALLOCATABLE :: ZW6      ! contains temporal serie to write
    REAL, DIMENSION(:,:,:,:),         ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
    REAL, DIMENSION(:,:,:),           ALLOCATABLE :: ZRHO
    !
    INTEGER, DIMENSION(:),            ALLOCATABLE :: IGRID    ! grid indicator
    CHARACTER(LEN=  8)                            :: YGROUP   ! group title
    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YCOMMENT ! comment string
    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YTITLE   ! title
    CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YUNIT    ! physical unit
    !
    INTEGER :: IPROC    ! number of variables records
    INTEGER :: JPROC    ! loop counter
    INTEGER :: JRR      ! loop counter
    INTEGER :: JSV      ! loop counter
    INTEGER :: IKU, IK  ! loop counter
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
    CHARACTER(LEN=2)  :: INDICE
    
    type(tfield_metadata_base), dimension(:), allocatable :: tzfields
    
    !
    !----------------------------------------------------------------------------
    !
    IF (TPROFILER%X(II)==XUNDEF) RETURN
    IF (TPROFILER%Y(II)==XUNDEF) RETURN
    IKU = SIZE(TPROFILER%W,2)    !nbre de niveaux sur la verticale SIZE(TPROFILER%W,2)
    !
    
    IPROC = 24 + SIZE(TPROFILER%R,4) + SIZE(TPROFILER%SV,4)
    
    IF (LORILAM) IPROC = IPROC + JPMODE*3
    IF (LDUST) IPROC = IPROC + NMODE_DST*3
    IF (LDUST .OR. LORILAM .OR. LSALT) IPROC=IPROC+NAER
    IF (SIZE(TPROFILER%TKE  )>0) IPROC = IPROC + 1
    !
    
    ALLOCATE (ZWORK6(1,1,IKU,size(tprofiler%tpdates),1,IPROC))
    
    ALLOCATE (YCOMMENT(IPROC))
    ALLOCATE (YTITLE  (IPROC))
    ALLOCATE (YUNIT   (IPROC))
    ALLOCATE (IGRID   (IPROC))
    !
    IGRID  = 1
    YGROUP = TPROFILER%NAME(II)
    !
    !----------------------------------------------------------------------------
    DO IK=1, IKU
    !
    JPROC=0
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'Th'
    YUNIT    (JPROC) = 'K'
    YCOMMENT (JPROC) = 'Potential temperature' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%TH(:,IK,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'Thv'
    YUNIT    (JPROC) = 'K'
    YCOMMENT (JPROC) = 'Virtual Potential temperature' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%THV(:,IK,II)
    !
    JPROC = JPROC + 1
    
    YTITLE   (JPROC) = 'VISI'
    YUNIT    (JPROC) = 'km'
    YCOMMENT (JPROC) = 'Visibility'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%VISI(:,IK,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'VISIKUN'
    YUNIT    (JPROC) = 'km'
    YCOMMENT (JPROC) = 'Visibility Kunkel'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%VISIKUN(:,IK,II)
    !
    JPROC = JPROC + 1
    
    YTITLE   (JPROC) = 'RARE'
    
    YCOMMENT (JPROC) = 'Radar reflectivity'       
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%RARE(:,IK,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'P'
    YUNIT    (JPROC) = 'Pascal'
    YCOMMENT (JPROC) = 'Pressure' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%P(:,IK,II)
    !
    JPROC = JPROC + 1
    
    YTITLE   (JPROC) = 'ALT'
    YUNIT    (JPROC) = 'm'
    YCOMMENT (JPROC) = 'Altitude' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZZ(:,IK,II)
    !
    JPROC = JPROC + 1
    
    YTITLE   (JPROC) = 'LON'
    
    YCOMMENT (JPROC) = 'Longitude'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LON(II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'LAT'
    
    YCOMMENT (JPROC) = 'Latitude'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LAT(II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'ZON_WIND'
    
    YCOMMENT (JPROC) = 'Zonal wind'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZON(:,IK,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'MER_WIND'
    
    YCOMMENT (JPROC) = 'Meridional wind'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%MER(:,IK,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'FF'           
    
    YCOMMENT (JPROC) = 'Wind intensity'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%FF(:,IK,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'DD'        
    YUNIT    (JPROC) = 'degree'
    YCOMMENT (JPROC) = 'Wind direction'
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%DD(:,IK,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'W'
    
    YCOMMENT (JPROC) = 'Air vertical speed' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%W(:,IK,II)
    !
    IF (LDIAG_IN_RUN) THEN
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'T2m'
      YUNIT    (JPROC) = 'K'
      YCOMMENT (JPROC) = '2-m temperature' 
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%T2M(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'Q2m'
    
      YCOMMENT (JPROC) = '2-m humidity' 
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%Q2M(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'HU2m'
    
      YCOMMENT (JPROC) = '2-m relative humidity' 
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%HU2M(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'zon10m'
    
      YCOMMENT (JPROC) = '10-m zonal wind' 
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZON10M(:,II)
      !       
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'mer10m'
    
      YCOMMENT (JPROC) = '10-m meridian wind' 
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%MER10M(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'RN' 
    
      YCOMMENT (JPROC) = 'Net radiation'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%RN(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'H' 
    
      YCOMMENT (JPROC) = 'Sensible heat flux'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%H(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'LE' 
    
      YCOMMENT (JPROC) = 'Total Latent heat flux'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LE(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'G' 
    
      YCOMMENT (JPROC) = 'Storage heat flux'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%GFLUX(:,II)
      !
    
      JPROC = JPROC + 1
    
      YCOMMENT (JPROC) = 'Downward short-wave radiation'
    
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SWD(:,II)
    
      !
      JPROC = JPROC + 1
    
      YCOMMENT (JPROC) = 'Upward short-wave radiation'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SWU(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'LWD'
    
      YCOMMENT (JPROC) = 'Downward long-wave radiation'
    
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LWD(:,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'LWU'
    
      YCOMMENT (JPROC) = 'Upward long-wave radiation'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LWU(:,II)
      !
    
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'TKE_DISS'
    
      YCOMMENT (JPROC) = 'TKE dissipation rate'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%TKE_DISS(:,IK,II)
      !
      JPROC = JPROC + 1
      YTITLE   (JPROC) = 'LEI' 
    
      YCOMMENT (JPROC) = 'Solid Latent heat flux'
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LEI(:,II)  
    !
    ENDIF
    !
    DO JRR=1,SIZE(TPROFILER%R,4)
      JPROC = JPROC+1
    
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%R(:,IK,II,JRR)
      IF (JRR==1) THEN
        YTITLE   (JPROC) = 'Rv'
        YCOMMENT (JPROC) = 'Water vapor mixing ratio' 
      ELSE IF (JRR==2) THEN
        YTITLE   (JPROC) = 'Rc'
        YCOMMENT (JPROC) = 'Liquid cloud water mixing ratio' 
      ELSE IF (JRR==3) THEN
        YTITLE   (JPROC) = 'Rr'
        YCOMMENT (JPROC) = 'Rain water mixing ratio' 
      ELSE IF (JRR==4) THEN
        YTITLE   (JPROC) = 'Ri'
        YCOMMENT (JPROC) = 'Ice cloud water mixing ratio' 
      ELSE IF (JRR==5) THEN
        YTITLE   (JPROC) = 'Rs'
        YCOMMENT (JPROC) = 'Snow mixing ratio' 
      ELSE IF (JRR==6) THEN
        YTITLE   (JPROC) = 'Rg'
        YCOMMENT (JPROC) = 'Graupel mixing ratio' 
      ELSE IF (JRR==7) THEN
        YTITLE   (JPROC) = 'Rh'
        YCOMMENT (JPROC) = 'Hail mixing ratio' 
      END IF
    END DO
    
    YCOMMENT (JPROC) = 'Density of dry air in moist' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%RHOD(:,IK,II)
    
    !
    IF (SIZE(TPROFILER%TKE,1)>0) THEN
      JPROC = JPROC+1
      YTITLE   (JPROC) = 'Tke'
    
      YCOMMENT (JPROC) = 'Turbulent kinetic energy' 
      ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%TKE(:,IK,II)
    END IF
    !
    
    YCOMMENT (JPROC) = 'Integrated Water Vapour' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%IWV(:,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'ZTD'
    YUNIT    (JPROC) = 'm'
    YCOMMENT (JPROC) = 'Zenith Tropospheric Delay' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZTD(:,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'ZWD'
    YUNIT    (JPROC) = 'm'
    YCOMMENT (JPROC) = 'Zenith Wet Delay' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZWD(:,II)
    !
    JPROC = JPROC + 1
    YTITLE   (JPROC) = 'ZHD'
    YUNIT    (JPROC) = 'm'
    YCOMMENT (JPROC) = 'Zenith Hydrostatic Delay' 
    ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZHD(:,II)
    !
    
    IF (SIZE(TPROFILER%SV,4)>=1) THEN
      ! User scalar variables
      DO JSV = 1,NSV_USER
        JPROC = JPROC+1
        WRITE (YTITLE(JPROC),FMT='(A2,I3.3)')   'Sv',JSV
    
        YCOMMENT (JPROC) = ' ' 
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
      END DO
    
     ! Passive pollutant  scalar variables
      DO JSV = NSV_PPBEG,NSV_PPEND
        JPROC = JPROC+1
        WRITE (YTITLE(JPROC),FMT='(A2,I3.3)')   'Sv',JSV
        YUNIT    (JPROC) = ''
        YCOMMENT (JPROC) = ' '
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
      END DO
    
     ! microphysical C2R2 scheme scalar variables
      DO JSV = NSV_C2R2BEG,NSV_C2R2END
        JPROC = JPROC+1
        YTITLE(JPROC)= TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))
    
        YCOMMENT (JPROC) = ' '
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
      END DO
      ! microphysical C3R5 scheme additional scalar variables
      DO JSV = NSV_C1R3BEG,NSV_C1R3END
        JPROC = JPROC+1
        YTITLE(JPROC)= TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))
    
        YCOMMENT (JPROC) = ' '
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
      END DO
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
      ! LIMA variables
      DO JSV=NSV_LIMA_BEG,NSV_LIMA_END
        JPROC = JPROC+1
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
        YCOMMENT (JPROC) = ' '
        IF (JSV==NSV_LIMA_NC) YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(1))//'T' 
        IF (JSV==NSV_LIMA_NR) YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(2))//'T' 
        IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN
            WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1)
            YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(3))//INDICE//'T'
        ENDIF
        IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN
            WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1)
            YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(4))//INDICE//'T'
        ENDIF
        IF (JSV .EQ. NSV_LIMA_SCAVMASS) YTITLE(JPROC)=TRIM(CAERO_MASS(1))//'T'
        IF (JSV==NSV_LIMA_NI) YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(1))//'T' 
        IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN
            WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1)
            YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(2))//INDICE//'T'
        ENDIF
        IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN
            WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1)
            YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T'
        ENDIF
        IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
    
          WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
          YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T'
    
    Gaelle TANGUY's avatar
    Gaelle TANGUY committed
        ENDIF
        IF (JSV .EQ. NSV_LIMA_HOM_HAZE) YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(5))//'T'
    
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
      END DO 
    
      ! electrical scalar variables
      DO JSV = NSV_ELECBEG,NSV_ELECEND
        JPROC = JPROC+1
        YTITLE(JPROC)= TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))
    
        YCOMMENT (JPROC) = ' '
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
      END DO
      ! chemical scalar variables
      DO JSV=NSV_CHEMBEG,NSV_CHEMEND
        JPROC = JPROC+1
    
        YTITLE(JPROC)= TRIM(CNAMES(JSV-NSV_CHEMBEG+1))
    
        YUNIT    (JPROC) = 'ppb'
        WRITE(YCOMMENT (JPROC),'(A5,A3,I3.3)') 'T(s) ','SVT',JSV
    
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV) * 1.E9
      END DO
      IF ((LORILAM).AND. .NOT.(ANY(TPROFILER%P(:,IK,II) == 0.))) THEN
    
        ALLOCATE (ZSV(1,1,size(tprofiler%tpdates),NSV_AER))
        ALLOCATE (ZRHO(1,1,size(tprofiler%tpdates)))
        ALLOCATE (ZN0(1,1,size(tprofiler%tpdates),JPMODE))
        ALLOCATE (ZRG(1,1,size(tprofiler%tpdates),JPMODE))
        ALLOCATE (ZSIG(1,1,size(tprofiler%tpdates),JPMODE))
    
        ZSV(1,1,:,1:NSV_AER) = TPROFILER%SV(:,IK,II,NSV_AERBEG:NSV_AEREND)
        IF (SIZE(TPROFILER%R,4) >0) THEN
          ZRHO(1,1,:) = 0.
          DO JRR=1,SIZE(TPROFILER%R,4)
            ZRHO(1,1,:) = ZRHO(1,1,:) + TPROFILER%R(:,IK,II,JRR)
          ENDDO
          ZRHO(1,1,:) = TPROFILER%TH(:,IK,II) * ( 1. + XRV/XRD*TPROFILER%R(:,IK,II,1) )  &
                                              / ( 1. + ZRHO(1,1,:)                ) 
        ELSE
          ZRHO(1,1,:) = TPROFILER%TH(:,IK,II)
        ENDIF
        ZRHO(1,1,:) =  TPROFILER%P(:,IK,II) / &
                      (XRD *ZRHO(1,1,:) *((TPROFILER%P(:,IK,II)/XP00)**(XRD/XCPD)) )
        CALL PPP2AERO(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
        DO JSV=1,JPMODE
          ! mean radius
          JPROC = JPROC+1
          WRITE(YTITLE(JPROC),'(A6,I1)')'AERRGA',JSV
          YUNIT    (JPROC) = 'um'
    
          WRITE(YCOMMENT(JPROC),'(A18,I1)')'RG (nb) AERO MODE ',JSV
    
          ZWORK6 (1,1,IK,:,1,JPROC) = ZRG(1,1,:,JSV)
          ! standard deviation
          JPROC = JPROC+1
          WRITE(YTITLE(JPROC),'(A7,I1)')'AERSIGA',JSV
          YUNIT    (JPROC) = '  '
          WRITE(YCOMMENT(JPROC),'(A16,I1)')'SIGMA AERO MODE ',JSV
          ZWORK6 (1,1,IK,:,1,JPROC) = ZSIG(1,1,:,JSV)
          ! particles number
          JPROC = JPROC+1
          WRITE(YTITLE(JPROC),'(A6,I1)')'AERN0A',JSV
    
          YUNIT    (JPROC) = 'm-3'
          WRITE(YCOMMENT(JPROC),'(A13,I1)')'N0 AERO MODE ',JSV
    
          ZWORK6 (1,1,IK,:,1,JPROC) = ZN0(1,1,:,JSV)
        ENDDO
        DEALLOCATE (ZSV,ZRHO) 
        DEALLOCATE (ZN0,ZRG,ZSIG) 
      END IF
      ! dust scalar variables
      DO JSV = NSV_DSTBEG,NSV_DSTEND
        JPROC = JPROC+1
        YTITLE(JPROC)= TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))
    
        YCOMMENT (JPROC) = ' '
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV) * 1.E9
      END DO
      IF ((LDUST).AND. .NOT.(ANY(TPROFILER%P(:,IK,II) == 0.))) THEN
    
        ALLOCATE (ZSV(1,1,size(tprofiler%tpdates),NSV_DST))
        ALLOCATE (ZRHO(1,1,size(tprofiler%tpdates)))
        ALLOCATE (ZN0(1,1,size(tprofiler%tpdates),NMODE_DST))
        ALLOCATE (ZRG(1,1,size(tprofiler%tpdates),NMODE_DST))
        ALLOCATE (ZSIG(1,1,size(tprofiler%tpdates),NMODE_DST))
    
        ZSV(1,1,:,1:NSV_DST) = TPROFILER%SV(:,IK,II,NSV_DSTBEG:NSV_DSTEND)
        IF (SIZE(TPROFILER%R,4) >0) THEN
          ZRHO(1,1,:) = 0.
          DO JRR=1,SIZE(TPROFILER%R,4)
            ZRHO(1,1,:) = ZRHO(1,1,:) + TPROFILER%R(:,IK,II,JRR)
          ENDDO
          ZRHO(1,1,:) = TPROFILER%TH(:,IK,II) * ( 1. + XRV/XRD*TPROFILER%R(:,IK,II,1) )  &
                                              / ( 1. + ZRHO(1,1,:)                ) 
        ELSE
          ZRHO(1,1,:) = TPROFILER%TH(:,IK,II)
        ENDIF
        ZRHO(1,1,:) =  TPROFILER%P(:,IK,II) / &
                      (XRD *ZRHO(1,1,:) *((TPROFILER%P(:,IK,II)/XP00)**(XRD/XCPD)) )
        CALL PPP2DUST(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
        DO JSV=1,NMODE_DST
          ! mean radius
          JPROC = JPROC+1
          WRITE(YTITLE(JPROC),'(A6,I1)')'DSTRGA',JSV
          YUNIT    (JPROC) = 'um'
    
          WRITE(YCOMMENT(JPROC),'(A18,I1)')'RG (nb) DUST MODE ',JSV
    
          ZWORK6 (1,1,IK,:,1,JPROC) = ZRG(1,1,:,JSV)
          ! standard deviation
          JPROC = JPROC+1
          WRITE(YTITLE(JPROC),'(A7,I1)')'DSTSIGA',JSV
          YUNIT    (JPROC) = '  '
          WRITE(YCOMMENT(JPROC),'(A16,I1)')'SIGMA DUST MODE ',JSV
          ZWORK6 (1,1,IK,:,1,JPROC) = ZSIG(1,1,:,JSV)
          ! particles number
          JPROC = JPROC+1
          WRITE(YTITLE(JPROC),'(A6,I1)')'DSTN0A',JSV
    
          YUNIT    (JPROC) = 'm-3'
          WRITE(YCOMMENT(JPROC),'(A13,I1)')'N0 DUST MODE ',JSV
    
          ZWORK6 (1,1,IK,:,1,JPROC) = ZN0(1,1,:,JSV)
        ENDDO
        DEALLOCATE (ZSV,ZRHO) 
        DEALLOCATE (ZN0,ZRG,ZSIG) 
      END IF
      ! sea salt scalar variables
      DO JSV = NSV_SLTBEG,NSV_SLTEND
        JPROC = JPROC+1
        YTITLE(JPROC)= TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))
    
        YCOMMENT (JPROC) = ' '
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV) * 1.E9
      END DO
      IF (LDUST .OR. LORILAM .OR. LSALT) THEN
      DO JSV = 1,NAER
        JPROC = JPROC+1
        WRITE(YTITLE(JPROC),'(A6,I1)')'AEREXT',JSV
        YUNIT    (JPROC) = ' '
        YCOMMENT (JPROC) = 'Aerosol Extinction'
        ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%AER(:,IK,II,JSV) 
      END DO
      ENDIF
    ENDIF
    !
    END DO
    !
    !----------------------------------------------------------------------------
    !
    
    
    ALLOCATE (ZW6(1,1,IKU,size(tprofiler%tpdates),1,JPROC))
    
    ZW6 = ZWORK6(:,:,:,:,:,:JPROC)
    DEALLOCATE(ZWORK6)
    
    
    allocate( tzfields( jproc ) )
    
    tzfields(:)%cmnhname  = ytitle(1 : jproc)
    tzfields(:)%cstdname  = ''
    tzfields(:)%clongname = ytitle(1 : jproc)
    tzfields(:)%cunits    = yunit(1 : jproc)
    tzfields(:)%ccomment  = ycomment(1 : jproc)
    tzfields(:)%ngrid     = 0
    tzfields(:)%ntype     = TYPEREAL
    tzfields(:)%ndims     = 3
    tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
    tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
    tzfields(:)%ndimlist(3) = NMNHDIM_LEVEL
    tzfields(:)%ndimlist(4) = NMNHDIM_PROFILER_TIME
    tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
    tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC
    
    
    tzbudiachro%cname      = ygroup
    tzbudiachro%ccomment   = 'Vertical profiles at position of profiler ' // Trim( ygroup )
    
    ! tzbudiachro%cmask     = NOT SET (default values)
    
    tzbudiachro%licompress = .true.
    tzbudiachro%ljcompress = .true.
    tzbudiachro%lkcompress = .false.
    
    tzbudiachro%ltcompress = .false.
    tzbudiachro%lnorm      = .false.
    
    tzbudiachro%nil        = 1
    tzbudiachro%nih        = 1
    tzbudiachro%njl        = 1
    tzbudiachro%njh        = 1
    tzbudiachro%nkl        = 1
    tzbudiachro%nkh        = iku
    
    call Write_diachro( tpdiafile, tzbudiachro, tzfields, tprofiler%tpdates, zw6 )
    
    DEALLOCATE (ZW6     )
    DEALLOCATE (YCOMMENT)
    DEALLOCATE (YTITLE  )
    DEALLOCATE (YUNIT   )
    DEALLOCATE (IGRID   )
    !----------------------------------------------------------------------------
    END SUBROUTINE PROFILER_DIACHRO_n
    !----------------------------------------------------------------------------
    !----------------------------------------------------------------------------
    !
    END SUBROUTINE WRITE_PROFILER_n