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_nf90.F90 in trunk/NEMO/OFF_SRC/IOM – NEMO

Context Navigation

source: trunk/NEMO/OFF_SRC/IOM/iom_nf90.F90 @ 719

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago
get back to the nemo_v2_3 version for trunk
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 27.9 KB

Line
1	MODULE iom_nf90
2	!!=====================================================================
3	!! * MODULE iom_nf90 *
4	!! Input/Output manager : Library to read input files with NF90 (only fliocom module)
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 kvid 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 lbclnk ! lateal boundary condition / mpp exchanges
22	USE iom_def ! iom variables definitions
23	USE netcdf ! NetCDF library
24
25	IMPLICIT NONE
26	PRIVATE
27
28	PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput
29
30	INTERFACE iom_nf90_get
31	MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
32	END INTERFACE
33	INTERFACE iom_nf90_rstput
34	MODULE PROCEDURE iom_nf90_rp0123d
35	END INTERFACE
36	!!----------------------------------------------------------------------
37	!! OPA 9.0 , LOCEAN-IPSL (2006)
38	!! $Header$
39	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
40	!!----------------------------------------------------------------------
41
42	CONTAINS
43
44	SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )
45	!!---------------------------------------------------------------------
46	!! * SUBROUTINE iom_open *
47	!!
48	!! ** Purpose : open an input file with NF90
49	!!---------------------------------------------------------------------
50	CHARACTER(len=*) , INTENT(inout) :: cdname ! File name
51	INTEGER , INTENT( out) :: kiomid ! nf90 identifier of the opened file
52	LOGICAL , INTENT(in ) :: ldwrt ! read or write the file?
53	LOGICAL , INTENT(in ) :: ldok ! check the existence
54	INTEGER, DIMENSION(2,5), INTENT(in ) :: kdompar ! domain parameters:
55
56	CHARACTER(LEN=100) :: clinfo ! info character
57	CHARACTER(LEN=100) :: cltmp ! temporary character
58	INTEGER :: iln ! lengths of character
59	INTEGER :: istop ! temporary storage of nstop
60	INTEGER :: if90id ! nf90 identifier of the opened file
61	INTEGER :: idmy ! dummy variable
62	!---------------------------------------------------------------------
63
64	clinfo = ' iom_nf90_open ~~~ '
65	istop = nstop ! store the actual value of nstop
66	!
67	IF( ldok ) THEN ! Open existing file...
68	! ! =============
69	IF( ldwrt ) THEN ! ... in write mode
70	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
71	CALL iom_nf90_check(NF90_OPEN(TRIM(cdname), NF90_WRITE , if90id), clinfo)
72	CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo)
73	ELSE ! ... in read mode
74	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
75	CALL iom_nf90_check(NF90_OPEN(TRIM(cdname), NF90_NOWRITE, if90id), clinfo)
76	ENDIF
77	ELSE ! the file does not exist
78	! ! =============
79	iln = INDEX( cdname, '.nc' )
80	IF( ldwrt ) THEN ! the file should be open in write mode so we create it...
81	IF( jpnij > 1 ) THEN
82	WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
83	cdname = TRIM(cltmp)
84	ENDIF
85	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
86	CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), NF90_NOCLOBBER, if90id ), clinfo)
87	CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo)
88	! define dimensions
89	CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1) , idmy ), clinfo)
90	CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1) , idmy ), clinfo)
91	CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk , idmy ), clinfo)
92	CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo)
93	! global attributes
94	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo)
95	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number' , narea-1 ), clinfo)
96	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1 , 2 /) ), clinfo)
97	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global' , (/jpiglo, jpjglo/) ), clinfo)
98	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local' , kdompar(:,1) ), clinfo)
99	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2) ), clinfo)
100	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last' , kdompar(:,3) ), clinfo)
101	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4) ), clinfo)
102	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end' , kdompar(:,5) ), clinfo)
103	CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo)
104	ELSE ! the file should be open for read mode so it must exist...
105	CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' )
106	ENDIF
107	ENDIF
108	! start to fill file informations
109	! =============
110	IF( istop == nstop ) THEN ! no error within this routine
111	kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
112	iom_file(kiomid)%name = TRIM(cdname)
113	iom_file(kiomid)%nfid = if90id
114	iom_file(kiomid)%iolib = jpnf90
115	iom_file(kiomid)%nvars = 0
116	iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode
117	CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
118	IF(lwp) WRITE(numout,*) ' ---> '//TRIM(cdname)//' OK'
119	ELSE
120	kiomid = 0 ! return error flag
121	ENDIF
122	!
123	END SUBROUTINE iom_nf90_open
124
125
126	SUBROUTINE iom_nf90_close( kiomid )
127	!!--------------------------------------------------------------------
128	!! * SUBROUTINE iom_nf90_close *
129	!!
130	!! ** Purpose : close an input file with NF90
131	!!--------------------------------------------------------------------
132	INTEGER, INTENT(in) :: kiomid ! iom identifier of the file to be closed
133	CHARACTER(LEN=100) :: clinfo ! info character
134	!---------------------------------------------------------------------
135	!
136	clinfo = ' iom_nf90_close , file: '//TRIM(iom_file(kiomid)%name)
137	CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
138	!
139	END SUBROUTINE iom_nf90_close
140
141
142	FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz )
143	!!-----------------------------------------------------------------------
144	!! * FUNCTION iom_varid *
145	!!
146	!! ** Purpose : get the id of a variable in a file with NF90
147	!!-----------------------------------------------------------------------
148	INTEGER , INTENT(in ) :: kiomid ! file Identifier
149	CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable
150	INTEGER , INTENT(in ) :: kiv !
151	INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions
152	!
153	INTEGER :: iom_nf90_varid ! iom variable Id
154	INTEGER :: if90id ! nf90 file identifier
155	INTEGER :: ji ! dummy loop index
156	INTEGER :: ivarid ! NetCDF variable Id
157	INTEGER :: i_nvd ! number of dimension of the variable
158	INTEGER, DIMENSION(jpmax_dims) :: idimid ! dimension ids of the variable
159	LOGICAL :: llok ! ok test
160	CHARACTER(LEN=100) :: clinfo ! info character
161	!!-----------------------------------------------------------------------
162	clinfo = ' iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
163	iom_nf90_varid = 0 ! default definition
164	IF( PRESENT(kdimsz) ) kdimsz(:) = 0 ! default definition
165	if90id = iom_file(kiomid)%nfid ! get back NetCDF file id
166	!
167	llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr ! does the variable exist in the file
168	IF( llok ) THEN
169	iom_nf90_varid = kiv
170	iom_file(kiomid)%nvars = kiv
171	iom_file(kiomid)%nvid(kiv) = ivarid
172	iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
173	CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo) ! number of dimensions
174	iom_file(kiomid)%ndims(kiv) = i_nvd
175	CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo) ! dimensions ids
176	DO ji = 1, i_nvd ! dimensions size
177	CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)
178	IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE. ! unlimited dimension?
179	END DO
180	!---------- Deal with scale_factor and offset
181	llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
182	IF( llok) THEN
183	CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
184	ELSE
185	iom_file(kiomid)%scf(kiv) = 1.
186	END IF
187	llok = NF90_Inquire_attribute(if90id, ivarid, 'offset') == nf90_noerr
188	IF( llok ) THEN
189	CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'offset', iom_file(kiomid)%ofs(kiv)), clinfo)
190	ELSE
191	iom_file(kiomid)%ofs(kiv) = 0.
192	END IF
193	! return the simension size
194	IF( PRESENT(kdimsz) ) THEN
195	IF( i_nvd == SIZE(kdimsz) ) THEN
196	kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
197	ELSE
198	WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
199	CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
200	ENDIF
201	ENDIF
202	!!$ ELSE
203	!!$ CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// &
204	!!$ & ' is not found in the file '//trim(iom_file(kiomid)%name) )
205	ENDIF
206	!
207	END FUNCTION iom_nf90_varid
208
209
210	SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar )
211	!!-----------------------------------------------------------------------
212	!! * ROUTINE iom_nf90_g0d *
213	!!
214	!! ** Purpose : read a scalar with NF90
215	!!-----------------------------------------------------------------------
216	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
217	INTEGER , INTENT(in ) :: kvid ! variable id
218	REAL(wp), INTENT( out) :: pvar ! read field
219	!
220	CHARACTER(LEN=100) :: clinfo ! info character
221	!---------------------------------------------------------------------
222	clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
223	CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar), clinfo )
224	!
225	END SUBROUTINE iom_nf90_g0d
226
227
228	SUBROUTINE iom_nf90_g123d( kiomid, kdom, kvid, knbdim, kstart, kcount, &
229	& pv_r1d, pv_r2d, pv_r3d)
230	!!-----------------------------------------------------------------------
231	!! * ROUTINE iom_nf90_g123d *
232	!!
233	!! ** Purpose : read a 1D/2D/3D variable with NF90
234	!!
235	!! ** Method : read ONE record at each CALL
236	!!-----------------------------------------------------------------------
237	INTEGER , INTENT(in ) :: kiomid ! iom identifier of the file
238	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
239	INTEGER , INTENT(in ) :: kvid ! Name of the variable
240	INTEGER , INTENT(in ) :: knbdim ! number of dimensions of the variable
241	INTEGER , DIMENSION(:) , INTENT(in ) :: kstart ! start position of the reading in each axis
242	INTEGER , DIMENSION(:) , INTENT(in ) :: kcount ! number of points to be read in each axis
243	REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case)
244	REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case)
245	REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case)
246	!
247	CHARACTER(LEN=100) :: clinfo ! info character
248	INTEGER :: if90id ! nf90 identifier of the opened file
249	INTEGER :: ivid ! nf90 variable id
250	!---------------------------------------------------------------------
251	clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
252	if90id = iom_file(kiomid)%nfid ! get back NetCDF file id
253	ivid = iom_file(kiomid)%nvid(kvid) ! get back NetCDF var id
254	IF( PRESENT(pv_r1d) ) THEN
255	CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r1d(:), start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo )
256	ELSEIF( PRESENT(pv_r2d) ) THEN
257	IF( kdom /= jpdom_unknown ) THEN
258	CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r2d(nldi:nlei,nldj:nlej), &
259	& start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo)
260	!--- Fill the overlap areas and extra hallows (mpp)
261	CALL lbc_lnk (pv_r2d,'Z',-999.,'no0')
262	ELSE
263	CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r2d(:,:), start=kstart(1:knbdim), count=kcount(1:knbdim)), clinfo)
264	ENDIF
265	ELSEIF( PRESENT(pv_r3d) ) THEN
266	IF( kdom /= jpdom_unknown ) THEN
267	CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r3d(nldi:nlei,nldj:nlej,:), &
268	& start=kstart(1:knbdim), count=kcount (1:knbdim)), clinfo)
269	!--- Fill the overlap areas and extra hallows (mpp)
270	! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
271	IF( kcount(3) == jpk ) THEN
272	CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
273	ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...)
274	pv_r3d(nlei+1:jpi, : ,:) = 1.
275	pv_r3d( : ,nlej+1:jpj,:) = 1.
276	ENDIF
277	ELSE
278	CALL iom_nf90_check(NF90_GET_VAR(if90id, ivid, pv_r3d(:,:,:), &
279	& start=kstart(1:knbdim), count=kcount (1:knbdim)), clinfo)
280	ENDIF
281	ENDIF
282	!
283	END SUBROUTINE iom_nf90_g123d
284
285
286	SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime )
287	!!--------------------------------------------------------------------
288	!! * SUBROUTINE iom_gettime *
289	!!
290	!! ** Purpose : read the time axis kvid in the file with NF90
291	!!--------------------------------------------------------------------
292	INTEGER , INTENT(in ) :: kiomid ! file Identifier
293	INTEGER , INTENT(in ) :: kvid ! variable id
294	REAL(wp), DIMENSION(:), INTENT( out) :: ptime ! the time axis
295	!
296	CHARACTER(LEN=100) :: clinfo ! info character
297	!---------------------------------------------------------------------
298	clinfo = 'iom_nf90_gettime, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
299	CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:), &
300	& start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo)
301	!
302	END SUBROUTINE iom_nf90_gettime
303
304
305	SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid , ktype, &
306	& pv_r0d, pv_r1d, pv_r2d, pv_r3d )
307	!!--------------------------------------------------------------------
308	!! * SUBROUTINE iom_nf90_rstput *
309	!!
310	!! ** Purpose : read the time axis cdvar in the file
311	!!--------------------------------------------------------------------
312	INTEGER , INTENT(in) :: kt ! ocean time-step
313	INTEGER , INTENT(in) :: kwrite ! writing time-step
314	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
315	CHARACTER(len=*) , INTENT(in) :: cdvar ! variable name
316	INTEGER , INTENT(in) :: kvid ! variable id
317	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable type (default R8)
318	REAL(wp) , INTENT(in), OPTIONAL :: pv_r0d ! written Od field
319	REAL(wp), DIMENSION( jpk), INTENT(in), OPTIONAL :: pv_r1d ! written 1d field
320	REAL(wp), DIMENSION(jpi,jpj ), INTENT(in), OPTIONAL :: pv_r2d ! written 2d field
321	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pv_r3d ! written 3d field
322	!
323	INTEGER :: idims ! number of dimension
324	INTEGER :: idvar ! variable id
325	INTEGER :: jd ! dimension loop counter
326	INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
327	INTEGER, DIMENSION(4) :: idimsz ! dimensions size
328	INTEGER, DIMENSION(4) :: idimid ! dimensions id
329	CHARACTER(LEN=100) :: clinfo ! info character
330	CHARACTER(LEN= 12), DIMENSION(4) :: cltmp ! temporary character
331	INTEGER :: if90id ! nf90 file identifier
332	INTEGER :: idmy ! dummy variable
333	INTEGER :: itype ! variable type
334	!---------------------------------------------------------------------
335	!
336	clinfo = ' iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
337	if90id = iom_file(kiomid)%nfid
338	!
339	! define dimension variables if it is not already done
340	! ==========================
341	IF( iom_file(kiomid)%nvars == 0 ) THEN
342	! are we in define mode?
343	IF( iom_file(kiomid)%irec /= -1 ) THEN ! trick: irec used to know if the file is in define mode or not
344	CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) ; iom_file(kiomid)%irec = -1
345	ENDIF
346	! define the dimension variables if it is not already done
347	cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter' /)
348	CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
349	CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
350	CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3 /), iom_file(kiomid)%nvid(3) ), clinfo)
351	CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4 /), iom_file(kiomid)%nvid(4) ), clinfo)
352	! update informations structure related the dimension variable we just added...
353	iom_file(kiomid)%nvars = 4
354	iom_file(kiomid)%luld(1:4) = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
355	iom_file(kiomid)%cn_var(1:4) = cltmp
356	iom_file(kiomid)%ndims(1:4) = (/ 2, 2, 1, 1 /)
357	CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)
358	CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)
359	iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
360	CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)
361	iom_file(kiomid)%dimsz(1 , 4) = 1 ! unlimited dimension
362	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
363	ENDIF
364	! define the data if it is not already done
365	! ===============
366	IF( kvid <= 0 ) THEN
367	idvar = iom_file(kiomid)%nvars + 1
368	! are we in define mode?
369	IF( iom_file(kiomid)%irec /= -1 ) THEN ! trick: irec used to know if the file is in define mode or not
370	CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) ; iom_file(kiomid)%irec = -1
371	ENDIF
372	! variable definition
373	IF( PRESENT(pv_r0d) ) THEN ; idims = 0
374	ELSEIF( PRESENT(pv_r1d) ) THEN ; idims = 2 ; idimid(1:idims) = (/ 3,4/)
375	ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2 ,4/)
376	ELSEIF( PRESENT(pv_r3d) ) THEN ; idims = 4 ; idimid(1:idims) = (/1,2,3,4/)
377	ENDIF
378	IF( PRESENT(ktype) ) THEN ! variable external type
379	SELECT CASE (ktype)
380	CASE (jp_r8) ; itype = NF90_DOUBLE
381	CASE (jp_r4) ; itype = NF90_FLOAT
382	CASE (jp_i4) ; itype = NF90_INT
383	CASE (jp_i2) ; itype = NF90_SHORT
384	CASE (jp_i1) ; itype = NF90_BYTE
385	CASE DEFAULT ; CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
386	END SELECT
387	ELSE
388	itype = NF90_DOUBLE
389	ENDIF
390	IF( PRESENT(pv_r0d) ) THEN
391	CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, &
392	& iom_file(kiomid)%nvid(idvar) ), clinfo)
393	ELSE
394	CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims), &
395	& iom_file(kiomid)%nvid(idvar) ), clinfo)
396	ENDIF
397	! update informations structure related the new variable we want to add...
398	iom_file(kiomid)%nvars = idvar
399	iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
400	iom_file(kiomid)%scf(idvar) = 1.
401	iom_file(kiomid)%ofs(idvar) = 0.
402	iom_file(kiomid)%ndims(idvar) = idims
403	IF( .NOT. PRESENT(pv_r0d) ) THEN ; iom_file(kiomid)%luld(idvar) = .TRUE.
404	ELSE ; iom_file(kiomid)%luld(idvar) = .FALSE.
405	ENDIF
406	DO jd = 1, idims
407	CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, idimid(jd), len = iom_file(kiomid)%dimsz(jd,idvar) ), clinfo)
408	END DO
409	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
410	ELSE
411	idvar = kvid
412	ENDIF
413
414	! time step kwrite : write the variable
415	IF( kt == kwrite ) THEN
416	! are we in write mode?
417	IF( iom_file(kiomid)%irec == -1 ) THEN ! trick: irec used to know if the file is in define mode or not
418	CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo) ; iom_file(kiomid)%irec = 0
419	ENDIF
420	! on what kind of domain must the data be written?
421	IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
422	idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
423	IF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
424	ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
425	ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN
426	ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj
427	ELSEIF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN
428	ix1 = 1 ; ix2 = jpi ; iy1 = 1 ; iy2 = jpj
429	ELSE
430	CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
431	ENDIF
432
433	! write dimension variables if it is not already done
434	! =============
435	IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
436	CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon' , idmy ), clinfo)
437	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo)
438	CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat' , idmy ), clinfo)
439	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo)
440	CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo)
441	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_0 ), clinfo)
442	! +++ WRONG VALUE: to be improved but not really useful...
443	CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)
444	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt ), clinfo)
445	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
446	ENDIF
447	ENDIF
448
449	! write the data
450	! =============
451	IF( PRESENT(pv_r0d) ) THEN
452	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r0d ), clinfo)
453	ELSEIF( PRESENT(pv_r1d) ) THEN
454	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r1d( :) ), clinfo)
455	ELSEIF( PRESENT(pv_r2d) ) THEN
456	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2 ) ), clinfo)
457	ELSEIF( PRESENT(pv_r3d) ) THEN
458	CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)
459	ENDIF
460	! add 1 to the size of the temporal dimension (not really useful...)
461	IF( iom_file(kiomid)%luld(idvar) ) iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) &
462	& = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
463	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
464	ENDIF
465	!
466	END SUBROUTINE iom_nf90_rp0123d
467
468
469	SUBROUTINE iom_nf90_check( kstatus, cdinfo )
470	!!--------------------------------------------------------------------
471	!! * SUBROUTINE iom_nf90_check *
472	!!
473	!! ** Purpose : check nf90 errors
474	!!--------------------------------------------------------------------
475	INTEGER, INTENT(in) :: kstatus
476	CHARACTER(LEN=*), INTENT(in) :: cdinfo
477	!---------------------------------------------------------------------
478	IF(kstatus /= nf90_noerr) CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
479	END SUBROUTINE iom_nf90_check
480
481
482	!!======================================================================
483	END MODULE iom_nf90

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

Download in other formats: