Ignore:
Timestamp:
2014-02-05T12:23:56+01:00 (8 years ago)
Author:
jchanut
Message:

Finalize Time split and AGRIF (tickets #106 and #107) + ticket #1240

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r4292 r4486  
    2828   USE lib_mpp 
    2929   USE wrk_nemo 
    30    USE dynspg_oce   
     30   USE dynspg_oce 
    3131 
    3232   IMPLICIT NONE 
     
    4040   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s 
    4141     
    42    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts 
     42   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    4343   PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn 
    4444 
     
    230230            DO jj=1,jpj 
    231231               ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj))) 
    232                ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u(1:2,jj,jk) 
     232               ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u_a(1:2,jj,jk) 
    233233            END DO 
    234234         END DO 
     
    245245         DO jk=1,jpkm1 
    246246            DO jj=1,jpj 
    247                spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
     247               spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 
    248248            END DO 
    249249         END DO 
     
    251251         DO jj=1,jpj 
    252252            IF (umask(2,jj,1).NE.0.) THEN 
    253                spgu(2,jj)=spgu(2,jj)/hu(2,jj) 
     253               spgu(2,jj)=spgu(2,jj)*hur_a(2,jj) 
    254254            ENDIF 
    255255         END DO 
     
    269269         DO jk=1,jpkm1 
    270270            DO jj=1,jpj 
    271                spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
     271               spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 
    272272            END DO 
    273273         END DO 
     
    275275         DO jj=1,jpj 
    276276            IF (umask(2,jj,1).NE.0.) THEN 
    277                spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 
     277               spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj) 
    278278            ENDIF 
    279279         END DO 
     
    288288            DO jj=1,jpj 
    289289               va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk) 
    290                va(2,jj,jk) = va(2,jj,jk) / fse3v(2,jj,jk) 
    291             END DO 
    292          END DO 
     290               va(2,jj,jk) = va(2,jj,jk) / fse3v_a(2,jj,jk) 
     291            END DO 
     292         END DO 
     293 
     294#if defined key_dynspg_ts 
     295         ! Set tangential velocities to time splitting estimate 
     296         spgv1(2,:)=0. 
     297         DO jk=1,jpkm1 
     298            DO jj=1,jpj 
     299               spgv1(2,jj)=spgv1(2,jj)+fse3v_a(2,jj,jk)*va(2,jj,jk) 
     300            END DO 
     301         END DO 
     302 
     303         DO jj=1,jpj 
     304            spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 
     305         END DO 
     306 
     307         DO jk=1,jpkm1 
     308            DO jj=1,jpj 
     309               va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-spgv1(2,jj))*vmask(2,jj,jk) 
     310            END DO 
     311         END DO 
     312#endif 
    293313 
    294314      ENDIF 
     
    304324            DO jj=1,jpj 
    305325               ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj))) 
    306  
    307                ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u(nlci-2:nlci-1,jj,jk) 
    308  
     326               ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u_a(nlci-2:nlci-1,jj,jk) 
    309327            END DO 
    310328         END DO 
     
    322340         do jk=1,jpkm1 
    323341            do jj=1,jpj 
    324                spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
     342               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
    325343            enddo 
    326344         enddo 
     
    328346         DO jj=1,jpj 
    329347            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    330                spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj) 
     348               spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj) 
    331349            ENDIF 
    332350         END DO 
     
    348366         DO jk=1,jpkm1 
    349367            DO jj=1,jpj 
    350                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
     368               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
    351369            END DO 
    352370         END DO 
     
    354372         DO jj=1,jpj 
    355373            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    356                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 
     374               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj) 
    357375            ENDIF 
    358376         END DO 
     
    367385            DO jj=1,jpj-1 
    368386               va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhox*e1v(nlci-1,jj)))*vmask(nlci-1,jj,jk) 
    369                va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v(nlci-1,jj,jk) 
    370             END DO 
    371          END DO 
     387               va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v_a(nlci-1,jj,jk) 
     388            END DO 
     389         END DO 
     390 
     391#if defined key_dynspg_ts 
     392         ! Set tangential velocities to time splitting estimate 
     393         spgv1(nlci-1,:)=0._wp 
     394         DO jk=1,jpkm1 
     395            DO jj=1,jpj 
     396               spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 
     397            END DO 
     398         END DO 
     399 
     400         DO jj=1,jpj 
     401            spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*hvr_a(nlci-1,jj) 
     402         END DO 
     403 
     404         DO jk=1,jpkm1 
     405            DO jj=1,jpj 
     406               va(nlci-1,jj,jk) = (va(nlci-1,jj,jk)+va_b(nlci-1,jj)-spgv1(nlci-1,jj))*vmask(nlci-1,jj,jk) 
     407            END DO 
     408         END DO 
     409#endif 
    372410 
    373411      ENDIF 
     
    384422            DO ji=1,jpi 
    385423               va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2))) 
    386                va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v(ji,1:2,jk) 
     424               va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v_a(ji,1:2,jk) 
    387425            END DO 
    388426         END DO 
     
    399437         DO jk=1,jpkm1 
    400438            DO ji=1,jpi 
    401                spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk) 
     439               spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk) 
    402440            END DO 
    403441         END DO 
     
    405443         DO ji=1,jpi 
    406444            IF (vmask(ji,2,1).NE.0.) THEN 
    407                spgv(ji,2)=spgv(ji,2)/hv(ji,2) 
     445               spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2) 
    408446            ENDIF 
    409447         END DO 
     
    423461         DO jk=1,jpkm1 
    424462            DO ji=1,jpi 
    425                spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
     463               spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
    426464            END DO 
    427465         END DO 
     
    429467         DO ji=1,jpi 
    430468            IF (vmask(ji,2,1).NE.0.) THEN 
    431                spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 
     469               spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2) 
    432470            ENDIF 
    433471         END DO 
     
    442480            DO ji=1,jpi 
    443481               ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk)  
    444                ua(ji,2,jk) = ua(ji,2,jk) / fse3u(ji,2,jk) 
    445             END DO 
    446          END DO 
    447  
     482               ua(ji,2,jk) = ua(ji,2,jk) / fse3u_a(ji,2,jk) 
     483            END DO 
     484         END DO 
     485 
     486#if defined key_dynspg_ts 
     487         ! Set tangential velocities to time splitting estimate 
     488         spgu1(:,2)=0._wp 
     489         DO jk=1,jpkm1 
     490            DO ji=1,jpi 
     491               spgu1(ji,2)=spgu1(ji,2)+fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 
     492            END DO 
     493         END DO 
     494 
     495         DO ji=1,jpi 
     496            spgu1(ji,2)=spgu1(ji,2)*hur_a(ji,2) 
     497         END DO 
     498 
     499         DO jk=1,jpkm1 
     500            DO ji=1,jpi 
     501               ua(ji,2,jk) = (ua(ji,2,jk)+ua_b(ji,2)-spgu1(ji,2))*umask(ji,2,jk) 
     502            END DO 
     503         END DO 
     504#endif 
    448505      ENDIF 
    449506 
     
    459516            DO ji=1,jpi 
    460517               va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1))) 
    461                va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v(ji,nlcj-2:nlcj-1,jk) 
     518               va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v_a(ji,nlcj-2:nlcj-1,jk) 
    462519            END DO 
    463520         END DO 
     
    474531         DO jk=1,jpkm1 
    475532            DO ji=1,jpi 
    476                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     533               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    477534            END DO 
    478535         END DO 
     
    480537         DO ji=1,jpi 
    481538            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    482                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2) 
     539               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2) 
    483540            ENDIF 
    484541         END DO 
     
    498555         DO jk=1,jpkm1 
    499556            DO ji=1,jpi 
    500                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     557               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    501558            END DO 
    502559         END DO 
     
    504561         DO ji=1,jpi 
    505562            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    506                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 
     563               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2) 
    507564            ENDIF 
    508565         END DO 
     
    517574            DO ji=1,jpi 
    518575               ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk) 
    519                ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u(ji,nlcj-1,jk) 
    520             END DO 
    521          END DO 
     576               ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u_a(ji,nlcj-1,jk) 
     577            END DO 
     578         END DO 
     579 
     580#if defined key_dynspg_ts 
     581         ! Set tangential velocities to time splitting estimate 
     582         spgu1(:,nlcj-1)=0._wp 
     583         DO jk=1,jpkm1 
     584            DO ji=1,jpi 
     585               spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 
     586            END DO 
     587         END DO 
     588 
     589         DO ji=1,jpi 
     590            spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*hur_a(ji,nlcj-1) 
     591         END DO 
     592 
     593         DO jk=1,jpkm1 
     594            DO ji=1,jpi 
     595               ua(ji,nlcj-1,jk) = (ua(ji,nlcj-1,jk)+ua_b(ji,nlcj-1)-spgu1(ji,nlcj-1))*umask(ji,nlcj-1,jk) 
     596            END DO 
     597         END DO 
     598#endif 
    522599 
    523600      ENDIF 
     
    528605   END SUBROUTINE Agrif_dyn 
    529606 
    530    SUBROUTINE Agrif_dyn_ts( kt, jn ) 
     607   SUBROUTINE Agrif_dyn_ts( jn ) 
    531608      !!---------------------------------------------------------------------- 
    532609      !!                  ***  ROUTINE Agrif_dyn_ts  *** 
    533610      !!----------------------------------------------------------------------   
    534611      !!  
    535       INTEGER, INTENT(in) ::   kt, jn 
     612      INTEGER, INTENT(in) ::   jn 
    536613      !! 
    537614      INTEGER :: ji, jj 
    538       REAL(wp) :: zrhox, zrhoy 
    539       REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 
    540       REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn 
    541615      !!----------------------------------------------------------------------   
    542616 
    543617      IF( Agrif_Root() )   RETURN 
    544618 
    545       IF ((kt==nit000).AND.(jn==1)) THEN 
    546          ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj)) 
    547          ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj)) 
    548          ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi)) 
    549          ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi)) 
    550       ENDIF 
    551  
    552       IF (jn==1) THEN  
    553          ! Fill boundary arrays at each baroclinic step  
    554          ! with Parent grid barotropic fluxes and sea level 
    555          ! 
    556          CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn ) 
    557  
    558          zrhox = Agrif_Rhox() 
    559          zrhoy = Agrif_Rhoy() 
    560  
    561 !alt         Agrif_SpecialValue    = 0.e0 
    562 !alt         Agrif_UseSpecialValue = .TRUE. 
    563 !alt         CALL Agrif_Bc_variable(zsshn, sshn_id, procname=interpsshn ) 
    564 !alt         Agrif_UseSpecialValue = .FALSE. 
    565  
    566          Agrif_SpecialValue=0. 
    567          Agrif_UseSpecialValue = ln_spc_dyn 
    568          zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp 
    569          CALL Agrif_Bc_variable(zunb,unb_id,procname=interpunb) 
    570          CALL Agrif_Bc_variable(zvnb,vnb_id,procname=interpvnb) 
    571          Agrif_UseSpecialValue = .FALSE. 
    572  
    573          IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    574             DO jj=1,jpj 
    575                ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) 
    576                vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) 
    577                hbdy_w(jj) = zsshn(2,jj) 
    578             END DO 
    579          ENDIF 
    580  
    581          IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    582             DO jj=1,jpj 
    583                ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) 
    584                vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) 
    585                hbdy_e(jj) = zsshn(nlci-1,jj) 
    586             END DO 
    587          ENDIF 
    588  
    589          IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    590             DO ji=1,jpi 
    591                ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) 
    592                vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) 
    593                hbdy_s(ji) = zsshn(ji,2) 
    594             END DO 
    595          ENDIF 
    596  
    597          IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    598             DO ji=1,jpi 
    599                ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) 
    600                vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) 
    601                hbdy_n(ji) = zsshn(ji,nlcj-1) 
    602             END DO 
    603          ENDIF 
    604  
    605          CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn ) 
    606       ENDIF ! jn==1 
    607  
    608       ! Then update velocities at each barotropic time step 
    609619      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    610620         DO jj=1,jpj 
     
    653663   END SUBROUTINE Agrif_dyn_ts 
    654664 
     665   SUBROUTINE Agrif_dta_ts( kt ) 
     666      !!---------------------------------------------------------------------- 
     667      !!                  ***  ROUTINE Agrif_dta_ts  *** 
     668      !!----------------------------------------------------------------------   
     669      !!  
     670      INTEGER, INTENT(in) ::   kt 
     671      !! 
     672      INTEGER :: ji, jj 
     673      LOGICAL :: ll_int_cons 
     674      REAL(wp) :: zrhox, zrhoy, zrhot, zt 
     675      REAL(wp) :: zaa, zab, zat 
     676      REAL(wp) :: zt0, zt1 
     677      REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn 
     678      REAL(wp), POINTER, DIMENSION(:,:) :: zuab, zvab, zubb, zvbb, zutn, zvtn 
     679      !!----------------------------------------------------------------------   
     680 
     681      IF( Agrif_Root() )   RETURN 
     682 
     683      ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in 
     684                             ! the forward case only 
     685 
     686      zrhox = Agrif_Rhox() 
     687      zrhoy = Agrif_Rhoy() 
     688      zrhot = Agrif_rhot() 
     689 
     690      IF ( kt==nit000 ) THEN ! Allocate boundary data arrays 
     691         ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj)) 
     692         ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj)) 
     693         ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi)) 
     694         ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi)) 
     695      ENDIF 
     696 
     697      CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn ) 
     698 
     699      ! "Central" time index for interpolation: 
     700      IF (ln_bt_fw) THEN 
     701         zt = REAL(Agrif_NbStepint()+0.5_wp,wp) / zrhot 
     702      ELSE 
     703         zt = REAL(Agrif_NbStepint(),wp) / zrhot 
     704      ENDIF 
     705 
     706      ! Linear interpolation of sea level 
     707      Agrif_SpecialValue    = 0.e0 
     708      Agrif_UseSpecialValue = .TRUE. 
     709      CALL Agrif_Bc_variable(zsshn, sshn_id,calledweight=zt, procname=interpsshn ) 
     710      Agrif_UseSpecialValue = .FALSE. 
     711 
     712      ! Interpolate barotropic fluxes 
     713      Agrif_SpecialValue=0. 
     714      Agrif_UseSpecialValue = ln_spc_dyn 
     715 
     716      IF (ll_int_cons) THEN ! Conservative interpolation 
     717         CALL wrk_alloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn ) 
     718         zuab(:,:) = 0._wp ; zvab(:,:) = 0._wp 
     719         zubb(:,:) = 0._wp ; zvbb(:,:) = 0._wp 
     720         zutn(:,:) = 0._wp ; zvtn(:,:) = 0._wp 
     721         CALL Agrif_Bc_variable(zubb,unb_id ,calledweight=0._wp, procname=interpunb) ! Before 
     722         CALL Agrif_Bc_variable(zvbb,vnb_id ,calledweight=0._wp, procname=interpvnb) 
     723         CALL Agrif_Bc_variable(zuab,unb_id ,calledweight=1._wp, procname=interpunb) ! After 
     724         CALL Agrif_Bc_variable(zvab,vnb_id ,calledweight=1._wp, procname=interpvnb) 
     725         CALL Agrif_Bc_variable(zutn,ub2b_id,calledweight=1._wp, procname=interpub2b)! Time integrated 
     726         CALL Agrif_Bc_variable(zvtn,vb2b_id,calledweight=1._wp, procname=interpvb2b) 
     727          
     728         ! Time indexes bounds for integration 
     729         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
     730         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 
     731 
     732         ! Polynomial interpolation coefficients: 
     733         zaa = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     734                 &      - zt0**2._wp * (       zt0 - 1._wp)        ) 
     735         zab = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     736                 &      - zt0        * (       zt0 - 1._wp)**2._wp ) 
     737         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)        & 
     738                 &      - zt0**2._wp * (-2._wp*zt0 + 3._wp)        )  
     739 
     740         ! Do time interpolation 
     741         IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     742            DO jj=1,jpj 
     743               zunb(2,jj) = zaa * zuab(2,jj) + zab * zubb(2,jj) + zat * zutn(2,jj) 
     744               zvnb(2,jj) = zaa * zvab(2,jj) + zab * zvbb(2,jj) + zat * zvtn(2,jj) 
     745            END DO 
     746         ENDIF 
     747         IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     748            DO jj=1,jpj 
     749               zunb(nlci-2,jj) = zaa * zuab(nlci-2,jj) + zab * zubb(nlci-2,jj) + zat * zutn(nlci-2,jj) 
     750               zvnb(nlci-1,jj) = zaa * zvab(nlci-1,jj) + zab * zvbb(nlci-1,jj) + zat * zvtn(nlci-1,jj) 
     751            END DO 
     752         ENDIF 
     753         IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     754            DO ji=1,jpi 
     755               zunb(ji,2) = zaa * zuab(ji,2) + zab * zubb(ji,2) + zat * zutn(ji,2) 
     756               zvnb(ji,2) = zaa * zvab(ji,2) + zab * zvbb(ji,2) + zat * zvtn(ji,2) 
     757            END DO 
     758         ENDIF 
     759         IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     760            DO ji=1,jpi 
     761               zunb(ji,nlcj-1) = zaa * zuab(ji,nlcj-1) + zab * zubb(ji,nlcj-1) + zat * zutn(ji,nlcj-1) 
     762               zvnb(ji,nlcj-2) = zaa * zvab(ji,nlcj-2) + zab * zvbb(ji,nlcj-2) + zat * zvtn(ji,nlcj-2) 
     763            END DO 
     764         ENDIF 
     765         CALL wrk_dealloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn ) 
     766 
     767      ELSE ! Linear interpolation 
     768         zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp 
     769         CALL Agrif_Bc_variable(zunb,unb_id,calledweight=zt, procname=interpunb) 
     770         CALL Agrif_Bc_variable(zvnb,vnb_id,calledweight=zt, procname=interpvnb) 
     771      ENDIF 
     772      Agrif_UseSpecialValue = .FALSE. 
     773 
     774      ! Fill boundary data arrays: 
     775      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     776         DO jj=1,jpj 
     777               ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) * umask(2,jj,1) 
     778               vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) * vmask(2,jj,1) 
     779               hbdy_w(jj) = zsshn(2,jj) * tmask(2,jj,1) 
     780         END DO 
     781      ENDIF 
     782 
     783      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     784         DO jj=1,jpj 
     785               ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) * umask(nlci-2,jj,1) 
     786               vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) * vmask(nlci-1,jj,1) 
     787               hbdy_e(jj) = zsshn(nlci-1,jj) * tmask(nlci-1,jj,1) 
     788         END DO 
     789      ENDIF 
     790 
     791      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     792         DO ji=1,jpi 
     793               ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) * umask(ji,2,1) 
     794               vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) * vmask(ji,2,1) 
     795               hbdy_s(ji) = zsshn(ji,2) * tmask(ji,2,1) 
     796         END DO 
     797      ENDIF 
     798 
     799      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     800         DO ji=1,jpi 
     801            ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) * umask(ji,nlcj-1,1) 
     802            vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) * vmask(ji,nlcj-2,1) 
     803            hbdy_n(ji) = zsshn(ji,nlcj-1) * tmask(ji,nlcj-1,1) 
     804         END DO 
     805      ENDIF 
     806 
     807      CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn ) 
     808 
     809   END SUBROUTINE Agrif_dta_ts 
     810 
    655811   SUBROUTINE Agrif_ssh( kt ) 
    656812      !!---------------------------------------------------------------------- 
     
    686842   END SUBROUTINE Agrif_ssh 
    687843 
    688    SUBROUTINE Agrif_ssh_ts( kt ) 
     844   SUBROUTINE Agrif_ssh_ts( jn ) 
    689845      !!---------------------------------------------------------------------- 
    690846      !!                  ***  ROUTINE Agrif_ssh_ts  *** 
    691847      !!----------------------------------------------------------------------   
    692       INTEGER, INTENT(in) ::   kt 
    693       !! 
     848      INTEGER, INTENT(in) ::   jn 
     849      !! 
     850      INTEGER :: ji,jj 
    694851      !!----------------------------------------------------------------------   
    695852 
    696853      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    697          ssha_e(2,:) = ssha_e(3,:) 
     854         DO jj=1,jpj 
     855            ssha_e(2,jj) = hbdy_w(jj) 
     856         END DO 
    698857      ENDIF 
    699858 
    700859      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    701          ssha_e(nlci-1,:) = ssha_e(nlci-2,:)     
     860         DO jj=1,jpj 
     861            ssha_e(nlci-1,jj) = hbdy_e(jj) 
     862         END DO 
    702863      ENDIF 
    703864 
    704865      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    705          ssha_e(:,2) = ssha_e(:,3) 
     866         DO ji=1,jpi 
     867            ssha_e(ji,2) = hbdy_s(ji) 
     868         END DO 
    706869      ENDIF 
    707870 
    708871      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    709          ssha_e(:,nlcj-1) = ssha_e(:,nlcj-2)             
     872         DO ji=1,jpi 
     873            ssha_e(ji,nlcj-1) = hbdy_n(ji) 
     874         END DO 
    710875      ENDIF 
    711876 
     
    740905            DO ji=i1,i2 
    741906               tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    742                tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk) 
     907               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 
    743908            END DO 
    744909         END DO 
     
    781946            DO ji=i1,i2 
    782947               tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    783                tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk) 
     948               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 
    784949            END DO 
    785950         END DO 
     
    815980      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    816981      !! 
    817       INTEGER :: ji,jj,jk 
    818       !!----------------------------------------------------------------------   
    819  
    820       tabres(:,:) = 0.e0 
    821       DO jk=1,jpkm1 
    822          DO jj=j1,j2 
    823             DO ji=i1,i2 
    824                tabres(ji,jj) = tabres(ji,jj) + e2u(ji,jj) * un(ji,jj,jk) & 
    825                   * umask(ji,jj,jk) * fse3u(ji,jj,jk) 
    826             END DO 
     982      INTEGER :: ji,jj 
     983      !!----------------------------------------------------------------------   
     984 
     985      DO jj=j1,j2 
     986         DO ji=i1,i2 
     987            tabres(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj)  
    827988         END DO 
    828989      END DO 
     
    837998      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    838999      !! 
    839       INTEGER :: ji,jj,jk 
    840       !!----------------------------------------------------------------------   
    841  
    842       tabres(:,:) = 0.e0 
    843       DO jk=1,jpkm1 
    844          DO jj=j1,j2 
    845             DO ji=i1,i2 
    846                tabres(ji,jj) = tabres(ji,jj) + e1v(ji,jj) * vn(ji,jj,jk) & 
    847                   * vmask(ji,jj,jk) * fse3v(ji,jj,jk) 
    848             END DO 
     1000      INTEGER :: ji,jj 
     1001      !!----------------------------------------------------------------------   
     1002 
     1003      DO jj=j1,j2 
     1004         DO ji=i1,i2 
     1005            tabres(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 
    8491006         END DO 
    8501007      END DO 
    8511008 
    8521009   END SUBROUTINE interpvnb 
     1010 
     1011   SUBROUTINE interpub2b(tabres,i1,i2,j1,j2) 
     1012      !!---------------------------------------------------------------------- 
     1013      !!                  ***  ROUTINE interpub2b  *** 
     1014      !!----------------------------------------------------------------------   
     1015      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     1016      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     1017      !! 
     1018      INTEGER :: ji,jj 
     1019      !!----------------------------------------------------------------------   
     1020 
     1021      DO jj=j1,j2 
     1022         DO ji=i1,i2 
     1023            tabres(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 
     1024         END DO 
     1025      END DO 
     1026 
     1027   END SUBROUTINE interpub2b 
     1028 
     1029   SUBROUTINE interpvb2b(tabres,i1,i2,j1,j2) 
     1030      !!---------------------------------------------------------------------- 
     1031      !!                  ***  ROUTINE interpvb2b  *** 
     1032      !!----------------------------------------------------------------------   
     1033      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     1034      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     1035      !! 
     1036      INTEGER :: ji,jj 
     1037      !!----------------------------------------------------------------------   
     1038 
     1039      DO jj=j1,j2 
     1040         DO ji=i1,i2 
     1041            tabres(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 
     1042         END DO 
     1043      END DO 
     1044 
     1045   END SUBROUTINE interpvb2b 
    8531046 
    8541047#else 
Note: See TracChangeset for help on using the changeset viewer.