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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

Last change on this file was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

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