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 5118 for trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 – NEMO

Ignore:
Timestamp:
2015-03-03T14:36:04+01:00 (9 years ago)
Author:
acc
Message:

Merge changes from dev_r5087_NOC2_JATTR (see #1472) into trunk following successful SETTE tests

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5043 r5118  
    543543   END SUBROUTINE iom_g1d 
    544544 
    545    SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     545   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 
    546546      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    547547      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
     
    551551      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    552552      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
     553      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
     554                                                                               ! look for and use a file attribute 
     555                                                                               ! called open_ocean_jstart to set the start 
     556                                                                               ! value for the 2nd dimension (netcdf only) 
    553557      ! 
    554558      IF( kiomid > 0 ) THEN 
    555559         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    556               &                                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     560              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     561              &                                                     lrowattr=lrowattr ) 
    557562      ENDIF 
    558563   END SUBROUTINE iom_g2d 
    559564 
    560    SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     565   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 
    561566      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    562567      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
     
    566571      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    567572      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
     573      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
     574                                                                                 ! look for and use a file attribute 
     575                                                                                 ! called open_ocean_jstart to set the start 
     576                                                                                 ! value for the 2nd dimension (netcdf only) 
    568577      ! 
    569578      IF( kiomid > 0 ) THEN 
    570579         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    571               &                                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     580              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     581              &                                                     lrowattr=lrowattr ) 
    572582      ENDIF 
    573583   END SUBROUTINE iom_g3d 
     
    576586   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   & 
    577587         &                  pv_r1d, pv_r2d, pv_r3d,   & 
    578          &                  ktime , kstart, kcount  ) 
     588         &                  ktime , kstart, kcount,   & 
     589         &                  lrowattr                ) 
    579590      !!----------------------------------------------------------------------- 
    580591      !!                  ***  ROUTINE  iom_get_123d  *** 
     
    593604      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
    594605      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
     606      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to 
     607                                                                           ! look for and use a file attribute 
     608                                                                           ! called open_ocean_jstart to set the start 
     609                                                                           ! value for the 2nd dimension (netcdf only) 
    595610      ! 
    596611      LOGICAL                        ::   llnoov      ! local definition to read overlap 
     612      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute 
     613      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute 
    597614      INTEGER                        ::   jl          ! loop on number of dimension  
    598615      INTEGER                        ::   idom        ! type of domain 
     
    604621      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes 
    605622      INTEGER                        ::   ji, jj      ! loop counters 
    606       INTEGER                        ::   irankpv       !  
     623      INTEGER                        ::   irankpv     !  
    607624      INTEGER                        ::   ind1, ind2  ! substring index 
    608625      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis 
     
    628645      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    629646      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 
     647 
     648      luse_jattr = .false. 
     649      IF( PRESENT(lrowattr) ) THEN 
     650         IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 
     651         IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true. 
     652      ENDIF 
     653      IF( luse_jattr ) THEN 
     654         SELECT CASE (iom_file(kiomid)%iolib) 
     655         CASE (jpioipsl, jprstdimg ) 
     656             CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 
     657             luse_jattr = .false. 
     658         CASE (jpnf90   )    
     659             ! Ok 
     660         CASE DEFAULT     
     661            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     662         END SELECT 
     663      ENDIF 
    630664 
    631665      ! Search for the variable in the data base (eventually actualize data) 
     
    701735            ELSE  
    702736               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
    703                   IF(     idom == jpdom_data    ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /)  ! icnt(1:2) done bellow 
    704                   ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done bellow 
     737                  IF(     idom == jpdom_data    ) THEN 
     738                     jstartrow = 1 
     739                     IF( luse_jattr ) THEN 
     740                        CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
     741                        jstartrow = MAX(1,jstartrow) 
     742                     ENDIF 
     743                     istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
     744                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below 
    705745                  ENDIF 
    706746                  ! we do not read the overlap                     -> we start to read at nldi, nldj 
Note: See TracChangeset for help on using the changeset viewer.