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 13286 for NEMO/trunk/src/OCE/IOM – NEMO

Ignore:
Timestamp:
2020-07-09T17:48:29+02:00 (4 years ago)
Author:
smasson
Message:

trunk: merge extra halos branch in trunk, see #2366

Location:
NEMO/trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools/@HEAD           tools 
         4^/utils/tools@HEAD            tools 
        55^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        … …  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@12931        sette 
         10^/utils/CI/r12931_sette_ticket2366@HEAD  sette 

  • NEMO/trunk/src/OCE/IOM/in_out_manager.F90

    r12933 r13286  
    118118   LOGICAL ::   ln_timing        !: run control for timing 
    119119   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics 
    120    INTEGER ::   nn_print         !: level of print (0 no print) 
    121120   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 
    122121   INTEGER ::   nn_ictle         !: End   i indice for the SUM control 
    … …  
    125124   INTEGER ::   nn_isplt         !: number of processors following i 
    126125   INTEGER ::   nn_jsplt         !: number of processors following j 
    127    !                                           
    128    INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names 
    129  
    130    INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors 
    131126 
    132127   !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/OCE/IOM/iom.F90

    r13226 r13286  
    2121   !!---------------------------------------------------------------------- 
    2222   USE dom_oce         ! ocean space and time domain 
     23   USE domutl          !  
    2324   USE c1d             ! 1D vertical configuration 
    2425   USE flo_oce         ! floats module declarations 
    … …  
    3435   USE ice      , ONLY :   jpl 
    3536#endif 
    36    USE domngb          ! ocean space and time domain 
    3737   USE phycst          ! physical constants 
    3838   USE dianam          ! build name of file 
    … …  
    101101CONTAINS 
    102102 
    103    SUBROUTINE iom_init( cdname, fname, ld_tmppatch, ld_closedef )  
     103   SUBROUTINE iom_init( cdname, fname, ld_closedef )  
    104104      !!---------------------------------------------------------------------- 
    105105      !!                     ***  ROUTINE   *** 
    … …  
    110110      CHARACTER(len=*),           INTENT(in)  :: cdname 
    111111      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname 
    112       LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch 
    113112      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef 
    114113#if defined key_iomput 
    … …  
    123122      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
    124123      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    125       LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    126       INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
    127       INTEGER ::   nldj_save, nlej_save    !: 
    128124      LOGICAL ::   ll_closedef = .TRUE. 
    129125      !!---------------------------------------------------------------------- 
    130126      ! 
    131       ! seb: patch before we remove periodicity and close boundaries in output files 
    132       IF( PRESENT(ld_tmppatch) ) THEN   ;   ll_tmppatch = ld_tmppatch 
    133       ELSE                              ;   ll_tmppatch = .TRUE. 
    134       ENDIF 
    135       IF ( ll_tmppatch ) THEN 
    136          nldi_save = nldi   ;   nlei_save = nlei 
    137          nldj_save = nldj   ;   nlej_save = nlej 
    138          IF( nimpp           ==      1 ) nldi = 1 
    139          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    140          IF( njmpp           ==      1 ) nldj = 1 
    141          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    142       ENDIF 
    143127      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 
    144128      ! 
    … …  
    157141 
    158142      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    159       CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    160           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    161       CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    162           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    163       CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    164           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     143      CASE ( 1)   ;   CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),  & 
     144          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) ) 
     145      CASE ( 0)   ;   CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),  & 
     146          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) ) 
     147      CASE (30)   ;   CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),  & 
     148          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) ) 
    165149      END SELECT 
    166150 
    … …  
    176160         ! 
    177161         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    178             CALL iom_set_domain_attr("grid_T", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 
    179             CALL iom_set_domain_attr("grid_U", area = real( e1e2u(nldi:nlei, nldj:nlej), dp)) 
    180             CALL iom_set_domain_attr("grid_V", area = real( e1e2v(nldi:nlei, nldj:nlej), dp)) 
    181             CALL iom_set_domain_attr("grid_W", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 
     162            CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     163            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 
     164            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 
     165            CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
    182166            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    183167            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    … …  
    199183         ! 
    200184         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata 
    201             CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp)) 
    202             CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej), dp) ) 
    203             CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej), dp) ) 
    204             CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp ) ) 
     185            CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     186            CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     187            CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     188            CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
    205189            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
    206190            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
    … …  
    288272      DEALLOCATE( zt_bnds, zw_bnds ) 
    289273      ! 
    290       IF ( ll_tmppatch ) THEN 
    291          nldi = nldi_save   ;   nlei = nlei_save 
    292          nldj = nldj_save   ;   nlej = nlej_save 
    293       ENDIF 
    294274#endif 
    295275      ! 
    … …  
    671651 
    672652 
    673    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 
     653   SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp ) 
    674654      !!--------------------------------------------------------------------- 
    675655      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    680660      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file 
    681661      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.) 
    682       INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap) 
    683662      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    684663      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    … …  
    693672      LOGICAL               ::   llok      ! check the existence  
    694673      LOGICAL               ::   llwrt     ! local definition of ldwrt 
    695       LOGICAL               ::   llnoov    ! local definition to read overlap 
    696674      LOGICAL               ::   llstop    ! local definition of ldstop 
    697675      LOGICAL               ::   lliof     ! local definition of ldiof 
    698676      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
    699677      INTEGER               ::   iln, ils  ! lengths of character 
    700       INTEGER               ::   idom      ! type of domain 
    701678      INTEGER               ::   istop     !  
    702       INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters:  
    703679      ! local number of points for x,y dimensions 
    704680      ! position of first local point for x,y dimensions 
    … …  
    732708      ELSE                        ;   lliof = .FALSE. 
    733709      ENDIF 
    734       ! do we read the overlap  
    735       ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    736       llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
    737710      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 
    738711      ! ============= 
    … …  
    774747         lxios_sini = .TRUE. 
    775748      ENDIF 
    776       IF( llwrt ) THEN 
    777          ! check the domain definition 
    778 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    779 !         idom = jpdom_local_noovlap   ! default definition 
    780          IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition 
    781          ELSE                ;   idom = jpdom_local_full      ! default definition 
    782          ENDIF 
    783          IF( PRESENT(kdom) )   idom = kdom 
    784          ! create the domain informations 
    785          ! ============= 
    786          SELECT CASE (idom) 
    787          CASE (jpdom_local_full) 
    788             idompar(:,1) = (/ jpi             , jpj              /) 
    789             idompar(:,2) = (/ nimpp           , njmpp            /) 
    790             idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /) 
    791             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    792             idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /) 
    793          CASE (jpdom_local_noextra) 
    794             idompar(:,1) = (/ nlci            , nlcj             /) 
    795             idompar(:,2) = (/ nimpp           , njmpp            /) 
    796             idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 
    797             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    798             idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /) 
    799          CASE (jpdom_local_noovlap) 
    800             idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /) 
    801             idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
    802             idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
    803             idompar(:,4) = (/ 0               , 0                /) 
    804             idompar(:,5) = (/ 0               , 0                /) 
    805          CASE DEFAULT 
    806             CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' ) 
    807          END SELECT 
    808       ENDIF 
    809749      ! Open the NetCDF file 
    810750      ! ============= 
    … …  
    830770      ENDIF 
    831771      IF( istop == nstop ) THEN   ! no error within this routine 
    832          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 
     772         CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp ) 
    833773      ENDIF 
    834774      ! 
    … …  
    10911031   END SUBROUTINE iom_g1d_dp 
    10921032 
    1093    SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
    1094       INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    1095       INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    1096       CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
    1097       REAL(sp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
    1098       REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)           ::   ztmp_pvar ! tmp var to read field 
    1099       INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
    1100       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    1101       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
    1102       LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1103                                                                                ! look for and use a file attribute 
    1104                                                                                ! called open_ocean_jstart to set the start 
    1105                                                                                ! value for the 2nd dimension (netcdf only) 
    1106       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS 
     1033   SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
     1034      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1035      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1036      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1037      REAL(sp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     1038      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)         ::   ztmp_pvar ! tmp var to read field 
     1039      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1040      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1041      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1042      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1043      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     1044      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
     1045      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
    11071046      ! 
    11081047      IF( kiomid > 0 ) THEN 
    11091048         IF( iom_file(kiomid)%nfid > 0 ) THEN 
    11101049            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 
    1111             CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=ztmp_pvar,   & 
    1112               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1113               &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
     1050            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = ztmp_pvar  , ktime = ktime,   & 
     1051             &                                                      cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1052             &                                                      kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1053            pvar = ztmp_pvar 
     1054            DEALLOCATE(ztmp_pvar) 
     1055         ENDIF 
     1056      ENDIF 
     1057   END SUBROUTINE iom_g2d_sp 
     1058 
     1059   SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
     1060      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1061      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1062      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1063      REAL(dp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     1064      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1065      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1066      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1067      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1068      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     1069      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
     1070      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1071      ! 
     1072      IF( kiomid > 0 ) THEN 
     1073         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = pvar  , ktime = ktime,   & 
     1074            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1075            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1076      ENDIF 
     1077   END SUBROUTINE iom_g2d_dp 
     1078 
     1079   SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
     1080      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1081      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1082      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1083      REAL(sp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1084      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)       ::   ztmp_pvar ! tmp var to read field 
     1085      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1086      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1087      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1088      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1089      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1090      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
     1091      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1092      ! 
     1093      IF( kiomid > 0 ) THEN 
     1094         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1095            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 
     1096            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = ztmp_pvar  , ktime = ktime,   & 
     1097            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1098            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
    11141099            pvar = ztmp_pvar 
    11151100            DEALLOCATE(ztmp_pvar) 
    11161101         END IF 
    11171102      ENDIF 
    1118    END SUBROUTINE iom_g2d_sp 
    1119  
    1120  
    1121    SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
    1122       INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    1123       INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    1124       CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
    1125       REAL(dp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
    1126       INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
    1127       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    1128       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
    1129       LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1130                                                                                ! look for and use a file attribute 
    1131                                                                                ! called open_ocean_jstart to set the start 
    1132                                                                                ! value for the 2nd dimension (netcdf only) 
    1133       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS 
    1134       ! 
    1135       IF( kiomid > 0 ) THEN 
    1136          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    1137               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1138               &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
    1139       ENDIF 
    1140    END SUBROUTINE iom_g2d_dp 
    1141  
    1142    SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
    1143       INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    1144       INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    1145       CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
    1146       REAL(sp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
    1147       REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)           ::   ztmp_pvar ! tmp var to read field 
    1148       INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
    1149       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    1150       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
    1151       LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1152                                                                                  ! look for and use a file attribute 
    1153                                                                                  ! called open_ocean_jstart to set the start 
    1154                                                                                  ! value for the 2nd dimension (netcdf only) 
    1155       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS 
     1103   END SUBROUTINE iom_g3d_sp 
     1104 
     1105   SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
     1106      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1107      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1108      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1109      REAL(dp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1110      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1111      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1112      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1113      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1114      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1115      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
     1116      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
    11561117      ! 
    11571118      IF( kiomid > 0 ) THEN 
    11581119         IF( iom_file(kiomid)%nfid > 0 ) THEN 
    1159             ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 
    1160             CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=ztmp_pvar,   & 
    1161               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1162               &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
    1163             pvar = ztmp_pvar 
    1164             DEALLOCATE(ztmp_pvar) 
     1120            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = pvar  , ktime = ktime,   & 
     1121            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1122            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
    11651123         END IF 
    11661124      ENDIF 
    1167    END SUBROUTINE iom_g3d_sp 
    1168  
    1169    SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
    1170       INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    1171       INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    1172       CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
    1173       REAL(dp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
    1174       INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
    1175       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    1176       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
    1177       LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1178                                                                                  ! look for and use a file attribute 
    1179                                                                                  ! called open_ocean_jstart to set the start 
    1180                                                                                  ! value for the 2nd dimension (netcdf only) 
    1181       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS 
    1182       ! 
    1183       IF( kiomid > 0 ) THEN 
    1184          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    1185               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1186               &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
    1187       ENDIF 
    11881125   END SUBROUTINE iom_g3d_dp 
    11891126 
    1190  
    1191  
    11921127   !!---------------------------------------------------------------------- 
    11931128 
    1194    SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   & 
    1195          &                  pv_r1d, pv_r2d, pv_r3d,   & 
    1196          &                  ktime , kstart, kcount,   & 
    1197          &                  lrowattr, ldxios        ) 
     1129   SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime ,   & 
     1130         &                  cd_type, psgn, kfill, kstart, kcount, ldxios ) 
    11981131      !!----------------------------------------------------------------------- 
    11991132      !!                  ***  ROUTINE  iom_get_123d  *** 
    … …  
    12031136      !! ** Method : read ONE record at each CALL 
    12041137      !!----------------------------------------------------------------------- 
    1205       INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file 
    1206       INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read 
    1207       CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable 
    1208       REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    1209       REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
    1210       REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
    1211       INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number 
    1212       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
    1213       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
    1214       LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to 
    1215                                                                            ! look for and use a file attribute 
    1216                                                                            ! called open_ocean_jstart to set the start 
    1217                                                                            ! value for the 2nd dimension (netcdf only) 
    1218       LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios     ! use XIOS to read restart 
    1219       ! 
    1220       LOGICAL                        ::   llxios       ! local definition for XIOS read 
    1221       LOGICAL                        ::   llnoov      ! local definition to read overlap 
    1222       LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute 
    1223       INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute 
     1138      INTEGER                    , INTENT(in   )           ::   kiomid    ! Identifier of the file 
     1139      INTEGER                    , INTENT(in   )           ::   kdom      ! Type of domain to be read 
     1140      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar     ! Name of the variable 
     1141      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
     1142      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
     1143      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     1144      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number 
     1145      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1146      REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1147      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1148      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis  
     1149      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount    ! number of points to be read in each axis 
     1150      LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios    ! use XIOS to read restart 
     1151      ! 
     1152      LOGICAL                        ::   llok        ! true if ok! 
     1153      LOGICAL                        ::   llxios      ! local definition for XIOS read 
    12241154      INTEGER                        ::   jl          ! loop on number of dimension  
    12251155      INTEGER                        ::   idom        ! type of domain 
    … …  
    12381168      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    12391169      REAL(dp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     1170      REAL(wp)                       ::   zsgn        ! local value of psgn 
    12401171      INTEGER                        ::   itmp        ! temporary integer 
    12411172      CHARACTER(LEN=256)             ::   clinfo      ! info character 
    12421173      CHARACTER(LEN=256)             ::   clname      ! file name 
    12431174      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    1244       LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
     1175      CHARACTER(LEN=1)               ::   cl_type     ! local value of cd_type 
     1176      LOGICAL                        ::   ll_only3rd  ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    12451177      INTEGER                        ::   inlev       ! number of levels for 3D data 
    12461178      REAL(dp)                       ::   gma, gmi 
    … …  
    12511183      ! 
    12521184      llxios = .FALSE. 
    1253       if(PRESENT(ldxios)) llxios = ldxios 
    1254       idvar = iom_varid( kiomid, cdvar )  
     1185      IF( PRESENT(ldxios) )  llxios = ldxios 
     1186      ! 
    12551187      idom = kdom 
     1188      istop = nstop 
    12561189      ! 
    12571190      IF(.NOT.llxios) THEN 
    12581191         clname = iom_file(kiomid)%name   !   esier to read 
    12591192         clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 
    1260          ! local definition of the domain ? 
    1261          ! do we read the overlap  
    1262          ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    1263          llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif  
    12641193         ! check kcount and kstart optionals parameters... 
    1265          IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
    1266          IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    1267          IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) & 
    1268      &          CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 
    1269  
    1270          luse_jattr = .false. 
    1271          IF( PRESENT(lrowattr) ) THEN 
    1272             IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 
    1273             IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true. 
    1274          ENDIF 
    1275  
     1194         IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
     1195         IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
     1196         IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) & 
     1197            &          CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy') 
     1198         IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) & 
     1199            &          CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present') 
     1200         ! 
    12761201         ! Search for the variable in the data base (eventually actualize data) 
    1277          istop = nstop 
    12781202         ! 
     1203         idvar = iom_varid( kiomid, cdvar )  
    12791204         IF( idvar > 0 ) THEN 
    1280             ! to write iom_file(kiomid)%dimsz in a shorter way ! 
    1281             idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)  
     1205            ! 
     1206            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)      ! to write iom_file(kiomid)%dimsz in a shorter way 
    12821207            inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file 
    12831208            idmspc = inbdim                                   ! number of spatial dimensions in the file 
    … …  
    12851210            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')  
    12861211            ! 
    1287             ! update idom definition... 
    1288             ! Identify the domain in case of jpdom_auto(glo/dta) definition 
    1289             IF( idom == jpdom_autoglo_xy ) THEN 
    1290                ll_depth_spec = .TRUE. 
    1291                idom = jpdom_autoglo 
    1292             ELSE 
    1293                ll_depth_spec = .FALSE. 
    1294             ENDIF 
    1295             IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN             
    1296                IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global  
    1297                ELSE                               ;   idom = jpdom_data 
    1298                ENDIF 
     1212            ! Identify the domain in case of jpdom_auto definition 
     1213            IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN             
     1214               idom = jpdom_global   ! default 
     1215               ! else: if the file name finishes with _xxxx.nc with xxxx any number 
    12991216               ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 
    13001217               ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 
    13011218               IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF 
    1302             ENDIF 
    1303             ! Identify the domain in case of jpdom_local definition 
    1304             IF( idom == jpdom_local ) THEN 
    1305                IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full 
    1306                ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra 
    1307                ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap 
    1308                ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 
    1309                ENDIF 
    13101219            ENDIF 
    13111220            ! 
    … …  
    13201229            WRITE(cldmspc , fmt='(i1)') idmspc 
    13211230            ! 
    1322             !!GS: we consider 2D data as 3D data with vertical dim size = 1 
    1323             !IF(     idmspc <  irankpv ) THEN  
    1324             !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
    1325             !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
    1326             !ELSEIF( idmspc == irankpv ) THEN 
    1327             IF( idmspc == irankpv ) THEN 
     1231            IF(     idmspc <  irankpv ) THEN                     ! it seems we want to read more than we can... 
     1232               IF(     irankpv == 3 .AND. idmspc == 2 ) THEN     !   3D input array from 2D spatial data in the file: 
     1233                  llok = inlev == 1                              !     -> 3rd dimension must be equal to 1 
     1234               ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN     !   3D input array from 1D spatial data in the file: 
     1235                  llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1   !     -> 2nd and 3rd dimensions must be equal to 1 
     1236               ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN     !   2D input array from 1D spatial data in the file: 
     1237                  llok = SIZE(pv_r2d, 2) == 1                    !     -> 2nd dimension must be equal to 1 
     1238               ELSE 
     1239                  llok = .FALSE. 
     1240               ENDIF 
     1241               IF( .NOT. llok )   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     1242                  &                                            '=> cannot read a true '//clrankpv//'D array from this file...' ) 
     1243            ELSEIF( idmspc == irankpv ) THEN 
    13281244               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    13291245                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
    1330             ELSEIF( idmspc >  irankpv ) THEN 
     1246            ELSEIF( idmspc >  irankpv ) THEN                     ! it seems we want to read less than we should... 
    13311247                  IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
    1332                      CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   & 
     1248                     CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...'              ,   & 
    13331249                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
    13341250                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
    … …  
    13441260            ! definition of istart and icnt 
    13451261            ! 
    1346             icnt  (:) = 1 
    1347             istart(:) = 1 
    1348             istart(idmspc+1) = itime 
    1349     
    1350             IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN  
    1351                istart(1:idmspc) = kstart(1:idmspc)  
    1352                icnt  (1:idmspc) = kcount(1:idmspc) 
    1353             ELSE 
    1354                IF(idom == jpdom_unknown ) THEN 
    1355                   icnt(1:idmspc) = idimsz(1:idmspc) 
    1356                ELSE  
    1357                   IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
    1358                      IF(     idom == jpdom_data    ) THEN 
    1359                         jstartrow = 1 
    1360                         IF( luse_jattr ) THEN 
    1361                            CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    1362                            jstartrow = MAX(1,jstartrow) 
    1363                         ENDIF 
    1364                         istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
    1365                      ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below 
    1366                      ENDIF 
    1367                      ! we do not read the overlap                     -> we start to read at nldi, nldj 
    1368 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1369 !                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1370                      IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1371                   ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
    1372 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1373 !                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1374                      IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1375                      ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /) 
    1376                      ENDIF 
    1377                      IF( PRESENT(pv_r3d) ) THEN 
    1378                         IF( idom == jpdom_data ) THEN                        ;                               icnt(3) = inlev 
    1379                         ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;   icnt(3) = kcount(3) 
    1380                         ELSE                                                 ;                               icnt(3) = inlev 
    1381                         ENDIF 
    1382                      ENDIF 
     1262            icnt  (:) = 1              ! default definition (simple way to deal with special cases listed above)  
     1263            istart(:) = 1              ! default definition (simple way to deal with special cases listed above)  
     1264            istart(idmspc+1) = itime   ! temporal dimenstion 
     1265            ! 
     1266            IF( idom == jpdom_unknown ) THEN 
     1267               IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN  
     1268                  istart(1:idmspc) = kstart(1:idmspc)  
     1269                  icnt  (1:idmspc) = kcount(1:idmspc) 
     1270               ELSE 
     1271                  icnt  (1:idmspc) = idimsz(1:idmspc) 
     1272               ENDIF 
     1273            ELSE   !   not a 1D array as pv_r1d requires jpdom_unknown 
     1274               ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0  
     1275               IF( idom == jpdom_global )   istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 
     1276               icnt(1:2) = (/ Ni_0, Nj_0 /) 
     1277               IF( PRESENT(pv_r3d) ) THEN 
     1278                  IF( idom == jpdom_auto_xy ) THEN 
     1279                     istart(3) = kstart(3) 
     1280                     icnt  (3) = kcount(3) 
     1281                  ELSE 
     1282                     icnt  (3) = inlev 
    13831283                  ENDIF 
    13841284               ENDIF 
    13851285            ENDIF 
    1386  
     1286            ! 
    13871287            ! check that istart and icnt can be used with this file 
    13881288            !- 
    … …  
    13951295               ENDIF 
    13961296            END DO 
    1397  
     1297            ! 
    13981298            ! check that icnt matches the input array 
    13991299            !-      
    … …  
    14051305            ELSE 
    14061306               IF( irankpv == 2 ) THEN 
    1407 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1408 !               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)' 
    1409                   IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 
    1410                   ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)' 
    1411                   ENDIF 
     1307                  ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0  ))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 
    14121308               ENDIF 
    14131309               IF( irankpv == 3 ) THEN  
    1414 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1415 !               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 
    1416                   IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 
    1417                   ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 
    1418                   ENDIF 
     1310                  ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 
    14191311               ENDIF 
    1420             ENDIF 
    1421           
     1312            ENDIF          
    14221313            DO jl = 1, irankpv 
    14231314               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 
    … …  
    14311322         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point... 
    14321323            ! 
    1433          ! find the right index of the array to be read 
    1434 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1435 !         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1436 !         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1437 !         ENDIF 
    1438             IF( llnoov ) THEN 
    1439                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1440                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1441                ENDIF 
    1442             ELSE 
    1443                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj 
    1444                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1445                ENDIF 
     1324            ! find the right index of the array to be read 
     1325            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = Nis0   ;   ix2 = Nie0      ;   iy1 = Njs0   ;   iy2 = Nje0 
     1326            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    14461327            ENDIF 
    14471328       
    … …  
    14501331            IF( istop == nstop ) THEN   ! no additional errors until this point... 
    14511332               IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 
    1452               
     1333 
     1334               cl_type = 'T' 
     1335               IF( PRESENT(cd_type) )   cl_type = cd_type 
     1336               zsgn = 1._wp 
     1337               IF( PRESENT(psgn   ) )   zsgn    = psgn 
    14531338               !--- overlap areas and extra hallows (mpp) 
    1454                IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1455                   CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    1456                ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    1457                   ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    1458                   IF( icnt(3) == inlev ) THEN 
    1459                      CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    1460                   ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    1461                      DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
    1462                      DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO 
    1463                   ENDIF 
     1339               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     1340                  CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 
     1341               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     1342                  CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 
    14641343               ENDIF 
    14651344               ! 
    … …  
    14781357         CALL iom_swap( TRIM(crxios_context) )  
    14791358         IF( PRESENT(pv_r3d) ) THEN 
    1480             pv_r3d(:, :, :) = 0. 
    1481             if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 
     1359            IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 
    14821360            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    1483             IF(idom /= jpdom_unknown ) then 
    1484                 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing) 
    1485             ENDIF 
     1361            IF(idom /= jpdom_unknown )   CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
    14861362         ELSEIF( PRESENT(pv_r2d) ) THEN 
    1487             pv_r2d(:, :) = 0. 
    1488             if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 
     1363            IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 
    14891364            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    1490             IF(idom /= jpdom_unknown ) THEN 
    1491                 CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing) 
    1492             ENDIF 
     1365            IF(idom /= jpdom_unknown )   CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
    14931366         ELSEIF( PRESENT(pv_r1d) ) THEN 
    1494             pv_r1d(:) = 0. 
    1495             if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 
     1367            IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 
    14961368            CALL xios_recv_field( trim(cdvar), pv_r1d) 
    14971369         ENDIF 
    … …  
    20361908      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    20371909      REAL(sp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    2038 #if defined key_iomput 
    2039       CALL xios_send_field(cdname, pfield2d) 
     1910      IF( iom_use(cdname) ) THEN 
     1911#if defined key_iomput 
     1912         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1913            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1914         ELSE 
     1915            CALL xios_send_field( cdname, pfield2d ) 
     1916         ENDIF 
    20401917#else 
    2041       IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    2042 #endif 
     1918         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1919#endif 
     1920      ENDIF 
    20431921   END SUBROUTINE iom_p2d_sp 
    20441922 
    … …  
    20461924      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    20471925      REAL(dp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    2048 #if defined key_iomput 
    2049       CALL xios_send_field(cdname, pfield2d) 
     1926      IF( iom_use(cdname) ) THEN 
     1927#if defined key_iomput 
     1928         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1929            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1930         ELSE 
     1931            CALL xios_send_field( cdname, pfield2d ) 
     1932         ENDIF 
    20501933#else 
    2051       IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    2052 #endif 
     1934         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1935#endif 
     1936      ENDIF 
    20531937   END SUBROUTINE iom_p2d_dp 
    20541938 
    … …  
    20561940      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20571941      REAL(sp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    2058 #if defined key_iomput 
    2059       CALL xios_send_field( cdname, pfield3d ) 
     1942      IF( iom_use(cdname) ) THEN 
     1943#if defined key_iomput 
     1944         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1945            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1946         ELSE 
     1947            CALL xios_send_field( cdname, pfield3d ) 
     1948         ENDIF 
    20601949#else 
    2061       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    2062 #endif 
     1950         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1951#endif 
     1952      ENDIF 
    20631953   END SUBROUTINE iom_p3d_sp 
    20641954 
    … …  
    20661956      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20671957      REAL(dp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    2068 #if defined key_iomput 
    2069       CALL xios_send_field( cdname, pfield3d ) 
     1958      IF( iom_use(cdname) ) THEN 
     1959#if defined key_iomput 
     1960         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1961            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1962         ELSE 
     1963            CALL xios_send_field( cdname, pfield3d ) 
     1964         ENDIF 
    20701965#else 
    2071       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    2072 #endif 
     1966         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1967#endif 
     1968      ENDIF 
    20731969   END SUBROUTINE iom_p3d_dp 
    20741970 
    … …  
    20761972      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20771973      REAL(sp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
    2078 #if defined key_iomput 
    2079       CALL xios_send_field(cdname, pfield4d) 
     1974      IF( iom_use(cdname) ) THEN 
     1975#if defined key_iomput 
     1976         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1977            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1978         ELSE 
     1979            CALL xios_send_field (cdname, pfield4d ) 
     1980         ENDIF 
    20801981#else 
    2081       IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
    2082 #endif 
     1982         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1983#endif 
     1984      ENDIF 
    20831985   END SUBROUTINE iom_p4d_sp 
    20841986 
    … …  
    20861988      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20871989      REAL(dp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
    2088 #if defined key_iomput 
    2089       CALL xios_send_field(cdname, pfield4d) 
     1990      IF( iom_use(cdname) ) THEN 
     1991#if defined key_iomput 
     1992         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1993            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1994         ELSE 
     1995            CALL xios_send_field (cdname, pfield4d ) 
     1996         ENDIF 
    20901997#else 
    2091       IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
    2092 #endif 
     1998         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1999#endif 
     2000      ENDIF 
    20932001   END SUBROUTINE iom_p4d_dp 
    20942002 
    … …  
    22872195      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    22882196      ! 
    2289       INTEGER  :: ni, nj 
    22902197      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    22912198      LOGICAL, INTENT(IN) :: ldxios, ldrxios 
    22922199      !!---------------------------------------------------------------------- 
    22932200      ! 
    2294       ni = nlei-nldi+1 
    2295       nj = nlej-nldj+1 
    2296       ! 
    2297       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    2298       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     2201      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 
     2202      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    22992203!don't define lon and lat for restart reading context.  
    23002204      IF ( .NOT.ldrxios ) & 
    2301          CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), dp),   & 
    2302          &                                     latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp ) )   
     2205         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   & 
     2206         &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))   
    23032207      ! 
    23042208      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 
    … …  
    23062210         SELECT CASE ( cdgrd ) 
    23072211         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    2308          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp ) 
    2309          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp ) 
     2212         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 
     2213         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) 
    23102214         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    23112215         END SELECT 
    23122216         ! 
    2313          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. ) 
    2314          CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
     2217         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0    /)) /= 0. ) 
     2218         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. ) 
    23152219      ENDIF 
    23162220      ! 
    23172221   END SUBROUTINE set_grid 
    2318  
    23192222 
    23202223   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 
    … …  
    23292232      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j) 
    23302233      ! 
    2331       INTEGER :: ji, jj, jn, ni, nj 
     2234      INTEGER :: ji, jj, jn 
    23322235      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    2333       !                                                 ! represents the bottom-left corner of cell (i,j) 
     2236      !                                                 ! represents the 
     2237      !                                                 bottom-left corner of 
     2238      !                                                 cell (i,j) 
    23342239      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    23352240      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
    … …  
    23462251      END SELECT 
    23472252      ! 
    2348       ni = nlei-nldi+1   ! Dimensions of subdomain interior 
    2349       nj = nlej-nldj+1 
    2350       ! 
    23512253      z_fld(:,:) = 1._wp 
    23522254      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold 
    23532255      ! 
    23542256      ! Cell vertices that can be defined 
    2355       DO jj = 2, jpjm1 
    2356          DO ji = 2, jpim1 
    2357             z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    2358             z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    2359             z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    2360             z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    2361             z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    2362             z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    2363             z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    2364             z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    2365          END DO 
    2366       END DO 
    2367       ! 
    2368       ! Cell vertices on boundries 
    2369       DO jn = 1, 4 
    2370          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp ) 
    2371          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp ) 
    2372       END DO 
    2373       ! 
    2374       ! Zero-size cells at closed boundaries if cell points provided, 
    2375       ! otherwise they are closed cells with unrealistic bounds 
    2376       IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 
    2377          IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    2378             DO jn = 1, 4        ! (West or jpni = 1), closed E-W 
    2379                z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:) 
    2380             END DO 
    2381          ENDIF 
    2382          IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    2383             DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
    2384                z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 
    2385             END DO 
    2386          ENDIF 
    2387          IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
    2388             DO jn = 1, 4        ! South or (jpnj = 1, not symmetric) 
    2389                z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1) 
    2390             END DO 
    2391          ENDIF 
    2392          IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
    2393             DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
    2394                z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 
    2395             END DO 
    2396          ENDIF 
    2397       ENDIF 
    2398       ! 
    2399       IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN    ! Rotate cells at the north fold 
    2400          DO jj = 1, jpj 
    2401             DO ji = 1, jpi 
    2402                IF( z_fld(ji,jj) == -1. ) THEN 
    2403                   z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
    2404                   z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
    2405                   z_bnds(:,ji,jj,:) = z_rot(:,:) 
    2406                ENDIF 
    2407             END DO 
    2408          END DO 
    2409       ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN                  ! Invert cells at the symmetric equator 
    2410          DO ji = 1, jpi 
    2411             z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
    2412             z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
    2413             z_bnds(:,ji,1,:) = z_rot(:,:) 
    2414          END DO 
    2415       ENDIF 
    2416       ! 
    2417       CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), dp),           & 
    2418           &                                    bounds_lon =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), dp), nvertex=4 ) 
    2419       ! 
    2420       DEALLOCATE( z_bnds, z_fld, z_rot )  
     2257      DO_2D_00_00 
     2258         z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     2259         z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     2260         z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     2261         z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     2262         z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     2263         z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     2264         z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     2265         z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     2266      END_2D 
     2267      ! 
     2268      DO_2D_00_00 
     2269         IF( z_fld(ji,jj) == -1. ) THEN 
     2270            z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
     2271            z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
     2272            z_bnds(:,ji,jj,:) = z_rot(:,:) 
     2273         ENDIF 
     2274      END_2D 
     2275      ! 
     2276      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp),           & 
     2277          &                                    bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 ) 
     2278      ! 
     2279      DEALLOCATE( z_bnds, z_fld, z_rot ) 
    24212280      ! 
    24222281   END SUBROUTINE set_grid_bounds 
    24232282 
    2424  
    24252283   SUBROUTINE set_grid_znl( plat ) 
    24262284      !!---------------------------------------------------------------------- 
    … …  
    24322290      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    24332291      ! 
    2434       INTEGER  :: ni, nj, ix, iy 
     2292      INTEGER  :: ix, iy 
    24352293      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    24362294      !!---------------------------------------------------------------------- 
    24372295      ! 
    2438       ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk) 
    2439       nj=nlej-nldj+1 
    2440       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
     2296      ALLOCATE( zlon(Ni_0*Nj_0) )       ;       zlon(:) = 0._wp 
    24412297      ! 
    24422298!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    24432299      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    2444       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    2445       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     2300      CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0) 
     2301      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    24462302      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   & 
    2447          &                             latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp))   
    2448       CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
     2303         &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))   
     2304      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0) 
    24492305      ! 
    24502306      CALL iom_update_file_name('ptr') 
    … …  
    25232379         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    25242380         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 
    2525          CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 
     2381         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 
    25262382         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    25272383         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 

  • NEMO/trunk/src/OCE/IOM/iom_def.F90

    r13062 r13286  
    1313   PRIVATE 
    1414 
    15    INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed 
    16    INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo) 
    17    INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases 
    18    INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   ) 
    19    INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  ) 
    20    INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  ) 
    21    INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking 
    22    INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !:  
    23    INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only 
    24    INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !:  
     15   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 1   !: ( 1  :Ni0glo, 1  :Nj0glo) 
     16   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 2   !: (Nis0: Nie0 ,Njs0: Nje0 ) 
     17   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 3   !: No dimension checking 
     18   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto          = 4   !:  
     19   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto_xy       = 5   !: Automatically set horizontal dimensions only 
    2520 
    2621   INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8) 
    … …  
    3530   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name 
    3631 
    37  
    3832!$AGRIF_DO_NOT_TREAT 
    3933   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0 
    … …  
    4539   LOGICAL, PUBLIC            ::   lxios_sini = .FALSE. ! is restart in a single file 
    4640   LOGICAL, PUBLIC            ::   lxios_set  = .FALSE.  
    47  
    48  
    4941 
    5042   TYPE, PUBLIC ::   file_descriptor 

  • NEMO/trunk/src/OCE/IOM/iom_nf90.F90

    r13226 r13286  
    4747CONTAINS 
    4848 
    49    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 
     49   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdlev, cdcomp ) 
    5050      !!--------------------------------------------------------------------- 
    5151      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    5757      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file? 
    5858      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    59       INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    6059      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
    6160      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    … …  
    134133            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    135134            ! define dimensions 
    136                                CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    137                                CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
     135                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',  Ni_0, idmy ), clinfo) 
     136                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',  Nj_0, idmy ), clinfo) 
    138137            SELECT CASE (clcomp) 
    139             CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
    140             CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat',          kdlev, idmy ), clinfo) 
    141             CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',          kdlev, idmy ), clinfo) 
    142             CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed',          kdlev, idmy ), clinfo) 
     138            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',   jpk, idmy ), clinfo) 
     139            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat', kdlev, idmy ), clinfo) 
     140            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev', kdlev, idmy ), clinfo) 
     141            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed', kdlev, idmy ), clinfo) 
    143142            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' ) 
    144143            END SELECT 
    145144                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    146145            ! global attributes 
    147             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
    148             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo) 
    149             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo) 
    150             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo) 
    151             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)      ), clinfo) 
    152             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)      ), clinfo) 
    153             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)      ), clinfo) 
    154             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)      ), clinfo) 
    155             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)      ), clinfo) 
    156             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo) 
     146            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij                        ), clinfo) 
     147            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1                      ), clinfo) 
     148            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1        , 2           /) ), clinfo) 
     149            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/ Ni0glo    , Nj0glo     /) ), clinfo) 
     150            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , (/ Ni_0      , Nj_0       /) ), clinfo) 
     151            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ), clinfo) 
     152            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , (/ mig0(Nie0), mjg0(Nje0) /) ), clinfo) 
     153            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0         , 0          /) ), clinfo) 
     154            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/ 0         , 0          /) ), clinfo) 
     155            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'                        ), clinfo) 
    157156         ELSE                          !* the file should be open for read mode so it must exist... 
    158157            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    … …  
    672671         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN 
    673672            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar) 
    674             IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN 
    675                ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej 
    676             ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN 
    677                ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj 
    678             ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN 
     673            IF(     idimsz(1) == Ni_0 .AND. idimsz(2) == Nj_0 ) THEN 
     674               ix1 = Nis0   ;   ix2 = Nie0   ;   iy1 = Njs0   ;   iy2 = Nje0 
     675            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
     676               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
     677            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
    679678               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    680679            ELSE  

  • NEMO/trunk/src/OCE/IOM/prtctl.F90

    r12377 r13286  
    88   !!---------------------------------------------------------------------- 
    99   USE dom_oce          ! ocean space and time domain variables 
    10 #if defined key_nemocice_decomp 
    11    USE ice_domain_size, only: nx_global, ny_global 
    12 #endif 
    1310   USE in_out_manager   ! I/O manager 
     11   USE mppini           ! distributed memory computing 
    1412   USE lib_mpp          ! distributed memory computing 
    1513 
    1614   IMPLICIT NONE 
    1715   PRIVATE 
    18  
    19    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid 
    20    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain 
    21    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain 
    22    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor 
    23    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain 
    24    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   ! 
    25  
    26    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values 
    27    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values 
    28  
    29    INTEGER ::   ktime   ! time step 
    30  
     16    
     17   INTEGER , DIMENSION(  :), ALLOCATABLE ::   numprt_oce, numprt_top 
     18   INTEGER , DIMENSION(  :), ALLOCATABLE ::   nall_ictls, nall_ictle   ! first, last indoor index for each i-domain 
     19   INTEGER , DIMENSION(  :), ALLOCATABLE ::   nall_jctls, nall_jctle   ! first, last indoor index for each j-domain 
     20   REAL(wp), DIMENSION(  :), ALLOCATABLE ::   t_ctl , s_ctl            ! previous tracer trend values 
     21   REAL(wp), DIMENSION(  :), ALLOCATABLE ::   u_ctl , v_ctl            ! previous velocity trend values 
     22   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   tra_ctl                  ! previous top trend values 
     23   !                                           
    3124   PUBLIC prt_ctl         ! called by all subroutines 
    3225   PUBLIC prt_ctl_info    ! called by all subroutines 
    33    PUBLIC prt_ctl_init    ! called by opa.F90 
    34    PUBLIC sub_dom         ! called by opa.F90 
     26   PUBLIC prt_ctl_init    ! called by nemogcm.F90 and prt_ctl_trc_init 
    3527 
    3628   !!---------------------------------------------------------------------- 
    … …  
    4133CONTAINS 
    4234 
    43    SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   & 
    44       &                                  mask2, clinfo2, kdim, clinfo3 ) 
     35   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2,   & 
     36      &                 clinfo, clinfo1, clinfo2, clinfo3, kdim ) 
    4537      !!---------------------------------------------------------------------- 
    4638      !!                     ***  ROUTINE prt_ctl  *** 
    … …  
    6860      !!                    tab2d_1 : first 2D array 
    6961      !!                    tab3d_1 : first 3D array 
     62      !!                    tab4d_1 : first 4D array 
    7063      !!                    mask1   : mask (3D) to apply to the tab[23]d_1 array 
    7164      !!                    clinfo1 : information about the tab[23]d_1 array 
    … …  
    7770      !!                    clinfo3 : additional information  
    7871      !!---------------------------------------------------------------------- 
    79       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1 
    80       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1 
    81       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1 
    82       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1 
    83       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2 
    84       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2 
    85       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2 
    86       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2 
    87       INTEGER                   , INTENT(in), OPTIONAL ::   kdim 
    88       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3 
    89       ! 
    90       CHARACTER (len=15) :: cl2 
    91       INTEGER ::  jn, sind, eind, kdir,j_id 
     72      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_1 
     73      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_1 
     74      REAL(wp),         DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d_1 
     75      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_2 
     76      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_2 
     77      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1 
     78      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2 
     79      CHARACTER(len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array 
     80      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo1 
     81      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo2 
     82      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo3 
     83      INTEGER                             , INTENT(in), OPTIONAL ::   kdim 
     84      ! 
     85      CHARACTER(len=30) :: cl1, cl2 
     86      INTEGER ::  jn, jl, kdir 
     87      INTEGER ::  iis, iie, jjs, jje 
     88      INTEGER ::  itra, inum 
    9289      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    93       REAL(wp), DIMENSION(jpi,jpj)     :: ztab2d_1, ztab2d_2 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 
    95       !!---------------------------------------------------------------------- 
    96  
     90      !!---------------------------------------------------------------------- 
     91      ! 
    9792      ! Arrays, scalars initialization  
    98       kdir      = jpkm1 
    99       cl2       = '' 
    100       zsum1     = 0.e0 
    101       zsum2     = 0.e0 
    102       zvctl1    = 0.e0 
    103       zvctl2    = 0.e0 
    104       ztab2d_1(:,:)   = 0.e0 
    105       ztab2d_2(:,:)   = 0.e0 
    106       ztab3d_1(:,:,:) = 0.e0 
    107       ztab3d_2(:,:,:) = 0.e0 
    108       zmask1  (:,:,:) = 1.e0 
    109       zmask2  (:,:,:) = 1.e0 
     93      cl1  = '' 
     94      cl2  = '' 
     95      kdir = jpkm1 
     96      itra = 1 
    11097 
    11198      ! Control of optional arguments 
    112       IF( PRESENT(clinfo2) )   cl2                  = clinfo2 
    113       IF( PRESENT(kdim)    )   kdir                 = kdim 
    114       IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:) 
    115       IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:) 
    116       IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,1:kdir) 
    117       IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir) 
    118       IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:) 
    119       IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:) 
    120  
    121       IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number 
    122          sind = narea 
    123          eind = narea 
    124       ELSE                                    ! processors total number 
    125          sind = 1 
    126          eind = ijsplt 
    127       ENDIF 
     99      IF( PRESENT(clinfo1) )   cl1  = clinfo1 
     100      IF( PRESENT(clinfo2) )   cl2  = clinfo2 
     101      IF( PRESENT(kdim)    )   kdir = kdim 
     102      IF( PRESENT(tab4d_1) )   itra = SIZE(tab4d_1,dim=4) 
    128103 
    129104      ! Loop over each sub-domain, i.e. the total number of processors ijsplt 
    130       DO jn = sind, eind 
    131          ! Set logical unit 
    132          j_id = numid(jn - narea + 1) 
    133          ! Set indices for the SUM control 
    134          IF( .NOT. lsp_area ) THEN 
    135             IF (lk_mpp .AND. jpnij > 1)   THEN 
    136                nictls = MAX(  1, nlditl(jn) ) 
    137                nictle = MIN(jpi, nleitl(jn) ) 
    138                njctls = MAX(  1, nldjtl(jn) ) 
    139                njctle = MIN(jpj, nlejtl(jn) ) 
    140                ! Do not take into account the bound of the domain 
    141                IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    142                IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    143                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nleitl(jn) - 1) 
    144                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(jn) - 1) 
     105      DO jl = 1, SIZE(nall_ictls) 
     106 
     107         ! define shoter names... 
     108         iis = nall_ictls(jl) 
     109         iie = nall_ictle(jl) 
     110         jjs = nall_jctls(jl) 
     111         jje = nall_jctle(jl) 
     112 
     113         IF( PRESENT(clinfo) ) THEN   ;   inum = numprt_top(jl) 
     114         ELSE                         ;   inum = numprt_oce(jl) 
     115         ENDIF 
     116 
     117         DO jn = 1, itra 
     118 
     119            IF( PRESENT(clinfo3) ) THEN 
     120               IF    ( clinfo3 == 'tra-ta' )   THEN 
     121                  zvctl1 = t_ctl(jl) 
     122               ELSEIF( clinfo3 == 'tra'    )   THEN 
     123                  zvctl1 = t_ctl(jl) 
     124                  zvctl2 = s_ctl(jl) 
     125               ELSEIF( clinfo3 == 'dyn'    )   THEN 
     126                  zvctl1 = u_ctl(jl) 
     127                  zvctl2 = v_ctl(jl) 
     128               ELSE 
     129                  zvctl1 = tra_ctl(jn,jl) 
     130               ENDIF 
     131            ENDIF 
     132 
     133            ! 2D arrays 
     134            IF( PRESENT(tab2d_1) ) THEN 
     135               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 
     136               ELSE                        ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje)                            ) 
     137               ENDIF 
     138            ENDIF 
     139            IF( PRESENT(tab2d_2) ) THEN 
     140               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 
     141               ELSE                        ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje)                            ) 
     142               ENDIF 
     143            ENDIF 
     144 
     145            ! 3D arrays 
     146            IF( PRESENT(tab3d_1) ) THEN 
     147               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     148               ELSE                        ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir)                                 ) 
     149               ENDIF 
     150            ENDIF 
     151            IF( PRESENT(tab3d_2) ) THEN 
     152               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 
     153               ELSE                        ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir)                                 ) 
     154               ENDIF 
     155            ENDIF 
     156 
     157            ! 4D arrays 
     158            IF( PRESENT(tab4d_1) ) THEN 
     159               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     160               ELSE                        ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn)                                 ) 
     161               ENDIF 
     162            ENDIF 
     163 
     164            ! Print the result 
     165            IF( PRESENT(clinfo ) )   cl1  = clinfo(jn) 
     166            IF( PRESENT(clinfo3) )   THEN 
     167               ! 
     168               IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 
     169                  WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 
     170               ELSE 
     171                  WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1 
     172               ENDIF 
     173               ! 
     174               SELECT CASE( clinfo3 ) 
     175               CASE ( 'tra-ta' )  
     176                  t_ctl(jl) = zsum1 
     177               CASE ( 'tra' )  
     178                  t_ctl(jl) = zsum1 
     179                  s_ctl(jl) = zsum2 
     180               CASE ( 'dyn' )  
     181                  u_ctl(jl) = zsum1 
     182                  v_ctl(jl) = zsum2 
     183               CASE default 
     184                  tra_ctl(jn,jl) = zsum1 
     185               END SELECT 
     186            ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
     187               WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 
    145188            ELSE 
    146                nictls = MAX(  1, nimpptl(jn) - 1 + nlditl(jn) ) 
    147                nictle = MIN(jpi, nimpptl(jn) - 1 + nleitl(jn) ) 
    148                njctls = MAX(  1, njmpptl(jn) - 1 + nldjtl(jn) ) 
    149                njctle = MIN(jpj, njmpptl(jn) - 1 + nlejtl(jn) ) 
    150                ! Do not take into account the bound of the domain 
    151                IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    152                IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    153                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nleitl(jn) - 2) 
    154                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nlejtl(jn) - 2) 
    155             ENDIF 
    156          ENDIF 
    157  
    158          IF( PRESENT(clinfo3)) THEN 
    159             IF ( clinfo3 == 'tra' )  THEN 
    160                zvctl1 = t_ctll(jn) 
    161                zvctl2 = s_ctll(jn) 
    162             ELSEIF ( clinfo3 == 'dyn' )   THEN 
    163                zvctl1 = u_ctll(jn) 
    164                zvctl2 = v_ctll(jn) 
    165             ENDIF 
    166          ENDIF 
    167  
    168          ! Compute the sum control 
    169          ! 2D arrays 
    170          IF( PRESENT(tab2d_1) )   THEN 
    171             zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) ) 
    172             zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) ) 
    173          ENDIF 
    174  
    175          ! 3D arrays 
    176          IF( PRESENT(tab3d_1) )   THEN 
    177             zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) ) 
    178             zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) ) 
    179          ENDIF 
    180  
    181          ! Print the result 
    182          IF( PRESENT(clinfo3) )   THEN 
    183             WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2 
    184             SELECT CASE( clinfo3 ) 
    185             CASE ( 'tra-ta' )  
    186                t_ctll(jn) = zsum1 
    187             CASE ( 'tra' )  
    188                 t_ctll(jn) = zsum1 
    189                 s_ctll(jn) = zsum2 
    190             CASE ( 'dyn' )  
    191                 u_ctll(jn) = zsum1 
    192                 v_ctll(jn) = zsum2  
    193             END SELECT 
    194          ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
    195             WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2 
    196          ELSE 
    197             WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1 
    198          ENDIF 
    199  
    200       ENDDO 
    201       ! 
    202    END SUBROUTINE prt_ctl 
    203  
    204  
    205    SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime) 
    206       !!---------------------------------------------------------------------- 
    207       !!                     ***  ROUTINE prt_ctl_info  *** 
    208       !! 
    209       !! ** Purpose : - print information without any computation 
    210       !! 
    211       !! ** Action  : - input arguments 
    212       !!                    clinfo1 : information about the ivar1 
    213       !!                    ivar1   : value to print 
    214       !!                    clinfo2 : information about the ivar2 
    215       !!                    ivar2   : value to print 
    216       !!---------------------------------------------------------------------- 
    217       CHARACTER (len=*), INTENT(in)           ::   clinfo1 
    218       INTEGER          , INTENT(in), OPTIONAL ::   ivar1 
    219       CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2 
    220       INTEGER          , INTENT(in), OPTIONAL ::   ivar2 
    221       INTEGER          , INTENT(in), OPTIONAL ::   itime 
    222       ! 
    223       INTEGER :: jn, sind, eind, iltime, j_id 
    224       !!---------------------------------------------------------------------- 
    225  
    226       IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number 
    227          sind = narea 
    228          eind = narea 
    229       ELSE                                    ! total number of processors 
    230          sind = 1 
    231          eind = ijsplt 
    232       ENDIF 
    233  
    234       ! Set to zero arrays at each new time step 
    235       IF( PRESENT(itime) )   THEN 
    236          iltime = itime 
    237          IF( iltime > ktime )   THEN 
    238             t_ctll(:) = 0.e0   ;   s_ctll(:) = 0.e0 
    239             u_ctll(:) = 0.e0   ;   v_ctll(:) = 0.e0 
    240             ktime = iltime 
    241          ENDIF 
    242       ENDIF 
    243  
    244       ! Loop over each sub-domain, i.e. number of processors ijsplt 
    245       DO jn = sind, eind 
    246          ! 
    247          j_id = numid(jn - narea + 1)         ! Set logical unit 
    248          ! 
    249          IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    250             WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2 
    251          ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN 
    252             WRITE(j_id,*)clinfo1, ivar1, clinfo2 
    253          ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    254             WRITE(j_id,*)clinfo1, ivar1, ivar2 
    255          ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN 
    256             WRITE(j_id,*)clinfo1, ivar1 
    257          ELSE 
    258             WRITE(j_id,*)clinfo1 
    259          ENDIF 
    260          ! 
    261       END DO 
    262       ! 
    263    END SUBROUTINE prt_ctl_info 
    264  
    265  
    266    SUBROUTINE prt_ctl_init 
    267       !!---------------------------------------------------------------------- 
    268       !!                     ***  ROUTINE prt_ctl_init  *** 
    269       !! 
    270       !! ** Purpose :   open ASCII files & compute indices 
    271       !!---------------------------------------------------------------------- 
    272       INTEGER ::   jn, sind, eind, j_id 
    273       CHARACTER (len=28) :: clfile_out 
    274       CHARACTER (len=23) :: clb_name 
    275       CHARACTER (len=19) :: cl_run 
    276       !!---------------------------------------------------------------------- 
    277  
    278       ! Allocate arrays 
    279       ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
    280          &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
    281          &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     & 
    282          &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       ) 
    283  
    284       ! Initialization  
    285       t_ctll(:) = 0.e0 
    286       s_ctll(:) = 0.e0 
    287       u_ctll(:) = 0.e0 
    288       v_ctll(:) = 0.e0 
    289       ktime = 1 
    290  
    291       IF( lk_mpp .AND. jpnij > 1 ) THEN 
    292          sind = narea 
    293          eind = narea 
    294          clb_name = "('mpp.output_',I4.4)" 
    295          cl_run = 'MULTI processor run' 
    296          ! use indices for each area computed by mpp_init subroutine 
    297          nlditl(1:jpnij) = nldit(:)  
    298          nleitl(1:jpnij) = nleit(:)  
    299          nldjtl(1:jpnij) = nldjt(:)  
    300          nlejtl(1:jpnij) = nlejt(:)  
    301          ! 
    302          nimpptl(1:jpnij) = nimppt(:) 
    303          njmpptl(1:jpnij) = njmppt(:) 
    304          ! 
    305          nlcitl(1:jpnij) = nlcit(:) 
    306          nlcjtl(1:jpnij) = nlcjt(:) 
    307          ! 
    308          ibonitl(1:jpnij) = ibonit(:) 
    309          ibonjtl(1:jpnij) = ibonjt(:) 
    310       ELSE 
    311          sind = 1 
    312          eind = ijsplt 
    313          clb_name = "('mono.output_',I4.4)" 
    314          cl_run = 'MONO processor run ' 
    315          ! compute indices for each area as done in mpp_init subroutine 
    316          CALL sub_dom 
    317       ENDIF 
    318  
    319       ALLOCATE( numid(eind-sind+1) ) 
    320  
    321       DO jn = sind, eind 
    322          WRITE(clfile_out,FMT=clb_name) jn-1 
    323          CALL ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. ) 
    324          j_id = numid(jn -narea + 1) 
    325          WRITE(j_id,*) 
    326          WRITE(j_id,*) '                 L O D Y C - I P S L' 
    327          WRITE(j_id,*) '                     O P A model' 
    328          WRITE(j_id,*) '            Ocean General Circulation Model' 
    329          WRITE(j_id,*) '               version OPA 9.0  (2005) ' 
    330          WRITE(j_id,*) 
    331          WRITE(j_id,*) '                   PROC number: ', jn 
    332          WRITE(j_id,*) 
    333          WRITE(j_id,FMT="(19x,a20)")cl_run 
    334  
    335          ! Print the SUM control indices 
    336          IF( .NOT. lsp_area )   THEN 
    337             nictls = nimpptl(jn) + nlditl(jn) - 1 
    338             nictle = nimpptl(jn) + nleitl(jn) - 1 
    339             njctls = njmpptl(jn) + nldjtl(jn) - 1 
    340             njctle = njmpptl(jn) + nlejtl(jn) - 1 
    341          ENDIF 
    342          WRITE(j_id,*)  
    343          WRITE(j_id,*) 'prt_ctl :  Sum control indices' 
    344          WRITE(j_id,*) '~~~~~~~' 
    345          WRITE(j_id,*) 
    346          WRITE(j_id,9000)'                                nlej   = ', nlejtl(jn), '              ' 
    347          WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------' 
    348          WRITE(j_id,9001)'                  |                                       |' 
    349          WRITE(j_id,9001)'                  |                                       |' 
    350          WRITE(j_id,9001)'                  |                                       |' 
    351          WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle 
    352          WRITE(j_id,9002)'           nldi   = ', nlditl(jn),  '                           nlei   = ', nleitl(jn) 
    353          WRITE(j_id,9001)'                  |                                       |' 
    354          WRITE(j_id,9001)'                  |                                       |' 
    355          WRITE(j_id,9001)'                  |                                       |' 
    356          WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------' 
    357          WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        nldj   = ', nldjtl(jn), '              ' 
    358          WRITE(j_id,*) 
    359          WRITE(j_id,*) 
    360  
    361 9000     FORMAT(a41,i4.4,a14) 
    362 9001     FORMAT(a59) 
    363 9002     FORMAT(a20,i4.4,a36,i3.3) 
    364 9003     FORMAT(a20,i4.4,a17,i4.4) 
    365 9004     FORMAT(a11,i4.4,a26,i4.4,a14) 
    366       END DO 
    367       ! 
    368    END SUBROUTINE prt_ctl_init 
    369  
    370  
    371    SUBROUTINE sub_dom 
    372       !!---------------------------------------------------------------------- 
    373       !!                  ***  ROUTINE sub_dom  *** 
    374       !!                     
    375       !! ** Purpose :   Lay out the global domain over processors.  
    376       !!                CAUTION:  
    377       !!                This part has been extracted from the mpp_init 
    378       !!                subroutine and names of variables/arrays have been  
    379       !!                slightly changed to avoid confusion but the computation 
    380       !!                is exactly the same. Any modification about indices of 
    381       !!                each sub-domain in the mppini.F90 module should be reported  
    382       !!                here. 
    383       !! 
    384       !! ** Method  :   Global domain is distributed in smaller local domains. 
    385       !!                Periodic condition is a function of the local domain position 
    386       !!                (global boundary or neighbouring domain) and of the global 
    387       !!                periodic 
    388       !!                Type :         jperio global periodic condition 
    389       !! 
    390       !! ** Action  : - set domain parameters 
    391       !!                    nimpp     : longitudinal index  
    392       !!                    njmpp     : latitudinal  index 
    393       !!                    narea     : number for local area 
    394       !!                    nlcil      : first dimension 
    395       !!                    nlcjl      : second dimension 
    396       !!                    nbondil    : mark for "east-west local boundary" 
    397       !!                    nbondjl    : mark for "north-south local boundary" 
    398       !! 
    399       !! History : 
    400       !!        !  94-11  (M. Guyon)  Original code 
    401       !!        !  95-04  (J. Escobar, M. Imbard) 
    402       !!        !  98-02  (M. Guyon)  FETI method 
    403       !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    404       !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    405       !!---------------------------------------------------------------------- 
    406       INTEGER ::   ji, jj, jn               ! dummy loop indices 
    407       INTEGER ::   & 
    408          ii, ij,                         &  ! temporary integers 
    409          irestil, irestjl,               &  !    "          " 
    410          ijpi  , ijpj, nlcil,            &  ! temporary logical unit 
    411          nlcjl , nbondil, nbondjl,       & 
    412          nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    413  
    414       INTEGER, DIMENSION(jpi,jpj) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
    415       REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    416       INTEGER ::   inum                     ! local logical unit 
    417       !!---------------------------------------------------------------------- 
    418  
    419       ! 
    420       ! 
    421       !  1. Dimension arrays for subdomains 
    422       ! ----------------------------------- 
    423       !  Computation of local domain sizes ilcitl() ilcjtl() 
    424       !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 
    425       !  The subdomains are squares leeser than or equal to the global 
    426       !  dimensions divided by the number of processors minus the overlap 
    427       !  array (cf. par_oce.F90). 
    428  
    429 #if defined key_nemocice_decomp 
    430       ijpi = ( nx_global+2-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 
    431       ijpj = ( ny_global+2-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls  
    432 #else 
    433       ijpi = ( jpiglo-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 
    434       ijpj = ( jpjglo-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls 
    435 #endif 
    436  
    437  
    438       nrecil  = 2 * nn_hls 
    439       nrecjl  = 2 * nn_hls 
    440       irestil = MOD( jpiglo - nrecil , isplt ) 
    441       irestjl = MOD( jpjglo - nrecjl , jsplt ) 
    442  
    443       IF(  irestil == 0 )   irestil = isplt 
    444 #if defined key_nemocice_decomp 
    445  
    446       ! In order to match CICE the size of domains in NEMO has to be changed 
    447       ! The last line of blocks (west) will have fewer points  
    448       DO jj = 1, jsplt  
    449          DO ji=1, isplt-1  
    450             ilcitl(ji,jj) = ijpi  
    451          END DO  
    452          ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 
    453       END DO  
    454  
    455 #else  
    456  
    457       DO jj = 1, jsplt 
    458          DO ji = 1, irestil 
    459             ilcitl(ji,jj) = ijpi 
    460          END DO 
    461          DO ji = irestil+1, isplt 
    462             ilcitl(ji,jj) = ijpi -1 
     189               WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 
     190            ENDIF 
     191 
    463192         END DO 
    464193      END DO 
    465  
    466 #endif 
    467        
    468       IF( irestjl == 0 )   irestjl = jsplt 
    469 #if defined key_nemocice_decomp  
    470  
    471       ! Same change to domains in North-South direction as in East-West.  
    472       DO ji = 1, isplt  
    473          DO jj=1, jsplt-1  
    474             ilcjtl(ji,jj) = ijpj  
    475          END DO  
    476          ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 
    477       END DO  
    478  
    479 #else  
    480  
    481       DO ji = 1, isplt 
    482          DO jj = 1, irestjl 
    483             ilcjtl(ji,jj) = ijpj 
    484          END DO 
    485          DO jj = irestjl+1, jsplt 
    486             ilcjtl(ji,jj) = ijpj -1 
    487          END DO 
     194      ! 
     195   END SUBROUTINE prt_ctl 
     196 
     197 
     198   SUBROUTINE prt_ctl_info (clinfo, ivar, cdcomp ) 
     199      !!---------------------------------------------------------------------- 
     200      !!                     ***  ROUTINE prt_ctl_info  *** 
     201      !! 
     202      !! ** Purpose : - print information without any computation 
     203      !! 
     204      !! ** Action  : - input arguments 
     205      !!                    clinfo : information about the ivar 
     206      !!                    ivar   : value to print 
     207      !!---------------------------------------------------------------------- 
     208      CHARACTER(len=*),           INTENT(in) ::   clinfo 
     209      INTEGER         , OPTIONAL, INTENT(in) ::   ivar 
     210      CHARACTER(len=3), OPTIONAL, INTENT(in) ::   cdcomp   ! only 'top' is accepted 
     211      ! 
     212      CHARACTER(len=3) :: clcomp 
     213      INTEGER ::  jl, inum 
     214      !!---------------------------------------------------------------------- 
     215      ! 
     216      IF( PRESENT(cdcomp) ) THEN   ;   clcomp = cdcomp 
     217      ELSE                         ;   clcomp = 'oce' 
     218      ENDIF 
     219      ! 
     220      DO jl = 1, SIZE(nall_ictls) 
     221         ! 
     222         IF( clcomp == 'oce' )   inum = numprt_oce(jl) 
     223         IF( clcomp == 'top' )   inum = numprt_top(jl) 
     224         ! 
     225         IF ( PRESENT(ivar) ) THEN   ;   WRITE(inum,*) clinfo, ivar 
     226         ELSE                        ;   WRITE(inum,*) clinfo 
     227         ENDIF 
     228         ! 
    488229      END DO 
    489  
    490 #endif 
    491       zidom = nrecil 
    492       DO ji = 1, isplt 
    493          zidom = zidom + ilcitl(ji,1) - nrecil 
     230      ! 
     231   END SUBROUTINE prt_ctl_info 
     232 
     233 
     234   SUBROUTINE prt_ctl_init( cdcomp, kntra ) 
     235      !!---------------------------------------------------------------------- 
     236      !!                     ***  ROUTINE prt_ctl_init  *** 
     237      !! 
     238      !! ** Purpose :   open ASCII files & compute indices 
     239      !!---------------------------------------------------------------------- 
     240      CHARACTER(len=3), OPTIONAL, INTENT(in   ) ::   cdcomp   ! only 'top' is accepted 
     241      INTEGER         , OPTIONAL, INTENT(in   ) ::   kntra    ! only for 'top': number of tracers 
     242      ! 
     243      INTEGER ::   ji, jj, jl 
     244      INTEGER ::   inum, idg, idg2 
     245      INTEGER ::   ijsplt, iimax, ijmax 
     246      INTEGER, DIMENSION(:,:), ALLOCATABLE ::    iimppt, ijmppt, ijpi, ijpj, iproc 
     247      INTEGER, DIMENSION(  :), ALLOCATABLE ::     iipos,  ijpos 
     248      LOGICAL, DIMENSION(:,:), ALLOCATABLE ::   llisoce 
     249      CHARACTER(len=64) :: clfile_out 
     250      CHARACTER(LEN=64) :: clfmt, clfmt2, clfmt3, clfmt4 
     251      CHARACTER(len=32) :: clname, cl_run 
     252      CHARACTER(len= 3) :: clcomp 
     253      !!---------------------------------------------------------------------- 
     254      ! 
     255      clname = 'output' 
     256      IF( PRESENT(cdcomp) ) THEN 
     257         clname = TRIM(clname)//'.'//TRIM(cdcomp) 
     258         clcomp = cdcomp 
     259      ELSE 
     260         clcomp = 'oce' 
     261      ENDIF 
     262      ! 
     263      IF( jpnij > 1 ) THEN   ! MULTI processor run 
     264         cl_run = 'MULTI processor run' 
     265         idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )    ! how many digits to we need to write? min=4, max=9 
     266         WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg        ! '(a,ix.x)' 
     267         WRITE(clfile_out,clfmt) 'mpp.'//trim(clname)//'_', narea - 1 
     268         ijsplt = 1 
     269      ELSE                   ! MONO processor run 
     270         cl_run = 'MONO processor run ' 
     271         IF(lwp) THEN                  ! control print 
     272            WRITE(numout,*) 
     273            WRITE(numout,*) 'prt_ctl_init: sn_cfctl%l_prtctl parameters' 
     274            WRITE(numout,*) '~~~~~~~~~~~~~' 
     275         ENDIF 
     276         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area          
     277            nn_isplt = MAX(1, nn_isplt)            ! number of processors following i-direction 
     278            nn_jsplt = MAX(1, nn_jsplt)            ! number of processors following j-direction 
     279            ijsplt = nn_isplt * nn_jsplt           ! total number of processors ijsplt 
     280            IF( ijsplt == 1 )   CALL ctl_warn( 'nn_isplt & nn_jsplt are equal to 1 -> control sum done over the whole domain' ) 
     281            IF(lwp) WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
     282            IF(lwp) WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
     283            idg = MAX( INT(LOG10(REAL(MAX(1,ijsplt-1),wp))) + 1, 4 )    ! how many digits to we need to write? min=4, max=9 
     284            WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg         ! '(a,ix.x)' 
     285            IF( ijsplt == 1 ) WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', 0 
     286         ELSE                                             ! print control done over a specific  area 
     287            ijsplt = 1 
     288            IF( nn_ictls < 1 .OR. nn_ictls > Ni0glo )   THEN 
     289               CALL ctl_warn( '          - nictls must be 1<=nictls>=Ni0glo, it is forced to 1' ) 
     290               nn_ictls = 1 
     291            ENDIF 
     292            IF( nn_ictle < 1 .OR. nn_ictle > Ni0glo )   THEN 
     293               CALL ctl_warn( '          - nictle must be 1<=nictle>=Ni0glo, it is forced to Ni0glo' ) 
     294               nn_ictle = Ni0glo 
     295            ENDIF 
     296            IF( nn_jctls < 1 .OR. nn_jctls > Nj0glo )   THEN 
     297               CALL ctl_warn( '          - njctls must be 1<=njctls>=Nj0glo, it is forced to 1' ) 
     298               nn_jctls = 1 
     299            ENDIF 
     300            IF( nn_jctle < 1 .OR. nn_jctle > Nj0glo )   THEN 
     301               CALL ctl_warn( '          - njctle must be 1<=njctle>=Nj0glo, it is forced to Nj0glo' ) 
     302               nn_jctle = Nj0glo 
     303            ENDIF 
     304            WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
     305            WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
     306            WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
     307            WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
     308            idg = MAXVAL( (/ nn_ictls,nn_ictle,nn_jctls,nn_jctle /) )   ! temporary use of idg to store the largest index 
     309            idg = MAX( INT(LOG10(REAL(idg,wp))) + 1, 4 )                ! how many digits to we need to write? min=4, max=9 
     310            WRITE(clfmt, "('(4(a,i', i1, '.', i1, '))')") idg, idg         ! '(4(a,ix.x))' 
     311            WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', nn_ictls, '_', nn_ictle, '_', nn_jctls, '_', nn_jctle 
     312         ENDIF 
     313      ENDIF 
     314 
     315      ! Allocate arrays 
     316      IF( .NOT. ALLOCATED(nall_ictls) ) ALLOCATE( nall_ictls(ijsplt), nall_ictle(ijsplt), nall_jctls(ijsplt), nall_jctle(ijsplt) ) 
     317 
     318      IF( jpnij > 1 ) THEN   ! MULTI processor run 
     319         ! 
     320         nall_ictls(1) = Nis0 
     321         nall_ictle(1) = Nie0 
     322         nall_jctls(1) = Njs0 
     323         nall_jctle(1) = Nje0 
     324         ! 
     325      ELSE                   ! MONO processor run 
     326         ! 
     327         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area 
     328            ! 
     329            ALLOCATE(  iimppt(nn_isplt,nn_jsplt), ijmppt(nn_isplt,nn_jsplt),  ijpi(nn_isplt,nn_jsplt),  ijpj(nn_isplt,nn_jsplt),   & 
     330               &      llisoce(nn_isplt,nn_jsplt),  iproc(nn_isplt,nn_jsplt), iipos(nn_isplt*nn_jsplt), ijpos(nn_isplt*nn_jsplt) ) 
     331            CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, nn_isplt, nn_jsplt, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 
     332            CALL mpp_is_ocean( llisoce ) 
     333            CALL mpp_getnum( llisoce, iproc, iipos, ijpos ) 
     334            ! 
     335            DO jj = 1,nn_jsplt 
     336               DO ji = 1, nn_isplt 
     337                  jl = iproc(ji,jj) + 1 
     338                  nall_ictls(jl) = iimppt(ji,jj) - 1 +      1      + nn_hls 
     339                  nall_ictle(jl) = iimppt(ji,jj) - 1 + ijpi(ji,jj) - nn_hls 
     340                  nall_jctls(jl) = ijmppt(ji,jj) - 1 +      1      + nn_hls 
     341                  nall_jctle(jl) = ijmppt(ji,jj) - 1 + ijpj(ji,jj) - nn_hls 
     342               END DO 
     343            END DO 
     344            ! 
     345            DEALLOCATE( iimppt, ijmppt, ijpi, ijpj, llisoce, iproc, iipos, ijpos ) 
     346            ! 
     347         ELSE                                             ! print control done over a specific  area 
     348            ! 
     349            nall_ictls(1) = nn_ictls + nn_hls 
     350            nall_ictle(1) = nn_ictle + nn_hls 
     351            nall_jctls(1) = nn_jctls + nn_hls 
     352            nall_jctle(1) = nn_jctle + nn_hls 
     353            ! 
     354         ENDIF 
     355      ENDIF 
     356 
     357      ! Initialization  
     358      IF( clcomp == 'oce' ) THEN 
     359         ALLOCATE( t_ctl(ijsplt), s_ctl(ijsplt), u_ctl(ijsplt), v_ctl(ijsplt), numprt_oce(ijsplt) ) 
     360         t_ctl(:) = 0.e0 
     361         s_ctl(:) = 0.e0 
     362         u_ctl(:) = 0.e0 
     363         v_ctl(:) = 0.e0 
     364      ENDIF 
     365      IF( clcomp == 'top' ) THEN 
     366         ALLOCATE( tra_ctl(kntra,ijsplt), numprt_top(ijsplt) ) 
     367         tra_ctl(:,:) = 0.e0 
     368      ENDIF 
     369 
     370      DO jl = 1,ijsplt 
     371 
     372         IF( ijsplt > 1 ) WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', jl-1 
     373 
     374         CALL ctl_opn( inum, clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. ) 
     375         IF( clcomp == 'oce' )   numprt_oce(jl) = inum 
     376         IF( clcomp == 'top' )   numprt_top(jl) = inum 
     377         WRITE(inum,*) 
     378         WRITE(inum,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
     379         WRITE(inum,*) '                       NEMO team' 
     380         WRITE(inum,*) '            Ocean General Circulation Model' 
     381         IF( clcomp == 'oce' )   WRITE(inum,*) '                NEMO version 4.x  (2020) ' 
     382         IF( clcomp == 'top' )   WRITE(inum,*) '                 TOP vversion x (2020) ' 
     383         WRITE(inum,*) 
     384         IF( ijsplt > 1 )   & 
     385            &   WRITE(inum,*) '              MPI-subdomain number: ', jl-1 
     386         IF(  jpnij > 1 )   & 
     387            &   WRITE(inum,*) '              MPI-subdomain number: ', narea-1 
     388         WRITE(inum,*) 
     389         WRITE(inum,'(19x,a20)') cl_run 
     390         WRITE(inum,*)  
     391         WRITE(inum,*) 'prt_ctl :  Sum control indices' 
     392         WRITE(inum,*) '~~~~~~~' 
     393         WRITE(inum,*) 
     394         ! 
     395         ! clfmt2: '              ----- jctle = XXX (YYY) -----'             -> '(18x, 13a1, a9, iM, a2, iN, a2, 13a1)' 
     396         ! clfmt3: '              |                           |'             -> '(18x, a1, Nx, a1)' 
     397         ! clfmt4: '        ictls = XXX (YYY)           ictle = XXX (YYY)'   -> '(Nx, a9, iM, a2, iP, a2, Qx, a9, iM, a2, iP, a2)' 
     398         !         '              |                           |' 
     399         !         '              ----- jctle = XXX (YYY) -----' 
     400         ! clfmt5: '   njmpp = XXX'                                          -> '(Nx, a9, iM)' 
     401         ! clfmt6: '           nimpp = XXX'                                  -> '(Nx, a9, iM)' 
     402         ! 
     403         idg = MAXVAL( (/ nall_ictls(jl), nall_ictle(jl), nall_jctls(jl), nall_jctle(jl) /) )   ! temporary use of idg 
     404         idg = INT(LOG10(REAL(idg,wp))) + 1                                                     ! how many digits do we use? 
     405         idg2 = MAXVAL( (/ mig0(nall_ictls(jl)), mig0(nall_ictle(jl)), mjg0(nall_jctls(jl)), mjg0(nall_jctle(jl)) /) ) 
     406         idg2 = INT(LOG10(REAL(idg2,wp))) + 1                                                   ! how many digits do we use? 
     407         WRITE(clfmt2, "('(18x, 13a1, a9, i', i1, ', a2, i',i1,', a2, 13a1)')") idg, idg2 
     408         WRITE(clfmt3, "('(18x, a1, ', i2,'x, a1)')") 13+9+idg+2+idg2+2+13 - 2 
     409         WRITE(clfmt4, "('(', i2,'x, a9, i', i1,', a2, i', i1,', a2, ', i2,'x, a9, i', i1,', a2, i', i1,', a2)')") & 
     410            &          18-7, idg, idg2, 13+9+idg+2+idg2+2+13 - (2+idg+2+idg2+2+8), idg, idg2 
     411         WRITE(inum,clfmt2) ('-', ji=1,13), ' jctle = ', nall_jctle(jl), ' (', mjg0(nall_jctle(jl)), ') ', ('-', ji=1,13) 
     412         WRITE(inum,clfmt3) '|', '|' 
     413         WRITE(inum,clfmt3) '|', '|' 
     414         WRITE(inum,clfmt3) '|', '|' 
     415         WRITE(inum,clfmt4)                 ' ictls = ', nall_ictls(jl), ' (', mig0(nall_ictls(jl)), ') ',   & 
     416            &                               ' ictle = ', nall_ictle(jl), ' (', mig0(nall_ictle(jl)), ') ' 
     417         WRITE(inum,clfmt3) '|', '|' 
     418         WRITE(inum,clfmt3) '|', '|' 
     419         WRITE(inum,clfmt3) '|', '|' 
     420         WRITE(inum,clfmt2) ('-', ji=1,13), ' jctls = ', nall_jctls(jl), ' (', mjg0(nall_jctls(jl)), ') ', ('-', ji=1,13) 
     421         WRITE(inum,*) 
     422         WRITE(inum,*) 
     423         ! 
    494424      END DO 
    495       IF(lwp) WRITE(numout,*) 
    496       IF(lwp) WRITE(numout,*)' sum ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 
    497        
    498       zjdom = nrecjl 
    499       DO jj = 1, jsplt 
    500          zjdom = zjdom + ilcjtl(1,jj) - nrecjl 
    501       END DO 
    502       IF(lwp) WRITE(numout,*)' sum ilcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo 
    503       IF(lwp) WRITE(numout,*) 
    504        
    505  
    506       !  2. Index arrays for subdomains 
    507       ! ------------------------------- 
    508  
    509       iimpptl(:,:) = 1 
    510       ijmpptl(:,:) = 1 
    511        
    512       IF( isplt > 1 ) THEN 
    513          DO jj = 1, jsplt 
    514             DO ji = 2, isplt 
    515                iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil 
    516             END DO 
    517          END DO 
    518       ENDIF 
    519  
    520       IF( jsplt > 1 ) THEN 
    521          DO jj = 2, jsplt 
    522             DO ji = 1, isplt 
    523                ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl 
    524             END DO 
    525          END DO 
    526       ENDIF 
    527        
    528       ! 3. Subdomain description 
    529       ! ------------------------ 
    530  
    531       DO jn = 1, ijsplt 
    532          ii = 1 + MOD( jn-1, isplt ) 
    533          ij = 1 + (jn-1) / isplt 
    534          nimpptl(jn) = iimpptl(ii,ij) 
    535          njmpptl(jn) = ijmpptl(ii,ij) 
    536          nlcitl (jn) = ilcitl (ii,ij)      
    537          nlcil       = nlcitl (jn)      
    538          nlcjtl (jn) = ilcjtl (ii,ij)      
    539          nlcjl       = nlcjtl (jn) 
    540          nbondjl = -1                                    ! general case 
    541          IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor 
    542          IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor 
    543          IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction 
    544          ibonjtl(jn) = nbondjl 
    545           
    546          nbondil = 0                                     !  
    547          IF( MOD( jn, isplt ) == 1 )   nbondil = -1      ! 
    548          IF( MOD( jn, isplt ) == 0 )   nbondil =  1      ! 
    549          IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction 
    550          ibonitl(jn) = nbondil 
    551           
    552          nldil =  1   + nn_hls 
    553          nleil = nlcil - nn_hls 
    554          IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1 
    555          IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil 
    556          nldjl =  1   + nn_hls 
    557          nlejl = nlcjl - nn_hls 
    558          IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1 
    559          IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl 
    560          nlditl(jn) = nldil 
    561          nleitl(jn) = nleil 
    562          nldjtl(jn) = nldjl 
    563          nlejtl(jn) = nlejl 
    564       END DO 
    565       ! 
    566       ! Save processor layout in layout_prtctl.dat file  
    567       IF(lwp) THEN 
    568          CALL ctl_opn( inum, 'layout_prtctl.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    569          WRITE(inum,'(a)') 'nproc nlcil nlcjl nldil nldjl nleil nlejl nimpptl njmpptl ibonitl ibonjtl' 
    570          ! 
    571          DO jn = 1, ijsplt 
    572             WRITE(inum,'(i5,6i6,4i8)') jn-1,nlcitl(jn),  nlcjtl(jn), & 
    573                &                            nlditl(jn),  nldjtl(jn), & 
    574                &                            nleitl(jn),  nlejtl(jn), & 
    575                &                           nimpptl(jn), njmpptl(jn), & 
    576                &                           ibonitl(jn), ibonjtl(jn) 
    577          END DO 
    578          CLOSE(inum)    
    579       END IF 
    580       ! 
    581       ! 
    582    END SUBROUTINE sub_dom 
     425      ! 
     426   END SUBROUTINE prt_ctl_init 
     427 
    583428 
    584429   !!====================================================================== 

  • NEMO/trunk/src/OCE/IOM/restart.F90

    r13237 r13286  
    214214             IF( .NOT.lxios_set ) THEN 
    215215                 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 
    216                  CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
     216                 CALL iom_init( crxios_context ) 
    217217                 lxios_set = .TRUE. 
    218218             ENDIF 
    219219         ENDIF 
    220220         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 
    221              CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
     221             CALL iom_init( crxios_context ) 
    222222             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 
    223223             lxios_set = .TRUE. 
    … …  
    259259       
    260260      ! Diurnal DSST  
    261       IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios )  
     261      IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst, ldxios = lrxios )  
    262262      IF ( ln_diurnal_only ) THEN  
    263263         IF(lwp) WRITE( numout, * ) & 
    264264         &   "rst_read:- ln_diurnal_only set, setting rhop=rho0"  
    265265         rhop = rho0 
    266          CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios )  
     266         CALL iom_get( numror, jpdom_auto, 'tn'     , w3d, ldxios = lrxios )  
    267267         ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 
    268268         RETURN  
    … …  
    270270       
    271271      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    272          CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios )   ! before fields 
    273          CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios ) 
    274          CALL iom_get( numror, jpdom_autoglo, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
    275          CALL iom_get( numror, jpdom_autoglo, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
    276          CALL iom_get( numror, jpdom_autoglo, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios ) 
     272         ! before fields 
     273         CALL iom_get( numror, jpdom_auto, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 
     274         CALL iom_get( numror, jpdom_auto, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 
     275         CALL iom_get( numror, jpdom_auto, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
     276         CALL iom_get( numror, jpdom_auto, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
     277         CALL iom_get( numror, jpdom_auto, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios ) 
    277278      ELSE 
    278279         l_1st_euler =  .TRUE.      ! before field not found, forced euler 1st time-step 
    279280      ENDIF 
    280281      ! 
    281       CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios )       ! now    fields 
    282       CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios ) 
    283       CALL iom_get( numror, jpdom_autoglo, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
    284       CALL iom_get( numror, jpdom_autoglo, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
    285       CALL iom_get( numror, jpdom_autoglo, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios ) 
     282      ! now fields 
     283      CALL iom_get( numror, jpdom_auto, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 
     284      CALL iom_get( numror, jpdom_auto, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 
     285      CALL iom_get( numror, jpdom_auto, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
     286      CALL iom_get( numror, jpdom_auto, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
     287      CALL iom_get( numror, jpdom_auto, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios ) 
    286288      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    287          CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
     289         CALL iom_get( numror, jpdom_auto, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
    288290      ELSE 
    289291         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) )    
Note: See TracChangeset for help on using the changeset viewer.