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

Go to the documentation of this file.
00001 !     #####################
00002       MODULE MODD_CH_ISBA_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_ISBA_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   LOGICAL                         :: LCH_NO_FLUX            ! flag for the calculation of
00046                                                             ! biogenic NO fluxes
00047   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSV =>NULL()           ! name of the scalar var.
00048   INTEGER    :: NSV_CHSBEG, NSV_CHSEND                      ! chemical begin and ending
00049                                                             ! index of the HSV/CSV array
00050   INTEGER    :: NBEQ                                        ! number of chemical species
00051                                                             ! in the surface scheme
00052   INTEGER    :: NSV_DSTBEG, NSV_DSTEND                      ! index of first and last dust
00053 !                                                           ! related scalar variable
00054   INTEGER    :: NSV_SLTBEG, NSV_SLTEND                      ! index of first and last sea salt
00055 !                                                           ! related scalar variable
00056   INTEGER    :: NSV_AERBEG, NSV_AEREND                      ! index of first and last dust
00057 !                                                           ! related scalar variable
00058   INTEGER    :: NDSTEQ                                      ! number of dust related species
00059 !                                                           ! in scalar variables list
00060   INTEGER    :: NAEREQ                                      ! number of aerosol species
00061   INTEGER    :: NSLTEQ                                      ! number of sea salt related species
00062 !                                                           ! in scalar variables list
00063   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00064                                                             ! (FOR DIAG ONLY)
00065   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00066   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CDSTNAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00067   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSLTNAMES =>NULL()     ! NAME OF CHEMICAL SPECIES
00068 
00069 !
00070 END TYPE CH_ISBA_t
00071 
00072 TYPE(CH_ISBA_t), ALLOCATABLE, TARGET, SAVE :: CH_ISBA_MODEL(:)
00073 
00074  CHARACTER(LEN=28), POINTER :: CCHEM_SURF_FILE=>NULL()
00075 !$OMP THREADPRIVATE(CCHEM_SURF_FILE)
00076  CHARACTER(LEN=6), POINTER :: CCH_DRY_DEP=>NULL()
00077 !$OMP THREADPRIVATE(CCH_DRY_DEP)
00078 REAL, DIMENSION(:,:,:), POINTER :: XDEP=>NULL()
00079 !$OMP THREADPRIVATE(XDEP)
00080 REAL, DIMENSION(:,:),   POINTER :: XSOILRC_SO2=>NULL()
00081 !$OMP THREADPRIVATE(XSOILRC_SO2)
00082 REAL, DIMENSION(:,:),   POINTER :: XSOILRC_O3=>NULL()
00083 !$OMP THREADPRIVATE(XSOILRC_O3)
00084 LOGICAL, POINTER :: LCH_BIO_FLUX=>NULL()
00085 !$OMP THREADPRIVATE(LCH_BIO_FLUX)
00086 LOGICAL, POINTER :: LCH_NO_FLUX=>NULL()
00087 !$OMP THREADPRIVATE(LCH_NO_FLUX)
00088  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSV=>NULL()
00089 !$OMP THREADPRIVATE(CSV)
00090 INTEGER, POINTER :: NSV_CHSBEG=>NULL(), NSV_CHSEND=>NULL()
00091 !$OMP THREADPRIVATE(NSV_CHSBEG, NSV_CHSEND)
00092 INTEGER, POINTER :: NSV_AERBEG=>NULL(), NSV_AEREND=>NULL()
00093 !$OMP THREADPRIVATE(NSV_AERBEG, NSV_AEREND)
00094 INTEGER, POINTER :: NSV_DSTBEG=>NULL(), NSV_DSTEND=>NULL()
00095 !$OMP THREADPRIVATE(NSV_DSTBEG, NSV_DSTEND)
00096 INTEGER, POINTER :: NSV_SLTBEG=>NULL(), NSV_SLTEND=>NULL()
00097 !$OMP THREADPRIVATE(NSV_SLTBEG, NSV_SLTEND)
00098 INTEGER, POINTER :: NBEQ=>NULL()
00099 !$OMP THREADPRIVATE(NBEQ)
00100 INTEGER, POINTER :: NAEREQ=>NULL()
00101 !$OMP THREADPRIVATE(NAEREQ)
00102 INTEGER, POINTER :: NDSTEQ=>NULL()
00103 !$OMP THREADPRIVATE(NDSTEQ)
00104 INTEGER, POINTER :: NSLTEQ=>NULL()
00105 !$OMP THREADPRIVATE(NSLTEQ)
00106  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES=>NULL()
00107 !$OMP THREADPRIVATE(CCH_NAMES)
00108  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES=>NULL()
00109 !$OMP THREADPRIVATE(CAER_NAMES)
00110  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CDSTNAMES=>NULL()
00111 !$OMP THREADPRIVATE(CDSTNAMES)
00112  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSLTNAMES=>NULL()
00113 !$OMP THREADPRIVATE(CSLTNAMES)
00114 
00115 CONTAINS
00116 
00117 SUBROUTINE CH_ISBA_GOTO_MODEL(KFROM, KTO, LKFROM)
00118 LOGICAL, INTENT(IN) :: LKFROM
00119 INTEGER, INTENT(IN) :: KFROM, KTO
00120 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00121 !
00122 ! Save current state for allocated arrays
00123 IF (LKFROM) THEN
00124 CH_ISBA_MODEL(KFROM)%XDEP=>XDEP
00125 CH_ISBA_MODEL(KFROM)%XSOILRC_SO2=>XSOILRC_SO2
00126 CH_ISBA_MODEL(KFROM)%XSOILRC_O3=>XSOILRC_O3
00127 CH_ISBA_MODEL(KFROM)%CSV=>CSV
00128 CH_ISBA_MODEL(KFROM)%CCH_NAMES=>CCH_NAMES
00129 CH_ISBA_MODEL(KFROM)%CDSTNAMES=>CDSTNAMES
00130 CH_ISBA_MODEL(KFROM)%CSLTNAMES=>CSLTNAMES
00131 CH_ISBA_MODEL(KFROM)%CAER_NAMES=>CAER_NAMES
00132 ENDIF
00133 
00134 !
00135 ! Current model is set to model KTO
00136 IF (LHOOK) CALL DR_HOOK('MODD_CH_ISBA_N:CH_ISBA_GOTO_MODEL',0,ZHOOK_HANDLE)
00137 CCHEM_SURF_FILE=>CH_ISBA_MODEL(KTO)%CCHEM_SURF_FILE
00138 CCH_DRY_DEP=>CH_ISBA_MODEL(KTO)%CCH_DRY_DEP
00139 XDEP=>CH_ISBA_MODEL(KTO)%XDEP
00140 XSOILRC_SO2=>CH_ISBA_MODEL(KTO)%XSOILRC_SO2
00141 XSOILRC_O3=>CH_ISBA_MODEL(KTO)%XSOILRC_O3
00142 LCH_BIO_FLUX=>CH_ISBA_MODEL(KTO)%LCH_BIO_FLUX
00143 LCH_NO_FLUX=>CH_ISBA_MODEL(KTO)%LCH_NO_FLUX
00144 CSV=>CH_ISBA_MODEL(KTO)%CSV
00145 NSV_CHSBEG=>CH_ISBA_MODEL(KTO)%NSV_CHSBEG
00146 NSV_CHSEND=>CH_ISBA_MODEL(KTO)%NSV_CHSEND
00147 NBEQ=>CH_ISBA_MODEL(KTO)%NBEQ
00148 NSV_DSTBEG=>CH_ISBA_MODEL(KTO)%NSV_DSTBEG
00149 NSV_DSTEND=>CH_ISBA_MODEL(KTO)%NSV_DSTEND
00150 NDSTEQ=>CH_ISBA_MODEL(KTO)%NDSTEQ
00151 NSV_SLTBEG=>CH_ISBA_MODEL(KTO)%NSV_SLTBEG
00152 NSV_SLTEND=>CH_ISBA_MODEL(KTO)%NSV_SLTEND
00153 NSLTEQ=>CH_ISBA_MODEL(KTO)%NSLTEQ
00154 NSV_AERBEG=>CH_ISBA_MODEL(KTO)%NSV_AERBEG
00155 NSV_AEREND=>CH_ISBA_MODEL(KTO)%NSV_AEREND
00156 NAEREQ=>CH_ISBA_MODEL(KTO)%NAEREQ
00157 CCH_NAMES=>CH_ISBA_MODEL(KTO)%CCH_NAMES
00158 CAER_NAMES=>CH_ISBA_MODEL(KTO)%CAER_NAMES
00159 CDSTNAMES=>CH_ISBA_MODEL(KTO)%CDSTNAMES
00160 CSLTNAMES=>CH_ISBA_MODEL(KTO)%CSLTNAMES
00161 IF (LHOOK) CALL DR_HOOK('MODD_CH_ISBA_N:CH_ISBA_GOTO_MODEL',1,ZHOOK_HANDLE)
00162 
00163 END SUBROUTINE CH_ISBA_GOTO_MODEL
00164 
00165 SUBROUTINE CH_ISBA_ALLOC(KMODEL)
00166 INTEGER, INTENT(IN) :: KMODEL
00167 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00168 IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_ALLOC",0,ZHOOK_HANDLE)
00169 ALLOCATE(CH_ISBA_MODEL(KMODEL))
00170 CH_ISBA_MODEL(:)%CCHEM_SURF_FILE=' '
00171 CH_ISBA_MODEL(:)%CCH_DRY_DEP=' '
00172 CH_ISBA_MODEL(:)%LCH_BIO_FLUX=.FALSE.
00173 CH_ISBA_MODEL(:)%LCH_NO_FLUX=.FALSE.
00174 CH_ISBA_MODEL(:)%NBEQ=0
00175 CH_ISBA_MODEL(:)%NDSTEQ=0
00176 CH_ISBA_MODEL(:)%NAEREQ=0
00177 CH_ISBA_MODEL(:)%NSLTEQ=0
00178 CH_ISBA_MODEL(:)%NSV_CHSBEG=0
00179 CH_ISBA_MODEL(:)%NSV_CHSEND=0
00180 CH_ISBA_MODEL(:)%NSV_DSTBEG=0
00181 CH_ISBA_MODEL(:)%NSV_DSTEND=0
00182 CH_ISBA_MODEL(:)%NSV_SLTBEG=0
00183 CH_ISBA_MODEL(:)%NSV_SLTEND=0
00184 CH_ISBA_MODEL(:)%NSV_AERBEG=0
00185 CH_ISBA_MODEL(:)%NSV_AEREND=0
00186 IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_ALLOC",1,ZHOOK_HANDLE)
00187 END SUBROUTINE CH_ISBA_ALLOC
00188 
00189 SUBROUTINE CH_ISBA_DEALLO
00190 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00191 IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_DEALLO",0,ZHOOK_HANDLE)
00192 IF (ALLOCATED(CH_ISBA_MODEL)) DEALLOCATE(CH_ISBA_MODEL)
00193 IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_DEALLO",1,ZHOOK_HANDLE)
00194 END SUBROUTINE CH_ISBA_DEALLO
00195 
00196 END MODULE MODD_CH_ISBA_n