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 9001 for branches/2017 – NEMO

Changeset 9001 for branches/2017


Ignore:
Timestamp:
2017-12-13T10:20:37+01:00 (6 years ago)
Author:
timgraham
Message:

Added vertical refinement to top sponge

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90

    r8993 r9001  
    7272      REAL(wp), DIMENSION(i1:i2,j1:j2)             ::   ztu, ztv 
    7373      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff 
     74      ! vertical interpolation: 
     75      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child 
     76      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin 
     77      REAL(wp), DIMENSION(k1:k2) :: h_in 
     78      REAL(wp), DIMENSION(1:jpk) :: h_out 
     79      INTEGER :: N_in, N_out 
     80      REAL(wp) :: h_diff 
    7481      !!---------------------------------------------------------------------- 
    7582      ! 
    7683      IF( before ) THEN 
    77          tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trb(i1:i2,j1:j2,k1:k2,n1:n2) 
     84         DO jn = 1, jptra 
     85            DO jk=k1,k2 
     86               DO jj=j1,j2 
     87                  DO ji=i1,i2 
     88                     tabres(ji,jj,jk,jn) = trb(ji,jj,jk,jn) 
     89                  END DO 
     90               END DO 
     91            END DO 
     92         END DO 
     93 
     94# if defined key_vertical 
     95         DO jk=k1,k2 
     96            DO jj=j1,j2 
     97               DO ji=i1,i2 
     98                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk)  
     99               END DO 
     100            END DO 
     101         END DO 
     102# endif 
    78103      ELSE       
    79 !!gm line below use of :,:  versus i1:i2,j1:j2  ....   strange, not wrong.    ===>> to be corrected 
    80          trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:)       
     104# if defined key_vertical 
     105         tabres_child(:,:,:,:) = 0. 
     106         DO jj=j1,j2 
     107            DO ji=i1,i2 
     108               N_in = 0 
     109               DO jk=k1,k2 !k2 = jpk of parent grid 
     110                  IF (tabres(ji,jj,jk,n2) == 0) EXIT 
     111                  N_in = N_in + 1 
     112                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1) 
     113                  h_in(N_in) = tabres(ji,jj,jk,n2) 
     114               END DO 
     115               N_out = 0 
     116               DO jk=1,jpk ! jpk of child grid 
     117                  IF (tmask(ji,jj,jk) == 0) EXIT  
     118                  N_out = N_out + 1 
     119                  h_out(jk) = e3t_n(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
     120               ENDDO 
     121               IF (N_in > 0) THEN 
     122                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     123                  tabres(ji,jj,k2,:) = tabres(ji,jj,k2-1,:) !what is this line for????? 
     124                  DO jn=1,jptra 
     125                     call reconstructandremap(tabin(1:N_in,jn),h_in,tabres_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) 
     126                  ENDDO 
     127               ENDIF 
     128            ENDDO 
     129         ENDDO 
     130# endif 
     131 
     132         DO jj=j1,j2 
     133            DO ji=i1,i2 
     134               DO jk=1,jpkm1 
     135# if defined key_vertical 
     136                  trbdiff(ji,jj,jk,1:jptra) = trb(ji,jj,jk,1:jptra) - tabres_child(ji,jj,jk,1:jptra) 
     137# else 
     138                  trbdiff(ji,jj,jk,1:jptra) = trb(ji,jj,jk,1:jptra) - tabres(ji,jj,jk,1:jptra) 
     139# endif 
     140               ENDDO 
     141            ENDDO 
     142         ENDDO 
     143 
    81144         DO jn = 1, jptra 
    82145            DO jk = 1, jpkm1 
Note: See TracChangeset for help on using the changeset viewer.