Changeset 8965

Timestamp:

2017-12-08T17:42:49+01:00 (7 years ago)

Author:

jchanut

Message:

Add zoom capability in default Gyre, remove bcs velocity update (non reproducible), add option to set clamped obcs - #1965

Location:

branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO

Files:

• NST_SRC/agrif_oce.F90 (modified) (1 diff)
• NST_SRC/agrif_opa_interp.F90 (modified) (5 diffs)
• NST_SRC/agrif_opa_sponge.F90 (modified) (2 diffs)
• NST_SRC/agrif_opa_update.F90 (modified) (1 diff)
• OPA_SRC/USR/usrdef_hgr.F90 (modified) (1 diff)
• OPA_SRC/USR/usrdef_nam.F90 (modified) (2 diffs)

branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

@@ -24 +24 @@
    REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
    LOGICAL , PUBLIC ::   ln_chk_bathy  = .FALSE.   !: check of parent bathymetry 
+   LOGICAL , PUBLIC ::   lk_agrif_clp  = .FALSE.   !: Flag to retrieve clamped open boundaries
 
    !                                              !!! OLD namelist names

branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

@@ -117 +117 @@
          ENDIF
          !
-         DO jk=1,jpkm1                 ! Smooth
-            DO jj=j1,j2
-               ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
-               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
-            END DO
-         END DO
+         IF (.NOT.lk_agrif_clp) THEN
+            DO jk=1,jpkm1              ! Smooth
+               DO jj=j1,j2
+                  ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk))
+                  ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
+               END DO
+            END DO
+         END IF
          !
          zub(2,:) = 0._wp              ! Correct transport
@@ -186 +188 @@
          ENDIF
 
-         DO jk = 1, jpkm1              ! Smooth
-            DO jj = j1, j2
-               ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
-                  &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
-            END DO
-         END DO
+         IF (.NOT.lk_agrif_clp) THEN
+            DO jk = 1, jpkm1           ! Smooth
+               DO jj = j1, j2
+                  ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk)      &
+                     &             * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
+               END DO
+            END DO
+         ENDIF
 
          zub(nlci-2,:) = 0._wp        ! Correct transport
@@ -255 +259 @@
          ENDIF
          !
-         DO jk = 1, jpkm1              ! Smooth
-            DO ji = i1, i2
-               va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
-                  &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
-            END DO
-         END DO
+         IF (.NOT.lk_agrif_clp) THEN
+            DO jk = 1, jpkm1              ! Smooth
+               DO ji = i1, i2
+                  va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk)    &
+                     &        * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
+               END DO
+            END DO
+         ENDIF
          !
          zvb(:,2) = 0._wp              ! Correct transport
@@ -324 +330 @@
          ENDIF
          !
-         DO jk = 1, jpkm1              ! Smooth
-            DO ji = i1, i2
-               va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
-                  &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
-            END DO
-         END DO
+         IF (.NOT.lk_agrif_clp) THEN
+            DO jk = 1, jpkm1           ! Smooth
+               DO ji = i1, i2
+                  va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk)   &
+                     &             * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
+               END DO
+            END DO
+         ENDIF
          !
          zvb(:,nlcj-2) = 0._wp         ! Correct transport
@@ -616 +624 @@
          ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
       ELSE
+         IF (lk_agrif_clp) THEN
+            DO jn = 1, jpts
+               DO jk = 1, jpkm1
+                  DO ji = i1,i2
+                     DO jj = j1,j2
+                        tsa(ji,jj,jk,jn) = ptab(ji,jj,jk,jn)
+                     END DO
+                  END DO
+               END DO
+            END DO           
+            return
+         ENDIF
          !
          western_side  = (nb == 1).AND.(ndir == 1)

branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

@@ -280 +280 @@
       !
       IF( before ) THEN
-         tabres = un(i1:i2,j1:j2,:)
+         tabres = ub(i1:i2,j1:j2,:)
       ELSE
          ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:)
@@ -377 +377 @@
 
       IF( before ) THEN 
-         tabres = vn(i1:i2,j1:j2,:)
+         tabres = vb(i1:i2,j1:j2,:)
       ELSE
          !

branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

@@ -97 +97 @@
       ! Account for updated thicknesses at boundary edges
       IF (.NOT.ln_linssh) THEN
-         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_u_bdy)
-         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_v_bdy)
+! For the time being calls below do not ensure reproducible results 
+!         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_u_bdy)
+!         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_v_bdy)
       ENDIF
 # endif

branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90

@@ -93 +93 @@
       zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp )
       zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp )
+
+#if defined key_agrif
+      ! ! Upper left longitude and latitude from parent:
+      IF (.NOT.Agrif_root()) THEN
+         zlam0 = zlam1 + Agrif_irhox() * REAL(Agrif_Parent(jpjglo)-2 , wp) * ze1deg * zcos_alpha  &
+                   &   + ( Agrif_Ix()*Agrif_irhox()-(0.5_wp+nbghostcells)) * ze1deg * zcos_alpha  &
+                   &   + ( Agrif_Iy()*Agrif_irhoy()-(0.5_wp+nbghostcells)) * ze1deg * zsin_alpha
+         zphi0 = zphi1 + Agrif_irhoy() * REAL(Agrif_Parent(jpjglo)-2 , wp) * ze1deg * zsin_alpha  &
+                   &   - ( Agrif_Ix()*Agrif_irhox()-nbghostcells )         * ze1deg * zsin_alpha  &
+                   &   + ( Agrif_Iy()*Agrif_irhoy()-nbghostcells )         * ze1deg * zcos_alpha
+      ENDIF 
+#endif
       !   
       IF( ln_bench ) THEN     ! benchmark: forced the resolution to be 106 km 

branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_nam.F90

@@ -70 +70 @@
       !
       cd_cfg = 'GYRE'               ! name & resolution (not used)
+#if defined key_agrif
+      IF (.NOT.Agrif_root()) nn_GYRE = Agrif_parent(nn_GYRE) * Agrif_irhox()
+#endif
       kk_cfg = nn_GYRE
       !
       kpi = 30 * nn_GYRE + 2        ! Global Domain size
       kpj = 20 * nn_GYRE + 2
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() ) THEN
+         kpi  = nbcellsx + 2 + 2*nbghostcells
+         kpj  = nbcellsy + 2 + 2*nbghostcells
+      ENDIF
+#endif
       kpk = jpkglo
       !
@@ -83 +92 @@
       WRITE(ldtxt(ii),*) '      GYRE used as Benchmark (=T)                      ln_bench  = ', ln_bench  ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '      inverse resolution & implied domain size         nn_GYRE   = ', nn_GYRE   ;   ii = ii + 1
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
       WRITE(ldtxt(ii),*) '         jpiglo = 30*nn_GYRE+2                            jpiglo = ', kpi       ;   ii = ii + 1
       WRITE(ldtxt(ii),*) '         jpjglo = 20*nn_GYRE+2                            jpjglo = ', kpj       ;   ii = ii + 1
+#if defined key_agrif
+      ENDIF
+#endif
       WRITE(ldtxt(ii),*) '      number of model levels                              jpkglo = ', kpk       ;   ii = ii + 1
       !