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

source: trunk/NEMO/OPA_SRC/IOM/iom_ioipsl.F90 @ 627

Last change on this file since 627 was 588, checked in by opalod, 17 years ago

nemo_v2_bugfix_001 : SM + CT : - add an initialization of iom_file(kiomid)%luld(kiv) field

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