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 11741 – NEMO

Changeset 11741


Ignore:
Timestamp:
2019-10-21T12:26:39+02:00 (4 years ago)
Author:
jchanut
Message:

#2222: correct definition of parent vertical grid on the child domain to perform vertical interpolation at boundaries. Use additionnal parent depths and number of levels arrays interpolated on the child grid domain to do so.
Correction of vertical interpolation of viscosity remains to be done as well as duplication of changes for passive tracers.

Location:
NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce.F90

    r11590 r11741  
    4646   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy, vbdy, hbdy 
    4747 
     48# if defined key_vertical 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht0_parent, hu0_parent, hv0_parent 
     50   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt_parent, mbku_parent, mbkv_parent 
     51# endif 
    4852 
    4953   INTEGER, PUBLIC :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update 
    … …  
    6064   INTEGER, PUBLIC :: avt_id, avm_id, en_id                ! TKE related identificators 
    6165   INTEGER, PUBLIC :: umsk_id, vmsk_id 
     66   INTEGER, PUBLIC :: mbkt_id, ht0_id 
    6267   INTEGER, PUBLIC :: kindic_agr 
    6368    
    … …  
    8388# if defined key_top          
    8489         &      tabspongedone_trn(jpi,jpj),           & 
    85 # endif          
     90# endif    
     91# if defined key_vertical 
     92         &      ht0_parent(jpi,jpj), mbkt_parent(jpi,jpj),  & 
     93         &      hu0_parent(jpi,jpj), mbku_parent(jpi,jpj),  & 
     94         &      hv0_parent(jpi,jpj), mbkv_parent(jpi,jpj),  & 
     95# endif       
    8696         &      tabspongedone_u  (jpi,jpj),           & 
    8797         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) ) 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_interp.F90

    r11625 r11741  
    4444   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    4545   PUBLIC   interpe3t, interpumsk, interpvmsk 
    46  
     46#if defined key_vertical 
     47   PUBLIC   interpht0, interpmbkt 
     48# endif 
    4749   INTEGER ::   bdy_tinterp = 0 
    4850 
    … …  
    662664      INTEGER  ::   N_in, N_out 
    663665      ! vertical interpolation: 
    664       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jpts) :: ptab_child 
     666      REAL(wp) :: zhtot 
    665667      REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin 
    666668      REAL(wp), DIMENSION(k1:k2) :: h_in 
    … …  
    680682 
    681683# if defined key_vertical 
    682         DO jk=k1,k2 
     684        ! Interpolate thicknesses 
     685        ! Warning: these are masked, hence extrapolated prior interpolation. 
     686        DO jk=k1,k2-1 
    683687           DO jj=j1,j2 
    684688              DO ji=i1,i2 
    685                  ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk)  
     689                  ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
    686690              END DO 
    687691           END DO 
    688692        END DO 
     693 
     694        ! Extrapolate thicknesses in partial bottom cells: 
     695        ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     696        IF (ln_zps) THEN 
     697           DO jj=j1,j2 
     698              DO ji=i1,i2 
     699                  jk = mbkt(ji,jj) 
     700                  ptab(ji,jj,jk,jpts+1) = 0._wp 
     701              END DO 
     702           END DO            
     703        END IF 
     704      
     705        ! Save ssh at last level: 
     706        IF (.NOT.ln_linssh) THEN 
     707           ptab(i1:i2,j1:j2,k2,jpts+1) = sshn(i1:i2,j1:j2)*tmask(i1:i2,j1:j2,1)  
     708        ELSE 
     709           ptab(i1:i2,j1:j2,k2,jpts+1) = 0._wp 
     710        END IF       
    689711# endif 
    690712      ELSE  
    691713 
    692 # if defined key_vertical               
     714# if defined key_vertical  
     715         IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp  
     716             
    693717         DO jj=j1,j2 
    694718            DO ji=i1,i2 
    695                ptab_child(ji,jj,:,:) = 0._wp 
    696                N_in = 0 
    697                DO jk=k1,k2 !k2 = jpk of parent grid 
    698                   IF (ptab(ji,jj,jk,n2) == 0) EXIT 
    699                   N_in = N_in + 1 
     719               tsa(ji,jj,:,:) = 0._wp 
     720               N_in = mbkt_parent(ji,jj) 
     721               zhtot = 0._wp 
     722               DO jk=1,N_in !k2 = jpk of parent grid 
     723                  IF (jk==N_in) THEN 
     724                     h_in(jk) = ht0_parent(ji,jj) + ptab(ji,jj,k2,n2) - zhtot 
     725                  ELSE 
     726                     h_in(jk) = ptab(ji,jj,jk,n2) 
     727                  ENDIF 
     728                  zhtot = zhtot + h_in(jk) 
    700729                  tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 
    701                   h_in(N_in) = ptab(ji,jj,jk,n2) 
    702730               END DO 
    703731               N_out = 0 
    … …  
    708736               ENDDO 
    709737               IF (N_in*N_out > 0) THEN 
    710                   CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),ptab_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
     738                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tsa(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    711739               ENDIF 
    712740            ENDDO 
    713741         ENDDO 
    714742# else 
    715          ptab_child(i1:i2,j1:j2,1:jpk,1:jpts) = ptab(i1:i2,j1:j2,1:jpk,1:jpts) 
    716 # endif 
    717743         ! 
    718744         DO jn=1, jpts 
    719             tsa(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
    720          END DO 
     745            tsa(i1:i2,j1:j2,1:jpk,jn)=ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
     746         END DO 
     747# endif 
    721748 
    722749      ENDIF 
    … …  
    752779      !! 
    753780      INTEGER :: ji,jj,jk 
    754       REAL(wp) :: zrhoy 
     781      REAL(wp) :: zrhoy, zhtot 
    755782      ! vertical interpolation: 
    756783      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    … …  
    766793                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk))  
    767794# if defined key_vertical 
    768                   ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)) 
     795                  ! Interpolate thicknesses (masked for subsequent extrapolation) 
     796                  ptab(ji,jj,jk,2) = umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk) 
    769797# endif 
    770798               END DO 
    771799            END DO 
    772800         END DO 
     801# if defined key_vertical 
     802         ! Extrapolate thicknesses in partial bottom cells: 
     803         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     804         IF (ln_zps) THEN 
     805            DO jj=j1,j2 
     806               DO ji=i1,i2 
     807                  jk = mbku(ji,jj) 
     808                  ptab(ji,jj,jk,2) = 0._wp 
     809               END DO 
     810            END DO            
     811         END IF 
     812        ! Save ssh at last level: 
     813        ptab(i1:i2,j1:j2,k2,2) = 0._wp 
     814        IF (.NOT.ln_linssh) THEN 
     815           ! This vertical sum below should be replaced by the sea-level at U-points (optimization): 
     816           DO jk=1,jpk 
     817              ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3u_n(i1:i2,j1:j2,jk) * umask(i1:i2,j1:j2,jk) 
     818           END DO 
     819           ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hu_0(i1:i2,j1:j2) 
     820        END IF  
     821# endif 
     822         ! 
    773823      ELSE 
    774824         zrhoy = Agrif_rhoy() 
    … …  
    776826! VERTICAL REFINEMENT BEGIN 
    777827 
     828         IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
     829 
    778830         DO ji=i1,i2 
    779831            DO jj=j1,j2 
    780                N_in = 0 
    781                DO jk=k1,k2 
    782                   IF (ptab(ji,jj,jk,2) == 0) EXIT 
    783                   N_in = N_in + 1 
    784                   tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2) 
    785                   h_in(N_in) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)  
     832               ua(ji,jj,:) = 0._wp 
     833               N_in = mbku_parent(ji,jj) 
     834               zhtot = 0._wp 
     835               DO jk=1,N_in 
     836                  IF (jk==N_in) THEN 
     837                     h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 
     838                  ELSE 
     839                     h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)  
     840                  ENDIF 
     841                  zhtot = zhtot + h_in(jk) 
     842                  tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)*zrhoy*h_in(jk)) 
    786843              ENDDO 
    787           
    788               IF (N_in == 0) THEN 
    789                  ua(ji,jj,:) = 0._wp 
    790                  CYCLE 
    791               ENDIF 
    792           
     844                   
    793845              N_out = 0 
    794846              DO jk=1,jpk 
    … …  
    797849                 h_out(N_out) = e3u_a(ji,jj,jk) 
    798850              ENDDO 
    799           
    800               IF (N_out == 0) THEN 
    801                  ua(ji,jj,:) = 0._wp 
    802                  CYCLE 
     851              IF (N_in*N_out > 0) THEN 
     852                 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ua(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    803853              ENDIF 
    804           
    805               CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ua(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    806854            ENDDO 
    807855         ENDDO 
    … …  
    834882      REAL(wp), DIMENSION(1:jpk) :: h_out 
    835883      INTEGER  :: N_in, N_out 
    836       REAL(wp) :: h_diff 
     884      REAL(wp) :: h_diff, zhtot 
    837885      !!---------------------------------------------     
    838886      !       
    … …  
    843891                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk)) 
    844892# if defined key_vertical 
     893                  ! Interpolate thicknesses (masked for subsequent extrapolation) 
    845894                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
    846895# endif 
    … …  
    848897            END DO 
    849898         END DO 
     899# if defined key_vertical 
     900         ! Extrapolate thicknesses in partial bottom cells: 
     901         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     902         IF (ln_zps) THEN 
     903            DO jj=j1,j2 
     904               DO ji=i1,i2 
     905                  jk = mbkv(ji,jj) 
     906                  ptab(ji,jj,jk,2) = 0._wp 
     907               END DO 
     908            END DO            
     909         END IF 
     910        ! Save ssh at last level: 
     911        ptab(i1:i2,j1:j2,k2,2) = 0._wp 
     912        IF (.NOT.ln_linssh) THEN 
     913           ! This vertical sum below should be replaced by the sea-level at V-points (optimization): 
     914           DO jk=1,jpk 
     915              ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3v_n(i1:i2,j1:j2,jk) * vmask(i1:i2,j1:j2,jk) 
     916           END DO 
     917           ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hv_0(i1:i2,j1:j2) 
     918        END IF  
     919# endif 
    850920      ELSE        
    851921         zrhox = Agrif_rhox() 
    852922# if defined key_vertical 
    853923 
     924         IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
     925 
    854926         DO jj=j1,j2 
    855927            DO ji=i1,i2 
    856                N_in = 0 
    857                DO jk=k1,k2 
    858                   if (ptab(ji,jj,jk,2) == 0) EXIT 
    859                   N_in = N_in + 1 
    860                   tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2) 
    861                   h_in(N_in) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 
    862                END DO 
    863                IF (N_in == 0) THEN 
    864                   va(ji,jj,:) = 0._wp 
    865                   CYCLE 
    866                ENDIF 
     928               va(ji,jj,:) = 0._wp 
     929               N_in = mbkv_parent(ji,jj) 
     930               zhtot = 0._wp 
     931               DO jk=1,N_in 
     932                  IF (jk==N_in) THEN 
     933                     h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 
     934                  ELSE 
     935                     h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)  
     936                  ENDIF 
     937                  zhtot = zhtot + h_in(jk) 
     938                  tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)*zrhox*h_in(jk)) 
     939              ENDDO 
    867940          
    868941               N_out = 0 
    … …  
    872945                  h_out(N_out) = e3v_a(ji,jj,jk) 
    873946               END DO 
    874                IF (N_out == 0) THEN 
    875                  va(ji,jj,:) = 0._wp 
    876                  CYCLE 
     947 
     948               IF (N_in*N_out > 0) THEN 
     949                  call reconstructandremap(tabin(1:N_in),h_in(1:N_in),va(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    877950               ENDIF 
    878                call reconstructandremap(tabin(1:N_in),h_in(1:N_in),va(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    879951            END DO 
    880952         END DO 
    … …  
    12571329   END SUBROUTINE interpavm 
    12581330 
     1331# if defined key_vertical 
     1332   SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before ) 
     1333      !!---------------------------------------------------------------------- 
     1334      !!                  ***  ROUTINE interpsshn  *** 
     1335      !!----------------------------------------------------------------------   
     1336      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1337      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1338      LOGICAL                         , INTENT(in   ) ::   before 
     1339      ! 
     1340      !!----------------------------------------------------------------------   
     1341      ! 
     1342      IF( before) THEN 
     1343         ptab(i1:i2,j1:j2) = REAL(mbkt(i1:i2,j1:j2),wp) 
     1344      ELSE 
     1345         mbkt_parent(i1:i2,j1:j2) = NINT(ptab(i1:i2,j1:j2)) 
     1346      ENDIF 
     1347      ! 
     1348   END SUBROUTINE interpmbkt 
     1349 
     1350   SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before ) 
     1351      !!---------------------------------------------------------------------- 
     1352      !!                  ***  ROUTINE interpsshn  *** 
     1353      !!----------------------------------------------------------------------   
     1354      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1355      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1356      LOGICAL                         , INTENT(in   ) ::   before 
     1357      ! 
     1358      !!----------------------------------------------------------------------   
     1359      ! 
     1360      IF( before) THEN 
     1361         ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2) 
     1362      ELSE 
     1363         ht0_parent(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) 
     1364      ENDIF 
     1365      ! 
     1366   END SUBROUTINE interpht0 
     1367#endif 
     1368 
    12591369#else 
    12601370   !!---------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_sponge.F90

    r11625 r11741  
    258258         CALL lbc_lnk( 'agrif_Sponge', fsaht_spu, 'U', 1. )   ! Lateral boundary conditions 
    259259         CALL lbc_lnk( 'agrif_Sponge', fsaht_spv, 'V', 1. ) 
    260           
     260 
    261261         spongedoneT = .TRUE. 
    262262      ENDIF 
    … …  
    293293      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    294294      INTEGER  ::   iku, ikv 
    295       REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
     295      REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot 
    296296      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv 
    297297      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff 
    … …  
    302302      REAL(wp), DIMENSION(1:jpk) :: h_out 
    303303      INTEGER :: N_in, N_out 
    304       REAL(wp) :: h_diff 
    305304      !!---------------------------------------------------------------------- 
    306305      ! 
    … …  
    317316 
    318317# if defined key_vertical 
    319          DO jk=k1,k2 
    320             DO jj=j1,j2 
    321                DO ji=i1,i2 
    322                   tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_b(ji,jj,jk)  
    323                END DO 
    324             END DO 
    325          END DO 
     318        ! Interpolate thicknesses 
     319        ! Warning: these are masked, hence extrapolated prior interpolation. 
     320        DO jk=k1,k2-1 
     321           DO jj=j1,j2 
     322              DO ji=i1,i2 
     323                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_b(ji,jj,jk) 
     324              END DO 
     325           END DO 
     326        END DO 
     327 
     328        ! Extrapolate thicknesses in partial bottom cells: 
     329        ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     330        IF (ln_zps) THEN 
     331           DO jj=j1,j2 
     332              DO ji=i1,i2 
     333                  jk = mbkt(ji,jj) 
     334                  tabres(ji,jj,jk,jpts+1) = 0._wp 
     335              END DO 
     336           END DO            
     337        END IF 
     338      
     339        ! Save ssh at last level: 
     340        IF (.NOT.ln_linssh) THEN 
     341           tabres(i1:i2,j1:j2,k2,jpts+1) = sshb(i1:i2,j1:j2)*tmask(i1:i2,j1:j2,1)  
     342        ELSE 
     343           tabres(i1:i2,j1:j2,k2,jpts+1) = 0._wp 
     344        END IF       
    326345# endif 
    327346 
    … …  
    329348         ! 
    330349# if defined key_vertical 
     350 
     351         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp 
     352 
    331353         DO jj=j1,j2 
    332354            DO ji=i1,i2 
    333355               tabres_child(ji,jj,:,:) = 0._wp  
    334                N_in = 0 
    335                DO jk=k1,k2 !k2 = jpk of parent grid 
    336                   IF (tabres(ji,jj,jk,n2) == 0) EXIT 
    337                   N_in = N_in + 1 
     356               N_in = mbkt_parent(ji,jj) 
     357               zhtot = 0._wp 
     358               DO jk=1,N_in !k2 = jpk of parent grid 
     359                  IF (jk==N_in) THEN 
     360                     h_in(jk) = ht0_parent(ji,jj) + tabres(ji,jj,k2,n2) - zhtot 
     361                  ELSE 
     362                     h_in(jk) = tabres(ji,jj,jk,n2) 
     363                  ENDIF 
     364                  zhtot = zhtot + h_in(jk) 
    338365                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1) 
    339                   h_in(N_in) = tabres(ji,jj,jk,n2) 
    340366               END DO 
    341367               N_out = 0 
    … …  
    345371                  h_out(jk) = e3t_b(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
    346372               ENDDO 
     373 
     374               ! Account for small differences in free-surface 
     375               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     376                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
     377               ELSE 
     378                  h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
     379               ENDIF 
    347380               IF (N_in*N_out > 0) THEN 
    348381                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    … …  
    356389               DO jk=1,jpkm1 
    357390# if defined key_vertical 
    358                   tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres_child(ji,jj,jk,1:jpts) 
     391                  tsbdiff(ji,jj,jk,1:jpts) = (tsb(ji,jj,jk,1:jpts) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk) 
    359392# else 
    360                   tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres(ji,jj,jk,1:jpts) 
     393                  tsbdiff(ji,jj,jk,1:jpts) = (tsb(ji,jj,jk,1:jpts) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk) 
    361394# endif 
    362395               ENDDO 
    … …  
    427460 
    428461      ! sponge parameters  
    429       REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, h_diff 
     462      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 
    430463      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff 
    431464      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff 
    … …  
    434467      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    435468      REAL(wp), DIMENSION(1:jpk) :: h_out 
    436       INTEGER ::N_in,N_out 
     469      INTEGER ::N_in, N_out 
    437470      !!---------------------------------------------     
    438471      ! 
    … …  
    449482         END DO 
    450483 
     484# if defined key_vertical 
     485         ! Extrapolate thicknesses in partial bottom cells: 
     486         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     487         IF (ln_zps) THEN 
     488            DO jj=j1,j2 
     489               DO ji=i1,i2 
     490                  jk = mbku(ji,jj) 
     491                  tabres(ji,jj,jk,m2) = 0._wp 
     492               END DO 
     493            END DO            
     494         END IF 
     495        ! Save ssh at last level: 
     496        tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
     497        IF (.NOT.ln_linssh) THEN 
     498           ! This vertical sum below should be replaced by the sea-level at U-points (optimization): 
     499           DO jk=1,jpk 
     500              tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u_b(i1:i2,j1:j2,jk) * umask(i1:i2,j1:j2,jk) 
     501           END DO 
     502           tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2) 
     503        END IF  
     504# endif 
     505 
    451506      ELSE 
    452507 
    453508# if defined key_vertical 
    454          tabres_child(:,:,:) = 0._wp 
     509         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
     510 
    455511         DO jj=j1,j2 
    456512            DO ji=i1,i2 
    457                N_in = 0 
    458                DO jk=k1,k2 
    459                   IF (tabres(ji,jj,jk,m2) == 0) EXIT 
    460                   N_in = N_in + 1 
     513               tabres_child(ji,jj,:) = 0._wp 
     514               N_in = mbku_parent(ji,jj) 
     515               zhtot = 0._wp 
     516               DO jk=1,N_in 
     517                  IF (jk==N_in) THEN 
     518                     h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     519                  ELSE 
     520                     h_in(jk) = tabres(ji,jj,jk,m2) 
     521                  ENDIF 
     522                  zhtot = zhtot + h_in(jk) 
    461523                  tabin(jk) = tabres(ji,jj,jk,m1) 
    462                   h_in(N_in) = tabres(ji,jj,jk,m2) 
    463               ENDDO 
    464               ! 
    465               IF (N_in == 0) THEN 
    466                  tabres_child(ji,jj,:) = 0. 
    467                  CYCLE 
    468               ENDIF 
    469           
    470               N_out = 0 
    471               DO jk=1,jpk 
    472                  if (umask(ji,jj,jk) == 0) EXIT 
    473                  N_out = N_out + 1 
    474                  h_out(N_out) = e3u_b(ji,jj,jk) 
    475               ENDDO 
    476           
    477               IF (N_out == 0) THEN 
    478                  tabres_child(ji,jj,:) = 0. 
    479                  CYCLE 
    480               ENDIF 
    481           
    482               IF (N_in * N_out > 0) THEN 
    483                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    484                  if (h_diff < -1.e4) then 
    485                     print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 
    486                  endif 
    487               ENDIF 
    488               CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    489           
     524               ENDDO 
     525               !          
     526               N_out = 0 
     527               DO jk=1,jpk 
     528                  IF (umask(ji,jj,jk) == 0) EXIT 
     529                  N_out = N_out + 1 
     530                  h_out(N_out) = e3u_b(ji,jj,jk) 
     531               ENDDO 
     532 
     533               ! Account for small differences in free-surface 
     534               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     535                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
     536               ELSE 
     537                  h_in(1)   = h_in(1)   - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
     538               ENDIF 
     539                   
     540               IF (N_in * N_out > 0) THEN 
     541                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     542               ENDIF  
    490543            ENDDO 
    491544         ENDDO 
    … …  
    580633      ! 
    581634      INTEGER  ::   ji, jj, jk, imax 
    582       REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, h_diff 
     635      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, zhtot 
    583636      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff 
    584637      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff 
    … …  
    601654            END DO 
    602655         END DO 
     656 
     657# if defined key_vertical 
     658         ! Extrapolate thicknesses in partial bottom cells: 
     659         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     660         IF (ln_zps) THEN 
     661            DO jj=j1,j2 
     662               DO ji=i1,i2 
     663                  jk = mbkv(ji,jj) 
     664                  tabres(ji,jj,jk,m2) = 0._wp 
     665               END DO 
     666            END DO            
     667         END IF 
     668        ! Save ssh at last level: 
     669        tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
     670        IF (.NOT.ln_linssh) THEN 
     671           ! This vertical sum below should be replaced by the sea-level at V-points (optimization): 
     672           DO jk=1,jpk 
     673              tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v_b(i1:i2,j1:j2,jk) * vmask(i1:i2,j1:j2,jk) 
     674           END DO 
     675           tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2) 
     676        END IF  
     677# endif 
     678 
    603679      ELSE 
    604680 
    605681# if defined key_vertical 
    606          tabres_child(:,:,:) = 0._wp 
     682         IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp 
    607683         DO jj=j1,j2 
    608684            DO ji=i1,i2 
    609                N_in = 0 
    610                DO jk=k1,k2 
    611                   IF (tabres(ji,jj,jk,m2) == 0) EXIT 
    612                   N_in = N_in + 1 
     685               tabres_child(ji,jj,:) = 0._wp 
     686               N_in = mbkv_parent(ji,jj) 
     687               zhtot = 0._wp 
     688               DO jk=1,N_in 
     689                  IF (jk==N_in) THEN 
     690                     h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 
     691                  ELSE 
     692                     h_in(jk) = tabres(ji,jj,jk,m2) 
     693                  ENDIF 
     694                  zhtot = zhtot + h_in(jk) 
    613695                  tabin(jk) = tabres(ji,jj,jk,m1) 
    614                   h_in(N_in) = tabres(ji,jj,jk,m2) 
    615               ENDDO 
     696               ENDDO 
     697               !           
     698               N_out = 0 
     699               DO jk=1,jpk 
     700                  IF (vmask(ji,jj,jk) == 0) EXIT 
     701                  N_out = N_out + 1 
     702                  h_out(N_out) = e3v_b(ji,jj,jk) 
     703               ENDDO 
     704 
     705               ! Account for small differences in free-surface 
     706               IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 
     707                  h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 
     708               ELSE 
     709                  h_in(1)   = h_in(1) - (  sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 
     710               ENDIF 
    616711          
    617               IF (N_in == 0) THEN 
    618                  tabres_child(ji,jj,:) = 0. 
    619                  CYCLE 
    620               ENDIF 
    621           
    622               N_out = 0 
    623               DO jk=1,jpk 
    624                  if (vmask(ji,jj,jk) == 0) EXIT 
    625                  N_out = N_out + 1 
    626                  h_out(N_out) = e3v_b(ji,jj,jk) 
    627               ENDDO 
    628           
    629               IF (N_in * N_out > 0) THEN 
    630                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    631                  if (h_diff < -1.e4) then 
    632                     print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 
    633                  endif 
    634               ENDIF 
    635               CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     712               IF (N_in * N_out > 0) THEN 
     713                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
     714               ENDIF 
    636715            ENDDO 
    637716         ENDDO 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_oce_update.F90

    r11625 r11741  
    1 #undef DECAL_FEEDBACK  /* SEPARATION of INTERFACES*/ 
    2 #undef VOL_REFLUX      /* VOLUME REFLUXING*/ 
     1#undef DECAL_FEEDBACK     /* SEPARATION of INTERFACES */ 
     2#undef DECAL_FEEDBACK_2D  /* SEPARATION of INTERFACES (Barotropic mode) */ 
     3#undef VOL_REFLUX         /* VOLUME REFLUXING*/ 
    34  
    45MODULE agrif_oce_update 
    … …  
    4849      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed() 
    4950 
     51! jc_alt      Agrif_UseSpecialValueInUpdate = .FALSE. 
    5052      Agrif_UseSpecialValueInUpdate = .TRUE. 
    5153      Agrif_SpecialValueFineGrid    = 0._wp 
    … …  
    9294# endif 
    9395 
    94 # if ! defined DECAL_FEEDBACK 
     96# if ! defined DECAL_FEEDBACK_2D 
    9597      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d) 
    9698      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d)   
    … …  
    100102# endif 
    101103      ! 
    102 # if ! defined DECAL_FEEDBACK 
     104# if ! defined DECAL_FEEDBACK_2D 
    103105      ! Account for updated thicknesses at boundary edges 
    104106      IF (.NOT.ln_linssh) THEN 
    … …  
    110112      IF ( ln_dynspg_ts .AND. ln_bt_fw ) THEN 
    111113         ! Update time integrated transports 
    112 #  if ! defined DECAL_FEEDBACK 
     114#  if ! defined DECAL_FEEDBACK_2D 
    113115         CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b) 
    114116         CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b) 
    … …  
    130132      Agrif_UseSpecialValueInUpdate = .TRUE. 
    131133      Agrif_SpecialValueFineGrid = 0. 
    132 # if ! defined DECAL_FEEDBACK 
     134# if ! defined DECAL_FEEDBACK_2D 
    133135      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) 
    134136# else 
    … …  
    141143      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
    142144         ! Refluxing on ssh: 
    143 #  if defined DECAL_FEEDBACK 
     145#  if defined DECAL_FEEDBACK_2D 
    144146         CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0, 0/),locupdate2=(/1, 1/),procname = reflux_sshu) 
    145147         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1, 1/),locupdate2=(/0, 0/),procname = reflux_sshv) 
    … …  
    299301                  DO ji=i1,i2 
    300302                     tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 
    301                                            * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1._wp)*999._wp 
     303                                         &  * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1._wp) * 999._wp 
     304!jc_alt                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) 
    302305                  END DO 
    303306               END DO 
    … …  
    307310            DO jj=j1,j2 
    308311               DO ji=i1,i2 
    309                   tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 
    310                                            + (tmask(ji,jj,jk)-1)*999._wp 
     312                  tabres(ji,jj,jk,n2) =      tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 
     313                                      &   + (tmask(ji,jj,jk) - 1._wp) * 999._wp 
     314! jc_alt                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 
    311315               END DO 
    312316            END DO 
    … …  
    320324               DO jk=k1,k2 !k2 = jpk of child grid 
    321325                  IF (tabres(ji,jj,jk,n2) < -900._wp  ) EXIT 
     326! jc_alt                  IF (tabres(ji,jj,jk,n2) == 0._wp  ) EXIT 
    322327                  N_in = N_in + 1 
    323328                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 
    … …  
    476481               DO ji=i1,i2 
    477482                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) * un(ji,jj,jk)  & 
    478                                        + (umask(ji,jj,jk)-1)*999._wp 
     483                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp 
     484! jc_alt                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) * un(ji,jj,jk)   
    479485                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)  & 
    480                                        + (umask(ji,jj,jk)-1)*999._wp 
     486                                     &  + (umask(ji,jj,jk)-1._wp)*999._wp 
     487! jc_alt                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk) 
    481488               END DO 
    482489            END DO 
    … …  
    491498               tabin(:) = 0._wp 
    492499               DO jk=k1,k2 !k2=jpk of child grid 
    493                   IF( tabres(ji,jj,jk,2) < -900) EXIT 
     500                  IF( tabres(ji,jj,jk,2) < -900._wp) EXIT 
     501! jc_alt                  IF( tabres(ji,jj,jk,2) == 0.) EXIT 
    494502                  N_in = N_in + 1 
    495503                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
    … …  
    671679               DO ji=i1,i2 
    672680                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) * vn(ji,jj,jk) & 
    673                                        + (vmask(ji,jj,jk)-1)*999._wp 
    674                   tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) & 
    675                                        + (vmask(ji,jj,jk)-1)*999._wp 
     681                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp 
     682! jc_alt                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) * vn(ji,jj,jk)  
     683                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) * vn(ji,jj,jk) & 
     684                                     & + (vmask(ji,jj,jk)-1._wp) * 999._wp 
     685! jc_alt                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) * vn(ji,jj,jk) 
    676686               END DO 
    677687            END DO 
    … …  
    684694               N_in = 0 
    685695               DO jk=k1,k2 
    686                   IF (tabres(ji,jj,jk,2) < -900) EXIT 
     696                  IF (tabres(ji,jj,jk,2) < -900._wp) EXIT 
     697! jc_alt                  IF (tabres(ji,jj,jk,2) == 0) EXIT 
    687698                  N_in = N_in + 1 
    688699                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90

    r11590 r11741  
    9797      USE oce 
    9898      USE lib_mpp 
    99       ! 
    100       IMPLICIT NONE 
    101       ! 
     99      USE lbclnk 
     100      ! 
     101      IMPLICIT NONE 
     102      ! 
     103      INTEGER :: ji, jj 
    102104      LOGICAL :: check_namelist 
    103105      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     106#if defined key_vertical 
     107      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     108#endif 
    104109      !!---------------------------------------------------------------------- 
    105110 
    … …  
    110115      ! 2. First interpolations of potentially non zero fields 
    111116      !------------------------------------------------------- 
     117 
     118#if defined key_vertical 
     119      ! Build consistent parent bathymetry and number of levels 
     120      ! on the child grid  
     121      Agrif_UseSpecialValue = .FALSE. 
     122      ht0_parent(:,:) = 0._wp 
     123      mbkt_parent(:,:) = 0 
     124      ! 
     125      CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     126      CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     127      ! 
     128      DO jj = 1, jpjm1 
     129         DO ji = 1, jpim1 
     130            hu0_parent(ji,jj)  = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) )  
     131            hv0_parent(ji,jj)  = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) )  
     132            mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj)  ) 
     133            mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj)  ) 
     134         END DO 
     135      END DO 
     136      ! 
     137      CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 
     138      CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 
     139      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 
     140      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     141      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
     142      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )       
     143#endif 
     144 
    112145      Agrif_SpecialValue    = 0._wp 
    113146      Agrif_UseSpecialValue = .TRUE. 
    … …  
    225258            END IF 
    226259         ENDIF 
     260 
     261#if defined key_vertical 
     262    IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     263       CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 
     264         ENDIF 
     265#endif 
    227266         ! 
    228267      ENDIF 
    … …  
    275314      CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
    276315      CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
     316# if defined key_vertical 
     317      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
     318      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 
     319# endif 
    277320 
    278321      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
    … …  
    311354      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    312355      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    313  
     356! 
     357! > Divergence conserving alternative: 
     358!      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant) 
     359!      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant) 
     360!      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear) 
     361!      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant) 
     362!      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear) 
     363!< 
    314364 
    315365      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    … …  
    319369      CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 
    320370      CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
     371 
     372# if defined key_vertical 
     373      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
     374      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
     375# endif 
    321376 
    322377      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
    … …  
    341396      CALL Agrif_Set_bc( umsk_id, (/0,0/) ) 
    342397      CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) 
    343  
     398# if defined key_vertical 
     399      ! extend the interpolation zone by 1 more point than necessary: 
     400      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     401      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     402# endif 
    344403 
    345404      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 

  • NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/vremap.F90

    r11605 r11741  
    317317 
    318318      ! specify methods 
     319!      opts%edge_meth = p1e_method     ! 1st-order edge interp. 
     320!      opts%cell_meth = plm_method     ! PLM method in cells 
    319321      opts%edge_meth = p3e_method     ! 3rd-order edge interp. 
    320       opts%cell_meth = ppm_method     ! PPM method in cells 
    321       opts%cell_lims = null_limit     ! no lim.      
     322      opts%cell_meth = ppm_method     ! PPM method in cells     
    322323!      opts%edge_meth = p5e_method     ! 5th-order edge interp. 
    323324!      opts%cell_meth = pqm_method     ! PQM method in cells 
    324 !      opts%cell_lims = mono_limit     ! monotone limiter    
     325 
     326      ! limiter 
     327!      opts%cell_lims = null_limit     ! no lim. 
     328      opts%cell_lims = mono_limit     ! monotone limiter    
    325329  
    326330      ! set boundary conditions 
Note: See TracChangeset for help on using the changeset viewer.