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 (13 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         CALL ctl_stop('ssh_wzv: failed to release workspace arrays.') 
     248      END IF 
     249      ! 
    241250   END SUBROUTINE ssh_wzv 
    242251 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90

    r2528 r2590  
    1616   PUBLIC 
    1717 
     18   PUBLIC flo_oce_alloc ! Routine called in nemogcm.F90 
     19 
    1820   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    !: float flag 
    1921 
    … …  
    3234   REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   tpifl, tpjfl, tpkfl   !: (i,j,k) indices of float position 
    3335 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   wb              !: vertical velocity at previous time step (m s-1). 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wb              !: vertical velocity at previous time step (m s-1). 
    3537    
    3638   !                                            !!! * namelist namflo : langrangian floats * 
    … …  
    4042   INTEGER, PUBLIC  ::   nn_writefl = 150        !: frequency of float output file  
    4143   INTEGER, PUBLIC  ::   nn_stockfl = 450        !: frequency of float restart file 
     44 
     45CONTAINS 
     46 
     47   FUNCTION flo_oce_alloc() 
     48     IMPLICIT none 
     49     INTEGER :: flo_oce_alloc 
     50 
     51     ALLOCATE(wb(jpi,jpj,jpk), Stat=flo_oce_alloc) 
     52 
     53   END FUNCTION flo_oce_alloc 
    4254 
    4355#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r2528 r2590  
    2323   PRIVATE 
    2424 
    25    PUBLIC   flo_wri    ! routine called by floats.F90 
     25   PUBLIC   flo_wri          ! routine called by floats.F90 
     26   PUBLIC   flow_wri_alloc   ! routine called by nemogcm.F90 
    2627 
    2728   INTEGER ::   jfl      ! number of floats 
    2829   INTEGER ::   numflo   ! logical unit for drifting floats 
     30 
     31   ! Following are only workspace arrays but shape is not (jpi,jpj) and 
     32   ! therefore make them module arrays rather than replacing with wrk_nemo 
     33   ! member arrays. 
     34   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ztemp, zsal   ! 2D workspace 
    2935 
    3036   !! * Substitutions 
    … …  
    3642   !!---------------------------------------------------------------------- 
    3743CONTAINS 
     44 
     45   FUNCTION flow_wri_alloc 
     46      !!------------------------------------------------------------------- 
     47      !!                ***  ROUTINE flo_wri_alloc  *** 
     48      !!------------------------------------------------------------------- 
     49      INTEGER :: flow_wri_alloc 
     50 
     51      ALLOCATE(ztemp(jpk,jpnfl), zsal(jpk,jpnfl), Stat=flow_wri_alloc) 
     52 
     53      IF(flow_wri_alloc /= 0)THEN 
     54         CALL ctl_warn('flow_wri_alloc: failed to allocate arrays.') 
     55      END IF 
     56 
     57   END FUNCTION flow_wri_alloc 
     58 
    3859 
    3960   SUBROUTINE flo_wri( kt ) 
    … …  
    5677      REAL(wp) ::   zafl,zbfl,zcfl,zdtj 
    5778      REAL(wp) ::   zxxu, zxxu_01,zxxu_10, zxxu_11 
    58       REAL(wp), DIMENSION (jpk,jpnfl) ::   ztemp, zsal   ! 2D workspace 
    5979      !!--------------------------------------------------------------------- 
    6080       

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r2586 r2590  
    887887      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    888888      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    889       REAL(wp)        , INTENT(in), DIMENSION(        jpk) ::   pvar     ! written field 
     889      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    890890      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    891891      INTEGER :: ivid   ! variable id 
    … …  
    909909      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    910910      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    911       REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj    ) ::   pvar     ! written field 
     911      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    912912      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    913913      INTEGER :: ivid   ! variable id 
    … …  
    931931      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    932932      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    933       REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvar     ! written field 
     933      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    934934      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    935935      INTEGER :: ivid   ! variable id 
    … …  
    964964   SUBROUTINE iom_p2d( cdname, pfield2d ) 
    965965      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    966       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfield2d 
     966      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    967967#if defined key_iomput 
    968968      CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) ) 
    … …  
    974974   SUBROUTINE iom_p3d( cdname, pfield3d ) 
    975975      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    976       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   pfield3d 
     976      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    977977#if defined key_iomput 
    978978      CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90

    r2528 r2590  
    418418      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! time axis name 
    419419      INTEGER                         , INTENT(in)           ::   kvid     ! variable id 
    420       REAL(wp), DIMENSION(        jpk), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
    421       REAL(wp), DIMENSION(jpi,jpj    ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
    422       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
     420      REAL(wp), DIMENSION(          :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
     421      REAL(wp), DIMENSION(:  ,:      ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
     422      REAL(wp), DIMENSION(:  ,:  ,:  ), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
    423423      ! 
    424424      CHARACTER(LEN=100)    ::   clinfo               ! info character 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90

    r2528 r2590  
    7878      !!   9.0  !  05-07  (C. Talandier) original code 
    7979      !!---------------------------------------------------------------------- 
     80      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     81      USE wrk_nemo, ONLY: ztab2d_1 => wrk_2d_1, ztab2d_2 => wrk_2d_2 
     82      USE wrk_nemo, ONLY:   zmask1 => wrk_3d_1,   zmask2 => wrk_3d_2, & 
     83                          ztab3d_1 => wrk_3d_3, ztab3d_2 => wrk_3d_4 
    8084      !! * Arguments 
    8185      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL :: tab2d_1 
    … …  
    9599      CHARACTER (len=15) :: cl2 
    96100      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    97       REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2 
    98       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 
    99       !!---------------------------------------------------------------------- 
     101      !!---------------------------------------------------------------------- 
     102 
     103      IF( (.NOT. wrk_use(2, 1,2)) .OR. (.NOT. wrk_use(3, 1,2,3,4)) )THEN 
     104         CALL ctl_stop('prt_ctl : requested workspace arrays unavailable.') 
     105         RETURN 
     106      END IF 
    100107 
    101108      ! Arrays, scalars initialization  
    … …  
    205212 
    206213      ENDDO 
     214 
     215      IF( (.NOT. wrk_release(2, 1,2)) .OR. (.NOT. wrk_release(3, 1,2,3,4)) )THEN 
     216         CALL ctl_stop('prt_ctl : failed to release workspace arrays.') 
     217      END IF 
    207218 
    208219   END SUBROUTINE prt_ctl 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r2481 r2590  
    6565   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 
    6666   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl 
     67   PUBLIC   mppsize 
     68   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90 
    6769 
    6870   !! * Interfaces 
    … …  
    120122   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors 
    121123   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm 
    122    INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_ice     ! dimension ndim_rank_ice 
     124   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_ice     ! dimension ndim_rank_ice 
    123125 
    124126   ! variables used for zonal integration 
    … …  
    127129   INTEGER ::   ngrp_znl        ! group ID for the znl processors 
    128130   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average 
    129    INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
     131   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain 
    130132    
    131133   ! North fold condition in mpp_mpi with jpni > 1 
    … …  
    137139   INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line 
    138140   INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm 
    139    INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north 
     141   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   ! dimension ndim_rank_north 
    140142 
    141143   ! Type of send : standard, buffered, immediate 
    … …  
    144146   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend  
    145147       
    146    REAL(wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend 
     148   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend 
    147149 
    148150   ! message passing arrays 
    149    REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north 
    150    REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   t4ew, t4we   ! 2 x 3d for east-west & west-east 
    151    REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4p1, t4p2   ! 2 x 3d for north fold 
    152    REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3ns, t3sn   ! 3d for north-south & south-north 
    153    REAL(wp), DIMENSION(jpj,jpreci,jpk,2)   ::   t3ew, t3we   ! 3d for east-west & west-east 
    154    REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3p1, t3p2   ! 3d for north fold 
    155    REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2ns, t2sn   ! 2d for north-south & south-north 
    156    REAL(wp), DIMENSION(jpj,jpreci,2)       ::   t2ew, t2we   ! 2d for east-west & west-east 
    157    REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2p1, t2p2   ! 2d for north fold 
    158    REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   tr2ns, tr2sn  ! 2d for north-south & south-north + extra outer halo 
    159    REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   tr2ew, tr2we  ! 2d for east-west   & west-east   + extra outer halo 
     151   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north 
     152   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ew, t4we   ! 2 x 3d for east-west & west-east 
     153   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4p1, t4p2   ! 2 x 3d for north fold 
     154   REAL(wp),   DIMENSION(:,:,:,:), ALLOCATABLE, SAVE ::   t3ns, t3sn   ! 3d for north-south & south-north 
     155   REAL(wp),   DIMENSION(:,:,:,:), ALLOCATABLE, SAVE ::   t3ew, t3we   ! 3d for east-west & west-east 
     156   REAL(wp),   DIMENSION(:,:,:,:), ALLOCATABLE, SAVE ::   t3p1, t3p2   ! 3d for north fold 
     157   REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   t2ns, t2sn   ! 2d for north-south & south-north 
     158   REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east 
     159   REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold 
     160   REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   tr2ns, tr2sn  ! 2d for north-south & south-north + extra outer halo 
     161   REAL(wp),     DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   tr2ew, tr2we  ! 2d for east-west   & west-east   + extra outer halo 
     162 
     163   ! Arrays used in mpp_lbc_north_3d() 
     164   REAL(wp),   DIMENSION(:,:,:), ALLOCATABLE, SAVE   ::   ztab 
     165   REAL(wp),   DIMENSION(:,:,:), ALLOCATABLE, SAVE   ::   znorthloc 
     166   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   znorthgloio 
     167 
     168   ! Arrays used in mpp_lbc_north_2d() 
     169   REAL(wp),   DIMENSION(:,:), ALLOCATABLE, SAVE    ::   ztab_2d 
     170   REAL(wp),   DIMENSION(:,:), ALLOCATABLE, SAVE    ::   znorthloc_2d 
     171   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_2d 
     172 
     173   ! Arrays used in mpp_lbc_north_e() 
     174   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_e 
     175   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   znorthloc_e 
     176   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_e 
     177 
    160178   !!---------------------------------------------------------------------- 
    161179   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    165183 
    166184CONTAINS 
     185 
     186   FUNCTION lib_mpp_alloc() 
     187      !!---------------------------------------------------------------------- 
     188      !!              ***  routine lib_mpp_alloc  *** 
     189      !!---------------------------------------------------------------------- 
     190      INTEGER :: lib_mpp_alloc 
     191      !!---------------------------------------------------------------------- 
     192 
     193      ALLOCATE(t4ns(jpi,jprecj,jpk,2,2), t4sn(jpi,jprecj,jpk,2,2), & 
     194               t4ew(jpj,jpreci,jpk,2,2), t4we(jpj,jpreci,jpk,2,2), & 
     195               t4p1(jpi,jprecj,jpk,2,2), t4p2(jpi,jprecj,jpk,2,2), & 
     196               t3ns(jpi,jprecj,jpk,2),   t3sn(jpi,jprecj,jpk,2),   & 
     197               t3ew(jpj,jpreci,jpk,2),   t3we(jpj,jpreci,jpk,2),   & 
     198               t3p1(jpi,jprecj,jpk,2),   t3p2(jpi,jprecj,jpk,2),   & 
     199               t2ns(jpi,jprecj,2),       t2sn(jpi,jprecj,2),       & 
     200               t2ew(jpj,jpreci,2),       t2we(jpj,jpreci,2),       & 
     201               t2p1(jpi,jprecj,2),       t2p2(jpi,jprecj,2),       & 
     202               tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2),         & 
     203               tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2),         & 
     204               tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2),         & 
     205               tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2),         & 
     206               ! 
     207               ztab(jpiglo,4,jpk),       znorthloc(jpi,4,jpk),     & 
     208               znorthgloio(jpi,4,jpk,jpni),                        & 
     209               ! 
     210               ztab_2d(jpiglo,4),        znorthloc_2d(jpi,4),      & 
     211               znorthgloio_2d(jpi,4,jpni),                         & 
     212               ! 
     213               ztab_e(jpiglo,4+2*jpr2dj),znorthloc_e(jpi,4+2*jpr2dj), & 
     214               znorthgloio_e(jpi,4+2*jpr2dj,jpni),                    & 
     215               Stat=lib_mpp_alloc) 
     216 
     217      IF(lib_mpp_alloc /= 0)THEN 
     218         CALL ctl_warn('lib_mpp_alloc : failed to allocate arrays.') 
     219      END IF 
     220 
     221   END FUNCTION lib_mpp_alloc 
     222 
    167223 
    168224   FUNCTION mynode(ldtxt, localComm) 
    … …  
    16701726      !! 
    16711727      !!---------------------------------------------------------------------- 
     1728      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     1729      USE wrk_nemo, ONLY: ztab => wrk_2d_1 
    16721730      INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices 
    16731731      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary 
    … …  
    16841742      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend 
    16851743      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend 
    1686       REAL(wp), DIMENSION(jpi,jpj) ::   ztab   ! temporary workspace 
    1687       !!---------------------------------------------------------------------- 
     1744      !!---------------------------------------------------------------------- 
     1745 
     1746      IF(.NOT. wrk_use(2, 1))THEN 
     1747         CALL ctl_stop('mppobc : requested workspace array unavailable.') 
     1748         RETURN 
     1749      END IF 
    16881750 
    16891751      ! boundary condition initialization 
    … …  
    18341896      END DO 
    18351897      ! 
     1898      IF(.NOT. wrk_release(2, 1))THEN 
     1899         CALL ctl_stop('mppobc : failed to release workspace array.') 
     1900      END IF 
     1901      ! 
    18361902   END SUBROUTINE mppobc 
    18371903    
    … …  
    18771943      INTEGER :: jjproc 
    18781944      INTEGER :: ii 
    1879       INTEGER, DIMENSION(jpnij) :: kice 
    1880       INTEGER, DIMENSION(jpnij) :: zwork 
    1881       !!---------------------------------------------------------------------- 
    1882       ! 
     1945      INTEGER, ALLOCATABLE, DIMENSION(:) :: kice 
     1946      INTEGER, ALLOCATABLE, DIMENSION(:) :: zwork 
     1947      !!---------------------------------------------------------------------- 
     1948      ! 
     1949      ! Since this is just an init routine and these arrays are of length jpnij 
     1950      ! then don't use wrk_nemo module - just allocate and deallocate. 
     1951      ALLOCATE(kice(jpnij), zwork(jpnij), Stat=ierr) 
     1952      IF(ierr /= 0)THEN 
     1953         CALL ctl_stop('mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length).') 
     1954         RETURN 
     1955      ENDIF 
     1956 
    18831957      ! Look for how many procs with sea-ice 
    18841958      ! 
    … …  
    19221996      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr) 
    19231997      ! 
     1998 
     1999      DEALLOCATE(kice, zwork) 
     2000 
    19242001   END SUBROUTINE mpp_ini_ice 
    19252002 
    … …  
    19472024      INTEGER :: jproc 
    19482025      INTEGER :: ii 
    1949       INTEGER, DIMENSION(jpnij) :: kwork 
     2026      INTEGER, ALLOCATABLE, DIMENSION(:) :: kwork 
    19502027      ! 
    19512028      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world 
    … …  
    19532030      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa 
    19542031      ! 
     2032      ALLOCATE(kwork(jpnij), Stat=ierr) 
     2033      IF(ierr /= 0)THEN 
     2034         CALL ctl_stop('mpp_ini_znl : failed to allocate 1D array of length jpnij') 
     2035         RETURN 
     2036      END IF 
     2037 
    19552038      IF ( jpnj == 1 ) THEN 
    19562039         ngrp_znl  = ngrp_world 
    … …  
    20162099      END IF 
    20172100 
     2101      DEALLOCATE(kwork) 
     2102 
    20182103   END SUBROUTINE mpp_ini_znl 
    20192104 
    … …  
    21062191      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    21072192      INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2108       REAL(wp), DIMENSION(jpiglo,4,jpk)      ::   ztab 
    2109       REAL(wp), DIMENSION(jpi   ,4,jpk)      ::   znorthloc 
    2110       REAL(wp), DIMENSION(jpi   ,4,jpk,jpni) ::   znorthgloio 
    21112193      !!---------------------------------------------------------------------- 
    21122194      !    
    … …  
    21722254      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    21732255      INTEGER ::   ijpj, ijpjm1, ij, iproc 
    2174       REAL(wp), DIMENSION(jpiglo,4)      ::   ztab 
    2175       REAL(wp), DIMENSION(jpi   ,4)      ::   znorthloc 
    2176       REAL(wp), DIMENSION(jpi   ,4,jpni) ::   znorthgloio 
    21772256      !!---------------------------------------------------------------------- 
    21782257      ! 
    21792258      ijpj   = 4 
    21802259      ijpjm1 = 3 
    2181       ztab(:,:) = 0.e0 
    2182       ! 
    2183       DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d 
     2260      ztab_2d(:,:) = 0.e0 
     2261      ! 
     2262      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc_2d the last 4 jlines of pt2d 
    21842263         ij = jj - nlcj + ijpj 
    2185          znorthloc(:,ij) = pt2d(:,jj) 
     2264         znorthloc_2d(:,ij) = pt2d(:,jj) 
    21862265      END DO 
    21872266 
    2188       !                                     ! Build in procs of ncomm_north the znorthgloio 
     2267      !                                     ! Build in procs of ncomm_north the znorthgloio_2d 
    21892268      itaille = jpi * ijpj 
    2190       CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        & 
    2191          &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     2269      CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        & 
     2270         &                znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    21922271      ! 
    21932272      DO jr = 1, ndim_rank_north            ! recover the global north array 
    … …  
    21982277         DO jj = 1, 4 
    21992278            DO ji = ildi, ilei 
    2200                ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr) 
     2279               ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr) 
    22012280            END DO 
    22022281         END DO 
    22032282      END DO 
    22042283      ! 
    2205       CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition 
     2284      CALL lbc_nfd( ztab_2d, cd_type, psgn )   ! North fold boundary condition 
    22062285      ! 
    22072286      ! 
    … …  
    22092288         ij = jj - nlcj + ijpj 
    22102289         DO ji = 1, nlci 
    2211             pt2d(ji,jj) = ztab(ji+nimpp-1,ij) 
     2290            pt2d(ji,jj) = ztab_2d(ji+nimpp-1,ij) 
    22122291         END DO 
    22132292      END DO 
    … …  
    22392318      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    22402319      INTEGER ::   ijpj, ij, iproc 
    2241       REAL(wp), DIMENSION(jpiglo,4+2*jpr2dj)      ::   ztab 
    2242       REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj)      ::   znorthloc 
    2243       REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj,jpni) ::   znorthgloio 
    22442320      !!---------------------------------------------------------------------- 
    22452321      ! 
    22462322      ijpj=4 
    2247       ztab(:,:) = 0.e0 
     2323      ztab_e(:,:) = 0.e0 
    22482324 
    22492325      ij=0 
    2250       ! put in znorthloc the last 4 jlines of pt2d 
     2326      ! put in znorthloc_e the last 4 jlines of pt2d 
    22512327      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 
    22522328         ij = ij + 1 
    22532329         DO ji = 1, jpi 
    2254             znorthloc(ji,ij)=pt2d(ji,jj) 
     2330            znorthloc_e(ji,ij)=pt2d(ji,jj) 
    22552331         END DO 
    22562332      END DO 
    22572333      ! 
    22582334      itaille = jpi * ( ijpj + 2 * jpr2dj ) 
    2259       CALL MPI_ALLGATHER( znorthloc(1,1)    , itaille, MPI_DOUBLE_PRECISION,    & 
    2260          &                znorthgloio(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     2335      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    & 
     2336         &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    22612337      ! 
    22622338      DO jr = 1, ndim_rank_north            ! recover the global north array 
    … …  
    22672343         DO jj = 1, ijpj+2*jpr2dj 
    22682344            DO ji = ildi, ilei 
    2269                ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr) 
     2345               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 
    22702346            END DO 
    22712347         END DO 
    … …  
    22752351      ! 2. North-Fold boundary conditions 
    22762352      ! ---------------------------------- 
    2277       CALL lbc_nfd( ztab(:,:), cd_type, psgn, pr2dj = jpr2dj ) 
     2353      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 
    22782354 
    22792355      ij = jpr2dj 
    … …  
    22822358      ij  = ij +1  
    22832359         DO ji= 1, nlci 
    2284             pt2d(ji,jj) = ztab(ji+nimpp-1,ij) 
     2360            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 
    22852361         END DO 
    22862362      END DO 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r2528 r2590  
    207207      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
    208208      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1) 
    209       REAL(wp), INTENT(in   ), DIMENSION        (jpk) ::   pdep       ! depth of the gridpoint (T, U, V, F) 
    210       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pah        ! adimensional vertical profile 
     209      REAL(wp), INTENT(in   ), DIMENSION          (:) ::   pdep       ! depth of the gridpoint (T, U, V, F) 
     210      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile 
    211211      !! 
    212212      INTEGER  ::   jk           ! dummy loop indices 
    … …  
    249249      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
    250250      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1) 
    251       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pdep       ! dep of the gridpoint (T, U, V, F) 
    252       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pah        ! adimensional vertical profile 
     251      REAL(wp), INTENT(in   ), DIMENSION      (:,:,:) ::   pdep       ! dep of the gridpoint (T, U, V, F) 
     252      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile 
    253253      !! 
    254254      INTEGER  ::   jk           ! dummy loop indices 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r2528 r2590  
    145145      !! * Modules used 
    146146      USE ldftra_oce, ONLY : aht0 
    147  
     147      USE wrk_nemo, ONLY: iwrk_use, iwrk_release 
     148      USE wrk_nemo, ONLY: icof => iwrk_2d_1 
    148149      !! * Arguments 
    149150      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    … …  
    155156      INTEGER ::   ifreq, il1, il2, ij, ii 
    156157      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    157       INTEGER, DIMENSION(jpi   ,jpj   ) ::   icof 
    158158 
    159159      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
    … …  
    161161      CHARACTER (len=15) ::   clexp 
    162162      !!---------------------------------------------------------------------- 
     163 
     164      IF(.not. iwrk_use(2, 1))THEN 
     165         CALL ctl_stop('ldf_dyn_c2d_orca: ERROR: requested workspace array is unavailable.') 
     166         RETURN 
     167      END IF 
    163168 
    164169      IF(lwp) WRITE(numout,*) 
    … …  
    288293      ENDIF 
    289294 
     295      IF(.not. iwrk_release(2, 1))THEN 
     296         CALL ctl_stop('ldf_dyn_c2d_orca: ERROR: failed to release workspace array.') 
     297      END IF 
     298 
    290299   END SUBROUTINE ldf_dyn_c2d_orca 
    291300 
    … …  
    307316      !! * Modules used 
    308317      USE ldftra_oce, ONLY : aht0 
     318      USE wrk_nemo, ONLY: iwrk_use, iwrk_release 
     319      USE wrk_nemo, ONLY: icof => iwrk_2d_1 
    309320 
    310321      !! * Arguments 
    … …  
    317328      INTEGER ::   ifreq, il1, il2, ij, ii 
    318329      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    319       INTEGER, DIMENSION(jpi   ,jpj   ) ::   icof 
    320330 
    321331      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s 
    … …  
    323333      CHARACTER (len=15) ::   clexp 
    324334      !!---------------------------------------------------------------------- 
     335 
     336      IF(.not. iwrk_use(2, 1))THEN 
     337         CALL ctl_stop('ldf_dyn_c2d_orca_R1: ERROR: requested workspace array is unavailable.') 
     338         RETURN 
     339      END IF 
    325340 
    326341      IF(lwp) WRITE(numout,*) 
    … …  
    457472      ENDIF 
    458473 
     474      IF(.not. iwrk_release(2, 1))THEN 
     475         CALL ctl_stop('ldf_dyn_c2d_orca_R1: ERROR: failed to release workspace array.') 
     476      END IF 
     477 
    459478   END SUBROUTINE ldf_dyn_c2d_orca_R1 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r2528 r2590  
    2727      !!---------------------------------------------------------------------- 
    2828      USE ldftra_oce, ONLY : aht0 
     29      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     30      USE wrk_nemo, ONLY: zcoef => wrk_1d_2 
    2931      !! 
    3032      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    … …  
    4042         zetmax, zefmax, & 
    4143         zeumax, zevmax    
    42       REAL(wp), DIMENSION(jpk) ::   zcoef   ! temporary workspace 
    43       !!---------------------------------------------------------------------- 
     44      !!---------------------------------------------------------------------- 
     45 
     46      IF(.not. wrk_use(1,2))THEN 
     47         CALL ctl_stop('ldf_dyn_c3d: ERROR: requested workspace array unavailable.') 
     48         RETURN 
     49      END IF 
    4450 
    4551      IF(lwp) WRITE(numout,*) 
    … …  
    182188      ENDIF 
    183189 
     190      IF(.not. wrk_release(1,2))THEN 
     191         CALL ctl_stop('ldf_dyn_c3d: ERROR: failed to release workspace array.') 
     192      END IF 
     193 
    184194   END SUBROUTINE ldf_dyn_c3d 
    185195 
    … …  
    194204      !!---------------------------------------------------------------------- 
    195205      USE ldftra_oce, ONLY : aht0 
     206      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     207      USE wrk_nemo, ONLY:  icof => iwrk_2d_1 
     208      USE wrk_nemo, ONLY: zahm0 =>  wrk_2d_1 
     209      USE wrk_nemo, ONLY: zcoef =>  wrk_1d_1 
    196210      !! 
    197211      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    … …  
    203217      INTEGER ::   ifreq, il1, il2, ij, ii 
    204218      INTEGER, DIMENSION(jpidta, jpjdta) ::   idata 
    205       INTEGER, DIMENSION(jpi   , jpj   ) ::   icof 
    206219 
    207220      REAL(wp) ::   & 
    208221         zahmeq, zcoff, zcoft, zmsk,   & ! ??? 
    209222         zemax, zemin, zeref, zahmm 
    210       REAL(wp), DIMENSION(jpi,jpj) ::   zahm0 
    211       REAL(wp), DIMENSION(jpk) ::   zcoef 
    212223 
    213224      CHARACTER (len=15) ::   clexp 
    214225      !!---------------------------------------------------------------------- 
     226 
     227      IF( (.not. iwrk_use(2,1)) .OR. (.not. wrk_use(2,1)) .OR. & 
     228          (.not. wrk_use(1,1)))THEN 
     229         CALL ctl_stop('ldf_dyn_c3d_orca: ERROR: requested workspace arrays are unavailable.') 
     230         RETURN 
     231      END IF 
    215232 
    216233      IF(lwp) WRITE(numout,*) 
    … …  
    457474      ENDIF 
    458475 
     476      IF( (.not. iwrk_release(2,1)) .OR. (.not. wrk_release(2,1)) .OR. & 
     477          (.not. wrk_release(1,1)))THEN 
     478         CALL ctl_stop('ldf_dyn_c3d_orca: ERROR: failed to release workspace arrays.') 
     479      END IF 
     480 
    459481   END SUBROUTINE ldf_dyn_c3d_orca 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90

    r2528 r2590  
    2323 
    2424#if defined key_dynldf_c3d 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ahm1, ahm2, ahm3, ahm4  ! ** 3D coefficients ** 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahm1, ahm2, ahm3, ahm4  ! ** 3D coefficients ** 
    2626#elif defined key_dynldf_c2d 
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)    ::   ahm1, ahm2, ahm3, ahm4  ! ** 2D coefficients ** 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) ::   ahm1, ahm2, ahm3, ahm4  ! ** 2D coefficients ** 
    2828#elif defined key_dynldf_c1d 
    2929   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   ahm1, ahm2, ahm3, ahm4  ! ** 2D coefficients ** 
    … …  
    3737   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!====================================================================== 
     39CONTAINS 
     40 
     41  FUNCTION ldfdyn_oce_alloc() 
     42    !!---------------------------------------------------------------------- 
     43    !!---------------------------------------------------------------------- 
     44    IMPLICIT none 
     45    INTEGER :: ldfdyn_oce_alloc 
     46 
     47    ldfdyn_oce_alloc = 0 
     48 
     49#if defined key_dynldf_c3d 
     50    ALLOCATE(ahm1(jpi,jpj,jpk), ahm2(jpi,jpj,jpk), ahm3(jpi,jpj,jpk), & 
     51             ahm4(jpi,jpj,jpk), Stat=ldfdyn_oce_alloc) 
     52#elif defined key_dynldf_c2d 
     53    ALLOCATE(ahm1(jpi,jpj), ahm2(jpi,jpj), ahm3(jpi,jpj),             & 
     54             ahm4(jpi,jpj),     Stat=ldfdyn_oce_alloc) 
     55#elif defined key_dynldf_c1d 
     56    ALLOCATE(ahm1(jpk), ahm2(jpk), ahm3(jpk),                         & 
     57             ahm4(jpk),         Stat=ldfdyn_oce_alloc) 
     58#endif 
     59 
     60  END FUNCTION ldfdyn_oce_alloc 
     61 
     62  !!---------------------------------------------------------------------- 
     63 
    3964END MODULE ldfdyn_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r2528 r2590  
    5353      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points.  
    5454      !!---------------------------------------------------------------------- 
     55      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     56      USE wrk_nemo, ONLY: zn  => wrk_2d_1, zah   => wrk_2d_2, & 
     57                          zhw => wrk_2d_3, zross => wrk_2d_4 
     58      !! 
    5559      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    5660      !! 
    5761      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    5862      REAL(wp) ::   zfw, ze3w, zn2, zf20, zaht, zaht_min      ! temporary scalars 
    59       REAL(wp), DIMENSION(jpi,jpj) ::   zn, zah, zhw, zross   ! 2D workspace 
    6063      !!---------------------------------------------------------------------- 
    6164       
     65      IF(.not. wrk_use(2, 1,2,3,4))THEN 
     66         CALL ctl_stop('ldf_eiv: ERROR: requested workspace arrays are unavailable.') 
     67         RETURN 
     68      END IF 
     69 
    6270      IF( kt == nit000 ) THEN 
    6371         IF(lwp) WRITE(numout,*) 
    … …  
    235243      CALL iom_put( "aht2d"    , ahtw )   ! lateral eddy diffusivity 
    236244      CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity 
     245      !   
     246      IF(.not. wrk_release(2, 1,2,3,4))THEN 
     247         CALL ctl_stop('ldf_eiv: ERROR: failed to release workspace arrays.') 
     248      END IF 
    237249      ! 
    238250   END SUBROUTINE ldf_eiv 
    … …  
    244256CONTAINS 
    245257   SUBROUTINE ldf_eiv( kt )       ! Empty routine 
     258      INTEGER :: kt 
    246259      WRITE(*,*) 'ldf_eiv: You should not have seen this print! error?', kt 
    247260   END SUBROUTINE ldf_eiv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2528 r2590  
    3838   PUBLIC   ldf_slp_grif   ! routine called by step.F90 
    3939   PUBLIC   ldf_slp_init   ! routine called by opa.F90 
     40   PUBLIC   ldf_slp_alloc  ! routine called by nemo_init->nemo_alloc 
    4041 
    4142   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag 
    4243   !                                                                             !! Madec operator 
    43    REAL(wp), PUBLIC, DIMENSION(:,:,:)    , ALLOCATABLE ::   uslp, wslpi          !: i_slope at U- and W-points 
    44    REAL(wp), PUBLIC, DIMENSION(:,:,:)    , ALLOCATABLE ::   vslp, wslpj          !: j-slope at V- and W-points 
    45    !                                                                             !! Griffies operator 
    46    REAL(wp), PUBLIC, DIMENSION(:,:,:)    , ALLOCATABLE ::   wslp2                !: wslp**2 from Griffies quarter cells 
    47    REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials  
    48    REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)    ::   uslp, wslpi          !: i_slope at U- and W-points 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)    ::   vslp, wslpj          !: j-slope at V- and W-points 
     46   !                                                                !! Griffies operator 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)    ::   wslp2                !: wslp**2 from Griffies quarter cells 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi_g, triadj_g   !: skew flux  slopes relative to geopotentials  
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   triadi  , triadj     !: isoneutral slopes relative to model-coordinate 
    4950 
    5051   !                                                              !! Madec operator 
    51    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   omlmask           ! mask of the surface mixed layer at T-pt 
    52    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer 
    53    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer 
    5455 
    5556   REAL(wp) ::   repsln = 1.e-25_wp       ! tiny value used as minium of di(rho), dj(rho) and dk(rho) 
     57 
     58   ! Workspace arrays for ldf_slp_grif. These could be replaced by several 3D and 2D workspace 
     59   ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace  
     60   ! arrays can't be used here because of the zero-indexing of some of the ranks. ARPDBG. 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zdzrho, zdyrho, zdxrho     ! Horizontal and vertical density gradients 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb 
    5663 
    5764   !! * Substitutions 
    … …  
    6673   !!---------------------------------------------------------------------- 
    6774CONTAINS 
     75 
     76   FUNCTION ldf_slp_alloc() 
     77      !!---------------------------------------------------------------------- 
     78      !!              ***  ROUTINE ldf_slp_alloc  *** 
     79      !!---------------------------------------------------------------------- 
     80      IMPLICIT none 
     81      INTEGER               :: ldf_slp_alloc 
     82      INTEGER, DIMENSION(3) :: ierr 
     83      !!---------------------------------------------------------------------- 
     84 
     85      ALLOCATE(uslp(jpi,jpj,jpk), wslpi(jpi,jpj,jpk), & 
     86               vslp(jpi,jpj,jpk), wslpj(jpi,jpj,jpk), Stat=ierr(1)) 
     87      ! 
     88      ALLOCATE(omlmask(jpi,jpj,jpk),                  & 
     89               uslpml(jpi,jpj), wslpiml(jpi,jpj),     & 
     90               vslpml(jpi,jpj), wslpjml(jpi,jpj), Stat=ierr(2)) 
     91      ! 
     92      ALLOCATE(zdzrho(jpi,jpj,jpk,0:1),  zdyrho(jpi,jpj,jpk,0:1),  & 
     93               zdxrho(jpi,jpj,jpk,0:1),  zti_mlb(jpi,jpj,0:1,0:1), & 
     94               ztj_mlb(jpi,jpj,0:1,0:1), Stat=ierr(3)) 
     95 
     96      ldf_slp_alloc = MAXVAL(ierr) 
     97 
     98   END FUNCTION ldf_slp_alloc 
     99 
    68100 
    69101   SUBROUTINE ldf_slp( kt, prd, pn2 ) 
    … …  
    96128      USE oce , zww   => ta   ! use ta as workspace 
    97129      USE oce , zwz   => sa   ! use sa as workspace 
    98       !! 
    99       INTEGER , INTENT(in)                         ::   kt    ! ocean time-step index 
    100       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   prd   ! in situ density 
    101       REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pn2   ! Brunt-Vaisala frequency (locally ref.) 
     130      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     131      USE wrk_nemo, ONLY: zdzr => wrk_3d_1 
     132      !! 
     133      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index 
     134      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density 
     135      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.) 
    102136      !! 
    103137      INTEGER  ::   ji , jj , jk    ! dummy loop indices 
    … …  
    108142      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    109143      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
    110       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzr   ! 3D workspace 
    111       !!---------------------------------------------------------------------- 
    112        
     144      !!---------------------------------------------------------------------- 
     145 
     146      IF(.not. wrk_use(3, 1))THEN 
     147         CALL ctl_stop('ldf_slp: ERROR: requested workspace arrays are unavailable.') 
     148         RETURN 
     149      END IF 
     150 
    113151      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    114152      z1_16  =  1.0_wp / 16._wp 
    … …  
    354392      ENDIF 
    355393      ! 
     394      IF(.not. wrk_release(3, 1))THEN 
     395         CALL ctl_stop('ldf_slp: ERROR: failed to release workspace arrays.') 
     396      END IF 
     397      ! 
    356398   END SUBROUTINE ldf_slp 
    357399    
    … …  
    375417      USE oce,   zdjt  => ta   ! use ta as workspace 
    376418      USE oce,   zdjs  => sa   ! use sa as workspace 
     419      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     420      USE wrk_nemo, ONLY: zdkt   => wrk_3d_2, zdks  => wrk_3d_3, & 
     421                          zalpha => wrk_3d_4, zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
     422      USE wrk_nemo, ONLY: z1_mlbw => wrk_2d_1 
    377423      !! 
    378424      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    … …  
    385431      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim 
    386432      REAL(wp) ::   zdzrho_raw 
    387       REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) ::   zdzrho, zdyrho, zdxrho     ! Horizontal and vertical density gradients 
    388       REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) ::   zti_mlb, ztj_mlb 
    389       REAL(wp), DIMENSION(jpi,jpj,jpk)     ::   zdkt, zdks 
    390       REAL(wp), DIMENSION(jpi,jpj,jpk)     ::   zalpha, zbeta       ! alpha, beta at T points, at depth fsgdept 
    391       REAL(wp), DIMENSION(jpi,jpj)         ::   z1_mlbw 
    392       !!---------------------------------------------------------------------- 
     433      !!---------------------------------------------------------------------- 
     434 
     435      IF( (.not. wrk_use(3, 2,3,4,5)) .OR. (.not. wrk_use(2, 1)) )THEN 
     436         CALL ctl_stop('ldf_slp_grif: ERROR: requested workspace arrays are unavailable.') 
     437         RETURN 
     438      END IF 
    393439 
    394440      !--------------------------------! 
    … …  
    572618      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    573619      ! 
     620      IF( (.not. wrk_release(3, 2,3,4,5)) .OR. (.not. wrk_release(2, 1)) )THEN 
     621         CALL ctl_stop('ldf_slp_grif: ERROR: failed to release workspace arrays.') 
     622      END IF 
     623      ! 
    574624   END SUBROUTINE ldf_slp_grif 
    575625 
    … …  
    591641      !!                omlmask         :  mixed layer mask 
    592642      !!---------------------------------------------------------------------- 
    593       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   prd            ! in situ density 
    594       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.) 
    595       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts) 
    596       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point) 
     643      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   prd            ! in situ density 
     644      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.) 
     645      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts) 
     646      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point) 
    597647      !! 
    598648      INTEGER  ::   ji , jj , jk         ! dummy loop indices 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r2528 r2590  
    1010   IMPLICIT NONE 
    1111   PRIVATE 
     12 
     13   PUBLIC ldftra_oce_alloc ! called by nemo_init->nemo_alloc, nemogcm.F90 
    1214 
    1315   !!---------------------------------------------------------------------- 
    … …  
    3234 
    3335#if defined key_traldf_c3d 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-, U-, V-, W-points 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-, U-, V-, W-points 
    3537#elif defined key_traldf_c2d 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-, U-, V-, W-points 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-, U-, V-, W-points 
    3739#elif defined key_traldf_c1d 
    38    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-, U-, V-, W-points 
     40   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-, U-, V-, W-points ARPDBGjpk 
    3941#else 
    4042   REAL(wp), PUBLIC                         ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-, U-, V-, W-points 
    … …  
    4951       
    5052# if defined key_traldf_c3d 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   aeiu, aeiv, aeiw  !: ** 3D coefficients ** at U-, V-, W-points  [m2/s] 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu, aeiv, aeiw  !: ** 3D coefficients ** at U-, V-, W-points  [m2/s] 
    5254# elif defined key_traldf_c2d 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)    ::   aeiu, aeiv, aeiw  !: ** 2D coefficients ** at U-, V-, W-points  [m2/s] 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) ::   aeiu, aeiv, aeiw  !: ** 2D coefficients ** at U-, V-, W-points  [m2/s] 
    5456# elif defined key_traldf_c1d 
    55    REAL(wp), PUBLIC, DIMENSION(jpk)        ::   aeiu, aeiv, aeiw  !: ** 1D coefficients ** at U-, V-, W-points  [m2/s] 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,     DIMENSION(:) ::   aeiu, aeiv, aeiw  !: ** 1D coefficients ** at U-, V-, W-points  [m2/s] 
    5658# else 
    5759   REAL(wp), PUBLIC                         ::   aeiu, aeiv, aeiw  !: ** 0D coefficients ** at U-, V-, W-points  [m2/s] 
    5860# endif 
    5961# if defined key_diaeiv 
    60    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s] 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s] 
    6163# endif 
    6264 
    … …  
    7476   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7577   !!===================================================================== 
     78CONTAINS 
     79 
     80   FUNCTION ldftra_oce_alloc() 
     81     !!---------------------------------------------------------------------- 
     82     !!---------------------------------------------------------------------- 
     83     IMPLICIT None 
     84     INTEGER               :: ldftra_oce_alloc 
     85     INTEGER, DIMENSION(3) :: ierr 
     86     !!---------------------------------------------------------------------- 
     87     ierr(:) = 0 
     88 
     89#if defined key_traldf_c3d 
     90     ALLOCATE(ahtt(jpi,jpj,jpk), ahtu(jpi,jpj,jpk), ahtv(jpi,jpj,jpk), & 
     91              ahtw(jpi,jpj,jpk), Stat=ierr(1)) 
     92#elif defined key_traldf_c2d 
     93     ALLOCATE(ahtt(jpi,jpj), ahtu(jpi,jpj), ahtv(jpi,jpj), & 
     94              ahtw(jpi,jpj), Stat=ierr(1)) 
     95#elif defined key_traldf_c1d 
     96     ! No need to allocate arrays where extent only depends on jpk ARPDBGjpk 
     97#endif 
     98 
     99#if defined key_traldf_eiv 
     100 
     101#if defined key_traldf_c3d 
     102     ALLOCATE(aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), aeiw(jpi,jpj,jpk), &  
     103              Stat=ierr(2)) 
     104#elif defined key_traldf_c2d 
     105     ALLOCATE(aeiu(jpi,jpj), aeiv(jpi,jpj), aeiw(jpi,jpj), Stat=ierr(2)) 
     106#elif defined key_traldf_c1d 
     107     ALLOCATE(aeiu(jpk), aeiv(jpk), aeiw(jpk), Stat=ierr(2)) 
     108#endif 
     109 
     110# if defined key_diaeiv 
     111     ALLOCATE(u_eiv(jpi,jpj,jpk), v_eiv(jpi,jpj,jpk), w_eiv(jpi,jpj,jpk), & 
     112              Stat=ierr(3)) 
     113# endif 
     114 
     115#endif 
     116      
     117     ldftra_oce_alloc = MAXVAL(ierr) 
     118 
     119   END FUNCTION ldftra_oce_alloc 
     120 
     121   !!---------------------------------------------------------------------- 
     122 
    76123END MODULE ldftra_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90

    r2528 r2590  
    7171   REAL(wp), PUBLIC ::   obcsurftot       !: Total lateral surface of open boundaries 
    7272    
    73    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: &  !: 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: &  !: 
    7474      obctmsk,            &  !: mask array identical to tmask, execpt along OBC where it is set to 0 
    7575      !                      !  it used to calculate the cumulate flux E-P in the obcvol.F90 routine 
    … …  
    8787   INTEGER ::   nje1m2, nje0m1    !: do loop index in mpp case for jpjefm1-1,jpjed 
    8888 
    89    REAL(wp), DIMENSION(jpj) ::   &  !: 
     89   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !: 
    9090      sshfoe,           & !: now climatology of the east boundary sea surface height 
    9191      ubtfoe,vbtfoe       !: now climatology of the east boundary barotropic transport 
    9292      
    93    REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     93   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    9494      ufoe, vfoe,       & !: now climatology of the east boundary velocities  
    9595      tfoe, sfoe,       & !: now climatology of the east boundary temperature and salinity 
    … …  
    9797      !                   ! in the obcdyn.F90 routine 
    9898 
    99    REAL(wp), DIMENSION(jpi,jpj) ::   sshfoe_b      !: east boundary ssh correction averaged over the barotropic loop 
     99   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfoe_b      !: east boundary ssh correction averaged over the barotropic loop 
    100100      !                                            !  (if Flather's algoritm applied at open boundary) 
    101101 
    … …  
    103103   !! Arrays for radiative East OBC:  
    104104   !!------------------------------- 
    105    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   uebnd, vebnd      !: baroclinic u & v component of the velocity over 3 rows  
     105   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uebnd, vebnd      !: baroclinic u & v component of the velocity over 3 rows  
    106106      !                                                    !  and 3 time step (now, before, and before before) 
    107    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   tebnd, sebnd      !: East boundary temperature and salinity over 2 rows  
     107   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tebnd, sebnd      !: East boundary temperature and salinity over 2 rows  
    108108      !                                                    !  and 2 time step (now and before) 
    109    REAL(wp), DIMENSION(jpj,jpk) ::   u_cxebnd, v_cxebnd    !: Zonal component of the phase speed ratio computed with  
     109   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxebnd, v_cxebnd    !: Zonal component of the phase speed ratio computed with  
    110110      !                                                    !  radiation of u and v velocity (respectively) at the  
    111111      !                                                    !  east open boundary (u_cxebnd = cx rdt ) 
    112    REAL(wp), DIMENSION(jpj,jpk) ::   uemsk, vemsk, temsk   !: 2D mask for the East OB 
     112   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uemsk, vemsk, temsk   !: 2D mask for the East OB 
    113113 
    114114   ! Note that those arrays are optimized for mpp case  
    … …  
    124124   INTEGER ::   njw1m2, njw0m1     !: do loop index in mpp case for jpjwfm2,jpjwd 
    125125 
    126    REAL(wp), DIMENSION(jpj) ::   &  !: 
     126   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !: 
    127127      sshfow,           & !: now climatology of the west boundary sea surface height 
    128128      ubtfow,vbtfow       !: now climatology of the west boundary barotropic transport 
    129129 
    130    REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
     130   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !: 
    131131      ufow, vfow,       & !: now climatology of the west velocities  
    132132      tfow, sfow,       & !: now climatology of the west temperature and salinity 
    … …  
    134134      !                   !  in the obcdyn.F90 routine 
    135135 
    136    REAL(wp), DIMENSION(jpi,jpj) ::   sshfow_b    !: west boundary ssh correction averaged over the barotropic loop 
     136   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfow_b    !: west boundary ssh correction averaged over the barotropic loop 
    137137      !                                          !  (if Flather's algoritm applied at open boundary) 
    138138 
    … …  
    140140   !! Arrays for radiative West OBC 
    141141   !!------------------------------- 
    142    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   uwbnd, vwbnd     !: baroclinic u & v components of the velocity over 3 rows  
     142   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uwbnd, vwbnd     !: baroclinic u & v components of the velocity over 3 rows  
    143143      !                                                   !  and 3 time step (now, before, and before before) 
    144    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   twbnd, swbnd     !: west boundary temperature and salinity over 2 rows and  
     144   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   twbnd, swbnd     !: west boundary temperature and salinity over 2 rows and  
    145145      !                                                   !  2 time step (now and before) 
    146    REAL(wp), DIMENSION(jpj,jpk) ::   u_cxwbnd, v_cxwbnd   !: Zonal component of the phase speed ratio computed with  
     146   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxwbnd, v_cxwbnd   !: Zonal component of the phase speed ratio computed with  
    147147      !                                                   !  radiation of zonal and meridional velocity (respectively)  
    148148      !                                                   !  at the west open boundary (u_cxwbnd = cx rdt ) 
    149    REAL(wp), DIMENSION(jpj,jpk) ::   uwmsk, vwmsk, twmsk  !: 2D mask for the West OB 
     149   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uwmsk, vwmsk, twmsk  !: 2D mask for the West OB 
    150150 
    151151   ! Note that those arrays are optimized for mpp case  
    … …  
    162162   INTEGER ::   njn0m1, njn1m1     !: do loop index in mpp case for jpnob-1 
    163163 
    164    REAL(wp), DIMENSION(jpi) ::   &  !: 
     164   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !: 
    165165      sshfon,           & !: now climatology of the north boundary sea surface height 
    166166      ubtfon,vbtfon       !: now climatology of the north boundary barotropic transport 
    167167 
    168    REAL(wp), DIMENSION(jpi,jpk) ::   &    !: 
     168   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &    !: 
    169169      ufon, vfon,       & !: now climatology of the north boundary velocities 
    170170      tfon, sfon,       & !: now climatology of the north boundary temperature and salinity 
    … …  
    172172      !                   !  in yhe obcdyn.F90 routine 
    173173 
    174    REAL(wp), DIMENSION(jpi,jpj) ::   sshfon_b      !: north boundary ssh correction averaged over the barotropic loop 
     174   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfon_b      !: north boundary ssh correction averaged over the barotropic loop 
    175175      !                                            !  (if Flather's algoritm applied at open boundary) 
    176176 
    … …  
    178178   !! Arrays for radiative North OBC 
    179179   !!-------------------------------- 
    180    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   unbnd, vnbnd      !: baroclinic u & v components of the velocity over 3 
     180   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   unbnd, vnbnd      !: baroclinic u & v components of the velocity over 3 
    181181      !                                                    !  rows and 3 time step (now, before, and before before) 
    182    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   tnbnd, snbnd      !: north boundary temperature and salinity over 
     182   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tnbnd, snbnd      !: north boundary temperature and salinity over 
    183183      !                                                    !  2 rows and 2 time step (now and before) 
    184    REAL(wp), DIMENSION(jpi,jpk) ::   u_cynbnd, v_cynbnd    !: Meridional component of the phase speed ratio compu- 
     184   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cynbnd, v_cynbnd    !: Meridional component of the phase speed ratio compu- 
    185185      !                                                    !  ted with radiation of zonal and meridional velocity  
    186186      !                                                    !  (respectively) at the north OB (u_cynbnd = cx rdt ) 
    187    REAL(wp), DIMENSION(jpi,jpk) ::   unmsk, vnmsk, tnmsk   !: 2D mask for the North OB 
     187   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   unmsk, vnmsk, tnmsk   !: 2D mask for the North OB 
    188188 
    189189   ! Note that those arrays are optimized for mpp case  
    … …  
    199199   INTEGER ::   njs0p1, njs1p1     !: do loop index in mpp case for jpsob+1 
    200200 
    201    REAL(wp), DIMENSION(jpi) ::    &   !: 
     201   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::    &   !: 
    202202      sshfos,           & !: now climatology of the south boundary sea surface height 
    203203      ubtfos,vbtfos       !: now climatology of the south boundary barotropic transport 
    204204 
    205    REAL(wp), DIMENSION(jpi,jpk) ::    &   !: 
     205   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::    &   !: 
    206206      ufos, vfos,       & !: now climatology of the south boundary velocities  
    207207      tfos, sfos,       & !: now climatology of the south boundary temperature and salinity 
    … …  
    209209      !                   !  in the obcdyn.F90 routine 
    210210 
    211    REAL(wp), DIMENSION(jpi,jpj) ::   sshfos_b     !: south boundary ssh correction averaged over the barotropic loop 
     211   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfos_b     !: south boundary ssh correction averaged over the barotropic loop 
    212212      !                                           !  (if Flather's algoritm applied at open boundary) 
    213213 
    … …  
    215215   !! Arrays for radiative South OBC   (computed by the forward time step in dynspg) 
    216216   !!-------------------------------- 
    217    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   usbnd, vsbnd     !: baroclinic u & v components of the velocity over 3  
     217   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   usbnd, vsbnd     !: baroclinic u & v components of the velocity over 3  
    218218      !                                                   !  rows and 3 time step (now, before, and before before) 
    219    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   tsbnd, ssbnd     !: south boundary temperature and salinity over 
     219   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsbnd, ssbnd     !: south boundary temperature and salinity over 
    220220      !                                                   !  2 rows and 2 time step (now and before) 
    221    REAL(wp), DIMENSION(jpi,jpk) ::   u_cysbnd, v_cysbnd   !: Meridional component of the phase speed ratio 
     221   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cysbnd, v_cysbnd   !: Meridional component of the phase speed ratio 
    222222      !                                                   !  computed with radiation of zonal and meridional velocity  
    223223      !                                                   !  (repsectively) at the south OB (u_cynbnd = cx rdt ) 
    224    REAL(wp), DIMENSION(jpi,jpk) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB 
     224   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB 
    225225 
    226226#else 
    … …  
    235235   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    236236   !!====================================================================== 
     237#if defined key_obc 
     238CONTAINS 
     239 
     240   FUNCTION obc_oce_alloc() 
     241     IMPLICIT none 
     242 
     243     ALLOCATE(                                                               & 
     244              !! East open boundary 
     245              obctmsk(jpi,jpj), obcumask(jpi,jpj), obcvmask(jpi,jpj),        & 
     246              sshfoe(jpjed:jpjef), ubtfoe(jpjed:jpjef), vbtfoe(jpjed:jpjef), & 
     247              ufoe(jpj,jpk), vfoe(jpj,jpk), tfoe(jpj,jpk), sfoe(jpj,jpk),    & 
     248              uclie(jpj,jpk), sshfoe_b(jpjed:jpjef,jpj),                     & 
     249              !! Arrays for radiative East OBC 
     250              uebnd(jpj,jpk,3,3), vebnd(jpj,jpk,3,3) ,                       & 
     251              tebnd(jpj,jpk,2,2), sebnd(jpj,jpk,2,2),                        & 
     252              u_cxebnd(jpj,jpk), v_cxebnd(jpj,jpk),                          & 
     253              uemsk(jpj,jpk), vemsk(jpj,jpk), temsk(jpj,jpk),                & 
     254              !! West open boundary 
     255              sshfow(jpjwd:jpjwf), ubtfow(jpjwd:jpjwf), vbtfow(jpjwd:jpjwf), & 
     256              ufow(jpj,jpk), vfow(jpj,jpk), tfow(jpj,jpk),                   & 
     257              sfow(jpj,jpk), ucliw(jpj,jpk), sshfow_b(jpjwd:jpjwf,jpj),      & 
     258              !! Arrays for radiative West OBC 
     259              uwbnd(jpj,jpk,3,3), vwbnd(jpj,jpk,3,3),                        & 
     260              twbnd(jpj,jpk,2,2), swbnd(jpj,jpk,2,2),                        & 
     261              u_cxwbnd(jpj,jpk), v_cxwbnd(jpj,jpk),                          & 
     262              uwmsk(jpj,jpk), vwmsk(jpj,jpk), twmsk(jpj,jpk),                & 
     263              !! North open boundary 
     264              sshfon(jpind:jpinf), ubtfon(jpind:jpinf), vbtfon(jpind:jpinf), & 
     265              ufon(jpi,jpk), vfon(jpi,jpk), tfon(jpi,jpk),                   & 
     266              sfon(jpi,jpk), vclin(jpi,jpk), sshfon_b(jpind:jpinf,jpj),      & 
     267              !! Arrays for radiative North OBC 
     268              unbnd(jpi,jpk,3,3), vnbnd(jpi,jpk,3,3),                        & 
     269              tnbnd(jpi,jpk,2,2), snbnd(jpi,jpk,2,2),                        & 
     270              u_cynbnd(jpi,jpk), v_cynbnd(jpi,jpk),                          & 
     271              unmsk(jpi,jpk), vnmsk(jpi,jpk), tnmsk (jpi,jpk),               & 
     272              !! South open boundary 
     273              sshfos(jpisd:jpisf), ubtfos(jpisd:jpisf), vbtfos(jpisd:jpisf), & 
     274              ufos(jpi,jpk), vfos(jpi,jpk), tfos(jpi,jpk),                   & 
     275              sfos(jpi,jpk), vclis(jpi,jpk),                                 & 
     276              sshfos_b(jpisd:jpisf,jpj),                                     & 
     277              !! Arrays for radiative South OBC  
     278              usbnd(jpi,jpk,3,3), vsbnd(jpi,jpk,3,3),                        & 
     279              tsbnd(jpi,jpk,2,2), ssbnd(jpi,jpk,2,2),                        & 
     280              u_cysbnd(jpi,jpk), v_cysbnd(jpi,jpk),                          & 
     281              usmsk(jpi,jpk), vsmsk(jpi,jpk), tsmsk(jpi,jpk),                & 
     282              !! 
     283              Stat=obc_oce_alloc ) 
     284 
     285   END FUNCTION obc_oce_alloc 
     286#endif ! Defined key_obc 
     287 
    237288END MODULE obc_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r2528 r2590  
    5353   ! bt arrays for interpolating time dependent data on the boundaries 
    5454   INTEGER :: nt_m=0, ntobc_m 
    55    REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtedta, vbtedta, sshedta  ! East 
    56    REAL(wp), DIMENSION(jpj,0:jptobc) :: ubtwdta, vbtwdta, sshwdta ! West 
    57    REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtndta, vbtndta, sshndta ! North 
    58    REAL(wp), DIMENSION(jpi,0:jptobc) :: ubtsdta, vbtsdta, sshsdta ! South 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtedta, vbtedta, sshedta       ! East 
     56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtwdta, vbtwdta, sshwdta   ! West 
     57   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtndta, vbtndta, sshndta   ! North 
     58   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtsdta, vbtsdta, sshsdta   ! South 
    5959   ! arrays used for interpolating time dependent data on the boundaries 
    60    REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uedta, vedta, tedta, sedta    ! East 
    61    REAL(wp), DIMENSION(jpj,jpk,0:jptobc) :: uwdta, vwdta, twdta, swdta    ! West 
    62    REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: undta, vndta, tndta, sndta    ! North 
    63    REAL(wp), DIMENSION(jpi,jpk,0:jptobc) :: usdta, vsdta, tsdta, ssdta    ! South 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uedta, vedta, tedta, sedta    ! East 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uwdta, vwdta, twdta, swdta    ! West 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: undta, vndta, tndta, sndta    ! North 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: usdta, vsdta, tsdta, ssdta    ! South 
    6464# else 
    6565   ! bt arrays for interpolating time dependent data on the boundaries 
    66    REAL(wp), DIMENSION(jpj,jptobc) :: ubtedta, vbtedta, sshedta  ! East 
    67    REAL(wp), DIMENSION(jpj,jptobc) :: ubtwdta, vbtwdta, sshwdta        ! West 
    68    REAL(wp), DIMENSION(jpi,jptobc) :: ubtndta, vbtndta, sshndta        ! North 
    69    REAL(wp), DIMENSION(jpi,jptobc) :: ubtsdta, vbtsdta, sshsdta        ! South 
     66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtedta, vbtedta, sshedta        ! East 
     67   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtwdta, vbtwdta, sshwdta        ! West 
     68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtndta, vbtndta, sshndta        ! North 
     69   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubtsdta, vbtsdta, sshsdta        ! South 
    7070   ! arrays used for interpolating time dependent data on the boundaries 
    71    REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uedta, vedta, tedta, sedta    ! East 
    72    REAL(wp), DIMENSION(jpj,jpk,jptobc) :: uwdta, vwdta, twdta, swdta    ! West 
    73    REAL(wp), DIMENSION(jpi,jpk,jptobc) :: undta, vndta, tndta, sndta    ! North 
    74    REAL(wp), DIMENSION(jpi,jpk,jptobc) :: usdta, vsdta, tsdta, ssdta    ! South 
     71   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uedta, vedta, tedta, sedta    ! East 
     72   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uwdta, vwdta, twdta, swdta    ! West 
     73   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: undta, vndta, tndta, sndta    ! North 
     74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: usdta, vsdta, tsdta, ssdta    ! South 
    7575# endif 
    76    LOGICAL, DIMENSION (jpj,jpk ) :: ltemsk=.TRUE., luemsk=.TRUE., lvemsk=.TRUE.  ! boolean msks 
    77    LOGICAL, DIMENSION (jpj,jpk ) :: ltwmsk=.TRUE., luwmsk=.TRUE., lvwmsk=.TRUE.  ! used for outliers 
    78    LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE.  ! checks 
    79    LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE. 
     76   ! Masks set to .TRUE. after successful allocation below 
     77   LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:,: ) :: ltemsk, luemsk, lvemsk  ! boolean msks 
     78   LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:,: ) :: ltwmsk, luwmsk, lvwmsk  ! used for outliers 
     79   LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:,: ) :: ltnmsk, lunmsk, lvnmsk  ! checks 
     80   LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:,: ) :: ltsmsk, lusmsk, lvsmsk 
    8081 
    8182   !! * Substitutions 
    … …  
    8990 
    9091CONTAINS 
     92 
     93   FUNCTION obc_dta_alloc() 
     94      !!------------------------------------------------------------------- 
     95      !!                     ***  ROUTINE obc_dta_alloc  *** 
     96      !!                     
     97      !!------------------------------------------------------------------- 
     98      IMPLICIT none 
     99      INTEGER :: obc_dta_alloc 
     100      INTEGER :: ierr(2) 
     101      !!------------------------------------------------------------------- 
     102 
     103# if defined key_dynspg_ts 
     104      ALLOCATE(ubtedta(jpj,0:jptobc), vbtedta(jpj,0:jptobc), & 
     105               sshedta(jpj,0:jptobc), ubtwdta(jpj,0:jptobc), & 
     106               vbtwdta(jpj,0:jptobc), sshwdta(jpj,0:jptobc), & 
     107               ubtndta(jpi,0:jptobc), vbtndta(jpi,0:jptobc), & 
     108               sshndta(jpi,0:jptobc), ubtsdta(jpi,0:jptobc), & 
     109               vbtsdta(jpi,0:jptobc), sshsdta(jpi,0:jptobc), & 
     110               ! arrays used for interpolating time dependent data on the boundaries 
     111               uedta(jpj,jpk,0:jptobc), vedta(jpj,jpk,0:jptobc), & 
     112               tedta(jpj,jpk,0:jptobc), sedta(jpj,jpk,0:jptobc), & 
     113               uwdta(jpj,jpk,0:jptobc), vwdta(jpj,jpk,0:jptobc), & 
     114               twdta(jpj,jpk,0:jptobc), swdta(jpj,jpk,0:jptobc), & 
     115               undta(jpi,jpk,0:jptobc), vndta(jpi,jpk,0:jptobc), & 
     116               tndta(jpi,jpk,0:jptobc), sndta(jpi,jpk,0:jptobc), & 
     117               usdta(jpi,jpk,0:jptobc), vsdta(jpi,jpk,0:jptobc), & 
     118               tsdta(jpi,jpk,0:jptobc), ssdta(jpi,jpk,0:jptobc), Stat=ierr(1) ) 
     119# else 
     120               ! bt arrays for interpolating time dependent data on the boundaries 
     121      ALLOCATE(ubtedta(jpj,jptobc), vbtedta(jpj,jptobc), sshedta(jpj,jptobc), & 
     122               ubtwdta(jpj,jptobc), vbtwdta(jpj,jptobc), sshwdta(jpj,jptobc), & 
     123               ubtndta(jpi,jptobc), vbtndta(jpi,jptobc), sshndta(jpi,jptobc), & 
     124               ubtsdta(jpi,jptobc), vbtsdta(jpi,jptobc), sshsdta(jpi,jptobc), & 
     125               ! arrays used for interpolating time dependent data on the boundaries 
     126               uedta(jpj,jpk,jptobc), vedta(jpj,jpk,jptobc),  & 
     127               tedta(jpj,jpk,jptobc), sedta(jpj,jpk,jptobc),  & 
     128               uwdta(jpj,jpk,jptobc), vwdta(jpj,jpk,jptobc),  & 
     129               twdta(jpj,jpk,jptobc), swdta(jpj,jpk,jptobc),  & 
     130               undta(jpi,jpk,jptobc), vndta(jpi,jpk,jptobc),  & 
     131               tndta(jpi,jpk,jptobc), sndta(jpi,jpk,jptobc),  & 
     132               usdta(jpi,jpk,jptobc), vsdta(jpi,jpk,jptobc),  & 
     133               tsdta(jpi,jpk,jptobc), ssdta(jpi,jpk,jptobc), Stat=ierr(1) ) 
     134# endif 
     135 
     136      ALLOCATE(uedta(jpj,jpk,jptobc), vedta(jpj,jpk,jptobc), & 
     137               tedta(jpj,jpk,jptobc), sedta(jpj,jpk,jptobc), & 
     138               uwdta(jpj,jpk,jptobc), vwdta(jpj,jpk,jptobc), & 
     139               twdta(jpj,jpk,jptobc), swdta(jpj,jpk,jptobc), & 
     140               undta(jpj,jpk,jptobc), vndta(jpj,jpk,jptobc), & 
     141               tndta(jpj,jpk,jptobc), sndta(jpj,jpk,jptobc), & 
     142               usdta(jpj,jpk,jptobc), vsdta(jpj,jpk,jptobc), & 
     143               tsdta(jpj,jpk,jptobc), ssdta(jpj,jpk,jptobc), & 
     144               ltemsk(jpj,jpk), luemsk(jpj,jpk), lvemsk(jpj,jpk), & 
     145               ltwmsk(jpj,jpk), luwmsk(jpj,jpk), lvwmsk(jpj,jpk), & 
     146               ltnmsk(jpj,jpk), lunmsk(jpj,jpk), lvnmsk(jpj,jpk), & 
     147               ltsmsk(jpj,jpk), lusmsk(jpj,jpk), lvsmsk(jpj,jpk), & 
     148               Stat=ierr(2)) 
     149 
     150      obc_dta_alloc = MAXVAL(ierr) 
     151 
     152      IF(obc_dta_alloc == 0)THEN 
     153         ! Initialise mask values following successful allocation 
     154         ltemsk(:)=.TRUE. 
     155         luemsk(:)=.TRUE. 
     156         lvemsk(:)=.TRUE. 
     157         ltwmsk(:)=.TRUE. 
     158         luwmsk(:)=.TRUE. 
     159         lvwmsk(:)=.TRUE. 
     160         ltnmsk(:)=.TRUE. 
     161         lunmsk(:)=.TRUE. 
     162         lvnmsk(:)=.TRUE. 
     163         ltsmsk(:)=.TRUE. 
     164         lusmsk(:)=.TRUE. 
     165         lvsmsk(:)=.TRUE. 
     166      END IF 
     167 
     168   END FUNCTION obc_dta_alloc 
     169 
    91170 
    92171   SUBROUTINE obc_dta( kt ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r2474 r2590  
    10261026         & frld 
    10271027#endif 
    1028  
     1028      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     1029#if ! defined key_ice_lim 
     1030      USE wrk_nemo, ONLY: frld => wrk_2d_1 
     1031#endif 
    10291032      IMPLICIT NONE 
    10301033 
    … …  
    10321035      INTEGER, INTENT(IN) :: kstp                         ! Current timestep 
    10331036      !! * Local declarations 
    1034 #if ! defined key_ice_lim 
    1035       REAL(wp), DIMENSION(jpi,jpj) :: frld 
    1036 #endif 
    10371037      INTEGER :: idaystp                ! Number of timesteps per day 
    10381038      INTEGER :: jprofset               ! Profile data set loop variable 
    … …  
    10441044      CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    10451045  
     1046#if ! defined key_ice_lim 
     1047      IF(.NOT. wrk_use(2, 1))THEN 
     1048         CALL ctl_stop('dia_obs : requested workspace array unavailable.') 
     1049         RETURN 
     1050      END IF 
     1051#endif 
     1052 
    10461053      IF(lwp) THEN 
    10471054         WRITE(numout,*) 
    … …  
    11211128      ENDIF 
    11221129 
     1130#if ! defined key_ice_lim 
     1131      IF(.NOT. wrk_release(2, 1))THEN 
     1132         CALL ctl_stop('dia_obs : failed to release workspace array.') 
     1133      END IF 
     1134#endif 
     1135 
    11231136   END SUBROUTINE dia_obs 
    11241137   

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90

    r2287 r2590  
    105105      !!        !  08-02  (K. Mogensen)  Original code 
    106106      !!---------------------------------------------------------------------- 
     107      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     108      USE wrk_nemo, ONLY: wrk_3d_1 
     109      !! 
    107110      !! * Arguments 
    108111      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil 
    … …  
    119122         & pgval            ! Stencil at each point 
    120123      !! * Local declarations 
    121       REAL(KIND=wp), DIMENSION(jpi,jpj,1) :: & 
     124      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 
    122125         & zval 
    123126      REAL(KIND=wp), DIMENSION(kptsi,kptsj,1,kobs) ::& 
    124127         & zgval  
    125128 
     129      ! Check workspace array and set-up pointer 
     130      IF(.NOT. wrk_use(3, 1))THEN 
     131         CALL ctl_stop('obs_int_comm_2d : requested workspace array unavailable.') 
     132         RETURN 
     133      END IF 
     134      zval => wrk_3d_1(:,:,1:1) 
     135 
    126136      ! Set up local "3D" buffer 
    127137 
    … …  
    144154 
    145155      pgval(:,:,:) = zgval(:,:,1,:) 
     156 
     157      ! 'Release' workspace array back to pool 
     158      IF(.NOT. wrk_release(3, 1))THEN 
     159         CALL ctl_stop('obs_int_comm_2d : failed to release workspace array.') 
     160      END IF 
    146161 
    147162   END SUBROUTINE obs_int_comm_2d 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90

    r2287 r2590  
    6767      !! * Modules used 
    6868      USE iom 
    69  
     69      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     70      USE wrk_nemo, ONLY: z_altbias => wrk_2d_1   ! Array to store the alt bias values 
     71      ! 
    7072      !! * Arguments 
    7173      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products 
    … …  
    9092      INTEGER :: i_var_id 
    9193 
    92       REAL(wp), DIMENSION(jpi,jpj) :: &  
    93          & z_altbias           ! Array to store the alt bias values 
    9494      REAL(wp), DIMENSION(1) :: & 
    9595         & zext, & 
    … …  
    109109      INTEGER :: numaltbias 
    110110 
     111      IF(.NOT. wrk_use(2, 1))THEN 
     112         CALL ctl_stop('obs_rea_altbias : requested workspace array unavailable.') 
     113         RETURN 
     114      END IF 
     115 
    111116      IF(lwp)WRITE(numout,*)  
    112117      IF(lwp)WRITE(numout,*) ' obs_rea_altbias : ' 
    … …  
    206211      END DO 
    207212 
     213      IF(.NOT. wrk_release(2, 1))THEN 
     214         CALL ctl_stop('obs_rea_altbias : failed to release workspace array.') 
     215      END IF 
     216 
    208217   END SUBROUTINE obs_rea_altbias 
    209218 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r2287 r2590  
    8181      !! * Modules used 
    8282      USE iom 
    83  
     83      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     84      USE wrk_nemo, ONLY: z_mdt => wrk_2d_1,  &  ! Array to store the MDT values 
     85                        mdtmask => wrk_2d_2    ! Array to store the mask for the MDT 
     86      !! 
    8487      !! * Arguments 
    8588      INTEGER, INTENT(IN) :: kslano          ! Number of SLA Products 
    … …  
    107110      INTEGER :: i_stat 
    108111 
    109       REAL(wp), DIMENSION(jpi,jpj) :: &  
    110          & z_mdt,       &  ! Array to store the MDT values 
    111          & mdtmask         ! Array to store the mask for the MDT 
    112112      REAL(wp), DIMENSION(1) :: & 
    113113         & zext, & 
    … …  
    129129         & igrdj 
    130130      INTEGER :: nummdt 
     131      !!---------------------------------------------------------------------- 
     132 
     133      IF(.NOT. wrk_use(2, 1,2))THEN 
     134         CALL ctl_stop('obs_rea_mdt : requested workspace array unavailable.') 
     135         RETURN 
     136      END IF 
    131137 
    132138      IF(lwp)WRITE(numout,*)  
    … …  
    234240      END DO 
    235241 
     242      IF(.NOT. wrk_release(2, 1,2))THEN 
     243         CALL ctl_stop('obs_rea_mdt : failed to release workspace arrays.') 
     244      END IF 
     245 
    236246   END SUBROUTINE obs_rea_mdt 
    237247 
    … …  
    256266      !!---------------------------------------------------------------------- 
    257267      !! * Modules used 
    258  
     268      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     269      USE wrk_nemo, ONLY: zpromsk => wrk_2d_3 
     270      !! 
    259271      !! * Arguments 
    260272      REAL(wp), DIMENSION(jpi,jpj), INTENT(INOUT) :: & 
    … …  
    270282      REAL(wp) :: zcorr_bcketa 
    271283      REAL(wp) :: zcorr 
    272       REAL(wp), DIMENSION(jpi,jpj) :: zpromsk 
    273284      INTEGER :: jj 
    274285      INTEGER :: ji 
    275286      CHARACTER(LEN=14), PARAMETER :: & 
    276287         & cpname = 'obs_offset_mdt' 
    277     
     288      !!---------------------------------------------------------------------- 
     289 
     290      IF(.NOT. wrk_use(2, 3))THEN 
     291         CALL ctl_stop('obs_offset_mdt : requested workspace array unavailable.') 
     292         RETURN 
     293      END IF 
     294 
    278295      !  Initialize the local mask, for domain projection  
    279296      !  Also exclude mdt points which are set to missing data 
    … …  
    341358 
    342359 
     360      IF(.NOT. wrk_release(2, 3))THEN 
     361         CALL ctl_stop('obs_offset_mdt : failed to release workspace array.') 
     362      END IF 
     363 
    343364   END SUBROUTINE obs_offset_mdt 
    344365  

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90

    r2287 r2590  
    5555      !!---------------------------------------------------------------------- 
    5656      !! * Modules used 
    57     
     57      USE wrk_nemo, ONLY: wrk_use, wrk_release    
     58      USE wrk_nemo, ONLY: zsingu => wrk_2d_1, zcosgu => wrk_2d_2, & 
     59                          zsingv => wrk_2d_3, zcosgv => wrk_2d_4 
    5860      !! * Arguments 
    5961      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read 
    … …  
    6365         & pv 
    6466      !! * Local declarations 
    65       REAL(wp), DIMENSION(jpi,jpj) :: & 
    66          & zsingu, & 
    67          & zcosgu, & 
    68          & zsingv, & 
    69          & zcosgv 
    7067      REAL(wp), DIMENSION(2,2,1) :: zweig 
    7168      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    … …  
    9693      INTEGER :: jk 
    9794 
     95      IF(.NOT. wrk_use(2, 1,2,3,4))THEN 
     96         CALL ctl_stop('obs_rotvel : requested workspace arrays unavailable.') 
     97         RETURN 
     98      END IF 
     99 
    98100      !----------------------------------------------------------------------- 
    99101      ! Allocate data for message parsing and interpolation 
    … …  
    227229         & ) 
    228230 
     231      IF(.NOT. wrk_release(2, 1,2,3,4))THEN 
     232         CALL ctl_stop('obs_rotvel : failed to release workspace arrays.') 
     233      END IF 
     234 
    229235   END SUBROUTINE obs_rotvel 
    230236 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r2528 r2590  
    6565      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    6666      !!---------------------------------------------------------------------- 
     67      USE wrk_nemo, ONLY: wrk_use, wrk_release, llwrk_use, llwrk_release 
     68      USE wrk_nemo, ONLY: llwrk_3d_1  
     69      USE wrk_nemo, ONLY: wrk_3d_6, wrk_3d_7 
     70      !! 
    6771      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
    6872      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness 
    … …  
    8286      REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2 
    8387      !! 
    84       LOGICAL , DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   llmask 
    85       REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 
    86       REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zficeth   !  function of ice thickness 
     88      LOGICAL,  POINTER, DIMENSION(:,:,:) ::   llmask    ! Pointer to sub-array of workspace array 
     89      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 
     90      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zficeth   !  function of ice thickness 
    8791      !!--------------------------------------------------------------------- 
    8892       
    8993      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
     94 
     95      IF( (.not. llwrk_use(3,1)) .OR. (.not. wrk_use(3, 6,7)) )THEN 
     96         CALL ctl_stop('albedo_ice: requested workspace arrays are unavailable.') 
     97         RETURN 
     98      ELSE IF(ijpl > jpk)THEN 
     99         ! 3D workspace arrays have extent jpk in 3rd dimension - check that  
     100         ! ijpl doesn't exceed it. 
     101         CALL ctl_stop('albedo_ice: 3rd dimension of standard workspace arrays too small for them to be used here.') 
     102         RETURN 
     103      ELSE 
     104         ! Associate pointers with sub-arrays of workspace arrays 
     105         llmask  => llwrk_3d_1(:,:,1:ijpl) 
     106         zalbfz  =>   wrk_3d_6(:,:,1:ijpl) 
     107         zficeth =>   wrk_3d_7(:,:,1:ijpl) 
     108      END IF 
    90109 
    91110      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    … …  
    94113      !  Computation of  zficeth 
    95114      !--------------------------- 
    96       llmask = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice ) 
     115      llmask(:,:,1:ijpl) = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice ) 
    97116      ! ice free of snow and melts 
    98       WHERE( llmask )   ;   zalbfz = rn_albice 
    99       ELSEWHERE         ;   zalbfz = rn_alphdi 
     117      WHERE( llmask(:,:,1:ijpl) )   ;   zalbfz = rn_albice 
     118      ELSEWHERE                     ;   zalbfz = rn_alphdi 
    100119      END WHERE 
    101120 
    … …  
    155174      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction 
    156175      ! 
     176      IF( (.not. llwrk_release(3, 1)) .OR. (.not. wrk_release(3, 6,7)) )THEN 
     177         CALL ctl_stop('albedo_ice: failed to release workspace arrays.') 
     178      END IF 
     179      ! 
    157180   END SUBROUTINE albedo_ice 
    158181 
    … …  
    166189      !! ** Method  :   .... 
    167190      !!---------------------------------------------------------------------- 
    168       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky 
    169       REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
     191      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky 
     192      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
    170193      !! 
    171194      REAL(wp) ::   zcoef   ! temporary scalar 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r2528 r2590  
    251251      INTEGER,                      INTENT( IN    )   :: kid       ! variable index in the array 
    252252      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    253       REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
     253      REAL(wp),     DIMENSION(:,:), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
    254254      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument 
    255255      !! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90

    r2528 r2590  
    117117      !! ** Method  :   OASIS4 MPI communication  
    118118      !!-------------------------------------------------------------------- 
     119      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     120      USE wrk_nemo, ONLY: zclo => wrk_3d_1, zcla => wrk_3d_2 
     121      USE wrk_nemo, ONLY: zlon => wrk_2d_1, zlat => wrk_2d_2 
     122      !! 
    119123      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields 
    120124      ! 
    … …  
    138142      LOGICAL                    :: new_points 
    139143      LOGICAL                    :: new_mask 
    140       LOGICAL                    :: llmask(jpi,jpj,1) 
     144      LOGICAL, ALLOCATABLE, SAVE :: llmask(:,:,:) ! jpi,jpj,1 
    141145 
    142146      INTEGER                    :: ji, jj, jg, jc     ! local loop indicees 
    … …  
    148152      CHARACTER(len=1), DIMENSION(4) :: clgrd = (/ 'T','U','V','F' /)     ! name of the grid points 
    149153 
    150       REAL(kind=wp), DIMENSION(jpi,jpj,4)  :: zclo, zcla 
    151       REAL(kind=wp), DIMENSION(jpi,jpj  )  :: zlon, zlat 
    152  
    153154      TYPE(PRISM_Time_struct)    :: tmpdate 
    154155      INTEGER                    :: idate_incr      ! date increment 
    155156      !! 
    156157      !!-------------------------------------------------------------------- 
     158 
     159      IF( (.not. wrk_use(3, 1,2)) .OR. (.not. wrk_use(2, 1,2)) )THEN 
     160         CALL ctl_stop('cpl_prism_define: ERROR: requested workspace arrays are unavailable.') 
     161         RETURN 
     162      END IF 
    157163 
    158164      IF(lwp) WRITE(numout,*) 
    … …  
    170176      ENDIF 
    171177 
     178      IF(.not. ALLOCATED(mask))THEN 
     179         ALLOCATE(llmask(jpi,jpj,1), Stat=ji) 
     180         IF(ji /= 0)THEN 
     181            CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating llmask' ) 
     182            RETURN 
     183         END IF 
     184      END IF 
    172185 
    173186      ! ----------------------------------------------------------------- 
    … …  
    320333      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef') 
    321334       
     335      IF( (.not. wrk_release(3, 1,2)) .OR. (.not. wrk_release(2, 1,2)) )THEN 
     336         CALL ctl_stop('cpl_prism_define: ERROR: failed to release workspace arrays.') 
     337      END IF 
     338 
    322339   END SUBROUTINE cpl_prism_define 
    323340    
    … …  
    336353      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument 
    337354      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    338       REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata 
     355      REAL(wp),     DIMENSION(:,:), INTENT( IN    )   :: pdata 
    339356      !! 
    340357      !! 
    … …  
    375392      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array 
    376393      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds 
    377       REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
     394      REAL(wp),     DIMENSION(:,:), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done 
    378395      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS4 info argument 
    379396      !! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r2528 r2590  
    596596      !! ** Method  :    
    597597      !!---------------------------------------------------------------------- 
     598      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     599      USE wrk_nemo, ONLY: utmp => wrk_2d_4, vtmp => wrk_2d_5 
     600      !! 
    598601      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
    599602      TYPE(FLD), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables 
    … …  
    603606      INTEGER                      ::   ill          ! character length 
    604607      INTEGER                      ::   iv           ! indice of V component 
    605       REAL(wp), DIMENSION(jpi,jpj) ::   utmp, vtmp   ! temporary arrays for vector rotation 
    606608      CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name 
    607609      !!--------------------------------------------------------------------- 
     610 
     611      IF(.not. wrk_use(2, 4,5))THEN 
     612         CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.') 
     613         RETURN 
     614      END IF 
     615 
    608616      !! (sga: following code should be modified so that pairs arent searched for each time 
    609617      ! 
    … …  
    638646          ENDIF 
    639647       END DO 
     648 
     649      IF(.not. wrk_release(2, 4,5))THEN 
     650         CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 
     651      END IF 
     652 
    640653   END SUBROUTINE fld_rot 
    641654 
    … …  
    813826      !! ** Method  :    
    814827      !!---------------------------------------------------------------------- 
     828      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     829      USE wrk_nemo, ONLY: data_tmp => wrk_2d_1 
     830      USE wrk_nemo, ONLY: data_src => iwrk_2d_1 
     831      !! 
    815832      TYPE( FLD ),      INTENT(in)            ::   sd            ! field with name of weights file 
    816833      !! 
    … …  
    821838      CHARACTER (len=5)                       ::   aname 
    822839      INTEGER , DIMENSION(3)                  ::   ddims 
    823       INTEGER , DIMENSION(jpi, jpj)           ::   data_src 
    824       REAL(wp), DIMENSION(jpi, jpj)           ::   data_tmp 
    825840      LOGICAL                                 ::   cyclical 
    826841      INTEGER                                 ::   zwrap         ! temporary integer 
    827842      !!---------------------------------------------------------------------- 
     843      ! 
     844      IF( (.NOT. wrk_use(2, 1)) .OR. (.NOT. iwrk_use(2,1)) )THEN 
     845         CALL ctl_stop('fld_weights: requested workspace arrays are unavailable.') 
     846         RETURN 
     847      END IF 
    828848      ! 
    829849      IF( nxt_wgt > tot_wgts ) THEN 
    … …  
    937957      ENDIF 
    938958 
     959      IF( (.NOT. wrk_release(2, 1)) .OR. (.NOT. iwrk_release(2,1)) )THEN 
     960         CALL ctl_stop('fld_weights: failed to release workspace arrays.') 
     961      END IF 
     962 
    939963   END SUBROUTINE fld_weight 
    940964 
    … …  
    952976      INTEGER,          INTENT(in)                        ::   kw                  ! weights number 
    953977      INTEGER,          INTENT(in)                        ::   kk                  ! vertical dimension of kk 
    954       REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta              ! output field on model grid 
     978      REAL(wp),         INTENT(inout), DIMENSION(:,:,:)  ::   dta              ! output field on model grid 
    955979      INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice) 
    956980      !!  

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r2528 r2590  
    2828 
    2929   PUBLIC   obs_rot 
    30  
    31    REAL(wp), DIMENSION(jpi,jpj) ::   & 
     30   PUBLIC   geo2oce_alloc ! Called in nemogcm.F90 
     31 
     32   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   & 
    3233      gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point 
    3334      gsinu, gcosu,   &  ! cos/sin between model grid lines and NP direction at U point 
    … …  
    3637 
    3738   LOGICAL ::   lmust_init = .TRUE.        !: used to initialize the cos/sin variables (se above) 
     39 
     40   ! Local 'saved' arrays - one set for geo2oce and one set for oce2geo. 
     41   ! Declared here so can be allocated in ge2oce_alloc(). 
     42   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zsinlon_o2g, zcoslon_o2g, zsinlat_o2g, zcoslat_o2g 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zsinlon_g2o, zcoslon_g2o, zsinlat_g2o, zcoslat_g2o 
    3844 
    3945   !! * Substitutions 
    … …  
    4652 
    4753CONTAINS 
     54 
     55   FUNCTION geo2oce_alloc() 
     56      !!---------------------------------------------------------------------- 
     57      !!                  ***  ROUTINE geo2oce_alloc  *** 
     58      !!---------------------------------------------------------------------- 
     59      IMPLICIT none 
     60      INTEGER :: geo2oce_alloc 
     61 
     62      ALLOCATE(gsint(jpi,jpj), gcost(jpi,jpj),   & 
     63               gsinu(jpi,jpj), gcosu(jpi,jpj),   & 
     64               gsinv(jpi,jpj), gcosv(jpi,jpj),   & 
     65               gsinf(jpi,jpj), gcosf(jpi,jpj),   & 
     66               ! 
     67               zsinlon_o2g(jpi,jpj,4), zcoslon_o2g(jpi,jpj,4), &  
     68               zsinlat_o2g(jpi,jpj,4), zcoslat_o2g(jpi,jpj,4), & 
     69               zsinlon_g2o(jpi,jpj,4), zcoslon_g2o(jpi,jpj,4), & 
     70               zsinlat_g2o(jpi,jpj,4), zcoslat_g2o(jpi,jpj,4), & 
     71               Stat=geo2oce_alloc) 
     72 
     73   END FUNCTION geo2oce_alloc 
     74 
    4875 
    4976   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
    … …  
    347374      INTEGER ::   ig     ! 
    348375      !! * Local save 
    349       REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat 
    350376      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE. 
    351377      !!---------------------------------------------------------------------- 
    … …  
    355381            ig = 1 
    356382            IF( .NOT. linit(ig) ) THEN  
    357                zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
    358                zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
    359                zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
    360                zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     383               zsinlon_g2o(:,:,ig) = SIN( rad * glamt(:,:) ) 
     384               zcoslon_g2o(:,:,ig) = COS( rad * glamt(:,:) ) 
     385               zsinlat_g2o(:,:,ig) = SIN( rad * gphit(:,:) ) 
     386               zcoslat_g2o(:,:,ig) = COS( rad * gphit(:,:) ) 
    361387               linit(ig) = .TRUE. 
    362388            ENDIF 
    … …  
    364390            ig = 2 
    365391            IF( .NOT. linit(ig) ) THEN  
    366                zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
    367                zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
    368                zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
    369                zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     392               zsinlon_g2o(:,:,ig) = SIN( rad * glamu(:,:) ) 
     393               zcoslon_g2o(:,:,ig) = COS( rad * glamu(:,:) ) 
     394               zsinlat_g2o(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     395               zcoslat_g2o(:,:,ig) = COS( rad * gphiu(:,:) ) 
    370396               linit(ig) = .TRUE. 
    371397            ENDIF 
    … …  
    373399            ig = 3 
    374400            IF( .NOT. linit(ig) ) THEN  
    375                zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
    376                zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
    377                zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
    378                zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     401               zsinlon_g2o(:,:,ig) = SIN( rad * glamv(:,:) ) 
     402               zcoslon_g2o(:,:,ig) = COS( rad * glamv(:,:) ) 
     403               zsinlat_g2o(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     404               zcoslat_g2o(:,:,ig) = COS( rad * gphiv(:,:) ) 
    379405               linit(ig) = .TRUE. 
    380406            ENDIF 
    … …  
    382408            ig = 4 
    383409            IF( .NOT. linit(ig) ) THEN  
    384                zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
    385                zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
    386                zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
    387                zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     410               zsinlon_g2o(:,:,ig) = SIN( rad * glamf(:,:) ) 
     411               zcoslon_g2o(:,:,ig) = COS( rad * glamf(:,:) ) 
     412               zsinlat_g2o(:,:,ig) = SIN( rad * gphif(:,:) ) 
     413               zcoslat_g2o(:,:,ig) = COS( rad * gphif(:,:) ) 
    388414               linit(ig) = .TRUE. 
    389415            ENDIF 
    … …  
    393419      END SELECT 
    394420       
    395       pte = - zsinlon(:,:,ig) * pxx + zcoslon(:,:,ig) * pyy 
    396       ptn = - zcoslon(:,:,ig) * zsinlat(:,:,ig) * pxx    & 
    397             - zsinlon(:,:,ig) * zsinlat(:,:,ig) * pyy    & 
    398             + zcoslat(:,:,ig) * pzz 
     421      pte = - zsinlon_g2o(:,:,ig) * pxx + zcoslon_g2o(:,:,ig) * pyy 
     422      ptn = - zcoslon_g2o(:,:,ig) * zsinlat_g2o(:,:,ig) * pxx    & 
     423            - zsinlon_g2o(:,:,ig) * zsinlat_g2o(:,:,ig) * pyy    & 
     424            + zcoslat_g2o(:,:,ig) * pzz 
    399425!!$   ptv =   zcoslon(:,:,ig) * zcoslat(:,:,ig) * pxx    & 
    400426!!$         + zsinlon(:,:,ig) * zcoslat(:,:,ig) * pyy    & 
    … …  
    415441      !!        !         (A. Caubel)  oce2geo - Original code 
    416442      !!---------------------------------------------------------------------- 
    417       REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    ) ::  pte, ptn 
    418       CHARACTER(len=1)            , INTENT( IN    ) ::  cgrid 
    419       REAL(wp), DIMENSION(jpi,jpj), INTENT(   OUT ) ::  pxx , pyy , pzz 
     443      REAL(wp), DIMENSION(:,:), INTENT( IN    ) ::  pte, ptn 
     444      CHARACTER(len=1)        , INTENT( IN    ) ::  cgrid 
     445      REAL(wp), DIMENSION(:,:), INTENT(   OUT ) ::  pxx , pyy , pzz 
    420446      !! 
    421447      REAL(wp), PARAMETER :: rpi = 3.141592653E0 
    … …  
    423449      INTEGER ::   ig     ! 
    424450      !! * Local save 
    425       REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   zsinlon, zcoslon, zsinlat, zcoslat 
    426451      LOGICAL , SAVE, DIMENSION(4)         ::   linit = .FALSE. 
    427452      !!---------------------------------------------------------------------- 
    … …  
    431456            ig = 1 
    432457            IF( .NOT. linit(ig) ) THEN  
    433                zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 
    434                zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 
    435                zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 
    436                zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 
     458               zsinlon_o2g(:,:,ig) = SIN( rad * glamt(:,:) ) 
     459               zcoslon_o2g(:,:,ig) = COS( rad * glamt(:,:) ) 
     460               zsinlat_o2g(:,:,ig) = SIN( rad * gphit(:,:) ) 
     461               zcoslat_o2g(:,:,ig) = COS( rad * gphit(:,:) ) 
    437462               linit(ig) = .TRUE. 
    438463            ENDIF 
    … …  
    440465            ig = 2 
    441466            IF( .NOT. linit(ig) ) THEN  
    442                zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 
    443                zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 
    444                zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 
    445                zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 
     467               zsinlon_o2g(:,:,ig) = SIN( rad * glamu(:,:) ) 
     468               zcoslon_o2g(:,:,ig) = COS( rad * glamu(:,:) ) 
     469               zsinlat_o2g(:,:,ig) = SIN( rad * gphiu(:,:) ) 
     470               zcoslat_o2g(:,:,ig) = COS( rad * gphiu(:,:) ) 
    446471               linit(ig) = .TRUE. 
    447472            ENDIF 
    … …  
    449474            ig = 3 
    450475            IF( .NOT. linit(ig) ) THEN  
    451                zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 
    452                zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 
    453                zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 
    454                zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 
     476               zsinlon_o2g(:,:,ig) = SIN( rad * glamv(:,:) ) 
     477               zcoslon_o2g(:,:,ig) = COS( rad * glamv(:,:) ) 
     478               zsinlat_o2g(:,:,ig) = SIN( rad * gphiv(:,:) ) 
     479               zcoslat_o2g(:,:,ig) = COS( rad * gphiv(:,:) ) 
    455480               linit(ig) = .TRUE. 
    456481            ENDIF 
    … …  
    458483            ig = 4 
    459484            IF( .NOT. linit(ig) ) THEN  
    460                zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 
    461                zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 
    462                zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 
    463                zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 
     485               zsinlon_o2g(:,:,ig) = SIN( rad * glamf(:,:) ) 
     486               zcoslon_o2g(:,:,ig) = COS( rad * glamf(:,:) ) 
     487               zsinlat_o2g(:,:,ig) = SIN( rad * gphif(:,:) ) 
     488               zcoslat_o2g(:,:,ig) = COS( rad * gphif(:,:) ) 
    464489               linit(ig) = .TRUE. 
    465490            ENDIF 
    … …  
    469494      END SELECT 
    470495 
    471        pxx = - zsinlon(:,:,ig) * pte - zcoslon(:,:,ig) * zsinlat(:,:,ig) * ptn  
    472        pyy =   zcoslon(:,:,ig) * pte - zsinlon(:,:,ig) * zsinlat(:,:,ig) * ptn 
    473        pzz =   zcoslat(:,:,ig) * ptn 
     496       pxx = - zsinlon_o2g(:,:,ig) * pte - zcoslon_o2g(:,:,ig) * zsinlat_o2g(:,:,ig) * ptn  
     497       pyy =   zcoslon_o2g(:,:,ig) * pte - zsinlon_o2g(:,:,ig) * zsinlat_o2g(:,:,ig) * ptn 
     498       pzz =   zcoslat_o2g(:,:,ig) * ptn 
    474499 
    475500       
    … …  
    496521      !!---------------------------------------------------------------------- 
    497522      !! * Arguments 
    498       REAL(wp), INTENT( IN   ), DIMENSION(jpi,jpj) ::   & 
     523      REAL(wp), INTENT( IN   ), DIMENSION(:,:) ::   & 
    499524         px1, py1          ! two horizontal components to be rotated 
    500       REAL(wp), INTENT( OUT  ), DIMENSION(jpi,jpj) ::   & 
     525      REAL(wp), INTENT( OUT  ), DIMENSION(:,:) ::   & 
    501526         px2, py2          ! the two horizontal components in the model repere 
    502527      INTEGER, INTENT( IN ) ::   & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90

    r2528 r2590  
    2222   PRIVATE 
    2323 
     24   PUBLIC sbc_ice_alloc ! called in nemogcm.F90 
     25 
    2426# if defined  key_lim2 
    2527   LOGICAL         , PUBLIC, PARAMETER ::   lk_lim2    = .TRUE.   !: LIM-2 ice model 
    … …  
    3739# endif 
    3840 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qns_ice   !: non solar heat flux over ice                         [W/m2] 
    40    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qsr_ice   !: solar heat flux over ice                             [W/m2] 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   qla_ice   !: latent flux over ice                                 [W/m2] 
    42    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqla_ice  !: latent sensibility over ice                          [W/m2/K] 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   dqns_ice  !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
    44    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   tn_ice    !: ice surface temperature                              [K] 
    45    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpl) ::   alb_ice   !: albedo of ice 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qns_ice   !: non solar heat flux over ice                         [W/m2] 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice   !: solar heat flux over ice                             [W/m2] 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice   !: latent flux over ice                                 [W/m2] 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqla_ice  !: latent sensibility over ice                          [W/m2/K] 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dqns_ice  !: non solar heat flux sensibility over ice (LW+SEN+LA) [W/m2/K] 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice    !: ice surface temperature                              [K] 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   alb_ice   !: albedo of ice 
    4648 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau_ice    !: u-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau_ice    !: v-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr1_i0      !: 1st fraction of Qsr which penetrates inside the ice cover 
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr2_i0      !: 2nd fraction of Qsr which penetrates inside the ice cover 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau_ice    !: u-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau_ice    !: v-stress over ice (I-pt for VP or U,V-pts for EVP)   [N/m2] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr1_i0      !: 1st fraction of Qsr which penetrates inside the ice cover 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr2_i0      !: 2nd fraction of Qsr which penetrates inside the ice cover 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_ice     !: solid freshwater budget over ice: sublivation - snow 
    5254 
    5355# if defined key_lim3 
    54    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tatm_ice    !: air temperature 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tatm_ice    !: air temperature 
    5557# endif 
     58 
     59CONTAINS 
     60 
     61  FUNCTION sbc_ice_alloc() 
     62    !!---------------------------------------------------------------------- 
     63    !!---------------------------------------------------------------------- 
     64    IMPLICIT none 
     65    INTEGER :: sbc_ice_alloc 
     66    !!---------------------------------------------------------------------- 
     67  
     68    ALLOCATE(qns_ice(jpi,jpj,jpl),  qsr_ice(jpi,jpj,jpl),               & 
     69             qla_ice(jpi,jpj,jpl),  dqla_ice(jpi,jpj,jpl),              & 
     70             dqns_ice(jpi,jpj,jpl), tn_ice(jpi,jpj,jpl),                & 
     71             alb_ice(jpi,jpj,jpl),                                      & 
     72             utau_ice(jpi,jpj),     vtau_ice(jpi,jpj), fr1_i0(jpi,jpj), & 
     73             fr2_i0(jpi,jpj),       emp_ice(jpi,jpj),                   & 
     74             Stat=sbc_ice_alloc) 
     75 
     76  END FUNCTION sbc_ice_alloc 
    5677 
    5778#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r2528 r2590  
    1414   IMPLICIT NONE 
    1515   PRIVATE 
    16     
     16 
     17   PUBLIC sbc_oce_alloc ! routine called in nemogcm.F90 
     18 
    1719   !!---------------------------------------------------------------------- 
    1820   !!           Namelist for the Ocean Surface Boundary Condition 
    … …  
    3941   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress) 
    4042   !!                                   !!   now    ! before   !! 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
    42    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2] 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]  
    44    !! wndm is used only in PISCES to compute surface gases exchanges in ice-free ocean or leads 
    45    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
    46    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2] 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2] 
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s] 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s] 
    52    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s] 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]   
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2] 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2] 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]  
     46   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s] 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2] 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2] 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2] 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s] 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s] 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff   [Kg/m2/s]   
    5456   !! 
    55    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] 
    56    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts 
     58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk 
    5759   !! 
    58    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tprecip           !: total precipitation                          [Kg/m2/s] 
    59    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
    60    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s] 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s] 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1) 
    6163#if defined key_cpl_carbon_cycle 
    62    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm] 
    6365#endif 
    6466 
    … …  
    6769   !!---------------------------------------------------------------------- 
    6870   INTEGER , PUBLIC                     ::   nn_fsbc   !: frequency of sbc computation (as well as sea-ice model) 
    69    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s] 
    70    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s] 
    71    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius] 
    72    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu] 
    73    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m] 
     71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s] 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s] 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius] 
     74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu] 
     75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m] 
    7476 
    7577   !!---------------------------------------------------------------------- 
    … …  
    7880   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7981   !!====================================================================== 
     82CONTAINS 
     83 
     84   FUNCTION sbc_oce_alloc() 
     85      !!--------------------------------------------------------------------- 
     86      !!                  ***  ROUTINE sbc_oce_alloc  *** 
     87      !!--------------------------------------------------------------------- 
     88      USE in_out_manager, ONLY: ctl_warn 
     89      IMPLICIT none 
     90      INTEGER :: sbc_oce_alloc 
     91      ! Local variables 
     92      INTEGER :: ierr(4) 
     93      !!--------------------------------------------------------------------- 
     94 
     95      ierr(:) = 0 
     96 
     97      ALLOCATE(utau(jpi,jpj),    utau_b(jpi,jpj),                      & 
     98               vtau(jpi,jpj),    vtau_b(jpi,jpj),                      & 
     99               taum(jpi,jpj),    wndm(jpi,jpj)  , Stat=ierr(1))  
     100 
     101      ALLOCATE(qsr(jpi,jpj),     qns(jpi,jpj),    qns_b(jpi,jpj),      & 
     102               qsr_tot(jpi,jpj), qns_tot(jpi,jpj),                     & 
     103               emp(jpi,jpj),     emp_b(jpi,jpj),                       & 
     104               emps(jpi,jpj),    emps_b(jpi,jpj), emp_tot(jpi,jpj),    & 
     105               Stat=ierr(2)) 
     106 
     107      ALLOCATE(rnf(jpi,jpj),          rnf_b(jpi,jpj),                       & 
     108               sbc_tsc(jpi,jpj,jpts), sbc_tsc_b(jpi,jpj,jpts),         &   
     109               qsr_hc(jpi,jpj,jpk) ,  qsr_hc_b(jpi,jpj,jpk),  Stat=ierr(3)) 
     110 
     111      ALLOCATE(tprecip(jpi,jpj),      sprecip(jpi,jpj), fr_i(jpi,jpj), & 
     112#if defined key_cpl_carbon_cycle 
     113               atm_co2(jpi,jpj),                                       & 
     114#endif 
     115               ssu_m(jpi,jpj), ssv_m(jpi,jpj), sst_m(jpi,jpj),         & 
     116               sss_m(jpi,jpj), ssh_m(jpi,jpj), Stat=ierr(4)) 
     117 
     118      sbc_oce_alloc = MAXVAL(ierr) 
     119 
     120      IF(sbc_oce_alloc > 0)THEN 
     121         CALL ctl_warn('sbc_oce_alloc: allocation of arrays failed.') 
     122      END IF 
     123 
     124   END FUNCTION sbc_oce_alloc 
     125 
     126 
     127   SUBROUTINE sbc_tau2wnd 
     128      !!--------------------------------------------------------------------- 
     129      !!                    ***  ROUTINE sbc_tau2wnd  *** 
     130      !!                    
     131      !! ** Purpose : Estimation of wind speed as a function of wind stress    
     132      !! 
     133      !! ** Method  : |tau|=rhoa*Cd*|U|^2 
     134      !!--------------------------------------------------------------------- 
     135      USE dom_oce         ! ocean space and time domain 
     136      USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     137      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3 
     138      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
     139      REAL(wp) ::   ztx, zty, ztau, zcoef ! temporary variables 
     140      INTEGER  ::   ji, jj                ! dummy indices 
     141      !! * Substitutions 
     142#  include "vectopt_loop_substitute.h90" 
     143      !!--------------------------------------------------------------------- 
     144      zcoef = 0.5 / ( zrhoa * zcdrag )  
     145!CDIR NOVERRCHK 
     146      DO jj = 2, jpjm1 
     147!CDIR NOVERRCHK 
     148         DO ji = fs_2, fs_jpim1   ! vect. opt. 
     149            ztx = utau(ji-1,jj  ) + utau(ji,jj)  
     150            zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
     151            ztau = SQRT( ztx * ztx + zty * zty ) 
     152            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1) 
     153         END DO 
     154      END DO 
     155      CALL lbc_lnk( wndm(:,:) , 'T', 1. ) 
     156 
     157   END SUBROUTINE sbc_tau2wnd 
     158 
    80159END MODULE sbc_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r2528 r2590  
    4343   PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90  
    4444   PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90  
     45   PUBLIC sbc_blk_clio_alloc  ! routine called by nemogcm.F90 
    4546 
    4647   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read  
    … …  
    5253   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin) 
    5354   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s) 
    54    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
     55   TYPE(FLD),ALLOCATABLE,SAVE,DIMENSION(:) :: sf  ! structure of input fields (file informations, fields read) 
    5556 
    5657   INTEGER, PARAMETER  ::   jpintsr = 24          ! number of time step between sunrise and sunset 
    … …  
    7374      &         6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 / 
    7475   !! 
    75    REAL(wp), DIMENSION(jpi,jpj) ::   sbudyko      ! cloudiness effect on LW radiation 
    76    REAL(wp), DIMENSION(jpi,jpj) ::   stauc        ! cloud optical depth  
     76   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sbudyko      ! cloudiness effect on LW radiation 
     77   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stauc        ! cloud optical depth  
    7778    
    7879   REAL(wp)  ::   zeps    = 1.e-20                ! constant values 
    … …  
    8788   !!---------------------------------------------------------------------- 
    8889CONTAINS 
     90 
     91   FUNCTION sbc_blk_clio_alloc() 
     92      !!--------------------------------------------------------------------- 
     93      !!                 ***  ROUTINE sbc_blk_clio_alloc  *** 
     94      !!--------------------------------------------------------------------- 
     95      IMPLICIT none 
     96      INTEGER :: sbc_blk_clio_alloc 
     97      !!--------------------------------------------------------------------- 
     98 
     99      ALLOCATE(sbudyko(jpi,jpj), & 
     100               stauc(jpi,jpj),   & 
     101               Stat=sbc_blk_clio_alloc) 
     102 
     103   END FUNCTION sbc_blk_clio_alloc 
    89104 
    90105   SUBROUTINE sbc_blk_clio( kt ) 
    … …  
    208223      !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC 
    209224      !!---------------------------------------------------------------------- 
     225      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     226      USE wrk_nemo, ONLY: zqlw => wrk_2d_1  ! long-wave heat flux over ocean 
     227      USE wrk_nemo, ONLY: zqla => wrk_2d_2  ! latent heat flux over ocean 
     228      USE wrk_nemo, ONLY: zqsb => wrk_2d_3  ! sensible heat flux over ocean 
     229      !! 
    210230      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data 
    211231      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 
    … …  
    223243      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         - 
    224244      REAL(wp) ::   ztx2, zty2                                  !    -         - 
    225       !! 
    226       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw        ! long-wave heat flux over ocean 
    227       REAL(wp), DIMENSION(jpi,jpj) ::   zqla        ! latent heat flux over ocean 
    228       REAL(wp), DIMENSION(jpi,jpj) ::   zqsb        ! sensible heat flux over ocean 
    229245      !!--------------------------------------------------------------------- 
     246 
     247      IF(.not. wrk_use(3, 1,2,3))THEN 
     248         CALL ctl_stop('blk_oce_clio: requested workspace arrays are unavailable.') 
     249         RETURN 
     250      END IF 
    230251 
    231252      zpatm = 101000.      ! atmospheric pressure  (assumed constant here) 
    … …  
    378399      ENDIF 
    379400 
     401      IF(.not. wrk_release(3, 1,2,3))THEN 
     402         CALL ctl_stop('blk_oce_clio: failed to release workspace arrays.') 
     403      END IF 
     404 
    380405   END SUBROUTINE blk_oce_clio 
    381406 
    … …  
    408433      !! 
    409434      !!---------------------------------------------------------------------- 
     435      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     436      USE wrk_nemo, ONLY:  ztatm => wrk_2d_1   ! Tair in Kelvin 
     437      USE wrk_nemo, ONLY:  zqatm => wrk_2d_2   ! specific humidity 
     438      USE wrk_nemo, ONLY: zevsqr => wrk_2d_3   ! vapour pressure square-root 
     439      USE wrk_nemo, ONLY:  zrhoa => wrk_2d_4   ! air density 
     440      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     441      !! 
    410442      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin] 
    411443      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%] 
    … …  
    435467      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         - 
    436468      !! 
    437       REAL(wp), DIMENSION(jpi,jpj) ::   ztatm   ! Tair in Kelvin 
    438       REAL(wp), DIMENSION(jpi,jpj) ::   zqatm   ! specific humidity 
    439       REAL(wp), DIMENSION(jpi,jpj) ::   zevsqr  ! vapour pressure square-root 
    440       REAL(wp), DIMENSION(jpi,jpj) ::   zrhoa   ! air density 
    441       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_qlw, z_qsb 
     469      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb 
    442470      !!--------------------------------------------------------------------- 
     471 
     472      IF( (.NOT. wrk_use(2, 1,2,3,4)) .OR. (.NOT. wrk_use(3, 1,2)) )THEN 
     473         CALL ctl_stop('blk_ice_clio: requested workspace arrays are unavailable.') 
     474         RETURN 
     475      ELSE IF(pdim > jpk)THEN 
     476         CALL ctl_stop('blk_ice_clio: too many ice levels to use wrk_nemo 3D workspaces.') 
     477         RETURN 
     478      END IF 
     479      z_qlw => wrk_3d_1(:,:,1:pdim) 
     480      z_qsb => wrk_3d_2(:,:,1:pdim) 
    443481 
    444482      ijpl  = pdim                           ! number of ice categories 
    … …  
    612650      ENDIF 
    613651 
     652      IF( (.NOT. wrk_release(2, 1,2,3,4)) .OR. (.NOT. wrk_release(3, 1,2)) )THEN 
     653         CALL ctl_stop('blk_ice_clio: failed to release workspace arrays.') 
     654      END IF 
    614655 
    615656   END SUBROUTINE blk_ice_clio 
    … …  
    626667      !!               - also initialise sbudyko and stauc once for all  
    627668      !!---------------------------------------------------------------------- 
     669      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     670      USE wrk_nemo, ONLY:   zev => wrk_2d_1                  ! vapour pressure 
     671      USE wrk_nemo, ONLY: zdlha => wrk_2d_2, zlsrise => wrk_2d_3, zlsset => wrk_2d_4  
     672      USE wrk_nemo, ONLY:   zps => wrk_2d_5, zpc => wrk_2d_6 ! sine (cosine) of latitude per sine (cosine) of solar declination  
     673      !! 
    628674      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   pqsr_oce    ! shortwave radiation  over the ocean 
    629675      !! 
    … …  
    644690      REAL(wp) ::   zxday, zdist, zcoef, zcoef1      ! 
    645691      REAL(wp) ::   zes 
    646       !! 
    647       REAL(wp), DIMENSION(jpi,jpj) ::   zev          ! vapour pressure 
    648       REAL(wp), DIMENSION(jpi,jpj) ::   zdlha, zlsrise, zlsset     ! 2D workspace 
    649  
    650       REAL(wp), DIMENSION(jpi,jpj) ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    651692      !!--------------------------------------------------------------------- 
    652693 
     694      IF(.NOT. wrk_use(2, 1,2,3,4,5,6))THEN 
     695         CALL ctl_stop('blk_clio_qsr_oce: requested workspace arrays unavailable.') 
     696         RETURN 
     697      END IF 
    653698 
    654699      IF( lbulk_init ) THEN             !   Initilization at first time step only 
    … …  
    764809      END DO 
    765810 
     811      IF(.NOT. wrk_release(2, 1,2,3,4,5,6))THEN 
     812         CALL ctl_stop('blk_clio_qsr_oce: failed to release workspace arrays.') 
     813      END IF 
     814 
    766815   END SUBROUTINE blk_clio_qsr_oce 
    767816 
    … …  
    777826      !!               - also initialise sbudyko and stauc once for all  
    778827      !!---------------------------------------------------------------------- 
     828      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     829      USE wrk_nemo, ONLY: zev => wrk_2d_1         ! vapour pressure 
     830      USE wrk_nemo, ONLY: zdlha => wrk_2d_2       ! 2D workspace 
     831      USE wrk_nemo, ONLY: zlsrise => wrk_2d_3     ! 2D workspace 
     832      USE wrk_nemo, ONLY: zlsset => wrk_2d_4      ! 2D workspace 
     833      USE wrk_nemo, ONLY: zps => wrk_2d_5, zpc => wrk_2d_6   ! sine (cosine) of latitude per sine (cosine) of solar declination  
     834      !! 
    779835      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_cs   ! albedo of ice under clear sky 
    780836      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_os   ! albedo of ice under overcast sky 
    … …  
    794850      REAL(wp) ::   zxday, zdist, zcoef, zcoef1   !    -         - 
    795851      REAL(wp) ::   zqsr_ice_cs, zqsr_ice_os      !    -         - 
    796       !! 
    797       REAL(wp), DIMENSION(jpi,jpj) ::   zev                      ! vapour pressure 
    798       REAL(wp), DIMENSION(jpi,jpj) ::   zdlha, zlsrise, zlsset   ! 2D workspace 
    799       REAL(wp), DIMENSION(jpi,jpj) ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination  
    800852      !!--------------------------------------------------------------------- 
     853 
     854      IF(.NOT. wrk_use(2, 1,2,3,4,5,6))THEN 
     855         CALL ctl_stop('blk_clio_qsr_ice: requested workspace arrays unavailable.') 
     856         RETURN 
     857      END IF 
    801858 
    802859      ijpl = SIZE(pqsr_ice, 3 )      ! number of ice categories 
    … …  
    901958      END DO 
    902959      ! 
     960      IF(.NOT. wrk_release(2, 1,2,3,4,5,6))THEN 
     961         CALL ctl_stop('blk_clio_qsr_ice: failed to release workspace arrays.') 
     962      END IF 
     963      ! 
    903964   END SUBROUTINE blk_clio_qsr_ice 
    904965 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r2528 r2590  
    4040   PRIVATE 
    4141 
    42    PUBLIC   sbc_blk_core       ! routine called in sbcmod module 
    43    PUBLIC   blk_ice_core       ! routine called in sbc_ice_lim module 
    44        
     42   PUBLIC   sbc_blk_core         ! routine called in sbcmod module 
     43   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module 
     44 
    4545   INTEGER , PARAMETER ::   jpfld   = 9           ! maximum number of files to read  
    4646   INTEGER , PARAMETER ::   jp_wndi = 1           ! index of 10m wind velocity (i-component) (m/s)    at T-point 
    … …  
    7878   !!---------------------------------------------------------------------- 
    7979CONTAINS 
     80 
    8081 
    8182   SUBROUTINE sbc_blk_core( kt ) 
    … …  
    210211      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC 
    211212      !!--------------------------------------------------------------------- 
     213      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     214      USE wrk_nemo, ONLY: zwnd_i => wrk_2d_1, zwnd_j  => wrk_2d_2   ! wind speed components at T-point 
     215      USE wrk_nemo, ONLY: zqsatw => wrk_2d_3           ! specific humidity at pst 
     216      USE wrk_nemo, ONLY: zqlw => wrk_2d_4, zqsb => wrk_2d_5       ! long wave and sensible heat fluxes 
     217      USE wrk_nemo, ONLY: zqla => wrk_2d_6, zevap => wrk_2d_7      ! latent heat fluxes and evaporation 
     218      USE wrk_nemo, ONLY:    Cd => wrk_2d_8           ! transfer coefficient for momentum      (tau) 
     219      USE wrk_nemo, ONLY:    Ch => wrk_2d_9           ! transfer coefficient for sensible heat (Q_sens) 
     220      USE wrk_nemo, ONLY:    Ce => wrk_2d_10          ! transfer coefficient for evaporation   (Q_lat) 
     221      USE wrk_nemo, ONLY:   zst => wrk_2d_11          ! surface temperature in Kelvin 
     222      USE wrk_nemo, ONLY: zt_zu => wrk_2d_12          ! air temperature at wind speed height 
     223      USE wrk_nemo, ONLY: zq_zu => wrk_2d_13          ! air spec. hum.  at wind speed height 
     224      !! 
    212225      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data 
    213       REAL(wp),  INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius] 
    214       REAL(wp),  INTENT(in), DIMENSION(jpi,jpj) ::   pu    ! surface current at U-point (i-component) [m/s] 
    215       REAL(wp),  INTENT(in), DIMENSION(jpi,jpj) ::   pv    ! surface current at V-point (j-component) [m/s] 
     226      REAL(wp),  INTENT(in), DIMENSION(:,:) ::   pst   ! surface temperature                      [Celcius] 
     227      REAL(wp),  INTENT(in), DIMENSION(:,:) ::   pu    ! surface current at U-point (i-component) [m/s] 
     228      REAL(wp),  INTENT(in), DIMENSION(:,:) ::   pv    ! surface current at V-point (j-component) [m/s] 
    216229 
    217230      INTEGER  ::   ji, jj     ! dummy loop indices 
    218231      REAL(wp) ::   zcoef_qsatw 
    219232      REAL(wp) ::   zztmp                                 ! temporary variable 
    220       REAL(wp), DIMENSION(jpi,jpj) ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
    221       REAL(wp), DIMENSION(jpi,jpj) ::   zqsatw            ! specific humidity at pst 
    222       REAL(wp), DIMENSION(jpi,jpj) ::   zqlw, zqsb        ! long wave and sensible heat fluxes 
    223       REAL(wp), DIMENSION(jpi,jpj) ::   zqla, zevap       ! latent heat fluxes and evaporation 
    224       REAL(wp), DIMENSION(jpi,jpj) ::   Cd                ! transfer coefficient for momentum      (tau) 
    225       REAL(wp), DIMENSION(jpi,jpj) ::   Ch                ! transfer coefficient for sensible heat (Q_sens) 
    226       REAL(wp), DIMENSION(jpi,jpj) ::   Ce                ! tansfert coefficient for evaporation   (Q_lat) 
    227       REAL(wp), DIMENSION(jpi,jpj) ::   zst               ! surface temperature in Kelvin 
    228       REAL(wp), DIMENSION(jpi,jpj) ::   zt_zu             ! air temperature at wind speed height 
    229       REAL(wp), DIMENSION(jpi,jpj) ::   zq_zu             ! air spec. hum.  at wind speed height 
    230233      !!--------------------------------------------------------------------- 
    231234 
     235      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13))THEN 
     236         CALL ctl_stop('blk_oce_core: requested workspace arrays unavailable.') 
     237         RETURN 
     238      END IF 
     239      ! 
    232240      ! local scalars ( place there for vector optimisation purposes) 
    233241      zcoef_qsatw = 0.98 * 640380. / rhoa 
    … …  
    293301!            &                    Cd    (:,:),             Ch  (:,:), Ce  (:,:)  ) 
    294302!gm bug 
    295          CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow,         & 
    296             &                    zqsatw, sf(jp_humi)%fnow, wndm,   & 
     303! ARPDBG - this won't compile with gfortran. Fix but check performance 
     304! as per comment above. 
     305         CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow(:,:,1),       & 
     306            &                    zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, & 
    297307            &                    Cd    , Ch              , Ce    ) 
    298308      ENDIF 
    … …  
    376386      ENDIF 
    377387      ! 
     388      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11,12,13))THEN 
     389         CALL ctl_stop('blk_oce_core: failed to release workspace arrays.') 
     390      END IF 
     391      ! 
    378392   END SUBROUTINE blk_oce_core 
    379393    
    … …  
    396410      !! caution : the net upward water flux has with mm/day unit 
    397411      !!--------------------------------------------------------------------- 
     412      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     413      USE wrk_nemo, ONLY: z_wnds_t => wrk_2d_1                ! wind speed ( = | U10m - U_ice | ) at T-point 
     414      USE wrk_nemo, ONLY: wrk_3d_4, wrk_3d_5, wrk_3d_6, wrk_3d_7 
     415      !! 
    398416      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin] 
    399       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
    400       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
     417      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s] 
     418      REAL(wp), DIMENSION(:,:)    , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid) 
    401419      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%] 
    402       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
    403       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
     420      REAL(wp), DIMENSION(:,:)    , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2] 
     421      REAL(wp), DIMENSION(:,:)    , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid) 
    404422      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2] 
    405423      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2] 
    … …  
    407425      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2] 
    408426      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2] 
    409       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
    410       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
    411       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
    412       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
     427      REAL(wp), DIMENSION(:,:)    , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s] 
     428      REAL(wp), DIMENSION(:,:),    INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s] 
     429      REAL(wp), DIMENSION(:,:),    INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%] 
     430      REAL(wp), DIMENSION(:,:),    INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%] 
    413431      CHARACTER(len=1)            , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid) 
    414432      INTEGER                     , INTENT(in   ) ::   pdim     ! number of ice categories 
    … …  
    422440      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point 
    423441      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point 
    424       REAL(wp), DIMENSION(jpi,jpj) ::   z_wnds_t                 ! wind speed ( = | U10m - U_ice | ) at T-point 
    425       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_qlw               ! long wave heat flux over ice 
    426       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_qsb               ! sensible  heat flux over ice 
    427       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_dqlw              ! long wave heat sensitivity over ice 
    428       REAL(wp), DIMENSION(jpi,jpj,pdim) ::   z_dqsb              ! sensible  heat sensitivity over ice 
     442      !! 
     443      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice 
     444      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice 
     445      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice 
     446      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice 
    429447      !!--------------------------------------------------------------------- 
    430448 
    431449      ijpl  = pdim                            ! number of ice categories 
     450 
     451      ! Set-up access to workspace arrays 
     452      IF( (.NOT. wrk_use(2, 1)) .OR. (.NOT. wrk_use(3, 4,5,6,7)) )THEN 
     453         CALL ctl_stop('blk_ice_core: requested workspace arrays unavailable.') 
     454         RETURN 
     455      ELSE IF(ijpl > jpk)THEN 
     456         CALL ctl_stop('blk_ice_core: no. of ice categories > jpk so wrk_nemo 3D workspaces cannot be used.') 
     457         RETURN 
     458      END IF 
     459      ! Set-up pointers to sub-arrays of workspaces 
     460      z_qlw  => wrk_3d_4(:,:,1:ijpl) 
     461      z_qsb  => wrk_3d_5(:,:,1:ijpl) 
     462      z_dqlw => wrk_3d_6(:,:,1:ijpl) 
     463      z_dqsb => wrk_3d_7(:,:,1:ijpl) 
    432464 
    433465      ! local scalars ( place there for vector optimisation purposes) 
    … …  
    579611      ENDIF 
    580612 
     613      IF( (.NOT. wrk_release(2, 1)) .OR. (.NOT. wrk_release(3, 4,5,6,7)) )THEN 
     614         CALL ctl_stop('blk_ice_core: failed to release workspace arrays.') 
     615      END IF 
     616 
    581617   END SUBROUTINE blk_ice_core 
    582618   
    … …  
    602638      !!   9.0  !  05-08  (L. Brodeau) Rewriting and optimization 
    603639      !!---------------------------------------------------------------------- 
     640      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     641      USE wrk_nemo, ONLY: dU10 => wrk_2d_14        ! dU                             [m/s] 
     642      USE wrk_nemo, ONLY: dT => wrk_2d_15          ! air/sea temperature difference   [K] 
     643      USE wrk_nemo, ONLY: dq => wrk_2d_16          ! air/sea humidity difference      [K] 
     644      USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_17      ! 10m neutral drag coefficient 
     645      USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_18      ! 10m neutral latent coefficient 
     646      USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_19      ! 10m neutral sensible coefficient 
     647      USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_20 ! root square of Cd_n10 
     648      USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_21     ! root square of Cd 
     649      USE wrk_nemo, ONLY: T_vpot => wrk_2d_22      ! virtual potential temperature    [K] 
     650      USE wrk_nemo, ONLY: T_star => wrk_2d_23      ! turbulent scale of tem. fluct. 
     651      USE wrk_nemo, ONLY: q_star => wrk_2d_24      ! turbulent humidity of temp. fluct. 
     652      USE wrk_nemo, ONLY: U_star => wrk_2d_25      ! turb. scale of velocity fluct. 
     653      USE wrk_nemo, ONLY: L => wrk_2d_26           ! Monin-Obukov length              [m] 
     654      USE wrk_nemo, ONLY: zeta => wrk_2d_27        ! stability parameter at height zu 
     655      USE wrk_nemo, ONLY: U_n10 => wrk_2d_28       ! neutral wind velocity at 10m     [m] 
     656      USE wrk_nemo, ONLY: xlogt => wrk_2d_29,    xct => wrk_2d_30,   & 
     657                         zpsi_h => wrk_2d_31, zpsi_m => wrk_2d_32 
     658      USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
     659      !! 
    604660      REAL(wp), INTENT(in) :: zu                 ! altitude of wind measurement       [m] 
    605       REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::  & 
     661      REAL(wp), INTENT(in),  DIMENSION(:,:) ::  & 
    606662         sst,       &       ! sea surface temperature         [Kelvin] 
    607663         T_a,       &       ! potential air temperature       [Kelvin] 
    … …  
    609665         q_a,       &       ! specific air humidity           [kg/kg] 
    610666         dU                 ! wind module |U(zu)-U(0)|        [m/s] 
    611       REAL(wp), intent(out), DIMENSION(jpi,jpj) :: & 
     667      REAL(wp), intent(out), DIMENSION(:,:) :: & 
    612668         Cd,    &                ! transfert coefficient for momentum       (tau) 
    613669         Ch,    &                ! transfert coefficient for temperature (Q_sens) 
    614670         Ce                      ! transfert coefficient for evaporation  (Q_lat) 
    615  
    616       !! * Local declarations 
    617       REAL(wp), DIMENSION(jpi,jpj)  ::   & 
    618          dU10,        &       ! dU                                   [m/s] 
    619          dT,          &       ! air/sea temperature differeence      [K] 
    620          dq,          &       ! air/sea humidity difference          [K] 
    621          Cd_n10,      &       ! 10m neutral drag coefficient 
    622          Ce_n10,      &       ! 10m neutral latent coefficient 
    623          Ch_n10,      &       ! 10m neutral sensible coefficient 
    624          sqrt_Cd_n10, &       ! root square of Cd_n10 
    625          sqrt_Cd,     &       ! root square of Cd 
    626          T_vpot,      &       ! virtual potential temperature        [K] 
    627          T_star,      &       ! turbulent scale of tem. fluct. 
    628          q_star,      &       ! turbulent humidity of temp. fluct. 
    629          U_star,      &       ! turb. scale of velocity fluct. 
    630          L,           &       ! Monin-Obukov length                  [m] 
    631          zeta,        &       ! stability parameter at height zu 
    632          U_n10,       &       ! neutral wind velocity at 10m         [m]    
    633          xlogt, xct, zpsi_h, zpsi_m 
    634671      !! 
    635672      INTEGER :: j_itt 
    636673      INTEGER, PARAMETER :: nb_itt = 3 
    637       INTEGER, DIMENSION(jpi,jpj)  ::   & 
    638          stab         ! 1st guess stability test integer 
    639674 
    640675      REAL(wp), PARAMETER ::                        & 
    … …  
    642677         kappa  = 0.4              ! von Karman s constant 
    643678      !!---------------------------------------------------------------------- 
     679 
     680      IF( (.NOT. wrk_use(2, 14,15,16,17,18,       & 
     681                         19,20,21,22,23,24,       & 
     682                         25,26,27,28,29,30,       & 
     683                         31,32))             .OR. & 
     684          (.NOT. iwrk_use(2, 1)) )THEN 
     685         CALL ctl_stop('TURB_CORE_1Z: requested workspace arrays unavailable.') 
     686         RETURN 
     687      END IF 
     688 
    644689      !! * Start 
    645690      !! Air/sea differences 
    … …  
    672717 
    673718         !! Stability parameters : 
    674          zeta = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta ) 
    675          zpsi_h = psi_h(zeta) 
    676          zpsi_m = psi_m(zeta) 
     719         zeta  = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta ) 
     720         zpsi_h  = psi_h(zeta) 
     721         zpsi_m  = psi_m(zeta) 
    677722 
    678723         !! Shifting the wind speed to 10m and neutral stability : 
    … …  
    701746      END DO 
    702747      !! 
     748      IF( (.NOT. wrk_release(2, 14,15,16,17,18,       & 
     749                             19,20,21,22,23,24,       & 
     750                             25,26,27,28,29,30,       & 
     751                             31,32))             .OR. & 
     752          (.NOT. iwrk_release(2, 1)) )THEN 
     753         CALL ctl_stop('TURB_CORE_1Z: failed to release workspace arrays.') 
     754      END IF 
     755      !! 
    703756    END SUBROUTINE TURB_CORE_1Z 
    704757 
    … …  
    722775      !!   9.0  !  06-12  (L. Brodeau) Original code for 2Z 
    723776      !!---------------------------------------------------------------------- 
     777      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     778      USE wrk_nemo, ONLY: dU10 => wrk_2d_1        ! dU                             [m/s] 
     779      USE wrk_nemo, ONLY: dT => wrk_2d_2          ! air/sea temperature difference   [K] 
     780      USE wrk_nemo, ONLY: dq => wrk_2d_3          ! air/sea humidity difference      [K] 
     781      USE wrk_nemo, ONLY: Cd_n10 => wrk_2d_4      ! 10m neutral drag coefficient 
     782      USE wrk_nemo, ONLY: Ce_n10 => wrk_2d_5      ! 10m neutral latent coefficient 
     783      USE wrk_nemo, ONLY: Ch_n10 => wrk_2d_6      ! 10m neutral sensible coefficient 
     784      USE wrk_nemo, ONLY: sqrt_Cd_n10 => wrk_2d_7 ! root square of Cd_n10 
     785      USE wrk_nemo, ONLY: sqrt_Cd => wrk_2d_8     ! root square of Cd 
     786      USE wrk_nemo, ONLY: T_vpot => wrk_2d_9      ! virtual potential temperature    [K] 
     787      USE wrk_nemo, ONLY: T_star => wrk_2d_10     ! turbulent scale of tem. fluct. 
     788      USE wrk_nemo, ONLY: q_star => wrk_2d_11     ! turbulent humidity of temp. fluct. 
     789      USE wrk_nemo, ONLY: U_star => wrk_2d_12     ! turb. scale of velocity fluct. 
     790      USE wrk_nemo, ONLY: L => wrk_2d_13          ! Monin-Obukov length              [m] 
     791      USE wrk_nemo, ONLY: zeta_u => wrk_2d_14     ! stability parameter at height zu 
     792      USE wrk_nemo, ONLY: zeta_t => wrk_2d_15     ! stability parameter at height zt 
     793      USE wrk_nemo, ONLY: U_n10 => wrk_2d_16      ! neutral wind velocity at 10m     [m] 
     794      USE wrk_nemo, ONLY: xlogt => wrk_2d_17, xct => wrk_2d_18, zpsi_hu => wrk_2d_19, zpsi_ht => wrk_2d_20, zpsi_m => wrk_2d_21 
     795      USE wrk_nemo, ONLY: stab => iwrk_2d_1      ! 1st guess stability test integer 
     796      !! 
    724797      REAL(wp), INTENT(in)   :: & 
    725798         zt,      &     ! height for T_zt and q_zt                   [m] 
    … …  
    738811         q_zu            ! spec. hum.  shifted at zu               [kg/kg] 
    739812 
    740       !! * Local declarations 
    741       REAL(wp), DIMENSION(jpi,jpj) ::  & 
    742          dU10,        &     ! dU                                [m/s] 
    743          dT,          &     ! air/sea temperature differeence   [K] 
    744          dq,          &     ! air/sea humidity difference       [K] 
    745          Cd_n10,      &     ! 10m neutral drag coefficient 
    746          Ce_n10,      &     ! 10m neutral latent coefficient 
    747          Ch_n10,      &     ! 10m neutral sensible coefficient 
    748          sqrt_Cd_n10, &     ! root square of Cd_n10 
    749          sqrt_Cd,     &     ! root square of Cd 
    750          T_vpot_u,    &     ! virtual potential temperature        [K] 
    751          T_star,      &     ! turbulent scale of tem. fluct. 
    752          q_star,      &     ! turbulent humidity of temp. fluct. 
    753          U_star,      &     ! turb. scale of velocity fluct. 
    754          L,           &     ! Monin-Obukov length                  [m] 
    755          zeta_u,      &     ! stability parameter at height zu 
    756          zeta_t,      &     ! stability parameter at height zt 
    757          U_n10,       &     ! neutral wind velocity at 10m        [m] 
    758          xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m 
    759  
    760813      INTEGER :: j_itt 
    761814      INTEGER, PARAMETER :: nb_itt = 3   ! number of itterations 
    762       INTEGER, DIMENSION(jpi,jpj) :: & 
    763            &     stab                ! 1st stability test integer 
    764815      REAL(wp), PARAMETER ::                        & 
    765816         grav   = 9.8,      &  ! gravity                        
    … …  
    767818      !!---------------------------------------------------------------------- 
    768819      !!  * Start 
     820 
     821      IF( (.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21)) .OR. & 
     822          (.NOT. iwrk_use(2, 1)) )THEN 
     823         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.') 
     824         RETURN 
     825      END IF 
    769826 
    770827      !! Initial air/sea differences 
    … …  
    789846      DO j_itt=1, nb_itt 
    790847         dT = T_zu - sst ;  dq = q_zu - q_sat ! Updating air/sea differences 
    791          T_vpot_u = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu 
     848         T_vpot = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu 
    792849         U_star = sqrt_Cd*dU10                ! Updating turbulent scales :   (L & Y eq. (7)) 
    793850         T_star  = Ch/sqrt_Cd*dT              ! 
    … …  
    795852         !! 
    796853         L = (U_star*U_star) &                ! Estimate the Monin-Obukov length at height zu 
    797               & / (kappa*grav/T_vpot_u*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star)) 
     854              & / (kappa*grav/T_vpot*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star)) 
    798855         !! Stability parameters : 
    799856         zeta_u  = zu/L  ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u ) 
    … …  
    841898      END DO 
    842899      !! 
     900      IF( (.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21)) .OR. & 
     901          (.NOT. iwrk_release(2, 1)) )THEN 
     902         CALL ctl_stop('TURB_CORE_2Z: requested workspace arrays unavailable.') 
     903      END IF 
     904 
    843905    END SUBROUTINE TURB_CORE_2Z 
    844906 
    845907 
    846908    FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e) 
     909      !------------------------------------------------------------------------------- 
     910      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     911      USE wrk_nemo, ONLY:     X2 => wrk_2d_33 
     912      USE wrk_nemo, ONLY:     X  => wrk_2d_34 
     913      USE wrk_nemo, ONLY: stabit => wrk_2d_35 
     914      !! 
    847915      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    848916 
    849917      REAL(wp), PARAMETER :: pi = 3.141592653589793_wp 
    850918      REAL(wp), DIMENSION(jpi,jpj)             :: psi_m 
    851       REAL(wp), DIMENSION(jpi,jpj)             :: X2, X, stabit 
     919      !------------------------------------------------------------------------------- 
     920 
     921      IF(.NOT. wrk_use(2, 33,34,35))THEN 
     922         CALL ctl_stop('psi_m: requested workspace arrays unavailable.') 
     923         RETURN 
     924      END IF 
     925 
    852926      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2) 
    853927      stabit    = 0.5 + sign(0.5,zta) 
    854928      psi_m = -5.*zta*stabit  &                                                  ! Stable 
    855929           & + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable  
     930 
     931      IF(.NOT. wrk_release(2, 33,34,35))THEN 
     932         CALL ctl_stop('psi_m: failed to release workspace arrays.') 
     933         RETURN 
     934      END IF 
     935 
    856936    END FUNCTION psi_m 
    857937 
     938 
    858939    FUNCTION psi_h(zta)    !! Psis, L & Y eq. (8c), (8d), (8e) 
     940      !------------------------------------------------------------------------------- 
     941      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     942      USE wrk_nemo, ONLY:     X2 => wrk_2d_33 
     943      USE wrk_nemo, ONLY:     X  => wrk_2d_34 
     944      USE wrk_nemo, ONLY: stabit => wrk_2d_35 
     945      !! 
    859946      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta 
    860947 
    861948      REAL(wp), DIMENSION(jpi,jpj)             :: psi_h 
    862       REAL(wp), DIMENSION(jpi,jpj)             :: X2, X, stabit 
     949      !------------------------------------------------------------------------------- 
     950 
     951      IF(.NOT. wrk_use(2, 33,34,35))THEN 
     952         CALL ctl_stop('psi_h: requested workspace arrays unavailable.') 
     953         RETURN 
     954      END IF 
     955 
    863956      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2) 
    864957      stabit    = 0.5 + sign(0.5,zta) 
    865958      psi_h = -5.*zta*stabit  &                                       ! Stable 
    866959           & + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable 
     960 
     961      IF(.NOT. wrk_release(2, 33,34,35))THEN 
     962         CALL ctl_stop('psi_h: failed to release workspace arrays.') 
     963         RETURN 
     964      END IF 
     965 
    867966    END FUNCTION psi_h 
    868967   

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r2528 r2590  
    5454   PRIVATE 
    5555 
    56    PUBLIC   sbc_cpl_rcv       ! routine called by sbc_ice_lim(_2).F90 
    57    PUBLIC   sbc_cpl_snd       ! routine called by step.F90 
    58    PUBLIC   sbc_cpl_ice_tau   ! routine called by sbc_ice_lim(_2).F90 
    59    PUBLIC   sbc_cpl_ice_flx   ! routine called by sbc_ice_lim(_2).F90 
    60     
     56   PUBLIC   sbc_cpl_rcv        ! routine called by sbc_ice_lim(_2).F90 
     57   PUBLIC   sbc_cpl_snd        ! routine called by step.F90 
     58   PUBLIC   sbc_cpl_ice_tau    ! routine called by sbc_ice_lim(_2).F90 
     59   PUBLIC   sbc_cpl_ice_flx    ! routine called by sbc_ice_lim(_2).F90 
     60   PUBLIC   sbc_cpl_init_alloc ! routine called by nemogcm.F90 
     61 
    6162   INTEGER, PARAMETER ::   jpr_otx1   =  1            ! 3 atmosphere-ocean stress components on grid 1 
    6263   INTEGER, PARAMETER ::   jpr_oty1   =  2            !  
    … …  
    149150   CHARACTER(len=100), DIMENSION(4) ::   cn_rcv_tau           ! array combining cn_rcv_tau_* 
    150151 
    151    REAL(wp), DIMENSION(jpi,jpj)       ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
    152  
    153    REAL(wp), DIMENSION(jpi,jpj,jprcv) ::   frcv               ! all fields recieved from the atmosphere 
    154    INTEGER , DIMENSION(        jprcv) ::   nrcvinfo           ! OASIS info argument 
     152   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
     153 
     154   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   frcv               ! all fields recieved from the atmosphere 
     155   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
    155156 
    156157#if ! defined key_lim2 && ! defined key_lim3 
    157158   ! quick patch to be able to run the coupled model without sea-ice... 
    158159   INTEGER, PARAMETER               ::   jpl = 1  
    159    REAL(wp), DIMENSION(jpi,jpj    ) ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 
    160    REAL(wp), DIMENSION(jpi,jpj,jpl) ::   tn_ice, alb_ice 
     160   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hicif, hsnif, u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 
     161   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice ! (jpi,jpj,jpl) 
    161162   REAL(wp)                         ::  lfus 
    162163#endif 
    … …  
    172173CONTAINS 
    173174   
     175   FUNCTION sbc_cpl_init_alloc() 
     176      !!---------------------------------------------------------------------- 
     177      !!             ***  ROUTINE sbc_cpl_init_alloc  *** 
     178      !!---------------------------------------------------------------------- 
     179      IMPLICIT none 
     180      INTEGER :: sbc_cpl_init_alloc 
     181      INTEGER :: ierr(2) 
     182      !!---------------------------------------------------------------------- 
     183 
     184      ierr(:) = 0 
     185 
     186      ALLOCATE(albedo_oce_mix(jpi,jpj), & 
     187               frcv(jpi,jpj,jprcv),     & 
     188               nrcvinfo(jprcv),  Stat=Stat=ierr(1)) 
     189 
     190#if ! defined key_lim2 && ! defined key_lim3 
     191      ! quick patch to be able to run the coupled model without sea-ice... 
     192      ALLOCATE(hicif(jpi,jpj), hsnif(jpi,jpj), u_ice(jpi,jpj),  & 
     193               v_ice(jpi,jpj), fr1_i0(jpi,jpj),fr2_i0(jpi,jpj), & 
     194               tn_ice(jpi,jpj,jpl), alb_ice(jpi,jpj,jpl),       & 
     195               Stat=ierr(2) ) 
     196#endif 
     197 
     198      sbc_cpl_init_alloc = MAXVAL(ierr) 
     199 
     200      IF(sbc_cpl_init_alloc > 0)THEN 
     201         CALL ctl_warn('sbc_cpl_init_alloc: allocation of arrays failed.') 
     202      END IF 
     203 
     204    END FUNCTION sbc_cpl_init_alloc 
     205 
    174206   SUBROUTINE sbc_cpl_init( k_ice )      
    175207      !!---------------------------------------------------------------------- 
    … …  
    184216      !!              * initialise the OASIS coupler 
    185217      !!---------------------------------------------------------------------- 
     218      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     219      USE wrk_nemo, ONLY: zacs => wrk_2d_1, zaos => wrk_2d_2 ! clear & overcast sky albedos 
     220      !! 
    186221      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3) 
    187222      !! 
    188223      INTEGER                      ::   jn           ! dummy loop index 
    189       REAL(wp), DIMENSION(jpi,jpj) ::   zacs, zaos   ! 2D workspace (clear & overcast sky albedos) 
    190224      !! 
    191225      NAMELIST/namsbc_cpl/  cn_snd_temperature, cn_snd_albedo    , cn_snd_thickness,                 &           
    … …  
    198232#endif 
    199233      !!--------------------------------------------------------------------- 
     234 
     235      IF(.not. wrk_use(2,1,2))THEN 
     236         CALL ctl_stop('sbc_cpl_init: requested workspace arrays unavailable.') 
     237         RETURN 
     238      END IF 
    200239 
    201240      ! ================================ ! 
    … …  
    532571         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    533572 
     573      IF(.not. wrk_release(2,1,2))THEN 
     574         CALL ctl_stop('sbc_cpl_init: failed to release workspace arrays.') 
     575      END IF 
     576 
    534577   END SUBROUTINE sbc_cpl_init 
    535578 
    … …  
    577620      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case) 
    578621      !!---------------------------------------------------------------------- 
     622      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     623      USE wrk_nemo, ONLY: ztx => wrk_2d_1, zty => wrk_2d_2 
     624      !! 
    579625      INTEGER, INTENT(in) ::   kt       ! ocean model time step index 
    580626      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation  
    … …  
    589635      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    590636      REAL(wp) ::   zzx, zzy               ! temporary variables 
    591       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace  
    592       !!---------------------------------------------------------------------- 
     637      !!---------------------------------------------------------------------- 
     638 
     639      IF(.not. wrk_use(2, 1,2))THEN 
     640         CALL ctl_stop('sbc_cpl_rcv: requested workspace arrays unavailable.') 
     641         RETURN 
     642      END IF 
    593643 
    594644      IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation 
    … …  
    778828      ENDIF 
    779829      ! 
     830      IF(.not. wrk_release(2, 1,2))THEN 
     831         CALL ctl_stop('sbc_cpl_rcv: failed to release workspace arrays.') 
     832      END IF 
     833      ! 
    780834   END SUBROUTINE sbc_cpl_rcv 
    781835    
    … …  
    814868      !! ** Action  :   return ptau_i, ptau_j, the stress over the ice at cp_ice_msh point 
    815869      !!---------------------------------------------------------------------- 
    816       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
    817       REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
     870      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     871      USE wrk_nemo, ONLY: ztx => wrk_2d_1, zty => wrk_2d_2 
     872      !! 
     873      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_taui   ! i- & j-components of atmos-ice stress [N/m2] 
     874      REAL(wp), INTENT(out), DIMENSION(:,:) ::   p_tauj   ! at I-point (B-grid) or U & V-point (C-grid) 
    818875      !! 
    819876      INTEGER ::   ji, jj                          ! dummy loop indices 
    820877      INTEGER ::   itx                             ! index of taux over ice 
    821       REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty   ! 2D workspace 
    822       !!---------------------------------------------------------------------- 
     878      !!---------------------------------------------------------------------- 
     879 
     880      IF(.not. wrk_use(2,1,2))THEN 
     881         CALL ctl_stop('sbc_cpl_ice_tau: requested workspace arrays unavailable.') 
     882         RETURN 
     883      END IF 
    823884 
    824885      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    … …  
    9881049      ENDIF 
    9891050      !    
     1051      IF(.not. wrk_release(2,1,2))THEN 
     1052         CALL ctl_stop('sbc_cpl_ice_tau: failed to release workspace arrays.') 
     1053      END IF 
     1054      ! 
    9901055   END SUBROUTINE sbc_cpl_ice_tau 
    9911056    
    … …  
    10361101      !!                   sprecip             solid precipitation over the ocean   
    10371102      !!---------------------------------------------------------------------- 
    1038       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl) ::   p_frld     ! lead fraction                [0 to 1] 
    1039       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1040       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1041       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1042       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1043       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s] 
    1044       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s] 
    1045       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj    ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s] 
    1046       REAL(wp), INTENT(  out), DIMENSION(jpi,jpj,jpl) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
     1103      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     1104      USE wrk_nemo, ONLY: zcptn => wrk_2d_1  ! rcp * tn(:,:,1) 
     1105      USE wrk_nemo, ONLY: ztmp  => wrk_2d_2  ! temporary array 
     1106      USE wrk_nemo, ONLY: zsnow => wrk_2d_3  ! snow precipitation  
     1107      USE wrk_nemo, ONLY: zicefr => wrk_3d_1 ! ice fraction  
     1108      !! 
     1109      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
     1110      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
     1111      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
     1112      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
     1113      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
     1114      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s] 
     1115      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s] 
     1116      REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s] 
     1117      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
    10471118      ! optional arguments, used only in 'mixed oce-ice' case 
    1048       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl), OPTIONAL ::   palbi   ! ice albedo  
    1049       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj    ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
    1050       REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpl), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1051      !! 
     1119      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
     1120      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
     1121      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
     1122      !! 
    10521123      INTEGER ::   ji, jj           ! dummy loop indices 
    10531124      INTEGER ::   isec, info       ! temporary integer 
    10541125      REAL(wp)::   zcoef, ztsurf    ! temporary scalar 
    1055       REAL(wp), DIMENSION(jpi,jpj    )::   zcptn    ! rcp * tn(:,:,1) 
    1056       REAL(wp), DIMENSION(jpi,jpj    )::   ztmp     ! temporary array 
    1057       REAL(wp), DIMENSION(jpi,jpj    )::   zsnow    ! snow precipitation  
    1058       REAL(wp), DIMENSION(jpi,jpj,jpl)::   zicefr   ! ice fraction  
    1059       !!---------------------------------------------------------------------- 
     1126      !!---------------------------------------------------------------------- 
     1127 
     1128      IF( (.not. wrk_use(2,1,2,3)) .OR. (.not. wrk_use(3,1)) )THEN 
     1129         CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable.') 
     1130         RETURN 
     1131      END IF 
     1132 
    10601133      zicefr(:,:,1) = 1.- p_frld(:,:,1) 
    10611134      IF( lk_diaar5 )   zcptn(:,:) = rcp * tn(:,:,1) 
    … …  
    11751248      END SELECT 
    11761249 
     1250      IF( (.not. wrk_release(2,1,2,3)) .OR. (.not. wrk_release(3,1)) )THEN 
     1251         CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays.') 
     1252      END IF 
     1253 
    11771254   END SUBROUTINE sbc_cpl_ice_flx 
    11781255    
    … …  
    11871264      !!              all the needed fields (as defined in sbc_cpl_init) 
    11881265      !!---------------------------------------------------------------------- 
     1266      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     1267      USE wrk_nemo, ONLY: zfr_l => wrk_2d_1 ! 1. - fr_i(:,:) 
     1268      USE wrk_nemo, ONLY: ztmp1 => wrk_2d_2, ztmp2 => wrk_2d_3 
     1269      USE wrk_nemo, ONLY: zotx1=> wrk_2d_4, zoty1=> wrk_2d_5, zotz1=> wrk_2d_6 
     1270      USE wrk_nemo, ONLY: zitx1=> wrk_2d_7, zity1=> wrk_2d_8, zitz1=> wrk_2d_9 
     1271      !! 
    11891272      INTEGER, INTENT(in) ::   kt 
    11901273      !! 
    11911274      INTEGER ::   ji, jj          ! dummy loop indices 
    11921275      INTEGER ::   isec, info      ! temporary integer 
    1193       REAL(wp), DIMENSION(jpi,jpj) ::   zfr_l   ! 1. - fr_i(:,:) 
    1194       REAL(wp), DIMENSION(jpi,jpj) ::   ztmp1, ztmp2 
    1195       REAL(wp), DIMENSION(jpi,jpj) ::   zotx1 , zoty1 , zotz1, zitx1, zity1, zitz1 
    1196       !!---------------------------------------------------------------------- 
     1276      !!---------------------------------------------------------------------- 
     1277 
     1278      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9))THEN 
     1279         CALL ctl_stop('sbc_cpl_snd: requested workspace arrays are unavailable.'); 
     1280         RETURN 
     1281      END IF 
    11971282 
    11981283      isec = ( kt - nit000 ) * NINT(rdttra(1))        ! date of exchanges 
    … …  
    13671452         !  
    13681453      ENDIF 
     1454   ! 
     1455      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9))THEN 
     1456         CALL ctl_stop('sbc_cpl_snd: failed to release workspace arrays.'); 
     1457         RETURN 
     1458      END IF 
    13691459   ! 
    13701460   END SUBROUTINE sbc_cpl_snd 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90

    r2528 r2590  
    2222   PRIVATE 
    2323   INTEGER, PUBLIC              ::   nday_qsr                    ! day when parameters were computed 
    24    REAL(wp), DIMENSION(jpi,jpj) ::   raa , rbb  , rcc  , rab     ! parameters used to compute the diurnal cycle 
    25    REAL(wp), DIMENSION(jpi,jpj) ::   rtmd, rdawn, rdusk, rscal   !     -       -         -           -      - 
     24   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   raa , rbb  , rcc  , rab     ! parameters used to compute the diurnal cycle 
     25   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rtmd, rdawn, rdusk, rscal   !     -       -         -           -      - 
    2626   
    27    PUBLIC   sbc_dcy     ! routine called by sbc 
     27   PUBLIC   sbc_dcy        ! routine called by sbc 
     28   PUBLIC   sbc_dcy_alloc  ! routine called by nemogcm.F90 
    2829 
    2930   !!---------------------------------------------------------------------- 
    … …  
    3334   !!---------------------------------------------------------------------- 
    3435CONTAINS 
     36 
     37      FUNCTION sbc_dcy_alloc() 
     38         !!---------------------------------------------------------------------- 
     39         !!                ***  ROUTINE sbc_dcy_alloc  *** 
     40         !!---------------------------------------------------------------------- 
     41         IMPLICIT none 
     42         INTEGER :: sbc_dcy_alloc 
     43         !!---------------------------------------------------------------------- 
     44 
     45         ALLOCATE(raa(jpi,jpj),  rbb(jpi,jpj),   rcc(jpi,jpj),   rab(jpi,jpj),   & 
     46                  rtmd(jpi,jpj), rdawn(jpi,jpj), rdusk(jpi,jpj), rscal(jpi,jpj), & 
     47                  Stat=sbc_dcy_alloc) 
     48 
     49         IF(sbc_dcy_alloc /= 0)THEN 
     50            CALL ctl_warn('sbc_dcy_alloc: failed to allocate arrays.') 
     51         END IF 
     52 
     53      END FUNCTION sbc_dcy_alloc 
     54 
    3555 
    3656      FUNCTION sbc_dcy( pqsrin ) RESULT( zqsrout ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r2528 r2590  
    2828   PRIVATE 
    2929 
    30    PUBLIC   sbc_fwb      ! routine called by step 
     30   PUBLIC   sbc_fwb       ! routine called by step 
     31   PUBLIC   sbc_fwb_alloc ! routine called in nemogcm.F90 
    3132 
    3233   REAL(wp) ::   a_fwb_b            ! annual domain averaged freshwater budget 
    … …  
    3536   REAL(wp) ::   area               ! global mean ocean surface (interior domain) 
    3637 
    37    REAL(wp), DIMENSION(jpi,jpj) ::   e1e2    ! area of the interior domain (e1t*e2t) 
     38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2    ! area of the interior domain (e1t*e2t) 
    3839 
    3940   !! * Substitutions 
    … …  
    4647   !!---------------------------------------------------------------------- 
    4748CONTAINS 
     49 
     50   FUNCTION sbc_fwb_alloc() 
     51      !!--------------------------------------------------------------------- 
     52      !!                ***  ROUTINE sbc_fwb_alloc  *** 
     53      !!--------------------------------------------------------------------- 
     54      IMPLICIT none 
     55      INTEGER :: sbc_fwb_alloc 
     56      !!--------------------------------------------------------------------- 
     57 
     58     ALLOCATE(e1e2(jpi,jpj), Stat=sbc_fwb_alloc) 
     59 
     60     IF(sbc_fwb_alloc /= 0)THEN 
     61        CALL ctl_warn('sbc_fwb_alloc: failed to allocate array.') 
     62     END IF 
     63 
     64   END FUNCTION sbc_fwb_alloc 
     65 
    4866 
    4967   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc ) 
    … …  
    6078      !!                   & spread out over erp area depending its sign 
    6179      !!---------------------------------------------------------------------- 
     80      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     81      USE wrk_nemo, ONLY:      ztmsk_neg => wrk_2d_1, ztmsk_pos=> wrk_2d_2 
     82      USE wrk_nemo, ONLY: ztmsk_tospread => wrk_2d_3 
     83      USE wrk_nemo, ONLY:          z_wgt => wrk_2d_4, zerp_cor => wrk_2d_5 
     84      !! 
    6285      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    6386      INTEGER, INTENT( in ) ::   kn_fsbc  !  
    … …  
    6891      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp       ! temporary scalars 
    6992      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread 
    70       REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread 
    71       REAL(wp), DIMENSION(jpi,jpj) ::   z_wgt, zerp_cor 
    7293      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF( .NOT. wrk_use(2, 1,2,3,4,5))THEN 
     96         CALL ctl_stop('sbc_fwb: requested workspace arrays are unavailable.') 
     97         RETURN 
     98      END IF 
    7399      ! 
    74100      IF( kt == nit000 ) THEN 
    … …  
    192218      END SELECT 
    193219      ! 
     220      IF( .NOT. wrk_release(2, 1,2,3,4,5))THEN 
     221         CALL ctl_stop('sbc_fwb: failed to release workspace arrays.') 
     222      END IF 
     223      ! 
    194224   END SUBROUTINE sbc_fwb 
    195225 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r2528 r2590  
    8888      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8989      !!--------------------------------------------------------------------- 
     90      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     91      USE wrk_nemo, ONLY: alb_ice_os => wrk_3d_1 ! albedo of the ice under overcast sky 
     92      USE wrk_nemo, ONLY: alb_ice_os => wrk_3d_2 ! albedo of ice under clear sky 
     93      !! 
    9094      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    9195      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    … …  
    9397      INTEGER  ::   jl                 ! loop index 
    9498      REAL(wp) ::   zcoef              ! temporary scalar 
    95       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   alb_ice_os   ! albedo of the ice under overcast sky 
    96       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   alb_ice_cs   ! albedo of ice under clear sky 
    9799      !!---------------------------------------------------------------------- 
     100 
     101      IF(.NOT. wrk_use(3, 1,2))THEN 
     102         CALL ctl_stop('sbc_ice_lim: requested workspace arrays are unavailable.') 
     103         RETURN 
     104      ELSE IF(jpl > jpk)THEN 
     105         CALL ctl_stop('sbc_ice_lim: extent of 3rd dimension of workspace arrays needs to exceed jpk.') 
     106         RETURN 
     107      END IF 
    98108 
    99109      IF( kt == nit000 ) THEN 
    … …  
    244254       
    245255!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
     256      ! 
     257      IF(.NOT. wrk_release(3, 1,2))THEN 
     258         CALL ctl_stop('sbc_ice_lim: failed to release workspace arrays.') 
     259      END IF 
    246260      ! 
    247261   END SUBROUTINE sbc_ice_lim 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r2528 r2590  
    8383      !!                utau, vtau, taum, wndm, qns , qsr, emp , emps 
    8484      !!--------------------------------------------------------------------- 
     85      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     86      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2, wrk_3d_3 
     87      !! 
    8588      INTEGER, INTENT(in) ::   kt      ! ocean time step 
    8689      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled ) 
    8790      !! 
    8891      INTEGER  ::   ji, jj   ! dummy loop indices 
    89       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb_ice_os   ! albedo of the ice under overcast sky 
    90       REAL(wp), DIMENSION(jpi,jpj,1) ::   zalb_ice_cs   ! albedo of ice under clear sky 
    91       REAL(wp), DIMENSION(jpi,jpj,1) ::   zsist        ! surface ice temperature (K) 
     92      ! Pointers into workspaces contained in the wrk_nemo module 
     93      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky 
     94      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky 
     95      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K) 
    9296      !!---------------------------------------------------------------------- 
     97 
     98      IF(.NOT. wrk_use(3, 1,2,3))THEN 
     99         CALL ctl_stop('sbc_ice_lim_2: requested workspace arrays are unavailable.') 
     100         RETURN 
     101      END IF 
     102      ! Use pointers to access only sub-arrays of workspaces 
     103      zalb_ice_os => wrk_3d_1(:,:,1:1) 
     104      zalb_ice_cs => wrk_3d_2(:,:,1:1) 
     105            zsist => wrk_3d_3(:,:,1:1) 
    93106 
    94107      IF( kt == nit000 ) THEN 
    … …  
    129142 
    130143         ! ... ice albedo (clear sky and overcast sky) 
    131          CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), reshape( hsnif, (/jpi,jpj,1/) ), zalb_ice_cs, zalb_ice_os ) 
     144         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 
     145                                 reshape( hsnif, (/jpi,jpj,1/) ), & 
     146                          zalb_ice_cs, zalb_ice_os ) 
    132147 
    133148         ! ... Sea-ice surface boundary conditions output from bulk formulae : 
    … …  
    214229      IF( ln_limdyn    )   CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents 
    215230      ! 
     231      IF(.NOT. wrk_release(3, 1,2,3))THEN 
     232         CALL ctl_stop('sbc_ice_lim_2: failed to release workspace arrays.') 
     233      END IF 
     234      ! 
    216235   END SUBROUTINE sbc_ice_lim_2 
    217236 
    … …  
    222241CONTAINS 
    223242   SUBROUTINE sbc_ice_lim_2 ( kt, ksbc )     ! Dummy routine 
     243      INTEGER, INTENT(in) ::   kt       
     244      INTEGER, INTENT(in) ::   ksbc     
    224245      WRITE(*,*) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc 
    225246   END SUBROUTINE sbc_ice_lim_2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r2528 r2590  
    3030   PUBLIC   sbc_rnf       ! routine call in sbcmod module 
    3131   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module 
     32   PUBLIC   sbc_rnf_alloc ! routine called in nemogcm module 
    3233 
    3334   !                                                      !!* namsbc_rnf namelist * 
    … …  
    4849 
    4950   INTEGER , PUBLIC                          ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths 
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   rnfmsk            !: river mouth mask (hori.) 
    51    REAL(wp), PUBLIC, DIMENSION(jpk)          ::   rnfmsk_z          !: river mouth mask (vert.) 
    52    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   h_rnf             !: depth of runoff in m 
    53    INTEGER,  PUBLIC, DIMENSION(jpi,jpj)      ::   nk_rnf            !: depth of runoff in model levels 
    54    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: rnf_tsc_b, rnf_tsc  !: before and now T & S contents of runoffs  [K.m/s & PSU.m/s] 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk            !: river mouth mask (hori.) 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z          !: river mouth mask (vert.) 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf             !: depth of runoff in m 
     54   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nk_rnf            !: depth of runoff in model levels 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rnf_tsc_b, rnf_tsc  !: before and now T & S contents of runoffs  [K.m/s & PSU.m/s] 
    5556    
    5657   REAL(wp) ::   r1_rau0   ! = 1 / rau0  
    … …  
    6869   !!---------------------------------------------------------------------- 
    6970CONTAINS 
     71 
     72   FUNCTION sbc_rnf_alloc() 
     73      !!---------------------------------------------------------------------- 
     74      !!                ***  ROUTINE sbc_rnf_alloc  *** 
     75      !!---------------------------------------------------------------------- 
     76      IMPLICIT none 
     77      INTEGER :: sbc_rnf_alloc 
     78      !!---------------------------------------------------------------------- 
     79 
     80      ALLOCATE(rnfmsk(jpi,jpj),         rnfmsk_z(jpk),         & 
     81               h_rnf(jpi,jpj),          nk_rnf(jpi,jpj),       & 
     82               rnf_tsc_b(jpi,jpj,jpts), rnf_tsc(jpi,jpj,jpts), & 
     83               Stat=sbc_rnf_alloc) 
     84 
     85      IF(sbc_rnf_alloc > 0)THEN 
     86         CALL ctl_warn('sbc_rnf_alloc: allocation of arrays failed.') 
     87      END IF 
     88 
     89   END FUNCTION sbc_rnf_alloc 
    7090 
    7191   SUBROUTINE sbc_rnf( kt ) 
    … …  
    182202      !! ** Action  :   phdivn   decreased by the runoff inflow 
    183203      !!---------------------------------------------------------------------- 
    184       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   phdivn   ! horizontal divergence 
     204      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence 
    185205      !! 
    186206      INTEGER  ::   ji, jj, jk   ! dummy loop indices 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r2528 r2590  
    2525   PRIVATE 
    2626 
    27    PUBLIC   sbc_ssr    ! routine called in sbcmod 
    28     
    29  
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   erp      !: evaporation damping   [kg/m2/s] 
    31    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qrp      !: heat flux damping        [w/m2] 
     27   PUBLIC   sbc_ssr       ! routine called in sbcmod 
     28   PUBLIC   sbc_ssr_alloc ! routine called in nemgcm 
     29 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   erp      !: evaporation damping   [kg/m2/s] 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qrp      !: heat flux damping        [w/m2] 
    3232 
    3333   !                                           !!* Namelist namsbc_ssr * 
    … …  
    5252 
    5353CONTAINS 
     54 
     55   FUNCTION sbc_ssr_alloc() 
     56      !!--------------------------------------------------------------------- 
     57      !!                  ***  ROUTINE sbc_ssr_alloc  *** 
     58      !!--------------------------------------------------------------------- 
     59      IMPLICIT none 
     60      INTEGER :: sbc_ssr_alloc 
     61      !!--------------------------------------------------------------------- 
     62 
     63      ALLOCATE(erp(jpi,jpj), qrp(jpi,jpj), Stat=sbc_ssr_alloc) 
     64 
     65      IF(sbc_ssr_alloc > 0)THEN 
     66         CALL ctl_warn('sbc_ssr_alloc: allocation of arrays failed.') 
     67      END IF 
     68 
     69   END FUNCTION sbc_ssr_alloc 
    5470 
    5571   SUBROUTINE sbc_ssr( kt ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90

    r2528 r2590  
    1010   IMPLICIT NONE 
    1111   PRIVATE 
     12 
     13   PUBLIC sol_oce_alloc ! routine called in nemogcm.F90 
    1214 
    1315   !                                             !!* Namelist namsol : elliptic solver * 
    … …  
    3537   REAL(wp), PUBLIC ::   rr          !: coefficient  =(rn,rn) 
    3638 
    37    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   gcp     !: matrix extra-diagonal elements 
    38    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcx     !: now    solution of the elliptic eq. 
    39    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcxb    !: before solution of the elliptic eq. 
    40    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdprc  !: inverse diagonal preconditioning matrix 
    41    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdmat  !: diagonal preconditioning matrix 
    42    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcb     !: second member of the elliptic eq. 
    43    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcr     !: residu =b-a.x 
    44    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdes   !: vector descente 
    45    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gccd    !: gccd= gcdprc^-1.a.d  
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gcp     !: matrix extra-diagonal elements 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcx     !: now    solution of the elliptic eq. 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcxb    !: before solution of the elliptic eq. 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdprc  !: inverse diagonal preconditioning matrix 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdmat  !: diagonal preconditioning matrix 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcb     !: second member of the elliptic eq. 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcr     !: residu =b-a.x 
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdes   !: vector descente 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gccd    !: gccd= gcdprc^-1.a.d  
    4648 
    4749#if defined key_agrif 
    48       REAL(wp), DIMENSION(jpi,jpj) :: laplacu, laplacv 
     50      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: laplacu, laplacv 
    4951#endif 
    5052 
    … …  
    5456   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5557   !!---------------------------------------------------------------------- 
     58CONTAINS 
     59 
     60   FUNCTION sol_oce_alloc() 
     61      USE in_out_manager, ONLY: ctl_warn 
     62      IMPLICIT none 
     63      INTEGER  :: sol_oce_alloc 
     64      ! Local vars 
     65      INTEGER  :: ierr(3) 
     66 
     67      ierr(:) = 0 
     68 
     69      ALLOCATE(gcp(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), & 
     70               gcx(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),   & 
     71               gcxb(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), Stat=ierr(1)) 
     72 
     73      ALLOCATE(gcdprc(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),&  
     74               gcdmat(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),&  
     75               gcb(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), Stat=ierr(2)) 
     76 
     77      ALLOCATE(gcr(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),   &  
     78               gcdes(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), &  
     79               gccd(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj),  & 
     80#if defined key_agrif 
     81               laplacu(jpi,jpj), laplacv(jpi,jpj),             & 
     82#endif 
     83               Stat=ierr(3)) 
     84 
     85      sol_oce_alloc = MAXVAL(ierr) 
     86 
     87      IF(sol_oce_alloc > 0)THEN 
     88         CALL ctl_warn('sol_oce_alloc: allocation of arrays failed.') 
     89      END IF 
     90 
     91  END FUNCTION sol_oce_alloc 
     92 
    5693END MODULE sol_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r2528 r2590  
    3535   PRIVATE 
    3636 
    37    PUBLIC   sol_mat    ! routine called by inisol.F90 
     37   PUBLIC   sol_mat        ! routine called by inisol.F90 
     38   PUBLIC   sol_mat_alloc  ! routine called by nemogcm.F90 
     39 
     40   ! Workspace array for sol_exd(). 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztab 
    3842 
    3943   !!---------------------------------------------------------------------- 
    … …  
    4448 
    4549CONTAINS 
     50 
     51   FUNCTION sol_mat_alloc() 
     52      !!---------------------------------------------------------------------- 
     53      !!                ***  ROUTINE sol_mat_alloc  *** 
     54      !!---------------------------------------------------------------------- 
     55      INTEGER :: sol_mat_alloc 
     56      !!---------------------------------------------------------------------- 
     57 
     58      ALLOCATE(ztab(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), & 
     59               Stat=sol_mat_alloc) 
     60 
     61      IF(sol_mat_alloc /= 0)THEN 
     62         CALL ctl_warn('sol_mat_alloc: failed to allocate array.') 
     63      END IF 
     64 
     65   END FUNCTION sol_mat_alloc 
     66 
    4667 
    4768   SUBROUTINE sol_mat( kt ) 
    … …  
    321342      INTEGER  ::   ji, jk   ! dummy loop indices 
    322343      INTEGER  ::   iloc     ! temporary integers 
    323       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   ztab   ! 2D workspace 
    324344      !!---------------------------------------------------------------------- 
    325345 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90

    r2528 r2590  
    8383      !!        !  08-01  (R. Benshila) mpp optimization 
    8484      !!---------------------------------------------------------------------- 
     85      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     86      USE wrk_nemo, ONLY: zgcr => wrk_2d_1 
     87      !! 
    8588      INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver- 
    8689      !                                      ! gence is not reached: the model is 
    … …  
    9194      REAL(wp) ::  zgcad                     ! temporary scalars 
    9295      REAL(wp), DIMENSION(2) :: zsum 
    93       REAL(wp), DIMENSION(jpi,jpj) :: zgcr 
    9496      !!---------------------------------------------------------------------- 
     97       
     98      IF( .not. wrk_use(2, 1) )THEN 
     99         CALL ctl_stop('sol_pcg: requested workspace array is unavailable') 
     100         RETURN 
     101      END IF 
    95102 
    96103      ! Initialization of the algorithm with standard PCG 
    … …  
    209216      CALL lbc_lnk( gcx, c_solver_pt, 1. ) 
    210217      
     218      !  
     219      IF( .not. wrk_release(2, 1) )THEN 
     220         CALL ctl_stop('sol_pcg: failed to release workspace array') 
     221      END IF 
     222      ! 
    211223   END SUBROUTINE sol_pcg 
    212224 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90

    r2528 r2590  
    5858      !!                Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 
    5959      !!---------------------------------------------------------------------- 
     60      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     61      USE wrk_nemo, ONLY: ztab => wrk_2d_1 
     62      !! 
    6063      INTEGER, INTENT(inout) ::   kindic   ! solver indicator, < 0 if the convergence is not reached: 
    6164      !                                    ! the model is stopped in step (set to zero before the call of solsor) 
    … …  
    6568      INTEGER  ::   ijmppodd, ijmppeven, ijpr2d 
    6669      REAL(wp) ::   ztmp, zres, zres2 
    67       REAL(wp), DIMENSION(jpi,jpj) ::ztab 
    6870      !!---------------------------------------------------------------------- 
    6971       
     72      IF( .not. wrk_use(2, 1) )THEN 
     73         CALL ctl_stop('sol_sor: requested workspace array is unavailable') 
     74         RETURN 
     75      END IF 
     76 
    7077      ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj   , 2 ) 
    7178      ijmppodd  = MOD( nimpp+njmpp+jpr2di+jpr2dj+1 , 2 ) 
    … …  
    163170      !  ------------- 
    164171      CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    ! boundary conditions 
     172      !  
     173      IF( .not. wrk_release(2, 1) )THEN 
     174         CALL ctl_stop('sol_sor: failed to release workspace array') 
     175      END IF 
    165176      ! 
    166177   END SUBROUTINE sol_sor 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r2528 r2590  
    107107      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    108108      !!---------------------------------------------------------------------- 
    109       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     109      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     110      USE wrk_nemo, ONLY: zws => wrk_3d_1 ! temporary workspace 
     111      !! 
     112      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    110113      !                                                               ! 2 : salinity               [psu] 
    111       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   prd   ! in situ density  
     114      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density  
    112115      !! 
    113116      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    … …  
    118121      REAL(wp) ::   zb1, za1, zkw, zk0   !    -         - 
    119122      REAL(wp) ::   zrau0r               !    -         - 
    120       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! temporary workspace 
    121       !!---------------------------------------------------------------------- 
     123      !!---------------------------------------------------------------------- 
     124 
     125      IF(.NOT. wrk_use(3, 1))THEN 
     126         CALL ctl_stop('eos_insitu : requested workspace array unavailable.') 
     127         RETURN 
     128      END IF 
    122129 
    123130      SELECT CASE( nn_eos ) 
    … …  
    183190      ! 
    184191      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk ) 
     192      ! 
     193      IF(.NOT. wrk_release(3, 1))THEN 
     194         CALL ctl_stop('eos_insitu : failed to release workspace array.') 
     195      END IF 
    185196      ! 
    186197   END SUBROUTINE eos_insitu 
    … …  
    233244      !!                Brown and Campana, Mon. Weather Rev., 1978 
    234245      !!---------------------------------------------------------------------- 
     246      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     247      USE wrk_nemo, ONLY: zws => wrk_3d_1 ! 3D workspace 
     248      !! 
    235249      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    236250      !                                                               ! 2 : salinity               [psu] 
    … …  
    241255      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    242256      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !    -         - 
    243       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! 3D workspace 
    244       !!---------------------------------------------------------------------- 
     257      !!---------------------------------------------------------------------- 
     258 
     259      IF(.NOT. wrk_use(3, 1))THEN 
     260         CALL ctl_stop('eos_insitu_pot: requested workspace array unavailable.') 
     261         RETURN 
     262      END IF 
    245263 
    246264      SELECT CASE ( nn_eos ) 
    … …  
    311329      ! 
    312330      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     331      ! 
     332      IF(.NOT. wrk_release(3, 1))THEN 
     333         CALL ctl_stop('eos_insitu_pot: failed to release workspace array.') 
     334      END IF 
    313335      ! 
    314336   END SUBROUTINE eos_insitu_pot 
    … …  
    351373      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    352374      !!---------------------------------------------------------------------- 
     375      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     376      USE wrk_nemo, ONLY: zws => wrk_2d_5 ! 2D workspace 
     377      !! 
    353378      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    354379      !                                                           ! 2 : salinity               [psu] 
    … …  
    359384      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    360385      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         - 
    361       REAL(wp), DIMENSION(jpi,jpj) ::   zws   ! 2D workspace 
    362       !!---------------------------------------------------------------------- 
     386      !!---------------------------------------------------------------------- 
     387 
     388      IF(.NOT. wrk_use(2, 5))THEN 
     389         CALL ctl_stop('eos_insitu_2d: requested workspace array unavailable.') 
     390         RETURN 
     391      END IF 
    363392 
    364393      prd(:,:) = 0.e0 
    … …  
    434463      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    435464      ! 
     465      IF(.NOT. wrk_release(2, 5))THEN 
     466         CALL ctl_stop('eos_insitu_2d: failed to release workspace array.') 
     467      END IF 
     468      ! 
    436469   END SUBROUTINE eos_insitu_2d 
    437470 
    … …  
    661694      !!---------------------------------------------------------------------- 
    662695      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
     696      ! Leave result array automatic rather than making explicitly allocated 
    663697      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
    664698      !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r2561 r2590  
    3232   PUBLIC   tra_adv        ! routine called by step module 
    3333   PUBLIC   tra_adv_init   ! routine called by opa module 
    34   
     34   PUBLIC   tra_adv_alloc  ! routine called by nemogcm module 
     35 
    3536   !                                        !!* Namelist namtra_adv * 
    3637   LOGICAL ::   ln_traadv_cen2   = .TRUE.    ! 2nd order centered scheme flag 
    … …  
    4344   INTEGER ::   nadv   ! choice of the type of advection scheme 
    4445 
    45    REAL(wp), DIMENSION(jpk) ::   r2dt   ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
     46   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::   r2dt   ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    4647 
    4748   !! * Substitutions 
    … …  
    5455   !!---------------------------------------------------------------------- 
    5556CONTAINS 
     57 
     58   FUNCTION tra_adv_alloc() 
     59      !!---------------------------------------------------------------------- 
     60      !!                ***  ROUTINE tra_adv_alloc  *** 
     61      !!---------------------------------------------------------------------- 
     62      IMPLICIT none 
     63      INTEGER tra_adv_alloc 
     64      !!---------------------------------------------------------------------- 
     65 
     66      ALLOCATE( r2dt(jpk), Stat=tra_adv_alloc) 
     67 
     68      IF(tra_adv_alloc /= 0)THEN 
     69         CALL ctl_warn('tra_adv_alloc: failed to allocate array.') 
     70      END IF 
     71 
     72   END FUNCTION tra_adv_alloc 
    5673 
    5774   SUBROUTINE tra_adv( kt ) 
    … …  
    6380      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    6481      !!---------------------------------------------------------------------- 
     82      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     83      USE wrk_nemo, ONLY: zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3 
    6584      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    6685      ! 
    6786      INTEGER ::   jk   ! dummy loop index 
    68       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! 3D workspace: effective transport 
    69       !!---------------------------------------------------------------------- 
     87      !!---------------------------------------------------------------------- 
     88      ! 
     89      IF(.not. wrk_use(3,1,2,3))THEN 
     90         CALL ctl_stop('tra_adv: ERROR: requested workspace arrays unavailable') 
     91         RETURN 
     92      END IF 
    7093      !                                          ! set time step 
    7194      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    126149      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    127150         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     151      ! 
     152      IF(.not. wrk_release(3,1,2,3))THEN 
     153         CALL ctl_stop('tra_adv: ERROR: failed to release workspace arrays') 
     154         RETURN 
     155      END IF 
    128156      ! 
    129157   END SUBROUTINE tra_adv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2528 r2590  
    3535   PRIVATE 
    3636 
    37    PUBLIC   tra_adv_cen2    ! routine called by step.F90 
    38    PUBLIC   ups_orca_set    ! routine used by traadv_cen2_jki.F90 
     37   PUBLIC   tra_adv_cen2       ! routine called by step.F90 
     38   PUBLIC   ups_orca_set       ! routine used by traadv_cen2_jki.F90 
     39   PUBLIC   tra_adv_cen2_alloc ! routine called by nemogcm.F90 
    3940 
    4041   LOGICAL  :: l_trd       ! flag to compute trends 
    4142 
    42    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: upsmsk    !: mixed upstream/centered scheme near some straits  
    43    !                                                   !  and in closed seas (orca 2 and 4 configurations) 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits  
     44   !                                                             !  and in closed seas (orca 2 and 4 configurations) 
    4445   !! * Substitutions 
    4546#  include "domzgr_substitute.h90" 
    … …  
    5152   !!---------------------------------------------------------------------- 
    5253CONTAINS 
     54 
     55   FUNCTION tra_adv_cen2_alloc() 
     56      !!---------------------------------------------------------------------- 
     57      !!               ***  ROUTINE tra_adv_cen2_alloc  *** 
     58      !!---------------------------------------------------------------------- 
     59      IMPLICIT none 
     60      INTEGER :: tra_adv_cen2_alloc 
     61      !!---------------------------------------------------------------------- 
     62 
     63      ALLOCATE(upsmsk(jpi,jpj), Stat=tra_adv_cen2_alloc) 
     64 
     65      IF(tra_adv_cen2_alloc > 0)THEN 
     66         CALL ctl_warn('tra_adv_cen2_alloc: failed to allocate array.') 
     67      END IF 
     68 
     69   END FUNCTION tra_adv_cen2_alloc 
    5370 
    5471   SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn,        & 
    … …  
    111128      USE oce         , zwx => ua   ! use ua as workspace 
    112129      USE oce         , zwy => va   ! use va as workspace 
     130      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     131      USE wrk_nemo, ONLY: ztfreez => wrk_2d_1 
     132      USE wrk_nemo, ONLY: zwz => wrk_3d_1, zind => wrk_3d_2 
    113133      !! 
    114134      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    128148      REAL(wp) ::   zupst , zcent                    !    -         - 
    129149      REAL(wp) ::   zice                             !    -         - 
    130       REAL(wp), DIMENSION(jpi,jpj)     ::   ztfreez            ! 2D workspace 
    131       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, zind   ! 3D workspace  
    132       !!---------------------------------------------------------------------- 
    133  
     150      !!---------------------------------------------------------------------- 
     151 
     152      IF( (.not. wrk_use(2, 1)) .OR. (.not. wrk_use(3, 1,2)))THEN 
     153         CALL ctl_stop('tra_adv_cen2: ERROR: requested workspace arrays unavailable') 
     154         RETURN 
     155      END IF 
    134156 
    135157      IF( kt == nit000 )  THEN 
    … …  
    269291         CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb ) 
    270292      ENDIF 
     293      ! 
     294      IF( (.not. wrk_release(2, 1)) .OR. (.not. wrk_release(3, 1,2)))THEN 
     295         CALL ctl_stop('tra_adv_cen2: ERROR: failed to release workspace arrays') 
     296      END IF 
    271297      ! 
    272298   END SUBROUTINE tra_adv_cen2 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r2528 r2590  
    6464      !! ** Action  : - add to p.n the eiv component 
    6565      !!---------------------------------------------------------------------- 
     66      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     67      USE wrk_nemo, ONLY: zu_eiv => wrk_2d_1, zv_eiv => wrk_2d_2, & 
     68                          zw_eiv => wrk_2d_3 
     69# if defined key_diaeiv  
     70      USE wrk_nemo, ONLY: z2d => wrk_2d_4 
     71#endif 
    6672      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
    6773      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    7379      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
    7480      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
    75       REAL(wp), DIMENSION(jpi,jpj) ::   zu_eiv, zv_eiv, zw_eiv     ! 2D workspace 
    7681# if defined key_diaeiv  
    7782      REAL(wp) ::   zztmp                      ! local scalar 
    78       REAL(wp), DIMENSION(jpi,jpj) ::   z2d    ! 2D workspace 
    7983# endif   
    8084      !!---------------------------------------------------------------------- 
     85 
     86# if defined key_diaeiv  
     87      IF(.not. wrk_use(2, 1,2,3,4))THEN 
     88#else 
     89      IF(.not. wrk_use(2, 1,2,3))THEN 
     90#endif 
     91         CALL ctl_stop('tra_adv_eiv: ERROR: requested workspace arrays are unavailable.') 
     92         RETURN 
     93      END IF 
    8194 
    8295      IF( kt == nit000 )  THEN 
    … …  
    180193# endif   
    181194      !  
     195# if defined key_diaeiv  
     196      IF(.not. wrk_release(2, 1,2,3,4))THEN 
     197#else 
     198      IF(.not. wrk_release(2, 1,2,3))THEN 
     199#endif 
     200         CALL ctl_stop('tra_adv_eiv: ERROR: failed to release workspace arrays.') 
     201      END IF 
     202      ! 
    182203    END SUBROUTINE tra_adv_eiv 
    183204 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2528 r2590  
    6363      USE oce         , zwx => ua   ! use ua as workspace 
    6464      USE oce         , zwy => va   ! use va as workspace 
     65      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     66      USE wrk_nemo, ONLY: zslpx => wrk_3d_1, zslpy => wrk_3d_2 
    6567      !! 
    6668      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7779      REAL(wp) ::   zw, z0w          !   -      - 
    7880      REAL(wp) ::   ztra, zbtr, zdt, zalpha 
    79       REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy   ! 3D workspace 
    8081      !!---------------------------------------------------------------------- 
     82 
     83      IF( .not. wrk_use(3, 1,2) )THEN 
     84         CALL ctl_stop('tra_adv_muscl: ERROR: requested workspace arrays unavailable') 
     85         RETURN 
     86      END IF 
    8187 
    8288      IF( kt == nit000 )  THEN 
    … …  
    249255      ENDDO 
    250256      ! 
     257      IF( .not. wrk_release(3, 1,2) )THEN 
     258         CALL ctl_stop('tra_adv_muscl: ERROR: requested workspace arrays unavailable') 
     259      END IF 
     260      ! 
    251261   END SUBROUTINE tra_adv_muscl 
    252262 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2528 r2590  
    6161      USE oce         , zwx => ua   ! use ua as workspace 
    6262      USE oce         , zwy => va   ! use va as workspace 
     63      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     64      USE wrk_nemo, ONLY: zslpx => wrk_3d_1, zslpy => wrk_3d_2 
    6365      !! 
    6466      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7577      REAL(wp) ::   zw, z0w          !   -      - 
    7678      REAL(wp) ::   ztra, zbtr, zdt, zalpha 
    77       REAL(wp), DIMENSION (jpi,jpj,jpk) ::  zslpx, zslpy   ! 3D workspace 
    7879      !!---------------------------------------------------------------------- 
     80 
     81      IF(.not. wrk_use(3, 1,2))THEN 
     82         CALL ctl_stop('tra_adv_muscl2: ERROR: requested workspace arrays are unavailable') 
     83         RETURN 
     84      END IF 
    7985 
    8086      IF( kt == nit000 )  THEN 
    … …  
    282288      END DO 
    283289      ! 
     290      IF(.not. wrk_release(3, 1,2))THEN 
     291         CALL ctl_stop('tra_adv_muscl2: ERROR: failed to release workspace arrays') 
     292      END IF 
     293      ! 
    284294   END SUBROUTINE tra_adv_muscl2 
    285295 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2528 r2590  
    116116      !!---------------------------------------------------------------------- 
    117117      USE oce         , zwx => ua   ! use ua as workspace 
     118      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     119      USE wrk_nemo, ONLY: zfu => wrk_3d_1, zfc => wrk_3d_2, zfd => wrk_3d_3 
    118120      !! 
    119121      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    128130      REAL(wp) :: ztra, zbtr               ! local scalars 
    129131      REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace 
    131132      !---------------------------------------------------------------------- 
    132  
     133      ! 
     134      IF(.not. wrk_use(3, 1,2,3))THEN 
     135         CALL ctl_stop('tra_adv_qck_i: ERROR: requested workspace arrays unavailable') 
     136         RETURN 
     137      END IF 
    133138      !                                                          ! =========== 
    134139      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    225230      END DO 
    226231      ! 
     232      IF(.not. wrk_release(3, 1,2,3))THEN 
     233         CALL ctl_stop('tra_adv_qck_i: ERROR: failed to release workspace arrays') 
     234      END IF 
     235      ! 
    227236   END SUBROUTINE tra_adv_qck_i 
    228237 
    … …  
    234243      !!---------------------------------------------------------------------- 
    235244      USE oce         , zwy => ua   ! use ua as workspace 
     245      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     246      USE wrk_nemo, ONLY: zfu => wrk_3d_1, zfc => wrk_3d_2, zfd => wrk_3d_3 
    236247      !! 
    237248      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    246257      REAL(wp) :: ztra, zbtr               ! local scalars 
    247258      REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
    248       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace 
    249259      !---------------------------------------------------------------------- 
    250  
     260      ! 
     261      IF(.not. wrk_use(3, 1,2,3))THEN 
     262         CALL ctl_stop('tra_adv_qck_j: ERROR: requested workspace arrays unavailable') 
     263         RETURN 
     264      END IF 
    251265      !                                                          ! =========== 
    252266      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    349363         ! 
    350364      END DO 
     365      ! 
     366      IF(.not. wrk_release(3, 1,2,3))THEN 
     367         CALL ctl_stop('tra_adv_qck_j: ERROR: failed to release workspace arrays') 
     368      END IF 
    351369      ! 
    352370   END SUBROUTINE tra_adv_qck_j 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r2528 r2590  
    6868      USE oce         , zwx => ua   ! use ua as workspace 
    6969      USE oce         , zwy => va   ! use va as workspace 
     70      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     71      USE wrk_nemo, ONLY: zwi => wrk_3d_6, zwz => wrk_3d_7 
    7072      !! 
    7173      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    8183      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    8284      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    83       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwi, zwz   ! 3D workspace 
     85 
    8486      REAL(wp), DIMENSION (:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
    8587      !!---------------------------------------------------------------------- 
     88 
     89      IF(.not. wrk_use(3, 6,7))THEN 
     90         CALL ctl_stop('tra_adv_tvd: ERROR: requested workspace arrays unavailable') 
     91         RETURN 
     92      END IF 
    8693 
    8794      IF( kt == nit000 )  THEN 
    … …  
    241248      END IF 
    242249      ! 
     250      IF(.not. wrk_release(3, 6,7))THEN 
     251         CALL ctl_stop('tra_adv_tvd: ERROR: failed to release workspace arrays') 
     252      END IF 
     253      ! 
    243254   END SUBROUTINE tra_adv_tvd 
    244255 
    … …  
    257268      !!       in-space based differencing for fluid 
    258269      !!---------------------------------------------------------------------- 
     270      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     271      USE wrk_nemo, ONLY: zbetup => wrk_3d_8, zbetdo => wrk_3d_9, & 
     272                          zbup => wrk_3d_10, zbdo => wrk_3d_11 
    259273      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    260274      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
    … …  
    263277      INTEGER ::   ji, jj, jk               ! dummy loop indices 
    264278      INTEGER ::   ikm1 
    265       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo 
    266       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbup, zbdo 
    267279      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt 
    268280      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv 
    269281      REAL(wp) ::   zup, zdo 
    270282      !!---------------------------------------------------------------------- 
     283 
     284      IF(.not. wrk_use(3, 8,9,10,11))THEN 
     285         CALL ctl_stop('nonosc: ERROR: requested workspace array unavailable') 
     286         RETURN 
     287      END IF 
    271288 
    272289      zbig = 1.e+40 
    … …  
    348365      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    349366      ! 
     367      IF(.not. wrk_release(3, 8,9,10,11))THEN 
     368         CALL ctl_stop('nonosc: ERROR: failed to release workspace arrays') 
     369      END IF 
     370      ! 
    350371   END SUBROUTINE nonosc 
    351372 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r2528 r2590  
    7575      USE oce         , zwx => ua   ! use ua as workspace 
    7676      USE oce         , zwy => va   ! use va as workspace 
     77      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     78      USE wrk_nemo, ONLY: ztu  => wrk_3d_1, ztv  => wrk_3d_2, & 
     79                          zltu => wrk_3d_3, zltv => wrk_3d_4, & 
     80                          zti  => wrk_3d_5, ztw  => wrk_3d_6 
    7781      !! 
    7882      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    9195      REAL(wp) ::   ztak, zfp_wk, zfm_wk    !   -      - 
    9296      REAL(wp) ::   zeeu, zeev, z_hdivn     !   -      - 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu , zltv   ! 3D workspace 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zti, ztw                !  -      - 
    95       !!---------------------------------------------------------------------- 
     97      !!---------------------------------------------------------------------- 
     98 
     99      IF( .not. wrk_use(3, 1,2,3,4,5,6) )THEN 
     100         CALL ctl_stop('tra_adv_ubs: ERROR: requested workspace arrays unavailable') 
     101         RETURN 
     102      END IF 
    96103 
    97104      IF( kt == nit000 )  THEN 
    … …  
    266273      ENDDO 
    267274      ! 
     275      IF( .not. wrk_release(3, 1,2,3,4,5,6) )THEN 
     276         CALL ctl_stop('tra_adv_ubs: ERROR: failed to release workspace arrays') 
     277      END IF 
     278      ! 
    268279   END SUBROUTINE tra_adv_ubs 
    269280 
    … …  
    282293      !!       in-space based differencing for fluid 
    283294      !!---------------------------------------------------------------------- 
     295      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     296      USE wrk_nemo, ONLY: zbetup => wrk_3d_1, zbetdo => wrk_3d_2 
     297      !! 
    284298      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step 
    285299      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
    … …  
    290304      INTEGER  ::   ikm1 
    291305      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt 
    292       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo 
    293       !!---------------------------------------------------------------------- 
     306      !!---------------------------------------------------------------------- 
     307 
     308      IF( .not. wrk_use(3, 1,2) )THEN 
     309         CALL ctl_stop('nonosc_z: ERROR: requested workspace arrays unavailable') 
     310         RETURN 
     311      END IF 
    294312 
    295313      zbig = 1.e+40 
    … …  
    363381      END DO 
    364382      ! 
     383      IF( .not. wrk_release(3, 1,2) )THEN 
     384         CALL ctl_stop('nonosc_z: ERROR: failed to release workspace arrays') 
     385      END IF 
     386      ! 
    365387   END SUBROUTINE nonosc_z 
    366388 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r2528 r2590  
    4242   PUBLIC   tra_bbl_adv   !  -          -          -              - 
    4343   PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90 
     44   PUBLIC   tra_bbl_alloc !  routine called by nemogcm.F90 
    4445 
    4546   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag 
    … …  
    5354   REAL(wp), PUBLIC ::   rn_gambbl  = 10.0_wp   !: lateral coeff. for bottom boundary layer scheme [s] 
    5455 
    55    REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
    56    REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coefficients at u and v-points 
    57  
    58    INTEGER , DIMENSION(jpi,jpj) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level 
    59    INTEGER , DIMENSION(jpi,jpj) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction 
    60    REAL(wp), DIMENSION(jpi,jpj) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
    61    REAL(wp), DIMENSION(jpi,jpj) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points 
    62    REAL(wp), DIMENSION(jpi,jpj) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points 
     56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
     57   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coefficients at u and v-points 
     58 
     59   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level 
     60   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points 
    6364   LOGICAL, PUBLIC              ::   l_bbl                    !: flag to compute bbl diffu. flux coef and transport 
    6465 
    … …  
    7273   !!---------------------------------------------------------------------- 
    7374CONTAINS 
     75 
     76   FUNCTION tra_bbl_alloc() 
     77      IMPLICIT none 
     78      INTEGER :: tra_bbl_alloc 
     79 
     80      ALLOCATE(utr_bbl(jpi,jpj),   vtr_bbl(jpi,jpj),   & 
     81               ahu_bbl(jpi,jpj),   ahv_bbl(jpi,jpj),   & 
     82               mbku_d(jpi,jpj),    mbkv_d(jpi,jpj),    & 
     83               mgrhu(jpi,jpj),     mgrhv(jpi,jpj),     & 
     84               ahu_bbl_0(jpi,jpj), ahv_bbl_0(jpi,jpj), & 
     85               e3u_bbl_0(jpi,jpj), e3v_bbl_0(jpi,jpj), & 
     86               e1e2t_r(jpi,jpj),                       & 
     87               Stat=tra_bbl_alloc) 
     88 
     89      IF(tra_bbl_alloc > 0)THEN 
     90         CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.') 
     91      END IF 
     92 
     93   END FUNCTION tra_bbl_alloc 
    7494 
    7595   SUBROUTINE tra_bbl( kt ) 
    … …  
    153173      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    154174      !!----------------------------------------------------------------------   
     175      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     176      USE wrk_nemo, ONLY: zptb => wrk_2d_1 
     177      !! 
    155178      INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
    156179      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields 
    … …  
    160183      INTEGER  ::   ik           ! local integers 
    161184      REAL(wp) ::   zbtr         ! local scalars 
    162       REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! tracer trend  
    163       !!---------------------------------------------------------------------- 
     185      !!---------------------------------------------------------------------- 
     186      ! 
     187      IF(.not. wrk_use(2,1))THEN 
     188         CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable') 
     189         RETURN 
     190      END IF 
    164191      ! 
    165192      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    196223      END DO                                                ! end tracer 
    197224      !                                                     ! =========== 
     225      IF(.not. wrk_release(2,1))THEN 
     226         CALL ctl_stop('tra_bbl_dif: ERROR: failed to release workspace array') 
     227      END IF 
     228      ! 
    198229   END SUBROUTINE tra_bbl_dif 
    199230    
    … …  
    314345      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    315346      !!----------------------------------------------------------------------   
     347      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     348      USE wrk_nemo, ONLY: zub => wrk_2d_1, zvb => wrk_2d_2, ztb => wrk_2d_3, & 
     349                          zsb => wrk_2d_4, zdep => wrk_2d_5 
    316350      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    317351      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    323357      REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars 
    324358      REAL(wp) ::   zgdrho, zt, zs, zh        !   -      - 
    325       REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb, ztb, zsb, zdep  !  2D workspace 
    326359      !! 
    327360      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function 
    … …  
    357390                                          - 0.121555e-07 ) * pfh 
    358391      !!---------------------------------------------------------------------- 
    359        
     392 
     393      IF(.not. wrk_use(2, 1,2,3,4,5))THEN 
     394         CALL ctl_stop('bbl: ERROR: requested workspace arrays unavailable') 
     395         RETURN 
     396      END IF 
     397      
    360398      IF( kt == nit000 )  THEN 
    361399         IF(lwp)  WRITE(numout,*) 
    … …  
    494532      ENDIF 
    495533      ! 
     534      IF(.not. wrk_release(2, 1,2,3,4,5))THEN 
     535         CALL ctl_stop('bbl: ERROR: failed to release workspace arrays') 
     536      END IF 
     537      ! 
    496538   END SUBROUTINE bbl 
    497539 
    … …  
    506548      !!              called by tra_bbl at the first timestep (nit000) 
    507549      !!---------------------------------------------------------------------- 
     550      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     551      USE wrk_nemo, ONLY: zmbk => wrk_2d_1 
    508552      INTEGER ::   ji, jj               ! dummy loop indices 
    509553      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer 
    510       REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace  
    511554      !! 
    512555      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 
    513556      !!---------------------------------------------------------------------- 
     557 
     558      IF(.not. wrk_use(2,1))THEN 
     559         CALL ctl_stop('tra_bbl_init: ERROR: requested workspace array unavailable') 
     560         RETURN 
     561      END IF 
    514562 
    515563      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme 
    … …  
    594642      ENDIF 
    595643      ! 
     644      IF(.not. wrk_release(2,1))THEN 
     645         CALL ctl_stop('tra_bbl_init: ERROR: failed to release workspace array') 
     646      END IF 
     647      ! 
    596648   END SUBROUTINE tra_bbl_init 
    597649 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r2528 r2590  
    4545   PUBLIC   dtacof       ! routine called by in both tradmp.F90 and trcdmp.F90 
    4646   PUBLIC   dtacof_zoom  ! routine called by in both tradmp.F90 and trcdmp.F90 
     47   PUBLIC   tra_dmp_alloc ! routine called by nemogcm.F90 
    4748 
    4849#if ! defined key_agrif 
    … …  
    5152   LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag 
    5253#endif 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   strdmp   !: damping salinity trend (psu/s) 
    54    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ttrdmp   !: damping temperature trend (Celcius/s) 
    55    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   resto    !: restoring coeff. on T and S (s-1) 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s) 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s) 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
    5657    
    5758   !                                !!* Namelist namtra_dmp : T & S newtonian damping * 
    … …  
    7273   !!---------------------------------------------------------------------- 
    7374CONTAINS 
     75 
     76   FUNCTION tra_dmp_alloc() 
     77      IMPLICIT none 
     78      INTEGER :: tra_dmp_alloc 
     79 
     80      ALLOCATE(strdmp(jpi,jpj,jpk), ttrdmp(jpi,jpj,jpk), & 
     81               resto(jpi,jpj,jpk), Stat=tra_dmp_alloc) 
     82 
     83      IF(tra_dmp_alloc /= 0)THEN 
     84         CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed.') 
     85      END IF 
     86 
     87   END FUNCTION tra_dmp_alloc 
    7488 
    7589   SUBROUTINE tra_dmp( kt ) 
    … …  
    312326      USE iom 
    313327      USE ioipsl 
     328      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     329      USE wrk_nemo, ONLY: zhfac => wrk_1d_1, zmrs => wrk_2d_1 
     330      USE wrk_nemo, ONLY: zdct => wrk_3d_1 
    314331      !! 
    315332      INTEGER                         , INTENT(in   )  ::  kn_hdmp    ! damping option 
    … …  
    327344      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   !   -      - 
    328345      REAL(wp) ::   zsdmp, zbdmp                !   -      - 
    329       REAL(wp), DIMENSION(jpk)         ::   zhfac 
    330       REAL(wp), DIMENSION(jpi,jpj)     ::   zmrs 
    331       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdct 
    332346      CHARACTER(len=20)                ::   cfile 
    333347      !!---------------------------------------------------------------------- 
    334348 
     349      IF( (.not. wrk_use(1,1)) .OR. (.not. wrk_use(2,1)) .OR. & 
     350          (.not. wrk_use(3,1)))THEN 
     351         CALL ctl_stop('dtacof: ERROR: requested workspace arrays unavailable') 
     352         RETURN 
     353      END IF 
    335354      !                                   ! ==================== 
    336355      !                                   !  ORCA configuration : global domain 
    … …  
    525544      ENDIF 
    526545      ! 
     546      IF( (.not. wrk_release(1,1)) .OR. (.not. wrk_release(2,1)) .OR. & 
     547          (.not. wrk_release(3,1)) )THEN 
     548         CALL ctl_stop('dtacof: ERROR: failed to release workspace arrays') 
     549      END IF 
     550      ! 
    527551   END SUBROUTINE dtacof 
    528552 
    … …  
    549573      !!---------------------------------------------------------------------- 
    550574      USE ioipsl      ! IOipsl librairy 
     575      USE wrk_nemo, ONLY: wrk_use, wrk_release, llwrk_use, llwrk_release 
     576      USE wrk_nemo, ONLY: zxc => wrk_1d_1, zyc => wrk_1d_2, & 
     577                          zzc => wrk_1d_3, zdis => wrk_1d_4 
     578      USE wrk_nemo, ONLY: llcotu => llwrk_2d_1, llcotv => llwrk_2d_2, & 
     579                          llcotf => llwrk_2d_3 
     580      USE wrk_nemo, ONLY: zxt => wrk_2d_1, zyt => wrk_2d_2, & 
     581                          zzt => wrk_2d_3, zmask => wrk_2d_4 
    551582      !! 
    552583      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline 
    … …  
    556587      INTEGER ::   icoast, itime 
    557588      INTEGER ::   icot         ! logical unit for file distance to the coast 
    558       LOGICAL, DIMENSION(jpi,jpj) ::   llcotu, llcotv, llcotf   ! ??? 
     589 
    559590      CHARACTER (len=32) ::   clname 
    560591      REAL(wp) ::   zdate0 
    561       REAL(wp), DIMENSION(jpi,jpj)   ::   zxt, zyt, zzt, zmask   ! cartesian coordinates for T-points 
    562       REAL(wp), DIMENSION(3*jpi*jpj) ::   zxc, zyc, zzc, zdis    ! temporary workspace 
    563       !!---------------------------------------------------------------------- 
     592      !!---------------------------------------------------------------------- 
     593 
     594      IF( (.not. llwrk_use(2,1,2,3)) .OR. (.not. wrk_use(2, 1,2,3,4)) .OR. & 
     595          (.not. wrk_use(1, 1,2,3,4)) )THEN 
     596         CALL ctl_stop('cofdis: ERROR: requested workspace arrays unavailable') 
     597         RETURN 
     598      END IF 
    564599 
    565600      ! 0. Initialization 
    … …  
    713748      CALL restclo( icot ) 
    714749      ! 
     750      IF( (.not. llwrk_release(2, 1,2,3)) .OR. & 
     751          (.not. wrk_release(2, 1,2,3,4)) .OR. &  
     752          (.not. wrk_release(1, 1,2,3,4)) )THEN 
     753         CALL ctl_stop('cofdis: ERROR: failed to release workspace arrays') 
     754      END IF 
     755      ! 
    715756   END SUBROUTINE cofdis 
    716757 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r2528 r2590  
    3535   PUBLIC   tra_ldf         ! called by step.F90  
    3636   PUBLIC   tra_ldf_init    ! called by opa.F90  
     37   PUBLIC   tra_ldf_alloc   ! called by nemogcm.F90 
    3738   ! 
    3839   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    3940#if defined key_traldf_ano 
    40    REAL, DIMENSION(jpi,jpj,jpk) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S for a constant profile 
     41   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S for a constant profile 
    4142#endif 
    4243 
    … …  
    5051   !!---------------------------------------------------------------------- 
    5152CONTAINS 
     53 
     54   FUNCTION tra_ldf_alloc() 
     55      IMPLICIT none 
     56      INTEGER :: tra_ldf_alloc 
     57 
     58      tra_ldf_alloc = 0 
     59 
     60#if defined key_traldf_ano 
     61      ALLOCATE(t0_ldf(jpi,jpj,jpk), s0_ldf(jpi,jpj,jpk), Stat=tra_ldf_alloc) 
     62#endif 
     63 
     64      IF(tra_ldf_alloc /= 0)THEN 
     65         CALL ctl_warn('tra_ldf_alloc: failed to allocate arrays t0_ldf and s0_ldf.') 
     66      END IF 
     67 
     68   END FUNCTION tra_ldf_alloc 
    5269 
    5370   SUBROUTINE tra_ldf( kt ) 
    … …  
    238255      !! ** Purpose :   initializations of  
    239256      !!---------------------------------------------------------------------- 
     257      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     258      USE wrk_nemo, ONLY: zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3  
     259      USE wrk_nemo, ONLY: zs_ref => wrk_3d_4, zsb => wrk_3d_5 ! 3D workspaces 
     260      !!  
    240261      USE zdf_oce         ! vertical mixing 
    241262      USE trazdf          ! vertical mixing: double diffusion 
    … …  
    245266      LOGICAL  ::   llsave          ! 
    246267      REAL(wp) ::   zt0, zs0, z12   ! temporary scalar 
    247       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zt_ref, ztb, zavt   ! 3D workspace 
    248       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zs_ref, zsb         ! 3D workspace 
    249       !!---------------------------------------------------------------------- 
     268      !!---------------------------------------------------------------------- 
     269 
     270      IF(.NOT. wrk_use(3, 1,2,3,4,5))THEN 
     271         CALL ctl_stop('ldf_ano : requested workspace arrays unavailable.') 
     272         RETURN 
     273      END IF 
    250274 
    251275      IF(lwp) THEN 
    … …  
    309333      avt(:,:,:)        = zavt(:,:,:) 
    310334      ! 
     335      IF(.NOT. wrk_release(3, 1,2,3,4,5))THEN 
     336         CALL ctl_stop('ldf_ano : failed to release workspace arrays.') 
     337      END IF 
     338      ! 
    311339   END SUBROUTINE ldf_ano 
    312340 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r2528 r2590  
    7575      USE oce         , ztu => ua   ! use ua as workspace 
    7676      USE oce         , ztv => va   ! use va as workspace 
     77      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     78      USE wrk_nemo, ONLY: zeeu => wrk_2d_1, zeev => wrk_2d_2, zlt => wrk_2d_3 
    7779      !! 
    7880      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    8587      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    8688      REAL(wp) ::  zbtr, ztra       ! local scalars 
    87       REAL(wp), DIMENSION(jpi,jpj) ::   zeeu, zeev, zlt   ! 2D workspace 
    8889      !!---------------------------------------------------------------------- 
     90 
     91      IF(.NOT. wrk_use(2, 1,2,3))THEN 
     92         CALL ctl_stop('tra_ldf_bilap: requested workspace arrays unavailable.') 
     93         RETURN 
     94      END IF 
    8995 
    9096      IF( kt == nit000 )  THEN 
    … …  
    160166      END DO                                              ! tracer loop 
    161167      !                                                   ! =========== 
     168      IF(.NOT. wrk_release(2, 1,2,3))THEN 
     169         CALL ctl_stop('tra_ldf_bilap: failed to release workspace arrays.') 
     170      END IF 
     171      ! 
    162172   END SUBROUTINE tra_ldf_bilap 
    163173 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r2528 r2590  
    6565      !!               biharmonic mixing trend. 
    6666      !!---------------------------------------------------------------------- 
     67      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     68      USE wrk_nemo, ONLY: wk1 => wrk_4d_1, wk2 => wrk_4d_2 
    6769      INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index 
    6870      CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    7274      !! 
    7375      INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) ::   wk1, wk2   ! 4D workspace 
    75       !!---------------------------------------------------------------------- 
     76      !!---------------------------------------------------------------------- 
     77 
     78      IF(.NOT. wrk_use(4, 1,2))THEN 
     79         CALL ctl_stop('tra_ldf_bilapg : requested workspace arrays unavailable.') 
     80         RETURN 
     81      END IF 
    7682 
    7783      IF( kt == nit000 )  THEN 
    … …  
    107113         END DO 
    108114      END DO 
     115      ! 
     116      IF(.NOT. wrk_release(4, 1,2))THEN 
     117         CALL ctl_stop('tra_ldf_bilapg : failed to release workspace arrays.') 
     118      END IF 
    109119      ! 
    110120   END SUBROUTINE tra_ldf_bilapg 
    … …  
    150160      !!---------------------------------------------------------------------- 
    151161      USE oce         , zftv => ua     ! use ua as workspace 
     162      USE wrk_nemo, ONLY: wrk_use, wrk_release, wrk_use_xz, wrk_release_xz 
     163      USE wrk_nemo, ONLY: zftu => wrk_2d_1,  zdkt => wrk_2d_2, zdk1t => wrk_2d_3 
     164      USE wrk_nemo, ONLY: zftw => wrk_xz_1, zdit => wrk_xz_2, & 
     165                          zdjt => wrk_xz_3, zdj1t => wrk_xz_4 
    152166      !! 
    153167      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index 
    … …  
    166180      REAL(wp) ::  zbtr, ztah, ztav 
    167181      REAL(wp) ::  zcof0, zcof1, zcof2, zcof3, zcof4 
    168       REAL(wp), DIMENSION(jpi,jpj) ::  zftu,  zdkt, zdk1t       ! workspace 
    169       REAL(wp), DIMENSION(jpi,jpk) ::  zftw, zdit, zdjt, zdj1t  !  
    170       !!---------------------------------------------------------------------- 
    171  
     182      !!---------------------------------------------------------------------- 
     183 
     184      IF( (.NOT. wrk_use(2, 1,2,3)) .OR. (.NOT. wrk_use_xz(1,2,3,4)) )THEN 
     185         CALL ctl_stop('ldfght : requested workspace arrays unavailable.') 
     186         RETURN 
     187      END IF 
    172188      ! 
    173189      DO jn = 1, kjpt 
    … …  
    321337      END DO 
    322338      ! 
     339      IF( (.NOT. wrk_release(2, 1,2,3)) .OR. (.NOT. wrk_release_xz(1,2,3,4)) )THEN 
     340         CALL ctl_stop('ldfght : failed to release workspace arrays.') 
     341      END IF 
     342      ! 
    323343   END SUBROUTINE ldfght 
    324344 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r2528 r2590  
    9292      USE oce         , zftu => ua   ! use ua as workspace 
    9393      USE oce         , zftv => va   ! use va as workspace 
     94      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     95      USE wrk_nemo, ONLY: zdkt => wrk_2d_1, zdk1t => wrk_2d_2   ! 2D workspace 
     96      USE wrk_nemo, ONLY: zdit => wrk_3d_1, zdjt => wrk_3d_2, ztfw => wrk_3d_3   ! 3D workspace 
     97      USE wrk_nemo, ONLY: z2d => wrk_2d_3   ! 2D workspace - used if key_diaar5 
    9498      !! 
    9599      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    105109      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    106110      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    107       REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t         ! 2D workspace 
    108       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw    ! 3D workspace 
    109111#if defined key_diaar5 
    110       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                 ! 2D workspace 
    111112      REAL(wp)                         ::   zztmp               ! local scalar 
    112113#endif 
    113114      !!---------------------------------------------------------------------- 
     115 
     116      IF( (.NOT. wrk_use(3, 1,2,3)) .OR. & 
     117          (.NOT. wrk_use(2, 1,2,3)) )THEN 
     118          CALL ctl_stop('tra_ldf_iso : requested workspace array unavailable.') 
     119          RETURN 
     120      END IF 
    114121 
    115122      IF( kt == nit000 )  THEN 
    … …  
    288295      END DO 
    289296      ! 
     297      IF( (.NOT. wrk_release(3, 1,2,3)) .OR.  & 
     298          (.NOT. wrk_release(2, 1,2,3)) )THEN 
     299          CALL ctl_stop('tra_ldf_iso : failed to release workspace arrays.') 
     300      END IF 
     301      ! 
    290302   END SUBROUTINE tra_ldf_iso 
    291303 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r2528 r2590  
    9292      USE oce,   zftu => ua   ! use ua as workspace 
    9393      USE oce,   zftv => va   ! use va as workspace 
     94      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     95      USE wrk_nemo, ONLY: zdit => wrk_3d_1, zdjt => wrk_3d_2, ztfw => wrk_3d_3 
     96      USE wrk_nemo, ONLY: wrk_3d_4 ! For 2D+1 workspace 
     97      USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! Only used if key_diaar5 defined 
    9498      !! 
    9599      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    107111      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    108112      REAL(wp) ::  zcoef0, zbtr                  !   -      - 
    109       REAL(wp), DIMENSION(jpi,jpj,0:1) ::   zdkt               ! 2D+1 workspace 
    110       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw   ! 3D workspace 
     113      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdkt           ! 2D+1 workspace 
    111114      ! 
    112115      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv 
    … …  
    114117      REAL(wp) ::   zah, zah_slp, zaei_slp 
    115118#if defined key_diaar5 
    116       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                ! 2D workspace 
    117119      REAL(wp)                         ::   zztmp              ! local scalar 
    118120#endif 
    119121      !!---------------------------------------------------------------------- 
     122 
     123      ! Check that workspace arrays are free for use and set-up pointer into 
     124      ! sub-array of a 3D workspace 
     125      IF( (.NOT. wrk_use(3, 1,2,3,4)) .OR. (.NOT. wrk_use(2, 1)))THEN 
     126         CALL ctl_stop('tra_ldf_iso_grif : requested workspace arrays unavailable.') 
     127         RETURN 
     128      END IF 
     129      zdkt(1:jpi,1:jpj,0:1) => wrk_3d_4(:,:,1:2) 
    120130 
    121131      IF( kt == nit000 )  THEN 
    … …  
    342352      END DO 
    343353      ! 
     354      IF( (.NOT. wrk_release(3, 1,2,3,4)) .OR. (.NOT. wrk_release(2, 1)))THEN 
     355         CALL ctl_stop('tra_ldf_iso_grif : failed to release workspace arrays.') 
     356      END IF 
     357      ! 
    344358  END SUBROUTINE tra_ldf_iso_grif 
    345359 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2528 r2590  
    2828   PRIVATE 
    2929 
    30    PUBLIC   tra_ldf_lap   ! routine called by step.F90 
     30   PUBLIC   tra_ldf_lap       ! routine called by step.F90 
     31   PUBLIC   tra_ldf_lap_alloc ! routine called by nemogcm.F90 
    3132 
    32    REAL(wp), DIMENSION(jpi,jpj) ::   e1ur, e2vr   ! scale factor coefficients 
     33   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients 
    3334 
    3435   !! * Substitutions 
    … …  
    4243   !!---------------------------------------------------------------------- 
    4344CONTAINS 
     45 
     46   FUNCTION tra_ldf_lap_alloc() 
     47      !!---------------------------------------------------------------------- 
     48      !!                ***  ROUTINE tra_ldf_lap_alloc  *** 
     49      !!---------------------------------------------------------------------- 
     50      IMPLICIT none 
     51      INTEGER :: tra_ldf_lap_alloc 
     52      !!---------------------------------------------------------------------- 
     53 
     54      ALLOCATE(e1ur(jpi,jpj), e2vr(jpi,jpj), Stat=tra_ldf_lap_alloc) 
     55 
     56      IF( tra_ldf_lap_alloc /= 0)THEN 
     57         CALL ctl_warn('tra_ldf_lap_alloc: failed to allocate e1ur and e2vr arrays.') 
     58      END IF 
     59 
     60   END FUNCTION tra_ldf_lap_alloc 
    4461 
    4562   SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,      & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r2528 r2590  
    2626   PRIVATE 
    2727 
    28    PUBLIC   tra_npc    ! routine called by step.F90 
     28   PUBLIC   tra_npc       ! routine called by step.F90 
    2929 
    3030   !! * Substitutions 
    … …  
    5555      !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    5656      !!---------------------------------------------------------------------- 
     57      USE wrk_nemo, ONLY: wrk_use, wrk_release, wrk_use_xz, wrk_release_xz 
     58      USE wrk_nemo, ONLY: ztrdt => wrk_3d_1, ztrds => wrk_3d_2, zrhop => wrk_3d_3 
     59      USE wrk_nemo, ONLY: zwx => wrk_xz_1, zwy => wrk_xz_2, zwz => wrk_xz_3 
     60      !! 
    5761      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5862      !! 
    … …  
    6367      INTEGER  ::   ikbot, ik, ikup, ikdown   ! ??? 
    6468      REAL(wp) ::   ze3tot, zta, zsa, zraua, ze3dwn 
    65       REAL(wp), DIMENSION(jpi,jpk)     ::   zwx, zwy, zwz   ! 2D arrays 
    66       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhop           ! 3D arrays 
    67       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds 
    6869      !!---------------------------------------------------------------------- 
     70 
     71      ! Strictly 1 and 2 3D workspaces only needed if(l_trdtra) but it doesn't  
     72      ! cost us anything and makes code simpler. 
     73      IF( (.NOT. wrk_use(3, 1,2,3)) .OR. (.NOT. wrk_use_xz(1,2,3)) )THEN 
     74         CALL ctl_stop('tra_npc: requested workspace arrays unavailable.') 
     75         RETURN 
     76      END IF 
    6977 
    7078      IF( MOD( kt, nn_npc ) == 0 ) THEN 
    … …  
    7684 
    7785         IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    78             ALLOCATE( ztrdt(jpi,jpj,jpk) )  ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    79             ALLOCATE( ztrds(jpi,jpj,jpk) )  ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     86            ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
     87            ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    8088         ENDIF 
    8189 
    … …  
    192200            CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt ) 
    193201            CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds ) 
    194             DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )  
    195202         ENDIF 
    196203       
    … …  
    210217      ENDIF 
    211218      ! 
     219      IF( (.NOT. wrk_release(3, 1,2,3))  .OR. (.NOT. wrk_release_xz(1,2,3)))THEN 
     220         CALL ctl_stop('tra_npc: failed to release workspace arrays.') 
     221      END IF 
     222      ! 
    212223   END SUBROUTINE tra_npc 
    213224 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2528 r2590  
    5555   PUBLIC   tra_nxt_fix   ! to be used in trcnxt 
    5656   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt 
     57   PUBLIC   tra_nxt_alloc ! used in nemogcm.F90 
    5758 
    5859   REAL(wp)                 ::   rbcp            ! Brown & Campana parameters for semi-implicit hpg 
    59    REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 
     60   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 
    6061 
    6162   !! * Substitutions 
    … …  
    6768   !!---------------------------------------------------------------------- 
    6869CONTAINS 
     70 
     71   FUNCTION tra_nxt_alloc() 
     72      !!---------------------------------------------------------------------- 
     73      !!                ***  ROUTINE tran_xt_alloc  *** 
     74      !!---------------------------------------------------------------------- 
     75      IMPLICIT none 
     76      INTEGER tra_nxt_alloc 
     77      !!---------------------------------------------------------------------- 
     78 
     79      ALLOCATE(r2dt(jpk), Stat=tra_nxt_alloc) 
     80 
     81      IF(tra_nxt_alloc /= 0)THEN 
     82         CALL ctl_warn('tra_nxt_alloc: failed to allocate array r2dt.') 
     83      END IF 
     84 
     85   END FUNCTION tra_nxt_alloc 
    6986 
    7087   SUBROUTINE tra_nxt( kt ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r2528 r2590  
    9090      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 
    9191      !!---------------------------------------------------------------------- 
     92      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     93      USE wrk_nemo, ONLY: zekb => wrk_2d_1, zekg => wrk_2d_2, zekr => wrk_2d_3 
     94      USE wrk_nemo, ONLY: ze0 => wrk_3d_1, ze1 => wrk_3d_2, ze2 => wrk_3d_3 
     95      USE wrk_nemo, ONLY: ze3 => wrk_3d_4, zea => wrk_3d_5 
    9296      !! 
    9397      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    … …  
    99103      REAL(wp) ::   zz0, zz1             !    -         - 
    100104      REAL(wp) ::   z1_e3t, zfact        !    -         - 
    101       REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace 
    102       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace 
    103105      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt 
    104106      !!---------------------------------------------------------------------- 
     107 
     108      IF( (.NOT. wrk_use(3, 1,2,3,4,5)) .OR. (.NOT. wrk_use(2, 1,2,3)) )THEN 
     109         CALL ctl_stop('tra_qsr : requested workspace arrays unavailable.') 
     110         RETURN 
     111      END IF 
    105112 
    106113      IF( kt == nit000 ) THEN 
    … …  
    283290      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    284291      ! 
     292      IF( (.NOT. wrk_release(3, 1,2,3,4,5)) .OR. & 
     293          (.NOT. wrk_release(2, 1,2,3)) )THEN 
     294         CALL ctl_stop('tra_qsr : failed to release workspace arrays.') 
     295      END IF 
     296      ! 
    285297   END SUBROUTINE tra_qsr 
    286298 
    … …  
    303315      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    304316      !!---------------------------------------------------------------------- 
     317      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     318      USE wrk_nemo, ONLY: zekb => wrk_2d_1, zekg => wrk_2d_2, zekr => wrk_2d_3 
     319      USE wrk_nemo, ONLY: ze0 => wrk_3d_1, ze1 => wrk_3d_2, ze2 => wrk_3d_3 
     320      USE wrk_nemo, ONLY: ze3 => wrk_3d_4, zea => wrk_3d_5 
     321      !! 
    305322      INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    306323      INTEGER  ::   irgb, ierror          ! temporary integer 
    … …  
    309326      REAL(wp) ::   zc2  , zc3  , zchl    !    -         - 
    310327      REAL(wp) ::   zz0  , zz1            !    -         - 
    311       REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr              ! 2D workspace 
    312       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0 , ze1 , ze2 , ze3 , zea   ! 3D workspace 
    313328      !! 
    314329      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files 
    … …  
    317332         &                  nn_chldta, rn_abs, rn_si0, rn_si1 
    318333      !!---------------------------------------------------------------------- 
     334 
     335      IF( (.NOT. wrk_use(2, 1,2,3)) .OR. (.NOT. wrk_use(3, 1,2,3,4,5)) )THEN 
     336         CALL ctl_stop('tra_qsr_init: requested workspace arrays unavailable.') 
     337         RETURN 
     338      END IF 
    319339 
    320340      cn_dir = './'       ! directory in which the model is executed 
    … …  
    490510      ENDIF 
    491511      ! 
     512      IF( (.NOT. wrk_release(2, 1,2,3)) .OR.   & 
     513          (.NOT. wrk_release(3, 1,2,3,4,5)) )THEN 
     514         CALL ctl_stop('tra_qsr_init: failed to release workspace arrays.') 
     515      END IF 
     516      ! 
    492517   END SUBROUTINE tra_qsr_init 
    493518 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r2528 r2590  
    3636   PUBLIC tra_zdf      !  routine called by step.F90 
    3737   PUBLIC tra_zdf_init !  routine called by opa.F90 
     38   PUBLIC tra_zdf_alloc!  routine called by nemogcm.F90 
    3839 
    3940   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    4041      !                                ! defined from ln_zdf...  namlist logicals) 
    41    REAL(wp), DIMENSION(jpk) ::   r2dt ! vertical profile time-step, = 2 rdttra 
    42       !                                ! except at nit000 (=rdttra) if neuler=0 
     42   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 
     43      !                                              ! except at nit000 (=rdttra) if neuler=0 
    4344 
    4445   !! * Substitutions 
    … …  
    5354 
    5455CONTAINS 
    55     
     56 
     57   FUNCTION tra_zdf_alloc() 
     58      !!----------------------------------------------------------------------  
     59      !!                ***  ROUTINE tra_zdf_alloc  *** 
     60      !!----------------------------------------------------------------------  
     61      IMPLICIT none 
     62      INTEGER :: tra_zdf_alloc 
     63      !!---------------------------------------------------------------------- 
     64 
     65      ALLOCATE(r2dt(jpk), Stat=tra_zdf_alloc) 
     66 
     67      IF(tra_zdf_alloc /= 0)THEN 
     68         CALL ctl_warn('tra_zdf_alloc: failed to allocate r2dt array') 
     69      END IF 
     70 
     71   END FUNCTION tra_zdf_alloc 
     72 
    5673   SUBROUTINE tra_zdf( kt ) 
    5774      !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r2528 r2590  
    7373      !! ** Action : - after tracer fields pta 
    7474      !!--------------------------------------------------------------------- 
     75      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     76      USE wrk_nemo, ONLY: zwx => wrk_3d_1, zwy => wrk_3d_2     ! 3D workspace 
     77      !! 
    7578      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index 
    7679      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator) 
    … …  
    8487      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars 
    8588      REAL(wp) ::  ztra, ze3tb               !   -      - 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy   ! 3D workspace 
    8789      !!--------------------------------------------------------------------- 
     90 
     91      IF(.NOT. wrk_use(3, 1,2))THEN 
     92         CALL ctl_stop('tra_zdf_exp : requested workspace arrays unavailable.') 
     93         RETURN 
     94      END IF 
    8895 
    8996      IF( kt == nit000 )  THEN 
    … …  
    158165      END DO 
    159166      ! 
     167      IF(.NOT. wrk_release(3, 1,2))THEN 
     168         CALL ctl_stop('tra_zdf_exp : failed to release workspace arrays.') 
     169      END IF 
     170      ! 
    160171   END SUBROUTINE tra_zdf_exp 
    161172 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r2528 r2590  
    9191      USE oce    , ONLY :   zwd   => ua   ! ua used as workspace 
    9292      USE oce    , ONLY :   zws   => va   ! va  -          - 
     93      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     94      USE wrk_nemo, ONLY: zwi => wrk_3d_1, zwt => wrk_3d_2  ! workspace arrays 
    9395      !!  
    9496      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
    … …  
    102104      REAL(wp) ::  zavi, zrhs, znvvl     ! local scalars 
    103105      REAL(wp) ::  ze3tb, ze3tn, ze3ta   ! variable vertical scale factors 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi, zwt   ! workspace arrays 
    105106      !!--------------------------------------------------------------------- 
     107 
     108      IF(.NOT. wrk_use(3, 1,2))THEN 
     109         CALL ctl_stop('tra_zdf_imp : requested workspace arrays unavailable.') 
     110         RETURN 
     111      END IF 
    106112 
    107113      IF( kt == nit000 )  THEN 
    … …  
    302308      END DO 
    303309      ! 
     310      IF(.NOT. wrk_release(3, 1,2))THEN 
     311         CALL ctl_stop('tra_zdf_imp : failed to release workspace arrays.') 
     312      END IF 
     313      ! 
    304314   END SUBROUTINE tra_zdf_imp 
    305315 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r2569 r2590  
    8080      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points  
    8181      !!---------------------------------------------------------------------- 
     82      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     83      USE wrk_nemo, ONLY: zri => wrk_2d_1, zrj => wrk_2d_2   ! interpolated value of rd 
     84      USE wrk_nemo, ONLY: zhi => wrk_2d_3, zhj => wrk_2d_4   ! depth of interpolation for eos2d 
     85      USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     86      !! 
    8287      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    8388      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    … …  
    8994      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    9095      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points 
    91       REAL(wp), DIMENSION(jpi,jpj,kjpt) ::   zti, ztj     ! interpolated value of tracer 
    92       REAL(wp), DIMENSION(jpi,jpj)      ::   zri, zrj     ! interpolated value of rd 
    93       REAL(wp), DIMENSION(jpi,jpj)      ::   zhi, zhj     ! depth of interpolation for eos2d 
     96      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zti, ztj    ! interpolated value of tracer 
    9497      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
    9598      !!---------------------------------------------------------------------- 
     99 
     100      IF( (.NOT. wrk_use(2, 1,2,3,4)) .OR. (.NOT. wrk_use(3, 1,2)) )THEN 
     101         CALL ctl_stop('zps_hde: requested workspace arrays unavailable.') 
     102         RETURN 
     103      ELSE IF(kjpt > jpk)THEN 
     104         CALL ctl_stop('zps_hde: no. of tracers > jpk so cannot use 3D workspace arrays from wrk_nemo module.') 
     105         RETURN 
     106      END IF 
     107      ! Set-up pointers to sub-arrays of workspaces 
     108      zti => wrk_3d_1(:,:,1:kjpt) 
     109      ztj => wrk_3d_2(:,:,1:kjpt) 
    96110 
    97111      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    … …  
    200214      END IF 
    201215      ! 
     216      IF( (.NOT. wrk_release(2, 1,2,3,4)) .OR. (.NOT. wrk_release(3, 1,2)) )THEN 
     217         CALL ctl_stop('zps_hde: failed to release workspace arrays.') 
     218      END IF 
     219      ! 
    202220   END SUBROUTINE zps_hde 
    203221 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90

    r2528 r2590  
    344344      !! ** Purpose :  write dynamic trends in ocean.output  
    345345      !!---------------------------------------------------------------------- 
     346      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     347      USE wrk_nemo, ONLY: zkepe => wrk_3d_1, zkx => wrk_3d_2, & 
     348                          zky => wrk_3d_3, zkz => wrk_3d_4 
    346349      INTEGER, INTENT(in) ::   kt                                  ! ocean time-step index 
    347350      !! 
    348351      INTEGER  ::   ji, jj, jk 
    349352      REAL(wp) ::   ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth   !    "      scalars 
    350       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zkepe, zkx, zky, zkz   ! temporary arrays 
    351       !!---------------------------------------------------------------------- 
     353      !!---------------------------------------------------------------------- 
     354 
     355      IF(.NOT. wrk_use(3, 1,2,3,4))THEN 
     356         CALL ctl_stop('trd_dwr : requested workspace arrays unavailable.') 
     357         RETURN 
     358      END IF 
    352359 
    353360      ! I. Momentum trends 
    … …  
    542549         ! 
    543550      ENDIF 
     551      ! 
     552      IF(.NOT. wrk_release(3, 1,2,3,4))THEN 
     553         CALL ctl_stop('trd_dwr : failed to release workspace arrays.') 
     554      END IF 
    544555      ! 
    545556   END SUBROUTINE trd_dwr 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r2528 r2590  
    4444   PUBLIC   trd_mld_init   ! routine called by opa.F90 
    4545   PUBLIC   trd_mld_zint   ! routine called by tracers routines 
     46   PUBLIC   trd_mld_alloc  ! routine called by nemogcm.F90 
    4647 
    4748   CHARACTER (LEN=40) ::  clhstnam         ! name of the trends NetCDF file 
    4849   INTEGER ::   nh_t, nmoymltrd 
    49    INTEGER ::   nidtrd, ndextrd1(jpi*jpj) 
     50   INTEGER ::   nidtrd 
     51   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1 
    5052   INTEGER ::   ndimtrd1                         
    5153   INTEGER ::   ionce, icount                    
    … …  
    6264 
    6365CONTAINS 
     66 
     67   FUNCTION trd_mld_alloc() 
     68      !!---------------------------------------------------------------------- 
     69      !!                  ***  ROUTINE trd_mld_alloc  *** 
     70      !!---------------------------------------------------------------------- 
     71      IMPLICIT none 
     72      INTEGER :: trd_mld_alloc 
     73      !!---------------------------------------------------------------------- 
     74 
     75      ALLOCATE(ndextrd1(jpi*jpj), Stat=trd_mld_alloc) 
     76 
     77      IF(trd_mld_alloc /= 0)THEN 
     78         CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 
     79      END IF 
     80 
     81   END FUNCTION trd_mld_alloc 
    6482 
    6583   SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) 
    … …  
    8199      !!            surface and the control surface is called "mixed-layer" 
    82100      !!---------------------------------------------------------------------- 
     101      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     102      USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 
     103      !! 
    83104      INTEGER, INTENT( in ) ::   ktrd                             ! ocean trend index 
    84105      CHARACTER(len=2), INTENT( in ) :: ctype                     ! surface/bottom (2D arrays) or 
    … …  
    87108      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  pstrdmld ! salinity trend  
    88109      INTEGER ::   ji, jj, jk, isum 
    89       REAL(wp), DIMENSION(jpi,jpj) ::  zvlmsk 
    90       !!---------------------------------------------------------------------- 
     110      !!---------------------------------------------------------------------- 
     111 
     112      IF(.NOT. wrk_use(2, 1))THEN 
     113         CALL ctl_stop('trd_mld_zint : requested workspace arrays unavailable.') 
     114         RETURN 
     115      END IF 
    91116 
    92117      ! I. Definition of control surface and associated fields 
    … …  
    176201         smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,1) * wkx(:,:,1)             
    177202      END SELECT 
     203      ! 
     204      IF(.NOT. wrk_release(2, 1))THEN 
     205         CALL ctl_stop('trd_mld_zint : failed to release workspace arrays.') 
     206      END IF 
    178207      ! 
    179208   END SUBROUTINE trd_mld_zint 
    … …  
    227256      !!       - See NEMO documentation (in preparation) 
    228257      !!---------------------------------------------------------------------- 
     258      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     259      USE wrk_nemo, ONLY: ztmltot => wrk_2d_1,  zsmltot => wrk_2d_2 ! dT/dt over the anlysis window (including Asselin) 
     260      USE wrk_nemo, ONLY: ztmlres => wrk_2d_3,  zsmlres => wrk_2d_4 ! residual = dh/dt entrainment term 
     261      USE wrk_nemo, ONLY: ztmlatf => wrk_2d_5,  zsmlatf => wrk_2d_6 ! needed for storage only 
     262      USE wrk_nemo, ONLY: ztmltot2 => wrk_2d_7, ztmlres2 => wrk_2d_8, ztmltrdm2 => wrk_2d_9    ! \  working arrays to diagnose the trends 
     263      USE wrk_nemo, ONLY: zsmltot2 => wrk_2d_10, zsmlres2 => wrk_2d_11, zsmltrdm2 => wrk_2d_12 !  > associated with the time meaned ML T & S 
     264      USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14                         ! / 
     265      !! 
    229266      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    230267      !! 
    … …  
    232269      LOGICAL :: lldebug = .TRUE. 
    233270      REAL(wp) :: zavt, zfn, zfn2 
    234       REAL(wp) ,DIMENSION(jpi,jpj) ::     & 
    235            ztmltot,  zsmltot,             & ! dT/dt over the anlysis window (including Asselin) 
    236            ztmlres,  zsmlres,             & ! residual = dh/dt entrainment term 
    237            ztmlatf,  zsmlatf,             & ! needed for storage only 
    238            ztmltot2, ztmlres2, ztmltrdm2, & ! \  working arrays to diagnose the trends 
    239            zsmltot2, zsmlres2, zsmltrdm2, & !  > associated with the time meaned ML T & S 
    240            ztmlatf2, zsmlatf2               ! / 
    241       REAL(wp), DIMENSION(jpi,jpj,jpltrd) ::  & 
     271      REAL(wp), POINTER, DIMENSION(:,:,:) ::  & 
    242272           ztmltrd2, zsmltrd2               ! only needed for mean diagnostics 
    243273#if defined key_dimgout 
    … …  
    247277      !!---------------------------------------------------------------------- 
    248278       
     279      ! Check that the workspace arrays are all OK to be used 
     280      IF( (.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)) .OR. & 
     281          (.NOT. wrk_use(3, 1,2)) )THEN 
     282         CALL ctl_stop('trd_mld : requested workspace arrays unavailable.') 
     283         RETURN 
     284      ELSE IF(jpltrd > jpk) 
     285         ! ARPDBG, is this reasonable or will this cause trouble in the future? 
     286         CALL ctl_stop('trd_mld : no. of mixed-layer trends (jpltrd) exceeds no. of model levels so cannot use 3D workspaces.') 
     287         RETURN          
     288      END IF 
     289      ! Set-up pointers into sub-arrays of 3d-workspaces 
     290      ztmltrd2 => wrk_3d_1(:,:,1:jpltrd) 
     291      zsmltrd2 => wrk_3d_2(:,:,1:jpltrd) 
    249292 
    250293      ! ====================================================================== 
    … …  
    707750      IF( lrst_oce )   CALL trd_mld_rst_write( kt )  
    708751 
     752      IF( (.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)) .OR. & 
     753          (.NOT. wrk_release(3, 1,2)) )THEN 
     754         CALL ctl_stop('trd_mld : failed to release workspace arrays.') 
     755      END IF 
     756 
    709757   END SUBROUTINE trd_mld 
    710758 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90

    r2528 r2590  
    1111   PRIVATE 
    1212 
     13   ! Routine accessibility 
     14   PUBLIC trdmld_oce_alloc    ! Called in nemogcm.F90 
     15 
    1316#if defined key_trdmld 
    1417   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .TRUE.    !: ML trend flag 
    … …  
    1821   !!* mixed layer trends indices 
    1922   INTEGER, PARAMETER, PUBLIC ::   jpltrd = 11    !: number of mixed-layer trends arrays 
    20    INTEGER, PUBLIC   &  
    21 #if !defined key_agrif 
    22       , PARAMETER  & 
    23 #endif 
    24 ::   jpktrd = jpk   !: max level for mixed-layer trends diag. 
     23   INTEGER, PUBLIC            ::   jpktrd         !: max level for mixed-layer trends diag. 
    2524   ! 
    2625   INTEGER, PUBLIC, PARAMETER ::   jpmld_xad =  1   !:  zonal       
    … …  
    4645   CHARACTER(LEN=80) , PUBLIC :: clname, ctrd(jpltrd+1,2) 
    4746 
    48    INTEGER , PUBLIC, DIMENSION(jpi,jpj)     ::   nmld   !: mixed layer depth indexes  
    49    INTEGER , PUBLIC, DIMENSION(jpi,jpj)     ::   nbol   !: mixed-layer depth indexes when read from file 
     47   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   nmld   !: mixed layer depth indexes  
     48   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   nbol   !: mixed-layer depth indexes when read from file 
    5049 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   wkx    !: 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wkx    !: 
    5251 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  & 
    5453      rmld   ,                      & !: mld depth (m) corresponding to nmld 
    5554      tml    , sml  ,               & !: \ "now" mixed layer temperature/salinity 
    … …  
    6665      rmld_sum, rmldbn                !: needed to compute the leap-frog time mean of the ML depth 
    6766 
    68    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
     67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  & 
    6968      tmlatfb, tmlatfn ,            & !: "before" Asselin contribution at begining of the averaging 
    7069      smlatfb, smlatfn,             & !: period (i.e. last contrib. from previous such period) and  
    … …  
    7271      tmlatfm, smlatfm                !: accumulator for Asselin trends (needed for storage only) 
    7372 
    74    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpltrd) ::  & 
     73   REAL(wp), PUBLIC, DIMENSION(:,:,:) ::  & 
    7574      tmltrd,                       & !: \ physical contributions to the total trend (for T/S), 
    7675      smltrd,                       & !: / cumulated over the current analysis window 
    … …  
    8786   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    8887   !!====================================================================== 
     88CONTAINS 
     89 
     90  FUNCTION trdmld_oce_alloc() 
     91     !!---------------------------------------------------------------------- 
     92     !!---------------------------------------------------------------------- 
     93     USE in_out_manager, ONLY: ctl_warn 
     94     IMPLICIT none 
     95     INTEGER :: trdmld_oce_alloc 
     96     INTEGER :: ierr(5) 
     97     !!---------------------------------------------------------------------- 
     98 
     99     ! Initialise jpktrd here as can no longer do it in MODULE body since 
     100     ! jpk is now a variable. 
     101     jpktrd = jpk   !: max level for mixed-layer trends diag. 
     102 
     103     ierr(:) = 0 
     104 
     105#if   defined  key_trdmld   ||   defined key_esopa 
     106     ALLOCATE(nmld(jpi,jpj), nbol(jpi,jpj),       & 
     107              wkx(jpi,jpj,jpk), rmld(jpi,jpj),    &  
     108              tml(jpi,jpj)    , sml(jpi,jpj),     &  
     109              tmlb(jpi,jpj)   , smlb(jpi,jpj) ,   & 
     110              tmlbb(jpi,jpj)  , smlbb(jpi,jpj),   & 
     111              Stat = ierr(1)) 
     112 
     113     ALLOCATE(tmlbn(jpi,jpj)  , smlbn(jpi,jpj),   & 
     114              tmltrdm(jpi,jpj), smltrdm(jpi,jpj), & 
     115              tml_sum(jpi,jpj), tml_sumb(jpi,jpj),& 
     116              tmltrd_atf_sumb(jpi,jpj), Stat=ierr(2)) 
     117 
     118     ALLOCATE(sml_sum(jpi,jpj), sml_sumb(jpi,jpj), & 
     119              smltrd_atf_sumb(jpi,jpj),            & 
     120              rmld_sum(jpi,jpj), rmldbn(jpi,jpj),  & 
     121              tmlatfb(jpi,jpj), tmlatfn(jpi,jpj),  &  
     122              Stat = ierr(3)) 
     123 
     124     ALLOCATE(smlatfb(jpi,jpj), smlatfn(jpi,jpj), &  
     125              tmlatfm(jpi,jpj), smlatfm(jpi,jpj), & 
     126              tmltrd(jpi,jpj,jpltrd),   smltrd(jpi,jpj,jpltrd), & 
     127              Stat=ierr(4)) 
     128 
     129     ALLOCATE(tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd),      & 
     130              tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd),     & 
     131              smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), & 
     132              Stat=ierr(5)) 
     133#endif 
     134 
     135     trdmld_oce_alloc = MAXVAL(ierr) 
     136 
     137    IF(trdmld_oce_alloc /= 0)THEN 
     138       CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 
     139    END IF 
     140 
     141  END FUNCTION trdmld_oce_alloc 
     142 
    89143END MODULE trdmld_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r2528 r2590  
    5151      !!              integral constraints 
    5252      !!---------------------------------------------------------------------- 
     53      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     54      USE wrk_nemo, ONLY: ztswu => wrk_2d_1,  & 
     55                          ztswv => wrk_2d_2,  & 
     56                          ztbfu => wrk_2d_3,  & 
     57                          ztbfv => wrk_2d_4,  & 
     58                          z2dx  => wrk_2d_5,  & 
     59                          z2dy  => wrk_2d_6 
     60      IMPLICIT none 
    5361      INTEGER, INTENT( in ) ::   kt                                ! time step 
    5462      INTEGER, INTENT( in ) ::   ktrd                              ! tracer trend index 
    5563      CHARACTER(len=3), INTENT( in ) ::   ctype                    ! momentum or tracers trends type 'DYN'/'TRA' 
    56       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdx ! Temperature or U trend  
    57       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   ptrdy ! Salinity    or V trend 
     64      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   ptrdx ! Temperature or U trend  
     65      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   ptrdy ! Salinity    or V trend 
    5866      !! 
    5967      INTEGER ::   ji, jj 
    60       REAL(wp), DIMENSION(jpi,jpj) ::   ztswu, ztswv               ! 2D workspace 
    61       REAL(wp), DIMENSION(jpi,jpj) ::   ztbfu, ztbfv               ! 2D workspace 
    62       REAL(wp), DIMENSION(jpi,jpj) ::   z2dx, z2dy                 ! workspace arrays 
    63       !!---------------------------------------------------------------------- 
     68      !!---------------------------------------------------------------------- 
     69 
     70      IF(.not. wrk_use(2, 1,2,3,4,5,6))THEN 
     71         CALL ctl_error('trd_mod: Requested workspace arrays already in use.') 
     72         RETURN 
     73      END IF 
    6474 
    6575      z2dx(:,:)   = 0.e0   ;   z2dy(:,:)   = 0.e0                  ! initialization of workspace arrays 
    … …  
    218228      ENDIF 
    219229      ! 
     230      IF(.not. wrk_release(2, 1,2,3,4,5,6))THEN 
     231         CALL ctl_error('trd_mod: Failed to release workspace arrays.') 
     232      END IF 
     233      ! 
    220234   END SUBROUTINE trd_mod 
    221235 
    … …  
    231245CONTAINS 
    232246   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt )   ! Empty routine 
    233       REAL    ::   ptrd3dx(:,:,:), ptrd3dy(:,:,:) 
    234       INTEGER ::   ktrd, kt                             
     247      REAL(wp) ::   ptrd3dx(:,:,:), ptrd3dy(:,:,:) 
     248      INTEGER  ::   ktrd, kt                             
    235249      CHARACTER(len=3) ::  ctype                   
    236250      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r2528 r2590  
    2121 
    2222   PUBLIC trd_tra          ! called by all  traXX modules 
     23   PUBLIC trd_tra_alloc    ! called by nemogcm.F90 
    2324  
    2425   !! * Module declaration 
    25    REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: trdtx, trdty, trdt  !: 
     26   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !: 
    2627 
    2728   !! * Substitutions 
    … …  
    3536 
    3637CONTAINS 
     38 
     39   FUNCTION trd_tra_alloc() 
     40      !!---------------------------------------------------------------------------- 
     41      !!                  ***  ROUTINE trd_tra_alloc  *** 
     42      !!---------------------------------------------------------------------------- 
     43      IMPLICIT none 
     44      INTEGER trd_tra_alloc 
     45      !!---------------------------------------------------------------------------- 
     46 
     47      ALLOCATE(trdtx(jpi,jpj,jpk), trdty(jpi,jpj,jpk), trdt(jpi,jpj,jpk), & 
     48               Stat=trd_tra_alloc) 
     49 
     50      IF(trd_tra_alloc /= 0)THEN 
     51         CALL ctl_warn('trd_tra_alloc: failed to allocate arrays.') 
     52      END IF 
     53 
     54    END FUNCTION trd_tra_alloc 
    3755 
    3856   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra ) 
    … …  
    5068      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls 
    5169      !!---------------------------------------------------------------------- 
     70      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     71      USE wrk_nemo, ONLY: ztrds => wrk_3d_1 
    5272      INTEGER                         , INTENT(in)           ::  kt      ! time step 
    5373      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC' 
    … …  
    5777      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity  
    5878      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable  
    59       !! 
    60       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztrds    !   
    61       !!---------------------------------------------------------------------- 
     79      !!---------------------------------------------------------------------- 
     80 
     81      IF(.NOT. wrk_use(3, 1))THEN 
     82         CALL ctl_stop('trd_tra: requested workspace array unavailable.') 
     83         RETURN 
     84      END IF 
    6285 
    6386      ! Control of optional arguments 
    … …  
    118141      ENDIF 
    119142      ! 
     143      IF(.NOT. wrk_release(3, 1))THEN 
     144         CALL ctl_stop('trd_tra: failed to release workspace array.') 
     145      END IF 
     146      ! 
    120147   END SUBROUTINE trd_tra 
    121148 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90

    r2528 r2590  
    3737   PUBLIC   trd_vor_zint   ! routine called by dynamics routines 
    3838   PUBLIC   trd_vor_init   ! routine called by opa.F90 
    39  
    40    INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndexvor1(jpi*jpj), ndimvor1, icount   ! needs for IOIPSL output 
     39   PUBLIC   trd_vor_alloc  ! routine called by nemogcm.F90 
     40 
     41   INTEGER ::   nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount   ! needs for IOIPSL output 
     42   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndexvor1 ! needed for IOIPSL output 
    4143   INTEGER ::   ndebug     ! (0/1) set it to 1 in case of problem to have more print 
    4244 
    43    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avr      ! average 
    44    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrb     ! before vorticity (kt-1) 
    45    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period 
    46    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrbn    ! after vorticity at time step after the 
    47    REAL(wp), DIMENSION(jpi,jpj) ::   rotot        ! begining of the NWRITE-1 timesteps 
    48    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrtot   ! 
    49    REAL(wp), DIMENSION(jpi,jpj) ::   vor_avrres   ! 
    50  
    51    REAL(wp), DIMENSION(jpi,jpj,jpltot_vor) ::   vortrd  ! curl of trends 
     45   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avr      ! average 
     46   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrb     ! before vorticity (kt-1) 
     47   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrbb    ! vorticity at begining of the nwrite-1 timestep averaging period 
     48   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrbn    ! after vorticity at time step after the 
     49   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   rotot        ! begining of the NWRITE-1 timesteps 
     50   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrtot   ! 
     51   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,  :) ::   vor_avrres   ! 
     52 
     53   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   vortrd  ! curl of trends 
    5254          
    5355   CHARACTER(len=12) ::   cvort 
    … …  
    6365   !!---------------------------------------------------------------------- 
    6466CONTAINS 
     67 
     68   FUNCTION trd_vor_alloc() 
     69      !!---------------------------------------------------------------------------- 
     70      !!                  ***  ROUTINE trd_vor_alloc  *** 
     71      !!---------------------------------------------------------------------------- 
     72      IMPLICIT none 
     73      INTEGER trd_vor_alloc 
     74      !!---------------------------------------------------------------------------- 
     75 
     76      ALLOCATE(vor_avr(jpi,jpj),    vor_avrb(jpi,jpj), vor_avrbb(jpi,jpj),  & 
     77               vor_avrbn(jpi,jpj),  rotot(jpi,jpj),    vor_avrtot(jpi,jpj), & 
     78               vor_avrres(jpi,jpj), vortrd(jpi,jpj,jpltot_vor),             & 
     79               ndexvor1(jpi*jpj),   Stat=trd_vor_alloc) 
     80 
     81      IF(trd_vor_alloc /= 0)THEN 
     82         CALL ctl_warn('trd_vor_alloc: failed to allocate arrays') 
     83      END IF 
     84 
     85   END FUNCTION trd_vor_alloc 
    6586 
    6687   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd ) 
    … …  
    91112      !!      trends output in netCDF format using ioipsl 
    92113      !!---------------------------------------------------------------------- 
     114      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     115      USE wrk_nemo, ONLY: zudpvor => wrk_2d_1, &   ! total cmulative trends 
     116                          zvdpvor => wrk_2d_2 
     117      !! 
    93118      INTEGER                     , INTENT(in   ) ::   ktrd       ! ocean trend index 
    94119      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    … …  
    97122      INTEGER ::   ji, jj       ! dummy loop indices 
    98123      INTEGER ::   ikbu, ikbv   ! local integers 
    99       REAL(wp), DIMENSION(jpi,jpj) ::   zudpvor, zvdpvor   ! total cmulative trends 
    100       !!---------------------------------------------------------------------- 
     124      !!---------------------------------------------------------------------- 
     125 
     126      IF(.NOT. wrk_use(2, 1,2))THEN 
     127         CALL ctl_stop('trd_vor_zint_2d : requested workspace arrays unavailable.') 
     128         RETURN 
     129      END IF 
    101130 
    102131      ! Initialization 
    … …  
    147176      ENDIF 
    148177      ! 
     178      IF(.NOT. wrk_release(2, 1,2))THEN 
     179         CALL ctl_stop('trd_vor_zint_2d : failed to release workspace arrays.') 
     180      END IF 
     181      ! 
    149182   END SUBROUTINE trd_vor_zint_2d 
    150183 
    … …  
    177210      !!      trends output in netCDF format using ioipsl 
    178211      !!---------------------------------------------------------------------- 
     212      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     213      USE wrk_nemo, ONLY: zubet   => wrk_2d_1,   zvbet => wrk_2d_2   ! Beta.V  
     214      USE wrk_nemo, ONLY: zudpvor => wrk_2d_3, zvdpvor => wrk_2d_4   ! total cmulative trends 
     215      !! 
    179216      INTEGER                         , INTENT(in   ) ::   ktrd       ! ocean trend index 
    180217      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   putrdvor   ! u vorticity trend  
    … …  
    182219      !! 
    183220      INTEGER ::   ji, jj, jk 
    184       REAL(wp), DIMENSION(jpi,jpj) ::   zubet  , zvbet     ! Beta.V  
    185       REAL(wp), DIMENSION(jpi,jpj) ::   zudpvor, zvdpvor   ! total cmulative trends 
    186221      !!---------------------------------------------------------------------- 
    187222      
     223      IF(.NOT. wrk_use(2, 1,2,3,4))THEN 
     224         CALL ctl_stop('trd_vor_zint_3d : requested workspace arrays unavailable.') 
     225         RETURN 
     226      END IF 
     227 
    188228      ! Initialization 
    189229      zubet  (:,:) = 0._wp 
    … …  
    248288      ENDIF 
    249289      ! 
     290      IF(.NOT. wrk_release(2, 1,2,3,4))THEN 
     291         CALL ctl_stop('trd_vor_zint_3d : failed to release workspace arrays.') 
     292      END IF 
     293      ! 
    250294   END SUBROUTINE trd_vor_zint_3d 
    251295 
    … …  
    258302      !!               and make outputs (NetCDF or DIMG format) 
    259303      !!---------------------------------------------------------------------- 
     304      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     305      USE wrk_nemo, ONLY: zun => wrk_2d_1, zvn => wrk_2d_2 ! 2D workspace 
     306      !! 
    260307      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    261308      !! 
    … …  
    263310      INTEGER  ::   it, itmod        ! local integers 
    264311      REAL(wp) ::   zmean            ! local scalars 
    265       REAL(wp), DIMENSION(jpi,jpj) ::   zun, zvn   ! 2D workspace 
    266       !!---------------------------------------------------------------------- 
     312      !!---------------------------------------------------------------------- 
     313 
     314      IF(.NOT. wrk_use(2, 1,2))THEN 
     315         CALL ctl_stop('trd_vor : requested workspace arrays unavailable.') 
     316         RETURN 
     317      END IF 
    267318 
    268319      !  ================= 
    … …  
    431482      IF( kt == nitend )   CALL histclo( nidvor ) 
    432483      ! 
     484      IF(.NOT. wrk_release(2, 1,2))THEN 
     485         CALL ctl_stop('trd_vor : failed to release workspace arrays.') 
     486      END IF 
     487      ! 
    433488   END SUBROUTINE trd_vor 
    434489 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r2528 r2590  
    1111   IMPLICIT NONE 
    1212   PRIVATE 
     13 
     14   ! Routine accessibility 
     15   PUBLIC  zdf_oce_alloc    ! Called in nemogcm.F90 
    1316 
    1417#if defined key_zdfcst   ||   defined key_esopa 
    … …  
    3336 
    3437 
    35    REAL(wp), PUBLIC, DIMENSION        (jpk) ::   avmb , avtb    !: background profile of avm and avt 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)    ::   avtb_2d        !: set in tke_init, for other modif than ice 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)    ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr 
    38    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts        [m2/s] 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt  [m2/s] 
     38   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(    :) ::   avmb , avtb    !: background profile of avm and avt 
     39   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(  :,:) ::   avtb_2d        !: set in tke_init, for other modif than ice 
     40   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(  :,:) ::   bfrua, bfrva   !: Bottom friction coefficients set in zdfbfr 
     41   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avmu , avmv    !: vertical viscosity coef at uw- & vw-pts        [m2/s] 
     42   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avm  , avt     !: vertical viscosity & diffusivity coef at w-pt  [m2/s] 
    4043  
    4144   !!---------------------------------------------------------------------- 
    … …  
    4447   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4548   !!====================================================================== 
     49CONTAINS 
     50 
     51   FUNCTION zdf_oce_alloc() 
     52      !!---------------------------------------------------------------------- 
     53      !!            *** Routine zdf_oce_alloc *** 
     54      !!---------------------------------------------------------------------- 
     55      USE in_out_manager, ONLY: ctl_warn 
     56      IMPLICIT none 
     57      INTEGER zdf_oce_alloc 
     58      !!---------------------------------------------------------------------- 
     59 
     60      ALLOCATE(avmb(jpk), avtb(jpk), avtb_2d(jpi,jpj), & 
     61               bfrua(jpi,jpj), bfrva(jpi,jpj),         & 
     62               avmu(jpi,jpj,jpk), avmv(jpi,jpj,jpk),   & 
     63               avm(jpi,jpj,jpk), avt(jpi,jpj,jpk),     & 
     64               Stat = zdf_oce_alloc ) 
     65 
     66      IF(zdf_oce_alloc /= 0)THEN 
     67         CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays.') 
     68      END IF 
     69 
     70   END FUNCTION zdf_oce_alloc 
     71 
    4672END MODULE zdf_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r2528 r2590  
    2828   PUBLIC   zdf_bfr         ! called by step.F90 
    2929   PUBLIC   zdf_bfr_init    ! called by opa.F90 
    30     
     30   PUBLIC   zdf_bfr_alloc   ! called by nemogcm.F90 
     31 
    3132   !                                    !!* Namelist nambfr: bottom friction namelist * 
    3233   INTEGER  ::   nn_bfr    = 0           ! = 0/1/2/3 type of bottom friction  
    … …  
    3738   LOGICAL  ::   ln_bfr2d  = .false.     ! logical switch for 2D enhancement 
    3839    
    39    REAL(wp), DIMENSION(jpi,jpj) ::   bfrcoef2d = 1.e-3_wp   ! 2D bottom drag coefficient 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  bfrcoef2d   ! 2D bottom drag coefficient 
     41                                                               ! Now initialised in zdf_bfr_alloc() 
    4042 
    4143   !! * Substitutions 
    … …  
    4850   !!---------------------------------------------------------------------- 
    4951CONTAINS 
     52 
     53   FUNCTION zdf_bfr_alloc() 
     54      !!---------------------------------------------------------------------- 
     55      !!                ***  ROUTINE zdf_bfr_alloc  *** 
     56      !!---------------------------------------------------------------------- 
     57      IMPLICIT none 
     58      INTEGER :: zdf_bfr_alloc 
     59      !!---------------------------------------------------------------------- 
     60 
     61      ALLOCATE(bfrcoef2d(jpi,jpj), Stat=zdf_bfr_alloc) 
     62 
     63      IF(zdf_bfr_alloc == 0)THEN 
     64         bfrcoef2d(:,:) = 1.e-3_wp 
     65      ELSE 
     66         CALL ctl_warn('zdf_bfr_alloc: allocation of array bfrcoef2d failed.') 
     67      END IF 
     68 
     69   END FUNCTION zdf_bfr_alloc 
     70 
    5071 
    5172   SUBROUTINE zdf_bfr( kt ) 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r2528 r2590  
    2727   PUBLIC   zdf_ddm       ! called by step.F90 
    2828   PUBLIC   zdf_ddm_init  ! called by opa.F90 
     29   PUBLIC   zdf_ddm_alloc ! called by nemogcm.F90 
    2930 
    3031   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag 
    3132 
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   avs    !: salinity vertical diffusivity coeff. at w-point 
    33    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rrau   !: heat/salt buoyancy flux ratio 
     33   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs    !: salinity vertical diffusivity coeff. at w-point 
     34   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   rrau   !: heat/salt buoyancy flux ratio 
    3435 
    3536   !                                  !!* Namelist namzdf_ddm : double diffusive mixing * 
    … …  
    4647 
    4748CONTAINS 
     49 
     50   FUNCTION zdf_ddm_alloc() 
     51      !!---------------------------------------------------------------------- 
     52      !!                ***  ROUTINE zdf_ddm_alloc  *** 
     53      !!---------------------------------------------------------------------- 
     54      IMPLICIT none 
     55      INTEGER zdf_ddm_alloc 
     56      !!---------------------------------------------------------------------- 
     57 
     58      ALLOCATE( avs(jpi,jpj,jpk), rrau(jpi,jpj,jpk), Stat = zdf_ddm_alloc) 
     59 
     60      IF(zdf_ddm_alloc /= 0)THEN 
     61         CALL ctl_warn('zdf_ddm_alloc: failed to allocate avs and rrau arrays.') 
     62      END IF 
     63 
     64   END FUNCTION zdf_ddm_alloc 
    4865 
    4966   SUBROUTINE zdf_ddm( kt ) 
    … …  
    7996      !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999. 
    8097      !!---------------------------------------------------------------------- 
     98      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     99      USE wrk_nemo, ONLY: zmsks  => wrk_2d_1,  & 
     100                          zmskf  => wrk_2d_2,  & 
     101                          zmskd1 => wrk_2d_3,  & 
     102                          zmskd2 => wrk_2d_4,  & 
     103                          zmskd3 => wrk_2d_5 
     104      IMPLICIT none 
    81105      INTEGER, INTENT(in) ::   kt   ! ocean time-step indexocean time step 
    82106      !! 
    … …  
    85109      REAL(wp) ::   zavft, zavfs    !    -         - 
    86110      REAL(wp) ::   zavdt, zavds    !    -         - 
    87       REAL(wp), DIMENSION(jpi,jpj) ::   zmsks, zmskf, zmskd1, zmskd2, zmskd3   ! 2D workspace  
    88       !!---------------------------------------------------------------------- 
     111      !!---------------------------------------------------------------------- 
     112 
     113      IF(.not. wrk_use(2, 1,2,3,4,5))THEN 
     114         CALL ctl_stop('zdf_ddm: Requested workspace arrays already in use.') 
     115         RETURN 
     116      END IF 
    89117 
    90118      !                                                ! =============== 
    … …  
    166194      !                                                   ! =============== 
    167195      ! 
    168       CALL lbc_lnk( avt , 'W', 1. )        ! Lateral boundary conditions   (unchanged sign) 
    169       CALL lbc_lnk( avs , 'W', 1. ) 
    170       CALL lbc_lnk( avm , 'W', 1. ) 
    171       CALL lbc_lnk( avmu, 'U', 1. )  
    172       CALL lbc_lnk( avmv, 'V', 1. ) 
     196      CALL lbc_lnk( avt , 'W', 1.0_wp )     ! Lateral boundary conditions   (unchanged sign) 
     197      CALL lbc_lnk( avs , 'W', 1.0_wp ) 
     198      CALL lbc_lnk( avm , 'W', 1.0_wp ) 
     199      CALL lbc_lnk( avmu, 'U', 1.0_wp )  
     200      CALL lbc_lnk( avmv, 'V', 1.0_wp ) 
    173201 
    174202      IF(ln_ctl) THEN 
    … …  
    177205            &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk) 
    178206      ENDIF 
     207      ! 
     208      IF(.not. wrk_release(2, 1,2,3,4,5))THEN 
     209         CALL ctl_stop('zdf_ddm: Release of workspace arrays failed.') 
     210      END IF 
    179211      ! 
    180212   END SUBROUTINE zdf_ddm 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r2528 r2590  
    3535   PUBLIC   zdf_gls_init   ! routine called in opa module 
    3636   PUBLIC   gls_rst        ! routine called in step module 
    37  
    38    LOGICAL , PUBLIC, PARAMETER              ::   lk_zdfgls = .TRUE.  !: TKE vertical mixing flag 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   en                  !: now turbulent kinetic energy 
    40    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mxln                !: now mixing length 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   zwall               !: wall function 
    42    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ustars2             !: Squared surface velocity scale at T-points 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ustarb2             !: Squared bottom  velocity scale at T-points 
     37   PUBLIC   zdf_gls_alloc  ! routine called in nemogcm module 
     38 
     39   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdfgls = .TRUE.   !: TKE vertical mixing flag 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en      !: now turbulent kinetic energy 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points 
    4445 
    4546   !                                         !!! ** Namelist  namzdf_gls  ** 
    … …  
    110111CONTAINS 
    111112 
     113   FUNCTION zdf_gls_alloc() 
     114      !!---------------------------------------------------------------------- 
     115      !!                ***  ROUTINE zdf_gls_alloc  *** 
     116      !!---------------------------------------------------------------------- 
     117      IMPLICIT none 
     118      INTEGER :: zdf_gls_alloc 
     119      !!---------------------------------------------------------------------- 
     120 
     121      ALLOCATE(en(jpi,jpj,jpk),  mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk), & 
     122               ustars2(jpi,jpj), ustarb2(jpi,jpj),                      & 
     123               Stat=zdf_gls_alloc) 
     124 
     125      IF(zdf_gls_alloc /= 0)THEN 
     126         CALL ctl_warn('zdf_gls_alloc: failed to allocate arrays.') 
     127      END IF 
     128 
     129   END FUNCTION zdf_gls_alloc 
     130 
     131 
    112132   SUBROUTINE zdf_gls( kt ) 
    113133      !!---------------------------------------------------------------------- 
    … …  
    121141      USE oce,     z_elem_c  =>   ta   ! use ta as workspace 
    122142      USE oce,     psi       =>   sa   ! use sa as workspace 
     143      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     144      USE wrk_nemo, ONLY: zdep  => wrk_2d_1 
     145      USE wrk_nemo, ONLY: zflxs => wrk_2d_2     ! Turbulence fluxed induced by internal waves  
     146      USE wrk_nemo, ONLY: zhsro => wrk_2d_3     ! Surface roughness (surface waves) 
     147      USE wrk_nemo, ONLY: eb        => wrk_3d_1   ! tke at time before 
     148      USE wrk_nemo, ONLY: mxlb      => wrk_3d_2   ! mixing length at time before 
     149      USE wrk_nemo, ONLY: shear     => wrk_3d_3   ! vertical shear 
     150      USE wrk_nemo, ONLY: eps       => wrk_3d_4   ! dissipation rate 
     151      USE wrk_nemo, ONLY: zwall_psi => wrk_3d_5   ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T) 
    123152      ! 
    124153      INTEGER, INTENT(in) ::   kt ! ocean time step 
    … …  
    129158      REAL(wp) ::   prod, buoy, diss, zdiss, sm         !   -      - 
    130159      REAL(wp) ::   gh, gm, shr, dif, zsqen, zav        !   -      - 
    131       REAL(wp), DIMENSION(jpi,jpj)     ::   zdep        ! 
    132       REAL(wp), DIMENSION(jpi,jpj)     ::   zflxs       ! Turbulence fluxed induced by internal waves  
    133       REAL(wp), DIMENSION(jpi,jpj)     ::   zhsro       ! Surface roughness (surface waves) 
    134       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eb          ! tke at time before 
    135       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   mxlb        ! mixing length at time before 
    136       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   shear       ! vertical shear 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   eps         ! dissipation rate 
    138       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwall_psi   ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T) 
    139160      !!-------------------------------------------------------------------- 
     161 
     162      IF( (.NOT. wrk_use(2, 1,2,3)) .OR. (.NOT. wrk_use(3, 1,2,3,4,5)) )THEN 
     163         CALL ctl_stop('zdf_gls: requested workspace arrays unavailable.') 
     164         RETURN 
     165      END IF 
    140166 
    141167      ! Preliminary computing 
    … …  
    864890      ENDIF 
    865891      ! 
     892      IF( (.NOT. wrk_release(2, 1,2,3)) .OR. & 
     893          (.NOT. wrk_release(3, 1,2,3,4,5)) )THEN 
     894         CALL ctl_stop('zdf_gls: failed to release workspace arrays.') 
     895      END IF 
     896      ! 
    866897   END SUBROUTINE zdf_gls 
    867898 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r2528 r2590  
    4242   PUBLIC   trc_kpp       ! routine called by trcstp.F90 
    4343#endif 
     44   PUBLIC   zdf_kpp_alloc ! routine called by nemogcm.F90 
    4445 
    4546   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag 
    4647 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o) 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   wt0      !: surface temperature flux for non local flux 
    49    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ws0      !: surface salinity flux for non local flux 
    50    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   hkpp     !: boundary layer depht 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o) 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wt0      !: surface temperature flux for non local flux 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ws0      !: surface salinity flux for non local flux 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hkpp     !: boundary layer depth 
    5152 
    5253   !                                        !!* Namelist namzdf_kpp * 
    … …  
    99100 
    100101#if ! defined key_kppcustom 
    101    REAL(wp), DIMENSION(jpk,jpk) ::   del     ! array for reference mean values of vertical integration  
     102   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   del     ! array for reference mean values of vertical integration  
    102103#endif 
    103104 
    … …  
    119120   REAL(wp) ::   deustar                 ! delta ustar in lookup table 
    120121#endif 
    121    REAL(wp), DIMENSION(jpk) ::   ratt   ! attenuation coef  (already defines in module traqsr,  
     122   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   ratt   ! attenuation coef  (already defines in module traqsr,  
    122123   !                                    ! but only if the solar radiation penetration is considered) 
    123124    
    … …  
    128129      !                           ! (default values: water type Ib)  
    129130 
    130    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points 
     131   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points 
    131132         
    132133  
    133134#if defined key_c1d 
    134    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rig    !: gradient Richardson number 
    135    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rib    !: bulk Richardson number 
    136    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   buof   !: buoyancy forcing 
    137    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mols   !: moning-Obukhov length scale  
    138    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ekdp   !: Ekman depth 
     135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number 
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rib    !: bulk Richardson number 
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   buof   !: buoyancy forcing 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mols   !: moning-Obukhov length scale  
     139   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ekdp   !: Ekman depth 
    139140#endif 
    140141 
    … …  
    152153 
    153154CONTAINS 
     155 
     156   FUNCTION zdf_kpp_alloc() 
     157      IMPLICIT none 
     158      INTEGER :: zdf_kpp_alloc 
     159 
     160      ALLOCATE(ghats(jpi,jpj,jpk), wt0(jpi,jpj), ws0(jpi,jpj), hkpp(jpi,jpj), & 
     161#if ! defined key_kpplktb 
     162               del(jpk,jpk),                                                  & 
     163#endif 
     164               ratt(jpk),                                                     & 
     165               etmean(jpi,jpj,jpk), eumean(jpi,jpj,jpk), evmean(jpi,jpj,jpk), & 
     166#if defined key_c1d 
     167               rig(jpi,jpj,jpk),  rib(jpi,jpj,jpk), buof(jpi,jpj,jpk),        & 
     168               mols(jpi,jpj,jpk), ekdp(jpi,jpj),                              & 
     169#endif 
     170               Stat=zdf_kpp_alloc) 
     171 
     172      IF(zdf_kpp_alloc /= 0)THEN 
     173         CALL ctl_warn('zdf_kpp_alloc: failed to allocate arrays.') 
     174      END IF 
     175 
     176   END FUNCTION zdf_kpp_alloc 
     177 
    154178 
    155179   SUBROUTINE zdf_kpp( kt ) 
    … …  
    196220      USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace 
    197221#endif 
     222      USE wrk_nemo, ONLY: wrk_use, wrk_release, wrk_use_xz, wrk_release_xz 
     223      USE wrk_nemo, ONLY: zBo    => wrk_2d_1, &  ! Surface buoyancy forcing, 
     224                          zBosol => wrk_2d_2, &  ! friction velocity 
     225                          zustar => wrk_2d_3 
     226      USE wrk_nemo, ONLY: zmask  => wrk_2d_4 
     227      USE wrk_nemo, ONLY: wrk_2d_5, wrk_2d_6, wrk_2d_7, wrk_2d_8, wrk_2d_9, & 
     228                          wrk_2d_10,wrk_2d_11 
     229      USE wrk_nemo, ONLY: wrk_1d_1,  wrk_1d_2,  wrk_1d_3,  wrk_1d_4,  & 
     230                          wrk_1d_5,  wrk_1d_6,  wrk_1d_7,  wrk_1d_8,  & 
     231                          wrk_1d_9,  wrk_1d_10, wrk_1d_11, wrk_1d_12, & 
     232                          wrk_1d_13, wrk_1d_14 
     233      USE wrk_nemo, ONLY: zblcm => wrk_xz_1, &   ! Boundary layer  
     234                          zblct => wrk_xz_2      !  diffusivities/viscosities 
     235#if defined key_zdfddm 
     236      USE wrk_nemo, ONLY: zblcs => wrk_xz_3 
     237#endif 
    198238      !! 
    199239      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    … …  
    202242      INTEGER ::   ikbot, jkmax, jkm1, jkp2   ! 
    203243 
    204       REAL(wp), DIMENSION(jpi,jpj) ::   zBo, zBosol, zustar         ! Surface buoyancy forcing, friction velocity 
    205244      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube     ! 
    206245      REAL(wp) ::   zrhos, zalbet, zbeta, zthermal, zhalin, zatt1   ! 
    … …  
    221260      REAL(wp) ::   zflag, ztemp, zrn2, zdep21, zdep32, zdep43 
    222261      REAL(wp) ::   zdku2, zdkv2, ze3sqr, zsh2, zri, zfri          ! Interior richardson mixing 
    223       REAL(wp), DIMENSION(jpi,0:2) ::   zmoek                      ! Moning-Obukov limitation 
    224       REAL(wp), DIMENSION(jpi)     ::   zmoa, zekman                 
    225       REAL(wp)                     ::   zmob, zek 
    226       REAL(wp), DIMENSION(jpi,4)   ::   zdepw, zdift, zvisc   ! The pipe  
    227       REAL(wp), DIMENSION(jpi,3)   ::   zdept 
    228       REAL(wp), DIMENSION(jpi,2)   ::   zriblk 
    229       REAL(wp), DIMENSION(jpi,jpk) ::   zmask                           
    230       REAL(wp), DIMENSION(jpi)     ::   zhmax, zria, zhbl  
     262      REAL(wp), POINTER, DIMENSION(:,:) ::   zmoek                 ! Moning-Obukov limitation 
     263      REAL(wp), POINTER, DIMENSION(:)   ::   zmoa, zekman                 
     264      REAL(wp)                          ::   zmob, zek 
     265      REAL(wp), POINTER, DIMENSION(:,:) ::   zdepw, zdift, zvisc   ! The pipe  
     266      REAL(wp), POINTER, DIMENSION(:,:) ::   zdept 
     267      REAL(wp), POINTER, DIMENSION(:,:) ::   zriblk 
     268      REAL(wp), POINTER, DIMENSION(:)   ::   zhmax, zria, zhbl  
    231269      REAL(wp) ::   zflagri, zflagek, zflagmo, zflagh, zflagkb   ! 
    232       REAL(wp), DIMENSION(jpi)     ::   za2m, za3m, zkmpm, za2t, za3t, zkmpt   ! Shape function (G) 
     270      REAL(wp), POINTER, DIMENSION(:)   ::   za2m, za3m, zkmpm, za2t, za3t, zkmpt   ! Shape function (G) 
    233271      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 
    234       REAL(wp), DIMENSION(jpi,jpk) ::   zblcm, zblct   ! Boundary layer diffusivities/viscosities 
    235272#if defined key_zdfddm 
    236273      REAL(wp) ::   zrrau, zds, zavdds, zavddt,zinr   ! double diffusion mixing 
    237       REAL(wp), DIMENSION(jpi,4) ::     zdifs 
    238       REAL(wp), DIMENSION(jpi)     ::   za2s, za3s, zkmps 
     274      REAL(wp), POINTER, DIMENSION(:,:) ::     zdifs 
     275      REAL(wp), POINTER, DIMENSION(:)   ::   za2s, za3s, zkmps 
    239276      REAL(wp) ::                       zkm1s 
    240       REAL(wp), DIMENSION(jpi,jpk) ::   zblcs                      
    241277#endif 
    242278      !!-------------------------------------------------------------------- 
    243279      
     280      IF( (.NOT. wrk_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)) .OR. & 
     281          (.NOT. wrk_use(2, 1,2,3,4,5,6,7,8,9,10,11))          .OR. & 
     282          (.NOT. wrk_use_xz(1,2,3)) )THEN 
     283         CALL ctl_stop('zdf_kpp : requested workspace arrays unavailable.') 
     284         RETURN 
     285      END IF 
     286      ! Set-up pointers to 2D spaces 
     287      zmoek(1:jpi,0:2) => wrk_2d_5(1:jpi,1:3) 
     288      zdepw => wrk_2d_6(:,1:4) 
     289      zdift => wrk_2d_7(:,1:4) 
     290      zvisc => wrk_2d_8(:,1:4) 
     291      zdept => wrk_2d_9(:,1:3) 
     292      zriblk => wrk_2d_10(:,1:2) 
     293      ! 1D spaces 
     294      zmoa   => wrk_1d_1(1:jpi) 
     295      zekman => wrk_1d_2(1:jpi) 
     296      zhmax  => wrk_1d_3(1:jpi) 
     297      zria   => wrk_1d_4(1:jpi) 
     298      zhbl   => wrk_1d_5(1:jpi) 
     299      za2m   => wrk_1d_6(1:jpi) 
     300      za3m   => wrk_1d_7(1:jpi) 
     301      zkmpm  => wrk_1d_8(1:jpi) 
     302      za2t   => wrk_1d_9(1:jpi) 
     303      za3t   => wrk_1d_10(1:jpi) 
     304      zkmpt  => wrk_1d_11(1:jpi) 
     305#if defined key_zdfddm 
     306      zdifs => wrk_2d_11(:,1:4) 
     307      za2s  => wrk_1d_12(1:jpi) 
     308      za3s  => wrk_1d_13(1:jpi) 
     309      zkmps => wrk_1d_14(1:jpi) 
     310#endif 
     311 
    244312      zviscos(:,:,:) = 0. 
    245313      zblcm  (:,:  ) = 0.  
    … …  
    11711239         ENDIF 
    11721240 
     1241      IF( (.NOT. wrk_release(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14)) .OR. & 
     1242          (.NOT. wrk_release(2, 1,2,3,4,5,6,7,8,9,10,11))          .OR. & 
     1243          (.NOT. wrk_release_xz(1,2,3)) )THEN 
     1244         CALL ctl_stop('zdf_kpp : failed to release workspace arrays.') 
     1245         RETURN 
     1246      END IF 
     1247 
    11731248   END SUBROUTINE zdf_kpp 
    11741249 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r2528 r2590  
    1919   PRIVATE 
    2020 
    21    PUBLIC   zdf_mxl    ! called by step.F90 
     21   PUBLIC   zdf_mxl       ! called by step.F90 
     22   PUBLIC   zdf_mxl_alloc ! called by nemogcm.F90 
    2223 
    23    INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   nmln    !: number of level in the mixed layer (used by TOP) 
    24    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hmld    !: mixing layer depth (turbocline)      [m] 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m] 
    26    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hmlpt   !: mixed layer depth at t-points        [m] 
     24   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   nmln    !: number of level in the mixed layer (used by TOP) 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmld    !: mixing layer depth (turbocline)      [m] 
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlp    !: mixed layer depth  (rho=rho0+zdcrit) [m] 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hmlpt   !: mixed layer depth at t-points        [m] 
    2728 
    2829   !! * Substitutions 
    … …  
    3536 
    3637CONTAINS 
     38 
     39   FUNCTION zdf_mxl_alloc() 
     40      !!---------------------------------------------------------------------- 
     41      !!               ***  ROUTINE zdf_mxl_alloc  *** 
     42      !!---------------------------------------------------------------------- 
     43      IMPLICIT none 
     44      INTEGER :: zdf_mxl_alloc 
     45      !!---------------------------------------------------------------------- 
     46 
     47      ALLOCATE(nmln(jpi,jpj), hmld(jpi,jpj), hmlp(jpi,jpj), hmlpt(jpi,jpj), & 
     48               Stat=zdf_mxl_alloc) 
     49 
     50      IF(zdf_mxl_alloc /= 0)THEN 
     51         CALL ctl_warn('zdf_mxl_alloc: failed to allocate arrays.') 
     52      END IF 
     53 
     54   END FUNCTION zdf_mxl_alloc 
     55 
    3756 
    3857   SUBROUTINE zdf_mxl( kt ) 
    … …  
    5372      !! ** Action  :   nmln, hmld, hmlp, hmlpt 
    5473      !!---------------------------------------------------------------------- 
     74      USE wrk_nemo, ONLY: iwrk_use, iwrk_release 
     75      USE wrk_nemo, ONLY: imld => iwrk_2d_1 ! temporary workspace 
     76      !! 
    5577      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5678      !! 
    5779      INTEGER                     ::   ji, jj, jk          ! dummy loop indices 
    5880      INTEGER                     ::   iikn, iiki          ! temporary integer within a do loop 
    59       INTEGER, DIMENSION(jpi,jpj) ::   imld                ! temporary workspace 
    6081      REAL(wp)                    ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth 
    6182      REAL(wp)                    ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth 
    6283      !!---------------------------------------------------------------------- 
     84 
     85      IF(.NOT. iwrk_use(2,1))THEN 
     86         CALL ctl_stop('zdf_mxl : requested workspace array unavailable.') 
     87         RETURN 
     88      END IF 
    6389 
    6490      IF( kt == nit000 ) THEN 
    … …  
    94120      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ', ovlap=1 ) 
    95121      ! 
     122      IF(.NOT. iwrk_release(2,1))THEN 
     123         CALL ctl_stop('zdf_mxl : failed to release workspace array.') 
     124      END IF 
     125      ! 
    96126   END SUBROUTINE zdf_mxl 
    97127 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r2528 r2590  
    3939   REAL(wp) ::   rn_alp   =   5._wp      ! coefficient of the parameterization 
    4040 
    41    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   tmric                    ! coef. for the horizontal mean at t-point 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric       ! coef. for the horizontal mean at t-point 
    4242 
    4343   !! * Substitutions 
    … …  
    4949   !!---------------------------------------------------------------------- 
    5050CONTAINS 
     51 
     52   FUNCTION zdf_ric_alloc() 
     53      !!---------------------------------------------------------------------- 
     54      !!                 ***  ROUTINE zdfric  *** 
     55      !!---------------------------------------------------------------------- 
     56      IMPLICIT none 
     57      INTEGER :: zdf_ric_alloc 
     58      !!---------------------------------------------------------------------- 
     59 
     60      ALLOCATE(tmric(jpi,jpj,jpk), Stat=zdf_ric_alloc) 
     61 
     62      IF(zdf_ric_alloc /= 0)THEN 
     63         CALL ctl_warn('zdf_ric_alloc: failed to allocate arrays.') 
     64      END IF 
     65 
     66   END FUNCTION zdf_ric_alloc 
     67 
    5168 
    5269   SUBROUTINE zdf_ric( kt ) 
    … …  
    7794      !! References : Pacanowski & Philander 1981, JPO, 1441-1451. 
    7895      !!---------------------------------------------------------------------- 
     96      USE wrk_nemo, ONLY: wrk_use, wrk_release 
     97      USE wrk_nemo, ONLY: zwx => wrk_2d_1 
     98      !! 
    7999      INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step 
    80100      !! 
    81101      INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    82102      REAL(wp) ::   zcoef, zdku, zdkv, zri, z05alp     ! temporary scalars 
    83       REAL(wp), DIMENSION(jpi,jpj) ::   zwx ! temporary workspace 
    84       !!---------------------------------------------------------------------- 
    85  
     103      !!---------------------------------------------------------------------- 
     104 
     105      IF(.NOT. wrk_use(2, 1))THEN 
     106         CALL ctl_stop('zdf_ric : requested workspace array unavailable.') 
     107         RETURN 
     108      END IF 
    86109      !                                                ! =============== 
    87110      DO jk = 2, jpkm1                                 ! Horizontal slab 
    … …  
    134157      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
    135158      ! 
     159      IF(.NOT. wrk_release(2, 1))THEN 
     160         CALL ctl_stop('zdf_ric : failed to release workspace array.') 
     161      END IF 
     162      ! 
    136163   END SUBROUTINE zdf_ric 
    137164 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r2528 r2590  
    5656   PUBLIC   zdf_tke_init   ! routine called in opa module 
    5757   PUBLIC   tke_rst        ! routine called in step module 
     58   PUBLIC   zdf_tke_alloc  ! routine called in nemogcm module 
    5859 
    5960   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag 
    … …  
    6162#if defined key_c1d 
    6263   !                                                           !!** 1D cfg only  **   ('key_c1d') 
    63    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales 
    64    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e_pdl, e_ric   !: prandl and local Richardson numbers 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_dis, e_mix   !: dissipation and mixing turbulent lengh scales 
     65   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers 
    6566#endif 
    6667 
    … …  
    8788   REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3) 
    8889 
    89    REAL(wp), DIMENSION(jpi,jpj,jpk), PUBLIC ::   en   ! now turbulent kinetic energy   [m2/s2] 
     90   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PUBLIC ::   en   ! now turbulent kinetic energy   [m2/s2] 
    9091    
    91    REAL(wp), DIMENSION(jpi,jpj)     ::   htau    ! depth of tke penetration (nn_htau) 
    92    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dissl   ! now mixing lenght of dissipation 
     92   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   htau    ! depth of tke penetration (nn_htau) 
     93   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)        ::   dissl   ! now mixing lenght of dissipation 
    9394 
    9495   !! * Substitutions 
    … …  
    101102   !!---------------------------------------------------------------------- 
    102103CONTAINS 
     104 
     105   FUNCTION zdf_tke_alloc() 
     106      !!---------------------------------------------------------------------- 
     107      !!                ***  ROUTINE zdf_tke_alloc  *** 
     108      !!---------------------------------------------------------------------- 
     109      IMPLICIT none 
     110      INTEGER :: zdf_tke_alloc 
     111      !!---------------------------------------------------------------------- 
     112 
     113      ALLOCATE(                                                            & 
     114#if defined key_c1d 
     115               e_dis(jpi,jpj,jpk), e_mix(jpi,jpj,jpk),                     & 
     116               e_pdl(jpi,jpj,jpk), e_ric(jpi,jpj,jpk),                     & 
     117#endif 
     118               en(jpi,jpj,jpk),    htau(jpi,jpj),      dissl(jpi,jpj,jpk), & 
     119               Stat=zdf_tke_alloc) 
     120 
     121      IF(zdf_tke_alloc /= 0)THEN 
     122         CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays.') 
     123      END IF 
     124 
     125   END FUNCTION zdf_tke_alloc 
     126 
    103127 
    104128   SUBROUTINE zdf_tke( kt ) 
    … …  
    177201      USE oce,   zd_up  =>   va   ! use va as workspace 
    178202      USE oce,   zd_lw  =>   ta   ! use ta as workspace 
     203      USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 
     204      USE wrk_nemo, ONLY: imlc => iwrk_2d_1 ! 2D INTEGER workspace 
     205      USE wrk_nemo, ONLY: zhlc => wrk_2d_1  ! 2D REAL workspace 
     206      USE wrk_nemo, ONLY: zpelc => wrk_3d_1 ! 3D REAL workspace 
    179207      !! 
    180208      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    … …  
    190218      REAL(wp) ::   zzd_up, zzd_lw                  !    -         - 
    191219!!bfr      REAL(wp) ::   zebot                           !    -         - 
    192       INTEGER , DIMENSION(jpi,jpj)     ::   imlc    ! 2D workspace 
    193       REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc    !  -      - 
    194       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpelc   ! 3D workspace 
    195220      !!-------------------------------------------------------------------- 
    196221      ! 
     222      IF( (.NOT. iwrk_use(2,1)) .OR. & 
     223          (.NOT. wrk_use(2, 1)) .OR. & 
     224          (.NOT. wrk_use(3, 1)) )THEN 
     225         CALL ctl_stop('tke_tke : requested workspace arrays unavailable.') 
     226         RETURN 
     227      END IF 
     228 
    197229      zbbrau = rn_ebb / rau0       ! Local constant initialisation 
    198230      zfact1 = -.5_wp * rdt  
    … …  
    408440      ! 
    409441      CALL lbc_lnk( en, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
     442      ! 
     443      IF( (.NOT. iwrk_release(2,1)) .OR. & 
     444          (.NOT. wrk_release(2, 1)) .OR. & 
     445          (.NOT. wrk_release(3, 1)) )THEN 
     446         CALL ctl_stop('tke_tke : failed to release workspace arrays.') 
     447      END IF 
    410448      ! 
    411449   END SUBROUTINE tke_tke 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r2528 r2590  
    2424   USE in_out_manager  ! I/O manager 
    2525   USE iom             ! I/O Manager 
     26   USE wrk_nemo, ONLY: wrk_use, wrk_release 
    2627 
    2728   IMPLICIT NONE 
    … …  
    3031   PUBLIC   zdf_tmx         ! called in step module  
    3132   PUBLIC   zdf_tmx_init    ! called in opa module  
     33   PUBLIC   zdf_tmx_alloc   ! called in nemogcm module 
    3234 
    3335   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: tidal mixing flag 
    … …  
    4143   REAL(wp) ::  rn_tfe_itf = 1.        ! ITF tidal dissipation efficiency (St Laurent et al. 2002) 
    4244 
    43    REAL(wp), DIMENSION(jpi,jpj)     ::   en_tmx     ! energy available for tidal mixing (W/m2) 
    44    REAL(wp), DIMENSION(jpi,jpj)     ::   mask_itf   ! mask to use over Indonesian area 
    45    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   az_tmx     ! coefficient used to evaluate the tidal induced Kz 
     45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   en_tmx     ! energy available for tidal mixing (W/m2) 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   mask_itf   ! mask to use over Indonesian area 
     47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   az_tmx     ! coefficient used to evaluate the tidal induced Kz 
    4648 
    4749   !! * Substitutions 
    … …  
    5557 
    5658CONTAINS 
     59 
     60   FUNCTION zdf_tmx_alloc() 
     61      !!---------------------------------------------------------------------- 
     62      !!                ***  ROUTINE zdf_tmx_alloc  *** 
     63      !!---------------------------------------------------------------------- 
     64      IMPLICIT none 
     65      INTEGER :: zdf_tmx_alloc 
     66      !!---------------------------------------------------------------------- 
     67 
     68      ALLOCATE(en_tmx(jpi,jpj), mask_itf(jpi,jpj), az_tmx(jpi,jpj,jpk), & 
     69               Stat=zdf_tmx_alloc) 
     70 
     71      IF(zdf_tmx_alloc /= 0)THEN 
     72         CALL ctl_warn('zdf_tmx_alloc: failed to allocate arrays.') 
     73      END IF 
     74 
     75   END FUNCTION zdf_tmx_alloc 
     76 
    5777 
    5878   SUBROUTINE zdf_tmx( kt ) 
    … …  
    91111      !!---------------------------------------------------------------------- 
    92112      USE oce, zav_tide  =>   ua    ! use ua as workspace 
     113      USE wrk_nemo, ONLY: zkz => wrk_2d_1 
    93114      !! 
    94115      INTEGER, INTENT(in) ::   kt   ! ocean time-step  
    … …  
    96117      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    97118      REAL(wp) ::   ztpc         ! scalar workspace 
    98       REAL(wp), DIMENSION(jpi,jpj) ::   zkz   ! temporary 2D workspace 
    99       !!---------------------------------------------------------------------- 
    100  
     119      !!---------------------------------------------------------------------- 
     120 
     121      IF(.NOT. wrk_use(2, 1))THEN 
     122         CALL ctl_stop('zdf_tmx : requested workspace array unavailable.') 
     123         RETURN 
     124      END IF 
    101125      !                          ! ----------------------- ! 
    102126      !                          !  Standard tidal mixing  !  (compute zav_tide) 
    … …  
    160184      IF(ln_ctl)   CALL prt_ctl(tab3d_1=zav_tide , clinfo1=' tmx - av_tide: ', tab3d_2=avt, clinfo2=' avt: ', ovlap=1, kdim=jpk) 
    161185      ! 
     186      IF(.NOT. wrk_release(2, 1))THEN 
     187         CALL ctl_stop('zdf_tmx : failed to release workspace array.') 
     188      END IF 
     189      ! 
    162190   END SUBROUTINE zdf_tmx 
    163191 
    … …  
    183211      !! References :  Koch-Larrouy et al. 2007, GRL  
    184212      !!---------------------------------------------------------------------- 
     213      USE wrk_nemo, ONLY: zkz => wrk_2d_5 
     214      USE wrk_nemo, ONLY: zsum1 => wrk_2d_2, zsum2 => wrk_2d_3, zsum => wrk_2d_4 
     215      USE wrk_nemo, ONLY: zempba_3d_1 => wrk_3d_1, zempba_3d_2 => wrk_3d_2 
     216      USE wrk_nemo, ONLY: zempba_3d   => wrk_3d_3, zdn2dz      => wrk_3d_4 
     217      USE wrk_nemo, ONLY: zavt_itf    => wrk_3d_5 
     218      !! 
    185219      INTEGER , INTENT(in   )                         ::   kt   ! ocean time-step 
    186220      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pav  ! Tidal mixing coef. 
    … …  
    188222      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    189223      REAL(wp) ::   zcoef, ztpc   ! temporary scalar 
    190       REAL(wp), DIMENSION(jpi,jpj)     ::   zkz                        ! 2D workspace 
    191       REAL(wp), DIMENSION(jpi,jpj)     ::   zsum1 , zsum2 , zsum       !  -      - 
    192       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zempba_3d_1, zempba_3d_2   ! 3D workspace 
    193       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zempba_3d  , zdn2dz        !  -      - 
    194       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zavt_itf                   !  -      - 
    195       !!---------------------------------------------------------------------- 
    196  
     224      !!---------------------------------------------------------------------- 
     225      ! 
     226      IF( (.NOT. wrk_use(2, 2,3,4,5)) .OR. (.NOT. wrk_use(3, 1,2,3,4,5)) )THEN 
     227         CALL ctl_stop('tmx_itf : requested workspace arrays unavailable.') 
     228         RETURN 
     229      END IF 
    197230      !                             ! compute the form function using N2 at each time step 
    198231      zempba_3d_1(:,:,jpk) = 0.e0 
    … …  
    279312      END DO 
    280313      ! 
     314      IF( (.NOT. wrk_release(2, 2,3,4,5)) .OR. & 
     315          (.NOT. wrk_release(3, 1,2,3,4,5)) )THEN 
     316         CALL ctl_stop('tmx_itf : failed to release workspace arrays.') 
     317      END IF 
     318      ! 
    281319   END SUBROUTINE tmx_itf 
    282320 
    … …  
    318356      !!---------------------------------------------------------------------- 
    319357      USE oce,   zav_tide  =>   ua   ! use ua as workspace 
     358      USE wrk_nemo, ONLY: zem2 => wrk_2d_1, &      ! read M2 and  
     359                          zek1 => wrk_2d_2         !    K1 tidal energy 
     360      USE wrk_nemo, ONLY: zkz   => wrk_2d_3        ! total M2, K1 and S2 tidal energy 
     361      USE wrk_nemo, ONLY: zfact => wrk_2d_4        ! used for vertical structure function 
     362      USE wrk_nemo, ONLY: zhdep => wrk_2d_5        ! Ocean depth  
     363      USE wrk_nemo, ONLY: zpc   => wrk_3d_1        ! power consumption 
    320364      !! 
    321365      INTEGER ::   ji, jj, jk    ! dummy loop indices 
    322366      INTEGER ::   inum          ! temporary logical unit 
    323367      REAL(wp) ::   ztpc, ze_z   ! total power consumption 
    324       REAL(wp), DIMENSION(jpi,jpj) ::  zem2, zek1   ! read M2 and K1 tidal energy 
    325       REAL(wp), DIMENSION(jpi,jpj) ::  zkz          ! total M2, K1 and S2 tidal energy 
    326       REAL(wp), DIMENSION(jpi,jpj) ::  zfact        ! used for vertical structure function 
    327       REAL(wp), DIMENSION(jpi,jpj) ::  zhdep        ! Ocean depth  
    328       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zpc      ! power consumption 
    329368      !! 
    330369      NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf 
    331370      !!---------------------------------------------------------------------- 
     371 
     372      IF( (.NOT. wrk_use(2, 1,2,3,4,5)) .OR. (.NOT. wrk_use(3, 1)) )THEN 
     373         CALL ctl_stop('zdf_tmx_init : requested workspace arrays unavailable.') 
     374         RETURN 
     375      END IF 
    332376 
    333377      REWIND( numnam )               ! Read Namelist namtmx : Tidal Mixing 
    … …  
    488532      ENDIF 
    489533      ! 
     534      IF( (.NOT. wrk_release(2, 1,2,3,4,5)) .OR. (.NOT. wrk_release(3, 1)) )THEN 
     535         CALL ctl_stop('zdf_tmx_init : failed to release workspace arrays.') 
     536      END IF 
     537      ! 
    490538   END SUBROUTINE zdf_tmx_init 
    491539 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2528 r2590  
    7070#endif 
    7171 
     72   IMPLICIT NONE 
    7273   PRIVATE 
    7374 
    … …  
    217218 
    218219      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print 
     220 
     221      ! Decide on size of grid now that we have our communicator size 
     222      ! If we're not using dynamic memory then mpp_partition does nothing. 
     223 
     224#if   defined key_mpp_mpi   ||   defined key_mpp_shmem 
     225      CALL nemo_partition(mppsize) 
     226#else 
     227      jpni = 1 
     228      jpnj = 1 
     229      jpnij = jpni*jpnj 
     230#endif 
     231      ! Calculate domain dimensions given calculated jpni and jpnj 
     232      ! This used to be done in par_oce.F90 when they were parameters rather 
     233      ! than variables 
     234      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci !: first  dim. 
     235      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dim. 
     236      jpim1 = jpi-1                                          !: inner domain indices 
     237      jpjm1 = jpj-1                                          !:   "           " 
     238      jpkm1 = jpk-1                                          !:   "           " 
     239      jpij  = jpi*jpj                                        !:  jpi x j 
     240 
     241      ! Now we know the dimensions of the grid, allocate arrays 
     242      CALL nemo_alloc() 
    219243 
    220244      IF(lwp) THEN                            ! open listing units 
    … …  
    428452 
    429453   !!====================================================================== 
     454 
     455   SUBROUTINE nemo_alloc 
     456     !!---------------------------------------------------------------------- 
     457     !!                     ***  ROUTINE nemo_alloc  *** 
     458     !! 
     459     !! ** Purpose :   Allocate all the dynamic arrays in the modules 
     460     !! 
     461     !! ** Method  : 
     462     !! 
     463     !! History : 
     464     !!   9.0  !  01-11  (A. R. Porter, STFC Daresbury) 
     465     !!---------------------------------------------------------------------- 
     466#if defined key_lim2 
     467     USE dom_ice_2,    ONLY: dom_ice_alloc_2 
     468     USE ice_2,        ONLY: ice_alloc_2 
     469     USE limdia_2,     ONLY: lim_dia_alloc_2 
     470     USE limhdf_2,     ONLY: lim_hdf_alloc_2 
     471     USE limsbc_2,     ONLY: lim_sbc_alloc_2 
     472     USE limwri_2,     ONLY: lim_wri_alloc_2 
     473     USE thd_ice_2,    ONLY: thd_ice_alloc_2 
     474#endif 
     475#if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp ) 
     476     USE limrhg,       ONLY: lim_rhg_alloc 
     477#endif 
     478#if defined key_lim3 
     479     USE dom_ice,      ONLY: dom_ice_alloc 
     480     USE limidt_me,    ONLY: lim_idt_me_alloc 
     481     USE thd_ice,      ONLY: thd_ice_alloc 
     482#endif 
     483#if defined key_bdy  
     484     USE bdy_oce,      ONLY: bdy_oce_alloc 
     485#endif 
     486#if defined key_diaar5 
     487     USE diaar5,       ONLY: dia_ar5_alloc 
     488#endif 
     489# if defined key_dimgout 
     490     USE diadimg,      ONLY: dia_wri_dimg_alloc 
     491#endif 
     492#if   defined key_diahth   ||   defined key_esopa 
     493     USE diahth,       ONLY: dia_hth_alloc 
     494#endif 
     495     USE diaptr,       ONLY: dia_ptr_alloc 
     496     USE diawri,       ONLY: dia_wri_alloc 
     497     USE divcur,       ONLY: div_cur_alloc 
     498     USE dom_oce,      ONLY: dom_oce_alloc 
     499#if defined key_vvl 
     500     USE domvvl,       ONLY: dom_vvl_alloc 
     501#endif 
     502     USE domwri,       ONLY: dom_wri_alloc 
     503#if defined key_dtasal   ||   defined key_esopa 
     504     USE dtasal,       ONLY: dta_sal_alloc 
     505#endif 
     506#if defined key_dtatem   ||   defined key_esopa 
     507     USE dtatem,       ONLY: dta_tem_alloc 
     508#endif 
     509#if defined key_ldfslp   ||   defined key_esopa 
     510     USE dynldf_bilapg,ONLY: dyn_ldf_bilapg_alloc 
     511#endif 
     512#if defined key_ldfslp   ||   defined key_esopa 
     513     USE dynldf_iso,   ONLY: dyn_ldf_iso_alloc 
     514#endif 
     515#if   defined key_dynspg_ts   ||   defined key_vvl   ||   defined key_esopa 
     516     USE dynspg_oce,   ONLY: dynspg_oce_alloc 
     517#endif 
     518     USE dynvor,       ONLY: dyn_vor_alloc 
     519     USE dynzdf_exp,   ONLY: dyn_zdf_exp_alloc 
     520#if   defined key_floats   ||   defined key_esopa 
     521     USE flo_oce,      ONLY: flo_oce_alloc 
     522#endif 
     523#if   defined key_floats   ||   defined key_esopa 
     524     USE flowri,       ONLY: flo_wri_alloc 
     525#endif 
     526     USE geo2ocean,    ONLY: geo2oce_alloc 
     527     USE ldfdyn_oce,   ONLY: ldfdyn_oce_alloc 
     528#if   defined key_ldfslp   ||   defined key_esopa 
     529     USE ldfslp,       ONLY: ldf_slp_alloc 
     530#endif 
     531     USE ldftra_oce,   ONLY: ldftra_oce_alloc 
     532#if   defined key_mpp_mpi   
     533     USE lib_mpp,      ONLY: lib_mpp_alloc 
     534#endif 
     535#if defined key_obc 
     536     USE obc_dta,      ONLY: obc_dta_alloc 
     537     USE obc_oce,      ONLY: obc_oce_alloc 
     538#endif 
     539     USE oce,          ONLY: oce_alloc 
     540     USE sbcblk_clio,  ONLY: sbc_blk_clio_alloc 
     541#if defined key_oasis3 || defined key_oasis4 
     542     USE sbccpl,       ONLY: sbc_cpl_init_alloc 
     543#endif 
     544     USE sbcdcy,       ONLY: sbc_dcy_alloc 
     545     USE sbcfwb,       ONLY: sbc_fwb_alloc 
     546#if defined key_lim3 || defined key_lim2 
     547     USE sbc_ice,      ONLY: sbc_ice_alloc 
     548#endif 
     549     USE sbc_oce,      ONLY: sbc_oce_alloc 
     550     USE sbcrnf,       ONLY: sbc_rnf_alloc 
     551     USE sbcssr,       ONLY: sbc_ssr_alloc 
     552     USE sol_oce,      ONLY: sol_oce_alloc 
     553     USE solmat,       ONLY: sol_mat_alloc 
     554     USE traadv,       ONLY: tra_adv_alloc 
     555     USE traadv_cen2,  ONLY: tra_adv_cen2_alloc 
     556#if   defined key_trabbl   ||   defined key_esopa 
     557     USE trabbl,       ONLY: tra_bbl_alloc 
     558#endif 
     559#if   defined key_tradmp   ||   defined key_esopa 
     560     USE tradmp,       ONLY: tra_dmp_alloc 
     561#endif 
     562     USE traldf,       ONLY: tra_ldf_alloc 
     563     USE traldf_lap,   ONLY: tra_ldf_lap_alloc 
     564     USE tranxt,       ONLY: tra_nxt_alloc 
     565     USE trazdf,       ONLY: tra_zdf_alloc 
     566     USE trc_oce,      ONLY: trc_oce_alloc 
     567#if   defined key_trdmld   ||   defined key_esopa 
     568     USE trdmld,       ONLY: trd_mld_alloc 
     569#endif 
     570     USE trdmld_oce,   ONLY: trdmld_oce_alloc 
     571#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc  
     572     USE trdtra,       ONLY: trd_tra_alloc 
     573#endif 
     574#if defined key_trdvor   ||   defined key_esopa 
     575     USE trdvor,       ONLY: trd_vor_alloc 
     576#endif 
     577     USE wrk_nemo,     ONLY: wrk_alloc 
     578     USE zdfbfr,       ONLY: zdf_bfr_alloc 
     579#if defined key_zdfddm   ||   defined key_esopa 
     580     USE zdfddm,       ONLY: zdf_ddm_alloc 
     581#endif 
     582#if defined key_zdfkpp   ||   defined key_esopa 
     583     USE zdfkpp,       ONLY: zdf_kpp_alloc 
     584#endif 
     585#if defined key_zdfgls   ||   defined key_esopa 
     586     USE zdfgls,       ONLY: zdf_gls_alloc 
     587#endif 
     588     USE zdfmxl,       ONLY: zdf_mxl_alloc 
     589     USE zdf_oce,      ONLY: zdf_oce_alloc 
     590#if defined key_zdfric   ||   defined key_esopa 
     591     USE zdfric,       ONLY: zdf_ric_alloc 
     592#endif 
     593#if defined key_zdftke   ||   defined key_esopa 
     594     USE zdftke,       ONLY: zdf_tke_alloc 
     595#endif 
     596#if defined key_zdftmx 
     597     USE zdftmx,       ONLY: zdf_tmx_alloc 
     598#endif 
     599     IMPLICIT none 
     600     INTEGER :: ierr 
     601     INTEGER :: i 
     602     !!---------------------------------------------------------------------- 
     603 
     604     ierr = 0 
     605 
     606     !! Calls to the _alloc() routines should be in the same order as the  
     607     !! modules are USE'd above 
     608#if defined key_lim2 
     609     ierr = ierr + dom_ice_alloc_2() 
     610     ierr = ierr + ice_alloc_2() 
     611     ierr = ierr + lim_dia_alloc_2() 
     612     ierr = ierr + lim_hdf_alloc_2() 
     613     ierr = ierr + lim_sbc_alloc_2() 
     614     ierr = ierr + lim_wri_alloc_2() 
     615     ierr = ierr + thd_ice_alloc_2() 
     616#endif 
     617#if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp ) 
     618     ierr = ierr + lim_rhg_alloc() 
     619#endif 
     620#if defined key_lim3 
     621     ierr = ierr + dom_ice_alloc() 
     622     ierr = ierr + lim_idt_me_alloc() 
     623     ierr = ierr + thd_ice_alloc() 
     624#endif 
     625     ! End of ice-related allocations 
     626#if  defined key_bdy 
     627     ierr = ierr + bdy_oce_alloc() 
     628#endif 
     629#if defined key_diaar5 
     630     ierr = ierr + dia_ar5_alloc() 
     631#endif 
     632# if defined key_dimgout 
     633     ierr = ierr + dia_wri_dimg_alloc() 
     634#endif 
     635     ierr = ierr + div_cur_alloc() 
     636#if   defined key_diahth   ||   defined key_esopa 
     637     ierr = ierr + dia_hth_alloc() 
     638#endif 
     639     ierr = ierr + dia_ptr_alloc() 
     640     ierr = ierr + dia_wri_alloc() 
     641     ierr = ierr + dom_oce_alloc() 
     642#if defined key_vvl 
     643     ierr = ierr + dom_vvl_alloc() 
     644#endif 
     645     ierr = ierr + dom_wri_alloc() 
     646#if defined key_dtasal   ||   defined key_esopa 
     647     ierr = ierr + dta_sal_alloc() 
     648#endif 
     649#if defined key_ldfslp   ||   defined key_esopa 
     650     ierr = ierr + dyn_ldf_bilapg_alloc() 
     651#endif 
     652#if defined key_dtasal   ||   defined key_esopa 
     653     ierr = ierr + dta_sal_alloc() 
     654#endif 
     655#if defined key_dtatem   ||   defined key_esopa 
     656     ierr = ierr + dta_tem_alloc() 
     657#endif 
     658#if defined key_ldfslp   ||   defined key_esopa 
     659     ierr = ierr + dyn_ldf_iso_alloc() 
     660#endif 
     661#if   defined key_dynspg_ts   ||   defined key_vvl   ||   defined key_esopa 
     662     ierr = ierr + dynspg_oce_alloc() 
     663#endif 
     664     ierr = ierr + dyn_vor_alloc() 
     665     ierr = ierr + dyn_zdf_exp_alloc() 
     666#if   defined key_floats   ||   defined key_esopa 
     667     ierr = ierr + flo_oce_alloc() 
     668#endif 
     669#if   defined key_floats   ||   defined key_esopa 
     670     ierr = ierr + flo_wri_alloc() 
     671#endif 
     672     ierr = ierr + geo2oce_alloc() 
     673     ierr = ierr + ldfdyn_oce_alloc() 
     674#if   defined key_ldfslp   ||   defined key_esopa 
     675     ierr = ierr + ldf_slp_alloc() 
     676#endif 
     677     ierr = ierr + ldftra_oce_alloc() 
     678#if defined key_mpp_mpi  
     679     ierr = ierr + lib_mpp_alloc() 
     680#endif 
     681#if defined key_obc 
     682     ierr = ierr + obc_dta_alloc() 
     683     ierr = ierr + obc_oce_alloc() 
     684#endif 
     685     ierr = ierr + oce_alloc() 
     686     ierr = ierr + sbc_blk_clio_alloc() 
     687#if defined key_oasis3 || defined key_oasis4 
     688     ierr = ierr + sbc_cpl_init_alloc() 
     689#endif 
     690     ierr = ierr + sbc_dcy_alloc() 
     691     ierr = ierr + sbc_fwb_alloc() 
     692#if defined key_lim3 || defined key_lim2 
     693     ierr = ierr + sbc_ice_alloc() 
     694#endif 
     695     ierr = ierr + sbc_oce_alloc() 
     696     ierr = ierr + sbc_rnf_alloc() 
     697     ierr = ierr + sbc_ssr_alloc() 
     698     ierr = ierr + sol_oce_alloc() 
     699     ierr = ierr + sol_mat_alloc() 
     700     ierr = ierr + tra_adv_alloc() 
     701     ierr = ierr + tra_adv_cen2_alloc() 
     702#if   defined key_trabbl   ||   defined key_esopa 
     703     ierr = ierr + tra_bbl_alloc() 
     704#endif 
     705#if   defined key_tradmp   ||   defined key_esopa 
     706     ierr = ierr + tra_dmp_alloc() 
     707#endif 
     708     ierr = ierr + tra_ldf_alloc() 
     709     ierr = ierr + tra_ldf_lap_alloc() 
     710     ierr = ierr + tra_nxt_alloc() 
     711     ierr = ierr + tra_zdf_alloc() 
     712     ierr = ierr + trc_oce_alloc() 
     713#if   defined key_trdmld   ||   defined key_esopa 
     714     ierr = ierr + trd_mld_alloc() 
     715#endif 
     716     ierr = ierr + trdmld_oce_alloc() 
     717#if  defined key_trdtra || defined key_trdmld || defined key_trdmld_trc  
     718     ierr = ierr + trd_tra_alloc() 
     719#endif 
     720#if defined key_trdvor   ||   defined key_esopa 
     721     ierr = ierr + trd_vor_alloc() 
     722#endif 
     723     ierr = ierr + wrk_alloc() 
     724     ierr = ierr + zdf_bfr_alloc() 
     725#if defined key_zdfddm   ||   defined key_esopa 
     726     ierr = ierr + zdf_ddm_alloc() 
     727#endif 
     728#if defined key_zdfkpp   ||   defined key_esopa 
     729     ierr = ierr + zdf_kpp_alloc() 
     730#endif 
     731#if defined key_zdfgls   ||   defined key_esopa 
     732     ierr = ierr + zdf_gls_alloc() 
     733#endif 
     734     ierr = ierr + zdf_mxl_alloc() 
     735     ierr = ierr + zdf_oce_alloc() 
     736#if defined key_zdfric   ||   defined key_esopa 
     737     ierr = ierr + zdf_ric_alloc() 
     738#endif 
     739#if defined key_zdftke   ||   defined key_esopa 
     740     ierr = ierr + zdf_tke_alloc() 
     741#endif 
     742#if defined key_zdftmx 
     743     ierr = ierr + zdf_tmx_alloc() 
     744#endif 
     745 
     746     IF( lk_mpp ) CALL mpp_sum(ierr) 
     747 
     748     IF(ierr > 0)THEN 
     749        WRITE(numout,*)  
     750        WRITE(numout,*) 'ERROR: Allocation of memory failed in nemo_alloc' 
     751        IF( lk_mpp ) CALL mppstop() 
     752        STOP 
     753     END IF 
     754 
     755   END SUBROUTINE nemo_alloc 
     756 
     757   !!====================================================================== 
     758 
     759   SUBROUTINE nemo_partition(num_pes) 
     760     USE par_oce 
     761     IMPLICIT none 
     762     INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have 
     763     ! Local variables 
     764     INTEGER, PARAMETER :: nfactmax = 20 
     765     INTEGER :: nfact ! The no. of factors returned 
     766     INTEGER :: ierr  ! Error flag 
     767     INTEGER :: i 
     768     INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are 
     769                                     ! closest in value 
     770     INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
     771     ierr = 0 
     772 
     773     CALL factorise(ifact, nfactmax, nfact, num_pes, ierr) 
     774 
     775     IF(nfact <= 1)THEN 
     776        WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
     777        WRITE (numout, *) '       : using grid of ',num_pes,' x 1' 
     778        jpnj = 1 
     779        jpni = num_pes 
     780     ELSE 
     781        ! Search through factors for the pair that are closest in value 
     782        mindiff = 1000000 
     783        imin    = 1 
     784        DO i=1,nfact-1,2 
     785           idiff = ABS(ifact(i) - ifact(i+1)) 
     786           IF(idiff < mindiff)THEN 
     787              mindiff = idiff 
     788              imin = i 
     789           END IF 
     790        END DO 
     791        jpnj = ifact(imin) 
     792        jpni = ifact(imin + 1) 
     793     ENDIF 
     794     jpnij = jpni*jpnj 
     795 
     796     WRITE(*,*) 'ARPDBG: jpni = ',jpni,'jpnj = ',jpnj,'jpnij = ',jpnij 
     797 
     798   END SUBROUTINE nemo_partition 
     799 
     800   !!====================================================================== 
     801 
     802   SUBROUTINE factorise ( ifax, maxfax, nfax, n, ierr ) 
     803 
     804     ! Subroutine to return the prime factors of n. 
     805     ! nfax factors are returned in array ifax which is of maximum 
     806     ! dimension maxfax. 
     807 
     808     IMPLICIT none 
     809 
     810     ! Subroutine arguments 
     811     INTEGER, INTENT(in)  :: n, maxfax 
     812     INTEGER, INTENT(Out) :: ierr, nfax 
     813     INTEGER, INTENT(out) :: ifax(maxfax) 
     814     ! Local variables. 
     815     INTEGER :: i, ifac, l, nu 
     816     INTEGER, PARAMETER :: ntest = 14 
     817     INTEGER :: lfax(ntest) 
     818 
     819     ! lfax contains the set of allowed factors. 
     820     data (lfax(i),i=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, & 
     821                             256, 128, 64, 32, 16, 8, 4, 2  / 
     822 
     823     ! Clear the error flag and initialise output vars 
     824     ierr = 0 
     825     ifax = 1 
     826     nfax = 0 
     827 
     828     ! Find the factors of n. 
     829     if ( n.eq.1 ) goto 20 
     830 
     831     ! nu holds the unfactorised part of the number. 
     832     ! nfax holds the number of factors found. 
     833     ! l points to the allowed factor list. 
     834     ! ifac holds the current factor. 
     835 
     836      nu = n 
     837      nfax = 0 
     838 
     839      DO l=ntest,1,-1 
     840 
     841         ifac = lfax(l) 
     842         IF(ifac > nu)CYCLE 
     843 
     844         ! Test whether the factor will divide. 
     845 
     846         If ( mod(nu,ifac).eq.0 ) then 
     847 
     848            ! Add the factor to the list. 
     849 
     850            nfax = nfax+1 
     851            if ( nfax.gt.maxfax ) then 
     852               ierr = 6 
     853               write (*,*) 'FACTOR: insufficient space in factor array ',nfax 
     854               return 
     855            endif 
     856            ifax(nfax) = ifac 
     857            ! Store the other factor that goes with this one 
     858            nfax = nfax + 1 
     859            ifax(nfax) = nu/ifac 
     860            !WRITE (*,*) 'ARPDBG, factors ',nfax-1,' & ',nfax,' are ', & 
     861            !            ifax(nfax-1),' and ',ifax(nfax) 
     862         END IF 
     863 
     864      END DO 
     865 
     866      ! Label 20 is the exit point from the factor search loop. 
     867   20 continue 
     868 
     869      return 
     870 
     871  END SUBROUTINE factorise 
     872 
     873  !!====================================================================== 
     874 
    430875END MODULE nemogcm 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r2528 r2590  
    1313   PRIVATE 
    1414 
     15   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 
     16 
    1517   LOGICAL         , PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion 
    1618 
    17    !! dynamics and tracer fields                  ! before ! now    ! after   ! the after trends becomes the fields 
    18    !! --------------------------                  ! fields ! fields ! trends  ! only after tra_zdf and dyn_spg 
    19    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   ub   ,  un    , ua      !: i-horizontal velocity        [m/s] 
    20    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   vb   ,  vn    , va      !: j-horizontal velocity        [m/s] 
    21    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::           wn              !: vertical velocity            [m/s] 
    22    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rotb ,  rotn            !: relative vorticity           [s-1] 
    23    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   hdivb,  hdivn           !: horizontal divergence        [s-1] 
    24    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   tb   ,  tn    , ta      !: potential temperature    [Celcius] 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   sb   ,  sn    , sa      !: salinity                     [psu] 
    26    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpts) ::  tsb  ,  tsn   , tsa     !: 4D T-S fields        [Celcius,psu]  
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rn2b ,  rn2             !: brunt-vaisala frequency**2   [s-2] 
     19   !! dynamics and tracer fields                           ! before ! now    ! after   ! the after trends becomes the fields 
     20   !! --------------------------                           ! fields ! fields ! trends  ! only after tra_zdf and dyn_spg 
     21   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ub   ,  un    , ua      !: i-horizontal velocity        [m/s] 
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   vb   ,  vn    , va      !: j-horizontal velocity        [m/s] 
     23   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::           wn              !: vertical velocity            [m/s] 
     24   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rotb ,  rotn            !: relative vorticity           [s-1] 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hdivb,  hdivn           !: horizontal divergence        [s-1] 
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tb   ,  tn    , ta      !: potential temperature    [Celcius] 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sb   ,  sn    , sa      !: salinity                     [psu] 
     28   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: tsb  ,  tsn   , tsa     !: 4D T-S fields        [Celcius,psu]  
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rn2b ,  rn2             !: brunt-vaisala frequency**2   [s-2] 
    2830   ! 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhop   !: potential volumic mass                           [kg/m3] 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3] 
    3133 
    32    !! free surface                       !  before  !  now     !  after   ! 
    33    !! ------------                       !  fields  !  fields  !  trends  ! 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshb   ,  sshn    ,  ssha    !: sea surface height at t-point [m] 
    35    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshu_b ,  sshu_n  ,  sshu_a  !: sea surface height at u-point [m] 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshv_b ,  sshv_n  ,  sshv_a  !: sea surface height at u-point [m] 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::             sshf_n             !: sea surface height at f-point [m] 
     34   !! free surface                                      !  before  !  now     !  after   ! 
     35   !! ------------                                      !  fields  !  fields  !  trends  ! 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn    ,  ssha    !: sea surface height at t-point [m] 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshu_b ,  sshu_n  ,  sshu_a  !: sea surface height at u-point [m] 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshv_b ,  sshv_n  ,  sshv_a  !: sea surface height at u-point [m] 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::             sshf_n             !: sea surface height at f-point [m] 
    3840   ! 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spgu, spgv                   !: horizontal surface pressure gradient 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv                   !: horizontal surface pressure gradient 
    4042 
    4143   !! interpolated gradient (only used in zps case) 
    4244   !! --------------------- 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
    44    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   gru , grv    !: horizontal gradient of rd at bottom u-point 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point  
     46   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point 
    4547 
    4648   !!---------------------------------------------------------------------- 
    … …  
    4951   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5052   !!====================================================================== 
     53CONTAINS 
     54 
     55   FUNCTION oce_alloc() 
     56     IMPLICIT none 
     57     INTEGER :: oce_alloc 
     58     INTEGER :: ierr(2) 
     59 
     60     ! The Allocate statement is broken up to prevent excessive 
     61     ! line lengths 
     62     ALLOCATE(ub(jpi,jpj,jpk), un(jpi,jpj,jpk), ua(jpi,jpj,jpk), & 
     63              vb(jpi,jpj,jpk), vn(jpi,jpj,jpk), va(jpi,jpj,jpk), &       
     64              wn(jpi,jpj,jpk),                                   & 
     65              rotb(jpi,jpj,jpk),  rotn(jpi,jpj,jpk),             &    
     66              hdivb(jpi,jpj,jpk), hdivn(jpi,jpj,jpk),            & 
     67              tb(jpi,jpj,jpk), tn(jpi,jpj,jpk), ta(jpi,jpj,jpk), & 
     68              sb(jpi,jpj,jpk), sn(jpi,jpj,jpk), sa(jpi,jpj,jpk), &       
     69              tsb(jpi,jpj,jpk,jpts),tsn(jpi,jpj,jpk,jpts),tsa(jpi,jpj,jpk,jpts),& 
     70              rn2b(jpi,jpj,jpk), rn2(jpi,jpj,jpk),               & 
     71              ! 
     72              Stat=ierr(1)) 
     73 
     74     ALLOCATE(rhd(jpi,jpj,jpk),                                  & 
     75              rhop(jpi,jpj,jpk),                                 & 
     76              ! 
     77              sshb(jpi,jpj),   sshn(jpi,jpj),   ssha(jpi,jpj),   & 
     78              sshu_b(jpi,jpj), sshu_n(jpi,jpj), sshu_a(jpi,jpj), & 
     79              sshv_b(jpi,jpj), sshv_n(jpi,jpj), sshv_a(jpi,jpj), & 
     80                               sshf_n(jpi,jpj),                  & 
     81              ! 
     82              spgu(jpi,jpj),   spgv(jpi,jpj),                    & 
     83              ! 
     84              gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),            & 
     85              gru(jpi,jpj), grv(jpi,jpj),                        & 
     86              ! 
     87              Stat=ierr(2)) 
     88 
     89     oce_alloc = maxval(ierr) 
     90 
     91   END FUNCTION oce_alloc 
     92 
    5193END MODULE oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r2528 r2590  
    1717   !!---------------------------------------------------------------------- 
    1818   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj 
    19 #if ! defined key_mpp_dyndist  
    20    INTEGER, PUBLIC, PARAMETER ::    &  !: 
    21 # if ! defined key_nproci 
    22       jpni   = 1,                   &  !: number of processors following i 
    23       jpnj   = 1,                   &  !: number of processors following j 
    24       jpnij  = 1                       !: nb of local domain = nb of processors  
    25       !                                !  ( <= jpni x jpnj ) 
    26 # else 
    27       jpni   = key_nproci,          &  !: number of processors following i 
    28       jpnj   = key_nprocj,          &  !: number of processors following j 
    29 #  if ! defined key_nprocij 
    30       jpnij  = key_nproci * key_nprocj !: nb of local domain = nb of processors  
    31       !                                !  ( <= jpni x jpnj ) 
    32 #  else 
    33       jpnij  = key_nprocij             !: nb of local domain = nb of processors  
    34       !                                !  ( <= jpni x jpnj ) 
    35 #  endif 
    36 # endif 
    37 #else 
     19!!$#if ! defined key_mpp_dyndist  
     20!!$   INTEGER, PUBLIC, PARAMETER ::    &  !: 
     21!!$# if ! defined key_nproci 
     22!!$      jpni   = 1,                   &  !: number of processors following i 
     23!!$      jpnj   = 1,                   &  !: number of processors following j 
     24!!$      jpnij  = 1                       !: nb of local domain = nb of processors  
     25!!$      !                                !  ( <= jpni x jpnj ) 
     26!!$# else 
     27!!$      jpni   = key_nproci,          &  !: number of processors following i 
     28!!$      jpnj   = key_nprocj,          &  !: number of processors following j 
     29!!$#  if ! defined key_nprocij 
     30!!$      jpnij  = key_nproci * key_nprocj !: nb of local domain = nb of processors  
     31!!$      !                                !  ( <= jpni x jpnj ) 
     32!!$#  else 
     33!!$      jpnij  = key_nprocij             !: nb of local domain = nb of processors  
     34!!$      !                                !  ( <= jpni x jpnj ) 
     35!!$#  endif 
     36!!$# endif 
     37!!$#else 
    3838   INTEGER, PUBLIC            ::   jpni         !: number of processors following i  
    3939   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j 
    4040   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj ) 
    41 #endif 
     41!!$#endif 
    4242   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo  
    4343   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo  
    … …  
    116116   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i 
    117117   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j 
    118    INTEGER, PUBLIC, PARAMETER ::   jpk     = jpkdta   !: number of vertical levels 
     118   INTEGER, PUBLIC            ::   jpk     = jpkdta   !: number of vertical levels 
    119119   ! zoom starting position  
    120120   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom 
    … …  
    195195   INTEGER, PUBLIC            ::   jpij  = jpi*jpj                                          !:  jpi x jpj 
    196196#else 
    197    INTEGER, PUBLIC, PARAMETER ::   jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension 
    198    INTEGER, PUBLIC, PARAMETER ::   jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension 
    199    INTEGER, PUBLIC, PARAMETER ::   jpim1 = jpi-1                                            !: inner domain indices 
    200    INTEGER, PUBLIC, PARAMETER ::   jpjm1 = jpj-1                                            !:   -     -      - 
    201    INTEGER, PUBLIC, PARAMETER ::   jpkm1 = jpk-1                                            !:   -     -      - 
    202    INTEGER, PUBLIC, PARAMETER ::   jpij = jpi*jpj                                          !:  jpi x jpj 
     197   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension 
     198   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension 
     199   INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices 
     200   INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      - 
     201   INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      - 
     202   INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj 
    203203#endif 
    204204 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

    r2528 r2590  
    2020   PUBLIC   trc_oce_rgb_read   ! routine called by traqsr.F90 
    2121   PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least 
    22   
    23    REAL(wp), PUBLIC                          ::   r_si2   !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB) 
    24    REAL(wp), PUBLIC , DIMENSION(jpi,jpj,jpk) ::   etot3   !: light absortion coefficient 
     22   PUBLIC   trc_oce_alloc      ! function called by nemogcm.F90 
     23 
     24   REAL(wp), PUBLIC                                      ::   r_si2   !: largest depth of extinction (blue & 0.01 mg.m-3)  (RGB) 
     25   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   etot3   !: light absortion coefficient 
    2526 
    2627#if defined key_top && defined key_pisces 
    … …  
    5758 
    5859CONTAINS 
     60 
     61   FUNCTION trc_oce_alloc() 
     62      !!---------------------------------------------------------------------- 
     63      IMPLICIT none 
     64      INTEGER :: trc_oce_alloc 
     65      !!---------------------------------------------------------------------- 
     66 
     67      ALLOCATE(etot3(jpi,jpj,jpk), Stat = trc_oce_alloc) 
     68 
     69      IF(trc_oce_alloc /= 0)THEN 
     70         CALL ctl_warn('trc_oce_alloc: failed to allocate array etot3.') 
     71      END IF 
     72 
     73   END FUNCTION trc_oce_alloc 
    5974 
    6075   SUBROUTINE trc_oce_rgb( prgb ) 
Note: See TracChangeset for help on using the changeset viewer.