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

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

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

Download in other formats: