Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r7698 r7753 113 113 IF( l_trd .OR. l_hst ) THEN 114 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 115 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 116 DO jk = 1, jpk 117 DO jj = 1, jpj 118 DO ji = 1, jpi 119 ztrdx(ji,jj,jk) = 0._wp 120 ztrdy(ji,jj,jk) = 0._wp 121 ztrdz(ji,jj,jk) = 0._wp 122 END DO 123 END DO 124 END DO 115 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 125 116 ENDIF 126 117 ! 127 118 IF( l_ptr ) THEN 128 119 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 129 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 130 DO jk = 1, jpk 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 zptry(ji,jj,jk) = 0._wp 134 END DO 135 END DO 136 END DO 120 zptry(:,:,:) = 0._wp 137 121 ENDIF 138 122 ! ! surface & bottom value : flux set to zero one for all 139 !$OMP PARALLEL 140 !$OMP DO schedule(static) private(jj, ji) 141 DO jj = 1, jpj 142 DO ji = 1, jpi 143 zwz(ji,jj, 1 ) = 0._wp 144 zwx(ji,jj,jpk) = 0._wp 145 zwy(ji,jj,jpk) = 0._wp 146 zwz(ji,jj,jpk) = 0._wp 147 END DO 148 END DO 149 !$OMP END DO NOWAIT 150 !$OMP DO schedule(static) private(jk, jj, ji) 151 DO jk = 1, jpk 152 DO jj = 1, jpj 153 DO ji = 1, jpi 154 zwi(ji,jj,jk) = 0._wp 155 END DO 156 END DO 157 END DO 158 !$OMP END PARALLEL 123 zwz(:,:, 1 ) = 0._wp 124 zwx(:,:,jpk) = 0._wp ; zwy(:,:,jpk) = 0._wp ; zwz(:,:,jpk) = 0._wp 125 ! 126 zwi(:,:,:) = 0._wp 159 127 ! 160 128 DO jn = 1, kjpt !== loop over the tracers ==! … … 162 130 ! !== upstream advection with initial mass fluxes & intermediate update ==! 163 131 ! !* upstream tracer flux in the i and j direction 164 !$OMP PARALLEL165 !$OMP DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui)166 132 DO jk = 1, jpkm1 167 133 DO jj = 1, jpjm1 … … 177 143 END DO 178 144 END DO 179 !$OMP END DO NOWAIT180 145 ! !* upstream tracer flux in the k direction *! 181 !$OMP DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk)182 146 DO jk = 2, jpkm1 ! Interior value ( multiplied by wmask) 183 147 DO jj = 1, jpj … … 189 153 END DO 190 154 END DO 191 !$OMP END PARALLEL192 155 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 193 156 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 194 !$OMP PARALLEL DO schedule(static) private(jj, ji)195 157 DO jj = 1, jpj 196 158 DO ji = 1, jpi … … 199 161 END DO 200 162 ELSE ! no cavities: only at the ocean surface 201 !$OMP PARALLEL DO schedule(static) private(jj, ji) 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 zwz(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 205 END DO 206 END DO 163 zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 207 164 ENDIF 208 165 ENDIF 209 166 ! 210 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra)211 167 DO jk = 1, jpkm1 !* trend and after field with monotonic scheme 212 168 DO jj = 2, jpjm1 … … 225 181 ! 226 182 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 227 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 228 DO jk = 1, jpk 229 DO jj = 1, jpj 230 DO ji = 1, jpi 231 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 232 ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 233 ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 234 END DO 235 END DO 236 END DO 183 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 237 184 END IF 238 185 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 239 IF( l_ptr ) THEN 240 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 241 DO jk = 1, jpk 242 DO jj = 1, jpj 243 DO ji = 1, jpi 244 zptry(ji,jj,jk) = zwy(ji,jj,jk) 245 END DO 246 END DO 247 END DO 248 END IF 186 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 249 187 ! 250 188 ! !== anti-diffusive flux : high order minus low order ==! … … 253 191 ! 254 192 CASE( 2 ) !- 2nd order centered 255 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)256 193 DO jk = 1, jpkm1 257 194 DO jj = 1, jpjm1 … … 264 201 ! 265 202 CASE( 4 ) !- 4th order centered 266 !$OMP PARALLEL 267 !$OMP DO schedule(static) private(jj, ji) 268 DO jj = 1, jpj 269 DO ji = 1, jpi 270 zltu(ji,jj,jpk) = 0._wp ! Bottom value : flux set to zero 271 zltv(ji,jj,jpk) = 0._wp 272 END DO 273 END DO 274 !$OMP DO schedule(static) private(jk, jj, ji) 203 zltu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 204 zltv(:,:,jpk) = 0._wp 275 205 DO jk = 1, jpkm1 ! Laplacian 276 206 DO jj = 1, jpjm1 ! 1st derivative (gradient) … … 287 217 END DO 288 218 END DO 289 !$OMP END PARALLEL290 219 CALL lbc_lnk( zltu, 'T', 1. ) ; CALL lbc_lnk( zltv, 'T', 1. ) ! Lateral boundary cond. (unchanged sgn) 291 220 ! 292 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v)293 221 DO jk = 1, jpkm1 ! Horizontal advective fluxes 294 222 DO jj = 1, jpjm1 … … 304 232 ! 305 233 CASE( 41 ) !- 4th order centered ==>> !!gm coding attempt need to be tested 306 !$OMP PARALLEL 307 !$OMP DO schedule(static) private(jj, ji) 308 DO jj = 1, jpj 309 DO ji = 1, jpi 310 ztu(ji,jj,jpk) = 0._wp ! Bottom value : flux set to zero 311 ztv(ji,jj,jpk) = 0._wp 312 END DO 313 END DO 314 !$OMP DO schedule(static) private(jk, jj, ji) 234 ztu(:,:,jpk) = 0._wp ! Bottom value : flux set to zero 235 ztv(:,:,jpk) = 0._wp 315 236 DO jk = 1, jpkm1 ! 1st derivative (gradient) 316 237 DO jj = 1, jpjm1 … … 321 242 END DO 322 243 END DO 323 !$OMP END PARALLEL324 244 CALL lbc_lnk( ztu, 'U', -1. ) ; CALL lbc_lnk( ztv, 'V', -1. ) ! Lateral boundary cond. (unchanged sgn) 325 245 ! 326 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v)327 246 DO jk = 1, jpkm1 ! Horizontal advective fluxes 328 247 DO jj = 2, jpjm1 … … 345 264 ! 346 265 CASE( 2 ) !- 2nd order centered 347 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)348 266 DO jk = 2, jpkm1 349 267 DO jj = 2, jpjm1 … … 357 275 CASE( 4 ) !- 4th order COMPACT 358 276 CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw ) ! zwt = COMPACT interpolation of T at w-point 359 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)360 277 DO jk = 2, jpkm1 361 278 DO jj = 2, jpjm1 … … 368 285 END SELECT 369 286 IF( ln_linssh ) THEN ! top ocean value: high order = upstream ==>> zwz=0 370 !$OMP PARALLEL DO schedule(static) private(jj, ji) 371 DO jj = 1, jpj 372 DO ji = 1, jpi 373 zwz(ji,jj,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 374 END DO 375 END DO 287 zwz(:,:,1) = 0._wp ! only ocean surface as interior zwz values have been w-masked 376 288 ENDIF 377 289 ! … … 385 297 ! !== final trend with corrected fluxes ==! 386 298 ! 387 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji)388 299 DO jk = 1, jpkm1 389 300 DO jj = 2, jpjm1 … … 398 309 ! 399 310 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 400 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 401 DO jk = 1, jpk 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk) ! <<< Add to previously computed 405 ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk) ! <<< Add to previously computed 406 ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk) ! <<< Add to previously computed 407 END DO 408 END DO 409 END DO 311 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 312 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 313 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 410 314 ENDIF 411 315 ! … … 421 325 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 422 326 IF( l_ptr ) THEN 423 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 424 DO jk = 1, jpk 425 DO jj = 1, jpj 426 DO ji = 1, jpi 427 zptry(ji,jj,jk) = zptry(ji,jj,jk) + zwy(ji,jj,jk) ! <<< Add to previously computed 428 END DO 429 END DO 430 END DO 327 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 431 328 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 432 329 ENDIF … … 765 662 zbig = 1.e+40_wp 766 663 zrtrn = 1.e-15_wp 664 zbetup(:,:,:) = 0._wp ; zbetdo(:,:,:) = 0._wp 767 665 768 666 ! Search local extrema … … 774 672 & paft * tmask + zbig * ( 1._wp - tmask ) ) 775 673 776 !$OMP PARALLEL777 !$OMP DO schedule(static) private(jk, jj, ji)778 DO jk = 1, jpk779 DO jj = 1, jpj780 DO ji = 1, jpi781 zbetup(ji,jj,jk) = 0._wp782 zbetdo(ji,jj,jk) = 0._wp783 END DO784 END DO785 END DO786 !$OMP DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt)787 674 DO jk = 1, jpkm1 788 675 ikm1 = MAX(jk-1,1) … … 819 706 END DO 820 707 END DO 821 !$OMP END PARALLEL822 708 CALL lbc_lnk( zbetup, 'T', 1. ) ; CALL lbc_lnk( zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 823 709 824 710 ! 3. monotonic flux in the i & j direction (paa & pbb) 825 711 ! ---------------------------------------- 826 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu)827 712 DO jk = 1, jpkm1 828 713 DO jj = 2, jpjm1
Note: See TracChangeset
for help on using the changeset viewer.
