soiltemp_arp_par.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 soiltemp_arp_par (IO, HPROGRAM)
!     ##############################################################
!
!!**** *SOILTEMP_ARP_PAR* Impose special pseudo depth for "force-restore"
!!                        multilayer deep temperature
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    B. Decharme        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    03/2009
!!
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modd_isba_options_n, ONLY : isba_options_t
!
USE modd_surf_par, ONLY : xundef
USE modd_read_namelist, ONLY : lnam_read
!
!
USE modn_soiltemp_arp
!
USE modi_get_luout
USE modi_open_namelist
USE modi_close_namelist
!
USE mode_pos_surf
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(isba_options_t), INTENT(INOUT) :: IO
!

 CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER               :: ILUOUT    ! output listing logical unit
INTEGER               :: ILUNAM    ! namelist file  logical unit
LOGICAL               :: GFOUND    ! true if namelist is found
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!*    0.3    Declaration of namelists
!            ------------------------
!
!
!-------------------------------------------------------------------------------
!
!*    1.      Initializations
!             ---------------
!

IF (lhook) CALL dr_hook('SOILTEMP_ARP_PAR',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
IF (lnam_read) THEN

 sodelx(:)      = xundef
 ltemp_arp      = .false.
 ntemplayer_arp = 4
 !
 !-------------------------------------------------------------------------------
 !
 !*    2.      Input value for SODELX variable
 !             -------------------------------
 !
 CALL open_namelist(hprogram,ilunam)
 !
 CALL posnam(ilunam,'NAM_SOILTEMP_ARP',gfound,iluout)
 IF (gfound) READ(unit=ilunam,nml=nam_soiltemp_arp)
 !
 CALL close_namelist(hprogram,ilunam)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*    3.      Consistency
!             -----------
!
IF(ltemp_arp.AND.io%CISBA=='DIF')THEN
   ltemp_arp=.false.
   WRITE(iluout,*)'LTEMP_ARP put at False because you use the ISBA-DF scheme'
ENDIF
!
IF(ltemp_arp)THEN
  IF(ntemplayer_arp>nmax_layer)THEN     
    WRITE(iluout,*)'NTEMPLAYER_ARP is too big (>10), NTEMPLAYER_ARP= ',ntemplayer_arp
    CALL abor1_sfx('NTEMPLAYER_ARP is too big (>10)')
  ELSEIF(ntemplayer_arp<4)THEN
    WRITE(iluout,*)'NTEMPLAYER_ARP must be at least equal to 4, NTEMPLAYER_ARP= ',ntemplayer_arp
    CALL abor1_sfx('NTEMPLAYER_ARP must be at least equal to 4')
  ENDIF
  IF(count(sodelx(1:ntemplayer_arp)/=xundef)>0.AND. &
       count(sodelx(1:ntemplayer_arp)/=xundef)/=ntemplayer_arp)THEN  
    WRITE(iluout,*)'Number of SODELX imposed values =',count(sodelx(1:ntemplayer_arp)/=xundef),&
                     ' /= NTEMPLAYER_ARP= ',ntemplayer_arp  
    CALL abor1_sfx('SODELX imposed values /= NTEMPLAYER_ARP')
  ENDIF          
ENDIF
!
!-------------------------------------------------------------------------------
!
!*    4.      Initialization
!             -------------------------------
!
IF(ltemp_arp)THEN
!
  ALLOCATE(io%XSODELX(ntemplayer_arp))
!
  IF(all(sodelx(:)==xundef))THEN
!          
    io%XSODELX(1)=0.5
    io%XSODELX(2)=1.5
    io%XSODELX(3)=4.5
    io%XSODELX(4)=13.5
    WRITE(iluout,*)'SODELX default values : ',io%XSODELX(:)
!    
  ELSE
!          
    io%XSODELX(:)=sodelx(1:ntemplayer_arp)
    WRITE(iluout,*)'SODELX imposed to : ',io%XSODELX(:)
!    
  ENDIF
!
ELSE
!
  ALLOCATE(io%XSODELX(0))
!
ENDIF
!
io%LTEMP_ARP     =ltemp_arp
io%NTEMPLAYER_ARP=ntemplayer_arp
IF (lhook) CALL dr_hook('SOILTEMP_ARP_PAR',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE soiltemp_arp_par