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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90 @ 3211

Last change on this file since 3211 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: 33.7 KB
Line 
1MODULE 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   !!             "   ! 07 07  (D. Storkey) Changes to iom_nf90_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 lbclnk          ! lateal boundary condition / mpp exchanges
22   USE iom_def         ! iom variables definitions
23   USE netcdf          ! NetCDF library
24   USE in_out_manager  ! I/O manager
25   USE lib_mpp         ! MPP library
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput
31   PUBLIC iom_nf90_getatt
32
33   INTERFACE iom_nf90_get
34      MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d
35   END INTERFACE
36   INTERFACE iom_nf90_getatt
37      MODULE PROCEDURE iom_nf90_intatt
38   END INTERFACE
39   INTERFACE iom_nf90_rstput
40      MODULE PROCEDURE iom_nf90_rp0123d
41   END INTERFACE
42
43   !! * Control permutation of array indices
44#  include "dom_oce_ftrans.h90"
45
46   !!----------------------------------------------------------------------
47   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
48   !! $Id$
49   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51
52CONTAINS
53
54   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )
55      !!---------------------------------------------------------------------
56      !!                   ***  SUBROUTINE  iom_open  ***
57      !!
58      !! ** Purpose : open an input file with NF90
59      !!---------------------------------------------------------------------
60      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
61      INTEGER                , INTENT(  out)           ::   kiomid      ! nf90 identifier of the opened file
62      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file?
63      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence
64      INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:
65
66      CHARACTER(LEN=100) ::   clinfo           ! info character
67      CHARACTER(LEN=100) ::   cltmp            ! temporary character
68      INTEGER            ::   iln              ! lengths of character
69      INTEGER            ::   istop            ! temporary storage of nstop
70      INTEGER            ::   if90id           ! nf90 identifier of the opened file
71      INTEGER            ::   idmy             ! dummy variable
72      INTEGER            ::   jl               ! loop variable
73      INTEGER            ::   ichunk           ! temporary storage of nn_chunksz
74      INTEGER            ::   imode            ! creation mode flag: NF90_CLOBBER or NF90_NOCLOBBER or NF90_HDF5
75      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5
76      LOGICAL            ::   llclobber        ! local definition of ln_clobber
77      !---------------------------------------------------------------------
78
79      clinfo = '                    iom_nf90_open ~~~  '
80      istop = nstop   ! store the actual value of nstop
81      IF( nn_chunksz > 0 ) THEN   ;   ichunk = nn_chunksz
82      ELSE                        ;   ichunk = NF90_SIZEHINT_DEFAULT
83      ENDIF
84      !
85      llclobber = ldwrt .AND. ln_clobber
86      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
87         !                 ! =============
88         IF( ldwrt ) THEN  ! ... in write mode
89            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode'
90            IF( snc4set%luse ) THEN
91               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id ), clinfo)
92            ELSE
93               CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_WRITE  , if90id, chunksize = ichunk ), clinfo)
94            ENDIF
95            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                          ), clinfo)
96         ELSE              ! ... in read mode
97            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
98            CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo)
99         ENDIF
100      ELSE                                       ! the file does not exist (or we overwrite it)
101         !                 ! =============
102         iln = INDEX( cdname, '.nc' )
103         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
104            IF( jpnij > 1 ) THEN
105               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc'
106               cdname = TRIM(cltmp)
107            ENDIF
108            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in WRITE mode'
109
110            IF( llclobber ) THEN   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_CLOBBER   )
111            ELSE                   ;   imode = IOR( NF90_64BIT_OFFSET, NF90_NOCLOBBER ) 
112            ENDIF
113            IF( snc4set%luse ) THEN
114               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' creating file: '//TRIM(cdname)//' in hdf5 (netcdf4) mode'
115               CALL GET_NF90_SYMBOL("NF90_HDF5", ihdf5)
116               IF( llclobber ) THEN   ;   imode = IOR(ihdf5, NF90_CLOBBER)
117               ELSE                   ;   imode = IOR(ihdf5, NF90_NOCLOBBER)
118               ENDIF
119               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id ), clinfo)
120            ELSE
121               CALL iom_nf90_check(NF90_CREATE( TRIM(cdname), imode, if90id, chunksize = ichunk ), clinfo)
122            ENDIF
123            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                     ), clinfo)
124            ! define dimensions
125            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo)
126            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo)
127            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo)
128            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo)
129            ! global attributes
130            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo)
131            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo)
132            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo)
133            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo)
134            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)       ), clinfo)
135            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)       ), clinfo)
136            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)       ), clinfo)
137            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)       ), clinfo)
138            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)       ), clinfo)
139            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo)
140         ELSE              ! the file should be open for read mode so it must exist...
141            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
142         ENDIF
143      ENDIF
144      ! start to fill file informations
145      ! =============
146      IF( istop == nstop ) THEN   ! no error within this routine
147!does not work with some compilers         kiomid = MINLOC(iom_file(:)%nfid, dim = 1)
148         kiomid = 0
149         DO jl = jpmax_files, 1, -1
150            IF( iom_file(jl)%nfid == 0 )   kiomid = jl
151         ENDDO
152         iom_file(kiomid)%name   = TRIM(cdname)
153         iom_file(kiomid)%nfid   = if90id
154         iom_file(kiomid)%iolib  = jpnf90
155         iom_file(kiomid)%nvars  = 0
156         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode
157         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo)
158         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN
159           CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,   &
160        &                                               name = iom_file(kiomid)%uldname), clinfo)
161         ENDIF
162         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
163      ELSE
164         kiomid = 0               ! return error flag
165      ENDIF
166      !
167   END SUBROUTINE iom_nf90_open
168
169
170   SUBROUTINE iom_nf90_close( kiomid )
171      !!--------------------------------------------------------------------
172      !!                   ***  SUBROUTINE  iom_nf90_close  ***
173      !!
174      !! ** Purpose : close an input file with NF90
175      !!--------------------------------------------------------------------
176      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
177      CHARACTER(LEN=100)  ::   clinfo   ! info character
178      !---------------------------------------------------------------------
179      !
180      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name)
181      CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo)
182      !   
183   END SUBROUTINE iom_nf90_close
184
185
186   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz ) 
187      !!-----------------------------------------------------------------------
188      !!                  ***  FUNCTION  iom_varid  ***
189      !!
190      !! ** Purpose : get the id of a variable in a file with NF90
191      !!-----------------------------------------------------------------------
192      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
193      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
194      INTEGER              , INTENT(in   )           ::   kiv   !
195      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
196      !
197      INTEGER                        ::   iom_nf90_varid   ! iom variable Id
198      INTEGER                        ::   if90id           ! nf90 file identifier
199      INTEGER                        ::   ji               ! dummy loop index
200      INTEGER                        ::   ivarid           ! NetCDF  variable Id
201      INTEGER                        ::   i_nvd            ! number of dimension of the variable
202      INTEGER, DIMENSION(jpmax_dims) ::   idimid           ! dimension ids of the variable
203      LOGICAL                        ::   llok             ! ok  test
204      CHARACTER(LEN=100)             ::   clinfo           ! info character
205      !!-----------------------------------------------------------------------
206      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
207      iom_nf90_varid = 0                    ! default definition
208      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
209      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id
210      !
211      llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file
212      IF( llok ) THEN
213         iom_nf90_varid = kiv
214         iom_file(kiomid)%nvars       = kiv
215         iom_file(kiomid)%nvid(kiv)   = ivarid
216         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
217         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions
218         iom_file(kiomid)%ndims(kiv)  = i_nvd
219         CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids
220         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
221         DO ji = 1, i_nvd                       ! dimensions size
222            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)   
223            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension?
224         END DO
225         !---------- Deal with scale_factor and add_offset
226         llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr
227         IF( llok) THEN
228            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo)
229         ELSE
230            iom_file(kiomid)%scf(kiv) = 1.
231         END IF
232         llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr
233         IF( llok ) THEN
234            CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo)
235         ELSE
236            iom_file(kiomid)%ofs(kiv) = 0.
237         END IF
238         ! return the simension size
239         IF( PRESENT(kdimsz) ) THEN
240            IF( i_nvd == SIZE(kdimsz) ) THEN
241               kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,kiv)
242            ELSE
243               WRITE(ctmp1,*) i_nvd, SIZE(kdimsz)
244               CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
245            ENDIF
246         ENDIF
247      ELSE 
248         iom_nf90_varid = -1   !   variable not found, return error code: -1
249      ENDIF
250      !
251   END FUNCTION iom_nf90_varid
252
253
254   SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar )
255      !!-----------------------------------------------------------------------
256      !!                  ***  ROUTINE  iom_nf90_g0d  ***
257      !!
258      !! ** Purpose : read a scalar with NF90
259      !!-----------------------------------------------------------------------
260      INTEGER , INTENT(in   ) ::   kiomid   ! Identifier of the file
261      INTEGER , INTENT(in   ) ::   kvid     ! variable id
262      REAL(wp), INTENT(  out) ::   pvar     ! read field
263      !
264      CHARACTER(LEN=100)      ::   clinfo   ! info character
265      !---------------------------------------------------------------------
266      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
267      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar), clinfo )
268      !
269   END SUBROUTINE iom_nf90_g0d
270
271
272   SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
273         &                    pv_r1d, pv_r2d, pv_r3d )
274      !!-----------------------------------------------------------------------
275      !!                  ***  ROUTINE  iom_nf90_g123d  ***
276      !!
277      !! ** Purpose : read a 1D/2D/3D variable with NF90
278      !!
279      !! ** Method : read ONE record at each CALL
280      !!-----------------------------------------------------------------------
281      INTEGER                    , INTENT(in   )           ::   kiomid    ! iom identifier of the file
282      INTEGER                    , INTENT(in   )           ::   kvid      ! Name of the variable
283      INTEGER                    , INTENT(in   )           ::   knbdim    ! number of dimensions of the variable
284      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kstart    ! start position of the reading in each axis
285      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis
286      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes
287      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
288      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
289      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
290      !
291      CHARACTER(LEN=100) ::   clinfo               ! info character
292      INTEGER            ::   if90id               ! nf90 identifier of the opened file
293      INTEGER            ::   ivid                 ! nf90 variable id
294      !---------------------------------------------------------------------
295      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
296      if90id = iom_file(kiomid)%nfid         ! get back NetCDF file id
297      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id
298      !
299      IF(     PRESENT(pv_r1d) ) THEN
300         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   &
301            &                                                                       count = kcount(1:knbdim)), clinfo )
302      ELSEIF( PRESENT(pv_r2d) ) THEN
303         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   &
304            &                                                                       count = kcount(1:knbdim)), clinfo )
305      ELSEIF( PRESENT(pv_r3d) ) THEN
306         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   &
307            &                                                                       count = kcount(1:knbdim)), clinfo )
308      ENDIF
309      !
310   END SUBROUTINE iom_nf90_g123d
311
312
313   SUBROUTINE iom_nf90_intatt( kiomid, cdatt, pvar )
314      !!-----------------------------------------------------------------------
315      !!                  ***  ROUTINE  iom_nf90_intatt  ***
316      !!
317      !! ** Purpose : read an integer attribute with NF90
318      !!-----------------------------------------------------------------------
319      INTEGER         , INTENT(in   ) ::   kiomid   ! Identifier of the file
320      CHARACTER(len=*), INTENT(in   ) ::   cdatt    ! attribute name
321      INTEGER         , INTENT(  out) ::   pvar     ! read field
322      !
323      INTEGER                         ::   if90id   ! temporary integer
324      LOGICAL                         ::   llok     ! temporary logical
325      CHARACTER(LEN=100)              ::   clinfo   ! info character
326      !---------------------------------------------------------------------
327      !
328      if90id = iom_file(kiomid)%nfid
329      llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr
330      IF( llok) THEN
331         clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt)
332         CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo)
333      ELSE
334         CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found')
335         pvar = -999
336      ENDIF
337      !
338   END SUBROUTINE iom_nf90_intatt
339
340
341   SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
342      !!--------------------------------------------------------------------
343      !!                   ***  SUBROUTINE iom_gettime  ***
344      !!
345      !! ** Purpose : read the time axis kvid in the file with NF90
346      !!--------------------------------------------------------------------
347      INTEGER                   , INTENT(in   ) ::   kiomid     ! file Identifier
348      INTEGER                   , INTENT(in   ) ::   kvid       ! variable id
349      REAL(wp), DIMENSION(:)    , INTENT(  out) ::   ptime      ! the time axis
350      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdunits    ! units attribute
351      CHARACTER(len=*), OPTIONAL, INTENT(  out) ::   cdcalendar ! calendar attribute
352      !
353      CHARACTER(LEN=100) ::   clinfo     ! info character
354      !---------------------------------------------------------------------
355      clinfo = 'iom_nf90_gettime, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid))
356      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   &
357            &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo)
358      IF ( PRESENT(cdunits) ) THEN
359         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", &
360            &                           values=cdunits), clinfo)
361      ENDIF
362      IF ( PRESENT(cdcalendar) ) THEN
363         CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", &
364            &                           values=cdcalendar), clinfo)
365      ENDIF
366      !
367   END SUBROUTINE iom_nf90_gettime
368
369
370   SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
371         &                               pv_r0d, pv_r1d, pv_r2d, pv_r3d )
372      !!--------------------------------------------------------------------
373      !!                   ***  SUBROUTINE  iom_nf90_rstput  ***
374      !!
375      !! ** Purpose : read the time axis cdvar in the file
376      !!--------------------------------------------------------------------
377      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
378      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
379      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file
380      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
381      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
382      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
383      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
384      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
385      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
386      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
387      !
388      INTEGER               :: idims                ! number of dimension
389      INTEGER               :: idvar                ! variable id
390      INTEGER               :: jd                   ! dimension loop counter   
391      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes   
392      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size 
393      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
394      CHARACTER(LEN=100)    :: clinfo               ! info character
395      CHARACTER(LEN= 12), DIMENSION(4) :: cltmp     ! temporary character
396      INTEGER               :: if90id               ! nf90 file identifier
397      INTEGER               :: idmy                 ! dummy variable
398      INTEGER               :: itype                ! variable type
399      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using
400                                                    ! nn_nchunks_[i,j,k,t] namelist parameters
401      INTEGER               :: ichunkalg, ishuffle,&
402                               ideflate, ideflate_level
403                                                    ! NetCDF4 internally fixed parameters
404      LOGICAL               :: lchunk               ! logical switch to activate chunking and compression
405                                                    ! when appropriate (currently chunking is applied to 4d fields only)
406      !---------------------------------------------------------------------
407      !
408      clinfo = '          iom_nf90_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
409      if90id = iom_file(kiomid)%nfid
410      !
411      ! define dimension variables if it is not already done
412      ! ==========================
413      IF( iom_file(kiomid)%nvars == 0 ) THEN
414         ! are we in define mode?
415         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
416            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
417         ENDIF
418         ! define the dimension variables if it is not already done
419         cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter' /)
420         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo)
421         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo)
422         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo)
423         CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo)
424         ! update informations structure related the dimension variable we just added...
425         iom_file(kiomid)%nvars       = 4
426         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /)
427         iom_file(kiomid)%cn_var(1:4) = cltmp
428         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /) 
429         ! trick: defined to 0 to say that dimension variables are defined but not yet written
430         iom_file(kiomid)%dimsz(1, 1)  = 0   
431         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done'
432      ENDIF
433      ! define the data if it is not already done
434      ! ===============
435      IF( kvid <= 0 ) THEN
436         !
437         ! NetCDF4 chunking and compression fixed settings
438         ichunkalg = 0
439         ishuffle = 1
440         ideflate = 1
441         ideflate_level = 1
442         !
443         idvar = iom_file(kiomid)%nvars + 1
444         ! are we in define mode?
445         IF( iom_file(kiomid)%irec /= -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
446            CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = -1
447         ENDIF
448         ! variable definition
449         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0
450         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   idims = 2   ;   idimid(1:idims) = (/    3,4/)
451         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/)
452         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   idims = 4   ;   idimid(1:idims) = (/1,2,3,4/)
453         ENDIF
454         IF( PRESENT(ktype) ) THEN   ! variable external type
455            SELECT CASE (ktype)
456            CASE (jp_r8)  ;   itype = NF90_DOUBLE
457            CASE (jp_r4)  ;   itype = NF90_FLOAT
458            CASE (jp_i4)  ;   itype = NF90_INT
459            CASE (jp_i2)  ;   itype = NF90_SHORT
460            CASE (jp_i1)  ;   itype = NF90_BYTE
461            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
462            END SELECT
463         ELSE
464            itype = NF90_DOUBLE
465         ENDIF
466         IF( PRESENT(pv_r0d) ) THEN
467            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype,                    &
468                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
469         ELSE
470            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims),   &
471                 &                            iom_file(kiomid)%nvid(idvar) ), clinfo)
472         ENDIF
473         lchunk = .false.
474         IF( snc4set%luse .AND. idims.eq.4 ) lchunk = .true.
475         ! update informations structure related the new variable we want to add...
476         iom_file(kiomid)%nvars         = idvar
477         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
478         iom_file(kiomid)%scf(idvar)    = 1.
479         iom_file(kiomid)%ofs(idvar)    = 0.
480         iom_file(kiomid)%ndims(idvar)  = idims
481         IF( .NOT. PRESENT(pv_r0d) ) THEN   ;   iom_file(kiomid)%luld(idvar) = .TRUE.
482         ELSE                               ;   iom_file(kiomid)%luld(idvar) = .FALSE.
483         ENDIF
484         DO jd = 1, idims
485            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, idimid(jd), len = iom_file(kiomid)%dimsz(jd,idvar) ), clinfo)
486            IF ( lchunk ) ichunksz(jd) = iom_file(kiomid)%dimsz(jd,idvar)
487         END DO
488         IF ( lchunk ) THEN
489            ! Calculate chunk sizes by partitioning each dimension as requested in namnc4 namelist
490            ! Disallow very small chunk sizes and prevent chunk sizes larger than each individual dimension
491            ichunksz(1) = MIN( ichunksz(1),MAX( (ichunksz(1)-1)/snc4set%ni + 1 ,16 ) ) ! Suggested default nc4set%ni=4
492            ichunksz(2) = MIN( ichunksz(2),MAX( (ichunksz(2)-1)/snc4set%nj + 1 ,16 ) ) ! Suggested default nc4set%nj=2
493            ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6
494            ichunksz(4) = 1                                                            ! Do not allow chunks to span the
495                                                                                       ! unlimited dimension
496            CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo)
497            CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo)
498            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' chunked ok. Chunks sizes: ', ichunksz
499         ENDIF
500         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
501      ELSE
502         idvar = kvid
503      ENDIF
504
505      ! time step kwrite : write the variable
506      IF( kt == kwrite ) THEN
507         ! are we in write mode?
508         IF( iom_file(kiomid)%irec == -1 ) THEN   ! trick: irec used to know if the file is in define mode or not
509            CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo)   ;   iom_file(kiomid)%irec = 0
510         ENDIF
511         ! on what kind of domain must the data be written?
512         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN
513            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar)
514            IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN
515               ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
516            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN
517               ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
518            ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN
519               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
520            ELSE
521               CALL ctl_stop( 'iom_nf90_rp0123d: should have been an impossible case...' )
522            ENDIF
523
524            ! write dimension variables if it is not already done
525            ! =============
526            ! trick: is defined to 0 => dimension variable are defined but not yet written
527            IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN
528               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon'     , idmy ), clinfo)
529               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo)
530               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat'     , idmy ), clinfo)
531               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo)
532               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo)
533               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_0                 ), clinfo)
534               ! +++ WRONG VALUE: to be improved but not really useful...
535               CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)
536               CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo)   
537               ! update the values of the variables dimensions size
538               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)
539               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)
540               iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1)
541               CALL iom_nf90_check(NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)
542               iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension
543               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
544            ENDIF
545         ENDIF
546
547         ! write the data
548         ! =============
549         IF(     PRESENT(pv_r0d) ) THEN
550            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r0d                      ), clinfo)
551         ELSEIF( PRESENT(pv_r1d) ) THEN
552            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r1d(                  :) ), clinfo)
553         ELSEIF( PRESENT(pv_r2d) ) THEN
554            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2   ) ), clinfo)
555         ELSEIF( PRESENT(pv_r3d) ) THEN
556            CALL iom_nf90_check(NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)
557         ENDIF
558         ! add 1 to the size of the temporal dimension (not really useful...)
559         IF( iom_file(kiomid)%luld(idvar) )   iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar)    &
560               &                            = iom_file(kiomid)%dimsz(iom_file(kiomid)%ndims(idvar), idvar) + 1
561         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
562      ENDIF
563      !     
564   END SUBROUTINE iom_nf90_rp0123d
565
566
567   SUBROUTINE iom_nf90_check( kstatus, cdinfo )
568      !!--------------------------------------------------------------------
569      !!                   ***  SUBROUTINE iom_nf90_check  ***
570      !!
571      !! ** Purpose :   check nf90 errors
572      !!--------------------------------------------------------------------
573      INTEGER,          INTENT(in) :: kstatus
574      CHARACTER(LEN=*), INTENT(in) :: cdinfo
575      !---------------------------------------------------------------------
576      IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) )
577   END SUBROUTINE iom_nf90_check
578
579   !!======================================================================
580END MODULE iom_nf90
Note: See TracBrowser for help on using the repository browser.