Changeset 12740 for NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90
- Timestamp:
- 2020-04-12T11:03:06+02:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/CANAL/MY_SRC/trazdf.F90
r12489 r12740 35 35 PUBLIC tra_zdf_imp ! called by trczdf.F90 36 36 37 !! * Substitutions 38 # include "do_loop_substitute.h90" 37 39 !!---------------------------------------------------------------------- 38 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 77 79 ! JMM avoid negative salinities near river outlet ! Ugly fix 78 80 ! JMM : restore negative salinities to small salinities: 79 !!$ WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp ) pts(:,:,:,jp_sal,Kaa) = 0.1_wp81 !!$ WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp ) pts(:,:,:,jp_sal,Kaa) = 0.1_wp 80 82 !!gm 81 83 … … 95 97 ENDIF 96 98 ! ! print mean trends (used for debugging) 97 IF( ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf - Ta: ', mask1=tmask, &98 & tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )99 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf - Ta: ', mask1=tmask, & 100 & tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 99 101 ! 100 102 IF( ln_timing ) CALL timing_stop('tra_zdf') … … 154 156 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 155 157 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 156 DO jk = 2, jpkm1 157 DO jj = 2, jpjm1 158 DO ji = fs_2, fs_jpim1 ! vector opt. 159 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 160 END DO 161 END DO 162 END DO 158 DO_3D_00_00( 2, jpkm1 ) 159 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 160 END_3D 163 161 ELSE ! standard or triad iso-neutral operator 164 DO jk = 2, jpkm1 165 DO jj = 2, jpjm1 166 DO ji = fs_2, fs_jpim1 ! vector opt. 167 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 168 END DO 169 END DO 170 END DO 162 DO_3D_00_00( 2, jpkm1 ) 163 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 164 END_3D 171 165 ENDIF 172 166 ENDIF … … 174 168 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 175 169 IF( ln_zad_Aimp ) THEN ! Adaptive implicit vertical advection 176 DO jk = 1, jpkm1 177 DO jj = 2, jpjm1 178 DO ji = fs_2, fs_jpim1 ! vector opt. (ensure same order of calculation as below if wi=0.) 179 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm) 180 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 181 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws & 182 & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 183 zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) 184 zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) 185 END DO 186 END DO 187 END DO 170 DO_3D_00_00( 1, jpkm1 ) 171 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm) 172 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 173 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws & 174 & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 175 zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) 176 zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) 177 END_3D 188 178 ELSE 189 DO jk = 1, jpkm1 190 DO jj = 2, jpjm1 191 DO ji = fs_2, fs_jpim1 ! vector opt. 192 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm) 193 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 194 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 195 END DO 196 END DO 197 END DO 179 DO_3D_00_00( 1, jpkm1 ) 180 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm) 181 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 182 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 183 END_3D 198 184 ENDIF 199 185 ! … … 217 203 ! used as a work space array: its value is modified. 218 204 ! 219 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 220 DO ji = fs_2, fs_jpim1 ! done one for all passive tracers (so included in the IF instruction) 221 zwt(ji,jj,1) = zwd(ji,jj,1) 222 END DO 223 END DO 224 DO jk = 2, jpkm1 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 227 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 228 END DO 229 END DO 230 END DO 205 DO_2D_00_00 206 zwt(ji,jj,1) = zwd(ji,jj,1) 207 END_2D 208 DO_3D_00_00( 2, jpkm1 ) 209 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 210 END_3D 231 211 ! 232 212 ENDIF 233 213 ! 234 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 235 DO ji = fs_2, fs_jpim1 236 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 237 END DO 238 END DO 239 DO jk = 2, jpkm1 240 DO jj = 2, jpjm1 241 DO ji = fs_2, fs_jpim1 242 zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side 243 pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 244 END DO 245 END DO 246 END DO 214 DO_2D_00_00 215 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 216 END_2D 217 DO_3D_00_00( 2, jpkm1 ) 218 zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side 219 pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 220 END_3D 247 221 ! 248 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 249 DO ji = fs_2, fs_jpim1 250 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 251 END DO 252 END DO 253 DO jk = jpk-2, 1, -1 254 DO jj = 2, jpjm1 255 DO ji = fs_2, fs_jpim1 256 pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) & 257 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 258 END DO 259 END DO 260 END DO 222 DO_2D_00_00 223 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 224 END_2D 225 DO_3DS_00_00( jpk-2, 1, -1 ) 226 pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) & 227 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 228 END_3D 261 229 ! ! ================= ! 262 230 END DO ! end tracer loop !
Note: See TracChangeset
for help on using the changeset viewer.
