New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
iom.F90 in trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/iom.F90 @ 508

Last change on this file since 508 was 508, checked in by opalod, 18 years ago

nemo_v1_update_071:RB: add iom for restart and reorganization of restart
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 49.2 KB
Line 
1MODULE iom
2   !!=====================================================================
3   !!                    ***  MODULE  iom ***
4   !! Input/Output manager :  Library to read input files
5   !!====================================================================
6   !! History :  9.0  ! 05 12  (J. Belier) Original code
7   !!            9.0  ! 06 02  (S. Masson) Adaptation to NEMO
8   !!--------------------------------------------------------------------
9   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
10
11   !!--------------------------------------------------------------------
12   !!   iom_open       : open a file read only
13   !!   iom_close      : close a file or all files opened by iom
14   !!   iom_get        : read a field (interfaced to several routines)
15   !!   iom_gettime    : read the time axis cdvar in the file               !!gm : never call ??????
16   !!   iom_varid      : get the id of a variable in a file
17   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
18   !!--------------------------------------------------------------------
19   USE in_out_manager  ! I/O manager
20   USE dom_oce         ! ocean space and time domain
21   USE lbclnk          ! lateal boundary condition / mpp exchanges
22   USE ioipsl          ! IOIPSL library
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC iom_open, iom_close, iom_get, iom_varid, iom_rstput, iom_gettime
28
29   INTERFACE iom_get
30      MODULE PROCEDURE iom_get_r_0d, iom_get_r_1d, iom_get_r_2d, iom_get_r_3d
31   END INTERFACE
32   INTERFACE iom_rstput
33      MODULE PROCEDURE iom_rstput_0d, iom_rstput_1d, iom_rstput_2d, iom_rstput_3d
34   END INTERFACE
35
36   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpidta, 1  :jpjdta)
37   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo)
38   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases
39   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   )
40   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  )
41   INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  )
42   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking
43
44   INTEGER, PARAMETER ::   jpmax_vars   = 60,   &  ! maximum number of variables in one file
45      &                    jpmax_dims   =  4,   &  ! maximum number of dimensions for one variable
46      &                    jpmax_digits =  5       ! maximum number of digits for the cpu number in the file name
47!$AGRIF_DO_NOT_TREAT
48   INTEGER ::   iom_init = 0
49   TYPE    ::   flio_file
50      CHARACTER(LEN=240)                        ::   name     ! name of the file
51      INTEGER                                   ::   iopen    ! 1(0) if the file is open(not open)
52      INTEGER                                   ::   nvars    ! number of identified varibles in the file
53      INTEGER                                   ::   iduld    ! id of the unlimited dimension
54      CHARACTER(LEN=16), DIMENSION(jpmax_vars)  ::   cn_var   ! names of the variables
55      INTEGER, DIMENSION(jpmax_vars)            ::   ndims    ! number of dimensions of the variables
56      LOGICAL, DIMENSION(jpmax_vars)            ::   luld     ! variable using the unlimited dimension
57      INTEGER, DIMENSION(jpmax_dims,jpmax_vars) ::   dimsz    ! size of variables dimensions
58      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      ! scale_factor of the variables
59      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      ! add_offset of the variables
60   END TYPE flio_file
61   TYPE(flio_file), DIMENSION(flio_max_files)   ::   iom_file ! array containing the info for all opened files
62!$AGRIF_END_DO_NOT_TREAT
63
64   !!----------------------------------------------------------------------
65   !!  OPA 9.0 , LOCEAN-IPSL (2006)
66   !! $Header$
67   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
68   !!----------------------------------------------------------------------
69
70CONTAINS
71
72   SUBROUTINE iom_open( cdname, knumfl, ldwrt, kdom, ldimg )
73      !!---------------------------------------------------------------------
74      !!                   ***  SUBROUTINE  iom_open  ***
75      !!
76      !! ** Purpose :  open an input file read only (return 0 if not found)
77      !!---------------------------------------------------------------------
78      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
79      INTEGER         , INTENT(  out)           ::   knumfl   ! Identifier of the opened file
80      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! read or write the file?
81      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written
82      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldimg    ! use dimg format?
83
84      CHARACTER(LEN=100)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
85      CHARACTER(LEN=100)    ::   cltmpn    ! tempory name to store clname (in writting mode)
86      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg"
87      CHARACTER(LEN=10)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
88      LOGICAL               ::   llok      ! check the existence
89      LOGICAL               ::   llwrt     !
90      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
91      INTEGER               ::   iln, ils  ! lengths of character
92      INTEGER               ::   idom      ! type of domain
93      INTEGER               ::   ifliodom  ! model domain identifier (see flio_dom_set)
94      INTEGER, DIMENSION(2) ::   iszl      ! local number of points for x,y dimensions
95      INTEGER, DIMENSION(2) ::   ifst      ! position of first local point for x,y dimensions
96      INTEGER, DIMENSION(2) ::   ilst      ! position of last local point for x,y dimensions
97      INTEGER, DIMENSION(2) ::   ihst      ! start halo size for x,y dimensions
98      INTEGER, DIMENSION(2) ::   ihnd      ! end halo size for x,y dimensions
99      !---------------------------------------------------------------------
100      ! if iom_open is called for the first time: initialize iom_file(:)%iopen to 0
101      ! (could be done when defining iom_file in f95 but not in f90)
102      IF( iom_init == 0 ) THEN
103         iom_file(:)%iopen = 0
104         iom_init = 1
105      ENDIF
106      ! do we read or write the file?
107      ! =============
108      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
109      ELSE                        ;   llwrt = .FALSE.
110      ENDIF
111      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
112      ! =============
113      clname   = trim(cdname)
114#if defined key_agrif
115      if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
116#endif   
117      ! which suffix should we use?
118      clsuffix = ".nc"
119      IF( PRESENT(ldimg) ) THEN   ;   IF( ldimg )   clsuffix = ".dimg"   ;   ENDIF
120      ! Add the suffix if needed
121      iln = LEN_TRIM(clname)
122      ils = LEN_TRIM(clsuffix)
123      IF( iln <= ils) clname = clname(1:iln)//TRIM(clsuffix)
124      IF( clname(iln-ils+1:iln) /= TRIM(clsuffix) )   clname = clname(1:iln)//TRIM(clsuffix)
125      cltmpn = clname   ! store this name
126      ! try to find if the file to be opened already exist
127      INQUIRE( FILE = clname, EXIST = llok )
128      IF( .NOT.llok ) THEN
129         ! we try to add the cpu number to the name
130         WRITE(clcpu,*) narea-1
131         clcpu  = TRIM(ADJUSTL(clcpu))
132         iln = INDEX(clname,TRIM(clsuffix))
133         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
134         icnt = 0
135         INQUIRE( FILE = clname, EXIST = llok ) 
136         ! we try different formats for the cpu number by adding 0
137         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
138            clcpu  = "0"//trim(clcpu)
139            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
140            INQUIRE( FILE = clname, EXIST = llok )
141            icnt = icnt + 1
142         END DO
143      ENDIF
144      !
145      IF( llok ) THEN      ! Open the file
146         !                 ! =============
147         IF( llwrt ) THEN
148            IF(lwp) WRITE(numout,*) '          iom_open ~~~  open existing file: '//TRIM(clname)//' in WRITE mode'
149            CALL flioopfd( TRIM(clname), knumfl, "WRITE" )
150         ELSE
151            IF(lwp) WRITE(numout,*) '          iom_open ~~~  open existing file: '//TRIM(clname)//' in READ mode'
152            CALL flioopfd( TRIM(clname), knumfl )
153         ENDIF
154      ELSE                 ! no way to find the file...
155         !                 ! =======================
156         IF( llwrt ) THEN 
157            ! file opened in write mode
158            ! the file does not exist, we must create it...
159            ! =============
160            llok = .TRUE.
161            ! on which domain must the file be written??
162            ! check the domain definition
163            idom = jpdom_local_noovlap   ! default definition
164            IF( PRESENT(kdom) )   idom = kdom
165            ! create the domain informations
166            ! =============
167            SELECT CASE (idom)
168            CASE (jpdom_local_full)
169               iszl = (/ jpi             , jpj              /)
170               ifst = (/ nimpp           , njmpp            /)
171               ilst = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
172               ihst = (/ nldi - 1        , nldj - 1         /)
173               ihnd = (/ jpi - nlei      , jpj - nlej       /)
174            CASE (jpdom_local_noextra)
175               iszl = (/ nlci            , nlcj             /)
176               ifst = (/ nimpp           , njmpp            /)
177               ilst = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
178               ihst = (/ nldi - 1        , nldj - 1         /)
179               ihnd = (/ nlci - nlei     , nlcj - nlej      /)
180            CASE (jpdom_local_noovlap)
181               iszl = (/ nlei - nldi + 1 , nlej - nldj + 1  /)
182               ifst = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
183               ilst = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
184               ihst = (/ 0               , 0                /)
185               ihnd = (/ 0               , 0                /)
186            CASE DEFAULT
187               llok = .FALSE.
188               CALL ctl_stop( 'iom_open: wrong value of kdom, only jpdom_local* cases are accepted' )
189            END SELECT
190            IF( llok ) THEN
191               CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/)   &
192                    &                  , iszl, ifst, ilst, ihst, ihnd, 'BOX', ifliodom )       
193               ! create the file
194               ! =============
195               ! Note that fliocrfd may change the value of clname (add the cpu number...)
196               clname = cltmpn   ! get back the file name without the cpu number in it
197               IF(lwp) WRITE(numout,*) '          iom_open ~~~  create new file: '//trim(clname)//' in WRITE mode'
198               CALL fliocrfd( clname, (/'x'    , 'y'    , 'z', 't'/)   &
199                    &               , (/iszl(1), iszl(2), jpk, -1 /)   &
200                    &               , knumfl, ifliodom )
201            ENDIF
202         ELSE
203            ! the file is open for read-only, it must exist...
204            iln = INDEX( cltmpn,TRIM(clsuffix) )
205            CALL ctl_stop( 'iom_open: file '//cltmpn(1:iln-1)//'* not found' )
206         ENDIF
207      ENDIF
208      ! start to fill the information of opened files
209      ! =============
210      IF( llok ) THEN                         
211         iom_file(knumfl)%iopen      = 1
212         iom_file(knumfl)%name       = TRIM(clname)
213         iom_file(knumfl)%nvars      = 0
214         iom_file(knumfl)%ndims(:)   = 0
215         iom_file(knumfl)%luld(:)    = .FALSE.
216         iom_file(knumfl)%dimsz(:,:) = 0
217         ! does the file contain time axis (that must be unlimitted) ?
218         CALL flioinqf( knumfl, id_uld = iom_file(knumfl)%iduld )
219         IF(lwp) WRITE(numout,*) '                   ---> OK'
220      ELSE
221         knumfl = 0      ! return error flag
222      ENDIF
223      !
224   END SUBROUTINE iom_open
225
226
227   SUBROUTINE iom_close( knumfl )
228      !!--------------------------------------------------------------------
229      !!                   ***  SUBROUTINE  iom_close  ***
230      !!
231      !! ** Purpose : close an input file, or all files opened by iom
232      !!--------------------------------------------------------------------
233      INTEGER, INTENT(in), OPTIONAL ::   knumfl   ! Identifier of the file to be closed
234      !                                           ! No argument : all the files opened by iom are closed
235
236      INTEGER ::   jf         ! dummy loop indices
237      INTEGER ::   i_s, i_e   ! temporary integer
238      !---------------------------------------------------------------------
239      !
240      IF( PRESENT(knumfl) ) THEN
241         i_s = knumfl
242         i_e = knumfl
243      ELSE
244         i_s = 1
245         i_e = flio_max_files
246      ENDIF
247     
248      IF( i_s > 0 ) THEN
249         DO jf = i_s, i_e
250            IF( iom_file(jf)%iopen > 0 ) THEN
251               CALL flioclo( jf )
252               IF(lwp) WRITE(numout,*) '          iom_close, close file: '//TRIM(iom_file(knumfl)%name)//' ok'
253               iom_file(jf)%iopen      = 0
254               iom_file(jf)%name       = 'NONE'
255               iom_file(jf)%nvars      = 0
256               iom_file(jf)%iduld      = 0
257               iom_file(jf)%ndims(:)   = 0
258               iom_file(jf)%luld(:)    = .FALSE.
259               iom_file(jf)%dimsz(:,:) = 0
260            ELSEIF( PRESENT(knumfl) ) THEN
261               WRITE(ctmp1,*) '--->',  knumfl
262               CALL ctl_stop( 'iom_close: Invalid file identifier', ctmp1 )
263            ENDIF
264         END DO
265      ENDIF
266      !   
267   END SUBROUTINE iom_close
268 
269
270   !!----------------------------------------------------------------------
271   !!                   INTERFACE iom_get_123d
272   !!----------------------------------------------------------------------
273   SUBROUTINE iom_get_r_0d( knumfl, cdvar, pvar )
274      INTEGER         , INTENT(in   )                 ::   knumfl    ! Identifier of the file
275      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
276      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
277      !
278      IF( knumfl > 0 .AND. iom_varid( knumfl, cdvar ) > 0 )   CALL fliogetv( knumfl, cdvar, pvar )
279   END SUBROUTINE iom_get_r_0d
280
281   SUBROUTINE iom_get_r_1d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount )
282      INTEGER         , INTENT(in   )                         ::   knumfl    ! Identifier of the file
283      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
284      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
285      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
286      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
287      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading
288      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
289      !
290      IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom       , cdvar        , pv_r1d=pvar,   &
291         &                                        ktime=ktime, kstart=kstart, kcount=kcount )
292   END SUBROUTINE iom_get_r_1d
293
294   SUBROUTINE iom_get_r_2d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount )
295      INTEGER         , INTENT(in   )                           ::   knumfl    ! Identifier of the file
296      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
297      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
298      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
299      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
300      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading
301      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
302      !
303      IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom       , cdvar        , pv_r2d=pvar,   &
304         &                                        ktime=ktime, kstart=kstart, kcount=kcount )
305   END SUBROUTINE iom_get_r_2d
306
307   SUBROUTINE iom_get_r_3d( knumfl, kdom, cdvar, pvar, ktime, kstart, kcount )
308      INTEGER         , INTENT(in   )                             ::   knumfl    ! Identifier of the file
309      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
310      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
311      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
312      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
313      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading
314      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
315      !
316      IF( knumfl > 0 ) CALL iom_get_123d( knumfl, kdom       , cdvar        , pv_r3d=pvar,   &
317         &                                        ktime=ktime, kstart=kstart, kcount=kcount )
318   END SUBROUTINE iom_get_r_3d
319   !!----------------------------------------------------------------------
320
321   SUBROUTINE iom_get_123d( knumfl, kdom  , cdvar ,   &
322        &                   pv_r1d, pv_r2d, pv_r3d,   &
323        &                   ktime , kstart, kcount  )
324     !!-----------------------------------------------------------------------
325     !!                  ***  ROUTINE  iom_get_123d  ***
326     !!
327     !! ** Purpose : read a 1D/2D/3D variable
328     !!
329     !! ** Method : read ONE record at each CALL
330     !!-----------------------------------------------------------------------
331     INTEGER                    , INTENT(in   )           ::   knumfl     ! Identifier of the file
332     INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
333     CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
334     REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
335     REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
336     REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
337     INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
338     INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis
339     INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
340     !
341     INTEGER                        ::   jl          ! loop on number of dimension
342     INTEGER                        ::   idom,    &  ! type of domain
343          &                              idvar,   &  ! id of the variable
344          &                              inbdim,  &  ! number of dimensions of the variable
345          &                              idmspc,  &  ! number of spatial dimensions
346          &                              itime,   &  ! record number
347          &                              istop       ! temporary value of nstop
348     INTEGER, DIMENSION(jpmax_dims) ::   istart,  &  ! starting point to read for each axis
349          &                              icnt,    &  ! number of value to read along each axis
350          &                              idimsz      ! size of the dimensions of the variable
351     REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
352     INTEGER                        ::   itmp        ! temporary integer
353     CHARACTER(LEN=100)             ::   clinfo      ! info character
354     !---------------------------------------------------------------------
355     !
356     clinfo = '          iom_get_123d, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar)
357     ! local definition of the domain ?
358     idom = kdom
359     ! check kcount and kstart optionals parameters...
360     IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) )   &
361          CALL ctl_stop( trim(clinfo), 'kcount present needs kstart present' )
362     IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) )   &
363          CALL ctl_stop( trim(clinfo), 'kstart present needs kcount present' )
364     IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   )   &
365          CALL ctl_stop( trim(clinfo), 'kstart present needs kdom = jpdom_unknown' )
366
367     ! Search for the variable in the data base (eventually actualize data)
368     istop = nstop
369     idvar = iom_varid( knumfl, cdvar )
370     !
371     IF( idvar > 0 ) THEN
372        ! to write iom_file(knumfl)%dimsz in a shorter way !
373        idimsz(:) = iom_file(knumfl)%dimsz(:, idvar) 
374        inbdim = iom_file(knumfl)%ndims(idvar)            ! number of dimensions in the file
375        idmspc = inbdim                                   ! number of spatial dimensions in the file
376        IF( iom_file(knumfl)%luld(idvar) )   idmspc = inbdim - 1
377        IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo),   &
378           &                    'the file has more than 3 spatial dimensions this case is not coded...' ) 
379        IF( idom == jpdom_local ) THEN        ! Identify the domain in case of jpdom_local definition
380           IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN
381              idom = jpdom_local_full
382           ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN
383              idom = jpdom_local_noextra
384           ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
385              idom = jpdom_local_noovlap
386           ELSE
387              CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
388           ENDIF
389        ENDIF
390        !
391        ! definition of istart and icnt
392        !
393        ! initializations
394        istart(:) = 1
395        icnt  (:) = 1
396        itime = 1
397        IF( PRESENT(ktime) ) itime = ktime
398        !
399        IF( PRESENT(pv_r1d) ) THEN
400           IF( idmspc == 1 ) THEN 
401              ! data is 1d array (+ maybe a temporal dimension)
402              IF( PRESENT(kstart) ) THEN
403                 istart(1:2) = (/ kstart(1), itime /)
404                 icnt(1) = kcount(1)
405              ELSE
406                 IF( kdom == jpdom_unknown ) THEN
407                    istart(2) = itime
408                    icnt(1) = idimsz(1)
409                 ELSE
410                    CALL ctl_stop( trim(clinfo), 'case not coded...You must use jpdom_unknown' )
411                 ENDIF
412              ENDIF
413           ELSE
414              CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 1D array,', &
415                   &         'we do not accept data with more than 1 spatial dimension',     &
416                   &         'Use ncwa -a to suppress the unnecessary dimensions')
417           ENDIF
418        ELSEIF( PRESENT(pv_r2d) ) THEN
419           SELECT CASE (idmspc)
420           CASE (1)
421              CALL ctl_stop( trim(clinfo), 'the file has only 1 spatial dimension',  &
422                   &         'it is impossible to read a 2d array from this file...')
423           CASE (2)
424              ! data is 2d array (+ maybe a temporal dimension)
425              IF( PRESENT(kstart) ) THEN
426                 istart(1:3) = (/ kstart(1:2), itime /)
427                 icnt(1:2) = kcount(1:2)
428              ELSE
429                 IF( kdom == jpdom_unknown ) THEN
430                    istart(3) = itime
431                    icnt(1:2) = idimsz(1:2)
432                 ELSE
433                    IF( idom == jpdom_data ) THEN
434                       istart(1:3) = (/ mig(1), mjg(1), itime /)
435                    ELSEIF( idom == jpdom_global ) THEN
436                       istart(1:3) = (/ nimpp, njmpp, itime /)
437                    ENDIF
438                    ! we do not read the overlap -> we start to read at nldi, nldj
439                    IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
440                    ! we do not read the overlap and the extra-halos 
441                    ! -> from nldi to nlei and from nldj to nlej
442                    icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
443                 ENDIF
444              ENDIF
445           CASE DEFAULT
446              IF( itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
447                 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...',                &
448                      &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
449                      &         'we accept this case even if there is a possible mix-up between z and time dimension' )           
450                 IF( PRESENT(kstart) ) THEN
451                    istart(1:2) = kstart(1:2)
452                    icnt(1:2) = kcount(1:2)
453                 ELSE
454                    IF( kdom == jpdom_unknown ) THEN
455                       icnt(1:2) = idimsz(1:2)
456                    ELSE
457                       IF( idom == jpdom_data ) THEN
458                          istart(1:2) = (/ mig(1), mjg(1) /)
459                       ELSEIF( idom == jpdom_global ) THEN
460                          istart(1:2) = (/ nimpp, njmpp /)
461                       ENDIF
462                       ! we do not read the overlap -> we start to read at nldi, nldj
463                       IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
464                       ! we do not read the overlap and the extra-halos 
465                       ! -> from nldi to nlei and from nldj to nlej
466                       icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
467                    ENDIF
468                 ENDIF
469              ELSE
470                 CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 2D array,',           &
471                      &                       'we do not accept data with more than 2 spatial dimension',   &
472                      &                       'Use ncwa -a to suppress the unnecessary dimensions' )
473              ENDIF
474           END SELECT
475        ELSEIF( PRESENT(pv_r3d) ) THEN
476           SELECT CASE (idmspc)
477           CASE( 1 )
478              CALL ctl_stop( trim(clinfo), 'the file has only 1 spatial dimension',            &
479                   &                       'it is impossible to read a 3d array from this file...' )
480           CASE( 2 )
481              CALL ctl_stop( trim(clinfo), 'the file has only 2 spatial dimension',            &
482                   &                       'it is impossible to read a 3d array from this file...' )
483           CASE( 3 )
484              ! data is 3d array (+ maybe a temporal dimension)
485              IF( PRESENT(kstart) ) THEN
486                 istart(1:4) = (/ kstart(1:3), itime /)
487                 icnt(1:3) = kcount(1:3)
488              ELSE
489                 IF( kdom == jpdom_unknown ) THEN
490                    istart(4) = itime
491                    icnt(1:3) = idimsz(1:3)
492                 ELSE
493                    IF( idom == jpdom_data ) THEN
494                       istart(1:4) = (/ mig(1), mjg(1), 1, itime /)
495                    ELSEIF( idom == jpdom_global ) THEN
496                       istart(1:4) = (/ nimpp, njmpp, 1, itime /)
497                    ENDIF
498                    ! we do not read the overlap -> we start to read at nldi, nldj
499                    IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
500                    ! we do not read the overlap and the extra-halos
501                    ! -> from nldi to nlei and from nldj to nlej
502                    icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
503                    IF( idom == jpdom_data ) THEN
504                       icnt(3) = jpkdta
505                    ELSE
506                       icnt(3) = jpk
507                    ENDIF
508                 ENDIF
509              ENDIF
510           CASE DEFAULT
511              CALL ctl_stop( trim(clinfo), 'to keep iom lisibility, when reading a 3D array,',   &
512                   &         'we do not accept data with more than 3 spatial dimension',         &
513                   &         'Use ncwa -a to suppress the unnecessary dimensions' )           
514           END SELECT
515        ENDIF
516
517        ! check that istart and icnt can be used with this file
518        !-
519        DO jl = 1, jpmax_dims
520           itmp = istart(jl)+icnt(jl)-1
521           IF( (itmp) > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
522              WRITE(ctmp1,*) '(istart(',jl,') + icnt(',jl,') - 1) = ', itmp
523              WRITE(ctmp2,*) ' is larger than idimsz(',jl,'): ', idimsz(jl)
524              CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
525           ENDIF
526        END DO
527
528        ! check that istart and icnt match the input array
529        !-     
530        IF( PRESENT(pv_r1d) ) THEN
531           itmp = size(pv_r1d)
532           WRITE(ctmp1,*) 'size(pv_r1d): ', itmp, ' /= icnt(1): ', icnt(1)
533           IF( itmp /= icnt(1) )   CALL ctl_stop( trim(clinfo), ctmp1 )
534        ELSEIF( PRESENT(pv_r2d) ) THEN
535           DO jl = 1, 2
536              IF( idom == jpdom_unknown ) THEN
537                 itmp = size(pv_r2d, jl)
538                 WRITE(ctmp1,*) 'size(pv_r2d, ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl)
539              ELSE
540                 itmp = size(pv_r2d(nldi:nlei,nldj:nlej), jl)
541                 WRITE(ctmp1,*) 'size(pv_r2d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl)
542              ENDIF
543              IF( itmp /= icnt(jl) )   CALL ctl_stop( trim(clinfo), ctmp1 )
544           END DO
545        ELSEIF( PRESENT(pv_r3d) ) THEN
546           DO jl = 1, 3
547              IF( idom == jpdom_unknown ) THEN
548                 itmp = size(pv_r3d, jl)
549                 WRITE(ctmp1,*) 'size(pv_r3d, ',jl,'): ',itmp,' /= icnt(',jl,'):', icnt(jl)
550              ELSE
551                 itmp = size(pv_r3d(nldi:nlei,nldj:nlej,:), jl)
552                 WRITE(ctmp1,*) 'size(pv_r3d(nldi:nlei,nldj:nlej), ',jl,'): ',itmp,' /= icnt(',jl,'): ',icnt(jl)
553              ENDIF
554              IF( itmp /= icnt(jl) )   CALL ctl_stop( trim(clinfo), ctmp1 )
555           END DO
556        ENDIF
557     ENDIF
558
559     ! read the data
560     !-     
561     IF( istop == nstop) THEN ! no additional errors until this point...
562        !
563        zscf = iom_file(knumfl)%scf(idvar)      ! scale factor
564        zofs = iom_file(knumfl)%ofs(idvar)      ! offset
565        !
566        IF( PRESENT(pv_r1d) ) THEN
567           CALL fliogetv( knumfl, cdvar, pv_r1d(:), start=istart(1:inbdim), count=icnt(1:inbdim) )
568           !--- Apply scale_factor and offset
569           IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
570           IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
571        ELSEIF( PRESENT(pv_r2d) ) THEN
572           IF( idom /= jpdom_unknown ) THEN
573              CALL fliogetv( knumfl, cdvar, pv_r2d(nldi:nlei,nldj:nlej), start=istart(1:inbdim), count=icnt(1:inbdim) )
574              !--- Apply scale_factor and offset
575!CDIR NOUNROLL
576              IF( zscf /= 1.)   pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) * zscf
577!CDIR NOUNROLL
578              IF( zofs /= 0.)   pv_r2d(nldi:nlei, nldj:nlej) = pv_r2d(nldi:nlei,nldj:nlej) + zofs
579              !--- Fill the overlap areas and extra hallows (mpp)
580              CALL lbc_lnk (pv_r2d,'Z',-999.,'no0')
581           ELSE
582              CALL fliogetv( knumfl, cdvar, pv_r2d(:,:), start=istart(1:inbdim), count=icnt(1:inbdim) )
583              !--- Apply scale_factor and offset
584!CDIR COLLAPSE
585              IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
586!CDIR COLLAPSE
587              IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
588           ENDIF
589        ELSEIF( PRESENT(pv_r3d) ) THEN
590           IF( idom /= jpdom_unknown ) THEN
591              CALL fliogetv( knumfl, cdvar, pv_r3d(nldi:nlei,nldj:nlej,:), start=istart(1:inbdim),   &
592                 &                                                         count=icnt  (1:inbdim) )
593              !--- Apply scale_factor and offset
594!CDIR NOUNROLL
595              IF( zscf /= 1. )   pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) * zscf
596!CDIR NOUNROLL
597              IF( zofs /= 0. )   pv_r3d(nldi:nlei,nldj:nlej,:) = pv_r3d(nldi:nlei,nldj:nlej,:) + zofs
598              !--- Fill the overlap areas and extra hallows (mpp)
599              IF( icnt(3) == jpk )   CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) ! this if could be removed with the new lbc_lnk ...
600           ELSE
601              CALL fliogetv( knumfl, cdvar, pv_r3d(:,:,:), start=istart(1:inbdim), count=icnt(1:inbdim) )
602              !--- Apply scale_factor and offset
603!CDIR COLLAPSE
604              IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
605!CDIR COLLAPSE
606              IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
607           ENDIF
608        ENDIF
609        !
610        IF( istop == nstop .AND. lwp )   &
611           WRITE(numout,*) '           read '//trim(cdvar)//' in '//trim(iom_file(knumfl)%name)//' ok'
612     ENDIF
613     !
614   END SUBROUTINE iom_get_123d
615
616   
617   SUBROUTINE iom_gettime( knumfl, cdvar, ptime )
618      !!--------------------------------------------------------------------
619      !!                   ***  SUBROUTINE iom_gettime  ***
620      !!
621      !! ** Purpose : read the time axis cdvar in the file
622      !!--------------------------------------------------------------------
623      INTEGER               , INTENT(in   ) ::   knumfl   ! file Identifier
624      CHARACTER(len=*)      , INTENT(in   ) ::   cdvar    ! time axis name
625      REAL(wp), DIMENSION(:), INTENT(  out) ::   ptime    ! the time axis
626      !
627      INTEGER            ::   idvar    ! id of the variable
628      CHARACTER(LEN=100) ::   clinfo   ! info character
629      !---------------------------------------------------------------------
630      !
631      clinfo = 'iom_gettime, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar)
632      idvar = iom_varid( knumfl, cdvar )
633      !
634      ptime(:) = 0. ! default definition
635      IF( idvar > 0 ) THEN
636         IF( iom_file(knumfl)%ndims(idvar) == 1 ) THEN
637            IF( iom_file(knumfl)%luld(idvar) ) THEN
638               IF( iom_file(knumfl)%dimsz(1,idvar) == size(ptime) ) THEN
639                  CALL fliogetv( knumfl, cdvar, ptime(:), start=(/ 1 /),   &
640                     &                                    count=(/ iom_file(knumfl)%dimsz(1,idvar) /) )
641               ELSE
642                  WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(knumfl)%dimsz(1,idvar)
643                  CALL ctl_stop( trim(clinfo), trim(ctmp1) )
644               ENDIF
645            ELSE
646               CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
647            ENDIF
648         ELSE
649            CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
650         ENDIF
651      ELSE
652         CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(knumfl)%name )
653      ENDIF
654      !
655   END SUBROUTINE iom_gettime
656   
657   
658   FUNCTION iom_varid ( knumfl, cdvar, kdimsz ) 
659      !!-----------------------------------------------------------------------
660      !!                  ***  FUNCTION  iom_varid  ***
661      !!
662      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
663      !!-----------------------------------------------------------------------
664      INTEGER              , INTENT(in   )           ::   knumfl   ! file Identifier
665      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
666      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
667      !
668      INTEGER                        ::   ji                       ! dummy loop index
669      INTEGER                        ::   iom_varid, idvar, i_nvd
670      INTEGER, DIMENSION(jpmax_dims) ::   idimid
671      LOGICAL                        ::   ll_fnd
672      CHARACTER(LEN=100)             ::   clinfo                   ! info character
673      !!-----------------------------------------------------------------------
674      clinfo = 'iom_varid, file: '//trim(iom_file(knumfl)%name)//', var: '//trim(cdvar)
675      iom_varid = 0                         ! default definition
676      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
677      !
678      IF( knumfl > 0 ) THEN
679         IF( iom_file(knumfl)%iopen == 0 ) THEN
680            CALL ctl_stop( trim(clinfo), 'the file is not open' )
681         ELSE
682            ll_fnd  = .FALSE.
683            idvar = 0
684            !
685            DO WHILE ( .NOT.ll_fnd .AND. idvar < iom_file(knumfl)%nvars )
686               idvar = idvar + 1
687               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(knumfl)%cn_var(idvar)) )
688            END DO
689            !
690            IF( .NOT.ll_fnd ) THEN
691               idvar = idvar + 1
692               IF( idvar <= jpmax_vars ) THEN
693                  CALL flioinqv( knumfl, cdvar, ll_fnd, nb_dims = i_nvd )
694                  IF( ll_fnd ) THEN
695                     IF( i_nvd <= jpmax_dims ) THEN
696                        iom_file(knumfl)%nvars           = idvar
697                        iom_file(knumfl)%cn_var(idvar) = trim(cdvar)
698                        iom_file(knumfl)%ndims(idvar)  = i_nvd
699                        CALL flioinqv( knumfl, cdvar, ll_fnd,   &
700                           &           len_dims = iom_file(knumfl)%dimsz(1:i_nvd,idvar), &
701                           &           id_dims  = idimid(1:i_nvd) )
702                        DO ji = 1, i_nvd
703                           IF( idimid(ji) == iom_file(knumfl)%iduld ) iom_file(knumfl)%luld(idvar) = .TRUE.
704                        END DO
705                        !----------
706                        !---------- Deal with scale_factor and offset
707                        CALL flioinqa( knumfl, cdvar, 'scale_factor', ll_fnd )
708                        IF( ll_fnd) THEN
709                           CALL fliogeta( knumfl, cdvar, 'scale_factor', iom_file(knumfl)%scf(idvar) )
710                        ELSE
711                           iom_file(knumfl)%scf(idvar) = 1.
712                        END IF
713                        CALL flioinqa( knumfl, cdvar, 'offset', ll_fnd )
714                        IF( ll_fnd ) THEN
715                           CALL fliogeta( knumfl, cdvar, 'offset', iom_file(knumfl)%ofs(idvar) )
716                        ELSE
717                           iom_file(knumfl)%ofs(idvar) = 0.
718                        END IF
719                        !
720                        iom_varid = idvar
721                        IF( PRESENT(kdimsz) ) THEN
722                           IF( i_nvd == size(kdimsz) ) THEN
723                              kdimsz(:) = iom_file(knumfl)%dimsz(1:i_nvd,idvar)
724                           ELSE
725                              WRITE(ctmp1,*) i_nvd, size(kdimsz)
726                              CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
727                           ENDIF
728                        ENDIF
729                     ELSE
730                        CALL ctl_stop( trim(clinfo), 'Too many dimensions in the file '//iom_file(knumfl)%name,   &
731                           &                        'increase the parameter jpmax_vars')
732                     ENDIF
733!!$                  ELSE 
734!!$                     CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// &
735!!$                        &                         ' is not found in the file '//trim(iom_file(knumfl)%name) )
736                  ENDIF
737               ELSE
738                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(knumfl)%name,   &
739                     &                         'increase the parameter jpmax_vars')
740               ENDIF
741            ELSE
742               iom_varid = idvar
743               IF( PRESENT(kdimsz) ) THEN
744                  i_nvd = iom_file(knumfl)%ndims(idvar)
745                  IF( i_nvd == size(kdimsz) ) THEN
746                     kdimsz(:) = iom_file(knumfl)%dimsz(1:i_nvd,idvar)
747                  ELSE
748                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
749                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
750                  ENDIF
751               ENDIF
752            ENDIF
753         ENDIF
754      ENDIF
755      !
756   END FUNCTION iom_varid
757
758   !!----------------------------------------------------------------------
759   !!                   INTERFACE iom_rstput
760   !!----------------------------------------------------------------------
761   SUBROUTINE iom_rstput_0d( kt, kwrite, knumfl, cdvar, pvar )
762      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
763      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
764      INTEGER         , INTENT(in)                         ::   knumfl   ! Identifier of the file
765      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
766      REAL(wp)        , INTENT(in)                         ::   pvar     ! read field
767      IF( knumfl > 0 )   CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r0d = pvar )
768   END SUBROUTINE iom_rstput_0d
769
770   SUBROUTINE iom_rstput_1d( kt, kwrite, knumfl, cdvar, pvar )
771      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
772      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
773      INTEGER         , INTENT(in)                         ::   knumfl   ! Identifier of the file
774      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
775      REAL(wp)        , INTENT(in), DIMENSION(        jpk) ::   pvar     ! read field
776      IF( knumfl > 0 )    CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r1d = pvar )
777   END SUBROUTINE iom_rstput_1d
778
779   SUBROUTINE iom_rstput_2d( kt, kwrite, knumfl, cdvar, pvar )
780      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
781      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
782      INTEGER         , INTENT(in)                         ::   knumfl   ! Identifier of the file
783      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
784      REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj    ) ::   pvar     ! read field
785      IF( knumfl > 0 )   CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r2d = pvar )
786   END SUBROUTINE iom_rstput_2d
787
788   SUBROUTINE iom_rstput_3d( kt, kwrite, knumfl, cdvar, pvar )
789      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
790      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
791      INTEGER         , INTENT(in)                         ::   knumfl   ! Identifier of the file
792      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
793      REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvar     ! read field
794      IF( knumfl > 0 )   CALL iom_rstput_0123d( kt, kwrite, knumfl, cdvar, pv_r3d = pvar )
795   END SUBROUTINE iom_rstput_3d
796   !!----------------------------------------------------------------------
797
798   SUBROUTINE iom_rstput_0123d( kt, kwrite, knumfl, cdvar ,   &
799      &                             pv_r0d, pv_r1d, pv_r2d, pv_r3d )
800      !!--------------------------------------------------------------------
801      !!                   ***  SUBROUTINE  iom_rstput  ***
802      !!
803      !! ** Purpose : read the time axis cdvar in the file
804      !!--------------------------------------------------------------------
805      INTEGER                   , INTENT(in)           ::   kt       ! ocean time-step
806      INTEGER                   , INTENT(in)           ::   kwrite   ! writing time-step
807      INTEGER                   , INTENT(in)           ::   knumfl   ! Identifier of the file
808      CHARACTER(len=*)          , INTENT(in)           ::   cdvar    ! time axis name
809      REAL(wp)                  , INTENT(in), OPTIONAL ::   pv_r0d   ! read field
810      REAL(wp), DIMENSION(:)    , INTENT(in), OPTIONAL ::   pv_r1d   ! read field
811      REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   pv_r2d   ! read field
812      REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   pv_r3d   ! read field
813      !
814      INTEGER               :: idims, idvar       
815      INTEGER               :: ix1, ix2, iy1, iy2       
816      INTEGER, DIMENSION(4) :: idimsz, idimid     
817      CHARACTER(LEN=100)    :: clinfo        ! info character
818      !---------------------------------------------------------------------
819      !
820      clinfo = '          iom_rstput_0123d, file: '//TRIM(iom_file(knumfl)%name)//', var: '//TRIM(cdvar)
821
822      ! define dimension variables if it is not already done
823      ! ==========================
824      IF( iom_file(knumfl)%nvars == 0 ) THEN
825         ! define the dimension variables if it is not already done
826         CALL fliodefv( knumfl,'nav_lon', (/1,2/), v_t=flio_r4   , axis='X',   &
827            &                  long_name="Longitude", units="degrees_east" )
828         CALL fliodefv( knumfl,'nav_lat', (/1,2/), v_t=flio_r4   , axis='Y',   &
829            &                  long_name="Latitude", units="degrees_north" )
830         CALL fliodefv( knumfl,'nav_lev', (/3/)  , v_t=flio_i4   , axis='Z',   &
831            &                  long_name="Model levels",units="model_levels")
832         CALL fliodefv( knumfl,'time_counter', (/4/), v_t=flio_r4, axis='T',   &
833            &                  long_name="Time axis", units='seconds since 0001-01-01 00:00:00' )
834         ! update informations structure related the dimension variable we just added...
835         iom_file(knumfl)%nvars       = 4
836         iom_file(knumfl)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
837         iom_file(knumfl)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /)
838         iom_file(knumfl)%cn_var(4)   = 'time_counter'
839         iom_file(knumfl)%ndims(1:4)  = (/ 2, 2, 1, 1 /) 
840         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
841      ENDIF
842
843      ! define the data if it is not already done
844      ! ===============
845      idvar = iom_varid( knumfl, cdvar )
846      IF( idvar <= 0 ) THEN
847         ! variable definition
848         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
849         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/)
850         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
851         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
852         ENDIF
853         IF( PRESENT(pv_r0d) ) THEN   ;   CALL fliodefv (knumfl, cdvar                 , v_t = flio_r8)
854         ELSE                         ;   CALL fliodefv (knumfl, cdvar, idimid(1:idims), v_t = flio_r8)
855         ENDIF
856         ! update informations structure related the new variable we want to add...
857         idvar                          = iom_file(knumfl)%nvars + 1
858         iom_file(knumfl)%nvars         = idvar
859         iom_file(knumfl)%cn_var(idvar) = TRIM(cdvar)
860         iom_file(knumfl)%scf(idvar)    = 1.
861         iom_file(knumfl)%ofs(idvar)    = 0.
862         iom_file(knumfl)%ndims(idvar)  = idims
863         IF( .NOT. PRESENT(pv_r0d) ) THEN
864            iom_file(knumfl)%luld(idvar) = .TRUE.
865            CALL flioinqf( knumfl, ln_dim = idimsz )
866            iom_file(knumfl)%dimsz(1:idims-1,idvar) = idimsz(idimid(1:idims-1))
867         ENDIF
868         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
869      ENDIF
870
871      ! time step kwrite : write the variable
872      IF( kt == kwrite ) THEN
873         ! on what kind of domain must the data be written?
874         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
875            idimsz(1:2) = iom_file(knumfl)%dimsz(1:2,idvar)
876            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
877               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
878            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
879               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
880            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
881               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
882            ELSE
883               CALL ctl_stop( 'iom_rstput_0123d: should have been an impossible case...' )
884            ENDIF
885
886            ! write dimension variables if it is not already done
887            ! =============
888            IF( iom_file(knumfl)%dimsz(1, 1) == 0 ) THEN
889               CALL flioputv( knumfl, 'nav_lon'     , glamt(ix1:ix2, iy1:iy2) )
890               CALL flioputv( knumfl, 'nav_lat'     , gphit(ix1:ix2, iy1:iy2) )
891               CALL flioputv( knumfl, 'nav_lev'     , gdept_0 )
892               CALL flioputv( knumfl, 'time_counter', kt )   ! +++ WRONG VALUE: to be improved but not really useful...
893               ! update informations structure related the dimension variable
894               iom_file(knumfl)%dimsz(1:2, 1) = idimsz(1:2)
895               iom_file(knumfl)%dimsz(1:2, 2) = idimsz(1:2)
896               iom_file(knumfl)%dimsz(1, 3:4) = (/idimsz(3), 1/)
897               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
898            ENDIF
899         ENDIF
900
901         ! write the data
902         ! =============
903         IF(     PRESENT(pv_r0d) ) THEN   ;   CALL flioputv( knumfl, cdvar, pv_r0d                      )
904         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   CALL flioputv( knumfl, cdvar, pv_r1d(                  :) )
905         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   CALL flioputv( knumfl, cdvar, pv_r2d(ix1:ix2, iy1:iy2   ) )
906         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   CALL flioputv( knumfl, cdvar, pv_r3d(ix1:ix2, iy1:iy2, :) )
907         ENDIF
908         ! add 1 to the size of the temporal dimension (not really useful...)
909         IF( iom_file(knumfl)%luld(idvar) )   iom_file(knumfl)%dimsz(iom_file(knumfl)%ndims(idvar), idvar)    &
910            &                               = iom_file(knumfl)%dimsz(iom_file(knumfl)%ndims(idvar), idvar) + 1
911         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
912      ENDIF
913      !     
914   END SUBROUTINE iom_rstput_0123d
915   
916   !!======================================================================
917END MODULE iom
Note: See TracBrowser for help on using the repository browser.