Changeset 14336 for NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/domain.F90

Timestamp:

2021-01-23T11:09:54+01:00 (3 years ago)

Author:

smasson

Message:

dev_r14312_MPI_Interface: replace jperio by l_Iperio, l_Jperio, l_NFold, c_NFtype, #2598

File:

• NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/domain.F90 (modified) (6 diffs)

NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/DOM/domain.F90

@@ -113 +113 @@
          WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
          WRITE(numout,*)     '              jpnij   : ', jpnij
-         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
-         SELECT CASE ( jperio )
-         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
-         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
-         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. cyclic north-south)'
-         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
-         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
-         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
-         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
-         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
-         CASE DEFAULT
-            CALL ctl_stop( 'dom_init:   jperio is out of range' )
-         END SELECT
+         WRITE(numout,*)     '      lateral boundary of the Global domain:'
+         WRITE(numout,*)     '              cyclic east-west             :', l_Iperio
+         WRITE(numout,*)     '              cyclic north-south           :', l_Jperio
+         WRITE(numout,*)     '              North Pole folding           :', l_NFold
+         WRITE(numout,*)     '                 type of North pole Folding:', c_NFtype
          WRITE(numout,*)     '      Ocean model configuration used:'
-         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
+         WRITE(numout,*)     '              cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
       ENDIF
 
@@ -622 +614 @@
 
 
-   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
+   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, ldIperio, ldJperio, ldNFold, cdNFtype )
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE domain_cfg  ***
@@ -630 +622 @@
       !! ** Method  :   read the cn_domcfg NetCDF file
       !!----------------------------------------------------------------------
-      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.
-      !
-      INTEGER ::   inum   ! local integer
+      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 ::   inum, iperio                   ! local integer
       REAL(wp) ::   zorca_res                     ! local scalars
-      REAL(wp) ::   zperio                        !   -      -
+      REAL(wp) ::   zperio, z01                   !   -      -
       INTEGER, DIMENSION(4) ::   idvar, idimsz    ! size   of dimensions
       !!----------------------------------------------------------------------
@@ -678 +672 @@
       kpj = idimsz(2)
       kpk = idimsz(3)
-      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
+      !
+      IF( iom_varid( inum, 'jperio', ldstop = .FALSE. ) > 0 ) THEN                   ! keep compatibility with old version...
+         CALL iom_get( inum, 'jperio', zperio )   ;   iperio = NINT( zperio )
+         ldIperio = iperio == 1 .OR. iperio == 4 .OR. iperio == 6 .OR. iperio == 7   ! i-periodicity
+         ldJperio = iperio == 2 .OR. iperio == 7                                     ! j-periodicity
+         ldNFold  = iperio >= 3 .OR. iperio <= 6                                     ! North pole folding
+         IF(     iperio == 3 .OR. iperio == 4 ) THEN   ;   cdNFtype = 'T'            !    folding at T point
+         ELSEIF( iperio == 5 .OR. iperio == 6 ) THEN   ;   cdNFtype = 'F'            !    folding at F point
+         ELSE                                          ;   cdNFtype = '-'  
+         ENDIF
+      ELSE   
+         z01 = 0._wp   ;   IF( iom_varid( inum, 'Iperio', ldstop = .FALSE. ) > 0 )   CALL iom_get( inum, 'Iperio', z01 )
+         ldIperio = NINT(z01) == 1               ! i-periodicity
+         z01 = 0._wp   ;   IF( iom_varid( inum, 'Jperio', ldstop = .FALSE. ) > 0 )   CALL iom_get( inum, 'Jperio', z01 )
+         ldJperio = NINT(z01) == 1               ! j-periodicity
+         cdNFtype = '-'                          ! default definition
+         z01 = 0._wp   ;   IF( iom_varid( inum, 'NFoldT', ldstop = .FALSE. ) > 0 )   CALL iom_get( inum, 'NFoldT', z01 )
+         IF( NINT(z01) == 1 )   cdNFtype = 'T'   ! folding at T point
+         z01 = 0._wp   ;   IF( iom_varid( inum, 'NFoldF', ldstop = .FALSE. ) > 0 )   CALL iom_get( inum, 'NFoldF', z01 )
+         IF( NINT(z01) == 1 )   cdNFtype = 'F'   ! folding at T point
+         ldNFold = cdNFtype /= '-'               ! North pole folding   
+      ENDIF
       CALL iom_close( inum )
       !
@@ -686 +701 @@
          WRITE(numout,*) '      Nj0glo = ', kpj
          WRITE(numout,*) '      jpkglo = ', kpk
-         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio
       ENDIF
       !
@@ -733 +747 @@
       !
       !                                   ! lateral boundary of the global domain
-      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
+      CALL iom_rstput( 0, 0, inum, 'Iperio', REAL( COUNT( (/l_Iperio/) ), wp), ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'Jperio', REAL( COUNT( (/l_Jperio/) ), wp), ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'NFoldT', REAL( COUNT( (/c_NFtype == 'T'/) ), wp), ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum, 'NFoldF', REAL( COUNT( (/c_NFtype == 'F'/) ), wp), ktype = jp_i1 )
       !
       !                                   ! type of vertical coordinate