Changeset 6772 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd_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/traadv_tvd_crs.F90
r6101 r6772 91 91 !!---------------------------------------------------------------------- 92 92 ! 93 93 94 IF( nn_timing == 1 ) CALL timing_start('tra_adv_tvd') 94 95 ! … … 126 127 ! upstream tracer flux in the i and j direction 127 128 DO jk = 1, jpkm1 128 DO jj = 1, jpjm1129 DO ji = 1, fs_jpim1 ! vector opt.129 DO jj = 2, jpj_crs-1 130 DO ji = 2, jpi_crs-1 130 131 ! upstream scheme 131 132 zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) … … 138 139 END DO 139 140 END DO 141 CALL crs_lbc_lnk( zwx, 'U', -1._wp ) 142 CALL crs_lbc_lnk( zwy, 'V', -1._wp ) 140 143 ! upstream tracer flux in the k direction 141 144 ! Surface value 142 145 IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0.e0 ! volume variable 143 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface146 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) !cbr * ptb(:,:,1,jn) ! linear free surface 144 147 ENDIF 145 148 ! Interior value 146 149 DO jk = 2, jpkm1 147 DO jj = 1, jpj148 DO ji = 1, jpi150 DO jj = 2, jpj_crs-1 151 DO ji = nldi_crs, nlei_crs 149 152 zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 150 153 zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) … … 153 156 END DO 154 157 END DO 158 CALL crs_lbc_lnk( zwz, 'T', 1. ) 159 155 160 ! total advective trend 156 161 DO jk = 1, jpkm1 157 162 z2dtt = p2dt(jk) 158 DO jj = 2, jpj m1159 DO ji = fs_2, fs_jpim1 ! vector opt.163 DO jj = 2, jpj_crs-1 164 DO ji = 2, jpi_crs-1 160 165 zbtr = r1_bt_crs(ji,jj,jk) 161 166 ! total intermediate advective trends … … 163 168 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 164 169 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) 165 ! update and guess with monotonic sheme 170 166 171 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 167 172 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask_crs(ji,jj,jk) … … 169 174 END DO 170 175 END DO 176 171 177 ! ! Lateral boundary conditions on zwi (unchanged sign) 172 178 CALL crs_lbc_lnk( zwi, 'T', 1. ) … … 187 193 ! antidiffusive flux on i and j 188 194 DO jk = 1, jpkm1 189 DO jj = 1, jpjm1190 DO ji = 1, fs_jpim1 ! vector opt.195 DO jj = 2, jpj_crs-1 196 DO ji = 2, jpi_crs-1 191 197 zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 192 198 zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) … … 198 204 ! 199 205 DO jk = 2, jpkm1 ! Interior value 200 DO jj = 1, jpj201 DO ji = 1, jpi206 DO jj = 2, jpj_crs-1 207 DO ji = 2, jpi_crs-1 202 208 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk) 203 209 END DO 204 210 END DO 205 211 END DO 206 212 CALL crs_lbc_lnk( zwx, 'U', -1. ) ; CALL crs_lbc_lnk( zwy, 'V', -1. ) ! Lateral bondary conditions 207 213 CALL crs_lbc_lnk( zwz, 'W', 1. ) … … 214 220 ! ------------------------------------ 215 221 DO jk = 1, jpkm1 216 DO jj = 2, jpj m1217 DO ji = fs_2, fs_jpim1 ! vector opt.222 DO jj = 2, jpj_crs-1 223 DO ji = 2, jpi_crs-1 218 224 zbtr = r1_bt_crs(ji,jj,jk) 219 225 ! total advective trends … … 247 253 END DO 248 254 ! 255 249 256 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz , zwx, zwy ) 250 257 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) … … 302 309 ikm1 = MAX(jk-1,1) 303 310 z2dtt = p2dt(jk) 304 DO jj = 2, jpj m1305 DO ji = fs_2, fs_jpim1 ! vector opt.311 DO jj = 2, jpj_crs-1 312 DO ji = 2, jpi_crs-1 306 313 307 314 ! search maximum in neighbourhood … … 339 346 ! ---------------------------------------- 340 347 DO jk = 1, jpkm1 341 DO jj = 2, jpj m1342 DO ji = fs_2, fs_jpim1 ! vector opt.348 DO jj = 2, jpj_crs-1 349 DO ji = 2, jpi_crs-1 343 350 zau = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 344 351 zbu = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
Note: See TracChangeset
for help on using the changeset viewer.