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

Context Navigation

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

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

Download in other formats: