|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !----------------------------------------------------------------- 00002 ! ####################### 00003 SUBROUTINE INIT_COUPL_TOPD(HPROGRAM,KI) 00004 ! ####################### 00005 ! 00006 !!**** *INIT_COUPL_TOPD* 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 !! This routine aims at initialising the variables 00011 ! needed for coupling with Topmodel. 00012 ! 00013 !!** METHOD 00014 !! ------ 00015 ! 00016 !! EXTERNAL 00017 !! -------- 00018 !! 00019 !! none 00020 !! 00021 !! IMPLICIT ARGUMENTS 00022 !! ------------------ 00023 !! 00024 !! 00025 !! REFERENCE 00026 !! --------- 00027 !! 00028 !! 00029 !! 00030 !! AUTHOR 00031 !! ------ 00032 !! 00033 !! K. Chancibault * LTHE / Meteo-France * 00034 !! 00035 !! MODIFICATIONS 00036 !! ------------- 00037 !! 00038 !! Original 16/10/2003 00039 !! Modif BV : supression of variables specific to Topmodel 00040 !! 20/12/2007 - mll : Adaptation between a lonlat grid system for ISBA 00041 !! and lambert II projection for topmodel 00042 !! 11/2011: Modif BV : Creation of masks between ISBA and TOPODYN 00043 ! transfered in PGD step (routine init_pgd_topd) 00044 !------------------------------------------------------------------------------- 00045 ! 00046 !* 0. DECLARATIONS 00047 ! ------------ 00048 ! 00049 ! Modules 00050 USE MODD_COUPLING_TOPD, ONLY : XWSTOPI, XWFCTOPI, XDTOPI, XAS_NATURE, XATOP,& 00051 XCSTOPI, XWTOPT, XAVG_RUNOFFCM, XAVG_DRAINCM,& 00052 XDTOPT, XKA_PRE, XKAC_PRE, NMASKI, XDMAXFC, & 00053 XWG_FULL, XWSTOPT, XWFCTOPT, NMASKT, & 00054 NNBV_IN_MESH, XBV_IN_MESH, XTOTBV_IN_MESH,& 00055 XRUNOFF_TOP, NNPIX,& 00056 XFRAC_D2, XFRAC_D3, XWGI_FULL,& 00057 XRUN_TOROUT, XDR_TOROUT,& 00058 LSTOCK_TOPD,NNB_STP_RESTART 00059 USE MODD_DUMMY_EXP_PROFILE,ONLY :XF_PARAM, XC_DEPTH_RATIO 00060 USE MODD_TOPODYN, ONLY : NNCAT, XMPARA, XCSTOPT, NMESHT, XDXT,& 00061 NNMC, XRTOP_D2, NNB_TOPD_STEP 00062 ! 00063 USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF 00064 USE MODD_ISBA_n, ONLY : XSAND, XDG, XCLAY, XWG,& 00065 CKSAT, XCONDSAT,XWGI, XF_PARAM_i=>XF_PARAM, & 00066 XC_DEPTH_RATIO_i=>XC_DEPTH_RATIO 00067 USE MODD_DIAG_EVAP_ISBA_n, ONLY : XAVG_RUNOFFC, XAVG_DRAINC 00068 00069 USE MODD_SURF_ATM_GRID_N, ONLY : XMESH_SIZE 00070 USE MODD_SURF_ATM_n, ONLY : NSIZE_NATURE, NR_NATURE 00071 ! 00072 ! Interfaces 00073 USE MODI_GET_LUOUT 00074 USE MODI_READ_FILE_MASKTOPD 00075 USE MODI_PACK_SAME_RANK 00076 USE MODI_UNPACK_SAME_RANK 00077 USE MODI_ISBA_TO_TOPD 00078 USE MODI_RESTART_COUPL_TOPD 00079 ! 00080 USE MODE_SOIL 00081 ! 00082 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00083 USE PARKIND1 ,ONLY : JPRB 00084 ! 00085 IMPLICIT NONE 00086 ! 00087 !* 0.1 declarations of arguments 00088 ! 00089 CHARACTER(LEN=*), INTENT(IN) :: HPROGRAM ! 00090 INTEGER, INTENT(IN) :: KI ! Grid dimensions 00091 ! 00092 !* 0.2 declarations of local variables 00093 ! 00094 !REAL, DIMENSION(:), ALLOCATABLE :: ZDTAV ! Averaged depth soil on TOP-LAT grid 00095 REAL, DIMENSION(:), ALLOCATABLE :: ZSAND_FULL, ZCLAY_FULL, ZDG_FULL ! Isba variables on the full domain 00096 REAL, DIMENSION(:), ALLOCATABLE :: ZFRAC ! fraction of SurfEx mesh that covers one or several catchments 00097 REAL, DIMENSION(:), ALLOCATABLE :: ZDMAXAV ! dificit maximal moyen par bassin 00098 REAL, DIMENSION(:),ALLOCATABLE :: ZSANDTOPI, ZCLAYTOPI!, ZWWILTTOPI !sand and clay fractions on TOPMODEL layers 00099 ! 00100 !ludo 00101 REAL, DIMENSION(:), ALLOCATABLE :: ZKSAT !ksat surf 00102 REAL, DIMENSION(:), ALLOCATABLE :: ZF_PARAM_FULL 00103 REAL, DIMENSION(:,:), ALLOCATABLE :: ZF_PARAMT!, ZWWILTTOPT 00104 REAL, DIMENSION(:), ALLOCATABLE :: ZDG2_FULL, ZDG3_FULL, ZWG2_FULL, ZWG3_FULL, ZRTOP_D2 00105 REAL,DIMENSION(:), ALLOCATABLE :: ZWGI_FULL, Z_WFCTOPI, Z_WSTOPI 00106 ! 00107 REAL :: ZCOEF_ANIS !coefficient anisotropie Ksat: 00108 ! Ksat horiz=ZCOEF*Ksat vert 00109 INTEGER :: JJ,JI ! loop control 00110 INTEGER :: JCAT,JMESH ! loop control 00111 INTEGER :: ILUOUT ! Logical unit for output filr 00112 ! 00113 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00114 !------------------------------------------------------------------------------- 00115 IF (LHOOK) CALL DR_HOOK('INIT_COUPL_TOPD',0,ZHOOK_HANDLE) 00116 ! 00117 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00118 ! 00119 WRITE(ILUOUT,*) 'INITIALISATION INIT_COUPL_TOPD' 00120 ! 00121 ALLOCATE(NMASKT(NNCAT,NMESHT)) 00122 NMASKT(:,:) = NUNDEF 00123 ! 00124 !* 1 Initialization: 00125 ! --------------- 00126 ! 00127 ! la surface saturee, à l'initialisation est nulle, donc on initialise les lambdas de telle sorte qu'aucun pixel ne soit sature 00128 ALLOCATE(XKA_PRE (NNCAT,NMESHT)) 00129 ALLOCATE(XKAC_PRE(NNCAT)) 00130 XKA_PRE(:,:) = 0.0 00131 XKAC_PRE(:) = MAXVAL(XKA_PRE) + 1. 00132 ! 00133 !Cumulated runoff initialisation 00134 ALLOCATE(XRUNOFF_TOP(NSIZE_NATURE)) 00135 XRUNOFF_TOP (:) = XAVG_RUNOFFC(:) 00136 ! 00137 IF(.NOT.ALLOCATED(XAVG_RUNOFFCM)) ALLOCATE(XAVG_RUNOFFCM(NSIZE_NATURE)) 00138 XAVG_RUNOFFCM(:) = XAVG_RUNOFFC(:) 00139 ! 00140 IF(.NOT.ALLOCATED(XAVG_DRAINCM )) ALLOCATE(XAVG_DRAINCM (NSIZE_NATURE)) 00141 XAVG_DRAINCM (:) = XAVG_DRAINC(:) 00142 ! 00143 ! 00144 ! Reading masks 00145 CALL READ_FILE_MASKTOPD(KI) 00146 ! 00147 !* 2.1 Fraction of SurfEx mesh with TOPMODEL 00148 ! ------------------------------------- 00149 ! 00150 ALLOCATE(NNBV_IN_MESH (KI,NNCAT)) 00151 ALLOCATE(XBV_IN_MESH (KI,NNCAT)) 00152 ALLOCATE(XTOTBV_IN_MESH(KI)) 00153 ! 00154 XTOTBV_IN_MESH(:) = 0.0 00155 ! 00156 DO JJ=1,KI 00157 ! 00158 XBV_IN_MESH(JJ,:) = 0.0 00159 ! 00160 DO JI=1,NNCAT 00161 NNBV_IN_MESH(JJ,JI) = COUNT( NMASKI(JJ,JI,:)/=NUNDEF ) 00162 XBV_IN_MESH (JJ,JI) = REAL(NNBV_IN_MESH(JJ,JI)) * XDXT(JI)**2 00163 XTOTBV_IN_MESH (JJ) = XTOTBV_IN_MESH(JJ) + XBV_IN_MESH(JJ,JI) 00164 ENDDO 00165 ! 00166 ENDDO 00167 ! 00168 !* 2.2 Fraction of SurfEx mesh with each catchment 00169 ! ------------------------------------------- 00170 ! 00171 ALLOCATE(ZFRAC(KI)) ! fraction not covered by catchments 00172 ZFRAC(:) = ( XMESH_SIZE(:)-XTOTBV_IN_MESH(:) ) / XMESH_SIZE(:) 00173 ZFRAC(:) = MIN(MAX(ZFRAC(:),0.),1.) 00174 ! 00175 ALLOCATE(XATOP(NSIZE_NATURE)) ! fraction covered by catchments part nature 00176 CALL PACK_SAME_RANK(NR_NATURE,(1.-ZFRAC),XATOP) 00177 ! 00178 ! 00179 IF (HPROGRAM=='POST ') GOTO 10 00180 ! 00181 !* 3.0 Wsat, Wfc and depth for TOPODYN on ISBA grid 00182 ! -------------------------------------------- 00183 !* 3.1 clay, sand fraction, depth hydraulic conductivity at saturation of the layer for TOPODYN 00184 ! --------------------------------------------------------- 00185 ! 00186 ALLOCATE(ZSAND_FULL(KI)) 00187 ALLOCATE(ZCLAY_FULL(KI)) 00188 CALL UNPACK_SAME_RANK(NR_NATURE,XSAND(:,2),ZSAND_FULL) 00189 CALL UNPACK_SAME_RANK(NR_NATURE,XCLAY(:,2),ZCLAY_FULL) 00190 ! 00191 !ludo prof variable pour tr lat (OK car sol homogene verticalement, faux sinon) 00192 ALLOCATE(ZDG2_FULL(KI)) 00193 ALLOCATE(ZDG3_FULL(KI)) 00194 CALL UNPACK_SAME_RANK(NR_NATURE,XDG(:,2,1),ZDG2_FULL) 00195 CALL UNPACK_SAME_RANK(NR_NATURE,XDG(:,3,1),ZDG3_FULL) 00196 ! 00197 ALLOCATE(ZRTOP_D2(KI)) 00198 ZRTOP_D2(:) = 0. 00199 ! 00200 DO JMESH=1,KI 00201 IF ( ZDG2_FULL(JMESH)/=XUNDEF .AND. ZFRAC(JMESH)<1. ) THEN 00202 ZRTOP_D2(JMESH) = 0. 00203 DO JCAT=1,NNCAT 00204 !moyenne ponderee pour cas ou plusieurs BV sur maille 00205 ZRTOP_D2(JMESH) = ZRTOP_D2(JMESH) + XRTOP_D2(JCAT)*XBV_IN_MESH(JMESH,JCAT)/XMESH_SIZE(JMESH) 00206 END DO 00207 ENDIF 00208 ENDDO 00209 !ZTOP_D2 * D2 < D3 : the depth concernet by lateral transfers is lower than D2 00210 WHERE( ZDG2_FULL/=XUNDEF .AND. ZRTOP_D2*ZDG2_FULL>ZDG3_FULL ) ZRTOP_D2(:) = ZDG3_FULL(:)/ZDG2_FULL(:) 00211 ! 00212 DEALLOCATE(ZFRAC) 00213 ! 00214 ALLOCATE(XFRAC_D2 (KI)) 00215 ALLOCATE(XFRAC_D3 (KI)) 00216 XFRAC_D2(:)=1. 00217 XFRAC_D3(:)=0. 00218 WHERE( ZDG2_FULL/=XUNDEF .AND. ZRTOP_D2*ZDG2_FULL>ZDG2_FULL ) ! if the depth is > D2 00219 XFRAC_D2(:) = MIN(1.,ZRTOP_D2(:)) 00220 XFRAC_D3(:) = (ZRTOP_D2(:)*ZDG2_FULL(:)-ZDG2_FULL(:)) / (ZDG3_FULL(:)-ZDG2_FULL(:)) 00221 XFRAC_D3(:) = MAX(0.,XFRAC_D3(:)) 00222 END WHERE 00223 ! 00224 ALLOCATE(ZDG_FULL(KI)) 00225 WHERE (ZDG2_FULL/=XUNDEF) 00226 ZDG_FULL = XFRAC_D2*ZDG2_FULL + XFRAC_D3*(ZDG3_FULL-ZDG2_FULL) 00227 ELSEWHERE 00228 ZDG_FULL = XUNDEF 00229 END WHERE 00230 ! 00231 ALLOCATE(ZSANDTOPI(KI)) 00232 ALLOCATE(ZCLAYTOPI(KI)) 00233 ZSANDTOPI(:)=0.0 00234 ZCLAYTOPI(:)=0.0 00235 ALLOCATE(XDTOPI(KI)) 00236 XDTOPI(:)=0.0 00237 WHERE ( ZDG_FULL/=XUNDEF .AND. ZDG_FULL/=0. ) 00238 XDTOPI = ZDG_FULL 00239 ZSANDTOPI = ZSANDTOPI + ZSAND_FULL * ZDG_FULL 00240 ZCLAYTOPI = ZCLAYTOPI + ZCLAY_FULL * ZDG_FULL 00241 ZSANDTOPI = ZSANDTOPI / XDTOPI 00242 ZCLAYTOPI = ZCLAYTOPI / XDTOPI 00243 ELSEWHERE 00244 ZSANDTOPI = XUNDEF 00245 ZCLAYTOPI = XUNDEF 00246 XDTOPI = XUNDEF 00247 END WHERE 00248 DEALLOCATE(ZSAND_FULL) 00249 DEALLOCATE(ZCLAY_FULL) 00250 ! 00251 !* 4.1 depth of the Isba layer on TOP-LAT grid 00252 ! --------------------------------------- 00253 ! 00254 ALLOCATE(XDTOPT(NNCAT,NMESHT)) 00255 XDTOPT(:,:) = 0.0 00256 CALL ISBA_TO_TOPD(XDTOPI,XDTOPT) 00257 ! 00258 !* 3.2 Wsat and Wfc on TOPODYN layer 00259 ! ----------------------------- 00260 ! 00261 ALLOCATE(XWSTOPI (KI)) 00262 ALLOCATE(XWFCTOPI (KI)) 00263 XWSTOPI (:) = 0.0 00264 XWFCTOPI(:) = 0.0 00265 !ALLOCATE(ZWWILTTOPI(KI)) 00266 XWSTOPI = WSAT_FUNC_1D (ZCLAYTOPI,ZSANDTOPI,'CH78') 00267 XWFCTOPI = WFC_FUNC_1D (ZCLAYTOPI,ZSANDTOPI,'CH78') 00268 !ZWWILTTOPI = WWILT_FUNC_1D(ZCLAYTOPI,ZSANDTOPI,'CH78') 00269 ! 00270 !modif ludo test ksat exp 00271 WRITE(ILUOUT,*) 'CKSAT==',CKSAT 00272 00273 ALLOCATE(ZKSAT(KI)) 00274 ZKSAT (:) = 0.0 00275 ALLOCATE(XCSTOPI(KI)) 00276 XCSTOPI(:) = 0.0 00277 IF( CKSAT=='SGH' .OR. CKSAT=='EXP' ) THEN 00278 ! 00279 !ludo calcul des profondeur efficaces 00280 !ZRTOP_D2(:) = 1. 00281 !ALLOCATE(XC_DEPTH_RATIO(SIZE(XC_DEPTH_RATIO_i))) 00282 !XC_DEPTH_RATIO(:) = XC_DEPTH_RATIO_i(:) 00283 !ZRTOP_D2(:) = XC_DEPTH_RATIO(:) 00284 !valeur patch 1 (idem wsat wfc) a voir cas ou il existe plusieurs patchs 00285 CALL UNPACK_SAME_RANK(NR_NATURE,XCONDSAT(:,1,1),ZKSAT) 00286 !passage de definition Ksat(profondeur) en Ksat(deficit) 00287 WHERE ( ZDG_FULL/=XUNDEF .AND. (XWSTOPI-XWFCTOPI/=0.) ) 00288 XCSTOPI(:) = ZKSAT(:) / (XWSTOPI(:)-XWFCTOPI(:)) 00289 END WHERE 00290 ! 00291 ELSE 00292 ! 00293 XCSTOPI(:) = HYDCONDSAT_FUNC(ZCLAYTOPI,ZSANDTOPI,'CH78') 00294 !passage de definition Ksat(profondeur) en Ksat(deficit) 00295 WHERE ( ZDG_FULL/=XUNDEF .AND. (XWSTOPI-XWFCTOPI/=0.) ) 00296 XCSTOPI(:) = XCSTOPI(:) / (XWSTOPI(:)-XWFCTOPI(:)) 00297 END WHERE 00298 ! 00299 ENDIF 00300 ! 00301 DEALLOCATE(ZSANDTOPI) 00302 DEALLOCATE(ZCLAYTOPI) 00303 DEALLOCATE(ZRTOP_D2) 00304 ! 00305 !* 4.3 Ko on TOP-LAT grid 00306 ! ------------------ 00307 ! 00308 ALLOCATE(XCSTOPT(NNCAT,NMESHT)) 00309 CALL ISBA_TO_TOPD(XCSTOPI,XCSTOPT) 00310 WHERE (XCSTOPT == XUNDEF) XCSTOPT = 0.0 00311 ! 00312 !* 3.3 Initialization of the previous time step water storage on ISBA grid to calculate the refill on Isba grid 00313 ! ------------------------------------------------------------------------- 00314 ! 00315 ALLOCATE(ZWG2_FULL(KI)) 00316 ALLOCATE(ZWG3_FULL(KI)) 00317 CALL UNPACK_SAME_RANK(NR_NATURE,XWG(:,2,1),ZWG2_FULL) 00318 CALL UNPACK_SAME_RANK(NR_NATURE,XWG(:,3,1),ZWG3_FULL) 00319 ! 00320 ALLOCATE(XWG_FULL(KI)) 00321 WHERE ( ZWG2_FULL/=XUNDEF .AND. ZDG_FULL/=0. ) 00322 XWG_FULL = ( XFRAC_D2*ZDG2_FULL*ZWG2_FULL + XFRAC_D3*(ZDG3_FULL-ZDG2_FULL)*ZWG3_FULL ) / ZDG_FULL 00323 ELSEWHERE 00324 XWG_FULL = XUNDEF 00325 END WHERE 00326 ! 00327 DEALLOCATE(ZWG2_FULL) 00328 DEALLOCATE(ZWG3_FULL) 00329 DEALLOCATE(ZDG3_FULL) 00330 ! 00331 ! 00332 ALLOCATE(XWTOPT(NNCAT,NMESHT)) 00333 XWTOPT(:,:) = 0.0 00334 CALL ISBA_TO_TOPD(XWG_FULL,XWTOPT) 00335 WHERE (XWTOPT == XUNDEF) XWTOPT = 0.0 00336 ! 00337 !ludo prise en compte glace (pas de glace dans 3e couche) 00338 ALLOCATE(ZWGI_FULL(KI)) 00339 ALLOCATE(XWGI_FULL(KI)) 00340 CALL UNPACK_SAME_RANK(NR_NATURE,XWGI(:,2,1),ZWGI_FULL) 00341 ! 00342 WHERE ( ZWGI_FULL/=XUNDEF .AND. XFRAC_D2>0. .AND. ZDG_FULL/=0. ) 00343 XWGI_FULL = (XFRAC_D2*ZDG2_FULL*ZWGI_FULL) / ZDG_FULL 00344 ELSEWHERE 00345 XWGI_FULL = XUNDEF 00346 END WHERE 00347 ! 00348 DEALLOCATE(ZWGI_FULL) 00349 DEALLOCATE(ZDG2_FULL) 00350 DEALLOCATE(ZDG_FULL) 00351 ! 00352 ALLOCATE(Z_WFCTOPI(KI)) 00353 ALLOCATE(Z_WSTOPI (KI)) 00354 !test reservoir top=eau+glace -> pas de modif Wsat et Wfc 00355 WHERE ( XWGI_FULL/=XUNDEF .AND. XWSTOPI/=0. ) 00356 Z_WSTOPI = XWSTOPI - XWGI_FULL 00357 Z_WFCTOPI = XWFCTOPI * Z_WSTOPI / XWSTOPI 00358 END WHERE 00359 ! 00360 !ludo calcul en fct teneur glace 00361 ! 00362 ALLOCATE(XWSTOPT (NNCAT,NMESHT)) 00363 ALLOCATE(XWFCTOPT(NNCAT,NMESHT)) 00364 CALL ISBA_TO_TOPD(Z_WSTOPI,XWSTOPT) 00365 CALL ISBA_TO_TOPD(Z_WFCTOPI,XWFCTOPT) 00366 DEALLOCATE(Z_WSTOPI) 00367 DEALLOCATE(Z_WFCTOPI) 00368 ! 00369 !* 4.0 calcul of time constant variables on TOPODYN grid 00370 ! ------------------------------------------------- 00371 ! 00372 !* 4.2 Wsat and Wfc on TOP-LAT grid 00373 ! ---------------------------- 00374 ! 00375 ALLOCATE(XDMAXFC(NNCAT,NMESHT)) 00376 XDMAXFC(:,:) = XUNDEF 00377 WHERE (XWFCTOPT /= XUNDEF) XDMAXFC = (XWSTOPT - XWFCTOPT) * XDTOPT ! (m) 00378 ! 00379 ! 00380 !* 4.4 Initialisation of the previous time step water storage on topodyn-lat grid 00381 ! -------------------------------------------------------------------------- 00382 !* 4.5 M parameter on TOPODYN grid 00383 ! ------------------------ 00384 !* 4.5.1 Mean depth soil on catchment 00385 ! 00386 ALLOCATE(XMPARA (NNCAT)) 00387 XMPARA (:) = 0.0 00388 ! 00389 IF( CKSAT=='EXP' .OR. CKSAT=='SGH' ) THEN 00390 !ludo test 00391 ALLOCATE(ZF_PARAM_FULL(KI)) 00392 ALLOCATE(ZF_PARAMT(NNCAT,NMESHT)) 00393 ALLOCATE(XF_PARAM(SIZE(XF_PARAM_i))) 00394 XF_PARAM(:) = XF_PARAM_i(:) 00395 CALL UNPACK_SAME_RANK(NR_NATURE,XF_PARAM(:),ZF_PARAM_FULL) 00396 CALL ISBA_TO_TOPD(ZF_PARAM_FULL,ZF_PARAMT) 00397 DEALLOCATE(ZF_PARAM_FULL) 00398 ! 00399 !passage de f a M (M=Wsat-Wfc/f) 00400 !ludo test ksat exp 00401 !ALLOCATE(ZWWILTTOPT(NNCAT,NMESHT)) 00402 !CALL ISBA_TO_TOPD(ZWWILTTOPI,ZWWILTTOPT) 00403 WHERE( ZF_PARAMT/=XUNDEF .AND. ZF_PARAMT/=0. ) ZF_PARAMT = (XWSTOPT-XWFCTOPT)/ZF_PARAMT 00404 !DEALLOCATE(ZWWILTTOPT) 00405 ! 00406 DO JJ=1,NNCAT 00407 XMPARA(JJ) = SUM(ZF_PARAMT(JJ,:),MASK=ZF_PARAMT(JJ,:)/=XUNDEF) / NNMC(JJ) 00408 ENDDO 00409 ! 00410 ZCOEF_ANIS = 1. 00411 XCSTOPT = XCSTOPT*ZCOEF_ANIS 00412 ! 00413 DEALLOCATE(ZF_PARAMT) 00414 ! 00415 ELSE 00416 ! 00417 ALLOCATE(ZDMAXAV(NNCAT)) 00418 ZDMAXAV(:) = 0.0 00419 DO JJ=1,NNCAT 00420 ZDMAXAV(JJ) = SUM( XDMAXFC(JJ,:),MASK=XDMAXFC(JJ,:)/=XUNDEF ) / NNMC(JJ) 00421 ENDDO 00422 ! 00423 !ALLOCATE(ZDTAV (NNCAT)) 00424 !ZDTAV (:) = 0.0 00425 DO JJ=1,NNCAT 00426 !ZDTAV(JJ) = SUM(XDTOPT(JJ,:),MASK=XDTOPT(JJ,:)/=XUNDEF) / NNMC(JJ) 00427 XMPARA(JJ) = ZDMAXAV(JJ) / 4. 00428 ENDDO 00429 !DEALLOCATE(ZDTAV) 00430 DEALLOCATE(ZDMAXAV) 00431 ! 00432 ENDIF 00433 ! 00434 !DEALLOCATE(ZWWILTTOPI) 00435 ! 00436 !* 5.0 Initial saturated area computation 00437 ! ----------------------------------------------------------- 00438 ! 00439 ALLOCATE(XAS_NATURE(NSIZE_NATURE)) 00440 XAS_NATURE(:) = 0.0 00441 ! 00442 !* 6.0 Stock management in case of restart 00443 ! ----------------------------------------------------------- 00444 ! 00445 10 CONTINUE 00446 ! 00447 !stock 00448 ALLOCATE(XRUN_TOROUT(NNCAT,NNB_TOPD_STEP+NNB_STP_RESTART)) 00449 ALLOCATE(XDR_TOROUT (NNCAT,NNB_TOPD_STEP+NNB_STP_RESTART)) 00450 XRUN_TOROUT(:,:) = 0. 00451 XDR_TOROUT (:,:) = 0. 00452 ! 00453 IF (HPROGRAM=='POST ') GOTO 20 00454 ! 00455 IF (LSTOCK_TOPD) CALL RESTART_COUPL_TOPD(HPROGRAM,KI) 00456 ! 00457 !* 7.0 deallocate 00458 ! ---------- 00459 ! 00460 20 CONTINUE 00461 ! 00462 IF (LHOOK) CALL DR_HOOK('INIT_COUPL_TOPD',1,ZHOOK_HANDLE) 00463 ! 00464 END SUBROUTINE INIT_COUPL_TOPD 00465 00466 00467 00468 00469 00470 00471
1.8.0
