New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
iom.F90 in NEMO/trunk/src/OCE/IOM – NEMO

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

Last change on this file since 13982 was 13982, checked in by smasson, 3 years ago

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