source: NEMO/trunk/src/OCE/IOM/iom.F90 @ 14072

Last change on this file since 14072 was 14072, checked in by laurent, 4 months ago

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369

  • Property svn:keywords set to Id
File size: 137.5 KB
Line 
1MODULE iom
2   !!======================================================================
3   !!                    ***  MODULE  iom ***
4   !! Input/Output manager :  Library to read input files
5   !!======================================================================
6   !! History :  2.0  ! 2005-12  (J. Belier) Original code
7   !!            2.0  ! 2006-02  (S. Masson) Adaptation to NEMO
8   !!            3.0  ! 2007-07  (D. Storkey) Changes to iom_gettime
9   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add C1D case
10   !!            3.6  ! 2014-15  DIMG format removed
11   !!            3.6  ! 2015-15  (J. Harle) Added procedure to read REAL attributes
12   !!            4.0  ! 2017-11  (M. Andrejczuk) Extend IOM interface to write any 3D fields
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   iom_open       : open a file read only
17   !!   iom_close      : close a file or all files opened by iom
18   !!   iom_get        : read a field (interfaced to several routines)
19   !!   iom_varid      : get the id of a variable in a file
20   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
21   !!----------------------------------------------------------------------
22   USE dom_oce         ! ocean space and time domain
23   USE domutl          !
24   USE c1d             ! 1D vertical configuration
25   USE flo_oce         ! floats module declarations
26   USE lbclnk          ! lateal boundary condition / mpp exchanges
27   USE iom_def         ! iom variables definitions
28   USE iom_nf90        ! NetCDF format with native NetCDF library
29   USE in_out_manager  ! I/O manager
30   USE lib_mpp           ! MPP library
31   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
32   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes
33#if defined key_si3
34   USE ice      , ONLY :   jpl
35#endif
36   USE phycst          ! physical constants
37   USE dianam          ! build name of file
38#if defined key_iomput
39   USE xios
40# endif
41   USE ioipsl, ONLY :  ju2ymds    ! for calendar
42   USE crs             ! Grid coarsening
43#if defined key_top
44   USE trc, ONLY    :  profsed
45#endif
46   USE lib_fortran
47   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal
48   USE iom_nf90
49   USE netcdf
50
51   IMPLICIT NONE
52   PUBLIC   !   must be public to be able to access iom_def through iom
53
54#if defined key_iomput
55   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
56#else
57   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
58#endif
59   PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var
60   PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
61   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val
62   PUBLIC iom_xios_setid
63
64   PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
65   PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
66   PRIVATE iom_get_123d
67   PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
68   PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
69   PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
70   PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
71#if defined key_iomput
72   PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
73   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate
74   PRIVATE iom_set_rst_context, iom_set_vars_active
75# endif
76   PRIVATE set_xios_context
77   PRIVATE iom_set_rstw_active
78
79   INTERFACE iom_get
80      MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
81      MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
82   END INTERFACE
83   INTERFACE iom_getatt
84      MODULE PROCEDURE iom_g0d_iatt, iom_g1d_iatt, iom_g0d_ratt, iom_g1d_ratt, iom_g0d_catt
85   END INTERFACE
86   INTERFACE iom_putatt
87      MODULE PROCEDURE iom_p0d_iatt, iom_p1d_iatt, iom_p0d_ratt, iom_p1d_ratt, iom_p0d_catt
88   END INTERFACE
89   INTERFACE iom_rstput
90      MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
91      MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
92   END INTERFACE
93   INTERFACE iom_put
94      MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
95      MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
96   END INTERFACE iom_put
97
98   !! * Substitutions
99#  include "do_loop_substitute.h90"
100   !!----------------------------------------------------------------------
101   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
102   !! $Id$
103   !! Software governed by the CeCILL license (see ./LICENSE)
104   !!----------------------------------------------------------------------
105CONTAINS
106
107   SUBROUTINE iom_init( cdname, kdid, ld_closedef )
108      !!----------------------------------------------------------------------
109      !!                     ***  ROUTINE   ***
110      !!
111      !! ** Purpose :
112      !!
113      !!----------------------------------------------------------------------
114      CHARACTER(len=*),           INTENT(in)  :: cdname
115      INTEGER         , OPTIONAL, INTENT(in)  :: kdid
116      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef
117#if defined key_iomput
118      !
119      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
120      TYPE(xios_date)     :: start_date
121      CHARACTER(len=lc) :: clname
122      INTEGER             :: irefyear, irefmonth, irefday
123      INTEGER           :: ji
124      LOGICAL           :: llrst_context              ! is context related to restart
125      LOGICAL           :: llrstr, llrstw
126      INTEGER           :: inum
127      !
128      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
129      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries
130      LOGICAL ::   ll_closedef
131      LOGICAL ::   ll_exist
132      !!----------------------------------------------------------------------
133      !
134      ll_closedef = .TRUE.
135      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef
136      !
137      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
138      !
139      clname = cdname
140      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
141      CALL xios_context_initialize(TRIM(clname), mpi_comm_oce)
142      CALL iom_swap( cdname )
143
144      llrstr = (cdname == cr_ocerst_cxt) .OR. (cdname == cr_icerst_cxt)
145      llrstr = llrstr .OR. (cdname == cr_toprst_cxt)
146      llrstr = llrstr .OR. (cdname == cr_sedrst_cxt)
147
148      llrstw = (cdname == cw_ocerst_cxt) .OR. (cdname == cw_icerst_cxt)
149      llrstw = llrstw .OR. (cdname == cw_toprst_cxt)
150      llrstw = llrstw .OR. (cdname == cw_sedrst_cxt)
151
152      llrst_context = llrstr .OR. llrstw
153
154      ! Calendar type is now defined in xml file
155      IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear  = 1900
156      IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01
157      IF (.NOT.(xios_getvar('ref_day'  ,irefday  ))) irefday   = 01
158
159      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
160      CASE ( 1)   ;   CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
161          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
162      CASE ( 0)   ;   CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
163          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
164      CASE (30)   ;   CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),   &
165          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) )
166      END SELECT
167
168      ! horizontal grid definition
169      IF(.NOT.llrst_context) CALL set_scalar
170      !
171      IF( cdname == cxios_context ) THEN
172         CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. )
173         CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. )
174         CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. )
175         CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. )
176         CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. )
177         CALL set_grid_znl( gphit )
178         !
179         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
180            CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
181            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp))
182            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp))
183            CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
184            CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp))
185            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
186            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
187            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
188            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
189            CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif )
190         ENDIF
191      ENDIF
192      !
193      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN
194         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
195         !
196         CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. )
197         CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. )
198         CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. )
199         CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. )
200         CALL set_grid_znl( gphit_crs )
201          !
202         CALL dom_grid_glo   ! Return to parent grid domain
203         !
204         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata
205            CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp))
206            CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp))
207            CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp))
208            CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp))
209            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
210            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
211            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
212            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
213         ENDIF
214      ENDIF
215      !
216      ! vertical grid definition
217      IF(.NOT.llrst_context) THEN
218         CALL iom_set_axis_attr(  "deptht", paxis = gdept_1d )
219         CALL iom_set_axis_attr(  "depthu", paxis = gdept_1d )
220         CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d )
221         CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d )
222          CALL iom_set_axis_attr(  "depthf", paxis = gdept_1d )
223
224          ! ABL
225         IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios)
226            ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom
227            ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp
228            e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp
229         ENDIF
230         CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) )
231         CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) )
232
233         ! Add vertical grid bounds
234         zt_bnds(2,:      ) = gdept_1d(:)
235         zt_bnds(1,2:jpk  ) = gdept_1d(1:jpkm1)
236         zt_bnds(1,1      ) = gdept_1d(1) - e3w_1d(1)
237         zw_bnds(1,:      ) = gdepw_1d(:)
238         zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk)
239         zw_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk)
240         CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds )
241         CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds )
242         CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds )
243         CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds )
244          CALL iom_set_axis_attr(  "depthf", bounds=zw_bnds )
245
246         ! ABL
247         za_bnds(1,:) = ghw_abl(1:jpkam1)
248         za_bnds(2,:) = ghw_abl(2:jpka  )
249         CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds )
250         za_bnds(1,:) = ght_abl(2:jpka  )
251         za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka)
252         CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds )
253
254         CALL iom_set_axis_attr(  "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )
255# if defined key_si3
256         CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
257         ! SIMIP diagnostics (4 main arctic straits)
258         CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )
259# endif
260#if defined key_top
261         IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed )
262#endif
263         CALL iom_set_axis_attr( "icbcla", class_num )
264         CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )   ! strange syntaxe and idea...
265         CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) )   ! strange syntaxe and idea...
266         CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )   ! strange syntaxe and idea...
267         ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists)
268         INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist )
269         nbasin = 1 + 4 * COUNT( (/ll_exist/) )
270         CALL iom_set_axis_attr( "basin"  , (/ (REAL(ji,wp), ji=1,nbasin) /) )
271      ENDIF
272      !
273      ! automatic definitions of some of the xml attributs
274      IF(llrstr) THEN
275         IF(PRESENT(kdid)) THEN
276            CALL iom_set_rst_context(.TRUE.)
277!set which fields will be read from restart file
278            CALL iom_set_vars_active(kdid)
279         ELSE
280            CALL ctl_stop( 'iom_init:', 'restart read with XIOS: missing pointer to NETCDF file' )
281         ENDIF
282      ELSE IF(llrstw) THEN
283         CALL iom_set_rstw_file(iom_file(kdid)%name)
284      ELSE
285         CALL set_xmlatt
286      ENDIF
287      !
288      ! set time step length
289      dtime%second = rn_Dt
290      CALL xios_set_timestep( dtime )
291      !
292      ! conditional closure of context definition
293      IF ( ll_closedef ) CALL iom_init_closedef
294      !
295      DEALLOCATE( zt_bnds, zw_bnds )
296      !
297#endif
298      !
299   END SUBROUTINE iom_init
300
301   SUBROUTINE iom_init_closedef(cdname)
302      !!----------------------------------------------------------------------
303      !!            ***  SUBROUTINE iom_init_closedef  ***
304      !!----------------------------------------------------------------------
305      !!
306      !! ** Purpose : Closure of context definition
307      !!
308      !!----------------------------------------------------------------------
309      CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname
310#if defined key_iomput
311      LOGICAL :: llrstw
312
313      llrstw = .FALSE.
314      IF(PRESENT(cdname)) THEN
315         llrstw = (cdname == cw_ocerst_cxt)
316         llrstw = llrstw .OR. (cdname == cw_icerst_cxt)
317         llrstw = llrstw .OR. (cdname == cw_toprst_cxt)
318         llrstw = llrstw .OR. (cdname == cw_sedrst_cxt)
319      ENDIF
320
321      IF( llrstw ) THEN
322!set names of the fields in restart file IF using XIOS to write data
323         CALL iom_set_rst_context(.FALSE.)
324         CALL xios_close_context_definition()
325      ELSE
326         CALL xios_close_context_definition()
327         CALL xios_update_calendar( 0 )
328      ENDIF
329#else
330      IF( .FALSE. )   WRITE(numout,*) 'iom_init_closedef: should not see this'   ! useless statement to avoid compilation warnings
331#endif
332
333   END SUBROUTINE iom_init_closedef
334
335   SUBROUTINE iom_set_vars_active(idnum)
336      !!---------------------------------------------------------------------
337      !!                   ***  SUBROUTINE  iom_set_vars_active  ***
338      !!
339      !! ** Purpose :  define filename in XIOS context for reading file,
340      !!               enable variables present in a file for reading with XIOS
341      !!               id of the file is assumed to be rrestart.
342      !!---------------------------------------------------------------------
343      INTEGER, INTENT(IN) :: idnum
344
345#if defined key_iomput
346      INTEGER                                    :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims
347      TYPE(xios_field)                           :: field_hdl
348      TYPE(xios_file)                            :: file_hdl
349      TYPE(xios_filegroup)                       :: filegroup_hdl
350      INTEGER                                    :: dimids(4), jv,i, idim
351      CHARACTER(LEN=256)                         :: clinfo               ! info character
352      INTEGER, ALLOCATABLE                       :: indimlens(:)
353      CHARACTER(LEN=nf90_max_name), ALLOCATABLE  :: indimnames(:)
354      CHARACTER(LEN=nf90_max_name)               :: dimname, varname
355      INTEGER                                    :: iln
356      CHARACTER(LEN=lc)                          :: fname
357      LOGICAL                                    :: lmeta
358!metadata in restart file for restart read with XIOS
359      INTEGER, PARAMETER                         :: NMETA = 10
360      CHARACTER(LEN=lc)                          :: meta(NMETA)
361
362
363      meta(1) = "nav_lat"
364      meta(2) = "nav_lon"
365      meta(3) = "nav_lev"
366      meta(4) = "time_instant"
367      meta(5) = "time_instant_bounds"
368      meta(6) = "time_counter"
369      meta(7) = "time_counter_bounds"
370      meta(8) = "x"
371      meta(9) = "y"
372      meta(10) = "numcat"
373
374      clinfo = '          iom_set_vars_active, file: '//TRIM(iom_file(idnum)%name)
375
376      iln = INDEX( iom_file(idnum)%name, '.nc' )
377!XIOS doee not need .nc
378      IF(iln > 0) THEN
379        fname =  iom_file(idnum)%name(1:iln-1)
380      ELSE
381        fname =  iom_file(idnum)%name
382      ENDIF
383
384!set name of the restart file and enable available fields
385      CALL xios_get_handle("file_definition", filegroup_hdl )
386      CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart')
387      CALL xios_set_file_attr( "rrestart", name=fname, type="one_file",      &
388           par_access="collective", enabled=.TRUE., mode="read",              &
389                                                    output_freq=xios_timestep )
390
391      CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, ndims, nvars, natts ), clinfo )
392      ALLOCATE(indimlens(ndims), indimnames(ndims))
393      CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, unlimitedDimId = unlimitedDimId ), clinfo )
394
395      DO idim = 1, ndims
396         CALL iom_nf90_check( nf90_inquire_dimension(iom_file(idnum)%nfid, idim, dimname, dimlen ), clinfo )
397         indimlens(idim) = dimlen
398         indimnames(idim) = dimname
399      ENDDO
400
401      DO jv =1, nvars
402         lmeta = .FALSE.
403         CALL iom_nf90_check( nf90_inquire_variable(iom_file(idnum)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo )
404         DO i = 1, NMETA
405           IF(varname == meta(i)) THEN
406             lmeta = .TRUE.
407           ENDIF
408         ENDDO
409         IF(.NOT.lmeta) THEN
410            CALL xios_add_child(file_hdl, field_hdl, varname)
411            mdims = ndims
412
413            IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN
414               mdims = mdims - 1
415            ENDIF
416
417            IF(mdims == 3) THEN
418               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname,   &
419                                   domain_ref="grid_N",                           &
420                                   axis_ref=iom_axis(indimlens(dimids(mdims))),   &
421                                   prec = 8, operation = "instant"                )
422            ELSEIF(mdims == 2) THEN
423               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname,  &
424                                   domain_ref="grid_N", prec = 8,                &
425                                   operation = "instant"                         )
426            ELSEIF(mdims == 1) THEN
427               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, &
428                                   axis_ref=iom_axis(indimlens(dimids(mdims))), &
429                                   prec = 8, operation = "instant"              )
430            ELSEIF(mdims == 0) THEN
431               CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, &
432                                   scalar_ref = "grid_scalar", prec = 8,        &
433                                   operation = "instant"                        )
434            ELSE
435               WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions'
436               CALL ctl_stop( 'iom_set_vars_active:', ctmp1 )
437            ENDIF
438         ENDIF
439      ENDDO
440      DEALLOCATE(indimlens, indimnames)
441#endif
442   END SUBROUTINE iom_set_vars_active
443
444   SUBROUTINE iom_set_rstw_file(cdrst_file)
445      !!---------------------------------------------------------------------
446      !!                   ***  SUBROUTINE iom_set_rstw_file   ***
447      !!
448      !! ** Purpose :  define file name in XIOS context for writing restart
449      !!---------------------------------------------------------------------
450      CHARACTER(len=*) :: cdrst_file
451#if defined key_iomput
452      TYPE(xios_file) :: file_hdl
453      TYPE(xios_filegroup) :: filegroup_hdl
454
455!set name of the restart file and enable available fields
456      IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ', TRIM(cdrst_file)
457      CALL xios_get_handle("file_definition", filegroup_hdl )
458      CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart')
459      IF(nxioso.eq.1) THEN
460         CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,&
461                                       mode="write", output_freq=xios_timestep)
462         IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode'
463      ELSE
464         CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,&
465                                            mode="write", output_freq=xios_timestep)
466         IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode'
467      ENDIF
468      CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file))
469#endif
470   END SUBROUTINE iom_set_rstw_file
471
472
473   SUBROUTINE iom_set_rstw_active(sdfield, rd0, rs0, rd1, rs1, rd2, rs2, rd3, rs3)
474      !!---------------------------------------------------------------------
475      !!                   ***  SUBROUTINE iom_set_rstw_active   ***
476      !!
477      !! ** Purpose :  define file name in XIOS context for writing restart
478      !!               enable variables present in restart file for writing
479      !!---------------------------------------------------------------------
480!sets enabled = .TRUE. for each field in restart file
481      CHARACTER(len = *), INTENT(IN)                     :: sdfield
482      REAL(dp), OPTIONAL, INTENT(IN)                     :: rd0
483      REAL(sp), OPTIONAL, INTENT(IN)                     :: rs0
484      REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:)       :: rd1
485      REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:)       :: rs1
486      REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :)    :: rd2
487      REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :)    :: rs2
488      REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3
489      REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3
490#if defined key_iomput
491      TYPE(xios_field) :: field_hdl
492      TYPE(xios_file) :: file_hdl
493
494      CALL xios_get_handle("wrestart", file_hdl)
495!define fields for restart context
496      CALL xios_add_child(file_hdl, field_hdl, sdfield)
497
498      IF(PRESENT(rd3)) THEN
499         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
500                             domain_ref = "grid_N",                       &
501                             axis_ref = iom_axis(size(rd3, 3)),           &
502                             prec = 8, operation = "instant"              )
503      ELSEIF(PRESENT(rs3)) THEN
504         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
505                             domain_ref = "grid_N",                       &
506                             axis_ref = iom_axis(size(rd3, 3)),           &
507                             prec = 4, operation = "instant"              )
508      ELSEIF(PRESENT(rd2)) THEN
509         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
510                             domain_ref = "grid_N", prec = 8,             &
511                             operation = "instant"                        )
512      ELSEIF(PRESENT(rs2)) THEN
513         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
514                             domain_ref = "grid_N", prec = 4,             &
515                             operation = "instant"                        )
516      ELSEIF(PRESENT(rd1)) THEN
517         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
518                             axis_ref = iom_axis(size(rd1, 1)),           &
519                             prec = 8, operation = "instant"              )
520      ELSEIF(PRESENT(rs1)) THEN
521         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
522                             axis_ref = iom_axis(size(rd1, 1)),           &
523                             prec = 4, operation = "instant"              )
524      ELSEIF(PRESENT(rd0)) THEN
525         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
526                             scalar_ref = "grid_scalar", prec = 8,        &
527                             operation = "instant"                        )
528      ELSEIF(PRESENT(rs0)) THEN
529         CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
530                             scalar_ref = "grid_scalar", prec = 4,        &
531                             operation = "instant"                        )
532      ENDIF
533#endif
534   END SUBROUTINE iom_set_rstw_active
535
536   FUNCTION iom_axis(idlev) result(axis_ref)
537      !!---------------------------------------------------------------------
538      !!                   ***  FUNCTION  iom_axis  ***
539      !!
540      !! ** Purpose : Used for grid definition when XIOS is used to read/write
541      !!              restart. Returns axis corresponding to the number of levels
542      !!              given as an input variable. Axes are defined in routine
543      !!              iom_set_rst_context
544      !!---------------------------------------------------------------------
545      INTEGER, INTENT(IN) :: idlev
546      CHARACTER(len=lc)   :: axis_ref
547      CHARACTER(len=12)   :: str
548      IF(idlev == jpk) THEN
549         axis_ref="nav_lev"
550#if defined key_si3
551      ELSEIF(idlev == jpl) THEN
552         axis_ref="numcat"
553#endif
554      ELSE
555         write(str, *) idlev
556         CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing')
557      ENDIF
558   END FUNCTION iom_axis
559
560   FUNCTION iom_xios_setid(cdname) result(kid)
561     !!---------------------------------------------------------------------
562      !!                   ***  FUNCTION    ***
563      !!
564      !! ** Purpose : this function returns first available id to keep information about file
565      !!              sets filename in iom_file structure and sets name
566      !!              of XIOS context depending on cdcomp
567      !!              corresponds to iom_nf90_open
568      !!---------------------------------------------------------------------
569      CHARACTER(len=*), INTENT(in   ) :: cdname      ! File name
570      INTEGER                         :: kid      ! identifier of the opened file
571      INTEGER                         :: jl
572
573      kid = 0
574      DO jl = jpmax_files, 1, -1
575         IF( iom_file(jl)%nfid == 0 )   kid = jl
576      ENDDO
577
578      iom_file(kid)%name   = TRIM(cdname)
579      iom_file(kid)%nfid   = 1
580      iom_file(kid)%nvars  = 0
581      iom_file(kid)%irec   = -1
582
583   END FUNCTION iom_xios_setid
584
585   SUBROUTINE iom_set_rst_context(ld_rstr)
586      !!---------------------------------------------------------------------
587      !!                   ***  SUBROUTINE  iom_set_rst_context  ***
588      !!
589      !! ** Purpose : Define domain, axis and grid for restart (read/write)
590      !!              context
591      !!
592      !!---------------------------------------------------------------------
593      LOGICAL, INTENT(IN)               :: ld_rstr
594      INTEGER :: ji
595#if defined key_iomput
596      TYPE(xios_domaingroup)            :: domaingroup_hdl
597      TYPE(xios_domain)                 :: domain_hdl
598      TYPE(xios_axisgroup)              :: axisgroup_hdl
599      TYPE(xios_axis)                   :: axis_hdl
600      TYPE(xios_scalar)                 :: scalar_hdl
601      TYPE(xios_scalargroup)            :: scalargroup_hdl
602
603      CALL xios_get_handle("domain_definition",domaingroup_hdl)
604      CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")
605      CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)
606
607      CALL xios_get_handle("axis_definition",axisgroup_hdl)
608      CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")
609!AGRIF fails to compile when unit= is in call to xios_set_axis_attr
610!     CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels",  unit="m", positive="down")
611      CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down")
612      CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d )
613#if defined key_si3
614      CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat")
615      CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) )
616#endif
617      CALL xios_get_handle("scalar_definition", scalargroup_hdl)
618      CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar")
619#endif
620   END SUBROUTINE iom_set_rst_context
621
622
623   SUBROUTINE set_xios_context(kdid, cdcont)
624      !!---------------------------------------------------------------------
625      !!                   ***  SUBROUTINE  iom_set_rst_context  ***
626      !!
627      !! ** Purpose : set correct XIOS context based on kdid
628      !!
629      !!---------------------------------------------------------------------
630      INTEGER,           INTENT(IN)     :: kdid           ! Identifier of the file
631      CHARACTER(LEN=lc), INTENT(OUT)    :: cdcont         ! name of the context for XIOS read/write
632
633      cdcont = "NONE"
634
635      IF(lrxios) THEN
636         IF(kdid == numror) THEN
637            cdcont = cr_ocerst_cxt
638         ELSEIF(kdid == numrir) THEN
639            cdcont = cr_icerst_cxt
640         ELSEIF(kdid == numrtr) THEN
641            cdcont = cr_toprst_cxt
642         ELSEIF(kdid == numrsr) THEN
643            cdcont = cr_sedrst_cxt
644         ENDIF
645      ENDIF
646
647      IF(lwxios) THEN
648         IF(kdid == numrow) THEN
649            cdcont = cw_ocerst_cxt
650         ELSEIF(kdid == numriw) THEN
651            cdcont = cw_icerst_cxt
652         ELSEIF(kdid == numrtw) THEN
653            cdcont = cw_toprst_cxt
654         ELSEIF(kdid == numrsw) THEN
655            cdcont = cw_sedrst_cxt
656         ENDIF
657      ENDIF
658   END SUBROUTINE set_xios_context
659
660
661   SUBROUTINE iom_swap( cdname )
662      !!---------------------------------------------------------------------
663      !!                   ***  SUBROUTINE  iom_swap  ***
664      !!
665      !! ** Purpose :  swap context between different agrif grid for xmlio_server
666      !!---------------------------------------------------------------------
667      CHARACTER(len=*), INTENT(in) :: cdname
668#if defined key_iomput
669      TYPE(xios_context) :: nemo_hdl
670      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
671        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
672      ELSE
673        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
674      ENDIF
675      !
676      CALL xios_set_current_context(nemo_hdl)
677#endif
678      !
679   END SUBROUTINE iom_swap
680
681
682   SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp )
683      !!---------------------------------------------------------------------
684      !!                   ***  SUBROUTINE  iom_open  ***
685      !!
686      !! ** Purpose :  open an input file (return 0 if not found)
687      !!---------------------------------------------------------------------
688      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
689      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
690      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
691      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
692      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
693      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels
694      CHARACTER(len=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open
695      !
696      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
697      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
698      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc"
699      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
700      CHARACTER(LEN=256)    ::   clinfo    ! info character
701      LOGICAL               ::   llok      ! check the existence
702      LOGICAL               ::   llwrt     ! local definition of ldwrt
703      LOGICAL               ::   llstop    ! local definition of ldstop
704      LOGICAL               ::   lliof     ! local definition of ldiof
705      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
706      INTEGER               ::   iln, ils  ! lengths of character
707      INTEGER               ::   istop     !
708      ! local number of points for x,y dimensions
709      ! position of first local point for x,y dimensions
710      ! position of last local point for x,y dimensions
711      ! start halo size for x,y dimensions
712      ! end halo size for x,y dimensions
713      !---------------------------------------------------------------------
714      ! Initializations and control
715      ! =============
716      kiomid = -1
717      clinfo = '                    iom_open ~~~  '
718      istop = nstop
719      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
720      ! (could be done when defining iom_file in f95 but not in f90)
721      IF( Agrif_Root() ) THEN
722         IF( iom_open_init == 0 ) THEN
723            iom_file(:)%nfid = 0
724            iom_open_init = 1
725         ENDIF
726      ENDIF
727      ! do we read or write the file?
728      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
729      ELSE                        ;   llwrt = .FALSE.
730      ENDIF
731      ! do we call ctl_stop if we try to open a non-existing file in read mode?
732      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
733      ELSE                         ;   llstop = .TRUE.
734      ENDIF
735      ! are we using interpolation on the fly?
736      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof
737      ELSE                        ;   lliof = .FALSE.
738      ENDIF
739      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
740      ! =============
741      clname   = trim(cdname)
742      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
743         iln    = INDEX(clname,'/')
744         cltmpn = clname(1:iln)
745         clname = clname(iln+1:LEN_TRIM(clname))
746         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
747      ENDIF
748      ! which suffix should we use?
749      clsuffix = '.nc'
750      ! Add the suffix if needed
751      iln = LEN_TRIM(clname)
752      ils = LEN_TRIM(clsuffix)
753      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
754         &   clname = TRIM(clname)//TRIM(clsuffix)
755      cltmpn = clname   ! store this name
756      ! try to find if the file to be opened already exist
757      ! =============
758      INQUIRE( FILE = clname, EXIST = llok )
759      IF( .NOT.llok ) THEN
760         ! we try to add the cpu number to the name
761         WRITE(clcpu,*) narea-1
762
763         clcpu  = TRIM(ADJUSTL(clcpu))
764         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
765         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
766         icnt = 0
767         INQUIRE( FILE = clname, EXIST = llok )
768         ! we try different formats for the cpu number by adding 0
769         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
770            clcpu  = "0"//trim(clcpu)
771            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
772            INQUIRE( FILE = clname, EXIST = llok )
773            icnt = icnt + 1
774         END DO
775      ELSE
776         lxios_sini = .TRUE.
777      ENDIF
778      ! Open the NetCDF file
779      ! =============
780      ! do we have some free file identifier?
781      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
782         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
783      ! if no file was found...
784      IF( .NOT. llok ) THEN
785         IF( .NOT. llwrt ) THEN   ! we are in read mode
786            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
787            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
788            ENDIF
789         ELSE                     ! we are in write mode so we
790            clname = cltmpn       ! get back the file name without the cpu number
791         ENDIF
792      ELSE
793         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file
794            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
795            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
796         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to
797            clname = cltmpn       ! overwrite so get back the file name without the cpu number
798         ENDIF
799      ENDIF
800      IF( istop == nstop ) THEN   ! no error within this routine
801         CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp )
802      ENDIF
803      !
804   END SUBROUTINE iom_open
805
806
807   SUBROUTINE iom_close( kiomid )
808      !!--------------------------------------------------------------------
809      !!                   ***  SUBROUTINE  iom_close  ***
810      !!
811      !! ** Purpose : close an input file, or all files opened by iom
812      !!--------------------------------------------------------------------
813      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
814      !                                              ! return 0 when file is properly closed
815      !                                              ! No argument: all files opened by iom are closed
816
817      INTEGER ::   jf         ! dummy loop indices
818      INTEGER ::   i_s, i_e   ! temporary integer
819      CHARACTER(LEN=100)    ::   clinfo    ! info character
820      !---------------------------------------------------------------------
821      !
822      IF( iom_open_init == 0 )   RETURN   ! avoid to use iom_file(jf)%nfid that us not yet initialized
823      !
824      clinfo = '                    iom_close ~~~  '
825      IF( PRESENT(kiomid) ) THEN
826         i_s = kiomid
827         i_e = kiomid
828      ELSE
829         i_s = 1
830         i_e = jpmax_files
831      ENDIF
832
833      IF( i_s > 0 ) THEN
834         DO jf = i_s, i_e
835            IF( iom_file(jf)%nfid > 0 ) THEN
836               CALL iom_nf90_close( jf )
837               iom_file(jf)%nfid       = 0          ! free the id
838               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
839               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
840            ELSEIF( PRESENT(kiomid) ) THEN
841               WRITE(ctmp1,*) '--->',  kiomid
842               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
843            ENDIF
844         END DO
845      ENDIF
846      !
847   END SUBROUTINE iom_close
848
849
850   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop )
851      !!-----------------------------------------------------------------------
852      !!                  ***  FUNCTION  iom_varid  ***
853      !!
854      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
855      !!-----------------------------------------------------------------------
856      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
857      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
858      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension
859      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions
860      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time)
861      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
862      !
863      INTEGER                        ::   iom_varid, iiv, i_nvd
864      LOGICAL                        ::   ll_fnd
865      CHARACTER(LEN=100)             ::   clinfo                   ! info character
866      LOGICAL                        ::   llstop                   ! local definition of ldstop
867      !!-----------------------------------------------------------------------
868      iom_varid = 0                         ! default definition
869      ! do we call ctl_stop if we look for non-existing variable?
870      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
871      ELSE                         ;   llstop = .TRUE.
872      ENDIF
873      !
874      IF( kiomid > 0 ) THEN
875         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
876         IF( iom_file(kiomid)%nfid == 0 ) THEN
877            CALL ctl_stop( trim(clinfo), 'the file is not open' )
878         ELSE
879            ll_fnd  = .FALSE.
880            iiv = 0
881            !
882            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
883               iiv = iiv + 1
884               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
885            END DO
886            !
887            IF( .NOT.ll_fnd ) THEN
888               iiv = iiv + 1
889               IF( iiv <= jpmax_vars ) THEN
890                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld )
891               ELSE
892                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
893                        &                      'increase the parameter jpmax_vars')
894               ENDIF
895               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' )
896            ELSE
897               iom_varid = iiv
898               IF( PRESENT(kdimsz) ) THEN
899                  i_nvd = iom_file(kiomid)%ndims(iiv)
900                  IF( i_nvd <= size(kdimsz) ) THEN
901                     kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
902                  ELSE
903                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
904                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
905                  ENDIF
906               ENDIF
907               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
908               IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld( iiv)
909            ENDIF
910         ENDIF
911      ENDIF
912      !
913   END FUNCTION iom_varid
914
915
916   !!----------------------------------------------------------------------
917   !!                   INTERFACE iom_get
918   !!----------------------------------------------------------------------
919   SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime )
920      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
921      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
922      REAL(sp)        , INTENT(  out)                 ::   pvar      ! read field
923      REAL(dp)                                        ::   ztmp_pvar ! tmp var to read field
924      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
925      !
926      INTEGER                                         ::   idvar     ! variable id
927      INTEGER                                         ::   idmspc    ! number of spatial dimensions
928      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
929      CHARACTER(LEN=100)                              ::   clinfo    ! info character
930      CHARACTER(LEN=100)                              ::   clname    ! file name
931      CHARACTER(LEN=1)                                ::   cldmspc   !
932      CHARACTER(LEN=lc)                               ::   context
933      !
934      CALL set_xios_context(kiomid, context)
935
936      IF(context == "NONE") THEN  ! read data using default library
937         itime = 1
938         IF( PRESENT(ktime) ) itime = ktime
939         !
940         clname = iom_file(kiomid)%name
941         clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
942         !
943         IF( kiomid > 0 ) THEN
944            idvar = iom_varid( kiomid, cdvar )
945            IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
946               idmspc = iom_file ( kiomid )%ndims( idvar )
947               IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
948               WRITE(cldmspc , fmt='(i1)') idmspc
949               IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
950                                    &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
951                                    &                         'Use ncwa -a to suppress the unnecessary dimensions' )
952               CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime )
953               pvar = ztmp_pvar
954            ENDIF
955         ENDIF
956      ELSE
957#if defined key_iomput
958         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar)
959         CALL iom_swap(context)
960         CALL xios_recv_field( trim(cdvar), pvar)
961         CALL iom_swap(cxios_context)
962#else
963         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar)
964         CALL ctl_stop( 'iom_g0d', ctmp1 )
965#endif
966      ENDIF
967   END SUBROUTINE iom_g0d_sp
968
969   SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime )
970      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
971      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
972      REAL(dp)        , INTENT(  out)                 ::   pvar      ! read field
973      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
974      !
975      INTEGER                                         ::   idvar     ! variable id
976      INTEGER                                         ::   idmspc    ! number of spatial dimensions
977      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
978      CHARACTER(LEN=100)                              ::   clinfo    ! info character
979      CHARACTER(LEN=100)                              ::   clname    ! file name
980      CHARACTER(LEN=1)                                ::   cldmspc   !
981      CHARACTER(LEN=lc)                               ::   context
982      !
983      CALL set_xios_context(kiomid, context)
984
985      IF(context == "NONE") THEN  ! read data using default library
986         itime = 1
987         IF( PRESENT(ktime) ) itime = ktime
988         !
989         clname = iom_file(kiomid)%name
990         clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
991         !
992         IF( kiomid > 0 ) THEN
993            idvar = iom_varid( kiomid, cdvar )
994            IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
995               idmspc = iom_file ( kiomid )%ndims( idvar )
996               IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
997               WRITE(cldmspc , fmt='(i1)') idmspc
998               IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
999                                    &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
1000                                    &                         'Use ncwa -a to suppress the unnecessary dimensions' )
1001               CALL iom_nf90_get( kiomid, idvar, pvar, itime )
1002            ENDIF
1003         ENDIF
1004      ELSE
1005#if defined key_iomput
1006         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar)
1007         CALL iom_swap(context)
1008         CALL xios_recv_field( trim(cdvar), pvar)
1009         CALL iom_swap(cxios_context)
1010#else
1011         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar)
1012         CALL ctl_stop( 'iom_g0d', ctmp1 )
1013#endif
1014      ENDIF
1015   END SUBROUTINE iom_g0d_dp
1016
1017   SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
1018      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
1019      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
1020      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
1021      REAL(sp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
1022      REAL(dp)        , ALLOCATABLE  , DIMENSION(:)           ::   ztmp_pvar ! tmp var to read field
1023      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
1024      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading
1025      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
1026      !
1027      IF( kiomid > 0 ) THEN
1028         IF( iom_file(kiomid)%nfid > 0 ) THEN
1029            ALLOCATE(ztmp_pvar(size(pvar,1)))
1030            CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=ztmp_pvar,   &
1031              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
1032            pvar = ztmp_pvar
1033            DEALLOCATE(ztmp_pvar)
1034         END IF
1035      ENDIF
1036   END SUBROUTINE iom_g1d_sp
1037
1038
1039   SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
1040      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
1041      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
1042      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
1043      REAL(dp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
1044      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
1045      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading
1046      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
1047      !
1048      IF( kiomid > 0 ) THEN
1049         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
1050              &                                                     ktime=ktime, kstart=kstart, kcount=kcount)
1051      ENDIF
1052   END SUBROUTINE iom_g1d_dp
1053
1054   SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount)
1055      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
1056      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
1057      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
1058      REAL(sp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field
1059      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)         ::   ztmp_pvar ! tmp var to read field
1060      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
1061      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
1062      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
1063      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
1064      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading
1065      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis
1066      !
1067      IF( kiomid > 0 ) THEN
1068         IF( iom_file(kiomid)%nfid > 0 ) THEN
1069            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2)))
1070            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = ztmp_pvar  , ktime = ktime,   &
1071             &                                                      cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
1072             &                                                      kstart  = kstart , kcount = kcount  )
1073            pvar = ztmp_pvar
1074            DEALLOCATE(ztmp_pvar)
1075         ENDIF
1076      ENDIF
1077   END SUBROUTINE iom_g2d_sp
1078
1079   SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount)
1080      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
1081      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
1082      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
1083      REAL(dp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field
1084      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
1085      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
1086      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold
1087      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
1088      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading
1089      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis
1090      !
1091      IF( kiomid > 0 ) THEN
1092         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = pvar  , ktime = ktime,   &
1093            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
1094            &                                                       kstart  = kstart , kcount = kcount                )
1095      ENDIF
1096   END SUBROUTINE iom_g2d_dp
1097
1098   SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount )
1099      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
1100      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
1101      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
1102      REAL(sp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field
1103      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)       ::   ztmp_pvar ! tmp var to read field
1104      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
1105      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
1106      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
1107      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
1108      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading
1109      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis
1110      !
1111      IF( kiomid > 0 ) THEN
1112         IF( iom_file(kiomid)%nfid > 0 ) THEN
1113            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3)))
1114            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = ztmp_pvar  , ktime = ktime,   &
1115            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
1116            &                                                       kstart  = kstart , kcount = kcount                )
1117            pvar = ztmp_pvar
1118            DEALLOCATE(ztmp_pvar)
1119         END IF
1120      ENDIF
1121   END SUBROUTINE iom_g3d_sp
1122
1123   SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount )
1124      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
1125      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
1126      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
1127      REAL(dp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field
1128      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
1129      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
1130      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
1131      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
1132      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading
1133      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis
1134      !
1135      IF( kiomid > 0 ) THEN
1136         IF( iom_file(kiomid)%nfid > 0 ) THEN
1137            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = pvar  , ktime = ktime,   &
1138            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   &
1139            &                                                       kstart  = kstart , kcount = kcount                )
1140         END IF
1141      ENDIF
1142   END SUBROUTINE iom_g3d_dp
1143
1144   !!----------------------------------------------------------------------
1145
1146   SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime ,   &
1147         &                  cd_type, psgn, kfill, kstart, kcount )
1148      !!-----------------------------------------------------------------------
1149      !!                  ***  ROUTINE  iom_get_123d  ***
1150      !!
1151      !! ** Purpose : read a 1D/2D/3D variable
1152      !!
1153      !! ** Method : read ONE record at each CALL
1154      !!-----------------------------------------------------------------------
1155      INTEGER                    , INTENT(in   )           ::   kiomid    ! Identifier of the file
1156      INTEGER                    , INTENT(in   )           ::   kdom      ! Type of domain to be read
1157      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar     ! Name of the variable
1158      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case)
1159      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case)
1160      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case)
1161      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number
1162      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W)
1163      REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold
1164      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk
1165      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis
1166      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount    ! number of points to be read in each axis
1167      !
1168      LOGICAL                        ::   llok        ! true if ok!
1169      INTEGER                        ::   jl          ! loop on number of dimension
1170      INTEGER                        ::   idom        ! type of domain
1171      INTEGER                        ::   idvar       ! id of the variable
1172      INTEGER                        ::   inbdim      ! number of dimensions of the variable
1173      INTEGER                        ::   idmspc      ! number of spatial dimensions
1174      INTEGER                        ::   itime       ! record number
1175      INTEGER                        ::   istop       ! temporary value of nstop
1176      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
1177      INTEGER                        ::   ji, jj      ! loop counters
1178      INTEGER                        ::   irankpv     !
1179      INTEGER                        ::   ind1, ind2  ! substring index
1180      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
1181      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis
1182      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
1183      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
1184      REAL(dp)                       ::   zscf, zofs  ! sacle_factor and add_offset
1185      REAL(wp)                       ::   zsgn        ! local value of psgn
1186      INTEGER                        ::   itmp        ! temporary integer
1187      CHARACTER(LEN=256)             ::   clinfo      ! info character
1188      CHARACTER(LEN=256)             ::   clname      ! file name
1189      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !
1190      CHARACTER(LEN=1)               ::   cl_type     ! local value of cd_type
1191      LOGICAL                        ::   ll_only3rd  ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
1192      INTEGER                        ::   inlev       ! number of levels for 3D data
1193      REAL(dp)                       ::   gma, gmi
1194      !---------------------------------------------------------------------
1195      CHARACTER(LEN=lc)                               ::   context
1196      !
1197      CALL set_xios_context(kiomid, context)
1198      inlev = -1
1199      IF( PRESENT(pv_r3d) )   inlev = SIZE(pv_r3d, 3)
1200      !
1201      idom = kdom
1202      istop = nstop
1203      !
1204      IF(context == "NONE") THEN
1205         clname = iom_file(kiomid)%name   !   esier to read
1206         clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
1207         ! check kcount and kstart optionals parameters...
1208         IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
1209         IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
1210         IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) &
1211            &          CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy')
1212         IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) &
1213            &          CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present')
1214         !
1215         ! Search for the variable in the data base (eventually actualize data)
1216         !
1217         idvar = iom_varid( kiomid, cdvar )
1218         IF( idvar > 0 ) THEN
1219            !
1220            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)      ! to write iom_file(kiomid)%dimsz in a shorter way
1221            inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
1222            idmspc = inbdim                                   ! number of spatial dimensions in the file
1223            IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
1224            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')
1225            !
1226            ! Identify the domain in case of jpdom_auto definition
1227            IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN
1228               idom = jpdom_global   ! default
1229               ! else: if the file name finishes with _xxxx.nc with xxxx any number
1230               ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
1231               ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
1232               IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
1233            ENDIF
1234            !
1235            ! check the consistency between input array and data rank in the file
1236            !
1237            ! initializations
1238            itime = 1
1239            IF( PRESENT(ktime) ) itime = ktime
1240            !
1241            irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
1242            WRITE(clrankpv, fmt='(i1)') irankpv
1243            WRITE(cldmspc , fmt='(i1)') idmspc
1244            !
1245            IF(     idmspc <  irankpv ) THEN                     ! it seems we want to read more than we can...
1246               IF(     irankpv == 3 .AND. idmspc == 2 ) THEN     !   3D input array from 2D spatial data in the file:
1247                  llok = inlev == 1                              !     -> 3rd dimension must be equal to 1
1248               ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN     !   3D input array from 1D spatial data in the file:
1249                  llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1   !     -> 2nd and 3rd dimensions must be equal to 1
1250               ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN     !   2D input array from 1D spatial data in the file:
1251                  llok = SIZE(pv_r2d, 2) == 1                    !     -> 2nd dimension must be equal to 1
1252               ELSE
1253                  llok = .FALSE.
1254               ENDIF
1255               IF( .NOT. llok )   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
1256                  &                                            '=> cannot read a true '//clrankpv//'D array from this file...' )
1257            ELSEIF( idmspc == irankpv ) THEN
1258               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
1259                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
1260            ELSEIF( idmspc >  irankpv ) THEN                     ! it seems we want to read less than we should...
1261                  IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
1262                     CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...'              ,   &
1263                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
1264                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )
1265                     idmspc = idmspc - 1
1266                  !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation
1267                  !ELSE
1268                  !   CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,',   &
1269                  !      &                         'we do not accept data with '//cldmspc//' spatial dimensions'  ,   &
1270                  !      &                         'Use ncwa -a to suppress the unnecessary dimensions' )
1271                  ENDIF
1272            ENDIF
1273            !
1274            ! definition of istart and icnt
1275            !
1276            icnt  (:) = 1              ! default definition (simple way to deal with special cases listed above)
1277            istart(:) = 1              ! default definition (simple way to deal with special cases listed above)
1278            istart(idmspc+1) = itime   ! temporal dimenstion
1279            !
1280            IF( idom == jpdom_unknown ) THEN
1281               IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN
1282                  istart(1:idmspc) = kstart(1:idmspc)
1283                  icnt  (1:idmspc) = kcount(1:idmspc)
1284               ELSE
1285                  icnt  (1:idmspc) = idimsz(1:idmspc)
1286               ENDIF
1287            ELSE   !   not a 1D array as pv_r1d requires jpdom_unknown
1288               ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0
1289               IF( idom == jpdom_global )   istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /)
1290               icnt(1:2) = (/ Ni_0, Nj_0 /)
1291               IF( PRESENT(pv_r3d) ) THEN
1292                  IF( idom == jpdom_auto_xy ) THEN
1293                     istart(3) = kstart(3)
1294                     icnt  (3) = kcount(3)
1295                  ELSE
1296                     icnt  (3) = inlev
1297                  ENDIF
1298               ENDIF
1299            ENDIF
1300            !
1301            ! check that istart and icnt can be used with this file
1302            !-
1303            DO jl = 1, jpmax_dims
1304               itmp = istart(jl)+icnt(jl)-1
1305               IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
1306                  WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
1307                  WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
1308                  CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )
1309               ENDIF
1310            END DO
1311            !
1312            ! check that icnt matches the input array
1313            !-
1314            IF( idom == jpdom_unknown ) THEN
1315               IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
1316               IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
1317               IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
1318               ctmp1 = 'd'
1319            ELSE
1320               IF( irankpv == 2 ) THEN
1321                  ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0  ))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)'
1322               ENDIF
1323               IF( irankpv == 3 ) THEN
1324                  ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)'
1325               ENDIF
1326            ENDIF
1327            DO jl = 1, irankpv
1328               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
1329               IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
1330            END DO
1331
1332         ENDIF
1333
1334         ! read the data
1335         !-
1336         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
1337            !
1338            ! find the right index of the array to be read
1339            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = Nis0   ;   ix2 = Nie0      ;   iy1 = Njs0   ;   iy2 = Nje0
1340            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
1341            ENDIF
1342
1343            CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, pv_r3d )
1344
1345            IF( istop == nstop ) THEN   ! no additional errors until this point...
1346               IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
1347
1348               cl_type = 'T'
1349               IF( PRESENT(cd_type) )   cl_type = cd_type
1350               zsgn = 1._wp
1351               IF( PRESENT(psgn   ) )   zsgn    = psgn
1352               !--- overlap areas and extra hallows (mpp)
1353               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1354                  CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill )
1355               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1356                  CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill )
1357               ENDIF
1358               !
1359            ELSE
1360               ! return if istop == nstop is false
1361               RETURN
1362            ENDIF
1363         ELSE
1364            ! return if statment idvar > 0 .AND. istop == nstop is false
1365            RETURN
1366         ENDIF
1367         !
1368      ELSE        ! read using XIOS. Only if KEY_IOMPUT is defined
1369#if defined key_iomput
1370!would be good to be able to check which context is active and swap only if current is not restart
1371         idvar = iom_varid( kiomid, cdvar )
1372         CALL iom_swap(context)
1373         zsgn = 1._wp
1374         IF( PRESENT(psgn   ) )   zsgn    = psgn
1375         cl_type = 'T'
1376         IF( PRESENT(cd_type) )   cl_type = cd_type
1377
1378         IF( PRESENT(pv_r3d) ) THEN
1379            IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar)
1380            CALL xios_recv_field( trim(cdvar), pv_r3d(:, :, :))
1381            IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1382               CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill)
1383            ENDIF
1384         ELSEIF( PRESENT(pv_r2d) ) THEN
1385            IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar)
1386            CALL xios_recv_field( trim(cdvar), pv_r2d(:, :))
1387            IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1388               CALL lbc_lnk('iom', pv_r2d, cl_type, zsgn, kfillmode = kfill)
1389            ENDIF
1390         ELSEIF( PRESENT(pv_r1d) ) THEN
1391            IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar)
1392            CALL xios_recv_field( trim(cdvar), pv_r1d)
1393         ENDIF
1394         CALL iom_swap(cxios_context)
1395#else
1396         istop = istop + 1
1397         clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar)
1398#endif
1399      ENDIF
1400!some final adjustments
1401      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
1402      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp )
1403      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp )
1404
1405      !--- Apply scale_factor and offset
1406      zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
1407      zofs = iom_file(kiomid)%ofs(idvar)      ! offset
1408      IF(     PRESENT(pv_r1d) ) THEN
1409         IF( zscf /= 1._wp )   pv_r1d(:) = pv_r1d(:) * zscf
1410         IF( zofs /= 0._wp )   pv_r1d(:) = pv_r1d(:) + zofs
1411      ELSEIF( PRESENT(pv_r2d) ) THEN
1412         IF( zscf /= 1._wp)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
1413         IF( zofs /= 0._wp)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
1414      ELSEIF( PRESENT(pv_r3d) ) THEN
1415         IF( zscf /= 1._wp)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
1416         IF( zofs /= 0._wp)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
1417      ENDIF
1418      !
1419   END SUBROUTINE iom_get_123d
1420
1421   SUBROUTINE iom_get_var( cdname, z2d)
1422      CHARACTER(LEN=*), INTENT(in ) ::   cdname
1423      REAL(wp), DIMENSION(jpi,jpj) ::   z2d
1424#if defined key_iomput
1425      IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN
1426         z2d(:,:) = 0._wp
1427         CALL xios_recv_field( cdname, z2d)
1428      ENDIF
1429#else
1430      IF( .FALSE. )   WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings
1431#endif
1432   END SUBROUTINE iom_get_var
1433
1434
1435   FUNCTION iom_getszuld ( kiomid )
1436      !!-----------------------------------------------------------------------
1437      !!                  ***  FUNCTION  iom_getszuld  ***
1438      !!
1439      !! ** Purpose : get the size of the unlimited dimension in a file
1440      !!              (return -1 if not found)
1441      !!-----------------------------------------------------------------------
1442      INTEGER, INTENT(in   ) ::   kiomid   ! file Identifier
1443      !
1444      INTEGER                ::   iom_getszuld
1445      !!-----------------------------------------------------------------------
1446      iom_getszuld = -1
1447      IF( kiomid > 0 ) THEN
1448         IF( iom_file(kiomid)%iduld > 0 )   iom_getszuld = iom_file(kiomid)%lenuld
1449      ENDIF
1450   END FUNCTION iom_getszuld
1451
1452
1453   !!----------------------------------------------------------------------
1454   !!                   INTERFACE iom_chkatt
1455   !!----------------------------------------------------------------------
1456   SUBROUTINE iom_chkatt( kiomid, cdatt, llok, ksize, cdvar )
1457      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
1458      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
1459      LOGICAL         , INTENT(  out)                 ::   llok      ! Error code
1460      INTEGER         , INTENT(  out), OPTIONAL       ::   ksize     ! Size of the attribute array
1461      CHARACTER(len=*), INTENT(in   ), OPTIONAL       ::   cdvar     ! Name of the variable
1462      !
1463      IF( kiomid > 0 ) THEN
1464         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_chkatt( kiomid, cdatt, llok, ksize=ksize, cdvar=cdvar )
1465      ENDIF
1466      !
1467   END SUBROUTINE iom_chkatt
1468
1469   !!----------------------------------------------------------------------
1470   !!                   INTERFACE iom_getatt
1471   !!----------------------------------------------------------------------
1472   SUBROUTINE iom_g0d_iatt( kiomid, cdatt, katt0d, cdvar )
1473      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1474      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1475      INTEGER               , INTENT(  out)           ::   katt0d    ! read field
1476      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1477      !
1478      IF( kiomid > 0 ) THEN
1479         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  katt0d =  katt0d, cdvar=cdvar )
1480      ENDIF
1481   END SUBROUTINE iom_g0d_iatt
1482
1483   SUBROUTINE iom_g1d_iatt( kiomid, cdatt, katt1d, cdvar )
1484      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1485      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1486      INTEGER, DIMENSION(:) , INTENT(  out)           ::   katt1d    ! read field
1487      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1488      !
1489      IF( kiomid > 0 ) THEN
1490         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  katt1d =  katt1d, cdvar=cdvar )
1491      ENDIF
1492   END SUBROUTINE iom_g1d_iatt
1493
1494   SUBROUTINE iom_g0d_ratt( kiomid, cdatt, patt0d, cdvar )
1495      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1496      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1497      REAL(wp)              , INTENT(  out)           ::   patt0d    ! read field
1498      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1499      !
1500      IF( kiomid > 0 ) THEN
1501         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  patt0d =  patt0d, cdvar=cdvar )
1502      ENDIF
1503   END SUBROUTINE iom_g0d_ratt
1504
1505   SUBROUTINE iom_g1d_ratt( kiomid, cdatt, patt1d, cdvar )
1506      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1507      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1508      REAL(wp), DIMENSION(:), INTENT(  out)           ::   patt1d    ! read field
1509      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1510      !
1511      IF( kiomid > 0 ) THEN
1512         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt,  patt1d =  patt1d, cdvar=cdvar )
1513      ENDIF
1514   END SUBROUTINE iom_g1d_ratt
1515
1516   SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar )
1517      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1518      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1519      CHARACTER(len=*)      , INTENT(  out)           ::   cdatt0d   ! read field
1520      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1521      !
1522      IF( kiomid > 0 ) THEN
1523         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_getatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
1524      ENDIF
1525   END SUBROUTINE iom_g0d_catt
1526
1527
1528   !!----------------------------------------------------------------------
1529   !!                   INTERFACE iom_putatt
1530   !!----------------------------------------------------------------------
1531   SUBROUTINE iom_p0d_iatt( kiomid, cdatt, katt0d, cdvar )
1532      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1533      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1534      INTEGER               , INTENT(in   )           ::   katt0d    ! written field
1535      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1536      !
1537      IF( kiomid > 0 ) THEN
1538         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  katt0d =  katt0d, cdvar=cdvar )
1539      ENDIF
1540   END SUBROUTINE iom_p0d_iatt
1541
1542   SUBROUTINE iom_p1d_iatt( kiomid, cdatt, katt1d, cdvar )
1543      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1544      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1545      INTEGER, DIMENSION(:) , INTENT(in   )           ::   katt1d    ! written field
1546      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1547      !
1548      IF( kiomid > 0 ) THEN
1549         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  katt1d =  katt1d, cdvar=cdvar )
1550      ENDIF
1551   END SUBROUTINE iom_p1d_iatt
1552
1553   SUBROUTINE iom_p0d_ratt( kiomid, cdatt, patt0d, cdvar )
1554      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1555      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1556      REAL(wp)              , INTENT(in   )           ::   patt0d    ! written field
1557      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1558      !
1559      IF( kiomid > 0 ) THEN
1560         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  patt0d =  patt0d, cdvar=cdvar )
1561      ENDIF
1562   END SUBROUTINE iom_p0d_ratt
1563
1564   SUBROUTINE iom_p1d_ratt( kiomid, cdatt, patt1d, cdvar )
1565      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1566      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1567      REAL(wp), DIMENSION(:), INTENT(in   )           ::   patt1d    ! written field
1568      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1569      !
1570      IF( kiomid > 0 ) THEN
1571         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt,  patt1d =  patt1d, cdvar=cdvar )
1572      ENDIF
1573   END SUBROUTINE iom_p1d_ratt
1574
1575   SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar )
1576      INTEGER               , INTENT(in   )           ::   kiomid    ! Identifier of the file
1577      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt     ! Name of the attribute
1578      CHARACTER(len=*)      , INTENT(in   )           ::   cdatt0d   ! written field
1579      CHARACTER(len=*)      , INTENT(in   ), OPTIONAL ::   cdvar     ! Name of the variable
1580      !
1581      IF( kiomid > 0 ) THEN
1582         IF( iom_file(kiomid)%nfid > 0 )   CALL iom_nf90_putatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
1583      ENDIF
1584   END SUBROUTINE iom_p0d_catt
1585
1586
1587   !!----------------------------------------------------------------------
1588   !!                   INTERFACE iom_rstput
1589   !!----------------------------------------------------------------------
1590   SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1591      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1592      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1593      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1594      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1595      REAL(sp)        , INTENT(in)                         ::   pvar     ! written field
1596      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1597      !
1598      LOGICAL           :: llx                ! local xios write flag
1599      INTEGER           :: ivid   ! variable id
1600      CHARACTER(LEN=lc) :: context
1601      !
1602      CALL set_xios_context(kiomid, context)
1603
1604      llx = .NOT. (context == "NONE")
1605
1606      IF( llx ) THEN
1607#ifdef key_iomput
1608         IF( kt == kwrite ) THEN
1609            IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar)
1610            CALL iom_swap(context)
1611            CALL iom_put(trim(cdvar), pvar)
1612            CALL iom_swap(cxios_context)
1613         ELSE
1614            IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar)
1615            CALL iom_swap(context)
1616            CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar )
1617            CALL iom_swap(cxios_context)
1618         ENDIF
1619#endif
1620      ELSE
1621         IF( kiomid > 0 ) THEN
1622            IF( iom_file(kiomid)%nfid > 0 ) THEN
1623               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1624               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = real(pvar, dp) )
1625            ENDIF
1626         ENDIF
1627      ENDIF
1628   END SUBROUTINE iom_rp0d_sp
1629
1630   SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1631      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1632      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1633      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1634      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1635      REAL(dp)        , INTENT(in)                         ::   pvar     ! written field
1636      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1637      !
1638      LOGICAL           :: llx                ! local xios write flag
1639      INTEGER           :: ivid   ! variable id
1640      CHARACTER(LEN=lc) :: context
1641      !
1642      CALL set_xios_context(kiomid, context)
1643
1644      llx = .NOT. (context == "NONE")
1645
1646      IF( llx ) THEN
1647#ifdef key_iomput
1648         IF( kt == kwrite ) THEN
1649            IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar)
1650            CALL iom_swap(context)
1651            CALL iom_put(trim(cdvar), pvar)
1652            CALL iom_swap(cxios_context)
1653         ELSE
1654            IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar)
1655            CALL iom_swap(context)
1656            CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar )
1657            CALL iom_swap(cxios_context)
1658         ENDIF
1659#endif
1660      ELSE
1661         IF( kiomid > 0 ) THEN
1662            IF( iom_file(kiomid)%nfid > 0 ) THEN
1663               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1664               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
1665            ENDIF
1666         ENDIF
1667      ENDIF
1668   END SUBROUTINE iom_rp0d_dp
1669
1670
1671   SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1672      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1673      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1674      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1675      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1676      REAL(sp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
1677      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1678      !
1679      LOGICAL           :: llx                ! local xios write flag
1680      INTEGER           :: ivid   ! variable id
1681      CHARACTER(LEN=lc) :: context
1682      !
1683      CALL set_xios_context(kiomid, context)
1684
1685      llx = .NOT. (context == "NONE")
1686
1687      IF( llx ) THEN
1688#ifdef key_iomput
1689         IF( kt == kwrite ) THEN
1690            IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar)
1691            CALL iom_swap(context)
1692            CALL iom_put(trim(cdvar), pvar)
1693            CALL iom_swap(cxios_context)
1694         ELSE
1695            IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar)
1696            CALL iom_swap(context)
1697            CALL iom_set_rstw_active( trim(cdvar), rs1 = pvar )
1698            CALL iom_swap(cxios_context)
1699         ENDIF
1700#endif
1701      ELSE
1702         IF( kiomid > 0 ) THEN
1703            IF( iom_file(kiomid)%nfid > 0 ) THEN
1704               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1705               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = real(pvar, dp) )
1706            ENDIF
1707         ENDIF
1708      ENDIF
1709   END SUBROUTINE iom_rp1d_sp
1710
1711   SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1712      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1713      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1714      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1715      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1716      REAL(dp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
1717      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1718      !
1719      LOGICAL           :: llx                ! local xios write flag
1720      INTEGER           :: ivid   ! variable id
1721      CHARACTER(LEN=lc) :: context
1722      !
1723      CALL set_xios_context(kiomid, context)
1724
1725      llx = .NOT. (context == "NONE")
1726
1727      IF( llx ) THEN
1728#ifdef key_iomput
1729         IF( kt == kwrite ) THEN
1730            IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar)
1731            CALL iom_swap(context)
1732            CALL iom_put(trim(cdvar), pvar)
1733            CALL iom_swap(cxios_context)
1734         ELSE
1735            IF(lwp) write(numout,*) 'RESTART: define (XIOS 1D)',trim(cdvar)
1736            CALL iom_swap(context)
1737            CALL iom_set_rstw_active( trim(cdvar), rd1 = pvar )
1738            CALL iom_swap(cxios_context)
1739         ENDIF
1740#endif
1741      ELSE
1742         IF( kiomid > 0 ) THEN
1743            IF( iom_file(kiomid)%nfid > 0 ) THEN
1744               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1745               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
1746            ENDIF
1747         ENDIF
1748      ENDIF
1749   END SUBROUTINE iom_rp1d_dp
1750
1751
1752   SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1753      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1754      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1755      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1756      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1757      REAL(sp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
1758      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1759      !
1760      LOGICAL            :: llx
1761      INTEGER            :: ivid   ! variable id
1762      CHARACTER(LEN=lc)  :: context
1763      !
1764      CALL set_xios_context(kiomid, context)
1765
1766      llx = .NOT. (context == "NONE")
1767
1768      IF( llx ) THEN
1769#ifdef key_iomput
1770         IF( kt == kwrite ) THEN
1771            IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar)
1772            CALL iom_swap(context)
1773            CALL iom_put(trim(cdvar), pvar)
1774            CALL iom_swap(cxios_context)
1775         ELSE
1776            IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar)
1777            CALL iom_swap(context)
1778            CALL iom_set_rstw_active( trim(cdvar), rs2 = pvar )
1779            CALL iom_swap(cxios_context)
1780         ENDIF
1781#endif
1782      ELSE
1783         IF( kiomid > 0 ) THEN
1784            IF( iom_file(kiomid)%nfid > 0 ) THEN
1785               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1786               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = real(pvar, dp) )
1787            ENDIF
1788         ENDIF
1789      ENDIF
1790   END SUBROUTINE iom_rp2d_sp
1791
1792   SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1793      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1794      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1795      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1796      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1797      REAL(dp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
1798      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1799      !
1800      LOGICAL           :: llx
1801      INTEGER           :: ivid   ! variable id
1802      CHARACTER(LEN=lc) :: context
1803      !
1804      CALL set_xios_context(kiomid, context)
1805
1806      llx = .NOT. (context == "NONE")
1807
1808      IF( llx ) THEN
1809#ifdef key_iomput
1810         IF( kt == kwrite ) THEN
1811            IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar)
1812            CALL iom_swap(context)
1813            CALL iom_put(trim(cdvar), pvar)
1814            CALL iom_swap(cxios_context)
1815         ELSE
1816            IF(lwp) write(numout,*) 'RESTART: define (XIOS 2D)',trim(cdvar)
1817            CALL iom_swap(context)
1818            CALL iom_set_rstw_active( trim(cdvar), rd2 = pvar )
1819            CALL iom_swap(cxios_context)
1820         ENDIF
1821#endif
1822      ELSE
1823         IF( kiomid > 0 ) THEN
1824            IF( iom_file(kiomid)%nfid > 0 ) THEN
1825               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1826               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
1827            ENDIF
1828         ENDIF
1829      ENDIF
1830   END SUBROUTINE iom_rp2d_dp
1831
1832
1833   SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1834      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1835      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1836      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1837      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1838      REAL(sp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
1839      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1840      !
1841      LOGICAL           :: llx                 ! local xios write flag
1842      INTEGER           :: ivid   ! variable id
1843      CHARACTER(LEN=lc) :: context
1844      !
1845      CALL set_xios_context(kiomid, context)
1846
1847      llx = .NOT. (context == "NONE")
1848
1849      IF( llx ) THEN
1850#ifdef key_iomput
1851         IF( kt == kwrite ) THEN
1852            IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar)
1853            CALL iom_swap(context)
1854            CALL iom_put(trim(cdvar), pvar)
1855            CALL iom_swap(cxios_context)
1856         ELSE
1857            IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar)
1858            CALL iom_swap(context)
1859            CALL iom_set_rstw_active( trim(cdvar), rs3 = pvar )
1860            CALL iom_swap(cxios_context)
1861         ENDIF
1862#endif
1863      ELSE
1864         IF( kiomid > 0 ) THEN
1865            IF( iom_file(kiomid)%nfid > 0 ) THEN
1866               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1867               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = real(pvar, dp) )
1868            ENDIF
1869         ENDIF
1870      ENDIF
1871   END SUBROUTINE iom_rp3d_sp
1872
1873   SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1874      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1875      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1876      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1877      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1878      REAL(dp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
1879      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1880      !
1881      LOGICAL           :: llx                 ! local xios write flag
1882      INTEGER           :: ivid   ! variable id
1883      CHARACTER(LEN=lc) :: context
1884      !
1885      CALL set_xios_context(kiomid, context)
1886
1887      llx = .NOT. (context == "NONE")
1888
1889      IF( llx ) THEN
1890#ifdef key_iomput
1891         IF( kt == kwrite ) THEN
1892            IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar)
1893            CALL iom_swap(context)
1894            CALL iom_put(trim(cdvar), pvar)
1895            CALL iom_swap(cxios_context)
1896         ELSE
1897            IF(lwp) write(numout,*) 'RESTART: define (XIOS 3D)',trim(cdvar)
1898            CALL iom_swap(context)
1899            CALL iom_set_rstw_active( trim(cdvar), rd3 = pvar )
1900            CALL iom_swap(cxios_context)
1901         ENDIF
1902#endif
1903      ELSE
1904         IF( kiomid > 0 ) THEN
1905            IF( iom_file(kiomid)%nfid > 0 ) THEN
1906               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1907               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
1908            ENDIF
1909         ENDIF
1910      ENDIF
1911   END SUBROUTINE iom_rp3d_dp
1912
1913
1914
1915  SUBROUTINE iom_delay_rst( cdaction, cdcpnt, kncid )
1916      !!---------------------------------------------------------------------
1917      !!   Routine iom_delay_rst: used read/write restart related to mpp_delay
1918      !!
1919      !!---------------------------------------------------------------------
1920      CHARACTER(len=*), INTENT(in   ) ::   cdaction        !
1921      CHARACTER(len=*), INTENT(in   ) ::   cdcpnt
1922      INTEGER         , INTENT(in   ) ::   kncid
1923      !
1924      INTEGER  :: ji
1925      INTEGER  :: indim
1926      LOGICAL  :: llattexist
1927      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   zreal1d
1928      !!---------------------------------------------------------------------
1929      !
1930      !                                      ===================================
1931      IF( TRIM(cdaction) == 'READ' ) THEN   ! read restart related to mpp_delay !
1932         !                                   ===================================
1933         DO ji = 1, nbdelay
1934            IF ( c_delaycpnt(ji) == cdcpnt ) THEN
1935               CALL iom_chkatt( kncid, 'DELAY_'//c_delaylist(ji), llattexist, indim )
1936               IF( llattexist )  THEN
1937                  ALLOCATE( todelay(ji)%z1d(indim) )
1938                  CALL iom_getatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
1939                  ndelayid(ji) = 0   ! set to 0 to specify that the value was read in the restart
1940               ENDIF
1941           ENDIF
1942         END DO
1943         !                                   ====================================
1944      ELSE                                  ! write restart related to mpp_delay !
1945         !                                   ====================================
1946         DO ji = 1, nbdelay   ! save only ocean delayed global communication variables
1947            IF ( c_delaycpnt(ji) == cdcpnt ) THEN
1948               IF( ASSOCIATED(todelay(ji)%z1d) ) THEN
1949                  CALL mpp_delay_rcv(ji)   ! make sure %z1d is received
1950                  CALL iom_putatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
1951               ENDIF
1952            ENDIF
1953         END DO
1954         !
1955      ENDIF
1956
1957   END SUBROUTINE iom_delay_rst
1958
1959
1960
1961   !!----------------------------------------------------------------------
1962   !!                   INTERFACE iom_put
1963   !!----------------------------------------------------------------------
1964   SUBROUTINE iom_p0d_sp( cdname, pfield0d )
1965      CHARACTER(LEN=*), INTENT(in) ::   cdname
1966      REAL(sp)        , INTENT(in) ::   pfield0d
1967      !!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
1968#if defined key_iomput
1969!!clem      zz(:,:)=pfield0d
1970!!clem      CALL xios_send_field(cdname, zz)
1971      CALL xios_send_field(cdname, (/pfield0d/))
1972#else
1973      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
1974#endif
1975   END SUBROUTINE iom_p0d_sp
1976
1977   SUBROUTINE iom_p0d_dp( cdname, pfield0d )
1978      CHARACTER(LEN=*), INTENT(in) ::   cdname
1979      REAL(dp)        , INTENT(in) ::   pfield0d
1980!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
1981#if defined key_iomput
1982!!clem      zz(:,:)=pfield0d
1983!!clem      CALL xios_send_field(cdname, zz)
1984      CALL xios_send_field(cdname, (/pfield0d/))
1985#else
1986      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
1987#endif
1988   END SUBROUTINE iom_p0d_dp
1989
1990
1991   SUBROUTINE iom_p1d_sp( cdname, pfield1d )
1992      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
1993      REAL(sp),     DIMENSION(:), INTENT(in) ::   pfield1d
1994#if defined key_iomput
1995      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
1996#else
1997      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
1998#endif
1999   END SUBROUTINE iom_p1d_sp
2000
2001   SUBROUTINE iom_p1d_dp( cdname, pfield1d )
2002      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
2003      REAL(dp),     DIMENSION(:), INTENT(in) ::   pfield1d
2004#if defined key_iomput
2005      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
2006#else
2007      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
2008#endif
2009   END SUBROUTINE iom_p1d_dp
2010
2011   SUBROUTINE iom_p2d_sp( cdname, pfield2d )
2012      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
2013      REAL(sp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
2014      IF( iom_use(cdname) ) THEN
2015#if defined key_iomput
2016         CALL xios_send_field( cdname, pfield2d )
2017#else
2018         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2019#endif
2020      ENDIF
2021   END SUBROUTINE iom_p2d_sp
2022
2023   SUBROUTINE iom_p2d_dp( cdname, pfield2d )
2024      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
2025      REAL(dp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
2026      IF( iom_use(cdname) ) THEN
2027#if defined key_iomput
2028         CALL xios_send_field( cdname, pfield2d )
2029#else
2030         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2031#endif
2032      ENDIF
2033   END SUBROUTINE iom_p2d_dp
2034
2035   SUBROUTINE iom_p3d_sp( cdname, pfield3d )
2036      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
2037      REAL(sp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
2038      IF( iom_use(cdname) ) THEN
2039#if defined key_iomput
2040         CALL xios_send_field( cdname, pfield3d )
2041#else
2042         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2043#endif
2044      ENDIF
2045   END SUBROUTINE iom_p3d_sp
2046
2047   SUBROUTINE iom_p3d_dp( cdname, pfield3d )
2048      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
2049      REAL(dp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
2050      IF( iom_use(cdname) ) THEN
2051#if defined key_iomput
2052         CALL xios_send_field( cdname, pfield3d )
2053#else
2054         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2055#endif
2056      ENDIF
2057   END SUBROUTINE iom_p3d_dp
2058
2059   SUBROUTINE iom_p4d_sp( cdname, pfield4d )
2060      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
2061      REAL(sp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d
2062      IF( iom_use(cdname) ) THEN
2063#if defined key_iomput
2064         CALL xios_send_field (cdname, pfield4d )
2065#else
2066         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2067#endif
2068      ENDIF
2069   END SUBROUTINE iom_p4d_sp
2070
2071   SUBROUTINE iom_p4d_dp( cdname, pfield4d )
2072      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
2073      REAL(dp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d
2074      IF( iom_use(cdname) ) THEN
2075#if defined key_iomput
2076         CALL xios_send_field (cdname, pfield4d )
2077#else
2078         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2079#endif
2080      ENDIF
2081   END SUBROUTINE iom_p4d_dp
2082
2083#if defined key_iomput
2084   !!----------------------------------------------------------------------
2085   !!   'key_iomput'                                         XIOS interface
2086   !!----------------------------------------------------------------------
2087
2088   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj,                                               &
2089      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
2090      &                                    nvertex, bounds_lon, bounds_lat, area )
2091      !!----------------------------------------------------------------------
2092      !!----------------------------------------------------------------------
2093      CHARACTER(LEN=*)                  , INTENT(in) ::   cdid
2094      INTEGER                 , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
2095      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
2096      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex
2097      REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
2098      REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
2099      LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask
2100      !!----------------------------------------------------------------------
2101      !
2102      IF( xios_is_valid_domain     (cdid) ) THEN
2103         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
2104            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
2105            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
2106            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
2107      ENDIF
2108      IF( xios_is_valid_domaingroup(cdid) ) THEN
2109         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
2110            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
2111            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      &
2112            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
2113      ENDIF
2114      !
2115      CALL xios_solve_inheritance()
2116      !
2117   END SUBROUTINE iom_set_domain_attr
2118
2119
2120   SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj )
2121      !!----------------------------------------------------------------------
2122      !!----------------------------------------------------------------------
2123      CHARACTER(LEN=*), INTENT(in) ::   cdid
2124      INTEGER         , INTENT(in) ::   ibegin, jbegin, ni, nj
2125      !
2126      TYPE(xios_gridgroup) :: gridgroup_hdl
2127      TYPE(xios_grid)      :: grid_hdl
2128      TYPE(xios_domain)    :: domain_hdl
2129      TYPE(xios_axis)      :: axis_hdl
2130      CHARACTER(LEN=64)    :: cldomrefid   ! domain_ref name
2131      CHARACTER(len=1)     :: cl1          ! last character of this name
2132      !!----------------------------------------------------------------------
2133      !
2134      IF( xios_is_valid_zoom_domain(cdid) ) THEN
2135         ! define the zoom_domain attributs
2136         CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj )
2137         ! define a new 2D grid with this new domain
2138         CALL xios_get_handle("grid_definition", gridgroup_hdl )
2139         CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_2D' )   ! add a new 2D grid to grid_definition
2140         CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) )             ! add its domain
2141         ! define a new 3D grid with this new domain
2142         CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_3D' )   ! add a new 3D grid to grid_definition
2143         CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) )             ! add its domain
2144         ! vertical axis
2145         cl1 = cdid(LEN_TRIM(cdid):)                                        ! last letter of cdid
2146         cl1 = CHAR(ICHAR(cl1)+32)                                          ! from upper to lower case
2147         CALL xios_add_child(grid_hdl, axis_hdl, 'depth'//cl1)              ! add its axis
2148      ENDIF
2149      !
2150   END SUBROUTINE iom_set_zoom_domain_attr
2151
2152
2153   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
2154      !!----------------------------------------------------------------------
2155      !!----------------------------------------------------------------------
2156      CHARACTER(LEN=*)      , INTENT(in) ::   cdid
2157      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis
2158      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
2159      !!----------------------------------------------------------------------
2160      IF( PRESENT(paxis) ) THEN
2161         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) )
2162         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) )
2163      ENDIF
2164      IF( PRESENT(bounds) ) THEN
2165         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=real(bounds, dp) )
2166         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) )
2167      ELSE
2168         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid)
2169         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid)
2170      END IF
2171      CALL xios_solve_inheritance()
2172   END SUBROUTINE iom_set_axis_attr
2173
2174
2175   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
2176      !!----------------------------------------------------------------------
2177      !!----------------------------------------------------------------------
2178      CHARACTER(LEN=*)             , INTENT(in) ::   cdid
2179      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_op
2180      TYPE(xios_duration), OPTIONAL, INTENT(in) ::   freq_offset
2181      !!----------------------------------------------------------------------
2182      IF( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
2183      IF( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
2184      CALL xios_solve_inheritance()
2185   END SUBROUTINE iom_set_field_attr
2186
2187
2188   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
2189      !!----------------------------------------------------------------------
2190      !!----------------------------------------------------------------------
2191      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
2192      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix
2193      !!----------------------------------------------------------------------
2194      IF( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix )
2195      IF( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
2196      CALL xios_solve_inheritance()
2197   END SUBROUTINE iom_set_file_attr
2198
2199
2200   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
2201      !!----------------------------------------------------------------------
2202      !!----------------------------------------------------------------------
2203      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
2204      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix
2205      TYPE(xios_duration), OPTIONAL , INTENT(out) :: output_freq
2206      LOGICAL                                 ::   llexist1,llexist2,llexist3
2207      !---------------------------------------------------------------------
2208      IF( PRESENT( name        ) )   name = ''          ! default values
2209      IF( PRESENT( name_suffix ) )   name_suffix = ''
2210      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0)
2211      IF( xios_is_valid_file     (cdid) ) THEN
2212         CALL xios_solve_inheritance()
2213         CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
2214         IF(llexist1)   CALL xios_get_file_attr     ( cdid, name = name )
2215         IF(llexist2)   CALL xios_get_file_attr     ( cdid, name_suffix = name_suffix )
2216         IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq )
2217      ENDIF
2218      IF( xios_is_valid_filegroup(cdid) ) THEN
2219         CALL xios_solve_inheritance()
2220         CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
2221         IF(llexist1)   CALL xios_get_filegroup_attr( cdid, name = name )
2222         IF(llexist2)   CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
2223         IF(llexist3)   CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
2224      ENDIF
2225   END SUBROUTINE iom_get_file_attr
2226
2227
2228   SUBROUTINE iom_set_grid_attr( cdid, mask )
2229      !!----------------------------------------------------------------------
2230      !!----------------------------------------------------------------------
2231      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
2232      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
2233      !!----------------------------------------------------------------------
2234      IF( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask )
2235      IF( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
2236      CALL xios_solve_inheritance()
2237   END SUBROUTINE iom_set_grid_attr
2238
2239   SUBROUTINE iom_setkt( kt, cdname )
2240      !!----------------------------------------------------------------------
2241      !!----------------------------------------------------------------------
2242      INTEGER         , INTENT(in) ::   kt
2243      CHARACTER(LEN=*), INTENT(in) ::   cdname
2244      !!----------------------------------------------------------------------
2245      CALL iom_swap( cdname )   ! swap to cdname context
2246      CALL xios_update_calendar(kt)
2247      IF( cdname /= TRIM(cxios_context) )   CALL iom_swap( cxios_context )   ! return back to nemo context
2248   END SUBROUTINE iom_setkt
2249
2250   SUBROUTINE iom_context_finalize( cdname )
2251      !!----------------------------------------------------------------------
2252      !!----------------------------------------------------------------------
2253      CHARACTER(LEN=*), INTENT(in) :: cdname
2254      CHARACTER(LEN=120)           :: clname
2255      !!----------------------------------------------------------------------
2256      clname = cdname
2257      IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname
2258      IF( xios_is_valid_context(clname) ) THEN
2259         CALL iom_swap( cdname )   ! swap to cdname context
2260         CALL xios_context_finalize() ! finalize the context
2261         IF( cdname /= cxios_context ) CALL iom_swap( cxios_context )   ! return back to nemo context
2262      ENDIF
2263      !
2264   END SUBROUTINE iom_context_finalize
2265
2266
2267   SUBROUTINE set_grid( cdgrd, plon, plat, ldxios, ldrxios )
2268      !!----------------------------------------------------------------------
2269      !!                     ***  ROUTINE set_grid  ***
2270      !!
2271      !! ** Purpose :   define horizontal grids
2272      !!----------------------------------------------------------------------
2273      CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd
2274      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
2275      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
2276      !
2277      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
2278      LOGICAL, INTENT(IN) :: ldxios, ldrxios
2279      !!----------------------------------------------------------------------
2280      !
2281      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0)
2282      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj)
2283!don't define lon and lat for restart reading context.
2284      IF ( .NOT.ldrxios ) &
2285         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   &
2286         &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))
2287      !
2288      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN
2289         ! mask land points, keep values on coast line -> specific mask for U, V and W points
2290         SELECT CASE ( cdgrd )
2291         CASE('T')   ;   zmask( :     , :     ,:) = tmask(:,:,:)
2292         CASE('U')   ;   zmask(2:jpim1, :     ,:) = tmask(2:jpim1, :     ,:) + tmask(3:jpi  , :   ,:)
2293         CASE('V')   ;   zmask( :     ,2:jpjm1,:) = tmask( :     ,2:jpjm1,:) + tmask( :     ,3:jpj,:)
2294         CASE('F')   ;   zmask(2:jpim1,2:jpjm1,:) = tmask(2:jpim1,2:jpjm1,:) + tmask(2:jpim1,3:jpj,:)    &
2295            &                                     + tmask(3:jpi  ,2:jpjm1,:) + tmask(3:jpi  ,3:jpj,:)
2296         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1)
2297         END SELECT
2298         !
2299         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0    /)) /= 0. )
2300         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. )
2301      ENDIF
2302      !
2303   END SUBROUTINE set_grid
2304
2305   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
2306      !!----------------------------------------------------------------------
2307      !!                   ***  ROUTINE set_grid_bounds  ***
2308      !!
2309      !! ** Purpose :   define horizontal grid corners
2310      !!
2311      !!----------------------------------------------------------------------
2312      CHARACTER(LEN=1)                      , INTENT(in) :: cdgrd
2313      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(in) :: plon_cnr, plat_cnr  ! Lat/lon coord. of a contiguous vertex of cell (i,j)
2314      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j)
2315      !
2316      INTEGER :: ji, jj, jn
2317      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
2318      !                                                 ! represents the
2319      !                                                 bottom-left corner of
2320      !                                                 cell (i,j)
2321      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
2322      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells
2323      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_rot       ! Lat/lon working array for rotation of cells
2324      !!----------------------------------------------------------------------
2325      !
2326      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  )
2327      !
2328      ! Offset of coordinate representing bottom-left corner
2329      SELECT CASE ( TRIM(cdgrd) )
2330      CASE ('T', 'W')   ;   icnr = -1   ;   jcnr = -1
2331      CASE ('U')        ;   icnr =  0   ;   jcnr = -1
2332      CASE ('V')        ;   icnr = -1   ;   jcnr =  0
2333      CASE ('F')        ;   icnr =  0   ;   jcnr =  0
2334      END SELECT
2335      !
2336      z_fld(:,:) = 1._wp
2337      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold
2338      !
2339      ! Cell vertices that can be defined
2340      DO_2D( 0, 0, 0, 0 )
2341         z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
2342         z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
2343         z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
2344         z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
2345         z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
2346         z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
2347         z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
2348         z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
2349      END_2D
2350      !
2351      DO_2D( 0, 0, 0, 0 )
2352         IF( z_fld(ji,jj) == -1. ) THEN
2353            z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
2354            z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
2355            z_bnds(:,ji,jj,:) = z_rot(:,:)
2356         ENDIF
2357      END_2D
2358      !
2359      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp),           &
2360          &                                    bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 )
2361      !
2362      DEALLOCATE( z_bnds, z_fld, z_rot )
2363      !
2364   END SUBROUTINE set_grid_bounds
2365
2366   SUBROUTINE set_grid_znl( plat )
2367      !!----------------------------------------------------------------------
2368      !!                     ***  ROUTINE set_grid_znl  ***
2369      !!
2370      !! ** Purpose :   define grids for zonal mean
2371      !!
2372      !!----------------------------------------------------------------------
2373      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
2374      !
2375      INTEGER  :: ix, iy
2376      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon
2377      !!----------------------------------------------------------------------
2378      !
2379      ALLOCATE( zlon(Ni_0*Nj_0) )       ;       zlon(:) = 0._wp
2380      !
2381!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots)
2382      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots)
2383      CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0)
2384      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj)
2385      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   &
2386         &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))
2387      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj0glo)
2388      !
2389      CALL iom_update_file_name('ptr')
2390      !
2391   END SUBROUTINE set_grid_znl
2392
2393
2394   SUBROUTINE set_scalar
2395      !!----------------------------------------------------------------------
2396      !!                     ***  ROUTINE set_scalar  ***
2397      !!
2398      !! ** Purpose :   define fake grids for scalar point
2399      !!
2400      !!----------------------------------------------------------------------
2401      REAL(dp), DIMENSION(1)   ::   zz = 1.
2402      !!----------------------------------------------------------------------
2403      !
2404      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
2405      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
2406      !
2407      zz = REAL( narea, wp )
2408      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
2409      !
2410   END SUBROUTINE set_scalar
2411
2412
2413   SUBROUTINE set_xmlatt
2414      !!----------------------------------------------------------------------
2415      !!                     ***  ROUTINE set_xmlatt  ***
2416      !!
2417      !! ** Purpose :   automatic definitions of some of the xml attributs...
2418      !!
2419      !!----------------------------------------------------------------------
2420      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
2421      CHARACTER(len=256)             ::   clsuff                   ! suffix name
2422      CHARACTER(len=1)               ::   cl1                      ! 1 character
2423      CHARACTER(len=2)               ::   cl2                      ! 2 characters
2424      CHARACTER(len=3)               ::   cl3                      ! 3 characters
2425      INTEGER                        ::   ji, jg                   ! loop counters
2426      INTEGER                        ::   ix, iy                   ! i-,j- index
2427      REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings
2428      REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings
2429      REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings
2430      REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings
2431      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
2432      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
2433      TYPE(xios_duration)            ::   f_op, f_of
2434      !!----------------------------------------------------------------------
2435      !
2436      ! frequency of the call of iom_put (attribut: freq_op)
2437      f_op%timestep = 1        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
2438      f_op%timestep = 2        ;  f_of%timestep =  0  ; CALL iom_set_field_attr('trendT_even'     , freq_op=f_op, freq_offset=f_of)
2439      f_op%timestep = 2        ;  f_of%timestep = -1  ; CALL iom_set_field_attr('trendT_odd'      , freq_op=f_op, freq_offset=f_of)
2440      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
2441      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
2442      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of)
2443
2444      ! output file names (attribut: name)
2445      DO ji = 1, 9
2446         WRITE(cl1,'(i1)') ji
2447         CALL iom_update_file_name('file'//cl1)
2448      END DO
2449      DO ji = 1, 99
2450         WRITE(cl2,'(i2.2)') ji
2451         CALL iom_update_file_name('file'//cl2)
2452      END DO
2453      DO ji = 1, 999
2454         WRITE(cl3,'(i3.3)') ji
2455         CALL iom_update_file_name('file'//cl3)
2456      END DO
2457
2458      ! Zooms...
2459      clgrd = (/ 'T', 'U', 'W' /)
2460      DO jg = 1, SIZE(clgrd)                                                                   ! grid type
2461         cl1 = clgrd(jg)
2462         ! Equatorial section (attributs: jbegin, ni, name_suffix)
2463         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 )
2464         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 )
2465         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
2466         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
2467         CALL iom_update_file_name('Eq'//cl1)
2468      END DO
2469      ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
2470      zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
2471      zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /)
2472      CALL set_mooring( zlontao, zlattao )
2473      ! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
2474      zlonrama = (/  55.0,  67.0, 80.5, 90.0 /)
2475      zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
2476      CALL set_mooring( zlonrama, zlatrama )
2477      ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
2478      zlonpira = (/ -38.0, -23.0, -10.0 /)
2479      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
2480      CALL set_mooring( zlonpira, zlatpira )
2481      !
2482   END SUBROUTINE set_xmlatt
2483
2484
2485   SUBROUTINE set_mooring( plon, plat )
2486      !!----------------------------------------------------------------------
2487      !!                     ***  ROUTINE set_mooring  ***
2488      !!
2489      !! ** Purpose :   automatic definitions of moorings xml attributs...
2490      !!
2491      !!----------------------------------------------------------------------
2492      REAL(wp), DIMENSION(:), INTENT(in) ::   plon, plat   ! longitudes/latitudes oft the mooring
2493      !
2494!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name
2495      CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name
2496      CHARACTER(len=256)            ::   clname                   ! file name
2497      CHARACTER(len=256)            ::   clsuff                   ! suffix name
2498      CHARACTER(len=1)              ::   cl1                      ! 1 character
2499      CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude
2500      INTEGER                       ::   ji, jj, jg               ! loop counters
2501      INTEGER                       ::   ix, iy                   ! i-,j- index
2502      REAL(wp)                      ::   zlon, zlat
2503      !!----------------------------------------------------------------------
2504      DO jg = 1, SIZE(clgrd)
2505         cl1 = clgrd(jg)
2506         DO ji = 1, SIZE(plon)
2507            DO jj = 1, SIZE(plat)
2508               zlon = plon(ji)
2509               zlat = plat(jj)
2510               ! modifications for RAMA moorings
2511               IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65.
2512               IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95.
2513               IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5.
2514               ! modifications for PIRATA moorings
2515               IF( zlon == -38. .AND. zlat == -19. )   zlon = -34.
2516               IF( zlon == -38. .AND. zlat == -14. )   zlon = -32.
2517               IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30.
2518               IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35.
2519               IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21.
2520               IF( zlon == -10. .AND. zlat == -14. )   zlat = -10.
2521               IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6.
2522               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF
2523               CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
2524               IF( zlon >= 0. ) THEN
2525                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e'
2526                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e'
2527                  ENDIF
2528               ELSE
2529                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w'
2530                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w'
2531                  ENDIF
2532               ENDIF
2533               IF( zlat >= 0. ) THEN
2534                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n'
2535                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n'
2536                  ENDIF
2537               ELSE
2538                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's'
2539                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's'
2540                  ENDIF
2541               ENDIF
2542               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
2543               CALL iom_set_zoom_domain_attr(TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1, ni=1, nj=1)
2544
2545               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
2546               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
2547               CALL iom_update_file_name(TRIM(clname)//cl1)
2548            END DO
2549         END DO
2550      END DO
2551
2552   END SUBROUTINE set_mooring
2553
2554
2555   SUBROUTINE iom_update_file_name( cdid )
2556      !!----------------------------------------------------------------------
2557      !!                     ***  ROUTINE iom_update_file_name  ***
2558      !!
2559      !! ** Purpose :
2560      !!
2561      !!----------------------------------------------------------------------
2562      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
2563      !
2564      CHARACTER(LEN=256) ::   clname
2565      CHARACTER(LEN=20)  ::   clfreq
2566      CHARACTER(LEN=20)  ::   cldate
2567      INTEGER            ::   idx
2568      INTEGER            ::   jn
2569      INTEGER            ::   itrlen
2570      INTEGER            ::   iyear, imonth, iday, isec
2571      REAL(wp)           ::   zsec
2572      LOGICAL            ::   llexist
2573      TYPE(xios_duration)   ::   output_freq
2574      !!----------------------------------------------------------------------
2575      !
2576      DO jn = 1, 2
2577         !
2578         output_freq = xios_duration(0,0,0,0,0,0)
2579         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq )
2580         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
2581         !
2582         IF ( TRIM(clname) /= '' ) THEN
2583            !
2584            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
2585            DO WHILE ( idx /= 0 )
2586               clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
2587               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
2588            END DO
2589            !
2590            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
2591            DO WHILE ( idx /= 0 )
2592              IF ( output_freq%timestep /= 0) THEN
2593                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts'
2594                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
2595              ELSE IF ( output_freq%second /= 0 ) THEN
2596                  WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s'
2597                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
2598              ELSE IF ( output_freq%minute /= 0 ) THEN
2599                  WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi'
2600                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
2601              ELSE IF ( output_freq%hour /= 0 ) THEN
2602                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'
2603                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
2604              ELSE IF ( output_freq%day /= 0 ) THEN
2605                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'
2606                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
2607              ELSE IF ( output_freq%month /= 0 ) THEN
2608                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'
2609                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
2610              ELSE IF ( output_freq%year /= 0 ) THEN
2611                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'
2612                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
2613              ELSE
2614                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
2615                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
2616              ENDIF
2617              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
2618              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
2619            END DO
2620            !
2621            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
2622            DO WHILE ( idx /= 0 )
2623               cldate = iom_sdate( fjulday - rn_Dt / rday )
2624               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
2625               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
2626            END DO
2627            !
2628            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
2629            DO WHILE ( idx /= 0 )
2630               cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. )
2631               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
2632               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
2633            END DO
2634            !
2635            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
2636            DO WHILE ( idx /= 0 )
2637               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
2638               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
2639               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
2640            END DO
2641            !
2642            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
2643            DO WHILE ( idx /= 0 )
2644               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
2645               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
2646               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
2647            END DO
2648            !
2649            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
2650            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
2651            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
2652            !
2653         ENDIF
2654         !
2655      END DO
2656      !
2657   END SUBROUTINE iom_update_file_name
2658
2659
2660   FUNCTION iom_sdate( pjday, ld24, ldfull )
2661      !!----------------------------------------------------------------------
2662      !!                     ***  ROUTINE iom_sdate  ***
2663      !!
2664      !! ** Purpose :   send back the date corresponding to the given julian day
2665      !!----------------------------------------------------------------------
2666      REAL(wp), INTENT(in   )           ::   pjday    ! julian day
2667      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24     ! true to force 24:00 instead of 00:00
2668      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull   ! true to get the compleate date: yyyymmdd_hh:mm:ss
2669      !
2670      CHARACTER(LEN=20) ::   iom_sdate
2671      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date
2672      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec
2673      REAL(wp)          ::   zsec
2674      LOGICAL           ::   ll24, llfull
2675      !!----------------------------------------------------------------------
2676      !
2677      IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24
2678      ELSE                       ;   ll24 = .FALSE.
2679      ENDIF
2680      !
2681      IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull
2682      ELSE                         ;   llfull = .FALSE.
2683      ENDIF
2684      !
2685      CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
2686      isec = NINT(zsec)
2687      !
2688      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day
2689         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec )
2690         isec = 86400
2691      ENDIF
2692      !
2693      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date
2694      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
2695      ENDIF
2696      !
2697!$AGRIF_DO_NOT_TREAT
2698      ! needed in the conv
2699      IF( llfull ) THEN
2700         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
2701         ihour   = isec / 3600
2702         isec    = MOD(isec, 3600)
2703         iminute = isec / 60
2704         isec    = MOD(isec, 60)
2705         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec    ! date of the end of run
2706      ELSE
2707         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
2708      ENDIF
2709!$AGRIF_END_DO_NOT_TREAT
2710      !
2711   END FUNCTION iom_sdate
2712
2713#else
2714   !!----------------------------------------------------------------------
2715   !!   NOT 'key_iomput'                               a few dummy routines
2716   !!----------------------------------------------------------------------
2717   SUBROUTINE iom_setkt( kt, cdname )
2718      INTEGER         , INTENT(in)::   kt
2719      CHARACTER(LEN=*), INTENT(in) ::   cdname
2720      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
2721   END SUBROUTINE iom_setkt
2722
2723   SUBROUTINE iom_context_finalize( cdname )
2724      CHARACTER(LEN=*), INTENT(in) ::   cdname
2725      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
2726   END SUBROUTINE iom_context_finalize
2727
2728   SUBROUTINE iom_update_file_name( cdid )
2729      CHARACTER(LEN=*), INTENT(in) ::   cdid
2730      IF( .FALSE. )   WRITE(numout,*)  cdid   ! useless test to avoid compilation warnings
2731   END SUBROUTINE iom_update_file_name
2732
2733#endif
2734
2735   LOGICAL FUNCTION iom_use( cdname )
2736      CHARACTER(LEN=*), INTENT(in) ::   cdname
2737#if defined key_iomput
2738      iom_use = xios_field_is_active( cdname )
2739#else
2740      iom_use = .FALSE.
2741#endif
2742   END FUNCTION iom_use
2743
2744   SUBROUTINE iom_miss_val( cdname, pmiss_val )
2745      CHARACTER(LEN=*), INTENT(in ) ::   cdname
2746      REAL(wp)        , INTENT(out) ::   pmiss_val
2747      REAL(dp)                      ::   ztmp_pmiss_val
2748#if defined key_iomput
2749      ! get missing value
2750      CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val )
2751      pmiss_val = ztmp_pmiss_val
2752#else
2753      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings
2754      IF( .FALSE. )   pmiss_val = 0._wp                   ! useless assignment to avoid compilation warnings
2755#endif
2756   END SUBROUTINE iom_miss_val
2757
2758   !!======================================================================
2759END MODULE iom
Note: See TracBrowser for help on using the repository browser.