Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Timestamp:
- 2015-12-03T09:10:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5260 r5989 11 11 !! 3.5 ! 2013-07 (J. Chanut) Switch to Forward-backward time stepping 12 12 !! 3.6 ! 2013-11 (A. Coward) Update for z-tilde compatibility 13 !! 3.7 ! 2015-11 (J. Chanut) free surface simplification 13 14 !!--------------------------------------------------------------------- 14 #if defined key_dynspg_ts || defined key_esopa15 15 !!---------------------------------------------------------------------- 16 !! 'key_dynspg_ts'split explicit free surface16 !! split explicit free surface 17 17 !!---------------------------------------------------------------------- 18 18 !! dyn_spg_ts : compute surface pressure gradient trend using a time- … … 23 23 USE sbc_oce ! surface boundary condition: ocean 24 24 USE sbcisf ! ice shelf variable (fwfisf) 25 USE dynspg_oce ! surface pressure gradient variables26 25 USE phycst ! physical constants 27 26 USE dynvor ! vorticity term 28 27 USE bdy_par ! for lk_bdy 29 USE bdytides ! open boundary condition data 28 USE bdytides ! open boundary condition data 30 29 USE bdydyn2d ! open boundary conditions on barotropic variables 31 30 USE sbctide ! tides … … 70 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 71 70 72 ! Arrays below are saved to allow testing of the "no time averaging" option73 ! If this option is not retained, these could be replaced by temporary arrays74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshbb_e, sshb_e, & ! Instantaneous barotropic arrays75 ubb_e, ub_e, &76 vbb_e, vb_e77 78 71 !! * Substitutions 79 72 # include "domzgr_substitute.h90" … … 90 83 !! *** routine dyn_spg_ts_alloc *** 91 84 !!---------------------------------------------------------------------- 92 INTEGER :: ierr( 3)85 INTEGER :: ierr(4) 93 86 !!---------------------------------------------------------------------- 94 87 ierr(:) = 0 95 88 96 ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 97 & ub_e(jpi,jpj) , vb_e(jpi,jpj) , & 98 & ubb_e(jpi,jpj) , vbb_e(jpi,jpj) , STAT= ierr(1) ) 89 ALLOCATE( ssha_e(jpi,jpj), sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 90 & ua_e(jpi,jpj), un_e(jpi,jpj), ub_e(jpi,jpj), ubb_e(jpi,jpj), & 91 & va_e(jpi,jpj), vn_e(jpi,jpj), vb_e(jpi,jpj), vbb_e(jpi,jpj), & 92 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT= ierr(1) ) 99 93 100 94 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 101 95 102 IF( ln_dynvor_een .or. ln_dynvor_een_old ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 103 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 96 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 97 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 98 99 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_adv(jpi,jpj), vn_adv(jpi,jpj), & 100 #if defined key_agrif 101 & ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , & 102 #endif 103 & STAT= ierr(4)) 104 104 105 105 dyn_spg_ts_alloc = MAXVAL(ierr(:)) 106 106 107 107 IF( lk_mpp ) CALL mpp_sum( dyn_spg_ts_alloc ) 108 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dyn spg_oce_alloc: failed to allocate arrays')108 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays') 109 109 ! 110 110 END FUNCTION dyn_spg_ts_alloc 111 111 112 112 113 SUBROUTINE dyn_spg_ts( kt ) … … 148 149 REAL(wp) :: zmdi 149 150 REAL(wp) :: zraur, z1_2dt_b, z2dt_bf ! local scalars 150 REAL(wp) :: zx1, zy1, zx2, zy2 ! - -151 REAL(wp) :: z1_12, z1_8, z1_4, z1_2 152 REAL(wp) :: zu_spg, zv_spg ! - -153 REAL(wp) :: zhura, zhvra 154 REAL(wp) :: za0, za1, za2, za3 155 ! 156 REAL(wp), POINTER, DIMENSION(:,:) :: z un_e, zvn_e, zsshp2_e151 REAL(wp) :: zx1, zy1, zx2, zy2 ! - - 152 REAL(wp) :: z1_12, z1_8, z1_4, z1_2 ! - - 153 REAL(wp) :: zu_spg, zv_spg ! - - 154 REAL(wp) :: zhura, zhvra ! - - 155 REAL(wp) :: za0, za1, za2, za3 ! - - 156 ! 157 REAL(wp), POINTER, DIMENSION(:,:) :: zsshp2_e 157 158 REAL(wp), POINTER, DIMENSION(:,:) :: zu_trd, zv_trd, zu_frc, zv_frc, zssh_frc 158 REAL(wp), POINTER, DIMENSION(:,:) :: z u_sum, zv_sum, zwx, zwy, zhdiv159 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zhdiv 159 160 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 160 161 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a … … 166 167 ! !* Allocate temporary arrays 167 168 CALL wrk_alloc( jpi, jpj, zsshp2_e, zhdiv ) 168 CALL wrk_alloc( jpi, jpj, zu_trd, zv_trd , zun_e, zvn_e)169 CALL wrk_alloc( jpi, jpj, zwx, zwy, z u_sum, zv_sum, zssh_frc, zu_frc, zv_frc)169 CALL wrk_alloc( jpi, jpj, zu_trd, zv_trd) 170 CALL wrk_alloc( jpi, jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc) 170 171 CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 171 172 CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a ) … … 191 192 ! 192 193 ! time offset in steps for bdy data update 193 IF (.NOT.ln_bt_fw) THEN ; noffset=- 2*nn_baro ; ELSE ; noffset = 0 ; ENDIF194 IF (.NOT.ln_bt_fw) THEN ; noffset=-nn_baro ; ELSE ; noffset = 0 ; ENDIF 194 195 ! 195 196 IF( kt == nit000 ) THEN !* initialisation … … 223 224 ! 224 225 IF ( kt == nit000 .OR. lk_vvl ) THEN 225 IF ( ln_dynvor_een_old ) THEN 226 DO jj = 1, jpjm1 227 DO ji = 1, jpim1 228 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 229 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 230 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 231 END DO 232 END DO 226 IF ( ln_dynvor_een ) THEN !== EEN scheme ==! 227 SELECT CASE( nn_een_e3f ) !* ff/e3 at F-point 228 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 229 DO jj = 1, jpjm1 230 DO ji = 1, jpim1 231 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 232 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 233 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 234 END DO 235 END DO 236 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 237 DO jj = 1, jpjm1 238 DO ji = 1, jpim1 239 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 240 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 241 & / ( MAX( 1._wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 242 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 243 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 244 END DO 245 END DO 246 END SELECT 233 247 CALL lbc_lnk( zwz, 'F', 1._wp ) 234 zwz(:,:) = ff(:,:) * zwz(:,:) 235 248 ! 236 249 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 237 250 DO jj = 2, jpj 238 DO ji = fs_2, jpi ! vector opt.251 DO ji = 2, jpi 239 252 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 240 253 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) … … 243 256 END DO 244 257 END DO 245 ELSE IF ( ln_dynvor_een ) THEN 246 DO jj = 1, jpjm1 247 DO ji = 1, jpim1 248 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 249 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 250 & / ( MAX( 1.0_wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 251 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) 252 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 253 END DO 254 END DO 255 CALL lbc_lnk( zwz, 'F', 1._wp ) 256 zwz(:,:) = ff(:,:) * zwz(:,:) 257 258 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 259 DO jj = 2, jpj 260 DO ji = fs_2, jpi ! vector opt. 261 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 262 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) 263 ftse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) 264 ftsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 265 END DO 266 END DO 267 ELSE 258 ! 259 ELSE !== all other schemes (ENE, ENS, MIX) 268 260 zwz(:,:) = 0._wp 269 zhf(:,:) = 0. 261 zhf(:,:) = 0._wp 270 262 IF ( .not. ln_sco ) THEN 263 264 !!gm agree the JC comment : this should be done in a much clear way 265 271 266 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case 272 267 ! Set it to zero for the time being … … 280 275 281 276 DO jj = 1, jpjm1 282 zhf(:,jj) = zhf(:,jj) *(1._wp- umask(:,jj,1) * umask(:,jj+1,1))277 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 283 278 END DO 284 279 … … 301 296 ! If forward start at previous time step, and centered integration, 302 297 ! then update averaging weights: 303 IF ( (.NOT.ln_bt_fw).AND.((neuler==0).AND.(kt==nit000+1))) THEN298 IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 304 299 ll_fw_start=.FALSE. 305 300 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) … … 342 337 DO jj = 2, jpjm1 343 338 DO ji = fs_2, fs_jpim1 ! vector opt. 344 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) /e1u(ji,jj)345 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)346 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) /e2v(ji,jj)347 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) /e2v(ji,jj)339 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 340 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 341 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 342 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 348 343 ! energy conserving formulation for planetary vorticity term 349 344 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) … … 356 351 DO ji = fs_2, fs_jpim1 ! vector opt. 357 352 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 358 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)353 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 359 354 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 360 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)355 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 361 356 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 362 357 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 364 359 END DO 365 360 ! 366 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN ! enstrophy and energy conserving scheme361 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 367 362 DO jj = 2, jpjm1 368 363 DO ji = fs_2, fs_jpim1 ! vector opt. 369 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &370 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &371 & + ftse(ji,jj ) * zwy(ji ,jj-1) &372 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )373 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &374 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &375 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &376 & + ftne(ji,jj ) * zwx(ji ,jj ) )364 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 365 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 366 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 367 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 368 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 369 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 370 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 371 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 377 372 END DO 378 373 END DO … … 385 380 DO jj = 2, jpjm1 386 381 DO ji = fs_2, fs_jpim1 ! vector opt. 387 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) /e1u(ji,jj)388 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) /e2v(ji,jj)382 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj) 383 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj) 389 384 END DO 390 385 END DO … … 435 430 DO jj = 2, jpjm1 436 431 DO ji = fs_2, fs_jpim1 ! vector opt. 437 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) /e1u(ji,jj)438 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)432 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 433 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 439 434 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 440 435 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 445 440 DO ji = fs_2, fs_jpim1 ! vector opt. 446 441 zu_spg = grav * z1_2 * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 447 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) /e1u(ji,jj)442 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 448 443 zv_spg = grav * z1_2 * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) & 449 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj)444 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 450 445 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 451 446 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 458 453 ! ! Surface net water flux and rivers 459 454 IF (ln_bt_fw) THEN 460 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf *fwfisf(:,:) )455 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 461 456 ELSE 462 457 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 463 & + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) ))458 & + fwfisf(:,:) + fwfisf_b(:,:) ) 464 459 ENDIF 465 460 #if defined key_asminc 466 461 ! ! Include the IAU weighted SSH increment 467 462 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 468 zssh_frc(:,:) = zssh_frc(:,:) +ssh_iau(:,:)469 ENDIF 470 #endif 471 ! !* Fill boundary data arrays withAGRIF472 ! ! ------------------------------------ -463 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 464 ENDIF 465 #endif 466 ! !* Fill boundary data arrays for AGRIF 467 ! ! ------------------------------------ 473 468 #if defined key_agrif 474 469 IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt ) … … 494 489 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 495 490 sshn_e(:,:) = sshn (:,:) 496 zun_e(:,:) = un_b (:,:)497 zvn_e(:,:) = vn_b (:,:)491 un_e (:,:) = un_b (:,:) 492 vn_e (:,:) = vn_b (:,:) 498 493 ! 499 494 hu_e (:,:) = hu (:,:) … … 503 498 ELSE ! CENTRED integration: start from BEFORE fields 504 499 sshn_e(:,:) = sshb (:,:) 505 zun_e(:,:) = ub_b (:,:)506 zvn_e(:,:) = vb_b (:,:)500 un_e (:,:) = ub_b (:,:) 501 vn_e (:,:) = vb_b (:,:) 507 502 ! 508 503 hu_e (:,:) = hu_b (:,:) … … 518 513 va_b (:,:) = 0._wp 519 514 ssha (:,:) = 0._wp ! Sum for after averaged sea level 520 zu_sum(:,:) = 0._wp ! Sum for now transport issued from ts loop521 zv_sum(:,:) = 0._wp515 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop 516 vn_adv(:,:) = 0._wp 522 517 ! ! ==================== ! 523 518 DO jn = 1, icycle ! sub-time-step loop ! … … 527 522 ! Update only tidal forcing at open boundaries 528 523 #if defined key_tide 529 IF ( lk_bdy .AND. lk_tide ) 530 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, koffset=noffset )524 IF ( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1) ) 525 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, time_offset=noffset ) 531 526 #endif 532 527 ! … … 543 538 544 539 ! Extrapolate barotropic velocities at step jit+0.5: 545 ua_e(:,:) = za1 * zun_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)546 va_e(:,:) = za1 * zvn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)540 ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 541 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 547 542 548 543 IF( lk_vvl ) THEN !* Update ocean depth (variable volume case only) … … 553 548 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 554 549 DO ji = 2, fs_jpim1 ! Vector opt. 555 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &556 & * ( e1 2t(ji ,jj) * zsshp2_e(ji ,jj) &557 & + e1 2t(ji+1,jj) * zsshp2_e(ji+1,jj) )558 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &559 & * ( e1 2t(ji,jj ) * zsshp2_e(ji,jj ) &560 & + e1 2t(ji,jj+1) * zsshp2_e(ji,jj+1) )561 END DO 562 END DO 563 CALL lbc_lnk ( zwx, 'U', 1._wp ) ; CALL lbc_lnk(zwy, 'V', 1._wp )550 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 551 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 552 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 553 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 554 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 555 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 556 END DO 557 END DO 558 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 564 559 ! 565 560 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points … … 606 601 ! Sum over sub-time-steps to compute advective velocities 607 602 za2 = wgtbtp2(jn) 608 zu_sum (:,:) = zu_sum (:,:) + za2 * zwx (:,:) / e2u(:,:)609 zv_sum (:,:) = zv_sum (:,:) + za2 * zwy (:,:) / e1v(:,:)603 un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 604 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 610 605 ! 611 606 ! Set next sea level: … … 613 608 DO ji = fs_2, fs_jpim1 ! vector opt. 614 609 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 615 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1 2t(ji,jj)610 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1e2t(ji,jj) 616 611 END DO 617 612 END DO … … 631 626 DO jj = 2, jpjm1 632 627 DO ji = 2, jpim1 ! NO Vector Opt. 633 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &634 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &635 & + e1 2t(ji+1,jj ) * ssha_e(ji+1,jj ) )636 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &637 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &638 & + e1 2t(ji ,jj+1) * ssha_e(ji ,jj+1) )639 END DO 640 END DO 641 CALL lbc_lnk ( zsshu_a, 'U', 1._wp ) ; CALL lbc_lnk(zsshv_a, 'V', 1._wp )628 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 629 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 630 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 631 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 632 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 633 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 634 END DO 635 END DO 636 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) 642 637 ENDIF 643 638 ! … … 670 665 DO jj = 2, jpjm1 671 666 DO ji = 2, jpim1 672 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1 2u(ji ,jj) &673 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj) &674 & + e1 2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) )675 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1 2v(ji ,jj ) &676 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj ) &677 & + e1 2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) )667 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1e2u(ji ,jj) & 668 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 669 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 670 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1e2v(ji ,jj ) & 671 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 672 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 678 673 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 679 674 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 692 687 DO jj = 2, jpjm1 693 688 DO ji = fs_2, fs_jpim1 ! vector opt. 694 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) /e1u(ji,jj)695 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)696 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) /e2v(ji,jj)697 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)689 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 690 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 691 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 692 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 698 693 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 699 694 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) … … 705 700 DO ji = fs_2, fs_jpim1 ! vector opt. 706 701 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 707 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)702 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 708 703 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 709 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)704 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 710 705 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 711 706 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 713 708 END DO 714 709 ! 715 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old) THEN !== energy and enstrophy conserving scheme ==!710 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 716 711 DO jj = 2, jpjm1 717 712 DO ji = fs_2, fs_jpim1 ! vector opt. 718 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &719 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &720 & + ftse(ji,jj ) * zwy(ji ,jj-1) &721 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )722 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &723 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &724 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &725 & + ftne(ji,jj ) * zwx(ji ,jj ) )713 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 714 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 715 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 716 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 717 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 718 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 719 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 720 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 726 721 END DO 727 722 END DO … … 733 728 DO jj = 2, jpjm1 734 729 DO ji = fs_2, fs_jpim1 ! vector opt. 735 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) /e1u(ji,jj)736 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) /e2v(ji,jj)730 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 731 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 737 732 zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg 738 733 zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg … … 742 737 ! 743 738 ! Add bottom stresses: 744 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * zun_e(:,:) * hur_e(:,:)745 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * zvn_e(:,:) * hvr_e(:,:)739 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 740 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 746 741 ! 747 742 ! Surface pressure trend: … … 749 744 DO ji = fs_2, fs_jpim1 ! vector opt. 750 745 ! Add surface pressure gradient 751 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) /e1u(ji,jj)752 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) /e2v(ji,jj)746 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 747 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 753 748 zwx(ji,jj) = zu_spg 754 749 zwy(ji,jj) = zv_spg … … 760 755 DO jj = 2, jpjm1 761 756 DO ji = fs_2, fs_jpim1 ! vector opt. 762 ua_e(ji,jj) = ( zun_e(ji,jj) &757 ua_e(ji,jj) = ( un_e(ji,jj) & 763 758 & + rdtbt * ( zwx(ji,jj) & 764 759 & + zu_trd(ji,jj) & … … 766 761 & ) * umask(ji,jj,1) 767 762 768 va_e(ji,jj) = ( zvn_e(ji,jj) &763 va_e(ji,jj) = ( vn_e(ji,jj) & 769 764 & + rdtbt * ( zwy(ji,jj) & 770 765 & + zv_trd(ji,jj) & … … 781 776 zhvra = vmask(ji,jj,1)/(hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - vmask(ji,jj,1)) 782 777 783 ua_e(ji,jj) = ( hu_e(ji,jj) * zun_e(ji,jj) &778 ua_e(ji,jj) = ( hu_e(ji,jj) * un_e(ji,jj) & 784 779 & + rdtbt * ( zhust_e(ji,jj) * zwx(ji,jj) & 785 780 & + zhup2_e(ji,jj) * zu_trd(ji,jj) & … … 787 782 & ) * zhura 788 783 789 va_e(ji,jj) = ( hv_e(ji,jj) * zvn_e(ji,jj) &784 va_e(ji,jj) = ( hv_e(ji,jj) * vn_e(ji,jj) & 790 785 & + rdtbt * ( zhvst_e(ji,jj) * zwy(ji,jj) & 791 786 & + zhvp2_e(ji,jj) * zv_trd(ji,jj) & … … 807 802 ! ! ----------------------- 808 803 ! 809 CALL lbc_lnk( ua_e , 'U', -1._wp ) ! local domain boundaries 810 CALL lbc_lnk( va_e , 'V', -1._wp ) 804 CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 811 805 812 806 #if defined key_bdy 813 807 ! open boundaries 814 IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, zun_e, zvn_e, hur_e, hvr_e, ssha_e )808 IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 815 809 #endif 816 810 #if defined key_agrif … … 820 814 ! ! ---- 821 815 ubb_e (:,:) = ub_e (:,:) 822 ub_e (:,:) = zun_e(:,:)823 zun_e(:,:) = ua_e (:,:)816 ub_e (:,:) = un_e (:,:) 817 un_e (:,:) = ua_e (:,:) 824 818 ! 825 819 vbb_e (:,:) = vb_e (:,:) 826 vb_e (:,:) = zvn_e(:,:)827 zvn_e(:,:) = va_e (:,:)820 vb_e (:,:) = vn_e (:,:) 821 vn_e (:,:) = va_e (:,:) 828 822 ! 829 823 sshbb_e(:,:) = sshb_e(:,:) … … 850 844 ! ----------------------------------------------------------------------------- 851 845 ! 852 ! At this stage ssha holds a time averaged value853 ! ! Sea Surface Height at u-,v- and f-points854 IF( lk_vvl ) THEN ! (required only in key_vvl case)855 DO jj = 1, jpjm1856 DO ji = 1, jpim1 ! NO Vector Opt.857 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) &858 & * ( e12t(ji ,jj) * ssha(ji ,jj) &859 & + e12t(ji+1,jj) * ssha(ji+1,jj) )860 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) &861 & * ( e12t(ji,jj ) * ssha(ji,jj ) &862 & + e12t(ji,jj+1) * ssha(ji,jj+1) )863 END DO864 END DO865 CALL lbc_lnk( zsshu_a, 'U', 1._wp ) ; CALL lbc_lnk( zsshv_a, 'V', 1._wp ) ! Boundary conditions866 ENDIF867 !868 846 ! Set advection velocity correction: 847 zwx(:,:) = un_adv(:,:) 848 zwy(:,:) = vn_adv(:,:) 869 849 IF (((kt==nit000).AND.(neuler==0)).OR.(.NOT.ln_bt_fw)) THEN 870 un_adv(:,:) = z u_sum(:,:)*hur(:,:)871 vn_adv(:,:) = z v_sum(:,:)*hvr(:,:)850 un_adv(:,:) = zwx(:,:)*hur(:,:) 851 vn_adv(:,:) = zwy(:,:)*hvr(:,:) 872 852 ELSE 873 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + z u_sum(:,:)) * hur(:,:)874 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + z v_sum(:,:)) * hvr(:,:)853 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:)) * hur(:,:) 854 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:)) * hvr(:,:) 875 855 END IF 876 856 877 857 IF (ln_bt_fw) THEN ! Save integrated transport for next computation 878 ub2_b(:,:) = z u_sum(:,:)879 vb2_b(:,:) = z v_sum(:,:)858 ub2_b(:,:) = zwx(:,:) 859 vb2_b(:,:) = zwy(:,:) 880 860 ENDIF 881 861 ! … … 887 867 END DO 888 868 ELSE 869 ! At this stage, ssha has been corrected: compute new depths at velocity points 870 DO jj = 1, jpjm1 871 DO ji = 1, jpim1 ! NO Vector Opt. 872 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 873 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 874 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 875 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 876 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 877 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 878 END DO 879 END DO 880 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 881 ! 889 882 DO jk=1,jpkm1 890 883 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b … … 905 898 #if defined key_agrif 906 899 ! Save time integrated fluxes during child grid integration 907 ! (used to update coarse grid transports) 908 ! Useless with 2nd order momentum schemes 900 ! (used to update coarse grid transports at next time step) 909 901 ! 910 902 IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN … … 926 918 ! 927 919 CALL wrk_dealloc( jpi, jpj, zsshp2_e, zhdiv ) 928 CALL wrk_dealloc( jpi, jpj, zu_trd, zv_trd , zun_e, zvn_e)929 CALL wrk_dealloc( jpi, jpj, zwx, zwy, z u_sum, zv_sum, zssh_frc, zu_frc, zv_frc )920 CALL wrk_dealloc( jpi, jpj, zu_trd, zv_trd ) 921 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc ) 930 922 CALL wrk_dealloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 931 923 CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a ) … … 1079 1071 ! 1080 1072 INTEGER :: ji ,jj 1081 INTEGER :: ios ! Local integer output status for namelist read1082 1073 REAL(wp) :: zxr2, zyr2, zcmax 1083 1074 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1084 1075 !! 1085 NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, &1086 & nn_baro, rn_bt_cmax, nn_bt_flt1087 1076 !!---------------------------------------------------------------------- 1088 1077 ! 1089 REWIND( numnam_ref ) ! Namelist namsplit in reference namelist : time splitting parameters 1090 READ ( numnam_ref, namsplit, IOSTAT = ios, ERR = 901) 1091 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in reference namelist', lwp ) 1092 1093 REWIND( numnam_cfg ) ! Namelist namsplit in configuration namelist : time splitting parameters 1094 READ ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 ) 1095 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp ) 1096 IF(lwm) WRITE ( numond, namsplit ) 1097 ! 1098 ! ! Max courant number for ext. grav. waves 1078 ! Max courant number for ext. grav. waves 1099 1079 ! 1100 1080 CALL wrk_alloc( jpi, jpj, zcu ) 1101 1081 ! 1102 IF (lk_vvl) THEN 1103 DO jj = 1, jpj 1104 DO ji =1, jpi 1105 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1106 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1107 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 1108 END DO 1109 END DO 1110 ELSE 1111 DO jj = 1, jpj 1112 DO ji =1, jpi 1113 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1114 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1115 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) ) 1116 END DO 1117 END DO 1118 ENDIF 1119 1120 zcmax = MAXVAL(zcu(:,:)) 1082 DO jj = 1, jpj 1083 DO ji =1, jpi 1084 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1085 zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 1086 zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 1087 END DO 1088 END DO 1089 ! 1090 zcmax = MAXVAL( zcu(:,:) ) 1121 1091 IF( lk_mpp ) CALL mpp_max( zcmax ) 1122 1092 1123 1093 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 1124 IF (ln_bt_ nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)1094 IF (ln_bt_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1125 1095 1126 rdtbt = rdt / FLOAT(nn_baro)1096 rdtbt = rdt / REAL( nn_baro , wp ) 1127 1097 zcmax = zcmax * rdtbt 1128 1098 ! Print results … … 1130 1100 IF(lwp) WRITE(numout,*) 'dyn_spg_ts : split-explicit free surface' 1131 1101 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 1132 IF( ln_bt_ nn_auto ) THEN1133 IF(lwp) WRITE(numout,*) ' ln_ts_ nn_auto=.true. Automatically set nn_baro '1102 IF( ln_bt_auto ) THEN 1103 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.true. Automatically set nn_baro ' 1134 1104 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1135 1105 ELSE 1136 IF(lwp) WRITE(numout,*) ' ln_ts_ nn_auto=.false.: Use nn_baro in namelist '1106 IF(lwp) WRITE(numout,*) ' ln_ts_auto=.false.: Use nn_baro in namelist ' 1137 1107 ENDIF 1138 1108 … … 1179 1149 END SUBROUTINE dyn_spg_ts_init 1180 1150 1181 #else1182 !!---------------------------------------------------------------------------1183 !! Default case : Empty module No split explicit free surface1184 !!---------------------------------------------------------------------------1185 CONTAINS1186 INTEGER FUNCTION dyn_spg_ts_alloc() ! Dummy function1187 dyn_spg_ts_alloc = 01188 END FUNCTION dyn_spg_ts_alloc1189 SUBROUTINE dyn_spg_ts( kt ) ! Empty routine1190 INTEGER, INTENT(in) :: kt1191 WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt1192 END SUBROUTINE dyn_spg_ts1193 SUBROUTINE ts_rst( kt, cdrw ) ! Empty routine1194 INTEGER , INTENT(in) :: kt ! ocean time-step1195 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag1196 WRITE(*,*) 'ts_rst : You should not have seen this print! error?', kt, cdrw1197 END SUBROUTINE ts_rst1198 SUBROUTINE dyn_spg_ts_init( kt ) ! Empty routine1199 INTEGER , INTENT(in) :: kt ! ocean time-step1200 WRITE(*,*) 'dyn_spg_ts_init : You should not have seen this print! error?', kt1201 END SUBROUTINE dyn_spg_ts_init1202 #endif1203 1204 1151 !!====================================================================== 1205 1152 END MODULE dynspg_ts 1206 1207 1208
Note: See TracChangeset
for help on using the changeset viewer.
