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

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE PREP_VER_FLAKE
00003 !     #################################################################################
00004 !
00005 !!****  *PREP_VER_FLAKE* - change in FLAKE var. due to altitude change
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    REFERENCE
00014 !!    ---------
00015 !!      
00016 !!
00017 !!    AUTHOR
00018 !!    ------
00019 !!     S. Malardel
00020 !!
00021 !!    MODIFICATIONS
00022 !!    -------------
00023 !!      Original    01/2004
00024 !!      09.2010, E. Kourzeneva: Make not possible to shift the lake profile
00025 !!                              in vertical, just to shift the lake surface 
00026 !!                              temperature and then to set the default lake profile
00027 !!------------------------------------------------------------------
00028 !
00029 
00030 !
00031 USE MODD_FLAKE_n,    ONLY : XZS, XTS  
00032 !
00033 USE MODD_PREP,       ONLY : XZS_LS, XT_CLIM_GRAD
00034 !
00035 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00036 USE PARKIND1  ,ONLY : JPRB
00037 !
00038 IMPLICIT NONE
00039 !
00040 !*      0.1    declarations of arguments
00041 !
00042 !*      0.2    declarations of local variables
00043 !
00044 REAL, DIMENSION(:), ALLOCATABLE :: ZTS_LS ! large-scale water temperature
00045 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00046 !
00047 !-------------------------------------------------------------------------------------
00048 IF (LHOOK) CALL DR_HOOK('PREP_VER_FLAKE',0,ZHOOK_HANDLE)
00049 
00050 !       1. Check if the shift is needed at all
00051 IF((ABS(MAXVAL(XZS)) < 0.001).AND.(ABS(MINVAL(XZS))< 0.001)) &
00052         CALL DR_HOOK('PREP_VER_FLAKE',1,ZHOOK_HANDLE)
00053 IF((ABS(MAXVAL(XZS)) < 0.001).AND.(ABS(MINVAL(XZS))< 0.001)) RETURN
00054 !
00055 !*      2.  Shift surface temperature of water
00056 !
00057 ALLOCATE(ZTS_LS(SIZE(XTS)))
00058 !
00059 ZTS_LS = XTS
00060 !
00061 XTS = ZTS_LS  + XT_CLIM_GRAD  * (XZS - XZS_LS)
00062 !
00063 DEALLOCATE(ZTS_LS)
00064 !
00065 IF (LHOOK) CALL DR_HOOK('PREP_VER_FLAKE',1,ZHOOK_HANDLE)
00066 !-------------------------------------------------------------------------------------
00067 !
00068 END SUBROUTINE PREP_VER_FLAKE