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/TRA – 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/TRA
Files:
27 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r2528 r2715  
    3333   USE dom_oce         ! ocean space and time domain 
    3434   USE phycst          ! physical constants 
     35   USE zdfddm          ! vertical physics: double diffusion 
    3536   USE in_out_manager  ! I/O manager 
    36    USE zdfddm          ! vertical physics: double diffusion 
     37   USE lib_mpp         ! MPP library 
    3738   USE prtctl          ! Print control 
    3839 
    … …  
    107108      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    108109      !!---------------------------------------------------------------------- 
    109       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    110       !                                                               ! 2 : salinity               [psu] 
    111       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   prd   ! in situ density  
     110      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     111      USE wrk_nemo, ONLY:   zws => wrk_3d_1   ! 3D workspace 
     112      !! 
     113      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
     114      !                                                      ! 2 : salinity               [psu] 
     115      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-] 
    112116      !! 
    113117      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    114       REAL(wp) ::   zt , zs , zh , zsr   ! temporary scalars 
    115       REAL(wp) ::   zr1, zr2, zr3, zr4   !    -         - 
    116       REAL(wp) ::   zrhop, ze, zbw, zb   !    -         - 
    117       REAL(wp) ::   zd , zc , zaw, za    !    -         - 
    118       REAL(wp) ::   zb1, za1, zkw, zk0   !    -         - 
    119       REAL(wp) ::   zrau0r               !    -         - 
    120       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! temporary workspace 
    121       !!---------------------------------------------------------------------- 
     118      REAL(wp) ::   zt , zs , zh , zsr   ! local scalars 
     119      REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      - 
     120      REAL(wp) ::   zrhop, ze, zbw, zb   !   -      - 
     121      REAL(wp) ::   zd , zc , zaw, za    !   -      - 
     122      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      - 
     123      REAL(wp) ::   zrau0r               !   -      - 
     124      !!---------------------------------------------------------------------- 
     125 
     126      IF( wrk_in_use(3, 1) ) THEN 
     127         CALL ctl_stop('eos_insitu: requested workspace array unavailable')   ;   RETURN 
     128      ENDIF 
    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( wrk_not_released(3, 1) )   CALL ctl_stop('eos_insitu: failed to release workspace array') 
    185194      ! 
    186195   END SUBROUTINE eos_insitu 
    … …  
    233242      !!                Brown and Campana, Mon. Weather Rev., 1978 
    234243      !!---------------------------------------------------------------------- 
    235       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    236       !                                                               ! 2 : salinity               [psu] 
    237       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density  
     244      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     245      USE wrk_nemo, ONLY:   zws => wrk_3d_1 ! 3D workspace 
     246      !! 
     247      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius] 
     248      !                                                                ! 2 : salinity               [psu] 
     249      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-] 
    238250      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced) 
    239  
     251      ! 
    240252      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    241       REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    242       REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !    -         - 
    243       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zws   ! 3D workspace 
    244       !!---------------------------------------------------------------------- 
     253      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars 
     254      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      - 
     255      !!---------------------------------------------------------------------- 
     256 
     257      IF( wrk_in_use(3, 1) ) THEN 
     258         CALL ctl_stop('eos_insitu_pot: requested workspace array unavailable')   ;   RETURN 
     259      ENDIF 
    245260 
    246261      SELECT CASE ( nn_eos ) 
    … …  
    311326      ! 
    312327      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
     328      ! 
     329      IF( wrk_not_released(3, 1) )   CALL ctl_stop('eos_insitu_pot: failed to release workspace array') 
    313330      ! 
    314331   END SUBROUTINE eos_insitu_pot 
    … …  
    351368      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 
    352369      !!---------------------------------------------------------------------- 
     370      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     371      USE wrk_nemo, ONLY:   zws => wrk_2d_5 ! 2D workspace 
     372      !! 
    353373      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    354374      !                                                           ! 2 : salinity               [psu] 
    … …  
    359379      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars 
    360380      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         - 
    361       REAL(wp), DIMENSION(jpi,jpj) ::   zws   ! 2D workspace 
    362       !!---------------------------------------------------------------------- 
    363  
    364       prd(:,:) = 0.e0 
     381      !!---------------------------------------------------------------------- 
     382 
     383      IF( wrk_in_use(2, 5) ) THEN 
     384         CALL ctl_stop('eos_insitu_2d: requested workspace array unavailable')   ;   RETURN 
     385      ENDIF 
     386 
     387      prd(:,:) = 0._wp 
    365388 
    366389      SELECT CASE( nn_eos ) 
    … …  
    434457      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    435458      ! 
     459      IF( wrk_not_released(2, 5) )   CALL ctl_stop('eos_insitu_2d: failed to release workspace array') 
     460      ! 
    436461   END SUBROUTINE eos_insitu_2d 
    437462 
    … …  
    469494      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius] 
    470495      !                                                               ! 2 : salinity               [psu] 
    471       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2    ! Brunt-Vaisala frequency [s-1] 
     496      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1] 
    472497      !! 
    473498      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    474       REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! temporary scalars  
     499      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars  
    475500#if defined key_zdfddm 
    476       REAL(wp) ::   zds   ! temporary scalars 
     501      REAL(wp) ::   zds   ! local scalars 
    477502#endif 
    478503      !!---------------------------------------------------------------------- 
    … …  
    488513               DO ji = 1, jpi 
    489514                  zgde3w = grav / fse3w(ji,jj,jk) 
    490                   zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )          ! potential temperature at w-point 
    491                   zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0   ! salinity anomaly (s-35) at w-point 
    492                   zh = fsdepw(ji,jj,jk)                                     ! depth in meters  at w-point 
     515                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt 
     516                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt 
     517                  zh = fsdepw(ji,jj,jk)                                                ! depth in meters  at w-point 
    493518                  ! 
    494519                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta 
    … …  
    586611      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts            ! pot. temperature & salinity 
    587612      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palph, pbeta   ! thermal & haline expansion coeff. 
    588       !! 
     613      ! 
    589614      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    590615      REAL(wp) ::   zt, zs, zh   ! local scalars  
    … …  
    661686      !!---------------------------------------------------------------------- 
    662687      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu] 
     688      ! Leave result array automatic rather than making explicitly allocated 
    663689      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius] 
    664690      !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r2561 r2715  
    2424   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2525   USE in_out_manager  ! I/O manager 
     26   USE iom             ! I/O module 
    2627   USE prtctl          ! Print control 
    27    USE iom 
     28   USE lib_mpp         ! MPP library 
    2829 
    2930   IMPLICIT NONE 
    … …  
    3233   PUBLIC   tra_adv        ! routine called by step module 
    3334   PUBLIC   tra_adv_init   ! routine called by opa module 
    34   
     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  
    4746   !! * Substitutions 
    4847#  include "domzgr_substitute.h90" 
    … …  
    6362      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    6463      !!---------------------------------------------------------------------- 
     64      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     65      USE wrk_nemo, ONLY:   zun => wrk_3d_1 , zvn => wrk_3d_2 , zwn => wrk_3d_3   ! 3D workspace 
     66      ! 
    6567      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    6668      ! 
    6769      INTEGER ::   jk   ! dummy loop index 
    68       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! 3D workspace: effective transport 
    69       !!---------------------------------------------------------------------- 
     70      !!---------------------------------------------------------------------- 
     71      ! 
     72      IF( wrk_in_use(3, 1,2,3) ) THEN 
     73         CALL ctl_stop('tra_adv: requested workspace arrays unavailable')   ;   RETURN 
     74      ENDIF 
    7075      !                                          ! set time step 
    7176      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    72          r2dt(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
     77         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
    7378      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    74          r2dt(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
     79         r2dtra(:) = 2._wp * rdttra(:)                   ! = 2 rdttra (leapfrog) 
    7580      ENDIF 
    7681      ! 
    … …  
    95100 
    96101      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    97       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRA',       zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
    98       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
    99       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL  
    100       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
    101       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
    102       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
     102      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
     103      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
     104      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL  
     105      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
     106      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
     107      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
    103108      ! 
    104109      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    105          CALL tra_adv_cen2  ( kt, 'TRA',       zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     110         CALL tra_adv_cen2  ( kt, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    106111         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               & 
    107112            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    108          CALL tra_adv_tvd   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     113         CALL tra_adv_tvd   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    109114         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               & 
    110115            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    111          CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts )           
     116         CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )           
    112117         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               & 
    113118            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    114          CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     119         CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    115120         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               & 
    116121            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    117          CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     122         CALL tra_adv_ubs   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    118123         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               & 
    119124            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    120          CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     125         CALL tra_adv_qck   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    121126         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               & 
    122127            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    … …  
    126131      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    127132         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     133      ! 
     134      IF( wrk_not_released(3,1,2,3) )   CALL ctl_stop('tra_adv: failed to release workspace arrays') 
    128135      ! 
    129136   END SUBROUTINE tra_adv 
    … …  
    144151      !!---------------------------------------------------------------------- 
    145152 
    146       REWIND ( numnam )               ! Read Namelist namtra_adv : tracer advection scheme 
    147       READ   ( numnam, namtra_adv ) 
     153      REWIND( numnam )                ! Read Namelist namtra_adv : tracer advection scheme 
     154      READ  ( numnam, namtra_adv ) 
    148155 
    149156      IF(lwp) THEN                    ! Namelist print 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2528 r2715  
    3131   USE restart         ! ocean restart 
    3232   USE trc_oce         ! share passive tracers/Ocean variables 
     33   USE lib_mpp         ! MPP library 
    3334 
    3435   IMPLICIT NONE 
    3536   PRIVATE 
    3637 
    37    PUBLIC   tra_adv_cen2    ! routine called by step.F90 
    38    PUBLIC   ups_orca_set    ! routine used by traadv_cen2_jki.F90 
     38   PUBLIC   tra_adv_cen2       ! routine called by step.F90 
     39   PUBLIC   ups_orca_set       ! routine used by traadv_cen2_jki.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" 
    … …  
    109110      !!              - save trends if needed 
    110111      !!---------------------------------------------------------------------- 
    111       USE oce         , zwx => ua   ! use ua as workspace 
    112       USE oce         , zwy => va   ! use va as workspace 
    113       !! 
     112      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     113      USE oce     , ONLY:   zwx => ua       , zwy  => va         ! (ua,va) used as 3D workspace 
     114      USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zind => wrk_3d_2   ! 3D workspace 
     115      USE wrk_nemo, ONLY:   ztfreez => wrk_2d_1                  ! 2D     - 
     116      ! 
    114117      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    115118      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    118121      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    119122      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    120       !! 
    121       INTEGER  ::   ji, jj, jk, jn                   ! dummy loop indices 
    122       REAL(wp) ::   zbtr, ztra                       ! temporary scalars 
    123       REAL(wp) ::   zfp_ui, zfp_vj, zfp_w            !    -         - 
    124       REAL(wp) ::   zfm_ui, zfm_vj, zfm_w            !    -         - 
    125       REAL(wp) ::   zcofi , zcofj , zcofk            !    -         - 
    126       REAL(wp) ::   zupsut, zcenut                   !    -         - 
    127       REAL(wp) ::   zupsvt, zcenvt                   !    -         - 
    128       REAL(wp) ::   zupst , zcent                    !    -         - 
    129       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  
     123      ! 
     124      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     125      INTEGER  ::   ierr             ! local integer 
     126      REAL(wp) ::   zbtr, ztra                            ! local scalars 
     127      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w, zcofi          !   -      - 
     128      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w, zcofj, zcofk   !   -      - 
     129      REAL(wp) ::   zupsut, zcenut, zupst                 !   -      - 
     130      REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      - 
     131      !!---------------------------------------------------------------------- 
     132 
     133      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
     134         CALL ctl_stop('tra_adv_cen2: requested workspace arrays unavailable')   ;   RETURN 
     135      ENDIF 
    134136 
    135137      IF( kt == nit000 )  THEN 
    … …  
    139141         IF(lwp) WRITE(numout,*) 
    140142         ! 
    141          upsmsk(:,:) = 0.e0                              ! not upstream by default 
     143         ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
     144         IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 
     145         ! 
     146         upsmsk(:,:) = 0._wp                             ! not upstream by default 
    142147         !  
    143148         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits 
    … …  
    151156         ! 
    152157         l_trd = .FALSE. 
    153          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     158         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    154159      ENDIF 
    155160      ! 
    … …  
    269274         CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb ) 
    270275      ENDIF 
     276      ! 
     277      IF( wrk_not_released(2, 1)   .OR.   & 
     278          wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays') 
    271279      ! 
    272280   END SUBROUTINE tra_adv_cen2 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r2528 r2715  
    2525   USE phycst          ! physical constants 
    2626   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    27    USE diaar5, ONLY :   lk_diaar5 
     27   USE diaar5, ONLY:   lk_diaar5 
    2828# endif   
    2929 
    … …  
    4141   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4242   !! $Id$ 
    43    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    44    !!---------------------------------------------------------------------- 
    45  
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     44   !!---------------------------------------------------------------------- 
    4645CONTAINS 
    4746 
    … …  
    6463      !! ** Action  : - add to p.n the eiv component 
    6564      !!---------------------------------------------------------------------- 
     65      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     66      USE wrk_nemo, ONLY:   zu_eiv => wrk_2d_1 , zv_eiv => wrk_2d_2 , zw_eiv => wrk_2d_3   ! 2D workspace 
     67# if defined key_diaeiv  
     68      USE wrk_nemo, ONLY:   z2d => wrk_2d_4   ! 2D workspace 
     69#endif 
    6670      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
    6771      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    7377      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
    7478      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
    75       REAL(wp), DIMENSION(jpi,jpj) ::   zu_eiv, zv_eiv, zw_eiv     ! 2D workspace 
    7679# if defined key_diaeiv  
    7780      REAL(wp) ::   zztmp                      ! local scalar 
    78       REAL(wp), DIMENSION(jpi,jpj) ::   z2d    ! 2D workspace 
    7981# endif   
    8082      !!---------------------------------------------------------------------- 
     83 
     84# if defined key_diaeiv  
     85      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
     86# else 
     87      IF( wrk_in_use(2, 1,2,3)   ) THEN 
     88# endif 
     89         CALL ctl_stop('tra_adv_eiv: requested workspace arrays are unavailable')   ;   RETURN 
     90      ENDIF 
    8191 
    8292      IF( kt == nit000 )  THEN 
    … …  
    180190# endif   
    181191      !  
     192# if defined key_diaeiv  
     193      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('tra_adv_eiv: failed to release workspace arrays') 
     194# else 
     195      IF( wrk_not_released(2, 1,2,3)   )   CALL ctl_stop('tra_adv_eiv: failed to release workspace arrays') 
     196# endif 
     197      ! 
    182198    END SUBROUTINE tra_adv_eiv 
    183199 
    … …  
    191207      CHARACTER(len=3) ::   cdtype 
    192208      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn 
    193       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype 
    194       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
     209      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
    195210   END SUBROUTINE tra_adv_eiv 
    196211#endif 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2528 r2715  
    6161      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6262      !!---------------------------------------------------------------------- 
    63       USE oce         , zwx => ua   ! use ua as workspace 
    64       USE oce         , zwy => va   ! use va as workspace 
    65       !! 
     63      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     64      USE oce     , ONLY:   zwx   => ua       , zwy   => va          ! (ua,va) used as workspace 
     65      USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2    ! 3D workspace 
     66      ! 
    6667      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    6768      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    7172      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field 
    7273      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    73       !! 
     74      ! 
    7475      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    75       REAL(wp) ::   zu, z0u, zzwx    ! local scalar 
    76       REAL(wp) ::   zv, z0v, zzwy    !   -      - 
    77       REAL(wp) ::   zw, z0w          !   -      - 
    78       REAL(wp) ::   ztra, zbtr, zdt, zalpha 
    79       REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy   ! 3D workspace 
     76      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars 
     77      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
     78      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    8079      !!---------------------------------------------------------------------- 
     80 
     81      IF( wrk_in_use(3, 1,2) ) THEN 
     82         CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable')   ;   RETURN 
     83      ENDIF 
    8184 
    8285      IF( kt == nit000 )  THEN 
    … …  
    249252      ENDDO 
    250253      ! 
     254      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable') 
     255      ! 
    251256   END SUBROUTINE tra_adv_muscl 
    252257 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2528 r2715  
    11MODULE traadv_muscl2 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  traadv_muscl2  *** 
    44   !! Ocean  tracers:  horizontal & vertical advective trend 
    5    !!============================================================================== 
     5   !!====================================================================== 
    66   !! History :  1.0  !  2002-06  (G. Madec) from traadv_muscl 
    77   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    … …  
    5959      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6060      !!---------------------------------------------------------------------- 
    61       USE oce         , zwx => ua   ! use ua as workspace 
    62       USE oce         , zwy => va   ! use va as workspace 
     61      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     62      USE oce     , ONLY:   zwx   => ua       , zwy   => va         ! (ua,va) used as 3D workspace 
     63      USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2   ! 3D workspace 
    6364      !! 
    6465      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7172      !! 
    7273      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    73       REAL(wp) ::   zu, z0u, zzwx    ! local scalar 
    74       REAL(wp) ::   zv, z0v, zzwy    !   -      - 
    75       REAL(wp) ::   zw, z0w          !   -      - 
    76       REAL(wp) ::   ztra, zbtr, zdt, zalpha 
    77       REAL(wp), DIMENSION (jpi,jpj,jpk) ::  zslpx, zslpy   ! 3D workspace 
     74      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars 
     75      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      - 
     76      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      - 
    7877      !!---------------------------------------------------------------------- 
     78 
     79      IF( wrk_in_use(3, 1,2) ) THEN 
     80         CALL ctl_stop('tra_adv_muscl2: requested workspace arrays are unavailable')   ;   RETURN 
     81      ENDIF 
    7982 
    8083      IF( kt == nit000 )  THEN 
    … …  
    8487         ! 
    8588         l_trd = .FALSE. 
    86          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     89         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    8790      ENDIF 
    8891 
    … …  
    282285      END DO 
    283286      ! 
     287      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl2: failed to release workspace arrays') 
     288      ! 
    284289   END SUBROUTINE tra_adv_muscl2 
    285290 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2528 r2715  
    115115      !! 
    116116      !!---------------------------------------------------------------------- 
    117       USE oce         , zwx => ua   ! use ua as workspace 
    118       !! 
    119       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    120       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    121       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    122       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    123       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun             ! i-velocity components 
    124       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    125       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    126       !! 
    127       INTEGER  :: ji, jj, jk, jn           ! dummy loop indices 
    128       REAL(wp) :: ztra, zbtr               ! local scalars 
    129       REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace 
     117      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     118      USE oce     , ONLY:   zwx => ua       ! ua used as workspace 
     119      USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     120      ! 
     121      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     122      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     123      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     124      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step 
     125      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components 
     126      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
     127      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     128      !! 
     129      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
     130      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
    131131      !---------------------------------------------------------------------- 
    132  
     132      ! 
     133      IF( wrk_in_use(3, 1,2,3) ) THEN 
     134         CALL ctl_stop('tra_adv_qck_i: requested workspace arrays unavailable')   ;   RETURN 
     135      ENDIF 
    133136      !                                                          ! =========== 
    134137      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    188191               DO ji = fs_2, fs_jpim1   ! vector opt.                
    189192                  zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    190                ENDDO 
     193               END DO 
    191194            END DO 
    192195         END DO 
    … …  
    225228      END DO 
    226229      ! 
     230      IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays') 
     231      ! 
    227232   END SUBROUTINE tra_adv_qck_i 
    228233 
    … …  
    233238      !! 
    234239      !!---------------------------------------------------------------------- 
    235       USE oce         , zwy => ua   ! use ua as workspace 
    236       !! 
    237       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    238       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    239       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    240       REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    241       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn             ! j-velocity components 
    242       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    243       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    244       !! 
    245       INTEGER  :: ji, jj, jk, jn           ! dummy loop indices 
    246       REAL(wp) :: ztra, zbtr               ! local scalars 
    247       REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
    248       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace 
     240      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     241      USE oce     , ONLY:   zwy => ua       ! ua used as workspace 
     242      USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     243      ! 
     244      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     245      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     246      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     247      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step 
     248      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components 
     249      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
     250      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     251      !! 
     252      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
     253      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars 
    249254      !---------------------------------------------------------------------- 
    250  
     255      ! 
     256      IF(wrk_in_use(3, 1,2,3))THEN 
     257         CALL ctl_stop('tra_adv_qck_j: ERROR: requested workspace arrays unavailable') 
     258         RETURN 
     259      END IF 
    251260      !                                                          ! =========== 
    252261      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    350359      END DO 
    351360      ! 
     361      IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays') 
     362      ! 
    352363   END SUBROUTINE tra_adv_qck_j 
    353364 
    … …  
    358369      !! 
    359370      !!---------------------------------------------------------------------- 
    360       USE oce         , zwz => ua   ! use ua as workspace 
    361       !! 
    362       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    363       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    364       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    365       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn             ! vertical velocity  
    366       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! before and now tracer fields 
    367       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    368       !! 
     371      USE oce, ONLY:   zwz => ua   ! ua used as workspace 
     372      ! 
     373      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
     374      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     375      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers 
     376      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity  
     377      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! before and now tracer fields 
     378      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
     379      ! 
    369380      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    370       REAL(wp) ::   zbtr , ztra      ! temporary scalars 
     381      REAL(wp) ::   zbtr , ztra      ! local scalars 
    371382      !!---------------------------------------------------------------------- 
    372383 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r2528 r2715  
    2525   USE dom_oce         ! ocean space and time domain 
    2626   USE trdmod_oce      ! tracers trends 
    27    USE trdtra      ! tracers trends 
     27   USE trdtra          ! tracers trends 
    2828   USE in_out_manager  ! I/O manager 
    2929   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    30    USE lib_mpp 
     30   USE lib_mpp         ! MPP library 
    3131   USE lbclnk          ! ocean lateral boundary condition (or mpp link)  
    3232   USE diaptr          ! poleward transport diagnostics 
    … …  
    3939   PUBLIC   tra_adv_tvd    ! routine called by step.F90 
    4040 
    41    LOGICAL  :: l_trd       ! flag to compute trends 
     41   LOGICAL ::   l_trd   ! flag to compute trends 
    4242 
    4343   !! * Substitutions 
    … …  
    6666      !!             - save the trends  
    6767      !!---------------------------------------------------------------------- 
    68       USE oce         , zwx => ua   ! use ua as workspace 
    69       USE oce         , zwy => va   ! use va as workspace 
    70       !! 
     68      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     69      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace 
     70      USE wrk_nemo, ONLY:   zwi => wrk_3d_12 , zwz => wrk_3d_13   ! 3D workspace 
     71      ! 
    7172      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    7273      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    7677      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    7778      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    78       !! 
     79      ! 
    7980      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices   
    8081      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar 
    8182      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    8283      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    83       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwi, zwz   ! 3D workspace 
    8484      REAL(wp), DIMENSION (:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
    8585      !!---------------------------------------------------------------------- 
     86 
     87      IF( wrk_in_use(3, 12,13) ) THEN 
     88         CALL ctl_stop('tra_adv_tvd: requested workspace arrays unavailable')   ;   RETURN 
     89      ENDIF 
    8690 
    8791      IF( kt == nit000 )  THEN 
    … …  
    235239         ENDIF 
    236240         ! 
    237       ENDDO 
     241      END DO 
    238242      ! 
    239243      IF( l_trd )  THEN 
    240244        DEALLOCATE( ztrdx )     ;     DEALLOCATE( ztrdy )     ;      DEALLOCATE( ztrdz )   
    241245      END IF 
     246      ! 
     247      IF( wrk_not_released(3, 12,13) )   CALL ctl_stop('tra_adv_tvd: failed to release workspace arrays') 
    242248      ! 
    243249   END SUBROUTINE tra_adv_tvd 
    … …  
    257263      !!       in-space based differencing for fluid 
    258264      !!---------------------------------------------------------------------- 
     265      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     266      USE wrk_nemo, ONLY:   zbetup => wrk_3d_8  , zbetdo => wrk_3d_9    ! 3D workspace 
     267      USE wrk_nemo, ONLY:   zbup   => wrk_3d_10 , zbdo   => wrk_3d_11   !  -     - 
     268      ! 
    259269      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
    260270      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
    261271      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    262       !! 
    263       INTEGER ::   ji, jj, jk               ! dummy loop indices 
    264       INTEGER ::   ikm1 
    265       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo 
    266       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbup, zbdo 
    267       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt 
    268       REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv 
    269       REAL(wp) ::   zup, zdo 
    270       !!---------------------------------------------------------------------- 
    271  
    272       zbig = 1.e+40 
    273       zrtrn = 1.e-15 
    274       zbetup(:,:,jpk) = 0.e0   ;   zbetdo(:,:,jpk) = 0.e0 
     272      ! 
     273      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     274      INTEGER ::   ikm1         ! local integer 
     275      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars 
     276      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
     277      !!---------------------------------------------------------------------- 
     278 
     279      IF( wrk_in_use(3, 8,9,10,11) ) THEN 
     280         CALL ctl_stop('nonosc: requested workspace array unavailable')   ;   RETURN 
     281      ENDIF 
     282 
     283      zbig  = 1.e+40_wp 
     284      zrtrn = 1.e-15_wp 
     285      zbetup(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp 
    275286 
    276287 
    … …  
    348359      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    349360      ! 
     361      IF( wrk_not_released(3, 8,9,10,11) )   CALL ctl_stop('nonosc: failed to release workspace arrays') 
     362      ! 
    350363   END SUBROUTINE nonosc 
    351364 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r2528 r2715  
    7373      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741.  
    7474      !!---------------------------------------------------------------------- 
    75       USE oce         , zwx => ua   ! use ua as workspace 
    76       USE oce         , zwy => va   ! use va as workspace 
    77       !! 
     75      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     76      USE oce     , ONLY:   zwx  => ua       , zwy  => va         ! (ua,va) used as workspace 
     77      USE wrk_nemo, ONLY:   ztu  => wrk_3d_1 , ztv  => wrk_3d_2   ! 3D workspace 
     78      USE wrk_nemo, ONLY:   zltu => wrk_3d_3 , zltv => wrk_3d_4   !  -      - 
     79      USE wrk_nemo, ONLY:   zti  => wrk_3d_5 , ztw  => wrk_3d_6   !  -      - 
     80      ! 
    7881      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    7982      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    8386      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    8487      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    85       !! 
    86       INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices 
    87       REAL(wp) ::   ztra, zbtr, zcoef       ! local scalars 
    88       REAL(wp) ::   zfp_ui, zfm_ui, zcenut  !   -      - 
    89       REAL(wp) ::   zfp_vj, zfm_vj, zcenvt  !   -      - 
    90       REAL(wp) ::   z2dtt                   !   -      - 
    91       REAL(wp) ::   ztak, zfp_wk, zfm_wk    !   -      - 
    92       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       !!---------------------------------------------------------------------- 
     88      ! 
     89      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     90      REAL(wp) ::   ztra, zbtr, zcoef, z2dtt                       ! local scalars 
     91      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      - 
     92      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      - 
     93      !!---------------------------------------------------------------------- 
     94 
     95      IF( wrk_in_use(3, 1,2,3,4,5,6) )THEN 
     96         CALL ctl_stop('tra_adv_ubs: requested workspace arrays unavailable')   ;   RETURN 
     97      ENDIF 
    9698 
    9799      IF( kt == nit000 )  THEN 
    … …  
    266268      ENDDO 
    267269      ! 
     270      IF( wrk_not_released(3, 1,2,3,4,5,6) )   CALL ctl_stop('tra_adv_ubs: failed to release workspace arrays') 
     271      ! 
    268272   END SUBROUTINE tra_adv_ubs 
    269273 
    … …  
    282286      !!       in-space based differencing for fluid 
    283287      !!---------------------------------------------------------------------- 
     288      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     289      USE wrk_nemo, ONLY:   zbetup => wrk_3d_1, zbetdo => wrk_3d_2   ! 3D workspace 
     290      ! 
    284291      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step 
    285292      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
    286293      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field 
    287294      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction 
    288       !! 
    289       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    290       INTEGER  ::   ikm1 
    291       REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt 
    292       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo 
    293       !!---------------------------------------------------------------------- 
    294  
    295       zbig = 1.e+40 
    296       zrtrn = 1.e-15 
    297       zbetup(:,:,:) = 0.e0   ;   zbetdo(:,:,:) = 0.e0 
     295      ! 
     296      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     297      INTEGER  ::   ikm1         ! local integer 
     298      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! local scalars 
     299      !!---------------------------------------------------------------------- 
     300 
     301      IF( wrk_in_use(3, 1,2) ) THEN 
     302         CALL ctl_stop('nonosc_z: requested workspace arrays unavailable')   ;   RETURN 
     303      ENDIF 
     304 
     305      zbig  = 1.e+40_wp 
     306      zrtrn = 1.e-15_wp 
     307      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
    298308 
    299309      ! Search local extrema 
    … …  
    363373      END DO 
    364374      ! 
     375      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('nonosc_z: failed to release workspace arrays') 
     376      ! 
    365377   END SUBROUTINE nonosc_z 
    366378 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r2528 r2715  
    6767      !!              Emile-Geay and Madec, 2009, Ocean Science. 
    6868      !!---------------------------------------------------------------------- 
    69       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     69      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7070      !! 
    7171      INTEGER  ::   ji, jj, ik    ! dummy loop indices 
    7272      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend 
    73       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt 
     73      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt 
    7474      !!---------------------------------------------------------------------- 
    7575      ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r2528 r2715  
    1717   !!   'key_trabbl'   or                             bottom boundary layer 
    1818   !!---------------------------------------------------------------------- 
     19   !!   tra_bbl_alloc : allocate trabbl arrays 
    1920   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 
    2021   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend 
    … …  
    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 
    63    LOGICAL, PUBLIC              ::   l_bbl                    !: flag to compute bbl diffu. flux coef and transport 
     56   LOGICAL , PUBLIC ::   l_bbl                  !: flag to compute bbl diffu. flux coef and transport 
     57    
     58   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coeff. at u & v-pts 
     60 
     61   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level 
     62   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
     64   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points 
     65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2] 
    6466 
    6567   !! * Substitutions 
    … …  
    7274   !!---------------------------------------------------------------------- 
    7375CONTAINS 
     76 
     77   INTEGER FUNCTION tra_bbl_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      !!                ***  FUNCTION tra_bbl_alloc  *** 
     80      !!---------------------------------------------------------------------- 
     81      ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d  (jpi,jpj) , mgrhu(jpi,jpj) ,     & 
     82         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     & 
     83         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          & 
     84         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj)                  , STAT= tra_bbl_alloc ) 
     85         ! 
     86      IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc ) 
     87      IF( tra_bbl_alloc > 0 )   CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.') 
     88   END FUNCTION tra_bbl_alloc 
     89 
    7490 
    7591   SUBROUTINE tra_bbl( kt ) 
    … …  
    153169      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    154170      !!----------------------------------------------------------------------   
    155       INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
    156       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields 
    157       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta   ! tracer trend  
    158       !! 
     171      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     172      USE wrk_nemo, ONLY:   zptb => wrk_2d_1 
     173      ! 
     174      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
     175      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
     176      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend  
     177      ! 
    159178      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    160179      INTEGER  ::   ik           ! local integers 
    161180      REAL(wp) ::   zbtr         ! local scalars 
    162       REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! tracer trend  
    163       !!---------------------------------------------------------------------- 
     181      !!---------------------------------------------------------------------- 
     182      ! 
     183      IF( wrk_in_use(2,1) ) THEN 
     184         CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable')   ;   RETURN 
     185      ENDIF 
    164186      ! 
    165187      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    185207#  endif 
    186208               ik = mbkt(ji,jj)                            ! bottom T-level index 
    187                zbtr = e1e2t_r(ji,jj)  / fse3t(ji,jj,ik) 
     209               zbtr = r1_e1e2t(ji,jj)  / fse3t(ji,jj,ik) 
    188210               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & 
    189211                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   & 
    … …  
    196218      END DO                                                ! end tracer 
    197219      !                                                     ! =========== 
     220      IF( wrk_not_released(2,1) )   CALL ctl_stop('tra_bbl_dif: failed to release workspace array') 
     221      ! 
    198222   END SUBROUTINE tra_bbl_dif 
    199223    
    … …  
    214238      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    215239      !!----------------------------------------------------------------------   
    216       INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
    217       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields 
    218       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta   ! tracer trend  
    219       !! 
     240      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
     241      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
     242      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend  
     243      ! 
    220244      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
    221245      INTEGER  ::   iis , iid , ijs , ijd    ! local integers 
    … …  
    242266                  ! 
    243267                  !                                               ! up  -slope T-point (shelf bottom point) 
    244                   zbtr = e1e2t_r(iis,jj) / fse3t(iis,jj,ikus) 
     268                  zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 
    245269                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    246270                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
    247271                  !                    
    248272                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    249                      zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,jk) 
     273                     zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 
    250274                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    251275                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
    252276                  END DO 
    253277                  !  
    254                   zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,ikud) 
     278                  zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 
    255279                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    256280                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
    … …  
    264288                  !  
    265289                  ! up  -slope T-point (shelf bottom point) 
    266                   zbtr = e1e2t_r(ji,ijs) / fse3t(ji,ijs,ikvs) 
     290                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 
    267291                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    268292                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
    269293                  !                    
    270294                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    271                      zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,jk) 
     295                     zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 
    272296                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    273297                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
    274298                  END DO 
    275299                  !                                               ! down-slope T-point (deep bottom point) 
    276                   zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,ikvd) 
     300                  zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 
    277301                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    278302                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
    … …  
    314338      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    315339      !!----------------------------------------------------------------------   
     340      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     341      USE wrk_nemo, ONLY:   zub => wrk_2d_1 , ztb => wrk_2d_2                      ! 2D workspace 
     342      USE wrk_nemo, ONLY:   zvb => wrk_2d_3 , zsb => wrk_2d_4 , zdep => wrk_2d_5 
     343      ! 
    316344      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    317345      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    323351      REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars 
    324352      REAL(wp) ::   zgdrho, zt, zs, zh        !   -      - 
    325       REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb, ztb, zsb, zdep  !  2D workspace 
    326353      !! 
    327354      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function 
    … …  
    357384                                          - 0.121555e-07 ) * pfh 
    358385      !!---------------------------------------------------------------------- 
    359        
     386 
     387      IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 
     388         CALL ctl_stop('bbl: requested workspace arrays unavailable')   ;   RETURN 
     389      ENDIF 
     390      
    360391      IF( kt == nit000 )  THEN 
    361392         IF(lwp)  WRITE(numout,*) 
    … …  
    494525      ENDIF 
    495526      ! 
     527      IF( wrk_not_released(2, 1,2,3,4,5) )   CALL ctl_stop('bbl: failed to release workspace arrays') 
     528      ! 
    496529   END SUBROUTINE bbl 
    497530 
    … …  
    504537      !! 
    505538      !! ** Method  :   Read the nambbl namelist and check the parameters 
    506       !!              called by tra_bbl at the first timestep (nit000) 
    507       !!---------------------------------------------------------------------- 
     539      !!              called by nemo_init at the first timestep (nit000) 
     540      !!---------------------------------------------------------------------- 
     541      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     542      USE wrk_nemo, ONLY:   zmbk => wrk_2d_1       ! 2D workspace 
    508543      INTEGER ::   ji, jj               ! dummy loop indices 
    509544      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer 
    510       REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace  
    511545      !! 
    512546      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 
    513547      !!---------------------------------------------------------------------- 
     548 
     549      IF( wrk_in_use(2,1) ) THEN 
     550         CALL ctl_stop('tra_bbl_init: requested workspace array unavailable')   ;   RETURN 
     551      ENDIF 
    514552 
    515553      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme 
    … …  
    528566         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s' 
    529567      ENDIF 
    530        
     568 
     569      !                              ! allocate trabbl arrays 
     570      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 
     571      
    531572      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity' 
    532573      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)' 
    … …  
    536577 
    537578      !                             !* inverse of surface of T-cells 
    538       e1e2t_r(:,:) = 1.0 / ( e1t(:,:) * e2t(:,:) ) 
     579      r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) ) 
    539580       
    540581      !                             !* vertical index of  "deep" bottom u- and v-points 
    … …  
    594635      ENDIF 
    595636      ! 
     637      IF( wrk_not_released(2,1) )   CALL ctl_stop('tra_bbl_init: failed to release workspace array') 
     638      ! 
    596639   END SUBROUTINE tra_bbl_init 
    597640 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r2528 r2715  
    1919   !!   'key_tradmp'                                       internal damping 
    2020   !!---------------------------------------------------------------------- 
     21   !!   tra_dmp_alloc : allocate tradmp arrays 
    2122   !!   tra_dmp       : update the tracer trend with the internal damping 
    2223   !!   tra_dmp_init  : initialization, namlist read, parameters control 
    … …  
    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   INTEGER FUNCTION tra_dmp_alloc() 
     77      !!---------------------------------------------------------------------- 
     78      !!                ***  FUNCTION tra_bbl_alloc  *** 
     79      !!---------------------------------------------------------------------- 
     80      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
     81      ! 
     82      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
     83      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed') 
     84   END FUNCTION tra_dmp_alloc 
     85 
    7486 
    7587   SUBROUTINE tra_dmp( kt ) 
    … …  
    193205      ENDIF 
    194206 
     207      !                              ! allocate tradmp arrays 
     208      IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
     209 
    195210      SELECT CASE ( nn_hdmp ) 
    196211      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
    … …  
    312327      USE iom 
    313328      USE ioipsl 
     329      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     330      USE wrk_nemo, ONLY:   zhfac => wrk_1d_1, zmrs => wrk_2d_1 , zdct  => wrk_3d_1   ! 1D, 2D, 3D workspace 
    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( wrk_in_use(1, 1) .OR.   & 
     350          wrk_in_use(2, 1) .OR.   & 
     351          wrk_in_use(3, 1)   ) THEN 
     352          CALL ctl_stop('dtacof: requested workspace arrays unavailable')   ;   RETURN 
     353      ENDIF 
    335354      !                                   ! ==================== 
    336355      !                                   !  ORCA configuration : global domain 
    … …  
    525544      ENDIF 
    526545      ! 
     546      IF( wrk_not_released(1, 1) .OR.   & 
     547          wrk_not_released(2, 1) .OR.   & 
     548          wrk_not_released(3, 1) )   CALL ctl_stop('dtacof: failed to release workspace arrays') 
     549      ! 
    527550   END SUBROUTINE dtacof 
    528551 
    … …  
    549572      !!---------------------------------------------------------------------- 
    550573      USE ioipsl      ! IOipsl librairy 
     574      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     575      USE wrk_nemo, ONLY:   zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4 
    551576      !! 
    552577      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline 
    553578      !! 
    554       INTEGER ::   ji, jj, jk, jl      ! dummy loop indices 
    555       INTEGER ::   iju, ijt            ! temporary integers 
    556       INTEGER ::   icoast, itime 
    557       INTEGER ::   icot         ! logical unit for file distance to the coast 
    558       LOGICAL, DIMENSION(jpi,jpj) ::   llcotu, llcotv, llcotf   ! ??? 
    559       CHARACTER (len=32) ::   clname 
    560       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       !!---------------------------------------------------------------------- 
     579      INTEGER ::   ji, jj, jk, jl   ! dummy loop indices 
     580      INTEGER ::   iju, ijt, icoast, itime, ierr, icot   ! local integers 
     581      CHARACTER (len=32) ::   clname                     ! local name 
     582      REAL(wp) ::   zdate0                               ! local scalar 
     583      LOGICAL , ALLOCATABLE, DIMENSION(:,:) ::   llcotu, llcotv, llcotf   ! 2D logical workspace 
     584      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   zxc, zyc, zzc, zdis    ! temporary workspace 
     585      !!---------------------------------------------------------------------- 
     586 
     587      IF( wrk_in_use(2, 1,2,3,4) .OR.  & 
     588          wrk_in_use(1, 1,2,3,4)  ) THEN 
     589          CALL ctl_stop('cofdis: requested workspace arrays unavailable')   ;   RETURN 
     590      ENDIF 
     591 
     592      ALLOCATE( llcotu(jpi,jpj) , llcotv(jpi,jpj) , llcotf(jpi,jpj) ,                        & 
     593         &      zxc (3*jpi*jpj) , zyc (3*jpi*jpj) , zzc (3*jpi*jpj) , zdis (3*jpi*jpj) , STAT=ierr ) 
     594      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     595      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cofdis: requested local arrays unavailable') 
    564596 
    565597      ! 0. Initialization 
    … …  
    713745      CALL restclo( icot ) 
    714746      ! 
     747      IF( wrk_not_released(2, 1,2,3,4) .OR. &  
     748          wrk_not_released(1, 1,2,3,4)  )   CALL ctl_stop('cofdis: failed to release workspace arrays') 
     749      DEALLOCATE( llcotu , llcotv , llcotf ,      & 
     750         &        zxc    , zyc    , zzc    , zdis ) 
     751      ! 
    715752   END SUBROUTINE cofdis 
    716753 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r2528 r2715  
    3737   ! 
    3838   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    39 #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 #endif 
     39 
     40   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile 
     41   !                                                               !  (key_traldf_ano only) 
    4242 
    4343   !! * Substitutions 
    … …  
    130130      !!---------------------------------------------------------------------- 
    131131      INTEGER ::   ioptio, ierr         ! temporary integers  
    132 !       
    133132      !!---------------------------------------------------------------------- 
    134133 
    … …  
    238237      !! ** Purpose :   initializations of  
    239238      !!---------------------------------------------------------------------- 
     239      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     240      USE wrk_nemo, ONLY:   zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3   ! 3D workspaces 
     241      USE wrk_nemo, ONLY:   zs_ref => wrk_3d_4, zsb => wrk_3d_5                     ! 3D workspaces 
     242      ! 
    240243      USE zdf_oce         ! vertical mixing 
    241244      USE trazdf          ! vertical mixing: double diffusion 
    242245      USE zdfddm          ! vertical mixing: double diffusion 
    243       !! 
     246      ! 
    244247      INTEGER  ::   jk              ! Dummy loop indice 
    245       LOGICAL  ::   llsave          ! 
    246       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       !!---------------------------------------------------------------------- 
     248      INTEGER  ::   ierr            ! local integer 
     249      LOGICAL  ::   llsave          ! local logical 
     250      REAL(wp) ::   zt0, zs0, z12   ! local scalar 
     251      !!---------------------------------------------------------------------- 
     252 
     253      IF( wrk_in_use(3, 1,2,3,4,5) ) THEN 
     254         CALL ctl_stop('ldf_ano : requested workspace arrays unavailable')   ;   RETURN 
     255      ENDIF 
    250256 
    251257      IF(lwp) THEN 
    … …  
    254260         WRITE(numout,*) '~~~~~~~~~~~' 
    255261      ENDIF 
     262 
     263      !                              ! allocate trabbl arrays 
     264      ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr ) 
     265      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     266      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' ) 
    256267 
    257268      ! defined the T & S reference profiles 
    … …  
    309320      avt(:,:,:)        = zavt(:,:,:) 
    310321      ! 
     322      IF( wrk_not_released(3, 1,2,3,4,5) )   CALL ctl_stop('ldf_ano: failed to release workspace arrays') 
     323      ! 
    311324   END SUBROUTINE ldf_ano 
    312325 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r2528 r2715  
    2828   USE diaptr          ! poleward transport diagnostics 
    2929   USE trc_oce         ! share passive tracers/Ocean variables 
     30   USE lib_mpp         ! MPP library 
    3031 
    3132   IMPLICIT NONE 
    … …  
    7374      !!               biharmonic mixing trend. 
    7475      !!---------------------------------------------------------------------- 
    75       USE oce         , ztu => ua   ! use ua as workspace 
    76       USE oce         , ztv => va   ! use va as workspace 
     76      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     77      USE oce     , ONLY:   ztu  => ua       , ztv  => va                           ! (ua,va) used as workspace 
     78      USE wrk_nemo, ONLY:   zeeu => wrk_2d_1 , zeev => wrk_2d_2 , zlt => wrk_2d_3   ! 2D workspace 
    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( wrk_in_use(2, 1,2,3) ) THEN 
     92         CALL ctl_stop('tra_ldf_bilap: requested workspace arrays unavailable')   ;   RETURN 
     93      ENDIF 
    8994 
    9095      IF( kt == nit000 )  THEN 
    … …  
    160165      END DO                                              ! tracer loop 
    161166      !                                                   ! =========== 
     167      IF( wrk_not_released(2, 1,2,3) )   CALL ctl_stop('tra_ldf_bilap: failed to release workspace arrays') 
     168      ! 
    162169   END SUBROUTINE tra_ldf_bilap 
    163170 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r2528 r2715  
    2424   USE diaptr          ! poleward transport diagnostics  
    2525   USE trc_oce         ! share passive tracers/Ocean variables 
     26   USE lib_mpp         ! MPP library 
    2627 
    2728   IMPLICIT NONE 
    … …  
    6566      !!               biharmonic mixing trend. 
    6667      !!---------------------------------------------------------------------- 
     68      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     69      USE wrk_nemo, ONLY:   wk1 => wrk_4d_1 , wk2 => wrk_4d_2     ! 4D workspace 
     70      ! 
    6771      INTEGER         , INTENT(in   )                      ::   kt       ! ocean time-step index 
    6872      CHARACTER(len=3), INTENT(in   )                      ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    7074      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields 
    7175      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
    72       !! 
    73       INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) ::   wk1, wk2   ! 4D workspace 
    75       !!---------------------------------------------------------------------- 
     76      ! 
     77      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     78      !!---------------------------------------------------------------------- 
     79 
     80      IF( wrk_in_use(4, 1,2) ) THEN 
     81         CALL ctl_stop('tra_ldf_bilapg: requested workspace arrays unavailable')   ;   RETURN 
     82      ENDIF 
    7683 
    7784      IF( kt == nit000 )  THEN 
    … …  
    107114         END DO 
    108115      END DO 
     116      ! 
     117      IF( wrk_not_released(4, 1,2) )   CALL ctl_stop('tra_ldf_bilapg : failed to release workspace arrays.') 
    109118      ! 
    110119   END SUBROUTINE tra_ldf_bilapg 
    … …  
    149158      !! 
    150159      !!---------------------------------------------------------------------- 
    151       USE oce         , zftv => ua     ! use ua as workspace 
    152       !! 
     160      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
     161      USE oce     , ONLY:   zftv => ua       ! ua used as workspace 
     162      USE wrk_nemo, ONLY:   zftu => wrk_2d_1 , zdkt  => wrk_2d_2 , zdk1t => wrk_2d_3 
     163      USE wrk_nemo, ONLY:   zftw => wrk_xz_1 , zdit  => wrk_xz_2  
     164      USE wrk_nemo, ONLY:   zdjt => wrk_xz_3 , zdj1t => wrk_xz_4 
     165      ! 
    153166      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index 
    154167      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator)  
    … …  
    166179      REAL(wp) ::  zbtr, ztah, ztav 
    167180      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  
     181      !!---------------------------------------------------------------------- 
     182 
     183      IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use_xz(1,2,3,4) )THEN 
     184         CALL ctl_stop('ldfght : requested workspace arrays unavailable')   ;   RETURN 
     185      ENDIF 
    172186      ! 
    173187      DO jn = 1, kjpt 
    … …  
    321335      END DO 
    322336      ! 
     337      IF( wrk_not_released(2, 1,2,3)   .OR.   & 
     338          wrk_not_released_xz(1,2,3,4) )   CALL ctl_stop('ldfght : failed to release workspace arrays.') 
     339      ! 
    323340   END SUBROUTINE ldfght 
    324341 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r2528 r2715  
    9090      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9191      !!---------------------------------------------------------------------- 
    92       USE oce         , zftu => ua   ! use ua as workspace 
    93       USE oce         , zftv => va   ! use va as workspace 
    94       !! 
     92      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     93      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace 
     94      USE wrk_nemo, ONLY:   zdkt => wrk_2d_1 , zdk1t => wrk_2d_2 , z2d  => wrk_2d_3   ! 2D workspace 
     95      USE wrk_nemo, ONLY:   zdit => wrk_3d_6 , zdjt  => wrk_3d_7 , ztfw => wrk_3d_8   ! 3D workspace 
     96      ! 
    9597      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    9698      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    100102      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    101103      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
    102       !! 
     104      ! 
    103105      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    104106      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
    105107      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    106108      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 
    109109#if defined key_diaar5 
    110       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                 ! 2D workspace 
    111110      REAL(wp)                         ::   zztmp               ! local scalar 
    112111#endif 
    113112      !!---------------------------------------------------------------------- 
     113 
     114      IF( wrk_in_use(3, 6,7,8) .OR. wrk_in_use(2, 1,2,3) ) THEN 
     115          CALL ctl_stop('tra_ldf_iso : requested workspace array unavailable')   ;   RETURN 
     116      ENDIF 
    114117 
    115118      IF( kt == nit000 )  THEN 
    … …  
    288291      END DO 
    289292      ! 
     293      IF( wrk_not_released(3, 6,7,8) .OR.   & 
     294          wrk_not_released(2, 1,2,3) )   CALL ctl_stop('tra_ldf_iso: failed to release workspace arrays') 
     295      ! 
    290296   END SUBROUTINE tra_ldf_iso 
    291297 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r2528 r2715  
    1616   USE oce             ! ocean dynamics and active tracers 
    1717   USE dom_oce         ! ocean space and time domain 
     18   USE phycst          ! physical constants 
    1819   USE trc_oce         ! share passive tracers/Ocean variables 
    1920   USE zdf_oce         ! ocean vertical physics 
    … …  
    2324   USE in_out_manager  ! I/O manager 
    2425   USE iom             ! I/O library 
    25 #if defined key_diaar5 
    26    USE phycst          ! physical constants 
    2726   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    28 #endif 
     27   USE lib_mpp         ! MPP library 
    2928 
    3029   IMPLICIT NONE 
    3130   PRIVATE 
    3231 
    33    PUBLIC tra_ldf_iso_grif   ! routine called by traldf.F90 
    34  
    35    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   psix_eiv 
    36    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   psiy_eiv 
    37    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   ah_wslp2 
     32   PUBLIC   tra_ldf_iso_grif   ! routine called by traldf.F90 
     33 
     34   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only) 
     35   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2 
     36   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt                 !  atypic workspace 
    3837 
    3938   !! * Substitutions 
    … …  
    9089      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9190      !!---------------------------------------------------------------------- 
    92       USE oce,   zftu => ua   ! use ua as workspace 
    93       USE oce,   zftv => va   ! use va as workspace 
    94       !! 
     91      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     92      USE oce     , ONLY:   zftu => ua       , zftv => va            ! (ua,va) used as 3D workspace 
     93      USE wrk_nemo, ONLY:   zdit => wrk_3d_6 , zdjt => wrk_3d_7 , ztfw => wrk_3d_8   ! 3D workspace 
     94      USE wrk_nemo, ONLY:   z2d  => wrk_2d_1                                         ! 2D workspace 
     95      ! 
    9596      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    9697      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    100101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    101102      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
    102       !! 
     103      ! 
    103104      INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices 
    104105      INTEGER  ::  ip,jp,kp        ! dummy loop indices 
    … …  
    107108      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
    108109      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 
     110      !REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdkt           ! 2D+1 workspace 
    111111      ! 
    112112      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv 
    … …  
    114114      REAL(wp) ::   zah, zah_slp, zaei_slp 
    115115#if defined key_diaar5 
    116       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                ! 2D workspace 
    117       REAL(wp)                         ::   zztmp              ! local scalar 
     116      REAL(wp) ::   zztmp              ! local scalar 
    118117#endif 
    119118      !!---------------------------------------------------------------------- 
     119 
     120      IF( wrk_in_use(3, 6,7,8) .OR. wrk_in_use(2, 1) ) THEN 
     121         CALL ctl_stop('tra_ldf_iso_grif: requested workspace arrays unavailable.')   ;   RETURN 
     122      ENDIF 
     123      ! ARP - line below uses 'bounds re-mapping' which is only defined in 
     124      ! Fortran 2003 and up. We would be OK if code was written to use 
     125      ! zdkt(:,:,1:2) instead as then wouldn't need to re-map bounds. 
     126      ! As it is, we make zdkt a module array and allocate it in _alloc(). 
     127      !zdkt(1:jpi,1:jpj,0:1) => wrk_3d_9(:,:,1:2) 
    120128 
    121129      IF( kt == nit000 )  THEN 
    … …  
    124132         IF(lwp) WRITE(numout,*) '                   WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL' 
    125133         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    126          ALLOCATE( ah_wslp2(jpi,jpj,jpk) , STAT=ierr ) 
    127          IF( ierr > 0 ) THEN 
    128             CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator ah_wslp2 ' )   ;   RETURN 
    129          ENDIF 
     134         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt(jpi,jpj,0:1), STAT=ierr ) 
     135         IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
     136         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 
    130137         IF( ln_traldf_gdia ) THEN 
    131138            ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
    132             IF( ierr > 0 ) THEN 
    133                CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator diagnostics ' )   ;   RETURN 
    134             ENDIF 
     139            IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
     140            IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 
    135141         ENDIF 
    136142      ENDIF 
    … …  
    342348      END DO 
    343349      ! 
     350      IF( wrk_not_released(3, 6,7,8) .OR.   & 
     351          wrk_not_released(2, 1)       )   CALL ctl_stop('tra_ldf_iso_grif: failed to release workspace arrays') 
     352      ! 
    344353  END SUBROUTINE tra_ldf_iso_grif 
    345354 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2528 r2715  
    2424   USE diaptr          ! poleward transport diagnostics 
    2525   USE trc_oce         ! share passive tracers/Ocean variables 
     26   USE lib_mpp         ! MPP library 
    2627 
    2728   IMPLICIT NONE 
    … …  
    3031   PUBLIC   tra_ldf_lap   ! routine called by step.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 
    … …  
    6263      !!                harmonic mixing trend. 
    6364      !!---------------------------------------------------------------------- 
    64       USE oce         , ztu => ua   ! use ua as workspace 
    65       USE oce         , ztv => va   ! use va as workspace 
    66       !! 
     65      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace 
     66      ! 
    6767      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    6868      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    … …  
    7171      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
    7272      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    73       !! 
     73      ! 
    7474      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    75       INTEGER  ::   iku, ikv             ! local integers 
     75      INTEGER  ::   iku, ikv, ierr       ! local integers 
    7676      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars 
    7777      !!---------------------------------------------------------------------- 
    … …  
    8181         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 
    8282         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     83         ! 
     84         ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr ) 
     85         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     86         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' ) 
     87         ! 
    8388         e1ur(:,:) = e2u(:,:) / e1u(:,:) 
    8489         e2vr(:,:) = e1v(:,:) / e2v(:,:) 
    … …  
    123128            DO jj = 2, jpjm1 
    124129               DO ji = fs_2, fs_jpim1   ! vector opt. 
    125                   zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     130                  zbtr = 1._wp / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    126131                  ! horizontal diffusive trends added to the general tracer trends 
    127132                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r2528 r2715  
    1818   USE zdf_oce         ! ocean vertical physics 
    1919   USE trdmod_oce      ! ocean active tracer trends 
    20    USE trdtra      ! ocean active tracer trends 
     20   USE trdtra          ! ocean active tracer trends 
    2121   USE eosbn2          ! equation of state (eos routine)  
    2222   USE lbclnk          ! lateral boundary conditions (or mpp link) 
    2323   USE in_out_manager  ! I/O manager 
     24   USE lib_mpp         ! MPP library 
    2425 
    2526   IMPLICIT NONE 
    2627   PRIVATE 
    2728 
    28    PUBLIC   tra_npc    ! routine called by step.F90 
     29   PUBLIC   tra_npc       ! routine called by step.F90 
    2930 
    3031   !! * Substitutions 
    … …  
    5556      !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    5657      !!---------------------------------------------------------------------- 
     58      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
     59      USE wrk_nemo, ONLY:   ztrdt => wrk_3d_1 , ztrds => wrk_3d_2 , zrhop => wrk_3d_3 
     60      USE wrk_nemo, ONLY:   zwx   => wrk_xz_1 , zwy   => wrk_xz_2 , zwz   => wrk_xz_3 
     61      ! 
    5762      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    58       !! 
     63      ! 
    5964      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6065      INTEGER  ::   inpcc        ! number of statically instable water column 
    … …  
    6368      INTEGER  ::   ikbot, ik, ikup, ikdown   ! ??? 
    6469      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 
    6870      !!---------------------------------------------------------------------- 
     71 
     72      ! Strictly 1 and 2 3D workspaces only needed if(l_trdtra) but it doesn't  
     73      ! cost us anything and makes code simpler. 
     74      IF( wrk_in_use(3, 1,2,3) .OR. wrk_in_use_xz(1,2,3) ) THEN 
     75         CALL ctl_stop('tra_npc: requested workspace arrays unavailable')   ;   RETURN 
     76      ENDIF 
    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       
    197204         ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign) 
    198205         ! ------------------------------============ 
    199          CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
    200          CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
     206         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    201207       
    202208 
    … …  
    210216      ENDIF 
    211217      ! 
     218      IF( wrk_not_released(3, 1,2,3) .OR.   & 
     219          wrk_not_released_xz(1,2,3) )   CALL ctl_stop('tra_npc: failed to release workspace arrays') 
     220      ! 
    212221   END SUBROUTINE tra_npc 
    213222 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2528 r2715  
    5656   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt 
    5757 
    58    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) 
     58   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg 
    6059 
    6160   !! * Substitutions 
    … …  
    6362   !!---------------------------------------------------------------------- 
    6463   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)  
    65    !! $Id $ 
    66    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     64   !! $Id$ 
     65   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6766   !!---------------------------------------------------------------------- 
    6867CONTAINS 
    … …  
    104103         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    105104         ! 
    106          rbcp    = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)       ! Brown & Campana parameter for semi-implicit hpg 
     105         rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg 
    107106      ENDIF 
    108107 
    … …  
    131130  
    132131      ! set time step size (Euler/Leapfrog) 
    133       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt(:) =     rdttra(:)      ! at nit000             (Euler) 
    134       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
     132      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler) 
     133      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
    135134      ENDIF 
    136135 
    … …  
    153152         ENDIF 
    154153      ENDIF  
    155  
     154      ! 
    156155#if defined key_agrif 
    157156      ! Update tracer at AGRIF zoom boundaries 
    … …  
    160159      CALL tra_swap 
    161160#endif       
    162  
     161      ! 
    163162      ! trends computation 
    164163      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    165164         DO jk = 1, jpkm1 
    166             zfact = 1.e0 / r2dt(jk)              
     165            zfact = 1.e0 / r2dtra(jk)              
    167166            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
    168167            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 
    … …  
    172171         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )  
    173172      END IF 
    174  
     173      ! 
    175174      !                        ! control print 
    176175      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   & 
    … …  
    203202      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
    204203      !!---------------------------------------------------------------------- 
    205       INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
    206       CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator) 
    207       INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers 
    208       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields 
    209       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields 
    210       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend 
    211       !! 
     204      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
     205      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
     206      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
     207      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields 
     208      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields 
     209      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend 
     210      ! 
    212211      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    213212      LOGICAL  ::   ll_tra_hpg       ! local logical 
    … …  
    270269      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
    271270      !!---------------------------------------------------------------------- 
    272       INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
    273       CHARACTER(len=3), INTENT(in   )                               ::  cdtype   ! =TRA or TRC (tracer indicator) 
    274       INTEGER         , INTENT(in   )                               ::  kjpt     ! number of tracers 
    275       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb      ! before tracer fields 
    276       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptn      ! now tracer fields 
    277       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  pta      ! tracer trend 
     271      INTEGER         , INTENT(in   )                               ::   kt       ! ocean time-step index 
     272      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator) 
     273      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers 
     274      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields 
     275      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields 
     276      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend 
    278277      !!      
    279278      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! local logical 
    280279      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
    281       REAL(wp) ::   ztc_a , ztc_n , ztc_b       ! local scalar 
    282       REAL(wp) ::   ztc_f , ztc_d               !   -      - 
    283       REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a      !   -      - 
    284       REAL(wp) ::   ze3t_f, ze3t_d              !   -      - 
    285       REAL(wp) ::   zfact1, zfact2              !   -      - 
     280      REAL(wp) ::   zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     281      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      - 
    286282      !!---------------------------------------------------------------------- 
    287283 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r2528 r2715  
    2828   USE fldread         ! read input fields 
    2929   USE restart         ! ocean restart 
     30   USE lib_mpp         ! MPP library 
    3031 
    3132   IMPLICIT NONE 
    … …  
    5859   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5960   !! $Id$ 
    60    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     61   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6162   !!---------------------------------------------------------------------- 
    62  
    6363CONTAINS 
    6464 
    … …  
    9090      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516. 
    9191      !!---------------------------------------------------------------------- 
    92       !! 
     92      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     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 
     96      ! 
    9397      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    94       !! 
     98      ! 
    9599      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    96       INTEGER  ::   irgb                 ! temporary integers 
    97       REAL(wp) ::   zchl, zcoef          ! temporary scalars 
     100      INTEGER  ::   irgb                 ! local integers 
     101      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars 
    98102      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         - 
    99       REAL(wp) ::   zz0, zz1             !    -         - 
    100       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 
     103      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         - 
    103104      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt 
    104105      !!---------------------------------------------------------------------- 
     106 
     107      IF( wrk_in_use(3, 1,2,3,4,5) .OR. wrk_in_use(2, 1,2,3) )THEN 
     108         CALL ctl_stop('tra_qsr: requested workspace arrays unavailable')   ;   RETURN 
     109      ENDIF 
    105110 
    106111      IF( kt == nit000 ) THEN 
    … …  
    283288      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    284289      ! 
     290      IF( wrk_not_released(3, 1,2,3,4,5) .OR.   & 
     291          wrk_not_released(2, 1,2,3)     )   CALL ctl_stop('tra_qsr: failed to release workspace arrays') 
     292      ! 
    285293   END SUBROUTINE tra_qsr 
    286294 
    … …  
    303311      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp. 
    304312      !!---------------------------------------------------------------------- 
    305       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    306       INTEGER  ::   irgb, ierror          ! temporary integer 
    307       INTEGER  ::   ioptio, nqsr          ! temporary integer 
    308       REAL(wp) ::   zc0  , zc1, zcoef     ! temporary scalars 
    309       REAL(wp) ::   zc2  , zc3  , zchl    !    -         - 
    310       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 
    313       !! 
     313      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     314      USE wrk_nemo, ONLY:   zekb => wrk_2d_1 , zekg => wrk_2d_2 , zekr => wrk_2d_3 
     315      USE wrk_nemo, ONLY:   ze0  => wrk_3d_1 , ze1  => wrk_3d_2 , ze2 => wrk_3d_3 
     316      USE wrk_nemo, ONLY:   ze3  => wrk_3d_4 , zea  => wrk_3d_5 
     317      ! 
     318      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     319      INTEGER  ::   irgb, ierror, ioptio, nqsr   ! local integer 
     320      REAL(wp) ::   zz0, zc0  , zc1, zcoef       ! local scalars 
     321      REAL(wp) ::   zz1, zc2  , zc3, zchl        !   -      - 
     322      ! 
    314323      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files 
    315324      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
     325      !! 
    316326      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   & 
    317327         &                  nn_chldta, rn_abs, rn_si0, rn_si1 
    318328      !!---------------------------------------------------------------------- 
     329 
     330      IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 1,2,3,4,5) )THEN 
     331         CALL ctl_stop('tra_qsr_init: requested workspace arrays unavailable')   ;   RETURN 
     332      ENDIF 
    319333 
    320334      cn_dir = './'       ! directory in which the model is executed 
    … …  
    490504      ENDIF 
    491505      ! 
     506      IF( wrk_not_released(2, 1,2,3)     .OR.   & 
     507          wrk_not_released(3, 1,2,3,4,5) )   CALL ctl_stop('tra_qsr_init: failed to release workspace arrays') 
     508      ! 
    492509   END SUBROUTINE tra_qsr_init 
    493510 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r2528 r2715  
    4040   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4141   !! $Id$ 
    42    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    43    !!---------------------------------------------------------------------- 
    44  
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     43   !!---------------------------------------------------------------------- 
    4544CONTAINS 
    4645 
    … …  
    210209               zdep = 1. / h_rnf(ji,jj) 
    211210               zdep = zfact * zdep   
    212                IF ( rnf(ji,jj) .ne. 0.0 ) THEN 
     211               IF ( rnf(ji,jj) /= 0._wp ) THEN 
    213212                  DO jk = 1, nk_rnf(ji,jj) 
    214213                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
    … …  
    216215                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   & 
    217216                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep  
    218                   ENDDO 
     217                  END DO 
    219218               ENDIF 
    220             ENDDO   
    221          ENDDO   
     219            END DO   
     220         END DO   
    222221      ENDIF   
    223222!!gm  It should be useless 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traswp.F90

    r2528 r2715  
    1616   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    1717   !! $Id$  
    18    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     18   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    1919   !!---------------------------------------------------------------------- 
    20  
    2120CONTAINS 
    2221 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r2528 r2715  
    1414   USE oce             ! ocean dynamics and tracers variables 
    1515   USE dom_oce         ! ocean space and time domain variables  
     16   USE domvvl          ! variable volume 
     17   USE phycst          ! physical constant 
    1618   USE zdf_oce         ! ocean vertical physics variables 
    1719   USE sbc_oce         ! surface boundary condition: ocean 
    … …  
    2628   USE in_out_manager  ! I/O manager 
    2729   USE prtctl          ! Print control 
     30   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     31   USE lib_mpp         ! MPP library 
    2832 
    29    USE phycst 
    30    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    31    USE domvvl          ! variable volume 
    3233 
    3334   IMPLICIT NONE 
    3435   PRIVATE 
    3536 
    36    PUBLIC tra_zdf      ! routine called by step.F90 
    37    PUBLIC tra_zdf_init !  routine called by opa.F90 
     37   PUBLIC   tra_zdf        ! routine called by step.F90 
     38   PUBLIC   tra_zdf_init   ! routine called by nemogcm.F90 
    3839 
    39    INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    40       !                                ! 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 
     40   INTEGER ::   nzdf = 0   ! type vertical diffusion algorithm used (defined from ln_zdf...  namlist logicals) 
    4341 
    4442   !! * Substitutions 
    … …  
    4947   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5048   !! $Id$ 
    51    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5250   !!---------------------------------------------------------------------- 
     51CONTAINS 
    5352 
    54 CONTAINS 
    55     
    5653   SUBROUTINE tra_zdf( kt ) 
    5754      !!---------------------------------------------------------------------- 
    … …  
    6865      !                                          ! set time step 
    6966      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    70          r2dt(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
     67         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
    7168      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    72          r2dt(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
     69         r2dtra(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
    7370      ENDIF 
    7471 
    … …  
    7976 
    8077      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    81       CASE ( 0 )    ;    CALL tra_zdf_exp( kt, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme  
    82       CASE ( 1 )    ;    CALL tra_zdf_imp( kt, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme  
     78      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme  
     79      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme  
    8380      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    84          CALL tra_zdf_exp( kt, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts ) 
     81         CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) 
    8582         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               & 
    8683         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    87          CALL tra_zdf_imp( kt, 'TRA', r2dt,            tsb, tsa, jpts )  
     84         CALL tra_zdf_imp( kt, 'TRA', r2dtra,            tsb, tsa, jpts )  
    8885         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               & 
    8986         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    … …  
    9289      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    9390         DO jk = 1, jpkm1 
    94             ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt(jk) ) - ztrdt(:,:,jk) 
    95             ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt(jk) ) - ztrds(:,:,jk) 
     91            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk) 
     92            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 
    9693         END DO 
    9794         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt ) 
    … …  
    103100      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
    104101         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    105  
     102      ! 
    106103   END SUBROUTINE tra_zdf 
    107104 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r2528 r2715  
    2828   USE zdf_oce         ! ocean vertical physics 
    2929   USE zdfddm          ! ocean vertical physics: double diffusion 
     30   USE trc_oce         ! share passive tracers/Ocean variables 
    3031   USE in_out_manager  ! I/O manager 
    31    USE trc_oce         ! share passive tracers/Ocean variables 
     32   USE lib_mpp         ! MPP library 
    3233 
    3334   IMPLICIT NONE 
    … …  
    4344   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4445   !! $Id$ 
    45    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4647   !!---------------------------------------------------------------------- 
    47  
    4848CONTAINS 
    4949 
    … …  
    7373      !! ** Action : - after tracer fields pta 
    7474      !!--------------------------------------------------------------------- 
     75      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     76      USE wrk_nemo, ONLY:   zwx => wrk_3d_6, zwy => wrk_3d_7     ! 3D workspace 
     77      ! 
    7578      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index 
    7679      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator) 
    … …  
    8083      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields 
    8184      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend  
    82       !!  
     85      ! 
    8386      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices 
    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( wrk_in_use(3, 6,7) ) THEN 
     92         CALL ctl_stop('tra_zdf_exp: requested workspace arrays unavailable')   ;   RETURN 
     93      ENDIF 
    8894 
    8995      IF( kt == nit000 )  THEN 
    … …  
    158164      END DO 
    159165      ! 
     166      IF( wrk_not_released(3, 6,7) )   CALL ctl_stop('tra_zdf_exp: failed to release workspace arrays') 
     167      ! 
    160168   END SUBROUTINE tra_zdf_exp 
    161169 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r2602 r2715  
    3434   USE in_out_manager  ! I/O manager 
    3535   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     36   USE lib_mpp         ! MPP library 
    3637 
    3738   IMPLICIT NONE 
    … …  
    7374      !! ** Action  : - pta  becomes the after tracer 
    7475      !!--------------------------------------------------------------------- 
    75       USE oce    , ONLY :   zwd   => ua   ! ua used as workspace 
    76       USE oce    , ONLY :   zws   => va   ! va  -          - 
    77       !!  
     76      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     77      USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace 
     78      USE wrk_nemo, ONLY:   zwi => wrk_3d_6 , zwt => wrk_3d_7   ! 3D workspace  
     79      ! 
    7880      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
    7981      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    8284      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields 
    8385      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
    84       !! 
    85       INTEGER  ::  ji, jj, jk, jn        ! dummy loop indices 
    86       REAL(wp) ::  zrhs                  ! local scalars 
    87       REAL(wp) ::  ze3tb, ze3tn, ze3ta   ! variable vertical scale factors 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi, zwt   ! workspace arrays 
     86      ! 
     87      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
     88      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars 
    8989      !!--------------------------------------------------------------------- 
     90 
     91      IF( wrk_in_use(3, 6,7) ) THEN 
     92         CALL ctl_stop('tra_zdf_imp : requested workspace arrays unavailable.')   ;   RETURN 
     93      ENDIF 
    9094 
    9195      IF( kt == nit000 )  THEN 
    … …  
    107111         ! Build matrix if temperature or salinity (only in double diffusion case) or first passive tracer 
    108112         ! 
    109          IF(  ( cdtype == 'TRA' .AND. ( ( jn == jp_tem ) .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR. & 
     113         IF(  ( cdtype == 'TRA' .AND. ( jn == jp_tem .OR. ( jn == jp_sal .AND. lk_zdfddm ) ) ) .OR.  & 
    110114            & ( cdtype == 'TRC' .AND. jn == 1 )  )  THEN 
    111115            ! 
    … …  
    224228      !                                               ! ================= ! 
    225229      ! 
     230      IF( wrk_not_released(3, 6,7) )   CALL ctl_stop('tra_zdf_imp: failed to release workspace arrays') 
     231      ! 
    226232   END SUBROUTINE tra_zdf_imp 
    227233 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r2569 r2715  
    2020   USE in_out_manager  ! I/O manager 
    2121   USE lbclnk          ! lateral boundary conditions (or mpp link) 
     22   USE lib_mpp         ! MPP library 
    2223 
    2324   IMPLICIT NONE 
    … …  
    8081      !!              - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points  
    8182      !!---------------------------------------------------------------------- 
     83      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     84      USE wrk_nemo, ONLY:   zri => wrk_2d_1 , zrj => wrk_2d_2   ! interpolated value of rd 
     85      USE wrk_nemo, ONLY:   zhi => wrk_2d_3 , zhj => wrk_2d_4   ! depth of interpolation for eos2d 
     86      ! 
    8287      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
    8388      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
    … …  
    8691      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
    8792      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts  
    88       !! 
     93      ! 
    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 
    9496      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars 
     97      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zti, ztj    ! interpolated value of tracer 
    9598      !!---------------------------------------------------------------------- 
     99 
     100      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
     101         CALL ctl_stop('zps_hde: requested workspace arrays unavailable')  ;  RETURN 
     102      END IF 
     103 
     104      ! Allocate workspaces whose dimension is > jpk 
     105      ALLOCATE( zti(jpi,jpj,kjpt) ) 
     106      ALLOCATE( ztj(jpi,jpj,kjpt) ) 
    96107 
    97108      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    … …  
    200211      END IF 
    201212      ! 
     213      IF( wrk_not_released(2, 1,2,3,4) )   CALL ctl_stop('zps_hde: failed to release workspace arrays') 
     214      ! 
     215      DEALLOCATE( zti ) 
     216      DEALLOCATE( ztj ) 
     217      ! 
    202218   END SUBROUTINE zps_hde 
    203219 
Note: See TracChangeset for help on using the changeset viewer.