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/IOM – NEMO

source: trunk/NEMO/OPA_SRC/IOM/iom.F90 @ 1200

Last change on this file since 1200 was 1200, checked in by rblod, 16 years ago

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 44.9 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   !!             "   ! 07 07  (D. Storkey) Changes to iom_gettime
9   !!--------------------------------------------------------------------
10   !!gm  caution add !DIR nec: improved performance to be checked as well as no result changes
11
12   !!--------------------------------------------------------------------
13   !!   iom_open       : open a file read only
14   !!   iom_close      : close a file or all files opened by iom
15   !!   iom_get        : read a field (interfaced to several routines)
16   !!   iom_gettime    : read the time axis cdvar in the file
17   !!   iom_varid      : get the id of a variable in a file
18   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
19   !!--------------------------------------------------------------------
20   USE in_out_manager  ! I/O manager
21   USE dom_oce         ! ocean space and time domain
22   USE lbclnk          ! lateal boundary condition / mpp exchanges
23   USE iom_def         ! iom variables definitions
24   USE iom_ioipsl      ! NetCDF format with IOIPSL library
25   USE iom_nf90        ! NetCDF format with native NetCDF library
26   USE iom_rstdimg     ! restarts access direct format "dimg" style...
27
28   IMPLICIT NONE
29   PUBLIC   !   must be public to be able to access iom_def through iom
30   
31   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
35
36   INTERFACE iom_get
37      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
38   END INTERFACE
39   INTERFACE iom_rstput
40      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
41   END INTERFACE
42
43   !!----------------------------------------------------------------------
44   !!  OPA 9.0 , LOCEAN-IPSL (2006)
45   !! $Id$
46   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
47   !!----------------------------------------------------------------------
48
49CONTAINS
50
51   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop )
52      !!---------------------------------------------------------------------
53      !!                   ***  SUBROUTINE  iom_open  ***
54      !!
55      !! ** Purpose :  open an input file (return 0 if not found)
56      !!---------------------------------------------------------------------
57      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
58      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
59      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
60      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
61      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.)
63
64      CHARACTER(LEN=100)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
65      CHARACTER(LEN=100)    ::   cltmpn    ! tempory name to store clname (in writting mode)
66      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg"
67      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
68      CHARACTER(LEN=100)    ::   clinfo    ! info character
69      LOGICAL               ::   llok      ! check the existence
70      LOGICAL               ::   llwrt     ! local definition of ldwrt
71      LOGICAL               ::   llnoov    ! local definition to read overlap
72      LOGICAL               ::   llstop    ! local definition of ldstop
73      INTEGER               ::   iolib     ! library do we use to open the file
74      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
75      INTEGER               ::   iln, ils  ! lengths of character
76      INTEGER               ::   idom      ! type of domain
77      INTEGER               ::   istop     !
78      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters:
79      ! local number of points for x,y dimensions
80      ! position of first local point for x,y dimensions
81      ! position of last local point for x,y dimensions
82      ! start halo size for x,y dimensions
83      ! end halo size for x,y dimensions
84      !---------------------------------------------------------------------
85      ! Initializations and control
86      ! =============
87      clinfo = '                    iom_open ~~~  '
88      istop = nstop
89      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
90      ! (could be done when defining iom_file in f95 but not in f90)
91      IF( iom_init == 0 ) THEN
92         iom_file(:)%nfid = 0
93         iom_init = 1
94      ENDIF
95      ! do we read or write the file?
96      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
97      ELSE                        ;   llwrt = .FALSE.
98      ENDIF
99      ! do we call ctl_stop if we try to open a non-existing file in read mode?
100      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
101      ELSE                         ;   llstop = .TRUE.
102      ENDIF
103      ! what library do we use to open the file?
104      IF( PRESENT(kiolib) ) THEN   ;   iolib = kiolib
105      ELSE                         ;   iolib = jpnf90
106      ENDIF
107      ! do we read the overlap
108      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
109      llnoov = (jpni * jpnj ) == jpni .AND. .NOT. lk_agrif 
110      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
111      ! =============
112      clname   = trim(cdname)
113#if defined key_agrif
114      IF ( .NOT. Agrif_Root() ) THEN
115         iln    = INDEX(clname,'/') 
116         cltmpn = clname(1:iln)
117         clname = clname(iln+1:LEN_TRIM(clname))
118         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
119      ENDIF
120#endif   
121      ! which suffix should we use?
122      SELECT CASE (iolib)
123      CASE (jpioipsl ) ;   clsuffix = '.nc'
124      CASE (jpnf90   ) ;   clsuffix = '.nc'
125      CASE (jprstdimg) ;   clsuffix = '.dimg'
126      CASE DEFAULT     ;   clsuffix = ''
127         CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
128      END SELECT
129      ! Add the suffix if needed
130      iln = LEN_TRIM(clname)
131      ils = LEN_TRIM(clsuffix)
132      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
133         &   clname = TRIM(clname)//TRIM(clsuffix)
134      cltmpn = clname   ! store this name
135      ! try to find if the file to be opened already exist
136      ! =============
137      INQUIRE( FILE = clname, EXIST = llok )
138      IF( .NOT.llok ) THEN
139         ! we try to add the cpu number to the name
140         IF( iolib == jprstdimg ) THEN   ;   WRITE(clcpu,*) narea
141         ELSE                            ;   WRITE(clcpu,*) narea-1
142         ENDIF
143         clcpu  = TRIM(ADJUSTL(clcpu))
144         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
145         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
146         icnt = 0
147         INQUIRE( FILE = clname, EXIST = llok ) 
148         ! we try different formats for the cpu number by adding 0
149         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
150            clcpu  = "0"//trim(clcpu)
151            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
152            INQUIRE( FILE = clname, EXIST = llok )
153            icnt = icnt + 1
154         END DO
155      ENDIF
156      IF( llwrt ) THEN
157         ! check the domain definition
158! JMM + SM: ugly patch before getting the new version of lib_mpp)
159!         idom = jpdom_local_noovlap   ! default definition
160         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
161         ELSE                ;   idom = jpdom_local_full      ! default definition
162         ENDIF
163         IF( PRESENT(kdom) )   idom = kdom
164         ! create the domain informations
165         ! =============
166         SELECT CASE (idom)
167         CASE (jpdom_local_full)
168            idompar(:,1) = (/ jpi             , jpj              /)
169            idompar(:,2) = (/ nimpp           , njmpp            /)
170            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
171            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
172            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /)
173         CASE (jpdom_local_noextra)
174            idompar(:,1) = (/ nlci            , nlcj             /)
175            idompar(:,2) = (/ nimpp           , njmpp            /)
176            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
177            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
178            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /)
179         CASE (jpdom_local_noovlap)
180            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /)
181            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
182            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
183            idompar(:,4) = (/ 0               , 0                /)
184            idompar(:,5) = (/ 0               , 0                /)
185         CASE DEFAULT
186            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
187         END SELECT
188      ENDIF
189      ! Open the NetCDF or RSTDIMG file
190      ! =============
191      ! do we have some free file identifier?
192      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
193         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
194      ! if no file was found...
195      IF( .NOT. llok ) THEN
196         IF( .NOT. llwrt ) THEN   ! we are in read mode
197            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
198            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
199            ENDIF
200         ELSE                     ! we are in write mode so we
201            clname = cltmpn       ! get back the file name without the cpu number
202         ENDIF
203      ENDIF
204      IF( istop == nstop ) THEN   ! no error within this routine
205         SELECT CASE (iolib)
206         CASE (jpioipsl )   ;   CALL iom_ioipsl_open(  clname, kiomid, llwrt, llok, idompar )
207         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
208         CASE (jprstdimg)   ;   CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
209         CASE DEFAULT
210            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
211         END SELECT
212      ENDIF
213      !
214   END SUBROUTINE iom_open
215
216
217   SUBROUTINE iom_close( kiomid )
218      !!--------------------------------------------------------------------
219      !!                   ***  SUBROUTINE  iom_close  ***
220      !!
221      !! ** Purpose : close an input file, or all files opened by iom
222      !!--------------------------------------------------------------------
223      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
224      !                                              ! return 0 when file is properly closed
225      !                                              ! No argument: all files opened by iom are closed
226
227      INTEGER ::   jf         ! dummy loop indices
228      INTEGER ::   i_s, i_e   ! temporary integer
229      CHARACTER(LEN=100)    ::   clinfo    ! info character
230      !---------------------------------------------------------------------
231      !
232      clinfo = '                    iom_close ~~~  '
233      IF( PRESENT(kiomid) ) THEN
234         i_s = kiomid
235         i_e = kiomid
236      ELSE
237         i_s = 1
238         i_e = jpmax_files
239      ENDIF
240
241      IF( i_s > 0 ) THEN
242         DO jf = i_s, i_e
243            IF( iom_file(jf)%nfid > 0 ) THEN
244               SELECT CASE (iom_file(jf)%iolib)
245               CASE (jpioipsl )   ;   CALL iom_ioipsl_close(  jf )
246               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
247               CASE (jprstdimg)   ;   CALL iom_rstdimg_close( jf )
248               CASE DEFAULT
249                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
250               END SELECT
251               iom_file(jf)%nfid       = 0          ! free the id
252               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
253               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
254            ELSEIF( PRESENT(kiomid) ) THEN
255               WRITE(ctmp1,*) '--->',  kiomid
256               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
257            ENDIF
258         END DO
259      ENDIF
260      !   
261   END SUBROUTINE iom_close
262
263
264   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop ) 
265      !!-----------------------------------------------------------------------
266      !!                  ***  FUNCTION  iom_varid  ***
267      !!
268      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
269      !!-----------------------------------------------------------------------
270      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
271      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
272      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
273      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
274      !
275      INTEGER                        ::   iom_varid, iiv, i_nvd
276      LOGICAL                        ::   ll_fnd
277      CHARACTER(LEN=100)             ::   clinfo                   ! info character
278      LOGICAL                        ::   llstop                   ! local definition of ldstop
279      !!-----------------------------------------------------------------------
280      iom_varid = 0                         ! default definition
281      ! do we call ctl_stop if we look for non-existing variable?
282      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
283      ELSE                         ;   llstop = .TRUE.
284      ENDIF
285      !
286      IF( kiomid > 0 ) THEN
287         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
288         IF( iom_file(kiomid)%nfid == 0 ) THEN
289            CALL ctl_stop( trim(clinfo), 'the file is not open' )
290         ELSE
291            ll_fnd  = .FALSE.
292            iiv = 0
293            !
294            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
295               iiv = iiv + 1
296               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
297            END DO
298            !
299            IF( .NOT.ll_fnd ) THEN
300               iiv = iiv + 1
301               IF( iiv <= jpmax_vars ) THEN
302                  SELECT CASE (iom_file(kiomid)%iolib)
303                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
304                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz )
305                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file
306                  CASE DEFAULT   
307                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
308                  END SELECT
309               ELSE
310                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
311                        &                         'increase the parameter jpmax_vars')
312               ENDIF
313               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
314            ELSE
315               iom_varid = iiv
316               IF( PRESENT(kdimsz) ) THEN
317                  i_nvd = iom_file(kiomid)%ndims(iiv)
318                  IF( i_nvd == size(kdimsz) ) THEN
319                     kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
320                  ELSE
321                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
322                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
323                  ENDIF
324               ENDIF
325            ENDIF
326         ENDIF
327      ENDIF
328      !
329   END FUNCTION iom_varid
330
331
332   !!----------------------------------------------------------------------
333   !!                   INTERFACE iom_get
334   !!----------------------------------------------------------------------
335   SUBROUTINE iom_g0d( kiomid, cdvar, pvar )
336      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
337      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
338      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
339      !
340      INTEGER               :: idvar   ! variable id
341      !
342      IF( kiomid > 0 ) THEN
343         idvar = iom_varid( kiomid, cdvar )
344         IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
345            SELECT CASE (iom_file(kiomid)%iolib)
346            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar )
347            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar )
348            CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar )
349            CASE DEFAULT   
350               CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
351            END SELECT
352         ENDIF
353      ENDIF
354   END SUBROUTINE iom_g0d
355
356   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
357      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
358      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
359      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
360      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
361      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
362      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading
363      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
364      !
365      IF( kiomid > 0 ) THEN
366         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
367              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
368      ENDIF
369   END SUBROUTINE iom_g1d
370
371   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
372      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
373      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
374      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
375      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
376      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
377      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading
378      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
379      !
380      IF( kiomid > 0 ) THEN
381         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
382              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
383      ENDIF
384   END SUBROUTINE iom_g2d
385
386   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
387      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
388      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
389      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
390      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
391      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
392      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading
393      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
394      !
395      IF( kiomid > 0 ) THEN
396         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
397              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
398      ENDIF
399   END SUBROUTINE iom_g3d
400   !!----------------------------------------------------------------------
401
402   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
403         &                  pv_r1d, pv_r2d, pv_r3d,   &
404         &                  ktime , kstart, kcount  )
405      !!-----------------------------------------------------------------------
406      !!                  ***  ROUTINE  iom_get_123d  ***
407      !!
408      !! ** Purpose : read a 1D/2D/3D variable
409      !!
410      !! ** Method : read ONE record at each CALL
411      !!-----------------------------------------------------------------------
412      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
413      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
414      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
415      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
416      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
417      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
418      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
419      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis
420      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
421      !
422      LOGICAL                        ::   llnoov      ! local definition to read overlap
423      INTEGER                        ::   jl          ! loop on number of dimension
424      INTEGER                        ::   idom        ! type of domain
425      INTEGER                        ::   idvar       ! id of the variable
426      INTEGER                        ::   inbdim      ! number of dimensions of the variable
427      INTEGER                        ::   idmspc      ! number of spatial dimensions
428      INTEGER                        ::   itime       ! record number
429      INTEGER                        ::   istop       ! temporary value of nstop
430      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
431      INTEGER                        ::   ji, jj      ! loop counters
432      INTEGER                        ::   irankpv       !
433      INTEGER                        ::   ind1, ind2  ! substring index
434      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
435      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis
436      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
437      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
438      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
439      INTEGER                        ::   itmp        ! temporary integer
440      CHARACTER(LEN=100)             ::   clinfo      ! info character
441      CHARACTER(LEN=100)             ::   clname      ! file name
442      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !
443      !---------------------------------------------------------------------
444      !
445      clname = iom_file(kiomid)%name   !   esier to read
446      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
447      ! local definition of the domain ?
448      idom = kdom
449      ! do we read the overlap
450      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
451      llnoov = (jpni * jpnj ) == jpni .AND. .NOT. lk_agrif 
452      ! check kcount and kstart optionals parameters...
453      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
454      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
455      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
456
457      ! Search for the variable in the data base (eventually actualize data)
458      istop = nstop
459      idvar = iom_varid( kiomid, cdvar )
460      !
461      IF( idvar > 0 ) THEN
462         ! to write iom_file(kiomid)%dimsz in a shorter way !
463         idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
464         inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
465         idmspc = inbdim                                   ! number of spatial dimensions in the file
466         IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
467         IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
468         !
469         ! update idom definition...
470         ! Identify the domain in case of jpdom_auto(glo/dta) definition
471         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN           
472            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
473            ELSE                               ;   idom = jpdom_data
474            ENDIF
475            ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
476            ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
477            IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
478         ENDIF
479         ! Identify the domain in case of jpdom_local definition
480         IF( idom == jpdom_local ) THEN
481            IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
482            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
483            ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
484            ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
485            ENDIF
486         ENDIF
487         !
488         ! check the consistency between input array and data rank in the file
489         !
490         ! initializations
491         itime = 1
492         IF( PRESENT(ktime) ) itime = ktime
493
494         irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
495         WRITE(clrankpv, fmt='(i1)') irankpv
496         WRITE(cldmspc , fmt='(i1)') idmspc
497         !
498         IF(     idmspc <  irankpv ) THEN
499            CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
500               &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
501         ELSEIF( idmspc == irankpv ) THEN
502            IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
503               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
504         ELSEIF( idmspc >  irankpv ) THEN
505               IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
506                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
507                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
508                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
509                  idmspc = idmspc - 1
510               ELSE
511                  CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
512                     &                         'we do not accept data with more than '//cldmspc//' spatial dimension',   &
513                     &                         'Use ncwa -a to suppress the unnecessary dimensions' )
514               ENDIF
515         ENDIF
516
517         !
518         ! definition of istart and icnt
519         !
520         icnt  (:) = 1
521         istart(:) = 1
522         istart(idmspc+1) = itime
523
524         IF(              PRESENT(kstart)       ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
525         ELSE
526            IF(           idom == jpdom_unknown ) THEN                                       ; icnt(1:idmspc) = idimsz(1:idmspc)
527            ELSE
528               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
529                  IF(     idom == jpdom_data    ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /)  ! icnt(1:2) done bellow
530                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done bellow
531                  ENDIF
532                  ! we do not read the overlap                     -> we start to read at nldi, nldj
533! JMM + SM: ugly patch before getting the new version of lib_mpp)
534!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
535                  IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
536                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej
537! JMM + SM: ugly patch before getting the new version of lib_mpp)
538!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
539                  IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
540                  ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
541                  ENDIF
542                  IF( PRESENT(pv_r3d) ) THEN
543                     IF( idom == jpdom_data ) THEN   ; icnt(3) = jpkdta
544                     ELSE                            ; icnt(3) = jpk
545                     ENDIF
546                  ENDIF
547               ENDIF
548            ENDIF
549         ENDIF
550
551         ! check that istart and icnt can be used with this file
552         !-
553         DO jl = 1, jpmax_dims
554            itmp = istart(jl)+icnt(jl)-1
555            IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
556               WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
557               WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
558               CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
559            ENDIF
560         END DO
561
562         ! check that icnt matches the input array
563         !-     
564         IF( idom == jpdom_unknown ) THEN
565            IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
566            IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
567            IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
568            ctmp1 = 'd'
569         ELSE
570            IF( irankpv == 2 ) THEN
571! JMM + SM: ugly patch before getting the new version of lib_mpp)
572!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
573               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
574               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
575               ENDIF
576            ENDIF
577            IF( irankpv == 3 ) THEN 
578! JMM + SM: ugly patch before getting the new version of lib_mpp)
579!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
580               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
581               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
582               ENDIF
583            ENDIF
584         ENDIF
585         
586         DO jl = 1, irankpv
587            WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
588            IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
589         END DO
590
591      ENDIF
592
593      ! read the data
594      !-     
595      IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
596         !
597         ! find the right index of the array to be read
598! JMM + SM: ugly patch before getting the new version of lib_mpp)
599!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
600!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
601!         ENDIF
602         IF( llnoov ) THEN
603            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
604            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
605            ENDIF
606         ELSE
607            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
608            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
609            ENDIF
610         ENDIF
611     
612         SELECT CASE (iom_file(kiomid)%iolib)
613         CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
614            &                                         pv_r1d, pv_r2d, pv_r3d )
615         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
616            &                                         pv_r1d, pv_r2d, pv_r3d )
617         CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2,   &
618            &                                         pv_r1d, pv_r2d, pv_r3d )
619         CASE DEFAULT   
620            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
621         END SELECT
622
623         IF( istop == nstop ) THEN   ! no additional errors until this point...
624            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
625         
626            !--- overlap areas and extra hallows (mpp)
627            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
628               CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
629            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
630               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
631               IF( icnt(3) == jpk ) THEN
632                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
633               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
634                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
635                  DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
636               ENDIF
637            ENDIF
638           
639            !--- Apply scale_factor and offset
640            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
641            zofs = iom_file(kiomid)%ofs(idvar)      ! offset
642            IF(     PRESENT(pv_r1d) ) THEN
643               IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
644               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
645            ELSEIF( PRESENT(pv_r2d) ) THEN
646               !CDIR COLLAPSE
647               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
648               !CDIR COLLAPSE
649               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
650            ELSEIF( PRESENT(pv_r3d) ) THEN
651               !CDIR COLLAPSE
652               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
653               !CDIR COLLAPSE
654               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
655            ENDIF
656            !
657         ENDIF
658         !
659      ENDIF
660      !
661   END SUBROUTINE iom_get_123d
662
663
664   SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
665      !!--------------------------------------------------------------------
666      !!                   ***  SUBROUTINE iom_gettime  ***
667      !!
668      !! ** Purpose : read the time axis cdvar in the file
669      !!--------------------------------------------------------------------
670      INTEGER                    , INTENT(in   ) ::   kiomid     ! file Identifier
671      REAL(wp), DIMENSION(:)     , INTENT(  out) ::   ptime      ! the time axis
672      CHARACTER(len=*), OPTIONAL , INTENT(in   ) ::   cdvar      ! time axis name
673      INTEGER         , OPTIONAL , INTENT(  out) ::   kntime     ! number of times in file
674      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdunits    ! units attribute of time coordinate
675      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdcalendar ! calendar attribute of
676      !
677      INTEGER, DIMENSION(1) :: kdimsz
678      INTEGER            ::   idvar    ! id of the variable
679      CHARACTER(LEN=32)  ::   tname    ! local name of time coordinate
680      CHARACTER(LEN=100) ::   clinfo   ! info character
681      !---------------------------------------------------------------------
682      !
683      IF ( PRESENT(cdvar) ) THEN
684         tname = cdvar
685      ELSE
686         tname = iom_file(kiomid)%uldname
687      ENDIF
688      IF( kiomid > 0 ) THEN
689         clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
690         IF ( PRESENT(kntime) ) THEN
691            idvar  = iom_varid( kiomid, tname, kdimsz = kdimsz )
692            kntime = kdimsz(1)
693         ELSE
694            idvar = iom_varid( kiomid, tname )
695         ENDIF
696         !
697         ptime(:) = 0. ! default definition
698         IF( idvar > 0 ) THEN
699            IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
700               IF( iom_file(kiomid)%luld(idvar) ) THEN
701                  IF( iom_file(kiomid)%dimsz(1,idvar) == size(ptime) ) THEN
702                     SELECT CASE (iom_file(kiomid)%iolib)
703                     CASE (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
704                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
705                     CASE (jprstdimg)   ;   CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
706                     CASE DEFAULT   
707                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
708                     END SELECT
709                  ELSE
710                     WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
711                     CALL ctl_stop( trim(clinfo), trim(ctmp1) )
712                  ENDIF
713               ELSE
714                  CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
715               ENDIF
716            ELSE
717               CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
718            ENDIF
719         ELSE
720            CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
721         ENDIF
722      ENDIF
723      !
724   END SUBROUTINE iom_gettime
725
726
727   !!----------------------------------------------------------------------
728   !!                   INTERFACE iom_rstput
729   !!----------------------------------------------------------------------
730   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
731      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
732      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
733      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
734      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
735      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
736      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
737      INTEGER :: ivid   ! variable id
738      IF( kiomid > 0 ) THEN
739         IF( iom_file(kiomid)%nfid > 0 ) THEN
740            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
741            SELECT CASE (iom_file(kiomid)%iolib)
742            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
743            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
744            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
745            CASE DEFAULT     
746               CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
747            END SELECT
748         ENDIF
749      ENDIF
750   END SUBROUTINE iom_rp0d
751
752   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
753      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
754      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
755      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
756      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
757      REAL(wp)        , INTENT(in), DIMENSION(        jpk) ::   pvar     ! written field
758      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
759      INTEGER :: ivid   ! variable id
760      IF( kiomid > 0 ) THEN
761         IF( iom_file(kiomid)%nfid > 0 ) THEN
762            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
763            SELECT CASE (iom_file(kiomid)%iolib)
764            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
765            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
766            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
767            CASE DEFAULT     
768               CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
769            END SELECT
770         ENDIF
771      ENDIF
772   END SUBROUTINE iom_rp1d
773
774   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
775      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
776      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
777      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
778      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
779      REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj    ) ::   pvar     ! written field
780      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
781      INTEGER :: ivid   ! variable id
782      IF( kiomid > 0 ) THEN
783         IF( iom_file(kiomid)%nfid > 0 ) THEN
784            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
785            SELECT CASE (iom_file(kiomid)%iolib)
786            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
787            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
788            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 
789            CASE DEFAULT     
790               CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
791            END SELECT
792         ENDIF
793      ENDIF
794   END SUBROUTINE iom_rp2d
795
796   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
797      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
798      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
799      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
800      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
801      REAL(wp)        , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pvar     ! written field
802      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
803      INTEGER :: ivid   ! variable id
804      IF( kiomid > 0 ) THEN
805         IF( iom_file(kiomid)%nfid > 0 ) THEN
806            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
807            SELECT CASE (iom_file(kiomid)%iolib)
808            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
809            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
810            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
811            CASE DEFAULT     
812               CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
813            END SELECT
814         ENDIF
815      ENDIF
816   END SUBROUTINE iom_rp3d
817   !!----------------------------------------------------------------------
818
819
820   !!======================================================================
821END MODULE iom
Note: See TracBrowser for help on using the repository browser.