Changeset 13337 for NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_user.F90

Timestamp:

2020-07-24T16:01:24+02:00 (4 years ago)

Author:

jchanut

Message:

#2222, start suppressing key_vertical (add ln_vremap namelist flag)

File:

• NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_user.F90 (modified) (17 diffs)

NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_user.F90

@@ -148 +148 @@
 
 
-   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa ) 
+   SUBROUTINE Agrif_Init_Domain
       !!----------------------------------------------------------------------
       !!                 *** ROUTINE Agrif_Init_Domain ***
@@ -168 +168 @@
       IMPLICIT NONE
       !
-      INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa
       !
       LOGICAL :: check_namelist
@@ -186 +185 @@
       mbkt_parent(:,:) = 0
       !
-  !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
-  !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
+!     CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
+!     CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
       CALL Agrif_Init_Variable(ht0_id , procname=interpht0 )
       CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt)
@@ -214 +213 @@
          zk(ji,jj) = REAL( mbku_parent(ji,jj), wp )
       END_2D
-      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp )
+      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'U', 1.0_wp )
       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
       DO_2D( 0, 0, 0, 0 )
          zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp )
       END_2D
-      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp )
+      CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'V', 1.0_wp )
       mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )   
 
@@ -231 +230 @@
          !
          kindic_agr = 0
-         IF( .NOT. l_vremap ) THEN
+         IF( .NOT. ln_vremap ) THEN
             !
             ! check if tmask and vertical scale factors agree with parent in sponge area:
@@ -239 +238 @@
             !
             ! In case of vertical interpolation, check only that total depths agree between child and parent:
-            DO ji = 1, jpi
-               DO jj = 1, jpj
-                  IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
-                  IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
-                  IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
-               END DO
-            END DO
-
-            CALL mpp_sum( 'agrif_user', kindic_agr )
+                  
+            CALL Agrif_check_bat( kindic_agr )           
+
+            CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr )
             IF( kindic_agr /= 0 ) THEN
                CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
@@ -257 +251 @@
       ENDIF
 
-      IF( l_vremap ) THEN
+      IF( ln_vremap ) THEN
       ! Additional constrain that should be removed someday:
          IF ( Agrif_Parent(jpk).GT.jpk ) THEN
-            CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' )
+            CALL ctl_stop( ' With ln_vremap, child grids must have jpk greater or equal to the parent value' )
          ENDIF
       ENDIF
@@ -291 +285 @@
       LOGICAL :: check_namelist
       CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
-      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
-      INTEGER :: ji, jj
 
       ! 1. Declaration of the type of variable which have to be interpolated
@@ -302 +294 @@
       Agrif_SpecialValue    = 0._wp
       Agrif_UseSpecialValue = .TRUE.
+      l_vremap              = ln_vremap
+
       CALL Agrif_Bc_variable(       tsn_id,calledweight=1.,procname=interptsn)
       CALL Agrif_Sponge
@@ -342 +336 @@
       ENDIF
       Agrif_UseSpecialValue = .FALSE. 
+      l_vremap              = .FALSE.
 
       !-----------------
@@ -398 +393 @@
       ind2 = nn_hls + 2 + nbghostcells_x
       ind3 = nn_hls + 2 + nbghostcells_y_s
-# if defined key_vertical
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id)
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id)
+
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/)  ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id)
       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id)
       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id)
@@ -407 +402 @@
       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id)
       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
-# else
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id)
-      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id)
-      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id)
-      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id)
-      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id)
-      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id)
-      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id)
-# endif
+
       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
@@ -432 +418 @@
 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
-# if defined key_vertical
          CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)
-# else
-         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id)
-# endif
       ENDIF
      
@@ -608 +590 @@
       CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear)
       CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear)
-      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  )
-      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   )
+      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear)
+      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear)
       CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear)
       CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear)
@@ -731 +713 @@
       ind2 = nn_hls + 2 + nbghostcells_x
       ind3 = nn_hls + 2 + nbghostcells_y_s
-# if defined key_vertical
+
       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)
       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)
-# else
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
-      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id)
-# endif
 
       ! 2. Type of interpolation
@@ -788 +766 @@
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
-                       & ln_spc_dyn, ln_chk_bathy
+                       & ln_spc_dyn, ln_vremap, ln_chk_bathy
       !!--------------------------------------------------------------------------------------
       !
@@ -809 +787 @@
          WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn
          WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
+         WRITE(numout,*) '      vertical remapping                ln_vremap     = ', ln_vremap
          WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
       ENDIF