SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/soilgrid.F90 Source File

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE SOILGRID(PSOILGRID, PSOILDEPTH, PDG, KWG_LAYER  )
00003 
00004 !     ##########################################################################
00005 !
00006 !!****  *SOILGRID*  
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !
00011 !     Calculates the soil grid configuration using a reference grid
00012 !     Also compute the root fraction
00013 !         
00014 !     
00015 !!**  METHOD
00016 !!    ------
00017 !
00018 !     Direct calculation
00019 !
00020 !!    EXTERNAL
00021 !!    --------
00022 !
00023 !     None
00024 !!
00025 !!    IMPLICIT ARGUMENTS
00026 !!    ------------------
00027 !!
00028 !!    REFERENCE
00029 !!    ---------
00030 !!
00031 !!    Noilhan and Planton (1989)
00032 !!    Belair (1995)
00033 !!    Boone (2000)
00034 !!    Boone et al. (2000)
00035 !!    Habets et al. (2003)
00036 !!    Decharme et al. (2011)
00037 !!      
00038 !!    AUTHOR
00039 !!    ------
00040 !!      A. Boone           * Meteo-France *
00041 !!      new version :
00042 !!      B. Decharme        * Meteo-France *
00043 !!
00044 !!    MODIFICATIONS
00045 !!    -------------
00046 !!      Original     12/04/03
00047 !!      new version :10/08/2011
00048 !!      modif       :   09/2012 soildepth can reach 12m (permafrost)
00049 !-------------------------------------------------------------------------------
00050 !
00051 !*       0.     DECLARATIONS
00052 !               ------------
00053 !
00054 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
00055 USE MODD_ISBA_PAR, ONLY : NOPTIMLAYER, XOPTIMGRID
00056 !
00057 USE MODI_ABOR1_SFX
00058 !
00059 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00060 USE PARKIND1  ,ONLY : JPRB
00061 !
00062 IMPLICIT NONE
00063 !
00064 !*      0.1    declarations of arguments
00065 !
00066 REAL,    DIMENSION(:),     INTENT(IN)    :: PSOILGRID   ! reference soil grid          (m)
00067 REAL,    DIMENSION(:,:),   INTENT(IN)    :: PSOILDEPTH  ! total soil depth             (m)   
00068 REAL,    DIMENSION(:,:,:), INTENT(OUT)   :: PDG         ! depth of base of soil layers (m)
00069 INTEGER, DIMENSION(:,:),   INTENT(OUT)   :: KWG_LAYER   ! last layers for soil moisture
00070 !
00071 !*      0.2    declarations of local variables
00072 !
00073 REAL,DIMENSION(SIZE(PDG,1),SIZE(PDG,3)) :: ZREF
00074 !
00075 REAL               :: ZWORK
00076 !
00077 INTEGER            :: INI,INL,IPATCH
00078 INTEGER            :: JJ,JL,JPATCH
00079 !
00080 LOGICAL            :: LOPTIMGRID
00081 !
00082 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00083 !-------------------------------------------------------------------------------
00084 !        0.     Initialization
00085 !               --------------
00086 !
00087 IF (LHOOK) CALL DR_HOOK('SOILGRID',0,ZHOOK_HANDLE)
00088 !
00089 INI    = SIZE(PDG,1)
00090 INL    = SIZE(PDG,2)
00091 IPATCH = SIZE(PDG,3)
00092 !
00093 KWG_LAYER (:,:) = 0
00094 ZREF      (:,:) = XUNDEF
00095 !
00096 !-------------------------------------------------------------------------------
00097 !
00098 !*       1.     Grid configuration
00099 !               ------------------
00100 !
00101 !*       1.1    Check consistency
00102 !               -----------------
00103 !
00104 LOPTIMGRID=.FALSE.
00105 IF(INL==NOPTIMLAYER) THEN
00106   IF( ALL(PSOILGRID(1:INL)==XOPTIMGRID(1:NOPTIMLAYER)) ) LOPTIMGRID=.TRUE.
00107 ENDIF
00108 !
00109 !*       1.2    Assign soil layer depths if ECOCLIMAP
00110 !               -------------------------------------
00111 !
00112 IF(LOPTIMGRID)THEN
00113   !
00114   !Optimized ECOCLIMAP soil grid
00115   CALL OPTIMSOILGRID
00116   !
00117 ELSE
00118   !
00119   WHERE(PSOILDEPTH(:,:)/=XUNDEF)
00120     PDG(:,1,:)=MIN(0.01,PSOILGRID(1))
00121   ELSEWHERE
00122     PDG(:,1,:)=XUNDEF
00123   ENDWHERE
00124   !
00125   DO JPATCH=1,IPATCH
00126     DO JJ=1,INI 
00127       !
00128       IF( PSOILDEPTH(JJ,JPATCH)==XUNDEF )THEN
00129         !
00130         PDG      (JJ,:,JPATCH) = XUNDEF              
00131         KWG_LAYER(JJ,  JPATCH) = NUNDEF
00132         !
00133       ELSE
00134         !
00135         DO JL=2,INL
00136           !
00137           PDG      (JJ,JL,JPATCH) = PSOILGRID(JL)
00138           ! 
00139           IF ( PSOILGRID(JL)-PSOILGRID(JL-1)<=0.3 ) THEN       
00140             ZWORK = ABS(PSOILGRID(JL)-PSOILDEPTH(JJ,JPATCH))
00141             IF(ZWORK<=ZREF(JJ,JPATCH))THEN
00142               KWG_LAYER(JJ,JPATCH) = JL
00143               ZREF     (JJ,JPATCH) = ZWORK
00144             ENDIF
00145           ELSEIF( PSOILDEPTH(JJ,JPATCH)>=(PSOILGRID(JL)*0.6+PSOILGRID(JL-1)*0.4) )THEN
00146             KWG_LAYER(JJ,JPATCH) = JL
00147           ENDIF
00148         ENDDO
00149         !
00150       ENDIF
00151     ENDDO
00152   ENDDO
00153   !
00154 ENDIF
00155 !
00156 IF(ANY(KWG_LAYER(:,:)==0))THEN
00157   CALL ABOR1_SFX('SOILGRID: WITH CISBA=DIF NWG_LAYER MUST BE DEFINED FOR EACH POINT')
00158 ENDIF
00159 !
00160 IF (LHOOK) CALL DR_HOOK('SOILGRID',1,ZHOOK_HANDLE)
00161 !
00162 !-------------------------------------------------------------------------------
00163 CONTAINS
00164 !-------------------------------------------------------------------------------
00165 !
00166 SUBROUTINE OPTIMSOILGRID
00167 !
00168 IMPLICIT NONE
00169 !
00170 ! declarations of local variables
00171 !
00172 INTEGER, PARAMETER                  :: NDLIM = 13
00173 !
00174 REAL, DIMENSION(NDLIM), PARAMETER   :: ZDLIM = 
00175       (/1.25,1.50,1.75,2.00,2.25,2.50,2.75,3.00,3.50,4.00,4.50,5.00,5.50/)
00176 !
00177 REAL,DIMENSION(SIZE(PDG,1),SIZE(PDG,3)) :: ZDG_WATER
00178 !
00179 LOGICAL            :: LWORK
00180 REAL(KIND=JPRB)    :: ZHOOK_HANDLE
00181 !
00182 !-------------------------------------------------------------------------------
00183 ! init
00184 !
00185 IF (LHOOK) CALL DR_HOOK('SOILGRID:OPTIMSOILGRID',0,ZHOOK_HANDLE)
00186 !
00187 ZDG_WATER (:,:) = XUNDEF
00188 !
00189 !-------------------------------------------------------------------------------
00190 !a. Arranged depth
00191 !
00192 DO JPATCH=1,IPATCH
00193    DO JJ=1,INI
00194       IF(PSOILDEPTH(JJ,JPATCH)<1.25)THEN
00195         ZDG_WATER(JJ,JPATCH)=MIN(1.0,PSOILDEPTH(JJ,JPATCH))
00196       ELSEIF(PSOILDEPTH(JJ,JPATCH)>=5.50.AND.PSOILDEPTH(JJ,JPATCH)<6.50)THEN
00197               ZDG_WATER(JJ,JPATCH)=5.50
00198       ELSEIF(PSOILDEPTH(JJ,JPATCH)>=6.50.AND.PSOILDEPTH(JJ,JPATCH)<10.50)THEN
00199               ZDG_WATER(JJ,JPATCH)=8.00
00200       ELSEIF(PSOILDEPTH(JJ,JPATCH)>=10.50.AND.PSOILDEPTH(JJ,JPATCH)<XUNDEF)THEN
00201               ZDG_WATER(JJ,JPATCH)=12.00              
00202       ELSE
00203         DO JL=1,NDLIM-1         
00204            IF(PSOILDEPTH(JJ,JPATCH)>=ZDLIM(JL).AND.PSOILDEPTH(JJ,JPATCH)<ZDLIM(JL+1))THEN
00205               ZDG_WATER(JJ,JPATCH)=MERGE(ZDLIM(JL),ZDLIM(JL+1),PSOILDEPTH(JJ,JPATCH)<(0.4*ZDLIM(JL)+0.6*ZDLIM(JL+1)))
00206            ENDIF
00207         ENDDO
00208       ENDIF
00209    ENDDO
00210 ENDDO      
00211 !
00212 !-------------------------------------------------------------------------------
00213 !b. General cases
00214 !
00215 DO JPATCH=1,IPATCH
00216   DO JJ=1,INI
00217     !
00218     IF(PSOILDEPTH(JJ,JPATCH)==XUNDEF)THEN
00219       !
00220       PDG      (JJ,:,JPATCH) = XUNDEF      
00221       KWG_LAYER(JJ,  JPATCH) = NUNDEF    
00222       !
00223     ELSE
00224       !
00225       PDG(JJ,:,JPATCH) = PSOILGRID(:)
00226       !      
00227       LWORK=(ZDG_WATER(JJ,JPATCH)<=1.0.OR.&
00228              ZDG_WATER(JJ,JPATCH)==1.5.OR.&
00229              ZDG_WATER(JJ,JPATCH)==2.0.OR.&
00230              ZDG_WATER(JJ,JPATCH)==3.0.OR.&
00231              ZDG_WATER(JJ,JPATCH)==5.0.OR.&
00232              ZDG_WATER(JJ,JPATCH)==8.0.OR.&
00233              ZDG_WATER(JJ,JPATCH)==12.0   )
00234       ! 
00235       IF (LWORK) THEN    
00236         DO JL=2,INL      
00237           ZWORK = ABS(PSOILGRID(JL)-ZDG_WATER(JJ,JPATCH))                 
00238           IF(ZWORK<=ZREF(JJ,JPATCH))THEN
00239             KWG_LAYER(JJ,JPATCH)=JL
00240             ZREF(JJ,JPATCH)=ZWORK
00241           ENDIF
00242         ENDDO           
00243       ENDIF
00244       !
00245     ENDIF
00246     !
00247   ENDDO
00248 ENDDO
00249 !
00250 !-------------------------------------------------------------------------------
00251 !c. Particular cases
00252 !
00253 WHERE (ZDG_WATER(:,:)==1.25)
00254   KWG_LAYER(:,:) = 9
00255   PDG(:,9,:) = ZDG_WATER(:,:)
00256 ELSEWHERE (ZDG_WATER(:,:)==1.75 .OR. ZDG_WATER(:,:)==2.25)
00257   KWG_LAYER(:,:) = 10
00258   PDG(:,10,:) = ZDG_WATER(:,:)
00259   WHERE (ZDG_WATER(:,:)==1.75) PDG(:,9,:) = 1.25
00260 ELSEWHERE (ZDG_WATER(:,:)==2.50 .OR. ZDG_WATER(:,:)==2.75 .OR. ZDG_WATER(:,:)==3.50)
00261   KWG_LAYER(:,:) = 11
00262   PDG(:,11,:) = ZDG_WATER(:,:)
00263 ELSEWHERE (ZDG_WATER(:,:)==4.00 .OR. ZDG_WATER(:,:)==4.50 .OR. ZDG_WATER(:,:)==5.50)
00264   KWG_LAYER(:,:) = 12
00265   PDG(:,12,:) = ZDG_WATER(:,:)
00266 ENDWHERE
00267 !
00268 IF (LHOOK) CALL DR_HOOK('SOILGRID:OPTIMSOILGRID',1,ZHOOK_HANDLE)
00269 !
00270 END SUBROUTINE OPTIMSOILGRID
00271 !
00272 !-------------------------------------------------------------------------------
00273 END SUBROUTINE SOILGRID