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 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/LDF – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/LDF
Files:
12 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r2528 r2715  
    3838   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3939   !! $Id$  
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4342CONTAINS 
    4443 
     
    6362      !!---------------------------------------------------------------------- 
    6463      INTEGER ::   ioptio         ! ??? 
    65       LOGICAL :: ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
     64      LOGICAL ::   ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
    6665      !!  
    6766      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  & 
     
    207206      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
    208207      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 
     208      REAL(wp), INTENT(in   ), DIMENSION          (:) ::   pdep       ! depth of the gridpoint (T, U, V, F) 
     209      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile 
    211210      !! 
    212211      INTEGER  ::   jk           ! dummy loop indices 
     
    249248      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
    250249      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 
     250      REAL(wp), INTENT(in   ), DIMENSION      (:,:,:) ::   pdep       ! dep of the gridpoint (T, U, V, F) 
     251      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile 
    253252      !! 
    254253      INTEGER  ::   jk           ! dummy loop indices 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90

    r2528 r2715  
    2424      !! 
    2525      !!---------------------------------------------------------------------- 
    26       !! * Arguments 
    27       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    28  
    29       !! * Local variables 
     26      LOGICAL, INTENT(in) :: ld_print   ! If true, output arrays on numout 
     27      ! 
    3028      INTEGER  ::   jk   ! dummy loop indice 
    3129      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs 
     
    3735      IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient' 
    3836      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    39       IF(lwp) WRITE(numout,*) 
    4037 
    4138      ! Set ahm1 for laplacian     (always at t-level) 
     
    124121      ENDIF 
    125122 9120 FORMAT('  jk      ahm       ','  depth w-level ' ) 
    126  
     123      ! 
    127124   END SUBROUTINE ldf_dyn_c1d 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90

    r2528 r2715  
    3232      !! 
    3333      !!---------------------------------------------------------------------- 
    34       !! * Arguments 
    3534      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    36  
    37       !! * Local variables 
    38       INTEGER :: ji, jj 
     35      ! 
     36      INTEGER  ::   ji, jj 
    3937      REAL(wp) ::   za00, zd_max, zetmax, zeumax, zefmax, zevmax 
    4038      !!---------------------------------------------------------------------- 
     
    4341      IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient' 
    4442      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    45       IF(lwp) WRITE(numout,*) 
    4643 
    4744      ! harmonic operator (ahm1, ahm2) : ( T- and F- points) (used for laplacian operators 
     
    123120         ENDIF 
    124121      ENDIF 
    125  
    126  
     122      ! 
    127123   END SUBROUTINE ldf_dyn_c2d 
    128124 
     
    143139      !! 
    144140      !!---------------------------------------------------------------------- 
    145       !! * Modules used 
    146       USE ldftra_oce, ONLY : aht0 
    147  
    148       !! * Arguments 
     141      USE ldftra_oce, ONLY:   aht0 
     142      USE wrk_nemo  , ONLY:   iwrk_in_use, iwrk_not_released 
     143      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     144      ! 
    149145      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    150  
    151       !! * Local variables 
    152       INTEGER ::   ji, jj, jn      ! dummy loop indices 
    153       INTEGER ::   inum            ! temporary logical unit 
    154       INTEGER ::   iim, ijm 
    155       INTEGER ::   ifreq, il1, il2, ij, ii 
     146      ! 
     147      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
     148      INTEGER  ::   inum, iim, ijm            ! local integers 
     149      INTEGER  ::   ifreq, il1, il2, ij, ii 
     150      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
     151      CHARACTER (len=15) ::   clexp 
    156152      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    157       INTEGER, DIMENSION(jpi   ,jpj   ) ::   icof 
    158  
    159       REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk 
    160  
    161       CHARACTER (len=15) ::   clexp 
    162       !!---------------------------------------------------------------------- 
     153      !!---------------------------------------------------------------------- 
     154 
     155      IF( iwrk_in_use(2, 1) )THEN 
     156         CALL ctl_stop('ldf_dyn_c2d_orca: requested workspace array is unavailable')   ;   RETURN 
     157      ENDIF 
    163158 
    164159      IF(lwp) WRITE(numout,*) 
    165160      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
    166161      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    167       IF(lwp) WRITE(numout,*) 
    168       IF(lwp) WRITE(numout,*) '        orca ocean model' 
    169       IF(lwp) WRITE(numout,*) 
     162      IF(lwp) WRITE(numout,*) '        orca ocean configuration' 
    170163 
    171164#if defined key_antarctic 
     
    288281      ENDIF 
    289282 
     283      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('ldf_dyn_c2d_orca: failed to release workspace array') 
     284      ! 
    290285   END SUBROUTINE ldf_dyn_c2d_orca 
     286 
    291287 
    292288   SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print ) 
     
    305301      !! 
    306302      !!---------------------------------------------------------------------- 
    307       !! * Modules used 
    308       USE ldftra_oce, ONLY : aht0 
    309  
    310       !! * Arguments 
     303      USE ldftra_oce, ONLY:   aht0 
     304      USE wrk_nemo  , ONLY:   iwrk_in_use, iwrk_not_released 
     305      USE wrk_nemo  , ONLY:   icof => iwrk_2d_1 
     306      ! 
    311307      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    312  
    313       !! * Local variables 
     308      ! 
    314309      INTEGER ::   ji, jj, jn      ! dummy loop indices 
    315310      INTEGER ::   inum            ! temporary logical unit 
    316311      INTEGER ::   iim, ijm 
    317312      INTEGER ::   ifreq, il1, il2, ij, ii 
     313      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s 
     314      CHARACTER (len=15) ::   clexp 
    318315      INTEGER, DIMENSION(jpidta,jpidta) ::   idata 
    319       INTEGER, DIMENSION(jpi   ,jpj   ) ::   icof 
    320  
    321       REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s 
    322  
    323       CHARACTER (len=15) ::   clexp 
    324       !!---------------------------------------------------------------------- 
     316      !!---------------------------------------------------------------------- 
     317 
     318      IF( iwrk_in_use(2, 1) ) THEN 
     319         CALL ctl_stop('ldf_dyn_c2d_orca_R1: requested workspace array is unavailable')   ;   RETURN 
     320      ENDIF 
    325321 
    326322      IF(lwp) WRITE(numout,*) 
    327323      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 
    328324      IF(lwp) WRITE(numout,*) '~~~~~~  --' 
    329       IF(lwp) WRITE(numout,*) 
    330       IF(lwp) WRITE(numout,*) '        orca_r1 ocean model' 
    331       IF(lwp) WRITE(numout,*) 
     325      IF(lwp) WRITE(numout,*) '        orca_r1 configuration' 
    332326 
    333327#if defined key_antarctic 
     
    457451      ENDIF 
    458452 
     453      IF( iwrk_not_released(2, 1) )   CALL ctl_stop('ldf_dyn_c2d_orca_R1: failed to release workspace array') 
     454      ! 
    459455   END SUBROUTINE ldf_dyn_c2d_orca_R1 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90

    r2528 r2715  
    2626      !!       ??? explanation of the default is missing 
    2727      !!---------------------------------------------------------------------- 
    28       USE ldftra_oce, ONLY : aht0 
    29       !! 
    30       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    31       !! 
    32       INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    33       REAL(wp) ::   & 
    34          zr = 0.2 ,   &  ! maximum of the reduction factor at the bottom ocean 
    35          !               ! ( 0 < zr < 1 ) 
    36          zh = 500.,   &  ! depth of at which start the reduction ( > dept(1) ) 
    37          zd_max   ,   &  ! maximum grid spacing over the global domain 
    38          za00, zc, zd    ! temporary scalars 
    39       REAL(wp) ::        & 
    40          zetmax, zefmax, & 
    41          zeumax, zevmax    
    42       REAL(wp), DIMENSION(jpk) ::   zcoef   ! temporary workspace 
    43       !!---------------------------------------------------------------------- 
     28      USE ldftra_oce, ONLY :   aht0 
     29      USE wrk_nemo  , ONLY:   wrk_in_use, wrk_not_released 
     30      USE wrk_nemo  , ONLY:   zcoef => wrk_1d_2 
     31      !! 
     32      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
     33      !! 
     34      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     35      REAL(wp) ::   zr = 0.2     ! maximum of the reduction factor at the bottom ocean ( 0 < zr < 1 ) 
     36      REAL(wp) ::   zh = 500.    ! depth of at which start the reduction ( > dept(1) ) 
     37      REAL(wp) ::   zd_max       ! maximum grid spacing over the global domain 
     38      REAL(wp) ::   za00, zc, zd, zetmax, zefmax, zeumax, zevmax   ! local scalars 
     39      !!---------------------------------------------------------------------- 
     40 
     41      IF( wrk_in_use(1,2) ) THEN 
     42         CALL ctl_stop('ldf_dyn_c3d: requested workspace array unavailable')   ;   RETURN 
     43      ENDIF 
    4444 
    4545      IF(lwp) WRITE(numout,*) 
     
    181181         ENDIF 
    182182      ENDIF 
    183  
     183      ! 
     184      IF( wrk_not_released(1,2) )   CALL ctl_stop('ldf_dyn_c3d: failed to release workspace array') 
     185      ! 
    184186   END SUBROUTINE ldf_dyn_c3d 
    185187 
     
    193195      !! ** Method  :   blah blah blah .... 
    194196      !!---------------------------------------------------------------------- 
    195       USE ldftra_oce, ONLY : aht0 
    196       !! 
    197       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
     197      USE ldftra_oce, ONLY:   aht0 
     198      USE wrk_nemo  , ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
     199      USE wrk_nemo  , ONLY:   icof  => iwrk_2d_1 
     200      USE wrk_nemo  , ONLY:   zahm0 =>  wrk_2d_1 
     201      USE wrk_nemo  , ONLY:   zcoef =>  wrk_1d_1 
     202      !! 
     203      LOGICAL, INTENT(in) ::   ld_print   ! If true, output arrays on numout 
    198204      !! 
    199205      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices 
    200       INTEGER ::   ii0, ii1, ij0, ij1  ! temporary integers 
    201       INTEGER ::   inum                ! temporary logical unit 
    202       INTEGER ::   iim, ijm 
     206      INTEGER ::   ii0, ii1, ij0, ij1  ! local integers 
     207      INTEGER ::   inum, iim, ijm      !  
    203208      INTEGER ::   ifreq, il1, il2, ij, ii 
    204209      INTEGER, DIMENSION(jpidta, jpjdta) ::   idata 
    205       INTEGER, DIMENSION(jpi   , jpj   ) ::   icof 
    206  
    207       REAL(wp) ::   & 
    208          zahmeq, zcoff, zcoft, zmsk,   & ! ??? 
    209          zemax, zemin, zeref, zahmm 
    210       REAL(wp), DIMENSION(jpi,jpj) ::   zahm0 
    211       REAL(wp), DIMENSION(jpk) ::   zcoef 
    212  
     210 
     211      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk   ! local scalars 
     212      REAL(wp) ::   zemax , zemin, zeref, zahmm 
    213213      CHARACTER (len=15) ::   clexp 
    214214      !!---------------------------------------------------------------------- 
     215 
     216      IF( iwrk_in_use(2,1) .OR. wrk_in_use(2,1) .OR. wrk_in_use(1,1) ) THEN 
     217         CALL ctl_stop('ldf_dyn_c3d_orca: requested workspace arrays are unavailable')   ;   RETURN 
     218      ENDIF 
    215219 
    216220      IF(lwp) WRITE(numout,*) 
    217221      IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient' 
    218222      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    219       IF(lwp) WRITE(numout,*) 
    220       IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 ocean model' 
    221       IF(lwp) WRITE(numout,*) '  reduced in the surface Eq. strip ' 
    222       IF(lwp) WRITE(numout,*) 
     223      IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 configuration: reduced in the surface Eq. strip ' 
    223224 
    224225      ! Read 2d integer array to specify western boundary increase in the 
     
    457458      ENDIF 
    458459 
     460      IF( iwrk_not_released(2,1) .OR.   & 
     461           wrk_not_released(2,1) .OR.   & 
     462           wrk_not_released(1,1)   ) CALL ctl_stop('ldf_dyn_c3d_orca: failed to release workspace arrays') 
     463      ! 
    459464   END SUBROUTINE ldf_dyn_c3d_orca 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90

    r2528 r2715  
    66   !! History :  1.0  ! 2002-11  (G. Madec)  F90: Free form and module 
    77   !!---------------------------------------------------------------------- 
    8    USE par_oce      ! ocean parameters 
     8   USE par_oce        ! ocean parameters 
     9   USE in_out_manager ! I/O manager 
     10   USE lib_mpp         ! MPP library 
    911 
    1012   IMPLICIT NONE 
     
    2022   REAL(wp), PUBLIC ::   rn_ahmb_0       =     0._wp   !: lateral laplacian background eddy viscosity (m2/s) 
    2123   REAL(wp), PUBLIC ::   rn_ahm_0_blp    =     0._wp   !: lateral bilaplacian eddy viscosity (m4/s) 
    22    REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         ! OLD namelist names 
     24   REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         !: OLD namelist names 
    2325 
     26   !                                                                                  !!! eddy coeff. at U-,V-,W-pts [m2/s] 
    2427#if defined key_dynldf_c3d 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ahm1, ahm2, ahm3, ahm4  ! ** 3D coefficients ** 
     28   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahm1, ahm2, ahm3, ahm4   !: ** 3D coefficients ** 
    2629#elif defined key_dynldf_c2d 
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ahm1, ahm2, ahm3, ahm4  ! ** 2D coefficients ** 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients ** 
    2831#elif defined key_dynldf_c1d 
    29    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   ahm1, ahm2, ahm3, ahm4  ! ** 2D coefficients ** 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients ** 
    3033#else 
    31    REAL(wp), PUBLIC                         ::   ahm1, ahm2, ahm3, ahm4  ! ** 0D coefficients ** 
     34   REAL(wp), PUBLIC                                      ::   ahm1, ahm2, ahm3, ahm4   !: ** 0D coefficients ** 
    3235#endif 
    3336 
    3437   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     38   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    3639   !! $Id$  
    37    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
     42CONTAINS 
     43 
     44   INTEGER FUNCTION ldfdyn_oce_alloc() 
     45      !!---------------------------------------------------------------------- 
     46      !!                 ***  FUNCTION ldfdyn_oce_alloc  *** 
     47      !!---------------------------------------------------------------------- 
     48      ldfdyn_oce_alloc = 0 
     49#if defined key_dynldf_c3d 
     50      ALLOCATE( ahm1(jpi,jpj,jpk) , ahm2(jpi,jpj,jpk) , ahm3(jpi,jpj,jpk) , ahm4(jpi,jpj,jpk) , STAT=ldfdyn_oce_alloc ) 
     51#elif defined key_dynldf_c2d 
     52      ALLOCATE( ahm1(jpi,jpj    ) , ahm2(jpi,jpj    ) , ahm3(jpi,jpj    ) , ahm4(jpi,jpj    ) , STAT=ldfdyn_oce_alloc ) 
     53#elif defined key_dynldf_c1d 
     54      ALLOCATE( ahm1(        jpk) , ahm2(        jpk) , ahm3(        jpk) , ahm4(        jpk) , STAT=ldfdyn_oce_alloc ) 
     55#endif 
     56      IF( ldfdyn_oce_alloc /= 0 )   CALL ctl_warn('ldfdyn_oce_alloc: failed to allocate arrays') 
     57      ! 
     58   END FUNCTION ldfdyn_oce_alloc 
     59 
    3860   !!====================================================================== 
    3961END MODULE ldfdyn_oce 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90

    r2528 r2715  
    5353      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points.  
    5454      !!---------------------------------------------------------------------- 
     55      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     56      USE wrk_nemo, ONLY:   zn  => wrk_2d_1 , zah   => wrk_2d_2   ! 2D workspace 
     57      USE wrk_nemo, ONLY:   zhw => wrk_2d_3 , zross => wrk_2d_4 
     58      ! 
    5559      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    56       !! 
     60      ! 
    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( wrk_in_use(2, 1,2,3,4) ) THEN 
     66         CALL ctl_stop('ldf_eiv: requested workspace arrays are unavailable.')   ;   RETURN 
     67      ENDIF 
     68 
    6269      IF( kt == nit000 ) THEN 
    6370         IF(lwp) WRITE(numout,*) 
     
    235242      CALL iom_put( "aht2d"    , ahtw )   ! lateral eddy diffusivity 
    236243      CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity 
     244      !   
     245      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('ldf_eiv: failed to release workspace arrays') 
    237246      ! 
    238247   END SUBROUTINE ldf_eiv 
     
    244253CONTAINS 
    245254   SUBROUTINE ldf_eiv( kt )       ! Empty routine 
     255      INTEGER :: kt 
    246256      WRITE(*,*) 'ldf_eiv: You should not have seen this print! error?', kt 
    247257   END SUBROUTINE ldf_eiv 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2605 r2715  
    4141   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag 
    4242   !                                                                             !! 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 
     43   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 
     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   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   omlmask           ! mask of the surface mixed layer at T-pt 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   uslpml, wslpiml   ! i_slope at U- and W-points just below the mixed layer 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   vslpml, wslpjml   ! j_slope at V- and W-points just below the mixed layer 
    5456 
    5557   REAL(wp) ::   repsln = 1.e-25_wp       ! tiny value used as minium of di(rho), dj(rho) and dk(rho) 
     58 
     59   ! Workspace arrays for ldf_slp_grif. These could be replaced by several 3D and 2D workspace 
     60   ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace  
     61   ! arrays can't be used here because of the zero-indexing of some of the ranks. ARPDBG. 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zdzrho , zdyrho, zdxrho     ! Horizontal and vertical density gradients 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   zti_mlb, ztj_mlb            ! for Griffies operator only 
    5664 
    5765   !! * Substitutions 
     
    6169#  include "vectopt_loop_substitute.h90" 
    6270   !!---------------------------------------------------------------------- 
    63    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     71   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    6472   !! $Id$ 
    6573   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6674   !!---------------------------------------------------------------------- 
    6775CONTAINS 
     76 
     77   INTEGER FUNCTION ldf_slp_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      !!              ***  FUNCTION ldf_slp_alloc  *** 
     80      !!---------------------------------------------------------------------- 
     81      ! 
     82      ALLOCATE( zdxrho (jpi,jpj,jpk,0:1) , zti_mlb(jpi,jpj,0:1,0:1) ,     & 
     83         &      zdyrho (jpi,jpj,jpk,0:1) , ztj_mlb(jpi,jpj,0:1,0:1) ,     & 
     84         &      zdzrho (jpi,jpj,jpk,0:1)                            , STAT=ldf_slp_alloc ) 
     85         ! 
     86      IF( lk_mpp             )   CALL mpp_sum ( ldf_slp_alloc ) 
     87      IF( ldf_slp_alloc /= 0 )   CALL ctl_warn('ldf_slp_alloc : failed to allocate arrays.') 
     88      ! 
     89   END FUNCTION ldf_slp_alloc 
     90 
    6891 
    6992   SUBROUTINE ldf_slp( kt, prd, pn2 ) 
     
    92115      !!               of now neutral surfaces at u-, w- and v- w-points, resp. 
    93116      !!---------------------------------------------------------------------- 
    94       USE oce , zgru  => ua   ! use ua as workspace 
    95       USE oce , zgrv  => va   ! use va as workspace 
    96       USE oce , zww   => ta   ! use ta as workspace 
    97       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.) 
     117      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     118      USE oce     , ONLY:   zgru => ua       , zww => va   ! (ua,va) used as workspace 
     119      USE oce     , ONLY:   zgrv => ta       , zwz => sa   ! (ta,sa) used as workspace 
     120      USE wrk_nemo, ONLY:   zdzr => wrk_3d_1               ! 3D workspace 
     121      !! 
     122      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index 
     123      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   prd   ! in situ density 
     124      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   pn2   ! Brunt-Vaisala frequency (locally ref.) 
    102125      !! 
    103126      INTEGER  ::   ji , jj , jk    ! dummy loop indices 
     
    108131      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    109132      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
    110       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdzr   ! 3D workspace 
    111       !!---------------------------------------------------------------------- 
    112        
     133      !!---------------------------------------------------------------------- 
     134 
     135      IF( wrk_in_use(3, 1) ) THEN 
     136         CALL ctl_stop('ldf_slp: requested workspace arrays are unavailable')   ;   RETURN 
     137      ENDIF 
     138 
    113139      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    114140      z1_16  =  1.0_wp / 16._wp 
     
    342368      ENDIF 
    343369 
    344        
    345370      ! IV. Lateral boundary conditions  
    346371      ! =============================== 
     
    354379      ENDIF 
    355380      ! 
     381      IF( wrk_not_released(3, 1) )   CALL ctl_stop('ldf_slp: failed to release workspace arrays') 
     382      ! 
    356383   END SUBROUTINE ldf_slp 
    357384    
     
    371398      !!             - wslp2              squared slope of neutral surfaces at w-points. 
    372399      !!---------------------------------------------------------------------- 
    373       USE oce,   zdit  => ua   ! use ua as workspace 
    374       USE oce,   zdis  => va   ! use va as workspace 
    375       USE oce,   zdjt  => ta   ! use ta as workspace 
    376       USE oce,   zdjs  => sa   ! use sa as workspace 
    377       !! 
    378       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    379       !! 
     400      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     401      USE oce     , ONLY:   zdit    => ua       , zdis   => va         ! (ua,va) used as workspace 
     402      USE oce     , ONLY:   zdjt    => ta       , zdjs   => sa         ! (ta,sa) used as workspace 
     403      USE wrk_nemo, ONLY:   zdkt    => wrk_3d_2 , zdks   => wrk_3d_3   ! 3D workspace 
     404      USE wrk_nemo, ONLY:   zalpha  => wrk_3d_4 , zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
     405      USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1 
     406      ! 
     407      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     408      ! 
    380409      INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
    381       INTEGER  ::   iku, ikv                ! temporary integer 
     410      INTEGER  ::   iku, ikv                                  ! local integer 
    382411      REAL(wp) ::   zfacti, zfactj, zatempw,zatempu,zatempv   ! local scalars 
    383       REAL(wp) ::   zbu, zbv, zbti, zbtj 
     412      REAL(wp) ::   zbu, zbv, zbti, zbtj                      !   -      - 
    384413      REAL(wp) ::   zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_lim2, zti_g_raw, zti_g_lim 
    385414      REAL(wp) ::   zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim 
    386415      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       !!---------------------------------------------------------------------- 
     416      !!---------------------------------------------------------------------- 
     417 
     418      IF( wrk_in_use(3, 2,3,4,5) .OR. wrk_in_use(2, 1) )THEN 
     419         CALL ctl_stop('ldf_slp_grif: requested workspace arrays are unavailable')   ;   RETURN 
     420      ENDIF 
    393421 
    394422      !--------------------------------! 
     
    572600      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    573601      ! 
     602      IF( wrk_not_released(3, 2,3,4,5) .OR.   & 
     603          wrk_not_released(2, 1)       )   CALL ctl_stop('ldf_slp_grif: failed to release workspace arrays') 
     604      ! 
    574605   END SUBROUTINE ldf_slp_grif 
    575606 
     
    591622      !!                omlmask         :  mixed layer mask 
    592623      !!---------------------------------------------------------------------- 
    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) 
     624      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   prd            ! in situ density 
     625      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   pn2            ! Brunt-Vaisala frequency (locally ref.) 
     626      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_gru, p_grv   ! i- & j-gradient of density (u- & v-pts) 
     627      REAL(wp), DIMENSION(:,:,:), INTENT(in) ::   p_dzr          ! z-gradient of density      (T-point) 
    597628      !! 
    598629      INTEGER  ::   ji , jj , jk         ! dummy loop indices 
     
    704735      !! 
    705736      !! ** Method  :   read the nammbf namelist and check the parameter  
    706       !!      values called by tra_dmp at the first timestep (nit000) 
     737      !!              values called by tra_dmp at the first timestep (nit000) 
    707738      !!---------------------------------------------------------------------- 
    708739      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     
    719750         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 
    720751         ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr ) 
    721          IF( ierr > 0 ) THEN 
    722             CALL ctl_stop( 'ldf_slp_init : unable to allocate Griffies operator slope ' )   ;   RETURN 
    723          ENDIF 
     752         IF( ierr > 0             )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 
     753         IF( ldf_slp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate workspace arrays' ) 
    724754         ! 
    725755         IF( ln_dynldf_iso )   CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 
    726756         ! 
    727          IF( ( ln_traldf_hor .AND. ln_dynldf_hor ) .AND. ln_sco )   & 
    728             &     CALL ctl_stop( 'ldf_slp_init: horizontal Griffies operator ',   & 
    729             &                                              'in s-coordinate not supported' ) 
     757         IF( ( ln_traldf_hor .OR. ln_dynldf_hor ) .AND. ln_sco )   & 
     758            CALL ctl_stop( 'ldf_slp_init: horizontal Griffies operator in s-coordinate not supported' ) 
    730759         ! 
    731760      ELSE                             ! Madec operator : slopes at u-, v-, and w-points 
    732761         ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                & 
    733762            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr ) 
    734          IF( ierr > 0 ) THEN 
    735             CALL ctl_stop( 'ldf_slp_init : unable to allocate Madec operator slope ' )   ;   RETURN 
    736          ENDIF 
     763         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 
    737764 
    738765         ! Direction of lateral diffusion (tracers and/or momentum) 
     
    745772!!gm I no longer understand this..... 
    746773         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 
    747             IF(lwp) THEN 
    748                WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
    749             ENDIF 
     774            IF(lwp)   WRITE(numout,*) '          Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 
    750775 
    751776            ! geopotential diffusion in s-coordinates on tracers and/or momentum 
     
    765790               END DO 
    766791            END DO 
    767             ! Lateral boundary conditions on the slopes 
    768             CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
    769             CALL lbc_lnk( wslpi, 'W', -1. )      ;      CALL lbc_lnk( wslpj, 'W', -1. ) 
     792            CALL lbc_lnk( uslp , 'U', -1. )   ;   CALL lbc_lnk( vslp , 'V', -1. )      ! Lateral boundary conditions 
     793            CALL lbc_lnk( wslpi, 'W', -1. )   ;   CALL lbc_lnk( wslpj, 'W', -1. ) 
    770794         ENDIF 
    771       ENDIF      ! 
     795      ENDIF 
     796      ! 
    772797   END SUBROUTINE ldf_slp_init 
    773798 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r2528 r2715  
    3636   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3737   !! $Id$ 
    38    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3939   !!---------------------------------------------------------------------- 
    40  
    4140CONTAINS 
    4241 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90

    r2528 r2715  
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    77   !! $Id$  
    8    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     8   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 
    1010 
     
    2828      !!         always harmonic      : aeiu = aeiv defined at T-level 
    2929      !!            aeiw defined at w-level 
    30       !! 
    3130      !!---------------------------------------------------------------------- 
    32       !! * Arguments 
    33       LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout 
    34  
    35       !! * Local variables 
    36       INTEGER ::   jk                  ! dummy loop indices 
    37       REAL(wp) ::   & 
    38          zkah, zahr, za00 , za01,   &  ! temporary scalars 
    39          zahf, zahs, zahtf, zahts 
     31      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout 
     32      ! 
     33      INTEGER  ::   jk   ! dummy loop indices 
     34      REAL(wp) ::   zkah, zahr, za00 , za01    ! local scalars 
     35      REAL(wp) ::   zahf, zahs, zahtf, zahts   !   -      - 
    4036      !!---------------------------------------------------------------------- 
    4137 
     
    130126      ENDIF 
    131127#endif 
    132  
     128      ! 
    133129   END SUBROUTINE ldf_tra_c1d 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90

    r2528 r2715  
    2525      !!       eddy induced velocity 
    2626      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts 
    27       !! 
    2827      !!---------------------------------------------------------------------- 
    29       !! * Arguments 
    30       LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout 
    31  
    32       !! * Local variables 
    33       INTEGER ::   ji, jj                  ! dummy loop indices 
     28      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout 
     29      ! 
     30      INTEGER ::   ji, jj   ! dummy loop indices 
    3431# if defined key_orca_r4 
    3532      INTEGER :: i1, i2, j1, j2 
    3633# endif 
    3734      REAL(wp) ::   za00, zd_max, zeumax, zevmax, zetmax 
    38        
    3935      !!---------------------------------------------------------------------- 
    4036 
     
    4339         IF(lwp) WRITE(numout,*) ' ldf_tra_c2d : 2D eddy diffusivity and eddy' 
    4440         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  induced velocity coefficients' 
    45          IF(lwp) WRITE(numout,*) 
    4641      ELSE 
    4742         IF(lwp) WRITE(numout,*) 
    4843         IF(lwp) WRITE(numout,*) ' ldf_tra2d : 2D eddy diffusivity coefficient' 
    4944         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --' 
    50          IF(lwp) WRITE(numout,*) 
    5145      ENDIF 
    5246 
     
    5751      ! ================== 
    5852      IF( ln_traldf_lap ) THEN 
    59    
     53         ! 
    6054         za00 = aht0 / zd_max 
    61    
     55         ! 
    6256         DO jj = 1, jpj  
    6357            DO ji = 1, jpi  
     
    167161         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    168162      ENDIF 
    169  
    170163# endif 
    171  
     164      ! 
    172165   END SUBROUTINE ldf_tra_c2d 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90

    r2528 r2715  
    66   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    77   !! $Id$  
    8    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     8   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    99   !!---------------------------------------------------------------------- 
    1010 
     
    2929      !!       eddy induced velocity 
    3030      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts 
    31       !! 
    3231      !!---------------------------------------------------------------------- 
    33       !! * Modules used 
    3432      USE ioipsl 
    35  
    36       !! * Arguments 
    37       LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout 
    38  
     33      ! 
     34      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout 
    3935      !!---------------------------------------------------------------------- 
    4036 
     
    4440         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  ' 
    4541         IF(lwp) WRITE(numout,*) '               Coefficients set to constant' 
    46          IF(lwp) WRITE(numout,*) 
    4742      ELSE 
    4843         IF(lwp) WRITE(numout,*) 
     
    5045         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- ' 
    5146         IF(lwp) WRITE(numout,*) '               Coefficients set to constant' 
    52          IF(lwp) WRITE(numout,*) 
    5347      ENDIF 
    5448 
     
    127121         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 
    128122      ENDIF 
    129  
    130 END SUBROUTINE ldf_tra_c3d 
     123      ! 
     124   END SUBROUTINE ldf_tra_c3d 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r2528 r2715  
    44   !! Ocean physics :  lateral tracer mixing coefficient defined in memory  
    55   !!===================================================================== 
    6    !! History :  9.0  !  02-11  (G. Madec)  Original code 
     6   !! History :  9.0  !  2002-11  (G. Madec)  Original code 
    77   !!---------------------------------------------------------------------- 
    8    USE par_oce         ! ocean parameters 
     8   USE par_oce        ! ocean parameters 
     9   USE in_out_manager ! I/O manager 
     10   USE lib_mpp         ! MPP library 
    911 
    1012   IMPLICIT NONE 
    1113   PRIVATE 
     14 
     15   PUBLIC ldftra_oce_alloc ! called by nemo_init->nemo_alloc, nemogcm.F90 
    1216 
    1317   !!---------------------------------------------------------------------- 
     
    3236 
    3337#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 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-,U-,V-,W-points 
    3539#elif defined key_traldf_c2d 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-, U-, V-, W-points 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-,U-,V-,W-points 
    3741#elif defined key_traldf_c1d 
    38    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-, U-, V-, W-points 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-,U-,V-,W-points 
    3943#else 
    40    REAL(wp), PUBLIC                         ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-, U-, V-, W-points 
     44   REAL(wp), PUBLIC                                      ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-,U-,V-,W-points 
    4145#endif 
    42  
    4346 
    4447#if defined key_traldf_eiv 
     
    4750   !!---------------------------------------------------------------------- 
    4851   LOGICAL, PUBLIC, PARAMETER               ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag 
    49        
     52    
     53   !                                                                              !!! eddy coefficients at U-, V-, W-points  [m2/s] 
    5054# 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] 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu , aeiv , aeiw   !: ** 3D coefficients ** 
    5256# elif defined key_traldf_c2d 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   aeiu, aeiv, aeiw  !: ** 2D coefficients ** at U-, V-, W-points  [m2/s] 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aeiu , aeiv , aeiw   !: ** 2D coefficients ** 
    5458# elif defined key_traldf_c1d 
    55    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   aeiu, aeiv, aeiw  !: ** 1D coefficients ** at U-, V-, W-points  [m2/s] 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   aeiu , aeiv , aeiw   !: ** 1D coefficients ** 
    5660# else 
    57    REAL(wp), PUBLIC                         ::   aeiu, aeiv, aeiw  !: ** 0D coefficients ** at U-, V-, W-points  [m2/s] 
     61   REAL(wp), PUBLIC                                      ::   aeiu , aeiv , aeiw   !: ** 0D coefficients ** 
    5862# endif 
    5963# if defined key_diaeiv 
    60    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s] 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s] 
    6165# endif 
    6266 
     
    7377   !! $Id$  
    7478   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     79   !!---------------------------------------------------------------------- 
     80CONTAINS 
     81 
     82   INTEGER FUNCTION ldftra_oce_alloc() 
     83     !!---------------------------------------------------------------------- 
     84      !!                 ***  FUNCTION ldftra_oce_alloc  *** 
     85     !!---------------------------------------------------------------------- 
     86     INTEGER, DIMENSION(3) :: ierr 
     87     !!---------------------------------------------------------------------- 
     88     ierr(:) = 0 
     89 
     90#if defined key_traldf_c3d 
     91      ALLOCATE( ahtt(jpi,jpj,jpk) , ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , ahtw(jpi,jpj,jpk) , STAT=ierr(1) ) 
     92#elif defined key_traldf_c2d 
     93      ALLOCATE( ahtt(jpi,jpj    ) , ahtu(jpi,jpj    ) , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) ) 
     94#elif defined key_traldf_c1d 
     95      ALLOCATE( ahtt(        jpk) , ahtu(        jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) ) 
     96#endif 
     97      ! 
     98#if defined key_traldf_eiv 
     99# if defined key_traldf_c3d 
     100      ALLOCATE( aeiu(jpi,jpj,jpk) , aeiv(jpi,jpj,jpk) , aeiw(jpi,jpj,jpk) , STAT=ierr(2) ) 
     101# elif defined key_traldf_c2d 
     102      ALLOCATE( aeiu(jpi,jpj    ) , aeiv(jpi,jpj    ) , aeiw(jpi,jpj    ) , STAT=ierr(2) ) 
     103# elif defined key_traldf_c1d 
     104      ALLOCATE( aeiu(        jpk) , aeiv(        jpk) , aeiw(        jpk) , STAT=ierr(2) ) 
     105# endif 
     106# if defined key_diaeiv 
     107      ALLOCATE( u_eiv(jpi,jpj,jpk), v_eiv(jpi,jpj,jpk), w_eiv(jpi,jpj,jpk), STAT=ierr(3)) 
     108# endif 
     109#endif 
     110      ldftra_oce_alloc = MAXVAL( ierr ) 
     111      IF( ldftra_oce_alloc /= 0 )   CALL ctl_warn('ldftra_oce_alloc: failed to allocate arrays') 
     112      ! 
     113   END FUNCTION ldftra_oce_alloc 
     114 
    75115   !!===================================================================== 
    76116END MODULE ldftra_oce 
Note: See TracChangeset for help on using the changeset viewer.