src/SURFEX/ch_init_emissionn.F90

   1 !SURFEX_LIC Copyright 1994-2014 Meteo-France
   2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
   3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
   4 !SURFEX_LIC for details. version 1.
   5 !     #########
   6       SUBROUTINE CH_INIT_EMISSION_n(HPROGRAM,KLU,HINIT,PRHOA,HCHEM_SURF_FILE)
   7 !     #######################################
   8 !
   9 !!****  *CH_INIT_EMIISION_n* - routine to initialize chemical emissions data structure
  10 !!
  11 !!    PURPOSE
  12 !!    -------
  13 !       Allocates and initialize emission surface fields
  14 !       by reading their value in initial file.
  15 !
  16 !!**  METHOD
  17 !!    ------
  18 !!
  19 !!
  20 !!    AUTHOR
  21 !!    ------
  22 !!      D. Gazen       * L.A. *
  23 !!
  24 !!    MODIFICATIONS
  25 !!    -------------
  26 !!      Original        08/03/2001
  27 !!      D.Gazen  01/12/03  change emissions handling for surf. externalization
  28 !!      P.Tulet  01/01/04  introduction of rhodref for externalization
  29 !!      M.Leriche & V. Masson 05/16 bug in write emis fields for nest
  30 !-----------------------------------------------------------------------------
  31 !
  32 !*       0.    DECLARATIONS
  33 !
  34 USE MODD_CH_EMIS_FIELD_n
  35 !
  36 USE MODI_GET_LUOUT
  37 USE MODI_BUILD_EMISSTAB_n
  38 USE MODI_BUILD_PRONOSLIST_n
  39 USE MODI_READ_SURF
  40 USE MODI_OPEN_NAMELIST
  41 USE MODI_CLOSE_NAMELIST
  42 USE MODI_READ_SURF_FIELD2D
  43 !
  44 !
  45 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  46 USE PARKIND1  ,ONLY : JPRB
  47 !
  48 USE MODI_ABOR1_SFX
  49 !
  50 IMPLICIT NONE
  51 !
  52 !*       0.1   declarations of arguments
  53 !
  54  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! Program name
  55 INTEGER,           INTENT(IN)  :: KLU      ! number of points
  56 CHARACTER(LEN=3),  INTENT(IN)  :: HINIT    ! Flag to know if one initializes:
  57 !                                          ! 'ALL' : all variables for a run
  58 !                                          ! 'PRE' : only variables to build
  59 !                                          !         an initial file
  60
  61 REAL, DIMENSION(:),INTENT(IN)  :: PRHOA    ! air density
  62 CHARACTER(LEN=28), INTENT(IN)  :: HCHEM_SURF_FILE ! ascii file for chemistry aggregation
  63 !
  64 !*       0.2   declarations of local variables
  65 !
  66 INTEGER             :: IRESP                 !   File
  67 INTEGER             :: ILUOUT                ! output listing logical unit
  68  CHARACTER (LEN=16)  :: YRECFM                ! management
  69  CHARACTER (LEN=100) :: YCOMMENT              ! variables
  70 INTEGER             :: JSPEC                 ! Loop index for cover data
  71 INTEGER             :: IIND1,IIND2           ! Indices counter
  72 !
  73  CHARACTER(LEN=40)                 :: YSPEC_NAME ! species name
  74  CHARACTER(LEN=LEN_HREC), DIMENSION(:),ALLOCATABLE :: YEMIS_NAME ! offline emitted species name
  75 INTEGER,DIMENSION(:),ALLOCATABLE  :: INBTIMES! number of emission times array
  76 INTEGER,DIMENSION(:),ALLOCATABLE  :: ITIMES  ! emission times for a species
  77 INTEGER,DIMENSION(:),ALLOCATABLE  :: IOFFNDX ! index array of offline emission species
  78 INTEGER                           :: INBTS   ! number of emission times for a species
  79 INTEGER                           :: INBOFF  ! Number of offline emissions
  80 INTEGER                           :: IVERB   ! verbose level
  81 INTEGER                           :: ICH      ! logical unit of input chemistry file
  82 CHARACTER(LEN=3)                  :: YSURF   ! surface type
  83 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D ! work array to read emission fields
  84 !
  85 INTEGER           :: IVERSION       ! version of surfex file being read
  86 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  87 !-------------------------------------------------------------------------------
  88 IF (LHOOK) CALL DR_HOOK('CH_INIT_EMISSION_N',0,ZHOOK_HANDLE)
  89  CALL GET_LUOUT(HPROGRAM,ILUOUT)
  90 WRITE(ILUOUT,*) '------ Beginning of CH_INIT_EMISSION ------'
  91 !
  92 !* ascendant compatibility
  93 YRECFM='VERSION'
  94  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
  95 !
  96 !*      1.     Chemical Emission fields
  97 !              ------------------------
  98 !
  99 ! Read the total number of emission files
 100 IF (IVERSION>=4) THEN
 101   CALL READ_SURF(HPROGRAM,'EMISFILE_NBR',NEMIS_NBR,IRESP)
 102 ELSE
 103   CALL READ_SURF(HPROGRAM,'EMISFILE_GR_NBR',NEMIS_NBR,IRESP)
 104 END IF
 105 IF (IRESP/=0) THEN
 106   CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF 2D CHEMICAL EMISSION FIELDS')
 107 END IF
 108 !
 109 ! Read the number of emission species
 110 IF (IVERSION>=4) THEN
 111   CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',NEMISPEC_NBR,IRESP)
 112 ELSE
 113   CALL READ_SURF(HPROGRAM,'EMISPEC_GR_NBR',NEMISPEC_NBR,IRESP)
 114 END IF
 115 IF (IRESP/=0) THEN
 116   CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF EMITTED CHEMICAL SPECIES')
 117 END IF
 118 !
 119 !
 120 IF (.NOT. ASSOCIATED(CEMIS_NAME))  THEN
 121   ALLOCATE(CEMIS_NAME(NEMISPEC_NBR))
 122 ELSE
 123   WRITE(ILUOUT,*) 'CEMIS_NAME already allocated with SIZE :',SIZE(CEMIS_NAME)
 124 END IF
 125
 126 IF (.NOT. ASSOCIATED(CEMIS_AREA))   ALLOCATE(CEMIS_AREA(NEMISPEC_NBR))
 127 IF (.NOT. ASSOCIATED(NEMIS_TIME))   ALLOCATE(NEMIS_TIME(NEMIS_NBR))
 128
 129 IF (HINIT/='ALL') THEN
 130   ALLOCATE(XEMIS_FIELDS(KLU,NEMIS_NBR))
 131   ALLOCATE(CEMIS_COMMENT(NEMIS_NBR))
 132 END IF
 133 !
 134 ALLOCATE(ITIMES(NEMIS_NBR))
 135 ALLOCATE(INBTIMES(NEMISPEC_NBR))
 136 ALLOCATE(IOFFNDX(NEMISPEC_NBR))
 137 !
 138 INBTIMES(:) = -1
 139 IOFFNDX(:)  = 0 ! Index array of offline species
 140 !
 141 IIND1      = 0 ! Index to fill NEMIS_GR_TIMES array
 142 IIND2      = 0 ! with emission times of offline species
 143 !
 144 INBOFF     = 0 ! number of offline emission species (with emis time > 0)
 145 DO JSPEC = 1,NEMISPEC_NBR ! Loop on the number of species
 146 !
 147 ! Read article EMISNAMExxx for the name of species
 148 ! and extract from comment : surface type + number of emission times
 149   WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
 150   CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
 151   IF (IRESP/=0) THEN
 152     CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
 153   END IF
 154   READ(YCOMMENT,'(A3,24x,I5)') YSURF, INBTS
 155   WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME),'(',INBTS,' instants )'
 156 !
 157 ! Read emission times for species number JSPEC
 158   WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
 159   CALL READ_SURF(HPROGRAM,YRECFM,ITIMES(1:INBTS),IRESP,YCOMMENT,'-')
 160   IF (IRESP/=0) THEN
 161     CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING EMISSION TIMES')
 162   END IF
 163   IF (INBTS == 1) WRITE(ILUOUT,*) ' -> ',ITIMES(1)
 164 !
 165 ! Is it an offline emission ?
 166   IF (INBTS >= 1) THEN
 167     IF (ITIMES(1) >= 0) THEN
 168 ! Yes it is. (Note that negative time refers to inline emission like biogenics
 169 ! fluxes)
 170 !
 171       INBOFF = INBOFF+1
 172       IOFFNDX(INBOFF)  = JSPEC
 173 !
 174 ! INBTIMES and NEMIS_TIME only updated for offline emission
 175       IIND1 = IIND2+1
 176       IIND2 = IIND2+INBTS
 177       NEMIS_TIME(IIND1:IIND2) = ITIMES(1:INBTS)
 178       INBTIMES(INBOFF) = INBTS
 179     END IF
 180   END IF
 181 !
 182 ! INBTIMES, CEMIS_AREA and CEMIS_NAME
 183 ! are updated for ALL species
 184   CEMIS_NAME(JSPEC) = YSPEC_NAME
 185   CEMIS_AREA(JSPEC) = YSURF
 186 !
 187 !*      2.     Simple reading of emission fields
 188
 189   IF (HINIT /= "ALL") THEN
 190     YRECFM='E_'//TRIM(ADJUSTL(YSPEC_NAME))
 191     ALLOCATE(ZWORK2D(KLU,INBTS))
 192     CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK2D(:,:),YRECFM,YCOMMENT)
 193     XEMIS_FIELDS(:,IIND1:IIND2) = ZWORK2D(:,:)
 194     CEMIS_COMMENT(IIND1:IIND2) = YCOMMENT
 195     DEALLOCATE(ZWORK2D)
 196   END IF
 197 END DO
 198 !
 199 WRITE(ILUOUT,*) '---- Nunmer of OFFLINE species = ',INBOFF
 200 WRITE(ILUOUT,*) 'INBTIMES=',INBTIMES
 201 WRITE(ILUOUT,*) 'IOFFNDX=',IOFFNDX
 202
 203 IVERB=6
 204
 205 !*      3.     Conversion and aggregation
 206
 207 IF (HINIT == "ALL") THEN
 208   IF (INBOFF > 0) THEN
 209     CALL OPEN_NAMELIST(HPROGRAM,ICH,HFILE=HCHEM_SURF_FILE)
 210     ALLOCATE(TSEMISS(INBOFF))
 211     ALLOCATE(YEMIS_NAME(INBOFF))
 212
 213     CALL BUILD_EMISSTAB_n(HPROGRAM,ICH,CEMIS_NAME,INBTIMES,NEMIS_TIME,&
 214          IOFFNDX,TSEMISS,KLU,ILUOUT,IVERB,PRHOA)
 215     DO JSPEC = 1,INBOFF ! Loop on the number of species
 216       YEMIS_NAME(JSPEC) = TSEMISS(JSPEC)%CNAME(1:12)
 217     END DO
 218     CALL BUILD_PRONOSLIST_n(SIZE(TSEMISS),YEMIS_NAME,TSPRONOSLIST,ICH,ILUOUT,IVERB)
 219     DEALLOCATE(YEMIS_NAME)
 220     CALL CLOSE_NAMELIST(HPROGRAM,ICH)
 221   ELSE
 222     ALLOCATE(TSEMISS(0))
 223     NULLIFY(TSPRONOSLIST)
 224   END IF
 225 END IF
 226 DEALLOCATE(ITIMES,INBTIMES,IOFFNDX)
 227 WRITE(ILUOUT,*) '------ Leaving CH_INIT_EMISSION ------'
 228 IF (LHOOK) CALL DR_HOOK('CH_INIT_EMISSION_N',1,ZHOOK_HANDLE)
 229 !-------------------------------------------------------------------------------
 230 !
 231 END SUBROUTINE CH_INIT_EMISSION_n