- Timestamp:
- 2015-07-16T13:55:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4770 r5602 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 … … 78 79 !!---------------------------------------------------------------------- 79 80 !! NEMO/OPA 3.5 , NEMO Consortium (2013) 80 !! $Id : dynspg_ts.F9081 !! $Id$ 81 82 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 82 83 !!---------------------------------------------------------------------- … … 97 98 ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 98 99 99 IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &100 & 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) ) 101 102 102 103 dyn_spg_ts_alloc = MAXVAL(ierr(:)) … … 218 219 ! 219 220 IF ( kt == nit000 .OR. lk_vvl ) THEN 220 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 221 242 DO jj = 1, jpjm1 222 243 DO ji = 1, jpim1 … … 339 360 END DO 340 361 ! 341 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 342 363 DO jj = 2, jpjm1 343 364 DO ji = fs_2, fs_jpim1 ! vector opt. … … 433 454 ! ! Surface net water flux and rivers 434 455 IF (ln_bt_fw) THEN 435 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) )456 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) ) 436 457 ELSE 437 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(:,:) ) ) 438 460 ENDIF 439 461 #if defined key_asminc 440 462 ! ! Include the IAU weighted SSH increment 441 463 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 442 zssh_frc(:,:) = zssh_frc(:,:) +ssh_iau(:,:)464 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 443 465 ENDIF 444 466 #endif … … 535 557 END DO 536 558 END DO 537 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 ) 538 560 ! 539 561 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points … … 613 635 END DO 614 636 END DO 615 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 ) 616 638 ENDIF 617 639 ! … … 687 709 END DO 688 710 ! 689 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 ==! 690 712 DO jj = 2, jpjm1 691 713 DO ji = fs_2, fs_jpim1 ! vector opt. … … 781 803 ! ! ----------------------- 782 804 ! 783 CALL lbc_lnk( ua_e , 'U', -1._wp ) ! local domain boundaries 784 CALL lbc_lnk( va_e , 'V', -1._wp ) 805 CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 785 806 786 807 #if defined key_bdy … … 837 858 END DO 838 859 END DO 839 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 840 861 ENDIF 841 862 !
Note: See TracChangeset
for help on using the changeset viewer.