New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4486 – NEMO

Changeset 4486


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

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

Location:
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r4292 r4486  
    4040   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
    4141   INTEGER :: trn_id, trb_id, tra_id 
    42    INTEGER :: unb_id, vnb_id 
     42   INTEGER :: unb_id, vnb_id, ub2b_id, vb2b_id 
    4343 
    4444   !!---------------------------------------------------------------------- 

  • 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 

  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r3294 r4486  
    1010   USE lib_mpp 
    1111   USE wrk_nemo   
     12   USE dynspg_oce 
    1213 
    1314   IMPLICIT NONE 
    … …  
    3435      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    3536 
    36         
     37 
    3738      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    3839#if defined TWO_WAY 
    … …  
    7980 
    8081      CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d) 
    81       CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d)   
     82      CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d) 
     83 
     84#if defined key_dynspg_ts 
     85      IF (ln_bt_fw) THEN 
     86         ! Update time integrated transports 
     87         IF (mod(nbcline,nbclineupdate) == 0) THEN 
     88            CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b) 
     89            CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b) 
     90         ELSE 
     91            CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b) 
     92            CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b) 
     93         ENDIF 
     94      END IF  
     95#endif 
    8296 
    8397      nbcline = nbcline + 1 
    8498 
    85       Agrif_UseSpecialValueInUpdate = ln_spc_dyn 
     99      Agrif_UseSpecialValueInUpdate = .TRUE.  
    86100      Agrif_SpecialValueFineGrid = 0. 
    87101      CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH) 
    … …  
    238252      IF (before) THEN 
    239253         zrhoy = Agrif_Rhoy() 
    240          DO jk = 1,jpkm1 
    241             DO jj=j1,j2 
    242                DO ji=i1,i2 
    243                   tabres(ji,jj) = tabres(ji,jj) + fse3u(ji,jj,jk) * un(ji,jj,jk) 
    244                END DO 
    245             END DO 
    246          END DO 
    247          DO jj=j1,j2 
    248             DO ji=i1,i2 
    249                tabres(ji,jj) = tabres(ji,jj) * e2u(ji,jj) 
     254         DO jj=j1,j2 
     255            DO ji=i1,i2 
     256               tabres(ji,jj) = un_b(ji,jj) * hu(ji,jj) * e2u(ji,jj) 
    250257            END DO 
    251258         END DO 
    … …  
    266273                  END DO 
    267274               ENDIF 
     275               ! Update barotropic velocities: 
     276               un_b(ji,jj) = tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj) 
    268277            END DO 
    269278         END DO 
    … …  
    287296      IF (before) THEN 
    288297         zrhox = Agrif_Rhox() 
    289          tabres = 0.e0 
    290          DO jk = 1,jpkm1 
    291             DO jj=j1,j2 
    292                DO ji=i1,i2 
    293                   tabres(ji,jj) = tabres(ji,jj) + fse3v(ji,jj,jk) * vn(ji,jj,jk) 
    294                END DO 
    295             END DO 
    296          END DO 
    297          DO jj=j1,j2 
    298             DO ji=i1,i2 
    299                tabres(ji,jj) = tabres(ji,jj) * e1v(ji,jj) 
     298         DO jj=j1,j2 
     299            DO ji=i1,i2 
     300               tabres(ji,jj) = vn_b(ji,jj) * hv(ji,jj) * e1v(ji,jj)  
    300301            END DO 
    301302         END DO 
    … …  
    316317                  END DO 
    317318               ENDIF 
     319               ! Update barotropic velocities: 
     320               vn_b(ji,jj) = tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj) 
    318321            END DO 
    319322         END DO 
    … …  
    333336 
    334337      INTEGER :: ji, jj 
    335       REAL(wp) :: zrhox, zrhoy 
     338 
     339      IF (before) THEN 
     340         DO jj=j1,j2 
     341            DO ji=i1,i2 
     342               tabres(ji,jj) = sshn(ji,jj) 
     343            END DO 
     344         END DO 
     345      ELSE 
     346         DO jj=j1,j2 
     347            DO ji=i1,i2 
     348               sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1) 
     349            END DO 
     350         END DO 
     351      ENDIF 
     352 
     353   END SUBROUTINE updateSSH 
     354 
     355   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) 
     356      !!--------------------------------------------- 
     357      !!          *** ROUTINE updateub2b *** 
     358      !!--------------------------------------------- 
     359 
     360      INTEGER, INTENT(in) :: i1, i2, j1, j2 
     361      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     362      LOGICAL, INTENT(in) :: before 
     363 
     364      INTEGER :: ji, jj 
     365      REAL(wp) :: zrhoy 
     366 
     367      IF (before) THEN 
     368         zrhoy = Agrif_Rhoy() 
     369         DO jj=j1,j2 
     370            DO ji=i1,i2 
     371               tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj) 
     372            END DO 
     373         END DO 
     374         tabres = zrhoy * tabres 
     375      ELSE 
     376         DO jj=j1,j2 
     377            DO ji=i1,i2 
     378               ub2_b(ji,jj) = tabres(ji,jj) / e2u(ji,jj) 
     379            END DO 
     380         END DO 
     381      ENDIF 
     382 
     383   END SUBROUTINE updateub2b 
     384 
     385   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 
     386      !!--------------------------------------------- 
     387      !!          *** ROUTINE updatevb2b *** 
     388      !!--------------------------------------------- 
     389 
     390      INTEGER, INTENT(in) :: i1, i2, j1, j2 
     391      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     392      LOGICAL, INTENT(in) :: before 
     393 
     394      INTEGER :: ji, jj 
     395      REAL(wp) :: zrhox 
    336396 
    337397      IF (before) THEN 
    338398         zrhox = Agrif_Rhox() 
    339          zrhoy = Agrif_Rhoy() 
    340          DO jj=j1,j2 
    341             DO ji=i1,i2 
    342                tabres(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * sshn(ji,jj) 
    343             END DO 
    344          END DO 
    345          tabres = zrhox * zrhoy * tabres 
    346       ELSE 
    347          DO jj=j1,j2 
    348             DO ji=i1,i2 
    349                sshn(ji,jj) = tabres(ji,jj) / (e1t(ji,jj) * e2t(ji,jj)) 
    350                sshn(ji,jj) = sshn(ji,jj) * tmask(ji,jj,1) 
    351             END DO 
    352          END DO 
    353       ENDIF 
    354  
    355    END SUBROUTINE updateSSH 
     399         DO jj=j1,j2 
     400            DO ji=i1,i2 
     401               tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj)  
     402            END DO 
     403         END DO 
     404         tabres = zrhox * tabres 
     405      ELSE 
     406         DO jj=j1,j2 
     407            DO ji=i1,i2 
     408               vb2_b(ji,jj) = tabres(ji,jj) / e1v(ji,jj) 
     409            END DO 
     410         END DO 
     411      ENDIF 
     412 
     413   END SUBROUTINE updatevb2b 
    356414 
    357415#else 
    … …  
    365423#endif 
    366424END MODULE agrif_opa_update 
     425 

  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r4331 r4486  
    294294   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    295295   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
     296   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id) 
     297   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id) 
    296298 
    297299   ! 2. Type of interpolation 
    … …  
    309311   Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    310312   Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     313   Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     314   Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    311315 
    312316   ! 3. Location of interpolation 
    … …  
    318322   Call Agrif_Set_bc(unb_id,(/0,1/)) 
    319323   Call Agrif_Set_bc(vnb_id,(/0,1/)) 
     324   Call Agrif_Set_bc(ub2b_id,(/0,1/)) 
     325   Call Agrif_Set_bc(vb2b_id,(/0,1/)) 
    320326 
    321327   Call Agrif_Set_bc(tsn_id,(/0,1/)) 
    … …  
    335341   Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    336342   Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     343 
     344   Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     345   Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    337346 
    338347END SUBROUTINE agrif_declare_var 

  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r4386 r4486  
    965965      ENDIF 
    966966 
     967#if defined key_agrif 
     968      IF (.NOT.Agrif_Root()) CALL ctl_stop( 'AGRIF not implemented with non-linear free surface (key_vvl)' ) 
     969#endif 
     970 
    967971   END SUBROUTINE dom_vvl_ctl 
    968972 

  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    r4370 r4486  
    3939   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur_e , hvr_e    ! inverse of hu_e and hv_e 
    4040   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv, vn_adv   ! Advection vel. at "now" barocl. step 
    41    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b,  vb2_b    ! Advection vel. at "now-0.5" barocl. step 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b,  vb2_b    ! Half step fluxes (ln_bt_fw=T) 
     42#if defined key_agrif 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b,  vb2_i_b! Half step time integrated fluxes  
     44#endif 
    4245 
    4346   !!---------------------------------------------------------------------- 
    … …  
    5558         &      ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) ,      & 
    5659         &      ub2_b(jpi,jpj)  , vb2_b(jpi,jpj)                                 ,      & 
     60#if defined key_agrif 
     61         &      ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                               ,      & 
     62#endif 
    5763         &      un_adv(jpi,jpj) , vn_adv(jpi,jpj)                                , STAT = dynspg_oce_alloc ) 
    5864         ! 

  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4374 r4486  
    143143      REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      - 
    144144      REAL(wp) ::   z1_12, z1_8, z1_4, z1_2    !   -      - 
    145       REAL(wp) ::   zu_spg, zv_spg                !   -      - 
     145      REAL(wp) ::   zu_spg, zv_spg             !   -      - 
    146146      REAL(wp) ::   zhura, zhvra               !   -      - 
    147147      REAL(wp) ::   za0, za1, za2, za3           !   -      - 
    … …  
    204204         CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) 
    205205         ! 
    206          IF ((neuler/=0).AND.(ln_bt_fw)) CALL ts_rst( nit000, 'READ' )  
    207206         ! 
    208207      ENDIF 
    … …  
    449448         zssh_frc(:,:) = zssh_frc(:,:) + ssh_iau(:,:) 
    450449      ENDIF 
     450#endif 
     451      !                                   !* Fill boundary data arrays with AGRIF 
     452      !                                   ! ------------------------------------- 
     453#if defined key_agrif 
     454         IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt ) 
    451455#endif 
    452456      ! 
    … …  
    543547         zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5 
    544548         zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 
     549         ! 
     550#if defined key_agrif 
     551         ! Set fluxes during predictor step to ensure  
     552         ! volume conservation 
     553         IF( (.NOT.Agrif_Root()).AND.ln_bt_fw ) THEN 
     554            IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     555               DO jj=1,jpj 
     556                  zwx(2,jj) = ubdy_w(jj) * e2u(2,jj) 
     557               END DO 
     558            ENDIF 
     559            IF((nbondi ==  1).OR.(nbondi == 2)) THEN 
     560               DO jj=1,jpj 
     561                  zwx(nlci-2,jj) = ubdy_e(jj) * e2u(nlci-2,jj) 
     562               END DO 
     563            ENDIF 
     564            IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     565               DO ji=1,jpi 
     566                  zwy(ji,2) = vbdy_s(ji) * e1v(ji,2) 
     567               END DO 
     568            ENDIF 
     569            IF((nbondj ==  1).OR.(nbondj == 2)) THEN 
     570               DO ji=1,jpi 
     571                  zwy(ji,nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-2) 
     572               END DO 
     573            ENDIF 
     574         ENDIF 
     575#endif 
     576         ! 
     577         ! Sum over sub-time-steps to compute advective velocities 
     578         za2 = wgtbtp2(jn) 
     579         zu_sum  (:,:) = zu_sum  (:,:) + za2 * zwx  (:,:) / e2u  (:,:) 
     580         zv_sum  (:,:) = zv_sum  (:,:) + za2 * zwy  (:,:) / e1v  (:,:) 
     581         ! 
     582         ! Set next sea level: 
    545583         DO jj = 2, jpjm1                                  
    546584            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    549587            END DO 
    550588         END DO 
    551          ! 
    552          ! Sum over sub-time-steps to compute advective velocities 
    553          za2 = wgtbtp2(jn) 
    554          zu_sum  (:,:) = zu_sum  (:,:) + za2 * ua_e  (:,:) * zhup2_e  (:,:) 
    555          zv_sum  (:,:) = zv_sum  (:,:) + za2 * va_e  (:,:) * zhvp2_e  (:,:) 
    556          ! 
    557          ! Set next sea level: 
    558589         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    559590         CALL lbc_lnk( ssha_e, 'T',  1._wp ) 
    … …  
    754785         IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, zun_e, zvn_e, hur_e, hvr_e, ssha_e ) 
    755786#endif 
    756 #if defined key_agrif 
    757          IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( kt, jn ) ! Agrif 
     787#if defined key_agrif                                                            
     788         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn ) ! Agrif 
    758789#endif 
    759790         !                                             !* Swap 
    … …  
    842873         ! 
    843874      END DO 
     875      ! 
     876#if defined key_agrif 
     877      ! Save time integrated fluxes during child grid integration 
     878      ! (used to update coarse grid transports) 
     879      ! Useless with 2nd order momentum schemes 
     880      ! 
     881      IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN 
     882         IF ( Agrif_NbStepint().EQ.0 ) THEN 
     883            ub2_i_b(:,:) = 0.e0 
     884            vb2_i_b(:,:) = 0.e0 
     885         END IF 
     886         ! 
     887         za1 = 1._wp / REAL(Agrif_rhot(), wp) 
     888         ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 
     889         vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 
     890      ENDIF 
     891      ! 
     892      ! 
     893#endif       
    844894      ! 
    845895      !                                   !* write time-spliting arrays in the restart 
    … …  
    9561006            CALL iom_get( numror, jpdom_autoglo, 'vb_e'     ,    vb_e(:,:) ) 
    9571007         ENDIF 
     1008#if defined key_agrif 
     1009         ! Read time integrated fluxes 
     1010         IF ( .NOT.Agrif_Root() ) THEN 
     1011            CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b'  , ub2_i_b(:,:) )    
     1012            CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b'  , vb2_i_b(:,:) ) 
     1013         ENDIF 
     1014#endif 
    9581015      ! 
    9591016      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
    … …  
    9691026            CALL iom_rstput( kt, nitrst, numrow, 'vb_e'     ,    vb_e(:,:) ) 
    9701027         ENDIF 
     1028#if defined key_agrif 
     1029         ! Save time integrated fluxes 
     1030         IF ( .NOT.Agrif_Root() ) THEN 
     1031            CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b'  , ub2_i_b(:,:) ) 
     1032            CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b'  , vb2_i_b(:,:) ) 
     1033         ENDIF 
     1034#endif 
    9711035      ENDIF 
    9721036      ! 
    … …  
    10531117      ENDIF 
    10541118      ! 
     1119#if defined key_agrif 
     1120      ! Restrict the use of Agrif to the forward case only 
     1121      IF ((.NOT.ln_bt_fw ).AND.(.NOT.Agrif_Root())) CALL ctl_stop( 'AGRIF not implemented if ln_bt_fw=.FALSE.' ) 
     1122#endif 
     1123      ! 
    10551124      IF(lwp) WRITE(numout,*)    '     Time filter choice, nn_bt_flt: ', nn_bt_flt 
    10561125      SELECT CASE ( nn_bt_flt ) 
    … …  
    10721141         CALL ctl_stop( 'dynspg_ts ERROR: Maximum Courant number is greater than 0.9: Inc. nn_baro !' )           
    10731142      ENDIF 
     1143      ! 
     1144      IF ((neuler/=0).AND.(ln_bt_fw)) CALL ts_rst( nit000, 'READ' )  
    10741145      ! 
    10751146      CALL wrk_dealloc( jpi, jpj, zcu ) 
    … …  
    11041175 
    11051176 
     1177 

  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r4370 r4486  
    113113      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    114114 
     115#if ! defined key_dynspg_ts 
     116      ! These lines are not necessary with time splitting since 
     117      ! boundary condition on sea level is set during ts loop 
    115118#if defined key_agrif 
    116119      CALL agrif_ssh( kt ) 
    117120#endif 
    118121#if defined key_bdy 
    119       ! bg jchanut tschanges 
    120       ! These lines are not necessary with time splitting since 
    121       ! boundary condition on sea level is set during ts loop 
    122122      IF (lk_bdy) THEN 
    123123         CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 
    … …  
    125125      ENDIF 
    126126#endif 
    127       ! end jchanut tschanges 
     127#endif 
     128 
    128129#if defined key_asminc 
    129130      !                                                ! Include the IAU weighted SSH increment 
Note: See TracChangeset for help on using the changeset viewer.