Changeset 4144 for branches/2013/dev_r3987_UKMO6_C1D/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

Timestamp:

2013-10-28T14:50:08+01:00 (10 years ago)

Author:

rfurner

Message:

Commit for 2013 changes; see #1085

File:

• branches/2013/dev_r3987_UKMO6_C1D/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 (modified) (3 diffs)

branches/2013/dev_r3987_UKMO6_C1D/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

@@ -463 +463 @@
    !!                   INTERFACE iom_get
    !!----------------------------------------------------------------------
-   SUBROUTINE iom_g0d( kiomid, cdvar, pvar )
+   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )
       INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
       CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
       REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
-      !
-      INTEGER               :: idvar   ! variable id
+      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
+      !
+      INTEGER                                         ::   idvar     ! variable id
+      INTEGER                                         ::   idmspc    ! number of spatial dimensions
+      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
+      CHARACTER(LEN=100)                              ::   clinfo    ! info character
+      CHARACTER(LEN=100)                              ::   clname    ! file name
+      CHARACTER(LEN=1)                                ::   cldmspc   !
+      !
+      itime = 1
+      IF( PRESENT(ktime) ) itime = ktime
+      !
+      clname = iom_file(kiomid)%name
+      clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
       !
       IF( kiomid > 0 ) THEN
          idvar = iom_varid( kiomid, cdvar )
          IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
+            idmspc = iom_file ( kiomid )%ndims( idvar )
+            IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
+            WRITE(cldmspc , fmt='(i1)') idmspc
+            IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
+                                 &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
+                                 &                         'Use ncwa -a to suppress the unnecessary dimensions' )
             SELECT CASE (iom_file(kiomid)%iolib)
-            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar )
-            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar )
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar, itime )
+            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar, itime )
             CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar )
             CASE DEFAULT    
@@ -640 +658 @@
                ELSE
                   CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
-                     &                         'we do not accept data with more than '//cldmspc//' spatial dimension',   &
+                     &                         'we do not accept data with '//cldmspc//' spatial dimensions',   &
                      &                         'Use ncwa -a to suppress the unnecessary dimensions' )
                ENDIF
@@ -752 +770 @@
 
          IF( istop == nstop ) THEN   ! no additional errors until this point...
-            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
           
             !--- overlap areas and extra hallows (mpp)