New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90 – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r2715 r3294  
    2020   USE lbclnk          ! lateral boundary conditions - mpp exchanges 
    2121   USE lib_mpp         ! MPP library 
     22   USE wrk_nemo        ! Memory allocation 
     23   USE timing          ! Timing 
    2224 
    2325   IMPLICIT NONE 
     
    6365      !!                                   masks, depth and vertical scale factors 
    6466      !!---------------------------------------------------------------------- 
    65       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY:   zprt  => wrk_2d_1 , zprw  => wrk_2d_2    ! 2D workspace 
    67       USE wrk_nemo, ONLY:   zdepu => wrk_3d_1 , zdepv => wrk_3d_2    ! 3D     - 
    6867      !! 
    6968      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file 
     
    7877      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations) 
    7978      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      ! 
    8689      IF(lwp) WRITE(numout,*) 
    8790      IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)' 
     
    260263      END SELECT 
    261264      ! 
    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') 
    264269      ! 
    265270   END SUBROUTINE dom_wri 
     
    275280      !!                2) check which elements have been changed 
    276281      !!---------------------------------------------------------------------- 
    277       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    278       USE wrk_nemo, ONLY:   ztstref => wrk_2d_3      ! array with different values for each element 
    279282      ! 
    280283      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
     
    284287      INTEGER  ::  ji       ! dummy loop indices 
    285288      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      ! 
    292296      ! build an array with different values for each element  
    293297      ! in mpp: make sure that these values are different even between process 
     
    304308      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    305309      ! 
    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') 
    307313      ! 
    308314   END SUBROUTINE dom_uniq 
Note: See TracChangeset for help on using the changeset viewer.