Changeset 7971 for branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
- Timestamp:
- 2017-04-26T12:03:26+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r6204 r7971 137 137 DO jk=1,jpkm1 138 138 DO jj=1,jpj 139 spgu(2,jj)=spgu(2,jj)+fse3u (2,jj,jk)*ua(2,jj,jk)139 spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 140 140 END DO 141 141 END DO … … 143 143 DO jj=1,jpj 144 144 IF (umask(2,jj,1).NE.0.) THEN 145 spgu(2,jj)=spgu(2,jj) /hu(2,jj)145 spgu(2,jj)=spgu(2,jj)*hur_a(2,jj) 146 146 ENDIF 147 147 END DO … … 161 161 DO jk=1,jpkm1 162 162 DO jj=1,jpj 163 spgu1(2,jj)=spgu1(2,jj)+fse3u (2,jj,jk)*ua(2,jj,jk)163 spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 164 164 END DO 165 165 END DO … … 167 167 DO jj=1,jpj 168 168 IF (umask(2,jj,1).NE.0.) THEN 169 spgu1(2,jj)=spgu1(2,jj) /hu(2,jj)169 spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj) 170 170 ENDIF 171 171 END DO … … 207 207 DO jk=1,jpkm1 208 208 DO jj=1,jpj 209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u (nlci-2,jj,jk)*ua(nlci-2,jj,jk)209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 210 210 ENDDO 211 211 ENDDO 212 212 DO jj=1,jpj 213 213 IF (umask(nlci-2,jj,1).NE.0.) THEN 214 spgu(nlci-2,jj)=spgu(nlci-2,jj) /hu(nlci-2,jj)214 spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj) 215 215 ENDIF 216 216 END DO … … 229 229 DO jk=1,jpkm1 230 230 DO jj=1,jpj 231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u (nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 232 232 END DO 233 233 END DO 234 234 DO jj=1,jpj 235 235 IF (umask(nlci-2,jj,1).NE.0.) THEN 236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj) /hu(nlci-2,jj)236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj) 237 237 ENDIF 238 238 END DO … … 278 278 DO jk=1,jpkm1 279 279 DO ji=1,jpi 280 spgv(ji,2)=spgv(ji,2)+fse3v (ji,2,jk)*va(ji,2,jk)280 spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk) 281 281 END DO 282 282 END DO … … 284 284 DO ji=1,jpi 285 285 IF (vmask(ji,2,1).NE.0.) THEN 286 spgv(ji,2)=spgv(ji,2) /hv(ji,2)286 spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2) 287 287 ENDIF 288 288 END DO … … 302 302 DO jk=1,jpkm1 303 303 DO ji=1,jpi 304 spgv1(ji,2)=spgv1(ji,2)+fse3v (ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)304 spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 305 305 END DO 306 306 END DO … … 308 308 DO ji=1,jpi 309 309 IF (vmask(ji,2,1).NE.0.) THEN 310 spgv1(ji,2)=spgv1(ji,2) /hv(ji,2)310 spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2) 311 311 ENDIF 312 312 END DO … … 353 353 DO jk=1,jpkm1 354 354 DO ji=1,jpi 355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v (ji,nlcj-2,jk)*va(ji,nlcj-2,jk)355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 356 356 END DO 357 357 END DO … … 359 359 DO ji=1,jpi 360 360 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2) /hv(ji,nlcj-2)361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2) 362 362 ENDIF 363 363 END DO … … 378 378 DO jk=1,jpkm1 379 379 DO ji=1,jpi 380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v (ji,nlcj-2,jk)*va(ji,nlcj-2,jk)380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 381 381 END DO 382 382 END DO … … 384 384 DO ji=1,jpi 385 385 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2) /hv(ji,nlcj-2)386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2) 387 387 ENDIF 388 388 END DO … … 503 503 zt = REAL(Agrif_NbStepint(),wp) / zrhot 504 504 ENDIF 505 506 ! Linear interpolation of sea level507 Agrif_SpecialValue = 0.e0508 Agrif_UseSpecialValue = .TRUE.509 CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn )510 Agrif_UseSpecialValue = .FALSE.511 505 512 506 ! Interpolate barotropic fluxes … … 539 533 SUBROUTINE Agrif_ssh( kt ) 540 534 !!---------------------------------------------------------------------- 541 !! *** ROUTINE Agrif_ DYN***535 !! *** ROUTINE Agrif_ssh *** 542 536 !!---------------------------------------------------------------------- 543 537 INTEGER, INTENT(in) :: kt 544 538 !! 539 INTEGER :: ji, jj 545 540 !!---------------------------------------------------------------------- 546 541 547 542 IF( Agrif_Root() ) RETURN 548 543 544 ! Linear interpolation of sea level 545 Agrif_SpecialValue = 0.e0 546 Agrif_UseSpecialValue = .TRUE. 547 CALL Agrif_Bc_variable(sshn_id, procname=interpsshn ) 548 Agrif_UseSpecialValue = .FALSE. 549 549 550 IF((nbondi == -1).OR.(nbondi == 2)) THEN 550 ssha(2,:)=ssha(3,:) 551 sshn(2,:)=sshn(3,:) 551 DO jj=1,jpj 552 ssha(2,jj) = hbdy_w(jj) 553 END DO 552 554 ENDIF 553 555 554 556 IF((nbondi == 1).OR.(nbondi == 2)) THEN 555 ssha(nlci-1,:)=ssha(nlci-2,:) 556 sshn(nlci-1,:)=sshn(nlci-2,:) 557 DO jj=1,jpj 558 ssha(nlci-1,jj) = hbdy_e(jj) 559 END DO 557 560 ENDIF 558 561 559 562 IF((nbondj == -1).OR.(nbondj == 2)) THEN 560 ssha(:,2)=ssha(:,3) 561 sshn(:,2)=sshn(:,3) 563 DO ji=1,jpi 564 ssha(ji,2) = hbdy_s(ji) 565 END DO 562 566 ENDIF 563 567 564 568 IF((nbondj == 1).OR.(nbondj == 2)) THEN 565 ssha(:,nlcj-1)=ssha(:,nlcj-2) 566 sshn(:,nlcj-1)=sshn(:,nlcj-2) 569 DO ji=1,jpi 570 ssha(ji,nlcj-1) = hbdy_n(ji) 571 END DO 567 572 ENDIF 568 573 … … 812 817 DO ji=i1,i2 813 818 ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 814 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u (ji,jj,jk)819 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u_n(ji,jj,jk) 815 820 END DO 816 821 END DO … … 821 826 DO jj=j1,j2 822 827 ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 823 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u (i1:i2,jj,jk)828 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u_a(i1:i2,jj,jk) 824 829 END DO 825 830 END DO … … 880 885 DO ji=i1,i2 881 886 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 882 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v (ji,jj,jk)887 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v_n(ji,jj,jk) 883 888 END DO 884 889 END DO … … 889 894 DO jj=j1,j2 890 895 va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 891 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v (i1:i2,jj,jk)896 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v_a(i1:i2,jj,jk) 892 897 END DO 893 898 END DO … … 1110 1115 ! Polynomial interpolation coefficients: 1111 1116 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1112 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) )1117 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1113 1118 ! 1114 1119 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2) … … 1151 1156 ! Polynomial interpolation coefficients: 1152 1157 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1153 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) )1158 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1154 1159 ! 1155 1160 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)
Note: See TracChangeset
for help on using the changeset viewer.
