SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/ini_data_soil.F90
Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE INI_DATA_SOIL(HISBA,PDG_OUT,PSURF,PSURF2,PROOTDEPTH, &
00003                                PSOILDEPTH,PSOILGRID,KWG_LAYER   )
00004 !     #########################
00005 !
00006 !!**** *INI_DATA_SOIL* initializes soil depth and root fraction for a given
00007 !!                     number of soil layers
00008 !!
00009 !!    PURPOSE
00010 !!    -------
00011 !!
00012 !!    METHOD
00013 !!    ------
00014 !!
00015 !!
00016 !!    EXTERNAL
00017 !!    --------
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------
00021 !!
00022 !!    REFERENCE
00023 !!    ---------
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!
00028 !!    V. Masson        Meteo-France
00029 !!
00030 !!    MODIFICATION
00031 !!    ------------
00032 !!
00033 !!    Original    01/04/2003
00034 !----------------------------------------------------------------------------
00035 !
00036 !*    0.     DECLARATION
00037 !            -----------
00038 !
00039 USE MODD_SURF_PAR,       ONLY : XUNDEF
00040 !
00041 USE MODI_SOILGRID
00042 USE MODI_ABOR1_SFX
00043 !
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*    0.1    Declaration of arguments
00050 !            ------------------------
00051 !
00052  CHARACTER(LEN=*), INTENT(IN) :: HISBA   ! type of soil (Force-Restore OR Diffusion)
00053 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDG_OUT
00054 !
00055 REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF
00056 REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PSURF2
00057 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PROOTDEPTH
00058 REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSOILDEPTH
00059 REAL, DIMENSION(:),   OPTIONAL, INTENT(IN) :: PSOILGRID   ! reference soil grid          (m)
00060 !
00061 INTEGER, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: KWG_LAYER   ! last layers for soil moisture
00062 !
00063 !*    0.2    Declaration of local variables
00064 !      ------------------------------
00065 !
00066 LOGICAL,DIMENSION(SIZE(PDG_OUT,1)) :: LSURF
00067 INTEGER            :: JLOOP    ! class loop counter
00068 INTEGER            :: JLAYER   ! soil layer loop counter
00069 INTEGER            :: JVEG     ! vegetation types loop counter
00070 !
00071 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00072 !-------------------------------------------------------------------------------
00073 !-------------------------------------------------------------------------------
00074 !
00075 !*    1.     Allocations
00076 !            -----------
00077 !
00078 IF (LHOOK) CALL DR_HOOK('INI_DATA_SOIL',0,ZHOOK_HANDLE)
00079 !
00080 PDG_OUT(:,:,:) = XUNDEF
00081 !
00082 !-------------------------------------------------------------------------------
00083 !
00084 !*    2.     loop on cover types
00085 !            -------------------
00086 !
00087 LSURF(:) = .FALSE. 
00088 !
00089 IF (PRESENT(PSURF2) .AND. PRESENT(PSURF)) THEN
00090   LSURF(:) = (PSURF(:)==0. .AND. PSURF2(:)==0.)
00091 ELSEIF (PRESENT(PSURF)) THEN
00092   LSURF(:) = (PSURF(:)==0.)
00093 ENDIF
00094 !
00095 !*    3.     soil depth
00096 !            ----------
00097 !
00098 !*    3.1    force-restore case (2 layers)
00099 !            ------------------
00100 IF (HISBA=='2-L') THEN
00101 
00102   IF (.NOT.PRESENT(PROOTDEPTH)) CALL ABOR1_SFX("INI_DATA_SOIL: FOR HISBA==2-L, PROOTDEPTH IS NEEDED")
00103    
00104   DO JLOOP = 1,SIZE(LSURF)
00105     IF (LSURF(JLOOP)) CYCLE
00106     WHERE(PROOTDEPTH(JLOOP,:) /= XUNDEF)
00107       PDG_OUT(JLOOP,1,:) = 0.01
00108       PDG_OUT(JLOOP,2,:) = PROOTDEPTH(JLOOP,:)
00109     END WHERE
00110   ENDDO
00111 !
00112 !
00113 !*    3.2    force-restore case (3 layers)
00114 !            ------------------
00115 !
00116 ELSE
00117           
00118   IF (.NOT.PRESENT(PSOILDEPTH)) CALL ABOR1_SFX("INI_DATA_SOIL: FOR HISBA/=2-L, PSOILDEPTH IS NEEDED")
00119 
00120   IF (HISBA=='3-L') THEN
00121 
00122     IF (.NOT.PRESENT(PROOTDEPTH)) CALL ABOR1_SFX("INI_DATA_SOIL: FOR HISBA==3-L, PROOTDEPTH IS NEEDED")
00123 
00124     DO JLOOP = 1,SIZE(LSURF)
00125       IF (LSURF(JLOOP)) CYCLE
00126       WHERE(PSOILDEPTH(JLOOP,:) /= XUNDEF)
00127         PDG_OUT(JLOOP,1,:) = 0.01
00128         PDG_OUT(JLOOP,2,:) = PROOTDEPTH(JLOOP,:)
00129         PDG_OUT(JLOOP,3,:) = PSOILDEPTH(JLOOP,:)
00130       END WHERE
00131     ENDDO
00132 !
00133 !
00134 !*    3.3    Diffusion case (at least 4 soil layers)
00135 !            --------------
00136 !
00137   ELSE
00138 
00139     IF (.NOT.PRESENT(PSOILGRID)) CALL ABOR1_SFX("INI_DATA_SOIL: FOR HISBA==DIF, PSOILGRID IS NEEDED")
00140     IF (.NOT.PRESENT(KWG_LAYER)) CALL ABOR1_SFX("INI_DATA_SOIL: FOR HISBA==DIF, KWG_LAYER IS NEEDED")
00141 
00142     CALL SOILGRID(PSOILGRID,PSOILDEPTH,PDG_OUT,KWG_LAYER)
00143 
00144   ENDIF
00145 
00146 ENDIF
00147 !
00148 IF (LHOOK) CALL DR_HOOK('INI_DATA_SOIL',1,ZHOOK_HANDLE)
00149 !-------------------------------------------------------------------------------
00150 !
00151 END SUBROUTINE INI_DATA_SOIL