Changeset 6772 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90
- Timestamp:
- 2016-07-01T18:02:45+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp_crs.F90
r5601 r6772 78 78 !! ** Action : - pta becomes the after tracer 79 79 !!--------------------------------------------------------------------- 80 USE ieee_arithmetic 80 81 ! 81 82 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 90 91 REAL(wp) :: zrhs, ze3tb, ze3tn, ze3ta ! local scalars 91 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwt,zwd,zws 93 REAL(wp) :: zmin,zmax 92 94 !!--------------------------------------------------------------------- 93 95 ! … … 135 137 END DO 136 138 ELSE IF( l_traldf_rot ) THEN ! standard isoneutral diff 137 138 DO jj = 2, jpj m1139 DO ji = fs_2, fs_jpim1 ! vector opt.139 DO jk = 2, jpkm1 140 DO jj = 2, jpj_crs-1 141 DO ji = 2, jpi_crs-1 140 142 zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk) & 141 143 & * ( wslpi_crs(ji,jj,jk) * wslpi_crs(ji,jj,jk) & … … 148 150 #endif 149 151 DO jk = 1, jpkm1 150 DO jj = 2, jpjm1 151 DO ji = fs_2, fs_jpim1 ! vector opt. 152 ze3ta = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk) ! after scale factor at T-point 153 ze3tn = r_vvl + ( 1. - r_vvl ) * e3t_crs(ji,jj,jk) ! now scale factor at T-point 152 DO jj = 2, jpj_crs-1 153 DO ji = 2, jpi_crs-1 154 155 #if defined key_vvl 156 ze3ta = ( 1. - r_vvl ) + r_vvl * fse3t_a_crs(ji,jj,jk) ! after scale factor at T-point 157 ze3tn = r_vvl + ( 1. - r_vvl ) * fse3t_n_crs(ji,jj,jk) ! now scale factor at T-point 158 #else 159 ze3ta = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,jk) ! after scale factor at T-point 160 ze3tn = r_vvl + ( 1. - r_vvl ) * e3t_0_crs(ji,jj,jk) ! now scale factor at T-point 161 #endif 154 162 !cbr zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * e3w_1d(jk ) ) !cc 155 163 !cbr zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_1d(jk+1) ) !cc 156 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * e3w_max_crs(ji,jj,jk) )157 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * e3w_max_crs(ji,jj,jk+1) )164 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * fse3w_max_crs(ji,jj,jk) ) 165 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w_max_crs(ji,jj,jk+1) ) 158 166 zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 159 167 END DO … … 182 190 ! first recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 183 191 ! done once for all passive tracers (so included in the IF instruction) 184 DO jj = 2, jpj m1185 DO ji = fs_2, fs_jpim1192 DO jj = 2, jpj_crs-1 193 DO ji = 2, jpi_crs-1 186 194 zwt(ji,jj,1) = zwd(ji,jj,1) 187 195 END DO 188 196 END DO 189 197 DO jk = 2, jpkm1 190 DO jj = 2, jpj m1191 DO ji = fs_2, fs_jpim1198 DO jj = 2, jpj_crs-1 199 DO ji = 2, jpi_crs-1 192 200 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 193 201 END DO … … 198 206 ! 199 207 ! second recurrence: Zk = Yk - Ik / Tk-1 Zk-1 200 DO jj = 2, jpjm1 201 DO ji = fs_2, fs_jpim1 202 ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1) 203 ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,1) 208 DO jj = 2, jpj_crs-1 209 DO ji = 2, jpi_crs-1 210 #if defined key_vvl 211 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b_crs(ji,jj,1) 212 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t_n_crs(ji,jj,1) 213 #else 214 ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,1) 215 ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,1) 216 #endif 204 217 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 205 218 END DO … … 207 220 208 221 DO jk = 2, jpkm1 209 DO jj = 2, jpjm1 210 DO ji = fs_2, fs_jpim1 211 ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk) 212 ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_crs(ji,jj,jk) 222 DO jj = 2, jpj_crs-1 223 DO ji = 2, jpi_crs-1 224 #if defined key_vvl 225 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b_crs(ji,jj,jk) 226 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t_n_crs(ji,jj,jk) 227 #else 228 ze3tb = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,jk) 229 ze3tn = ( 1. - r_vvl ) + r_vvl * e3t_0_crs(ji,jj,jk) 230 #endif 213 231 zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn) ! zrhs=right hand side 214 pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn) 215 232 pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn) 216 233 END DO 217 234 END DO … … 219 236 220 237 ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 221 DO jj = 2, jpj m1222 DO ji = fs_2, fs_jpim1238 DO jj = 2, jpj_crs-1 239 DO ji = 2, jpi_crs-1 223 240 pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask_crs(ji,jj,jpkm1) 224 241 END DO 225 242 END DO 226 243 DO jk = jpk-2, 1, -1 227 DO jj = 2, jpj m1228 DO ji = fs_2, fs_jpim1244 DO jj = 2, jpj_crs-1 245 DO ji = 2, jpi_crs-1 229 246 pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) ) & 230 & / zwt(ji,jj,jk) * tmask_crs(ji,jj,jk) 231 232 END DO 233 END DO 234 END DO 235 247 & / zwt(ji,jj,jk) * tmask_crs(ji,jj,jk) 248 END DO 249 END DO 250 END DO 236 251 ! ! ================= ! 237 252 END DO ! end tracer loop !
Note: See TracChangeset
for help on using the changeset viewer.