init_chemicaln.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!#############################################################
SUBROUTINE init_chemical_n(KLUOUT, KSV, HSV, SV, HCH_NAMES, HAER_NAMES, &
                           HDSTNAMES, HSLTNAMES     )  
!#############################################################
!
!!****  *INIT_CHEMICAL_n* - routine to initialize CHEMICAL SPECIES
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    08/2011
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_sv_n, ONLY : sv_t
!
USE modd_chs_aerosol,    ONLY: lvarsigi, lvarsigj
USE modd_dst_surf,       ONLY: lvarsig_dst, ndstmde,  ndst_mdebeg, lrgfix_dst, jpmode_dst
USE modd_slt_surf,       ONLY: lvarsig_slt, nsltmde,  nslt_mdebeg, lrgfix_slt, jpmode_slt
!
USE modi_ch_init_names
USE modi_dslt_init_names
USE modi_dslt_init_modes
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
INTEGER,                          INTENT(IN) :: KLUOUT
INTEGER,                          INTENT(IN) :: KSV      ! number of scalars
 CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN) :: HSV      ! name of all scalar variables
 TYPE(sv_t), INTENT(INOUT) :: SV
 CHARACTER(LEN=6), DIMENSION(:), POINTER :: HCH_NAMES
 CHARACTER(LEN=6), DIMENSION(:), POINTER :: HAER_NAMES     

 CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HDSTNAMES
 CHARACTER(LEN=6), DIMENSION(:), POINTER, OPTIONAL :: HSLTNAMES
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!               Initialisation for IO
!
!
IF (lhook) CALL dr_hook('INIT_CHEMICAL_n',0,zhook_handle)
!
IF (ksv /= 0) THEN
  !
  ALLOCATE(sv%CSV(ksv))
  CALL ch_init_names(kluout, hsv, sv, lvarsigi, lvarsigj    )  

  IF (sv%NBEQ > 0 ) THEN
    ALLOCATE(hch_names(sv%NBEQ))
    hch_names(:) = sv%CSV(sv%NSV_CHSBEG:sv%NSV_CHSEND)
  ELSE
    ALLOCATE(hch_names(0))
  END IF

  IF (sv%NAEREQ > 0 ) THEN
    ALLOCATE(haer_names(sv%NAEREQ))
    haer_names(:) = sv%CSV(sv%NSV_AERBEG:sv%NSV_AEREND)
  ELSE
    ALLOCATE(haer_names(0))
  END IF
  !
  CALL dslt_init_names(         &
         kluout,                &!I [idx] index of writing unit
         'DSTM',                &
         hsv,                   &!I [char] list of scalar variables
         jpmode_dst,            &
         sv%NDSTEQ,                &!O [nbr] number of dust related tracers
         sv%NSV_DSTBEG,            &!O [idx] first dust related scalar variable
         sv%NSV_DSTEND,            &!O [idx] last dust related scalar variable
         lvarsig_dst,           &!O type of standard deviation (fixed or variable)
         lrgfix_dst             &!O type of mean radius (fixed or variable)        
         )  

  IF (PRESENT(hdstnames)) THEN
    IF (sv%NDSTEQ >=1) THEN
      CALL dslt_init_modes(       &
            sv%NDSTEQ,               &!I [nbr] number of dust related variables in scalar list
            sv%NSV_DSTBEG,           &!I [idx] index of first dust related variable in scalar list
            sv%NSV_DSTEND,           &!I [idx] index of last dust related variable in scalar list
            lvarsig_dst,          &!I type of standard deviation (fixed or variable)
            lrgfix_dst,           &!O type of mean radius (fixed or variable)        
            ndst_mdebeg,          &!O [idx] index of mass for first mode in scalar list
            ndstmde               &!O [nbr] number of modes to be transported
            )

      IF(.NOT. ASSOCIATED(hdstnames)) ALLOCATE (hdstnames(sv%NDSTEQ))
      hdstnames(:) = sv%CSV(sv%NSV_DSTBEG:sv%NSV_DSTEND)
    ENDIF
  ENDIF


  CALL dslt_init_names(         &
          kluout,               &!I [idx] index of writing unit
         'SLTM',                &          
          hsv,                  &!I [char] list of scalar variables
          jpmode_slt,           &          
          sv%NSLTEQ,               &!O [nbr] number of sea salt related tracers
          sv%NSV_SLTBEG,           &!O [idx] first sea salt related scalar variable
          sv%NSV_SLTEND,           &!O [idx] last sea salt related scalar variable
          lvarsig_slt,          &!O type of standard deviation (fixed or variable)
          lrgfix_slt            &!O type of mean radius (fixed or variable)        
          )  

  IF (PRESENT(hsltnames)) THEN
    IF (sv%NSLTEQ >=1) THEN
      CALL dslt_init_modes(       &
            sv%NSLTEQ,               &!I [nbr] number of sea salt related variables in scalar list
            sv%NSV_SLTBEG,           &!I [idx] index of first sea salt related variable in scalar list
            sv%NSV_SLTEND,           &!I [idx] index of last sea salt related variable in scalar list
            lvarsig_slt,          &!I type of standard deviation (fixed or variable)
            lrgfix_slt,           &!O type of mean radius (fixed or variable)
            nslt_mdebeg,          &!O [idx] index of mass for first mode in scalar list
            nsltmde               &!O [nbr] number of modes to be transported
            )  
      IF(.NOT. ASSOCIATED(hsltnames)) ALLOCATE (hsltnames(sv%NSLTEQ))
      hsltnames(:) = sv%CSV(sv%NSV_SLTBEG:sv%NSV_SLTEND)
    ENDIF
  END IF

ELSE
  ALLOCATE(sv%CSV     (0))
  IF (PRESENT(hdstnames)) ALLOCATE(hdstnames(0))
  IF (PRESENT(hsltnames)) ALLOCATE(hsltnames(0))
ENDIF
!
IF (lhook) CALL dr_hook('INIT_CHEMICAL_n',1,zhook_handle)
!
END SUBROUTINE init_chemical_n