ini_data_soil.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 ini_data_soil(HISBA,PDG_OUT,PSURF,PSURF2,PROOTDEPTH, &
                               PSOILDEPTH,PSOILGRID,KWG_LAYER   )
!     #########################
!
!!**** *INI_DATA_SOIL* initializes soil depth and root fraction for a given
!!                     number of soil layers
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    01/04/2003
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modd_surf_par,       ONLY : xundef
!
USE modi_soilgrid
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
 CHARACTER(LEN=*), INTENT(IN) :: HISBA   ! type of soil (Force-Restore OR Diffusion)
REAL, DIMENSION(:,:), INTENT(OUT) :: PDG_OUT
!
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF2
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PROOTDEPTH
REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSOILDEPTH
REAL, DIMENSION(:),   OPTIONAL, INTENT(IN) :: PSOILGRID   ! reference soil grid          (m)
!
INTEGER, DIMENSION(:), OPTIONAL, INTENT(OUT) :: KWG_LAYER   ! last layers for soil moisture
!
!*    0.2    Declaration of local variables
!      ------------------------------
!
LOGICAL,DIMENSION(SIZE(PDG_OUT,1)) :: LSURF
INTEGER            :: JLOOP    ! class loop counter
INTEGER            :: JLAYER   ! soil layer loop counter
INTEGER            :: JVEG     ! vegetation types loop counter
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
!*    1.     Allocations
!            -----------
!
IF (lhook) CALL dr_hook('INI_DATA_SOIL',0,zhook_handle)
!
pdg_out(:,:) = xundef
!
!-------------------------------------------------------------------------------
!
!*    2.     loop on cover types
!            -------------------
!
lsurf(:) = .false. 
!
IF (PRESENT(psurf2) .AND. PRESENT(psurf)) THEN
  lsurf(:) = (psurf(:)==0. .AND. psurf2(:)==0.)
ELSEIF (PRESENT(psurf)) THEN
  lsurf(:) = (psurf(:)==0.)
ENDIF
!
!*    3.     soil depth
!            ----------
!
!*    3.1    force-restore case (2 layers)
!            ------------------
IF (hisba=='2-L') THEN

  IF (.NOT.PRESENT(prootdepth)) CALL abor1_sfx("INI_DATA_SOIL: FOR HISBA==2-L, PROOTDEPTH IS NEEDED")
   
  DO jloop = 1,SIZE(lsurf)
    IF (lsurf(jloop)) cycle
    IF(prootdepth(jloop) /= xundef) THEN
      pdg_out(jloop,1) = 0.01
      pdg_out(jloop,2) = prootdepth(jloop)
    ENDIF
  ENDDO
!
!
!*    3.2    force-restore case (3 layers)
!            ------------------
!
ELSE
          
  IF (.NOT.PRESENT(psoildepth)) CALL abor1_sfx("INI_DATA_SOIL: FOR HISBA/=2-L, PSOILDEPTH IS NEEDED")

  IF (hisba=='3-L') THEN

    IF (.NOT.PRESENT(prootdepth)) CALL abor1_sfx("INI_DATA_SOIL: FOR HISBA==3-L, PROOTDEPTH IS NEEDED")

    DO jloop = 1,SIZE(lsurf)
      IF (lsurf(jloop)) cycle
      IF(psoildepth(jloop) /= xundef) THEN
        pdg_out(jloop,1) = 0.01
        pdg_out(jloop,2) = prootdepth(jloop)
        pdg_out(jloop,3) = psoildepth(jloop)
      ENDIF
    ENDDO
!
!
!*    3.3    Diffusion case (at least 4 soil layers)
!            --------------
!
  ELSE

    IF (.NOT.PRESENT(psoilgrid)) CALL abor1_sfx("INI_DATA_SOIL: FOR HISBA==DIF, PSOILGRID IS NEEDED")
    IF (.NOT.PRESENT(kwg_layer)) CALL abor1_sfx("INI_DATA_SOIL: FOR HISBA==DIF, KWG_LAYER IS NEEDED")

    CALL soilgrid(psoilgrid,psoildepth,pdg_out,kwg_layer)

  ENDIF

ENDIF
!
IF (lhook) CALL dr_hook('INI_DATA_SOIL',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE ini_data_soil