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

Context Navigation

source: trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90 @ 933

Last change on this file since 933 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: 23.7 KB

Line
1	MODULE iom_ioipsl
2	!!=====================================================================
3	!! * MODULE iom_ioipsl *
4	!! Input/Output manager : Library to read input files with IOIPSL (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 ioipsl ! IOIPSL library
24
25	IMPLICIT NONE
26	PRIVATE
27
28	PUBLIC iom_ioipsl_open, iom_ioipsl_close, iom_ioipsl_varid, iom_ioipsl_get, iom_ioipsl_gettime, iom_ioipsl_rstput
29
30	INTERFACE iom_ioipsl_get
31	MODULE PROCEDURE iom_ioipsl_g0d, iom_ioipsl_g123d
32	END INTERFACE
33	INTERFACE iom_ioipsl_rstput
34	MODULE PROCEDURE iom_ioipsl_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_ioipsl_open( cdname, kiomid, ldwrt, ldok, kdompar )
45	!!---------------------------------------------------------------------
46	!! * SUBROUTINE iom_open *
47	!!
48	!! ** Purpose : open an input file with IOIPSL (only fliocom module)
49	!!---------------------------------------------------------------------
50	CHARACTER(len=*) , INTENT(inout) :: cdname ! File name
51	INTEGER , INTENT( out) :: kiomid ! ioipsl 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	INTEGER :: iln ! lengths of character
58	INTEGER :: istop ! temporary storage of nstop
59	INTEGER :: ifliodom ! model domain identifier (see flio_dom_set)
60	INTEGER :: ioipslid ! ioipsl identifier of the opened file
61	!---------------------------------------------------------------------
62
63	clinfo = ' iom_ioipsl_open ~~~ '
64	istop = nstop
65	!
66	IF( ldok ) THEN ! Open existing file...
67	! ! =============
68	IF( ldwrt ) THEN ! ... in write mode
69	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
70	CALL flioopfd( TRIM(cdname), ioipslid, "WRITE" )
71	ELSE ! ... in read mode
72	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
73	CALL flioopfd( TRIM(cdname), ioipslid )
74	ENDIF
75	ELSE ! the file does not exist
76	! ! =============
77	iln = INDEX( cdname, '.nc' )
78	IF( ldwrt ) THEN ! the file should be open in write mode so we create it...
79	IF( jpnij > 1 ) THEN
80	! define the domain position regarding to the global domain (mainly useful in mpp)
81	CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/) &
82	& , kdompar(:,1), kdompar(:,2), kdompar(:,3), kdompar(:,4), kdompar(:,5) &
83	& , 'BOX', ifliodom )
84	! Note that fliocrfd may change the value of cdname (add the cpu number...)
85	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname(1:iln-1)//'... in WRITE mode'
86	CALL fliocrfd( cdname, (/'x' , 'y' , 'z', 't'/) &
87	& , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, ifliodom )
88	ELSE ! the file should be open for read mode so it must exist...
89	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname//' in WRITE mode'
90	CALL fliocrfd( cdname, (/'x' , 'y' , 'z', 't'/) &
91	& , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid )
92	ENDIF
93	ELSE ! the file should be open for read mode so it must exist...
94	CALL ctl_stop( TRIM(clinfo), 'File '//cdname(1:iln-1)//'* not found' )
95	ENDIF
96	ENDIF
97	! start to fill file informations
98	! =============
99	IF( istop == nstop ) THEN ! no error within this routine
100	kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
101	iom_file(kiomid)%name = TRIM(cdname)
102	iom_file(kiomid)%nfid = ioipslid
103	iom_file(kiomid)%iolib = jpioipsl
104	iom_file(kiomid)%nvars = 0
105	iom_file(kiomid)%irec = -1 ! useless for NetCDF files
106	CALL flioinqf( ioipslid, id_uld = iom_file(kiomid)%iduld )
107	IF(lwp) WRITE(numout,*) ' ---> '//TRIM(cdname)//' OK'
108	ELSE
109	kiomid = 0 ! return error flag
110	ENDIF
111	!
112	END SUBROUTINE iom_ioipsl_open
113
114
115	SUBROUTINE iom_ioipsl_close( kiomid )
116	!!--------------------------------------------------------------------
117	!! * SUBROUTINE iom_ioipsl_close *
118	!!
119	!! ** Purpose : close an input file with IOIPSL (only fliocom module)
120	!!--------------------------------------------------------------------
121	INTEGER, INTENT(in) :: kiomid ! iom identifier of the file to be closed
122	!---------------------------------------------------------------------
123	!
124	CALL flioclo( iom_file(kiomid)%nfid )
125	!
126	END SUBROUTINE iom_ioipsl_close
127
128
129	FUNCTION iom_ioipsl_varid ( kiomid, cdvar, kiv, kdimsz )
130	!!-----------------------------------------------------------------------
131	!! * FUNCTION iom_varid *
132	!!
133	!! ** Purpose : get the id of a variable in a file with IOIPSL (only fliocom module)
134	!!-----------------------------------------------------------------------
135	INTEGER , INTENT(in ) :: kiomid ! file Identifier
136	CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable
137	INTEGER , INTENT(in ) :: kiv !
138	INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions
139	!
140	INTEGER :: iom_ioipsl_varid ! iom variable Id
141	INTEGER :: ioipslid ! ioipsl file identifier
142	INTEGER :: ji ! dummy loop index
143	INTEGER :: i_nvd ! number of dimension of the variable
144	INTEGER, DIMENSION(jpmax_dims) :: idimid ! dimension ids of the variable
145	LOGICAL :: ll_fnd ! found test
146	CHARACTER(LEN=100) :: clinfo ! info character
147	!!-----------------------------------------------------------------------
148	clinfo = 'iom_ioipsl_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
149	iom_ioipsl_varid = 0 ! default definition
150	IF( PRESENT(kdimsz) ) kdimsz(:) = 0 ! default definition
151	ioipslid = iom_file(kiomid)%nfid ! get back ioipsl file identifier
152	CALL flioinqv( ioipslid, cdvar, ll_fnd, nb_dims = i_nvd ) ! does the variable exist in the file
153	IF( ll_fnd ) THEN
154	IF( i_nvd <= jpmax_dims ) THEN
155	iom_ioipsl_varid = kiv
156	iom_file(kiomid)%nvars = kiv
157	iom_file(kiomid)%nvid(kiv) = -1 ! variable id is not available in ioipsl
158	iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
159	iom_file(kiomid)%ndims(kiv) = i_nvd
160	CALL flioinqv( ioipslid, cdvar, ll_fnd, &
161	& len_dims = iom_file(kiomid)%dimsz(1:i_nvd,kiv), & ! dimensions size
162	& id_dims = idimid(1:i_nvd) ) ! dimensions ids
163	DO ji = 1, i_nvd ! find the unlimited dimension
164	IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.
165	END DO
166	!---------- Deal with scale_factor and offset
167	CALL flioinqa( ioipslid, cdvar, 'scale_factor', ll_fnd )
168	IF( ll_fnd) THEN
169	CALL fliogeta( ioipslid, cdvar, 'scale_factor', iom_file(kiomid)%scf(kiv) )
170	ELSE
171	iom_file(kiomid)%scf(kiv) = 1.
172	END IF
173	CALL flioinqa( ioipslid, cdvar, 'offset', ll_fnd )
174	IF( ll_fnd ) THEN
175	CALL fliogeta( ioipslid, cdvar, 'offset', iom_file(kiomid)%ofs(kiv) )
176	ELSE
177	iom_file(kiomid)%ofs(kiv) = 0.
178	END IF
179	! return the simension size
180	IF( PRESENT(kdimsz) ) THEN
181	IF( i_nvd == SIZE(kdimsz) ) THEN
182	kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
183	ELSE
184	WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
185	CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
186	ENDIF
187	ENDIF
188	ELSE
189	CALL ctl_stop( TRIM(clinfo), 'Too many dimensions in the file '//iom_file(kiomid)%name, &
190	& 'increase the parameter jpmax_vars')
191	ENDIF
192	!!$ ELSE
193	!!$ CALL ctl_warn( trim(clinfo), 'Variable '//trim(cdvar)// &
194	!!$ & ' is not found in the file '//trim(iom_file(kiomid)%name) )
195	ENDIF
196	!
197	END FUNCTION iom_ioipsl_varid
198
199
200	SUBROUTINE iom_ioipsl_g0d( kiomid, kvid, pvar )
201	!!-----------------------------------------------------------------------
202	!! * ROUTINE iom_ioipsl_g0d *
203	!!
204	!! ** Purpose : read a scalar with IOIPSL (only fliocom module)
205	!!-----------------------------------------------------------------------
206	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
207	INTEGER , INTENT(in ) :: kvid ! variable id
208	REAL(wp), INTENT( out) :: pvar ! read field
209	!
210	CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), pvar )
211	!
212	END SUBROUTINE iom_ioipsl_g0d
213
214
215	SUBROUTINE iom_ioipsl_g123d( kiomid, kdom, kvid, knbdim, kstart, kcount, &
216	& pv_r1d, pv_r2d, pv_r3d)
217	!!-----------------------------------------------------------------------
218	!! * ROUTINE iom_ioipsl_g123d *
219	!!
220	!! ** Purpose : read a 1D/2D/3D variable with IOIPSL (only fliocom module)
221	!!
222	!! ** Method : read ONE record at each CALL
223	!!-----------------------------------------------------------------------
224	INTEGER , INTENT(in ) :: kiomid ! iom identifier of the file
225	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
226	INTEGER , INTENT(in ) :: kvid ! Name of the variable
227	INTEGER , INTENT(in ) :: knbdim ! number of dimensions of the variable
228	INTEGER , DIMENSION(:) , INTENT(in ) :: kstart ! start position of the reading in each axis
229	INTEGER , DIMENSION(:) , INTENT(in ) :: kcount ! number of points to be read in each axis
230	REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case)
231	REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case)
232	REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case)
233	!
234	INTEGER :: ioipslid ! ioipsl file identifier
235	CHARACTER(LEN=100) :: clvn ! variable name
236	!---------------------------------------------------------------------
237	clvn = TRIM(iom_file(kiomid)%cn_var(kvid))
238	ioipslid = iom_file(kiomid)%nfid
239	!
240	IF( PRESENT(pv_r1d) ) THEN
241	CALL fliogetv( ioipslid, clvn, pv_r1d(:), start=kstart(1:knbdim), count=kcount(1:knbdim) )
242	ELSEIF( PRESENT(pv_r2d) ) THEN
243	IF( kdom /= jpdom_unknown ) THEN
244	CALL fliogetv( ioipslid, clvn, pv_r2d(nldi:nlei,nldj:nlej), start=kstart(1:knbdim), count=kcount(1:knbdim) )
245	!--- Fill the overlap areas and extra hallows (mpp)
246	CALL lbc_lnk (pv_r2d,'Z',-999.,'no0')
247	ELSE
248	CALL fliogetv( ioipslid, clvn, pv_r2d(:,:), start=kstart(1:knbdim), count=kcount(1:knbdim) )
249	ENDIF
250	ELSEIF( PRESENT(pv_r3d) ) THEN
251	IF( kdom /= jpdom_unknown ) THEN
252	CALL fliogetv( ioipslid, clvn, pv_r3d(nldi:nlei,nldj:nlej,:), start=kstart(1:knbdim), &
253	& count=kcount (1:knbdim) )
254	!--- Fill the overlap areas and extra hallows (mpp)
255	! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
256	IF( kcount(3) == jpk ) THEN
257	CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
258	ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...)
259	pv_r3d(nlei+1:jpi, : ,:) = 1.
260	pv_r3d( : ,nlej+1:jpj,:) = 1.
261	ENDIF
262	ELSE
263	CALL fliogetv( ioipslid, clvn, pv_r3d(:,:,:), start=kstart(1:knbdim), count=kcount(1:knbdim) )
264	ENDIF
265	ENDIF
266	!
267	!
268	END SUBROUTINE iom_ioipsl_g123d
269
270
271	SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime )
272	!!--------------------------------------------------------------------
273	!! * SUBROUTINE iom_gettime *
274	!!
275	!! ** Purpose : read the time axis kvid in the file with IOIPSL (only fliocom module)
276	!!--------------------------------------------------------------------
277	INTEGER , INTENT(in ) :: kiomid ! file Identifier
278	INTEGER , INTENT(in ) :: kvid ! variable id
279	REAL(wp), DIMENSION(:), INTENT( out) :: ptime ! the time axis
280	!---------------------------------------------------------------------
281	!
282	CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), ptime(:), &
283	& start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /) )
284	!
285	END SUBROUTINE iom_ioipsl_gettime
286
287
288	SUBROUTINE iom_ioipsl_rp0123d( kt, kwrite, kiomid, cdvar , kvid , ktype, &
289	& pv_r0d, pv_r1d, pv_r2d, pv_r3d )
290	!!--------------------------------------------------------------------
291	!! * SUBROUTINE iom_ioipsl_rstput *
292	!!
293	!! ** Purpose : read the time axis cdvar in the file
294	!!--------------------------------------------------------------------
295	INTEGER , INTENT(in) :: kt ! ocean time-step
296	INTEGER , INTENT(in) :: kwrite ! writing time-step
297	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
298	CHARACTER(len=*) , INTENT(in) :: cdvar ! variable name
299	INTEGER , INTENT(in) :: kvid ! variable id
300	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable type (default R8)
301	REAL(wp) , INTENT(in), OPTIONAL :: pv_r0d ! written Od field
302	REAL(wp), DIMENSION( jpk), INTENT(in), OPTIONAL :: pv_r1d ! written 1d field
303	REAL(wp), DIMENSION(jpi,jpj ), INTENT(in), OPTIONAL :: pv_r2d ! written 2d field
304	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pv_r3d ! written 3d field
305	!
306	INTEGER :: idims ! number of dimension
307	INTEGER :: idvar ! variable id
308	INTEGER :: itype ! variable type
309	INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
310	INTEGER, DIMENSION(4) :: idimsz ! dimensions size
311	INTEGER, DIMENSION(4) :: idimid ! dimensions id
312	CHARACTER(LEN=100) :: clinfo ! info character
313	INTEGER :: ioipslid ! ioipsl file identifier
314	!---------------------------------------------------------------------
315	!
316	clinfo = ' iom_ioipsl_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
317	ioipslid = iom_file(kiomid)%nfid
318	!
319	! define dimension variables if it is not already done
320	! ==========================
321	IF( iom_file(kiomid)%nvars == 0 ) THEN
322	! define the dimension variables if it is not already done
323	CALL fliodefv( ioipslid,'nav_lon', (/1,2/), v_t=flio_r4 , axis='X', &
324	& long_name="Longitude", units="degrees_east" )
325	CALL fliodefv( ioipslid,'nav_lat', (/1,2/), v_t=flio_r4 , axis='Y', &
326	& long_name="Latitude", units="degrees_north" )
327	CALL fliodefv( ioipslid,'nav_lev', (/3/) , v_t=flio_i4 , axis='Z', &
328	& long_name="Model levels",units="model_levels")
329	CALL fliodefv( ioipslid,'time_counter', (/4/), v_t=flio_r4, axis='T', &
330	& long_name="Time axis", units='seconds since 0001-01-01 00:00:00' )
331	! update informations structure related the dimension variable we just added...
332	iom_file(kiomid)%nvars = 4
333	iom_file(kiomid)%luld(1:4) = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
334	iom_file(kiomid)%cn_var(1:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /)
335	iom_file(kiomid)%cn_var(4) = 'time_counter'
336	iom_file(kiomid)%ndims(1:4) = (/ 2, 2, 1, 1 /)
337	CALL flioinqf( ioipslid, ln_dim = idimsz )
338	iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2)
339	iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2)
340	iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/)
341	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
342	ENDIF
343
344	! define the data if it is not already done
345	! ===============
346	IF( kvid <= 0 ) THEN
347	! variable definition
348	IF( PRESENT(pv_r0d) ) THEN ; idims = 0
349	ELSEIF( PRESENT(pv_r1d) ) THEN ; idims = 2 ; idimid(1:idims) = (/ 3,4/)
350	ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2 ,4/)
351	ELSEIF( PRESENT(pv_r3d) ) THEN ; idims = 4 ; idimid(1:idims) = (/1,2,3,4/)
352	ENDIF
353	IF( PRESENT(ktype) ) THEN ! variable external type
354	SELECT CASE (ktype)
355	CASE (jp_r8) ; itype = flio_r8
356	CASE (jp_r4) ; itype = flio_r4
357	CASE (jp_i4) ; itype = flio_i4
358	CASE (jp_i2) ; itype = flio_i2
359	CASE (jp_i1) ; itype = flio_i1 ! fliocom does not handle i1 type of variable
360	CASE DEFAULT ; CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
361	END SELECT
362	ELSE
363	itype = flio_r8
364	ENDIF
365	IF( PRESENT(pv_r0d) ) THEN ; CALL fliodefv (ioipslid, TRIM(cdvar) , v_t = itype)
366	ELSE ; CALL fliodefv (ioipslid, TRIM(cdvar), idimid(1:idims), v_t = itype)
367	ENDIF
368	! update informations structure related the new variable we want to add...
369	idvar = iom_file(kiomid)%nvars + 1
370	iom_file(kiomid)%nvars = idvar
371	iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
372	iom_file(kiomid)%nvid(idvar) = -1 ! netcdf variable id is not available in ioipsl
373	iom_file(kiomid)%scf(idvar) = 1.
374	iom_file(kiomid)%ofs(idvar) = 0.
375	iom_file(kiomid)%ndims(idvar) = idims
376	IF( .NOT. PRESENT(pv_r0d) ) THEN
377	iom_file(kiomid)%luld(idvar) = .TRUE.
378	CALL flioinqf( ioipslid, ln_dim = idimsz )
379	iom_file(kiomid)%dimsz(1:idims-1,idvar) = idimsz(idimid(1:idims-1))
380	ELSE
381	iom_file(kiomid)%luld(idvar) = .FALSE.
382	ENDIF
383	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
384	ELSE
385	idvar = kvid
386	ENDIF
387
388	! time step kwrite : write the variable
389	IF( kt == kwrite ) THEN
390	! on what kind of domain must the data be written?
391	IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
392	idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
393	IF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
394	ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
395	ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN
396	ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj
397	ELSEIF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN
398	ix1 = 1 ; ix2 = jpi ; iy1 = 1 ; iy2 = jpj
399	ELSE
400	CALL ctl_stop( 'iom_ioipsl_rp0123d: should have been an impossible case...' )
401	ENDIF
402
403	! write dimension variables if it is not already done
404	! =============
405	IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
406	CALL flioputv( ioipslid, 'nav_lon' , glamt(ix1:ix2, iy1:iy2) )
407	CALL flioputv( ioipslid, 'nav_lat' , gphit(ix1:ix2, iy1:iy2) )
408	CALL flioputv( ioipslid, 'nav_lev' , gdept_0 )
409	! +++ WRONG VALUE: to be improved but not really useful...
410	CALL flioputv( ioipslid, 'time_counter', kt )
411	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
412	ENDIF
413	ENDIF
414
415	! write the data
416	! =============
417	IF( PRESENT(pv_r0d) ) THEN ; CALL flioputv( ioipslid, cdvar, pv_r0d )
418	ELSEIF( PRESENT(pv_r1d) ) THEN ; CALL flioputv( ioipslid, cdvar, pv_r1d( :) )
419	ELSEIF( PRESENT(pv_r2d) ) THEN ; CALL flioputv( ioipslid, cdvar, pv_r2d(ix1:ix2, iy1:iy2 ) )
420	ELSEIF( PRESENT(pv_r3d) ) THEN ; CALL flioputv( ioipslid, cdvar, pv_r3d(ix1:ix2, iy1:iy2, :) )
421	ENDIF
422	! add 1 to the size of the temporal dimension (not really useful...)
423	IF( iom_file(kiomid)%luld(idvar) ) iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) &
424	& = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
425	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
426	ENDIF
427	!
428	END SUBROUTINE iom_ioipsl_rp0123d
429
430
431	!!======================================================================
432	END MODULE iom_ioipsl

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

Download in other formats: