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 @ 552

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

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

Download in other formats: