SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/ch_init

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE CH_INIT_EMISSION_n(HPROGRAM,KLU,KCH,PRHOA)
00003 !     #######################################
00004 !
00005 !!****  *CH_INIT_EMIISION_n* - routine to initialize chemical emissions data structure
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !       Allocates and initialize emission surface fields
00010 !       by reading their value in initial file.
00011 !
00012 !!**  METHOD
00013 !!    ------
00014 !!    
00015 !!    
00016 !!    AUTHOR
00017 !!    ------
00018 !!      D. Gazen       * L.A. *
00019 !!
00020 !!    MODIFICATIONS
00021 !!    -------------
00022 !!      Original        08/03/2001
00023 !!      D.Gazen  01/12/03  change emissions handling for surf. externalization
00024 !!      P.Tulet  01/01/04  introduction of rhodref for externalization
00025 !-----------------------------------------------------------------------------
00026 !
00027 !*       0.    DECLARATIONS
00028 !
00029 USE MODD_CH_EMIS_FIELD_n
00030 !
00031 USE MODI_GET_LUOUT
00032 USE MODI_BUILD_EMISSTAB_n
00033 USE MODI_BUILD_PRONOSLIST_n
00034 USE MODI_READ_SURF
00035 !
00036 !
00037 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00038 USE PARKIND1  ,ONLY : JPRB
00039 !
00040 USE MODI_ABOR1_SFX
00041 !
00042 IMPLICIT NONE
00043 !
00044 !*       0.1   declarations of arguments
00045 !
00046  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! Program name
00047 INTEGER,           INTENT(IN)  :: KLU      ! number of points
00048 INTEGER,           INTENT(IN)  :: KCH      ! logical unit of input chemistry file
00049 REAL, DIMENSION(:),INTENT(IN)  :: PRHOA    ! air density
00050 !
00051 !*       0.2   declarations of local variables
00052 !
00053 INTEGER             :: IRESP                 !   File 
00054 INTEGER             :: ILUOUT                ! output listing logical unit
00055  CHARACTER (LEN=16)  :: YRECFM                ! management
00056  CHARACTER (LEN=100) :: YCOMMENT              ! variables
00057 INTEGER             :: JSPEC                 ! Loop index for cover data
00058 INTEGER             :: IIND1,IIND2           ! Indices counter
00059 !
00060  CHARACTER(LEN=40)                 :: YSPEC_NAME ! species name
00061  CHARACTER(LEN=6), DIMENSION(:),ALLOCATABLE :: YEMIS_NAME ! species name
00062 INTEGER,DIMENSION(:),ALLOCATABLE  :: INBTIMES! number of emission times array
00063 INTEGER,DIMENSION(:),ALLOCATABLE  :: ITIMES  ! emission times for a species
00064 INTEGER,DIMENSION(:),ALLOCATABLE  :: IOFFNDX ! index array of offline emission species
00065 INTEGER                           :: INBTS   ! number of emission times for a species
00066 INTEGER                           :: INBOFF  ! Number of offline emissions
00067 INTEGER                           :: IVERB   ! verbose level
00068  CHARACTER(LEN=3)                  :: YSURF   ! surface type
00069 !
00070 INTEGER           :: IVERSION       ! version of surfex file being read
00071 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00072 !-------------------------------------------------------------------------------
00073 IF (LHOOK) CALL DR_HOOK('CH_INIT_EMISSION_N',0,ZHOOK_HANDLE)
00074  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00075 WRITE(ILUOUT,*) '------ Beginning of CH_INIT_EMISSION ------'
00076 !
00077 !* ascendant compatibility
00078 YRECFM='VERSION'
00079  CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
00080 !
00081 !*      2.     Chemical Emission fields
00082 !              ------------------------
00083 !
00084 ! Read the total number of emission files 
00085 IF (IVERSION>=4) THEN
00086   CALL READ_SURF(HPROGRAM,'EMISFILE_NBR',NEMIS_NBR,IRESP)
00087 ELSE
00088   CALL READ_SURF(HPROGRAM,'EMISFILE_GR_NBR',NEMIS_NBR,IRESP)
00089 END IF
00090 IF (IRESP/=0) THEN
00091   CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF 2D CHEMICAL EMISSION FIELDS')
00092 END IF
00093 !
00094 ! Read the number of emission species
00095 IF (IVERSION>=4) THEN
00096   CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',NEMISPEC_NBR,IRESP)
00097 ELSE
00098   CALL READ_SURF(HPROGRAM,'EMISPEC_GR_NBR',NEMISPEC_NBR,IRESP)
00099 END IF
00100 IF (IRESP/=0) THEN
00101   CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NB OF EMITTED CHEMICAL SPECIES')
00102 END IF
00103 !
00104 !
00105 IF (.NOT. ASSOCIATED(CEMIS_NAME))  THEN 
00106   ALLOCATE(CEMIS_NAME(NEMISPEC_NBR))
00107 ELSE
00108   WRITE(ILUOUT,*) 'CEMIS_NAME already allocated with SIZE :',SIZE(CEMIS_NAME)
00109 END IF
00110 
00111 IF (.NOT. ASSOCIATED(CEMIS_AREA))   ALLOCATE(CEMIS_AREA(NEMISPEC_NBR))
00112 IF (.NOT. ASSOCIATED(NEMIS_TIME))   ALLOCATE(NEMIS_TIME(NEMIS_NBR))
00113 !
00114 ALLOCATE(ITIMES(NEMIS_NBR))
00115 ALLOCATE(INBTIMES(NEMISPEC_NBR))
00116 ALLOCATE(IOFFNDX(NEMISPEC_NBR))
00117 !
00118 INBTIMES(:) = -1
00119 IOFFNDX(:)  = 0 ! Index array of offline species 
00120 !
00121 IIND1      = 0 ! Index to fill NEMIS_GR_TIMES array
00122 IIND2      = 0 ! with emission times of offline species
00123 !
00124 INBOFF     = 0 ! number of offline emission species (with emis time > 0)
00125 DO JSPEC = 1,NEMISPEC_NBR ! Loop on the number of species
00126 !
00127 ! Read article EMISNAMExxx for the name of species
00128 ! and extract from comment : surface type + number of emission times
00129   WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
00130   CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
00131   IF (IRESP/=0) THEN
00132     CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
00133   END IF
00134   READ(YCOMMENT,'(A3,24x,I5)') YSURF, INBTS
00135   WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME),'(',INBTS,' instants )'
00136 !
00137 ! Read emission times for species number JSPEC
00138   WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
00139   CALL READ_SURF(HPROGRAM,YRECFM,ITIMES(1:INBTS),IRESP,YCOMMENT,'-')
00140   IF (IRESP/=0) THEN
00141     CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING EMISSION TIMES')
00142   END IF
00143   IF (INBTS == 1) WRITE(ILUOUT,*) ' -> ',ITIMES(1)
00144 !
00145 ! Is it an offline emission ?
00146   IF (INBTS >= 1) THEN
00147     IF (ITIMES(1) >= 0) THEN 
00148 ! Yes it is. (Note that negative time refers to inline emission like biogenics
00149 ! fluxes)
00150 !
00151       INBOFF = INBOFF+1
00152       IOFFNDX(INBOFF)  = JSPEC
00153 !
00154 ! INBTIMES and NEMIS_TIME only updated for offline emission
00155       IIND1 = IIND2+1
00156       IIND2 = IIND2+INBTS
00157       NEMIS_TIME(IIND1:IIND2) = ITIMES(1:INBTS)
00158       INBTIMES(INBOFF) = INBTS
00159     END IF
00160   END IF
00161 !
00162 ! INBTIMES, CEMIS_AREA and CEMIS_NAME 
00163 ! are updated for ALL species
00164   CEMIS_NAME(JSPEC) = YSPEC_NAME
00165   CEMIS_AREA(JSPEC) = YSURF
00166 ! 
00167 END DO
00168 !
00169 WRITE(ILUOUT,*) '---- Nunmer of OFFLINE species = ',INBOFF
00170 WRITE(ILUOUT,*) 'INBTIMES=',INBTIMES
00171 WRITE(ILUOUT,*) 'IOFFNDX=',IOFFNDX
00172 
00173 IVERB=6
00174 
00175 IF (INBOFF > 0) THEN
00176   ALLOCATE(TSEMISS(INBOFF))
00177   ALLOCATE(YEMIS_NAME(INBOFF))
00178 
00179   CALL BUILD_EMISSTAB_n(HPROGRAM,KCH,CEMIS_NAME,INBTIMES,NEMIS_TIME,&
00180          IOFFNDX,TSEMISS,KLU,ILUOUT,IVERB,PRHOA)  
00181   DO JSPEC = 1,INBOFF ! Loop on the number of species
00182     YEMIS_NAME(JSPEC) = TSEMISS(JSPEC)%CNAME(1:6)
00183   END DO
00184   CALL BUILD_PRONOSLIST_n(SIZE(TSEMISS),YEMIS_NAME,TSPRONOSLIST,KCH,ILUOUT,IVERB)
00185   DEALLOCATE(YEMIS_NAME)
00186 ELSE
00187   ALLOCATE(TSEMISS(0))
00188   NULLIFY(TSPRONOSLIST)
00189 END IF
00190 
00191 DEALLOCATE(ITIMES,INBTIMES,IOFFNDX)
00192 WRITE(ILUOUT,*) '------ Leaving CH_INIT_EMISSION ------'
00193 IF (LHOOK) CALL DR_HOOK('CH_INIT_EMISSION_N',1,ZHOOK_HANDLE)
00194 !-------------------------------------------------------------------------------
00195 !
00196 END SUBROUTINE CH_INIT_EMISSION_n