pgd_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 pgd_flake (DTCO, FG, F, UG, U, USS, &
                            hprogram,oecoclimap,orm_river)
!     ##############################################################
!
!!**** *PGD_FLAKE* monitor for averaging and interpolations of FLAKE physiographic fields
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    03/2004
!!    04/2013, P. Le Moigne : allow limitation of lake depth
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_flake_grid_n, ONLY : flake_grid_t
USE modd_flake_n, ONLY : flake_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
!
USE modd_data_lake,      ONLY : clakeldb, cstatusldb
USE modd_data_cover_par, ONLY : jpcover
USE modd_surf_par,       ONLY : xundef
!
USE modd_pgdwork,        ONLY : catype
!
!
USE modi_abor1_sfx
USE modi_get_luout
USE modi_pgd_field

USE modi_get_surf_size_n
USE modi_pack_pgd
!
USE modi_open_namelist
USE modi_close_namelist
!
USE modi_treat_global_lake_depth
!
USE mode_pos_surf
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_write_cover_tex_water
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(flake_grid_t), INTENT(INOUT) :: fg
TYPE(flake_t), INTENT(INOUT) :: f
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
!
 CHARACTER(LEN=6),    INTENT(IN)    :: hprogram     ! Type of program
LOGICAL,             INTENT(IN)    :: oecoclimap
LOGICAL,             INTENT(IN)    :: orm_river    ! delete river coverage (default = false)
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER                           :: iluout    ! output listing logical unit
INTEGER                           :: ilunam    ! namelist file logical unit
LOGICAL                           :: gfound    ! flag when namelist is present
INTEGER,DIMENSION(:),ALLOCATABLE  :: iwater_status
!
!*    0.3    Declaration of namelists
!            ------------------------
!
 CHARACTER(LEN=28)        :: ywater_depth  ! file name for water depth
 CHARACTER(LEN=28)        :: ywater_depth_status  ! file name for water depth status
 CHARACTER(LEN=28)        :: ywater_fetch
 CHARACTER(LEN=28)        :: yt_bs
 CHARACTER(LEN=28)        :: ydepth_bs
 CHARACTER(LEN=28)        :: yextcoef_water

 CHARACTER(LEN=6)         :: ywater_depthfiletype ! water depth file type
 CHARACTER(LEN=6)         :: ywater_fetchfiletype
 CHARACTER(LEN=6)         :: yt_bsfiletype
 CHARACTER(LEN=6)         :: ydepth_bsfiletype
 CHARACTER(LEN=6)         :: yextcoef_waterfiletype

REAL                     :: xunif_water_depth   ! uniform value of water depth
REAL                     :: xunif_water_fetch
REAL                     :: xunif_t_bs
REAL                     :: xunif_depth_bs
REAL                     :: xunif_extcoef_water
REAL                     :: xmax_depth
REAL(KIND=JPRB) :: zhook_handle
!
namelist/nam_data_flake/ ywater_depth, ywater_depth_status, ywater_depthfiletype,     &
                         xunif_water_depth, ywater_fetch, ywater_fetchfiletype,       &
                         xunif_water_fetch, yt_bs, yt_bsfiletype, xunif_t_bs,         &
                         ydepth_bs, ydepth_bsfiletype, xunif_depth_bs,                &
                         yextcoef_water, yextcoef_waterfiletype, xunif_extcoef_water, &
                         xmax_depth  
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PGD_FLAKE',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!-------------------------------------------------------------------------------
!
!*    1.      Initializations of defaults
!             ---------------------------
!
xunif_water_depth  = 10.
xunif_water_fetch  = 1000.
xunif_t_bs         = 286.
xunif_depth_bs     = 1.
xunif_extcoef_water= 3.
!
ywater_depth        = '                          '
ywater_depth_status = '                          '
ywater_fetch        = '                          '
yt_bs               = '                          '
ydepth_bs           = '                          '
yextcoef_water      = '                          '
!
ywater_depthfiletype   = '      '
ywater_fetchfiletype   = '      '
yt_bsfiletype          = '      '
ydepth_bsfiletype      = '      '
yextcoef_waterfiletype = '      '
!
xmax_depth  = 1.e+20
!
!-------------------------------------------------------------------------------
!
!*    2.      Reading of namelist
!             -------------------
!
 CALL open_namelist(hprogram,ilunam)
!
 CALL posnam(ilunam,'NAM_DATA_FLAKE',gfound,iluout)
IF (gfound) READ(unit=ilunam,nml=nam_data_flake)
!
 CALL close_namelist(hprogram,ilunam)
!
!-------------------------------------------------------------------------------
!
!*    3.      Coherence of options
!             --------------------
!
!-------------------------------------------------------------------------------
!
!*    4.      Number of points and packing
!             ----------------------------
!
 CALL get_surf_size_n(dtco, u, &
                      'WATER ',fg%NDIM)
