Changeset 12229 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/NST/agrif_top_sponge.F90

Timestamp:

2019-12-12T17:41:04+01:00 (4 years ago)

Author:

acc

Message:

2019/dev_r11943_MERGE_2019: Merge in dev_AGRIF-01-05_merged. Fully SETTE tested

File:

• NEMO/branches/2019/dev_r11943_MERGE_2019/src/NST/agrif_top_sponge.F90 (modified) (8 diffs)

NEMO/branches/2019/dev_r11943_MERGE_2019/src/NST/agrif_top_sponge.F90

@@ -20 +20 @@
    USE agrif_oce
    USE agrif_oce_sponge
+   USE vremap
    !
    USE in_out_manager
@@ -66 +67 @@
       !
       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      REAL(wp) ::   zabe1, zabe2
-      REAL(wp), DIMENSION(i1:i2,j1:j2)             ::   ztu, ztv
-      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff
+      REAL(wp) ::   zabe1, zabe2, ztrelax
+      REAL(wp), DIMENSION(i1:i2,j1:j2)               ::   ztu, ztv
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,1:jptra) ::   trbdiff
       ! vertical interpolation:
-      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child
-      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
+      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,1:jptra) ::tabres_child
+      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin
       REAL(wp), DIMENSION(k1:k2) :: h_in
       REAL(wp), DIMENSION(1:jpk) :: h_out
@@ -83 +84 @@
                DO jj=j1,j2
                   DO ji=i1,i2
-                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kbb)
+                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kbb_a)
                   END DO
                END DO
@@ -93 +94 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) 
+                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 
                END DO
             END DO
@@ -108 +109 @@
                   N_in = N_in + 1
                   tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)
-                  h_in(N_in)  = tabres(ji,jj,jk,n2)
+                  h_in(N_in) = tabres(ji,jj,jk,n2)
                END DO
                N_out = 0
                DO jk=1,jpk ! jpk of child grid
                   IF (tmask(ji,jj,jk) == 0) EXIT 
-                  N_out     = N_out + 1
-                  h_out(jk) = e3t(ji,jj,jk,Kmm) !Child grid scale factors. Could multiply by e1e2t here instead of division above
+                  N_out = N_out + 1
+                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above
                ENDDO
                IF (N_in > 0) THEN
-                  h_diff = SUM( h_out(1:N_out) ) - SUM( h_in(1:N_in) )
-                  tabres(ji,jj,k2,:) = tabres(ji,jj,k2-1,:) !what is this line for?????
-                  DO jn=1,jptra
-                     call reconstructandremap(tabin(1:N_in,jn),h_in,tabres_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
-                  ENDDO
+                  CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,tabres_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra)
                ENDIF
             ENDDO
@@ -131 +128 @@
                DO jk=1,jpkm1
 # if defined key_vertical
-                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb) - tabres_child(ji,jj,jk,1:jptra)
+                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra)
 # else
-                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb) -       tabres(ji,jj,jk,1:jptra)
+                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra)
 # endif
                ENDDO
@@ -139 +136 @@
          ENDDO
 
+         !* set relaxation time scale
+         IF( neuler == 0 .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_tra  / (        rdt )
+         ELSE                                          ;   ztrelax =   rn_trelax_tra  / (2._wp * rdt )
+         ENDIF
+
          DO jn = 1, jptra
             DO jk = 1, jpkm1
                DO jj = j1,j2-1
                   DO ji = i1,i2-1
-                     zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk)
-                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
+                     zabe1 = rn_sponge_tra * fspu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk)
+                     zabe2 = rn_sponge_tra * fspv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk)
                      ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) )
                      ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )
@@ -153 +155 @@
                   DO ji = i1+1,i2-1
                      IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 
-                        tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + (  ztu(ji,jj) - ztu(ji-1,jj  )       &
-                           &                                           + ztv(ji,jj) - ztv(ji  ,jj-1)  )    &
-                           &                                          * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+                        tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + (  ztu(ji,jj) - ztu(ji-1,jj  )     &
+                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  &
+                           &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)  &
+                           &                                - ztrelax * fspt(ji,jj) * trbdiff(ji,jj,jk,jn)
                      ENDIF
                   END DO