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 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domain.F90 – NEMO

Ignore:
Timestamp:
2021-03-26T15:33:49+01:00 (3 years ago)
Author:
sparonuz
Message:

Merge trunk -r14642:HEAD

Location:
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette_wave@13990         sette 
         11^/utils/CI/sette@14244        sette 

  • NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DOM/domain.F90

    r14219 r14644  
    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 
    … …  
    182174      !                                 != ssh initialization 
    183175      ! 
    184       IF( l_offline .OR. l_SAS ) THEN        !* No ocean dynamics calculation : set to 0 
     176      IF( l_SAS ) THEN        !* No ocean dynamics calculation : set to 0 
    185177         ssh(:,:,:) = 0._wp 
    186178#if defined key_agrif 
    … …  
    283275      mig0(:) = mig(:) - nn_hls 
    284276      mjg0(:) = mjg(:) - nn_hls 
    285       ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 
    286       ! we must define mig0 and mjg0 as bellow. 
    287       ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 
    288       mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
    289       mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 
    290       ! 
    291277      !                              ! global domain, including halos, indices ==> local domain indices 
    292278      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
    … …  
    429415            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock 
    430416         ENDIF 
    431 #if ! defined key_iomput 
     417#if ! defined key_xios 
    432418         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write 
    433419#endif 
    … …  
    506492         ENDIF 
    507493      ENDIF 
    508 #if ! defined key_iomput 
     494#if ! defined key_xios 
    509495      IF( nn_write == -1 )   CALL ctl_warn( 'nn_write = -1 --> no output files will be done' ) 
    510496      IF ( nn_write == 0 ) THEN 
    … …  
    628614 
    629615 
    630    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 ) 
    631617      !!---------------------------------------------------------------------- 
    632618      !!                     ***  ROUTINE domain_cfg  *** 
    … …  
    636622      !! ** Method  :   read the cn_domcfg NetCDF file 
    637623      !!---------------------------------------------------------------------- 
    638       CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name 
    639       INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution 
    640       INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes 
    641       INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c. 
    642       ! 
    643       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 
    644633      REAL(wp) ::   zorca_res                     ! local scalars 
    645634      REAL(wp) ::   zperio                        !   -      - 
    … …  
    655644      CALL iom_open( cn_domcfg, inum ) 
    656645      ! 
    657       !                                   !- ORCA family specificity 
    658       IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  & 
    659          & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN 
    660          ! 
    661          cd_cfg = 'ORCA' 
    662          CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res ) 
    663          ! 
    664          IF(lwp) THEN 
    665             WRITE(numout,*) '   .' 
    666             WRITE(numout,*) '   ==>>>   ORCA configuration ' 
    667             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 
    668660         ENDIF 
    669          ! 
    670       ELSE                                !- cd_cfg & k_cfg are not used 
    671          cd_cfg = 'UNKNOWN' 
    672          kk_cfg = -9999999 
    673                                           !- or they may be present as global attributes 
    674                                           !- (netcdf only) 
    675          CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found 
    676          CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found 
    677          IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN' 
    678          IF( kk_cfg == -999     ) kk_cfg = -9999999 
    679          ! 
    680       ENDIF 
    681        ! 
     661      ENDIF 
     662      ! ------- keep compatibility with OLD VERSION... end ------- 
     663      ! 
    682664      idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz )   ! use e3t_0, that must exist, to get jp(ijk)glo 
    683665      kpi = idimsz(1) 
    684666      kpj = idimsz(2) 
    685667      kpk = idimsz(3) 
    686       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      ! 
    687690      CALL iom_close( inum ) 
    688691      ! 
    689692      IF(lwp) THEN 
    690          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 
    691697         WRITE(numout,*) '      Ni0glo = ', kpi 
    692698         WRITE(numout,*) '      Nj0glo = ', kpj 
    693699         WRITE(numout,*) '      jpkglo = ', kpk 
    694          WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    695700      ENDIF 
    696701      ! 
    … …  
    730735      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    731736      ! 
    732       !                             !==  ORCA family specificities  ==! 
    733       IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 
    734          CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 ) 
    735          CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 
    736       ENDIF 
     737      !                             !==  Configuration specificities  ==! 
     738      ! 
     739      CALL iom_putatt( inum,  'CfgName', TRIM(cn_cfg) ) 
     740      CALL iom_putatt( inum, 'CfgIndex',      nn_cfg  ) 
    737741      ! 
    738742      !                             !==  domain characteristics  ==! 
    739743      ! 
    740744      !                                   ! lateral boundary of the global domain 
    741       CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, dp), ktype = jp_i4 ) 
    742       ! 
     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 
    743750      !                                   ! type of vertical coordinate 
    744       CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), dp), ktype = jp_i4 ) 
    745       CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), dp), ktype = jp_i4 ) 
    746       CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), dp), ktype = jp_i4 ) 
    747       ! 
     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       
    748755      !                                   ! ocean cavities under iceshelves 
    749       CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), dp), ktype = jp_i4 ) 
     756      CALL iom_putatt( inum, 'IsfCav', COUNT( (/ln_isfcav/) ) ) 
    750757      ! 
    751758      !                             !==  horizontal mesh  ! 
    … …  
    800807         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 ) 
    801808      ENDIF 
    802       ! 
    803       ! Add some global attributes ( netcdf only ) 
    804       CALL iom_putatt( inum, 'nn_cfg', nn_cfg ) 
    805       CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) ) 
    806       ! 
    807       !                                ! ============================ 
    808       !                                !        close the files 
    809       !                                ! ============================ 
     809      !                       ! ============================ ! 
     810      !                       !        close the files 
     811      !                       ! ============================ ! 
    810812      CALL iom_close( inum ) 
    811813      ! 
Note: See TracChangeset for help on using the changeset viewer.