!
ALLOCATE(f%LCOVER     (jpcover))
ALLOCATE(f%XZS        (fg%NDIM))
ALLOCATE(fg%XLAT       (fg%NDIM))
ALLOCATE(fg%XLON       (fg%NDIM))
ALLOCATE(fg%XMESH_SIZE (fg%NDIM))
!
 CALL pack_pgd(dtco, u, &
               hprogram, 'WATER ',                    &
                fg%CGRID,  fg%XGRID_PAR,                     &
                f%LCOVER, f%XCOVER, f%XZS,                   &
                fg%XLAT, fg%XLON, fg%XMESH_SIZE                 )  
!
!-------------------------------------------------------------------------------
!
!*    5.      Water depth
!             -----------
!
ALLOCATE(f%XWATER_DEPTH  (fg%NDIM)) 
!
IF (trim(ywater_depth)==trim(clakeldb) .AND. trim(ywater_depthfiletype)=='DIRECT') THEN
  !      
  IF (trim(ywater_depth_status)=='') THEN
     WRITE(iluout,*)'Depth Status file name not initialized'
     WRITE(iluout,*)'add YWATER_DEPTH_STATUS="GlobalLakeStatus" in NAM_DATA_FLAKE'
     CALL abor1_sfx('PGD_FLAKE: STATUS INPUT FILE NAME NOT SET')
  ELSEIF (trim(ywater_depth_status)==trim(cstatusldb)) THEN
     ALLOCATE(iwater_status(fg%NDIM))       
     CALL treat_global_lake_depth(dtco, ug, u, uss, &
                                  hprogram,f%XWATER_DEPTH(:),iwater_status(:))
  ELSE
     WRITE(iluout,*)'Wrong name for Depth Status file :',' expected: ',trim(cstatusldb),' input: ',trim(ywater_depth_status)
     CALL abor1_sfx('PGD_FLAKE: WRONG STATUS INPUT FILE NAME')
  ENDIF
  !
ELSE
  !
  IF(oecoclimap.AND.(.NOT.orm_river))THEN
     WRITE(iluout,*)'With this version of Flake, river must be removed'
     WRITE(iluout,*)'Indeed, river energy budget can not be computed  '
     WRITE(iluout,*)'using static lake scheme without 2D informations.'
     WRITE(iluout,*)'Please add LRM_RIVER = T in NAM_COVER            '
     WRITE(iluout,*)' '
     WRITE(iluout,*)'If you still want to use Flake to comput river   '
     WRITE(iluout,*)'energy budget, please use the two files for the  '
     WRITE(iluout,*)'Kourzeneva 2009 method: ',clakeldb(1:len_trim(clakeldb)),' ',&
                                               cstatusldb(1:len_trim(cstatusldb))
     CALL abor1_sfx('PGD_FLAKE: WITH THIS VERSION OF FLAKE, LRM_RIVER MUST BE TRUE')         
  ENDIF
  !
  catype='INV'
  CALL pgd_field(dtco, ug, u, uss, &
                 hprogram,'water depth','WAT',ywater_depth,ywater_depthfiletype,xunif_water_depth,f%XWATER_DEPTH(:))
  !
ENDIF
!
f%XWATER_DEPTH(:) = min(f%XWATER_DEPTH(:),xmax_depth)
WRITE(iluout,*)'MAXIMUM LAKE DEPTH = ',xmax_depth
!
!-------------------------------------------------------------------------------
!
!*    6.      Wind fetch
!             ----------
!
ALLOCATE(f%XWATER_FETCH  (fg%NDIM)) 
!
 catype='ARI'
 CALL pgd_field(dtco, ug, u, uss, &
                 hprogram,'wind fetch','WAT',ywater_fetch,ywater_fetchfiletype,xunif_water_fetch,f%XWATER_FETCH(:))
!
!-------------------------------------------------------------------------------
!
!*    7.      Sediments bottom temperature
!             ----------------------------
!
ALLOCATE(f%XT_BS         (fg%NDIM)) 
!
 catype='ARI'
 CALL pgd_field(dtco, ug, u, uss, &
                 hprogram,'sediments bottom temperature ','WAT',yt_bs,yt_bsfiletype,xunif_t_bs,f%XT_BS(:))
!
!-------------------------------------------------------------------------------
!
!*    8.      Depth of sediments layer
!             ------------------------
!
ALLOCATE(f%XDEPTH_BS     (fg%NDIM)) 
!
 catype='INV'
 CALL pgd_field(dtco, ug, u, uss, &
                 hprogram,'depth of sediments layer','WAT',ydepth_bs,ydepth_bsfiletype,xunif_depth_bs,f%XDEPTH_BS(:))
!
!-------------------------------------------------------------------------------
!
!*    9.      Water extinction coefficient
!             ----------------------------

ALLOCATE(f%XEXTCOEF_WATER(fg%NDIM)) 
!
 catype='ARI'
 CALL pgd_field(dtco, ug, u, uss, &
                 hprogram,'water extinction coefficient','WAT', &
                 yextcoef_water,yextcoef_waterfiletype,xunif_extcoef_water, &
                 f%XEXTCOEF_WATER(:))  
!
!-------------------------------------------------------------------------------
!
!*   10.     Prints of flake parameters in a tex file
!            ----------------------------------------
!
 CALL write_cover_tex_water
!
IF (lhook) CALL dr_hook('PGD_FLAKE',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE pgd_flake