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 2590 – NEMO

Changeset 2590


Ignore:
Timestamp:
2011-02-18T13:49:27+01:00 (14 years ago)
Author:
trackstand2
Message:

Merge branch 'dynamic_memory' into master-svn-dyn

Location:
branches/dev_r2586_dynamic_mem
Files:
3 added
138 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90

    r2528 r2590  
    2020   PRIVATE 
    2121 
     22   ! Routine accessibility 
     23   PUBLIC    dom_ice_alloc_2    ! Called from nemogcm.F90 
     24 
    2225   LOGICAL, PUBLIC ::   l_jeq     = .TRUE.     !: Equator inside the domain flag 
    2326 
     
    2528      !                                        !  (otherwise = jpj+10 (SH) or -10 (SH) ) 
    2629 
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   fs2cor , fcor     !: coriolis factor and coeficient 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   covrai            !: sine of geographic latitude 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   area              !: surface of grid cell  
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tms    , tmu      !: temperature and velocity points masks 
    31    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght              !: weight of the 4 neighbours to compute averages 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   fs2cor , fcor     !: coriolis factor and coeficient 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   covrai            !: sine of geographic latitude 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   area              !: surface of grid cell  
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tms    , tmu      !: temperature and velocity points masks 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   wght              !: weight of the 4 neighbours to compute averages 
    3235 
    3336 
    3437# if defined key_lim2_vp 
    35    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   akappa , bkappa   !: first and third group of metric coefficients 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd            !: second group of metric coefficients 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)     ::   akappa , bkappa   !: first and third group of metric coefficients 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:,:) ::   alambd            !: second group of metric coefficients 
    3740# else 
    38    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmv    , tmf      !: y-velocity and F-points masks 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmi               !: ice mask: =1 if ice thick > 0 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmv    , tmf      !: y-velocity and F-points masks 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmi               !: ice mask: =1 if ice thick > 0 
    4043# endif 
    4144 
     
    4649#endif 
    4750   !!====================================================================== 
     51#if defined key_lim2 
     52   CONTAINS 
     53 
     54     FUNCTION dom_ice_alloc_2() 
     55        USE in_out_manager, ONLY: ctl_warn 
     56        IMPLICIT none 
     57        INTEGER :: dom_ice_alloc_2 
     58        INTEGER :: ierr(2) 
     59 
     60        ierr(:) = 0 
     61 
     62        ALLOCATE(fs2cor(jpi,jpj),  fcor(jpi,jpj),                             & 
     63                 covrai(jpi,jpj),  area(jpi,jpj), tms(jpi,jpj), tmu(jpi,jpj), & 
     64                 wght(jpi,jpj,2,2),  Stat=ierr(1) ) 
     65 
     66        ALLOCATE(                                                             & 
     67#if defined key_lim2_vp  
     68                 akappa(jpi,jpj,2,2), bkappa(jpi,jpj,2,2),                    & 
     69                 alambd(jpi,jpj,2,2,2,2),                                     & 
     70#else 
     71                 tmv(jpi,jpj), tmf(jpi,jpj), tmi(jpi,jpj),                    & 
     72#endif 
     73                 Stat=ierr(2)) 
     74 
     75        dom_ice_alloc_2 = MAXVAL(ierr) 
     76 
     77        IF(dom_ice_alloc_2 /= 0)THEN 
     78           CALL ctl_warn('dom_ice_alloc_2: failed to allocate arrays.') 
     79        END IF 
     80 
     81     END FUNCTION dom_ice_alloc_2 
     82#endif 
     83 
    4884END MODULE dom_ice_2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90

    r2528 r2590  
    1616   PRIVATE 
    1717    
     18   ! Routine accessibility 
     19   PUBLIC    ice_alloc_2  !  Called in nemogcm.F90 
     20 
    1821   INTEGER , PUBLIC ::   numit     !: ice iteration index 
    1922   REAL(wp), PUBLIC ::   rdt_ice   !: ice time step 
     
    5457   REAL(wp), PUBLIC ::   pstarh                !: pstar / 2.0 
    5558 
    56    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
    57    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
    58    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s         !: friction velocity 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ust2s         !: friction velocity 
    5962 
    6063   !!* Ice Rheology 
     
    6366   LOGICAL , PUBLIC ::   lk_lim2_vp = .TRUE.               !: Visco-Plactic reology flag  
    6467   ! 
    65    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnm , hicm   !: mean snow and ice thicknesses 
     68   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hsnm , hicm   !: mean snow and ice thicknesses 
    6669   ! 
    6770# else 
     
    6972   LOGICAL , PUBLIC::   lk_lim2_vp = .FALSE.               !: Visco-Plactic reology flag  
    7073   ! 
    71    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress1_i     !: first stress tensor element        
    72    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress2_i     !: second stress tensor element 
    73    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   stress12_i    !: diagonal stress tensor element 
    74    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   delta_i       !: rheology delta factor (see Flato and Hibler 95) [s-1] 
    75    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   divu_i        !: Divergence of the velocity field [s-1] -> limrhg.F90 
    76    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90 
    77    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   at_i          !: ice fraction 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress1_i     !: first stress tensor element        
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress2_i     !: second stress tensor element 
     76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stress12_i    !: diagonal stress tensor element 
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   delta_i       !: rheology delta factor (see Flato and Hibler 95) [s-1] 
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   divu_i        !: Divergence of the velocity field [s-1] -> limrhg.F90 
     79   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90 
     80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i          !: ice fraction 
    7881   ! 
    7982   REAL(wp), PUBLIC, DIMENSION(:,:)    , POINTER :: vt_s ,vt_i    !: mean snow and ice thicknesses 
    80    REAL(wp), PUBLIC, DIMENSION(jpi,jpj), TARGET  :: hsnm , hicm   !: target vt_s,vt_i pointers  
    81 #endif 
    82  
    83    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvosif       !: ice volume change at ice surface (only used for outputs) 
    84    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvobif       !: ice volume change at ice bottom  (only used for outputs) 
    85    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdvolif       !: Total   ice volume change (only used for outputs) 
    86    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvonif       !: Lateral ice volume change (only used for outputs) 
    87    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature [Kelvin] 
    88    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS 
    89    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicif         !: Ice thickness 
    90    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnif         !: Snow thickness 
    91    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hicifp        !: Ice production/melting 
    92    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   frld          !: Leads fraction = 1-a/totalarea 
    93    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   phicif        !: ice thickness  at previous time  
    94    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pfrld         !: Leads fraction at previous time   
    95    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qstoif        !: Energy stored in the brine pockets 
    96    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fbif          !: Heat flux at the ice base 
    97    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmsnif       !: Variation of snow mass 
    98    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdmicif       !: Variation of ice mass 
    99    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qldif         !: heat balance of the lead (or of the open ocean) 
    100    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qcmif         !: Energy needed to freeze the ocean surface layer 
    101    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdtcn         !: net downward heat flux from the ice to the ocean 
    102    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2) 
    103    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   thcm          !: part of the solar energy used in the lead heat budget 
    104    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fstric        !: Solar flux transmitted trough the ice 
    105    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ffltbif       !: linked with the max heat contained in brine pockets (?) 
    106    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fscmbq        !: Linked with the solar flux below the ice (?) 
    107    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fsbbq         !: Also linked with the solar flux below the ice (?) 
    108    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qfvbq         !: used to store energy in case of toral lateral ablation (?) 
    109    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   dmgwi         !: Variation of the mass of snow ice 
    110    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_ice, v_ice  !: two components of the ice   velocity at I-point (m/s) 
    111    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   u_oce, v_oce  !: two components of the ocean velocity at I-point (m/s) 
    112  
    113    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jplayersp1) ::   tbif  !: Temperature inside the ice/snow layer 
     83   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET  :: hsnm , hicm   !: target vt_s,vt_i pointers  
     84#endif 
     85 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif       !: ice volume change at ice surface (only used for outputs) 
     87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif       !: ice volume change at ice bottom  (only used for outputs) 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif       !: Total   ice volume change (only used for outputs) 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif       !: Lateral ice volume change (only used for outputs) 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist          !: Sea-Ice Surface Temperature [Kelvin] 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicif         !: Ice thickness 
     93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hsnif         !: Snow thickness 
     94   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp        !: Ice production/melting 
     95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frld          !: Leads fraction = 1-a/totalarea 
     96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   phicif        !: ice thickness  at previous time  
     97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   pfrld         !: Leads fraction at previous time   
     98   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qstoif        !: Energy stored in the brine pockets 
     99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fbif          !: Heat flux at the ice base 
     100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmsnif       !: Variation of snow mass 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmicif       !: Variation of ice mass 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qldif         !: heat balance of the lead (or of the open ocean) 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qcmif         !: Energy needed to freeze the ocean surface layer 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdtcn         !: net downward heat flux from the ice to the ocean 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qdtcn         !: energy from the ice to the ocean point (at a factor 2) 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   thcm          !: part of the solar energy used in the lead heat budget 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric        !: Solar flux transmitted trough the ice 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif       !: linked with the max heat contained in brine pockets (?) 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq        !: Linked with the solar flux below the ice (?) 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq         !: Also linked with the solar flux below the ice (?) 
     111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq         !: used to store energy in case of toral lateral ablation (?) 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi         !: Variation of the mass of snow ice 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice  !: two components of the ice   velocity at I-point (m/s) 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_oce, v_oce  !: two components of the ocean velocity at I-point (m/s) 
     115 
     116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tbif  !: Temperature inside the ice/snow layer 
    114117 
    115118   !!* moment used in the advection scheme 
    116    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxice, syice, sxxice, syyice, sxyice   !: for ice  volume 
    117    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume 
    118    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area 
    119    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow 
    120    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer 
    121    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
    122    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxice, syice, sxxice, syyice, sxyice   !: for ice  volume 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxsn,  sysn,  sxxsn,  syysn,  sxysn    !: for snow volume                   
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxa,   sya,   sxxa,   syya,   sxya     !: for ice cover area                
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc0,  syc0,  sxxc0,  syyc0,  sxyc0    !: for heat content of snow          
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc1,  syc1,  sxxc1,  syyc1,  sxyc1    !: for heat content of 1st ice layer 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxc2,  syc2,  sxxc2,  syyc2,  sxyc2    !: for heat content of 2nd ice layer 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sxst,  syst,  sxxst,  syyst,  sxyst    !: for heat content of brine pockets 
    123126 
    124127#else 
     
    133136   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    134137   !!====================================================================== 
     138 
     139#if defined key_lim2 
     140   CONTAINS 
     141 
     142     FUNCTION ice_alloc_2() 
     143        !!----------------------------------------------------------------- 
     144        !!               *** Routine ice_alloc_2 *** 
     145        !!----------------------------------------------------------------- 
     146        USE in_out_manager, ONLY: ctl_warn 
     147        IMPLICIT none 
     148        INTEGER :: ice_alloc_2 
     149        ! Local variables 
     150        INTEGER :: ierr(9) 
     151        !!----------------------------------------------------------------- 
     152 
     153        ierr(:) = 0 
     154 
     155        ! What could be one huge allocate statement is broken-up to try to 
     156        ! stay within Fortran's max-line length limit. 
     157        ALLOCATE(ahiu(jpi,jpj), ahiv(jpi,jpj), & 
     158                 pahu(jpi,jpj), pahv(jpi,jpj), & 
     159                 ust2s(jpi,jpj), Stat=ierr(1)) 
     160 
     161        ALLOCATE(                              & 
     162#if defined key_lim2_vp 
     163                 hsnm(jpi,jpj), hicm(jpi,jpj), & 
     164#else 
     165                 stress1_i(jpi,jpj), stress2_i(jpi,jpj), stress12_i(jpi,jpj), & 
     166                 delta_i(jpi,jpj),   divu_i(jpi,jpj),    shear_i(jpi,jpj),    & 
     167                 at_i(jpi,jpj), hsnm(jpi,jpj), hicm(jpi,jpj),                 & 
     168#endif 
     169                 Stat=ierr(2)) 
     170 
     171        ALLOCATE(rdvosif(jpi,jpj), rdvobif(jpi,jpj),                          & 
     172                 fdvolif(jpi,jpj), rdvonif(jpi,jpj),                          & 
     173                 sist(jpi,jpj),    tfu(jpi,jpj),         hicif(jpi,jpj),      & 
     174                 hsnif(jpi,jpj),   hicifp(jpi,jpj),      frld(jpi,jpj),       & 
     175                 Stat=ierr(3)) 
     176 
     177        ALLOCATE(phicif(jpi,jpj),  pfrld(jpi,jpj),       qstoif(jpi,jpj),     & 
     178                 fbif(jpi,jpj),    rdmsnif(jpi,jpj),     rdmicif(jpi,jpj),    & 
     179                 qldif(jpi,jpj),   qcmif(jpi,jpj),       fdtcn(jpi,jpj),      & 
     180                 qdtcn(jpi,jpj),   thcm(jpi,jpj),        Stat=ierr(4)) 
     181 
     182        ALLOCATE(fstric(jpi,jpj),  ffltbif(jpi,jpj),     fscmbq(jpi,jpj),     & 
     183                 fsbbq(jpi,jpj),   qfvbq(jpi,jpj),       dmgwi(jpi,jpj),      & 
     184                 u_ice(jpi,jpj),   v_ice(jpi,jpj),                            & 
     185                 u_oce(jpi,jpj),   v_oce(jpi,jpj),                            & 
     186                 tbif(jpi,jpj,jplayersp1), Stat=ierr(5)) 
     187 
     188        ALLOCATE(sxice(jpi,jpj),   syice(jpi,jpj),  sxxice(jpi,jpj),          & 
     189                 syyice(jpi,jpj),  sxyice(jpi,jpj),                           & 
     190                 sxsn(jpi,jpj),    sysn(jpi,jpj),  sxxsn(jpi,jpj),            & 
     191                 syysn(jpi,jpj),   sxysn(jpi,jpj), Stat=ierr(6)) 
     192 
     193        ALLOCATE(sxa(jpi,jpj),     sya(jpi,jpj),   sxxa(jpi,jpj),             & 
     194                 syya(jpi,jpj),    sxya(jpi,jpj),                             &  
     195                 sxc0(jpi,jpj),    syc0(jpi,jpj),  sxxc0(jpi,jpj),            & 
     196                 syyc0(jpi,jpj),   sxyc0(jpi,jpj), Stat=ierr(7)) 
     197 
     198        ALLOCATE(sxc1(jpi,jpj),    syc1(jpi,jpj),  sxxc1(jpi,jpj),            & 
     199                 syyc1(jpi,jpj),   sxyc1(jpi,jpj),                            & 
     200                 sxc2(jpi,jpj),    syc2(jpi,jpj),  sxxc2(jpi,jpj),            & 
     201                 syyc2(jpi,jpj),   sxyc2(jpi,jpj), Stat=ierr(8)) 
     202 
     203        ALLOCATE(sxst(jpi,jpj),    syst(jpi,jpj),  sxxst(jpi,jpj),            & 
     204                 syyst(jpi,jpj),   sxyst(jpi,jpj), Stat=ierr(9)) 
     205 
     206        ice_alloc_2 = MAXVAL(ierr) 
     207 
     208        IF(ice_alloc_2 /= 0)THEN 
     209           CALL ctl_warn('ice_alloc_2: failed to allocate arrays.') 
     210        END IF 
     211 
     212     END FUNCTION ice_alloc_2 
     213 
     214#endif 
     215 
    135216END MODULE ice_2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90

    r2528 r2590  
    5858      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681. 
    5959      !!-------------------------------------------------------------------- 
     60      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     61      USE wrk_nemo, ONLY: zf0 => wrk_2d_11, zfx => wrk_2d_12, zfy => wrk_2d_13 
     62      USE wrk_nemo, ONLY: zbet => wrk_2d_14, zfm => wrk_2d_15, zfxx => wrk_2d_16 
     63      USE wrk_nemo, ONLY: zfyy => wrk_2d_17, zfxy => wrk_2d_18, zalg => wrk_2d_19 
     64      USE wrk_nemo, ONLY: zalg1 => wrk_2d_20, zalg1q => wrk_2d_21 
     65      !! 
    6066      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    6167      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) 
     
    7076      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    7177      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    72       REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace 
    73       REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      - 
    74       REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      - 
    7578      !--------------------------------------------------------------------- 
     79 
     80      IF(.NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 
     81         CALL ctl_stop('lim_adv_x_2 : requested workspace arrays unavailable.') 
     82         RETURN 
     83      END IF 
    7684 
    7785      ! Limitation of moments.                                            
     
    218226      ENDIF 
    219227      ! 
     228      IF(.NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 
     229         CALL ctl_stop('lim_adv_x_2 : failed to release workspace arrays.') 
     230      END IF 
     231      ! 
    220232   END SUBROUTINE lim_adv_x_2 
    221233 
     
    235247      !! Reference:  Prather, 1986, JGR, 91, D6. 6671-6681. 
    236248      !!--------------------------------------------------------------------- 
     249      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     250      USE wrk_nemo, ONLY: zf0 => wrk_2d_11, zfx => wrk_2d_12, zfy => wrk_2d_13 
     251      USE wrk_nemo, ONLY: zbet => wrk_2d_14, zfm => wrk_2d_15, zfxx => wrk_2d_16 
     252      USE wrk_nemo, ONLY: zfyy => wrk_2d_17, zfxy => wrk_2d_18, zalg => wrk_2d_19 
     253      USE wrk_nemo, ONLY: zalg1 => wrk_2d_20, zalg1q => wrk_2d_21 
     254      !! 
    237255      REAL(wp)                    , INTENT(in   ) ::   pdf                ! reduction factor for the time step 
    238256      REAL(wp)                    , INTENT(in   ) ::   pcrh               ! call lim_adv_x then lim_adv_y (=1) or the opposite (=0) 
     
    247265      REAL(wp) ::   zs1new, zalf , zalfq , zbt           !    -         - 
    248266      REAL(wp) ::   zs2new, zalf1, zalf1q, zbt1          !    -         - 
    249       REAL(wp), DIMENSION(jpi,jpj) ::   zf0, zfx , zfy , zbet   ! 2D workspace 
    250       REAL(wp), DIMENSION(jpi,jpj) ::   zfm, zfxx, zfyy, zfxy   !  -      - 
    251       REAL(wp), DIMENSION(jpi,jpj) ::   zalg, zalg1, zalg1q     !  -      - 
    252267      !--------------------------------------------------------------------- 
     268 
     269      IF(.NOT. wrk_use(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 
     270         CALL ctl_stop('lim_adv_y_2 : requested workspace arrays unavailable.') 
     271         RETURN 
     272      END IF 
    253273 
    254274      ! Limitation of moments. 
     
    398418      ENDIF 
    399419      ! 
     420      IF(.NOT. wrk_release(2, 11,12,13,14,15,16,17,18,19,20,21))THEN 
     421        CALL ctl_stop('lim_adv_y_2 : failed to release workspace arrays.') 
     422      END IF 
     423      ! 
    400424   END SUBROUTINE lim_adv_y_2 
    401425 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90

    r2528 r2590  
    2929 
    3030   PUBLIC               lim_dia_2          ! called by sbc_ice_lim_2 
     31   PUBLIC               lim_dia_alloc_2    ! called by nemogcm 
     32 
    3133   INTEGER, PUBLIC ::   ntmoy   = 1 ,   &  !: instantaneous values of ice evolution or averaging ntmoy 
    3234      &                 ninfo   = 1        !: frequency of ouputs on file ice_evolu in case of averaging 
     
    5254   REAL(wp)                     ::   epsi06 = 1.e-06      ! ??? 
    5355   REAL(wp), DIMENSION(jpinfmx) ::   vinfom               ! temporary working space 
    54    REAL(wp), DIMENSION(jpi,jpj) ::   aire                 ! masked grid cell area 
     56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   aire                 ! masked grid cell area 
    5557 
    5658   !! * Substitutions 
     
    6365 
    6466CONTAINS 
     67 
     68   FUNCTION lim_dia_alloc_2() 
     69      !!-------------------------------------------------------------------- 
     70      !!                  ***  ROUTINE lim_dia_2  *** 
     71      !!-------------------------------------------------------------------- 
     72      IMPLICIT none 
     73      INTEGER :: lim_dia_alloc_2 
     74      !!-------------------------------------------------------------------- 
     75 
     76      ALLOCATE(aire(jpi,jpj), Stat=lim_dia_alloc_2) 
     77 
     78      IF(lim_dia_alloc_2 /= 0)THEN 
     79         CALL ctl_warn('lim_dia_alloc_2: failed to allocate array aire.') 
     80      END IF 
     81 
     82   END FUNCTION lim_dia_alloc_2 
     83 
    6584 
    6685   SUBROUTINE lim_dia_2( kt ) 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90

    r2528 r2590  
    5858      !!              - treatment of the case if no ice dynamic 
    5959      !!--------------------------------------------------------------------- 
     60      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     61      USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2 
     62      USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2  ! ice-ocean velocity 
    6063      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    6164      !! 
     
    6366      INTEGER  ::   i_j1, i_jpj        ! Starting/ending j-indices for rheology 
    6467      REAL(wp) ::   zcoef              ! temporary scalar 
    65       REAL(wp), DIMENSION(jpj)     ::   zind           ! i-averaged indicator of sea-ice 
    66       REAL(wp), DIMENSION(jpj)     ::   zmsk           ! i-averaged of tmask 
    67       REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io   ! ice-ocean velocity 
     68      REAL(wp), POINTER, DIMENSION(:)     ::   zind     ! i-averaged indicator of sea-ice 
     69      REAL(wp), POINTER, DIMENSION(:)     ::   zmsk     ! i-averaged of tmask 
    6870      !!--------------------------------------------------------------------- 
     71 
     72      IF( (.NOT. wrk_use(1, 1,2)) .OR. (.NOT. wrk_use(2, 1,2)) )THEN 
     73         CALL ctl_stop('lim_dyn_2 : requested workspace arrays unavailable.') 
     74         RETURN 
     75      END IF 
     76      ! Set-up pointers to sub-arrays of workspaces 
     77      zind => wrk_1d_1(1:jpj) 
     78      zmsk => wrk_1d_2(1:jpj) 
    6979 
    7080      IF( kt == nit000 )   CALL lim_dyn_init_2   ! Initialization (first time-step only) 
     
    200210      ! 
    201211      IF(ln_ctl)   CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn  : ust2s :') 
     212      ! 
     213      IF( (.NOT. wrk_release(1, 1,2)) .OR. (.NOT. wrk_release(2, 1,2)) )THEN 
     214         CALL ctl_stop('lim_dyn_2 : failed to release workspace arrays.') 
     215      END IF 
    202216      ! 
    203217   END SUBROUTINE lim_dyn_2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90

    r2528 r2590  
    2222 
    2323   !! * Routine accessibility 
    24    PUBLIC lim_hdf_2    ! called by lim_tra_2 
     24   PUBLIC lim_hdf_2    ! called by    lim_tra_2 
     25   PUBLIC lim_hdf_alloc_2 ! called by nemogcm 
    2526 
    2627   !! * Module variables 
    2728   LOGICAL  ::   linit = .TRUE.              ! ??? 
    2829   REAL(wp) ::   epsi04 = 1e-04              ! constant 
    29    REAL(wp), DIMENSION(jpi,jpj) ::   zfact   ! ??? 
     30   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zfact   ! ??? 
    3031 
    3132   !! * Substitution  
     
    3839 
    3940CONTAINS 
     41 
     42   FUNCTION lim_hdf_alloc_2() 
     43      !!------------------------------------------------------------------- 
     44      !!                  ***  ROUTINE lim_hdf_alloc_2  *** 
     45      !!------------------------------------------------------------------- 
     46      IMPLICIT none 
     47      INTEGER :: lim_hdf_alloc_2 
     48      !!------------------------------------------------------------------- 
     49 
     50      ALLOCATE(zfact(jpi,jpj), Stat=lim_hdf_alloc_2) 
     51 
     52      IF(lim_hdf_alloc_2 /= 0)THEN 
     53         CALL ctl_warn('lim_hdf_alloc_2: failed to allocate zfact array.') 
     54      END IF 
     55 
     56   END FUNCTION lim_hdf_alloc_2 
     57 
    4058 
    4159   SUBROUTINE lim_hdf_2( ptab ) 
     
    5674      !!        !  02-08 (C. Ethe)  F90, free form 
    5775      !!------------------------------------------------------------------- 
     76      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     77      USE wrk_nemo, ONLY: zrlx  => wrk_2d_11, zflu  => wrk_2d_12 
     78      USE wrk_nemo, ONLY: zflv  => wrk_2d_13, ptab0 => wrk_2d_14 
     79      USE wrk_nemo, ONLY: zdiv0 => wrk_2d_15, zdiv  => wrk_2d_16 
     80      !! 
    5881      ! * Arguments 
    5982      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   & 
    6083         ptab                 ! Field on which the diffusion is applied   
    61       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    62          ptab0                ! ??? 
    6384 
    6485      ! * Local variables 
     
    6990      REAL(wp) ::  & 
    7091         zalfa, zrlxint, zconv, zeps   ! temporary scalars 
    71       REAL(wp), DIMENSION(jpi,jpj) ::  &  
    72          zrlx, zflu, zflv, &  ! temporary workspaces 
    73          zdiv0, zdiv          !    "           " 
    74       !!------------------------------------------------------------------- 
     92      !!------------------------------------------------------------------- 
     93 
     94      IF(.NOT. wrk_use(2, 11,12,13,14,15,16))THEN 
     95         CALL ctl_stop('lim_hdf_2 : requested workspace arrays unavailable.') 
     96         RETURN 
     97      END IF 
    7598 
    7699      ! Initialisation 
     
    170193      ENDIF 
    171194 
     195      IF(.NOT. wrk_release(2, 11,12,13,14,15,16))THEN 
     196         CALL ctl_stop('lim_hdf_2 : failed to release workspace arrays.') 
     197         RETURN 
     198      END IF 
     199 
    172200   END SUBROUTINE lim_hdf_2 
    173201 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90

    r2528 r2590  
    4545      !! ** Refer.  : Deleersnijder et al. Ocean Modelling 100, 7-10  
    4646      !!---------------------------------------------------------------------  
     47      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     48      USE wrk_nemo, ONLY: zd2d1 => wrk_2d_1, zd1d2 => wrk_2d_2 
    4749      INTEGER :: ji, jj      ! dummy loop indices 
    4850      REAL(wp) ::   zusden   ! local scalars 
     
    5153      REAL(wp) ::   zh1p  , zh2p      !   -      - 
    5254      REAL(wp) ::   zd2d1p, zd1d2p    !   -      - 
    53       REAL(wp), DIMENSION(jpi,jpj) ::   zd2d1 , zd1d2   ! 2D workspace 
    5455#endif 
    5556      !!--------------------------------------------------------------------- 
     57 
     58      IF(.NOT. wrk_use(2, 1,2))THEN 
     59         CALL ctl_stop('lim_msh_2 : requested workspace arrays unavailable.') 
     60         RETURN 
     61      END IF 
    5662 
    5763      IF(lwp) THEN 
     
    275281      area(:,:) = e1t(:,:) * e2t(:,:) 
    276282      ! 
     283      IF(.NOT. wrk_release(2, 1,2))THEN 
     284         CALL ctl_stop('lim_msh_2 : failed to release workspace arrays.') 
     285      END IF 
     286      ! 
    277287   END SUBROUTINE lim_msh_2 
    278288 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90

    r2528 r2590  
    3333   PRIVATE 
    3434 
    35    PUBLIC   lim_rhg_2 ! routine called by lim_dyn 
     35   PUBLIC   lim_rhg_2         ! routine called by lim_dyn 
     36   PUBLIC   lim_rhg_alloc_2   ! routine called by lim_dyn_alloc_2 
    3637 
    3738   REAL(wp) ::   rzero   = 0._wp   ! constant value: zero 
    3839   REAL(wp) ::   rone    = 1._wp   !            and  one 
     40 
     41   ! 2D workspaces for lim_rhg_2. Can't use wrk_nemo module for them because 
     42   ! extent in 2nd dimension is > jpj. 
     43   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zu0, zv0 
     44   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zu_n, zv_n 
     45   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zu_a, zv_a 
     46   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zviszeta, zviseta 
     47   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zzfrld, zztms 
     48   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   zi1, zi2, zmasst, zpresh 
    3949 
    4050   !! * Substitutions 
     
    4656   !!---------------------------------------------------------------------- 
    4757CONTAINS 
     58 
     59   FUNCTION lim_rhg_alloc_2() 
     60      !!------------------------------------------------------------------- 
     61      !!               ***  FUNCTION lim_rhg_alloc_2  *** 
     62      !!------------------------------------------------------------------- 
     63      INTEGER :: lim_rhg_alloc_2 
     64      !!------------------------------------------------------------------- 
     65 
     66      ALLOCATE(zu0(jpi,0:jpj+1),      zv0(jpi,0:jpj+1),     & 
     67               zu_n(jpi,0:jpj+1),     zv_n(jpi,0:jpj+1),    & 
     68               zu_a(jpi,0:jpj+1),     zv_a(jpi,0:jpj+1),    & 
     69               zviszeta(jpi,0:jpj+1), zviseta(jpi,0:jpj+1), & 
     70               zzfrld(jpi,0:jpj+1),   zztms(jpi,0:jpj+1),   & 
     71               zi1(jpi,0:jpj+1),      zi2(jpi,0:jpj+1),     & 
     72               zmasst(jpi,0:jpj+1),   zpresh(jpi,0:jpj+1),  & 
     73               Stat=lim_rhg_alloc_2) 
     74 
     75      IF(lim_rhg_alloc_2 /= 0)THEN 
     76         CALL ctl_warn('lim_rhg_alloc_2 : failed to allocate arrays.') 
     77      END IF 
     78 
     79   END FUNCTION lim_rhg_alloc_2 
     80 
    4881 
    4982   SUBROUTINE lim_rhg_2( k_j1, k_jpj ) 
     
    5992      !!              at I-point 
    6093      !!------------------------------------------------------------------- 
     94      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     95      USE wrk_nemo, ONLY: zfrld => wrk_2d_1, zmass => wrk_2d_2, zcorl => wrk_2d_3 
     96      USE wrk_nemo, ONLY: za1ct => wrk_2d_4, za2ct => wrk_2d_5, zresr => wrk_2d_6 
     97      USE wrk_nemo, ONLY: zc1u  => wrk_2d_7, zc1v  => wrk_2d_8, zc2u => wrk_2d_9 
     98      USE wrk_nemo, ONLY: zc2v  => wrk_2d_10, zsang => wrk_2d_11 
     99      !! 
    61100      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation 
    62101      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation 
     
    79118      REAL(wp) ::   zs21_11, zs21_12, zs21_21, zs21_22 
    80119      REAL(wp) ::   zs22_11, zs22_12, zs22_21, zs22_22 
    81       REAL(wp), DIMENSION(jpi,  jpj  ) ::   zfrld, zmass, zcorl 
    82       REAL(wp), DIMENSION(jpi,  jpj  ) ::   za1ct, za2ct, zresr 
    83       REAL(wp), DIMENSION(jpi,  jpj  ) ::   zc1u, zc1v, zc2u, zc2v 
    84       REAL(wp), DIMENSION(jpi,  jpj  ) ::   zsang 
    85       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu0, zv0 
    86       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_n, zv_n 
    87       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zu_a, zv_a 
    88       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zviszeta, zviseta 
    89       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zzfrld, zztms 
    90       REAL(wp), DIMENSION(jpi,0:jpj+1) ::   zi1, zi2, zmasst, zpresh 
    91120      !!------------------------------------------------------------------- 
    92121       
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r2566 r2590  
    3636   PRIVATE 
    3737 
    38    PUBLIC   lim_sbc_flx_2   ! called by sbc_ice_lim_2 
    39    PUBLIC   lim_sbc_tau_2   ! called by sbc_ice_lim_2 
     38   PUBLIC   lim_sbc_flx_2     ! called by sbc_ice_lim_2 
     39   PUBLIC   lim_sbc_tau_2     ! called by sbc_ice_lim_2 
     40   PUBLIC   lim_sbc_alloc_2   ! called by nemogcm.F90 
    4041 
    4142   REAL(wp)  ::   r1_rdtice            ! = 1. / rdt_ice  
     
    4445   REAL(wp)  ::   rone   = 1._wp       !     -      - 
    4546   ! 
    46    REAL(wp), DIMENSION(jpi,jpj) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case 
    47  
    48    REAL(wp), DIMENSION(jpi,jpj) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2] 
    49    REAL(wp), DIMENSION(jpi,jpj) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s] 
     47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   soce_0, sice_0   ! constant SSS and ice salinity used in levitating sea-ice case 
     48 
     49   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_oce, vtau_oce   ! air-ocean surface i- & j-stress              [N/m2] 
     50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmod_io              ! modulus of the ice-ocean relative velocity   [m/s] 
    5051 
    5152   !! * Substitutions 
     
    5758   !!---------------------------------------------------------------------- 
    5859CONTAINS 
     60 
     61   FUNCTION lim_sbc_alloc_2() 
     62      !!------------------------------------------------------------------- 
     63      !!             ***  ROUTINE lim_sbc_alloc_2 *** 
     64      !!------------------------------------------------------------------- 
     65      IMPLICIT none 
     66      INTEGER :: lim_sbc_alloc_2 
     67      !!------------------------------------------------------------------- 
     68 
     69      ALLOCATE(soce_0(jpi,jpj),   sice_0(jpi,jpj),   & 
     70               utau_oce(jpi,jpj), vtau_oce(jpi,jpj), & 
     71               tmod_io(jpi,jpj),                     & 
     72               Stat=lim_sbc_alloc_2) 
     73 
     74      IF(lim_sbc_alloc_2 /= 0)THEN 
     75         CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.') 
     76      END IF 
     77 
     78   END FUNCTION lim_sbc_alloc_2 
     79 
    5980 
    6081   SUBROUTINE lim_sbc_flx_2( kt ) 
     
    82103      !!              Tartinville et al. 2001 Ocean Modelling, 3, 95-108. 
    83104      !!--------------------------------------------------------------------- 
     105      USE wrk_nemo, ONLY: wrk_release, wrk_use 
     106      USE wrk_nemo, ONLY: zqnsoce => wrk_2d_1 ! 2D workspace 
     107      USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5 
    84108      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    85109      !! 
     
    90114      REAL(wp) ::   zqsr, zqns, zfm            ! local scalars 
    91115      REAL(wp) ::   zinda, zfons, zemp         !   -      - 
    92       REAL(wp), DIMENSION(jpi,jpj)   ::   zqnsoce       ! 2D workspace 
    93       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb, zalbp   ! 2D/3D workspace 
     116      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace 
    94117      !!--------------------------------------------------------------------- 
    95118      
     119      IF( (.NOT. wrk_use(2, 1)) .OR. (.NOT. wrk_use(3, 4,5)) )THEN 
     120         CALL ctl_stop('lim_sbc_flx_2 : requested workspace arrays unavailable.') 
     121         RETURN 
     122      END IF 
     123      ! Set-up pointers to sub-arrays of 3d workspaces 
     124      zalb  => wrk_3d_4(:,:,1:1) 
     125      zalbp => wrk_3d_5(:,:,1:1) 
     126 
    96127      IF( kt == nit000 ) THEN 
    97128         IF(lwp) WRITE(numout,*) 
     
    150181!!$!                -> ice aera increases  ???         -> ice aera decreases ??? 
    151182!!$ 
    152 !!$            iadv    = ( 1  - i1mfr ) * zinda   
     183!!$            iadv    = ( 1  - i1mfr ) * zinda 
    153184!!$!                     pure ocean      ice at 
    154185!!$!                     at current      previous 
     
    159190!!$!                            current          
    160191!!$!                         -> ??? 
    161 !!$  
    162 !!$            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv  
    163 !!$!                                                    ice disapear                            
     192!!$ 
     193!!$            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
     194!!$!                                                    ice disapear 
    164195!!$ 
    165196!!$ 
     
    244275         CALL prt_ctl(tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice  : ') 
    245276      ENDIF  
     277      ! 
     278      IF( (.NOT. wrk_release(2, 1)) .OR. (.NOT. wrk_release(3, 4,5)) )THEN 
     279         CALL ctl_stop('lim_sbc_flx_2 : failed to release workspace arrays.') 
     280      END IF 
    246281      ! 
    247282   END SUBROUTINE lim_sbc_flx_2 
     
    274309      !!              - taum       : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes 
    275310      !!--------------------------------------------------------------------- 
     311      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     312      USE wrk_nemo, ONLY: ztio_u => wrk_2d_1, ztio_v => wrk_2d_2     ! ocean stress below sea-ice 
    276313      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index 
    277314      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents 
     
    281318      REAL(wp) ::   zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi   !   -      - 
    282319      REAL(wp) ::   zsang, zumt                                   !    -         - 
    283       REAL(wp), DIMENSION(jpi,jpj) ::   ztio_u, ztio_v   ! ocean stress below sea-ice 
    284320      !!--------------------------------------------------------------------- 
     321      ! 
     322      IF(.NOT. wrk_use(2, 1,2))THEN 
     323         CALL ctl_stop('lim_sbc_tau_2 : requested workspace arrays unavailable.') 
     324         RETURN 
     325      END IF 
    285326      ! 
    286327      IF( kt == nit000 .AND. lwp ) THEN         ! control print 
     
    405446         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask ) 
    406447      !   
     448      IF(.NOT. wrk_release(2, 1,2))THEN 
     449         CALL ctl_stop('lim_sbc_tau_2 : failed to release workspace arrays.') 
     450      END IF 
     451 
    407452   END SUBROUTINE lim_sbc_tau_2 
    408453 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90

    r2528 r2590  
    7575      !! References :   Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90 
    7676      !!--------------------------------------------------------------------- 
     77      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     78      USE wrk_nemo, ONLY: ztmp    => wrk_2d_1, & ! 2D workspace 
     79                          zqlbsbq => wrk_2d_2, & ! link with lead energy budget qldif 
     80                          zlicegr => wrk_2d_3    ! link with lateral ice growth  
     81      USE wrk_nemo, ONLY: zmsk => wrk_3d_4       ! 3D workspace 
     82      USE wrk_nemo, ONLY: zdvosif => wrk_2d_4, & !: Variation of volume at surface 
     83                          zdvobif => wrk_2d_5, & !: Variation of ice volume at the bottom ice     (outputs only) 
     84                          zdvolif => wrk_2d_6, & !: Total variation of ice volume                 (outputs only) 
     85                          zdvonif => wrk_2d_7, & !: Surface accretion Snow to Ice transformation  (outputs only) 
     86                          zdvomif => wrk_2d_8, & !: Bottom variation of ice volume due to melting (outputs only) 
     87                          zu_imasstr =>wrk_2d_9, & !: Sea-ice transport along i-axis at U-point     (outputs only)  
     88                          zv_imasstr =>wrk_2d_10   !: Sea-ice transport along j-axis at V-point     (outputs only)  
     89      !! 
    7790      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    7891      !! 
     
    91104      REAL(wp) ::   zfontn               ! heat flux from snow thickness 
    92105      REAL(wp) ::   zfntlat, zpareff     ! test. the val. of lead heat budget 
    93       REAL(wp), DIMENSION(jpi,jpj)     ::   ztmp      ! 2D workspace 
    94       REAL(wp), DIMENSION(jpi,jpj)     ::   zqlbsbq   ! link with lead energy budget qldif 
     106 
    95107      REAL(wp) ::   zuice_m, zvice_m     ! Sea-ice velocities at U & V-points 
    96108      REAL(wp) ::   zhice_u, zhice_v     ! Sea-ice volume at U & V-points 
     
    98110      REAL(wp) ::   zrhoij, zrhoijm1     ! temporary scalars 
    99111      REAL(wp) ::   zztmp                ! temporary scalars within a loop 
    100       REAL(wp), DIMENSION(jpi,jpj)     ::   zlicegr   ! link with lateral ice growth  
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmsk      ! 3D workspace 
    102112!!$      REAL(wp), DIMENSION(jpi,jpj) ::   firic         !: IR flux over the ice            (outputs only) 
    103113!!$      REAL(wp), DIMENSION(jpi,jpj) ::   fcsic         !: Sensible heat flux over the ice (outputs only) 
    104114!!$      REAL(wp), DIMENSION(jpi,jpj) ::   fleic         !: Latent heat flux over the ice   (outputs only) 
    105115!!$      REAL(wp), DIMENSION(jpi,jpj) ::   qlatic        !: latent flux                     (outputs only) 
    106       REAL(wp), DIMENSION(jpi,jpj) ::   zdvosif       !: Variation of volume at surface                (outputs only) 
    107       REAL(wp), DIMENSION(jpi,jpj) ::   zdvobif       !: Variation of ice volume at the bottom ice     (outputs only) 
    108       REAL(wp), DIMENSION(jpi,jpj) ::   zdvolif       !: Total variation of ice volume                 (outputs only) 
    109       REAL(wp), DIMENSION(jpi,jpj) ::   zdvonif       !: Surface accretion Snow to Ice transformation  (outputs only) 
    110       REAL(wp), DIMENSION(jpi,jpj) ::   zdvomif       !: Bottom variation of ice volume due to melting (outputs only) 
    111       REAL(wp), DIMENSION(jpi,jpj) ::   zu_imasstr    !: Sea-ice transport along i-axis at U-point     (outputs only)  
    112       REAL(wp), DIMENSION(jpi,jpj) ::   zv_imasstr    !: Sea-ice transport along j-axis at V-point     (outputs only)  
    113116      !!------------------------------------------------------------------- 
     117 
     118      IF( (.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10)) .OR.  & 
     119          (.NOT. wrk_use(3, 4))   ) THEN 
     120         CALL ctl_stop('lim_thd_2 : requested workspace arrays unavailable') 
     121         RETURN 
     122      END IF 
    114123 
    115124      IF( kt == nit000 )   CALL lim_thd_init_2  ! Initialization (first time-step only) 
     
    512521      ENDIF 
    513522       ! 
     523      IF( (.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10)) .OR.  & 
     524          (.NOT. wrk_release(3, 4))   ) THEN 
     525         CALL ctl_stop('lim_thd_2 : failed to release workspace arrays') 
     526      END IF 
     527      ! 
    514528    END SUBROUTINE lim_thd_2 
    515529 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90

    r2528 r2590  
    6868      !!   2.0  !  02-08 (C. Ethe, G. Madec)  F90, mpp 
    6969      !!------------------------------------------------------------------- 
     70      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     71      USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2, wrk_1d_3, wrk_1d_4, wrk_1d_5, wrk_1d_6 
     72      USE in_out_manager, ONLY: ctl_stop 
     73      !! 
    7074      !! * Arguments 
    7175      INTEGER , INTENT(IN)::  & 
     
    7983         iiceform       ,   &  !  1 = ice formed   ; 0 = no ice formed 
    8084         ihemis                !  dummy indice 
    81       REAL(wp), DIMENSION(jpij) :: & 
     85      REAL(wp), POINTER, DIMENSION(:) :: & 
    8286         zqbgow           ,  &  !  heat budget of the open water (negative) 
    8387         zfrl_old         ,  &  !  previous sea/ice fraction 
     
    101105         zah, zalpha , zbeta 
    102106      !!---------------------------------------------------------------------       
    103                     
     107                
     108      IF(.NOT. wrk_use(1, 1,2,3,4,5,6))THEN 
     109         CALL ctl_stop('lim_thd_lac_2 : requestead workspace arrays unavailable.') 
     110         RETURN 
     111      END IF 
     112      ! Set-up pointers to sub-arrays of workspace arrays 
     113      zqbgow    => wrk_1d_1(1:jpij) 
     114      zfrl_old  => wrk_1d_2(1:jpij)          
     115      zhice_old => wrk_1d_3(1:jpij)         
     116      zhice0    => wrk_1d_4(1:jpij)         
     117      zfrlmin   => wrk_1d_5(1:jpij)         
     118      zdhicbot  => wrk_1d_6(1:jpij)  
     119       
    104120      !-------------------------------------------------------------- 
    105121      !   Computation of the heat budget of the open water (negative) 
     
    219235      END DO 
    220236       
     237      IF(.NOT. wrk_release(1, 1,2,3,4,5,6))THEN 
     238         CALL ctl_stop('lim_thd_lac_2 : failed to release workspace arrays.') 
     239      END IF 
     240 
    221241   END SUBROUTINE lim_thd_lac_2 
    222242#else 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90

    r2528 r2590  
    6969      !!              Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268   
    7070      !!------------------------------------------------------------------ 
     71      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     72      USE wrk_nemo, ONLY: wrk_1d_1,  wrk_1d_2,  wrk_1d_3,  wrk_1d_4,  wrk_1d_5  
     73      USE wrk_nemo, ONLY: wrk_1d_6,  wrk_1d_7,  wrk_1d_8,  wrk_1d_9,  wrk_1d_10 
     74      USE wrk_nemo, ONLY: wrk_1d_11, wrk_1d_12, wrk_1d_13, wrk_1d_14, wrk_1d_15 
     75      USE wrk_nemo, ONLY: wrk_1d_16, wrk_1d_17, wrk_1d_18, wrk_1d_19, wrk_1d_20 
     76      USE wrk_nemo, ONLY: wrk_1d_21, wrk_1d_22, wrk_1d_23, wrk_1d_24, wrk_1d_25 
     77      USE wrk_nemo, ONLY: wrk_1d_26, wrk_1d_27 
     78      !! 
    7179      INTEGER, INTENT(in) ::   kideb    ! Start point on which the  the computation is applied 
    7280      INTEGER, INTENT(in) ::   kiut     ! End point on which the  the computation is applied 
    7381      !! 
    7482      INTEGER ::   ji       ! dummy loop indices 
    75       REAL(wp), DIMENSION(jpij,2) ::   zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 ) 
    76       REAL(wp), DIMENSION(jpij) ::  & 
     83      REAL(wp), POINTER, DIMENSION(:) ::   zqcmlts        ! energy due to surface melting 
     84      REAL(wp), POINTER, DIMENSION(:) ::   zqcmltb        ! energy due to bottom melting 
     85      REAL(wp), POINTER, DIMENSION(:) ::  & 
    7786         ztsmlt      &    ! snow/ice surface melting temperature 
    7887         ,ztbif      &    ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.  
     
    8897         , zts_old   &    ! previous surface temperature 
    8998         , zidsn , z1midsn , zidsnic ! tempory variables 
    90       REAL(wp), DIMENSION(jpij) ::   & 
     99      REAL(wp), POINTER, DIMENSION(:) ::   & 
    91100          zfnet       &  ! net heat flux at the top surface( incl. conductive heat flux) 
    92101          , zsprecip  &    ! snow accumulation 
     
    160169       !!---------------------------------------------------------------------- 
    161170 
     171       IF(.NOT. wrk_use(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10, & 
     172                           11,12,13,14,15,16,17,18,19,20, & 
     173                           21,22,23,24,25,26,27))THEN 
     174          CALL ctl_stop('lim_thd_zdf_2 : requested workspace arrays unavailable.') 
     175          RETURN 
     176       END IF 
     177 
     178       ztsmlt  => wrk_1d_1(1:jpij) 
     179       ztbif   => wrk_1d_2(1:jpij)   
     180       zksn    => wrk_1d_3(1:jpij)   
     181       zkic    => wrk_1d_4(1:jpij)    
     182       zksndh  => wrk_1d_5(1:jpij)    
     183       zfcsu   => wrk_1d_6(1:jpij)    
     184       zfcsudt => wrk_1d_7(1:jpij)   
     185       zi0     => wrk_1d_8(1:jpij)    
     186       z1mi0   => wrk_1d_9(1:jpij)     
     187       zqmax   => wrk_1d_10(1:jpij)     
     188       zrcpdt  => wrk_1d_11(1:jpij)   
     189       zts_old => wrk_1d_12(1:jpij)   
     190       zidsn   => wrk_1d_13(1:jpij)  
     191       z1midsn => wrk_1d_14(1:jpij)  
     192       zidsnic => wrk_1d_15(1:jpij) 
     193 
     194       zfnet     => wrk_1d_16(1:jpij) 
     195       zsprecip  => wrk_1d_17(1:jpij)   
     196       zhsnw_old => wrk_1d_18(1:jpij)  
     197       zdhictop  => wrk_1d_19(1:jpij)  
     198       zdhicbot  => wrk_1d_20(1:jpij) 
     199       zqsup     => wrk_1d_21(1:jpij)   
     200       zqocea    => wrk_1d_22(1:jpij) 
     201       zfrl_old  => wrk_1d_23(1:jpij)  
     202       zfrld_1d  => wrk_1d_24(1:jpij)  
     203       zep       => wrk_1d_25(1:jpij)  
     204 
     205       zqcmlts   => wrk_1d_26(1:jpij) 
     206       zqcmltb   => wrk_1d_27(1:jpij) 
     207 
    162208       !----------------------------------------------------------------------- 
    163209       !  1. Boundaries conditions for snow/ice system internal temperature 
     
    171217          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) ) 
    172218          !--computation of energy due to surface melting 
    173           zqcmlt(ji,1) = ( MAX ( zzero ,  & 
     219          zqcmlts(ji) = ( MAX ( zzero ,  & 
    174220             &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn ) 
    175221          !--computation of energy due to bottom melting 
    176           zqcmlt(ji,2) = ( MAX( zzero , & 
     222          zqcmltb(ji) = ( MAX( zzero , & 
    177223             &                  rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) & 
    178224             &           + MAX( zzero , & 
     
    467513          zhsnw_old(ji) =  h_snow_1d(ji) 
    468514          !--computation of the energy needed to melt snow 
    469           zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlt(ji,1) 
     515          zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlts(ji) 
    470516          !--change in snow thickness due to melt 
    471517          zdhsmlt = - zqsnw_mlt / xlsn 
     
    587633 
    588634          !---treatment of the case of melting/growing 
    589           zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmlt(ji,2) )   & 
    590              &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmlt(ji,2)  ) 
     635          zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmltb(ji) )   & 
     636             &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji)  ) 
    591637          qstbif_1d(ji) =         zibmlt   * qstbif_1d(ji)   & 
    592638             &           + ( 1.0 - zibmlt ) * zqstbif_bot 
     
    762808       END DO 
    763809       !  
     810       IF(.NOT. wrk_release(1, 1,  2, 3, 4, 5, 6, 7, 8, 9,10, & 
     811                               11,12,13,14,15,16,17,18,19,20, & 
     812                               21,22,23,24,25,26,27))THEN 
     813          CALL ctl_stop('lim_thd_zdf_2 : failed to release workspace arrays.') 
     814       END IF 
     815       ! 
    764816    END SUBROUTINE lim_thd_zdf_2 
    765817 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90

    r2528 r2590  
    6363      !! ** action : 
    6464      !!--------------------------------------------------------------------- 
     65      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     66      USE wrk_nemo, ONLY: zui_u  => wrk_2d_1, zvi_v => wrk_2d_2, zsm  => wrk_2d_3 
     67      USE wrk_nemo, ONLY: zs0ice => wrk_2d_4, zs0sn => wrk_2d_5, zs0a => wrk_2d_6 
     68      USE wrk_nemo, ONLY: zs0c0 => wrk_2d_7,  zs0c1 => wrk_2d_8, zs0c2 => wrk_2d_9, & 
     69                          zs0st => wrk_2d_10 
     70      !! 
    6571      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    6672      !! 
     
    7177      REAL(wp) ::   zvbord , zcfl   , zusnit            !   -      - 
    7278      REAL(wp) ::   zrtt   , ztsn   , ztic1 , ztic2     !   -      - 
    73       REAL(wp), DIMENSION(jpi,jpj)  ::   zui_u , zvi_v , zsm             ! 2D workspace 
    74       REAL(wp), DIMENSION(jpi,jpj)  ::   zs0ice, zs0sn , zs0a            !  -      - 
    75       REAL(wp), DIMENSION(jpi,jpj)  ::   zs0c0 , zs0c1 , zs0c2 , zs0st   !  -      - 
    7679      !--------------------------------------------------------------------- 
     80 
     81      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10))THEN 
     82         CALL ctl_stop('lim_trp_2 : requested workspace arrays unavailable.') 
     83         RETURN 
     84      END IF 
    7785 
    7886      IF( kt == nit000  )   CALL lim_trp_init_2      ! Initialization (first time-step only) 
     
    266274      ENDIF 
    267275      ! 
     276      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10))THEN 
     277         CALL ctl_stop('lim_trp_2 : failed to release workspace arrays.') 
     278      END IF 
     279      ! 
    268280   END SUBROUTINE lim_trp_2 
    269281 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90

    r2528 r2590  
    3939#endif 
    4040   PUBLIC   lim_wri_state_2   ! called by dia_wri_state  
     41   PUBLIC   lim_wri_alloc_2   ! called by nemogcm.F90 
    4142 
    4243   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output 
     
    5051 
    5152   INTEGER ::   nice, nhorid, ndim, niter, ndepid       ! ???? 
    52    INTEGER , DIMENSION( jpij ) ::   ndex51              ! ???? 
     53   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51   ! ???? 
    5354 
    5455   REAL(wp)  ::            &  ! constant values 
     
    5758      zone   = 1.e0 
    5859 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zcmo      ! Workspace array for netcdf writer.  
     61 
     62 
    5963   !! * Substitutions 
    6064#   include "vectopt_loop_substitute.h90" 
     
    6670 
    6771CONTAINS 
     72 
     73   FUNCTION lim_wri_alloc_2() 
     74      !!------------------------------------------------------------------- 
     75      !!                  ***   ROUTINE lim_wri_alloc_2  *** 
     76      !!------------------------------------------------------------------- 
     77      IMPLICIT none 
     78      INTEGER :: lim_wri_alloc_2 
     79      !!------------------------------------------------------------------- 
     80 
     81      ALLOCATE(ndex51(jpij), zcmo(jpi,jpj,jpnoumax), Stat=lim_wri_alloc_2) 
     82 
     83      IF(lim_wri_alloc_2 /= 0)THEN 
     84         CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51') 
     85      END IF 
     86 
     87   END FUNCTION lim_wri_alloc_2 
     88 
    6889 
    6990#if ! defined key_iomput 
     
    85106      !!      of a day 
    86107      !!------------------------------------------------------------------- 
     108      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     109      USE wrk_nemo, ONLY: zfield => wrk_2d_1 
     110      !! 
    87111      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    88112      !! 
     
    92116         &          zindh, zinda, zindb, ztmu 
    93117      REAL(wp), DIMENSION(1)                ::   zdept 
    94       REAL(wp), DIMENSION(jpi,jpj)          ::   zfield 
    95       REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo 
    96       !!------------------------------------------------------------------- 
     118      !!------------------------------------------------------------------- 
     119 
     120      IF(.NOT. wrk_use(2, 1))THEN 
     121         CALL ctl_stop('lim_wri_2 : requested workspace array unavailable.') 
     122         RETURN 
     123      END IF 
    97124                                                 !--------------------! 
    98125      IF( kt == nit000 ) THEN                    !   Initialisation   ! 
     
    185212       
    186213      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice )  
     214 
     215      IF(.NOT. wrk_release(2, 1))THEN 
     216         CALL ctl_stop('lim_wri_2 : failed to release workspace array.') 
     217      END IF 
    187218 
    188219   END SUBROUTINE lim_wri_2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90

    r2528 r2590  
    2525         ztmu 
    2626    REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: & 
    27          zcmo 
     27         zcmo !ARPDBGWORK 
    2828    REAL(wp), DIMENSION(jpi,jpj) ::  & 
    2929         zfield 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90

    r2528 r2590  
    1717   IMPLICIT NONE 
    1818   PRIVATE 
     19 
     20   PUBLIC thd_ice_alloc_2 ! Routine called by nemogcm.F90 
    1921 
    2022   !! * Share Module variables 
     
    4345      cnscg                  !: ratio  rcpsn/rcpic 
    4446 
    45    INTEGER , PUBLIC, DIMENSION(jpij) ::   &  !: 
     47   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    4648      npb     ,   &   !: number of points where computations has to be done 
    4749      npac            !: correspondance between the points 
    4850 
    49    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:  
    5052      qldif_1d    ,     &  !: corresponding to the 2D var  qldif 
    5153      qcmif_1d    ,     &  !: corresponding to the 2D var  qcmif 
     
    8082      dqla_ice_1d          !:    "                  "      dqla_ice 
    8183 
    82    REAL(wp), PUBLIC, DIMENSION(jpij,jplayersp1) ::   &  !: 
     84   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    8385      tbif_1d              !: corresponding to the 2D var  tbif 
    8486 
    8587   !!====================================================================== 
     88 CONTAINS 
     89 
     90   FUNCTION thd_ice_alloc_2() 
     91      USE in_out_manager, ONLY: ctl_warn 
     92      IMPLICIT none 
     93      INTEGER :: thd_ice_alloc_2 
     94      ! Local vars 
     95      INTEGER :: ierr(4) 
     96 
     97      ierr(:) = 0 
     98 
     99      ALLOCATE(npb(jpij), npac(jpij),                             & 
     100               qldif_1d(jpij), qcmif_1d(jpij), thcm_1d(jpij),     & 
     101               fstbif_1d(jpij), fltbif_1d(jpij), fscbq_1d(jpij),  & 
     102               qsr_ice_1d(jpij),fr1_i0_1d(jpij), fr2_i0_1d(jpij), Stat=ierr(1)) 
     103 
     104      ALLOCATE(qns_ice_1d(jpij), qfvbq_1d(jpij), sist_1d(jpij), tfu_1d(jpij), & 
     105               sprecip_1d(jpij), h_snow_1d(jpij),h_ice_1d(jpij),frld_1d(jpij),& 
     106               qstbif_1d(jpij),  fbif_1d(jpij),  Stat=ierr(2)) 
     107 
     108      ALLOCATE(rdmicif_1d(jpij), rdmsnif_1d(jpij), qlbbq_1d(jpij),   & 
     109               dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , rdvomif_1d(jpij), & 
     110               dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , & 
     111               Stat=ierr(3)) 
     112 
     113      ALLOCATE(dqns_ice_1d(jpij) ,qla_ice_1d(jpij), dqla_ice_1d(jpij), & 
     114               tbif_1d(jpij, jplayersp1), Stat=ierr(4)) 
     115 
     116      thd_ice_alloc_2 = MAXVAL(ierr) 
     117 
     118      IF(thd_ice_alloc_2 /= 0)THEN 
     119         CALL ctl_warn('thd_ice_alloc_2: failed to allocate arrays.') 
     120      END IF 
     121 
     122   END FUNCTION thd_ice_alloc_2 
     123 
    86124#endif 
    87125END MODULE thd_ice_2 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90

    r2528 r2590  
    1111   PRIVATE 
    1212 
     13   PUBLIC dom_ice_alloc   ! Routine called by nemogcm.F90 
     14 
    1315   LOGICAL, PUBLIC ::   l_jeq = .TRUE.       !: Equator inside the domain flag 
    1416 
    1517   INTEGER, PUBLIC ::   njeq , njeqm1        !: j-index of the equator if it is inside the domain 
    1618 
    17    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fs2cor     !: coriolis factor 
    18    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fcor       !: coriolis coefficient 
    19    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   covrai     !: sine of geographic latitude 
    20    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   area       !: surface of grid cell  
    21    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tms, tmi   !: temperature mask, mask for stress 
    22    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmu, tmv   !: mask at u and v velocity points 
    23    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmf        !: mask at f-point 
     19   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fs2cor     !: coriolis factor 
     20   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient 
     21   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude 
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell  
     23   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress 
     24   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmu, tmv   !: mask at u and v velocity points 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmf        !: mask at f-point 
    2426 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2) ::   wght     !: weight of the 4 neighbours to compute averages 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages 
    2628 
    2729   !!---------------------------------------------------------------------- 
     
    3032   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3133   !!====================================================================== 
     34CONTAINS 
     35 
     36   FUNCTION dom_ice_alloc 
     37      !!------------------------------------------------------------------- 
     38      !!            *** Routine dom_ice_alloc *** 
     39      !!------------------------------------------------------------------- 
     40      INTEGER :: dom_ice_alloc 
     41      !!------------------------------------------------------------------- 
     42 
     43      ALLOCATE(fs2cor(jpi,jpj), fcor(jpi,jpj), & 
     44               covrai(jpi,jpj), area(jpi,jpj), & 
     45               tms(jpi,jpj)   , tmi(jpi,jpj) , & 
     46               tmu(jpi,jpj)   , tmv(jpi,jpj) , & 
     47               tmf(jpi,jpj)   ,                & 
     48               wght(jpi,jpj,2,2), Stat = dom_ice_alloc) 
     49 
     50      IF(dom_ice_alloc /= 0)THEN 
     51         CALL ctl_warn('dom_ice_alloc: failed to allocate arrays.') 
     52      END IF 
     53 
     54   END FUNCTION dom_ice_alloc 
     55 
    3256END MODULE dom_ice 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r2528 r2590  
    2727   USE prtctl           ! Print control 
    2828   USE lib_mpp 
     29   USE wrk_nemo, ONLY: wrk_use, wrk_release 
    2930 
    3031   IMPLICIT NONE 
     
    3940   PUBLIC lim_itd_me_init 
    4041   PUBLIC lim_itd_me_zapsmall 
     42   PUBLIC lim_idt_me_alloc  ! called by nemogcm.F90 
    4143 
    4244   !! * Module variables 
     
    5153   ! Variables shared among ridging subroutines 
    5254   !----------------------------------------------------------------------- 
    53    REAL(wp), DIMENSION (jpi,jpj) ::    & 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:) ::    & 
    5456      asum         , & ! sum of total ice and open water area 
    5557      aksum            ! ratio of area removed to area ridged 
    5658 
    57    REAL(wp), DIMENSION(jpi,jpj,0:jpl) :: &      
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: &      
    5860      athorn           ! participation function; fraction of ridging/ 
    5961   !  closing associated w/ category n 
    6062 
    61    REAL(wp), DIMENSION(jpi,jpj,jpl) ::  & 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  & 
    6264      hrmin      , &   ! minimum ridge thickness 
    6365      hrmax      , &   ! maximum ridge thickness 
     
    7880   !----------------------------------------------------------------------- 
    7981   ! 
    80    REAL (wp), DIMENSION(jpi,jpj) :: & 
     82   REAL (wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 
    8183      dardg1dt     , & ! rate of fractional area loss by ridging ice (1/s) 
    8284      dardg2dt     , & ! rate of fractional area gain by new ridges (1/s) 
     
    9698   !!-----------------------------------------------------------------------------! 
    9799   !!-----------------------------------------------------------------------------! 
     100 
     101   FUNCTION lim_idt_me_alloc() 
     102      !!---------------------------------------------------------------------! 
     103      !!                ***  ROUTINE lim_itd_me_alloc *** 
     104      !!---------------------------------------------------------------------! 
     105      INTEGER :: lim_idt_me_alloc 
     106      !!---------------------------------------------------------------------! 
     107 
     108      ALLOCATE(asum(jpi,jpj), aksum(jpi,jpj), athorn(jpi,jpj,0:jpl), & 
     109               ! 
     110               hrmin(jpi,jpj,jpl),  hrmax(jpi,jpj,jpl)      , & 
     111               hraft(jpi,jpj,jpl),  krdg(jpi,jpj,jpl)       , & 
     112               aridge(jpi,jpj,jpl), araft(jpi,jpj,jpl)      , & 
     113               ! 
     114               dardg1dt(jpi,jpj)  , dardg2dt(jpi,jpj)       , &  
     115               dvirdgdt(jpi,jpj)  , opening(jpi,jpj)        , & 
     116               !  
     117               Stat=lim_idt_me_alloc) 
     118 
     119      IF(lim_idt_me_alloc /= 0)THEN 
     120         CALL ctl_warn('lim_idt_me_alloc: failed to allocate arrays.') 
     121      END IF 
     122 
     123   END FUNCTION lim_idt_me_alloc 
     124 
    98125 
    99126   SUBROUTINE lim_itd_me ! (subroutine 1/6) 
     
    149176      !!  and Elizabeth C. Hunke, LANL are gratefully acknowledged 
    150177      !!--------------------------------------------------------------------! 
     178      USE wrk_nemo, ONLY: & 
     179          closing_net   => wrk_2d_1, &  ! net rate at which area is removed    (1/s) 
     180                                        ! (ridging ice area - area of new ridges) / dt 
     181          divu_adv      => wrk_2d_2, &  ! divu as implied by transport scheme  (1/s) 
     182          opning        => wrk_2d_3, &  ! rate of opening due to divergence/shear 
     183          closing_gross => wrk_2d_4, &  ! rate at which area removed, not counting 
     184                                        ! area of new ridges 
     185          msnow_mlt     => wrk_2d_5, &  ! mass of snow added to ocean (kg m-2) 
     186          esnow_mlt     => wrk_2d_6       ! energy needed to melt snow in ocean (J m-2) 
     187      USE wrk_nemo, ONLY: vt_i_init  => wrk_2d_7, &  !  ice volume summed over  
     188                          vt_i_final => wrk_2d_8     !  categories 
     189 
    151190      !! * Arguments 
    152191 
     
    164203         epsi06    =  1.0e-6 
    165204 
    166       REAL(wp), DIMENSION(jpi,jpj) :: & 
    167          closing_net,        &  ! net rate at which area is removed    (1/s) 
    168                                 ! (ridging ice area - area of new ridges) / dt 
    169          divu_adv   ,        &  ! divu as implied by transport scheme  (1/s) 
    170          opning     ,        &  ! rate of opening due to divergence/shear 
    171          closing_gross,      &  ! rate at which area removed, not counting 
    172                                 ! area of new ridges 
    173          msnow_mlt  ,        &  ! mass of snow added to ocean (kg m-2) 
    174          esnow_mlt              ! energy needed to melt snow in ocean (J m-2) 
    175  
    176205      REAL(wp) ::            & 
    177206         w1,                 &  ! temporary variable 
     
    187216         big = 1.0e8 
    188217 
    189       REAL (wp), DIMENSION(jpi,jpj) :: &  !  
    190          vt_i_init, vt_i_final       !  ice volume summed over categories 
    191  
    192218      CHARACTER (len = 15) :: fieldid 
    193219 
    194220      !!-- End of declarations 
    195221      !-----------------------------------------------------------------------------! 
     222 
     223      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 
     224         CALL ctl_stop(' : requested workspace arrays unavailable.') 
     225         RETURN 
     226      END IF 
    196227 
    197228      IF( numit == nstart  ) CALL lim_itd_me_init ! Initialization (first time-step only) 
     
    551582      END DO 
    552583 
     584      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8))THEN 
     585         CALL ctl_stop('lim_itd_me : failed to release workspace arrays.') 
     586      END IF 
     587 
    553588   END SUBROUTINE lim_itd_me 
    554589 
     
    577612      !!                 
    578613      !!---------------------------------------------------------------------- 
     614      USE wrk_nemo, ONLY: zworka => wrk_2d_1 !: temporary array used here 
     615      ! 
    579616      !! * Arguments 
    580617 
     
    594631         zdummy 
    595632 
    596       REAL(wp), DIMENSION(jpi,jpj) :: & 
    597          zworka              !: temporary array used here 
     633      IF(.NOT. wrk_use(2, 1))THEN 
     634         CALL ctl_stop('lim_itd_me_icestrength : requested workspace array unavailable.') 
     635         RETURN 
     636      END IF 
    598637 
    599638      !------------------------------------------------------------------------------! 
     
    765804      ! Boundary conditions 
    766805      CALL lbc_lnk( strength, 'T', 1. ) 
     806 
     807      IF(.NOT. wrk_release(2, 1))THEN 
     808         CALL ctl_stop('lim_itd_me_icestrength : failed to release workspace array.') 
     809      END IF 
    767810 
    768811   END SUBROUTINE lim_itd_me_icestrength 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r2580 r2590  
    3737   PRIVATE 
    3838 
    39    PUBLIC   lim_rhg   ! routine called by lim_dyn (or lim_dyn_2) 
     39   PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2) 
     40   PUBLIC   lim_rhg_alloc  ! routine called by nemo_alloc in nemogcm.F90 
    4041 
    4142   REAL(wp) ::   rzero   = 0._wp   ! constant values 
    4243   REAL(wp) ::   rone    = 1._wp   ! constant values 
    4344       
     45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 
     46         zpresh        ,             & !: temporary array for ice strength 
     47         zpreshc       ,             & !: Ice strength on grid cell corners (zpreshc) 
     48         zfrld1, zfrld2,             & !: lead fraction on U/V points                                     
     49         zmass1, zmass2,             & !: ice/snow mass on U/V points                                     
     50         zcorl1, zcorl2,             & !: coriolis parameter on U/V points 
     51         za1ct, za2ct  ,             & !: temporary arrays 
     52         zc1           ,             & !: ice mass 
     53         zusw          ,             & !: temporary weight for the computation 
     54                                !: of ice strength 
     55         u_oce1, v_oce1,             & !: ocean u/v component on U points                            
     56         u_oce2, v_oce2,             & !: ocean u/v component on V points 
     57         u_ice2,                     & !: ice u component on V point 
     58         v_ice1                        !: ice v component on U point 
     59 
     60   REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zf1, zf2   ! arrays for internal stresses 
     61 
     62   REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) :: & 
     63         zdd, zdt,                   & ! Divergence and tension at centre of grid cells 
     64         zds,                        & ! Shear on northeast corner of grid cells 
     65         deltat,                     & ! Delta at centre of grid cells 
     66         deltac,                     & ! Delta on corners 
     67         zs1, zs2,                   & ! Diagonal stress tensor components zs1 and zs2  
     68         zs12                          ! Non-diagonal stress tensor component zs12 
     69 
     70   REAL(wp),ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zu_ice, zv_ice, zresr   ! Local error on velocity 
     71 
    4472   !! * Substitutions 
    4573#  include "vectopt_loop_substitute.h90" 
     
    5078   !!---------------------------------------------------------------------- 
    5179CONTAINS 
     80 
     81   FUNCTION lim_rhg_alloc() 
     82      !!------------------------------------------------------------------- 
     83      !!                 ***  FUNCTION lim_rhg_alloc  *** 
     84      !!------------------------------------------------------------------- 
     85      IMPLICIT none 
     86      INTEGER :: lim_rhg_alloc 
     87      INTEGER :: ierr(2) 
     88      !!------------------------------------------------------------------- 
     89 
     90      ierr(:) = 0 
     91 
     92      ALLOCATE(zpresh(jpi,jpj), zpreshc(jpi,jpj), & 
     93               zfrld1(jpi,jpj), zfrld2(jpi,jpj),  & 
     94               zmass1(jpi,jpj), zmass2(jpi,jpj),  & 
     95               zcorl1(jpi,jpj), zcorl2(jpi,jpj),  & 
     96               za1ct(jpi,jpj),  za2ct(jpi,jpj) ,  & 
     97               zc1(jpi,jpj)   , zusw(jpi,jpj)  ,  & 
     98               u_oce1(jpi,jpj), v_oce1(jpi,jpj),  & 
     99               u_oce2(jpi,jpj), v_oce2(jpi,jpj),  & 
     100               u_ice2(jpi,jpj), v_ice1(jpi,jpj), Stat=ierr(1)) 
     101 
     102      ALLOCATE(zf1(jpi,jpj),    zf2(jpi,jpj),               & 
     103               zdd(jpi,jpj),    zdt(jpi,jpj), zds(jpi,jpj), & 
     104               deltat(jpi,jpj), deltac(jpi,jpj),            & 
     105               zs1(jpi,jpj),    zs2(jpi,jpj), zs12(jpi,jpj),& 
     106               zu_ice(jpi,jpj), zv_ice(jpi,jpj),            & 
     107               zresr(jpi,jpj), Stat=ierr(2)) 
     108 
     109      lim_rhg_alloc = MAXVAL(ierr) 
     110 
     111   END FUNCTION lim_rhg_alloc 
     112 
    52113 
    53114   SUBROUTINE lim_rhg( k_j1, k_jpj ) 
     
    111172      REAL(wp) ::   za, zstms, zsang, zmask   ! local scalars 
    112173 
    113       REAL(wp),DIMENSION(jpi,jpj) :: & 
    114          zpresh        ,             & !: temporary array for ice strength 
    115          zpreshc       ,             & !: Ice strength on grid cell corners (zpreshc) 
    116          zfrld1, zfrld2,             & !: lead fraction on U/V points                                     
    117          zmass1, zmass2,             & !: ice/snow mass on U/V points                                     
    118          zcorl1, zcorl2,             & !: coriolis parameter on U/V points 
    119          za1ct, za2ct  ,             & !: temporary arrays 
    120          zc1           ,             & !: ice mass 
    121          zusw          ,             & !: temporary weight for the computation 
    122                                 !: of ice strength 
    123          u_oce1, v_oce1,             & !: ocean u/v component on U points                            
    124          u_oce2, v_oce2,             & !: ocean u/v component on V points 
    125          u_ice2,                     & !: ice u component on V point 
    126          v_ice1                        !: ice v component on U point 
    127  
    128174      REAL(wp) :: & 
    129175         dtevp,                      & ! time step for subcycling 
     
    140186         sigma1, sigma2                ! internal ice stress 
    141187 
    142       REAL(wp),DIMENSION(jpi,jpj) ::   zf1, zf2   ! arrays for internal stresses 
    143  
    144       REAL(wp),DIMENSION(jpi,jpj) :: & 
    145          zdd, zdt,                   & ! Divergence and tension at centre of grid cells 
    146          zds,                        & ! Shear on northeast corner of grid cells 
    147          deltat,                     & ! Delta at centre of grid cells 
    148          deltac,                     & ! Delta on corners 
    149          zs1, zs2,                   & ! Diagonal stress tensor components zs1 and zs2  
    150          zs12                          ! Non-diagonal stress tensor component zs12 
    151  
    152188      REAL(wp) :: & 
    153189         zresm            ,          & ! Maximal error on ice velocity 
     
    155191         zdummy                        ! dummy argument 
    156192 
    157       REAL(wp),DIMENSION(jpi,jpj) ::   zu_ice, zv_ice, zresr   ! Local error on velocity 
    158193      !!------------------------------------------------------------------- 
    159194#if  defined key_lim2 && ! defined key_lim2_vp 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r2528 r2590  
    1616   IMPLICIT NONE 
    1717   PRIVATE 
     18 
     19   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90 
    1820 
    1921   !!--------------------------- 
     
    5153   !: are the variables corresponding to 2d vectors 
    5254 
    53    INTEGER , PUBLIC, DIMENSION(jpij) ::   &  !: 
     55   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    5456      npb     ,   &   !: number of points where computations has to be done 
    5557      npac            !: correspondance between the points (lateral accretion) 
    5658 
    57    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:  
    5860      qldif_1d    ,     &  !: corresponding to the 2D var  qldif 
    5961      qcmif_1d    ,     &  !: corresponding to the 2D var  qcmif 
     
    6870      t_bo_b               !:    "                  "      t_bo 
    6971 
    70    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !:  
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:  
    7173      sprecip_1d  ,     &  !:    "                  "      sprecip 
    7274      frld_1d     ,     &  !:    "                  "      frld 
     
    106108      hicol_b              !:    Ice collection thickness accumulated in fleads 
    107109 
    108    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !: 
     110   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    109111      t_su_b      ,     &  !:    "                  "      t_su 
    110112      a_i_b       ,     &  !:                              a_i 
     
    122124      o_i_b                !:    Ice age                        [days] 
    123125 
    124    REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) ::   &  !: 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    125127      t_s_b              !: corresponding to the 2D var  t_s 
    126    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax) ::   &  !: 
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    127129      t_i_b,            &  !: corresponding to the 2D var  t_i 
    128130      s_i_b,            &  !: profiled ice salinity 
     
    132134   ! Clean the following ... 
    133135   ! These variables are coded for conservation checks 
    134    REAL(wp), PUBLIC, DIMENSION(jpij,jpl)    ::   &  ! 
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   &  ! 
    135137      qt_i_in   ,           &  !: ice energy summed over categories (initial) 
    136138      qt_i_fin  ,           &  !: ice energy summed over categories (final) 
     
    140142      cons_error, surf_error   !: conservation, surface error 
    141143 
    142    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax)::   &  !:  goes to trash 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)::   &  !:  goes to trash 
    143145      q_i_layer_in,         & 
    144146      q_i_layer_fin,        & 
    145147      dq_i_layer, radab 
    146148 
    147    REAL(wp), PUBLIC, DIMENSION(jpij) ::   &  !: 
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    148150      ftotal_in  ,          &  !: initial total heat flux 
    149151      ftotal_fin               !: final total heat flux 
    150152 
    151    REAL(wp), PUBLIC, DIMENSION(jpij,0:nlay_s) ::   &  !: 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    152154      fc_s 
    153    REAL(wp), PUBLIC, DIMENSION(jpij,0:jkmax)  ::   &  !: 
     155   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   &  !: 
    154156      fc_i 
    155    REAL(wp), PUBLIC, DIMENSION(jpij,nlay_s) ::   &  !: 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    156158      de_s_lay 
    157    REAL(wp), PUBLIC, DIMENSION(jpij,jkmax)  ::   &  !: 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   &  !: 
    158160      de_i_lay 
    159161   INTEGER , PUBLIC ::                           & 
     
    161163 
    162164   !!====================================================================== 
     165CONTAINS 
     166 
     167   FUNCTION thd_ice_alloc() 
     168      !!---------------------------------------------------------------------! 
     169      !!                ***  ROUTINE thd_ice_alloc *** 
     170      !!---------------------------------------------------------------------! 
     171      INTEGER :: thd_ice_alloc 
     172      INTEGER :: ierr(4) 
     173      !!---------------------------------------------------------------------! 
     174 
     175      ALLOCATE(npb(jpij)     , npac(jpij),                           & 
     176               ! 
     177               qldif_1d(jpij) , qcmif_1d(jpij) , fstbif_1d(jpij)   , &    
     178               fltbif_1d(jpij), fscbq_1d(jpij) , qsr_ice_1d(jpij)  , &    
     179               fr1_i0_1d(jpij), fr2_i0_1d(jpij), qnsr_ice_1d(jpij) , &     
     180               qfvbq_1d(jpij) , t_bo_b(jpij)   ,                     & 
     181               Stat=ierr(1)) 
     182               ! 
     183      ALLOCATE(sprecip_1d(jpij), frld_1d(jpij)   , at_i_b(jpij)    , &     
     184               fbif_1d(jpij)   , rdmicif_1d(jpij), rdmsnif_1d(jpij), & 
     185               qlbbq_1d(jpij)  , dmgwi_1d(jpij)  , dvsbq_1d(jpij)  , &    
     186               dvbbq_1d(jpij)  , dvlbq_1d(jpij)  , dvnbq_1d(jpij)  , &    
     187               dqns_ice_1d(jpij),qla_ice_1d(jpij), dqla_ice_1d(jpij),& 
     188               tatm_ice_1d(jpij),fsup(jpij)      , focea(jpij)     , &    
     189               i0(jpij)        , old_ht_i_b(jpij), old_ht_s_b(jpij), &   
     190               fsbri_1d(jpij)  , fhbri_1d(jpij)  , fseqv_1d(jpij)  , & 
     191               dsm_i_fl_1d(jpij),dsm_i_gd_1d(jpij),dsm_i_se_1d(jpij),&      
     192               dsm_i_si_1d(jpij),hicol_b(jpij)                     , & 
     193               Stat=ierr(2)) 
     194               ! 
     195      ALLOCATE(t_su_b(jpij)     , a_i_b(jpij)    , ht_i_b(jpij)    , &    
     196               ht_s_b(jpij)     , fc_su(jpij)    , fc_bo_i(jpij)   , &     
     197               dh_s_tot(jpij)   , dh_i_surf(jpij), dh_i_bott(jpij) , &     
     198               dh_snowice(jpij) , sm_i_b(jpij)   , s_i_new(jpij)   , &     
     199               s_snowice(jpij)  , o_i_b(jpij)                      , & 
     200               ! 
     201               t_s_b(jpij,nlay_s),                                   & 
     202               ! 
     203               t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                , &             
     204               q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , & 
     205               Stat=ierr(3)) 
     206               ! 
     207      ALLOCATE(qt_i_in(jpij,jpl) , qt_i_fin(jpij,jpl), qt_s_in(jpij,jpl),   & 
     208               qt_s_fin(jpij,jpl), dq_i(jpij,jpl)    , sum_fluxq(jpij,jpl), & 
     209               fatm(jpij,jpl),     foce(jpij,jpl)    , cons_error(jpij,jpl),& 
     210               surf_error(jpij,jpl),                                        & 
     211               ! 
     212               q_i_layer_in(jpij,jkmax), q_i_layer_fin(jpij,jkmax),        & 
     213               dq_i_layer(jpij,jkmax)  , radab(jpij,jkmax),                & 
     214               ! 
     215               ftotal_in(jpij), ftotal_fin(jpij),                          & 
     216               ! 
     217               fc_s(jpij,0:nlay_s),   fc_i(jpij,0:jkmax)                 , & 
     218               de_s_lay(jpij,nlay_s), de_i_lay(jpij,jkmax)               , & 
     219               ! 
     220               Stat=ierr(4)) 
     221 
     222      thd_ice_alloc = MAXVAL(ierr) 
     223 
     224      IF(thd_ice_alloc /= 0)THEN 
     225         CALL ctl_warn('thd_ice_alloc: failed to allocate arrays.') 
     226      END IF 
     227 
     228   END FUNCTION thd_ice_alloc 
     229 
    163230END MODULE thd_ice 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r2528 r2590  
    4848   !! Global variables 
    4949   !!---------------------------------------------------------------------- 
    50    REAL(wp), DIMENSION(jpi,jpj) ::   bdytmask   !: Mask defining computational domain at T-points 
    51    REAL(wp), DIMENSION(jpi,jpj) ::   bdyumask   !: Mask defining computational domain at U-points 
    52    REAL(wp), DIMENSION(jpi,jpj) ::   bdyvmask   !: Mask defining computational domain at V-points 
     50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdytmask   !: Mask defining computational domain at T-points 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyumask   !: Mask defining computational domain at U-points 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyvmask   !: Mask defining computational domain at V-points 
    5353 
    5454   !!---------------------------------------------------------------------- 
     
    7070   REAL(wp), DIMENSION(jpbdim)     ::   sshbdy            !: Now clim of bdy sea surface height (Flather) 
    7171   REAL(wp), DIMENSION(jpbdim)     ::   ubtbdy, vbtbdy    !: Now clim of bdy barotropic velocity components 
    72    REAL(wp), DIMENSION(jpbdim,jpk) ::   tbdy  , sbdy      !: Now clim of bdy temperature and salinity   
    73    REAL(wp), DIMENSION(jpbdim,jpk) ::   ubdy  , vbdy    !: Now clim of bdy velocity components 
     72   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tbdy  , sbdy      !: Now clim of bdy temperature and salinity   
     73   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubdy  , vbdy    !: Now clim of bdy velocity components 
    7474   REAL(wp), DIMENSION(jpbdim) ::   sshtide               !: Tidal boundary array : SSH 
    7575   REAL(wp), DIMENSION(jpbdim) ::   utide, vtide          !: Tidal boundary array : U and V 
     
    9292   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9393   !!====================================================================== 
     94#if defined key_bdy  
     95CONTAINS 
     96 
     97   FUNCTION bdy_oce_alloc() 
     98      INTEGER :: bdy_oce_alloc 
     99 
     100      ALLOCATE(bdytmask(jpi,jpj), bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 
     101               tbdy(jpbdim,jpk),  sbdy(jpbdim,jpk),                     & 
     102               ubdy(jpbdim,jpk),  vbdy(jpbdim,jpk),                     & 
     103               Stat=bdy_oce_alloc) 
     104  
     105      IF(bdy_oce_alloc /= 0)THEN 
     106         CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.') 
     107      END IF 
     108 
     109   END FUNCTION bdy_oce_alloc 
     110#endif 
     111 
    94112END MODULE bdy_oce 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r2528 r2590  
    2525   PUBLIC   dia_ar5        ! routine called in step.F90 module 
    2626   PUBLIC   dia_ar5_init   ! routine called in opa.F90 module 
     27   PUBLIC   dia_ar5_alloc  ! routine called in nemogcm.F90 module 
    2728 
    2829   LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE.   ! coupled flag 
     
    3031   REAL(wp)                         ::   vol0         ! ocean volume (interior domain) 
    3132   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain) 
    32    REAL(wp), DIMENSION(jpi,jpj    ) ::   area         ! cell surface (interior domain) 
    33    REAL(wp), DIMENSION(jpi,jpj    ) ::   thick0       ! ocean thickness (interior domain) 
    34    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sn0          ! initial salinity 
     33   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   area         ! cell surface (interior domain) 
     34   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
     35   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
    3536       
    3637   !! * Substitutions 
     
    4344CONTAINS 
    4445 
     46   FUNCTION dia_ar5_alloc() 
     47      !!---------------------------------------------------------------------- 
     48      !!                    ***  ROUTINE dia_ar5_alloc  *** 
     49      !!---------------------------------------------------------------------- 
     50      INTEGER :: dia_ar5_alloc 
     51      !!---------------------------------------------------------------------- 
     52 
     53      ALLOCATE(area(jpi,jpj), thick0(jpi,jpj), sn0(jpi,jpj,jpk), & 
     54               Stat=dia_ar5_alloc) 
     55 
     56      IF(dia_ar5_alloc /= 0)THEN 
     57         CALL ctl_warn('dia_ar5_alloc: failed to allocate arrays') 
     58      END IF 
     59 
     60   END FUNCTION dia_ar5_alloc 
     61 
     62 
    4563   SUBROUTINE dia_ar5( kt ) 
    4664      !!---------------------------------------------------------------------- 
     
    5068      !! 
    5169      !!---------------------------------------------------------------------- 
     70      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     71      USE wrk_nemo, ONLY: zarea_ssh => wrk_2d_1, zbotpres => wrk_2d_2 
     72      USE wrk_nemo, ONLY: zrhd => wrk_3d_1, zrhop => wrk_3d_2 
     73      USE wrk_nemo, ONLY: ztsn => wrk_4d_1 
     74      !! 
    5275      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5376      !! 
    5477      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    5578      REAL(wp) ::   zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 
    56       REAL(wp), DIMENSION(jpi,jpj    ) ::   zarea_ssh, zbotpres 
    57       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhd, zrhop 
    58       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   ztsn 
    5979      !!-------------------------------------------------------------------- 
     80 
     81      IF( (.NOT. wrk_use(2, 1,2)) .OR. & 
     82          (.NOT. wrk_use(3, 1,2)) .OR. & 
     83          (.NOT. wrk_use(4, 1)) )THEN 
     84         CALL ctl_stop('dia_ar5: requested workspace arrays unavailable') 
     85         RETURN 
     86      END IF 
    6087 
    6188      CALL iom_put( 'cellthc', fse3t(:,:,:) ) 
     
    137164      CALL iom_put( 'saltot' , zsal  ) 
    138165      ! 
     166      IF( (.NOT. wrk_release(2, 1,2)) .OR. & 
     167          (.NOT. wrk_release(3, 1,2)) .OR. & 
     168          (.NOT. wrk_release(4, 1)) )THEN 
     169         CALL ctl_stop('dia_ar5: failed to release workspace arrays') 
     170      END IF 
     171      ! 
    139172   END SUBROUTINE dia_ar5 
    140173 
     
    146179      !! ** Purpose :   initialization for AR5 diagnostic computation 
    147180      !!---------------------------------------------------------------------- 
     181      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     182      USE wrk_nemo, ONLY: wrk_4d_1 
     183      !! 
    148184      INTEGER  ::   inum 
    149185      INTEGER  ::   ik 
    150186      INTEGER  ::   ji, jj, jk  ! dummy loop indices 
    151187      REAL(wp) ::   zztmp   
    152       REAL(wp), DIMENSION(jpi,jpj,jpk, 2) ::   zsaldta   ! Jan/Dec levitus salinity 
    153       !!---------------------------------------------------------------------- 
    154       ! 
     188      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity 
     189      !!---------------------------------------------------------------------- 
     190      ! 
     191      IF(.NOT. wrk_use(4, 1))THEN 
     192         CALL ctl_stop('dia_ar5_init: requested workspace array unavailable.') 
     193         RETURN 
     194      END IF 
     195      zsaldta => wrk_4d_1(:,:,:,1:2) 
     196 
    155197      area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 
    156198 
     
    183225      ENDIF 
    184226      ! 
     227      IF(.NOT. wrk_release(4, 1))THEN 
     228         CALL ctl_stop('dia_ar5_init: failed to release workspace array.') 
     229      END IF 
     230      ! 
    185231   END SUBROUTINE dia_ar5_init 
    186232 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    r2528 r2590  
    1717   !! * Accessibility 
    1818   PUBLIC dia_wri_dimg            ! called by trd_mld (eg) 
     19   PUBLIC dia_wri_dimg_alloc      ! called by nemo_alloc in nemogcm.F90 
    1920 
    2021   !! * Substitutions 
    2122#  include "domzgr_substitute.h90" 
     23 
     24   !! These workspace arrays are inside the module so that we can make them 
     25   !! allocatable in a clean way. Not done in wrk_nemo because these are 
     26   !! of KIND(sp). 
     27   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d  ! 2d temporary workspace (sp) 
     28   REAL(sp), ALLOCATABLE, SAVE,   DIMENSION(:) :: z4dep ! vertical level (sp) 
    2229 
    2330   !!---------------------------------------------------------------------- 
     
    2835 
    2936CONTAINS 
     37 
     38  FUNCTION dia_wri_dimg_alloc() 
     39     !!--------------------------------------------------------------------- 
     40     !!        *** ROUTINE dia_wri_dimg_alloc *** 
     41     !! 
     42     !!--------------------------------------------------------------------- 
     43     INTEGER :: dia_wri_dimg_alloc 
     44     !!--------------------------------------------------------------------- 
     45 
     46     ALLOCATE(z42d(jpi,jpj), z4dep(jpk), Stat=dia_wri_dimg_alloc) 
     47 
     48     IF(dia_wri_dimg_alloc /= 0)THEN 
     49        CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') 
     50     END IF 
     51 
     52  END FUNCTION dia_wri_dimg_alloc 
     53 
    3054 
    3155  SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type , ksubi ) 
     
    6387    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm 
    6488    REAL(sp)                    :: zsouth 
    65     REAL(sp),DIMENSION(jpi,jpj) :: z42d        ! 2d temporary workspace (sp) 
    66     REAL(sp),DIMENSION(jpk)     :: z4dep       ! vertical level (sp) 
    6789 
    6890    CHARACTER(LEN=80) :: clname                ! name of file in case of dimgnnn 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r2561 r2590  
    2626   PRIVATE 
    2727 
    28    PUBLIC   dia_hth    ! routine called by step.F90 
     28   PUBLIC   dia_hth       ! routine called by step.F90 
     29   PUBLIC   dia_hth_alloc ! routine called by nemogcm.F90 
    2930 
    3031   LOGICAL , PUBLIC, PARAMETER          ::   lk_diahth = .TRUE.   !: thermocline-20d depths flag 
    3132   ! note: following variables should move to local variables once iom_put is always used  
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hth                  !: depth of the max vertical temperature gradient [m] 
    33    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hd20                 !: depth of 20 C isotherm                         [m] 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hd28                 !: depth of 28 C isotherm                         [m] 
    35    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   htc3                 !: heat content of first 300 m                    [W] 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hth                  !: depth of the max vertical temperature gradient [m] 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd20                 !: depth of 20 C isotherm                         [m] 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hd28                 !: depth of 28 C isotherm                         [m] 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   htc3                 !: heat content of first 300 m                    [W] 
    3637 
    3738   !! * Substitutions 
     
    4344   !!---------------------------------------------------------------------- 
    4445CONTAINS 
     46 
     47   FUNCTION dia_hth_alloc() 
     48     !!--------------------------------------------------------------------- 
     49      IMPLICIT none 
     50      INTEGER :: dia_hth_alloc 
     51 
     52      ALLOCATE(hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), & 
     53               Stat=dia_hth_alloc) 
     54 
     55      IF(dia_hth_alloc /= 0)THEN 
     56         CALL ctl_warn('dia_hth_alloc: failed to allocate arrays.') 
     57      END IF 
     58   END FUNCTION dia_hth_alloc 
    4559 
    4660   SUBROUTINE dia_hth( kt ) 
     
    6882      INTEGER                          ::   ji, jj, jk            ! dummy loop arguments 
    6983      INTEGER                          ::   iid, ilevel           ! temporary integers 
    70       INTEGER, DIMENSION(jpi,jpj)      ::   ik20, ik28            ! levels 
     84      INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ik20, ik28  ! levels 
    7185      REAL(wp)                         ::   zavt5 = 5.e-4_wp      ! Kz criterion for the turbocline depth 
    7286      REAL(wp)                         ::   zrho3 = 0.03_wp       ! density     criterion for mixed layer depth 
     
    7690      REAL(wp)                         ::   zztmp, zzdep          ! temporary scalars inside do loop 
    7791      REAL(wp)                         ::   zu, zv, zw, zut, zvt  ! temporary workspace 
    78       REAL(wp), DIMENSION(jpi,jpj)     ::   zabs2                 ! MLD: abs( tn - tn(10m) ) = ztem2  
    79       REAL(wp), DIMENSION(jpi,jpj)     ::   ztm2                  ! Top of thermocline: tn = tn(10m) - ztem2      
    80       REAL(wp), DIMENSION(jpi,jpj)     ::   zrho10_3              ! MLD: rho = rho10m + zrho3       
    81       REAL(wp), DIMENSION(jpi,jpj)     ::   zpycn                 ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) 
    82       REAL(wp), DIMENSION(jpi,jpj)     ::   ztinv                 ! max of temperature inversion 
    83       REAL(wp), DIMENSION(jpi,jpj)     ::   zdepinv               ! depth of temperature inversion 
    84       REAL(wp), DIMENSION(jpi,jpj)     ::   zrho0_3               ! MLD rho = rho(surf) = 0.03 
    85       REAL(wp), DIMENSION(jpi,jpj)     ::   zrho0_1               ! MLD rho = rho(surf) = 0.01 
    86       REAL(wp), DIMENSION(jpi,jpj)     ::   zmaxdzT               ! max of dT/dz 
    87       REAL(wp), DIMENSION(jpi,jpj)     ::   zthick                ! vertical integration thickness  
    88       REAL(wp), DIMENSION(jpi,jpj)     ::   zdelr                 ! delta rho equivalent to deltaT = 0.2 
     92      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zabs2      ! MLD: abs( tn - tn(10m) ) = ztem2  
     93      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztm2       ! Top of thermocline: tn = tn(10m) - ztem2      
     94      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho10_3   ! MLD: rho = rho10m + zrho3       
     95      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zpycn      ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) 
     96      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztinv      ! max of temperature inversion 
     97      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zdepinv    ! depth of temperature inversion 
     98      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho0_3    ! MLD rho = rho(surf) = 0.03 
     99      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zrho0_1    ! MLD rho = rho(surf) = 0.01 
     100      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zmaxdzT    ! max of dT/dz 
     101      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zthick     ! vertical integration thickness  
     102      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zdelr      ! delta rho equivalent to deltaT = 0.2 
    89103      !!---------------------------------------------------------------------- 
    90104 
    91105      IF( kt == nit000 ) THEN 
     106 
     107         IF(.not. ALLOCATED(ik20))THEN 
     108            ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), & 
     109                     zabs2(jpi,jpj),   & 
     110                     ztm2(jpi,jpj),    & 
     111                     zrho10_3(jpi,jpj),& 
     112                     zpycn(jpi,jpj),   & 
     113                     ztinv(jpi,jpj),   & 
     114                     zdepinv(jpi,jpj), & 
     115                     zrho0_3(jpi,jpj), & 
     116                     zrho0_1(jpi,jpj), & 
     117                     zmaxdzT(jpi,jpj), & 
     118                     zthick(jpi,jpj),  & 
     119                     zdelr(jpi,jpj), Stat=ji) 
     120            IF(ji /= 0)THEN 
     121               WRITE(*,*) 'ERROR: allocation of arrays failed in dia_hth' 
     122               CALL mppabort() 
     123            END IF 
     124         END IF 
     125 
    92126         IF(lwp) WRITE(numout,*) 
    93127         IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth' 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r2571 r2590  
    4141   PUBLIC   ptr_vj         ! call by tra_ldf & tra_adv routines 
    4242   PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines 
     43   PUBLIC   dia_ptr_alloc  ! call in nemogcm module 
    4344 
    4445   !                                           !!** namelist  namptr  ** 
     
    7172   REAL(wp) ::   rc_pwatt = 1.e-15_wp  ! conversion from W    to PW (further x rau0 x Cp) 
    7273   REAL(wp) ::   rc_ggram = 1.e-6_wp   ! conversion from g    to Pg 
     74 
     75   REAL(wp), TARGET, DIMENSION(:),   ALLOCATABLE, SAVE :: p_fval1d 
     76   REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d 
     77 
     78   !! Integer, 1D workspace arrays. Not common enough to be implemented in  
     79   !! wrk_nemo module. 
     80   INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc 
     81   INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30 
     82   INTEGER, ALLOCATABLE, SAVE, DIMENSION (:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 
    7383 
    7484   !! * Substitutions 
     
    8292CONTAINS 
    8393 
     94    FUNCTION dia_ptr_alloc() 
     95      !!---------------------------------------------------------------------- 
     96      !!                    ***  ROUTINE dia_ptr_alloc  *** 
     97      !!---------------------------------------------------------------------- 
     98      INTEGER               :: dia_ptr_alloc 
     99      INTEGER, DIMENSION(5) :: ierr 
     100      !!---------------------------------------------------------------------- 
     101 
     102      ierr(:) = 0 
     103 
     104      ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
     105                htr_adv(jpj) , str_adv(jpj) ,   & 
     106                htr_ldf(jpj) , str_ldf(jpj) ,   & 
     107                htr_ove(jpj) , str_ove(jpj),    & 
     108                htr(jpj,nptr) , str(jpj,nptr) , & 
     109                tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 
     110                sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1)  ) 
     111         ! 
     112#if defined key_diaeiv 
     113      ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 
     114                v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 
     115#endif 
     116 
     117      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 
     118 
     119      ALLOCATE(ndex(jpj*jpk),        ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 
     120               ndex_ind(jpj*jpk),    ndex_ipc(jpj*jpk),                    & 
     121               ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4)) 
     122 
     123      ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk),                   & 
     124               ndex_h(jpj),          ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 
     125               ndex_h_ind_30(jpj),   ndex_h_ipc_30(jpj), Stat=ierr(5)) 
     126 
     127      dia_ptr_alloc = MAXVAL(ierr) 
     128 
     129   END FUNCTION dia_ptr_alloc 
     130 
     131 
    84132   FUNCTION ptr_vj_3d( pva )   RESULT ( p_fval ) 
    85133      !!---------------------------------------------------------------------- 
     
    93141      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    94142      !!---------------------------------------------------------------------- 
     143      IMPLICIT none 
    95144      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point 
    96145      !! 
    97146      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments 
    98147      INTEGER                  ::   ijpj         ! ??? 
    99       REAL(wp), DIMENSION(jpj) ::   p_fval       ! function value 
     148      REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value 
    100149      !!-------------------------------------------------------------------- 
    101150      ! 
     151      p_fval => p_fval1d 
     152 
    102153      ijpj = jpj 
    103154      p_fval(:) = 0._wp 
     
    128179      !! ** Action  : - p_fval: i-k-mean poleward flux of pva 
    129180      !!---------------------------------------------------------------------- 
     181      IMPLICIT none 
    130182      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point 
    131183      !! 
    132       INTEGER                  ::   ji,jj    ! dummy loop arguments 
    133       INTEGER                  ::   ijpj     ! ??? 
    134       REAL(wp), DIMENSION(jpj) ::   p_fval  ! function value 
     184      INTEGER                  ::   ji,jj       ! dummy loop arguments 
     185      INTEGER                  ::   ijpj        ! ??? 
     186      REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 
    135187      !!-------------------------------------------------------------------- 
    136188      !  
     189      p_fval => p_fval1d 
     190 
    137191      ijpj = jpj 
    138192      p_fval(:) = 0._wp 
     
    161215      !! ** Action  : - p_fval: i-mean poleward flux of pva 
    162216      !!---------------------------------------------------------------------- 
     217#if defined key_mpp_mpi 
     218      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     219      USE wrk_nemo, ONLY: zwork => wrk_1d_1 
     220#endif 
     221      !! 
     222      IMPLICIT none 
    163223      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point 
    164224      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask 
    165225      !! 
    166       INTEGER                      ::   ji, jj, jk  ! dummy loop arguments 
    167       REAL(wp), DIMENSION(jpj,jpk) ::   p_fval       ! return function value 
     226      INTEGER                           :: ji, jj, jk ! dummy loop arguments 
     227      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value 
    168228#if defined key_mpp_mpi 
    169229      INTEGER, DIMENSION(1) ::   ish 
    170230      INTEGER, DIMENSION(2) ::   ish2 
    171       REAL(wp), DIMENSION(jpj*jpk) ::   zwork   ! 1D workspace 
     231      INTEGER               ::   ijpjjpk 
    172232#endif 
    173233      !!-------------------------------------------------------------------- 
    174234      ! 
     235#if defined key_mpp_mpi 
     236      IF(.not. wrk_use(1, 1))THEN 
     237         CALL ctl_stop('ptr_vjk: ERROR - requested workspace array is unavailable') 
     238         RETURN 
     239      END IF 
     240#endif 
     241 
     242      p_fval => p_fval2d 
     243 
    175244      p_fval(:,:) = 0._wp 
    176245      ! 
     
    195264      ! 
    196265#if defined key_mpp_mpi 
    197       ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    198       zwork(:) = RESHAPE( p_fval, ish ) 
    199       CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 
     266      ijpjjpk = jpj*jpk 
     267      ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk 
     268      zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 
     269      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
    200270      p_fval(:,:) = RESHAPE( zwork, ish2 ) 
    201271#endif 
    202272      ! 
     273#if defined key_mpp_mpi 
     274      IF(.not. wrk_release(1, 1))THEN 
     275         CALL ctl_stop('ptr_vjk: ERROR - failed to release workspace array') 
     276      END IF 
     277#endif 
     278      ! 
    203279   END FUNCTION ptr_vjk 
    204280 
     
    214290      !! ** Action  : - p_fval: i-sum of e1t*e3t*pta 
    215291      !!---------------------------------------------------------------------- 
     292#if defined key_mpp_mpi 
     293      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     294      USE wrk_nemo, ONLY: zwork => wrk_1d_1 
     295#endif 
     296      !! 
    216297      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point 
    217298      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask 
    218299      !! 
    219       INTEGER                     ::  ji, jj, jk   ! dummy loop arguments 
    220       REAL(wp),DIMENSION(jpj,jpk) ::  p_fval       ! return function value 
     300      INTEGER                           :: ji, jj, jk   ! dummy loop arguments 
     301      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval       ! return function value 
    221302#if defined key_mpp_mpi 
    222303      INTEGER, DIMENSION(1) ::   ish 
    223304      INTEGER, DIMENSION(2) ::   ish2 
    224       REAL(wp),DIMENSION(jpj*jpk) ::   zwork   ! 1D workspace 
     305      INTEGER               ::   ijpjjpk 
    225306#endif 
    226307      !!--------------------------------------------------------------------  
    227308      ! 
     309#if defined key_mpp_mpi 
     310      IF(.NOT. wrk_use(1, 1))THEN 
     311         CALL ctl_stop('ptr_tjk: requested workspace array unavailable.') 
     312         RETURN 
     313      END IF 
     314#endif 
     315 
     316      p_fval => p_fval2d 
     317 
    228318      p_fval(:,:) = 0._wp 
    229319      DO jk = 1, jpkm1 
     
    235325      END DO 
    236326#if defined key_mpp_mpi 
     327      ijpjjpk = jpj*jpk 
    237328      ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk 
    238       zwork(:)= RESHAPE( p_fval, ish ) 
    239       CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 
     329      zwork(1:ijpjjpk)= RESHAPE( p_fval, ish ) 
     330      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 
    240331      p_fval(:,:)= RESHAPE( zwork, ish2 ) 
    241332#endif 
    242333      ! 
     334#if defined key_mpp_mpi 
     335      IF(.NOT. wrk_release(1, 1))THEN 
     336         CALL ctl_stop('ptr_tjk: failed to release workspace array.') 
     337      END IF 
     338#endif 
     339      !     
    243340   END FUNCTION ptr_tjk 
    244341 
     
    250347      USE oce,     vt  =>   ua   ! use ua as workspace 
    251348      USE oce,     vs  =>   ua   ! use ua as workspace 
     349      IMPLICIT none 
    252350      !! 
    253351      INTEGER, INTENT(in) ::   kt   ! ocean time step index 
     
    388486      IF( .NOT. ln_diaptr ) THEN       ! diaptr not used 
    389487        RETURN 
    390       ELSE                             ! Allocate the diaptr arrays 
    391          ALLOCATE( btmsk(jpi,jpj,nptr) ,                                                                      & 
    392             &      htr_adv(jpj) , str_adv(jpj) , htr_ldf(jpj) , str_ldf(jpj) , htr_ove(jpj) , str_ove(jpj),   & 
    393             &      htr(jpj,nptr) , str(jpj,nptr) ,                                                              & 
    394             &      tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) ,                         & 
    395             &      sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr)                       , STAT=ierr  ) 
    396          ! 
    397          IF( ierr > 0 ) THEN 
    398             CALL ctl_stop( 'dia_ptr_init : unable to allocate standard arrays' )   ;   RETURN 
    399          ENDIF 
    400 #if defined key_diaeiv 
    401 !!       IF( lk_diaeiv )   &              ! eddy induced velocity arrays 
    402             ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , v_msf_eiv(jpj,jpk,nptr) , STAT=ierr ) 
    403          ! 
    404          IF( ierr > 0 ) THEN 
    405             CALL ctl_stop( 'dia_ptr_init : unable to allocate eiv arrays' )   ;   RETURN 
    406          ENDIF 
    407 #endif 
    408488      ENDIF 
    409489       
     
    460540      !! ** Method  :   NetCDF file 
    461541      !!---------------------------------------------------------------------- 
     542      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     543      USE wrk_nemo, ONLY: zphi => wrk_1d_1, zfoo => wrk_1d_2 
     544      USE wrk_nemo, ONLY: z_1  => wrk_2d_1 
     545      !! 
    462546      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    463547      !! 
     
    466550      INTEGER, SAVE ::         ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30 
    467551      INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 
    468       INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc 
    469       INTEGER, SAVE, DIMENSION (jpj*jpk) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30 
    470       INTEGER, SAVE, DIMENSION (jpj)     :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 
    471552      !! 
    472553      CHARACTER (len=40)       ::   clhstnam, clop, clop_once, cl_comment   ! temporary names 
     
    476557#endif 
    477558      REAL(wp)                 ::   zsto, zout, zdt, zjulian                ! temporary scalars 
    478       REAL(wp), DIMENSION(jpj) ::   zphi, zfoo 
    479       REAL(wp), DIMENSION(jpj,jpk) :: z_1 
    480       !!---------------------------------------------------------------------- 
     559      !!---------------------------------------------------------------------- 
     560 
     561      IF( (.not. wrk_use(1, 1,2)) .OR. (.not. wrk_use(2, 1)) )THEN 
     562         CALL ctl_stop('dia_ptr_wri: ERROR: requested workspace arrays unavailable') 
     563         RETURN 
     564      END IF 
    481565 
    482566      ! define time axis 
     
    507591            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole 
    508592            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole 
    509             zphi(:) = 0._wp 
     593            zphi(1:jpj) = 0._wp 
    510594            DO ji = mi0(iline), mi1(iline)  
    511                zphi(:) = gphiv(ji,:)         ! if iline is in the local domain 
     595               zphi(1:jpj) = gphiv(ji,:)         ! if iline is in the local domain 
    512596               ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 
    513597               IF( jp_cfg == 05 ) THEN 
     
    533617         ELSE                                        !   OTHER configurations  
    534618            !                                        ! ======================= 
    535             zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line 
     619            zphi(1:jpj) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line 
    536620            ! 
    537621         ENDIF 
     
    555639 
    556640            zout = nn_fwri * zdt 
    557             zfoo(:) = 0._wp 
     641            zfoo(1:jpj) = 0._wp 
    558642 
    559643            ! Compute julian date from starting date of the run 
     
    802886      ENDIF 
    803887      ! 
    804    END SUBROUTINE dia_ptr_wri 
     888      IF( (.not. wrk_release(1, 1,2)) .OR. (.not. wrk_release(2, 1)) )THEN 
     889         CALL ctl_stop('dia_ptr_wri: ERROR: failed to release workspace arrays') 
     890      END IF 
     891      ! 
     892  END SUBROUTINE dia_ptr_wri 
    805893 
    806894   !!====================================================================== 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r2561 r2590  
    5454   PUBLIC   dia_wri                 ! routines called by step.F90 
    5555   PUBLIC   dia_wri_state 
     56   PUBLIC   dia_wri_alloc           ! Called by nemogcm module 
    5657 
    5758   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
     
    6061   INTEGER ::   nid_W, nz_W, nh_W                    ! grid_W file 
    6162   INTEGER ::   ndex(1)                              ! ??? 
    62    INTEGER, DIMENSION(jpi*jpj)     ::  ndex_hT, ndex_hU, ndex_hV 
    63    INTEGER, DIMENSION(jpi*jpj*jpk) ::  ndex_T, ndex_U, ndex_V 
     63   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
     64   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 
    6465 
    6566   !! * Substitutions 
     
    7374   !!---------------------------------------------------------------------- 
    7475CONTAINS 
     76 
     77  FUNCTION dia_wri_alloc() 
     78    !!---------------------------------------------------------------------- 
     79    IMPLICIT none 
     80    INTEGER :: dia_wri_alloc 
     81    INTEGER, DIMENSION(2) :: ierr 
     82    !!---------------------------------------------------------------------- 
     83     
     84    ierr = 0 
     85 
     86    ALLOCATE(ndex_hT(jpi*jpj), ndex_hU(jpi*jpj), ndex_hV(jpi*jpj), & 
     87             ndex_T(jpi*jpj*jpk), ndex_U(jpi*jpj*jpk), ndex_V(jpi*jpj*jpk), & 
     88             Stat=ierr(1)) 
     89 
     90    dia_wri_alloc = MAXVAL(ierr) 
     91 
     92  END FUNCTION dia_wri_alloc 
    7593 
    7694#if defined key_dimgout 
     
    98116      !!---------------------------------------------------------------------- 
    99117      USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace 
     118      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     119      USE wrk_nemo, ONLY: z2d => wrk_2d_1 
    100120      !! 
    101121      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     
    103123      INTEGER                      ::   ji, jj, jk              ! dummy loop indices 
    104124      REAL(wp)                     ::   zztmp, zztmpx, zztmpy   !  
    105       REAL(wp), DIMENSION(jpi,jpj) ::   z2d                     !  
    106125      !!---------------------------------------------------------------------- 
    107126      !  
     127      IF( .not. wrk_use(2, 1))THEN 
     128         CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') 
     129         RETURN 
     130      END IF 
     131      ! 
    108132      ! Output the initial state and forcings 
    109133      IF( ninist == 1 ) THEN                        
     
    175199      ENDIF 
    176200      ! 
     201      IF( .not. wrk_release(2, 1))THEN 
     202         CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.') 
     203         RETURN 
     204      END IF 
     205      ! 
    177206   END SUBROUTINE dia_wri 
    178207 
     
    194223      !!      Each nwrite time step, output the instantaneous or mean fields 
    195224      !!---------------------------------------------------------------------- 
     225      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     226      USE wrk_nemo, ONLY: zw2d => wrk_2d_1 
     227      !! 
    196228      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    197229      !! 
     
    201233      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
    202234      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! local scalars 
    203       REAL(wp), DIMENSION(jpi,jpj) ::   zw2d                 ! 2D workspace 
    204235      !!---------------------------------------------------------------------- 
     236      ! 
     237      IF( .not. wrk_use(2, 1))THEN 
     238         CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') 
     239         RETURN 
     240      END IF 
    205241      ! 
    206242      ! Output the initial state and forcings 
     
    571607      ENDIF 
    572608      ! 
     609      IF( .not. wrk_release(2, 1))THEN 
     610         CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.') 
     611         RETURN 
     612      END IF 
     613      ! 
    573614   END SUBROUTINE dia_wri 
    574615# endif 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r2528 r2590  
    7979#endif 
    8080 
    81     REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  um , vm   ! used to compute mean u, v fields 
    82     REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  wm        ! used to compute mean w fields 
    83     REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  avtm      ! used to compute mean kz fields 
    84     REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  tm , sm   ! used to compute mean t, s fields 
    85     REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  fsel      ! used to compute mean 2d fields 
     81    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm   ! used to compute mean u, v fields 
     82    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  wm        ! used to compute mean w fields 
     83    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm      ! used to compute mean kz fields 
     84    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm   ! used to compute mean t, s fields 
     85    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel      ! used to compute mean 2d fields 
    8686    REAL(wp) :: zdtj 
    8787    ! 
     
    9595    !  --------------- 
    9696    ! 
     97    IF(.not.ALLOCATED(um))THEN 
     98       ALLOCATE(um(jpi,jpj,jpk), vm(jpi,jpj,jpk), & 
     99                wm(jpi,jpj,jpk),                  & 
     100                avtm(jpi,jpj,jpk),                & 
     101                tm(jpi,jpj,jpk), sm(jpi,jpj,jpk), & 
     102                fsel(jpi,jpj,jpk),                & 
     103                Stat=jk) 
     104       IF(jk /= 0)THEN 
     105          WRITE(*,*) 'ERROR: allocate failed in dia_wri (diawri_dimg.h90)' 
     106          CALL mppabort() 
     107       END IF 
     108    END IF 
     109 
    97110    inbsel = 17 
    98111 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2528 r2590  
    4949   INTEGER , PUBLIC                 ::   neuler  = 0   !: restart euler forward option (0=Euler) 
    5050   REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    51    REAL(wp), PUBLIC, DIMENSION(jpk) ::   rdttra        !: vertical profile of tracer time step 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttra  !: vertical profile of tracer time step 
    5252 
    5353   !                                         !!* Namelist namcla : cross land advection 
     
    8383   INTEGER, PUBLIC ::   nidom             !: ??? 
    8484 
    85    INTEGER, PUBLIC, DIMENSION(jpi)    ::   mig        !: local  ==> global domain i-index 
    86    INTEGER, PUBLIC, DIMENSION(jpj)    ::   mjg        !: local  ==> global domain j-index 
    87    INTEGER, PUBLIC, DIMENSION(jpidta) ::   mi0, mi1   !: global ==> local  domain i-index    !!bug ==> other solution? 
     85   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index 
     86   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index 
     87   INTEGER, PUBLIC,               DIMENSION(jpidta) ::   mi0, mi1   !: global ==> local  domain i-index    !!bug ==> other solution? 
    8888   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain) 
    89    INTEGER, PUBLIC, DIMENSION(jpjdta) ::   mj0, mj1   !: global ==> local  domain j-index     !!bug ==> other solution? 
     89   INTEGER, PUBLIC,               DIMENSION(jpjdta) ::   mj0, mj1   !: global ==> local  domain j-index     !!bug ==> other solution? 
    9090   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain) 
    91    INTEGER, PUBLIC, DIMENSION(jpnij) ::   nimppt, njmppt   !: i-, j-indexes for each processor 
    92    INTEGER, PUBLIC, DIMENSION(jpnij) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
    93    INTEGER, PUBLIC, DIMENSION(jpnij) ::   nlcit , nlcjt    !: dimensions of every subdomain 
    94    INTEGER, PUBLIC, DIMENSION(jpnij) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
    95    INTEGER, PUBLIC, DIMENSION(jpnij) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
     91   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor 
     92   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
     93   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain 
     94   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
     95   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
    9696 
    9797   !!---------------------------------------------------------------------- 
    9898   !! horizontal curvilinear coordinate and scale factors 
    9999   !! --------------------------------------------------------------------- 
    100    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   glamt, glamu   !: longitude of t-, u-, v- and f-points (degre) 
    101    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   glamv, glamf   !: 
    102    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
    103    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gphiv, gphif   !: 
    104    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1t, e2t       !: horizontal scale factors at t-point (m) 
    105    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1u, e2u       !: horizontal scale factors at u-point (m) 
    106    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1v, e2v       !: horizontal scale factors at v-point (m) 
    107    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1f, e2f       !: horizontal scale factors at f-point (m) 
    108    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
     100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamt, glamu   !: longitude of t-, u-, v- and f-points (degre) 
     101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamv, glamf   !: 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !: 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m) 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m) 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m) 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m) 
     108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
    109109 
    110110   !!---------------------------------------------------------------------- 
     
    118118   !! All coordinates 
    119119   !! --------------- 
    120    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdep3w          !: depth of T-points (sum of e3w) (m) 
    121    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdept , gdepw   !: analytical depth at T-W  points (m) 
    122    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3v   , e3f     !: analytical vertical scale factors at  V--F 
    123    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3t   , e3u     !:                                       T--U  points (m) 
    124    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3vw            !: analytical vertical scale factors at  VW-- 
    125    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3w   , e3uw    !:                                        W--UW  points (m) 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w          !: depth of T-points (sum of e3w) (m) 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept , gdepw   !: analytical depth at T-W  points (m) 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v   , e3f     !: analytical vertical scale factors at  V--F 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t   , e3u     !:                                       T--U  points (m) 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw            !: analytical vertical scale factors at  VW-- 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w   , e3uw    !:                                        W--UW  points (m) 
    126126#if defined key_vvl 
    127127   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag 
     
    129129   !! All coordinates 
    130130   !! --------------- 
    131    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdep3w_1           !: depth of T-points (sum of e3w) (m) 
    132    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdept_1, gdepw_1   !: analytical depth at T-W  points (m) 
    133    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3v_1  , e3f_1     !: analytical vertical scale factors at  V--F 
    134    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3t_1  , e3u_1     !:                                       T--U  points (m) 
    135    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3vw_1             !: analytical vertical scale factors at  VW-- 
    136    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3w_1  , e3uw_1    !:                                       W--UW  points (m) 
    137    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3t_b              !: before         -      -      -    -   T      points (m) 
    138    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3u_b  , e3v_b     !:   -            -      -      -    -   U--V   points (m) 
     131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_1           !: depth of T-points (sum of e3w) (m) 
     132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_1, gdepw_1   !: analytical depth at T-W  points (m) 
     133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_1  , e3f_1     !: analytical vertical scale factors at  V--F 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_1  , e3u_1     !:                                       T--U  points (m) 
     135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_1             !: analytical vertical scale factors at  VW-- 
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_1  , e3uw_1    !:                                       W--UW  points (m) 
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_b              !: before         -      -      -    -   T      points (m) 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_b  , e3v_b     !:   -            -      -      -    -   U--V   points (m) 
    139139#else 
    140140   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag 
    141141#endif 
    142    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m) 
    143    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hu   , hv     !: depth at u- and v-points (meters) 
    144    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters) 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m) 
     143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu   , hv     !: depth at u- and v-points (meters) 
     144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters) 
    145145 
    146146   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
     
    149149   !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 
    150150   !! =-----------------====------ 
    151    REAL(wp), PUBLIC, DIMENSION(jpk)     ::   gdept_0, gdepw_0  !: reference depth of t- and w-points (m) 
    152    REAL(wp), PUBLIC, DIMENSION(jpk)     ::   e3t_0  , e3w_0     !: reference vertical scale factors at T- and W-pts (m) 
    153    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e3tp   , e3wp      !: ocean bottom level thickness at T and W points 
     151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m) 
     152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: e3t_0  , e3w_0   !: reference vertical scale factors at T- and W-pts (m) 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp   , e3wp    !: ocean bottom level thickness at T and W points 
    154154 
    155155   !! s-coordinate and hybrid z-s-coordinate 
    156156   !! =----------------======--------------- 
    157    REAL(wp), PUBLIC, DIMENSION(jpk) ::   gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic) 
    158    REAL(wp), PUBLIC, DIMENSION(jpk) ::   gsi3w          !: model level depth coefficient at w-level (sum of gsigw) 
    159    REAL(wp), PUBLIC, DIMENSION(jpk) ::   esigt, esigw   !: vertical scale factor coef. at t-, w-levels 
    160  
    161    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hbatv , hbatf    !: ocean depth at the vertical of  V--F 
    162    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hbatt , hbatu    !:                                 T--U  points (m) 
    163    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   scosrf, scobot   !: ocean surface and bottom topographies  
    164    !                                                          !  (if deviating from coordinate surfaces in HYBRID) 
    165    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hifv  , hiff     !: interface depth between stretching at  V--F 
    166    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hift  , hifu     !: and quasi-uniform spacing              T--U  points (m) 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic) 
     158   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   gsi3w          !: model level depth coefficient at w-level (sum of gsigw) 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   esigt, esigw   !: vertical scale factor coef. at t-, w-levels 
     160 
     161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatv , hbatf    !: ocean depth at the vertical of  V--F 
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hbatt , hbatu    !:                                 T--U  points (m) 
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   scosrf, scobot   !: ocean surface and bottom topographies  
     164   !                                        !  (if deviating from coordinate surfaces in HYBRID) 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hifv  , hiff     !: interface depth between stretching at  V--F 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hift  , hifu     !: and quasi-uniform spacing              T--U  points (m) 
    167167 
    168168   !!---------------------------------------------------------------------- 
    169169   !! masks, bathymetry 
    170170   !! --------------------------------------------------------------------- 
    171    INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbathy       !: number of ocean level (=0, 1, ... , jpk-1) 
    172    INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbkt         !: vertical index of the bottom last T- ocean level 
    173    INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbku, mbkv   !: vertical index of the bottom last U- and W- ocean level 
    174    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bathy        !: ocean depth (meters) 
    175    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmask_i      !: interior domain T-point mask 
    176    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bmask        !: land/ocean mask of barotropic stream function 
    177  
    178    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
     171   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy       !: number of ocean level (=0, 1, ... , jpk-1) 
     172   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt         !: vertical index of the bottom last T- ocean level 
     173   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku, mbkv   !: vertical index of the bottom last U- and W- ocean level 
     174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy        !: ocean depth (meters) 
     175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i      !: interior domain T-point mask 
     176   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask        !: land/ocean mask of barotropic stream function 
     177 
     178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    179179 
    180180   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
    181181 
    182182#if defined key_noslip_accurate 
    183    INTEGER, PUBLIC, DIMENSION            (4,jpk) ::   npcoa          !: ??? 
    184    INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) ::   nicoa, njcoa  !: ??? 
     183   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: npcoa        !: ??? 
     184   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nicoa, njcoa !: ??? 
    185185#endif 
    186186 
     
    215215   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .FALSE.   !: agrif flag 
    216216#endif 
     217 
     218   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90 
     219 
    217220   !!---------------------------------------------------------------------- 
    218221   !! agrif domain 
     
    222225#else 
    223226   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag 
     227#endif 
    224228 
    225229CONTAINS 
     230 
     231#if ! defined key_agrif 
    226232   LOGICAL FUNCTION Agrif_Root() 
    227233      Agrif_Root = .TRUE. 
     
    232238   END FUNCTION Agrif_CFixed 
    233239#endif 
     240 
     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 
     276 
     277#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)) 
     293    ! 
     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)) 
     315 
     316#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 
    234325   !!---------------------------------------------------------------------- 
    235326   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r2528 r2590  
    3434   PRIVATE 
    3535 
    36    PUBLIC   dom_msk    ! routine called by inidom.F90 
     36   PUBLIC   dom_msk        ! routine called by inidom.F90 
     37   PUBLIC   dom_msk_alloc  ! routine called by nemogcm.F90 
    3738 
    3839   !                            !!* Namelist namlbc : lateral boundary condition * 
    3940   REAL(wp) ::   rn_shlat = 2.   ! type of lateral boundary condition on velocity 
    40     
     41 
     42   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  icoord ! Workspace for dom_msk_nsa() 
     43 
    4144   !! * Substitutions 
    4245#  include "vectopt_loop_substitute.h90" 
     
    4851CONTAINS 
    4952    
     53   FUNCTION dom_msk_alloc() 
     54      !!--------------------------------------------------------------------- 
     55      !!                 ***  ROUTINE dom_msk_alloc  *** 
     56      !!--------------------------------------------------------------------- 
     57      INTEGER :: dom_msk_alloc 
     58 
     59      dom_msk_alloc = 0 
     60 
     61#if defined key_noslip_accurate 
     62      ALLOCATE(icoord(jpi*jpj*jpk,3), Stat=dom_msk_alloc) 
     63#endif 
     64 
     65      IF(dom_msk_alloc /= 0)THEN 
     66         CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array.') 
     67      END IF 
     68 
     69   END FUNCTION dom_msk_alloc 
     70 
     71 
    5072   SUBROUTINE dom_msk 
    5173      !!--------------------------------------------------------------------- 
     
    109131      !!               tmask_i  : interior ocean mask 
    110132      !!---------------------------------------------------------------------- 
     133      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     134      USE wrk_nemo, ONLY: zwf => wrk_2d_1 
     135      USE wrk_nemo, ONLY: imsk => iwrk_2d_1 
     136      !! 
    111137      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    112138      INTEGER  ::   iif, iil, ii0, ii1, ii 
    113139      INTEGER  ::   ijf, ijl, ij0, ij1 
    114       INTEGER , DIMENSION(jpi,jpj) ::  imsk 
    115       REAL(wp), DIMENSION(jpi,jpj) ::   zwf 
    116140      !! 
    117141      NAMELIST/namlbc/ rn_shlat 
    118142      !!--------------------------------------------------------------------- 
    119143       
     144      IF( (.not. wrk_use(2,1)) .OR. (.not. iwrk_use(2,1)) )THEN 
     145         CALL ctl_stop('dom_msk: ERROR: requested workspace arrays unavailable.') 
     146         RETURN 
     147      END IF 
     148 
    120149      REWIND( numnam )              ! Namelist namlbc : lateral momentum boundary condition 
    121150      READ  ( numnam, namlbc ) 
     
    414443      ENDIF 
    415444      ! 
     445      IF( (.not. wrk_release(2,1)) .OR. (.not. iwrk_release(2,1)) )THEN 
     446         CALL ctl_stop('dom_msk: ERROR: failed to release workspace arrays.') 
     447      END IF 
     448      ! 
    416449   END SUBROUTINE dom_msk 
    417450 
     
    434467      INTEGER  ::   ine, inw, ins, inn, itest, ierror, iind, ijnd 
    435468      REAL(wp) ::   zaa 
    436       INTEGER, DIMENSION(jpi*jpj*jpk,3) ::  icoord 
    437469      !!--------------------------------------------------------------------- 
    438470       
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r2528 r2590  
    3636      !! 
    3737      !!---------------------------------------------------------------------- 
     38      USE in_out_manager, ONLY: ctl_stop 
     39      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     40      USE wrk_nemo, ONLY: zglam => wrk_2d_2, & 
     41                          zgphi => wrk_2d_3, & 
     42                          zmask => wrk_2d_4, & 
     43                          zdist => wrk_2d_5 
     44      IMPLICIT none 
    3845      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point 
    3946      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point 
     
    4148      !! 
    4249      INTEGER , DIMENSION(2)        ::   iloc 
    43       REAL(wp), DIMENSION(jpi,jpj)  ::   zglam, zgphi, zmask, zdist 
    4450      REAL(wp)                      ::   zlon 
    4551      REAL(wp)                      ::   zmini 
    4652      !!-------------------------------------------------------------------- 
    47        
     53 
     54      IF(.not. wrk_use(2, 2, 3, 4, 5))THEN 
     55         CALL ctl_stop('dom_ngb: Requested workspaces already in use.') 
     56      END IF 
     57 
    4858      zmask(:,:) = 0. 
    4959      SELECT CASE( cdgrid ) 
     
    7181      ENDIF 
    7282 
     83      IF(.not. wrk_release(2, 2,3,4,5))THEN 
     84         CALL ctl_stop('dom_ngb: error releasing workspaces.') 
     85      ENDIF 
     86 
    7387   END SUBROUTINE dom_ngb 
    7488 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r2528 r2590  
    2424   PRIVATE 
    2525 
    26    PUBLIC   dom_vvl    ! called by domain.F90 
    27  
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ee_t, ee_u, ee_v, ee_f   !: ??? 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mut, muu, muv, muf       !: ???  
    30  
    31    REAL(wp), DIMENSION(jpk) ::   r2dt   ! vertical profile time-step, = 2 rdttra  
     26   PUBLIC   dom_vvl       ! called by domain.F90 
     27   PUBLIC   dom_vvl_alloc ! called by nemogcm.F90 
     28 
     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  
    3233      !                                 ! except at nit000 (=rdttra) if neuler=0 
    3334 
     
    4243 
    4344CONTAINS        
     45 
     46   FUNCTION dom_vvl_alloc() 
     47      !!---------------------------------------------------------------------- 
     48      !!                ***  ROUTINE dom_vvl_alloc  *** 
     49      !!---------------------------------------------------------------------- 
     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 
     63   END FUNCTION dom_vvl_alloc 
     64 
    4465 
    4566   SUBROUTINE dom_vvl 
     
    5071      !!               ssh over the whole water column (scale factors) 
    5172      !!---------------------------------------------------------------------- 
     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 
     76      !! 
    5277      INTEGER  ::   ji, jj, jk 
    5378      REAL(wp) ::   zcoefu , zcoefv   , zcoeff                   ! temporary scalars 
    5479      REAL(wp) ::   zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1   !     -        - 
    55       REAL(wp), DIMENSION(jpi,jpj) ::  zs_t, zs_u_1, zs_v_1      !     -     2D workspace 
    56       !!---------------------------------------------------------------------- 
     80      !!---------------------------------------------------------------------- 
     81 
     82      IF(.not. wrk_use(2, 1,2,3))THEN 
     83         CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.') 
     84         RETURN 
     85      END IF 
    5786 
    5887      IF(lwp)   THEN 
     
    167196      fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 
    168197      ! 
     198      IF(.not. wrk_release(2, 1,2,3))THEN 
     199         CALL ctl_stop('dom_vvl: ERROR - failed to release workspace arrays.') 
     200      END IF 
     201      ! 
    169202   END SUBROUTINE dom_vvl 
    170203 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r2528 r2590  
    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 
    2730 
    2831   !! * Substitutions 
     
    3437   !!---------------------------------------------------------------------- 
    3538CONTAINS 
     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 
    3651 
    3752   SUBROUTINE dom_wri 
     
    6378      !!                                   masks, depth and vertical scale factors 
    6479      !!---------------------------------------------------------------------- 
     80      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     81      USE wrk_nemo, ONLY: zprt  => wrk_2d_1, zprw  => wrk_2d_2 
     82      USE wrk_nemo, ONLY: zdepu => wrk_3d_1, zdepv => wrk_3d_2 
     83      !! 
    6584      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file 
    6685      INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file 
     
    7493      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations) 
    7594      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    76       REAL(wp), DIMENSION(jpi,jpj)     ::   zprt , zprw    ! 2D workspace 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu, zdepv   ! 3D workspace 
    78      !!---------------------------------------------------------------------- 
     95      !!---------------------------------------------------------------------- 
     96 
     97      IF( (.not. wrk_use(2, 1,2)) .OR. (.not. wrk_use(3, 1,2)) )THEN 
     98         CALL ctl_stop('dom_wri: ERROR - requested workspace arrays unavailable.') 
     99         RETURN 
     100      END IF 
    79101 
    80102      IF(lwp) WRITE(numout,*) 
     
    122144      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 
    123145       
    124        
    125       zprt = tmask(:,:,1) * dom_uniq('T')                               !    ! unique point mask 
     146      CALL dom_uniq(zprw, 'T') 
     147      zprt = tmask(:,:,1) * zprw                               !    ! unique point mask 
    126148      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )   
    127       zprt = umask(:,:,1) * dom_uniq('U') 
     149      CALL dom_uniq(zprw, 'U') 
     150      zprt = umask(:,:,1) * zprw 
    128151      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
    129       zprt = vmask(:,:,1) * dom_uniq('V') 
     152      CALL dom_uniq(zprw, 'V') 
     153      zprt = vmask(:,:,1) * zprw 
    130154      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
    131       zprt = fmask(:,:,1) * dom_uniq('F') 
     155      CALL dom_uniq(zprw, 'F') 
     156      zprt = fmask(:,:,1) * zprw 
    132157      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )   
    133158 
     
    251276      END SELECT 
    252277      ! 
     278      IF( (.not. wrk_release(2, 1,2)) .OR. (.not. wrk_release(3, 1,2)) )THEN 
     279         CALL ctl_stop('dom_wri: ERROR - failed to release workspace arrays.') 
     280      END IF 
     281      ! 
    253282   END SUBROUTINE dom_wri 
    254283 
    255284 
    256    FUNCTION dom_uniq( cdgrd )   RESULT( puniq ) 
     285   SUBROUTINE dom_uniq(puniq, cdgrd ) 
    257286      !!---------------------------------------------------------------------- 
    258287      !!                  ***  ROUTINE dom_uniq  *** 
     
    263292      !!                2) check which elements have been changed 
    264293      !!---------------------------------------------------------------------- 
     294      !! 
     295      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     296      USE wrk_nemo, ONLY: ztstref => wrk_2d_1      ! array with different values for each element 
     297     !! 
    265298      CHARACTER(len=1)            , INTENT(in   ) ::  cdgrd   !  
    266       REAL(wp), DIMENSION(jpi,jpj)                ::  puniq   !  
    267       ! 
    268       REAL(wp), DIMENSION(jpi,jpj  ) ::  ztstref   ! array with different values for each element  
     299      REAL(wp), DIMENSION(:,:)    , INTENT(inout) ::  puniq   !  
     300      ! 
    269301      REAL(wp)                       ::  zshift    ! shift value link to the process number 
    270       LOGICAL , DIMENSION(jpi,jpj,1) ::  lldbl     ! is the point unique or not? 
    271302      INTEGER                        ::  ji        ! dummy loop indices 
    272303      !!---------------------------------------------------------------------- 
    273       ! 
     304 
     305      IF(.not. wrk_use(2, 1))THEN 
     306         CALL ctl_stop('dom_uniq: ERROR - requested workspace array unavailable.') 
     307         RETURN 
     308      END IF 
     309 
    274310      ! build an array with different values for each element  
    275311      ! in mpp: make sure that these values are different even between process 
     
    286322      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    287323      ! 
    288    END FUNCTION dom_uniq 
     324   END SUBROUTINE dom_uniq 
    289325 
    290326   !!====================================================================== 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2536 r2590  
    4242   PRIVATE 
    4343 
    44    PUBLIC   dom_zgr      ! called by dom_init.F90 
     44   PUBLIC   dom_zgr        ! called by dom_init.F90 
     45   PUBLIC   dom_zgr_alloc  ! called by nemo_alloc in nemogcm.F90 
    4546 
    4647   !                                       !!* Namelist namzgr_sco * 
     
    5455   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 
    5556   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates 
    56   
     57 
     58   !! Arrays used in zgr_sco 
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsigw3 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsigt3 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gsi3w3 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigt3 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigw3 
     64   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigtu3 
     65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigtv3 
     66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigtf3 
     67   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigwu3 
     68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   esigwv3 
     69 
    5770   !! * Substitutions 
    5871#  include "domzgr_substitute.h90" 
     
    6477   !!---------------------------------------------------------------------- 
    6578CONTAINS        
     79 
     80   FUNCTION dom_zgr_alloc() 
     81      !!---------------------------------------------------------------------- 
     82      !!                ***  FUNCTION dom_zgr_alloc  *** 
     83      !!---------------------------------------------------------------------- 
     84      INTEGER :: dom_zgr_alloc 
     85      !!---------------------------------------------------------------------- 
     86 
     87      ALLOCATE(gsigw3(jpi,jpj,jpk),  gsigt3(jpi,jpj,jpk),   & 
     88               esigt3(jpi,jpj,jpk),  esigw3(jpi,jpj,jpk),   & 
     89               esigtu3(jpi,jpj,jpk), esigtv3(jpi,jpj,jpk),  & 
     90               esigtf3(jpi,jpj,jpk), esigwu3(jpi,jpj,jpk),  & 
     91               esigwv3(jpi,jpj,jpk), Stat=dom_zgr_alloc) 
     92 
     93      IF(dom_zgr_alloc /= 0)THEN 
     94         CALL ctl_warn('dom_zgr_alloc: failed to allocate arrays.') 
     95      END IF 
     96 
     97   END FUNCTION dom_zgr_alloc 
     98 
    6699 
    67100   SUBROUTINE dom_zgr 
     
    586619      !!              - update bathy : meter bathymetry (in meters) 
    587620      !!---------------------------------------------------------------------- 
     621      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     622      USE wrk_nemo, ONLY: zbathy => wrk_2d_1 
     623      !! 
    588624      INTEGER ::   ji, jj, jl                    ! dummy loop indices 
    589625      INTEGER ::   icompt, ibtest, ikmax         ! temporary integers 
    590       REAL(wp), DIMENSION(jpi,jpj) ::   zbathy   ! temporary workspace 
    591       !!---------------------------------------------------------------------- 
     626      !!---------------------------------------------------------------------- 
     627 
     628      IF(.not. wrk_use(2, 1))THEN 
     629         CALL ctl_stop('zgr_bat_ctl: ERROR: requested workspace array unavailable.') 
     630         RETURN 
     631      END IF 
    592632 
    593633      IF(lwp) WRITE(numout,*) 
     
    693733      ENDIF 
    694734      ! 
     735      IF(.not. wrk_release(2, 1))THEN 
     736         CALL ctl_stop('zgr_bat_ctl: ERROR: failed to release workspace array.') 
     737         RETURN 
     738      END IF 
     739      ! 
    695740   END SUBROUTINE zgr_bat_ctl 
    696741 
     
    708753      !!                                     (min value = 1 over land) 
    709754      !!---------------------------------------------------------------------- 
     755      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     756      USE wrk_nemo, ONLY: zmbk => wrk_2d_1 
     757      !! 
    710758      INTEGER ::   ji, jj   ! dummy loop indices 
    711       REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace  
    712       !!---------------------------------------------------------------------- 
     759      !!---------------------------------------------------------------------- 
     760      ! 
     761      IF( .not. wrk_use(2, 1))THEN 
     762         CALL ctl_stop('zgr_bot_level: ERROR - requested 2D workspace unavailable.') 
     763         RETURN 
     764      END IF 
    713765      ! 
    714766      IF(lwp) WRITE(numout,*) 
     
    727779      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    728780      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
     781      ! 
     782      IF( .not. wrk_release(2, 1))THEN 
     783         CALL ctl_stop('zgr_bot_level: ERROR - failed to release workspace array.') 
     784         RETURN 
     785      END IF 
    729786      ! 
    730787   END SUBROUTINE zgr_bot_level 
     
    803860      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 
    804861      !!---------------------------------------------------------------------- 
     862      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     863      USE wrk_nemo, ONLY: zprt => wrk_3d_1 
     864      !! 
    805865      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    806866      INTEGER  ::   ik, it           ! temporary integers 
     
    811871      REAL(wp) ::   zdiff            ! temporary scalar 
    812872      REAL(wp) ::   zrefdep          ! temporary scalar 
    813       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprt   ! 3D workspace 
    814873      !!--------------------------------------------------------------------- 
     874      !  
     875      IF( .not. wrk_use(3, 1))THEN 
     876         CALL ctl_stop('zgr_zps: ERROR - requested workspace unavailable.') 
     877         RETURN 
     878      END IF 
    815879 
    816880      IF(lwp) WRITE(numout,*) 
     
    10041068      ENDIF   
    10051069      ! 
     1070      IF( .not. wrk_release(3, 1))THEN 
     1071         CALL ctl_stop('zgr_zps: ERROR - failed to release workspace.') 
     1072         RETURN 
     1073      END IF 
     1074      ! 
    10061075   END SUBROUTINE zgr_zps 
    10071076 
     
    10901159      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 
    10911160      !!---------------------------------------------------------------------- 
     1161      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     1162      USE wrk_nemo, ONLY: zenv => wrk_2d_1, ztmp => wrk_2d_2, zmsk => wrk_2d_3, & 
     1163                          zri => wrk_2d_4, zrj => wrk_2d_5, zhbat => wrk_2d_6 
     1164      !! 
    10921165      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument 
    10931166      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers 
    10941167      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper   ! temporary scalars 
    1095       REAL(wp), DIMENSION(jpi,jpj) ::   zenv, ztmp, zmsk    ! 2D workspace 
    1096       REAL(wp), DIMENSION(jpi,jpj) ::   zri , zrj , zhbat   !  -     - 
    1097       !! 
    1098       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gsigw3 
    1099       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gsigt3 
    1100       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gsi3w3 
    1101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigt3 
    1102       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigw3 
    1103       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigtu3 
    1104       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigtv3 
    1105       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigtf3 
    1106       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigwu3 
    1107       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   esigwv3 
    11081168      !! 
    11091169      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 
    11101170      !!---------------------------------------------------------------------- 
     1171 
     1172      IF(.not. wrk_use(2, 1,2,3,4,5,6))THEN 
     1173         CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') 
     1174         RETURN 
     1175      END IF 
    11111176 
    11121177      REWIND( numnam )                        ! Read Namelist namzgr_sco : sigma-stretching parameters 
     
    15511616!!gm bug    #endif 
    15521617      ! 
     1618      IF(.not. wrk_release(2, 1,2,3,4,5,6))THEN 
     1619         CALL ctl_stop('zgr_sco: ERROR - failed to release workspace arrays') 
     1620      END IF 
     1621      ! 
    15531622   END SUBROUTINE zgr_sco 
    15541623 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r2528 r2590  
    446446      !!                 p=integral [ rau*g dz ] 
    447447      !!---------------------------------------------------------------------- 
     448      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     449      USE wrk_nemo, ONLY: zprn => wrk_3d_1 
     450 
    448451      USE dynspg          ! surface pressure gradient             (dyn_spg routine) 
    449452      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine) 
     
    453456      INTEGER ::   indic             ! ??? 
    454457      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars 
    455       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zprn     ! workspace 
    456       !!---------------------------------------------------------------------- 
     458      !!---------------------------------------------------------------------- 
     459 
     460      IF(.NOT. wrk_use(3, 1))THEN 
     461         CALL ctl_stop('istage_uvg: requested workspace array unavailable.') 
     462         RETURN 
     463      END IF 
    457464 
    458465      IF(lwp) WRITE(numout,*)  
     
    551558      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value 
    552559      ! 
     560      IF(.NOT. wrk_release(3, 1))THEN 
     561         CALL ctl_stop('istage_uvg: failed to release workspace array.') 
     562      END IF 
     563      ! 
    553564   END SUBROUTINE istate_uvg 
    554565 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90

    r2528 r2590  
    2525   PRIVATE 
    2626 
    27    PUBLIC   dta_sal   ! called by step.F90 and inidta.F90 
    28     
    29    LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag 
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   s_dta    !: salinity data at given time-step 
     27   PUBLIC   dta_sal        ! called by step.F90 and inidta.F90 
     28   PUBLIC   dta_sal_alloc  ! Called by nemogcm.F90 
     29 
     30   LOGICAL , PUBLIC, PARAMETER              :: lk_dtasal = .TRUE. !: salinity data flag 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_dta !: salinity data at given time-step 
    3132 
    3233   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal       ! structure of input SST (file informations, fields read) 
     
    4041   !!---------------------------------------------------------------------- 
    4142CONTAINS 
     43 
     44   FUNCTION dta_sal_alloc() 
     45     IMPLICIT none 
     46     INTEGER :: dta_sal_alloc 
     47     INTEGER :: ierr 
     48 
     49     ALLOCATE(s_dta(jpi,jpj,jpk),  & 
     50              sf_sal(1),           & 
     51              Stat=ierr) 
     52     IF(ierr <= 0)THEN 
     53        ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   ) 
     54     END IF 
     55 
     56     dta_sal_alloc = ierr 
     57 
     58   END FUNCTION dta_sal_alloc 
    4259 
    4360   SUBROUTINE dta_sal( kt ) 
     
    88105            WRITE(numout,*) '~~~~~~~ ' 
    89106         ENDIF 
    90          ALLOCATE( sf_sal(1), STAT=ierror ) 
    91          IF( ierror > 0 ) THEN 
    92              CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN 
    93          ENDIF 
    94                                 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   ) 
     107! ARPDBG moved first two allocate's into dta_sal_alloc() 
     108!!$         ALLOCATE( sf_sal(1), STAT=ierror ) 
     109!!$         IF( ierror > 0 ) THEN 
     110!!$             CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN 
     111!!$         ENDIF 
     112!!$                                ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk)   ) 
    95113         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 
    96114         !                         ! fill sf_sal with sn_sal and control print 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90

    r2528 r2590  
    2525   PRIVATE 
    2626 
    27    PUBLIC   dta_tem    ! called by step.F90 and inidta.F90 
     27   PUBLIC   dta_tem        ! called by step.F90 and inidta.F90 
     28   PUBLIC   dta_tem_alloc  ! called by nemo_init in nemogcm.F90 
    2829 
    2930   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag 
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_dta !: temperature data at given time-step 
    3132 
    3233   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read) 
     
    4041   !!---------------------------------------------------------------------- 
    4142CONTAINS 
     43 
     44   FUNCTION dta_tem_alloc() 
     45     IMPLICIT none 
     46     INTEGER :: dta_tem_alloc 
     47     INTEGER :: ierror 
     48     ALLOCATE(t_dta(jpi,jpj,jpk), & 
     49              sf_tem(1),          & 
     50              STAT=ierror ) 
     51     IF( ierror <= 0 ) THEN 
     52        ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk), STAT=ierror   ) 
     53     END IF 
     54 
     55     dta_tem_alloc = ierror 
     56 
     57   END FUNCTION dta_tem_alloc 
     58 
    4259 
    4360   SUBROUTINE dta_tem( kt ) 
     
    95112            WRITE(numout,*) '~~~~~~~ ' 
    96113         ENDIF 
    97          ALLOCATE( sf_tem(1), STAT=ierror ) 
    98          IF( ierror > 0 ) THEN 
    99              CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN 
    100          ENDIF 
    101                                 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   ) 
     114! ARPDBG - moved into dta_tem_alloc() 
     115!!$         ALLOCATE( sf_tem(1), STAT=ierror ) 
     116!!$         IF( ierror > 0 ) THEN 
     117!!$             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN 
     118!!$         ENDIF 
     119!!$                                ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   ) 
    102120         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 
    103121         !                         ! fill sf_tem with sn_tem and control print 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2528 r2590  
    3535   PRIVATE 
    3636 
    37    PUBLIC   div_cur    ! routine called by step.F90 and istate.F90 
     37   PUBLIC   div_cur       ! routine called by step.F90 and istate.F90 
     38   PUBLIC   div_cur_alloc ! routine called by nemogcm.F90 
     39 
     40   ! These workspace arrays are not replaced by wrk_nemo because they  
     41   ! have extents greater than (jpi,jpj) 
     42   REAL(wp), DIMENSION(:,:) ::   zwu   ! workspace 
     43   REAL(wp), DIMENSION(:,:) ::   zwv   ! workspace 
    3844 
    3945   !! * Substitutions 
     
    4652   !!---------------------------------------------------------------------- 
    4753CONTAINS 
     54 
     55   FUNCTION div_cur_alloc() 
     56      !!---------------------------------------------------------------------- 
     57      !!               ***  ROUTINE div_cur_alloc  *** 
     58      !!---------------------------------------------------------------------- 
     59      INTEGER :: div_cur_alloc 
     60      !!---------------------------------------------------------------------- 
     61 
     62      div_cur_alloc = 0 
     63 
     64#if defined key_noslip_accurate 
     65      ALLOCATE(zwu( jpi, 1:jpj+2), zwv(-1:jpi+2, jpj), Stat=div_cur_alloc) 
     66#endif 
     67 
     68      IF(div_cur_alloc /= 0)THEN 
     69         CALL ctl_warn('div_cur_alloc: failed to allocate arrays.') 
     70      END IF 
     71 
     72   END FUNCTION div_cur_alloc 
    4873 
    4974#if defined key_noslip_accurate 
     
    88113      INTEGER ::   ijt, iju       ! temporary integer 
    89114      REAL(wp) ::  zraur, zdep 
    90       REAL(wp), DIMENSION(   jpi  ,1:jpj+2) ::   zwu   ! workspace 
    91       REAL(wp), DIMENSION(-1:jpi+2,  jpj  ) ::   zwv   ! workspace 
    92115      !!---------------------------------------------------------------------- 
    93116 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r2528 r2590  
    4949      USE oce, ONLY:   zfu => ta   ! use ta as 3D workspace 
    5050      USE oce, ONLY:   zfv => sa   ! use sa as 3D workspace 
     51      USE wrk_nemo, ONLY: zfu_t => wrk_3d_1, & ! 3D workspaces 
     52                          zfu_f => wrk_3d_2, & 
     53                          zfu_uw =>wrk_3d_3, & 
     54                          zfv_t => wrk_3d_4, &  
     55                          zfv_f => wrk_3d_5, &  
     56                          zfv_vw =>wrk_3d_6, & 
     57                          zfw   => wrk_3d_7, & 
     58                          wrk_use, wrk_release 
     59      IMPLICIT none 
    5160      !! 
    5261      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     
    5463      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    5564      REAL(wp) ::   zbu, zbv     ! temporary scalars 
    56       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zfu_t, zfu_f, zfu_uw   ! 3D workspace 
    57       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zfv_t, zfv_f, zfv_vw   !  -      - 
    58       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zfw                    !  -      - 
    5965      !!---------------------------------------------------------------------- 
    6066 
     
    6470         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    6571      ENDIF 
     72 
     73      ! Check that global workspace arrays aren't already in use 
     74      IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN 
     75         IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - global workspace arrays already in use.' 
     76         CALL ctl_stop('dyn_adv_cen2 : run-time error - global workspace arrays already in use.') 
     77      END IF 
    6678 
    6779      IF( l_trddyn ) THEN           ! Save ua and va trends 
     
    157169         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    158170      ! 
     171      ! Flag that the global workspace arrays are no longer in use 
     172      IF( .not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7) )THEN 
     173         IF(lwp) WRITE(numout, *) 'dyn_adv_cen2 : run-time error - failed to release global workspace arrays.' 
     174      END IF 
     175      ! 
    159176   END SUBROUTINE dyn_adv_cen2 
    160177 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r2528 r2590  
    7070      USE oce, ONLY:   zfu => ta   ! use ta as 3D workspace 
    7171      USE oce, ONLY:   zfv => sa   ! use sa as 3D workspace 
     72      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     73      USE wrk_nemo, ONLY: zfu_t  =>wrk_3d_1, & 
     74                          zfu_f  =>wrk_3d_2, & 
     75                          zfv_t  =>wrk_3d_3, & 
     76                          zfv_f  =>wrk_3d_4, & 
     77                          zfw    =>wrk_3d_5, & 
     78                          zfu_uw =>wrk_3d_6, & 
     79                          zfv_vw =>wrk_3d_7  
     80      USE wrk_nemo, ONLY: zlu_uu=>wrk_4d_1, & 
     81                          zlu_uv=>wrk_4d_2, & 
     82                          zlv_vv=>wrk_4d_3, & 
     83                          zlv_vu=>wrk_4d_4 
    7284      !! 
    7385      INTEGER, INTENT(in) ::   kt     ! ocean time-step index 
     
    7688      REAL(wp) ::   zbu, zbv    ! temporary scalars 
    7789      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f     ! temporary workspace 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f     !    "           " 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfw, zfu_uw, zfv_vw 
    81       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv   ! temporary workspace 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu   ! temporary workspace 
     90! ARPDBG - arrays below replaced with global work spaces 
     91!!$      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfu_t, zfu_f     ! temporary workspace 
     92!!$      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfv_t, zfv_f     !    "           " 
     93!!$      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::   zfw, zfu_uw, zfv_vw 
     94!!$      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlu_uu, zlu_uv   ! temporary workspace 
     95!!$      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   zlv_vv, zlv_vu   ! temporary workspace 
    8396      !!---------------------------------------------------------------------- 
    8497 
     
    88101         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    89102      ENDIF 
     103 
     104      ! Check that required workspace arrays are not already in use 
     105      IF( .not. wrk_use(3, 1, 2, 3, 4, 5, 6, 7) )THEN 
     106         CALL ctl_stop('dyn_adv_ubs : error : required 3d workspace array is already in use') 
     107      END IF 
     108      IF(.not. wrk_use(4, 1, 2, 3, 4) )THEN 
     109         CALL ctl_stop('dyn_adv_ubs : error : required 4d workspace array is already in use') 
     110      END IF 
     111 
    90112      zfu_t(:,:,:) = 0.e0 
    91113      zfv_t(:,:,:) = 0.e0 
     
    248270         &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    249271      ! 
     272      ! Signal that we're done with the 3D and 4D global workspace arrays 
     273      IF( (.not. wrk_release(3, 1, 2, 3, 4, 5, 6, 7)) .OR. & 
     274          (.not. wrk_release(4, 1, 2, 3, 4)) )THEN 
     275         IF(lwp) WRITE(numout,*) 'dyn_adv_ubs : failed to release workspace arrays' 
     276      END IF 
     277      ! 
    250278   END SUBROUTINE dyn_adv_ubs 
    251279 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2528 r2590  
    7676      !!             - Save the trend (l_trddyn=T) 
    7777      !!---------------------------------------------------------------------- 
     78      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     79      USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
     80      !! 
    7881      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7982      !! 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D temporary workspace 
    81       !!---------------------------------------------------------------------- 
     83      !!---------------------------------------------------------------------- 
     84      ! 
     85      IF(.NOT. wrk_use(3, 1,2))THEN 
     86         CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable.') 
     87         RETURN 
     88      END IF 
    8289      ! 
    8390      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
     
    104111      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    105112         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     113      ! 
     114      IF(.NOT. wrk_release(3, 1,2))THEN 
     115         CALL ctl_stop('dyn_hpg: failed to release workspace arrays.') 
     116      END IF 
    106117      ! 
    107118   END SUBROUTINE dyn_hpg 
     
    594605      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    595606      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     607      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     608      USE wrk_nemo, ONLY: drhox => wrk_3d_1, dzx => wrk_3d_2 
     609      USE wrk_nemo, ONLY: drhou => wrk_3d_3, dzu => wrk_3d_4, rho_i => wrk_3d_5 
     610      USE wrk_nemo, ONLY: drhoy => wrk_3d_6, dzy => wrk_3d_7 
     611      USE wrk_nemo, ONLY: drhov => wrk_3d_8, dzv => wrk_3d_9, rho_j => wrk_3d_10 
     612      USE wrk_nemo, ONLY: drhoz => wrk_3d_11, dzz => wrk_3d_12  
     613      USE wrk_nemo, ONLY: drhow => wrk_3d_13, dzw => wrk_3d_14 
     614      USE wrk_nemo, ONLY: rho_k => wrk_3d_15 
    596615      !! 
    597616      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     
    601620      REAL(wp) ::   z1_10, cffu, cffx   !    "         " 
    602621      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
    603       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhox, dzx, drhou, dzu, rho_i   ! 3D workspace 
    604       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhoy, dzy, drhov, dzv, rho_j   !  "      " 
    605       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   drhoz, dzz, drhow, dzw, rho_k   !  "      " 
    606       !!---------------------------------------------------------------------- 
     622      !!---------------------------------------------------------------------- 
     623 
     624      IF(.NOT. wrk_use(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15))THEN 
     625         CALL ctl_stop('dyn:hpg_djc : requested workspace arrays unavailable.') 
     626         RETURN 
     627      END IF 
    607628 
    608629      IF( kt == nit000 ) THEN 
     
    802823      END DO 
    803824      ! 
     825      IF(.NOT. wrk_release(3, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15))THEN 
     826         CALL ctl_stop('dyn:hpg_djc : failed to release workspace arrays.') 
     827      END IF 
     828      ! 
    804829   END SUBROUTINE hpg_djc 
    805830 
     
    815840      USE oce, ONLY :   zhpi => ta   ! use ta as 3D workspace 
    816841      USE oce, ONLY :   zhpj => sa   ! use sa as 3D workspace 
     842      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     843      USE wrk_nemo, ONLY: zdistr => wrk_2d_1, zsina => wrk_2d_2, & 
     844                          zcosa  => wrk_2d_3 
     845      USE wrk_nemo, ONLY: zhpiorg => wrk_3d_1, zhpirot => wrk_3d_2 
     846      USE wrk_nemo, ONLY: zhpitra => wrk_3d_3, zhpine => wrk_3d_4 
     847      USE wrk_nemo, ONLY: zhpjorg => wrk_3d_5, zhpjrot => wrk_3d_6 
     848      USE wrk_nemo, ONLY: zhpjtra => wrk_3d_7, zhpjne => wrk_3d_8 
    817849      !! 
    818850      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     
    821853      REAL(wp) ::   zforg, zcoef0, zuap, zmskd1, zmskd1m   ! temporary scalar 
    822854      REAL(wp) ::   zfrot        , zvap, zmskd2, zmskd2m   !    "         " 
    823       REAL(wp), DIMENSION(jpi,jpj)     ::   zdistr, zsina, zcosa                ! 2D workspace 
    824       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpiorg, zhpirot, zhpitra, zhpine   ! 3D workspace 
    825       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhpjorg, zhpjrot, zhpjtra, zhpjne   !  "      " 
    826       !!---------------------------------------------------------------------- 
     855      !!---------------------------------------------------------------------- 
     856 
     857      IF( (.NOT. wrk_use(2, 1,2,3)) .OR.               & 
     858          (.NOT. wrk_use(3, 1,2,3,4,5,6,7,8)))THEN 
     859         CALL ctl_stop('dyn:hpg_rot : requested workspace arrays unavailable.') 
     860         RETURN 
     861      END IF 
    827862 
    828863      IF( kt == nit000 ) THEN 
     
    9811016      END DO 
    9821017      ! 
     1018      IF( (.NOT. wrk_release(2, 1,2,3)) .OR.               & 
     1019          (.NOT. wrk_release(3, 1,2,3,4,5,6,7,8)))THEN 
     1020         CALL ctl_stop('dyn:hpg_rot : failed to release workspace arrays.') 
     1021      END IF 
     1022      ! 
    9831023   END SUBROUTINE hpg_rot 
    9841024 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r2528 r2590  
    5454      USE oce, ONLY :   ztrdu => ta   ! use ta as 3D workspace    
    5555      USE oce, ONLY :   ztrdv => sa   ! use sa as 3D workspace    
     56      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     57      USE wrk_nemo, ONLY: zhke => wrk_3d_1 
    5658      !! 
    5759      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     
    5961      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6062      REAL(wp) ::   zu, zv       ! temporary scalars 
    61       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zhke   ! temporary 3D workspace 
    6263      !!---------------------------------------------------------------------- 
     64 
     65      IF(.NOT. wrk_use(3,1))THEN 
     66         CALL ctl_stop('dyn_key: requested workspace array is unavailable.') 
     67      END IF 
    6368 
    6469      IF( kt == nit000 ) THEN 
     
    104109         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    105110      ! 
     111      IF(.NOT. wrk_release(3,1))THEN 
     112         CALL ctl_stop('dyn_key: failed to release workspace array.') 
     113      END IF 
     114 
    106115   END SUBROUTINE dyn_keg 
    107116 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r2528 r2590  
    5252      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    5353      !!---------------------------------------------------------------------- 
     54      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     55      USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
     56      !! 
    5457      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    55       !! 
    56       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    57       !!---------------------------------------------------------------------- 
    58  
     58      !!---------------------------------------------------------------------- 
     59 
     60      IF(.NOT. wrk_use(3, 1,2))THEN 
     61         CALL ctl_stop('dyn_ldf: requested workspace arrays unavailable.') 
     62         RETURN 
     63      END IF 
     64      ! 
    5965      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    6066         ztrdu(:,:,:) = ua(:,:,:)  
     
    106112         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    107113      ! 
     114      IF(.NOT. wrk_release(3, 1,2))THEN 
     115         CALL ctl_stop('dyn_ldf: failed to release workspace arrays.') 
     116      END IF 
     117      ! 
    108118   END SUBROUTINE dyn_ldf 
    109119 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r2528 r2590  
    7979      !!   9.0  !  04-08  (C. Talandier) New trends organization 
    8080      !!---------------------------------------------------------------------- 
     81      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     82      USE wrk_nemo, ONLY: zcu => wrk_2d_1, zcv => wrk_2d_2  
     83      USE wrk_nemo, ONLY: zuf => wrk_3d_1, zut => wrk_3d_2, & 
     84                          zlu => wrk_3d_3, zlv => wrk_3d_4 
    8185      !! * Arguments 
    8286      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
     
    8589      INTEGER  ::   ji, jj, jk                ! dummy loop indices 
    8690      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v ! temporary scalar 
    87       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    88          zcu, zcv                             ! temporary workspace 
    89       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    90          zuf, zut, zlu, zlv                   ! temporary workspace 
    9191      !!---------------------------------------------------------------------- 
    9292      !!  OPA 8.5, LODYC-IPSL (2002) 
    9393      !!---------------------------------------------------------------------- 
     94 
     95      IF( (.NOT. wrk_use(2, 1,2)) .OR. (.NOT. wrk_use(3, 1,2,3,4)) )THEN 
     96         CALL ctl_stop('dyn_ldf_bilap : requested workspace arrays unavailable.') 
     97         RETURN 
     98      END IF 
    9499 
    95100      IF( kt == nit000 ) THEN 
     
    214219      END DO                                           !   End of slab 
    215220      !                                                ! =============== 
    216  
     221      IF( (.NOT. wrk_release(2, 1,2)) .OR.       & 
     222          (.NOT. wrk_release(3, 1,2,3,4)) )THEN 
     223         CALL ctl_stop('dyn_ldf_bilap : failed to release workspace arrays.') 
     224      END IF 
     225      ! 
    217226   END SUBROUTINE dyn_ldf_bilap 
    218227 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r2528 r2590  
    2828 
    2929   !! * Routine accessibility 
    30    PUBLIC dyn_ldf_bilapg ! called by step.F90 
     30   PUBLIC dyn_ldf_bilapg       ! called by step.F90 
     31   PUBLIC dyn_ldf_bilapg_alloc ! called by nemogcm.F90 
     32 
     33   ! These are just workspace arrays but since they're (jpi,jpk) it's not 
     34   ! worth putting them in the wrk_nemo module. 
     35   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw, zdiu, zdiv 
     36   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  
    3137 
    3238   !! * Substitutions 
     
    4046 
    4147CONTAINS 
     48 
     49   FUNCTION dyn_ldf_bilapg_alloc() 
     50      !!---------------------------------------------------------------------- 
     51      !!               ***  ROUTINE dyn_ldf_bilapg_alloc  *** 
     52      !!---------------------------------------------------------------------- 
     53      INTEGER :: dyn_ldf_bilapg_alloc 
     54 
     55      ALLOCATE(zfuw(jpi,jpk), zfvw(jpi,jpk),  zdiu(jpi,jpk), zdiv(jpi,jpk), & 
     56               zdju(jpi,jpk), zdj1u(jpi,jpk), zdjv(jpi,jpk), zdj1v(jpi,jpk),& 
     57               Stat = dyn_ldf_bilapg_alloc) 
     58 
     59      IF(dyn_ldf_bilapg_alloc /= 0)THEN 
     60         CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 
     61      END IF 
     62 
     63   END FUNCTION dyn_ldf_bilapg_alloc 
     64 
    4265 
    4366   SUBROUTINE dyn_ldf_bilapg( kt ) 
     
    7699      USE oce, ONLY :    zwk3 => ta,   & ! use ta as 3D workspace    
    77100                         zwk4 => sa      ! use sa as 3D workspace    
    78  
     101      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     102      ! work array used for rotated biharmonic operator on  
     103      ! tracers and/or momentum 
     104      USE wrk_nemo, ONLY: zwk1 => wrk_3d_1, &  
     105                          zwk2 => wrk_3d_2 
    79106      !! * Arguments 
    80107      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
     
    82109      !! * Local declarations 
    83110      INTEGER ::   ji, jj, jk                 ! dummy loop indices 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    85          zwk1, zwk2                ! work array used for rotated biharmonic 
    86          !                         ! operator on tracers and/or momentum 
    87       !!---------------------------------------------------------------------- 
     111      !!---------------------------------------------------------------------- 
     112 
     113      IF(.NOT. wrk_use(3, 1,2))THEN 
     114         CALL ctl_stop('dyn_ldf_bilapg: requested workspace arrays unavailable.') 
     115         RETURN 
     116      END IF 
    88117 
    89118      IF( kt == nit000 ) THEN 
     
    130159      END DO                                           !   End of slab 
    131160      !                                                ! =============== 
    132  
     161      IF(.NOT. wrk_release(3, 1,2))THEN 
     162         CALL ctl_stop('dyn_ldf_bilapg: failed to release workspace arrays.') 
     163      END IF 
     164      ! 
    133165   END SUBROUTINE dyn_ldf_bilapg 
    134166 
     
    179211      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    180212      !!---------------------------------------------------------------------- 
     213      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     214      USE wrk_nemo, ONLY: ziut => wrk_2d_1, zjuf => wrk_2d_2, zjvt => wrk_2d_3 
     215      USE wrk_nemo, ONLY: zivf => wrk_2d_4, zdku => wrk_2d_5, zdk1u => wrk_2d_6 
     216      USE wrk_nemo, ONLY: zdkv => wrk_2d_7, zdk1v => wrk_2d_8 
     217      !! 
    181218      !! * Arguments 
    182219      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
     
    199236         zbur, zbvr, zmkt, zmkf, zuav, zvav,    & 
    200237         zuwslpi, zuwslpj, zvwslpi, zvwslpj 
    201       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    202          ziut, zjuf , zjvt, zivf,       &  ! workspace 
    203          zdku, zdk1u, zdkv, zdk1v 
    204       REAL(wp), DIMENSION(jpi,jpk) ::   & 
    205          zfuw, zfvw, zdiu, zdiv,        &  ! workspace 
    206          zdju, zdj1u, zdjv, zdj1v  
    207       !!---------------------------------------------------------------------- 
    208  
     238      !!---------------------------------------------------------------------- 
     239 
     240      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 
     241         CALL ctl_stop('dyn:ldfguv : requested workspace arrays unavailable.') 
     242         RETURN 
     243      END IF 
    209244      !                               ! ********** !   ! =============== 
    210245      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab 
     
    461496      END DO                                           !   End of slab 
    462497      !                                                ! =============== 
     498 
     499      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8))THEN 
     500         CALL ctl_stop('dyn:ldfguv : failed to release workspace arrays.') 
     501      END IF 
     502      ! 
    463503   END SUBROUTINE ldfguv 
    464504 
     
    469509CONTAINS 
    470510   SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine 
     511      INTEGER, INTENT(in) :: kt 
    471512      WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt 
    472513   END SUBROUTINE dyn_ldf_bilapg 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r2528 r2590  
    3030   !! * Routine accessibility 
    3131   PUBLIC dyn_ldf_iso           ! called by step.F90 
     32   PUBLIC dyn_ldf_iso_alloc     ! called by nemogcm.F90 
     33 
     34   ! These are just workspace arrays but because they are (jpi,jpk) in extent 
     35   ! we can't use the arrays in wrk_nemo for them 
     36   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u 
     37   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v 
    3238 
    3339   !! * Substitutions 
     
    4248 
    4349CONTAINS 
     50 
     51   FUNCTION dyn_ldf_iso_alloc() 
     52      !!---------------------------------------------------------------------- 
     53      !!                  ***  ROUTINE dyn_ldf_iso_alloc  *** 
     54      !!---------------------------------------------------------------------- 
     55      INTEGER :: dyn_ldf_iso_alloc 
     56      !!---------------------------------------------------------------------- 
     57 
     58      ALLOCATE(zfuw(jpi,jpk), zdiu(jpi,jpk), zdju(jpi,jpk), zdj1u(jpi,jpk), &  
     59               zfvw(jpi,jpk), zdiv(jpi,jpk), zdjv(jpi,jpk), zdj1v(jpi,jpk), & 
     60               Stat=dyn_ldf_iso_alloc) 
     61 
     62      IF(dyn_ldf_iso_alloc /= 0)THEN 
     63         CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 
     64      END IF 
     65 
     66   END FUNCTION dyn_ldf_iso_alloc 
     67 
    4468 
    4569   SUBROUTINE dyn_ldf_iso( kt ) 
     
    93117      !!        !  05-11  (G. Madec)  s-coordinate: horizontal diffusion 
    94118      !!---------------------------------------------------------------------- 
     119      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     120      USE wrk_nemo, ONLY: ziut => wrk_2d_1, zjuf  => wrk_2d_2, & ! temporary workspace 
     121                          zjvt => wrk_2d_3, zivf  => wrk_2d_4, &  
     122                          zdku => wrk_2d_5, zdk1u => wrk_2d_6, & 
     123                          zdkv => wrk_2d_7, zdk1v => wrk_2d_8 
     124      !! 
    95125      !! * Arguments 
    96126      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
     
    102132         zmskt, zmskf, zbu, zbv,       & 
    103133         zuah, zvah 
    104       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    105          ziut, zjuf, zjvt, zivf,        & ! temporary workspace 
    106          zdku, zdk1u, zdkv, zdk1v 
    107134 
    108135      REAL(wp) ::   & 
    109136         zcoef0, zcoef3, zcoef4, zmkt, zmkf,   & 
    110137         zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj 
    111       REAL(wp), DIMENSION(jpi,jpk) ::        & 
    112          zfuw, zdiu, zdju, zdj1u,            & !    "        " 
    113          zfvw, zdiv, zdjv, zdj1v 
    114  
    115       !!---------------------------------------------------------------------- 
     138 
     139      !!---------------------------------------------------------------------- 
     140 
     141      IF( .NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 
     142         CALL ctl_stop('dyn_ldf_iso: requested workspace arrays unavailable.') 
     143         RETURN 
     144      END IF 
    116145 
    117146      IF( kt == nit000 ) THEN 
     
    420449      !                                                ! =============== 
    421450 
     451      IF( .NOT. wrk_release(2, 1,2,3,4,5,6,7,8))THEN 
     452         CALL ctl_stop('dyn_ldf_iso: failed to release workspace arrays.') 
     453      END IF 
     454 
    422455   END SUBROUTINE dyn_ldf_iso 
    423456 
     
    428461CONTAINS 
    429462   SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine 
     463      INTEGER, INTENT(in) :: kt 
    430464      WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt 
    431465   END SUBROUTINE dyn_ldf_iso 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2528 r2590  
    9393      USE oce, ONLY :   ze3u_f => ta   ! use ta as 3D workspace 
    9494      USE oce, ONLY :   ze3v_f => sa   ! use sa as 3D workspace 
     95      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     96      USE wrk_nemo, ONLY:   zs_t => wrk_2d_1, zs_u_1 => wrk_2d_2, & 
     97                          zs_v_1 => wrk_2d_3 
    9598      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    9699      !! 
     
    105108      REAL(wp) ::   zv_t_ij  , zv_t_ip1j     !     -        - 
    106109      REAL(wp) ::   zv_t_ijp1                !     -        - 
    107       REAL(wp), DIMENSION(jpi,jpj) ::  zs_t, zs_u_1, zs_v_1      ! temporary 2D workspace 
    108110      !!---------------------------------------------------------------------- 
     111 
     112      IF(.NOT. wrk_use(2, 1,2,3))THEN 
     113         CALL ctl_stop('dyn_nxt: requested workspace arrays unavailable.') 
     114         RETURN 
     115      END IF 
    109116 
    110117      IF( kt == nit000 ) THEN 
     
    318325         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
    319326      !  
     327      IF(.NOT. wrk_release(2, 1,2,3))THEN 
     328         CALL ctl_stop('dyn_nxt: failed to release workspace arrays.') 
     329      END IF 
     330      ! 
    320331   END SUBROUTINE dyn_nxt 
    321332 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2528 r2590  
    7373      !!        of the physical meaning of the results.  
    7474      !!---------------------------------------------------------------------- 
     75      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     76      USE wrk_nemo, ONLY: ztrdu => wrk_3d_4, ztrdv => wrk_3d_5 
     77      !! 
    7578      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    7679      INTEGER, INTENT(  out) ::   kindic   ! solver flag 
     
    7881      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    7982      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    81       !!---------------------------------------------------------------------- 
    82  
     83      !!---------------------------------------------------------------------- 
     84 
     85      IF(.NOT. wrk_use(3, 4,5))THEN 
     86         CALL ctl_stop('dyn_spg: requested workspace arrays unavailable.') 
     87         RETURN 
     88      END IF 
    8389 
    8490!!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that  
     
    149155         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    150156      ! 
     157      IF(.NOT. wrk_release(3, 4,5))THEN 
     158         CALL ctl_stop('dyn_spg: failed to release workspace arrays.') 
     159      END IF 
     160      ! 
    151161   END SUBROUTINE dyn_spg 
    152162 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    r2528 r2590  
    3535#if   defined key_dynspg_ts   ||   defined key_vvl   ||   defined key_esopa 
    3636  !                                                                !!! Time splitting scheme (sub-time step variables) 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ua_e  , va_e             ! barotropic velocities (after) 
    38    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshn_e, ssha_e, sshn_b   ! sea surface heigth (now, after, average) 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu_e  , hv_e             ! now ocean depth ( = Ho+sshn_e ) 
    40    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hur_e , hvr_e            ! inverse of the now depth ( = 1/(Ho+sshn_e) ) 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e  , va_e             ! barotropic velocities (after) 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e, sshn_b   ! sea surface heigth (now, after, average) 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e  , hv_e             ! now ocean depth ( = Ho+sshn_e ) 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e            ! inverse of the now depth ( = 1/(Ho+sshn_e) ) 
    4141#endif 
    4242 
     
    4646   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4747   !!====================================================================== 
     48CONTAINS 
     49 
     50  FUNCTION dynspg_oce_alloc() 
     51    IMPLICIT none 
     52    INTEGER :: dynspg_oce_alloc 
     53 
     54    dynspg_oce_alloc = 0 
     55 
     56#if   defined key_dynspg_ts   ||   defined key_vvl   ||   defined key_esopa 
     57    ALLOCATE(ua_e(jpi,jpj),   va_e(jpi,jpj)  ,                  & 
     58             sshn_e(jpi,jpj), ssha_e(jpi,jpj), sshn_b(jpi,jpj), & 
     59             hu_e(jpi,jpj),   hv_e(jpi,jpj)  ,                  & 
     60             hur_e(jpi,jpj),  hvr_e(jpi,jpj) ,                  & 
     61             Stat=dynspg_oce_alloc) 
     62#endif 
     63 
     64  END FUNCTION dynspg_oce_alloc 
     65 
    4866END MODULE dynspg_oce 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r2564 r2590  
    4545   PRIVATE 
    4646 
    47    PUBLIC dyn_spg_ts  ! routine called by step.F90 
    48    PUBLIC ts_rst      ! routine called by istate.F90 
    49  
    50  
    51    REAL(wp), DIMENSION(jpi,jpj) ::  ftnw, ftne   ! triad of coriolis parameter 
    52    REAL(wp), DIMENSION(jpi,jpj) ::  ftsw, ftse   ! (only used with een vorticity scheme) 
    53  
    54    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   un_b, vn_b   ! now    averaged velocity 
    55    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ub_b, vb_b   ! before averaged velocity 
     47   PUBLIC dyn_spg_ts        ! routine called by step.F90 
     48   PUBLIC ts_rst            ! routine called by istate.F90 
     49   PUBLIC dyn_spg_ts_alloc  ! routine called by nemogcm.F90 
     50 
     51 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   ! triad of coriolis parameter 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   ! (only used with een vorticity scheme) 
     54 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_b, vn_b   ! now    averaged velocity 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b, vb_b   ! before averaged velocity 
    5657 
    5758 
     
    6667 
    6768CONTAINS 
     69 
     70   FUNCTION dyn_spg_ts_alloc() 
     71      !!---------------------------------------------------------------------- 
     72      !!                  ***  routine dyn_spg_ts_alloc  *** 
     73      !!---------------------------------------------------------------------- 
     74      IMPLICIT none 
     75      INTEGER :: dyn_spg_ts_malloc 
     76      !!---------------------------------------------------------------------- 
     77 
     78      ALLOCATE(ftnw(jpi,jpj), ftne(jpi,jpj), ftsw(jpi,jpj), ftse(jpi,jpj), & 
     79               un_b(jpi,jpj), vn_b(jpi,jpj), ub_b(jpi,jpj), vb_b(jpi,jpj), & 
     80               Stat=dyn_spg_ts_malloc) 
     81 
     82   END FUNCTION dyn_spg_ts_malloc 
     83 
    6884 
    6985   SUBROUTINE dyn_spg_ts( kt ) 
     
    94110      !! References : Griffies et al., (2003): A technical guide to MOM4. NOAA/GFDL 
    95111      !!--------------------------------------------------------------------- 
     112      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     113      USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, zsshb_e => wrk_2d_2 
     114      USE wrk_nemo, ONLY: zbfru => wrk_2d_3  , zbfrv => wrk_2d_4  
     115      USE wrk_nemo, ONLY: zsshun_e => wrk_2d_5, zsshvn_e => wrk_2d_6 
     116      USE wrk_nemo, ONLY: zcu => wrk_2d_7, zwx => wrk_2d_8, zua => wrk_2d_9, zun => wrk_2d_10 
     117      USE wrk_nemo, ONLY: zcv => wrk_2d_11, zwy => wrk_2d_12, zva => wrk_2d_13, zvn => wrk_2d_14 
     118      USE wrk_nemo, ONLY: zun_e => wrk_2d_15, zub_e => wrk_2d_16, zu_sum => wrk_2d_17 
     119      USE wrk_nemo, ONLY: zvn_e => wrk_2d_18, zvb_e => wrk_2d_19, zv_sum => wrk_2d_20 
     120      USE wrk_nemo, ONLY: zssh_sum => wrk_2d_21 
     121      !! 
    96122      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
    97123      !! 
     
    104130      REAL(wp) ::   zu_spg, zu_cor, zu_sld, zu_asp   !     -         - 
    105131      REAL(wp) ::   zv_spg, zv_cor, zv_sld, zv_asp   !     -         - 
    106       !! 
    107       REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv, zsshb_e 
    108       !! 
    109       REAL(wp), DIMENSION(jpi,jpj) ::   zbfru  , zbfrv     ! 2D workspace 
    110       !! 
    111       REAL(wp), DIMENSION(jpi,jpj) ::   zsshun_e, zsshvn_e   ! 2D workspace 
    112       !! 
    113       REAL(wp), DIMENSION(jpi,jpj) ::   zcu, zwx, zua, zun   ! 2D workspace 
    114       REAL(wp), DIMENSION(jpi,jpj) ::   zcv, zwy, zva, zvn   !  -      - 
    115       REAL(wp), DIMENSION(jpi,jpj) ::   zun_e, zub_e, zu_sum      ! 2D workspace 
    116       REAL(wp), DIMENSION(jpi,jpj) ::   zvn_e, zvb_e, zv_sum      !  -      - 
    117       REAL(wp), DIMENSION(jpi,jpj) ::   zssh_sum                  !  -      - 
    118132      !!---------------------------------------------------------------------- 
     133 
     134      IF(.NOT. wrk_use(2,  1, 2, 3, 4, 5, 6, 7, 8, 9,10,         & 
     135                          11,12,13,14,15,16,17,18,19,20,21))THEN 
     136         CALL ctl_stop('dyn_spg_ts: requested workspace arrays unavailable.') 
     137         RETURN 
     138      END IF 
    119139 
    120140      IF( kt == nit000 ) THEN             !* initialisation 
     
    550570      ! 
    551571      ! 
     572      IF(.NOT. wrk_release(2,  1, 2, 3, 4, 5, 6, 7, 8, 9,10,         & 
     573                              11,12,13,14,15,16,17,18,19,20,21))THEN 
     574         CALL ctl_stop('dyn_spg_ts: failed to release workspace arrays.') 
     575      END IF 
     576      ! 
    552577   END SUBROUTINE dyn_spg_ts 
    553578 
     
    641666CONTAINS 
    642667   SUBROUTINE dyn_spg_ts( kt )       ! Empty routine 
     668      INTEGER, INTENT(in) :: kt 
    643669      WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt 
    644670   END SUBROUTINE dyn_spg_ts 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r2528 r2590  
    3939   PUBLIC   dyn_vor        ! routine called by step.F90 
    4040   PUBLIC   dyn_vor_init   ! routine called by opa.F90 
     41   PUBLIC   dyn_vor_alloc  ! routine called by nemogcm.F90 
    4142 
    4243   !                                             !!* Namelist namdyn_vor: vorticity term 
     
    5051   INTEGER ::   nrvm = 2   ! =2 relative vorticity ; =3 metric term 
    5152   INTEGER ::   ntot = 4   ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term 
     53 
     54!!$#if defined key_vvl 
     55!!$   REAL(wp), DIMENSION(jpi,jpj,jpk)       ::   ze3f  
     56!!$#else 
     57!!$   REAL(wp), ALLOCATABLE, DIMENSION(jpi,jpj,jpk), SAVE ::   ze3f 
     58!!$#endif 
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ze3f 
    5260 
    5361   !! * Substitutions 
     
    6169 
    6270CONTAINS 
     71 
     72   FUNCTION dyn_vor_alloc() 
     73      !!---------------------------------------------------------------------- 
     74      !!              *** Routine dyn_vor_alloc *** 
     75      !!---------------------------------------------------------------------- 
     76      IMPLICIT none 
     77      INTEGER :: dyn_vor_alloc 
     78      !!---------------------------------------------------------------------- 
     79 
     80      ALLOCATE(ze3f(jpi,jpj,jpk), Stat=dyn_vor_alloc) 
     81 
     82      IF(dyn_vor_alloc /= 0 )THEN 
     83         CALL ctl_warn('dyn_vor_alloc: failed to allocate array ze3f.') 
     84      END IF 
     85 
     86   END FUNCTION dyn_vor_alloc 
     87 
    6388 
    6489   SUBROUTINE dyn_vor( kt ) 
     
    205230      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    206231      !!---------------------------------------------------------------------- 
     232      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     233      USE wrk_nemo, ONLY: zwx => wrk_2d_1, zwy => wrk_2d_2, zwz => wrk_2d_3 
     234      !! 
    207235      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    208236      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     
    214242      REAL(wp) ::   zx1, zy1, zfact2   ! temporary scalars 
    215243      REAL(wp) ::   zx2, zy2           !    "         " 
    216       REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! temporary 2D workspace 
    217       !!---------------------------------------------------------------------- 
     244      !!---------------------------------------------------------------------- 
     245 
     246      IF(.NOT. wrk_use(2, 1,2,3))THEN 
     247         CALL ctl_stop('dyn:vor_ene: requested workspace arrays unavailable.') 
     248         RETURN 
     249      END IF 
    218250 
    219251      IF( kt == nit000 ) THEN 
     
    280312      END DO                                           !   End of slab 
    281313      !                                                ! =============== 
     314      IF(.NOT. wrk_release(2, 1,2,3))THEN 
     315         CALL ctl_stop('dyn:vor_ene: failed to release workspace arrays.') 
     316      END IF 
     317      ! 
    282318   END SUBROUTINE vor_ene 
    283319 
     
    314350      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    315351      !!---------------------------------------------------------------------- 
     352      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     353      USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, & 
     354                          zwz => wrk_2d_6, zww => wrk_2d_7 
     355      !! 
    316356      INTEGER, INTENT(in) ::   kt   ! ocean timestep index 
    317357      !! 
     
    319359      REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! temporary scalars 
    320360      REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !    "         " 
    321       REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz, zww   ! temporary 3D workspace 
    322       !!---------------------------------------------------------------------- 
     361      !!---------------------------------------------------------------------- 
     362 
     363      IF(.NOT. wrk_use(2, 4,5,6,7))THEN 
     364         CALL ctl_stop('dyn:vor_mix: requested workspace arrays unavailable.') 
     365         RETURN 
     366      END IF 
    323367 
    324368      IF( kt == nit000 ) THEN 
     
    392436      END DO                                           !   End of slab 
    393437      !                                                ! =============== 
     438      IF(.NOT. wrk_release(2, 4,5,6,7))THEN 
     439         CALL ctl_stop('dyn:vor_mix: failed to release workspace arrays.') 
     440      END IF 
     441      ! 
    394442   END SUBROUTINE vor_mix 
    395443 
     
    421469      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    422470      !!---------------------------------------------------------------------- 
     471      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     472      USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, zwz => wrk_2d_6 
     473      !! 
    423474      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    424475      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     
    429480      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    430481      REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars 
    431       REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz   ! temporary 3D workspace 
    432482      !!---------------------------------------------------------------------- 
    433483       
     484      IF(.NOT. wrk_use(2, 4,5,6))THEN 
     485         CALL ctl_stop('dyn:vor_ens : requested workspace arrays unavailable.') 
     486         RETURN 
     487      END IF 
     488 
    434489      IF( kt == nit000 ) THEN 
    435490         IF(lwp) WRITE(numout,*) 
     
    503558      END DO                                           !   End of slab 
    504559      !                                                ! =============== 
     560      IF(.NOT. wrk_release(2, 4,5,6))THEN 
     561         CALL ctl_stop('dyn:vor_ens : failed to release workspace arrays.') 
     562      END IF 
     563      ! 
    505564   END SUBROUTINE vor_ens 
    506565 
     
    525584      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    526585      !!---------------------------------------------------------------------- 
     586      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     587      USE wrk_nemo, ONLY: zwx => wrk_2d_1,  zwy => wrk_2d_2,  zwz => wrk_2d_3  
     588      USE wrk_nemo, ONLY: ztnw => wrk_2d_4, ztne => wrk_2d_5, & 
     589                          ztsw => wrk_2d_6, ztse => wrk_2d_7 
     590      !! 
    527591      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    528592      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
     
    533597      INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    534598      REAL(wp) ::   zfac12, zua, zva   ! temporary scalars 
    535       REAL(wp), DIMENSION(jpi,jpj) ::   zwx, zwy, zwz            ! temporary 2D workspace 
    536       REAL(wp), DIMENSION(jpi,jpj) ::   ztnw, ztne, ztsw, ztse   ! temporary 3D workspace 
    537 #if defined key_vvl 
    538       REAL(wp), DIMENSION(jpi,jpj,jpk)       ::   ze3f 
    539 #else 
    540       REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE ::   ze3f 
    541 #endif 
    542       !!---------------------------------------------------------------------- 
     599      !!---------------------------------------------------------------------- 
     600 
     601      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7))THEN 
     602         CALL ctl_stop('dyn:vor_een : requested workspace arrays unavailable.') 
     603         RETURN 
     604      END IF 
    543605 
    544606      IF( kt == nit000 ) THEN 
     
    634696      END DO                                           !   End of slab 
    635697      !                                                ! =============== 
     698      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7))THEN 
     699         CALL ctl_stop('dyn:vor_een : failed to release workspace arrays.') 
     700      END IF 
     701      ! 
    636702   END SUBROUTINE vor_een 
    637703 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r2528 r2590  
    5656      USE oce, ONLY:   zwuw => ta   ! use ta as 3D workspace 
    5757      USE oce, ONLY:   zwvw => sa   ! use sa as 3D workspace 
     58      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     59      USE wrk_nemo, ONLY: zww => wrk_2d_1 
     60      USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
    5861      !! 
    5962      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
     
    6164      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    6265      REAL(wp) ::   zua, zva        ! temporary scalars 
    63       REAL(wp), DIMENSION(jpi,jpj)     ::   zww            ! 2D  workspace 
    64       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    6566      !!---------------------------------------------------------------------- 
    6667       
     68      IF( (.NOT. wrk_use(2, 1))  .OR.    & 
     69          (.NOT. wrk_use(3, 1,2)) )THEN 
     70         CALL ctl_stop('dyn_zad: requested workspace arrays unavailable.') 
     71         RETURN 
     72      END IF 
     73 
    6774      IF( kt == nit000 ) THEN 
    6875         IF(lwp)WRITE(numout,*) 
     
    119126         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    120127      ! 
     128      IF( (.NOT. wrk_release(2, 1))  .OR.    & 
     129          (.NOT. wrk_release(3, 1,2)) )THEN 
     130         CALL ctl_stop('dyn_zad: failed to release workspace arrays.') 
     131      END IF 
     132 
    121133   END SUBROUTINE dyn_zad 
    122134 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r2528 r2590  
    5252      !! ** Purpose :   compute the vertical ocean dynamics physics. 
    5353      !!--------------------------------------------------------------------- 
     54      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     55      USE wrk_nemo, ONLY: ztrdu => wrk_3d_1, ztrdv => wrk_3d_2 
     56      !! 
    5457      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    55       !! 
    56       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace 
    5758      !!--------------------------------------------------------------------- 
    5859 
     60      IF(.NOT. wrk_use(3, 1,2))THEN 
     61         CALL ctl_stop('dyn_zdf: requested workspace arrays unavailable.') 
     62         RETURN 
     63      END IF 
    5964      !                                          ! set time step 
    6065      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdtra (restart with Euler time stepping) 
     
    8994      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf  - Ua: ', mask1=umask,               & 
    9095            &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     96      ! 
     97      IF(.NOT. wrk_release(3, 1,2))THEN 
     98         CALL ctl_stop('dyn_zdf: failed to release workspace arrays.') 
     99      END IF 
    91100      ! 
    92101   END SUBROUTINE dyn_zdf 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r2528 r2590  
    2424   PRIVATE 
    2525 
    26    PUBLIC   dyn_zdf_exp   ! called by step.F90 
     26   PUBLIC   dyn_zdf_exp       ! called by step.F90 
     27   PUBLIC   dyn_zdf_exp_alloc ! called by nemogcm.F90 
    2728 
     29   ! 2D workspaces. Not replaced with wrk_nemo arrays because these 
     30   ! have shape (jpi,jpk). 
     31   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwx, zwy, zwz, zww  
     32    
    2833   !! * Substitutions 
    2934#  include "domzgr_substitute.h90" 
     
    3641 
    3742CONTAINS 
     43 
     44   FUNCTION dyn_zdf_exp_alloc() 
     45      !!---------------------------------------------------------------------- 
     46      !!                ***  ROUTINE dyn_zdf_exp_alloc  *** 
     47      !!---------------------------------------------------------------------- 
     48      INTEGER :: dyn_zdf_exp_alloc 
     49      !!---------------------------------------------------------------------- 
     50 
     51      ALLOCATE(zwx(jpi,jpk), zwy(jpi,jpk), zwz(jpi,jpk), zww(jpi,jpk), & 
     52               Stat=dyn_zdf_exp_alloc) 
     53 
     54      IF(dyn_zdf_exp_alloc /= 0)THEN 
     55         CALL ctl_warn('dyn_zdf_exp_alloc: failed to allocate arrays.') 
     56      END IF 
     57 
     58   END FUNCTION dyn_zdf_exp_alloc 
     59 
    3860 
    3961   SUBROUTINE dyn_zdf_exp( kt, p2dt ) 
     
    5880      INTEGER ::   ji, jj, jk, jl                            ! dummy loop indices 
    5981      REAL(wp) ::   zrau0r, zlavmr, zua, zva                 ! temporary scalars 
    60       REAL(wp), DIMENSION(jpi,jpk) ::   zwx, zwy, zwz, zww   ! 2D workspace 
    6182      !!---------------------------------------------------------------------- 
    6283 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r2528 r2590  
    5656      USE oce, ONLY :  zwd   => ta      ! use ta as workspace 
    5757      USE oce, ONLY :  zws   => sa      ! use sa as workspace 
     58      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     59      USE wrk_nemo, ONLY: zwi => wrk_3d_3 ! workspace 
    5860      !! 
    5961      INTEGER , INTENT( in ) ::   kt    ! ocean time-step index 
     
    6365      REAL(wp) ::   z1_p2dt, zcoef         ! temporary scalars 
    6466      REAL(wp) ::   zzwi, zzws, zrhs       ! temporary scalars 
    65       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi        ! 3D workspace 
    6667      !!---------------------------------------------------------------------- 
     68 
     69      IF(.NOT. wrk_use(3, 3))THEN 
     70         CALL ctl_stop('dyn_zdf_imp : requested workspace array unavailable.') 
     71         RETURN 
     72      END IF 
    6773 
    6874      IF( kt == nit000 ) THEN 
     
    253259      END DO 
    254260      ! 
     261      IF(.NOT. wrk_release(3, 3))THEN 
     262         CALL ctl_stop('dyn_zdf_imp : failed to release workspace array.') 
     263      END IF 
     264      ! 
    255265   END SUBROUTINE dyn_zdf_imp 
    256266 
  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2528 r2590  
    7676      !!---------------------------------------------------------------------- 
    7777      USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace 
     78      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     79      USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_2 
    7880      !! 
    7981      INTEGER, INTENT(in) ::   kt   ! time step 
     
    8284      REAL(wp) ::   zcoefu, zcoefv, zcoeff      ! temporary scalars 
    8385      REAL(wp) ::   z2dt, z1_2dt, z1_rau0       ! temporary scalars 
    84       REAL(wp), DIMENSION(jpi,jpj) ::   zhdiv       ! 2D workspace 
    85       REAL(wp), DIMENSION(jpi,jpj) ::   z2d         ! 2D workspace 
    86       !!---------------------------------------------------------------------- 
     86      !!---------------------------------------------------------------------- 
     87 
     88      IF(.NOT. wrk_use(2, 1,2))THEN 
     89         CALL ctl_stop('ssh_wzv: requested workspace arrays unavailable.') 
     90         RETURN 
     91      END IF 
    8792 
    8893      IF( kt == nit000 ) THEN 
     
    239244      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 ) 
    240245      ! 
     246      IF(.NOT. wrk_release(2, 1,2))THEN 
     247