Changeset 5948 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
- Timestamp:
- 2015-11-30T11:47:24+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r5947 r5948 19 19 20 20 !!---------------------------------------------------------------------- 21 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical 22 !! part of the mixing tensor. 23 !!---------------------------------------------------------------------- 24 USE oce ! ocean dynamics and tracers variables 25 USE dom_oce ! ocean space and time domain variables 26 USE zdf_oce ! ocean vertical physics variables 27 USE trc_oce ! share passive tracers/ocean variables 28 USE domvvl ! variable volume 29 USE ldftra_oce ! ocean active tracers: lateral physics 30 USE ldftra ! lateral mixing type 31 USE ldfslp ! lateral physics: slope of diffusion 32 USE zdfddm ! ocean vertical physics: double diffusion 33 USE traldf_iso_grif ! active tracers: Griffies operator 34 USE in_out_manager ! I/O manager 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 USE lib_mpp ! MPP library 37 USE wrk_nemo ! Memory Allocation 38 USE timing ! Timing 21 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical part of the mixing tensor. 22 !!---------------------------------------------------------------------- 23 USE oce ! ocean dynamics and tracers variables 24 USE dom_oce ! ocean space and time domain variables 25 USE zdf_oce ! ocean vertical physics variables 26 USE trc_oce ! share passive tracers/ocean variables 27 USE domvvl ! variable volume 28 USE ldftra ! lateral mixing type 29 USE ldfslp ! lateral physics: slope of diffusion 30 USE zdfddm ! ocean vertical physics: double diffusion 31 USE traldf_triad ! active tracers: Method of Stabilizing Correction 32 ! 33 USE in_out_manager ! I/O manager 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! Memory Allocation 37 USE timing ! Timing 39 38 40 39 IMPLICIT NONE … … 47 46 !! * Substitutions 48 47 # include "domzgr_substitute.h90" 49 # include "ldftra_substitute.h90"50 48 # include "zdfddm_substitute.h90" 51 49 # include "vectopt_loop_substitute.h90" 52 50 !!---------------------------------------------------------------------- 53 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)51 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 54 52 !! $Id$ 55 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 76 74 !! ** Action : - pta becomes the after tracer 77 75 !!--------------------------------------------------------------------- 78 USE oce , ONLY: zwd => ua , zws => va ! (ua,va) used as 3D workspace79 !80 76 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 77 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 88 84 INTEGER :: ji, jj, jk, jn ! dummy loop indices 89 85 REAL(wp) :: zrhs, ze3tb, ze3tn, ze3ta ! local scalars 90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwt 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwt, zwd, zws 91 87 !!--------------------------------------------------------------------- 92 88 ! 93 89 IF( nn_timing == 1 ) CALL timing_start('tra_zdf_imp') 94 90 ! 95 CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt)91 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwt, zwd, zws ) 96 92 ! 97 93 IF( kt == kit000 ) THEN … … 120 116 ELSE ; zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 121 117 ENDIF 122 DO jj=1, jpj 123 DO ji=1, jpi 124 zwt(ji,jj,1) = 0._wp 125 END DO 126 END DO 127 ! 128 #if defined key_ldfslp 129 ! isoneutral diffusion: add the contribution 130 IF( ln_traldf_grif ) THEN ! Griffies isoneutral diff 131 DO jk = 2, jpkm1 132 DO jj = 2, jpjm1 133 DO ji = fs_2, fs_jpim1 ! vector opt. 134 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 118 zwt(:,:,1) = 0._wp 119 ! 120 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 121 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 122 DO jk = 2, jpkm1 123 DO jj = 2, jpjm1 124 DO ji = fs_2, fs_jpim1 ! vector opt. 125 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 126 END DO 135 127 END DO 136 128 END DO 137 END DO 138 ELSE IF( l_traldf_rot ) THEN ! standard isoneutral diff 139 DO jk = 2, jpkm1 140 DO jj = 2, jpjm1 141 DO ji = fs_2, fs_jpim1 ! vector opt. 142 zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk) & 143 & * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 144 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) 129 ELSE ! standard or triad iso-neutral operator 130 DO jk = 2, jpkm1 131 DO jj = 2, jpjm1 132 DO ji = fs_2, fs_jpim1 ! vector opt. 133 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 134 END DO 145 135 END DO 146 136 END DO 147 END DO137 ENDIF 148 138 ENDIF 149 #endif 139 ! 150 140 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 151 141 DO jk = 1, jpkm1 … … 202 192 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1) 203 193 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1) 204 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) & 205 & + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 194 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 206 195 END DO 207 196 END DO … … 235 224 ! ! ================= ! 236 225 ! 237 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwt)226 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwt, zwd, zws ) 238 227 ! 239 228 IF( nn_timing == 1 ) CALL timing_stop('tra_zdf_imp')
Note: See TracChangeset
for help on using the changeset viewer.
