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 6060 for branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP – NEMO

Ignore:
Timestamp:
2015-12-16T10:25:22+01:00 (8 years ago)
Author:
timgraham
Message:

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch

Location:
branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r5836 r6060  
    6262 
    6363   !! * Substitutions 
    64 #  include "domzgr_substitute.h90" 
    6564#  include "vectopt_loop_substitute.h90" 
    6665   !!---------------------------------------------------------------------- 
    … …  
    109108      !                                               !==  effective transport  ==! 
    110109      DO jk = 1, jpkm1 
    111          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    112          zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     110         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
     111         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    113112         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    114113      END DO 
    … …  
    231230            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
    232231         ENDIF 
    233          IF( lk_vvl ) THEN 
     232         IF( .NOT.ln_linssh ) THEN 
    234233            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
    235234         ENDIF 

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5836 r6060  
    4343 
    4444   !! * Substitutions 
    45 #  include "domzgr_substitute.h90" 
    4645#  include "vectopt_loop_substitute.h90" 
    4746   !!---------------------------------------------------------------------- 
    … …  
    8281      !!              - save the trends ('key_trdmxl_trc') 
    8382      !!---------------------------------------------------------------------- 
    84       !! 
    85       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    86       !! 
    87       INTEGER  ::   ji, jj, jk, jn, jl       ! dummy loop indices 
    88       REAL(wp) ::   ztra                 ! temporary scalars 
    89       CHARACTER (len=22) :: charout 
     83      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     84      ! 
     85      INTEGER ::   ji, jj, jk, jn, jl   ! dummy loop indices 
     86      CHARACTER (len=22) ::   charout 
    9087      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
    91       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
     88      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
    9289      !!---------------------------------------------------------------------- 
    9390      ! 
    … …  
    105102            ! 
    106103            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    107                 
     104               ! 
    108105               jl = n_trc_index(jn)  
    109106               CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
    110107               ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
    111  
     108               ! 
    112109               SELECT CASE ( nn_zdmp_tr ) 
    113110               ! 
    … …  
    116113                     DO jj = 2, jpjm1 
    117114                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    118                            ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    119                            tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     115                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    120116                        END DO 
    121117                     END DO 
    122118                  END DO 
    123                ! 
     119                  ! 
    124120               CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    125121                  DO jk = 1, jpkm1 
    … …  
    127123                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    128124                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN  
    129                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    130                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     125                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    131126                           ENDIF 
    132127                        END DO 
    133128                     END DO 
    134129                  END DO 
    135                ! 
     130                  ! 
    136131               CASE ( 2 )               !==  no damping in the mixed layer   ==!  
    137132                  DO jk = 1, jpkm1 
    138133                     DO jj = 2, jpjm1 
    139134                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    140                            IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    141                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    142                               tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     135                           IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
     136                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    143137                           END IF 
    144138                        END DO 
    145139                     END DO 
    146140                  END DO 
    147                !   
     141                  !   
    148142               END SELECT 
    149143               !  
    … …  
    162156      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
    163157      !                                          ! print mean trends (used for debugging) 
    164       IF( ln_ctl )   THEN 
    165          WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout) 
    166                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     158      IF( ln_ctl ) THEN 
     159         WRITE(charout, FMT="('dmp ')") 
     160         CALL prt_ctl_trc_info(charout) 
     161         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    167162      ENDIF 
    168163      ! 
    … …  
    170165      ! 
    171166   END SUBROUTINE trc_dmp 
     167 
    172168 
    173169   SUBROUTINE trc_dmp_ini 
    … …  
    180176      !!              called by trc_dmp at the first timestep (nittrc000) 
    181177      !!---------------------------------------------------------------------- 
    182       ! 
    183       INTEGER ::  ios                 ! Local integer output status for namelist read 
    184       INTEGER :: imask  !local file handle 
    185       ! 
     178      INTEGER ::   ios, imask  ! local integers 
     179      !! 
    186180      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 
    187181      !!---------------------------------------------------------------------- 
    188  
     182      ! 
    189183      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
    190184      ! 
    191  
    192185      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
    193186      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
    … …  
    233226   END SUBROUTINE trc_dmp_ini 
    234227 
     228 
    235229   SUBROUTINE trc_dmp_clo( kt ) 
    236230      !!--------------------------------------------------------------------- 
    … …  
    245239      !!                nctsi2(), nctsj2() : north-east Closed sea limits (i,j) 
    246240      !!---------------------------------------------------------------------- 
    247       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    248       ! 
    249       INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
    250       INTEGER :: isrow                                      ! local index 
    251       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    252  
    253       !!---------------------------------------------------------------------- 
    254  
     241      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     242      ! 
     243      INTEGER ::   ji , jj, jk, jn, jl, jc   ! dummy loop indicesa 
     244      INTEGER ::   isrow                     ! local index 
     245      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrcdta   ! 3D  workspace 
     246      !!---------------------------------------------------------------------- 
     247      ! 
    255248      IF( kt == nit000 ) THEN 
    256249         ! initial values 
    … …  
    364357   END SUBROUTINE trc_dmp_clo 
    365358 
    366  
    367359#else 
    368360   !!---------------------------------------------------------------------- 
    … …  
    376368#endif 
    377369 
    378  
    379370   !!====================================================================== 
    380371END MODULE trcdmp 

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5836 r6060  
    1212   !!   'key_top'                                                TOP models 
    1313   !!---------------------------------------------------------------------- 
    14    !!   trc_ldf      : update the tracer trend with the lateral diffusion 
    15    !!   trc_ldf_ini  : initialization, namelist read, and parameters control 
    16    !!---------------------------------------------------------------------- 
    17    USE trc           ! ocean passive tracers variables 
    18    USE oce_trc       ! ocean dynamics and active tracers 
    19    USE ldfslp        ! lateral diffusion: iso-neutral slope 
    20    USE traldf_lap    ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap   routine) 
    21    USE traldf_iso    ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso   routine) 
    22    USE traldf_triad  ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad routine) 
    23    USE traldf_blp    ! lateral diffusion (iso-level lap/blp)                       (tra_ldf_lap   routine) 
    24    USE trd_oce       ! trends: ocean variables 
    25    USE trdtra        ! trends manager: tracers  
     14   !!   trc_ldf       : update the tracer trend with the lateral diffusion 
     15   !!   trc_ldf_ini   : initialization, namelist read, and parameters control 
     16   !!---------------------------------------------------------------------- 
     17   USE trc            ! ocean passive tracers variables 
     18   USE oce_trc        ! ocean dynamics and active tracers 
     19   USE ldfslp         ! lateral diffusion: iso-neutral slope 
     20   USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level      operator  (tra_ldf_lap/_blp   routine) 
     21   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine) 
     22   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_     triad routine) 
     23   USE trd_oce        ! trends: ocean variables 
     24   USE trdtra         ! trends manager: tracers 
    2625   ! 
    27    USE prtctl_trc      ! Print control 
     26   USE prtctl_trc     ! Print control 
    2827 
    2928   IMPLICIT NONE 
    … …  
    4241   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          --     -       -   [m4/s] 
    4342   ! 
    44                                                  !!: ** lateral mixing namelist (nam_trcldf) ** 
    45    REAL(wp) ::  rldf    ! ratio between active and passive tracers diffusive coefficient 
     43   !                      !!: ** lateral mixing namelist (nam_trcldf) ** 
     44   REAL(wp) ::  rldf       ! ratio between active and passive tracers diffusive coefficient 
     45    
    4646   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
    4747    
    4848   !! * Substitutions 
    49 #  include "domzgr_substitute.h90" 
    5049#  include "vectopt_loop_substitute.h90" 
    5150   !!---------------------------------------------------------------------- 
    … …  
    6463      !!---------------------------------------------------------------------- 
    6564      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    66       !! 
     65      ! 
    6766      INTEGER            :: jn 
    6867      CHARACTER (len=22) :: charout 
    … …  
    9998      END SELECT 
    10099      ! 
    101       IF( l_trdtrc )   THEN                    ! save the horizontal diffusive trends for further diagnostics 
     100      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics 
    102101        DO jn = 1, jptra 
    103102           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    … …  
    106105        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    107106      ENDIF 
    108       !                                        ! print mean trends (used for debugging) 
    109       IF( ln_ctl ) THEN 
    110          WRITE(charout, FMT="('ldf ')")   ;   CALL prt_ctl_trc_info(charout) 
    111                                               CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     107      !                 
     108      IF( ln_ctl ) THEN                        ! print mean trends (used for debugging) 
     109         WRITE(charout, FMT="('ldf ')") 
     110         CALL prt_ctl_trc_info(charout) 
     111         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    112112      ENDIF 
    113113      ! 
    … …  
    133133      INTEGER ::   ioptio, ierr   ! temporary integers 
    134134      INTEGER ::   ios            ! Local integer output status for namelist read 
    135       ! 
     135      !! 
    136136      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  & 
    137137         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  & 
    138138         &                 rn_ahtrc_0   , rn_bhtrc_0 
    139139      !!---------------------------------------------------------------------- 
    140       REWIND( numnat_ref )              !  namtrc_ldf in reference namelist  
     140      ! 
     141      REWIND( numnat_ref )             !  namtrc_ldf in reference namelist  
    141142      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 
    142 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 
    143  
    144       REWIND( numnat_cfg )              !  namtrc_ldf in configuration namelist  
     143903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 
     144      ! 
     145      REWIND( numnat_cfg )             !  namtrc_ldf in configuration namelist  
    145146      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 
    146 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
     147904   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
    147148      IF(lwm) WRITE ( numont, namtrc_ldf ) 
    148  
    149       IF(lwp) THEN                    ! Namelist print 
     149      ! 
     150      IF(lwp) THEN                     ! Namelist print 
    150151         WRITE(numout,*) 
    151152         WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator' 
    … …  
    174175      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 
    175176      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' ) 
    176        
     177      ! 
    177178      ioptio = 0 
    178179      IF( ln_trcldf_lev )   ioptio = ioptio + 1 
    … …  
    180181      IF( ln_trcldf_iso )   ioptio = ioptio + 1 
    181182      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 
    182  
     183      ! 
    183184      ! defined the type of lateral diffusion from ln_trcldf_... logicals 
    184185      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
    … …  
    204205         ENDIF 
    205206         !                                ! diffusivity ratio: passive / active tracers  
    206          IF( ABS(rn_aht_0) < 2._wp*TINY(1.e0) ) THEN 
    207             IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     207         IF( ABS(rn_aht_0) < 2._wp*TINY(1._wp) ) THEN 
     208            IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1._wp) ) THEN 
    208209               rldf = 1.0_wp 
    209210            ELSE 
    210                CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     211               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    211212            ENDIF 
    212213         ELSE 
    … …  
    235236         ENDIF 
    236237         !                                ! diffusivity ratio: passive / active tracers  
    237          IF( ABS(rn_bht_0) < 2._wp*TINY(1.e0) ) THEN 
    238             IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     238         IF( ABS(rn_bht_0) < 2._wp*TINY(1._wp) ) THEN 
     239            IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1._wp) ) THEN 
    239240               rldf = 1.0_wp 
    240241            ELSE 
    241                CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     242               CALL ctl_stop( 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    242243            ENDIF 
    243244         ELSE 
    … …  
    246247      ENDIF 
    247248      ! 
    248       IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    249       IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   & 
    250            CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    251            &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    252       IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    253          IF( .NOT.l_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require l_ldfslp' ) 
    254       ENDIF 
     249      IF( ierr == 1 )   CALL ctl_stop( 'trc_ldf_ctl: iso-level in z-partial step, not allowed' ) 
     250      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   CALL ctl_stop( 'trc_ldf_ctl: eiv requires isopycnal laplacian diffusion' ) 
     251      IF( nldf == 1 .OR. nldf == 3 )   l_ldfslp = .TRUE.    ! slope of neutral surfaces required  
    255252      ! 
    256253      IF(lwp) THEN 
    257254         WRITE(numout,*) 
    258          IF( nldf == np_no_ldf )   WRITE(numout,*) '          NO lateral diffusion' 
    259          IF( nldf == np_lap    )   WRITE(numout,*) '          laplacian iso-level operator' 
    260          IF( nldf == np_lap_i  )   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
    261          IF( nldf == np_lap_it )   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
    262          IF( nldf == np_blp    )   WRITE(numout,*) '          bilaplacian iso-level operator' 
    263          IF( nldf == np_blp_i  )   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
    264          IF( nldf == np_blp_it )   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
     255         SELECT CASE( nldf ) 
     256         CASE( np_no_ldf )   ;   WRITE(numout,*) '          NO lateral diffusion' 
     257         CASE( np_lap    )   ;   WRITE(numout,*) '          laplacian iso-level operator' 
     258         CASE( np_lap_i  )   ;   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
     259         CASE( np_lap_it )   ;   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
     260         CASE( np_blp    )   ;   WRITE(numout,*) '          bilaplacian iso-level operator' 
     261         CASE( np_blp_i  )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
     262         CASE( np_blp_it )   ;   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
     263         END SELECT 
    265264      ENDIF 
    266265      ! 

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r5656 r6060  
    101101         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 
    102102      ENDIF 
    103  
     103      ! 
    104104#if defined key_agrif 
    105105      CALL Agrif_trc                   ! AGRIF zoom boundaries 
    106106#endif 
    107       ! Update after tracer on domain lateral boundaries 
    108       DO jn = 1, jptra 
     107      DO jn = 1, jptra                 ! Update after tracer on domain lateral boundaries 
    109108         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )    
    110109      END DO 
    111  
    112  
    113110#if defined key_bdy 
    114 !!      CALL bdy_trc( kt )               ! BDY open boundaries 
     111!!      CALL bdy_trc( kt )             ! BDY open boundaries 
    115112#endif 
    116113 
    117  
    118       ! set time step size (Euler/Leapfrog) 
     114      !                                ! set time step size (Euler/Leapfrog) 
    119115      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
    120116      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
    121117      ENDIF 
    122118 
    123       ! trends computation initialisation 
    124       IF( l_trdtrc )  THEN 
    125          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )  !* store now fields before applying the Asselin filter 
     119      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application 
     120         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) 
    126121         ztrdt(:,:,:,:)  = trn(:,:,:,:) 
    127122      ENDIF 
    128       ! Leap-Frog + Asselin filter time stepping 
    129       IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
    130          !                                                ! (only swap) 
     123      !                                ! Leap-Frog + Asselin filter time stepping 
     124      IF( neuler == 0 .AND. kt == nittrc000 ) THEN    ! Euler time-stepping at first time-step (only swap) 
    131125         DO jn = 1, jptra 
    132126            DO jk = 1, jpkm1 
    … …  
    134128            END DO 
    135129         END DO 
    136          !                                               
    137       ELSE 
    138          ! Leap-Frog + Asselin filter time stepping 
    139          IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
    140            &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl)  
    141          ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     130      ELSE                                            ! Asselin filter + swap 
     131         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh 
     132         ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
     133           &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh 
    142134         ENDIF 
     135         ! 
     136         DO jn = 1, jptra 
     137            CALL lbc_lnk( trb(:,:,:,jn), 'T', 1._wp )  
     138            CALL lbc_lnk( trn(:,:,:,jn), 'T', 1._wp ) 
     139            CALL lbc_lnk( tra(:,:,:,jn), 'T', 1._wp ) 
     140         END DO 
    143141      ENDIF 
    144  
    145       ! trends computation 
    146       IF( l_trdtrc ) THEN                                      ! trends 
     142      ! 
     143      IF( l_trdtrc ) THEN              ! trends: send Asselin filter trends to trdtra manager for further diagnostics 
    147144         DO jn = 1, jptra 
    148145            DO jk = 1, jpkm1 
    149                zfact = 1.e0 / r2dt(jk)   
     146               zfact = 1._wp / r2dt(jk)   
    150147               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
    151148               CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5836 r6060  
    3131 
    3232   !! * Substitutions 
    33 #  include "domzgr_substitute.h90" 
    3433#  include "vectopt_loop_substitute.h90" 
    3534   !!---------------------------------------------------------------------- 
    … …  
    7675      ! 
    7776      ! Allocate temporary workspace 
    78                       CALL wrk_alloc( jpi, jpj,      zsfx   ) 
    79       IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 
     77                      CALL wrk_alloc( jpi,jpj,       zsfx   ) 
     78      IF( l_trdtrc )  CALL wrk_alloc( jpi,jpj,jpk,  ztrtrd ) 
    8079      ! 
    8180      zrtrn = 1.e-15_wp 
    … …  
    129128      ! Coupling offline : runoff are in emp which contains E-P-R 
    130129      ! 
    131       IF( .NOT. lk_offline .AND. lk_vvl ) THEN  ! online coupling with vvl 
     130      IF( .NOT. lk_offline .AND. .NOT.ln_linssh ) THEN  ! online coupling with vvl 
    132131         zsfx(:,:) = 0._wp 
    133132      ELSE                                      ! online coupling free surface or offline with free surface 
    … …  
    138137      DO jn = 1, jptra 
    139138         ! 
    140          IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    141          !                                             ! add the trend to the general tracer trend 
     139         IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    142140 
    143141         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice) 
    … …  
    153151            DO jj = 2, jpj 
    154152               DO ji = fs_2, fs_jpim1   ! vector opt. 
    155                   zse3t = 1. / fse3t(ji,jj,1) 
     153                  zse3t = 1. / e3t_n(ji,jj,1) 
    156154                  ! tracer flux at the ice/ocean interface (tracer/m2/s) 
    157155                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
    … …  
    174172         DO jj = 2, jpj 
    175173            DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                zse3t = zfact / fse3t(ji,jj,1) 
     174               zse3t = zfact / e3t_n(ji,jj,1) 
    177175               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
    178176            END DO 
    … …  
    203201                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    204202      ENDIF 
    205                       CALL wrk_dealloc( jpi, jpj,      zsfx   ) 
    206       IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
     203                      CALL wrk_dealloc( jpi,jpj,       zsfx   ) 
     204      IF( l_trdtrc )  CALL wrk_dealloc( jpi,jpj,jpk,  ztrtrd ) 
    207205      ! 
    208206      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc') 

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r5836 r6060  
    4040 
    4141   !! * Substitutions 
    42 #  include "domzgr_substitute.h90" 
    4342#  include "zdfddm_substitute.h90" 
    4443#  include "vectopt_loop_substitute.h90" 

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    r5836 r6060  
    6666 
    6767   !! * Substitutions 
    68 #  include "domzgr_substitute.h90" 
    6968#  include "zdfddm_substitute.h90" 
    7069   !!---------------------------------------------------------------------- 
    … …  
    175174            DO jj = 1, jpj 
    176175               DO ji = 1, jpi 
    177                   IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     176                  IF( jk - nmld_trc(ji,jj) < 0 )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    178177               END DO 
    179178            END DO 
    … …  
    293292            DO jj = 1,jpj 
    294293              DO ji = 1,jpi 
    295                   IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk) 
     294                  IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    296295               END DO 
    297296            END DO 
    … …  
    417416               DO jn = 1, jptra 
    418417                  IF( ln_trdtrc(jn) )    & 
    419                   tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
     418                  tmltrd_trc(ji,jj,jpmxl_trc_zdf,jn) = - zavt / e3w_n(ji,jj,ik) * tmask(ji,jj,ik)  & 
    420419                       &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            & 
    421420                       &                    / MAX( 1., rmld_trc(ji,jj) ) * tmask(ji,jj,1) 

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

    r5341 r6060  
    2121   
    2222   INTEGER ::   nummldw_trc               ! logical unit for mld restart 
     23    
    2324   !!--------------------------------------------------------------------------------- 
    2425   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    2627   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2728   !!--------------------------------------------------------------------------------- 
    28    
    2929CONTAINS 
    30    
    3130 
    3231    SUBROUTINE trd_mxl_trc_rst_write( kt ) 
Note: See TracChangeset for help on using the changeset viewer.