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

Go to the documentation of this file.
00001 !     ###########################
00002       MODULE MODD_CH_EMIS_FIELD_n
00003 !     ###########################
00004 !
00005 !!****  *MODD_CH_EMIS_FIELD_n* - declaration of chemical emission data arrays
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !       The purpose of this declarative module is to specify  the 
00010 !     chemical emission data arrays.
00011 !
00012 !!
00013 !!**  IMPLICIT ARGUMENTS
00014 !!    ------------------
00015 !!      None 
00016 !!
00017 !!    REFERENCE
00018 !!    ---------
00019 !!      
00020 !!
00021 !!    AUTHOR
00022 !!    ------
00023 !!      D. Gazen   *L.A.*
00024 !!
00025 !!    MODIFICATIONS
00026 !!    -------------
00027 !!      Original    08/03/2001                      
00028 !!      01/12/03    (D.Gazen) change emissions handling for surf. externalization
00029 !-------------------------------------------------------------------------------
00030 !
00031 !*       0.   DECLARATIONS
00032 !             ------------
00033 !
00034 USE MODD_TYPE_EFUTIL
00035 !
00036 !
00037 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00038 USE PARKIND1  ,ONLY : JPRB
00039 !
00040 IMPLICIT NONE
00041 
00042 INTEGER,PARAMETER :: JPEMISMAX = 10000
00043 TYPE CH_EMIS_FIELD_t
00044 !
00045   REAL               :: XTIME_SIMUL  = 0.
00046   INTEGER            :: NEMIS_NBR
00047 !                          ! number of chemical pgd fields chosen by user
00048   CHARACTER(LEN=3) , DIMENSION(:), POINTER :: CEMIS_AREA
00049 !                          ! areas where chemical pgd fields are defined
00050 !                          ! 'ALL' : everywhere
00051 !                          ! 'SEA' : where sea exists
00052 !                          ! 'LAN' : where land exists
00053 !                          ! 'WAT' : where inland water exists
00054 !                          ! 'NAT' : where natural or agricultural areas exist
00055 !                          ! 'TWN' : where town areas exist
00056 !                          ! 'STR' : where streets are present
00057 !                          ! 'BLD' : where buildings are present
00058 !                          !
00059   CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_COMMENT ! comment
00060   CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_NAME
00061 !                          ! name of the chemical pgd fields (emitted species)
00062 !
00063   INTEGER,           DIMENSION(:), POINTER :: NEMIS_TIME   ! emission time
00064 !
00065   REAL,              DIMENSION(:,:), POINTER:: XEMIS_FIELDS ! emission pgd fields values
00066 !
00067   INTEGER                                          :: NEMISPEC_NBR ! Number of chemical species
00068 !
00069   TYPE(EMISSVAR_T),  DIMENSION(:), POINTER :: TSEMISS      ! Offline emission struct array
00070 !
00071   TYPE(PRONOSVAR_T),               POINTER     :: TSPRONOSLIST ! Head pointer on pronostic
00072 !                                                              variables list
00073 !-------------------------------------------------------------------------------
00074 !
00075 END TYPE CH_EMIS_FIELD_t
00076 
00077 TYPE(CH_EMIS_FIELD_t), ALLOCATABLE, TARGET, SAVE :: CH_EMIS_FIELD_MODEL(:)
00078 
00079 INTEGER, POINTER :: NEMIS_NBR=>NULL()
00080 !$OMP THREADPRIVATE(NEMIS_NBR)
00081 REAL,    POINTER :: XTIME_SIMUL=>NULL()
00082 !$OMP THREADPRIVATE(XTIME_SIMUL)
00083  CHARACTER(LEN=3) , DIMENSION(:), POINTER :: CEMIS_AREA=>NULL()
00084 !$OMP THREADPRIVATE(CEMIS_AREA)
00085  CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_COMMENT=>NULL()
00086 !$OMP THREADPRIVATE(CEMIS_COMMENT)
00087  CHARACTER(LEN=40), DIMENSION(:), POINTER :: CEMIS_NAME=>NULL()
00088 !$OMP THREADPRIVATE(CEMIS_NAME)
00089 INTEGER,           DIMENSION(:), POINTER :: NEMIS_TIME=>NULL()
00090 !$OMP THREADPRIVATE(NEMIS_TIME)
00091 REAL,              DIMENSION(:,:), POINTER:: XEMIS_FIELDS=>NULL()
00092 !$OMP THREADPRIVATE(XEMIS_FIELDS)
00093 INTEGER, POINTER :: NEMISPEC_NBR=>NULL()
00094 !$OMP THREADPRIVATE(NEMISPEC_NBR)
00095 TYPE(EMISSVAR_T),  DIMENSION(:), POINTER :: TSEMISS=>NULL()
00096 !$OMP THREADPRIVATE(TSEMISS)
00097 TYPE(PRONOSVAR_T),               POINTER     :: TSPRONOSLIST=>NULL()
00098 !$OMP THREADPRIVATE(TSPRONOSLIST)
00099 
00100 CONTAINS
00101 
00102 SUBROUTINE CH_EMIS_FIELD_GOTO_MODEL(KFROM, KTO, LKFROM)
00103 LOGICAL, INTENT(IN) :: LKFROM
00104 INTEGER, INTENT(IN) :: KFROM, KTO
00105 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00106 !
00107 ! Save current state for allocated arrays
00108 IF (LKFROM) THEN
00109 CH_EMIS_FIELD_MODEL(KFROM)%CEMIS_AREA=>CEMIS_AREA
00110 CH_EMIS_FIELD_MODEL(KFROM)%CEMIS_COMMENT=>CEMIS_COMMENT
00111 CH_EMIS_FIELD_MODEL(KFROM)%CEMIS_NAME=>CEMIS_NAME
00112 CH_EMIS_FIELD_MODEL(KFROM)%NEMIS_TIME=>NEMIS_TIME
00113 CH_EMIS_FIELD_MODEL(KFROM)%XEMIS_FIELDS=>XEMIS_FIELDS
00114 CH_EMIS_FIELD_MODEL(KFROM)%TSEMISS=>TSEMISS
00115 CH_EMIS_FIELD_MODEL(KFROM)%TSPRONOSLIST=>TSPRONOSLIST
00116 ENDIF
00117 !
00118 ! Current model is set to model KTO
00119 IF (LHOOK) CALL DR_HOOK('MODD_CH_EMIS_FIELD_N:CH_EMIS_FIELD_GOTO_MODEL',0,ZHOOK_HANDLE)
00120 
00121 XTIME_SIMUL=>CH_EMIS_FIELD_MODEL(KTO)%XTIME_SIMUL
00122 NEMIS_NBR=>CH_EMIS_FIELD_MODEL(KTO)%NEMIS_NBR
00123 CEMIS_AREA=>CH_EMIS_FIELD_MODEL(KTO)%CEMIS_AREA
00124 CEMIS_COMMENT=>CH_EMIS_FIELD_MODEL(KTO)%CEMIS_COMMENT
00125 CEMIS_NAME=>CH_EMIS_FIELD_MODEL(KTO)%CEMIS_NAME
00126 NEMIS_TIME=>CH_EMIS_FIELD_MODEL(KTO)%NEMIS_TIME
00127 XEMIS_FIELDS=>CH_EMIS_FIELD_MODEL(KTO)%XEMIS_FIELDS
00128 NEMISPEC_NBR=>CH_EMIS_FIELD_MODEL(KTO)%NEMISPEC_NBR
00129 TSEMISS=>CH_EMIS_FIELD_MODEL(KTO)%TSEMISS
00130 TSPRONOSLIST=>CH_EMIS_FIELD_MODEL(KTO)%TSPRONOSLIST
00131 IF (LHOOK) CALL DR_HOOK('MODD_CH_EMIS_FIELD_N:CH_EMIS_FIELD_GOTO_MODEL',1,ZHOOK_HANDLE)
00132 
00133 END SUBROUTINE CH_EMIS_FIELD_GOTO_MODEL
00134 
00135 SUBROUTINE CH_EMIS_FIELD_ALLOC(KMODEL)
00136 INTEGER, INTENT(IN) :: KMODEL
00137 INTEGER :: J
00138 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00139 IF (LHOOK) CALL DR_HOOK("MODD_CH_EMIS_FIELD_N:CH_EMIS_FIELD_ALLOC",0,ZHOOK_HANDLE)
00140 ALLOCATE(CH_EMIS_FIELD_MODEL(KMODEL))
00141 DO J=1,KMODEL
00142   NULLIFY(CH_EMIS_FIELD_MODEL(J)%CEMIS_AREA)
00143   NULLIFY(CH_EMIS_FIELD_MODEL(J)%CEMIS_COMMENT)
00144   NULLIFY(CH_EMIS_FIELD_MODEL(J)%CEMIS_NAME)
00145   NULLIFY(CH_EMIS_FIELD_MODEL(J)%NEMIS_TIME)
00146   NULLIFY(CH_EMIS_FIELD_MODEL(J)%XEMIS_FIELDS)
00147   NULLIFY(CH_EMIS_FIELD_MODEL(J)%TSEMISS)
00148 ENDDO
00149 CH_EMIS_FIELD_MODEL(:)%XTIME_SIMUL=0.
00150 CH_EMIS_FIELD_MODEL(:)%NEMIS_NBR=0
00151 CH_EMIS_FIELD_MODEL(:)%NEMISPEC_NBR=0
00152 IF (LHOOK) CALL DR_HOOK("MODD_CH_EMIS_FIELD_N:CH_EMIS_FIELD_ALLOC",1,ZHOOK_HANDLE)
00153 END SUBROUTINE CH_EMIS_FIELD_ALLOC
00154 
00155 SUBROUTINE CH_EMIS_FIELD_DEALLO
00156 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00157 IF (LHOOK) CALL DR_HOOK("MODD_CH_EMIS_FIELD_N:CH_EMIS_FIELD_DEALLO",0,ZHOOK_HANDLE)
00158 IF (ALLOCATED(CH_EMIS_FIELD_MODEL)) DEALLOCATE(CH_EMIS_FIELD_MODEL)
00159 IF (LHOOK) CALL DR_HOOK("MODD_CH_EMIS_FIELD_N:CH_EMIS_FIELD_DEALLO",1,ZHOOK_HANDLE)
00160 END SUBROUTINE CH_EMIS_FIELD_DEALLO
00161 
00162 END MODULE MODD_CH_EMIS_FIELD_n
00163