Changeset 1405
- Timestamp:
- 2009-04-16T15:36:22+02:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_004_VVL/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r1389 r1405 1 1 MODULE dynspg_ts 2 !!======================================================================3 !! *** MODULE dynspg_ts ***4 !! Ocean dynamics: surface pressure gradient trend5 2 !!====================================================================== 6 3 !! History : 9.0 ! 04-12 (L. Bessieres, G. Madec) Original code … … 85 82 !! (= 2 * baroclinic time step) and saved in zsshX_b, zuX_b 86 83 !! and zvX_b (X specifying after, now or before). 87 !! -3- Update of sea surface height from time averaged barotropic 88 !! variables. 89 !! - apply lateral boundary conditions on sshn. 90 !! -4- The new general trend becomes : 91 !! ua = ua - sum_k(ua)/H + ( zua_b - sum_k(ub) )/H 84 !! -3- The new general trend becomes : 85 !! ua = ua - sum_k(ua)/H + ( zua_e - sum_k(ub) )/H 92 86 !! 93 87 !! ** Action : - Update (ua,va) with the surf. pressure gradient trend … … 107 101 zcu, zcv, zwx, zwy, zhdiv, & ! temporary arrays 108 102 zua, zva, zub, zvb, & ! " " 109 z ssha_b, zua_b, zva_b, & ! " "110 zub_e, zvb_e, 111 zu n_e, zvn_e ! " "103 zua_e, zva_e, zssha_e, & ! " " 104 zub_e, zvb_e, zsshb_e, & ! " " 105 zu_sum, zv_sum, zssh_sum 112 106 !! Variable volume 113 107 REAL(wp), DIMENSION(jpi,jpj) :: & 114 108 zspgu_1, zspgv_1, zsshun_e, zsshvn_e ! 2D workspace 115 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfse3un_e, zfse3vn_e ! 3D workspace116 109 !!---------------------------------------------------------------------- 117 110 118 111 ! Arrays initialization 119 112 ! --------------------- 120 zua_b(:,:) = 0.e0 ; zub_e(:,:) = 0.e0 ; zun_e(:,:) = 0.e0121 zva_b(:,:) = 0.e0 ; zvb_e(:,:) = 0.e0 ; zvn_e(:,:) = 0.e0122 113 zhdiv(:,:) = 0.e0 123 114 … … 133 124 ! ! sshb, sshn, sshb_b, sshn_b, un_b, vn_b 134 125 135 ssha_e(:,:) = sshn(:,:) 136 ua_e(:,:) = un_b(:,:) 137 va_e(:,:) = vn_b(:,:) 138 hu_e(:,:) = hu(:,:) 139 hv_e(:,:) = hv(:,:) 140 126 zssha_e(:,:) = sshn(:,:) 127 zua_e (:,:) = un_e(:,:) 128 zva_e (:,:) = vn_e(:,:) 129 hu_e (:,:) = hu (:,:) 130 hv_e (:,:) = hv (:,:) 141 131 IF( ln_dynvor_een ) THEN 142 132 ftne(1,:) = 0.e0 ; ftnw(1,:) = 0.e0 ; ftse(1,:) = 0.e0 ; ftsw(1,:) = 0.e0 … … 170 160 zspgv_1(ji,jj) = -grav * ( ( rhd(ji ,jj+1,1) + 1 ) * sshn(ji ,jj+1) & 171 161 & - ( rhd(ji ,jj ,1) + 1 ) * sshn(ji ,jj ) ) / e2v(ji,jj) 172 END DO 162 END DO 173 163 END DO 174 164 … … 193 183 zfact2 = 0.5 * 0.5 194 184 zraur = 1. / rauw ! 1 / volumic mass of pure water 195 185 196 186 ! ----------------------------------------------------------------------------- 197 187 ! Phase 1 : Coupling between general trend and barotropic estimates (1st step) … … 215 205 zva(ji,1) = zva(ji,1) + fse3v(ji,1,jk) * vmask(ji,1,jk) * va(ji,1,jk) 216 206 ! ! Vertically integrated transports (before) 217 zub(ji,1) = zub(ji,1) + fse3u (ji,1,jk) * ub(ji,1,jk)218 zvb(ji,1) = zvb(ji,1) + fse3v (ji,1,jk) * vb(ji,1,jk)207 zub(ji,1) = zub(ji,1) + fse3u_b(ji,1,jk) * ub(ji,1,jk) 208 zvb(ji,1) = zvb(ji,1) + fse3v_b(ji,1,jk) * vb(ji,1,jk) 219 209 ! ! Planetary vorticity transport fluxes (now) 220 210 zwx(ji,1) = zwx(ji,1) + e2u(ji,1) * fse3u(ji,1,jk) * un(ji,1,jk) … … 228 218 zva(:,:) = zva(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 229 219 ! ! Vertically integrated transports (before) 230 zub(:,:) = zub(:,:) + fse3u (:,:,jk) * ub(:,:,jk)231 zvb(:,:) = zvb(:,:) + fse3v (:,:,jk) * vb(:,:,jk)220 zub(:,:) = zub(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) 221 zvb(:,:) = zvb(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) 232 222 ! ! Planetary vorticity (now) 233 223 zwx(:,:) = zwx(:,:) + e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) … … 304 294 !---------------- 305 295 ! Number of iteration of the barotropic loop 306 icycle = 3 * nn_baro / 2296 icycle = 2 * nn_baro + 1 307 297 308 298 ! variables for the barotropic equations 309 sshb_e (:,:) = sshn_b(:,:) ! (barotropic) sea surface height (before and now) 310 sshn_e (:,:) = sshn_b(:,:) 311 zub_e (:,:) = un_b (:,:) ! barotropic transports issued from the barotropic equations (before and now) 312 zvb_e (:,:) = vn_b (:,:) 313 zun_e (:,:) = un_b (:,:) 314 zvn_e (:,:) = vn_b (:,:) 315 zssha_b(:,:) = 0.e0 316 zua_b (:,:) = 0.e0 317 zva_b (:,:) = 0.e0 318 hu_e (:,:) = hu (:,:) ! (barotropic) ocean depth at u-point 319 hv_e (:,:) = hv (:,:) ! (barotropic) ocean depth at v-point 320 IF( lk_vvl ) THEN 321 zsshun_e(:,:) = sshu (:,:) ! (barotropic) sea surface height (now) at u-point 322 zsshvn_e(:,:) = sshv (:,:) ! (barotropic) sea surface height (now) at v-point 323 zfse3un_e(:,:,:) = fse3u(:,:,:) ! (barotropic) scale factors at u-point 324 zfse3un_e(:,:,:) = fse3v(:,:,:) ! (barotropic) scale factors at v-point 299 zu_sum (:,:) = 0.e0 300 zv_sum (:,:) = 0.e0 301 zssh_sum(:,:) = 0.e0 302 hu_e (:,:) = hu (:,:) ! (barotropic) ocean depth at u-point 303 hv_e (:,:) = hv (:,:) ! (barotropic) ocean depth at v-point 304 zsshb_e (:,:) = sshn_e(:,:) ! (barotropic) sea surface height (before and now) 305 ! vertical sum 306 un_e (:,:) = 0.e0 307 vn_e (:,:) = 0.e0 308 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 309 DO jk = 1, jpkm1 310 DO ji = 1, jpij 311 un_e(ji,1) = un_e(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk) 312 vn_e(ji,1) = vn_e(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk) 313 END DO 314 END DO 315 ELSE ! No vector opt. 316 DO jk = 1, jpkm1 317 un_e(:,:) = un_e(:,:) + fse3u(:,:,jk) * un(:,:,jk) 318 vn_e(:,:) = vn_e(:,:) + fse3v(:,:,jk) * vn(:,:,jk) 319 END DO 325 320 ENDIF 321 zub_e (:,:) = un_e(:,:) 322 zvb_e (:,:) = vn_e(:,:) 323 326 324 327 325 ! set ssh corrections to 0 … … 352 350 DO jj = 2, jpjm1 353 351 DO ji = fs_2, fs_jpim1 ! vector opt. 354 zhdiv(ji,jj) = ( e2u(ji ,jj ) * zun_e(ji ,jj) &355 & -e2u(ji-1,jj ) * zun_e(ji-1,jj) &356 & +e1v(ji ,jj ) * zvn_e(ji ,jj) &357 & -e1v(ji ,jj-1) * zvn_e(ji ,jj-1) ) &352 zhdiv(ji,jj) = ( e2u(ji ,jj ) * un_e(ji ,jj) & 353 & -e2u(ji-1,jj ) * un_e(ji-1,jj) & 354 & +e1v(ji ,jj ) * vn_e(ji ,jj) & 355 & -e1v(ji ,jj-1) * vn_e(ji ,jj-1) ) & 358 356 & / (e1t(ji,jj)*e2t(ji,jj)) 359 357 END DO … … 370 368 371 369 #if defined key_bdy 372 373 374 375 376 370 DO jj = 1, jpj 371 DO ji = 1, jpi 372 zhdiv(ji,jj) = zhdiv(ji,jj)*bdytmask(ji,jj) 373 END DO 374 END DO 377 375 #endif 378 376 … … 381 379 DO jj = 2, jpjm1 382 380 DO ji = fs_2, fs_jpim1 ! vector opt. 383 ssha_e(ji,jj) = (sshb_e(ji,jj) - z2dt_e * ( zraur * emp(ji,jj) &384 & + zhdiv(ji,jj) ) ) * tmask(ji,jj,1)381 zssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * emp(ji,jj) & 382 & + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 385 383 END DO 386 384 END DO … … 388 386 ! evolution of the barotropic transport ( following the vorticity scheme used) 389 387 ! ---------------------------------------------------------------------------- 390 zwx(:,:) = e2u(:,:) * zun_e(:,:)391 zwy(:,:) = e1v(:,:) * zvn_e(:,:)388 zwx(:,:) = e2u(:,:) * un_e(:,:) 389 zwy(:,:) = e1v(:,:) * vn_e(:,:) 392 390 393 391 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN ! energy conserving or mixed scheme … … 396 394 ! surface pressure gradient 397 395 IF( lk_vvl) THEN 398 zspgu = -grav * ( ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj) &399 & - ( rhd(ji,jj,1) + 1 ) * sshn_e(ji,jj) ) * hu_e(ji,jj) / e1u(ji,jj)400 zspgv = -grav * ( ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji,jj+1) &401 & - ( rhd(ji,jj,1) + 1 ) * sshn_e(ji,jj) ) * hv_e(ji,jj) / e2v(ji,jj)396 zspgu = -grav * ( ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj ) & 397 & - ( rhd(ji ,jj ,1) + 1 ) * sshn_e(ji ,jj ) ) * hu(ji,jj) / e1u(ji,jj) 398 zspgv = -grav * ( ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji ,jj+1) & 399 & - ( rhd(ji ,jj ,1) + 1 ) * sshn_e(ji ,jj ) ) * hv(ji,jj) / e2v(ji,jj) 402 400 ELSE 403 401 zspgu = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj) … … 412 410 zcvbt =-zfact2 * ( ff(ji-1,jj ) * zx1 + ff(ji,jj) * zx2 ) 413 411 ! after transports 414 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1)415 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1)412 zua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1) 413 zva_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1) 416 414 END DO 417 415 END DO … … 422 420 ! surface pressure gradient 423 421 IF( lk_vvl) THEN 424 zspgu = -grav * ( ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj) &425 & - ( rhd(ji,jj,1) + 1 ) * sshn_e(ji,jj) ) * hu_e(ji,jj) / e1u(ji,jj)426 zspgv = -grav * ( ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji,jj+1) &427 & - ( rhd(ji,jj,1) + 1 ) * sshn_e(ji,jj) ) * hv_e(ji,jj) / e2v(ji,jj)422 zspgu = -grav * ( ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj ) & 423 & - ( rhd(ji ,jj ,1) + 1 ) * sshn_e(ji ,jj ) ) * hu(ji,jj) / e1u(ji,jj) 424 zspgv = -grav * ( ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji ,jj+1) & 425 & - ( rhd(ji ,jj ,1) + 1 ) * sshn_e(ji ,jj ) ) * hv(ji,jj) / e2v(ji,jj) 428 426 ELSE 429 427 zspgu = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj) … … 432 430 ! enstrophy conserving formulation for planetary vorticity term 433 431 zy1 = zfact1 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 434 432 + zwy(ji ,jj ) + zwy(ji+1,jj ) ) / e1u(ji,jj) 435 433 zx1 =-zfact1 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 436 434 + zwx(ji ,jj ) + zwx(ji ,jj+1) ) / e2v(ji,jj) 437 435 zcubt = zy1 * ( ff(ji ,jj-1) + ff(ji,jj) ) 438 436 zcvbt = zx1 * ( ff(ji-1,jj ) + ff(ji,jj) ) 439 437 ! after transports 440 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1)441 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1)438 zua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1) 439 zva_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1) 442 440 END DO 443 441 END DO … … 449 447 ! surface pressure gradient 450 448 IF( lk_vvl) THEN 451 zspgu = -grav * ( ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj) &452 & - ( rhd(ji,jj,1) + 1 ) * sshn_e(ji,jj) ) * hu_e(ji,jj) / e1u(ji,jj)453 zspgv = -grav * ( ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji,jj+1) &454 & - ( rhd(ji,jj,1) + 1 ) * sshn_e(ji,jj) ) * hv_e(ji,jj) / e2v(ji,jj)449 zspgu = -grav * ( ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj ) & 450 & - ( rhd(ji ,jj ,1) + 1 ) * sshn_e(ji ,jj ) ) * hu(ji,jj) / e1u(ji,jj) 451 zspgv = -grav * ( ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji ,jj+1) & 452 & - ( rhd(ji ,jj ,1) + 1 ) * sshn_e(ji ,jj ) ) * hv(ji,jj) / e2v(ji,jj) 455 453 ELSE 456 454 zspgu = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj) … … 463 461 & + ftnw(ji,jj ) * zwx(ji-1,jj ) + ftne(ji,jj ) * zwx(ji ,jj ) ) 464 462 ! after transports 465 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1)466 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1)463 zua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1) 464 zva_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1) 467 465 END DO 468 466 END DO … … 477 475 478 476 ! ... Boundary conditions on ua_e, va_e, ssha_e 479 CALL lbc_lnk( ua_e , 'U', -1. )480 CALL lbc_lnk( va_e , 'V', -1. )481 CALL lbc_lnk( ssha_e, 'T', 1. )477 CALL lbc_lnk( zua_e , 'U', -1. ) 478 CALL lbc_lnk( zva_e , 'V', -1. ) 479 CALL lbc_lnk( zssha_e, 'T', 1. ) 482 480 483 481 ! temporal sum 484 482 !------------- 485 IF( jit >= nn_baro / 2 ) THEN 486 zssha_b(:,:) = zssha_b(:,:) + ssha_e(:,:) 487 zua_b (:,:) = zua_b (:,:) + ua_e (:,:) 488 zva_b (:,:) = zva_b (:,:) + va_e (:,:) 489 ENDIF 483 zu_sum (:,:) = zu_sum (:,:) + zua_e (:,:) 484 zv_sum (:,:) = zv_sum (:,:) + zva_e (:,:) 485 zssh_sum(:,:) = zssh_sum(:,:) + zssha_e(:,:) 490 486 491 487 ! Time filter and swap of dynamics arrays 492 488 ! --------------------------------------- 493 489 IF( jit == 1 ) THEN ! Euler (forward) time stepping 494 sshb_e (:,:) = sshn_e(:,:)495 zub_e (:,:) = zun_e(:,:)496 zvb_e (:,:) = zvn_e(:,:)497 sshn_e (:,:) = ssha_e(:,:)498 zun_e (:,:) =ua_e (:,:)499 zvn_e (:,:) =va_e (:,:)490 zsshb_e(:,:) = sshn_e (:,:) 491 zub_e (:,:) = un_e (:,:) 492 zvb_e (:,:) = vn_e (:,:) 493 sshn_e (:,:) = zssha_e(:,:) 494 un_e (:,:) = zua_e (:,:) 495 vn_e (:,:) = zva_e (:,:) 500 496 ELSE ! Asselin filtering 501 sshb_e (:,:) = atfp * ( sshb_e(:,:) +ssha_e(:,:) ) + atfp1 * sshn_e(:,:)502 zub_e (:,:) = atfp * ( zub_e (:,:) + ua_e (:,:) ) + atfp1 * zun_e (:,:)503 zvb_e (:,:) = atfp * ( zvb_e (:,:) + va_e (:,:) ) + atfp1 * zvn_e (:,:)504 sshn_e (:,:) = ssha_e(:,:)505 zun_e (:,:) =ua_e (:,:)506 zvn_e (:,:) =va_e (:,:)497 zsshb_e(:,:) = atfp * ( zsshb_e(:,:) + zssha_e(:,:) ) + atfp1 * sshn_e(:,:) 498 zub_e (:,:) = atfp * ( zub_e (:,:) + zua_e (:,:) ) + atfp1 * un_e (:,:) 499 zvb_e (:,:) = atfp * ( zvb_e (:,:) + zva_e (:,:) ) + atfp1 * vn_e (:,:) 500 sshn_e (:,:) = zssha_e(:,:) 501 un_e (:,:) = zua_e (:,:) 502 vn_e (:,:) = zva_e (:,:) 507 503 ENDIF 508 504 509 IF( lk_vvl ) THEN ! Variable volume 505 IF( lk_vvl ) THEN ! Variable volume ! needed for BDY ??? 510 506 511 507 ! Sea surface elevation … … 528 524 529 525 ! Boundaries conditions 530 CALL lbc_lnk( zsshun_e, 'U', 1. ) ; 526 CALL lbc_lnk( zsshun_e, 'U', 1. ) ; CALL lbc_lnk( zsshvn_e, 'V', 1. ) 531 527 532 528 ! Ocean depth at U- and V-points 533 hu_e(:,:) = 0.e0 534 hv_e(:,:) = 0.e0 535 536 DO jk = 1, jpk 537 hu_e(:,:) = hu_e(:,:) + zfse3un_e(:,:,jk) * umask(:,:,jk) 538 hv_e(:,:) = hv_e(:,:) + zfse3vn_e(:,:,jk) * vmask(:,:,jk) 539 END DO 540 541 ENDIF ! End variable volume case 542 529 ! ------------------------------------------- 530 hu_e(:,:) = hu_0(:,:) + zsshun_e(:,:) 531 hv_e(:,:) = hv_0(:,:) + zsshvn_e(:,:) 532 533 ! 534 ENDIF 543 535 ! ! ==================== ! 544 536 END DO ! end loop ! 545 537 ! ! ==================== ! 546 538 547 548 539 ! Time average of after barotropic variables 549 zcoef = 1.e0 / ( nn_baro + 1 ) 550 zssha_b(:,:) = zcoef * zssha_b(:,:) 551 zua_b (:,:) = zcoef * zua_b (:,:) 552 zva_b (:,:) = zcoef * zva_b (:,:) 540 zcoef = 1.e0 / ( 2 * nn_baro + 1 ) 541 un_e (:,:) = zcoef * zu_sum (:,:) 542 vn_e (:,:) = zcoef * zv_sum (:,:) 543 sshn_e(:,:) = zcoef * zssh_sum(:,:) 544 553 545 #if defined key_obc 554 546 IF( lp_obc_east ) sshfoe_b(:,:) = zcoef * sshfoe_b(:,:) … … 557 549 IF( lp_obc_south ) sshfos_b(:,:) = zcoef * sshfos_b(:,:) 558 550 #endif 559 560 561 ! ---------------------------------------------------------------------------562 ! Phase 3 : Update sea surface height from time averaged barotropic variables563 ! ---------------------------------------------------------------------------564 !RB_vvl now done in ssh_wzv and ssh_nxt565 551 566 552 ! ----------------------------------------------------------------------------- 567 ! Phase 4. Coupling between general trend and barotropic estimates - (2nd step)553 ! Phase 3. Coupling between general trend and barotropic estimates - (2nd step) 568 554 ! ----------------------------------------------------------------------------- 569 555 570 ! Swap on time averaged barotropic variables 571 ! ------------------------------------------ 572 sshb_b(:,:) = sshn_b (:,:) 573 IF ( neuler == 0 .AND. kt == nit000 ) zssha_b(:,:) = sshn(:,:) 574 sshn_b(:,:) = zssha_b(:,:) 575 un_b (:,:) = zua_b (:,:) 576 vn_b (:,:) = zva_b (:,:) 577 556 557 578 558 ! add time averaged barotropic coriolis and surface pressure gradient 579 559 ! terms to the general momentum trend 580 560 ! -------------------------------------------------------------------- 581 561 DO jk=1,jpkm1 582 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( zua_b(:,:) - zub(:,:) ) / z2dt_b583 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( zva_b(:,:) - zvb(:,:) ) / z2dt_b562 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( un_e(:,:) - zub(:,:) ) / z2dt_b 563 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( vn_e(:,:) - zvb(:,:) ) / z2dt_b 584 564 END DO 585 565 … … 588 568 IF( lrst_oce ) CALL ts_rst( kt, 'WRITE' ) 589 569 590 ! print sum trends (used for debugging)591 IF( ln_ctl ) CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh : ', mask1=tmask )592 570 ! 593 571 END SUBROUTINE dyn_spg_ts … … 607 585 ! 608 586 IF( TRIM(cdrw) == 'READ' ) THEN 609 IF( iom_varid( numror, 'sshn_b', ldstop = .FALSE. ) > 0 ) THEN 610 CALL iom_get( numror, jpdom_autoglo, 'sshb_b', sshb_b(:,:) ) ! free surface issued 611 CALL iom_get( numror, jpdom_autoglo, 'sshn_b', sshn_b(:,:) ) ! from time-splitting loop 612 CALL iom_get( numror, jpdom_autoglo, 'un_b' , un_b (:,:) ) ! horizontal transports issued 613 CALL iom_get( numror, jpdom_autoglo, 'vn_b' , vn_b (:,:) ) ! from barotropic loop 614 IF( neuler == 0 ) sshb_b(:,:) = sshn_b(:,:) 587 IF( iom_varid( numror, 'sshn_e', ldstop = .FALSE. ) > 0 ) THEN 588 CALL iom_get( numror, jpdom_autoglo, 'sshn_e', sshn_e(:,:) ) ! free surface and 589 CALL iom_get( numror, jpdom_autoglo, 'un_e' , un_e (:,:) ) ! horizontal transports issued 590 CALL iom_get( numror, jpdom_autoglo, 'vn_e' , vn_e (:,:) ) ! from barotropic loop 615 591 ELSE 616 sshb_b(:,:) = sshb(:,:) 617 sshn_b(:,:) = sshn(:,:) 618 un_b (:,:) = 0.e0 619 vn_b (:,:) = 0.e0 592 sshn_e(:,:) = sshn(:,:) 593 un_e (:,:) = 0.e0 594 vn_e (:,:) = 0.e0 620 595 ! vertical sum 621 596 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 622 597 DO jk = 1, jpkm1 623 598 DO ji = 1, jpij 624 un_ b(ji,1) = un_b(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk)625 vn_ b(ji,1) = vn_b(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk)599 un_e(ji,1) = un_e(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk) 600 vn_e(ji,1) = vn_e(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk) 626 601 END DO 627 602 END DO 628 603 ELSE ! No vector opt. 629 604 DO jk = 1, jpkm1 630 un_ b(:,:) = un_b(:,:) + fse3u(:,:,jk) * un(:,:,jk)631 vn_ b(:,:) = vn_b(:,:) + fse3v(:,:,jk) * vn(:,:,jk)605 un_e(:,:) = un_e(:,:) + fse3u(:,:,jk) * un(:,:,jk) 606 vn_e(:,:) = vn_e(:,:) + fse3v(:,:,jk) * vn(:,:,jk) 632 607 END DO 633 608 ENDIF 634 609 ENDIF 635 610 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 636 CALL iom_rstput( kt, nitrst, numrow, 'sshb_b', sshb_b(:,:) ) ! free surface issued 637 CALL iom_rstput( kt, nitrst, numrow, 'sshn_b', sshn_b(:,:) ) ! from barotropic loop 638 CALL iom_rstput( kt, nitrst, numrow, 'un_b' , un_b (:,:) ) ! horizontal transports issued 639 CALL iom_rstput( kt, nitrst, numrow, 'vn_b' , vn_b (:,:) ) ! from barotropic loop 611 CALL iom_rstput( kt, nitrst, numrow, 'sshn_e', sshn_e(:,:) ) ! free surface and 612 CALL iom_rstput( kt, nitrst, numrow, 'un_e' , un_e (:,:) ) ! horizontal transports issued 613 CALL iom_rstput( kt, nitrst, numrow, 'vn_e' , vn_e (:,:) ) ! from barotropic loop 640 614 ENDIF 641 615 !
Note: See TracChangeset
for help on using the changeset viewer.
