Changeset 14433 for NEMO/trunk/tests/CANAL/MY_SRC

Timestamp:

2021-02-11T09:06:49+01:00 (3 years ago)

Author:

smasson

Message:

trunk: merge dev_r14312_MPI_Interface into the trunk, #2598

Location:

NEMO/trunk/tests/CANAL/MY_SRC

Files:

• usrdef_hgr.F90 (modified) (2 diffs)
• usrdef_istate.F90 (modified) (1 diff)
• usrdef_nam.F90 (modified) (7 diffs)
• usrdef_zgr.F90 (modified) (1 diff)

NEMO/trunk/tests/CANAL/MY_SRC/usrdef_hgr.F90

@@ -64 +64 @@
       !
       INTEGER  ::   ji, jj     ! dummy loop indices
-      REAL(wp) ::   zphi0, zlam0, zbeta, zf0
+      INTEGER  ::   ii0, ij0   ! dummy loop indices
+      REAL(wp) ::   zbeta, zf0
       REAL(wp) ::   zti, ztj   ! local scalars
       !!-------------------------------------------------------------------------------
@@ -77 +78 @@
       ! Position coordinates (in kilometers)
       !                          ==========
-      zlam0 = -REAL(Ni0glo, wp) * rn_0xratio * rn_dx
-      zphi0 = -REAL(Nj0glo, wp) * rn_0yratio * rn_dy
+      ii0 = NINT( REAL(Ni0glo, wp) * rn_0xratio )
+      ij0 = NINT( REAL(Nj0glo, wp) * rn_0yratio )
 
 #if defined key_agrif
       ! ! let lower left longitude and latitude from parent
       IF (.NOT.Agrif_root()) THEN
-          zlam0 = (0.5_wp-(Agrif_parent(jpiglo)-1)/2)*Agrif_irhox()*rn_dx &
-             &+(Agrif_Ix()+nbghostcells-1)*Agrif_irhox()*rn_dx-(0.5_wp+nbghostcells)*rn_dx
-          zphi0 = (0.5_wp-(Agrif_parent(jpjglo)-1)/2)*Agrif_irhoy()*rn_dy &
-             &+(Agrif_Iy()+nbghostcells-1)*Agrif_irhoy()*rn_dy-(0.5_wp+nbghostcells)*rn_dy
+          to be coded...
       ENDIF 
 #endif
          
       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )         
-         zti = REAL( mig0(ji), wp ) - 0.5_wp  ! start at i=0.5 in the global grid without halos
-         ztj = REAL( mjg0(jj), wp ) - 0.5_wp  ! start at j=0.5 in the global grid without halos
+         zti = REAL( mig0(ji)-ii0, wp )   ! =0 at i=ii0 in the global grid without halos
+         ztj = REAL( mjg0(jj)-ij0, wp )   ! =0 at i=ij0 in the global grid without halos
          
-         plamt(ji,jj) = zlam0 + rn_dx *   zti
-         plamu(ji,jj) = zlam0 + rn_dx * ( zti + 0.5_wp ) 
+         plamt(ji,jj) = rn_dx *   zti
+         plamu(ji,jj) = rn_dx * ( zti + 0.5_wp ) 
          plamv(ji,jj) = plamt(ji,jj) 
          plamf(ji,jj) = plamu(ji,jj) 
          
-         pphit(ji,jj) = zphi0 + rn_dy *   ztj
-         pphiv(ji,jj) = zphi0 + rn_dy * ( ztj + 0.5_wp ) 
+         pphit(ji,jj) = rn_dy *   ztj
+         pphiv(ji,jj) = rn_dy * ( ztj + 0.5_wp ) 
          pphiu(ji,jj) = pphit(ji,jj) 
          pphif(ji,jj) = pphiv(ji,jj) 

NEMO/trunk/tests/CANAL/MY_SRC/usrdef_istate.F90

@@ -239 +239 @@
       !
       CALL lbc_lnk( 'usrdef_istate', pts , 'T',  1. )
-      CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. )
+      CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. )
 
    END SUBROUTINE usr_def_istate

NEMO/trunk/tests/CANAL/MY_SRC/usrdef_nam.F90

