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 branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

Context Navigation

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90 @ 4409

Last change on this file since 4409 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.

Property svn:keywords set to Id

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

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

Download in other formats: