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 8568 for branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

Ignore:
Timestamp:
2017-09-27T16:29:24+02:00 (7 years ago)
Author:
gm
Message:

#1911 (ENHANCE-09): PART I.2 - _NONE option + remove zts + see associated wiki page

Location:
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA
Files:
21 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r8215 r8568  
    4646   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    4747   USE prtctl         ! Print control 
    48    USE wrk_nemo       ! Memory Allocation 
    4948   USE lbclnk         ! ocean lateral boundary conditions 
    5049   USE timing         ! Timing 
    … …  
    231230      !!---------------------------------------------------------------------- 
    232231      ! 
    233       IF( nn_timing == 1 )   CALL timing_start('eos-insitu') 
     232      IF( ln_timing )   CALL timing_start('eos-insitu') 
    234233      ! 
    235234      SELECT CASE( neos ) 
    … …  
    298297      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu  : ', ovlap=1, kdim=jpk ) 
    299298      ! 
    300       IF( nn_timing == 1 )   CALL timing_stop('eos-insitu') 
     299      IF( ln_timing )   CALL timing_stop('eos-insitu') 
    301300      ! 
    302301   END SUBROUTINE eos_insitu 
    … …  
    329328      !!---------------------------------------------------------------------- 
    330329      ! 
    331       IF( nn_timing == 1 )   CALL timing_start('eos-pot') 
     330      IF( ln_timing )   CALL timing_start('eos-pot') 
    332331      ! 
    333332      SELECT CASE ( neos ) 
    … …  
    465464      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 
    466465      ! 
    467       IF( nn_timing == 1 )   CALL timing_stop('eos-pot') 
     466      IF( ln_timing )   CALL timing_stop('eos-pot') 
    468467      ! 
    469468   END SUBROUTINE eos_insitu_pot 
    … …  
    491490      !!---------------------------------------------------------------------- 
    492491      ! 
    493       IF( nn_timing == 1 )   CALL timing_start('eos2d') 
     492      IF( ln_timing )   CALL timing_start('eos2d') 
    494493      ! 
    495494      prd(:,:) = 0._wp 
    … …  
    560559      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 
    561560      ! 
    562       IF( nn_timing == 1 )   CALL timing_stop('eos2d') 
     561      IF( ln_timing )   CALL timing_stop('eos2d') 
    563562      ! 
    564563   END SUBROUTINE eos_insitu_2d 
    … …  
    583582      !!---------------------------------------------------------------------- 
    584583      ! 
    585       IF( nn_timing == 1 )   CALL timing_start('rab_3d') 
     584      IF( ln_timing )   CALL timing_start('rab_3d') 
    586585      ! 
    587586      SELECT CASE ( neos ) 
    … …  
    674673         &                       tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', ovlap=1, kdim=jpk ) 
    675674      ! 
    676       IF( nn_timing == 1 )   CALL timing_stop('rab_3d') 
     675      IF( ln_timing )   CALL timing_stop('rab_3d') 
    677676      ! 
    678677   END SUBROUTINE rab_3d 
    … …  
    696695      !!---------------------------------------------------------------------- 
    697696      ! 
    698       IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     697      IF( ln_timing )  CALL timing_start('rab_2d') 
    699698      ! 
    700699      pab(:,:,:) = 0._wp 
    … …  
    791790         &                       tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 
    792791      ! 
    793       IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     792      IF( ln_timing )   CALL timing_stop('rab_2d') 
    794793      ! 
    795794   END SUBROUTINE rab_2d 
    … …  
    812811      !!---------------------------------------------------------------------- 
    813812      ! 
    814       IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
     813      IF( ln_timing )  CALL timing_start('rab_2d') 
    815814      ! 
    816815      pab(:) = 0._wp 
    … …  
    888887      END SELECT 
    889888      ! 
    890       IF( nn_timing == 1 )   CALL timing_stop('rab_2d') 
     889      IF( ln_timing )   CALL timing_stop('rab_2d') 
    891890      ! 
    892891   END SUBROUTINE rab_0d 
    … …  
    915914      !!---------------------------------------------------------------------- 
    916915      ! 
    917       IF( nn_timing == 1 ) CALL timing_start('bn2') 
     916      IF( ln_timing )  CALL timing_start('bn2') 
    918917      ! 
    919918      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    … …  
    935934      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk ) 
    936935      ! 
    937       IF( nn_timing == 1 )   CALL timing_stop('bn2') 
     936      IF( ln_timing )   CALL timing_stop('bn2') 
    938937      ! 
    939938   END SUBROUTINE bn2 
    … …  
    963962      !!---------------------------------------------------------------------- 
    964963      ! 
    965       IF ( nn_timing == 1 )   CALL timing_start('eos_pt_from_ct') 
     964      IF( ln_timing )   CALL timing_start('eos_pt_from_ct') 
    966965      ! 
    967966      zdeltaS = 5._wp 
    … …  
    994993      END DO 
    995994      ! 
    996       IF( nn_timing == 1 )   CALL timing_stop('eos_pt_from_ct') 
     995      IF( ln_timing )   CALL timing_stop('eos_pt_from_ct') 
    997996      ! 
    998997   END FUNCTION eos_pt_from_ct 
    … …  
    11281127      !!---------------------------------------------------------------------- 
    11291128      ! 
    1130       IF( nn_timing == 1 )   CALL timing_start('eos_pen') 
     1129      IF( ln_timing )   CALL timing_start('eos_pen') 
    11311130      ! 
    11321131      SELECT CASE ( neos ) 
    … …  
    12221221      END SELECT 
    12231222      ! 
    1224       IF( nn_timing == 1 )   CALL timing_stop('eos_pen') 
     1223      IF( ln_timing )   CALL timing_stop('eos_pen') 
    12251224      ! 
    12261225   END SUBROUTINE eos_pen 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r7753 r8568  
    1414   !!---------------------------------------------------------------------- 
    1515   !!   tra_adv       : compute ocean tracer advection trend 
    16    !!   tra_adv_ctl   : control the different options of advection scheme 
     16   !!   tra_adv_init  : control the different options of advection scheme 
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce            ! ocean dynamics and active tracers 
    1919   USE dom_oce        ! ocean space and time domain 
    2020   USE domvvl         ! variable vertical scale factors 
     21   USE sbcwave        ! wave module 
     22   USE sbc_oce        ! surface boundary condition: ocean 
    2123   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
    2224   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
    … …  
    2729   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
    2830   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    29    USE trd_oce         ! trends: ocean variables 
    30    USE trdtra          ! trends manager: tracers  
     31   USE trd_oce        ! trends: ocean variables 
     32   USE trdtra         ! trends manager: tracers  
     33   USE diaptr         ! Poleward heat transport  
    3134   ! 
    3235   USE in_out_manager ! I/O manager 
    … …  
    3437   USE prtctl         ! Print control 
    3538   USE lib_mpp        ! MPP library 
    36    USE wrk_nemo       ! Memory Allocation 
    3739   USE timing         ! Timing 
    38    USE sbcwave        ! wave module 
    39    USE sbc_oce        ! surface boundary condition: ocean 
    40    USE diaptr         ! Poleward heat transport  
    4140 
    4241   IMPLICIT NONE 
    4342   PRIVATE 
    4443 
    45    PUBLIC   tra_adv        ! routine called by step module 
    46    PUBLIC   tra_adv_init   ! routine called by opa module 
     44   PUBLIC   tra_adv        ! called by step.F90 
     45   PUBLIC   tra_adv_init   ! called by nemogcm.F90 
    4746 
    4847   !                            !!* Namelist namtra_adv * 
     48   LOGICAL ::   ln_traadv_NONE   ! no advection on T and S 
    4949   LOGICAL ::   ln_traadv_cen    ! centered scheme flag 
    5050   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme 
    5151   LOGICAL ::   ln_traadv_fct    ! FCT scheme flag 
    5252   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme 
    53    INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping 
    5453   LOGICAL ::   ln_traadv_mus    ! MUSCL scheme flag 
    5554   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths 
    … …  
    5857   LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag 
    5958 
    60    INTEGER ::              nadv             ! choice of the type of advection scheme 
    61    ! 
    62    !                                        ! associated indices: 
     59   INTEGER ::   nadv             ! choice of the type of advection scheme 
     60   !                             ! associated indices: 
    6361   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
    6462   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
    6563   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
    66    INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping 
    67    INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme 
    68    INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme 
    69    INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme 
     64   INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme 
     65   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme 
     66   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    7067    
    7168   !! * Substitutions 
    7269#  include "vectopt_loop_substitute.h90" 
    7370   !!---------------------------------------------------------------------- 
    74    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     71   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    7572   !! $Id$ 
    7673   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    8683      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    8784      !!---------------------------------------------------------------------- 
    88       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     85      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8986      ! 
    9087      INTEGER ::   jk   ! dummy loop index 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    93       !!---------------------------------------------------------------------- 
    94       ! 
    95       IF( nn_timing == 1 )  CALL timing_start('tra_adv') 
    96       ! 
    97       CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zun, zvn, zwn   ! 3D workspace 
     89      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds 
     90      !!---------------------------------------------------------------------- 
     91      ! 
     92      IF( ln_timing )   CALL timing_start('tra_adv') 
    9893      ! 
    9994      !                                          ! set time step 
    100       zun(:,:,:) = 0.0 
    101       zvn(:,:,:) = 0.0 
    102       zwn(:,:,:) = 0.0 
    103       !     
    104       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    105          r2dt = rdt                                 ! = rdt (restarting with Euler time stepping) 
    106       ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    107          r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog) 
     95      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =        rdt   ! at nit000             (Euler) 
     96      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog) 
    10897      ENDIF 
    10998      ! 
    11099      !                                         !==  effective transport  ==! 
     100      zun(:,:,jpk) = 0._wp 
     101      zvn(:,:,jpk) = 0._wp 
     102      zwn(:,:,jpk) = 0._wp 
    111103      IF( ln_wave .AND. ln_sdw )  THEN 
    112104         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    … …  
    146138      ! 
    147139      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    148          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     140         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
    149141         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    150142         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    153145      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
    154146      ! 
    155       CASE ( np_CEN )                                    ! Centered scheme : 2nd / 4th order 
     147      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    156148         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
    157       CASE ( np_FCT )                                    ! FCT scheme      : 2nd / 4th order 
     149      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    158150         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
    159       CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
    160          CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts ) 
    161       CASE ( np_MUS )                                    ! MUSCL 
     151      CASE ( np_MUS )                                 ! MUSCL 
    162152         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
    163       CASE ( np_UBS )                                    ! UBS 
     153      CASE ( np_UBS )                                 ! UBS 
    164154         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
    165       CASE ( np_QCK )                                    ! QUICKEST 
     155      CASE ( np_QCK )                                 ! QUICKEST 
    166156         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
    167157      ! 
    … …  
    175165         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
    176166         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
    177          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     167         DEALLOCATE( ztrdt, ztrds ) 
    178168      ENDIF 
    179169      !                                              ! print mean trends (used for debugging) 
    … …  
    181171         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    182172      ! 
    183       IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv' ) 
    184       ! 
    185       CALL wrk_dealloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
    186       !                                           
     173      IF( ln_timing )   CALL timing_stop( 'tra_adv' ) 
     174      ! 
    187175   END SUBROUTINE tra_adv 
    188176 
    … …  
    197185      INTEGER ::   ioptio, ios   ! Local integers 
    198186      ! 
    199       NAMELIST/namtra_adv/ ln_traadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN 
    200          &                 ln_traadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT 
    201          &                 ln_traadv_mus,                     ln_mus_ups,   &   ! MUSCL 
    202          &                 ln_traadv_ubs,           nn_ubs_v,               &   ! UBS 
    203          &                 ln_traadv_qck                                        ! QCK 
     187      NAMELIST/namtra_adv/ ln_traadv_NONE,                       &   ! No advection 
     188         &                 ln_traadv_cen , nn_cen_h, nn_cen_v,   &   ! CEN 
     189         &                 ln_traadv_fct , nn_fct_h, nn_fct_v,   &   ! FCT 
     190         &                 ln_traadv_mus , ln_mus_ups,           &   ! MUSCL 
     191         &                 ln_traadv_ubs ,           nn_ubs_v,   &   ! UBS 
     192         &                 ln_traadv_qck                             ! QCK 
    204193      !!---------------------------------------------------------------------- 
    205194      ! 
    … …  
    217206         WRITE(numout,*) 
    218207         WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme' 
    219          WRITE(numout,*) '~~~~~~~~~~~' 
     208         WRITE(numout,*) '~~~~~~~~~~~~' 
    220209         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers' 
     210         WRITE(numout,*) '      No advection on T & S                     ln_traadv_NONE= ', ln_traadv_NONE 
    221211         WRITE(numout,*) '      centered scheme                           ln_traadv_cen = ', ln_traadv_cen 
    222212         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h 
    … …  
    225215         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h 
    226216         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v 
    227          WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts 
    228217         WRITE(numout,*) '      MUSCL scheme                              ln_traadv_mus = ', ln_traadv_mus 
    229218         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups 
    … …  
    233222      ENDIF 
    234223      ! 
    235       ioptio = 0                       !==  Parameter control  ==! 
    236       IF( ln_traadv_cen )   ioptio = ioptio + 1 
    237       IF( ln_traadv_fct )   ioptio = ioptio + 1 
    238       IF( ln_traadv_mus )   ioptio = ioptio + 1 
    239       IF( ln_traadv_ubs )   ioptio = ioptio + 1 
    240       IF( ln_traadv_qck )   ioptio = ioptio + 1 
    241       ! 
    242       IF( ioptio == 0 ) THEN 
    243          nadv = np_NO_adv 
    244          CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' ) 
    245       ENDIF 
    246       IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' ) 
     224      !                                !==  Parameter control & set nadv ==! 
     225      ioptio = 0                        
     226      IF( ln_traadv_NONE ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_NO_adv   ;   ENDIF 
     227      IF( ln_traadv_cen  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_CEN      ;   ENDIF 
     228      IF( ln_traadv_fct  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_FCT      ;   ENDIF 
     229      IF( ln_traadv_mus  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_MUS      ;   ENDIF 
     230      IF( ln_traadv_ubs  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_UBS      ;   ENDIF 
     231      IF( ln_traadv_qck  ) THEN   ;   ioptio = ioptio + 1   ;   nadv = np_QCK      ;   ENDIF 
     232      ! 
     233      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection option in namelist namtra_adv' ) 
    247234      ! 
    248235      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered 
    … …  
    254241        CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' ) 
    255242      ENDIF 
    256       IF( ln_traadv_fct .AND. nn_fct_zts > 0 ) THEN 
    257          IF( nn_fct_h == 4 ) THEN 
    258             nn_fct_h = 2 
    259             CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
    260          ENDIF 
    261          IF( .NOT.ln_linssh ) THEN 
    262             CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
    263          ENDIF 
    264          IF( nn_fct_zts == 1 )   CALL ctl_warn( 'tra_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 
    265       ENDIF 
    266243      IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS 
    267244        CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' ) 
    … …  
    275252      ENDIF 
    276253      ! 
    277       !                                !==  used advection scheme  ==!   
    278       !                                      ! set nadv 
    279       IF( ln_traadv_cen                      )   nadv = np_CEN 
    280       IF( ln_traadv_fct                      )   nadv = np_FCT 
    281       IF( ln_traadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts 
    282       IF( ln_traadv_mus                      )   nadv = np_MUS 
    283       IF( ln_traadv_ubs                      )   nadv = np_UBS 
    284       IF( ln_traadv_qck                      )   nadv = np_QCK 
    285       ! 
    286       IF(lwp) THEN                           ! Print the choice 
     254      !                                !==  Print the choice  ==!   
     255      IF(lwp) THEN 
    287256         WRITE(numout,*) 
    288257         SELECT CASE ( nadv ) 
    … …  
    292261         CASE( np_FCT     )   ;   WRITE(numout,*) '      ===>>   FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    293262            &                                                                      ' Vertical   order: ', nn_fct_v 
    294          CASE( np_FCT_zts )   ;   WRITE(numout,*) '      ===>>   use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
    295263         CASE( np_MUS     )   ;   WRITE(numout,*) '      ===>>   MUSCL    scheme is used' 
    296264         CASE( np_UBS     )   ;   WRITE(numout,*) '      ===>>   UBS      scheme is used' 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

    r7646 r8568  
    1111   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used 
    1212   !!---------------------------------------------------------------------- 
    13    USE oce      , ONLY: tsn ! now ocean temperature and salinity 
    1413   USE dom_oce        ! ocean space and time domain 
    1514   USE eosbn2         ! equation of state 
    … …  
    2423   USE trc_oce        ! share passive tracers/Ocean variables 
    2524   USE lib_mpp        ! MPP library 
    26    USE wrk_nemo       ! Memory Allocation 
    2725   USE timing         ! Timing 
    2826 
    … …  
    3028   PRIVATE 
    3129 
    32    PUBLIC   tra_adv_cen       ! routine called by step.F90 
     30   PUBLIC   tra_adv_cen   ! called by traadv.F90 
    3331    
    3432   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6 
    3533 
    36    LOGICAL :: l_trd   ! flag to compute trends 
    37    LOGICAL :: l_ptr   ! flag to compute poleward transport 
    38    LOGICAL :: l_hst   ! flag to compute heat/salt transport 
     34   LOGICAL ::   l_trd   ! flag to compute trends 
     35   LOGICAL ::   l_ptr   ! flag to compute poleward transport 
     36   LOGICAL ::   l_hst   ! flag to compute heat/salt transport 
    3937 
    4038   !! * Substitutions 
    4139#  include "vectopt_loop_substitute.h90" 
    4240   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    44    !! $Id$ 
     41   !! NEMO/OPA 4.0, NEMO Consortium (2017) 
     42   !! $Id:$ 
    4543   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4644   !!---------------------------------------------------------------------- 
    … …  
    4846 
    4947   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     & 
    50       &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
     48      &                                        ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
    5149      !!---------------------------------------------------------------------- 
    5250      !!                  ***  ROUTINE tra_adv_cen  *** 
    … …  
    8078      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars 
    8179      REAL(wp) ::   zC2t_v, zC4t_v   !   -      - 
    82       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz, ztu, ztv, ztw 
    8381      !!---------------------------------------------------------------------- 
    8482      ! 
    85       IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen') 
    86       ! 
    87       CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw ) 
     83      IF( ln_timing )   CALL timing_start('tra_adv_cen') 
    8884      ! 
    8985      IF( kt == kit000 )  THEN 
    … …  
    9288         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 
    9389      ENDIF 
    94       ! 
     90      !                          ! set local switches 
    9591      l_trd = .FALSE. 
    9692      l_hst = .FALSE. 
    … …  
    130126               END DO 
    131127            END DO 
    132             CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
     128            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. 
    133129            ! 
    134130            DO jk = 1, jpkm1                       ! Horizontal advective fluxes 
    … …  
    203199         END IF 
    204200         !                                 ! "Poleward" heat and salt transports  
    205          IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
     201         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    206202         !                                 !  heat and salt transport 
    207          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
     203         IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 
    208204         ! 
    209205      END DO 
    210206      ! 
    211       CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw ) 
    212       ! 
    213       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen') 
     207      IF( ln_timing )   CALL timing_stop('tra_adv_cen') 
    214208      ! 
    215209   END SUBROUTINE tra_adv_cen 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r7753 r8568  
    99   !!---------------------------------------------------------------------- 
    1010   !!  tra_adv_fct    : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme 
    11    !!  tra_adv_fct_zts: update the tracer trend with a 3D advective trends using a 2nd order FCT scheme  
    1211   !!                   with sub-time-stepping in the vertical direction 
    1312   !!  nonosc         : compute monotonic tracer fluxes by a non-oscillatory algorithm  
    … …  
    2120   USE diaptr         ! poleward transport diagnostics 
    2221   USE diaar5         ! AR5 diagnostics 
    23    USE phycst, ONLY: rau0_rcp 
     22   USE phycst  , ONLY : rau0_rcp 
    2423   ! 
    2524   USE in_out_manager ! I/O manager 
    26    USE iom 
     25   USE iom            !  
    2726   USE lib_mpp        ! MPP library 
    2827   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    2928   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    30    USE wrk_nemo       ! Memory Allocation 
    3129   USE timing         ! Timing 
    3230 
    … …  
    3432   PRIVATE 
    3533 
    36    PUBLIC   tra_adv_fct        ! routine called by traadv.F90 
    37    PUBLIC   tra_adv_fct_zts    ! routine called by traadv.F90 
    38    PUBLIC   interp_4th_cpt     ! routine called by traadv_cen.F90 
     34   PUBLIC   tra_adv_fct        ! called by traadv.F90 
     35   PUBLIC   interp_4th_cpt     ! called by traadv_cen.F90 
    3936 
    4037   LOGICAL  ::   l_trd   ! flag to compute trends 
    … …  
    5047#  include "vectopt_loop_substitute.h90" 
    5148   !!---------------------------------------------------------------------- 
    52    !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     49   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    5350   !! $Id$ 
    5451   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7067      !! 
    7168      !! ** Action : - update pta  with the now advective tracer trends 
    72       !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
     69      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T) 
    7370      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    7471      !!---------------------------------------------------------------------- 
    … …  
    8885      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u   !   -      - 
    8986      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v   !   -      - 
    90       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdx, ztrdy, ztrdz, zptry 
    92       REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    93       !!---------------------------------------------------------------------- 
    94       ! 
    95       IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct') 
    96       ! 
    97       CALL wrk_alloc( jpi,jpj,jpk,   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
     87      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 
     88      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry 
     89      !!---------------------------------------------------------------------- 
     90      ! 
     91      IF( ln_timing )   CALL timing_start('tra_adv_fct') 
    9892      ! 
    9993      IF( kt == kit000 )  THEN 
    … …  
    10397      ENDIF 
    10498      ! 
    105       l_trd = .FALSE. 
     99      l_trd = .FALSE.            ! set local switches 
    106100      l_hst = .FALSE. 
    107101      l_ptr = .FALSE. 
    108       IF( ( cdtype == 'TRA'   .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )     l_trd = .TRUE. 
    109       IF(   cdtype == 'TRA'   .AND. ln_diaptr )                                              l_ptr = .TRUE.  
    110       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    111          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
     102      IF( ( cdtype =='TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )       l_trd = .TRUE. 
     103      IF(   cdtype =='TRA' .AND. ln_diaptr )                                                l_ptr = .TRUE.  
     104      IF(   cdtype =='TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
     105         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE. 
    112106      ! 
    113107      IF( l_trd .OR. l_hst )  THEN 
    114          CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     108         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 
    115109         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
    116110      ENDIF 
    117111      ! 
    118112      IF( l_ptr ) THEN   
    119          CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
     113         ALLOCATE( zptry(jpi,jpj,jpk) ) 
    120114         zptry(:,:,:) = 0._wp 
    121115      ENDIF 
    … …  
    184178         END IF 
    185179         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    186          IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:)  
     180         IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)  
    187181         ! 
    188182         !        !==  anti-diffusive flux : high order minus low order  ==! 
    … …  
    308302         END DO 
    309303         ! 
    310          IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    311             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    312             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    313             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
     304         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport 
     305            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes  
     306            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes 
     307            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! 
     308            ! 
     309            IF( l_trd ) THEN              ! trend diagnostics 
     310               CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     311               CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     312               CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
     313            ENDIF 
     314            !                             ! heat/salt transport 
     315            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
     316            ! 
     317            DEALLOCATE( ztrdx, ztrdy, ztrdz ) 
    314318         ENDIF 
    315             ! 
    316          IF( l_trd ) THEN  
    317             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    318             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    319             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    320             ! 
    321          END IF 
    322          !                                !  heat/salt transport 
    323          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
    324  
    325          !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    326          IF( l_ptr ) THEN   
    327             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     319         IF( l_ptr ) THEN              ! "Poleward" transports 
     320            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes 
    328321            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
     322            DEALLOCATE( zptry ) 
    329323         ENDIF 
    330324         ! 
    331325      END DO                     ! end of tracer loop 
    332326      ! 
    333                               CALL wrk_dealloc( jpi,jpj,jpk,    zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 
    334       IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    335       IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    336       ! 
    337       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct') 
     327      IF( ln_timing )   CALL timing_stop('tra_adv_fct') 
    338328      ! 
    339329   END SUBROUTINE tra_adv_fct 
    340  
    341  
    342    SUBROUTINE tra_adv_fct_zts( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
    343       &                                                  ptb, ptn, pta, kjpt, kn_fct_zts ) 
    344       !!---------------------------------------------------------------------- 
    345       !!                  ***  ROUTINE tra_adv_fct_zts  *** 
    346       !!  
    347       !! **  Purpose :   Compute the now trend due to total advection of  
    348       !!       tracers and add it to the general trend of tracer equations 
    349       !! 
    350       !! **  Method  :   TVD ZTS scheme, i.e. 2nd order centered scheme with 
    351       !!       corrected flux (monotonic correction). This version use sub- 
    352       !!       timestepping for the vertical advection which increases stability 
    353       !!       when vertical metrics are small. 
    354       !!       note: - this advection scheme needs a leap-frog time scheme 
    355       !! 
    356       !! ** Action : - update (pta) with the now advective tracer trends 
    357       !!             - save the trends  
    358       !!---------------------------------------------------------------------- 
    359       INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    360       INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    361       CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    362       INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    363       INTEGER                              , INTENT(in   ) ::   kn_fct_zts      ! number of number of vertical sub-timesteps 
    364       REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    365       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
    366       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
    367       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    368       ! 
    369       REAL(wp), DIMENSION( jpk )                           ::   zts             ! length of sub-timestep for vertical advection 
    370       REAL(wp)                                             ::   zr_p2dt         ! reciprocal of tracer timestep 
    371       INTEGER  ::   ji, jj, jk, jl, jn       ! dummy loop indices   
    372       INTEGER  ::   jtb, jtn, jta   ! sub timestep pointers for leap-frog/euler forward steps 
    373       INTEGER  ::   jtaken          ! toggle for collecting appropriate fluxes from sub timesteps 
    374       REAL(wp) ::   z_rzts          ! Fractional length of Euler forward sub-timestep for vertical advection 
    375       REAL(wp) ::   ztra            ! local scalar 
    376       REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
    377       REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    378       REAL(wp), POINTER, DIMENSION(:,:  )   ::   zwx_sav , zwy_sav 
    379       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 
    380       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdx, ztrdy, ztrdz 
    381       REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
    382       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrs 
    383       !!---------------------------------------------------------------------- 
    384       ! 
    385       IF( nn_timing == 1 )  CALL timing_start('tra_adv_fct_zts') 
    386       ! 
    387       CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    388       CALL wrk_alloc( jpi,jpj,jpk,         zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    389       CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    390       ! 
    391       IF( kt == kit000 )  THEN 
    392          IF(lwp) WRITE(numout,*) 
    393          IF(lwp) WRITE(numout,*) 'tra_adv_fct_zts : 2nd order FCT scheme with ', kn_fct_zts, ' vertical sub-timestep on ', cdtype 
    394          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    395       ENDIF 
    396       ! 
    397       l_trd = .FALSE. 
    398       l_hst = .FALSE. 
    399       l_ptr = .FALSE. 
    400       IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE. 
    401       IF(   cdtype == 'TRA' .AND. ln_diaptr )                                               l_ptr = .TRUE.  
    402       IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 
    403          &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE. 
    404       ! 
    405       IF( l_trd .OR. l_hst )  THEN 
    406          CALL wrk_alloc( jpi,jpj,jpk,   ztrdx, ztrdy, ztrdz ) 
    407          ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
    408       ENDIF 
    409       ! 
    410       IF( l_ptr ) THEN   
    411          CALL wrk_alloc( jpi, jpj,jpk, zptry ) 
    412          zptry(:,:,:) = 0._wp 
    413       ENDIF 
    414       zwi(:,:,:) = 0._wp 
    415       z_rzts = 1._wp / REAL( kn_fct_zts, wp ) 
    416       zr_p2dt = 1._wp / p2dt 
    417       ! 
    418       ! surface & Bottom value : flux set to zero for all tracers 
    419       zwz(:,:, 1 ) = 0._wp 
    420       zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp 
    421       zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp 
    422       ! 
    423       !                                                          ! =========== 
    424       DO jn = 1, kjpt                                            ! tracer loop 
    425          !                                                       ! =========== 
    426          ! 
    427          ! Upstream advection with initial mass fluxes & intermediate update 
    428          DO jk = 1, jpkm1        ! upstream tracer flux in the i and j direction 
    429             DO jj = 1, jpjm1 
    430                DO ji = 1, fs_jpim1   ! vector opt. 
    431                   ! upstream scheme 
    432                   zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) 
    433                   zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 
    434                   zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
    435                   zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
    436                   zwx(ji,jj,jk) = 0.5_wp * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) ) 
    437                   zwy(ji,jj,jk) = 0.5_wp * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) ) 
    438                END DO 
    439             END DO 
    440          END DO 
    441          !                       ! upstream tracer flux in the k direction 
    442          DO jk = 2, jpkm1              ! Interior value 
    443             DO jj = 1, jpj 
    444                DO ji = 1, jpi 
    445                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
    446                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
    447                   zwz(ji,jj,jk) = 0.5_wp * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    448                END DO 
    449             END DO 
    450          END DO 
    451          IF( ln_linssh ) THEN          ! top value : linear free surface case only (as zwz is multiplied by wmask) 
    452             IF( ln_isfcav ) THEN             ! ice-shelf cavities: top value 
    453                DO jj = 1, jpj 
    454                   DO ji = 1, jpi 
    455                      zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)  
    456                   END DO 
    457                END DO    
    458             ELSE                             ! no cavities, surface value 
    459                zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    460             ENDIF 
    461          ENDIF 
    462          ! 
    463          DO jk = 1, jpkm1         ! total advective trend 
    464             DO jj = 2, jpjm1 
    465                DO ji = fs_2, fs_jpim1   ! vector opt. 
    466                   !                             ! total intermediate advective trends 
    467                   ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    468                      &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    469                      &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   ) * r1_e1e2t(ji,jj) 
    470                   !                             ! update and guess with monotonic sheme 
    471                   pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    472                   zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    473                END DO 
    474             END DO 
    475          END DO 
    476          !                            
    477          CALL lbc_lnk( zwi, 'T', 1. )     ! Lateral boundary conditions on zwi  (unchanged sign) 
    478          !                 
    479          IF( l_trd .OR. l_hst )  THEN                ! trend diagnostics (contribution of upstream fluxes) 
    480             ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    481          END IF 
    482          !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    483          IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:) 
    484  
    485          ! 3. anti-diffusive flux : high order minus low order 
    486          ! --------------------------------------------------- 
    487  
    488          DO jk = 1, jpkm1                    !* horizontal anti-diffusive fluxes 
    489             ! 
    490             DO jj = 1, jpjm1 
    491                DO ji = 1, fs_jpim1   ! vector opt. 
    492                   zwx_sav(ji,jj) = zwx(ji,jj,jk) 
    493                   zwy_sav(ji,jj) = zwy(ji,jj,jk) 
    494                   ! 
    495                   zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) 
    496                   zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) 
    497                END DO 
    498             END DO 
    499             ! 
    500             DO jj = 2, jpjm1                    ! partial horizontal divergence 
    501                DO ji = fs_2, fs_jpim1 
    502                   zhdiv(ji,jj,jk) = (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   & 
    503                      &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  ) 
    504                END DO 
    505             END DO 
    506             ! 
    507             DO jj = 1, jpjm1 
    508                DO ji = 1, fs_jpim1   ! vector opt. 
    509                   zwx(ji,jj,jk) = zwx(ji,jj,jk) - zwx_sav(ji,jj) 
    510                   zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwy_sav(ji,jj) 
    511                END DO 
    512             END DO 
    513          END DO 
    514          ! 
    515          !                                !* vertical anti-diffusive flux 
    516          zwz_sav(:,:,:)   = zwz(:,:,:) 
    517          ztrs   (:,:,:,1) = ptb(:,:,:,jn) 
    518          ztrs   (:,:,1,2) = ptb(:,:,1,jn) 
    519          ztrs   (:,:,1,3) = ptb(:,:,1,jn) 
    520          zwzts  (:,:,:)   = 0._wp 
    521          ! 
    522          DO jl = 1, kn_fct_zts                  ! Start of sub timestepping loop 
    523             ! 
    524             IF( jl == 1 ) THEN                        ! Euler forward to kick things off 
    525                jtb = 1   ;   jtn = 1   ;   jta = 2 
    526                zts(:) = p2dt * z_rzts 
    527                jtaken = MOD( kn_fct_zts + 1 , 2)            ! Toggle to collect every second flux 
    528                !                                            ! starting at jl =1 if kn_fct_zts is odd;  
    529                !                                            ! starting at jl =2 otherwise 
    530             ELSEIF( jl == 2 ) THEN                    ! First leapfrog step 
    531                jtb = 1   ;   jtn = 2   ;   jta = 3 
    532                zts(:) = 2._wp * p2dt * z_rzts 
    533             ELSE                                      ! Shuffle pointers for subsequent leapfrog steps 
    534                jtb = MOD(jtb,3) + 1 
    535                jtn = MOD(jtn,3) + 1 
    536                jta = MOD(jta,3) + 1 
    537             ENDIF 
    538             DO jk = 2, jpkm1                          ! interior value 
    539                DO jj = 2, jpjm1 
    540                   DO ji = fs_2, fs_jpim1 
    541                      zwz(ji,jj,jk) = 0.5_wp * pwn(ji,jj,jk) * ( ztrs(ji,jj,jk,jtn) + ztrs(ji,jj,jk-1,jtn) ) * wmask(ji,jj,jk) 
    542                      IF( jtaken == 0 )   zwzts(ji,jj,jk) = zwzts(ji,jj,jk) + zwz(ji,jj,jk) * zts(jk)    ! Accumulate time-weighted vertcal flux 
    543                   END DO 
    544                END DO 
    545             END DO 
    546             IF( ln_linssh ) THEN                    ! top value (only in linear free surface case) 
    547                IF( ln_isfcav ) THEN                      ! ice-shelf cavities 
    548                   DO jj = 1, jpj 
    549                      DO ji = 1, jpi 
    550                         zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    551                      END DO 
    552                   END DO    
    553                ELSE                                      ! no ocean cavities 
    554                   zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    555                ENDIF 
    556             ENDIF 
    557             ! 
    558             jtaken = MOD( jtaken + 1 , 2 ) 
    559             ! 
    560             DO jk = 2, jpkm1                             ! total advective trends 
    561                DO jj = 2, jpjm1 
    562                   DO ji = fs_2, fs_jpim1 
    563                      ztrs(ji,jj,jk,jta) = ztrs(ji,jj,jk,jtb)                                                 & 
    564                         &               - zts(jk) * (  zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    565                         &                         * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    566                   END DO 
    567                END DO 
    568             END DO 
    569             ! 
    570          END DO 
    571  
    572          DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping 
    573             DO jj = 2, jpjm1 
    574                DO ji = fs_2, fs_jpim1 
    575                   zwz(ji,jj,jk) = ( zwzts(ji,jj,jk) * zr_p2dt - zwz_sav(ji,jj,jk) ) * wmask(ji,jj,jk) 
    576                END DO 
    577             END DO 
    578          END DO 
    579          CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
    580          CALL lbc_lnk( zwz, 'W',  1. ) 
    581  
    582          ! 4. monotonicity algorithm 
    583          ! ------------------------- 
    584          CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 
    585  
    586  
    587          ! 5. final trend with corrected fluxes 
    588          ! ------------------------------------ 
    589          DO jk = 1, jpkm1 
    590             DO jj = 2, jpjm1 
    591                DO ji = fs_2, fs_jpim1   ! vector opt.   
    592                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (   zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )       & 
    593                      &                                    + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)   )   & 
    594                      &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    595                END DO 
    596             END DO 
    597          END DO 
    598  
    599         ! 
    600          IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    601             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    602             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    603             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    604          ENDIF 
    605             ! 
    606          IF( l_trd ) THEN  
    607             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
    608             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
    609             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    610             ! 
    611          END IF 
    612          !                                             ! heat/salt transport 
    613          IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 
    614  
    615          !                                            ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    616          IF( l_ptr ) THEN   
    617             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    618             CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
    619          ENDIF 
    620          ! 
    621       END DO 
    622       ! 
    623                               CALL wrk_alloc( jpi,jpj,             zwx_sav, zwy_sav ) 
    624                               CALL wrk_alloc( jpi,jpj, jpk,        zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 
    625                               CALL wrk_alloc( jpi,jpj,jpk,kjpt+1,  ztrs ) 
    626       IF( l_trd .OR. l_hst )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    627       IF( l_ptr )             CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    628       ! 
    629       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_fct_zts') 
    630       ! 
    631    END SUBROUTINE tra_adv_fct_zts 
    632330 
    633331 
    … …  
    653351      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars 
    654352      REAL(wp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      - 
    655       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo, zbup, zbdo 
    656       !!---------------------------------------------------------------------- 
    657       ! 
    658       IF( nn_timing == 1 )  CALL timing_start('nonosc') 
    659       ! 
    660       CALL wrk_alloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
     353      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 
     354      !!---------------------------------------------------------------------- 
     355      ! 
     356      IF( ln_timing )   CALL timing_start('nonosc') 
    661357      ! 
    662358      zbig  = 1.e+40_wp 
    … …  
    734430      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    735431      ! 
    736       CALL wrk_dealloc( jpi, jpj, jpk, zbetup, zbetdo, zbup, zbdo ) 
    737       ! 
    738       IF( nn_timing == 1 )  CALL timing_stop('nonosc') 
     432      IF( ln_timing )   CALL timing_stop('nonosc') 
    739433      ! 
    740434   END SUBROUTINE nonosc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r7753 r8568  
    1515   USE phycst         ! physical constant 
    1616   USE zdfmxl         ! mixed layer depth 
     17   ! 
    1718   USE lbclnk         ! lateral boundary condition / mpp link 
    1819   USE in_out_manager ! I/O manager 
    1920   USE iom            ! IOM library 
    2021   USE lib_mpp        ! MPP library 
    21    USE wrk_nemo       ! work arrays 
    2222   USE timing         ! Timing 
    2323 
    … …  
    8686      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport 
    8787      ! 
    88       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    89       INTEGER  ::   ikmax        ! temporary integer 
    90       REAL(wp) ::   zcuw, zmuw   ! local scalar 
    91       REAL(wp) ::   zcvw, zmvw   !   -      - 
    92       REAL(wp) ::   zc                                     !   -      - 
    93       ! 
    94       INTEGER  ::   ii, ij, ik              ! local integers 
    95       INTEGER, DIMENSION(3) ::   ilocu      ! 
    96       INTEGER, DIMENSION(2) ::   ilocs      ! 
    97       REAL(wp), POINTER, DIMENSION(:,:  ) :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
    98       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw 
    99       INTEGER, POINTER, DIMENSION(:,:) :: inml_mle 
    100       !!---------------------------------------------------------------------- 
    101       ! 
    102       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mle') 
    103       CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) 
    104       CALL wrk_alloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw) 
    105       CALL wrk_alloc( jpi, jpj, inml_mle) 
     88      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     89      INTEGER  ::   ii, ij, ik, ikmax   ! local integers 
     90      REAL(wp) ::   zcuw, zmuw, zc      ! local scalar 
     91      REAL(wp) ::   zcvw, zmvw          !   -      - 
     92      INTEGER , DIMENSION(jpi,jpj)     :: inml_mle 
     93      REAL(wp), DIMENSION(jpi,jpj)     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 
     95      !!---------------------------------------------------------------------- 
     96      ! 
     97      IF( ln_timing )   CALL timing_start('tra_adv_mle') 
    10698      ! 
    10799      !                                      !==  MLD used for MLE  ==! 
    … …  
    256248         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction 
    257249      ENDIF 
    258       CALL wrk_dealloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) 
    259       CALL wrk_dealloc( jpi, jpj, jpk, zpsi_uw, zpsi_vw) 
    260       CALL wrk_dealloc( jpi, jpj, inml_mle) 
    261  
    262       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mle') 
     250      ! 
     251      IF( ln_timing )   CALL timing_stop('tra_adv_mle') 
    263252      ! 
    264253   END SUBROUTINE tra_adv_mle 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r7753 r8568  
    2626 
    2727   ! 
    28    USE iom 
    29    USE wrk_nemo       ! Memory Allocation 
     28   USE iom            ! XIOS library 
    3029   USE timing         ! Timing 
    3130   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    8584      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    8685      ! 
    87       INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    88       INTEGER  ::   ierr                 ! local integer 
    89       REAL(wp) ::   zu, z0u, zzwx, zw    ! local scalars 
    90       REAL(wp) ::   zv, z0v, zzwy, z0w   !   -      - 
    91       REAL(wp) ::   zalpha               !   -      - 
    92       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zslpx, zslpy   ! 3D workspace 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx  , zwy     ! -      -  
     86      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     87      INTEGER  ::   ierr             ! local integer 
     88      REAL(wp) ::   zu, z0u, zzwx, zw , zalpha   ! local scalars 
     89      REAL(wp) ::   zv, z0v, zzwy, z0w           !   -      - 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zslpx   ! 3D workspace 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zslpy   ! -      -  
    9492      !!---------------------------------------------------------------------- 
    9593      ! 
    96       IF( nn_timing == 1 )  CALL timing_start('tra_adv_mus') 
    97       ! 
    98       CALL wrk_alloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy ) 
     94      IF( ln_timing )   CALL timing_start('tra_adv_mus') 
    9995      ! 
    10096      IF( kt == kit000 )  THEN 
    … …  
    279275      END DO                     ! end of tracer loop 
    280276      ! 
    281       CALL wrk_dealloc( jpi,jpj,jpk,   zslpx, zslpy, zwx, zwy ) 
    282       ! 
    283       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_mus') 
     277      IF( ln_timing )   CALL timing_stop('tra_adv_mus') 
    284278      ! 
    285279   END SUBROUTINE tra_adv_mus 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r7646 r8568  
    2525   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    2626   USE in_out_manager  ! I/O manager 
    27    USE wrk_nemo        ! Memory Allocation 
    2827   USE timing          ! Timing 
    2928   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    4342#  include "vectopt_loop_substitute.h90" 
    4443   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     44   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    4645   !! $Id$ 
    4746   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    9695      !!---------------------------------------------------------------------- 
    9796      ! 
    98       IF( nn_timing == 1 )  CALL timing_start('tra_adv_qck') 
     97      IF( ln_timing )   CALL timing_start('tra_adv_qck') 
    9998      ! 
    10099      IF( kt == kit000 )  THEN 
    … …  
    118117      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt ) 
    119118      ! 
    120       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_qck') 
     119      IF( ln_timing )   CALL timing_stop('tra_adv_qck') 
    121120      ! 
    122121   END SUBROUTINE tra_adv_qck 
    … …  
    138137      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    139138      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    140       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zfu, zfc, zfd 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zfu, zfc, zfd 
    141140      !---------------------------------------------------------------------- 
    142141      ! 
    143       CALL wrk_alloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    144142      !                                                          ! =========== 
    145143      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    230228         END DO 
    231229         !                                 ! trend diagnostics 
    232          IF( l_trd )                     CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     230         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    233231         ! 
    234232      END DO 
    235       ! 
    236       CALL wrk_dealloc( jpi, jpj, jpk, zwx, zfu, zfc, zfd ) 
    237233      ! 
    238234   END SUBROUTINE tra_adv_qck_i 
    … …  
    252248      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    253249      !! 
    254       INTEGER  :: ji, jj, jk, jn   ! dummy loop indices 
     250      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices 
    255251      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars 
    256       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwy, zfu, zfc, zfd 
     252      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zfu, zfc, zfd   ! 3D workspace 
    257253      !---------------------------------------------------------------------- 
    258       ! 
    259       CALL wrk_alloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    260254      ! 
    261255      !                                                          ! =========== 
    … …  
    320314            END DO 
    321315         END DO 
    322          !--- Lateral boundary conditions  
    323          CALL lbc_lnk( zfu(:,:,:), 'T', 1. )  
     316         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )    !--- Lateral boundary conditions  
    324317         ! 
    325318         ! Tracer flux on the x-direction 
    … …  
    359352      END DO 
    360353      ! 
    361       CALL wrk_dealloc( jpi, jpj, jpk, zwy, zfu, zfc, zfd ) 
    362       ! 
    363354   END SUBROUTINE tra_adv_qck_j 
    364355 
    … …  
    377368      ! 
    378369      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    379       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz 
    380       !!---------------------------------------------------------------------- 
    381       ! 
    382       CALL wrk_alloc( jpi,jpj,jpk,   zwz ) 
     370      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz   ! 3D workspace 
     371      !!---------------------------------------------------------------------- 
    383372      ! 
    384373      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers 
    … …  
    421410      END DO 
    422411      ! 
    423       CALL wrk_dealloc( jpi,jpj,jpk,   zwz ) 
    424       ! 
    425412   END SUBROUTINE tra_adv_cen2_k 
    426413 
    … …  
    443430      !---------------------------------------------------------------------- 
    444431      ! 
    445       IF( nn_timing == 1 )  CALL timing_start('quickest') 
     432      IF( ln_timing )   CALL timing_start('quickest') 
    446433      ! 
    447434      DO jk = 1, jpkm1 
    … …  
    475462      END DO 
    476463      ! 
    477       IF( nn_timing == 1 )  CALL timing_stop('quickest') 
     464      IF( ln_timing )   CALL timing_stop('quickest') 
    478465      ! 
    479466   END SUBROUTINE quickest 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r7646 r8568  
    2222 
    2323   ! 
    24    USE iom 
    25    USE lib_mpp        ! I/O library 
     24   USE iom            ! XIOS library 
     25   USE lib_mpp        ! massively parallel library 
    2626   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    2727   USE in_out_manager ! I/O manager 
    28    USE wrk_nemo       ! Memory Allocation 
    2928   USE timing         ! Timing 
    3029   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    101100      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      - 
    102101      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      - 
    103       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zltu, zltv, zti, ztw 
    104       !!---------------------------------------------------------------------- 
    105       ! 
    106       IF( nn_timing == 1 )  CALL timing_start('tra_adv_ubs') 
    107       ! 
    108       CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw ) 
     102      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zltu, zltv, zti, ztw   ! 3D workspace 
     103      !!---------------------------------------------------------------------- 
     104      ! 
     105      IF( ln_timing )   CALL timing_start('tra_adv_ubs') 
    109106      ! 
    110107      IF( kt == kit000 )  THEN 
    … …  
    285282      END DO 
    286283      ! 
    287       CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zltu, zltv, zti, ztw ) 
    288       ! 
    289       IF( nn_timing == 1 )  CALL timing_stop('tra_adv_ubs') 
     284      IF( ln_timing )   CALL timing_stop('tra_adv_ubs') 
    290285      ! 
    291286   END SUBROUTINE tra_adv_ubs 
    … …  
    313308      INTEGER  ::   ikm1         ! local integer 
    314309      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars 
    315       REAL(wp), POINTER, DIMENSION(:,:,:) :: zbetup, zbetdo 
    316       !!---------------------------------------------------------------------- 
    317       ! 
    318       IF( nn_timing == 1 )  CALL timing_start('nonosc_z') 
    319       ! 
    320       CALL wrk_alloc( jpi,jpj,jpk,   zbetup, zbetdo ) 
     310      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zbetup, zbetdo     ! 3D workspace 
     311      !!---------------------------------------------------------------------- 
     312      ! 
     313      IF( ln_timing )   CALL timing_start('nonosc_z') 
    321314      ! 
    322315      zbig  = 1.e+40_wp 
    … …  
    387380      END DO 
    388381      ! 
    389       CALL wrk_dealloc( jpi,jpj,jpk,   zbetup, zbetdo ) 
    390       ! 
    391       IF( nn_timing == 1 )  CALL timing_stop('nonosc_z') 
     382      IF( ln_timing )   CALL timing_stop('nonosc_z') 
    392383      ! 
    393384   END SUBROUTINE nonosc_z 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r7753 r8568  
    2727   USE lib_mpp        ! distributed memory computing library 
    2828   USE prtctl         ! Print control 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    7776      ! 
    7877      INTEGER  ::   ji, jj    ! dummy loop indices 
    79       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt 
     78      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt   ! 3D workspace 
    8079      !!---------------------------------------------------------------------- 
    8180      ! 
    82       IF( nn_timing == 1 )  CALL timing_start('tra_bbc') 
     81      IF( ln_timing )   CALL timing_start('tra_bbc') 
    8382      ! 
    8483      IF( l_trdtra )   THEN         ! Save the input temperature trend 
    85          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
     84         ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
    8685         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    8786      ENDIF 
    … …  
    9897         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    9998         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    100          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt ) 
     99         DEALLOCATE( ztrdt ) 
    101100      ENDIF 
    102101      ! 
    103102      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    104103      ! 
    105       IF( nn_timing == 1 )  CALL timing_stop('tra_bbc') 
     104      IF( ln_timing )   CALL timing_stop('tra_bbc') 
    106105      ! 
    107106   END SUBROUTINE tra_bbc 
    … …  
    130129      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read 
    131130      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files 
    132       ! 
     131      !! 
    133132      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir  
    134133      !!---------------------------------------------------------------------- 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r8215 r8568  
    3535   USE lbclnk         ! ocean lateral boundary conditions 
    3636   USE prtctl         ! Print control 
    37    USE wrk_nemo       ! Memory Allocation 
    3837   USE timing         ! Timing 
    3938   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
    … …  
    104103      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    105104      ! 
    106       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    107       !!---------------------------------------------------------------------- 
    108       ! 
    109       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl') 
     105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     106      !!---------------------------------------------------------------------- 
     107      ! 
     108      IF( ln_timing )   CALL timing_start( 'tra_bbl') 
    110109      ! 
    111110      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    112          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     111         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    113112         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    114113         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    148147         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    149148         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    150          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    151       ENDIF 
    152       ! 
    153       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl') 
     149         DEALLOCATE( ztrdt, ztrds ) 
     150      ENDIF 
     151      ! 
     152      IF( ln_timing )  CALL timing_stop( 'tra_bbl') 
    154153      ! 
    155154   END SUBROUTINE tra_bbl 
    … …  
    184183      INTEGER  ::   ik           ! local integers 
    185184      REAL(wp) ::   zbtr         ! local scalars 
    186       REAL(wp), POINTER, DIMENSION(:,:) :: zptb 
    187       !!---------------------------------------------------------------------- 
    188       ! 
    189       IF( nn_timing == 1 )  CALL timing_start('tra_bbl_dif') 
    190       ! 
    191       CALL wrk_alloc( jpi, jpj, zptb ) 
     185      REAL(wp), DIMENSION(jpi,jpj) ::   zptb   ! workspace 
     186      !!---------------------------------------------------------------------- 
     187      ! 
     188      IF( ln_timing )   CALL timing_start('tra_bbl_dif') 
    192189      ! 
    193190      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    214211      END DO                                                ! end tracer 
    215212      !                                                     ! =========== 
    216       CALL wrk_dealloc( jpi, jpj, zptb ) 
    217       ! 
    218       IF( nn_timing == 1 )  CALL timing_stop('tra_bbl_dif') 
     213      ! 
     214      IF( ln_timing )   CALL timing_stop('tra_bbl_dif') 
    219215      ! 
    220216   END SUBROUTINE tra_bbl_dif 
    … …  
    247243      !!---------------------------------------------------------------------- 
    248244      ! 
    249       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_adv') 
     245      IF( ln_timing )   CALL timing_start( 'tra_bbl_adv') 
    250246      !                                                          ! =========== 
    251247      DO jn = 1, kjpt                                            ! tracer loop 
    … …  
    303299      !                                                     ! =========== 
    304300      ! 
    305       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_adv') 
     301      IF( ln_timing )   CALL timing_stop( 'tra_bbl_adv') 
    306302      ! 
    307303   END SUBROUTINE tra_bbl_adv 
    … …  
    348344      !!---------------------------------------------------------------------- 
    349345      ! 
    350       IF( nn_timing == 1 )  CALL timing_start( 'bbl') 
     346      IF( ln_timing )   CALL timing_start( 'bbl') 
    351347      ! 
    352348      IF( kt == kit000 )  THEN 
    … …  
    479475      ENDIF 
    480476      ! 
    481       IF( nn_timing == 1 )  CALL timing_stop( 'bbl') 
     477      IF( ln_timing )   CALL timing_stop( 'bbl') 
    482478      ! 
    483479   END SUBROUTINE bbl 
    … …  
    493489      !!              called by nemo_init at the first timestep (kit000) 
    494490      !!---------------------------------------------------------------------- 
    495       INTEGER ::   ji, jj               ! dummy loop indices 
    496       INTEGER ::   ii0, ii1, ij0, ij1   ! local integer 
    497       INTEGER ::   ios                  !   -      - 
    498       REAL(wp), POINTER, DIMENSION(:,:) :: zmbk 
     491      INTEGER ::   ji, jj                      ! dummy loop indices 
     492      INTEGER ::   ii0, ii1, ij0, ij1, ios     ! local integer 
     493      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! workspace 
    499494      !! 
    500495      NAMELIST/nambbl/ ln_trabbl, nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 
    501496      !!---------------------------------------------------------------------- 
    502497      ! 
    503       IF( nn_timing == 1 )  CALL timing_start( 'tra_bbl_init') 
     498      IF( ln_timing )   CALL timing_start( 'tra_bbl_init') 
    504499      ! 
    505500      REWIND( numnam_ref )              ! Namelist nambbl in reference namelist : Bottom boundary layer scheme 
    … …  
    544539      END DO 
    545540      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
    546       CALL wrk_alloc( jpi, jpj, zmbk ) 
    547541      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    548542      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
    549       CALL wrk_dealloc( jpi, jpj, zmbk ) 
    550543      ! 
    551544      !                                 !* sign of grad(H) at u- and v-points 
    … …  
    570563      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    571564      ! 
    572       IF( nn_timing == 1 )  CALL timing_stop( 'tra_bbl_init') 
     565      IF( ln_timing )   CALL timing_stop( 'tra_bbl_init') 
    573566      ! 
    574567   END SUBROUTINE tra_bbl_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r7753 r8568  
    3333   ! 
    3434   USE in_out_manager ! I/O manager 
     35   USE iom            ! XIOS 
    3536   USE lib_mpp        ! MPP library 
    3637   USE prtctl         ! Print control 
    37    USE wrk_nemo       ! Memory allocation 
    3838   USE timing         ! Timing 
    39    USE iom 
    4039 
    4140   IMPLICIT NONE 
    … …  
    9493      ! 
    9594      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    96       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta, ztrdts 
    97       !!---------------------------------------------------------------------- 
    98       ! 
    99       IF( nn_timing == 1 )   CALL timing_start('tra_dmp') 
    100       ! 
    101       CALL wrk_alloc( jpi,jpj,jpk,jpts,   zts_dta ) 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts)     ::  zts_dta 
     96      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts 
     97      !!---------------------------------------------------------------------- 
     98      ! 
     99      IF( ln_timing )   CALL timing_start('tra_dmp') 
     100      ! 
    102101      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    103          CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts )  
     102         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )  
    104103         ztrdts(:,:,:,:) = tsa(:,:,:,:)  
    105104      ENDIF 
    … …  
    154153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    155154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 
    156          CALL wrk_dealloc( jpi,jpj,jpk,jpts,  ztrdts )  
     155         DEALLOCATE( ztrdts )  
    157156      ENDIF 
    158157      !                           ! Control print 
    … …  
    160159         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    161160      ! 
    162       CALL wrk_dealloc( jpi,jpj,jpk,jpts,   zts_dta ) 
    163       ! 
    164       IF( nn_timing == 1 )   CALL timing_stop('tra_dmp') 
     161      IF( ln_timing )   CALL timing_stop('tra_dmp') 
    165162      ! 
    166163   END SUBROUTINE tra_dmp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r7765 r8568  
    3030   USE lib_mpp        ! distribued memory computing library 
    3131   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo       ! Memory allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    5857      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5958      !! 
    60       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    61       !!---------------------------------------------------------------------- 
    62       ! 
    63       IF( nn_timing == 1 )   CALL timing_start('tra_ldf') 
     59      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     60      !!---------------------------------------------------------------------- 
     61      ! 
     62      IF( ln_timing )   CALL timing_start('tra_ldf') 
    6463      ! 
    6564      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    66          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds )  
     65         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    6766         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    6867         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    8584         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    8685         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
    87          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt, ztrds )  
     86         DEALLOCATE( ztrdt, ztrds )  
    8887      ENDIF 
    8988      !                                        !* print mean trends (used for debugging) 
    … …  
    9190         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    9291      ! 
    93       IF( nn_timing == 1 )   CALL timing_stop('tra_ldf') 
     92      IF( ln_timing )   CALL timing_stop('tra_ldf') 
    9493      ! 
    9594   END SUBROUTINE tra_ldf 
    … …  
    107106      !!---------------------------------------------------------------------- 
    108107      ! 
    109       IF(lwp) THEN                     ! Namelist print 
     108      IF(lwp) THEN                     !==  Namelist print  ==! 
    110109         WRITE(numout,*) 
    111110         WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator' 
    … …  
    114113         WRITE(numout,*) '      see ldf_tra_init report for lateral mixing parameters' 
    115114      ENDIF 
    116       !                                   ! use of lateral operator or not 
     115      !                                !==  use of lateral operator or not  ==! 
    117116      nldf   = np_ERROR 
    118117      ioptio = 0 
    119       IF( ln_traldf_lap )   ioptio = ioptio + 1 
    120       IF( ln_traldf_blp )   ioptio = ioptio + 1 
    121       IF( ioptio >  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    122       IF( ioptio == 0   )   nldf = np_no_ldf     ! No lateral diffusion 
    123       ! 
    124       IF( nldf /= np_no_ldf ) THEN        ! direction ==>> type of operator   
     118      IF( ln_traldf_NONE ) THEN   ;   nldf = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF 
     119      IF( ln_traldf_lap  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     120      IF( ln_traldf_blp  ) THEN   ;                          ioptio = ioptio + 1   ;   ENDIF 
     121      IF( ioptio /=  1   )   CALL ctl_stop( 'tra_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 
     122      ! 
     123      IF( .NOT.ln_traldf_NONE ) THEN   !==  direction ==>> type of operator  ==! 
    125124         ioptio = 0 
    126125         IF( ln_traldf_lev )   ioptio = ioptio + 1 
    127126         IF( ln_traldf_hor )   ioptio = ioptio + 1 
    128127         IF( ln_traldf_iso )   ioptio = ioptio + 1 
    129          IF( ioptio >  1 )   CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' ) 
     128         IF( ioptio /=  1  )   CALL ctl_stop( 'tra_ldf_init: use ONE direction (level/hor/iso)' ) 
    130129         ! 
    131130         !                                ! defined the type of lateral diffusion from ln_traldf_... logicals 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r7753 r8568  
    3030   USE phycst         ! physical constants 
    3131   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    32    USE wrk_nemo       ! Memory Allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    111110      REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      - 
    112111      REAL(wp) ::  zcoef0, ze3w_2, zsign, z2dt, z1_2dt   !   -      - 
    113       REAL(wp), POINTER, DIMENSION(:,:)   ::   zdkt, zdk1t, z2d 
    114       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdit, zdjt, zftu, zftv, ztfw  
    115       !!---------------------------------------------------------------------- 
    116       ! 
    117       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso') 
    118       ! 
    119       CALL wrk_alloc( jpi,jpj,       zdkt, zdk1t, z2d )  
    120       CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt , zftu, zftv, ztfw  )  
     112      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t, z2d 
     113      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, zftu, zftv, ztfw  
     114      !!---------------------------------------------------------------------- 
     115      ! 
     116      IF( ln_timing )   CALL timing_start('tra_ldf_iso') 
    121117      ! 
    122118      IF( kt == kit000 )  THEN 
    … …  
    386382         !                                                        ! =============== 
    387383      END DO                                                      ! end tracer loop 
    388       !                                                           ! =============== 
    389       ! 
    390       CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d )  
    391       CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw  )  
    392       ! 
    393       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso') 
     384      ! 
     385      IF( ln_timing )   CALL timing_stop('tra_ldf_iso') 
    394386      ! 
    395387   END SUBROUTINE tra_ldf_iso 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90

    r7646 r8568  
    2222   ! 
    2323   USE in_out_manager ! I/O manager 
     24   USE iom            ! I/O library 
    2425   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2526   USE lib_mpp        ! distribued memory computing library 
    2627   USE timing         ! Timing 
    27    USE wrk_nemo       ! Memory allocation 
    28    USE iom 
    2928 
    3029   IMPLICIT NONE 
    … …  
    8786      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    8887      REAL(wp) ::   zsign            ! local scalars 
    89       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev 
    90       !!---------------------------------------------------------------------- 
    91       ! 
    92       IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap') 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztu, ztv, zaheeu, zaheev 
     89      !!---------------------------------------------------------------------- 
     90      ! 
     91      IF( ln_timing )   CALL timing_start('tra_ldf_lap') 
    9392      ! 
    9493      IF( kt == nit000 .AND. lwp )  THEN 
    … …  
    9796         WRITE(numout,*) '~~~~~~~~~~~ ' 
    9897      ENDIF 
    99       ! 
    100       CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
    10198      ! 
    10299      l_hst = .FALSE. 
    … …  
    169166      !                             ! ================== 
    170167      ! 
    171       CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev )  
    172       ! 
    173       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap') 
     168      IF( ln_timing )   CALL timing_stop('tra_ldf_lap') 
    174169      ! 
    175170   END SUBROUTINE tra_ldf_lap 
    … …  
    203198      ! 
    204199      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    205       REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zlap         ! laplacian at t-point 
    206       REAL(wp), POINTER, DIMENSION(:,:,:)  :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
    207       REAL(wp), POINTER, DIMENSION(:,:,:)  :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
     200      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: zlap         ! laplacian at t-point 
     201      REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zglu, zglv   ! bottom GRADh of the laplacian (u- and v-points) 
     202      REAL(wp), DIMENSION(jpi,jpj,    kjpt) :: zgui, zgvi   ! top    GRADh of the laplacian (u- and v-points) 
    208203      !!--------------------------------------------------------------------- 
    209204      ! 
    210       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_blp') 
    211       ! 
    212       CALL wrk_alloc( jpi,jpj,jpk,kjpt,   zlap )  
    213       CALL wrk_alloc( jpi,jpj,    kjpt,   zglu, zglv, zgui, zgvi )  
     205      IF( ln_timing )   CALL timing_start('tra_ldf_blp') 
    214206      ! 
    215207      IF( kt == kit000 .AND. lwp )  THEN 
    … …  
    253245      END SELECT 
    254246      ! 
    255       CALL wrk_dealloc( jpi,jpj,jpk,kjpt,   zlap )  
    256       CALL wrk_dealloc( jpi,jpj    ,kjpt,   zglu, zglv, zgui, zgvi )  
    257       ! 
    258       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_blp') 
     247      IF( ln_timing )   CALL timing_stop('tra_ldf_blp') 
    259248      ! 
    260249   END SUBROUTINE tra_ldf_blp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90

    r7646 r8568  
    2727   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2828   USE lib_mpp        ! MPP library 
    29    USE wrk_nemo       ! Memory Allocation 
    3029   USE timing         ! Timing 
    3130 
    … …  
    9493      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 
    9594      REAL(wp) ::   zah, zah_slp, zaei_slp 
    96       REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d                                            ! 2D workspace 
    97       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
     95      REAL(wp), DIMENSION(jpi,jpj    ) ::   z2d                                              ! 2D workspace 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     - 
    9897      !!---------------------------------------------------------------------- 
    9998      ! 
    100       IF( nn_timing == 1 )  CALL timing_start('tra_ldf_triad') 
    101       ! 
    102       CALL wrk_alloc( jpi,jpj,       z2d )  
    103       CALL wrk_alloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
     99      IF( ln_timing )   CALL timing_start('tra_ldf_triad') 
    104100      ! 
    105101      IF( .NOT.ALLOCATED(zdkt3d) )  THEN 
    … …  
    434430      END DO                                                      ! end tracer loop 
    435431      !                                                           ! =============== 
    436       ! 
    437       CALL wrk_dealloc( jpi,jpj,       z2d )  
    438       CALL wrk_dealloc( jpi,jpj,jpk,   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw  )  
    439       ! 
    440       IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_triad') 
     432      IF( ln_timing )   CALL timing_stop('tra_ldf_triad') 
    441433      ! 
    442434   END SUBROUTINE tra_ldf_triad 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90

    r6140 r8568  
    2626   USE in_out_manager ! I/O manager 
    2727   USE lib_mpp        ! MPP library 
    28    USE wrk_nemo       ! Memory Allocation 
    2928   USE timing         ! Timing 
    3029 
    … …  
    6766      REAL(wp) ::   zta, zalfa, zsum_temp, zsum_alfa, zaw, zdz, zsum_z 
    6867      REAL(wp) ::   zsa, zbeta, zsum_sali, zsum_beta, zbw, zrw, z1_r2dt 
    69       REAL(wp), PARAMETER :: zn2_zero = 1.e-14_wp       ! acceptance criteria for neutrality (N2==0) 
    70       REAL(wp), POINTER, DIMENSION(:)       ::   zvn2   ! vertical profile of N2 at 1 given point... 
    71       REAL(wp), POINTER, DIMENSION(:,:)     ::   zvts   ! vertical profile of T and S at 1 given point... 
    72       REAL(wp), POINTER, DIMENSION(:,:)     ::   zvab   ! vertical profile of alpha and beta 
    73       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zn2    ! N^2  
    74       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zab    ! alpha and beta 
    75       REAL(wp), POINTER, DIMENSION(:,:,:)   ::   ztrdt, ztrds   ! 3D workspace 
     68      REAL(wp), PARAMETER ::   zn2_zero = 1.e-14_wp      ! acceptance criteria for neutrality (N2==0) 
     69      REAL(wp), DIMENSION(        jpk     ) ::   zvn2         ! vertical profile of N2 at 1 given point... 
     70      REAL(wp), DIMENSION(        jpk,jpts) ::   zvts, zvab   ! vertical profile of T & S , and  alpha & betaat 1 given point 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk     ) ::   zn2          ! N^2  
     72      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   zab          ! alpha and beta 
     73      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    7674      ! 
    7775      LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is 
    … …  
    8078      !!---------------------------------------------------------------------- 
    8179      ! 
    82       IF( nn_timing == 1 )  CALL timing_start('tra_npc') 
     80      IF( ln_timing )   CALL timing_start('tra_npc') 
    8381      ! 
    8482      IF( MOD( kt, nn_npc ) == 0 ) THEN 
    8583         ! 
    86          CALL wrk_alloc( jpi, jpj, jpk, zn2 )    ! N2 
    87          CALL wrk_alloc( jpi, jpj, jpk, 2, zab ) ! Alpha and Beta 
    88          CALL wrk_alloc( jpk, 2, zvts, zvab )    ! 1D column vector at point ji,jj 
    89          CALL wrk_alloc( jpk, zvn2 )             ! 1D column vector at point ji,jj 
    90  
    9184         IF( l_trdtra )   THEN                    !* Save initial after fields 
    92             CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     85            ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    9386            ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    9487            ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    9588         ENDIF 
    96  
     89         ! 
    9790         IF( l_LB_debug ) THEN 
    9891            ! Location of 1 known convection site to follow what's happening in the water column 
    … …  
    10194            klc1 =  mbkt(ilc1,jlc1) ! bottom of the ocean for debug point...           
    10295         ENDIF 
    103           
     96         ! 
    10497         CALL eos_rab( tsa, zab )         ! after alpha and beta (given on T-points) 
    10598         CALL bn2    ( tsa, zab, zn2 )    ! after Brunt-Vaisala  (given on W-points) 
    106          
     99         ! 
    107100         inpcc = 0 
    108  
     101         ! 
    109102         DO jj = 2, jpjm1                 ! interior column only 
    110103            DO ji = fs_2, fs_jpim1 
    … …  
    313306            CALL trd_tra( kt, 'TRA', jp_tem, jptra_npc, ztrdt ) 
    314307            CALL trd_tra( kt, 'TRA', jp_sal, jptra_npc, ztrds ) 
    315             CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     308            DEALLOCATE( ztrdt, ztrds ) 
    316309         ENDIF 
    317310         ! 
    … …  
    323316         ENDIF 
    324317         ! 
    325          CALL wrk_dealloc(jpi, jpj, jpk, zn2 ) 
    326          CALL wrk_dealloc(jpi, jpj, jpk, 2, zab ) 
    327          CALL wrk_dealloc(jpk, zvn2 ) 
    328          CALL wrk_dealloc(jpk, 2, zvts, zvab ) 
    329          ! 
    330318      ENDIF   ! IF( MOD( kt, nn_npc ) == 0 ) THEN 
    331319      ! 
    332       IF( nn_timing == 1 )  CALL timing_stop('tra_npc') 
     320      IF( ln_timing )   CALL timing_stop('tra_npc') 
    333321      ! 
    334322   END SUBROUTINE tra_npc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r7753 r8568  
    3535   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    3636   USE phycst          ! physical constant 
    37    USE ldftra          ! lateral physics on tracers 
    38    USE ldfslp 
    39    USE bdy_oce   , ONLY: ln_bdy 
     37   USE ldftra          ! lateral physics : tracers 
     38   USE ldfslp          ! lateral physics : slopes 
     39   USE bdy_oce  , ONLY : ln_bdy 
    4040   USE bdytra          ! open boundary condition (bdy_tra routine) 
    4141   ! 
    … …  
    4343   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4444   USE prtctl          ! Print control 
    45    USE wrk_nemo        ! Memory allocation 
    4645   USE timing          ! Timing 
    4746#if defined key_agrif 
    … …  
    9190      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    9291      REAL(wp) ::   zfact            ! local scalars 
    93       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    94       !!---------------------------------------------------------------------- 
    95       ! 
    96       IF( nn_timing == 1 )  CALL timing_start( 'tra_nxt') 
     92      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
     93      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF( ln_timing )   CALL timing_start( 'tra_nxt') 
    9796      ! 
    9897      IF( kt == nit000 ) THEN 
    … …  
    120119      ! trends computation initialisation 
    121120      IF( l_trdtra )   THEN                     
    122          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     121         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    123122         ztrdt(:,:,jk) = 0._wp 
    124123         ztrds(:,:,jk) = 0._wp 
    … …  
    170169         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    171170         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 
    172          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     171         DEALLOCATE( ztrdt , ztrds ) 
    173172      END IF 
    174173      ! 
    … …  
    177176         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask ) 
    178177      ! 
    179       IF( nn_timing == 1 )   CALL timing_stop('tra_nxt') 
     178      IF( ln_timing )   CALL timing_stop('tra_nxt') 
    180179      ! 
    181180   END SUBROUTINE tra_nxt 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r7753 r8568  
    2929   USE in_out_manager ! I/O manager 
    3030   USE prtctl         ! Print control 
    31    USE iom            ! I/O manager 
     31   USE iom            ! I/O library 
    3232   USE fldread        ! read input fields 
    3333   USE restart        ! ocean restart 
    3434   USE lib_mpp        ! MPP library 
    3535   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    36    USE wrk_nemo       ! Memory Allocation 
    3736   USE timing         ! Timing 
    3837 
    … …  
    113112      REAL(wp) ::   zCb, zCmax, zze, zpsi, zpsimax, zdelpsi, zCtot, zCze 
    114113      REAL(wp) ::   zlogc, zlogc2, zlogc3  
    115       REAL(wp), POINTER, DIMENSION(:,:)   :: zekb, zekg, zekr 
    116       REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
    117       REAL(wp), POINTER, DIMENSION(:,:,:) :: zetot, zchl3d 
    118       !!---------------------------------------------------------------------- 
    119       ! 
    120       IF( nn_timing == 1 )  CALL timing_start('tra_qsr') 
     114      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   :: zekb, zekg, zekr 
     115      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt 
     116      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zetot, zchl3d 
     117      !!---------------------------------------------------------------------- 
     118      ! 
     119      IF( ln_timing )   CALL timing_start('tra_qsr') 
    121120      ! 
    122121      IF( kt == nit000 ) THEN 
    … …  
    127126      ! 
    128127      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    129          CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )  
     128         ALLOCATE( ztrdt(jpi,jpj,jpk) )  
    130129         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    131130      ENDIF 
    … …  
    161160      CASE( np_RGB , np_RGBc )         !==  R-G-B fluxes  ==! 
    162161         ! 
    163          CALL wrk_alloc( jpi,jpj,       zekb, zekg, zekr        )  
    164          CALL wrk_alloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d )  
     162         ALLOCATE( zekb(jpi,jpj)     , zekg(jpi,jpj)     , zekr  (jpi,jpj)     , & 
     163            &      ze0 (jpi,jpj,jpk) , ze1 (jpi,jpj,jpk) , ze2   (jpi,jpj,jpk) , & 
     164            &      ze3 (jpi,jpj,jpk) , zea (jpi,jpj,jpk) , zchl3d(jpi,jpj,jpk)   )  
    165165         ! 
    166166         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    … …  
    240240         END DO 
    241241         ! 
    242          CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        )  
    243          CALL wrk_dealloc( jpi,jpj,jpk,   ze0, ze1, ze2, ze3, zea, zchl3d )  
     242         DEALLOCATE( zekb , zekg , zekr , ze0 , ze1 , ze2 , ze3 , zea , zchl3d )  
    244243         ! 
    245244      CASE( np_2BD  )            !==  2-bands fluxes  ==! 
    … …  
    282281      ! 
    283282      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution 
    284          CALL wrk_alloc( jpi,jpj,jpk,   zetot ) 
    285          ! 
     283         ALLOCATE( zetot(jpi,jpj,jpk) ) 
    286284         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    287285         DO jk = nksr, 1, -1 
    288             zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 
     286            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rau0_rcp 
    289287         END DO          
    290288         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    291          ! 
    292          CALL wrk_dealloc( jpi,jpj,jpk,   zetot )  
     289         DEALLOCATE( zetot )  
    293290      ENDIF 
    294291      ! 
    … …  
    301298         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    302299         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    303          CALL wrk_dealloc( jpi,jpj,jpk,  ztrdt )  
     300         DEALLOCATE( ztrdt )  
    304301      ENDIF 
    305302      !                       ! print mean trends (used for debugging) 
    306303      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    307304      ! 
    308       IF( nn_timing == 1 )  CALL timing_stop('tra_qsr') 
     305      IF( ln_timing )   CALL timing_stop('tra_qsr') 
    309306      ! 
    310307   END SUBROUTINE tra_qsr 
    … …  
    340337      !!---------------------------------------------------------------------- 
    341338      ! 
    342       IF( nn_timing == 1 )   CALL timing_start('tra_qsr_init') 
     339      IF( ln_timing )   CALL timing_start('tra_qsr_init') 
    343340      ! 
    344341      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference     namelist 
    … …  
    435432      ENDIF 
    436433      ! 
    437       IF( nn_timing == 1 )   CALL timing_stop('tra_qsr_init') 
     434      IF( ln_timing )   CALL timing_stop('tra_qsr_init') 
    438435      ! 
    439436   END SUBROUTINE tra_qsr_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r7788 r8568  
    3232   USE iom            ! xIOS server 
    3333   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    34    USE wrk_nemo       ! Memory Allocation 
    3534   USE timing         ! Timing 
    3635 
    … …  
    7574      INTEGER  ::   ikt, ikb              ! local integers 
    7675      REAL(wp) ::   zfact, z1_e3t, zdep   ! local scalar 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
     76      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    7877      !!---------------------------------------------------------------------- 
    7978      ! 
    80       IF( nn_timing == 1 )  CALL timing_start('tra_sbc') 
     79      IF( ln_timing )   CALL timing_start('tra_sbc') 
    8180      ! 
    8281      IF( kt == nit000 ) THEN 
    … …  
    8786      ! 
    8887      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    89          CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
     88         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    9089         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    9190         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    … …  
    232231         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    233232         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
    234          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )  
     233         DEALLOCATE( ztrdt , ztrds )  
    235234      ENDIF 
    236235      ! 
    … …  
    238237         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    239238      ! 
    240       IF( nn_timing == 1 )  CALL timing_stop('tra_sbc') 
     239      IF( ln_timing )   CALL timing_stop('tra_sbc') 
    241240      ! 
    242241   END SUBROUTINE tra_sbc 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r8215 r8568  
    5656      !!--------------------------------------------------------------------- 
    5757      ! 
    58       IF( nn_timing == 1 )  CALL timing_start('tra_zdf') 
     58      IF( ln_timing )   CALL timing_start('tra_zdf') 
    5959      ! 
    6060      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    9797         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    9898      ! 
    99       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf') 
     99      IF( ln_timing )   CALL timing_stop('tra_zdf') 
    100100      ! 
    101101   END SUBROUTINE tra_zdf 
    … …  
    135135      !!--------------------------------------------------------------------- 
    136136      ! 
    137       IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp') 
     137      IF( ln_timing )   CALL timing_start('tra_zdf_imp') 
    138138      ! 
    139139      IF( kt == kit000 )  THEN 
    … …  
    255255      !                                               ! ================= ! 
    256256      ! 
    257       IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp') 
     257      IF( ln_timing )   CALL timing_stop('tra_zdf_imp') 
    258258      ! 
    259259   END SUBROUTINE tra_zdf_imp 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r7753 r8568  
    2222   USE lbclnk          ! lateral boundary conditions (or mpp link) 
    2323   USE lib_mpp         ! MPP library 
    24    USE wrk_nemo        ! Memory allocation 
    2524   USE timing          ! Timing 
    2625 
    … …  
    9998      !!---------------------------------------------------------------------- 
    10099      ! 
    101       IF( nn_timing == 1 )   CALL timing_start( 'zps_hde') 
    102       ! 
    103       pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp 
    104       pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp 
     100      IF( ln_timing )   CALL timing_start( 'zps_hde') 
     101      ! 
     102      pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp 
     103      pgtv(:,:,:) = 0._wp   ;   ztj (:,:,:) = 0._wp   ;   zhj (:,:) = 0._wp 
    105104      ! 
    106105      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    … …  
    188187      END IF 
    189188      ! 
    190       IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde') 
     189      IF( ln_timing )   CALL timing_stop( 'zps_hde') 
    191190      ! 
    192191   END SUBROUTINE zps_hde 
    193    ! 
     192 
     193 
    194194   SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, pgtui, pgtvi,  & 
    195195      &                          prd, pgru, pgrv, pgrui, pgrvi ) 
    … …  
    256256      !!---------------------------------------------------------------------- 
    257257      ! 
    258       IF( nn_timing == 1 )  CALL timing_start( 'zps_hde_isf') 
     258      IF( ln_timing )   CALL timing_start( 'zps_hde_isf') 
    259259      ! 
    260260      pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp 
    … …  
    453453      END IF   
    454454      ! 
    455       IF( nn_timing == 1 )   CALL timing_stop( 'zps_hde_isf') 
     455      IF( ln_timing )   CALL timing_stop( 'zps_hde_isf') 
    456456      ! 
    457457   END SUBROUTINE zps_hde_isf 
     458 
    458459   !!====================================================================== 
    459460END MODULE zpshde 
Note: See TracChangeset for help on using the changeset viewer.