prep_flake.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
SUBROUTINE prep_flake (DTCO, USS, FG, F, SB, UG, U, GCP, &
                       HPROGRAM,HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,YDCTL)
!     #################################################################################
!
!!****  *PREP_FLAKE* - prepares FLAKE fields
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     S. Malardel
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      S. Riette   06/2009 PREP_FLAKE_SBL has no more argument
!!      E. Kourzeneva 09/2010 (i)  Change the default initialisation,
!!                            (ii) Include the possibility to use 
!!                                 lake climate data
!!      P. Marguinaud10/2014, Support for a 2-part PREP
!!------------------------------------------------------------------
!
!
USE modd_sfx_grid_n, ONLY : grid_t
USE modd_flake_n, ONLY : flake_t
USE modd_canopy_n, ONLY : canopy_t
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_sso_n, ONLY : sso_t
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_grid_conf_proj_n, ONLY : grid_conf_proj_t
!
USE modi_prep_hor_flake_field
USE modi_prep_ver_flake
USE modi_prep_sbl
USE modi_prep_output_grid
USE modi_get_luout
USE modi_cli_lake
!
USE modn_prep_flake
!
USE modd_read_namelist,ONLY : lnam_read
USE modd_surf_atm,     ONLY : lvertshift
USE modd_prep,         ONLY : xzs_ls
USE modd_prep_flake,   ONLY : lclim_lake
USE modd_surf_par,     ONLY : xundef
!
USE modd_csts,       ONLY : xtt
USE mode_prep_ctl, ONLY : prep_ctl, prep_ctl_can
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_clean_prep_output_grid
!
USE modi_abor1_sfx
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(sso_t), INTENT(INOUT) :: USS
!
TYPE(grid_t), INTENT(INOUT) :: FG
TYPE(flake_t), INTENT(INOUT) :: F
TYPE(canopy_t), INTENT(INOUT) :: SB
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(grid_conf_proj_t),INTENT(INOUT) :: GCP
!
type(prep_ctl),    INTENT(INOUT) :: ydctl
!
 CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
 CHARACTER(LEN=28),  INTENT(IN)  :: HATMFILE    ! name of the Atmospheric file
 CHARACTER(LEN=6),   INTENT(IN)  :: HATMFILETYPE! type of the Atmospheric file
 CHARACTER(LEN=28),  INTENT(IN)  :: HPGDFILE    ! name of the Atmospheric file
 CHARACTER(LEN=6),   INTENT(IN)  :: HPGDFILETYPE! type of the Atmospheric file
!
!*      0.2    declarations of local variables
!
INTEGER :: ISIZE
INTEGER :: ILUOUT
LOGICAL :: GNOVALUE       ! if the variable is not defined
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
!*      1.     Default of configuration
!
!
IF (lhook) CALL dr_hook('PREP_FLAKE',0,zhook_handle)
!
IF (.NOT. prep_ctl_can(ydctl)) THEN
  CALL abor1_sfx('PREP_FLAKE: TWO STEP PREP NOT IMPLEMENTED')
ENDIF

 CALL get_luout(hprogram,iluout)
!
 CALL prep_output_grid(ug%G, fg, u%NSIZE_FULL, iluout)
!
isize = SIZE(fg%XLAT)
!
!-------------------------------------------------------------------------------------
!
!*      2.     Reading and horizontal interpolations
!
!
!*      2.0    Large scale orography
!
 CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'ZS     ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype)
!
!*      2.1    FLake variables
!
gnovalue = .false.
!
IF (.NOT.lclim_lake) THEN
  !
  CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'TS     ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  IF (gnovalue) CALL abor1_sfx('PREP_FLAKE: AT LEAST TS SHOULD BE GIVEN!')
  !
  CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'T_SNOW ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'T_ICE  ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'T_WML  ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  ALLOCATE(f%XT_MNW(isize))
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'T_BOT  ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'T_B1   ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'CT     ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'H_SNOW ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'H_ICE  ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'H_ML   ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, gcp, isize, f, &
                           hprogram,'H_B1   ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
