SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/modd_flaken.F90
Go to the documentation of this file.
00001 !     ####################
00002 MODULE MODD_FLAKE_n
00003 !     ####################
00004 !
00005 !!****  *MODD_FLAKE_n - declaration of surface parameters for the FLake model 
00006 !!                      for inland water surfaces
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !     Declaration of surface parameters
00011 !
00012 !!
00013 !!**  IMPLICIT ARGUMENTS
00014 !!    ------------------
00015 !!      None 
00016 !!
00017 !!    REFERENCE
00018 !!    ---------
00019 !!
00020 !!    AUTHOR
00021 !!    ------
00022 !!      V. Masson  *Meteo France*
00023 !!
00024 !!    MODIFICATIONS
00025 !!    -------------
00026 !!      Original       01/2004
00027 !
00028 !*       0.   DECLARATIONS
00029 !             ------------
00030 !
00031 USE MODD_TYPE_DATE_SURF
00032 !
00033 
00034 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00035 USE PARKIND1  ,ONLY : JPRB
00036 !
00037 IMPLICIT NONE
00038 TYPE FLAKE_t 
00039 !
00040 ! General surface: 
00041 !
00042   REAL, POINTER, DIMENSION(:) :: XZS       ! orography                     (m)
00043   REAL, POINTER, DIMENSION(:) :: XZ0       ! roughness length              (m)
00044   REAL, POINTER, DIMENSION(:) :: XUSTAR    ! air friction velocity         (m/s)
00045   REAL, POINTER, DIMENSION(:,:) :: XCOVER  ! fraction of each ecosystem    (-)
00046   LOGICAL, POINTER, DIMENSION(:):: LCOVER  ! GCOVER(i)=T --> ith cover field is not 0.
00047   LOGICAL                       :: LSBL    ! T: SBL scheme within the Surface Boundary Layer
00048 !                                          ! F: no atmospheric layers below forcing level  
00049 !
00050 ! Inland water:
00051   REAL, POINTER, DIMENSION(:) :: XEMIS  ! water surface emissivity (NOT USED BY FLAKE)
00052 ! FLake parameters
00053   REAL, POINTER, DIMENSION(:) :: XWATER_DEPTH  ! Lake depth (m)
00054   REAL, POINTER, DIMENSION(:) :: XWATER_FETCH  ! Lake fetch (m)
00055   REAL, POINTER, DIMENSION(:) :: XT_BS         ! Temperature at the outer edge of the thermally 
00056                                                !       active layer of the bottom sediments [K]
00057   REAL, POINTER, DIMENSION(:) :: XDEPTH_BS     ! Depth of the thermally active layer of the
00058                                                !       bottom sediments [m]
00059   REAL, POINTER, DIMENSION(:) :: XCORIO        ! The Coriolis parameter [s^{-1}]
00060   REAL, POINTER, DIMENSION(:) :: XDIR_ALB      ! Water surface direct albedo
00061   REAL, POINTER, DIMENSION(:) :: XSCA_ALB      ! Water surface diffuse albedo
00062   REAL, POINTER, DIMENSION(:) :: XICE_ALB      ! Ice surface albedo (for ESM coupling)
00063   REAL, POINTER, DIMENSION(:) :: XSNOW_ALB     ! Snow surface albedo
00064   REAL, POINTER, DIMENSION(:) :: XEXTCOEF_WATER ! Extinction coefficient for the water [m^{-1}]
00065   REAL, POINTER, DIMENSION(:) :: XEXTCOEF_ICE   ! Extinction coefficient for the ice [m^{-1}]
00066   REAL, POINTER, DIMENSION(:) :: XEXTCOEF_SNOW  ! Extinction coefficient for the snow [m^{-1}] 
00067 ! Flake variables
00068   REAL, POINTER, DIMENSION(:) :: XT_SNOW       ! Temperature at the air-snow interface [K]    
00069   REAL, POINTER, DIMENSION(:) :: XT_ICE        ! Temperature at the snow-ice or air-ice 
00070                                                !        interface [K]
00071   REAL, POINTER, DIMENSION(:) :: XT_MNW        ! Mean temperature of the water column [K]
00072   REAL, POINTER, DIMENSION(:) :: XT_WML        ! Mixed-layer temperature [K]
00073   REAL, POINTER, DIMENSION(:) :: XT_BOT        ! Temperature at the water-bottom sediment 
00074                                                !        interface [K]
00075   REAL, POINTER, DIMENSION(:) :: XT_B1         ! Temperature at the bottom of the upper 
00076                                                !        layer of the sediments [K]
00077   REAL, POINTER, DIMENSION(:) :: XCT           ! Shape factor (thermocline)
00078   REAL, POINTER, DIMENSION(:) :: XH_SNOW       ! Snow thickness [m]
00079   REAL, POINTER, DIMENSION(:) :: XH_ICE        ! Ice thickness [m]
00080   REAL, POINTER, DIMENSION(:) :: XH_ML         ! Thickness of the mixed-layer [m]
00081   REAL, POINTER, DIMENSION(:) :: XH_B1         ! Thickness of the upper layer of bottom sediments [m]                                    
00082 !
00083   REAL, POINTER, DIMENSION(:) :: XTS  ! surface temperature  (K)
00084                                       ! (water or ice or snow)
00085 
00086 ! Date:
00087 !
00088   TYPE (DATE_TIME)                  :: TTIME         ! current date and time
00089 !
00090 ! Time-step:
00091 !
00092   REAL                              :: XTSTEP        ! time step
00093 !
00094   REAL                              :: XOUT_TSTEP    ! output writing time step
00095 !
00096 ! FLake switches
00097 !
00098   LOGICAL            :: LSEDIMENTS  ! flag to use or not the bottom sediments
00099   CHARACTER(LEN=3)   :: CSNOW_FLK   ! FLake snow scheme
00100   CHARACTER(LEN=5)   :: CFLK_FLUX   ! Type of flux computation
00101   CHARACTER(LEN=4)   :: CFLK_ALB    ! Type of albedo
00102 !
00103 ! ECUME switches for FLake
00104   LOGICAL                           :: LPRECIP     ! flag for precip correction
00105   LOGICAL                           :: LPWEBB      ! flag for heat flux correction
00106   REAL                              :: XICHCE      ! CE coef calculation for ECUME
00107 !
00108 END TYPE FLAKE_t
00109 
00110 TYPE(FLAKE_t), ALLOCATABLE, TARGET, SAVE :: FLAKE_MODEL(:)
00111 
00112 REAL, POINTER, DIMENSION(:) :: XZS=>NULL()
00113 !$OMP THREADPRIVATE(XZS)
00114 REAL, POINTER, DIMENSION(:) :: XZ0=>NULL()
00115 !$OMP THREADPRIVATE(XZ0)
00116 REAL, POINTER, DIMENSION(:) :: XUSTAR=>NULL()
00117 !$OMP THREADPRIVATE(XUSTAR)
00118 REAL, POINTER, DIMENSION(:,:) :: XCOVER=>NULL()
00119 !$OMP THREADPRIVATE(XCOVER)
00120 LOGICAL, POINTER, DIMENSION(:):: LCOVER=>NULL()
00121 !$OMP THREADPRIVATE(LCOVER)
00122 LOGICAL, POINTER :: LSBL=>NULL()
00123 !$OMP THREADPRIVATE(LSBL)
00124 REAL, POINTER, DIMENSION(:) :: XEMIS=>NULL()
00125 !$OMP THREADPRIVATE(XEMIS)
00126 REAL, POINTER, DIMENSION(:) :: XWATER_DEPTH=>NULL()
00127 !$OMP THREADPRIVATE(XWATER_DEPTH)
00128 REAL, POINTER, DIMENSION(:) :: XWATER_FETCH=>NULL()
00129 !$OMP THREADPRIVATE(XWATER_FETCH)
00130 REAL, POINTER, DIMENSION(:) :: XT_BS=>NULL()
00131 !$OMP THREADPRIVATE(XT_BS)
00132 REAL, POINTER, DIMENSION(:) :: XDEPTH_BS=>NULL()
00133 !$OMP THREADPRIVATE(XDEPTH_BS)
00134 REAL, POINTER, DIMENSION(:) :: XCORIO=>NULL()
00135 !$OMP THREADPRIVATE(XCORIO)
00136 REAL, POINTER, DIMENSION(:) :: XDIR_ALB=>NULL()
00137 !$OMP THREADPRIVATE(XDIR_ALB)
00138 REAL, POINTER, DIMENSION(:) :: XSCA_ALB=>NULL()
00139 !$OMP THREADPRIVATE(XSCA_ALB)
00140 REAL, POINTER, DIMENSION(:) :: XICE_ALB=>NULL()
00141 !$OMP THREADPRIVATE(XICE_ALB)
00142 REAL, POINTER, DIMENSION(:) :: XSNOW_ALB=>NULL()
00143 !$OMP THREADPRIVATE(XSNOW_ALB)
00144 REAL, POINTER, DIMENSION(:) :: XEXTCOEF_WATER=>NULL()
00145 !$OMP THREADPRIVATE(XEXTCOEF_WATER)
00146 REAL, POINTER, DIMENSION(:) :: XEXTCOEF_ICE=>NULL()
00147 !$OMP THREADPRIVATE(XEXTCOEF_ICE)
00148 REAL, POINTER, DIMENSION(:) :: XEXTCOEF_SNOW=>NULL()
00149 !$OMP THREADPRIVATE(XEXTCOEF_SNOW)
00150 REAL, POINTER, DIMENSION(:) :: XT_SNOW=>NULL()
00151 !$OMP THREADPRIVATE(XT_SNOW)
00152 REAL, POINTER, DIMENSION(:) :: XT_ICE=>NULL()
00153 !$OMP THREADPRIVATE(XT_ICE)
00154 REAL, POINTER, DIMENSION(:) :: XT_MNW=>NULL()
00155 !$OMP THREADPRIVATE(XT_MNW)
00156 REAL, POINTER, DIMENSION(:) :: XT_WML=>NULL()
00157 !$OMP THREADPRIVATE(XT_WML)
00158 REAL, POINTER, DIMENSION(:) :: XT_BOT=>NULL()
00159 !$OMP THREADPRIVATE(XT_BOT)
00160 REAL, POINTER, DIMENSION(:) :: XT_B1=>NULL()
00161 !$OMP THREADPRIVATE(XT_B1)
00162 REAL, POINTER, DIMENSION(:) :: XCT=>NULL()
00163 !$OMP THREADPRIVATE(XCT)
00164 REAL, POINTER, DIMENSION(:) :: XH_SNOW=>NULL()
00165 !$OMP THREADPRIVATE(XH_SNOW)
00166 REAL, POINTER, DIMENSION(:) :: XH_ICE=>NULL()
00167 !$OMP THREADPRIVATE(XH_ICE)
00168 REAL, POINTER, DIMENSION(:) :: XH_ML=>NULL()
00169 !$OMP THREADPRIVATE(XH_ML)
00170 REAL, POINTER, DIMENSION(:) :: XH_B1=>NULL()
00171 !$OMP THREADPRIVATE(XH_B1)
00172 REAL, POINTER, DIMENSION(:) :: XTS=>NULL()
00173 !$OMP THREADPRIVATE(XTS)
00174 TYPE (DATE_TIME), POINTER :: TTIME=>NULL()
00175 !$OMP THREADPRIVATE(TTIME)
00176 REAL, POINTER :: XTSTEP=>NULL()
00177 !$OMP THREADPRIVATE(XTSTEP)
00178 REAL, POINTER :: XOUT_TSTEP=>NULL()
00179 !$OMP THREADPRIVATE(XOUT_TSTEP)
00180 !
00181 LOGICAL, POINTER            :: LSEDIMENTS=>NULL()  
00182 !$OMP THREADPRIVATE(LSEDIMENTS)
00183  CHARACTER(LEN=3),POINTER    :: CSNOW_FLK=>NULL()
00184 !$OMP THREADPRIVATE(CSNOW_FLK)
00185  CHARACTER(LEN=4),POINTER    :: CFLK_ALB=>NULL()
00186 !$OMP THREADPRIVATE(CFLK_ALB)
00187  CHARACTER(LEN=5),POINTER    :: CFLK_FLUX=>NULL()
00188 !$OMP THREADPRIVATE(CFLK_FLUX)
00189 !
00190 REAL, POINTER :: XICHCE=>NULL()
00191 !$OMP THREADPRIVATE(XICHCE)
00192 LOGICAL, POINTER :: LPRECIP=>NULL()
00193 !$OMP THREADPRIVATE(LPRECIP)
00194 LOGICAL, POINTER :: LPWEBB=>NULL()
00195 !$OMP THREADPRIVATE(LPWEBB)
00196 
00197 CONTAINS
00198 
00199 SUBROUTINE FLAKE_GOTO_MODEL(KFROM, KTO, LKFROM)
00200 LOGICAL, INTENT(IN) :: LKFROM
00201 INTEGER, INTENT(IN) :: KFROM, KTO
00202 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00203 !
00204 ! Save current state for allocated arrays
00205 IF (LKFROM) THEN
00206 FLAKE_MODEL(KFROM)%XZS=>XZS
00207 FLAKE_MODEL(KFROM)%XZ0=>XZ0
00208 FLAKE_MODEL(KFROM)%XUSTAR=>XUSTAR
00209 FLAKE_MODEL(KFROM)%XCOVER=>XCOVER
00210 FLAKE_MODEL(KFROM)%LCOVER=>LCOVER
00211 FLAKE_MODEL(KFROM)%XEMIS=>  XEMIS
00212 FLAKE_MODEL(KFROM)%XWATER_DEPTH=>  XWATER_DEPTH
00213 FLAKE_MODEL(KFROM)%XWATER_FETCH=>  XWATER_FETCH
00214 FLAKE_MODEL(KFROM)%XT_BS=>         XT_BS
00215 FLAKE_MODEL(KFROM)%XDEPTH_BS=>     XDEPTH_BS
00216 FLAKE_MODEL(KFROM)%XCORIO=>        XCORIO
00217 FLAKE_MODEL(KFROM)%XDIR_ALB=>      XDIR_ALB
00218 FLAKE_MODEL(KFROM)%XSCA_ALB=>      XSCA_ALB
00219 FLAKE_MODEL(KFROM)%XICE_ALB=>      XICE_ALB
00220 FLAKE_MODEL(KFROM)%XSNOW_ALB=>     XSNOW_ALB
00221 FLAKE_MODEL(KFROM)%XEXTCOEF_WATER=>XEXTCOEF_WATER
00222 FLAKE_MODEL(KFROM)%XEXTCOEF_ICE=>  XEXTCOEF_ICE
00223 FLAKE_MODEL(KFROM)%XEXTCOEF_SNOW=> XEXTCOEF_SNOW
00224 FLAKE_MODEL(KFROM)%XT_SNOW=>       XT_SNOW
00225 FLAKE_MODEL(KFROM)%XT_ICE=>        XT_ICE
00226 FLAKE_MODEL(KFROM)%XT_MNW=>        XT_MNW
00227 FLAKE_MODEL(KFROM)%XT_WML=>        XT_WML
00228 FLAKE_MODEL(KFROM)%XT_BOT=>        XT_BOT
00229 FLAKE_MODEL(KFROM)%XT_B1=>         XT_B1
00230 FLAKE_MODEL(KFROM)%XCT=>           XCT
00231 FLAKE_MODEL(KFROM)%XH_SNOW=>       XH_SNOW
00232 FLAKE_MODEL(KFROM)%XH_ICE=>        XH_ICE
00233 FLAKE_MODEL(KFROM)%XH_ML=>         XH_ML
00234 FLAKE_MODEL(KFROM)%XH_B1=>         XH_B1            
00235 FLAKE_MODEL(KFROM)%XTS=>XTS
00236 ENDIF
00237 !
00238 ! Current model is set to model KTO
00239 IF (LHOOK) CALL DR_HOOK('MODD_FLAKE_N:FLAKE_GOTO_MODEL',0,ZHOOK_HANDLE)
00240 XZS=>FLAKE_MODEL(KTO)%XZS
00241 XZ0=>FLAKE_MODEL(KTO)%XZ0
00242 XUSTAR=>FLAKE_MODEL(KTO)%XUSTAR
00243 XCOVER=>FLAKE_MODEL(KTO)%XCOVER
00244 LCOVER=>FLAKE_MODEL(KTO)%LCOVER
00245 LSBL=>FLAKE_MODEL(KTO)%LSBL
00246 XEMIS  =>FLAKE_MODEL(KTO)%XEMIS
00247 XWATER_DEPTH  =>FLAKE_MODEL(KTO)%XWATER_DEPTH
00248 XWATER_FETCH  =>FLAKE_MODEL(KTO)%XWATER_FETCH
00249 XT_BS         =>FLAKE_MODEL(KTO)%XT_BS
00250 XDEPTH_BS     =>FLAKE_MODEL(KTO)%XDEPTH_BS
00251 XCORIO        =>FLAKE_MODEL(KTO)%XCORIO
00252 XDIR_ALB      =>FLAKE_MODEL(KTO)%XDIR_ALB
00253 XSCA_ALB      =>FLAKE_MODEL(KTO)%XSCA_ALB
00254 XICE_ALB      =>FLAKE_MODEL(KTO)%XICE_ALB
00255 XSNOW_ALB     =>FLAKE_MODEL(KTO)%XSNOW_ALB
00256 XEXTCOEF_WATER =>FLAKE_MODEL(KTO)%XEXTCOEF_WATER
00257 XEXTCOEF_ICE  =>FLAKE_MODEL(KTO)%XEXTCOEF_ICE
00258 XEXTCOEF_SNOW =>FLAKE_MODEL(KTO)%XEXTCOEF_SNOW
00259 XT_SNOW       =>FLAKE_MODEL(KTO)%XT_SNOW
00260 XT_ICE        =>FLAKE_MODEL(KTO)%XT_ICE
00261 XT_MNW        =>FLAKE_MODEL(KTO)%XT_MNW
00262 XT_WML        =>FLAKE_MODEL(KTO)%XT_WML
00263 XT_BOT        =>FLAKE_MODEL(KTO)%XT_BOT
00264 XT_B1         =>FLAKE_MODEL(KTO)%XT_B1
00265 XCT           =>FLAKE_MODEL(KTO)%XCT
00266 XH_SNOW       =>FLAKE_MODEL(KTO)%XH_SNOW
00267 XH_ICE        =>FLAKE_MODEL(KTO)%XH_ICE
00268 XH_ML         =>FLAKE_MODEL(KTO)%XH_ML
00269 XH_B1         =>FLAKE_MODEL(KTO)%XH_B1        
00270 XTS=>FLAKE_MODEL(KTO)%XTS
00271 TTIME=>FLAKE_MODEL(KTO)%TTIME
00272 XTSTEP=>FLAKE_MODEL(KTO)%XTSTEP
00273 XOUT_TSTEP=>FLAKE_MODEL(KTO)%XOUT_TSTEP
00274 !
00275 LSEDIMENTS=>FLAKE_MODEL(KTO)%LSEDIMENTS  
00276 CSNOW_FLK=>FLAKE_MODEL(KTO)%CSNOW_FLK
00277 CFLK_ALB=>FLAKE_MODEL(KTO)%CFLK_ALB
00278 CFLK_FLUX=>FLAKE_MODEL(KTO)%CFLK_FLUX
00279 !
00280 XICHCE=>FLAKE_MODEL(KTO)%XICHCE
00281 LPRECIP=>FLAKE_MODEL(KTO)%LPRECIP  
00282 LPWEBB=>FLAKE_MODEL(KTO)%LPWEBB  
00283 !
00284 IF (LHOOK) CALL DR_HOOK('MODD_FLAKE_N:FLAKE_GOTO_MODEL',1,ZHOOK_HANDLE)
00285 
00286 END SUBROUTINE FLAKE_GOTO_MODEL
00287 
00288 SUBROUTINE FLAKE_ALLOC(KMODEL)
00289 INTEGER, INTENT(IN) :: KMODEL
00290 INTEGER :: J
00291 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00292 IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_N:FLAKE_ALLOC",0,ZHOOK_HANDLE)
00293 ALLOCATE(FLAKE_MODEL(KMODEL))
00294 DO J=1,KMODEL
00295   NULLIFY(FLAKE_MODEL(J)%XZS)
00296   NULLIFY(FLAKE_MODEL(J)%XZ0)
00297   NULLIFY(FLAKE_MODEL(J)%XUSTAR)
00298   NULLIFY(FLAKE_MODEL(J)%XCOVER)
00299   NULLIFY(FLAKE_MODEL(J)%LCOVER)
00300   NULLIFY(FLAKE_MODEL(J)%XEMIS)
00301   NULLIFY(FLAKE_MODEL(J)%XWATER_DEPTH)
00302   NULLIFY(FLAKE_MODEL(J)%XWATER_FETCH)
00303   NULLIFY(FLAKE_MODEL(J)%XT_BS)
00304   NULLIFY(FLAKE_MODEL(J)%XDEPTH_BS)
00305   NULLIFY(FLAKE_MODEL(J)%XCORIO)
00306   NULLIFY(FLAKE_MODEL(J)%XDIR_ALB)
00307   NULLIFY(FLAKE_MODEL(J)%XSCA_ALB)
00308   NULLIFY(FLAKE_MODEL(J)%XICE_ALB)
00309   NULLIFY(FLAKE_MODEL(J)%XSNOW_ALB)
00310   NULLIFY(FLAKE_MODEL(J)%XEXTCOEF_WATER)
00311   NULLIFY(FLAKE_MODEL(J)%XEXTCOEF_ICE)
00312   NULLIFY(FLAKE_MODEL(J)%XEXTCOEF_SNOW)
00313   NULLIFY(FLAKE_MODEL(J)%XT_SNOW)
00314   NULLIFY(FLAKE_MODEL(J)%XT_ICE)
00315   NULLIFY(FLAKE_MODEL(J)%XT_MNW)
00316   NULLIFY(FLAKE_MODEL(J)%XT_WML)
00317   NULLIFY(FLAKE_MODEL(J)%XT_BOT)
00318   NULLIFY(FLAKE_MODEL(J)%XT_B1)
00319   NULLIFY(FLAKE_MODEL(J)%XCT)
00320   NULLIFY(FLAKE_MODEL(J)%XH_SNOW)
00321   NULLIFY(FLAKE_MODEL(J)%XH_ICE)
00322   NULLIFY(FLAKE_MODEL(J)%XH_ML)
00323   NULLIFY(FLAKE_MODEL(J)%XH_B1)
00324   NULLIFY(FLAKE_MODEL(J)%XTS)
00325 ENDDO
00326 FLAKE_MODEL(:)%LSBL=.FALSE.
00327 FLAKE_MODEL(:)%XTSTEP=0.
00328 FLAKE_MODEL(:)%XOUT_TSTEP=0.
00329 FLAKE_MODEL(:)%LSEDIMENTS=.FALSE.
00330 FLAKE_MODEL(:)%CSNOW_FLK='   '
00331 FLAKE_MODEL(:)%CFLK_ALB='    '
00332 FLAKE_MODEL(:)%CFLK_FLUX='     '
00333 FLAKE_MODEL(:)%XICHCE=0.
00334 FLAKE_MODEL(:)%LPRECIP=.FALSE.
00335 FLAKE_MODEL(:)%LPWEBB=.FALSE.
00336 IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_N:FLAKE_ALLOC",1,ZHOOK_HANDLE)
00337 END SUBROUTINE FLAKE_ALLOC
00338 
00339 SUBROUTINE FLAKE_DEALLO
00340 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00341 IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_N:FLAKE_DEALLO",0,ZHOOK_HANDLE)
00342 IF (ALLOCATED(FLAKE_MODEL)) DEALLOCATE(FLAKE_MODEL)
00343 IF (LHOOK) CALL DR_HOOK("MODD_FLAKE_N:FLAKE_DEALLO",1,ZHOOK_HANDLE)
00344 END SUBROUTINE FLAKE_DEALLO
00345 
00346 END MODULE MODD_FLAKE_n