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
    WHERE(prootdepth(jloop,:) /= xundef)
      pdg_out(jloop,1,:) = 0.01
      pdg_out(jloop,2,:) = prootdepth(jloop,:)
    END WHERE
  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
      WHERE(psoildepth(jloop,:) /= xundef)
        pdg_out(jloop,1,:) = 0.01
        pdg_out(jloop,2,:) = prootdepth(jloop,:)
        pdg_out(jloop,3,:) = psoildepth(jloop,:)
      END WHERE
    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