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

Go to the documentation of this file.
00001 !     #####################
00002       MODULE MODD_CH_TEB_n
00003 !     ######################
00004 !
00005 !!
00006 !!    PURPOSE
00007 !!    -------
00008 !     
00009 !   
00010 !
00011 !!
00012 !!**  IMPLICIT ARGUMENTS
00013 !!    ------------------
00014 !!      None
00015 !!
00016 !
00017 !!    AUTHOR
00018 !!    ------
00019 !!  P. Tulet   *Meteo France*
00020 !!
00021 !!    MODIFICATIONS
00022 !!    -------------
00023 !!  16/07/03 (P. Tulet)  restructured for externalization
00024 !------------------------------------------------------------------------------
00025 !
00026 !*       0.   DECLARATIONS
00027 !             ------------
00028 !
00029 !
00030 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00031 USE PARKIND1  ,ONLY : JPRB
00032 !
00033 IMPLICIT NONE
00034 
00035 TYPE CH_TEB_t
00036 !
00037   CHARACTER(LEN=28)  :: CCHEM_SURF_FILE  ! name of general (chemical) purpose ASCII input file
00038   CHARACTER(LEN=6)                :: CCH_DRY_DEP            !  deposition scheme
00039   REAL, DIMENSION(:,:),   POINTER :: XDEP =>NULL()                  ! final dry deposition
00040                                                             ! velocity  for nature
00041   REAL, DIMENSION(:,:),   POINTER :: XSOILRC_SO2 =>NULL()           ! for SO2
00042   REAL, DIMENSION(:,:),   POINTER :: XSOILRC_O3 =>NULL()            ! for O3
00043   LOGICAL                         :: LCH_BIO_FLUX           ! flag for the calculation of
00044                                                             ! biogenic fluxes
00045   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSV =>NULL()           ! name of the scalar var.
00046   INTEGER    :: NSV_CHSBEG, NSV_CHSEND                      ! chemical begin and ending
00047                                                             ! index of the HSV/CSV array
00048   INTEGER    :: NBEQ                                        ! number of chemical species
00049                                                             ! in the surface scheme
00050   INTEGER    :: NSV_DSTBEG, NSV_DSTEND                      ! index of first and last dust
00051 !                                                           ! related scalar variable
00052   INTEGER    :: NSV_SLTBEG, NSV_SLTEND                      ! index of first and last sea salt
00053 !                                                           ! related scalar variable
00054   INTEGER    :: NSV_AERBEG, NSV_AEREND                      ! index of first and last dust
00055 !                                                           ! related scalar variable
00056   INTEGER    :: NDSTEQ                                      ! number of dust related species
00057 !                                                           ! in scalar variables list
00058   INTEGER    :: NAEREQ                                      ! number of aerosol species
00059   INTEGER    :: NSLTEQ                                      ! number of sea salt related species
00060 !                                                           ! in scalar variables list
00061   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00062                                                             ! (FOR DIAG ONLY)
00063   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00064   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CDSTNAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00065   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSLTNAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00066 
00067 !
00068 END TYPE CH_TEB_t
00069 
00070 TYPE(CH_TEB_t), ALLOCATABLE, TARGET, SAVE :: CH_TEB_MODEL(:)
00071 
00072  CHARACTER(LEN=28), POINTER :: CCHEM_SURF_FILE=>NULL()
00073 !$OMP THREADPRIVATE(CCHEM_SURF_FILE)
00074  CHARACTER(LEN=6), POINTER :: CCH_DRY_DEP=>NULL()
00075 !$OMP THREADPRIVATE(CCH_DRY_DEP)
00076 REAL, DIMENSION(:,:),   POINTER :: XDEP=>NULL()
00077 !$OMP THREADPRIVATE(XDEP)
00078 REAL, DIMENSION(:,:),   POINTER :: XSOILRC_SO2=>NULL()
00079 !$OMP THREADPRIVATE(XSOILRC_SO2)
00080 REAL, DIMENSION(:,:),   POINTER :: XSOILRC_O3=>NULL()
00081 !$OMP THREADPRIVATE(XSOILRC_O3)
00082 LOGICAL, POINTER :: LCH_BIO_FLUX=>NULL()
00083 !$OMP THREADPRIVATE(LCH_BIO_FLUX)
00084  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSV=>NULL()
00085 !$OMP THREADPRIVATE(CSV)
00086 INTEGER, POINTER :: NSV_CHSBEG=>NULL(), NSV_CHSEND=>NULL()
00087 !$OMP THREADPRIVATE(NSV_CHSBEG,NSV_CHSEND)
00088 INTEGER, POINTER :: NSV_AERBEG=>NULL(), NSV_AEREND=>NULL()
00089 !$OMP THREADPRIVATE(NSV_AERBEG,NSV_AEREND)
00090 INTEGER, POINTER :: NSV_DSTBEG=>NULL(), NSV_DSTEND=>NULL()
00091 !$OMP THREADPRIVATE(NSV_DSTBEG,NSV_DSTEND)
00092 INTEGER, POINTER :: NSV_SLTBEG=>NULL(), NSV_SLTEND=>NULL()
00093 !$OMP THREADPRIVATE(NSV_SLTBEG,NSV_SLTEND)
00094 INTEGER, POINTER :: NBEQ=>NULL()
00095 !$OMP THREADPRIVATE(NBEQ)
00096 INTEGER, POINTER :: NAEREQ=>NULL()
00097 !$OMP THREADPRIVATE(NAEREQ)
00098 INTEGER, POINTER :: NDSTEQ=>NULL()
00099 !$OMP THREADPRIVATE(NDSTEQ)
00100 INTEGER, POINTER :: NSLTEQ=>NULL()
00101 !$OMP THREADPRIVATE(NSLTEQ)
00102  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES=>NULL()
00103 !$OMP THREADPRIVATE(CCH_NAMES)
00104  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES=>NULL()
00105 !$OMP THREADPRIVATE(CAER_NAMES)
00106  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CDSTNAMES=>NULL()
00107 !$OMP THREADPRIVATE(CDSTNAMES)
00108  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSLTNAMES=>NULL()
00109 !$OMP THREADPRIVATE(CSLTNAMES)
00110 
00111 CONTAINS
00112 
00113 SUBROUTINE CH_TEB_GOTO_MODEL(KFROM, KTO, LKFROM)
00114 LOGICAL, INTENT(IN) :: LKFROM
00115 INTEGER, INTENT(IN) :: KFROM, KTO
00116 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00117 !
00118 ! Save current state for allocated arrays
00119 IF (LKFROM) THEN
00120 CH_TEB_MODEL(KFROM)%XDEP=>XDEP
00121 CH_TEB_MODEL(KFROM)%XSOILRC_SO2=>XSOILRC_SO2
00122 CH_TEB_MODEL(KFROM)%XSOILRC_O3=>XSOILRC_O3
00123 CH_TEB_MODEL(KFROM)%CSV=>CSV
00124 CH_TEB_MODEL(KFROM)%CCH_NAMES=>CCH_NAMES
00125 CH_TEB_MODEL(KFROM)%CDSTNAMES=>CDSTNAMES
00126 CH_TEB_MODEL(KFROM)%CSLTNAMES=>CSLTNAMES
00127 CH_TEB_MODEL(KFROM)%CAER_NAMES=>CAER_NAMES
00128 ENDIF
00129 
00130 !
00131 ! Current model is set to model KTO
00132 IF (LHOOK) CALL DR_HOOK('MODD_CH_TEB_N:CH_TEB_GOTO_MODEL',0,ZHOOK_HANDLE)
00133 CCHEM_SURF_FILE=>CH_TEB_MODEL(KTO)%CCHEM_SURF_FILE
00134 CCH_DRY_DEP=>CH_TEB_MODEL(KTO)%CCH_DRY_DEP
00135 XDEP=>CH_TEB_MODEL(KTO)%XDEP
00136 XSOILRC_SO2=>CH_TEB_MODEL(KTO)%XSOILRC_SO2
00137 XSOILRC_O3=>CH_TEB_MODEL(KTO)%XSOILRC_O3
00138 LCH_BIO_FLUX=>CH_TEB_MODEL(KTO)%LCH_BIO_FLUX
00139 CSV=>CH_TEB_MODEL(KTO)%CSV
00140 NSV_CHSBEG=>CH_TEB_MODEL(KTO)%NSV_CHSBEG
00141 NSV_CHSEND=>CH_TEB_MODEL(KTO)%NSV_CHSEND
00142 NBEQ=>CH_TEB_MODEL(KTO)%NBEQ
00143 NSV_DSTBEG=>CH_TEB_MODEL(KTO)%NSV_DSTBEG
00144 NSV_DSTEND=>CH_TEB_MODEL(KTO)%NSV_DSTEND
00145 NDSTEQ=>CH_TEB_MODEL(KTO)%NDSTEQ
00146 NSV_SLTBEG=>CH_TEB_MODEL(KTO)%NSV_SLTBEG
00147 NSV_SLTEND=>CH_TEB_MODEL(KTO)%NSV_SLTEND
00148 NSLTEQ=>CH_TEB_MODEL(KTO)%NSLTEQ
00149 NSV_AERBEG=>CH_TEB_MODEL(KTO)%NSV_AERBEG
00150 NSV_AEREND=>CH_TEB_MODEL(KTO)%NSV_AEREND
00151 NAEREQ=>CH_TEB_MODEL(KTO)%NAEREQ
00152 CCH_NAMES=>CH_TEB_MODEL(KTO)%CCH_NAMES
00153 CAER_NAMES=>CH_TEB_MODEL(KTO)%CAER_NAMES
00154 CDSTNAMES=>CH_TEB_MODEL(KTO)%CDSTNAMES
00155 CSLTNAMES=>CH_TEB_MODEL(KTO)%CSLTNAMES
00156 IF (LHOOK) CALL DR_HOOK('MODD_CH_TEB_N:CH_TEB_GOTO_MODEL',1,ZHOOK_HANDLE)
00157 
00158 END SUBROUTINE CH_TEB_GOTO_MODEL
00159 
00160 SUBROUTINE CH_TEB_ALLOC(KMODEL)
00161 INTEGER, INTENT(IN) :: KMODEL
00162 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00163 IF (LHOOK) CALL DR_HOOK("MODD_CH_TEB_N:CH_TEB_ALLOC",0,ZHOOK_HANDLE)
00164 ALLOCATE(CH_TEB_MODEL(KMODEL))
00165 CH_TEB_MODEL(:)%CCHEM_SURF_FILE=' '
00166 CH_TEB_MODEL(:)%CCH_DRY_DEP=' '
00167 CH_TEB_MODEL(:)%LCH_BIO_FLUX=.FALSE.
00168 CH_TEB_MODEL(:)%NBEQ=0
00169 CH_TEB_MODEL(:)%NDSTEQ=0
00170 CH_TEB_MODEL(:)%NAEREQ=0
00171 CH_TEB_MODEL(:)%NSLTEQ=0
00172 CH_TEB_MODEL(:)%NSV_CHSBEG=0
00173 CH_TEB_MODEL(:)%NSV_CHSEND=0
00174 CH_TEB_MODEL(:)%NSV_DSTBEG=0
00175 CH_TEB_MODEL(:)%NSV_DSTEND=0
00176 CH_TEB_MODEL(:)%NSV_SLTBEG=0
00177 CH_TEB_MODEL(:)%NSV_SLTEND=0
00178 CH_TEB_MODEL(:)%NSV_AERBEG=0
00179 CH_TEB_MODEL(:)%NSV_AEREND=0
00180 IF (LHOOK) CALL DR_HOOK("MODD_CH_TEB_N:CH_TEB_ALLOC",1,ZHOOK_HANDLE)
00181 END SUBROUTINE CH_TEB_ALLOC
00182 
00183 SUBROUTINE CH_TEB_DEALLO
00184 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00185 IF (LHOOK) CALL DR_HOOK("MODD_CH_TEB_N:CH_TEB_DEALLO",0,ZHOOK_HANDLE)
00186 IF (ALLOCATED(CH_TEB_MODEL)) DEALLOCATE(CH_TEB_MODEL)
00187 IF (LHOOK) CALL DR_HOOK("MODD_CH_TEB_N:CH_TEB_DEALLO",1,ZHOOK_HANDLE)
00188 END SUBROUTINE CH_TEB_DEALLO
00189 
00190 END MODULE MODD_CH_TEB_n