- Timestamp:
- 2017-12-12T16:42:29+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_METO_MERCATOR_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7646 r8993 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 … … 116 117 ENDIF 117 118 ! 118 DO jk=1,jpkm1 ! Smooth 119 DO jj=j1,j2 120 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 121 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 122 END DO 123 END DO 119 IF (.NOT.lk_agrif_clp) THEN 120 DO jk=1,jpkm1 ! Smooth 121 DO jj=j1,j2 122 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 123 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 124 END DO 125 END DO 126 END IF 124 127 ! 125 128 zub(2,:) = 0._wp ! Correct transport … … 185 188 ENDIF 186 189 187 DO jk = 1, jpkm1 ! Smooth 188 DO jj = j1, j2 189 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 190 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 191 END DO 192 END DO 190 IF (.NOT.lk_agrif_clp) THEN 191 DO jk = 1, jpkm1 ! Smooth 192 DO jj = j1, j2 193 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 194 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 195 END DO 196 END DO 197 ENDIF 193 198 194 199 zub(nlci-2,:) = 0._wp ! Correct transport … … 254 259 ENDIF 255 260 ! 256 DO jk = 1, jpkm1 ! Smooth 257 DO ji = i1, i2 258 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 259 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 260 END DO 261 END DO 261 IF (.NOT.lk_agrif_clp) THEN 262 DO jk = 1, jpkm1 ! Smooth 263 DO ji = i1, i2 264 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 265 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 266 END DO 267 END DO 268 ENDIF 262 269 ! 263 270 zvb(:,2) = 0._wp ! Correct transport … … 323 330 ENDIF 324 331 ! 325 DO jk = 1, jpkm1 ! Smooth 326 DO ji = i1, i2 327 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 328 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 329 END DO 330 END DO 332 IF (.NOT.lk_agrif_clp) THEN 333 DO jk = 1, jpkm1 ! Smooth 334 DO ji = i1, i2 335 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 336 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 337 END DO 338 END DO 339 ENDIF 331 340 ! 332 341 zvb(:,nlcj-2) = 0._wp ! Correct transport … … 449 458 INTEGER :: ji, jj 450 459 LOGICAL :: ll_int_cons 451 REAL(wp) :: zrhot, zt452 460 !!---------------------------------------------------------------------- 453 461 ! … … 456 464 ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only 457 465 ! 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. 466 ! Enforce volume conservation if no time refinement: 467 IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE. 472 468 ! 473 469 ! Interpolate barotropic fluxes 474 Agrif_SpecialValue=0. 470 Agrif_SpecialValue=0._wp 475 471 Agrif_UseSpecialValue = ln_spc_dyn 476 472 ! … … 491 487 ubdy_n(:) = 0._wp ; vbdy_n(:) = 0._wp 492 488 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 )489 CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 490 CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) 495 491 ENDIF 496 492 Agrif_UseSpecialValue = .FALSE. … … 501 497 SUBROUTINE Agrif_ssh( kt ) 502 498 !!---------------------------------------------------------------------- 503 !! *** ROUTINE Agrif_ DYN***499 !! *** ROUTINE Agrif_ssh *** 504 500 !!---------------------------------------------------------------------- 505 501 INTEGER, INTENT(in) :: kt 506 502 !! 503 INTEGER :: ji, jj 507 504 !!---------------------------------------------------------------------- 508 505 ! 509 506 IF( Agrif_Root() ) RETURN 507 ! 508 ! Linear interpolation in time of sea level 509 ! 510 Agrif_SpecialValue = 0._wp 511 Agrif_UseSpecialValue = .TRUE. 512 CALL Agrif_Bc_variable(sshn_id, procname=interpsshn ) 513 Agrif_UseSpecialValue = .FALSE. 510 514 ! 511 515 IF((nbondi == -1).OR.(nbondi == 2)) THEN 512 ssha(2,:)=ssha(3,:) 513 sshn(2,:)=sshn(3,:) 516 DO jj=1,jpj 517 ssha(2,jj) = hbdy_w(jj) 518 END DO 514 519 ENDIF 515 520 ! 516 521 IF((nbondi == 1).OR.(nbondi == 2)) THEN 517 ssha(nlci-1,:)=ssha(nlci-2,:) 518 sshn(nlci-1,:)=sshn(nlci-2,:) 522 DO jj=1,jpj 523 ssha(nlci-1,jj) = hbdy_e(jj) 524 END DO 519 525 ENDIF 520 526 ! 521 527 IF((nbondj == -1).OR.(nbondj == 2)) THEN 522 ssha(:,2)=ssha(:,3) 523 sshn(:,2)=sshn(:,3) 528 DO ji=1,jpi 529 ssha(ji,2) = hbdy_s(ji) 530 END DO 524 531 ENDIF 525 532 ! 526 533 IF((nbondj == 1).OR.(nbondj == 2)) THEN 527 ssha(:,nlcj-1)=ssha(:,nlcj-2) 528 sshn(:,nlcj-1)=sshn(:,nlcj-2) 534 DO ji=1,jpi 535 ssha(ji,nlcj-1) = hbdy_n(ji) 536 END DO 529 537 ENDIF 530 538 ! … … 541 549 !!---------------------------------------------------------------------- 542 550 ! 551 ! 552 IF( Agrif_Root() ) RETURN 553 ! 543 554 IF((nbondi == -1).OR.(nbondi == 2)) THEN 544 555 DO jj = 1, jpj … … 567 578 END SUBROUTINE Agrif_ssh_ts 568 579 569 # if defined key_zdftke 570 571 SUBROUTINE Agrif_ tke572 !!---------------------------------------------------------------------- 573 !! *** ROUTINE Agrif_ tke***580 # if defined key_zdftke || defined key_zdfgls 581 582 SUBROUTINE Agrif_avm 583 !!---------------------------------------------------------------------- 584 !! *** ROUTINE Agrif_avm *** 574 585 !!---------------------------------------------------------------------- 575 586 REAL(wp) :: zalpha 576 587 !!---------------------------------------------------------------------- 577 588 ! 578 zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 579 IF( zalpha > 1. ) zalpha = 1. 589 IF( Agrif_Root() ) RETURN 590 ! 591 ! zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 592 ! IF( zalpha > 1. ) zalpha = 1. 593 zalpha = 1._wp ! JC: proper time interpolation impossible 594 ! => use last available value from parent 580 595 ! 581 596 Agrif_SpecialValue = 0.e0 … … 586 601 Agrif_UseSpecialValue = .FALSE. 587 602 ! 588 END SUBROUTINE Agrif_ tke603 END SUBROUTINE Agrif_avm 589 604 590 605 # endif … … 609 624 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 610 625 ELSE 626 IF (lk_agrif_clp) THEN 627 DO jn = 1, jpts 628 DO jk = 1, jpkm1 629 DO ji = i1,i2 630 DO jj = j1,j2 631 tsa(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) 632 END DO 633 END DO 634 END DO 635 END DO 636 return 637 ENDIF 611 638 ! 612 639 western_side = (nb == 1).AND.(ndir == 1) … … 781 808 ! 782 809 IF( before ) THEN 783 DO jk = k1, jpk810 DO jk = 1, jpkm1 784 811 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 812 END DO … … 788 815 DO jk = 1, jpkm1 789 816 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) )817 ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk) / ( zrhoy * e2u(i1:i2,jj) * e3u_a(i1:i2,jj,jk) ) 791 818 END DO 792 819 END DO … … 808 835 !!---------------------------------------------------------------------- 809 836 ! 810 IF( before ) THEN !interpv entre 1 et k2 et interpv2d en jpkp1811 DO jk = k1, jpk837 IF( before ) THEN 838 DO jk = 1, jpkm1 812 839 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 840 END DO … … 815 842 zrhox= Agrif_Rhox() 816 843 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) )844 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 845 END DO 819 846 ENDIF … … 978 1005 !!---------------------------------------------------------------------- 979 1006 IF( before ) THEN 980 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 1007 IF ( ln_bt_fw ) THEN 1008 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 1009 ELSE 1010 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 1011 ENDIF 981 1012 ELSE 982 1013 western_side = (nb == 1).AND.(ndir == 1) … … 1016 1047 ! 1017 1048 IF( before ) THEN 1018 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 1049 IF ( ln_bt_fw ) THEN 1050 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 1051 ELSE 1052 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 1053 ENDIF 1019 1054 ELSE 1020 1055 western_side = (nb == 1).AND.(ndir == 1) … … 1175 1210 END SUBROUTINE interpvmsk 1176 1211 1177 # if defined key_zdftke 1212 # if defined key_zdftke || defined key_zdfgls 1178 1213 1179 1214 SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) … … 1189 1224 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1190 1225 ELSE 1191 avm _k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)1226 avm (i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1192 1227 ENDIF 1193 1228 ! 1194 1229 END SUBROUTINE interpavm 1195 1230 1196 # endif /* key_zdftke */1231 # endif /* key_zdftke || key_zdfgls */ 1197 1232 1198 1233 #else
Note: See TracChangeset
for help on using the changeset viewer.
