- Timestamp:
- 2015-12-21T12:38:26+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r6138 r6141 1 1 MODULE dynspg_ts 2 !!====================================================================== 3 !! *** MODULE dynspg_ts *** 4 !! Ocean dynamics: surface pressure gradient trend, split-explicit scheme 2 5 !!====================================================================== 3 6 !! History : 1.0 ! 2004-12 (L. Bessieres, G. Madec) Original code … … 13 16 !! 3.7 ! 2015-11 (J. Chanut) free surface simplification 14 17 !!--------------------------------------------------------------------- 18 15 19 !!---------------------------------------------------------------------- 16 !! split explicit free surface17 !! ----------------------------------------------------------------------18 !! dyn_spg_ts : compute surface pressure gradient trend using a time-19 !! splitting scheme and add to the general trend20 !! dyn_spg_ts : compute surface pressure gradient trend using a time-splitting scheme 21 !! dyn_spg_ts_init: initialisation of the time-splitting scheme 22 !! ts_wgt : set time-splitting weights for temporal averaging (or not) 23 !! ts_rst : read/write time-splitting fields in restart file 20 24 !!---------------------------------------------------------------------- 21 25 USE oce ! ocean dynamics and tracers 22 26 USE dom_oce ! ocean space and time domain 23 27 USE sbc_oce ! surface boundary condition: ocean 28 USE zdf_oce ! Bottom friction coefts 24 29 USE sbcisf ! ice shelf variable (fwfisf) 30 USE sbcapr ! surface boundary condition: atmospheric pressure 31 USE dynadv , ONLY: ln_dynadv_vec 25 32 USE phycst ! physical constants 26 33 USE dynvor ! vorticity term 34 USE wet_dry ! wetting/drying flux limter 27 35 USE bdy_par ! for lk_bdy 28 36 USE bdytides ! open boundary condition data … … 30 38 USE sbctide ! tides 31 39 USE updtide ! tide potential 40 ! 41 USE in_out_manager ! I/O manager 32 42 USE lib_mpp ! distributed memory computing library 33 43 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 34 44 USE prtctl ! Print control 35 USE in_out_manager ! I/O manager36 45 USE iom ! IOM library 37 46 USE restart ! only for lrst_oce 38 USE zdf_oce ! Bottom friction coefts39 47 USE wrk_nemo ! Memory Allocation 40 48 USE timing ! Timing 41 USE sbcapr ! surface boundary condition: atmospheric pressure 42 USE wet_dry ! wetting/drying flux limter 43 USE dynadv, ONLY: ln_dynadv_vec 49 USE diatmb ! Top,middle,bottom output 44 50 #if defined key_agrif 45 51 USE agrif_opa_interp ! agrif … … 49 55 #endif 50 56 57 51 58 IMPLICIT NONE 52 59 PRIVATE … … 60 67 REAL(wp),SAVE :: rdtbt ! Barotropic time step 61 68 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: & 63 wgtbtp1, & ! Primary weights used for time filtering of barotropic variables 64 wgtbtp2 ! Secondary weights used for time filtering of barotropic variables 65 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwz ! ff/h at F points 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne ! triad of coriolis parameter 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: wgtbtp1, wgtbtp2 !: 1st & 2nd weights used in time filtering of barotropic fields 70 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zwz !: ff/h at F points 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftnw, ftne !: triad of coriolis parameter 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse !: (only used with een vorticity scheme) 74 75 !! Time filtered arrays at baroclinic time step: 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv , vn_adv !: Advection vel. at "now" barocl. step 69 77 70 78 !! * Substitutions 71 # include "domzgr_substitute.h90"72 79 # include "vectopt_loop_substitute.h90" 73 80 !!---------------------------------------------------------------------- … … 82 89 !! *** routine dyn_spg_ts_alloc *** 83 90 !!---------------------------------------------------------------------- 84 INTEGER :: ierr( 4)91 INTEGER :: ierr(3) 85 92 !!---------------------------------------------------------------------- 86 93 ierr(:) = 0 87 88 ALLOCATE( ssha_e(jpi,jpj), sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 89 & ua_e(jpi,jpj), un_e(jpi,jpj), ub_e(jpi,jpj), ubb_e(jpi,jpj), & 90 & va_e(jpi,jpj), vn_e(jpi,jpj), vb_e(jpi,jpj), vbb_e(jpi,jpj), & 91 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT= ierr(1) ) 92 93 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 94 95 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 96 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 97 98 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_adv(jpi,jpj), vn_adv(jpi,jpj), & 99 #if defined key_agrif 100 & ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , & 101 #endif 102 & STAT= ierr(4)) 103 104 dyn_spg_ts_alloc = MAXVAL(ierr(:)) 105 94 ! 95 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) ) 96 ! 97 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 98 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(2) ) 99 ! 100 ALLOCATE( un_adv(jpi,jpj), vn_adv(jpi,jpj) , STAT=ierr(3) ) 101 ! 102 dyn_spg_ts_alloc = MAXVAL( ierr(:) ) 103 ! 106 104 IF( lk_mpp ) CALL mpp_sum( dyn_spg_ts_alloc ) 107 105 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_warn('dyn_spg_ts_alloc: failed to allocate arrays') … … 113 111 !!---------------------------------------------------------------------- 114 112 !! 115 !! ** Purpose : 116 !! -Compute the now trend due to the explicit time stepping117 !! of the quasi-linear barotropic system.113 !! ** Purpose : - Compute the now trend due to the explicit time stepping 114 !! of the quasi-linear barotropic system, and add it to the 115 !! general momentum trend. 118 116 !! 119 !! ** Method : 117 !! ** Method : - split-explicit schem (time splitting) : 120 118 !! Barotropic variables are advanced from internal time steps 121 119 !! "n" to "n+1" if ln_bt_fw=T … … 131 129 !! continuity equation taken at the baroclinic time steps. This 132 130 !! ensures tracers conservation. 133 !! - Update 3d trend (ua, va)with barotropic component.131 !! - (ua, va) momentum trend updated with barotropic component. 134 132 !! 135 !! References : Shchepetkin, A.F. and J.C. McWilliams, 2005: 136 !! The regional oceanic modeling system (ROMS): 137 !! a split-explicit, free-surface, 138 !! topography-following-coordinate oceanic model. 139 !! Ocean Modelling, 9, 347-404. 133 !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005. 140 134 !!--------------------------------------------------------------------- 141 !142 135 INTEGER, INTENT(in) :: kt ! ocean time-step index 143 136 ! … … 147 140 INTEGER :: ji, jj, jk, jn ! dummy loop indices 148 141 INTEGER :: ikbu, ikbv, noffset ! local integers 142 INTEGER :: iktu, iktv ! local integers 143 REAL(wp) :: zmdi 149 144 REAL(wp) :: zraur, z1_2dt_b, z2dt_bf ! local scalars 150 145 REAL(wp) :: zx1, zy1, zx2, zy2 ! - - … … 167 162 ! 168 163 ! !* Allocate temporary arrays 169 CALL wrk_alloc( jpi, jpj,zsshp2_e, zhdiv )170 CALL wrk_alloc( jpi, jpj,zu_trd, zv_trd)171 CALL wrk_alloc( jpi, jpj,zwx, zwy, zssh_frc, zu_frc, zv_frc)172 CALL wrk_alloc( jpi, jpj,zhup2_e, zhvp2_e, zhust_e, zhvst_e)173 CALL wrk_alloc( jpi, jpj,zsshu_a, zsshv_a )174 CALL wrk_alloc( jpi, jpj,zhf )164 CALL wrk_alloc( jpi,jpj, zsshp2_e, zhdiv ) 165 CALL wrk_alloc( jpi,jpj, zu_trd, zv_trd) 166 CALL wrk_alloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc) 167 CALL wrk_alloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 168 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a ) 169 CALL wrk_alloc( jpi,jpj, zhf ) 175 170 IF(ln_wd) CALL wrk_alloc( jpi, jpj, zcpx, zcpy, wduflt1, wdvflt1 ) 176 171 ! 172 zmdi=1.e+20 ! missing data indicator for masking 177 173 ! !* Local constant initialization 178 174 z1_12 = 1._wp / 12._wp … … 181 177 z1_2 = 0.5_wp 182 178 zraur = 1._wp / rau0 183 ! 184 IF( kt == nit000 .AND. neuler == 0 ) THEN ! reciprocal of baroclinic time step 185 z2dt_bf = rdt 186 ELSE 187 z2dt_bf = 2.0_wp * rdt 179 ! ! reciprocal of baroclinic time step 180 IF( kt == nit000 .AND. neuler == 0 ) THEN ; z2dt_bf = rdt 181 ELSE ; z2dt_bf = 2.0_wp * rdt 188 182 ENDIF 189 183 z1_2dt_b = 1.0_wp / z2dt_bf 190 184 ! 191 ll_init = ln_bt_av! if no time averaging, then no specific restart185 ll_init = ln_bt_av ! if no time averaging, then no specific restart 192 186 ll_fw_start = .FALSE. 193 ! 194 ! time offset in steps for bdy data update 195 IF (.NOT.ln_bt_fw) THEN ; noffset=-nn_baro ; ELSE ; noffset = 0 ; ENDIF 187 ! ! time offset in steps for bdy data update 188 IF( .NOT.ln_bt_fw ) THEN ; noffset = - nn_baro 189 ELSE ; noffset = 0 190 ENDIF 196 191 ! 197 192 IF( kt == nit000 ) THEN !* initialisation … … 202 197 IF(lwp) WRITE(numout,*) 203 198 ! 204 IF (neuler==0)ll_init=.TRUE.205 ! 206 IF (ln_bt_fw.OR.(neuler==0)) THEN207 ll_fw_start=.TRUE.208 noffset= 0199 IF( neuler == 0 ) ll_init=.TRUE. 200 ! 201 IF( ln_bt_fw .OR. neuler == 0 ) THEN 202 ll_fw_start =.TRUE. 203 noffset = 0 209 204 ELSE 210 ll_fw_start=.FALSE.205 ll_fw_start =.FALSE. 211 206 ENDIF 212 207 ! 213 208 ! Set averaging weights and cycle length: 214 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) 215 ! 209 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 216 210 ! 217 211 ENDIF … … 224 218 ! and update depths at T-F points (ht and zhf resp.) at each barotropic time step 225 219 ! 226 IF ( kt == nit000 .OR. lk_vvl) THEN227 IF ( ln_dynvor_een ) THEN!== EEN scheme ==!220 IF( kt == nit000 .OR. .NOT.ln_linssh ) THEN 221 IF( ln_dynvor_een ) THEN !== EEN scheme ==! 228 222 SELECT CASE( nn_een_e3f ) !* ff/e3 at F-point 229 223 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 230 224 DO jj = 1, jpjm1 231 225 DO ji = 1, jpim1 232 zwz(ji,jj) = ( ht (ji ,jj+1) + ht(ji+1,jj+1) + &233 & ht (ji ,jj ) + ht(ji+1,jj ) ) / 4._wp226 zwz(ji,jj) = ( ht_n(ji ,jj+1) + ht_n(ji+1,jj+1) + & 227 & ht_n(ji ,jj ) + ht_n(ji+1,jj ) ) * 0.25_wp 234 228 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff(ji,jj) / zwz(ji,jj) 235 229 END DO … … 238 232 DO jj = 1, jpjm1 239 233 DO ji = 1, jpim1 240 zwz(ji,jj) = ( ht (ji ,jj+1) + ht(ji+1,jj+1) + &241 & ht (ji ,jj ) + ht(ji+1,jj ) ) &234 zwz(ji,jj) = ( ht_n(ji ,jj+1) + ht_n(ji+1,jj+1) + & 235 & ht_n(ji ,jj ) + ht_n(ji+1,jj ) ) & 242 236 & / ( MAX( 1._wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 243 237 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) … … 281 275 DO jk = 1, jpkm1 282 276 DO jj = 1, jpjm1 283 zhf(:,jj) = zhf(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)277 zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 284 278 END DO 285 279 END DO … … 313 307 ! 314 308 DO jk = 1, jpkm1 315 zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)316 zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)309 zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 310 zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 317 311 END DO 318 312 ! 319 zu_frc(:,:) = zu_frc(:,:) * hur(:,:)320 zv_frc(:,:) = zv_frc(:,:) * hvr(:,:)313 zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 314 zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 321 315 ! 322 316 ! … … 332 326 ! !* barotropic Coriolis trends (vorticity scheme dependent) 333 327 ! ! -------------------------------------------------------- 334 zwx(:,:) = un_b(:,:) * hu (:,:) * e2u(:,:) ! now fluxes335 zwy(:,:) = vn_b(:,:) * hv (:,:) * e1v(:,:)328 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 329 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 336 330 ! 337 331 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN ! energy conserving or mixed scheme … … 378 372 ! !* Right-Hand-Side of the barotropic momentum equation 379 373 ! ! ---------------------------------------------------- 380 IF( lk_vvl ) THEN! Variable volume : remove surface pressure gradient374 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 381 375 IF(ln_wd) THEN ! Calculating and applying W/D gravity filters 382 376 wduflt1(:,:) = 1.0_wp … … 444 438 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 445 439 DO ji = fs_2, fs_jpim1 446 zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * umask(ji,jj,1)447 zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * vmask(ji,jj,1)448 END DO449 END DO 440 zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 441 zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) 442 END DO 443 END DO 450 444 ! 451 445 ! ! Add bottom stress contribution from baroclinic velocities: … … 472 466 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 473 467 IF(ln_wd) THEN 474 zu_frc(:,:) = zu_frc(:,:) + MAX( hur(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:)475 zv_frc(:,:) = zv_frc(:,:) + MAX( hvr(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:)468 zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 469 zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 476 470 ELSE 477 zu_frc(:,:) = zu_frc(:,:) + hur(:,:) * bfrua(:,:) * zwx(:,:)478 zv_frc(:,:) = zv_frc(:,:) + hvr(:,:) * bfrva(:,:) * zwy(:,:)471 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 472 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 479 473 END IF 480 474 ! 475 ! ! Add top stress contribution from baroclinic velocities: 476 IF (ln_bt_fw) THEN 477 DO jj = 2, jpjm1 478 DO ji = fs_2, fs_jpim1 ! vector opt. 479 iktu = miku(ji,jj) 480 iktv = mikv(ji,jj) 481 zwx(ji,jj) = un(ji,jj,iktu) - un_b(ji,jj) ! NOW top baroclinic velocities 482 zwy(ji,jj) = vn(ji,jj,iktv) - vn_b(ji,jj) 483 END DO 484 END DO 485 ELSE 486 DO jj = 2, jpjm1 487 DO ji = fs_2, fs_jpim1 ! vector opt. 488 iktu = miku(ji,jj) 489 iktv = mikv(ji,jj) 490 zwx(ji,jj) = ub(ji,jj,iktu) - ub_b(ji,jj) ! BEFORE top baroclinic velocities 491 zwy(ji,jj) = vb(ji,jj,iktv) - vb_b(ji,jj) 492 END DO 493 END DO 494 ENDIF 495 ! 496 ! Note that the "unclipped" top friction parameter is used even with explicit drag 497 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 498 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 499 ! 481 500 IF (ln_bt_fw) THEN ! Add wind forcing 482 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * hur(:,:)483 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * hvr(:,:)501 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 502 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 484 503 ELSE 485 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * hur(:,:)486 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * hvr(:,:)504 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 505 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 487 506 ENDIF 488 507 ! … … 555 574 ! 556 575 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 557 sshn_e(:,:) = sshn(:,:)558 un_e (:,:) = un_b(:,:)559 vn_e (:,:) = vn_b(:,:)560 ! 561 hu_e (:,:) = hu(:,:)562 hv_e (:,:) = hv(:,:)563 hur_e (:,:) = hur(:,:)564 hvr_e (:,:) = hvr(:,:)576 sshn_e(:,:) = sshn(:,:) 577 un_e (:,:) = un_b(:,:) 578 vn_e (:,:) = vn_b(:,:) 579 ! 580 hu_e (:,:) = hu_n(:,:) 581 hv_e (:,:) = hv_n(:,:) 582 hur_e (:,:) = r1_hu_n(:,:) 583 hvr_e (:,:) = r1_hv_n(:,:) 565 584 ELSE ! CENTRED integration: start from BEFORE fields 566 sshn_e(:,:) = sshb(:,:)567 un_e (:,:) = ub_b(:,:)568 vn_e (:,:) = vb_b(:,:)569 ! 570 hu_e (:,:) = hu_b(:,:)571 hv_e (:,:) = hv_b(:,:)572 hur_e (:,:) = hur_b(:,:)573 hvr_e (:,:) = hvr_b(:,:)585 sshn_e(:,:) = sshb(:,:) 586 un_e (:,:) = ub_b(:,:) 587 vn_e (:,:) = vb_b(:,:) 588 ! 589 hu_e (:,:) = hu_b(:,:) 590 hv_e (:,:) = hv_b(:,:) 591 hur_e (:,:) = r1_hu_b(:,:) 592 hvr_e (:,:) = r1_hv_b(:,:) 574 593 ENDIF 575 594 ! … … 589 608 ! Update only tidal forcing at open boundaries 590 609 #if defined key_tide 591 IF ( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset=(noffset+1))592 IF ( ln_tide_pot .AND. lk_tide ) CALL upd_tide( kt, kit=jn, time_offset=noffset)610 IF( lk_bdy .AND. lk_tide ) CALL bdy_dta_tides( kt, kit=jn, time_offset= noffset+1 ) 611 IF( ln_tide_pot .AND. lk_tide ) CALL upd_tide ( kt, kit=jn, time_offset= noffset ) 593 612 #endif 594 613 ! … … 608 627 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 609 628 610 IF( lk_vvl ) THEN!* Update ocean depth (variable volume case only)629 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 611 630 ! ! ------------------ 612 631 ! Extrapolate Sea Level at step jit+0.5: … … 615 634 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 616 635 DO ji = 2, fs_jpim1 ! Vector opt. 617 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) &636 zwx(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 618 637 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 619 638 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 620 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) &639 zwy(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 621 640 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 622 641 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) … … 632 651 END IF 633 652 ELSE 634 zhup2_e (:,:) = hu (:,:)635 zhvp2_e (:,:) = hv (:,:)653 zhup2_e (:,:) = hu_n(:,:) 654 zhvp2_e (:,:) = hv_n(:,:) 636 655 ENDIF 637 656 ! !* after ssh … … 644 663 ! 645 664 #if defined key_agrif 646 ! Set fluxes during predictor step to ensure 647 ! volume conservation 648 IF( (.NOT.Agrif_Root()).AND.ln_bt_fw ) THEN 665 ! Set fluxes during predictor step to ensure volume conservation 666 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 649 667 IF((nbondi == -1).OR.(nbondi == 2)) THEN 650 668 DO jj=1,jpj … … 683 701 END DO 684 702 END DO 685 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * tmask(:,:,1)703 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 686 704 IF(ln_wd) ssha_e(:,:) = MAX(ssha_e(:,:), rn_wdmin1 - bathy(:,:)) 687 705 CALL lbc_lnk( ssha_e, 'T', 1._wp ) 688 706 689 707 #if defined key_bdy 690 ! Duplicate sea level across open boundaries (this is only cosmetic if l k_vvl=.false.)691 IF (lk_bdy)CALL bdy_ssh( ssha_e )708 ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 709 IF( lk_bdy ) CALL bdy_ssh( ssha_e ) 692 710 #endif 693 711 #if defined key_agrif 694 IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn )712 IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn ) 695 713 #endif 696 714 ! 697 715 ! Sea Surface Height at u-,v-points (vvl case only) 698 IF ( lk_vvl) THEN716 IF( .NOT.ln_linssh ) THEN 699 717 DO jj = 2, jpjm1 700 718 DO ji = 2, jpim1 ! NO Vector Opt. 701 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj)&702 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) &703 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) )704 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj)&705 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) &706 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) )719 zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 720 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 721 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 722 zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 723 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 724 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 707 725 END DO 708 726 END DO … … 728 746 za3=0.013_wp ! za3 = eps 729 747 ENDIF 730 748 ! 731 749 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 732 750 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 733 734 751 IF(ln_wd) THEN ! Calculating and applying W/D gravity filters 735 752 wduflt1(:,:) = 1._wp … … 774 791 ! 775 792 ! Compute associated depths at U and V points: 776 IF ( lk_vvl.AND.(.NOT.ln_dynadv_vec) ) THEN793 IF( .NOT.ln_linssh .AND. .NOT.ln_dynadv_vec ) THEN !* Vector form 777 794 ! 778 795 DO jj = 2, jpjm1 779 796 DO ji = 2, jpim1 780 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1e2u(ji ,jj) &797 zx1 = z1_2 * ssumask(ji ,jj) * r1_e1e2u(ji ,jj) & 781 798 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 782 799 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 783 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1e2v(ji ,jj ) &800 zy1 = z1_2 * ssvmask(ji ,jj) * r1_e1e2v(ji ,jj ) & 784 801 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 785 802 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) … … 798 815 ! 799 816 ! Add Coriolis trend: 800 ! zwz array below or triads normally depend on sea level with key_vvland should be updated817 ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated 801 818 ! at each time step. We however keep them constant here for optimization. 802 819 ! Recall that zwx and zwy arrays hold fluxes at this stage: … … 804 821 ! zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 805 822 ! 806 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN 823 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN !== energy conserving or mixed scheme ==! 807 824 DO jj = 2, jpjm1 808 825 DO ji = fs_2, fs_jpim1 ! vector opt. … … 816 833 END DO 817 834 ! 818 ELSEIF ( ln_dynvor_ens ) THEN 835 ELSEIF ( ln_dynvor_ens ) THEN !== enstrophy conserving scheme ==! 819 836 DO jj = 2, jpjm1 820 837 DO ji = fs_2, fs_jpim1 ! vector opt. … … 828 845 END DO 829 846 ! 830 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==!847 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 831 848 DO jj = 2, jpjm1 832 849 DO ji = fs_2, fs_jpim1 ! vector opt. … … 859 876 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 860 877 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 878 ! 879 ! Add top stresses: 880 zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 881 zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 861 882 ! 862 883 ! Surface pressure trend: … … 886 907 ! 887 908 ! Set next velocities: 888 IF( ln_dynadv_vec .OR. (.NOT. lk_vvl) ) THEN !Vector form909 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 889 910 DO jj = 2, jpjm1 890 911 DO ji = fs_2, fs_jpim1 ! vector opt. … … 893 914 & + zu_trd(ji,jj) & 894 915 & + zu_frc(ji,jj) ) & 895 & ) * umask(ji,jj,1)916 & ) * ssumask(ji,jj) 896 917 897 918 va_e(ji,jj) = ( vn_e(ji,jj) & … … 899 920 & + zv_trd(ji,jj) & 900 921 & + zv_frc(ji,jj) ) & 901 & ) * vmask(ji,jj,1)902 END DO 903 END DO 904 905 ELSE !Flux form922 & ) * ssvmask(ji,jj) 923 END DO 924 END DO 925 ! 926 ELSE !* Flux form 906 927 DO jj = 2, jpjm1 907 928 DO ji = fs_2, fs_jpim1 ! vector opt. 929 zhura = ssumask(ji,jj)/(hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj)) 930 zhvra = ssvmask(ji,jj)/(hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj)) 908 931 909 932 IF(ln_wd) THEN … … 914 937 zhvra = hv_0(ji,jj) + zsshv_a(ji,jj) 915 938 END IF 916 917 939 zhura = umask(ji,jj,1)/(zhura + 1._wp - umask(ji,jj,1)) 918 940 zhvra = vmask(ji,jj,1)/(zhvra + 1._wp - vmask(ji,jj,1)) … … 921 943 & + rdtbt * ( zhust_e(ji,jj) * zwx(ji,jj) & 922 944 & + zhup2_e(ji,jj) * zu_trd(ji,jj) & 923 & + hu(ji,jj) * zu_frc(ji,jj) ) &945 & + hu_n(ji,jj) * zu_frc(ji,jj) ) & 924 946 & ) * zhura 925 947 … … 927 949 & + rdtbt * ( zhvst_e(ji,jj) * zwy(ji,jj) & 928 950 & + zhvp2_e(ji,jj) * zv_trd(ji,jj) & 929 & + hv(ji,jj) * zv_frc(ji,jj) ) &951 & + hv_n(ji,jj) * zv_frc(ji,jj) ) & 930 952 & ) * zhvra 931 953 END DO … … 933 955 ENDIF 934 956 ! 935 IF( lk_vvl ) THEN !* Update ocean depth (variable volume case only) 936 ! ! ---------------------------------------------- 957 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 937 958 IF(ln_wd) THEN 938 959 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) … … 942 963 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 943 964 END IF 944 945 hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1._wp - umask(:,:,1) ) 946 hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1._wp - vmask(:,:,1) ) 965 hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 966 hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 947 967 ! 948 968 ENDIF 949 ! !* domain lateral boundary 950 ! ! ----------------------- 951 ! 969 ! !* domain lateral boundary 952 970 CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 953 971 ! 954 972 #if defined key_bdy 955 956 IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )973 ! ! open boundaries 974 IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 957 975 #endif 958 976 #if defined key_agrif … … 976 994 ! ! ---------------------- 977 995 za1 = wgtbtp1(jn) 978 IF (( ln_dynadv_vec ).OR. (.NOT. lk_vvl)) THEN ! Sum velocities996 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 979 997 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) 980 998 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) 981 ELSE 999 ELSE ! Sum transports 982 1000 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) * hu_e (:,:) 983 1001 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) * hv_e (:,:) … … 995 1013 zwx(:,:) = un_adv(:,:) 996 1014 zwy(:,:) = vn_adv(:,:) 997 IF (((kt==nit000).AND.(neuler==0)).OR.(.NOT.ln_bt_fw)) THEN998 un_adv(:,:) = zwx(:,:) *hur(:,:)999 vn_adv(:,:) = zwy(:,:) *hvr(:,:)1015 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 1016 un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 1017 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 1000 1018 ELSE 1001 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * hur(:,:)1002 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * hvr(:,:)1019 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 1020 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 1003 1021 END IF 1004 1022 1005 IF (ln_bt_fw) THEN ! Save integrated transport for next computation1023 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 1006 1024 ub2_b(:,:) = zwx(:,:) 1007 1025 vb2_b(:,:) = zwy(:,:) … … 1009 1027 ! 1010 1028 ! Update barotropic trend: 1011 IF (( ln_dynadv_vec ).OR. (.NOT. lk_vvl)) THEN1029 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1012 1030 DO jk=1,jpkm1 1013 1031 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b … … 1029 1047 ! 1030 1048 DO jk=1,jpkm1 1031 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b1032 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b1049 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 1050 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 1033 1051 END DO 1034 1052 ! Save barotropic velocities not transport: 1035 ua_b (:,:) = ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - umask(:,:,1) )1036 va_b (:,:) = va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - vmask(:,:,1) )1053 ua_b(:,:) = ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 1054 va_b(:,:) = va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 1037 1055 ENDIF 1038 1056 ! 1039 1057 DO jk = 1, jpkm1 1040 1058 ! Correct velocities: 1041 un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) *umask(:,:,jk)1042 vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) *vmask(:,:,jk)1059 un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 1060 vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 1043 1061 ! 1044 1062 END DO 1063 ! 1064 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current 1065 CALL iom_put( "vbar", vn_adv(:,:) ) ! barotropic i-current 1045 1066 ! 1046 1067 #if defined key_agrif … … 1048 1069 ! (used to update coarse grid transports at next time step) 1049 1070 ! 1050 IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw)) THEN1051 IF ( Agrif_NbStepint().EQ.0 ) THEN1052 ub2_i_b(:,:) = 0. e01053 vb2_i_b(:,:) = 0. e01071 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 1072 IF( Agrif_NbStepint() == 0 ) THEN 1073 ub2_i_b(:,:) = 0._wp 1074 vb2_i_b(:,:) = 0._wp 1054 1075 END IF 1055 1076 ! … … 1058 1079 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 1059 1080 ENDIF 1060 !1061 !1062 1081 #endif 1063 !1064 1082 ! !* write time-spliting arrays in the restart 1065 IF( lrst_oce .AND.ln_bt_fw) CALL ts_rst( kt, 'WRITE' )1066 ! 1067 CALL wrk_dealloc( jpi, jpj,zsshp2_e, zhdiv )1068 CALL wrk_dealloc( jpi, jpj,zu_trd, zv_trd )1069 CALL wrk_dealloc( jpi, jpj,zwx, zwy, zssh_frc, zu_frc, zv_frc )1070 CALL wrk_dealloc( jpi, jpj,zhup2_e, zhvp2_e, zhust_e, zhvst_e )1071 CALL wrk_dealloc( jpi, jpj,zsshu_a, zsshv_a )1072 CALL wrk_dealloc( jpi, jpj,zhf )1083 IF( lrst_oce .AND.ln_bt_fw ) CALL ts_rst( kt, 'WRITE' ) 1084 ! 1085 CALL wrk_dealloc( jpi,jpj, zsshp2_e, zhdiv ) 1086 CALL wrk_dealloc( jpi,jpj, zu_trd, zv_trd ) 1087 CALL wrk_dealloc( jpi,jpj, zwx, zwy, zssh_frc, zu_frc, zv_frc ) 1088 CALL wrk_dealloc( jpi,jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 1089 CALL wrk_dealloc( jpi,jpj, zsshu_a, zsshv_a ) 1090 CALL wrk_dealloc( jpi,jpj, zhf ) 1073 1091 IF(ln_wd) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy, wduflt1, wdvflt1 ) 1074 1092 ! 1093 IF ( ln_diatmb ) THEN 1094 CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) ) ! Barotropic U Velocity 1095 CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) ) ! Barotropic V Velocity 1096 ENDIF 1075 1097 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') 1076 1098 ! 1077 1099 END SUBROUTINE dyn_spg_ts 1100 1078 1101 1079 1102 SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) … … 1154 1177 END SUBROUTINE ts_wgt 1155 1178 1179 1156 1180 SUBROUTINE ts_rst( kt, cdrw ) 1157 1181 !!--------------------------------------------------------------------- … … 1207 1231 END SUBROUTINE ts_rst 1208 1232 1209 SUBROUTINE dyn_spg_ts_init( kt ) 1233 1234 SUBROUTINE dyn_spg_ts_init 1210 1235 !!--------------------------------------------------------------------- 1211 1236 !! *** ROUTINE dyn_spg_ts_init *** … … 1213 1238 !! ** Purpose : Set time splitting options 1214 1239 !!---------------------------------------------------------------------- 1215 INTEGER , INTENT(in) :: kt ! ocean time-step 1216 ! 1217 INTEGER :: ji ,jj 1218 REAL(wp) :: zxr2, zyr2, zcmax 1219 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1220 !! 1240 INTEGER :: ji ,jj ! dummy loop indices 1241 REAL(wp) :: zxr2, zyr2, zcmax ! local scalar 1242 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1221 1243 !!---------------------------------------------------------------------- 1222 1244 ! 1223 1245 ! Max courant number for ext. grav. waves 1224 1246 ! 1225 CALL wrk_alloc( jpi, jpj,zcu )1247 CALL wrk_alloc( jpi,jpj, zcu ) 1226 1248 ! 1227 1249 DO jj = 1, jpj … … 1237 1259 1238 1260 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 1239 IF (ln_bt_auto)nn_baro = CEILING( rdt / rn_bt_cmax * zcmax)1261 IF( ln_bt_auto ) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1240 1262 1241 1263 rdtbt = rdt / REAL( nn_baro , wp ) … … 1267 1289 #if defined key_agrif 1268 1290 ! Restrict the use of Agrif to the forward case only 1269 IF ((.NOT.ln_bt_fw ).AND.(.NOT.Agrif_Root()))CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' )1291 IF( .NOT.ln_bt_fw .AND. .NOT.Agrif_Root() ) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 1270 1292 #endif 1271 1293 ! 1272 1294 IF(lwp) WRITE(numout,*) ' Time filter choice, nn_bt_flt: ', nn_bt_flt 1273 1295 SELECT CASE ( nn_bt_flt ) 1274 CASE( 0 ); IF(lwp) WRITE(numout,*) ' Dirac'1275 CASE( 1 ); IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro'1276 CASE( 2 ); IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro'1277 1296 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac' 1297 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro' 1298 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro' 1299 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 1278 1300 END SELECT 1279 1301 ! … … 1283 1305 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1284 1306 ! 1285 IF ((.NOT.ln_bt_av).AND.(.NOT.ln_bt_fw)) THEN1307 IF( .NOT.ln_bt_av .AND. .NOT.ln_bt_fw ) THEN 1286 1308 CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) 1287 1309 ENDIF 1288 IF 1310 IF( zcmax>0.9_wp ) THEN 1289 1311 CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' ) 1290 1312 ENDIF 1291 1313 ! 1292 CALL wrk_dealloc( jpi, jpj,zcu )1314 CALL wrk_dealloc( jpi,jpj, zcu ) 1293 1315 ! 1294 1316 END SUBROUTINE dyn_spg_ts_init
Note: See TracChangeset
for help on using the changeset viewer.
