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 6140 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 – NEMO

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r5930 r6140  
    2626   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
    2727   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    28    USE c1d            ! 1D vertical configuration 
    2928   ! 
    3029   USE in_out_manager ! I/O manager 
     
    6766    
    6867   !! * Substitutions 
    69 #  include "domzgr_substitute.h90" 
    7068#  include "vectopt_loop_substitute.h90" 
    7169   !!---------------------------------------------------------------------- 
     
    9694      !                                          ! set time step 
    9795      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    98          r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
     96         r2dt = rdt                                 ! = rdt (restarting with Euler time stepping) 
    9997      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    100          r2dtra(:) = 2._wp * rdttra(:)                   ! = 2 rdttra (leapfrog) 
     98         r2dt = 2._wp * rdt                         ! = 2 rdt (leapfrog) 
    10199      ENDIF 
    102100      ! 
    103101      !                                         !==  effective transport  ==! 
    104102      DO jk = 1, jpkm1 
    105          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
    106          zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     103         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
     104         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    107105         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    108106      END DO 
     
    135133         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
    136134      CASE ( np_FCT )                                    ! FCT scheme      : 2nd / 4th order 
    137          CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
     135         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
    138136      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
    139          CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts ) 
     137         CALL tra_adv_fct_zts( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_fct_zts ) 
    140138      CASE ( np_MUS )                                    ! MUSCL 
    141          CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
     139         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
    142140      CASE ( np_UBS )                                    ! UBS 
    143          CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
     141         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
    144142      CASE ( np_QCK )                                    ! QUICKEST 
    145          CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
     143         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
    146144      ! 
    147145      END SELECT 
    148146      ! 
    149       !                                              ! print mean trends (used for debugging) 
     147      !                                         ! print mean trends (used for debugging) 
    150148      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    151149         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
     
    175173      ! 
    176174      !                                !==  Namelist  ==! 
    177       ! 
    178175      REWIND( numnam_ref )                   ! Namelist namtra_adv in reference namelist : Tracer advection scheme 
    179176      READ  ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901) 
    180 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp ) 
     177901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in reference namelist', lwp ) 
    181178      ! 
    182179      REWIND( numnam_cfg )                   ! Namelist namtra_adv in configuration namelist : Tracer advection scheme 
    183180      READ  ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 ) 
    184 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp ) 
    185       IF(lwm) WRITE ( numond, namtra_adv ) 
    186  
     181902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtra_adv in configuration namelist', lwp ) 
     182      IF(lwm) WRITE( numond, namtra_adv ) 
     183      ! 
    187184      IF(lwp) THEN                           ! Namelist print 
    188185         WRITE(numout,*) 
     
    203200         WRITE(numout,*) '      QUICKEST scheme                           ln_traadv_qck = ', ln_traadv_qck 
    204201      ENDIF 
    205  
     202      ! 
    206203      ioptio = 0                       !==  Parameter control  ==! 
    207204      IF( ln_traadv_cen )   ioptio = ioptio + 1 
     
    215212         CALL ctl_warn( 'tra_adv_init: You are running without tracer advection.' ) 
    216213      ENDIF 
    217       IF( (ioptio /= 1).AND. (.NOT. lk_c1d ) ) &  
    218         CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' ) 
     214      IF( ioptio /= 1 )   CALL ctl_stop( 'tra_adv_init: Choose ONE advection scheme in namelist namtra_adv' ) 
    219215      ! 
    220216      IF( ln_traadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   &          ! Centered 
     
    231227            CALL ctl_stop( 'tra_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
    232228         ENDIF 
    233          IF( lk_vvl ) THEN 
     229         IF( .NOT.ln_linssh ) THEN 
    234230            CALL ctl_stop( 'tra_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
    235231         ENDIF 
     
    243239      ENDIF 
    244240      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities 
    245          IF(  ln_traadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF 
    246             & ln_traadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 
     241         IF(  ln_traadv_cen .AND. nn_cen_v == 4    .OR.   &                            ! NO 4th order with ISF 
     242            & ln_traadv_fct .AND. nn_fct_v == 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 
    247243      ENDIF 
    248244      ! 
     
    255251      IF( ln_traadv_ubs                      )   nadv = np_UBS 
    256252      IF( ln_traadv_qck                      )   nadv = np_QCK 
    257  
     253      ! 
    258254      IF(lwp) THEN                           ! Print the choice 
    259255         WRITE(numout,*) 
    260          IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO T-S advection' 
    261          IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
    262             &                                                                        ' Vertical   order: ', nn_cen_v 
    263          IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
    264             &                                                                        ' Vertical   order: ', nn_fct_v 
    265          IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
    266          IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used' 
    267          IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used' 
    268          IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used' 
     256         SELECT CASE ( nadv ) 
     257         CASE( np_NO_adv  )   ;   WRITE(numout,*) '         NO T-S advection' 
     258         CASE( np_CEN     )   ;   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     259            &                                                                     ' Vertical   order: ', nn_cen_v 
     260         CASE( np_FCT     )   ;   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     261            &                                                                      ' Vertical   order: ', nn_fct_v 
     262         CASE( np_FCT_zts )   ;   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
     263         CASE( np_MUS     )   ;   WRITE(numout,*) '         MUSCL    scheme is used' 
     264         CASE( np_UBS     )   ;   WRITE(numout,*) '         UBS      scheme is used' 
     265         CASE( np_QCK     )   ;   WRITE(numout,*) '         QUICKEST scheme is used' 
     266         END SELECT 
    269267      ENDIF 
    270268      ! 
Note: See TracChangeset for help on using the changeset viewer.