- Timestamp:
- 2017-11-17T17:19:55+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7646 r8741 24 24 USE agrif_oce 25 25 USE phycst 26 USE dynspg_ts, ONLY: un_adv, vn_adv 26 27 ! 27 28 USE in_out_manager … … 38 39 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 39 40 PUBLIC interpe3t, interpumsk, interpvmsk 40 # if defined key_zdftke 41 PUBLIC Agrif_ tke, interpavm41 # if defined key_zdftke || defined key_zdfgls 42 PUBLIC Agrif_avm, interpavm 42 43 # endif 43 44 … … 449 450 INTEGER :: ji, jj 450 451 LOGICAL :: ll_int_cons 451 REAL(wp) :: zrhot, zt452 452 !!---------------------------------------------------------------------- 453 453 ! … … 456 456 ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only 457 457 ! 458 zrhot = Agrif_rhot() 459 ! 460 ! "Central" time index for interpolation: 461 IF( ln_bt_fw ) THEN 462 zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot 463 ELSE 464 zt = REAL( Agrif_NbStepint() , wp ) / zrhot 465 ENDIF 466 ! 467 ! Linear interpolation of sea level 468 Agrif_SpecialValue = 0._wp 469 Agrif_UseSpecialValue = .TRUE. 470 CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn ) 471 Agrif_UseSpecialValue = .FALSE. 458 ! Enforce volume conservation if no time refinement: 459 IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE. 472 460 ! 473 461 ! Interpolate barotropic fluxes 474 Agrif_SpecialValue=0. 462 Agrif_SpecialValue=0._wp 475 463 Agrif_UseSpecialValue = ln_spc_dyn 476 464 ! … … 491 479 ubdy_n(:) = 0._wp ; vbdy_n(:) = 0._wp 492 480 ubdy_s(:) = 0._wp ; vbdy_s(:) = 0._wp 493 CALL Agrif_Bc_variable( unb_id, calledweight=zt,procname=interpunb )494 CALL Agrif_Bc_variable( vnb_id, calledweight=zt,procname=interpvnb )481 CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 482 CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) 495 483 ENDIF 496 484 Agrif_UseSpecialValue = .FALSE. … … 501 489 SUBROUTINE Agrif_ssh( kt ) 502 490 !!---------------------------------------------------------------------- 503 !! *** ROUTINE Agrif_ DYN***491 !! *** ROUTINE Agrif_ssh *** 504 492 !!---------------------------------------------------------------------- 505 493 INTEGER, INTENT(in) :: kt 506 494 !! 495 INTEGER :: ji, jj 507 496 !!---------------------------------------------------------------------- 508 497 ! 509 498 IF( Agrif_Root() ) RETURN 499 ! 500 ! Linear interpolation in time of sea level 501 ! 502 Agrif_SpecialValue = 0._wp 503 Agrif_UseSpecialValue = .TRUE. 504 CALL Agrif_Bc_variable(sshn_id, procname=interpsshn ) 505 Agrif_UseSpecialValue = .FALSE. 510 506 ! 511 507 IF((nbondi == -1).OR.(nbondi == 2)) THEN 512 ssha(2,:)=ssha(3,:) 513 sshn(2,:)=sshn(3,:) 508 DO jj=1,jpj 509 ssha(2,jj) = hbdy_w(jj) 510 END DO 514 511 ENDIF 515 512 ! 516 513 IF((nbondi == 1).OR.(nbondi == 2)) THEN 517 ssha(nlci-1,:)=ssha(nlci-2,:) 518 sshn(nlci-1,:)=sshn(nlci-2,:) 514 DO jj=1,jpj 515 ssha(nlci-1,jj) = hbdy_e(jj) 516 END DO 519 517 ENDIF 520 518 ! 521 519 IF((nbondj == -1).OR.(nbondj == 2)) THEN 522 ssha(:,2)=ssha(:,3) 523 sshn(:,2)=sshn(:,3) 520 DO ji=1,jpi 521 ssha(ji,2) = hbdy_s(ji) 522 END DO 524 523 ENDIF 525 524 ! 526 525 IF((nbondj == 1).OR.(nbondj == 2)) THEN 527 ssha(:,nlcj-1)=ssha(:,nlcj-2) 528 sshn(:,nlcj-1)=sshn(:,nlcj-2) 526 DO ji=1,jpi 527 ssha(ji,nlcj-1) = hbdy_n(ji) 528 END DO 529 529 ENDIF 530 530 ! … … 541 541 !!---------------------------------------------------------------------- 542 542 ! 543 ! 544 IF( Agrif_Root() ) RETURN 545 ! 543 546 IF((nbondi == -1).OR.(nbondi == 2)) THEN 544 547 DO jj = 1, jpj … … 567 570 END SUBROUTINE Agrif_ssh_ts 568 571 569 # if defined key_zdftke 570 571 SUBROUTINE Agrif_ tke572 !!---------------------------------------------------------------------- 573 !! *** ROUTINE Agrif_ tke***572 # if defined key_zdftke || defined key_zdfgls 573 574 SUBROUTINE Agrif_avm 575 !!---------------------------------------------------------------------- 576 !! *** ROUTINE Agrif_avm *** 574 577 !!---------------------------------------------------------------------- 575 578 REAL(wp) :: zalpha 576 579 !!---------------------------------------------------------------------- 577 580 ! 578 zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 579 IF( zalpha > 1. ) zalpha = 1. 581 IF( Agrif_Root() ) RETURN 582 ! 583 ! zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 584 ! IF( zalpha > 1. ) zalpha = 1. 585 zalpha = 1._wp ! JC: proper time interpolation impossible 586 ! => use last available value from parent 580 587 ! 581 588 Agrif_SpecialValue = 0.e0 … … 586 593 Agrif_UseSpecialValue = .FALSE. 587 594 ! 588 END SUBROUTINE Agrif_ tke595 END SUBROUTINE Agrif_avm 589 596 590 597 # endif … … 781 788 ! 782 789 IF( before ) THEN 783 DO jk = k1, jpk790 DO jk = 1, jpkm1 784 791 ptab(i1:i2,j1:j2,jk) = e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 785 792 END DO … … 788 795 DO jk = 1, jpkm1 789 796 DO jj=j1,j2 790 ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_ n(i1:i2,jj,jk) )797 ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_a(i1:i2,jj,jk) ) 791 798 END DO 792 799 END DO … … 808 815 !!---------------------------------------------------------------------- 809 816 ! 810 IF( before ) THEN !interpv entre 1 et k2 et interpv2d en jpkp1811 DO jk = k1, jpk817 IF( before ) THEN 818 DO jk = 1, jpkm1 812 819 ptab(i1:i2,j1:j2,jk) = e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) * vn(i1:i2,j1:j2,jk) 813 820 END DO … … 815 822 zrhox= Agrif_Rhox() 816 823 DO jk = 1, jpkm1 817 va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_ n(i1:i2,j1:j2,jk) )824 va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_a(i1:i2,j1:j2,jk) ) 818 825 END DO 819 826 ENDIF … … 978 985 !!---------------------------------------------------------------------- 979 986 IF( before ) THEN 980 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 987 IF ( ln_bt_fw ) THEN 988 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 989 ELSE 990 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 991 ENDIF 981 992 ELSE 982 993 western_side = (nb == 1).AND.(ndir == 1) … … 1016 1027 ! 1017 1028 IF( before ) THEN 1018 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 1029 IF ( ln_bt_fw ) THEN 1030 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 1031 ELSE 1032 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 1033 ENDIF 1019 1034 ELSE 1020 1035 western_side = (nb == 1).AND.(ndir == 1) … … 1175 1190 END SUBROUTINE interpvmsk 1176 1191 1177 # if defined key_zdftke 1192 # if defined key_zdftke || defined key_zdfgls 1178 1193 1179 1194 SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) … … 1189 1204 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1190 1205 ELSE 1191 avm _k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)1206 avm (i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1192 1207 ENDIF 1193 1208 ! 1194 1209 END SUBROUTINE interpavm 1195 1210 1196 # endif /* key_zdftke */1211 # endif /* key_zdftke || key_zdfgls */ 1197 1212 1198 1213 #else
Note: See TracChangeset
for help on using the changeset viewer.
