Changeset 4370 for branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN
- Timestamp:
- 2014-01-23T18:13:16+01:00 (10 years ago)
- Location:
- branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r4354 r4370 39 39 USE wrk_nemo ! Memory Allocation 40 40 USE prtctl ! Print control 41 USE dynspg_ts ! Barotropic velocities42 41 43 42 #if defined key_agrif … … 102 101 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 103 102 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 104 REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva , zhura, zhvra, zhurb, zhvrb103 REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva 105 104 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f 106 105 !!---------------------------------------------------------------------- … … 109 108 ! 110 109 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 111 IF ( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zua, zva , zhura, zhvra)110 IF ( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zua, zva ) 112 111 ! 113 112 IF( kt == nit000 ) THEN … … 157 156 zua(:,:) = 0._wp 158 157 zva(:,:) = 0._wp 159 IF (lk_vvl) THEN 160 zhura(:,:) = 0._wp 161 zhvra(:,:) = 0._wp 162 DO jk = 1, jpkm1 163 zua(:,:) = zua(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 164 zva(:,:) = zva(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 165 zhura(:,:) = zhura(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 166 zhvra(:,:) = zhvra(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 167 END DO 168 zhura(:,:) = umask(:,:,1) / ( zhura(:,:) + 1._wp - umask(:,:,1) ) 169 zhvra(:,:) = vmask(:,:,1) / ( zhvra(:,:) + 1._wp - vmask(:,:,1) ) 170 DO jk = 1, jpkm1 171 ua(:,:,jk) = ( ua(:,:,jk) - zua(:,:) * zhura(:,:) + ua_b(:,:) ) * umask(:,:,jk) 172 va(:,:,jk) = ( va(:,:,jk) - zva(:,:) * zhvra(:,:) + va_b(:,:) ) * vmask(:,:,jk) 173 END DO 174 ELSE 175 DO jk = 1, jpkm1 176 zua(:,:) = zua(:,:) + fse3u(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 177 zva(:,:) = zva(:,:) + fse3v(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 178 END DO 179 DO jk = 1, jpkm1 180 ua(:,:,jk) = ( ua(:,:,jk) - zua(:,:) * hur(:,:) + ua_b(:,:) ) *umask(:,:,jk) 181 va(:,:,jk) = ( va(:,:,jk) - zva(:,:) * hvr(:,:) + va_b(:,:) ) *vmask(:,:,jk) 182 END DO 183 ENDIF 158 DO jk = 1, jpkm1 159 zua(:,:) = zua(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 160 zva(:,:) = zva(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 161 END DO 162 DO jk = 1, jpkm1 163 ua(:,:,jk) = ( ua(:,:,jk) - zua(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 164 va(:,:,jk) = ( va(:,:,jk) - zva(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 165 END DO 184 166 185 167 IF (lk_dynspg_ts.AND.(.NOT.ln_bt_fw)) THEN … … 321 303 zua(:,:) = 0._wp 322 304 zva(:,:) = 0._wp 323 IF (lk_vvl) THEN 324 DO jk = 1, jpkm1 325 zua(:,:) = zua(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 326 zva(:,:) = zva(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 327 END DO 328 ELSE 329 DO jk = 1, jpkm1 330 zua(:,:) = zua(:,:) + fse3u(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 331 zva(:,:) = zva(:,:) + fse3v(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 332 END DO 333 ENDIF 305 DO jk = 1, jpkm1 306 zua(:,:) = zua(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 307 zva(:,:) = zva(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 308 END DO 334 309 DO jk = 1, jpkm1 335 310 ub(:,:,jk) = ub(:,:,jk) - (zua(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk) … … 344 319 ! integration 345 320 ! 346 IF (lk_vvl) THEN347 CALL wrk_alloc( jpi, jpj, zhurb, zhvrb )348 zhurb(:,:) = 0._wp349 zhvrb(:,:) = 0._wp350 DO jk = 1, jpk 351 zhurb(:,:) = zhurb(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)352 zhvrb(:,:) = zhvrb(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)353 END DO 354 zhurb(:,:) = umask(:,:,1) / ( zhurb(:,:) + 1._wp- umask(:,:,1) )355 zhvrb(:,:) = vmask(:,:,1) / ( zhvrb(:,:) + 1._wp- vmask(:,:,1) )321 ! 322 IF (lk_vvl) THEN 323 hu_b(:,:) = 0. 324 hv_b(:,:) = 0. 325 DO jk = 1, jpkm1 326 hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 327 hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 328 END DO 329 hur_b(:,:) = umask(:,:,1) / ( hu_b(:,:) + 1. - umask(:,:,1) ) 330 hvr_b(:,:) = vmask(:,:,1) / ( hv_b(:,:) + 1. - vmask(:,:,1) ) 356 331 ENDIF 357 332 ! … … 367 342 DO ji = 1, jpi 368 343 #endif 369 un_b(ji,jj) = un_b(ji,jj) + fse3u_ n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)370 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_ n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)344 un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 345 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 371 346 ! 372 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 373 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 347 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 348 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 374 349 END DO 375 350 END DO 376 351 END DO 377 352 ! 378 un_b(:,:) = un_b(:,:) * hur(:,:) 379 vn_b(:,:) = vn_b(:,:) * hvr(:,:) 380 ! 381 IF( lk_vvl ) THEN 382 ub_b(:,:) = ub_b(:,:) * zhurb(:,:) 383 vb_b(:,:) = vb_b(:,:) * zhvrb(:,:) 384 ELSE 385 ub_b(:,:) = ub_b(:,:) * hur(:,:) 386 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 387 ENDIF 388 ! 389 IF (lk_vvl) CALL wrk_dealloc( jpi, jpj, zhurb, zhvrb ) 353 ! 354 un_b(:,:) = un_b(:,:) * hur_a(:,:) 355 vn_b(:,:) = vn_b(:,:) * hvr_a(:,:) 356 ub_b(:,:) = ub_b(:,:) * hur_b(:,:) 357 vb_b(:,:) = vb_b(:,:) * hvr_b(:,:) 358 ! 390 359 ! 391 360 IF(ln_ctl) CALL prt_ctl( tab3d_1=un, clinfo1=' nxt - Un: ', mask1=umask, & … … 393 362 ! 394 363 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 395 IF ( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zua, zva , zhura, zhvra)364 IF ( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zua, zva ) 396 365 ! 397 366 IF( nn_timing == 1 ) CALL timing_stop('dyn_nxt') -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r4354 r4370 34 34 35 35 ! !!! Time splitting scheme (key_dynspg_ts) 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_e, ssha_e ! sea surface heigth (now, after, average) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_b ! before field without time-filter 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b, vb2_b ! Advection vel. at "now-0.5" barocl. step 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e ! sea surface heigth (now, after) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b, vb2_b ! Advection vel. at "now-0.5" barocl. step 43 42 44 43 !!---------------------------------------------------------------------- … … 56 55 & ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) , & 57 56 & ub2_b(jpi,jpj) , vb2_b(jpi,jpj) , & 58 & un_adv(jpi,jpj) , vn_adv(jpi,jpj) , & 59 & sshn_b(jpi,jpj) , STAT = dynspg_oce_alloc ) 57 & un_adv(jpi,jpj) , vn_adv(jpi,jpj) , STAT = dynspg_oce_alloc ) 60 58 ! 61 59 IF( lk_mpp ) CALL mpp_sum ( dynspg_oce_alloc ) -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4354 r4370 14 14 #if defined key_dynspg_ts || defined key_esopa 15 15 !!---------------------------------------------------------------------- 16 !! 'key_dynspg_ts' free surface cst volume with time splitting16 !! 'key_dynspg_ts' split explicit free surface 17 17 !!---------------------------------------------------------------------- 18 18 !! dyn_spg_ts : compute surface pressure gradient trend using a time- … … 55 55 PUBLIC dyn_spg_ts_init ! " " " " 56 56 57 ! Potential namelist parameters below to be read in dyn_spg_ts_init58 LOGICAL, PUBLIC, PARAMETER :: ln_bt_fw=.TRUE. !: Forward integration of barotropic sub-stepping59 LOGICAL, PRIVATE, PARAMETER :: ln_bt_av=.TRUE. !: Time averaging of barotropic variables60 LOGICAL, PRIVATE, PARAMETER :: ln_bt_nn_auto=.FALSE. !: Set number of iterations automatically61 INTEGER, PRIVATE, PARAMETER :: nn_bt_flt=1 !: Filter choice62 REAL(wp), PRIVATE, PARAMETER :: rn_bt_cmax=0.8_wp !: Max. courant number (used if ln_bt_nn_auto=T)63 ! End namelist parameters64 65 57 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 66 58 REAL(wp),SAVE :: rdtbt ! Barotropic time step … … 160 152 REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum, zwx, zwy, zhdiv 161 153 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 162 REAL(wp), POINTER, DIMENSION(:,:) :: zhur_b, zhvr_b163 154 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 164 REAL(wp), POINTER, DIMENSION(:,:) :: zh t, zhf155 REAL(wp), POINTER, DIMENSION(:,:) :: zhf 165 156 !!---------------------------------------------------------------------- 166 157 ! … … 172 163 CALL wrk_alloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 173 164 CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 174 CALL wrk_alloc( jpi, jpj, zhur_b, zhvr_b )175 165 CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a ) 176 CALL wrk_alloc( jpi, jpj, zh t, zhf )166 CALL wrk_alloc( jpi, jpj, zhf ) 177 167 ! 178 168 ! !* Local constant initialization … … 228 218 IF ( kt == nit000 .OR. lk_vvl ) THEN 229 219 IF ( ln_dynvor_een ) THEN 230 ! JC: Simplification needed below: define ht_0 even when volume is fixed231 IF (lk_vvl) THEN232 zht(:,:) = (ht_0(:,:) + sshn(:,:)) * tmask(:,:,1)233 ELSE234 zht(:,:) = 0.235 DO jk = 1, jpkm1236 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)237 END DO238 ENDIF239 240 220 DO jj = 1, jpjm1 241 221 DO ji = 1, jpim1 242 zwz(ji,jj) = ( zht(ji ,jj+1) + zht(ji+1,jj+1) + &243 & zht(ji ,jj ) + zht(ji+1,jj ) ) &222 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 223 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 244 224 & / ( MAX( 1.0_wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 245 225 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) … … 261 241 ELSE 262 242 zwz(:,:) = 0._wp 263 zh t(:,:) = 0.243 zhf(:,:) = 0. 264 244 IF ( .not. ln_sco ) THEN 265 245 ! IF( rn_hmin < 0._wp ) THEN ; jk = - INT( rn_hmin ) ! from a nb of level 266 246 ! ELSE ; jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 ) ! from a depth 267 247 ! ENDIF 268 ! zh t(:,:) = gdepw_0(:,:,jk+1)248 ! zhf(:,:) = gdepw_0(:,:,jk+1) 269 249 ELSE 270 zh t(:,:) = hbatf(:,:)250 zhf(:,:) = hbatf(:,:) 271 251 END IF 272 252 273 253 DO jj = 1, jpjm1 274 zh t(:,jj) = zht(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1))254 zhf(:,jj) = zhf(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 275 255 END DO 276 256 277 257 DO jk = 1, jpkm1 278 258 DO jj = 1, jpjm1 279 zh t(:,jj) = zht(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)280 END DO 281 END DO 282 CALL lbc_lnk( zh t, 'F', 1._wp )259 zhf(:,jj) = zhf(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 260 END DO 261 END DO 262 CALL lbc_lnk( zhf, 'F', 1._wp ) 283 263 ! JC: TBC. hf should be greater than 0 284 264 DO jj = 1, jpj 285 265 DO ji = 1, jpi 286 IF( zh t(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zht(ji,jj) ! zhtis actually hf here but it saves an array266 IF( zhf(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zhf(ji,jj) ! zhf is actually hf here but it saves an array 287 267 END DO 288 268 END DO … … 296 276 ll_fw_start=.FALSE. 297 277 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) 298 ENDIF299 300 ! before inverse water column height at u- and v- points301 IF( lk_vvl ) THEN302 zhur_b(:,:) = 0.303 zhvr_b(:,:) = 0.304 DO jk = 1, jpk305 zhur_b(:,:) = zhur_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)306 zhvr_b(:,:) = zhvr_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)307 END DO308 zhur_b(:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1. - umask(:,:,1) )309 zhvr_b(:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1. - vmask(:,:,1) )310 ELSE311 zhur_b(:,:) = hur(:,:)312 zhvr_b(:,:) = hvr(:,:)313 278 ENDIF 314 279 … … 331 296 DO ji = 1, jpi 332 297 #endif 333 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u (ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk)334 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v (ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)298 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 299 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 335 300 END DO 336 301 END DO … … 492 457 ! ! Initialisations ! 493 458 ! ! ==================== ! 494 ! Initialize barotropic variables: 495 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 496 sshn_e (:,:) = sshn (:,:) 497 zun_e (:,:) = un_b (:,:) 498 zvn_e (:,:) = vn_b (:,:) 499 ELSE ! CENTRED integration: start from BEFORE fields 500 sshn_e (:,:) = sshb (:,:) 501 zun_e (:,:) = ub_b (:,:) 502 zvn_e (:,:) = vb_b (:,:) 503 ENDIF 504 ! 505 ! Initialize depths: 506 IF ( lk_vvl.AND.(.NOT.ln_bt_fw) ) THEN 507 hu_e (:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) ) 508 hv_e (:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) ) 509 hur_e (:,:) = zhur_b(:,:) 510 hvr_e (:,:) = zhvr_b(:,:) 511 ELSE 459 ! Initialize barotropic variables: 460 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 461 sshn_e(:,:) = sshn (:,:) 462 zun_e (:,:) = un_b (:,:) 463 zvn_e (:,:) = vn_b (:,:) 464 ! 512 465 hu_e (:,:) = hu (:,:) 513 466 hv_e (:,:) = hv (:,:) 514 467 hur_e (:,:) = hur (:,:) 515 468 hvr_e (:,:) = hvr (:,:) 516 ENDIF 517 ! 518 IF (.NOT.lk_vvl) THEN ! Depths at jn+0.5: 519 zhup2_e (:,:) = hu(:,:) 520 zhvp2_e (:,:) = hv(:,:) 521 ENDIF 469 ELSE ! CENTRED integration: start from BEFORE fields 470 sshn_e(:,:) = sshb (:,:) 471 zun_e (:,:) = ub_b (:,:) 472 zvn_e (:,:) = vb_b (:,:) 473 ! 474 hu_e (:,:) = hu_b (:,:) 475 hv_e (:,:) = hv_b (:,:) 476 hur_e (:,:) = hur_b(:,:) 477 hvr_e (:,:) = hvr_b(:,:) 478 ENDIF 479 ! 480 ! 522 481 ! 523 482 ! Initialize sums: … … 560 519 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 561 520 DO ji = 2, fs_jpim1 ! Vector opt. 562 zwx(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )&563 & * ( e1 t(ji ,jj) * e2t(ji ,jj) * zsshp2_e(ji ,jj) &564 & + e1 t(ji+1,jj) * e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )565 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )&566 & * ( e1 t(ji,jj ) * e2t(ji,jj ) * zsshp2_e(ji,jj ) &567 & + e1 t(ji,jj+1) * e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )521 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 522 & * ( e12t(ji ,jj) * zsshp2_e(ji ,jj) & 523 & + e12t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 524 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 525 & * ( e12t(ji,jj ) * zsshp2_e(ji,jj ) & 526 & + e12t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 568 527 END DO 569 528 END DO … … 572 531 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 573 532 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 533 ELSE 534 zhup2_e (:,:) = hu(:,:) 535 zhvp2_e (:,:) = hv(:,:) 574 536 ENDIF 575 537 ! !* after ssh … … 583 545 DO ji = fs_2, fs_jpim1 ! vector opt. 584 546 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 585 & + zwy(ji,jj) - zwy(ji,jj-1) & 586 & ) / ( e1t(ji,jj) * e2t(ji,jj) ) 547 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e12t(ji,jj) 587 548 END DO 588 549 END DO … … 609 570 DO jj = 2, jpjm1 610 571 DO ji = 2, jpim1 ! NO Vector Opt. 611 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) )&612 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha_e(ji ,jj) &613 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha_e(ji+1,jj) )614 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) )&615 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha_e(ji,jj ) &616 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha_e(ji,jj+1) )572 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 573 & * ( e12t(ji ,jj ) * ssha_e(ji ,jj ) & 574 & + e12t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 575 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 576 & * ( e12t(ji ,jj ) * ssha_e(ji ,jj ) & 577 & + e12t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 617 578 END DO 618 579 END DO … … 648 609 DO jj = 2, jpjm1 649 610 DO ji = 2, jpim1 650 zx1 = z1_2 * umask(ji ,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )&651 & * ( e1t(ji ,jj) * e2t(ji ,jj) * zsshp2_e(ji ,jj)&652 & + e1t(ji+1,jj) * e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )653 zy1 = z1_2 * vmask(ji ,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )&654 & * ( e1 t(ji,jj ) * e2t(ji,jj ) * zsshp2_e(ji,jj ) &655 & + e1 t(ji,jj+1) * e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )611 zx1 = z1_2 * umask(ji ,jj,1) * r1_e12u(ji ,jj) & 612 & * ( e12t(ji ,jj ) * zsshp2_e(ji ,jj) & 613 & + e12t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 614 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e12v(ji ,jj ) & 615 & * ( e12t(ji ,jj ) * zsshp2_e(ji ,jj ) & 616 & + e12t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 656 617 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 657 618 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 833 794 DO jj = 1, jpjm1 834 795 DO ji = 1, jpim1 ! NO Vector Opt. 835 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) )&836 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj)&837 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )838 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) )&839 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj )&840 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )796 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 797 & * ( e12t(ji ,jj) * ssha_e(ji ,jj) & 798 & + e12t(ji+1,jj) * ssha_e(ji+1,jj) ) 799 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 800 & * ( e12t(ji,jj ) * ssha_e(ji,jj ) & 801 & + e12t(ji,jj+1) * ssha_e(ji,jj+1) ) 841 802 END DO 842 803 END DO … … 865 826 END DO 866 827 ELSE 867 hu_e (:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) )868 hv_e (:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) )869 828 DO jk=1,jpkm1 870 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_ e(:,:) ) * z1_2dt_b871 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_ e(:,:) ) * z1_2dt_b829 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 830 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 872 831 END DO 873 832 ! Save barotropic velocities not transport: … … 890 849 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc ) 891 850 CALL wrk_dealloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 892 CALL wrk_dealloc( jpi, jpj, zhur_b, zhvr_b )893 851 CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a ) 894 CALL wrk_dealloc( jpi, jpj, zh t, zhf )852 CALL wrk_dealloc( jpi, jpj, zhf ) 895 853 ! 896 854 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') … … 989 947 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) ) 990 948 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) ) 991 IF( .NOT.ln_bt_av .AND. iom_varid( numror, 'sshbb_e', ldstop = .FALSE. ) > 0) THEN949 IF( .NOT.ln_bt_av ) THEN 992 950 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) ) 993 951 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:) ) … … 996 954 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:) ) 997 955 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:) ) 998 ELSE999 sshbb_e = sshn_b ! ACC GUESS WORK1000 ubb_e = ub_b1001 vbb_e = vb_b1002 sshb_e = sshn_b1003 ub_e = ub_b1004 vb_e = vb_b1005 956 ENDIF 1006 957 ! … … 1029 980 INTEGER , INTENT(in) :: kt ! ocean time-step 1030 981 ! 1031 INTEGER :: ji ,jj, jk 982 INTEGER :: ji ,jj 983 INTEGER :: ios ! Local integer output status for namelist read 1032 984 REAL(wp) :: zxr2, zyr2, zcmax 1033 REAL(wp), POINTER, DIMENSION(:,:) :: zcu , zht985 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1034 986 !! 1035 !NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, &1036 !& nn_baro, rn_bt_cmax, nn_bt_flt987 NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, & 988 & nn_baro, rn_bt_cmax, nn_bt_flt 1037 989 !!---------------------------------------------------------------------- 1038 ! REWIND( numnam ) !* Namelist namsplit: split-explicit free surface 1039 ! READ ( numnam, namsplit ) 990 ! 991 REWIND( numnam_ref ) ! Namelist namsplit in reference namelist : time splitting parameters 992 READ ( numnam_ref, namsplit, IOSTAT = ios, ERR = 901) 993 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in reference namelist', lwp ) 994 995 REWIND( numnam_cfg ) ! Namelist namsplit in configuration namelist : time splitting parameters 996 READ ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 ) 997 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp ) 998 WRITE ( numond, namsplit ) 999 ! 1040 1000 ! ! Max courant number for ext. grav. waves 1041 1001 ! 1042 CALL wrk_alloc( jpi, jpj, zcu, zht ) 1043 ! 1044 ! JC: Simplification needed below: define ht_0 even when volume is fixed 1002 CALL wrk_alloc( jpi, jpj, zcu ) 1003 ! 1045 1004 IF (lk_vvl) THEN 1046 zht(:,:) = ht_0(:,:) * tmask(:,:,1) 1005 DO jj = 1, jpj 1006 DO ji =1, jpi 1007 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1008 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1009 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 1010 END DO 1011 END DO 1047 1012 ELSE 1048 zht(:,:) = 0. 1049 DO jk = 1, jpkm1 1050 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 1051 END DO 1052 ENDIF 1053 1054 DO jj = 1, jpj 1055 DO ji =1, jpi 1056 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1057 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1058 zcu(ji,jj) = sqrt(grav*zht(ji,jj)*(zxr2 + zyr2) ) 1059 END DO 1060 END DO 1013 DO jj = 1, jpj 1014 DO ji =1, jpi 1015 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1016 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1017 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) ) 1018 END DO 1019 END DO 1020 ENDIF 1061 1021 1062 1022 zcmax = MAXVAL(zcu(:,:)) 1063 1023 IF( lk_mpp ) CALL mpp_max( zcmax ) 1064 1024 1065 ! Estimate number of iterations to satisfy a max courant number= 0.81025 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 1066 1026 IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1067 1027 … … 1073 1033 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 1074 1034 IF( ln_bt_nn_auto ) THEN 1075 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.true. Automatically set nn_baro '1076 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax1035 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.true. Automatically set nn_baro ' 1036 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1077 1037 ELSE 1078 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.false.: Use nn_baro in namelist ' 1079 ENDIF 1080 IF(lwp) WRITE(numout,*) ' nn_baro = ', nn_baro 1081 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt 1082 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1038 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.false.: Use nn_baro in namelist ' 1039 ENDIF 1083 1040 1084 1041 IF(ln_bt_av) THEN 1085 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Time averaging over nn_baro time steps is on '1042 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Time averaging over nn_baro time steps is on ' 1086 1043 ELSE 1087 IF(lwp) WRITE(numout,*) ' ln_bt_av=.false. => No time averaging of barotropic variables '1044 IF(lwp) WRITE(numout,*) ' ln_bt_av=.false. => No time averaging of barotropic variables ' 1088 1045 ENDIF 1089 1046 ! 1090 1047 ! 1091 1048 IF(ln_bt_fw) THEN 1092 IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables '1049 IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables ' 1093 1050 ELSE 1094 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables '1095 ENDIF 1096 ! 1097 IF(lwp) WRITE(numout,*) 'Time filter choice, nn_bt_flt: ', nn_bt_flt1051 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables ' 1052 ENDIF 1053 ! 1054 IF(lwp) WRITE(numout,*) ' Time filter choice, nn_bt_flt: ', nn_bt_flt 1098 1055 SELECT CASE ( nn_bt_flt ) 1099 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac'1100 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro'1101 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro'1056 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac' 1057 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro' 1058 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro' 1102 1059 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 1103 1060 END SELECT 1104 1061 ! 1062 IF(lwp) WRITE(numout,*) ' ' 1063 IF(lwp) WRITE(numout,*) ' nn_baro = ', nn_baro 1064 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt 1065 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1066 ! 1105 1067 IF ((.NOT.ln_bt_av).AND.(.NOT.ln_bt_fw)) THEN 1106 1068 CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) … … 1110 1072 ENDIF 1111 1073 ! 1112 CALL wrk_dealloc( jpi, jpj, zcu , zht)1074 CALL wrk_dealloc( jpi, jpj, zcu ) 1113 1075 ! 1114 1076 END SUBROUTINE dyn_spg_ts_init … … 1116 1078 #else 1117 1079 !!--------------------------------------------------------------------------- 1118 !! Default case : Empty module No s tandard free surface constant volume1080 !! Default case : Empty module No split explicit free surface 1119 1081 !!--------------------------------------------------------------------------- 1120 1121 USE par_kind1122 LOGICAL, PUBLIC, PARAMETER :: ln_bt_fw=.FALSE. ! Forward integration of barotropic sub-stepping1123 1082 CONTAINS 1124 1083 INTEGER FUNCTION dyn_spg_ts_alloc() ! Dummy function -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4354 r4370 27 27 USE dynadv ! dynamics: vector invariant versus flux form 28 28 USE dynspg_oce, ONLY: lk_dynspg_ts 29 USE dynspg_ts30 29 31 30 IMPLICIT NONE -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r4338 r4370 33 33 USE diaar5, ONLY: lk_diaar5 34 34 USE iom 35 USE sbcrnf, ONLY: h_rnf, nk_rnf, sbc_rnf_div ! River runoff36 USE dynspg_ts, ONLY: ln_bt_fw37 USE dynspg_oce, ONLY: lk_dynspg_ts38 35 #if defined key_agrif 39 36 USE agrif_opa_update
Note: See TracChangeset
for help on using the changeset viewer.