SURFEX v7.3
General documentation of Surfex
|
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