|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_HOR_SNOW_FIELDS(HPROGRAM,HSURF, & 00003 HFILE,HFILETYPE, & 00004 HFILEPGD,HFILEPGDTYPE, & 00005 KLUOUT,OUNIF,KPATCH, & 00006 KL,TPSNOW, TPTIME, & 00007 PUNIF_WSNOW, PUNIF_RSNOW, & 00008 PUNIF_TSNOW, PUNIF_ASNOW, & 00009 OSNOW_IDEAL, & 00010 PUNIF_SG1SNOW, PUNIF_SG2SNOW,& 00011 PUNIF_HISTSNOW,PUNIF_AGESNOW,& 00012 PVEGTYPE_PATCH, PPATCH ) 00013 ! ####################################################### 00014 ! 00015 ! 00016 !!**** *PREP_HOR_SNOW_FIELDS* - prepares all snow fields for one surface scheme. 00017 !! 00018 !! PURPOSE 00019 !! ------- 00020 ! 00021 !!** METHOD 00022 !! ------ 00023 !! 00024 !! REFERENCE 00025 !! --------- 00026 !! 00027 !! 00028 !! AUTHOR 00029 !! ------ 00030 !! V. Masson 00031 !! 00032 !! MODIFICATIONS 00033 !! ------------- 00034 !! Original 01/2004 00035 !!------------------------------------------------------------------ 00036 ! 00037 USE MODD_TYPE_SNOW 00038 USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME 00039 ! 00040 USE MODD_SURF_PAR, ONLY : XUNDEF 00041 ! 00042 USE MODI_ALLOCATE_GR_SNOW 00043 USE MODI_PREP_HOR_SNOW_FIELD 00044 USE MODE_SNOW3L 00045 ! 00046 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00047 USE PARKIND1 ,ONLY : JPRB 00048 ! 00049 IMPLICIT NONE 00050 ! 00051 !* 0.1 declarations of arguments 00052 ! 00053 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00054 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00055 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name 00056 CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! file type 00057 CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! file name 00058 CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! file type 00059 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00060 LOGICAL, INTENT(IN) :: OUNIF ! flag for prescribed uniform field 00061 INTEGER, INTENT(IN) :: KPATCH ! patch number for output scheme 00062 INTEGER, INTENT(IN) :: KL ! number of points 00063 TYPE(SURF_SNOW) :: TPSNOW ! snow fields 00064 TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! date and time 00065 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_WSNOW ! prescribed snow content (kg/m2) 00066 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_RSNOW ! prescribed density (kg/m3) 00067 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_TSNOW ! prescribed temperature (K) 00068 REAL, INTENT(IN) :: PUNIF_ASNOW ! prescribed albedo (-) 00069 LOGICAL, INTENT(IN) :: OSNOW_IDEAL 00070 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG1SNOW ! 00071 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG2SNOW ! 00072 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_HISTSNOW ! 00073 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_AGESNOW ! 00074 00075 REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PVEGTYPE_PATCH ! fraction of each patch 00076 REAL,DIMENSION(:,:),INTENT(IN), OPTIONAL :: PPATCH ! fraction of each patch 00077 ! 00078 ! 00079 !* 0.2 declarations of local variables 00080 ! 00081 CHARACTER(LEN=10) :: YSNSURF ! type of field 00082 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZW ! total snow content 00083 REAL,ALLOCATABLE,DIMENSION(:,:) :: ZWRHO ! total snow content from rho profile alone 00084 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZD ! total snow depth 00085 REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZDEPTH ! snow depth of each layer 00086 REAL,DIMENSION(KL,KPATCH) :: ZPATCH ! fraction of each patch 00087 REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZVEGTYPE_PATCH ! fraction of each patch 00088 ! 00089 INTEGER :: JPATCH ! loop counter on patches 00090 INTEGER :: JLAYER ! loop counter on layers 00091 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00092 !--------------------------------------------------------------------------- 00093 ! 00094 IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELDS',0,ZHOOK_HANDLE) 00095 IF (PRESENT(PPATCH)) THEN 00096 ZPATCH = PPATCH 00097 ELSE 00098 ZPATCH = 1. 00099 ENDIF 00100 IF (PRESENT(PVEGTYPE_PATCH)) THEN 00101 ALLOCATE(ZVEGTYPE_PATCH(KL,SIZE(PVEGTYPE_PATCH,2),KPATCH)) 00102 ZVEGTYPE_PATCH = PVEGTYPE_PATCH 00103 ELSE 00104 ALLOCATE(ZVEGTYPE_PATCH(KL,1,KPATCH)) 00105 ZVEGTYPE_PATCH = 1. 00106 ENDIF 00107 ! 00108 !* 1. Allocation of output field 00109 ! 00110 CALL ALLOCATE_GR_SNOW(TPSNOW,KL,KPATCH) 00111 ! 00112 !--------------------------------------------------------------------------- 00113 ! 00114 !* 3. Treatment of total snow content (kg/m2) 00115 ! 00116 ALLOCATE(ZW(KL,TPSNOW%NLAYER,KPATCH)) 00117 ! 00118 YSNSURF='WWW'//HSURF 00119 CALL PREP_HOR_SNOW_FIELD(HPROGRAM, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, & 00120 KLUOUT, OUNIF, YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00121 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00122 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00123 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00124 PF=ZW,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH ) 00125 ! 00126 !---------------------------------------------------------------------------- 00127 ! 00128 !* 4. Treatment of total snow depth 00129 ! 00130 ALLOCATE(ZD(KL,TPSNOW%NLAYER,KPATCH)) 00131 ! 00132 YSNSURF='DEP'//HSURF 00133 CALL PREP_HOR_SNOW_FIELD(HPROGRAM, HFILE, HFILETYPE, HFILEPGD, HFILEPGDTYPE, & 00134 KLUOUT, OUNIF, YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00135 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00136 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00137 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00138 PF=ZD,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH ) 00139 ! 00140 !* snow layer thickness definition 00141 ! 00142 ALLOCATE(ZDEPTH(SIZE(TPSNOW%WSNOW,1),TPSNOW%NLAYER,KPATCH)) 00143 ! 00144 IF (OSNOW_IDEAL) THEN 00145 ZDEPTH(:,:,:) = ZD(:,:,:) 00146 ELSE 00147 IF (TPSNOW%NLAYER==1) THEN 00148 DO JPATCH=1,KPATCH 00149 ZDEPTH(:,1,JPATCH) = ZD(:,1,JPATCH) 00150 END DO 00151 ELSEIF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN 00152 DO JPATCH=1,KPATCH 00153 CALL SNOW3LGRID(ZDEPTH(:,:,JPATCH),ZD(:,1,JPATCH)) 00154 END DO 00155 ENDIF 00156 ENDIF 00157 ! 00158 !---------------------------------------------------------------------------- 00159 ! 00160 !* 4. Snow density profile 00161 ! -------------------- 00162 ! 00163 !* density profile 00164 YSNSURF='RHO'//HSURF 00165 CALL PREP_HOR_SNOW_FIELD(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, & 00166 KLUOUT,OUNIF,YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00167 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00168 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00169 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00170 PDEPTH=ZDEPTH,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH ) 00171 ! 00172 !---------------------------------------------------------------------------- 00173 ! 00174 !* 5. Snow water content profile 00175 ! -------------------------- 00176 00177 IF (OSNOW_IDEAL) THEN 00178 ! 00179 TPSNOW%WSNOW(:,:,:) = ZW(:,:,:) 00180 ! 00181 ELSE 00182 ! 00183 ALLOCATE(ZWRHO(SIZE(TPSNOW%WSNOW,1),KPATCH)) 00184 ZWRHO(:,:) = 0. 00185 ! 00186 !* snow depth estimated from rho profile 00187 DO JPATCH=1,KPATCH 00188 DO JLAYER=1,TPSNOW%NLAYER 00189 WHERE (ZPATCH(:,JPATCH)>0. .AND. TPSNOW%RHO(:,JLAYER,JPATCH)/=XUNDEF) 00190 ZWRHO(:,JPATCH) = ZWRHO(:,JPATCH) + TPSNOW%RHO(:,JLAYER,JPATCH) * ZDEPTH(:,JLAYER,JPATCH) 00191 ELSEWHERE 00192 ZWRHO(:,JPATCH) = XUNDEF 00193 END WHERE 00194 END DO 00195 END DO 00196 ! 00197 !* modification of rho: coherence between rho profile, total snow and total depth 00198 DO JPATCH=1,KPATCH 00199 DO JLAYER=1,TPSNOW%NLAYER 00200 WHERE(ZPATCH(:,JPATCH)>0. .AND. ZWRHO(:,JPATCH)/=0. .AND. ZWRHO(:,JPATCH)/=XUNDEF) 00201 TPSNOW%RHO(:,JLAYER,JPATCH) = TPSNOW%RHO(:,JLAYER,JPATCH) * ZW(:,1,JPATCH) / ZWRHO(:,JPATCH) 00202 ELSEWHERE 00203 TPSNOW%RHO(:,JLAYER,JPATCH) = XUNDEF 00204 END WHERE 00205 END DO 00206 END DO 00207 ! 00208 !* snow content profile for each grid level 00209 DO JPATCH=1,KPATCH 00210 DO JLAYER=1,TPSNOW%NLAYER 00211 WHERE(ZPATCH(:,JPATCH)>0.) 00212 TPSNOW%WSNOW(:,JLAYER,JPATCH) = TPSNOW%RHO(:,JLAYER,JPATCH) * ZDEPTH(:,JLAYER,JPATCH) 00213 ELSEWHERE 00214 TPSNOW%WSNOW(:,JLAYER,JPATCH) = XUNDEF 00215 END WHERE 00216 END DO 00217 END DO 00218 ! 00219 DEALLOCATE(ZWRHO) 00220 ! 00221 ENDIF 00222 ! 00223 !---------------------------------------------------------------------------- 00224 ! 00225 !* 6. Albedo and snow heat content 00226 ! ---------------------------- 00227 ! 00228 !* albedo 00229 YSNSURF='ALB'//HSURF 00230 CALL PREP_HOR_SNOW_FIELD(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, & 00231 KLUOUT,OUNIF,YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00232 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00233 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00234 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00235 PDEPTH=ZDEPTH,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH) 00236 ! 00237 !* heat in snowpack profile 00238 YSNSURF='HEA'//HSURF 00239 CALL PREP_HOR_SNOW_FIELD(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, & 00240 KLUOUT,OUNIF,YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00241 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00242 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00243 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00244 PDEPTH=ZDEPTH,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH) 00245 ! 00246 !---------------------------------------------------------------------------- 00247 ! 00248 !* 7. Crocus specific parameters 00249 ! -------------------------- 00250 ! 00251 IF (TPSNOW%SCHEME=='CRO') THEN 00252 ! 00253 YSNSURF='SG1'//HSURF 00254 CALL PREP_HOR_SNOW_FIELD(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, & 00255 KLUOUT,OUNIF,YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00256 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00257 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00258 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00259 PDEPTH=ZDEPTH,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH) 00260 ! 00261 YSNSURF='SG2'//HSURF 00262 CALL PREP_HOR_SNOW_FIELD(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, & 00263 KLUOUT,OUNIF,YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00264 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00265 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00266 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00267 PDEPTH=ZDEPTH,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH) 00268 ! 00269 YSNSURF='HIS'//HSURF 00270 CALL PREP_HOR_SNOW_FIELD(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, & 00271 KLUOUT,OUNIF,YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00272 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00273 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00274 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00275 PDEPTH=ZDEPTH,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH) 00276 ! 00277 YSNSURF='AGE'//HSURF 00278 CALL PREP_HOR_SNOW_FIELD(HPROGRAM,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE, & 00279 KLUOUT,OUNIF,YSNSURF, KPATCH, KL, TPSNOW, TPTIME, & 00280 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, PUNIF_ASNOW, & 00281 OSNOW_IDEAL, PUNIF_SG1SNOW, & 00282 PUNIF_SG2SNOW, PUNIF_HISTSNOW,PUNIF_AGESNOW, & 00283 PDEPTH=ZDEPTH,PVEGTYPE_PATCH=ZVEGTYPE_PATCH,PPATCH=ZPATCH) 00284 ! 00285 ENDIF 00286 ! 00287 !* 8. Deallocations 00288 ! 00289 DEALLOCATE(ZD ) 00290 DEALLOCATE(ZW ) 00291 DEALLOCATE(ZDEPTH ) 00292 IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELDS',1,ZHOOK_HANDLE) 00293 ! 00294 !---------------------------------------------------------------------------- 00295 ! 00296 END SUBROUTINE PREP_HOR_SNOW_FIELDS
1.8.0