@@ -50 +50 @@
    LOGICAL , PUBLIC ::   ln_sshnoise=.false. ! add random noise on initial ssh
    REAL(wp), PUBLIC ::   rn_lambda  = 50.    ! gaussian lambda
-   INTEGER , PUBLIC ::   nn_perio   =    0   ! periodicity of the channel (0=closed, 1=E-W)
 
    !!----------------------------------------------------------------------
@@ -59 +58 @@
 CONTAINS
 
-   SUBROUTINE usr_def_nam( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+   SUBROUTINE usr_def_nam( cd_cfg, kk_cfg, kpi, kpj, kpk, ldIperio, ldJperio, ldNFold, cdNFtype )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE dom_nam  ***
@@ -71 +70 @@
       !! ** input   : - namusr_def namelist found in namelist_cfg
       !!----------------------------------------------------------------------
-      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
-      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
-      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
-      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
+      CHARACTER(len=*), INTENT(out) ::   cd_cfg               ! configuration name
+      INTEGER         , INTENT(out) ::   kk_cfg               ! configuration resolution
+      INTEGER         , INTENT(out) ::   kpi, kpj, kpk        ! global domain sizes
+      LOGICAL         , INTENT(out) ::   ldIperio, ldJperio   ! i- and j- periodicity
+      LOGICAL         , INTENT(out) ::   ldNFold              ! North pole folding
+      CHARACTER(len=1), INTENT(out) ::   cdNFtype             ! Folding type: T or F
       !
       INTEGER ::   ios      ! Local integer
       REAL(wp)::   zh       ! Local scalars
+      LOGICAL ::   ln_Iperio, ln_Jperio
       !!
       NAMELIST/namusr_def/  rn_domszx, rn_domszy, rn_domszz, rn_dx, rn_dy, rn_dz, rn_0xratio, rn_0yratio   &
          &                 , nn_fcase, rn_ppgphi0, rn_u10, rn_windszx, rn_windszy & !!, rn_uofac   &
          &                 , rn_vtxmax, rn_uzonal, rn_ujetszx, rn_ujetszy  &
-         &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda, nn_perio
+         &                 , nn_botcase, nn_initcase, ln_sshnoise, rn_lambda, ln_Iperio, ln_Jperio
       !!----------------------------------------------------------------------
       !
@@ -102 +104 @@
 #endif
       !
-      IF(lwm)   WRITE( numond, namusr_def )
-      !
       cd_cfg = 'EW_CANAL'             ! name & resolution (not used)
       kk_cfg = INT( rn_dx )
@@ -109 +109 @@
       IF( Agrif_Root() ) THEN        ! Global Domain size:  EW_CANAL global domain is  1800 km x 1800 Km x 5000 m
          kpi = NINT( rn_domszx / rn_dx ) + 1
-         kpj = NINT( rn_domszy / rn_dy ) + 3
+         kpj = NINT( rn_domszy / rn_dy ) + 1
       ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side
          kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2
@@ -117 +117 @@
       !
       zh  = (kpk-1)*rn_dz
-      !                             ! Set the lateral boundary condition of the global domain
-      kperio = 1                    ! EW_CANAL configuration : closed basin
       !                             ! control print
       IF(lwp) THEN
@@ -149 +147 @@
          WRITE(numout,*) '      add random noise on initial ssh   ln_sshnoise= ', ln_sshnoise
          WRITE(numout,*) '      Gaussian lambda parameter          rn_lambda = ', rn_lambda
-         WRITE(numout,*) '      Periodicity of the basin            nn_perio = ', nn_perio
+         WRITE(numout,*) '      i and j Periodicity     ln_Iperio, ln_Jperio = ', ln_Iperio, ln_Jperio
+         WRITE(numout,*) '   '
       ENDIF
       !                             ! Set the lateral boundary condition of the global domain
-      kperio = nn_perio                    ! EW_CANAL configuration : closed basin
+      ldIperio = ln_Iperio   ;   ldJperio = ln_Jperio   ! CANAL configuration
+      ldNFold  =  .FALSE.    ;   cdNFtype = '-'
       !
    END SUBROUTINE usr_def_nam

NEMO/trunk/tests/CANAL/MY_SRC/usrdef_zgr.F90

@@ -202 +202 @@
       END SELECT
       !
-      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed)
+      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (closed boundaries)
       !
       k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere