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, FM, UG, U, &
                       hprogram,hatmfile,hatmfiletype,hpgdfile,hpgdfiletype)
!     #################################################################################
!
!!****  *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
!!------------------------------------------------------------------
!
!
!
USE modd_surfex_n, ONLY : flake_model_t
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modi_prep_hor_flake_field
USE modi_prep_ver_flake
USE modi_prep_flake_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 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(surf_atm_sso_t), INTENT(INOUT) :: uss
!
TYPE(flake_model_t), INTENT(INOUT) :: fm
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 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 :: 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)
 CALL get_luout(hprogram,iluout)
!
 CALL prep_output_grid(ug, u, &
                       iluout,fm%FG%CGRID,fm%FG%XGRID_PAR,fm%FG%XLAT,fm%FG%XLON)
!
!-------------------------------------------------------------------------------------
!
!*      2.     Reading and horizontal interpolations
!
!
!*      2.0    Large scale orography
!
 CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%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, &
                           fm%FG, fm%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, &
                           fm%FG, fm%F, &
                           hprogram,'T_SNOW ',hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'T_ICE  ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'T_WML  ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  ALLOCATE(fm%F%XT_MNW(SIZE(fm%FG%XLAT)))
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'T_BOT  ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'T_B1   ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'CT     ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'H_SNOW ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'H_ICE  ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'H_ML   ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
  IF (.NOT.gnovalue) CALL prep_hor_flake_field(dtco, ug, u, uss, &
                           fm%FG, fm%F, &
                           hprogram,'H_B1   ',hatmfile,hatmfiletype,&
        hpgdfile,hpgdfiletype,gnovalue)
  !
ENDIF
!
IF (lclim_lake .OR. gnovalue) THEN
  IF (lclim_lake) THEN
    ALLOCATE(fm%F%XTS(SIZE(fm%FG%XLAT)))
    fm%F%XTS(:)=xundef
  ENDIF
  ALLOCATE(fm%F%XT_SNOW(SIZE(fm%FG%XLAT))) 
  ALLOCATE(fm%F%XT_ICE(SIZE(fm%FG%XLAT)))  
  ALLOCATE(fm%F%XT_WML(SIZE(fm%FG%XLAT)))
  ALLOCATE(fm%F%XT_MNW(SIZE(fm%FG%XLAT))) 
  ALLOCATE(fm%F%XT_BOT(SIZE(fm%FG%XLAT)))  
  ALLOCATE(fm%F%XT_B1(SIZE(fm%FG%XLAT)))
  ALLOCATE(fm%F%XCT(SIZE(fm%FG%XLAT)))  
  ALLOCATE(fm%F%XH_SNOW(SIZE(fm%FG%XLAT)))  
  ALLOCATE(fm%F%XH_ICE(SIZE(fm%FG%XLAT)))
  ALLOCATE(fm%F%XH_ML(SIZE(fm%FG%XLAT)))
  ALLOCATE(fm%F%XH_B1(SIZE(fm%FG%XLAT)))  
  fm%F%XT_SNOW(:)=xundef
  fm%F%XT_ICE(:)=xundef
  fm%F%XT_WML(:)=xundef
  fm%F%XT_MNW(:)=xundef
  fm%F%XT_BOT(:)=xundef
  fm%F%XT_B1(:)=xundef
  fm%F%XCT(:)=xundef
  fm%F%XH_SNOW(:)=xundef
  fm%F%XH_ICE(:)=xundef
  fm%F%XH_ML(:)=xundef
  fm%F%XH_B1(:)=xundef
ENDIF
!
!-------------------------------------------------------------------------------------
!
 CALL clean_prep_output_grid
!
!*      2.2    Roughness
!
ALLOCATE(fm%F%XZ0(SIZE(fm%F%XTS)))
fm%F%XZ0 = 0.001
!
!*      2.2    Friction velocity
!
ALLOCATE(fm%F%XUSTAR(SIZE(fm%F%XTS)))
fm%F%XUSTAR = 0.
!
!-------------------------------------------------------------------------------------

!
!*      3.     Vertical interpolations of all variables
!
IF(.NOT.lclim_lake) THEN
  IF (lvertshift)THEN    
    CALL prep_ver_flake(fm%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(fm%FG, fm%F)
ELSEIF (.NOT.gnovalue) THEN
  fm%F%XT_MNW(:)=fm%F%XT_WML(:)-(fm%F%XT_WML(:)-fm%F%XT_BOT(:))*(1.-fm%F%XH_ML(:)/fm%F%XWATER_DEPTH(:))*fm%F%XCT(:)
ELSE
  WRITE(iluout,*) "WARNING! One of the lake profile variales was not indicated, so set the default profile!"
  fm%F%XT_WML=max(fm%F%XTS(:),xtt)  
  fm%F%XT_SNOW=min(fm%F%XTS(:),xtt)
  fm%F%XT_ICE=min(fm%F%XTS(:),xtt)
  fm%F%XH_B1=0.0 
  fm%F%XCT=0.5   
  fm%F%XH_SNOW=0.0   
  WHERE (fm%F%XTS <= xtt)
   fm%F%XT_BOT=xtt+4.
   fm%F%XT_B1=xtt+3.9
   fm%F%XH_ICE=0.01
   fm%F%XH_ML=fm%F%XWATER_DEPTH/2.
   fm%F%XT_MNW=fm%F%XT_WML-(fm%F%XT_WML-fm%F%XT_BOT)*(1.-fm%F%XH_ML/fm%F%XWATER_DEPTH)*fm%F%XCT
  ELSEWHERE
   fm%F%XT_BOT=fm%F%XTS
   fm%F%XT_B1=fm%F%XTS-0.1
   fm%F%XH_ICE=0.0
   fm%F%XH_ML=fm%F%XWATER_DEPTH
   fm%F%XT_MNW=fm%F%XTS 
  END WHERE
END IF
!
!-------------------------------------------------------------------------------------
!
!*      6.     Preparation of SBL air variables
!
fm%F%LSBL = lwat_sbl
IF (fm%F%LSBL) CALL prep_flake_sbl(fm%FG, fm%FSB)
IF (lhook) CALL dr_hook('PREP_FLAKE',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE prep_flake