Changeset 5837 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Timestamp:
- 2015-10-26T15:59:39+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4624 r5837 22 22 USE dom_oce ! ocean space and time domain 23 23 USE sbc_oce ! surface boundary condition: ocean 24 USE sbcisf ! ice shelf variable (fwfisf) 24 25 USE dynspg_oce ! surface pressure gradient variables 25 26 USE phycst ! physical constants … … 44 45 USE agrif_opa_interp ! agrif 45 46 #endif 46 47 #if defined key_asminc 48 USE asminc ! Assimilation increment 49 #endif 47 50 48 51 IMPLICIT NONE … … 76 79 !!---------------------------------------------------------------------- 77 80 !! NEMO/OPA 3.5 , NEMO Consortium (2013) 78 !! $Id : dynspg_ts.F9081 !! $Id$ 79 82 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 80 83 !!---------------------------------------------------------------------- … … 95 98 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 96 99 97 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &98 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) )100 IF( ln_dynvor_een .or. ln_dynvor_een_old ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , & 101 & ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 99 102 100 103 dyn_spg_ts_alloc = MAXVAL(ierr(:)) … … 216 219 ! 217 220 IF ( kt == nit000 .OR. lk_vvl ) THEN 218 IF ( ln_dynvor_een ) THEN 221 IF ( ln_dynvor_een_old ) THEN 222 DO jj = 1, jpjm1 223 DO ji = 1, jpim1 224 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 225 & ht(ji ,jj ) + ht(ji+1,jj ) ) / 4._wp 226 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zwz(ji,jj) 227 END DO 228 END DO 229 CALL lbc_lnk( zwz, 'F', 1._wp ) 230 zwz(:,:) = ff(:,:) * zwz(:,:) 231 232 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 233 DO jj = 2, jpj 234 DO ji = fs_2, jpi ! vector opt. 235 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 236 ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) 237 ftse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) 238 ftsw(ji,jj) = zwz(ji ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj ) 239 END DO 240 END DO 241 ELSE IF ( ln_dynvor_een ) THEN 219 242 DO jj = 1, jpjm1 220 243 DO ji = 1, jpim1 … … 290 313 ! 291 314 DO jk = 1, jpkm1 292 #if defined key_vectopt_loop 293 DO jj = 1, 1 !Vector opt. => forced unrolling 294 DO ji = 1, jpij 295 #else 296 DO jj = 1, jpj 297 DO ji = 1, jpi 298 #endif 299 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 300 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 301 END DO 302 END DO 315 zu_frc(:,:) = zu_frc(:,:) + fse3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 316 zv_frc(:,:) = zv_frc(:,:) + fse3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 303 317 END DO 304 318 ! … … 346 360 END DO 347 361 ! 348 ELSEIF ( ln_dynvor_een ) THEN! enstrophy and energy conserving scheme362 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN ! enstrophy and energy conserving scheme 349 363 DO jj = 2, jpjm1 350 364 DO ji = fs_2, fs_jpim1 ! vector opt. … … 440 454 ! ! Surface net water flux and rivers 441 455 IF (ln_bt_fw) THEN 442 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) )456 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) ) 443 457 ELSE 444 zssh_frc(:,:) = zraur * z1_2 * (emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)) 458 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 459 & + rdivisf * ( fwfisf(:,:) + fwfisf_b(:,:) ) ) 445 460 ENDIF 446 461 #if defined key_asminc 447 462 ! ! Include the IAU weighted SSH increment 448 463 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 449 zssh_frc(:,:) = zssh_frc(:,:) +ssh_iau(:,:)464 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 450 465 ENDIF 451 466 #endif … … 464 479 ! ! ==================== ! 465 480 ! Initialize barotropic variables: 481 IF( ll_init )THEN 482 sshbb_e(:,:) = 0._wp 483 ubb_e (:,:) = 0._wp 484 vbb_e (:,:) = 0._wp 485 sshb_e (:,:) = 0._wp 486 ub_e (:,:) = 0._wp 487 vb_e (:,:) = 0._wp 488 ENDIF 489 ! 466 490 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 467 491 sshn_e(:,:) = sshn (:,:) … … 533 557 END DO 534 558 END DO 535 CALL lbc_lnk ( zwx, 'U', 1._wp ) ; CALL lbc_lnk(zwy, 'V', 1._wp )559 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 536 560 ! 537 561 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points … … 611 635 END DO 612 636 END DO 613 CALL lbc_lnk ( zsshu_a, 'U', 1._wp ) ; CALL lbc_lnk(zsshv_a, 'V', 1._wp )637 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) 614 638 ENDIF 615 639 ! … … 685 709 END DO 686 710 ! 687 ELSEIF ( ln_dynvor_een ) THEN!== energy and enstrophy conserving scheme ==!711 ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN !== energy and enstrophy conserving scheme ==! 688 712 DO jj = 2, jpjm1 689 713 DO ji = fs_2, fs_jpim1 ! vector opt. … … 779 803 ! ! ----------------------- 780 804 ! 781 CALL lbc_lnk( ua_e , 'U', -1._wp ) ! local domain boundaries 782 CALL lbc_lnk( va_e , 'V', -1._wp ) 805 CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 783 806 784 807 #if defined key_bdy … … 835 858 END DO 836 859 END DO 837 CALL lbc_lnk ( zsshu_a, 'U', 1._wp ) ; CALL lbc_lnk(zsshv_a, 'V', 1._wp ) ! Boundary conditions860 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 838 861 ENDIF 839 862 !
Note: See TracChangeset
for help on using the changeset viewer.