ENDIF
!
IF (lclim_lake .OR. gnovalue) THEN
  IF (lclim_lake) THEN
    ALLOCATE(f%XTS(isize))
    f%XTS(:)=xundef
  ENDIF
  ALLOCATE(f%XT_SNOW(isize)) 
  ALLOCATE(f%XT_ICE(isize))  
  ALLOCATE(f%XT_WML(isize))
  ALLOCATE(f%XT_MNW(isize)) 
  ALLOCATE(f%XT_BOT(isize))  
  ALLOCATE(f%XT_B1(isize))
  ALLOCATE(f%XCT(isize))  
  ALLOCATE(f%XH_SNOW(isize))  
  ALLOCATE(f%XH_ICE(isize))
  ALLOCATE(f%XH_ML(isize))
  ALLOCATE(f%XH_B1(isize))  
  f%XT_SNOW(:)=xundef
  f%XT_ICE(:)=xundef
  f%XT_WML(:)=xundef
  f%XT_MNW(:)=xundef
  f%XT_BOT(:)=xundef
  f%XT_B1(:)=xundef
  f%XCT(:)=xundef
  f%XH_SNOW(:)=xundef
  f%XH_ICE(:)=xundef
  f%XH_ML(:)=xundef
  f%XH_B1(:)=xundef
ENDIF
!
!-------------------------------------------------------------------------------------
!
 CALL clean_prep_output_grid
!
!*      2.2    Roughness
!
ALLOCATE(f%XZ0(SIZE(f%XTS)))
f%XZ0 = 0.001
!
!*      2.2    Friction velocity
!
ALLOCATE(f%XUSTAR(SIZE(f%XTS)))
f%XUSTAR = 0.
!
!-------------------------------------------------------------------------------------

!
!*      3.     Vertical interpolations of all variables
!
IF(.NOT.lclim_lake) THEN
  IF (lvertshift)THEN    
    CALL prep_ver_flake(f)
    WRITE(iluout,*) "WARNING: You want the vertical shift for lakes?"
    WRITE(iluout,*) "WARNING: Vertical shift for the lake temperature profile is impossible!"
    WRITE(iluout,*) "WARNING: So, set the default vertical profiles from the shifted surface temperature."    !
    gnovalue=.true.
  ENDIF
END IF
!
DEALLOCATE(xzs_ls)
!-------------------------------------------------------------------------------------
!
!*      4.    Compute T_MNW and give the default profile if needed 
!              or read data from climate files 
!
IF (lclim_lake) THEN
 CALL cli_lake(fg, f)
ELSEIF (.NOT.gnovalue) THEN
  f%XT_MNW(:)=f%XT_WML(:)-(f%XT_WML(:)-f%XT_BOT(:))*(1.-f%XH_ML(:)/f%XWATER_DEPTH(:))*f%XCT(:)
ELSE
  WRITE(iluout,*) "WARNING! One of the lake profile variales was not indicated, so set the default profile!"
  f%XT_WML=max(f%XTS(:),xtt)  
  f%XT_SNOW=min(f%XTS(:),xtt)
  f%XT_ICE=min(f%XTS(:),xtt)
  f%XH_B1=0.0 
  f%XCT=0.5   
  f%XH_SNOW=0.0   
  WHERE (f%XTS <= xtt)
   f%XT_BOT=xtt+4.
   f%XT_B1=xtt+3.9
   f%XH_ICE=0.01
   f%XH_ML=f%XWATER_DEPTH/2.
   f%XT_MNW=f%XT_WML-(f%XT_WML-f%XT_BOT)*(1.-f%XH_ML/f%XWATER_DEPTH)*f%XCT
  ELSEWHERE
   f%XT_BOT=f%XTS
   f%XT_B1=f%XTS-0.1
   f%XH_ICE=0.0
   f%XH_ML=f%XWATER_DEPTH
   f%XT_MNW=f%XTS 
  END WHERE
END IF
!
!-------------------------------------------------------------------------------------
!
!*      6.     Preparation of SBL air variables
!
f%LSBL = lwat_sbl
IF (f%LSBL) CALL prep_sbl(isize, sb)
!
IF (lhook) CALL dr_hook('PREP_FLAKE',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE prep_flake