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

Context Navigation

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

Last change on this file since 1341 was 1341, checked in by ctlod, 15 years ago
add the initialization of kiomid variable to -1, see ticket: #370
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 45.3 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: