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 2618 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

Ignore:
Timestamp:
2011-02-26T13:31:38+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; move dyn allocation from nemogcm to module when possible (continuation)

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2590 r2618  
    77   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
    88   !!            3.3  ! 2010-11  (G. Madec) add mbk. arrays associated to the deepest ocean level 
    9    !!---------------------------------------------------------------------- 
    10    USE par_oce      ! ocean parameters 
     9   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
     10   !!---------------------------------------------------------------------- 
     11 
     12   !!---------------------------------------------------------------------- 
     13   !!   Agrif_Root    : dummy function used when lk_agrif=F 
     14   !!   Agrif_CFixed  : dummy function used when lk_agrif=F 
     15   !!   dom_oce_alloc : dynamical allocation of dom_oce arrays 
     16   !!---------------------------------------------------------------------- 
     17   USE par_oce        ! ocean parameters 
    1118 
    1219   IMPLICIT NONE 
    13    PUBLIC           ! allows the acces to par_oce when dom_oce is used 
    14    !                ! exception to coding rules... to be suppressed ??? 
     20   PUBLIC             ! allows the acces to par_oce when dom_oce is used 
     21   !                  ! exception to coding rules... to be suppressed ??? 
     22 
     23   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90 
    1524 
    1625   !!---------------------------------------------------------------------- 
    … …  
    4453   REAL(wp), PUBLIC ::   rdth            !: depth variation of tracer step 
    4554   INTEGER , PUBLIC ::   nclosea         !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 
    46  
    4755 
    4856   !                                                  !!! associated variables 
    … …  
    216224#endif 
    217225 
    218    PUBLIC dom_oce_alloc  ! Called from nemogcm.F90 
    219  
    220226   !!---------------------------------------------------------------------- 
    221227   !! agrif domain 
    … …  
    227233#endif 
    228234 
     235   !!---------------------------------------------------------------------- 
     236   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     237   !! $Id$  
     238   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     239   !!---------------------------------------------------------------------- 
    229240CONTAINS 
    230241 
    231242#if ! defined key_agrif 
     243   !!---------------------------------------------------------------------- 
     244   !! NOT 'key_agrif'      dummy function                     No AGRIF zoom 
     245   !!---------------------------------------------------------------------- 
    232246   LOGICAL FUNCTION Agrif_Root() 
    233247      Agrif_Root = .TRUE. 
    … …  
    235249 
    236250   CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    237      Agrif_CFixed = '0'  
     251      Agrif_CFixed = '0'  
    238252   END FUNCTION Agrif_CFixed 
    239253#endif 
    240254 
    241    FUNCTION dom_oce_alloc() 
    242      !!---------------------------------------------------------------------- 
    243      USE par_oce, Only: jpi, jpj, jpk, jpnij 
    244      IMPLICIT none 
    245      INTEGER :: dom_oce_alloc 
    246      INTEGER, DIMENSION(11) :: ierr 
    247      
    248      ierr(:) = 0 
    249  
    250      ALLOCATE(rdttra(jpk), mig(jpi), mjg(jpj), Stat=ierr(1)) 
    251  
    252      ALLOCATE(nimppt(jpnij), njmppt(jpnij), & 
    253               ibonit(jpnij), ibonjt(jpnij), & 
    254               nlcit(jpnij), nlcjt(jpnij),   & 
    255               nldit(jpnij), nldjt(jpnij),   & 
    256               nleit(jpnij), nlejt(jpnij), Stat=ierr(2)) 
    257  
    258      ALLOCATE(glamt(jpi,jpj), glamu(jpi,jpj), &  
    259               glamv(jpi,jpj), glamf(jpi,jpj), &   
    260               gphit(jpi,jpj), gphiu(jpi,jpj), &   
    261               gphiv(jpi,jpj), gphif(jpi,jpj), &   
    262               e1t(jpi,jpj), e2t(jpi,jpj),     &   
    263               e1u(jpi,jpj), e2u(jpi,jpj),     &   
    264               e1v(jpi,jpj), e2v(jpi,jpj),     &   
    265               e1f(jpi,jpj), e2f(jpi,jpj),     &   
    266               ff(jpi,jpj), Stat=ierr(3))      
    267  
    268     !IF( .not. lk_zco )THEN 
    269      ALLOCATE(gdep3w(jpi,jpj,jpk),                        & 
    270               gdept(jpi,jpj,jpk) , gdepw(jpi,jpj,jpk),    & 
    271               e3v(jpi,jpj,jpk)   , e3f(jpi,jpj,jpk)  ,    & 
    272               e3t(jpi,jpj,jpk)   , e3u(jpi,jpj,jpk)  ,    & 
    273               e3vw(jpi,jpj,jpk)  ,                        & 
    274               e3w(jpi,jpj,jpk)   , e3uw(jpi,jpj,jpk) , Stat=ierr(4)) 
    275     !END IF 
     255   INTEGER FUNCTION dom_oce_alloc() 
     256      !!---------------------------------------------------------------------- 
     257      INTEGER, DIMENSION(11) :: ierr 
     258      !!---------------------------------------------------------------------- 
     259 
     260      ierr(:) = 0 
     261 
     262      ALLOCATE( rdttra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
     263 
     264      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 
     265         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
     266         &                                      nleit(jpnij) , nlejt(jpnij) , STAT=ierr(2) ) 
     267 
     268      ALLOCATE( glamt(jpi,jpj), gphit(jpi,jpj), e1t(jpi,jpj), e2t(jpi,jpj),                  &  
     269         &      glamu(jpi,jpj), gphiu(jpi,jpj), e1u(jpi,jpj), e2u(jpi,jpj),                  &   
     270         &      glamv(jpi,jpj), gphiv(jpi,jpj), e1v(jpi,jpj), e2v(jpi,jpj),                  &   
     271         &      glamf(jpi,jpj), gphif(jpi,jpj), e1f(jpi,jpj), e2f(jpi,jpj), ff(jpi,jpj), STAT=ierr(3) )      
     272 
     273      ALLOCATE( gdep3w(jpi,jpj,jpk) , e3v(jpi,jpj,jpk) , e3f (jpi,jpj,jpk) ,                         & 
     274         &      gdept (jpi,jpj,jpk) , e3t(jpi,jpj,jpk) , e3u (jpi,jpj,jpk) ,                         & 
     275         &      gdepw (jpi,jpj,jpk) , e3w(jpi,jpj,jpk) , e3vw(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , STAT=ierr(4) ) 
    276276 
    277277#if defined key_vvl 
    278      ALLOCATE(gdep3w_1(jpi,jpj,jpk)       ,  & 
    279               gdept_1(jpi,jpj,jpk), gdepw_1(jpi,jpj,jpk),  & 
    280               e3v_1(jpi,jpj,jpk)  , e3f_1(jpi,jpj,jpk)  ,  & 
    281               e3t_1(jpi,jpj,jpk)  , e3u_1(jpi,jpj,jpk)  ,  & 
    282               e3vw_1(jpi,jpj,jpk) ,                        &  
    283               e3w_1(jpi,jpj,jpk)  , e3uw_1(jpi,jpj,jpk),   & 
    284               e3t_b(jpi,jpj,jpk)  ,                        & 
    285               e3u_b(jpi,jpj,jpk)  , e3v_b(jpi,jpj,jpk),    & 
    286               Stat=ierr(5)) 
    287 #endif 
    288  
    289     ALLOCATE(hur(jpi,jpj), hvr(jpi,jpj),  & 
    290              hu(jpi,jpj),  hv(jpi,jpj),   & 
    291              hu_0(jpi,jpj), hv_0(jpi,jpj),& 
    292              Stat=ierr(6)) 
     278      ALLOCATE( gdep3w_1(jpi,jpj,jpk) , e3v_1(jpi,jpj,jpk) , e3f_1 (jpi,jpj,jpk) ,                           & 
     279         &      gdept_1 (jpi,jpj,jpk) , e3t_1(jpi,jpj,jpk) , e3u_1 (jpi,jpj,jpk) ,                           & 
     280         &      gdepw_1 (jpi,jpj,jpk) , e3w_1(jpi,jpj,jpk) , e3vw_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk) ,     & 
     281         &      e3t_b   (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk)                        , STAT=ierr(5) ) 
     282#endif 
     283 
     284      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) ,     & 
     285         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) ) 
     286 
     287      ALLOCATE( gdept_0(jpk) , gdepw_0(jpk) ,                                     & 
     288         &      e3t_0  (jpk) , e3w_0  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) ,     & 
     289         &      gsigt  (jpk) , gsigw  (jpk) , gsi3w(jpk)    ,                     & 
     290         &      esigt  (jpk) , esigw  (jpk)                                 , STAT=ierr(7) ) 
    293291    ! 
    294     ALLOCATE(gdept_0(jpk), gdepw_0(jpk),  e3t_0(jpk),    & 
    295              e3w_0(jpk)  , e3tp(jpi,jpj), e3wp(jpi,jpj), & 
    296              gsigt(jpk)  , gsigw(jpk)   , gsi3w(jpk),    & 
    297              esigt(jpk)  , esigw(jpk)   , Stat=ierr(7)) 
    298     ! 
    299     ALLOCATE(hbatv(jpi,jpj) , hbatf(jpi,jpj) ,   & 
    300              hbatt(jpi,jpj) , hbatu(jpi,jpj) ,   & 
    301              scosrf(jpi,jpj), scobot(jpi,jpj),   & 
    302              hifv(jpi,jpj)  , hiff(jpi,jpj)  ,   & 
    303              hift(jpi,jpj)  , hifu(jpi,jpj)  ,   & 
    304              Stat=ierr(8)) 
    305     ! 
    306     ALLOCATE(mbathy(jpi,jpj),                             & 
    307              mbkt(jpi,jpj), mbku(jpi,jpj), mbkv(jpi,jpj), & 
    308              bathy(jpi,jpj),                              & 
    309              tmask_i(jpi,jpj),bmask(jpi,jpj),             & 
    310              Stat=ierr(9)) 
    311  
    312     ALLOCATE(tmask(jpi,jpj,jpk), umask(jpi,jpj,jpk),    &  
    313              vmask(jpi,jpj,jpk), fmask(jpi,jpj,jpk),    & 
    314              Stat=ierr(10)) 
     292      ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) ,     & 
     293         &      hbatt (jpi,jpj) , hbatu (jpi,jpj) ,     & 
     294         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     & 
     295         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     & 
     296         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(8) ) 
     297 
     298      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                     & 
     299         &     tmask_i(jpi,jpj) , bmask(jpi,jpj) ,                     & 
     300         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 
     301 
     302      ALLOCATE( tmask(jpi,jpj,jpk), umask(jpi,jpj,jpk),     &  
     303         &      vmask(jpi,jpj,jpk), fmask(jpi,jpj,jpk), STAT=ierr(10) ) 
    315304 
    316305#if defined key_noslip_accurate 
    317     ALLOCATE(npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), & 
    318              Stat=ierr(11)) 
    319 #endif 
    320  
    321     dom_oce_alloc = MAXVAL(ierr) 
    322  
    323   END FUNCTION dom_oce_alloc 
    324  
    325    !!---------------------------------------------------------------------- 
    326    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    327    !! $Id$  
    328    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     306      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) ) 
     307#endif 
     308      ! 
     309      dom_oce_alloc = MAXVAL(ierr) 
     310      ! 
     311   END FUNCTION dom_oce_alloc 
     312 
    329313   !!====================================================================== 
    330314END MODULE dom_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r2590 r2618  
    2727   PUBLIC   dom_vvl_alloc ! called by nemogcm.F90 
    2828 
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) ::   ee_t, ee_u, ee_v, ee_f   !: ??? 
    30    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut, muu, muv, muf       !: ???  
    31  
    32    REAL(wp),         ALLOCATABLE, SAVE,     DIMENSION(:) ::   r2dt   ! vertical profile time-step, = 2 rdttra  
    33       !                                 ! except at nit000 (=rdttra) if neuler=0 
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   ee_t, ee_u, ee_v, ee_f   !: ??? 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut , muu , muv , muf    !: ???  
     31 
     32   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:)    ::   r2dt   ! vertical profile time-step, = 2 rdttra  
     33      !                                                              ! except at nit000 (=rdttra) if neuler=0 
    3434 
    3535   !! * Substitutions 
    … …  
    3737#  include "vectopt_loop_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     39   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    4040   !! $Id$ 
    41    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    42    !!---------------------------------------------------------------------- 
    43  
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     42   !!---------------------------------------------------------------------- 
    4443CONTAINS        
    4544 
    46    FUNCTION dom_vvl_alloc() 
     45   INTEGER FUNCTION dom_vvl_alloc() 
    4746      !!---------------------------------------------------------------------- 
    4847      !!                ***  ROUTINE dom_vvl_alloc  *** 
    4948      !!---------------------------------------------------------------------- 
    50       IMPLICIT none 
    51       INTEGER :: dom_vvl_alloc 
    52       !!---------------------------------------------------------------------- 
    53  
    54       ALLOCATE(mut(jpi,jpj,jpk), muu(jpi,jpj,jpk), muv(jpi,jpj,jpk),       & 
    55                muf(jpi,jpj,jpk),                                           & 
    56                ee_t(jpi,jpj), ee_u(jpi,jpj), ee_v(jpi,jpj), ee_f(jpi,jpj), & 
    57                r2dt(jpk), Stat=dom_vvl_alloc) 
    58  
    59       IF(dom_vvl_alloc /= 0)THEN 
    60          CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
    61       END IF 
    62  
     49      ! 
     50      ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,    & 
     51         &      ee_t(jpi,jpj)     , ee_u(jpi,jpj)     , ee_v(jpi,jpj)     , ee_f(jpi,jpj)     ,    & 
     52         &      r2dt(jpk)                                                                     , STAT=dom_vvl_alloc) 
     53         ! 
     54      IF( lk_mpp             )   CALL mpp_sum ( dom_vvl_alloc ) 
     55      IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
     56      ! 
    6357   END FUNCTION dom_vvl_alloc 
    6458 
    … …  
    7165      !!               ssh over the whole water column (scale factors) 
    7266      !!---------------------------------------------------------------------- 
    73       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    74       USE wrk_nemo, ONLY: zs_t   => wrk_2d_1, zs_u_1 => wrk_2d_2, & 
    75                           zs_v_1 => wrk_2d_3 
     67      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     68      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1, zs_u_1 => wrk_2d_2 
     69      USE wrk_nemo, ONLY:   zs_v_1 => wrk_2d_3 
    7670      !! 
    7771      INTEGER  ::   ji, jj, jk 
    78       REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! temporary scalars 
    79       REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !     -        - 
     72      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! local scalars 
     73      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !   -      - 
    8074      !!---------------------------------------------------------------------- 
    8175 
    8276      IF(.not. wrk_use(2, 1,2,3))THEN 
    83          CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.') 
    84          RETURN 
     77         CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.')   ;   RETURN 
    8578      END IF 
    8679 
    87       IF(lwp)   THEN 
     80      IF(lwp) THEN 
    8881         WRITE(numout,*) 
    89          WRITE(numout,*) 'dom_vvl : Variable volume activated' 
     82         WRITE(numout,*) 'dom_vvl : Variable volume initialization' 
    9083         WRITE(numout,*) '~~~~~~~~  compute coef. used to spread ssh over each layers' 
    9184      ENDIF 
    92  
     85       
     86      IF( dom_vvl_alloc /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl : unable to allocate arrays' ) 
    9387 
    9488      fsdept(:,:,:) = gdept (:,:,:) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r2590 r2618  
    22   !!====================================================================== 
    33   !!                       ***  MODULE domwri  *** 
    4    !! Ocean initialization : write the ocean domain mesh ask file(s) 
     4   !! Ocean initialization : write the ocean domain mesh file(s) 
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1997-02  (G. Madec)  Original code 
    77   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL 
    88   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file 
     9   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq  
     10   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation 
    911   !!---------------------------------------------------------------------- 
    1012 
    1113   !!---------------------------------------------------------------------- 
    1214   !!   dom_wri        : create and write mesh and mask file(s) 
    13    !!                    nmsh = 1  :   mesh_mask file 
    14    !!                         = 2  :   mesh and mask file 
    15    !!                         = 3  :   mesh_hgr, mesh_zgr and mask 
     15   !!   dom_uniq       : 
    1616   !!---------------------------------------------------------------------- 
    1717   USE dom_oce         ! ocean space and time domain 
    … …  
    2525 
    2626   PUBLIC dom_wri        ! routine called by inidom.F90 
    27    PUBLIC dom_wri_alloc  ! routine called by nemogcm.F90 
    28  
    29    LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  lldbl  ! Used in dom_uniq to store whether each point is unique or not 
    3027 
    3128   !! * Substitutions 
    … …  
    3734   !!---------------------------------------------------------------------- 
    3835CONTAINS 
    39  
    40    FUNCTION dom_wri_alloc() 
    41       !!---------------------------------------------------------------------- 
    42       !!                  ***  ROUTINE dom_wri_alloc  *** 
    43       !!---------------------------------------------------------------------- 
    44       INTEGER :: dom_wri_alloc 
    45       !!---------------------------------------------------------------------- 
    46  
    47       ALLOCATE(lldbl(jpi,jpj,1), Stat = dom_wri_alloc) 
    48  
    49    END FUNCTION dom_wri_alloc 
    50  
    5136 
    5237   SUBROUTINE dom_wri 
    … …  
    144129      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 
    145130       
    146       CALL dom_uniq(zprw, 'T') 
     131      CALL dom_uniq( zprw, 'T' ) 
    147132      zprt = tmask(:,:,1) * zprw                               !    ! unique point mask 
    148133      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )   
    149       CALL dom_uniq(zprw, 'U') 
     134      CALL dom_uniq( zprw, 'U' ) 
    150135      zprt = umask(:,:,1) * zprw 
    151136      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
    152       CALL dom_uniq(zprw, 'V') 
     137      CALL dom_uniq( zprw, 'V' ) 
    153138      zprt = vmask(:,:,1) * zprw 
    154139      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
    155       CALL dom_uniq(zprw, 'F') 
     140      CALL dom_uniq( zprw, 'F' ) 
    156141      zprt = fmask(:,:,1) * zprw 
    157142      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )   
    … …  
    283268 
    284269 
    285    SUBROUTINE dom_uniq(puniq, cdgrd ) 
     270   SUBROUTINE dom_uniq( puniq, cdgrd ) 
    286271      !!---------------------------------------------------------------------- 
    287272      !!                  ***  ROUTINE dom_uniq  *** 
    … …  
    296281      USE wrk_nemo, ONLY: ztstref => wrk_2d_1      ! array with different values for each element 
    297282     !! 
    298       CHARACTER(len=1)            , INTENT(in   ) ::  cdgrd   !  
    299       REAL(wp), DIMENSION(:,:)    , INTENT(inout) ::  puniq   !  
    300       ! 
    301       REAL(wp)                       ::  zshift    ! shift value link to the process number 
    302       INTEGER                        ::  ji        ! dummy loop indices 
    303       !!---------------------------------------------------------------------- 
    304  
    305       IF(.not. wrk_use(2, 1))THEN 
    306          CALL ctl_stop('dom_uniq: ERROR - requested workspace array unavailable.') 
    307          RETURN 
     283      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
     284      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
     285      ! 
     286      REAL(wp) ::  zshift   ! shift value link to the process number 
     287      INTEGER  ::  ji       ! dummy loop indices 
     288      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
     289      !!---------------------------------------------------------------------- 
     290 
     291      IF( .not. wrk_use(2, 1) ) THEN 
     292         CALL ctl_stop('dom_uniq: ERROR - requested workspace array unavailable.')   ;   RETURN 
    308293      END IF 
    309294 
Note: See TracChangeset for help on using the changeset viewer.