New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14433 for NEMO/trunk/src/OCE/DOM/domain.F90 – NEMO

Ignore:
Timestamp:
2021-02-11T09:06:49+01:00 (3 years ago)
Author:
smasson
Message:

trunk: merge dev_r14312_MPI_Interface into the trunk, #2598

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/DOM/domain.F90

    r14255 r14433  
    113113         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls 
    114114         WRITE(numout,*)     '              jpnij   : ', jpnij 
    115          WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio 
    116          SELECT CASE ( jperio ) 
    117          CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)' 
    118          CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)' 
    119          CASE( 2 )   ;   WRITE(numout,*) '         (i.e. cyclic north-south)' 
    120          CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)' 
    121          CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)' 
    122          CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)' 
    123          CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)' 
    124          CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)' 
    125          CASE DEFAULT 
    126             CALL ctl_stop( 'dom_init:   jperio is out of range' ) 
    127          END SELECT 
     115         WRITE(numout,*)     '      lateral boundary of the Global domain:' 
     116         WRITE(numout,*)     '              cyclic east-west             :', l_Iperio 
     117         WRITE(numout,*)     '              cyclic north-south           :', l_Jperio 
     118         WRITE(numout,*)     '              North Pole folding           :', l_NFold 
     119         WRITE(numout,*)     '                 type of North pole Folding:', c_NFtype 
    128120         WRITE(numout,*)     '      Ocean model configuration used:' 
    129          WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
     121         WRITE(numout,*)     '              cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg 
    130122      ENDIF 
    131123 
     
    622614 
    623615 
    624    SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 
     616   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, ldIperio, ldJperio, ldNFold, cdNFtype ) 
    625617      !!---------------------------------------------------------------------- 
    626618      !!                     ***  ROUTINE domain_cfg  *** 
     
    630622      !! ** Method  :   read the cn_domcfg NetCDF file 
    631623      !!---------------------------------------------------------------------- 
    632       CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
    633       INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
    634       INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
    635       INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
    636       ! 
    637       INTEGER ::   inum   ! local integer 
     624      CHARACTER(len=*), INTENT(out) ::   cd_cfg               ! configuration name 
     625      INTEGER         , INTENT(out) ::   kk_cfg               ! configuration resolution 
     626      INTEGER         , INTENT(out) ::   kpi, kpj, kpk        ! global domain sizes 
     627      LOGICAL         , INTENT(out) ::   ldIperio, ldJperio   ! i- and j- periodicity 
     628      LOGICAL         , INTENT(out) ::   ldNFold              ! North pole folding 
     629      CHARACTER(len=1), INTENT(out) ::   cdNFtype             ! Folding type: T or F 
     630      ! 
     631      CHARACTER(len=7) ::   catt                  ! 'T', 'F', '-' or 'UNKNOWN' 
     632      INTEGER ::   inum, iperio, iatt             ! local integer 
    638633      REAL(wp) ::   zorca_res                     ! local scalars 
    639634      REAL(wp) ::   zperio                        !   -      - 
     
    649644      CALL iom_open( cn_domcfg, inum ) 
    650645      ! 
    651       !                                   !- ORCA family specificity 
    652       IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  & 
    653          & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN 
    654          ! 
    655          cd_cfg = 'ORCA' 
    656          CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res ) 
    657          ! 
    658          IF(lwp) THEN 
    659             WRITE(numout,*) '   .' 
    660             WRITE(numout,*) '   ==>>>   ORCA configuration ' 
    661             WRITE(numout,*) '   .' 
     646      CALL iom_getatt( inum,  'CfgName', cd_cfg )   ! returns 'UNKNOWN' if not found 
     647      CALL iom_getatt( inum, 'CfgIndex', kk_cfg )   ! returns      -999 if not found 
     648      ! 
     649      ! ------- keep compatibility with OLD VERSION... start ------- 
     650      IF( cd_cfg == 'UNKNOWN' .AND. kk_cfg == -999 ) THEN 
     651         IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  & 
     652            & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN 
     653            ! 
     654            cd_cfg = 'ORCA' 
     655            CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res ) 
     656            ! 
     657         ELSE 
     658            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns 'UNKNOWN' if not found 
     659            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns      -999 if not found 
    662660         ENDIF 
    663          ! 
    664       ELSE                                !- cd_cfg & k_cfg are not used 
    665          cd_cfg = 'UNKNOWN' 
    666          kk_cfg = -9999999 
    667                                           !- or they may be present as global attributes 
    668                                           !- (netcdf only) 
    669          CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found 
    670          CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found 
    671          IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN' 
    672          IF( kk_cfg == -999     ) kk_cfg = -9999999 
    673          ! 
    674       ENDIF 
    675        ! 
     661      ENDIF 
     662      ! ------- keep compatibility with OLD VERSION... end ------- 
     663      ! 
    676664      idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz )   ! use e3t_0, that must exist, to get jp(ijk)glo 
    677665      kpi = idimsz(1) 
    678666      kpj = idimsz(2) 
    679667      kpk = idimsz(3) 
    680       CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio ) 
     668      ! 
     669      CALL iom_getatt( inum, 'Iperio', iatt )   ;   ldIperio = iatt == 1   ! returns      -999 if not found -> default = .false. 
     670      CALL iom_getatt( inum, 'Jperio', iatt )   ;   ldJperio = iatt == 1   ! returns      -999 if not found -> default = .false. 
     671      CALL iom_getatt( inum,  'NFold', iatt )   ;   ldNFold  = iatt == 1   ! returns      -999 if not found -> default = .false. 
     672      CALL iom_getatt( inum, 'NFtype', catt )                              ! returns 'UNKNOWN' if not found 
     673      IF( LEN_TRIM(catt) == 1 ) THEN   ;   cdNFtype = TRIM(catt) 
     674      ELSE                             ;   cdNFtype = '-' 
     675      ENDIF 
     676      ! 
     677      ! ------- keep compatibility with OLD VERSION... start ------- 
     678      IF( iatt == -999 .AND. catt == 'UNKNOWN' .AND. iom_varid( inum, 'jperio', ldstop = .FALSE. ) > 0 ) THEN                     
     679         CALL iom_get( inum, 'jperio', zperio )   ;   iperio = NINT( zperio ) 
     680         ldIperio = iperio == 1  .OR. iperio == 4 .OR. iperio == 6 .OR. iperio == 7   ! i-periodicity 
     681         ldJperio = iperio == 2  .OR. iperio == 7                                     ! j-periodicity 
     682         ldNFold  = iperio >= 3 .AND. iperio <= 6                                     ! North pole folding 
     683         IF(     iperio == 3 .OR. iperio == 4 ) THEN   ;   cdNFtype = 'T'             !    folding at T point 
     684         ELSEIF( iperio == 5 .OR. iperio == 6 ) THEN   ;   cdNFtype = 'F'             !    folding at F point 
     685         ELSE                                          ;   cdNFtype = '-'             !    default value 
     686         ENDIF 
     687      ENDIF 
     688      ! ------- keep compatibility with OLD VERSION... end ------- 
     689      ! 
    681690      CALL iom_close( inum ) 
    682691      ! 
    683692      IF(lwp) THEN 
    684          WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg 
     693         WRITE(numout,*) '   .' 
     694         WRITE(numout,*) '   ==>>>   ', TRIM(cn_cfg), ' configuration ' 
     695         WRITE(numout,*) '   .' 
     696         WRITE(numout,*) '      nn_cfg = ', kk_cfg 
    685697         WRITE(numout,*) '      Ni0glo = ', kpi 
    686698         WRITE(numout,*) '      Nj0glo = ', kpj 
    687699         WRITE(numout,*) '      jpkglo = ', kpk 
    688          WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    689700      ENDIF 
    690701      ! 
     
    724735      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    725736      ! 
    726       !                             !==  ORCA family specificities  ==! 
    727       IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 
    728          CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    729          CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 
    730       ENDIF 
     737      !                             !==  Configuration specificities  ==! 
     738      ! 
     739      CALL iom_putatt( inum,  'CfgName', TRIM(cn_cfg) ) 
     740      CALL iom_putatt( inum, 'CfgIndex',      nn_cfg  ) 
    731741      ! 
    732742      !                             !==  domain characteristics  ==! 
    733743      ! 
    734744      !                                   ! lateral boundary of the global domain 
    735       CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
    736       ! 
     745      CALL iom_putatt( inum, 'Iperio', COUNT( (/l_Iperio/) ) ) 
     746      CALL iom_putatt( inum, 'Jperio', COUNT( (/l_Jperio/) ) ) 
     747      CALL iom_putatt( inum,  'NFold', COUNT( (/l_NFold /) ) ) 
     748      CALL iom_putatt( inum, 'NFtype',          c_NFtype     ) 
     749 
    737750      !                                   ! type of vertical coordinate 
    738       CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 
    739       CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 
    740       CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 
    741       ! 
     751      IF(ln_zco)   CALL iom_putatt( inum, 'VertCoord', 'zco' ) 
     752      IF(ln_zps)   CALL iom_putatt( inum, 'VertCoord', 'zps' ) 
     753      IF(ln_sco)   CALL iom_putatt( inum, 'VertCoord', 'sco' ) 
     754       
    742755      !                                   ! ocean cavities under iceshelves 
    743       CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 
     756      CALL iom_putatt( inum, 'IsfCav', COUNT( (/ln_isfcav/) ) ) 
    744757      ! 
    745758      !                             !==  horizontal mesh  ! 
     
    794807         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 ) 
    795808      ENDIF 
    796       ! 
    797       ! Add some global attributes ( netcdf only ) 
    798       CALL iom_putatt( inum, 'nn_cfg', nn_cfg ) 
    799       CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) ) 
    800       ! 
    801       !                                ! ============================ 
    802       !                                !        close the files 
    803       !                                ! ============================ 
     809      !                       ! ============================ ! 
     810      !                       !        close the files 
     811      !                       ! ============================ ! 
    804812      CALL iom_close( inum ) 
    805813      ! 
Note: See TracChangeset for help on using the changeset viewer.