Changeset 6454

Timestamp:

2016-04-08T10:49:50+02:00 (8 years ago)

Author:

timgraham

Message:

Added in modifications to updateTS as made in Grenoble

Location:

branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC

Files:

• agrif_opa_update.F90 (modified) (6 diffs)
• agrif_user.F90 (modified) (1 diff)

branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

@@ -263 +263 @@
       !!---------------------------------------------
       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
-      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2+1), INTENT(inout) :: ptab
       LOGICAL, INTENT(in) :: before
       !!
@@ -271 +271 @@
       REAL(wp) :: h_in(k1:k2)
       REAL(wp) :: h_out(1:jpk)
-      INTEGER :: N_in, N_out
+      INTEGER  :: N_in, N_out
       REAL(wp) :: h_diff
+      REAL(wp) :: zrho_xy
       REAL(wp) :: tabin(k1:k2,n1:n2)
 ! VERTICAL REFINEMENT END
@@ -278 +279 @@
       !
       IF (before) THEN
+         zrho_xy = Agrif_rhox() * Agrif_rhoy() 
          DO jn = n1,n2
             DO jk=k1,k2
                DO jj=j1,j2
                   DO ji=i1,i2
-                     ptab(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)
+                     ptab(ji,jj,jk,jn) = zrho_xy * tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk)
                   END DO
                END DO
             END DO
          END DO
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  ptab(ji,jj,jk,n2+1) = zrho_xy * e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         
       ELSE
 ! VERTICAL REFINEMENT BEGIN
@@ -294 +304 @@
          DO ji=i1,i2
            N_in = 0
-           DO jk=k1,k2
-             IF (update_scales_t(ji,jj,jk) == 0) EXIT
+           DO jk=k1,k2 !k2 = jpk of child grid
+             IF (ptab(ji,jj,jk,n2+1) == 0) EXIT
              N_in = N_in + 1
-             tabin(jk,:) = ptab(ji,jj,jk,:)
-             h_in(N_in) = update_scales_t(ji,jj,jk)
+             tabin(jk,:) = ptab(ji,jj,jk,n1:n2)/ptab(ji,jj,jk,n2+1)
+             h_in(N_in) = ptab(ji,jj,jk,n2+1)/e1e2t(ji,jj)
            ENDDO
            N_out = 0
-           DO jk=1,jpk
-             IF (tmask(ji,jj,jk) == 0) EXIT
+           DO jk=1,jpk ! jpk of parent grid
+             IF (tmask(ji,jj,jk) == 0) EXIT ! TODO: Will not work with ISF
              N_out = N_out + 1
-             h_out(N_out) = e3t_n(ji,jj,jk)
+             h_out(N_out) = e3t_n(ji,jj,jk)!Parent 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))
-             IF (h_diff > 0) THEN
-               N_in = N_in + 1
-               h_in(N_in) = h_diff
-               tabin(N_in,:) = tabin(N_in-1,:)
+! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly
+             IF abs(h_diff > 1.e-8) THEN
+!               N_in = N_in + 1
+!               h_in(N_in) = h_diff
+!               tabin(N_in,:) = tabin(N_in-1,:)
              ELSEIF (h_diff < 0) THEN
              print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out))
              print *,'Nval = ',N_out,mbathy(ji,jj)
              print *,'BATHY = ',gdepw_0(ji,jj,mbathy(ji,jj)+1),sum(e3t_0(ji,jj,1:mbathy(ji,jj)))
-          !   STOP
-               N_out = N_out + 1
-               h_out(N_out) = - h_diff
+             STOP
+!               N_out = N_out + 1
+!               h_out(N_out) = - h_diff
              ENDIF
              DO jn=n1,n2
@@ -367 +378 @@
       !!           *** ROUTINE updateu ***
       !!---------------------------------------------
-      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2
+      !!
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
       LOGICAL                               , INTENT(in   ) :: before
@@ -388 +400 @@
             DO jj=j1,j2
                DO ji=i1,i2
-                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
-                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3u_n(ji,jj,jk)
+                  ptab(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)
                END DO
             END DO

branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

@@ -375 +375 @@
    ! 1. Declaration of the type of variable which have to be interpolated
    !---------------------------------------------------------------------
-   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
+   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)