Changeset 508 for trunk/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Timestamp:
- 2006-10-03T17:58:55+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DYN/dynspg_ts.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r455 r508 4 4 !! Ocean dynamics: surface pressure gradient trend 5 5 !!====================================================================== 6 !! History : 9.0 ! 04-12 (L. Bessieres, G. Madec) Original code 7 !! " " ! 05-11 (V. Garnier, G. Madec) optimization 8 !! 9.0 ! 06-08 (S. Masson) distributed restart using iom 9 !!--------------------------------------------------------------------- 6 10 #if ( defined key_dynspg_ts && ! defined key_mpp_omp ) || defined key_esopa 7 11 !!---------------------------------------------------------------------- … … 9 13 !! NOT 'key_mpp_omp' k-j-i loop (vector opt.) 10 14 !!---------------------------------------------------------------------- 15 !!---------------------------------------------------------------------- 11 16 !! dyn_spg_ts : compute surface pressure gradient trend using a time- 12 17 !! splitting scheme and add to the general trend 18 !! ts_rst : read/write the time-splitting restart fields in the ocean restart file 13 19 !!---------------------------------------------------------------------- 14 20 !! * Modules used … … 27 33 USE dynspg_oce ! surface pressure gradient variables 28 34 USE in_out_manager ! I/O manager 35 USE iom 36 USE restart ! only for lrst_oce 29 37 30 38 IMPLICIT NONE 31 39 PRIVATE 32 40 33 !! * Accessibility34 41 PUBLIC dyn_spg_ts ! routine called by step.F90 42 43 REAL(wp), DIMENSION(jpi,jpj) :: ftnw, ftne, & ! triad of coriolis parameter 44 & ftsw, ftse ! (only used with een vorticity scheme) 45 35 46 36 47 !! * Substitutions … … 74 85 !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 75 86 !! 76 !! References : 77 !! Griffies et al., (2003): A technical guide to MOM4. NOAA/GFDL 78 !! 79 !! History : 80 !! 9.0 ! 04-12 (L. Bessieres, G. Madec) Original code 81 !! ! 05-11 (V. Garnier, G. Madec) optimization 87 !! References : Griffies et al., (2003): A technical guide to MOM4. NOAA/GFDL 82 88 !!--------------------------------------------------------------------- 83 !! * Arguments84 89 INTEGER, INTENT( in ) :: kt ! ocean time-step index 85 90 … … 97 102 zsshb_e, zub_e, zvb_e, & ! " " 98 103 zun_e, zvn_e ! " " 99 REAL(wp), DIMENSION(jpi,jpj),SAVE :: &100 ztnw, ztne, ztsw, ztse101 104 !!---------------------------------------------------------------------- 102 105 … … 109 112 110 113 IF( kt == nit000 ) THEN 111 114 ! 112 115 IF(lwp) WRITE(numout,*) 113 116 IF(lwp) WRITE(numout,*) 'dyn_spg_ts : surface pressure gradient trend' … … 115 118 IF(lwp) WRITE(numout,*) ' Number of sub cycle in 1 time-step (2 rdt) : icycle = ', FLOOR( 2*rdt/rdtbt ) 116 119 117 IF( .NOT. ln_rstart ) THEN 118 ! initialize barotropic specific arrays 119 sshb_b(:,:) = sshb(:,:) 120 sshn_b(:,:) = sshn(:,:) 121 un_b(:,:) = 0.e0 122 vn_b(:,:) = 0.e0 123 ! vertical sum 124 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 125 DO jk = 1, jpkm1 126 DO ji = 1, jpij 127 un_b(ji,1) = un_b(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk) 128 vn_b(ji,1) = vn_b(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk) 129 END DO 130 END DO 131 ELSE ! No vector opt. 132 DO jk = 1, jpkm1 133 un_b(:,:) = un_b(:,:) + fse3u(:,:,jk) * un(:,:,jk) 134 vn_b(:,:) = vn_b(:,:) + fse3v(:,:,jk) * vn(:,:,jk) 135 END DO 136 ENDIF 137 ENDIF 120 CALL ts_rst( nit000, 'READ' ) ! read or initialize the following fields: 121 ! ! sshb, sshn, sshb_b, sshn_b, un_b, vn_b 122 138 123 ssha_e(:,:) = sshn(:,:) 139 124 ua_e(:,:) = un_b(:,:) … … 141 126 142 127 IF( ln_dynvor_een ) THEN 143 ztne(1,:) = 0.e0 ; ztnw(1,:) = 0.e0 ; ztse(1,:) = 0.e0 ; ztsw(1,:) = 0.e0128 ftne(1,:) = 0.e0 ; ftnw(1,:) = 0.e0 ; ftse(1,:) = 0.e0 ; ftsw(1,:) = 0.e0 144 129 DO jj = 2, jpj 145 130 DO ji = fs_2, jpi ! vector opt. 146 ztne(ji,jj) = ( ff(ji-1,jj ) + ff(ji ,jj ) + ff(ji ,jj-1) ) / 3.147 ztnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj ) + ff(ji ,jj ) ) / 3.148 ztse(ji,jj) = ( ff(ji ,jj ) + ff(ji ,jj-1) + ff(ji-1,jj-1) ) / 3.149 ztsw(ji,jj) = ( ff(ji ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj ) ) / 3.131 ftne(ji,jj) = ( ff(ji-1,jj ) + ff(ji ,jj ) + ff(ji ,jj-1) ) / 3. 132 ftnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj ) + ff(ji ,jj ) ) / 3. 133 ftse(ji,jj) = ( ff(ji ,jj ) + ff(ji ,jj-1) + ff(ji-1,jj-1) ) / 3. 134 ftsw(ji,jj) = ( ff(ji ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj ) ) / 3. 150 135 END DO 151 136 END DO 152 137 ENDIF 153 138 ! 154 139 ENDIF 155 140 156 141 ! Local constant initialization 157 142 ! -------------------------------- … … 216 201 END DO 217 202 END DO 218 203 ! 219 204 ELSEIF ( ln_dynvor_ens ) THEN ! enstrophy conserving scheme 220 205 DO jj = 2, jpjm1 … … 228 213 END DO 229 214 END DO 230 215 ! 231 216 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 232 217 zfac25 = 0.25 … … 241 226 END DO 242 227 END DO 243 228 ! 244 229 ENDIF 245 230 … … 300 285 DO jit = 1, icycle ! sub-time-step loop ! 301 286 ! ! ==================== ! 302 303 287 z2dt_e = 2. * rdtbt 304 288 IF ( jit == 1 ) z2dt_e = rdtbt … … 360 344 END DO 361 345 END DO 362 346 ! 363 347 ELSEIF ( ln_dynvor_ens ) THEN ! enstrophy conserving scheme 364 348 DO jj = 2, jpjm1 … … 379 363 END DO 380 364 END DO 381 365 ! 382 366 ELSEIF ( ln_dynvor_een ) THEN ! energy and enstrophy conserving scheme 383 367 zfac25 = 0.25 … … 397 381 END DO 398 382 END DO 383 ! 399 384 ENDIF 400 385 … … 504 489 END DO 505 490 506 IF(ln_ctl) THEN ! print sum trends (used for debugging) 507 CALL prt_ctl(tab2d_1=sshn, clinfo1=' ssh : ', mask1=tmask) 491 ! write filtered free surface arrays in restart file 492 ! -------------------------------------------------- 493 IF( lrst_oce ) CALL ts_rst( kt, 'WRITE' ) 494 495 ! print sum trends (used for debugging) 496 IF( ln_ctl ) CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh : ', mask1=tmask ) 497 ! 498 END SUBROUTINE dyn_spg_ts 499 500 501 SUBROUTINE ts_rst( kt, cdrw ) 502 !!--------------------------------------------------------------------- 503 !! *** ROUTINE ts_rst *** 504 !! 505 !! ** Purpose : Read or write time-splitting arrays in restart file 506 !!---------------------------------------------------------------------- 507 INTEGER , INTENT(in) :: kt ! ocean time-step 508 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 509 ! 510 INTEGER :: ji, jk ! dummy loop indices 511 !!---------------------------------------------------------------------- 512 ! 513 IF( TRIM(cdrw) == 'READ' ) THEN 514 IF( iom_varid( numror, 'sshn' ) > 0 ) THEN 515 CALL iom_get( numror, jpdom_local, 'sshb' , sshb(:,:) ) 516 CALL iom_get( numror, jpdom_local, 'sshn' , sshn(:,:) ) 517 IF( neuler == 0 ) sshb(:,:) = sshn(:,:) 518 ELSE 519 sshb(:,:) = 0.e0 520 sshn(:,:) = 0.e0 521 ENDIF 522 IF( iom_varid( numror, 'sshn_b' ) > 0 ) THEN 523 CALL iom_get( numror, jpdom_local, 'sshb_b', sshb_b(:,:) ) ! free surface issued 524 CALL iom_get( numror, jpdom_local, 'sshn_b', sshn_b(:,:) ) ! from time-splitting loop 525 CALL iom_get( numror, jpdom_local, 'un_b' , un_b (:,:) ) ! horizontal transports issued 526 CALL iom_get( numror, jpdom_local, 'vn_b' , vn_b (:,:) ) ! from barotropic loop 527 IF( neuler == 0 ) sshb_b(:,:) = sshn_b(:,:) 528 ELSE 529 sshb_b(:,:) = sshb(:,:) 530 sshn_b(:,:) = sshn(:,:) 531 un_b (:,:) = 0.e0 532 vn_b (:,:) = 0.e0 533 ! vertical sum 534 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 535 DO jk = 1, jpkm1 536 DO ji = 1, jpij 537 un_b(ji,1) = un_b(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk) 538 vn_b(ji,1) = vn_b(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk) 539 END DO 540 END DO 541 ELSE ! No vector opt. 542 DO jk = 1, jpkm1 543 un_b(:,:) = un_b(:,:) + fse3u(:,:,jk) * un(:,:,jk) 544 vn_b(:,:) = vn_b(:,:) + fse3v(:,:,jk) * vn(:,:,jk) 545 END DO 546 ENDIF 547 ENDIF 548 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 549 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb (:,:) ) 550 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn (:,:) ) 551 CALL iom_rstput( kt, nitrst, numrow, 'sshb_b', sshb_b(:,:) ) ! free surface issued 552 CALL iom_rstput( kt, nitrst, numrow, 'sshn_b', sshn_b(:,:) ) ! from barotropic loop 553 CALL iom_rstput( kt, nitrst, numrow, 'un_b' , un_b (:,:) ) ! horizontal transports issued 554 CALL iom_rstput( kt, nitrst, numrow, 'vn_b' , vn_b (:,:) ) ! from barotropic loop 508 555 ENDIF 509 510 END SUBROUTINE dyn_spg_ts 556 ! 557 END SUBROUTINE ts_rst 558 511 559 #else 512 560 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
