Changeset 975


Ignore:
Timestamp:
2008-05-15T16:10:33+02:00 (13 years ago)
Author:
cetlod
Message:

Update IOM modules, see ticket 150

Location:
trunk/NEMO/OFF_SRC/IOM
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OFF_SRC/IOM/in_out_manager.F90

    r719 r975  
    3333   INTEGER            ::   nleapy     = 0         !: Leap year calendar flag (0/1 or 30) 
    3434   INTEGER            ::   ninist     = 0         !: initial state output flag (0/1) 
     35   LOGICAL            ::   ln_dimgnnn = .FALSE.   !: type of dimgout. (F): 1 file for all proc 
     36                                                  !:                  (T): 1 file per proc 
    3537   !!---------------------------------------------------------------------- 
    3638   !! was in restart but moved here because of the OFF line... better solution should be found... 
     
    7274   !!                          Run control   
    7375   !!---------------------------------------------------------------------- 
    74     
     76 
    7577   INTEGER            ::   nstop = 0                !: error flag (=number of reason for a premature stop run) 
    7678   INTEGER            ::   nwarn = 0                !: warning flag (=number of warning found during the run) 
    77    CHARACTER(LEN=100) ::   ctmp1, ctmp2, ctmp3      !: temporary character 
     79   CHARACTER(len=200) ::   ctmp1, ctmp2, ctmp3      !: temporary character 
    7880   CHARACTER (len=64) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !: 
    7981   CHARACTER (len=64) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !: 
     
    8284   !!---------------------------------------------------------------------- 
    8385   !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    84    !! $Header$  
     86   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/in_out_manager.F90,v 1.11 2007/03/02 16:37:06 opalod Exp $  
    8587   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    8688   !!---------------------------------------------------------------------- 
     
    168170        getunit = -1 
    169171     ENDIF 
    170       
     172 
    171173   END FUNCTION getunit 
    172174 
  • trunk/NEMO/OFF_SRC/IOM/iom.F90

    r719 r975  
    66   !! History :  9.0  ! 05 12  (J. Belier) Original code 
    77   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
     8   !!             "   ! 07 07  (D. Storkey) Changes to iom_gettime 
    89   !!-------------------------------------------------------------------- 
    910   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
     
    1920   USE in_out_manager  ! I/O manager 
    2021   USE dom_oce         ! ocean space and time domain 
     22   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2123   USE iom_def         ! iom variables definitions 
    2224   USE iom_ioipsl      ! NetCDF format with IOIPSL library 
     
    2830    
    2931   PUBLIC iom_open, iom_close, iom_varid, iom_get, iom_gettime, iom_rstput 
     32 
     33   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
     34   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 
    3035 
    3136   INTERFACE iom_get 
     
    3843   !!---------------------------------------------------------------------- 
    3944   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    40    !! $Header$ 
     45   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/iom.F90,v 1.10 2007/06/29 14:10:50 opalod Exp $ 
    4146   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4247   !!---------------------------------------------------------------------- 
     
    4449CONTAINS 
    4550 
    46    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib ) 
     51   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop ) 
    4752      !!--------------------------------------------------------------------- 
    4853      !!                   ***  SUBROUTINE  iom_open  *** 
     
    5560      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap) 
    5661      INTEGER         , INTENT(in   ), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90)  
     62      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    5763 
    5864      CHARACTER(LEN=100)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
     
    6268      CHARACTER(LEN=100)    ::   clinfo    ! info character 
    6369      LOGICAL               ::   llok      ! check the existence  
    64       LOGICAL               ::   llwrt     !  
     70      LOGICAL               ::   llwrt     ! local definition of ldwrt 
     71      LOGICAL               ::   llstop    ! local definition of ldstop 
    6572      INTEGER               ::   iolib     ! library do we use to open the file 
    6673      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
     
    8996      ELSE                        ;   llwrt = .FALSE. 
    9097      ENDIF 
     98      ! do we call ctl_stop if we try to open a non-existing file in read mode? 
     99      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop 
     100      ELSE                         ;   llstop = .TRUE. 
     101      ENDIF 
    91102      ! what library do we use to open the file? 
    92103      IF( PRESENT(kiolib) ) THEN   ;   iolib = kiolib 
     
    110121      iln = LEN_TRIM(clname) 
    111122      ils = LEN_TRIM(clsuffix) 
    112       IF( iln <= ils) clname = clname(1:iln)//TRIM(clsuffix) 
    113       IF( clname(iln-ils+1:iln) /= TRIM(clsuffix) )   clname = clname(1:iln)//TRIM(clsuffix) 
     123      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   & 
     124         &   clname = TRIM(clname)//TRIM(clsuffix) 
    114125      cltmpn = clname   ! store this name 
    115126      ! try to find if the file to be opened already exist 
     
    118129      IF( .NOT.llok ) THEN 
    119130         ! we try to add the cpu number to the name 
    120          WRITE(clcpu,*) narea-1 
     131         IF( iolib == jprstdimg ) THEN   ;   WRITE(clcpu,*) narea 
     132         ELSE                            ;   WRITE(clcpu,*) narea-1 
     133         ENDIF 
    121134         clcpu  = TRIM(ADJUSTL(clcpu)) 
    122          iln = INDEX(clname,TRIM(clsuffix)) 
     135         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.) 
    123136         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 
    124137         icnt = 0 
     
    132145         END DO 
    133146      ENDIF 
    134       ! check the domain definition 
    135       idom = jpdom_local_noovlap   ! default definition 
    136       IF( PRESENT(kdom) )   idom = kdom 
    137       ! create the domain informations 
    138       ! ============= 
    139       SELECT CASE (idom) 
    140       CASE (jpdom_local_full) 
    141          idompar(:,1) = (/ jpi             , jpj              /) 
    142          idompar(:,2) = (/ nimpp           , njmpp            /) 
    143          idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /) 
    144          idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    145          idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /) 
    146       CASE (jpdom_local_noextra) 
    147          idompar(:,1) = (/ nlci            , nlcj             /) 
    148          idompar(:,2) = (/ nimpp           , njmpp            /) 
    149          idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 
    150          idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    151          idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /) 
    152       CASE (jpdom_local_noovlap) 
    153          idompar(:,1) = (/ nlei - nldi + 1 , nlej - nldj + 1  /) 
    154          idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
    155          idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
    156          idompar(:,4) = (/ 0               , 0                /) 
    157          idompar(:,5) = (/ 0               , 0                /) 
    158       CASE DEFAULT 
    159          CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' ) 
    160       END SELECT 
     147      IF( llwrt ) THEN 
     148         ! check the domain definition 
     149! JMM + SM: ugly patch before getting the new version of lib_mpp) 
     150!         idom = jpdom_local_noovlap   ! default definition 
     151         IF( jpni*jpnj == jpnij ) THEN   ;   idom = jpdom_local_noovlap   ! default definition 
     152         ELSE                            ;   idom = jpdom_local_full      ! default definition 
     153         ENDIF 
     154         IF( PRESENT(kdom) )   idom = kdom 
     155         ! create the domain informations 
     156         ! ============= 
     157         SELECT CASE (idom) 
     158         CASE (jpdom_local_full) 
     159            idompar(:,1) = (/ jpi             , jpj              /) 
     160            idompar(:,2) = (/ nimpp           , njmpp            /) 
     161            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /) 
     162            idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
     163            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /) 
     164         CASE (jpdom_local_noextra) 
     165            idompar(:,1) = (/ nlci            , nlcj             /) 
     166            idompar(:,2) = (/ nimpp           , njmpp            /) 
     167            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 
     168            idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
     169            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /) 
     170         CASE (jpdom_local_noovlap) 
     171            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /) 
     172            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
     173            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
     174            idompar(:,4) = (/ 0               , 0                /) 
     175            idompar(:,5) = (/ 0               , 0                /) 
     176         CASE DEFAULT 
     177            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' ) 
     178         END SELECT 
     179      ENDIF 
    161180      ! Open the NetCDF or RSTDIMG file 
    162181      ! ============= 
    163182      ! do we have some free file identifier? 
    164183      IF( MINVAL(iom_file(:)%nfid) /= 0 )   & 
    165             &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' ) 
     184         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' ) 
     185      ! if no file was found... 
     186      IF( .NOT. llok ) THEN 
     187         IF( .NOT. llwrt ) THEN   ! we are in read mode  
     188            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' ) 
     189            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file 
     190            ENDIF 
     191         ELSE                     ! we are in write mode so we  
     192            clname = cltmpn       ! get back the file name without the cpu number 
     193         ENDIF 
     194      ENDIF 
    166195      IF( istop == nstop ) THEN   ! no error within this routine 
    167          IF( .NOT. llok )   clname = cltmpn   ! get back the file name without the cpu number 
    168196         SELECT CASE (iolib) 
    169197         CASE (jpioipsl )   ;   CALL iom_ioipsl_open(  clname, kiomid, llwrt, llok, idompar ) 
     
    212240               END SELECT 
    213241               iom_file(jf)%nfid       = 0   ! free the id  
    214                IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(kiomid)%name)//' ok' 
     242               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok' 
    215243            ELSEIF( PRESENT(kiomid) ) THEN 
    216244               WRITE(ctmp1,*) '--->',  kiomid 
     
    223251 
    224252 
    225    FUNCTION iom_varid ( kiomid, cdvar, kdimsz 
     253   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop 
    226254      !!----------------------------------------------------------------------- 
    227255      !!                  ***  FUNCTION  iom_varid  *** 
     
    232260      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    233261      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
     262      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.) 
    234263      ! 
    235264      INTEGER                        ::   iom_varid, iiv, i_nvd 
    236265      LOGICAL                        ::   ll_fnd 
    237266      CHARACTER(LEN=100)             ::   clinfo                   ! info character 
     267      LOGICAL                        ::   llstop                   ! local definition of ldstop 
    238268      !!----------------------------------------------------------------------- 
    239       clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar) 
    240269      iom_varid = 0                         ! default definition 
    241       ! 
    242       IF( kiomid > 0 ) THEN 
     270      ! do we call ctl_stop if we look for non-existing variable? 
     271      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop 
     272      ELSE                         ;   llstop = .TRUE. 
     273      ENDIF 
     274      ! 
     275      IF( kiomid > 0 ) THEN 
     276         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar) 
    243277         IF( iom_file(kiomid)%nfid == 0 ) THEN  
    244278            CALL ctl_stop( trim(clinfo), 'the file is not open' ) 
     
    257291                  SELECT CASE (iom_file(kiomid)%iolib) 
    258292                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz ) 
    259                   CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid kiomid, cdvar, iiv, kdimsz ) 
    260                   CASE (jprstdimg)   ;   iom_varid = 0   ! all variables are listed in iom_file 
     293                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz ) 
     294                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file 
    261295                  CASE DEFAULT    
    262296                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     
    266300                        &                         'increase the parameter jpmax_vars') 
    267301               ENDIF 
     302               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' )  
    268303            ELSE 
    269304               iom_varid = iiv 
     
    294329      INTEGER               :: idvar   ! variable id 
    295330      ! 
    296       idvar = iom_varid( kiomid, cdvar ) 
    297       IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 
    298          SELECT CASE (iom_file(kiomid)%iolib) 
    299          CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar ) 
    300          CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar ) 
    301          CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar ) 
    302          CASE DEFAULT     
    303             CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    304          END SELECT 
    305       END IF 
     331      IF( kiomid > 0 ) THEN 
     332         idvar = iom_varid( kiomid, cdvar ) 
     333         IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 
     334            SELECT CASE (iom_file(kiomid)%iolib) 
     335            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar ) 
     336            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar ) 
     337            CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar ) 
     338            CASE DEFAULT     
     339               CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     340            END SELECT 
     341         ENDIF 
     342      ENDIF 
    306343   END SUBROUTINE iom_g0d 
    307344 
     
    315352      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
    316353      ! 
    317       IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   & 
    318             &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
     354      IF( kiomid > 0 ) THEN 
     355         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   & 
     356              &                                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     357      ENDIF 
    319358   END SUBROUTINE iom_g1d 
    320359 
     
    328367      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
    329368      ! 
    330       IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    331             &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
     369      IF( kiomid > 0 ) THEN 
     370         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
     371              &                                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     372      ENDIF 
    332373   END SUBROUTINE iom_g2d 
    333374 
     
    341382      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
    342383      ! 
    343       IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    344             &                                        ktime=ktime, kstart=kstart, kcount=kcount ) 
     384      IF( kiomid > 0 ) THEN 
     385         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
     386              &                                                     ktime=ktime, kstart=kstart, kcount=kcount ) 
     387      ENDIF 
    345388   END SUBROUTINE iom_g3d 
    346389   !!---------------------------------------------------------------------- 
    347390 
    348391   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   & 
    349          &                   pv_r1d, pv_r2d, pv_r3d,   & 
    350          &                   ktime , kstart, kcount  ) 
     392         &                  pv_r1d, pv_r2d, pv_r3d,   & 
     393         &                  ktime , kstart, kcount  ) 
    351394      !!----------------------------------------------------------------------- 
    352395      !!                  ***  ROUTINE  iom_get_123d  *** 
     
    373416      INTEGER                        ::   itime       ! record number 
    374417      INTEGER                        ::   istop       ! temporary value of nstop 
     418      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes 
     419      INTEGER                        ::   ji, jj      ! loop counters 
     420      INTEGER                        ::   irankpv       !  
     421      INTEGER                        ::   ind1, ind2  ! substring index 
    375422      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis 
    376423      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis  
    377424      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable 
     425      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    378426      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
    379427      INTEGER                        ::   itmp        ! temporary integer 
    380428      CHARACTER(LEN=100)             ::   clinfo      ! info character 
     429      CHARACTER(LEN=100)             ::   clname      ! file name 
     430      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    381431      !--------------------------------------------------------------------- 
    382432      ! 
    383       clinfo = '          iom_get_123d, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar) 
     433      clname = iom_file(kiomid)%name   !   esier to read 
     434      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 
    384435      ! local definition of the domain ? 
    385436      idom = kdom 
    386437      ! check kcount and kstart optionals parameters... 
    387       IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) )   & 
    388             CALL ctl_stop( trim(clinfo), 'kcount present needs kstart present' ) 
    389       IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) )   & 
    390             CALL ctl_stop( trim(clinfo), 'kstart present needs kcount present' ) 
    391       IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   )   & 
    392             CALL ctl_stop( trim(clinfo), 'kstart present needs kdom = jpdom_unknown' ) 
     438      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
     439      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
     440      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 
    393441 
    394442      ! Search for the variable in the data base (eventually actualize data) 
     
    402450         idmspc = inbdim                                   ! number of spatial dimensions in the file 
    403451         IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1 
    404          IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo),   & 
    405                &                    'the file has more than 3 spatial dimensions this case is not coded...' )  
    406          IF( idom == jpdom_local ) THEN        ! Identify the domain in case of jpdom_local definition 
    407             IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN  
    408                idom = jpdom_local_full 
    409             ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN  
    410                idom = jpdom_local_noextra 
    411             ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN  
    412                idom = jpdom_local_noovlap 
    413             ELSE  
    414                CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 
    415             ENDIF 
    416          ENDIF 
     452         IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')  
     453         ! 
     454         ! update idom definition... 
     455         ! Identify the domain in case of jpdom_auto(glo/dta) definition 
     456         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN             
     457            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global  
     458            ELSE                               ;   idom = jpdom_data 
     459            ENDIF 
     460            ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 
     461            ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 
     462            IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF 
     463         ENDIF 
     464         ! Identify the domain in case of jpdom_local definition 
     465         IF( idom == jpdom_local ) THEN 
     466            IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full 
     467            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra 
     468            ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap 
     469            ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 
     470            ENDIF 
     471         ENDIF 
     472         ! 
     473         ! check the consistency between input array and data rank in the file 
     474         ! 
     475         ! initializations 
     476         itime = 1 
     477         IF( PRESENT(ktime) ) itime = ktime 
     478 
     479         irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 
     480         WRITE(clrankpv, fmt='(i1)') irankpv 
     481         WRITE(cldmspc , fmt='(i1)') idmspc 
     482         ! 
     483         IF(     idmspc <  irankpv ) THEN  
     484            CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     485               &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
     486         ELSEIF( idmspc == irankpv ) THEN 
     487            IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
     488               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
     489         ELSEIF( idmspc >  irankpv ) THEN 
     490               IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
     491                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   & 
     492                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
     493                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
     494                  idmspc = idmspc - 1 
     495               ELSE 
     496                  CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   & 
     497                     &                         'we do not accept data with more than '//cldmspc//' spatial dimension',   & 
     498                     &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
     499               ENDIF 
     500         ENDIF 
     501 
    417502         ! 
    418503         ! definition of istart and icnt 
    419504         ! 
    420          ! initializations 
     505         icnt  (:) = 1 
    421506         istart(:) = 1 
    422          icnt  (:) = 1 
    423          itime = 1 
    424          IF( PRESENT(ktime) ) itime = ktime 
    425          ! 
    426          IF( PRESENT(pv_r1d) ) THEN 
    427             IF( idmspc == 1 ) THEN  
    428                ! data is 1d array (+ maybe a temporal dimension) 
    429                IF( PRESENT(kstart) ) THEN 
    430                   istart(1:2) = (/ kstart(1), itime /) 
    431                   icnt(1) = kcount(1) 
    432                ELSE 
    433                   IF( kdom == jpdom_unknown ) THEN 
    434                      istart(2) = itime 
    435                      icnt(1) = idimsz(1) 
    436                   ELSE  
    437                      CALL ctl_stop( trim(clinfo), 'case not coded...You must use jpdom_unknown' ) 
     507         istart(idmspc+1) = itime 
     508 
     509         IF(              PRESENT(kstart)       ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 
     510         ELSE 
     511            IF(           idom == jpdom_unknown ) THEN                                       ; icnt(1:idmspc) = idimsz(1:idmspc) 
     512            ELSE  
     513               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
     514                  IF(     idom == jpdom_data    ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /)  ! icnt(1:2) done bellow 
     515                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done bellow 
    438516                  ENDIF 
    439                ENDIF 
    440             ELSE 
    441                CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 1D array,', & 
    442                      &         'we do not accept data with more than 1 spatial dimension',     & 
    443                      &         'Use ncwa -a to suppress the unnecessary dimensions') 
    444             ENDIF 
    445          ELSEIF( PRESENT(pv_r2d) ) THEN 
    446             SELECT CASE (idmspc) 
    447             CASE (1) 
    448                CALL ctl_stop( trim(clinfo), 'the file has only 1 spatial dimension',  & 
    449                      &         'it is impossible to read a 2d array from this file...') 
    450             CASE (2) 
    451                ! data is 2d array (+ maybe a temporal dimension) 
    452                IF( PRESENT(kstart) ) THEN 
    453                   istart(1:3) = (/ kstart(1:2), itime /) 
    454                   icnt(1:2) = kcount(1:2) 
    455                ELSE 
    456                   IF( kdom == jpdom_unknown ) THEN 
    457                      istart(3) = itime 
    458                      icnt(1:2) = idimsz(1:2) 
    459                   ELSE  
    460                      IF( idom == jpdom_data ) THEN 
    461                         istart(1:3) = (/ mig(1), mjg(1), itime /) 
    462                      ELSEIF( idom == jpdom_global ) THEN 
    463                         istart(1:3) = (/ nimpp, njmpp, itime /) 
    464                      ENDIF 
    465                      ! we do not read the overlap -> we start to read at nldi, nldj 
    466                      IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    467                      ! we do not read the overlap and the extra-halos   
    468                      ! -> from nldi to nlei and from nldj to nlej  
    469                      icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
     517                  ! we do not read the overlap                     -> we start to read at nldi, nldj 
     518! JMM + SM: ugly patch before getting the new version of lib_mpp) 
     519!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
     520                  IF( jpni*jpnj == jpnij .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
     521                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
     522! JMM + SM: ugly patch before getting the new version of lib_mpp) 
     523!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
     524                  IF( jpni*jpnj == jpnij ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
     525                  ELSE                            ;   icnt(1:2) = (/ nlci           , nlcj            /) 
    470526                  ENDIF 
    471                ENDIF 
    472             CASE DEFAULT 
    473                IF( itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
    474                   CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...',                & 
    475                         &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
    476                         &         'we accept this case even if there is a possible mix-up between z and time dimension' )            
    477                   IF( PRESENT(kstart) ) THEN 
    478                      istart(1:2) = kstart(1:2) 
    479                      icnt(1:2) = kcount(1:2) 
    480                   ELSE 
    481                      IF( kdom == jpdom_unknown ) THEN 
    482                         icnt(1:2) = idimsz(1:2) 
    483                      ELSE  
    484                         IF( idom == jpdom_data ) THEN 
    485                            istart(1:2) = (/ mig(1), mjg(1) /) 
    486                         ELSEIF( idom == jpdom_global ) THEN 
    487                            istart(1:2) = (/ nimpp, njmpp /) 
    488                         ENDIF 
    489                         ! we do not read the overlap -> we start to read at nldi, nldj 
    490                         IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    491                         ! we do not read the overlap and the extra-halos   
    492                         ! -> from nldi to nlei and from nldj to nlej  
    493                         icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    494                      ENDIF 
    495                   ENDIF 
    496                ELSE 
    497                   CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 2D array,',           & 
    498                         &                       'we do not accept data with more than 2 spatial dimension',   & 
    499                         &                       'Use ncwa -a to suppress the unnecessary dimensions' ) 
    500                ENDIF 
    501             END SELECT 
    502          ELSEIF( PRESENT(pv_r3d) ) THEN 
    503             SELECT CASE (idmspc) 
    504             CASE( 1 ) 
    505                CALL ctl_stop( trim(clinfo), 'the file has only 1 spatial dimension',            & 
    506                      &                       'it is impossible to read a 3d array from this file...' ) 
    507             CASE( 2 ) 
    508                CALL ctl_stop( trim(clinfo), 'the file has only 2 spatial dimension',            & 
    509                      &                       'it is impossible to read a 3d array from this file...' ) 
    510             CASE( 3 ) 
    511                ! data is 3d array (+ maybe a temporal dimension) 
    512                IF( PRESENT(kstart) ) THEN 
    513                   istart(1:4) = (/ kstart(1:3), itime /) 
    514                   icnt(1:3) = kcount(1:3) 
    515                ELSE 
    516                   IF( kdom == jpdom_unknown ) THEN 
    517                      istart(4) = itime 
    518                      icnt(1:3) = idimsz(1:3) 
    519                   ELSE  
    520                      IF( idom == jpdom_data ) THEN 
    521                         istart(1:4) = (/ mig(1), mjg(1), 1, itime /) 
    522                      ELSEIF( idom == jpdom_global ) THEN 
    523                         istart(1:4) = (/ nimpp, njmpp, 1, itime /) 
    524                      ENDIF 
    525                      ! we do not read the overlap -> we start to read at nldi, nldj 
    526                      IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    527                      ! we do not read the overlap and the extra-halos 
    528                      ! -> from nldi to nlei and from nldj to nlej  
    529                      icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    530                      IF( idom == jpdom_data ) THEN  
    531                         icnt(3) = jpkdta 
    532                      ELSE 
    533                         icnt(3) = jpk 
     527                  IF( PRESENT(pv_r3d) ) THEN 
     528                     IF( idom == jpdom_data ) THEN   ; icnt(3) = jpkdta 
     529                     ELSE                            ; icnt(3) = jpk 
    534530                     ENDIF 
    535531                  ENDIF 
    536532               ENDIF 
    537             CASE DEFAULT 
    538                CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 3D array,',   & 
    539                      &         'we do not accept data with more than 3 spatial dimension',         & 
    540                      &         'Use ncwa -a to suppress the unnecessary dimensions' )            
    541             END SELECT 
     533            ENDIF 
    542534         ENDIF 
    543535 
     
    546538         DO jl = 1, jpmax_dims 
    547539            itmp = istart(jl)+icnt(jl)-1 
    548             IF( (itmp) > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 
    549                WRITE(ctmp1,*) '(istart(',jl,') + icnt(',jl,') - 1) = ', itmp 
    550                WRITE(ctmp2,*) ' is larger than idimsz(',jl,'): ', idimsz(jl) 
     540            IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 
     541               WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 
     542               WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl) 
    551543               CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )      
    552544            ENDIF 
     
    555547         ! check that icnt matches the input array 
    556548         !-      
    557          IF( PRESENT(pv_r1d) ) THEN 
    558             itmp = size(pv_r1d) 
    559             WRITE(ctmp1,*) 'size(pv_r1d): ', itmp, ' /= icnt(1): ', icnt(1) 
    560             IF( itmp /= icnt(1) )   CALL ctl_stop( trim(clinfo), ctmp1 ) 
    561          ELSEIF( PRESENT(pv_r2d) ) THEN 
    562             DO jl = 1, 2 
    563                IF( idom == jpdom_unknown ) THEN 
    564                   itmp = size(pv_r2d, jl) 
    565                   WRITE(ctmp1,*) 'size(pv_r2d, ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl) 
    566                ELSE  
    567                   itmp = size(pv_r2d(nldi:nlei,nldj:nlej), jl) 
    568                   WRITE(ctmp1,*) 'size(pv_r2d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl) 
     549         IF( idom == jpdom_unknown ) THEN 
     550            IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d) 
     551            IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d) 
     552            IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d) 
     553            ctmp1 = 'd' 
     554         ELSE 
     555            IF( irankpv == 2 ) THEN 
     556! JMM + SM: ugly patch before getting the new version of lib_mpp) 
     557!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)' 
     558               IF( jpni*jpnj == jpnij ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 
     559               ELSE                          ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)' 
    569560               ENDIF 
    570                IF( itmp /= icnt(jl) )   CALL ctl_stop( trim(clinfo), ctmp1 ) 
    571             END DO 
    572          ELSEIF( PRESENT(pv_r3d) ) THEN 
    573             DO jl = 1, 3 
    574                IF( idom == jpdom_unknown ) THEN 
    575                   itmp = size(pv_r3d, jl) 
    576                   WRITE(ctmp1,*) 'size(pv_r3d, ',jl,'): ',itmp,' /= icnt(',jl,'):', icnt(jl) 
    577                ELSE  
    578                   itmp = size(pv_r3d(nldi:nlei,nldj:nlej,:), jl) 
    579                   WRITE(ctmp1,*) 'size(pv_r3d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl) 
     561            ENDIF 
     562            IF( irankpv == 3 ) THEN  
     563! JMM + SM: ugly patch before getting the new version of lib_mpp) 
     564!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 
     565               IF( jpni*jpnj == jpnij ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 
     566               ELSE                          ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 
    580567               ENDIF 
    581                IF( itmp /= icnt(jl) )   CALL ctl_stop( trim(clinfo), ctmp1 ) 
    582             END DO 
    583          ENDIF 
     568            ENDIF 
     569         ENDIF 
     570          
     571         DO jl = 1, irankpv 
     572            WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 
     573            IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 
     574         END DO 
     575 
    584576      ENDIF 
    585577 
    586578      ! read the data 
    587579      !-      
    588       IF( istop == nstop) THEN ! no additional errors until this point... 
     580      IF( idvar > 0 .AND. istop == nstop ) THEN  ! no additional errors until this point... 
    589581         ! 
     582         ! find the right index of the array to be read 
     583! JMM + SM: ugly patch before getting the new version of lib_mpp) 
     584!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
     585!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
     586!         ENDIF 
     587         IF( jpni*jpnj == jpnij ) THEN 
     588            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
     589            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
     590            ENDIF 
     591         ELSE 
     592            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj 
     593            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
     594            ENDIF 
     595         ENDIF 
     596       
    590597         SELECT CASE (iom_file(kiomid)%iolib) 
    591          CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idom, idvar, inbdim, istart, icnt, pv_r1d, pv_r2d, pv_r3d ) 
    592          CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idom, idvar, inbdim, istart, icnt, pv_r1d, pv_r2d, pv_r3d ) 
    593          CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idom, idvar,         istart, icnt, pv_r1d, pv_r2d, pv_r3d ) 
     598         CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   & 
     599            &                                         pv_r1d, pv_r2d, pv_r3d ) 
     600         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   & 
     601            &                                         pv_r1d, pv_r2d, pv_r3d ) 
     602         CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2,   & 
     603            &                                         pv_r1d, pv_r2d, pv_r3d ) 
    594604         CASE DEFAULT     
    595605            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    596606         END SELECT 
    597          IF( istop == nstop .AND. lwp )   & 
    598                WRITE(numout,*) '           read '//trim(cdvar)//' in '//trim(iom_file(kiomid)%name)//' ok' 
    599          !--- Apply scale_factor and offset 
    600          zscf = iom_file(kiomid)%scf(idvar)      ! scale factor 
    601          zofs = iom_file(kiomid)%ofs(idvar)      ! offset 
    602          IF( PRESENT(pv_r1d) ) THEN 
    603             IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf  
    604             IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs 
    605          ELSEIF( PRESENT(pv_r2d) ) THEN 
    606 !CDIR COLLAPSE 
    607             IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf 
    608 !CDIR COLLAPSE 
    609             IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs 
    610          ELSEIF( PRESENT(pv_r3d) ) THEN 
    611 !CDIR COLLAPSE 
    612             IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 
    613 !CDIR COLLAPSE 
    614             IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 
     607 
     608         IF( istop == nstop ) THEN   ! no additional errors until this point... 
     609            IF(lwp) WRITE(numout,*) '           read '//TRIM(cdvar)//' in '//TRIM(iom_file(kiomid)%name)//' ok' 
     610             
     611            !--- overlap areas and extra hallows (mpp) 
     612            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
     613               CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 
     614            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
     615               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
     616               IF( icnt(3) == jpk ) THEN 
     617                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
     618               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
     619                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
     620                  DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO 
     621               ENDIF 
     622            ENDIF 
     623             
     624            !--- Apply scale_factor and offset 
     625            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor 
     626            zofs = iom_file(kiomid)%ofs(idvar)      ! offset 
     627            IF(     PRESENT(pv_r1d) ) THEN 
     628               IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf  
     629               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs 
     630            ELSEIF( PRESENT(pv_r2d) ) THEN 
     631               !CDIR COLLAPSE 
     632               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf 
     633               !CDIR COLLAPSE 
     634               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs 
     635            ELSEIF( PRESENT(pv_r3d) ) THEN 
     636               !CDIR COLLAPSE 
     637               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 
     638               !CDIR COLLAPSE 
     639               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 
     640            ENDIF 
     641            ! 
    615642         ENDIF 
    616643         ! 
     
    620647 
    621648 
    622    SUBROUTINE iom_gettime( kiomid, cdvar, ptime ) 
     649   SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar ) 
    623650      !!-------------------------------------------------------------------- 
    624651      !!                   ***  SUBROUTINE iom_gettime  *** 
     
    626653      !! ** Purpose : read the time axis cdvar in the file  
    627654      !!-------------------------------------------------------------------- 
    628       INTEGER               , INTENT(in   ) ::   kiomid   ! file Identifier 
    629       CHARACTER(len=*)      , INTENT(in   ) ::   cdvar    ! time axis name 
    630       REAL(wp), DIMENSION(:), INTENT(  out) ::   ptime    ! the time axis 
    631       ! 
     655      INTEGER                    , INTENT(in   ) ::   kiomid     ! file Identifier 
     656      REAL(wp), DIMENSION(:)     , INTENT(  out) ::   ptime      ! the time axis 
     657      CHARACTER(len=*), OPTIONAL , INTENT(in   ) ::   cdvar      ! time axis name 
     658      INTEGER         , OPTIONAL , INTENT(  out) ::   kntime     ! number of times in file 
     659      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdunits    ! units attribute of time coordinate 
     660      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdcalendar ! calendar attribute of  
     661      ! 
     662      INTEGER, DIMENSION(1) :: kdimsz 
    632663      INTEGER            ::   idvar    ! id of the variable 
     664      CHARACTER(LEN=32)  ::   tname    ! local name of time coordinate 
    633665      CHARACTER(LEN=100) ::   clinfo   ! info character 
    634666      !--------------------------------------------------------------------- 
    635667      ! 
    636       clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar) 
    637       idvar = iom_varid( kiomid, cdvar ) 
    638       ! 
    639       ptime(:) = 0. ! default definition 
    640       IF( idvar > 0 ) THEN 
    641          IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN 
    642             IF( iom_file(kiomid)%luld(idvar) ) THEN 
    643                IF( iom_file(kiomid)%dimsz(1,idvar) == size(ptime) ) THEN 
    644                   SELECT CASE (iom_file(kiomid)%iolib) 
    645                   CASE (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime ) 
    646                   CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime ) 
    647                   CASE (jprstdimg)   ;   CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' ) 
    648                   CASE DEFAULT     
    649                      CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    650                   END SELECT 
     668      IF ( PRESENT(cdvar) ) THEN 
     669         tname = cdvar 
     670      ELSE 
     671         tname = iom_file(kiomid)%uldname 
     672      ENDIF 
     673      IF( kiomid > 0 ) THEN 
     674         clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname) 
     675         IF ( PRESENT(kntime) ) THEN 
     676            idvar  = iom_varid( kiomid, tname, kdimsz = kdimsz ) 
     677            kntime = kdimsz(1) 
     678         ELSE 
     679            idvar = iom_varid( kiomid, tname ) 
     680         ENDIF 
     681         ! 
     682         ptime(:) = 0. ! default definition 
     683         IF( idvar > 0 ) THEN 
     684            IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN 
     685               IF( iom_file(kiomid)%luld(idvar) ) THEN 
     686                  IF( iom_file(kiomid)%dimsz(1,idvar) == size(ptime) ) THEN 
     687                     SELECT CASE (iom_file(kiomid)%iolib) 
     688                     CASE (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar ) 
     689                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar ) 
     690                     CASE (jprstdimg)   ;   CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' ) 
     691                     CASE DEFAULT     
     692                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     693                     END SELECT 
     694                  ELSE 
     695                     WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar) 
     696                     CALL ctl_stop( trim(clinfo), trim(ctmp1) ) 
     697                  ENDIF 
    651698               ELSE 
    652                   WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar) 
    653                   CALL ctl_stop( trim(clinfo), trim(ctmp1) ) 
     699                  CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' ) 
    654700               ENDIF 
    655701            ELSE 
    656                CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' ) 
     702               CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' ) 
    657703            ENDIF 
    658704         ELSE 
    659             CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' ) 
    660          ENDIF 
    661       ELSE 
    662          CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name ) 
     705            CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name ) 
     706         ENDIF 
    663707      ENDIF 
    664708      ! 
     
    677721      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    678722      INTEGER :: ivid   ! variable id 
    679       IF( iom_file(kiomid)%nfid > 0 ) THEN 
    680          ivid = iom_varid(kiomid, cdvar) 
    681          SELECT CASE (iom_file(kiomid)%iolib) 
    682          CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
    683          CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
    684          CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, pvar ) 
    685          CASE DEFAULT      
    686             CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    687          END SELECT 
    688       END IF 
     723      IF( kiomid > 0 ) THEN 
     724         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     725            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     726            SELECT CASE (iom_file(kiomid)%iolib) 
     727            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     728            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     729            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar ) 
     730            CASE DEFAULT      
     731               CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     732            END SELECT 
     733         ENDIF 
     734      ENDIF 
    689735   END SUBROUTINE iom_rp0d 
    690736 
     
    697743      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    698744      INTEGER :: ivid   ! variable id 
    699       IF( iom_file(kiomid)%nfid > 0 ) THEN 
    700          ivid = iom_varid(kiomid, cdvar) 
    701          SELECT CASE (iom_file(kiomid)%iolib) 
    702          CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
    703          CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
    704          CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r1d = pvar ) 
    705          CASE DEFAULT      
    706             CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    707          END SELECT 
    708       END IF 
     745      IF( kiomid > 0 ) THEN 
     746         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     747            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     748            SELECT CASE (iom_file(kiomid)%iolib) 
     749            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     750            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     751            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar ) 
     752            CASE DEFAULT      
     753               CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     754            END SELECT 
     755         ENDIF 
     756      ENDIF 
    709757   END SUBROUTINE iom_rp1d 
    710758 
     
    717765      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    718766      INTEGER :: ivid   ! variable id 
    719       IF( iom_file(kiomid)%nfid > 0 ) THEN 
    720          ivid = iom_varid(kiomid, cdvar) 
    721          SELECT CASE (iom_file(kiomid)%iolib) 
    722          CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
    723          CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
    724          CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r2d = pvar )  
    725          CASE DEFAULT      
    726             CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    727          END SELECT 
    728       END IF 
     767      IF( kiomid > 0 ) THEN 
     768         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     769            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     770            SELECT CASE (iom_file(kiomid)%iolib) 
     771            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     772            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     773            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar )  
     774            CASE DEFAULT      
     775               CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     776            END SELECT 
     777         ENDIF 
     778      ENDIF 
    729779   END SUBROUTINE iom_rp2d 
    730780 
     
    737787      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    738788      INTEGER :: ivid   ! variable id 
    739       IF( iom_file(kiomid)%nfid > 0 ) THEN 
    740          ivid = iom_varid(kiomid, cdvar) 
    741          SELECT CASE (iom_file(kiomid)%iolib) 
    742          CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    743          CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    744          CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, pv_r3d = pvar ) 
    745          CASE DEFAULT      
    746             CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' ) 
    747          END SELECT 
    748       END IF 
     789      IF( kiomid > 0 ) THEN 
     790         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     791            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     792            SELECT CASE (iom_file(kiomid)%iolib) 
     793            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
     794            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
     795            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar ) 
     796            CASE DEFAULT      
     797               CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' ) 
     798            END SELECT 
     799         ENDIF 
     800      ENDIF 
    749801   END SUBROUTINE iom_rp3d 
    750802   !!---------------------------------------------------------------------- 
  • trunk/NEMO/OFF_SRC/IOM/iom_def.F90

    r719 r975  
    55   !!==================================================================== 
    66   !! History :  9.0  ! 06 09  (S. Masson) Original code 
     7   !!             "   ! 07 07  (D. Storkey) Add uldname 
    78   !!-------------------------------------------------------------------- 
    89   !!--------------------------------------------------------------------------------- 
    910   !! OPA 9.0 , LOCEAN-IPSL (2006)  
    10    !! $Header$  
     11   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/iom_def.F90,v 1.7 2007/06/05 10:33:38 opalod Exp $  
    1112   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1213   !!--------------------------------------------------------------------------------- 
     
    2425   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  ) 
    2526   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking 
     27   INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !:  
     28   INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 9   !:  
    2629 
    2730   INTEGER, PARAMETER, PUBLIC ::   jpioipsl    = 100      !: Use ioipsl (fliocom only) library 
     
    4144 
    4245   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 20   !: maximum number of simultaneously opened file 
    43    INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 60   !: maximum number of variables in one file 
     46   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 360  !: maximum number of variables in one file 
    4447   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    4548   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 
    4649 
     50!$AGRIF_DO_NOT_TREAT 
    4751   INTEGER, PUBLIC            ::   iom_init = 0        !: used to initialize iom_file(:)%nfid to 0 
    48 !$AGRIF_DO_NOT_TREAT 
     52 
    4953   TYPE, PUBLIC ::   file_descriptor 
    5054      CHARACTER(LEN=240)                        ::   name     !: name of the file 
     
    5458      INTEGER                                   ::   iduld    !: id of the unlimited dimension 
    5559      INTEGER                                   ::   irec     !: writing record position   
    56       CHARACTER(LEN=16), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables 
     60      CHARACTER(LEN=32)                         ::   uldname  !: name of the unlimited dimension 
     61      CHARACTER(LEN=32), DIMENSION(jpmax_vars)  ::   cn_var   !: names of the variables 
    5762      INTEGER, DIMENSION(jpmax_vars)            ::   nvid     !: id of the variables 
    5863      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    !: number of dimensions of the variables 
  • trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90

    r719 r975  
    66   !! History :  9.0  ! 05 12  (J. Belier) Original code 
    77   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
     8   !!             "   ! 07 07  (D. Storkey) Changes to iom_ioipsl_gettime 
    89   !!-------------------------------------------------------------------- 
    910   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
     
    1920   USE in_out_manager  ! I/O manager 
    2021   USE dom_oce         ! ocean space and time domain 
    21    USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2222   USE iom_def         ! iom variables definitions 
    2323   USE ioipsl          ! IOIPSL library 
     
    3636   !!---------------------------------------------------------------------- 
    3737   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    38    !! $Header$ 
     38   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/iom_ioipsl.F90,v 1.8 2007/06/29 14:10:50 opalod Exp $ 
    3939   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4040   !!---------------------------------------------------------------------- 
     
    4848      !! ** Purpose :  open an input file with IOIPSL (only fliocom module) 
    4949      !!--------------------------------------------------------------------- 
    50       CHARACTER(len=*)       , INTENT(inout) ::   cdname    ! File name 
    51       INTEGER                , INTENT(  out) ::   kiomid    ! ioipsl identifier of the opened file 
    52       LOGICAL                , INTENT(in   ) ::   ldwrt     ! read or write the file? 
    53       LOGICAL                , INTENT(in   ) ::   ldok      ! check the existence  
    54       INTEGER, DIMENSION(2,5), INTENT(in   ) ::   kdompar   ! domain parameters:  
     50      CHARACTER(len=*)       , INTENT(inout)           ::   cdname    ! File name 
     51      INTEGER                , INTENT(  out)           ::   kiomid    ! ioipsl identifier of the opened file 
     52      LOGICAL                , INTENT(in   )           ::   ldwrt     ! read or write the file? 
     53      LOGICAL                , INTENT(in   )           ::   ldok      ! check the existence  
     54      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar   ! domain parameters:  
    5555 
    5656      CHARACTER(LEN=100) ::   clinfo     ! info character 
     
    5959      INTEGER            ::   ifliodom   ! model domain identifier (see flio_dom_set) 
    6060      INTEGER            ::   ioipslid   ! ioipsl identifier of the opened file 
     61      INTEGER            ::   jl         ! loop variable 
    6162      !--------------------------------------------------------------------- 
    6263 
     
    9293            ENDIF 
    9394         ELSE              ! the file should be open for read mode so it must exist... 
    94             CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' ) 
     95            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    9596         ENDIF 
    9697      ENDIF 
     
    9899      ! ============= 
    99100      IF( istop == nstop ) THEN   ! no error within this routine 
    100          kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     101!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     102         kiomid = 0 
     103         DO jl = jpmax_files, 1, -1 
     104            IF( iom_file(jl)%nfid == 0 )   kiomid = jl 
     105         ENDDO 
    101106         iom_file(kiomid)%name   = TRIM(cdname) 
    102107         iom_file(kiomid)%nfid   = ioipslid 
     
    161166                  &           len_dims = iom_file(kiomid)%dimsz(1:i_nvd,kiv), &   ! dimensions size 
    162167                  &           id_dims  = idimid(1:i_nvd) )                        ! dimensions ids 
    163             DO ji = 1, i_nvd   ! find the unlimited dimension 
     168            iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
     169            DO ji = 1, i_nvd                       ! find the unlimited dimension 
    164170               IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE. 
    165171            END DO 
    166             !---------- Deal with scale_factor and offset 
     172            !---------- Deal with scale_factor and add_offset 
    167173            CALL flioinqa( ioipslid, cdvar, 'scale_factor', ll_fnd ) 
    168174            IF( ll_fnd) THEN 
     
    171177               iom_file(kiomid)%scf(kiv) = 1. 
    172178            END IF 
    173             CALL flioinqa( ioipslid, cdvar, 'offset', ll_fnd ) 
     179            CALL flioinqa( ioipslid, cdvar, 'add_offset', ll_fnd ) 
    174180            IF( ll_fnd ) THEN 
    175                CALL fliogeta( ioipslid, cdvar, 'offset', iom_file(kiomid)%ofs(kiv) ) 
     181               CALL fliogeta( ioipslid, cdvar, 'add_offset', iom_file(kiomid)%ofs(kiv) ) 
    176182            ELSE 
    177183               iom_file(kiomid)%ofs(kiv) = 0. 
     
    190196                  &                       'increase the parameter jpmax_vars') 
    191197         ENDIF 
    192 !!$                  ELSE   
    193 !!$                     CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// & 
    194 !!$                        &                         ' is not found in the file '//trim(iom_file(kiomid)%name) ) 
     198      ELSE   
     199         iom_ioipsl_varid = -1   !   variable not found, return error code: -1 
    195200      ENDIF 
    196201      ! 
     
    213218 
    214219 
    215    SUBROUTINE iom_ioipsl_g123d( kiomid, kdom, kvid, knbdim, kstart, kcount,    & 
    216          &                          pv_r1d, pv_r2d, pv_r3d) 
     220   SUBROUTINE iom_ioipsl_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
     221         &                      pv_r1d, pv_r2d, pv_r3d) 
    217222      !!----------------------------------------------------------------------- 
    218223      !!                  ***  ROUTINE  iom_ioipsl_g123d  *** 
     
    223228      !!----------------------------------------------------------------------- 
    224229      INTEGER                    , INTENT(in   )           ::   kiomid     ! iom identifier of the file 
    225       INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read 
    226230      INTEGER                    , INTENT(in   )           ::   kvid       ! Name of the variable 
    227231      INTEGER                    , INTENT(in   )           ::   knbdim     ! number of dimensions of the variable 
    228232      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart     ! start position of the reading in each axis  
    229233      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount     ! number of points to be read in each axis 
     234      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    230235      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    231236      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
     
    235240      CHARACTER(LEN=100)    ::   clvn       ! variable name 
    236241      !--------------------------------------------------------------------- 
    237       clvn = TRIM(iom_file(kiomid)%cn_var(kvid)) 
    238       ioipslid = iom_file(kiomid)%nfid 
     242      clvn = TRIM(iom_file(kiomid)%cn_var(kvid))   ! get back variable name  
     243      ioipslid = iom_file(kiomid)%nfid             ! get back IPIPSL file id 
    239244      ! 
    240245      IF( PRESENT(pv_r1d) ) THEN 
    241          CALL fliogetv( ioipslid, clvn, pv_r1d(:), start=kstart(1:knbdim), count=kcount(1:knbdim) ) 
     246         CALL fliogetv( ioipslid, clvn, pv_r1d(:                ), start = kstart(1:knbdim), count = kcount(1:knbdim) ) 
    242247      ELSEIF( PRESENT(pv_r2d) ) THEN 
    243          IF( kdom /= jpdom_unknown ) THEN 
    244             CALL fliogetv( ioipslid, clvn, pv_r2d(nldi:nlei,nldj:nlej), start=kstart(1:knbdim), count=kcount(1:knbdim) ) 
    245             !--- Fill the overlap areas and extra hallows (mpp) 
    246             CALL lbc_lnk (pv_r2d,'Z',-999.,'no0') 
    247          ELSE 
    248             CALL fliogetv( ioipslid, clvn, pv_r2d(:,:), start=kstart(1:knbdim), count=kcount(1:knbdim) ) 
    249          ENDIF 
     248         CALL fliogetv( ioipslid, clvn, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim), count = kcount(1:knbdim) ) 
    250249      ELSEIF( PRESENT(pv_r3d) ) THEN 
    251          IF( kdom /= jpdom_unknown ) THEN 
    252             CALL fliogetv( ioipslid, clvn, pv_r3d(nldi:nlei,nldj:nlej,:), start=kstart(1:knbdim),   & 
    253                   &                                                         count=kcount  (1:knbdim) ) 
    254             !--- Fill the overlap areas and extra hallows (mpp) 
    255             ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    256             IF( kcount(3) == jpk ) THEN 
    257                CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
    258             ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    259                pv_r3d(nlei+1:jpi,      :   ,:) = 1.             
    260                pv_r3d(      :   ,nlej+1:jpj,:) = 1.             
    261             ENDIF 
    262          ELSE 
    263             CALL fliogetv( ioipslid, clvn, pv_r3d(:,:,:), start=kstart(1:knbdim), count=kcount(1:knbdim) ) 
    264          ENDIF 
     250         CALL fliogetv( ioipslid, clvn, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim), count = kcount(1:knbdim) ) 
    265251      ENDIF 
    266252      ! 
     
    269255 
    270256 
    271    SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime ) 
     257   SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime, cdunits, cdcalendar ) 
    272258      !!-------------------------------------------------------------------- 
    273259      !!                   ***  SUBROUTINE iom_gettime  *** 
     
    275261      !! ** Purpose : read the time axis kvid in the file with IOIPSL (only fliocom module) 
    276262      !!-------------------------------------------------------------------- 
    277       INTEGER               , INTENT(in   ) ::   kiomid   ! file Identifier 
    278       INTEGER               , INTENT(in   ) ::   kvid     ! variable id 
    279       REAL(wp), DIMENSION(:), INTENT(  out) ::   ptime    ! the time axis 
     263      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier 
     264      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id 
     265      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis 
     266      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute 
     267      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute 
    280268      !--------------------------------------------------------------------- 
    281269      ! 
    282270      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), ptime(:),   & 
    283271            &         start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /) ) 
     272      IF ( PRESENT(cdunits) ) THEN  
     273         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "units", cdunits ) 
     274      ENDIF 
     275      IF ( PRESENT(cdcalendar) ) THEN  
     276         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "calendar", cdcalendar ) 
     277      ENDIF 
    284278      ! 
    285279   END SUBROUTINE iom_ioipsl_gettime 
     
    330324               &                  long_name="Time axis", units='seconds since 0001-01-01 00:00:00' ) 
    331325         ! update informations structure related the dimension variable we just added... 
    332          iom_file(kiomid)%nvars         = 4 
    333          iom_file(kiomid)%luld(1:4)     = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 
    334          iom_file(kiomid)%cn_var(1:3)   = (/ 'nav_lon', 'nav_lat', 'nav_lev' /) 
    335          iom_file(kiomid)%cn_var(4)     = 'time_counter' 
    336          iom_file(kiomid)%ndims(1:4)    = (/ 2, 2, 1, 1 /)   
    337          CALL flioinqf( ioipslid, ln_dim = idimsz ) 
    338          iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2) 
    339          iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2) 
    340          iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/) 
     326         iom_file(kiomid)%nvars       = 4 
     327         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 
     328         iom_file(kiomid)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /) 
     329         iom_file(kiomid)%cn_var(4)   = 'time_counter' 
     330         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /) 
     331         ! trick: defined to 0 to say that dimension variables are defined but not yet written 
     332         iom_file(kiomid)%dimsz(1, 1) = 0    
    341333         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 
    342334      ENDIF 
     
    403395            ! write dimension variables if it is not already done 
    404396            ! ============= 
     397            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    405398            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    406399               CALL flioputv( ioipslid, 'nav_lon'     , glamt(ix1:ix2, iy1:iy2) ) 
     
    408401               CALL flioputv( ioipslid, 'nav_lev'     , gdept_0 ) 
    409402               ! +++ WRONG VALUE: to be improved but not really useful... 
    410                CALL flioputv( ioipslid, 'time_counter', kt )    
     403               CALL flioputv( ioipslid, 'time_counter', kt ) 
     404               ! update the values of the variables dimensions size 
     405               CALL flioinqf( ioipslid, ln_dim = idimsz ) 
     406               iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2) 
     407               iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2) 
     408               iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/) 
    411409               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
    412410            ENDIF 
  • trunk/NEMO/OFF_SRC/IOM/iom_nf90.F90

    r719 r975  
    66   !! History :  9.0  ! 05 12  (J. Belier) Original code 
    77   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO 
     8   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_gettime 
    89   !!-------------------------------------------------------------------- 
    910   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes 
     
    3637   !!---------------------------------------------------------------------- 
    3738   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    38    !! $Header$ 
     39   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/iom_nf90.F90,v 1.8 2007/06/29 14:10:50 opalod Exp $ 
    3940   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4041   !!---------------------------------------------------------------------- 
     
    4849      !! ** Purpose : open an input file with NF90 
    4950      !!--------------------------------------------------------------------- 
    50       CHARACTER(len=*)       , INTENT(inout) ::   cdname    ! File name 
    51       INTEGER                , INTENT(  out) ::   kiomid    ! nf90 identifier of the opened file 
    52       LOGICAL                , INTENT(in   ) ::   ldwrt     ! read or write the file? 
    53       LOGICAL                , INTENT(in   ) ::   ldok      ! check the existence  
    54       INTEGER, DIMENSION(2,5), INTENT(in   ) ::   kdompar   ! domain parameters:  
     51      CHARACTER(len=*)       , INTENT(inout)           ::   cdname    ! File name 
     52      INTEGER                , INTENT(  out)           ::   kiomid    ! nf90 identifier of the opened file 
     53      LOGICAL                , INTENT(in   )           ::   ldwrt     ! read or write the file? 
     54      LOGICAL                , INTENT(in   )           ::   ldok      ! check the existence  
     55      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar   ! domain parameters:  
    5556 
    5657      CHARACTER(LEN=100) ::   clinfo   ! info character 
     
    6061      INTEGER            ::   if90id   ! nf90 identifier of the opened file 
    6162      INTEGER            ::   idmy     ! dummy variable 
     63      INTEGER            ::   jl       ! loop variable 
    6264      !--------------------------------------------------------------------- 
    6365 
     
    103105            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo) 
    104106         ELSE              ! the file should be open for read mode so it must exist... 
    105             CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' ) 
     107            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    106108         ENDIF 
    107109      ENDIF 
     
    109111      ! ============= 
    110112      IF( istop == nstop ) THEN   ! no error within this routine 
    111          kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     113!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     114         kiomid = 0 
     115         DO jl = jpmax_files, 1, -1 
     116            IF( iom_file(jl)%nfid == 0 )   kiomid = jl 
     117         ENDDO 
    112118         iom_file(kiomid)%name   = TRIM(cdname) 
    113119         iom_file(kiomid)%nfid   = if90id 
     
    116122         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
    117123         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
     124         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN 
     125           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,   & 
     126        &                                               name = iom_file(kiomid)%uldname), clinfo) 
     127         ENDIF 
    118128         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK' 
    119129      ELSE 
     
    174184         iom_file(kiomid)%ndims(kiv)  = i_nvd 
    175185         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids 
    176          DO ji = 1, i_nvd   ! dimensions size 
     186         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
     187         DO ji = 1, i_nvd                       ! dimensions size 
    177188            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    
    178189            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension?  
    179190         END DO 
    180          !---------- Deal with scale_factor and offset 
     191         !---------- Deal with scale_factor and add_offset 
    181192         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr 
    182193         IF( llok) THEN 
     
    185196            iom_file(kiomid)%scf(kiv) = 1. 
    186197         END IF 
    187          llok = NF90_Inquire_attribute(if90id, ivarid, 'offset') == nf90_noerr 
     198         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr 
    188199         IF( llok ) THEN 
    189             CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'offset', iom_file(kiomid)%ofs(kiv)), clinfo) 
     200            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo) 
    190201         ELSE 
    191202            iom_file(kiomid)%ofs(kiv) = 0. 
     
    200211            ENDIF 
    201212         ENDIF 
    202 !!$                  ELSE   
    203 !!$                     CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// & 
    204 !!$                        &                         ' is not found in the file '//trim(iom_file(kiomid)%name) ) 
     213      ELSE   
     214         iom_nf90_varid = -1   !   variable not found, return error code: -1 
    205215      ENDIF 
    206216      ! 
     
    226236 
    227237 
    228    SUBROUTINE iom_nf90_g123d( kiomid, kdom, kvid, knbdim, kstart, kcount,    & 
    229          &                          pv_r1d, pv_r2d, pv_r3d) 
     238   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
     239         &                    pv_r1d, pv_r2d, pv_r3d ) 
    230240      !!----------------------------------------------------------------------- 
    231241      !!                  ***  ROUTINE  iom_nf90_g123d  *** 
     
    236246      !!----------------------------------------------------------------------- 
    237247      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file 
    238       INTEGER                    , INTENT(in   )           ::   kdom      ! Type of domain to be read 
    239248      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable 
    240249      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable 
    241250      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis  
    242251      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis 
     252      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    243253      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
    244254      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
    245255      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
    246256      ! 
    247       CHARACTER(LEN=100) ::   clinfo   ! info character 
    248       INTEGER            ::   if90id   ! nf90 identifier of the opened file 
    249       INTEGER            ::   ivid     ! nf90 variable id 
     257      CHARACTER(LEN=100) ::   clinfo               ! info character 
     258      INTEGER            ::   if90id               ! nf90 identifier of the opened file 
     259      INTEGER            ::   ivid                 ! nf90 variable id 
    250260      !--------------------------------------------------------------------- 
    251261      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    252262      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id 
    253263      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id 
    254       IF( PRESENT(pv_r1d) ) THEN 
    255          CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r1d(:), start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo ) 
     264      ! 
     265      IF(     PRESENT(pv_r1d) ) THEN 
     266         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   & 
     267            &                                                                       count = kcount(1:knbdim)), clinfo ) 
    256268      ELSEIF( PRESENT(pv_r2d) ) THEN 
    257          IF( kdom /= jpdom_unknown ) THEN 
    258             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r2d(nldi:nlei,nldj:nlej),   & 
    259                   &                           start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo) 
    260             !--- Fill the overlap areas and extra hallows (mpp) 
    261             CALL lbc_lnk (pv_r2d,'Z',-999.,'no0') 
    262          ELSE 
    263             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r2d(:,:), start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo) 
    264          ENDIF 
     269         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   & 
     270            &                                                                       count = kcount(1:knbdim)), clinfo ) 
    265271      ELSEIF( PRESENT(pv_r3d) ) THEN 
    266          IF( kdom /= jpdom_unknown ) THEN 
    267             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r3d(nldi:nlei,nldj:nlej,:),   & 
    268                   &                           start=kstart(1:knbdim), count=kcount  (1:knbdim)), clinfo) 
    269             !--- Fill the overlap areas and extra hallows (mpp) 
    270             ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    271             IF( kcount(3) == jpk ) THEN 
    272                CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
    273             ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    274                pv_r3d(nlei+1:jpi,      :   ,:) = 1.             
    275                pv_r3d(      :   ,nlej+1:jpj,:) = 1.             
    276             ENDIF 
    277          ELSE 
    278             CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r3d(:,:,:),   & 
    279                   &                           start=kstart(1:knbdim), count=kcount  (1:knbdim)), clinfo) 
    280          ENDIF 
     272         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   & 
     273            &                                                                       count = kcount(1:knbdim)), clinfo ) 
    281274      ENDIF 
    282275      ! 
     
    284277 
    285278 
    286    SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime ) 
     279   SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar ) 
    287280      !!-------------------------------------------------------------------- 
    288281      !!                   ***  SUBROUTINE iom_gettime  *** 
     
    290283      !! ** Purpose : read the time axis kvid in the file with NF90 
    291284      !!-------------------------------------------------------------------- 
    292       INTEGER               , INTENT(in   ) ::   kiomid   ! file Identifier 
    293       INTEGER               , INTENT(in   ) ::   kvid     ! variable id 
    294       REAL(wp), DIMENSION(:), INTENT(  out) ::   ptime    ! the time axis 
     285      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier 
     286      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id 
     287      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis 
     288      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute 
     289      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute 
    295290      ! 
    296291      CHARACTER(LEN=100) ::   clinfo     ! info character 
     
    299294      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   & 
    300295            &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo) 
     296      IF ( PRESENT(cdunits) ) THEN  
     297         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", & 
     298            &                           values=cdunits), clinfo) 
     299      ENDIF 
     300      IF ( PRESENT(cdcalendar) ) THEN  
     301         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", & 
     302            &                           values=cdcalendar), clinfo) 
     303      ENDIF 
    301304      ! 
    302305   END SUBROUTINE iom_nf90_gettime 
     
    355358         iom_file(kiomid)%cn_var(1:4) = cltmp 
    356359         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /)   
    357          CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo) 
    358          CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo) 
    359          iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
    360          CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo) 
    361          iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
     360         ! trick: defined to 0 to say that dimension variables are defined but not yet written 
     361         iom_file(kiomid)%dimsz(1, 1)  = 0    
    362362         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 
    363363      ENDIF 
     
    433433            ! write dimension variables if it is not already done 
    434434            ! ============= 
     435            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    435436            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    436437               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo) 
     
    443444               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo) 
    444445               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)    
     446               ! update the values of the variables dimensions size 
     447               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo) 
     448               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo) 
     449               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
     450               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo) 
     451               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
    445452               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
    446453            ENDIF 
  • trunk/NEMO/OFF_SRC/IOM/iom_rstdimg.F90

    r719 r975  
    3131      MODULE PROCEDURE iom_rstdimg_rp0d, iom_rstdimg_rp123d 
    3232   END INTERFACE 
     33 
     34   INTEGER, PARAMETER ::   jpvnl          = 32   ! variable name length 
     35       
    3336   !!---------------------------------------------------------------------- 
    3437   !!  OPA 9.0 , LOCEAN-IPSL (2006) 
    35    !! $Header$ 
     38   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/IOM/iom_rstdimg.F90,v 1.9 2007/06/29 14:10:50 opalod Exp $ 
    3639   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3740   !!---------------------------------------------------------------------- 
     
    4548      !! ** Purpose :  open an input file read only (return 0 if not found) 
    4649      !!--------------------------------------------------------------------- 
    47       CHARACTER(len=*)       , INTENT(inout) ::   cdname   ! File name 
    48       INTEGER                , INTENT(  out) ::   kiomid   ! iom identifier of the opened file 
    49       LOGICAL                , INTENT(in   ) ::   ldwrt    ! read or write the file? 
    50       LOGICAL                , INTENT(in   ) ::   ldok     ! check the existence  
    51       INTEGER, DIMENSION(2,5), INTENT(in   ) ::   kdompar  ! domain parameters:  
     50      CHARACTER(len=*)       , INTENT(inout)           ::   cdname   ! File name 
     51      INTEGER                , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file 
     52      LOGICAL                , INTENT(in   )           ::   ldwrt    ! read or write the file? 
     53      LOGICAL                , INTENT(in   )           ::   ldok     ! check the existence  
     54      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar  ! domain parameters:  
    5255 
    5356      CHARACTER(LEN=100)                      ::   clinfo                     ! info character 
     
    5962      INTEGER                                 ::   irecl8                     ! record length 
    6063      INTEGER                                 ::   ios                        ! IO status 
     64      INTEGER                                 ::   irhd                       ! record of the header infos 
    6165      INTEGER                                 ::   ivnum                      ! number of variables 
    6266      INTEGER                                 ::   ishft                      ! counter shift 
     
    6468      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables 
    6569      INTEGER                                 ::   ipni, ipnj, ipnij, iarea   ! domain decomposition  
    66       CHARACTER(LEN=8), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables 
     70      INTEGER                                 ::   iiglo, ijglo               ! domain global size  
     71      INTEGER                                 ::   jl                         ! loop variable 
     72      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables 
    6773      REAL(wp),         DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record 
    6874      !                                                                               ! position for 1/2/3D variables 
    6975      !--------------------------------------------------------------------- 
    70  
    7176      clinfo = '                    iom_rstdimg_open ~~~  ' 
    7277      istop = nstop      ! store the actual value of nstop 
     
    99104         iln = INDEX( cdname, '.dimg' ) 
    100105         IF( ldwrt ) THEN  ! the file should be open in readwrite mode so we create it... 
    101             irecl8= kdompar(1,1) * kdompar(2,1) * wp 
     106            irecl8= MAX( kdompar(1,1) * kdompar(2,1) * wp, ( 8*jpnij + 15 ) * 4 ) 
    102107            IF( jpnij > 1 ) THEN 
    103                WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.dimg' 
     108               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea, '.dimg' 
    104109               cdname = TRIM(cltmp) 
    105110            ENDIF 
     
    108113               &       , RECL = irecl8, STATUS = 'new', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 ) 
    109114         ELSE              ! the file should be open for read mode so it must exist... 
    110             CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' ) 
     115            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    111116         ENDIF 
    112117      ENDIF 
     
    114119      ! ============= 
    115120      IF( ldok ) THEN      ! old file 
    116          READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d 
    117          READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d,   & 
     121         READ( idrst, REC = 1   , IOSTAT = ios, ERR = 987 )              & 
     122              &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   & 
     123              &   ipni, ipnj, ipnij, iarea, iiglo, ijglo 
     124         READ( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                       & 
    118125            &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
    119             &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
    120             &   ipni, ipnj, ipnij, iarea  
     126            &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d) 
    121127         clinfo = TRIM(clinfo)//' file '//TRIM(cdname) 
    122          IF( inx   /= kdompar(1,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in i direction' ) 
    123          IF( iny   /= kdompar(2,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in j direction' ) 
     128         IF( iiglo /= jpiglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in i direction' ) 
     129         IF( ijglo /= jpjglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in j direction' ) 
     130         IF( ldwrt ) THEN 
     131            IF( inx   /= kdompar(1,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in i direction' ) 
     132            IF( iny   /= kdompar(2,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in j direction' ) 
     133         ENDIF 
    124134         IF( inz   /= jpk          )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in k direction' ) 
    125135         IF( ipni  /= jpni         )   CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along I' ) 
     
    131141      ! ============= 
    132142      IF( istop == nstop ) THEN   ! no error within this routine 
    133          kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     143!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1) 
     144         kiomid = 0 
     145         DO jl = jpmax_files, 1, -1 
     146            IF( iom_file(jl)%nfid == 0 )   kiomid = jl 
     147         ENDDO 
    134148         iom_file(kiomid)%name    = TRIM(cdname) 
    135149         iom_file(kiomid)%nfid    = idrst 
     
    209223      INTEGER                                 ::   irecl8                     ! record length 
    210224      INTEGER                                 ::   ios                        ! IO status 
     225      INTEGER                                 ::   irhd                       ! record of the header infos 
    211226      INTEGER                                 ::   ivnum                      ! number of variables 
    212227      INTEGER                                 ::   idrst                      ! file logical unit 
    213228      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable 
    214229      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables 
    215       CHARACTER(LEN=8), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables 
    216       REAL(wp),         DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record 
     230      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d    ! name of 0/1/2/3D variables 
     231      REAL(wp),          DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d    ! value of 0d variables or record 
    217232      !                                                                               ! position for 1/2/3D variables 
    218233      !--------------------------------------------------------------------- 
     
    226241      IF( ios == 0 ) THEN 
    227242         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   ! get back domain size 
     243         irhd = iom_file(kiomid)%irec 
    228244         ivnum = iom_file(kiomid)%nvars 
    229245         in0d = 0   ;   in1d = 0   ;   in2d = 0   ;   in3d = 0 
     
    249265            END SELECT 
    250266         END DO 
    251          ! force to have at least 1 valriable in each list (not necessary (?), but safer) 
     267         ! force to have at least 1 variable in each list (not necessary (?), but safer...) 
    252268         IF( in0d == 0 ) THEN   ;   in0d = 1   ;   clna0d(1) = 'no0d'   ;   zval0d(1) = -1.   ;   ENDIF 
    253269         IF( in1d == 0 ) THEN   ;   in1d = 1   ;   clna1d(1) = 'no1d'   ;   zval1d(1) = -1.   ;   ENDIF 
     
    255271         IF( in3d == 0 ) THEN   ;   in3d = 1   ;   clna3d(1) = 'no3d'   ;   zval3d(1) = -1.   ;   ENDIF 
    256272         ! update the file header before closing it 
    257          WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz, in0d, in1d, in2d, in3d,   & 
    258             &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
    259             &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d),   & 
    260             &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo, nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt 
     273         WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 )              & 
     274            &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   & 
     275            &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo,              & 
     276            &   nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt 
     277         IF( (ivnum * (jpvnl + wp)) > irecl8 ) THEN  
     278            CALL ctl_stop( TRIM(clinfo),   & 
     279                 &   'Last record size is too big... You could reduce the value of jpvnl' ) 
     280         ELSE  
     281            WRITE( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                        & 
     282                 &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   & 
     283                 &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d) 
     284         ENDIF 
    261285      ELSE 
    262286         ios = 0   ! we cannot write in the file 
     
    290314 
    291315 
    292    SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, pv_r0d ) 
     316   SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, kvid, pv_r0d ) 
    293317      !!-------------------------------------------------------------------- 
    294318      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  *** 
     
    298322      INTEGER                   , INTENT(in) ::   kiomid   ! Identifier of the file  
    299323      CHARACTER(len=*)          , INTENT(in) ::   cdvar    ! time axis name 
     324      INTEGER                   , INTENT(in) ::   kvid     ! variable id 
    300325      REAL(wp)                  , INTENT(in) ::   pv_r0d   ! written 0d field 
    301326      ! 
     
    305330      !   
    306331      clinfo = '                    iom_rstdimg_rp0d ~~~  ' 
    307       idvar = iom_file(kiomid)%nvars + 1 
     332      IF( kvid <= 0 ) THEN   !   new variable 
     333         idvar = iom_file(kiomid)%nvars + 1 
     334      ELSE                   !   the variable already exists in the file 
     335         idvar = kvid 
     336      ENDIF 
    308337      IF( idvar <= jpmax_vars ) THEN 
    309338         iom_file(kiomid)%nvars = idvar 
     
    320349 
    321350 
    322    SUBROUTINE iom_rstdimg_g123d( kiomid, kdom  , kvid  , kstart, kcount,    & 
    323          &                          pv_r1d, pv_r2d, pv_r3d ) 
     351   SUBROUTINE iom_rstdimg_g123d( kiomid, kdom  , kvid, kx1, kx2, ky1, ky2,   & 
     352         &                       pv_r1d, pv_r2d, pv_r3d ) 
    324353      !!----------------------------------------------------------------------- 
    325354      !!                  ***  ROUTINE  iom_rstdimg_g123d  *** 
     
    332361      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read 
    333362      INTEGER                    , INTENT(in   )           ::   kvid       ! variable id 
    334       INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart     ! start position of the reading in each axis  
    335       INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount     ! number of points to be read in each axis 
     363      INTEGER ,                    INTENT(inout)           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    336364      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    337365      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
     
    342370      INTEGER            ::   jk                   ! loop counter 
    343371      INTEGER            ::   idrst                ! logical unit of the restart file 
    344       INTEGER            ::   istop                ! temporary storage of nstop 
    345       INTEGER            ::   ix1, ix2, iy1, iy2   ! subdomain indexes 
    346372      !--------------------------------------------------------------------- 
    347373      clinfo = '                    iom_rstdimg_g123d ~~~  ' 
    348374      ! 
    349       istop = nstop                   ! store the actual value of nstop 
    350       idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file 
    351       IF( kdom == jpdom_data .OR. kdom == jpdom_global )   & 
    352             &   CALL ctl_stop( TRIM(clinfo), TRIM(iom_file(kiomid)%cn_var(kvid))//': case not coded for rstdimg files' ) 
    353       ! 
    354       IF( istop == nstop .AND. kvid > 0 ) THEN 
    355          IF( .NOT. PRESENT(pv_r1d) ) THEN 
    356             SELECT CASE (kdom)   ! find the right index of the array to be read 
    357             CASE (jpdom_local_full)      ;   ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej 
    358             CASE (jpdom_local_noextra)   ;   ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj 
    359             CASE (jpdom_local_noovlap)   ;   ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej 
    360             CASE DEFAULT                 ;   CALL ctl_stop( clinfo, 'we should not be there...' ) 
    361             END SELECT 
    362          ENDIF 
     375      IF( kdom == jpdom_data .OR. kdom == jpdom_global ) THEN 
     376         CALL ctl_stop( TRIM(clinfo), TRIM(iom_file(kiomid)%cn_var(kvid))//': case not coded for rstdimg files' ) 
     377      ELSE 
     378      ! 
     379         idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file 
     380         ! modify the subdomain indexes because we cannot directly extract the appropriate subdomaine 
     381         IF(     kdom == jpdom_local_full    ) THEN   ;   kx1 = 1   ;   kx2 = jpi    ;   ky1 = 1 
     382         ELSEIF( kdom == jpdom_local_noextra ) THEN   ;   kx1 = 1   ;   kx2 = nlci   ;   ky1 = 1 
     383         ENDIF 
     384         ! 
    363385         IF(     PRESENT(pv_r1d) ) THEN   ! read 1D variables 
    364             READ( idrst, REC = iom_file(kiomid)%nvid(kvid), IOSTAT = ios, ERR = 987 )   pv_r1d(:) 
     386            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r1d(:) 
    365387         ELSEIF( PRESENT(pv_r2d) ) THEN   ! read 2D variables 
    366             READ( idrst, REC = iom_file(kiomid)%nvid(kvid), IOSTAT = ios, ERR = 987 )   pv_r2d(ix1:ix2, iy1:iy2 ) 
    367             SELECT CASE (kdom) 
    368             CASE (jpdom_local_noextra)   !--- Fill extra hallows (mpp)        
    369                pv_r2d(nlci+1:jpi,      :   ) = 1.     
    370                pv_r2d(      :   ,nlcj+1:jpj) = 1.             
    371             CASE (jpdom_local_noovlap)   !--- Fill the overlap areas and extra hallows (mpp) 
    372                CALL lbc_lnk (pv_r2d,'Z',-999.,'no0') 
    373             CASE DEFAULT 
    374             END SELECT 
     388            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r2d(kx1:kx2, ky1:ky2    ) 
    375389         ELSEIF( PRESENT(pv_r3d) ) THEN   ! read 3D variables 
    376390            DO jk = 1, iom_file(kiomid)%dimsz(3,kvid)   ! do loop on each level 
    377                READ( idrst, REC = iom_file(kiomid)%nvid(kvid) + jk - 1, IOSTAT = ios, ERR = 987 )   & 
    378                      &      pv_r3d( ix1:ix2, iy1:iy2, jk ) 
    379             END DO 
    380             SELECT CASE (kdom) 
    381             CASE (jpdom_local_noextra)   !--- Fill extra hallows (mpp)        
    382                pv_r3d(nlci+1:jpi,      :   ,:) = 1.     
    383                pv_r3d(      :   ,nlcj+1:jpj,:) = 1.             
    384             CASE (jpdom_local_noovlap)   !--- Fill the overlap areas and extra hallows (mpp) 
    385                ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    386                IF( kcount(3) == jpk ) THEN 
    387                   CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 
    388                ELSE 
    389                   pv_r3d(nlei+1:jpi,      :   ,:) = 1.             
    390                   pv_r3d(      :   ,nlej+1:jpj,:) = 1.             
    391                ENDIF 
    392             CASE DEFAULT 
    393             END SELECT 
    394          ENDIF 
    395       ENDIF 
    396 987   CONTINUE 
    397       IF( ios /= 0 ) THEN 
    398          WRITE(ctmp1,*) '           iostat = ', ios 
    399          CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 ) 
     391               READ( idrst, REC = iom_file(kiomid)%nvid(kvid) + jk - 1, IOSTAT = ios, ERR = 987 )   pv_r3d(kx1:kx2, ky1:ky2, jk) 
     392            END DO 
     393         ENDIF 
     394987      CONTINUE 
     395         IF( ios /= 0 ) THEN 
     396            WRITE(ctmp1,*) '           iostat = ', ios 
     397            CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 ) 
     398         ENDIF 
    400399      ENDIF 
    401400      ! 
     
    403402 
    404403 
    405    SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, pv_r1d, pv_r2d, pv_r3d ) 
     404   SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, kvid, pv_r1d, pv_r2d, pv_r3d ) 
    406405      !!-------------------------------------------------------------------- 
    407406      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  *** 
     
    411410      INTEGER                         , INTENT(in)           ::   kiomid   ! Identifier of the file  
    412411      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! time axis name 
     412      INTEGER                         , INTENT(in)           ::   kvid     ! variable id 
    413413      REAL(wp), DIMENSION(        jpk), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
    414414      REAL(wp), DIMENSION(jpi,jpj    ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
     
    431431      irec = iom_file(kiomid)%irec    ! get back the record number of the variable 
    432432      idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file 
    433       idvar = iom_file(kiomid)%nvars + 1 
     433      IF( kvid <= 0 ) THEN   !   new variable 
     434         idvar = iom_file(kiomid)%nvars + 1 
     435      ELSE                   !   the variable already exists in the file 
     436         idvar = kvid 
     437      ENDIF 
    434438      IF( idvar > jpmax_vars )   CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' ) 
    435439      IF( .NOT. PRESENT(pv_r1d) ) THEN 
Note: See TracChangeset for help on using the changeset viewer.