Changeset 501 for trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90
- Timestamp:
- 2006-09-12T13:10:14+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/TRP/trcbbl_adv.h90
r403 r501 52 52 !! 9.0 ! 04-03 (C. Ethe) Adaptation for Passive tracers 53 53 !!---------------------------------------------------------------------- 54 !! * Modules used 55 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 56 USE eosbn2 57 54 !gh 55 58 56 !! * Arguments 59 57 INTEGER, INTENT( in ) :: kt ! ocean time-step … … 66 64 zsign, zt, zs, zh, zalbet, & ! temporary scalars 67 65 zgdrho, zbtr, ztra ! " " 68 REAL(wp), DIMENSION(jpi,jpj) :: & 69 zki, zkj, zkw, zkx, zky, zkz, & ! temporary workspace arrays 70 ztnb, zsnb, zdep, ztrb, & ! " " 71 zahu, zahv ! " " 66 REAL(wp), DIMENSION(jpi,jpj) :: & 67 ztnb, zsnb, zdep, ztrb ! temporary workspace arrays 72 68 REAL(wp), DIMENSION(jpi,jpj) :: & ! temporary workspace arrays 73 69 zalphax, zwu, zunb, & ! " " 74 70 zalphay, zwv, zvnb, & ! " " 75 zwx, zwy ! " " 71 zwx, zwy, zww, zwz, & ! " " 72 zti, zsi ,ztmin,ztmax, zsmin,zsmax! " " 73 ! " " 76 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 77 75 zhdivn ! temporary workspace arrays 78 76 REAL(wp) :: & 79 zfui, zfvj, zbt, zsigna ! temporary scalars 77 zfui, zfvj, zbt, zsigna, & ! temporary scalars 78 iku1,iku2,ikv1,ikv2, & ! temporary scalars 79 ze3u,ze3v, & ! temporary scalars 80 z2,z2dtt ! temporary scalars 80 81 REAL(wp) :: & 81 82 fsalbt, pft, pfs, pfh ! statement function … … 103 104 !!---------------------------------------------------------------------- 104 105 105 IF( kt == nittrc000 ) CALL trc_bbl_init ! initialization at first time-step106 106 IF( kt == nit000 ) CALL trc_bbl_init ! initialization at first time-step 107 107 108 ! 1. 2D fields of bottom temperature and salinity, and bottom slope 108 109 ! ----------------------------------------------------------------- 109 110 ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 110 111 111 #if defined key_vectopt_loop && ! defined key_ autotasking112 #if defined key_vectopt_loop && ! defined key_mpp_omp 112 113 jj = 1 113 114 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 116 117 DO ji = 1, jpi 117 118 #endif 118 ik = mbkt(ji,jj) 119 ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)! masked now T at the ocean bottom120 zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)! masked now S at the ocean bottom119 ik = mbkt(ji,jj) ! index of the bottom ocean T-level 120 ztnb(ji,jj) = tn(ji,jj,ik) ! masked now T at the ocean bottom 121 zsnb(ji,jj) = sn(ji,jj,ik) ! masked now S at the ocean bottom 121 122 zdep(ji,jj) = fsdept(ji,jj,ik) ! depth of the ocean bottom T-level 122 #if ! defined key_vectopt_loop || defined key_autotasking 123 !gh 124 zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) 125 zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 126 #if ! defined key_vectopt_loop || defined key_mpp_omp 123 127 END DO 124 128 #endif 125 129 END DO 126 #if defined key_vectopt_loop && ! defined key_autotasking127 jj = 1128 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)129 zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) * umask(ji,jj,1)130 zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) * vmask(ji,jj,1) ! retirer le mask en u, v et t !131 END DO132 #else133 DO jj = 1, jpjm1134 DO ji = 1, jpim1135 zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) * umask(ji,jj,1)136 zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) * vmask(ji,jj,1)137 END DO138 END DO139 #endif140 141 ! boundary conditions on zunb and zvnb (changed sign)142 CALL lbc_lnk( zunb, 'U', -1. ) ; CALL lbc_lnk( zvnb, 'V', -1. )143 144 145 130 146 131 ! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0 … … 166 151 zgdrho = zgdrho * umask(ji,jj,1) 167 152 ! ... sign of local i-gradient of density multiplied by the i-slope 168 zsign = sign( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 169 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 170 171 zsigna= sign(0.5, zunb(ji,jj)*( zdep(ji+1,jj) - zdep(ji,jj) )) 172 zalphax(ji,jj)=(0.5+zsigna)*(0.5-zsign)*umask(ji,jj,1) 153 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 154 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 155 zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5-zsign ) * umask(ji,jj,1) 173 156 END DO 174 157 END DO … … 185 168 zgdrho = zalbet*( ztnb(ji,jj+1) - ztnb(ji,jj) ) & 186 169 - ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 187 zgdrho = zgdrho *vmask(ji,jj,1)170 zgdrho = zgdrho * vmask(ji,jj,1) 188 171 ! ... sign of local j-gradient of density multiplied by the j-slope 189 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 190 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 191 192 zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 193 zalphay(ji,jj)=(0.5+zsigna)*(0.5-zsign)*vmask(ji,jj,1) 172 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 173 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 174 zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 194 175 END DO 195 176 END DO … … 198 179 CASE ( 1 ) ! Linear formulation function of temperature only 199 180 200 201 # if defined key_vectopt_loop && ! defined key_autotasking202 jj = 1203 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)204 # else205 181 DO jj = 1, jpjm1 206 DO ji = 1, jpim1 207 # endif 182 DO ji = 1, fs_jpim1 ! vector opt. 208 183 ! temperature, salinity anomalie and depth 209 184 zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 210 185 zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 211 186 zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 212 ! masked ratio alpha/beta187 !gh ! masked ratio alpha/beta 213 188 ! local density gradient along i-bathymetric slope 214 zgdrho = ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 189 zgdrho = ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 215 190 ! sign of local i-gradient of density multiplied by the i-slope 216 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 217 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 218 219 zsigna= sign(0.5, zunb(ji,jj)*( zdep(ji+1,jj) - zdep(ji,jj) )) 220 zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 221 # if ! defined key_vectopt_loop || defined key_autotasking 191 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 192 zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 193 zalphax(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 222 194 END DO 223 # endif 224 END DO 225 226 # if defined key_vectopt_loop && ! defined key_autotasking 227 jj = 1 228 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 229 # else 195 END DO 196 230 197 DO jj = 1, jpjm1 231 DO ji = 1, jpim1 232 # endif 198 DO ji = 1, fs_jpim1 ! vector opt. 233 199 ! temperature, salinity anomalie and depth 234 200 zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 235 201 zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 236 202 zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 237 ! masked ratio alpha/beta203 !gh ! masked ratio alpha/beta 238 204 ! local density gradient along j-bathymetric slope 239 zgdrho = ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 205 zgdrho = ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 240 206 ! sign of local j-gradient of density multiplied by the j-slope 241 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 242 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 243 244 zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 245 zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 246 # if ! defined key_vectopt_loop || defined key_autotasking 207 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 208 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 209 zalphay(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 247 210 END DO 248 # endif 249 END DO 250 211 END DO 212 251 213 CASE ( 2 ) ! Linear formulation function of temperature and salinity 252 253 DO jj = 1, jpjm1 254 DO ji = 1, fs_jpim1 ! vector opt. 255 ! local density gradient along i-bathymetric slope 214 DO jj = 1, jpjm1 215 DO ji = 1, fs_jpim1 ! vector opt. 216 ! local density gradient along i-bathymetric slope 256 217 zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 257 218 - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 258 219 ! sign of local i-gradient of density multiplied by the i-slope 259 220 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 260 261 zsigna= sign(0.5, zunb(ji,jj)*( zdep(ji+1,jj) - zdep(ji,jj) )) 221 zsigna= SIGN( 0.5, zunb(ji,jj)*( zdep(ji+1,jj) - zdep(ji,jj) )) 262 222 zalphax(ji,jj)=(0.5-zsigna)*(0.5-zsign)*umask(ji,jj,1) 223 END DO 224 END DO 225 226 DO jj = 1, jpjm1 227 DO ji = 1, fs_jpim1 ! vector opt. 228 ! local density gradient along j-bathymetric slope 229 zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 230 - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 231 ! sign of local j-gradient of density multiplied by the j-slope 232 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 233 zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 234 zalphay(ji,jj) = ( 0.5 - zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 263 235 END DO 264 236 END DO 265 237 266 DO jj = 1, jpjm1 267 DO ji = 1, fs_jpim1 ! vector opt. 268 ! local density gradient along j-bathymetric slope 269 zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 270 - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 271 ! sign of local j-gradient of density multiplied by the j-slope 272 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 273 274 zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) ) 275 zalphay(ji,jj)=(0.5-zsigna)*(0.5-zsign)*vmask(ji,jj,1) 276 END DO 277 END DO 278 279 238 280 239 CASE DEFAULT 281 240 … … 295 254 u_trc_bbl(:,:,:) = 0.e0 296 255 v_trc_bbl(:,:,:) = 0.e0 297 # if defined key_vectopt_loop && ! defined key_autotasking 256 257 258 !gh 259 IF( ln_zps ) THEN 260 ! partial steps correction 261 262 #if defined key_vectopt_loop && ! defined key_mpp_omp 298 263 jj = 1 299 264 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 300 # 265 #else 301 266 DO jj = 1, jpjm1 302 267 DO ji = 1, jpim1 303 # endif 304 iku = mbku(ji,jj) 305 ikv = mbkv(ji,jj) 268 #endif 269 iku = mbku(ji ,jj ) 270 ikv = mbkv(ji ,jj ) 271 iku1 = mbkt(ji+1,jj ) 272 iku2 = mbkt(ji ,jj ) 273 ikv1 = mbkt(ji ,jj+1) 274 ikv2 = mbkt(ji ,jj ) 275 ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 276 ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 277 306 278 IF( MAX(iku,ikv) > 1 ) THEN 307 u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * umask(ji,jj,1)308 v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * vmask(ji,jj,1)279 u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * ze3u / fse3u(ji,jj,iku) 280 v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv) 309 281 ENDIF 310 # if ! defined key_vectopt_loop || defined key_autotasking311 END DO 312 # 282 #if ! defined key_vectopt_loop || defined key_mpp_omp 283 END DO 284 #endif 313 285 END DO 314 286 315 287 ! lateral boundary conditions on u_trc_bbl and v_trc_bbl (changed sign) 316 288 CALL lbc_lnk( u_trc_bbl, 'U', -1. ) ; CALL lbc_lnk( v_trc_bbl, 'V', -1. ) 317 318 289 290 ELSE ! z-coordinate - full steps or s-coordinate 291 ! if not partial step loop over the whole domain no lbc call 292 293 #if defined key_vectopt_loop && ! defined key_mpp_omp 294 jj = 1 295 DO ji = 1, jpij ! vector opt. (forced unrolling) 296 #else 297 DO jj = 1, jpj 298 DO ji = 1, jpi 299 #endif 300 iku = mbku(ji,jj) 301 ikv = mbkv(ji,jj) 302 IF( MAX(iku,ikv) > 1 ) THEN 303 u_trc_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) 304 v_trc_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) 305 ENDIF 306 #if ! defined key_vectopt_loop || defined key_mpp_omp 307 END DO 308 #endif 309 END DO 310 311 ENDIF 319 312 320 313 DO jn = 1, jptra 321 314 322 #if defined key_vectopt_loop && ! defined key_ autotasking315 #if defined key_vectopt_loop && ! defined key_mpp_omp 323 316 jj = 1 324 317 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 329 322 ik = mbkt(ji,jj) ! index of the bottom ocean T-level 330 323 ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1) ! masked now T at the ocean bottom 331 #if ! defined key_vectopt_loop || defined key_autotasking 332 END DO 333 #endif 334 END DO 324 #if ! defined key_vectopt_loop || defined key_mpp_omp 325 END DO 326 #endif 327 END DO 328 335 329 336 330 … … 339 333 ! ... Second order centered tracer flux at u and v-points 340 334 341 # if defined key_vectopt_loop && ! defined key_ autotasking335 # if defined key_vectopt_loop && ! defined key_mpp_omp 342 336 jj = 1 343 337 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 348 342 iku = mbku(ji,jj) 349 343 ikv = mbkv(ji,jj) 350 zfui = zalphax(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,iku) * zunb(ji,jj)351 zfvj = zalphay(ji,jj) *e1v(ji,jj) * fse3v(ji,jj,ikv) * zvnb(ji,jj)344 zfui = e2u(ji,jj) * fse3u(ji,jj,iku) * u_trc_bbl(ji,jj,iku) 345 zfvj = e1v(ji,jj) * fse3v(ji,jj,ikv) * v_trc_bbl(ji,jj,ikv) 352 346 ! upstream scheme 353 347 zwx(ji,jj) = ( ( zfui + ABS( zfui ) ) * ztrb(ji ,jj ) & … … 355 349 zwy(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * ztrb(ji ,jj ) & 356 350 & +( zfvj - ABS( zfvj ) ) * ztrb(ji ,jj+1) ) * 0.5 357 #if ! defined key_vectopt_loop || defined key_autotasking 358 END DO 359 #endif 360 END DO 361 # if defined key_vectopt_loop && ! defined key_autotasking 351 #if ! defined key_vectopt_loop || defined key_mpp_omp 352 END DO 353 #endif 354 END DO 355 356 # if defined key_vectopt_loop && ! defined key_mpp_omp 362 357 jj = 1 363 358 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 371 366 ztra = - zbtr * ( zwx(ji,jj) - zwx(ji-1,jj ) & 372 367 & + zwy(ji,jj) - zwy(ji ,jj-1) ) 373 368 374 369 ! add it to the general tracer trends 375 370 tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra 376 #if ! defined key_vectopt_loop || defined key_ autotasking377 END DO 378 #endif 379 END DO 380 381 END DO382 383 IF(ln_ctl) THEN ! print mean trends (used for debugging)371 #if ! defined key_vectopt_loop || defined key_mpp_omp 372 END DO 373 #endif 374 END DO 375 376 END DO 377 378 IF(ln_ctl) THEN ! print mean trends (used for debugging) 384 379 WRITE(charout, FMT="('bbl - adv')") 385 380 CALL prt_ctl_trc_info(charout) 386 381 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 387 382 ENDIF 383 388 384 ! 6. Vertical advection velocities 389 385 ! -------------------------------- … … 393 389 DO jj=1, jpjm1 394 390 DO ji = 1, fs_jpim1 ! vertor opt. 395 zwu(ji,jj) = -e2u(ji,jj) * u_trc_bbl(ji,jj,jk) 396 zwv(ji,jj) = -e1v(ji,jj) * v_trc_bbl(ji,jj,jk) 391 zwu(ji,jj) = -e2u(ji,jj) * u_trc_bbl(ji,jj,jk) * fse3u(ji,jj,jk) 392 zwv(ji,jj) = -e1v(ji,jj) * v_trc_bbl(ji,jj,jk) * fse3v(ji,jj,jk) 397 393 END DO 398 394 END DO … … 401 397 DO jj = 2, jpjm1 402 398 DO ji = fs_2, fs_jpim1 ! vector opt. 403 zbt = e1t(ji,jj) * e2t(ji,jj) 399 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 404 400 zhdivn(ji,jj,jk) = ( zwu(ji,jj) - zwu(ji-1,jj ) & 405 401 & + zwv(ji,jj) - zwv(ji ,jj-1) ) / zbt … … 410 406 411 407 ! ... horizontal bottom divergence 412 # if defined key_vectopt_loop && ! defined key_autotasking 413 jj = 1 414 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 408 !gh 409 IF( ln_zps ) THEN 410 411 # if defined key_vectopt_loop && ! defined key_mpp_omp 412 jj = 1 413 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 415 414 # else 416 DO jj = 1, jpjm1 417 DO ji = 1, jpim1 418 # endif 419 iku = mbku(ji,jj) 420 ikv = mbkv(ji,jj) 421 zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 422 zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 423 #if ! defined key_vectopt_loop || defined key_autotasking 424 END DO 425 #endif 426 END DO 427 428 # if defined key_vectopt_loop && ! defined key_autotasking 415 DO jj = 1, jpjm1 416 DO ji = 1, jpim1 417 # endif 418 iku = mbku(ji ,jj ) 419 ikv = mbkv(ji ,jj ) 420 iku1 = mbkt(ji+1,jj ) 421 iku2 = mbkt(ji ,jj ) 422 ikv1 = mbkt(ji ,jj+1) 423 ikv2 = mbkt(ji ,jj ) 424 ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 425 ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 426 427 zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u 428 zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v 429 #if ! defined key_vectopt_loop || defined key_mpp_omp 430 END DO 431 #endif 432 END DO 433 434 ELSE 435 436 # if defined key_vectopt_loop && ! defined key_mpp_omp 437 jj = 1 438 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 439 # else 440 DO jj = 1, jpjm1 441 DO ji = 1, jpim1 442 # endif 443 iku = mbku(ji,jj) 444 ikv = mbkv(ji,jj) 445 zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 446 zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 447 #if ! defined key_vectopt_loop || defined key_mpp_omp 448 END DO 449 #endif 450 END DO 451 ENDIF 452 453 # if defined key_vectopt_loop && ! defined key_mpp_omp 429 454 jj = 1 430 455 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 436 461 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) 437 462 zhdivn(ji,jj,ik) = & 438 & ( zwu(ji ,jj ) * ( zunb(ji ,jj ) - un(ji ,jj ,ik) *umask(ji ,jj ,1)) &439 & - zwu(ji-1,jj ) * ( zunb(ji-1,jj ) - un(ji-1,jj ,ik) *umask(ji-1,jj ,1)) &440 & + zwv(ji ,jj ) * ( zvnb(ji ,jj ) - vn(ji ,jj ,ik) *vmask(ji ,jj ,1)) &441 & - zwv(ji ,jj-1) * ( zvnb(ji ,jj-1) - vn(ji ,jj-1,ik) *vmask(ji ,jj-1,1)) &463 & ( zwu(ji ,jj ) * ( zunb(ji ,jj ) - un(ji ,jj ,ik) ) & 464 & - zwu(ji-1,jj ) * ( zunb(ji-1,jj ) - un(ji-1,jj ,ik) ) & 465 & + zwv(ji ,jj ) * ( zvnb(ji ,jj ) - vn(ji ,jj ,ik) ) & 466 & - zwv(ji ,jj-1) * ( zvnb(ji ,jj-1) - vn(ji ,jj-1,ik) ) & 442 467 & ) / zbt 443 468 444 # if ! defined key_vectopt_loop || defined key_ autotasking469 # if ! defined key_vectopt_loop || defined key_mpp_omp 445 470 END DO 446 471 # endif
Note: See TracChangeset
for help on using the changeset viewer.
