Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r2715 r3294 20 20 USE lbclnk ! lateral boundary conditions - mpp exchanges 21 21 USE lib_mpp ! MPP library 22 USE wrk_nemo ! Memory allocation 23 USE timing ! Timing 22 24 23 25 IMPLICIT NONE … … 63 65 !! masks, depth and vertical scale factors 64 66 !!---------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released66 USE wrk_nemo, ONLY: zprt => wrk_2d_1 , zprw => wrk_2d_2 ! 2D workspace67 USE wrk_nemo, ONLY: zdepu => wrk_3d_1 , zdepv => wrk_3d_2 ! 3D -68 67 !! 69 68 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file … … 78 77 CHARACTER(len=21) :: clnam4 ! filename (vertical mesh informations) 79 78 INTEGER :: ji, jj, jk ! dummy loop indices 80 !!---------------------------------------------------------------------- 81 82 IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2) )THEN 83 CALL ctl_stop('dom_wri: requested workspace arrays unavailable') ; RETURN 84 END IF 85 79 ! ! workspaces 80 REAL(wp), POINTER, DIMENSION(:,: ) :: zprt, zprw 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 82 !!---------------------------------------------------------------------- 83 ! 84 IF( nn_timing == 1 ) CALL timing_start('dom_wri') 85 ! 86 CALL wrk_alloc( jpi, jpj, zprt, zprw ) 87 CALL wrk_alloc( jpi, jpj, jpk, zdepu, zdepv ) 88 ! 86 89 IF(lwp) WRITE(numout,*) 87 90 IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)' … … 260 263 END SELECT 261 264 ! 262 IF( wrk_not_released(2, 1,2) .OR. & 263 wrk_not_released(3, 1,2) ) CALL ctl_stop('dom_wri: failed to release workspace arrays') 265 CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 266 CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv ) 267 ! 268 IF( nn_timing == 1 ) CALL timing_stop('dom_wri') 264 269 ! 265 270 END SUBROUTINE dom_wri … … 275 280 !! 2) check which elements have been changed 276 281 !!---------------------------------------------------------------------- 277 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released278 USE wrk_nemo, ONLY: ztstref => wrk_2d_3 ! array with different values for each element279 282 ! 280 283 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! … … 284 287 INTEGER :: ji ! dummy loop indices 285 288 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not 286 !!---------------------------------------------------------------------- 287 288 IF( wrk_in_use(2, 3) ) THEN 289 CALL ctl_stop('dom_uniq: requested workspace array unavailable') ; RETURN 290 ENDIF 291 289 REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 290 !!---------------------------------------------------------------------- 291 ! 292 IF( nn_timing == 1 ) CALL timing_start('dom_uniq') 293 ! 294 CALL wrk_alloc( jpi, jpj, ztstref ) 295 ! 292 296 ! build an array with different values for each element 293 297 ! in mpp: make sure that these values are different even between process … … 304 308 puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 305 309 ! 306 IF( wrk_not_released(2, 3) ) CALL ctl_stop('dom_uniq: failed to release workspace array') 310 CALL wrk_dealloc( jpi, jpj, ztstref ) 311 ! 312 IF( nn_timing == 1 ) CALL timing_stop('dom_uniq') 307 313 ! 308 314 END SUBROUTINE dom_uniq
Note: See TracChangeset
for help on using the changeset viewer.