Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r7698 r7753 108 108 ! 109 109 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 110 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 111 DO jk = 1, jpk 112 DO jj = 1, jpj 113 DO ji = 1, jpi 114 xind(ji,jj,jk) = 1._wp ! set equal to 1 where up-stream is not needed 115 END DO 116 END DO 117 END DO 110 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 118 111 ! 119 112 IF( ld_msc_ups ) THEN ! define the upstream indicator (if asked) 120 113 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 121 !$OMP PARALLEL 122 !$OMP DO schedule(static) private(jj, ji) 123 DO jj = 1, jpj 124 DO ji = 1, jpi 125 upsmsk(ji,jj) = 0._wp ! not upstream by default 126 END DO 127 END DO 114 upsmsk(:,:) = 0._wp ! not upstream by default 128 115 ! 129 !$OMP DO schedule(static) private(jk,jj,ji)130 116 DO jk = 1, jpkm1 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 xind(ji,jj,jk) = 1._wp & ! =>1 where up-stream is not needed 134 & - MAX ( rnfmsk(ji,jj) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 135 & upsmsk(ji,jj) ) * tmask(ji,jj,jk) ! =>0 in some user defined area 136 END DO 137 END DO 138 END DO 139 !$OMP END DO NOWAIT 140 !$OMP END PARALLEL 117 xind(:,:,jk) = 1._wp & ! =>1 where up-stream is not needed 118 & - MAX ( rnfmsk(:,:) * rnfmsk_z(jk), & ! =>0 near runoff mouths (& closed sea outflows) 119 & upsmsk(:,:) ) * tmask(:,:,jk) ! =>0 in some user defined area 120 END DO 141 121 ENDIF 142 122 ! … … 156 136 ! 157 137 ! !-- first guess of the slopes 158 !$OMP PARALLEL 159 !$OMP DO schedule(static) private(jj, ji) 160 DO jj = 1, jpj 161 DO ji = 1, jpi 162 zwx(ji,jj,jpk) = 0._wp ! bottom values 163 zwy(ji,jj,jpk) = 0._wp 164 END DO 165 END DO 166 !$OMP DO schedule(static) private(jk, jj, ji) 138 zwx(:,:,jpk) = 0._wp ! bottom values 139 zwy(:,:,jpk) = 0._wp 167 140 DO jk = 1, jpkm1 ! interior values 168 141 DO jj = 1, jpjm1 … … 173 146 END DO 174 147 END DO 175 !$OMP END DO NOWAIT176 !$OMP END PARALLEL177 148 CALL lbc_lnk( zwx, 'U', -1. ) ! lateral boundary conditions (changed sign) 178 149 CALL lbc_lnk( zwy, 'V', -1. ) 179 150 ! !-- Slopes of tracer 180 !$OMP PARALLEL 181 !$OMP DO schedule(static) private(jj, ji) 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 zslpx(ji,jj,jpk) = 0._wp ! bottom values 185 zslpy(ji,jj,jpk) = 0._wp 186 END DO 187 END DO 188 !$OMP DO schedule(static) private(jk, jj, ji) 151 zslpx(:,:,jpk) = 0._wp ! bottom values 152 zslpy(:,:,jpk) = 0._wp 189 153 DO jk = 1, jpkm1 ! interior values 190 154 DO jj = 2, jpj … … 198 162 END DO 199 163 ! 200 !$OMP DO schedule(static) private(jk, jj, ji)201 164 DO jk = 1, jpkm1 !-- Slopes limitation 202 165 DO jj = 2, jpj … … 212 175 END DO 213 176 ! 214 !$OMP DO schedule(static) private(jk, jj, ji, z0u, zalpha, zu, zv, zzwx, zzwy, z0v)215 177 DO jk = 1, jpkm1 !-- MUSCL horizontal advective fluxes 216 178 DO jj = 2, jpjm1 … … 233 195 END DO 234 196 END DO 235 !$OMP END DO NOWAIT236 !$OMP END PARALLEL237 197 CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 238 198 ! 239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)240 199 DO jk = 1, jpkm1 !-- Tracer advective trend 241 200 DO jj = 2, jpjm1 … … 260 219 ! 261 220 ! !-- first guess of the slopes 262 !$OMP PARALLEL 263 !$OMP DO schedule(static) private(jj, ji) 264 DO jj = 1, jpj 265 DO ji = 1, jpi 266 zwx(ji,jj, 1 ) = 0._wp ! surface & bottom boundary conditions 267 zwx(ji,jj,jpk) = 0._wp 268 END DO 269 END DO 270 !$OMP DO schedule(static) private(jk, jj, ji) 221 zwx(:,:, 1 ) = 0._wp ! surface & bottom boundary conditions 222 zwx(:,:,jpk) = 0._wp 271 223 DO jk = 2, jpkm1 ! interior values 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 275 END DO 276 END DO 224 zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 277 225 END DO 278 226 ! !-- Slopes of tracer 279 !$OMP END DO NOWAIT 280 !$OMP DO schedule(static) private(jj, ji) 281 DO jj = 1, jpj 282 DO ji = 1, jpi 283 zslpx(ji,jj,1) = 0._wp ! surface values 284 END DO 285 END DO 286 !$OMP DO schedule(static) private(jk, jj, ji) 227 zslpx(:,:,1) = 0._wp ! surface values 287 228 DO jk = 2, jpkm1 ! interior value 288 229 DO jj = 1, jpj … … 293 234 END DO 294 235 END DO 295 !$OMP DO schedule(static) private(jk, jj, ji)296 236 DO jk = 2, jpkm1 !-- Slopes limitation 297 237 DO jj = 1, jpj ! interior values … … 303 243 END DO 304 244 END DO 305 !$OMP DO schedule(static) private(jk, jj, ji, z0w, zalpha, zw, zzwx, zzwy)306 245 DO jk = 1, jpk-2 !-- vertical advective flux 307 246 DO jj = 2, jpjm1 … … 316 255 END DO 317 256 END DO 318 !$OMP END DO NOWAIT319 !$OMP END PARALLEL320 257 IF( ln_linssh ) THEN ! top values, linear free surface only 321 258 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 322 !$OMP PARALLEL DO schedule(static) private(jj, ji)323 259 DO jj = 1, jpj 324 260 DO ji = 1, jpi … … 327 263 END DO 328 264 ELSE ! no cavities: only at the ocean surface 329 !$OMP PARALLEL DO schedule(static) private(jj, ji) 330 DO jj = 1, jpj 331 DO ji = 1, jpi 332 zwx(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 333 END DO 334 END DO 265 zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 335 266 ENDIF 336 267 ENDIF 337 268 ! 338 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)339 269 DO jk = 1, jpkm1 !-- vertical advective trend 340 270 DO jj = 2, jpjm1
Note: See TracChangeset
for help on using the changeset viewer.
