|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_HOR_SNOW_FIELD( HPROGRAM, & 00003 HFILE,HFILETYPE, & 00004 HFILEPGD,HFILEPGDTYPE, & 00005 KLUOUT,OUNIF,HSNSURF,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 PF,PDEPTH,PVEGTYPE_PATCH,PPATCH ) 00013 ! ####################################################### 00014 ! 00015 !!**** *PREP_HOR_SNOW_FIELD* - reads, interpolates and prepares a snow field 00016 !! 00017 !! PURPOSE 00018 !! ------- 00019 !! 00020 !!** METHOD 00021 !! ------ 00022 !! 00023 !! REFERENCE 00024 !! --------- 00025 !! 00026 !! 00027 !! AUTHOR 00028 !! ------ 00029 !! V. Masson 00030 !! 00031 !! MODIFICATIONS 00032 !! ------------- 00033 !! Original 01/2004 00034 !! P. Le Moigne 10/2005, Phasage Arome 00035 !!------------------------------------------------------------------ 00036 ! 00037 USE MODD_TYPE_SNOW 00038 USE MODD_TYPE_DATE_SURF, ONLY : DATE_TIME 00039 ! 00040 USE MODD_CSTS, ONLY : XTT 00041 USE MODD_PREP_SNOW, ONLY : XGRID_SNOW 00042 USE MODD_SURF_PAR, ONLY : XUNDEF 00043 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00044 USE MODD_PREP, ONLY : LINTERP 00045 ! 00046 USE MODI_PREP_SNOW_GRIB 00047 USE MODI_PREP_SNOW_UNIF 00048 USE MODI_PREP_SNOW_EXTERN 00049 USE MODI_PREP_SNOW_BUFFER 00050 USE MODI_HOR_INTERPOL 00051 USE MODI_VEGTYPE_GRID_TO_PATCH_GRID 00052 USE MODI_SNOW_HEAT_TO_T_WLIQ 00053 USE MODI_VEGTYPE_TO_PATCH 00054 ! 00055 USE MODI_ABOR1_SFX 00056 ! 00057 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00058 USE PARKIND1 ,ONLY : JPRB 00059 ! 00060 IMPLICIT NONE 00061 ! 00062 !* 0.1 declarations of arguments 00063 ! 00064 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00065 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! file name 00066 CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! file type 00067 CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! file name 00068 CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! file type 00069 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00070 LOGICAL, INTENT(IN) :: OUNIF ! flag for prescribed uniform field 00071 CHARACTER(LEN=10) :: HSNSURF ! type of field 00072 INTEGER, INTENT(IN) :: KPATCH ! patch number for output scheme 00073 INTEGER, INTENT(IN) :: KL ! number of points 00074 TYPE(SURF_SNOW) :: TPSNOW ! snow fields 00075 TYPE(DATE_TIME), INTENT(IN) :: TPTIME ! date and time 00076 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_WSNOW ! prescribed snow content (kg/m2) 00077 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_RSNOW ! prescribed density (kg/m3) 00078 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_TSNOW ! prescribed temperature (K) 00079 REAL, INTENT(IN) :: PUNIF_ASNOW ! prescribed albedo (-) 00080 LOGICAL, INTENT(IN) :: OSNOW_IDEAL 00081 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG1SNOW ! 00082 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_SG2SNOW ! 00083 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_HISTSNOW ! 00084 REAL, DIMENSION(:), INTENT(IN) :: PUNIF_AGESNOW ! 00085 00086 REAL,DIMENSION(:,:,:), INTENT(OUT),OPTIONAL :: PF ! output field (x,kpatch) 00087 REAL,DIMENSION(:,:,:),INTENT(IN), OPTIONAL :: PDEPTH ! thickness of each snow layer 00088 REAL,DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PVEGTYPE_PATCH ! fraction of each patch 00089 REAL,DIMENSION(:,:), INTENT(IN), OPTIONAL :: PPATCH ! fraction of each patch 00090 ! 00091 ! 00092 !* 0.2 declarations of local variables 00093 ! 00094 REAL, POINTER, DIMENSION(:,:,:) :: ZFIELDIN ! field to interpolate horizontally 00095 REAL, POINTER, DIMENSION(:,:) :: ZFIELD ! field to interpolate horizontally 00096 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZFIELDOUT ! field interpolated horizontally 00097 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZD ! snow depth (x, kpatch) 00098 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZW ! work array (x, fine snow grid, kpatch) 00099 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZHEAT ! work array (x, output snow grid, kpatch) 00100 REAL, ALLOCATABLE, DIMENSION(:,:,:) :: ZGRID ! grid array (x, output snow grid, kpatch) 00101 ! 00102 LOGICAL :: GSNOW_IDEAL 00103 INTEGER :: JPATCH ! loop on patches 00104 INTEGER :: JVEGTYPE ! loop on vegtypes 00105 INTEGER :: JLAYER ! loop on layers 00106 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00107 !---------------------------------------------------------------------------- 00108 ! 00109 !* 1. Does the field exist? 00110 ! 00111 ! 00112 IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELD',0,ZHOOK_HANDLE) 00113 IF (HSNSURF(1:3)=='HEA' .AND. TPSNOW%SCHEME=='D95' .AND. LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELD',1,ZHOOK_HANDLE) 00114 IF (HSNSURF(1:3)=='HEA' .AND. TPSNOW%SCHEME=='D95') RETURN 00115 ! 00116 GSNOW_IDEAL = .FALSE. 00117 ! 00118 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00119 ! 00120 !* 2. Reading of input configuration (Grid and interpolation type) 00121 ! 00122 IF (OUNIF) THEN 00123 GSNOW_IDEAL = OSNOW_IDEAL 00124 CALL PREP_SNOW_UNIF(KLUOUT,HSNSURF,ZFIELDIN, TPTIME, GSNOW_IDEAL, & 00125 PUNIF_WSNOW, PUNIF_RSNOW, PUNIF_TSNOW, & 00126 PUNIF_ASNOW, PUNIF_SG1SNOW, & 00127 PUNIF_SG2SNOW, PUNIF_HISTSNOW, PUNIF_AGESNOW ) 00128 ELSE IF (HFILETYPE=='GRIB ') THEN 00129 CALL PREP_SNOW_GRIB(HPROGRAM,HSNSURF,HFILE,KLUOUT,ZFIELDIN) 00130 ELSE IF (HFILETYPE=='MESONH' .OR. HFILETYPE=='ASCII ' .OR. HFILETYPE=='LFI ') THEN 00131 GSNOW_IDEAL = OSNOW_IDEAL 00132 CALL PREP_SNOW_EXTERN(HPROGRAM,HSNSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,& 00133 KLUOUT,ZFIELDIN,GSNOW_IDEAL,TPSNOW%NLAYER) 00134 ELSE IF (HFILETYPE=='BUFFER') THEN 00135 CALL PREP_SNOW_BUFFER(HPROGRAM,HSNSURF,KLUOUT,ZFIELDIN) 00136 ELSE 00137 CALL ABOR1_SFX('PREP_HOR_SNOW_FIELD: data file type not supported : '//HFILETYPE) 00138 END IF 00139 ! 00140 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00141 ! 00142 !* 3. Horizontal interpolation 00143 ! 00144 ALLOCATE(ZFIELDOUT(KL,SIZE(ZFIELDIN,2),SIZE(ZFIELDIN,3))) 00145 ALLOCATE(ZFIELD(SIZE(ZFIELDIN,1),SIZE(ZFIELDIN,2))) 00146 ! 00147 ! 00148 DO JVEGTYPE = 1, SIZE(ZFIELDIN,3) 00149 JPATCH = 1 00150 IF (KPATCH>1) JPATCH = VEGTYPE_TO_PATCH(JVEGTYPE,KPATCH) 00151 IF (PRESENT(PDEPTH)) THEN 00152 !* does not interpolates snow caracteristics on points without snow 00153 LINTERP(:) = ( PDEPTH(:,1,JPATCH) /= 0. .AND. PDEPTH(:,1,JPATCH) /= XUNDEF ) 00154 IF (PRESENT(PPATCH)) LINTERP(:) = LINTERP(:) .AND. (PPATCH(:,JPATCH)>0.) 00155 ELSEIF (PRESENT(PPATCH))THEN 00156 LINTERP(:) = (PPATCH(:,JPATCH)>0.) 00157 ENDIF 00158 !* horizontal interpolation 00159 ZFIELD=ZFIELDIN(:,:,JVEGTYPE) 00160 CALL HOR_INTERPOL(KLUOUT,ZFIELD,ZFIELDOUT(:,:,JVEGTYPE)) 00161 ! 00162 LINTERP(:) = .TRUE. 00163 END DO 00164 ! 00165 DEALLOCATE(ZFIELD) 00166 ! 00167 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00168 ! 00169 !* 4. Transformation from vegtype grid to patch grid, if any 00170 ! 00171 ALLOCATE(ZW (SIZE(ZFIELDOUT,1),SIZE(ZFIELDOUT,2),KPATCH)) 00172 ! 00173 ZW = 0. 00174 IF (SIZE(ZFIELDOUT,3)==NVEGTYPE) THEN 00175 CALL VEGTYPE_GRID_TO_PATCH_GRID(KPATCH,PVEGTYPE_PATCH,PPATCH,ZFIELDOUT,ZW) 00176 ELSE 00177 DO JPATCH=1,KPATCH 00178 ZW(:,:,JPATCH) = ZFIELDOUT(:,:,1) 00179 END DO 00180 END IF 00181 ! 00182 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00183 ! 00184 !* 5. Defines normalized output grid, if depths of snow layers are present 00185 ! 00186 IF (PRESENT(PDEPTH) .AND. .NOT.GSNOW_IDEAL) THEN 00187 ! 00188 !* total snow depth 00189 ! 00190 ALLOCATE(ZD(SIZE(TPSNOW%WSNOW,1),KPATCH)) 00191 ZD(:,:)=0. 00192 DO JPATCH=1,KPATCH 00193 DO JLAYER=1,TPSNOW%NLAYER 00194 WHERE (PDEPTH(:,JLAYER,JPATCH)/=XUNDEF) ZD(:,JPATCH) = ZD(:,JPATCH) + PDEPTH(:,JLAYER,JPATCH) 00195 END DO 00196 END DO 00197 ! 00198 !* grid at center of layers 00199 ! 00200 ALLOCATE(ZGRID(SIZE(ZW,1),TPSNOW%NLAYER,KPATCH)) 00201 DO JPATCH=1,KPATCH 00202 ZGRID(:,1,JPATCH) = 0.5 * PDEPTH(:,1,JPATCH) 00203 DO JLAYER=2,TPSNOW%NLAYER 00204 ZGRID(:,JLAYER,JPATCH) = ZGRID(:,JLAYER-1,JPATCH) + 0.5 * PDEPTH(:,JLAYER-1,JPATCH) & 00205 + 0.5 * PDEPTH(:,JLAYER ,JPATCH) 00206 END DO 00207 END DO 00208 ! 00209 !* normalized grid 00210 ! 00211 DO JPATCH=1,KPATCH 00212 DO JLAYER=1,TPSNOW%NLAYER 00213 WHERE (ZD(:,JPATCH)/=0.) 00214 ZGRID(:,JLAYER,JPATCH) = ZGRID(:,JLAYER,JPATCH) / ZD(:,JPATCH) 00215 ELSEWHERE 00216 ZGRID(:,JLAYER,JPATCH) = 0.5 00217 END WHERE 00218 END DO 00219 END DO 00220 ! 00221 DEALLOCATE(ZD) 00222 ! 00223 ELSEIF (.NOT.GSNOW_IDEAL) THEN 00224 IF (HSNSURF(1:3)=='RHO' .OR. HSNSURF(1:3)=='HEA') THEN 00225 WRITE(KLUOUT,*) 'when interpolation profiles of snow pack quantities,' 00226 WRITE(KLUOUT,*) 'depth of snow layers must be given' 00227 CALL ABOR1_SFX('PREP_HOR_SNOW_FIELD: DEPTH OF SNOW LAYERS NEEDED') 00228 END IF 00229 END IF 00230 ! 00231 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00232 ! 00233 !* 6. Return to historical variable 00234 ! 00235 SELECT CASE (HSNSURF(1:3)) 00236 ! 00237 CASE('DEP','WWW') ! total snow depth or snow content 00238 ! 00239 DO JPATCH=1,KPATCH 00240 IF (GSNOW_IDEAL) THEN 00241 PF(:,:,JPATCH) = ZW(:,:,JPATCH) 00242 ELSE 00243 DO JLAYER=1,SIZE(PF,2) 00244 PF(:,JLAYER,JPATCH) = ZW(:,1,JPATCH) 00245 ENDDO 00246 ENDIF 00247 END DO 00248 ! 00249 IF (PRESENT(PPATCH)) THEN 00250 DO JLAYER = 1,TPSNOW%NLAYER 00251 WHERE(PPATCH(:,:)==0.) 00252 PF(:,JLAYER,:) = XUNDEF 00253 END WHERE 00254 ENDDO 00255 ENDIF 00256 ! 00257 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00258 ! 00259 CASE('RHO') 00260 ! 00261 IF (GSNOW_IDEAL) THEN 00262 TPSNOW%RHO = ZW 00263 ELSE 00264 !* interpolation on snow levels 00265 CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%RHO) 00266 ENDIF 00267 ! 00268 !* mask for areas where there is no snow 00269 DO JPATCH=1,KPATCH 00270 DO JLAYER=1,TPSNOW%NLAYER 00271 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%RHO(:,JLAYER,JPATCH) = XUNDEF 00272 END DO 00273 END DO 00274 ! 00275 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00276 ! 00277 CASE('ALB') 00278 ! 00279 DO JPATCH=1,KPATCH 00280 TPSNOW%ALB(:,JPATCH) = ZW(:,1,JPATCH) 00281 END DO 00282 ! 00283 !* mask for areas where there is no snow 00284 DO JPATCH=1,KPATCH 00285 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%ALB(:,JPATCH) = XUNDEF 00286 END DO 00287 ! 00288 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00289 ! 00290 CASE('HEA') 00291 ! 00292 IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN 00293 ! 00294 IF (GSNOW_IDEAL) THEN 00295 TPSNOW%HEAT = ZW 00296 ELSE 00297 !* interpolation of heat on snow levels 00298 CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%HEAT) 00299 ENDIF 00300 ! 00301 !* mask for areas where there is no snow 00302 DO JPATCH=1,KPATCH 00303 DO JLAYER=1,TPSNOW%NLAYER 00304 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%HEAT(:,JLAYER,JPATCH) = XUNDEF 00305 END DO 00306 END DO 00307 ! 00308 ELSE IF (TPSNOW%SCHEME=='1-L') THEN 00309 !* interpolation of heat on snow levels 00310 ALLOCATE(ZHEAT(SIZE(ZFIELDOUT,1),TPSNOW%NLAYER,KPATCH)) 00311 ! 00312 IF (GSNOW_IDEAL) THEN 00313 ZHEAT = ZW 00314 ELSE 00315 CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,ZHEAT) 00316 ENDIF 00317 ! 00318 !* transformation from heat to temperature 00319 CALL SNOW_HEAT_TO_T_WLIQ(ZHEAT,TPSNOW%RHO,TPSNOW%T) 00320 WHERE (TPSNOW%T>XTT) TPSNOW%T = XTT 00321 DEALLOCATE(ZHEAT) 00322 ! 00323 !* mask for areas where there is no snow 00324 DO JPATCH=1,KPATCH 00325 DO JLAYER=1,TPSNOW%NLAYER 00326 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%T(:,JLAYER,JPATCH) = XUNDEF 00327 END DO 00328 END DO 00329 ! 00330 END IF 00331 ! 00332 ! 00333 CASE('SG1') 00334 ! 00335 IF (GSNOW_IDEAL) THEN 00336 TPSNOW%GRAN1 = ZW 00337 ELSE 00338 !* interpolation of heat on snow levels 00339 CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%GRAN1) 00340 ENDIF 00341 ! 00342 !* mask for areas where there is no snow 00343 DO JPATCH=1,KPATCH 00344 DO JLAYER=1,TPSNOW%NLAYER 00345 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%GRAN1(:,JLAYER,JPATCH) = XUNDEF 00346 END DO 00347 END DO 00348 ! 00349 CASE('SG2') 00350 ! 00351 IF (GSNOW_IDEAL) THEN 00352 TPSNOW%GRAN2 = ZW 00353 ELSE 00354 !* interpolation of heat on snow levels 00355 CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%GRAN2) 00356 ENDIF 00357 ! 00358 !* mask for areas where there is no snow 00359 DO JPATCH=1,KPATCH 00360 DO JLAYER=1,TPSNOW%NLAYER 00361 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%GRAN2(:,JLAYER,JPATCH) = XUNDEF 00362 END DO 00363 END DO 00364 ! 00365 CASE('HIS') 00366 ! 00367 IF (GSNOW_IDEAL) THEN 00368 TPSNOW%HIST = ZW 00369 ELSE 00370 !* interpolation of heat on snow levels 00371 CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%HIST) 00372 ENDIF 00373 ! 00374 !* mask for areas where there is no snow 00375 DO JPATCH=1,KPATCH 00376 DO JLAYER=1,TPSNOW%NLAYER 00377 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%HIST(:,JLAYER,JPATCH) = XUNDEF 00378 END DO 00379 END DO 00380 ! 00381 CASE('AGE') 00382 ! 00383 IF (GSNOW_IDEAL) THEN 00384 TPSNOW%AGE = ZW 00385 ELSE 00386 !* interpolation of heat on snow levels 00387 CALL INIT_FROM_REF_GRID(XGRID_SNOW,ZW,ZGRID,TPSNOW%AGE) 00388 ENDIF 00389 ! 00390 !* mask for areas where there is no snow 00391 DO JPATCH=1,KPATCH 00392 DO JLAYER=1,TPSNOW%NLAYER 00393 WHERE(PDEPTH(:,1,JPATCH)==0. .OR. PDEPTH(:,1,JPATCH)==XUNDEF) TPSNOW%AGE(:,JLAYER,JPATCH) = XUNDEF 00394 END DO 00395 END DO 00396 ! 00397 END SELECT 00398 ! 00399 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00400 ! 00401 !* 7. Deallocations 00402 ! 00403 DEALLOCATE(ZFIELDIN ) 00404 DEALLOCATE(ZFIELDOUT) 00405 IF (PRESENT(PDEPTH) .AND. .NOT.GSNOW_IDEAL) DEALLOCATE(ZGRID ) 00406 DEALLOCATE(ZW ) 00407 IF (LHOOK) CALL DR_HOOK('PREP_HOR_SNOW_FIELD',1,ZHOOK_HANDLE) 00408 ! 00409 !------------------------------------------------------------------------------------- 00410 ! 00411 CONTAINS 00412 ! 00413 !------------------------------------------------------------------------------------- 00414 ! 00415 SUBROUTINE INIT_FROM_REF_GRID(PGRID1,PT1,PD2,PT2) 00416 ! 00417 USE MODI_INTERP_GRID 00418 ! 00419 REAL, DIMENSION(:,:,:), INTENT(IN) :: PT1 ! variable profile 00420 REAL, DIMENSION(:), INTENT(IN) :: PGRID1 ! normalized grid 00421 REAL, DIMENSION(:,:,:), INTENT(IN) :: PD2 ! output layer thickness 00422 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PT2 ! variable profile 00423 ! 00424 INTEGER :: JL ! loop counter 00425 REAL, DIMENSION(SIZE(PT1,1),SIZE(PT1,2)) :: ZD1 ! input grid 00426 REAL, DIMENSION(SIZE(PD2,1),SIZE(PD2,2)) :: ZD2 ! output grid 00427 REAL, DIMENSION(SIZE(PD2,1)) :: ZDT ! output total thickness 00428 INTEGER :: JPATCH ! loop on patches 00429 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00430 ! 00431 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00432 ! 00433 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',0,ZHOOK_HANDLE) 00434 DO JPATCH=1,KPATCH 00435 ZD2(:,:) = 0. 00436 ZDT (:) = 0. 00437 ! 00438 DO JL=1,SIZE(ZD2,2) 00439 ZD2(:,JL) = ZDT(:) + PD2(:,JL,JPATCH)/2. 00440 ZDT (:) = ZDT(:) + PD2(:,JL,JPATCH) 00441 END DO 00442 ! 00443 DO JL=1,SIZE(PT1,2) 00444 ZD1(:,JL) = PGRID1(JL) * ZDT(:) 00445 END DO 00446 ! 00447 CALL INTERP_GRID(ZD1,PT1(:,:,JPATCH),ZD2,PT2(:,:,JPATCH)) 00448 END DO 00449 IF (LHOOK) CALL DR_HOOK('INIT_FROM_REF_GRID',1,ZHOOK_HANDLE) 00450 ! 00451 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 00452 END SUBROUTINE INIT_FROM_REF_GRID 00453 !------------------------------------------------------------------------------------- 00454 ! 00455 END SUBROUTINE PREP_HOR_SNOW_FIELD
1.8.0
