|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PGD_COVER(HPROGRAM) 00003 ! ############################################################## 00004 ! 00005 !!**** *PGD_COVER* monitor for averaging and interpolations of cover fractions 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 ! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! AUTHOR 00024 !! ------ 00025 !! 00026 !! V. Masson Meteo-France 00027 !! 00028 !! MODIFICATION 00029 !! ------------ 00030 !! 00031 !! Original 10/12/97 00032 !! B. Decharme 06/2008 limit of coast coverage under which the coast is replaced by sea or inland water 00033 !! B. Decharme 06/2009 remove lack and sea as the user want 00034 !! B. Decharme 07/2009 compatibility between Surfex and Orca (Nemo) grid (Earth Model) 00035 !! B. Decharme 07/2012 if sea or water imposed to 1 in a grid cell: no extrapolation 00036 !! 00037 !---------------------------------------------------------------------------- 00038 ! 00039 !* 0. DECLARATION 00040 ! ----------- 00041 ! 00042 USE MODD_SURF_PAR, ONLY : XUNDEF 00043 USE MODD_PGD_GRID, ONLY : CGRID, NL, XGRID_PAR, NGRID_PAR 00044 USE MODD_PGDWORK, ONLY : XSUMCOVER, NSIZE 00045 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NROCK, NSEA, NWATER, NPERMSNOW 00046 USE MODD_DATA_COVER, ONLY : XDATA_TOWN, XDATA_SEA 00047 USE MODD_SURF_ATM_n, ONLY : CNATURE, CSEA, CTOWN, CWATER, & 00048 XNATURE, XSEA, XTOWN, XWATER, & 00049 XCOVER, LCOVER, & 00050 NSIZE_NATURE, NSIZE_SEA, & 00051 NSIZE_TOWN, NSIZE_WATER,NSIZE_FULL, & 00052 NDIM_NATURE, NDIM_SEA, & 00053 NDIM_TOWN,NDIM_WATER 00054 ! 00055 USE MODI_GET_LUOUT 00056 USE MODE_GRIDTYPE_GAUSS 00057 00058 USE MODI_TREAT_FIELD 00059 USE MODI_INTERPOL_FIELD2D 00060 USE MODI_CONVERT_COVER_FRAC 00061 ! 00062 USE MODI_READ_LCOVER 00063 USE MODI_READ_SURF 00064 USE MODI_SUM_ON_ALL_PROCS 00065 ! 00066 USE MODI_READ_NAM_PGD_COVER 00067 ! 00068 USE MODI_INIT_IO_SURF_n 00069 USE MODI_END_IO_SURF_n 00070 #ifdef ASC 00071 USE MODD_IO_SURF_ASC, ONLY : CFILEIN 00072 #endif 00073 #ifdef FA 00074 USE MODD_IO_SURF_FA, ONLY : CFILEIN_FA 00075 #endif 00076 #ifdef LFI 00077 USE MODD_IO_SURF_LFI, ONLY : CFILEIN_LFI 00078 #endif 00079 ! 00080 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00081 USE PARKIND1 ,ONLY : JPRB 00082 ! 00083 USE MODI_ABOR1_SFX 00084 ! 00085 USE MODI_PGD_ECOCLIMAP2_DATA 00086 ! 00087 IMPLICIT NONE 00088 ! 00089 !* 0.1 Declaration of arguments 00090 ! ------------------------ 00091 ! 00092 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program 00093 ! 00094 ! 00095 !* 0.2 Declaration of local variables 00096 ! ------------------------------ 00097 ! 00098 INTEGER :: ILUOUT ! output listing logical unit 00099 ! 00100 INTEGER :: JCOVER ! loop counter on covers 00101 INTEGER :: JL ! loop counter on horizontal points 00102 INTEGER, DIMENSION(1) :: IMAXCOVER ! index of maximum cover for the given point 00103 INTEGER :: IRESP ! Error code after redding 00104 ! 00105 REAL, DIMENSION(:), ALLOCATABLE :: ZLAT 00106 ! 00107 !* 0.3 Declaration of namelists 00108 ! ------------------------ 00109 ! 00110 REAL, DIMENSION(:), ALLOCATABLE :: XUNIF_COVER ! value of each cover (cover will be 00111 ! uniform on the horizontal) 00112 REAL, DIMENSION(:), ALLOCATABLE :: ZSEA !to check compatibility between 00113 REAL, DIMENSION(:), ALLOCATABLE :: ZWATER !prescribed fractions and ECOCLIMAP 00114 REAL, DIMENSION(:), ALLOCATABLE :: ZNATURE 00115 REAL, DIMENSION(:), ALLOCATABLE :: ZTOWN 00116 REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER_NATURE, ZCOVER_TOWN, ZCOVER_SEA, ZCOVER_WATER 00117 REAL, DIMENSION(JPCOVER) :: ZDEF 00118 CHARACTER(LEN=10) :: YFIELD 00119 ! 00120 CHARACTER(LEN=28) :: YCOVER ! file name for cover types 00121 CHARACTER(LEN=6) :: YFILETYPE ! data file type 00122 REAL :: XRM_COVER ! limit of coverage under which the 00123 ! cover is removed. Default is 1.E-6 00124 REAL :: XRM_COAST ! limit of coast coverage under which 00125 ! the coast is replaced by sea or 00126 ! inland water. Default is 1. 00127 ! 00128 REAL :: XRM_LAKE ! limit of inland lake coverage under which 00129 ! the water is removed. Default is 0.0 00130 ! 00131 REAL :: XRM_SEA ! limit of sea coverage under which 00132 ! the sea is removed. Default is 0.0 00133 ! 00134 LOGICAL :: LORCA_GRID ! flag to compatibility between Surfex and Orca grid 00135 ! (Earth Model over Antarctic) 00136 REAL :: XLAT_ANT ! Lattitude limit from Orca grid (Antartic) 00137 ! 00138 LOGICAL :: LIMP_COVER ! Imposed values for Cover from another PGD file 00139 INTEGER :: ICOVER ! 0 if cover is not present, >1 if present somewhere 00140 ! ! (even on another processor) 00141 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00142 ! 00143 !--------------------------------------------------------------- 00144 ! 00145 !* 1. Initializations 00146 ! --------------- 00147 ! 00148 IF (LHOOK) CALL DR_HOOK('PGD_COVER',0,ZHOOK_HANDLE) 00149 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00150 ! 00151 ALLOCATE(XCOVER (NL,JPCOVER)) 00152 ALLOCATE(XUNIF_COVER(JPCOVER)) 00153 ! 00154 XCOVER = XUNDEF 00155 XUNIF_COVER = XUNDEF 00156 !------------------------------------------------------------------------------- 00157 ! 00158 !* 2. Input file for cover types 00159 ! -------------------------- 00160 ! 00161 CALL READ_NAM_PGD_COVER(HPROGRAM, YCOVER, YFILETYPE, XUNIF_COVER, & 00162 XRM_COVER, XRM_COAST, XRM_LAKE, XRM_SEA, & 00163 LORCA_GRID, XLAT_ANT, LIMP_COVER ) 00164 ! 00165 !------------------------------------------------------------------------------- 00166 ! 00167 !* 3. Uniform field is prescribed 00168 ! --------------------------- 00169 !------------------------------------------------------------------------------- 00170 ! 00171 IF (ANY(XUNIF_COVER/=0.)) THEN 00172 ! 00173 !* 3.1 Verification of the total input cover fractions 00174 ! ----------------------------------------------- 00175 ! 00176 IF (ABS(SUM(XUNIF_COVER)-1.)>1.E-6) THEN 00177 WRITE(ILUOUT,*) ' ' 00178 WRITE(ILUOUT,*) '***************************************************' 00179 WRITE(ILUOUT,*) '* Error in COVER fractions preparation *' 00180 WRITE(ILUOUT,*) '* The prescribed covers does not fit *' 00181 WRITE(ILUOUT,*) '* The sum of all cover must be equal to 1 exactly *' 00182 WRITE(ILUOUT,*) '***************************************************' 00183 WRITE(ILUOUT,*) ' ' 00184 CALL ABOR1_SFX('PGD_COVER: SUM OF ALL COVER FRACTIONS MUST BE 1.') 00185 ! 00186 !* 3.2 Use of the presribed cover fractions 00187 ! ------------------------------------ 00188 ! 00189 ELSE 00190 XCOVER(:,:) =0. 00191 DO JCOVER=1,JPCOVER 00192 XCOVER(:,JCOVER) = XUNIF_COVER(JCOVER) 00193 END DO 00194 XCOVER(:,:)=XCOVER(:,:)/SPREAD(SUM(XCOVER(:,:),2),2,JPCOVER) 00195 END IF 00196 ! 00197 !* 3.3 No data 00198 ! ------- 00199 ! 00200 ELSEIF (LEN_TRIM(YCOVER)==0) THEN 00201 WRITE(ILUOUT,*) ' ' 00202 WRITE(ILUOUT,*) '***********************************************************' 00203 WRITE(ILUOUT,*) '* Error in COVER fractions preparation *' 00204 WRITE(ILUOUT,*) '* There is no prescribed cover fraction and no input file *' 00205 WRITE(ILUOUT,*) '***********************************************************' 00206 WRITE(ILUOUT,*) ' ' 00207 CALL ABOR1_SFX('PGD_COVER: NO PRESCRIBED COVER NOR INPUT FILE') 00208 ! 00209 !------------------------------------------------------------------------------- 00210 ELSEIF(LIMP_COVER)THEN !LIMP_COVER (impose cover from input file at the same resolution) 00211 ! 00212 IF(YFILETYPE=='NETCDF')THEN 00213 CALL ABOR1_SFX('Use another format than netcdf for cover input file with LIMP_COVER') 00214 ELSE 00215 #ifdef ASC 00216 CFILEIN = ADJUSTL(ADJUSTR(YCOVER)//'.txt') 00217 #endif 00218 #ifdef FA 00219 CFILEIN_FA = ADJUSTL(ADJUSTR(YCOVER)//'.fa') 00220 #endif 00221 #ifdef LFI 00222 CFILEIN_LFI = ADJUSTL(YCOVER) 00223 #endif 00224 CALL INIT_IO_SURF_n(YFILETYPE,'FULL ','SURF ','READ ') 00225 ENDIF 00226 ! 00227 ALLOCATE(LCOVER(JPCOVER)) 00228 CALL READ_LCOVER(YFILETYPE,LCOVER) 00229 ! 00230 CALL READ_SURF(YFILETYPE,'COVER',XCOVER(:,:),LCOVER,IRESP) 00231 ! 00232 CALL END_IO_SURF_n(YFILETYPE) 00233 ! 00234 ELSE 00235 !------------------------------------------------------------------------------- 00236 ! 00237 !* 3. Averages the field 00238 ! ------------------ 00239 ! 00240 ALLOCATE(NSIZE (NL) ) 00241 ALLOCATE(XSUMCOVER (NL,JPCOVER)) 00242 ! 00243 NSIZE (:) = 0. 00244 XSUMCOVER(:,:) = 0. 00245 CALL TREAT_FIELD(HPROGRAM,'SURF ',YFILETYPE,'A_COVR',YCOVER, & 00246 'COVER ' ) 00247 00248 ! 00249 !* 4. Interpolation if some points are not initialized (no data for these points) (same time) 00250 ! --------------------------------------------------------------------------------------- 00251 ! 00252 WRITE(YFIELD,FMT='(A)') 'covers' 00253 CALL INTERPOL_FIELD2D(HPROGRAM,ILUOUT,NSIZE,XCOVER(:,:),YFIELD) 00254 ! 00255 !------------------------------------------------------------------------------- 00256 ! 00257 !* 5. Coherence check 00258 ! --------------- 00259 ! 00260 XCOVER(:,:)=XCOVER(:,:)/SPREAD(SUM(XCOVER(:,:),2),2,JPCOVER) 00261 ! 00262 DEALLOCATE(NSIZE ) 00263 DEALLOCATE(XSUMCOVER) 00264 ! 00265 !------------------------------------------------------------------------------- 00266 ! 00267 !* 6. Special treatments asked by user 00268 ! -------------------------------- 00269 ! 00270 ! * removes cover with very small coverage 00271 DO JL=1,SIZE(XCOVER,1) 00272 IMAXCOVER(:) = MAXLOC(XCOVER(JL,:)) 00273 DO JCOVER=1,JPCOVER 00274 IF (XCOVER(JL,JCOVER)<=XRM_COVER .AND. JCOVER /= IMAXCOVER(1)) THEN 00275 XCOVER(JL,JCOVER) = 0. 00276 END IF 00277 END DO 00278 END DO 00279 ! 00280 ! * removes cover; replace by sea or inland water if sea or inland water > XRM_COAST 00281 DO JCOVER=1,JPCOVER 00282 DO JL=1,SIZE(NSEA) 00283 WHERE(XCOVER(:,NSEA(JL))>=XRM_COAST) 00284 XCOVER(:,JCOVER) = 0. 00285 XCOVER(:,NSEA(JL)) = 1. 00286 END WHERE 00287 ENDDO 00288 DO JL=1,SIZE(NWATER) 00289 WHERE(XCOVER(:,NWATER(JL))>=XRM_COAST) 00290 XCOVER(:,JCOVER) = 0. 00291 XCOVER(:,NWATER(JL)) = 1. 00292 END WHERE 00293 ENDDO 00294 ENDDO 00295 ! 00296 ! * removes lake as the user want 00297 IF(XRM_LAKE>0.0)THEN 00298 DO JL=1,SIZE(NWATER) 00299 WHERE(XCOVER(:,NWATER(JL))<=XRM_LAKE) 00300 XCOVER(:,NWATER(JL)) = 0. 00301 ENDWHERE 00302 ENDDO 00303 ENDIF 00304 ! 00305 ! * removes sea as the user want 00306 IF(XRM_SEA>0.0)THEN 00307 DO JL=1,SIZE(NSEA) 00308 WHERE(XCOVER(:,NSEA(JL))<=XRM_SEA) 00309 XCOVER(:,NSEA(JL)) = 0. 00310 ENDWHERE 00311 ENDDO 00312 ENDIF 00313 ! 00314 ! * Compatibility between Surfex and Orca grid 00315 ! (Earth Model over water bodies and Antarctic) 00316 ! 00317 IF(LORCA_GRID.AND.CGRID=='GAUSS ')THEN 00318 ! 00319 ! No river or inland water bodies 00320 XCOVER(:,NWATER(2)) = 0. 00321 XCOVER(:,NWATER(3)) = 0. 00322 ! 00323 ALLOCATE(ZLAT(NL)) 00324 CALL GET_GRIDTYPE_GAUSS(XGRID_PAR,PLAT=ZLAT) 00325 ! 00326 DO JL=1,SIZE(NSEA) 00327 WHERE(ZLAT(:)<XLAT_ANT.AND.XCOVER(:,NSEA(JL))>0.0) 00328 XCOVER(:,NPERMSNOW) = 1.0 00329 XCOVER(:,NSEA(JL)) = 0.0 00330 ENDWHERE 00331 ENDDO 00332 DO JL=1,SIZE(NWATER) 00333 WHERE(ZLAT(:)<XLAT_ANT.AND.XCOVER(:,NWATER(JL))>0.0) 00334 XCOVER(:,NPERMSNOW) = 1.0 00335 XCOVER(:,NWATER(JL)) = 0.0 00336 ENDWHERE 00337 ENDDO 00338 ! 00339 DEALLOCATE(ZLAT) 00340 ! 00341 ENDIF 00342 ! 00343 !------------------------------------------------------------------------------- 00344 ! 00345 !* 7. Coherence check 00346 ! --------------- 00347 ! 00348 XCOVER(:,:)=XCOVER(:,:)/SPREAD(SUM(XCOVER(:,:),2),2,JPCOVER) 00349 ! 00350 !------------------------------------------------------------------------------- 00351 END IF 00352 ! 00353 DEALLOCATE(XUNIF_COVER) 00354 ! 00355 !------------------------------------------------------------------------------- 00356 ! 00357 IF(.NOT.LIMP_COVER)THEN 00358 00359 !* 8. List of cover present 00360 ! --------------------- 00361 ! 00362 IF ( SUM_ON_ALL_PROCS(HPROGRAM,CGRID,ANY(XCOVER(:,300:)>0.,DIM=2),'COV' ) >0 ) & 00363 CALL PGD_ECOCLIMAP2_DATA(HPROGRAM) 00364 ! 00365 !------------------------------------------------------------------------------- 00366 ENDIF 00367 !------------------------------------------------------------------------------- 00368 ! 00369 !* 9. Land - sea fractions 00370 ! -------------------- 00371 ! 00372 IF (.NOT.ASSOCIATED(XSEA)) THEN 00373 00374 ALLOCATE(XSEA (NL)) 00375 ALLOCATE(XWATER (NL)) 00376 ALLOCATE(XNATURE(NL)) 00377 ALLOCATE(XTOWN (NL)) 00378 CALL CONVERT_COVER_FRAC(XCOVER,XSEA,XNATURE,XTOWN,XWATER) 00379 00380 ELSE 00381 !if fractions are prescribed, it has to be verified that the locations of 00382 !ECOCLIMAP covers are compatible with the fractions of surface types 00383 ALLOCATE(ZSEA (NL)) 00384 ALLOCATE(ZWATER (NL)) 00385 ALLOCATE(ZNATURE(NL)) 00386 ALLOCATE(ZTOWN (NL)) 00387 CALL CONVERT_COVER_FRAC(XCOVER,ZSEA,ZNATURE,ZTOWN,ZWATER) 00388 ! 00389 ALLOCATE(ZCOVER_NATURE(NL,JPCOVER)) 00390 ALLOCATE(ZCOVER_TOWN (NL,JPCOVER)) 00391 ALLOCATE(ZCOVER_SEA (NL,JPCOVER)) 00392 ALLOCATE(ZCOVER_WATER (NL,JPCOVER)) 00393 ! 00394 ZCOVER_NATURE(:,:) = XCOVER(:,:) 00395 ZCOVER_TOWN (:,:) = XCOVER(:,:) 00396 ZCOVER_SEA (:,:) = XCOVER(:,:) 00397 ZCOVER_WATER (:,:) = XCOVER(:,:) 00398 ! 00399 ALLOCATE(NSIZE(NL)) 00400 ! 00401 WRITE(ILUOUT,FMT=*) & 00402 '*********************************************************************' 00403 WRITE(ILUOUT,FMT=*) & 00404 '* Coherence computation between covers and imposed nature fraction *' 00405 WRITE(ILUOUT,FMT=*) & 00406 '*********************************************************************' 00407 NSIZE(:) = 1 00408 WHERE (XNATURE(:).NE.0. .AND. ZNATURE(:).EQ.0.) NSIZE(:)=0 00409 DO JL=1,SIZE(XCOVER,1) 00410 IF (XNATURE(JL).EQ.0.) NSIZE(JL)=-1 00411 ENDDO 00412 ZDEF(:)=0. 00413 ZDEF(4)=1. ! if not enough covers are present, cover 4 assumed 00414 CALL INTERPOL_FIELD2D(HPROGRAM,ILUOUT,NSIZE,ZCOVER_NATURE(:,:),YFIELD,ZDEF) 00415 00416 WRITE(ILUOUT,FMT=*) & 00417 '*********************************************************************' 00418 WRITE(ILUOUT,FMT=*) & 00419 '* Coherence computation between covers and imposed town fraction *' 00420 WRITE(ILUOUT,FMT=*) & 00421 '*********************************************************************' 00422 NSIZE(:) = 1 00423 WHERE (XTOWN(:).NE.0. .AND. ZTOWN(:).EQ.0.) NSIZE(:)=0 00424 DO JL=1,SIZE(XCOVER,1) 00425 IF (XTOWN(JL).EQ.0.) NSIZE(JL)=-1 00426 ENDDO 00427 ZDEF(:)=0. 00428 ZDEF(7)=1. ! if not enough covers are present, cover 7 assumed 00429 CALL INTERPOL_FIELD2D(HPROGRAM,ILUOUT,NSIZE,ZCOVER_TOWN (:,:),YFIELD,ZDEF) 00430 00431 WRITE(ILUOUT,FMT=*) & 00432 '*********************************************************************' 00433 WRITE(ILUOUT,FMT=*) & 00434 '* Coherence computation between covers and imposed water fraction *' 00435 WRITE(ILUOUT,FMT=*) & 00436 '*********************************************************************' 00437 NSIZE(:) = 1 00438 WHERE (XWATER(:).NE.0. .AND. ZWATER(:).EQ.0.) NSIZE(:)=0 00439 ! if water imposed to 1 in a grid cell: no extrapolation 00440 DO JL=1,SIZE(XCOVER,1) 00441 IF(XWATER(JL)==1.0)THEN 00442 ZCOVER_WATER(JL,1)=0.0 00443 ZCOVER_WATER(JL,2)=1.0 00444 ZCOVER_WATER(JL,3:JPCOVER)=0.0 00445 NSIZE(JL)=1 00446 ELSEIF(XWATER(JL)==0.0)THEN 00447 NSIZE(JL)=-1 00448 ENDIF 00449 ENDDO 00450 ZDEF(:)=0. 00451 ZDEF(2)=1. ! if not enough covers are present, cover 002 assumed 00452 CALL INTERPOL_FIELD2D(HPROGRAM,ILUOUT,NSIZE,ZCOVER_WATER (:,:),YFIELD,PDEF=ZDEF) 00453 00454 WRITE(ILUOUT,FMT=*) & 00455 '*********************************************************************' 00456 WRITE(ILUOUT,FMT=*) & 00457 '* Coherence computation between covers and imposed sea fraction *' 00458 WRITE(ILUOUT,FMT=*) & 00459 '*********************************************************************' 00460 NSIZE(:) = 1 00461 WHERE (XSEA(:).NE.0. .AND. ZSEA(:).EQ.0.) NSIZE(:)=0 00462 ! if sea imposed to 1 in a grid cell: no extrapolation 00463 DO JL=1,SIZE(XCOVER,1) 00464 IF(XSEA(JL)==1.0)THEN 00465 ZCOVER_SEA(JL,1)=1.0 00466 ZCOVER_SEA(JL,2:JPCOVER)=0.0 00467 NSIZE(JL)=1 00468 ELSEIF(XSEA(JL)==0.0)THEN 00469 NSIZE(JL)=-1 00470 ENDIF 00471 ENDDO 00472 ZDEF(:)=0. 00473 ZDEF(1)=1. ! if not enough covers are present, cover 001 assumed 00474 CALL INTERPOL_FIELD2D(HPROGRAM,ILUOUT,NSIZE,ZCOVER_SEA (:,:),YFIELD,PDEF=ZDEF) 00475 ! 00476 XCOVER(:,:) = XCOVER(:,:) + 0.001 * ( ZCOVER_NATURE(:,:) + ZCOVER_TOWN(:,:) + & 00477 ZCOVER_WATER (:,:) + ZCOVER_SEA (:,:) ) 00478 ! 00479 XCOVER(:,:)=XCOVER(:,:)/SPREAD(SUM(XCOVER(:,:),2),2,JPCOVER) 00480 ! 00481 DEALLOCATE(ZCOVER_NATURE) 00482 DEALLOCATE(ZCOVER_TOWN ) 00483 DEALLOCATE(ZCOVER_WATER ) 00484 DEALLOCATE(ZCOVER_SEA ) 00485 ! 00486 DEALLOCATE(NSIZE ) 00487 DEALLOCATE(ZSEA ) 00488 DEALLOCATE(ZWATER ) 00489 DEALLOCATE(ZNATURE ) 00490 DEALLOCATE(ZTOWN ) 00491 ! 00492 ENDIF 00493 ! 00494 NSIZE_NATURE = COUNT(XNATURE(:) > 0.0) 00495 NSIZE_WATER = COUNT(XWATER (:) > 0.0) 00496 NSIZE_SEA = COUNT(XSEA (:) > 0.0) 00497 NSIZE_TOWN = COUNT(XTOWN (:) > 0.0) 00498 NSIZE_FULL = NL 00499 ! 00500 NDIM_NATURE = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XNATURE(:) > 0., 'DIM') 00501 NDIM_WATER = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XWATER (:) > 0., 'DIM') 00502 NDIM_SEA = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XSEA (:) > 0., 'DIM') 00503 NDIM_TOWN = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XTOWN (:) > 0., 'DIM') 00504 ! 00505 !* 8. List of cover present 00506 ! --------------------- 00507 ! 00508 ALLOCATE(LCOVER(JPCOVER)) 00509 LCOVER = .FALSE. 00510 DO JCOVER=1,JPCOVER 00511 ICOVER = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,XCOVER(:,JCOVER)/=0., 'COV') 00512 IF (ICOVER>0) LCOVER(JCOVER)=.TRUE. 00513 END DO 00514 ! 00515 IF (LHOOK) CALL DR_HOOK('PGD_COVER',1,ZHOOK_HANDLE) 00516 !------------------------------------------------------------------------------- 00517 ! 00518 END SUBROUTINE PGD_COVER
1.8.0
