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 12738 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2020-04-11T15:38:38+02:00 (4 years ago)
Author:
smasson
Message:

Extra_Halo: iom cleaning/update to work only with unknown, global or local (without halos) domains, see #2366

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90

    r12489 r12738  
    665665 
    666666 
    667    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev ) 
     667   SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev ) 
    668668      !!--------------------------------------------------------------------- 
    669669      !!                   ***  SUBROUTINE  iom_open  *** 
     
    674674      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file 
    675675      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.) 
    676       INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap) 
    677676      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    678677      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
     
    686685      LOGICAL               ::   llok      ! check the existence  
    687686      LOGICAL               ::   llwrt     ! local definition of ldwrt 
    688       LOGICAL               ::   llnoov    ! local definition to read overlap 
    689687      LOGICAL               ::   llstop    ! local definition of ldstop 
    690688      LOGICAL               ::   lliof     ! local definition of ldiof 
    691689      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
    692690      INTEGER               ::   iln, ils  ! lengths of character 
    693       INTEGER               ::   idom      ! type of domain 
    694691      INTEGER               ::   istop     !  
    695692      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters:  
     
    725722      ELSE                        ;   lliof = .FALSE. 
    726723      ENDIF 
    727       ! do we read the overlap  
    728       ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    729       llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
    730724      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 
    731725      ! ============= 
     
    768762      ENDIF 
    769763      IF( llwrt ) THEN 
    770          ! check the domain definition 
    771 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    772 !         idom = jpdom_local_noovlap   ! default definition 
    773          IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition 
    774          ELSE                ;   idom = jpdom_local_full      ! default definition 
    775          ENDIF 
    776          IF( PRESENT(kdom) )   idom = kdom 
    777          ! create the domain informations 
    778          ! ============= 
    779          SELECT CASE (idom) 
    780          CASE (jpdom_local_full) 
    781             idompar(:,1) = (/ jpi             , jpj              /) 
    782             idompar(:,2) = (/ nimpp           , njmpp            /) 
    783             idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /) 
    784             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    785             idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /) 
    786          CASE (jpdom_local_noextra) 
    787             idompar(:,1) = (/ nlci            , nlcj             /) 
    788             idompar(:,2) = (/ nimpp           , njmpp            /) 
    789             idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 
    790             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    791             idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /) 
    792          CASE (jpdom_local_noovlap) 
    793             idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /) 
    794             idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
    795             idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
    796             idompar(:,4) = (/ 0               , 0                /) 
    797             idompar(:,5) = (/ 0               , 0                /) 
    798          CASE DEFAULT 
    799             CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' ) 
    800          END SELECT 
     764         idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /) 
     765         idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
     766         idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
     767         idompar(:,4) = (/ 0               , 0                /) 
     768         idompar(:,5) = (/ 0               , 0                /) 
    801769      ENDIF 
    802770      ! Open the NetCDF file 
     
    991959   END SUBROUTINE iom_g0d 
    992960 
    993    SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
     961   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime,                kstart, kcount, ldxios ) 
    994962      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    995963      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     
    1002970      ! 
    1003971      IF( kiomid > 0 ) THEN 
    1004          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   & 
    1005               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1006               &                                                    ldxios=ldxios ) 
     972         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom         , cdvar            , pv_r1d=pvar,   & 
     973            &                                                       ktime=ktime  ,                                  & 
     974            &                                                       kstart=kstart, kcount=kcount    , ldxios=ldxios ) 
    1007975      ENDIF 
    1008976   END SUBROUTINE iom_g1d 
    1009977 
    1010    SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
    1011       INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    1012       INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    1013       CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
    1014       REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
    1015       INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
    1016       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    1017       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
    1018       LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1019                                                                                ! look for and use a file attribute 
    1020                                                                                ! called open_ocean_jstart to set the start 
    1021                                                                                ! value for the 2nd dimension (netcdf only) 
    1022       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS 
     978   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kstart, kcount, ldxios) 
     979      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     980      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     981      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     982      REAL(wp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     983      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     984      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     985      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     986      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     987      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
     988      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
    1023989      ! 
    1024990      IF( kiomid > 0 ) THEN 
    1025          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    1026               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1027               &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
     991         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom         , cdvar            , pv_r2d=pvar,   & 
     992            &                                                       ktime=ktime  , cd_type = cd_type, psgn = psgn,  & 
     993            &                                                       kstart=kstart, kcount=kcount    , ldxios=ldxios  ) 
    1028994      ENDIF 
    1029995   END SUBROUTINE iom_g2d 
    1030996 
    1031    SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
    1032       INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    1033       INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    1034       CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
    1035       REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
    1036       INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
    1037       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    1038       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
    1039       LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1040                                                                                  ! look for and use a file attribute 
    1041                                                                                  ! called open_ocean_jstart to set the start 
    1042                                                                                  ! value for the 2nd dimension (netcdf only) 
    1043       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS 
     997   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kstart, kcount, ldxios ) 
     998      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     999      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1000      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1001      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1002      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1003      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1004      REAL(wp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1005      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1006      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
     1007      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
    10441008      ! 
    10451009      IF( kiomid > 0 ) THEN 
    1046          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    1047               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1048               &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
     1010         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom         , cdvar            , pv_r3d=pvar,   & 
     1011            &                                                       ktime=ktime  , cd_type = cd_type, psgn = psgn,  & 
     1012            &                                                       kstart=kstart, kcount=kcount    , ldxios=ldxios ) 
    10491013      ENDIF 
    10501014   END SUBROUTINE iom_g3d 
    10511015   !!---------------------------------------------------------------------- 
    10521016 
    1053    SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   & 
    1054          &                  pv_r1d, pv_r2d, pv_r3d,   & 
    1055          &                  ktime , kstart, kcount,   & 
    1056          &                  lrowattr, ldxios        ) 
     1017   SUBROUTINE iom_get_123d( kiomid, kdom   , cdvar , pv_r1d, pv_r2d, pv_r3d,   & 
     1018         &                  ktime , cd_type, psgn  , kstart, kcount, ldxios ) 
    10571019      !!----------------------------------------------------------------------- 
    10581020      !!                  ***  ROUTINE  iom_get_123d  *** 
     
    10621024      !! ** Method : read ONE record at each CALL 
    10631025      !!----------------------------------------------------------------------- 
    1064       INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file 
    1065       INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read 
    1066       CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable 
    1067       REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    1068       REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
    1069       REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
    1070       INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number 
    1071       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
    1072       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
    1073       LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to 
    1074                                                                            ! look for and use a file attribute 
    1075                                                                            ! called open_ocean_jstart to set the start 
    1076                                                                            ! value for the 2nd dimension (netcdf only) 
    1077       LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios     ! use XIOS to read restart 
    1078       ! 
    1079       LOGICAL                        ::   llxios       ! local definition for XIOS read 
    1080       LOGICAL                        ::   llnoov      ! local definition to read overlap 
    1081       LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute 
    1082       INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute 
     1026      INTEGER                    , INTENT(in   )           ::   kiomid    ! Identifier of the file 
     1027      INTEGER                    , INTENT(in   )           ::   kdom      ! Type of domain to be read 
     1028      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar     ! Name of the variable 
     1029      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
     1030      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
     1031      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     1032      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number 
     1033      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1034      REAL(wp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1035      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis  
     1036      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount    ! number of points to be read in each axis 
     1037      LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios    ! use XIOS to read restart 
     1038      ! 
     1039      LOGICAL                        ::   llok        ! true if ok! 
     1040      LOGICAL                        ::   llxios      ! local definition for XIOS read 
    10831041      INTEGER                        ::   jl          ! loop on number of dimension  
    10841042      INTEGER                        ::   idom        ! type of domain 
     
    10971055      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    10981056      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     1057      REAL(wp)                       ::   zsgn        ! local value of psgn 
    10991058      INTEGER                        ::   itmp        ! temporary integer 
    11001059      CHARACTER(LEN=256)             ::   clinfo      ! info character 
    11011060      CHARACTER(LEN=256)             ::   clname      ! file name 
    11021061      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    1103       LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
     1062      CHARACTER(LEN=1)               ::   cl_type     ! local value of cd_type 
     1063      LOGICAL                        ::   ll_only3rd  ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    11041064      INTEGER                        ::   inlev       ! number of levels for 3D data 
    11051065      REAL(wp)                       ::   gma, gmi 
     
    11101070      ! 
    11111071      llxios = .FALSE. 
    1112       if(PRESENT(ldxios)) llxios = ldxios 
    1113       idvar = iom_varid( kiomid, cdvar )  
     1072      IF( PRESENT(ldxios) )  llxios = ldxios 
     1073      ! 
    11141074      idom = kdom 
     1075      istop = nstop 
    11151076      ! 
    11161077      IF(.NOT.llxios) THEN 
    11171078         clname = iom_file(kiomid)%name   !   esier to read 
    11181079         clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 
    1119          ! local definition of the domain ? 
    1120          ! do we read the overlap  
    1121          ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    1122          llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif  
    11231080         ! check kcount and kstart optionals parameters... 
    1124          IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
    1125          IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    1126          IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) & 
    1127      &          CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 
    1128  
    1129          luse_jattr = .false. 
    1130          IF( PRESENT(lrowattr) ) THEN 
    1131             IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 
    1132             IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true. 
    1133          ENDIF 
    1134  
     1081         IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
     1082         IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
     1083         IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_auto_xy  ) & 
     1084            &          CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy') 
     1085         ! 
    11351086         ! Search for the variable in the data base (eventually actualize data) 
    1136          istop = nstop 
    11371087         ! 
     1088         idvar = iom_varid( kiomid, cdvar )  
    11381089         IF( idvar > 0 ) THEN 
    1139             ! to write iom_file(kiomid)%dimsz in a shorter way ! 
    1140             idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)  
     1090            ! 
     1091            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)      ! to write iom_file(kiomid)%dimsz in a shorter way 
    11411092            inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file 
    11421093            idmspc = inbdim                                   ! number of spatial dimensions in the file 
     
    11441095            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')  
    11451096            ! 
    1146             ! update idom definition... 
    1147             ! Identify the domain in case of jpdom_auto(glo/dta) definition 
    1148             IF( idom == jpdom_autoglo_xy ) THEN 
    1149                ll_depth_spec = .TRUE. 
    1150                idom = jpdom_autoglo 
    1151             ELSE 
    1152                ll_depth_spec = .FALSE. 
    1153             ENDIF 
    1154             IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN             
    1155                IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global  
    1156                ELSE                               ;   idom = jpdom_data 
    1157                ENDIF 
     1097            ! Identify the domain in case of jpdom_auto definition 
     1098            ll_only3rd = idom == jpdom_auto_xy             ! depth is specified if idom == jpdom_auto_xy  
     1099            IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN             
     1100               idom = jpdom_global   ! default 
     1101               ! else: if the file name finishes with _xxxx.nc with xxxx any number 
    11581102               ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 
    11591103               ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 
    11601104               IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF 
    1161             ENDIF 
    1162             ! Identify the domain in case of jpdom_local definition 
    1163             IF( idom == jpdom_local ) THEN 
    1164                IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full 
    1165                ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra 
    1166                ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap 
    1167                ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 
    1168                ENDIF 
    11691105            ENDIF 
    11701106            ! 
     
    11791115            WRITE(cldmspc , fmt='(i1)') idmspc 
    11801116            ! 
    1181             !!GS: we consider 2D data as 3D data with vertical dim size = 1 
    1182             !IF(     idmspc <  irankpv ) THEN  
    1183             !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
    1184             !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
    1185             !ELSEIF( idmspc == irankpv ) THEN 
    1186             IF( idmspc == irankpv ) THEN 
     1117            IF(     idmspc <  irankpv ) THEN                     ! it seems we want to read more than we can... 
     1118               IF(     irankpv == 3 .AND. idmspc == 2 ) THEN     !   3D input array from 2D spatial data in the file: 
     1119                  llok = inlev == 1                              !     -> 3rd dimension must be equal to 1 
     1120               ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN     !   3D input array from 1D spatial data in the file: 
     1121                  llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1   !     -> 2nd and 3rd dimensions must be equal to 1 
     1122               ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN     !   2D input array from 1D spatial data in the file: 
     1123                  llok = SIZE(pv_r2d, 2) == 1                    !     -> 2nd dimension must be equal to 1 
     1124               ELSE 
     1125                  llok = .FALSE. 
     1126               ENDIF 
     1127               IF( .NOT. llok )   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     1128                  &                                            '=> cannot read a true '//clrankpv//'D array from this file...' ) 
     1129            ELSEIF( idmspc == irankpv ) THEN 
    11871130               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    11881131                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
    1189             ELSEIF( idmspc >  irankpv ) THEN 
     1132            ELSEIF( idmspc >  irankpv ) THEN                     ! it seems we want to read less than we should... 
    11901133                  IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
    1191                      CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   & 
     1134                     CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...'              ,   & 
    11921135                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
    11931136                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
     
    12021145            ! definition of istart and icnt 
    12031146            ! 
    1204             icnt  (:) = 1 
    1205             istart(:) = 1 
     1147            icnt  (:) = 1   ! default definition (simple way to deal with special cases listed above)  
     1148            istart(:) = 1   ! default definition (simple way to deal with special cases listed above)  
    12061149            istart(idmspc+1) = itime 
    1207     
    1208             IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN  
     1150            ! 
     1151            IF( PRESENT(kstart) .AND. .NOT. ll_only3rd ) THEN  
    12091152               istart(1:idmspc) = kstart(1:idmspc)  
    12101153               icnt  (1:idmspc) = kcount(1:idmspc) 
     
    12141157               ELSE  
    12151158                  IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
    1216                      IF(     idom == jpdom_data    ) THEN 
    1217                         jstartrow = 1 
    1218                         IF( luse_jattr ) THEN 
    1219                            CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    1220                            jstartrow = MAX(1,jstartrow) 
    1221                         ENDIF 
    1222                         istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
    1223                      ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below 
    1224                      ENDIF 
    1225                      ! we do not read the overlap                     -> we start to read at nldi, nldj 
    1226 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1227 !                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1228                      IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1229                   ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
    1230 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1231 !                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1232                      IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1233                      ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /) 
    1234                      ENDIF 
     1159                     ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
     1160                     IF( idom == jpdom_global )   istart(1:2) = (/ mig(nldi), mjg(nldj) /) 
     1161                     icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    12351162                     IF( PRESENT(pv_r3d) ) THEN 
    1236                         IF( idom == jpdom_data ) THEN                        ;                               icnt(3) = inlev 
    1237                         ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;   icnt(3) = kcount(3) 
    1238                         ELSE                                                 ;                               icnt(3) = inlev 
     1163                        IF( ll_only3rd .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;   icnt(3) = kcount(3) 
     1164                        ELSE                                          ;                               icnt(3) = inlev 
    12391165                        ENDIF 
    12401166                     ENDIF 
     
    12421168               ENDIF 
    12431169            ENDIF 
    1244  
     1170            ! 
    12451171            ! check that istart and icnt can be used with this file 
    12461172            !- 
     
    12531179               ENDIF 
    12541180            END DO 
    1255  
     1181            ! 
    12561182            ! check that icnt matches the input array 
    12571183            !-      
     
    12631189            ELSE 
    12641190               IF( irankpv == 2 ) THEN 
    1265 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1266 !               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)' 
    1267                   IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 
    1268                   ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)' 
    1269                   ENDIF 
     1191                  ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)' 
    12701192               ENDIF 
    12711193               IF( irankpv == 3 ) THEN  
    1272 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1273 !               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 
    1274                   IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 
    1275                   ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 
    1276                   ENDIF 
     1194                  ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 
    12771195               ENDIF 
    1278             ENDIF 
    1279           
     1196            ENDIF          
    12801197            DO jl = 1, irankpv 
    12811198               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 
     
    12891206         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point... 
    12901207            ! 
    1291          ! find the right index of the array to be read 
    1292 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1293 !         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1294 !         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1295 !         ENDIF 
    1296             IF( llnoov ) THEN 
    1297                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1298                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1299                ENDIF 
    1300             ELSE 
    1301                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj 
    1302                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1303                ENDIF 
     1208            ! find the right index of the array to be read 
     1209            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
     1210            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    13041211            ENDIF 
    13051212       
     
    13081215            IF( istop == nstop ) THEN   ! no additional errors until this point... 
    13091216               IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 
    1310               
     1217 
     1218               cl_type = 'T' 
     1219               IF( PRESENT(cd_type) )   cl_type = cd_type 
     1220               zsgn = 1._wp 
     1221               IF( PRESENT(psgn   ) )   zsgn    = psgn 
    13111222               !--- overlap areas and extra hallows (mpp) 
    13121223               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1313                   CALL lbc_lnk( 'iom', pv_r2d,'Z', -999., kfillmode = jpfillnothing ) 
     1224                  CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = jpfillnothing ) 
    13141225               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    1315                   ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    1316                   IF( icnt(3) == inlev ) THEN 
    1317                      CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 
    1318                   ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    1319                      DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
    1320                      DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO 
    1321                   ENDIF 
     1226                  CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = jpfillnothing ) 
    13221227               ENDIF 
    13231228               ! 
     
    13361241         CALL iom_swap( TRIM(crxios_context) )  
    13371242         IF( PRESENT(pv_r3d) ) THEN 
    1338             pv_r3d(:, :, :) = 0. 
    1339             if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 
     1243            IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 
    13401244            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    1341             IF(idom /= jpdom_unknown ) then 
    1342                 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
    1343             ENDIF 
     1245            IF(idom /= jpdom_unknown )   CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
    13441246         ELSEIF( PRESENT(pv_r2d) ) THEN 
    1345             pv_r2d(:, :) = 0. 
    1346             if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 
     1247            IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 
    13471248            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    1348             IF(idom /= jpdom_unknown ) THEN 
    1349                 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
    1350             ENDIF 
     1249            IF(idom /= jpdom_unknown )   CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
    13511250         ELSEIF( PRESENT(pv_r1d) ) THEN 
    1352             pv_r1d(:) = 0. 
    1353             if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 
     1251            IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 
    13541252            CALL xios_recv_field( trim(cdvar), pv_r1d) 
    13551253         ENDIF 
Note: See TracChangeset for help on using the changeset viewer.