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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 @ 11101

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

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

File size: 101.4 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   !!--------------------------------------------------------------------
11
12   !!--------------------------------------------------------------------
13   !!   iom_open       : open a file read only
14   !!   iom_close      : close a file or all files opened by iom
15   !!   iom_get        : read a field (interfaced to several routines)
16   !!   iom_gettime    : read the time axis cdvar in the file
17   !!   iom_varid      : get the id of a variable in a file
18   !!   iom_rstput     : write a field in a restart file (interfaced to several routines)
19   !!--------------------------------------------------------------------
20   USE dom_oce         ! ocean space and time domain
21   USE c1d             ! 1D vertical configuration
22   USE flo_oce         ! floats module declarations
23   USE lbclnk          ! lateal boundary condition / mpp exchanges
24   USE iom_def         ! iom variables definitions
25   USE iom_ioipsl      ! NetCDF format with IOIPSL library
26   USE iom_nf90        ! NetCDF format with native NetCDF library
27   USE iom_rstdimg     ! restarts access direct format "dimg" style...
28   USE in_out_manager  ! I/O manager
29   USE lib_mpp           ! MPP library
30#if defined key_iomput
31   USE sbc_oce, ONLY :   nn_fsbc         ! ocean space and time domain
32   USE trc_oce, ONLY :   nn_dttrc        !  !: frequency of step on passive tracers
33   USE icb_oce, ONLY :   nclasses, class_num       !  !: iceberg classes
34#if defined key_lim3
35   USE ice    , ONLY :   jpl
36#elif defined key_lim2
37   USE par_ice_2
38#endif
39   USE domngb          ! ocean space and time domain
40   USE phycst          ! physical constants
41   USE dianam          ! build name of file
42   USE xios
43# endif
44   USE ioipsl, ONLY :  ju2ymds    ! for calendar
45   USE crs             ! Grid coarsening
46   USE timing
47
48   IMPLICIT NONE
49   PUBLIC   !   must be public to be able to access iom_def through iom
50   
51#if defined key_iomput
52   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag
53#else
54   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
55#endif
56   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
57   PUBLIC iom_getatt, iom_use, iom_context_finalize
58
59   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
60   PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
61   PRIVATE iom_p1d, iom_p2d, iom_p3d
62#if defined key_iomput
63   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
64   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
65# endif
66
67   INTERFACE iom_get
68      MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
69   END INTERFACE
70   INTERFACE iom_getatt
71      MODULE PROCEDURE iom_g0d_intatt
72   END INTERFACE
73   INTERFACE iom_rstput
74      MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
75   END INTERFACE
76  INTERFACE iom_put
77     MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
78  END INTERFACE
79
80   !!----------------------------------------------------------------------
81   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
82   !! $Id$
83   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
84   !!----------------------------------------------------------------------
85
86CONTAINS
87
88   SUBROUTINE iom_init( cdname ) 
89      !!----------------------------------------------------------------------
90      !!                     ***  ROUTINE   ***
91      !!
92      !! ** Purpose :   
93      !!
94      !!----------------------------------------------------------------------
95      CHARACTER(len=*), INTENT(in)  :: cdname
96#if defined key_iomput
97#if ! defined key_xios2
98      TYPE(xios_time)     :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
99      CHARACTER(len=19)   :: cldate 
100#else
101      TYPE(xios_duration) :: dtime    = xios_duration(0, 0, 0, 0, 0, 0)
102      TYPE(xios_date)     :: start_date
103#endif
104      CHARACTER(len=10)   :: clname
105      INTEGER             :: ji
106      !
107      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
108      !!----------------------------------------------------------------------
109#if ! defined key_xios2
110      ALLOCATE( z_bnds(jpk,2) )
111#else
112      ALLOCATE( z_bnds(2,jpk) )
113#endif
114
115      clname = cdname
116      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
117      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
118      CALL iom_swap( cdname )
119
120      ! calendar parameters
121#if ! defined key_xios2
122      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
123      CASE ( 1)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")
124      CASE ( 0)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap")
125      CASE (30)   ;   CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360")
126      END SELECT
127      WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday 
128      CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
129#else
130      ! Calendar type is now defined in xml file
131      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
132      CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
133          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
134      CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), &
135          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
136      CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), &
137          &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) )
138      END SELECT
139#endif
140      ! horizontal grid definition
141
142      CALL set_scalar
143
144      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 
145         CALL set_grid( "T", glamt, gphit ) 
146         CALL set_grid( "U", glamu, gphiu )
147         CALL set_grid( "V", glamv, gphiv )
148         CALL set_grid( "W", glamt, gphit )
149         CALL set_grid_znl( gphit )
150         !
151         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
152            CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej))
153            CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej))
154            CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej))
155            CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej))
156            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
157            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
158            CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
159            CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
160         ENDIF
161      ENDIF
162
163      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 
164         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
165         !
166         CALL set_grid( "T", glamt_crs, gphit_crs ) 
167         CALL set_grid( "U", glamu_crs, gphiu_crs ) 
168         CALL set_grid( "V", glamv_crs, gphiv_crs ) 
169         CALL set_grid( "W", glamt_crs, gphit_crs ) 
170         CALL set_grid_znl( gphit_crs )
171          !
172         CALL dom_grid_glo   ! Return to parent grid domain
173         !
174         IF( ln_cfmeta ) THEN   ! Add additional grid metadata
175            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))
176            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))
177            CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))
178            CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))
179            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
180            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
181            CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
182            CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
183         ENDIF
184      ENDIF
185
186      ! vertical grid definition
187      CALL iom_set_axis_attr( "deptht", gdept_1d )
188      CALL iom_set_axis_attr( "depthu", gdept_1d )
189      CALL iom_set_axis_attr( "depthv", gdept_1d )
190      CALL iom_set_axis_attr( "depthw", gdepw_1d )
191
192      ! Add vertical grid bounds
193#if ! defined key_xios2
194      z_bnds(:      ,1) = gdepw_1d(:)
195      z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk)
196      z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk)
197#else
198      z_bnds(1      ,:) = gdepw_1d(:)
199      z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk)
200      z_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk)
201#endif
202
203      CALL iom_set_axis_attr( "deptht", bounds=z_bnds )
204      CALL iom_set_axis_attr( "depthu", bounds=z_bnds )
205      CALL iom_set_axis_attr( "depthv", bounds=z_bnds )
206
207#if ! defined key_xios2
208      z_bnds(:    ,2)  = gdept_1d(:)
209      z_bnds(2:jpk,1)  = gdept_1d(1:jpkm1)
210      z_bnds(1    ,1)  = gdept_1d(1) - e3w_1d(1)
211#else
212      z_bnds(2,:    )  = gdept_1d(:)
213      z_bnds(1,2:jpk)  = gdept_1d(1:jpkm1)
214      z_bnds(1,1    )  = gdept_1d(1) - e3w_1d(1)
215#endif
216      CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
217
218
219# if defined key_floats
220      CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
221# endif
222#if defined key_lim3 || defined key_lim2
223      CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
224#endif
225      CALL iom_set_axis_attr( "icbcla", class_num )
226      CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
227      CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
228     
229      ! automatic definitions of some of the xml attributs
230      CALL set_xmlatt
231
232      CALL set_1point
233
234      ! end file definition
235      dtime%second = rdt
236      CALL xios_set_timestep(dtime)
237      CALL xios_close_context_definition()
238     
239      CALL xios_update_calendar(0)
240
241      DEALLOCATE( z_bnds )
242
243#endif
244     
245   END SUBROUTINE iom_init
246
247
248   SUBROUTINE iom_swap( cdname )
249      !!---------------------------------------------------------------------
250      !!                   ***  SUBROUTINE  iom_swap  ***
251      !!
252      !! ** Purpose :  swap context between different agrif grid for xmlio_server
253      !!---------------------------------------------------------------------
254      CHARACTER(len=*), INTENT(in) :: cdname
255#if defined key_iomput
256      TYPE(xios_context) :: nemo_hdl
257
258      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
259        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
260      ELSE
261        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
262      ENDIF
263      !
264      CALL xios_set_current_context(nemo_hdl)
265#endif
266      !
267   END SUBROUTINE iom_swap
268
269
270   SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
271      !!---------------------------------------------------------------------
272      !!                   ***  SUBROUTINE  iom_open  ***
273      !!
274      !! ** Purpose :  open an input file (return 0 if not found)
275      !!---------------------------------------------------------------------
276      CHARACTER(len=*), INTENT(in   )           ::   cdname   ! File name
277      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file
278      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.)
279      INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap)
280      INTEGER         , INTENT(in   ), OPTIONAL ::   kiolib   ! library used to open the file (default = jpnf90)
281      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
282      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
283
284      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
285      CHARACTER(LEN=256)    ::   cltmpn    ! tempory name to store clname (in writting mode)
286      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg"
287      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
288      CHARACTER(LEN=256)    ::   clinfo    ! info character
289      LOGICAL               ::   llok      ! check the existence
290      LOGICAL               ::   llwrt     ! local definition of ldwrt
291      LOGICAL               ::   llnoov    ! local definition to read overlap
292      LOGICAL               ::   llstop    ! local definition of ldstop
293      LOGICAL               ::   lliof     ! local definition of ldiof
294      INTEGER               ::   iolib     ! library do we use to open the file
295      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits)
296      INTEGER               ::   iln, ils  ! lengths of character
297      INTEGER               ::   idom      ! type of domain
298      INTEGER               ::   istop     !
299      INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters:
300      ! local number of points for x,y dimensions
301      ! position of first local point for x,y dimensions
302      ! position of last local point for x,y dimensions
303      ! start halo size for x,y dimensions
304      ! end halo size for x,y dimensions
305      !---------------------------------------------------------------------
306      ! Initializations and control
307      ! =============
308      kiomid = -1
309      clinfo = '                    iom_open ~~~  '
310      istop = nstop
311      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
312      ! (could be done when defining iom_file in f95 but not in f90)
313      IF( Agrif_Root() ) THEN
314         IF( iom_open_init == 0 ) THEN
315            iom_file(:)%nfid = 0
316            iom_open_init = 1
317         ENDIF
318      ENDIF
319      ! do we read or write the file?
320      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt
321      ELSE                        ;   llwrt = .FALSE.
322      ENDIF
323      ! do we call ctl_stop if we try to open a non-existing file in read mode?
324      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
325      ELSE                         ;   llstop = .TRUE.
326      ENDIF
327      ! what library do we use to open the file?
328      IF( PRESENT(kiolib) ) THEN   ;   iolib = kiolib
329      ELSE                         ;   iolib = jpnf90
330      ENDIF
331      ! are we using interpolation on the fly?
332      IF( PRESENT(ldiof) ) THEN   ;   lliof = ldiof
333      ELSE                        ;   lliof = .FALSE.
334      ENDIF
335      ! do we read the overlap
336      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
337      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
338      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
339      ! =============
340      clname   = trim(cdname)
341      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
342         iln    = INDEX(clname,'/') 
343         cltmpn = clname(1:iln)
344         clname = clname(iln+1:LEN_TRIM(clname))
345         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
346      ENDIF
347      ! which suffix should we use?
348      SELECT CASE (iolib)
349      CASE (jpioipsl ) ;   clsuffix = '.nc'
350      CASE (jpnf90   ) ;   clsuffix = '.nc'
351      CASE (jprstdimg) ;   clsuffix = '.dimg'
352      CASE DEFAULT     ;   clsuffix = ''
353         CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
354      END SELECT
355      ! Add the suffix if needed
356      iln = LEN_TRIM(clname)
357      ils = LEN_TRIM(clsuffix)
358      IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 )   &
359         &   clname = TRIM(clname)//TRIM(clsuffix)
360      cltmpn = clname   ! store this name
361      ! try to find if the file to be opened already exist
362      ! =============
363      INQUIRE( FILE = clname, EXIST = llok )
364      IF( .NOT.llok ) THEN
365         ! we try to add the cpu number to the name
366         IF( iolib == jprstdimg ) THEN   ;   WRITE(clcpu,*) narea
367         ELSE                            ;   WRITE(clcpu,*) narea-1
368         ENDIF
369         clcpu  = TRIM(ADJUSTL(clcpu))
370         iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
371         clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
372         icnt = 0
373         INQUIRE( FILE = clname, EXIST = llok ) 
374         ! we try different formats for the cpu number by adding 0
375         DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
376            clcpu  = "0"//trim(clcpu)
377            clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
378            INQUIRE( FILE = clname, EXIST = llok )
379            icnt = icnt + 1
380         END DO
381      ENDIF
382      IF( llwrt ) THEN
383         ! check the domain definition
384! JMM + SM: ugly patch before getting the new version of lib_mpp)
385!         idom = jpdom_local_noovlap   ! default definition
386         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
387         ELSE                ;   idom = jpdom_local_full      ! default definition
388         ENDIF
389         IF( PRESENT(kdom) )   idom = kdom
390         ! create the domain informations
391         ! =============
392         SELECT CASE (idom)
393         CASE (jpdom_local_full)
394            idompar(:,1) = (/ jpi             , jpj              /)
395            idompar(:,2) = (/ nimpp           , njmpp            /)
396            idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /)
397            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
398            idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /)
399         CASE (jpdom_local_noextra)
400            idompar(:,1) = (/ nlci            , nlcj             /)
401            idompar(:,2) = (/ nimpp           , njmpp            /)
402            idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
403            idompar(:,4) = (/ nldi - 1        , nldj - 1         /)
404            idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /)
405         CASE (jpdom_local_noovlap)
406            idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /)
407            idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
408            idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
409            idompar(:,4) = (/ 0               , 0                /)
410            idompar(:,5) = (/ 0               , 0                /)
411         CASE DEFAULT
412            CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
413         END SELECT
414      ENDIF
415      ! Open the NetCDF or RSTDIMG file
416      ! =============
417      ! do we have some free file identifier?
418      IF( MINVAL(iom_file(:)%nfid) /= 0 )   &
419         &   CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
420      ! if no file was found...
421      IF( .NOT. llok ) THEN
422         IF( .NOT. llwrt ) THEN   ! we are in read mode
423            IF( llstop ) THEN   ;   CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
424            ELSE                ;   istop = nstop + 1   ! make sure that istop /= nstop so we don't open the file
425            ENDIF
426         ELSE                     ! we are in write mode so we
427            clname = cltmpn       ! get back the file name without the cpu number
428         ENDIF
429      ELSE
430         IF( llwrt .AND. .NOT. ln_clobber ) THEN   ! we stop as we want to write in a new file
431            CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
432            istop = nstop + 1                      ! make sure that istop /= nstop so we don't open the file
433         ELSEIF( llwrt ) THEN     ! the file exists and we are in write mode with permission to
434            clname = cltmpn       ! overwrite so get back the file name without the cpu number
435         ENDIF
436      ENDIF
437      IF( istop == nstop ) THEN   ! no error within this routine
438         SELECT CASE (iolib)
439         CASE (jpioipsl )   ;   CALL iom_ioipsl_open(  clname, kiomid, llwrt, llok, idompar )
440         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
441         CASE (jprstdimg)   ;   CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
442         CASE DEFAULT
443            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
444         END SELECT
445      ENDIF
446      !
447   END SUBROUTINE iom_open
448
449
450   SUBROUTINE iom_close( kiomid )
451      !!--------------------------------------------------------------------
452      !!                   ***  SUBROUTINE  iom_close  ***
453      !!
454      !! ** Purpose : close an input file, or all files opened by iom
455      !!--------------------------------------------------------------------
456      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
457      !                                              ! return 0 when file is properly closed
458      !                                              ! No argument: all files opened by iom are closed
459
460      INTEGER ::   jf         ! dummy loop indices
461      INTEGER ::   i_s, i_e   ! temporary integer
462      CHARACTER(LEN=100)    ::   clinfo    ! info character
463      !---------------------------------------------------------------------
464      !
465      clinfo = '                    iom_close ~~~  '
466      IF( PRESENT(kiomid) ) THEN
467         i_s = kiomid
468         i_e = kiomid
469      ELSE
470         i_s = 1
471         i_e = jpmax_files
472      ENDIF
473
474      IF( i_s > 0 ) THEN
475         DO jf = i_s, i_e
476            IF( iom_file(jf)%nfid > 0 ) THEN
477               SELECT CASE (iom_file(jf)%iolib)
478               CASE (jpioipsl )   ;   CALL iom_ioipsl_close(  jf )
479               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
480               CASE (jprstdimg)   ;   CALL iom_rstdimg_close( jf )
481               CASE DEFAULT
482                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
483               END SELECT
484               iom_file(jf)%nfid       = 0          ! free the id
485               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
486               IF(lwp .AND. nprint > 0) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
487            ELSEIF( PRESENT(kiomid) ) THEN
488               WRITE(ctmp1,*) '--->',  kiomid
489               CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
490            ENDIF
491         END DO
492      ENDIF
493      !   
494   END SUBROUTINE iom_close
495
496
497   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop ) 
498      !!-----------------------------------------------------------------------
499      !!                  ***  FUNCTION  iom_varid  ***
500      !!
501      !! ** Purpose : get the id of a variable in a file (return 0 if not found)
502      !!-----------------------------------------------------------------------
503      INTEGER              , INTENT(in   )           ::   kiomid   ! file Identifier
504      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable
505      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions
506      INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions
507      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.)
508      !
509      INTEGER                        ::   iom_varid, iiv, i_nvd
510      LOGICAL                        ::   ll_fnd
511      CHARACTER(LEN=100)             ::   clinfo                   ! info character
512      LOGICAL                        ::   llstop                   ! local definition of ldstop
513      !!-----------------------------------------------------------------------
514      iom_varid = 0                         ! default definition
515      ! do we call ctl_stop if we look for non-existing variable?
516      IF( PRESENT(ldstop) ) THEN   ;   llstop = ldstop
517      ELSE                         ;   llstop = .TRUE.
518      ENDIF
519      !
520      IF( kiomid > 0 ) THEN
521         clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
522         IF( iom_file(kiomid)%nfid == 0 ) THEN
523            CALL ctl_stop( trim(clinfo), 'the file is not open' )
524         ELSE
525            ll_fnd  = .FALSE.
526            iiv = 0
527            !
528            DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
529               iiv = iiv + 1
530               ll_fnd  = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
531            END DO
532            !
533            IF( .NOT.ll_fnd ) THEN
534               iiv = iiv + 1
535               IF( iiv <= jpmax_vars ) THEN
536                  SELECT CASE (iom_file(kiomid)%iolib)
537                  CASE (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
538                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz, kndims )
539                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file
540                  CASE DEFAULT   
541                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
542                  END SELECT
543               ELSE
544                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   &
545                        &                         'increase the parameter jpmax_vars')
546               ENDIF
547               IF( llstop .AND. iom_varid == -1 )   CALL ctl_stop( TRIM(clinfo)//' not found' ) 
548            ELSE
549               iom_varid = iiv
550               IF( PRESENT(kdimsz) ) THEN
551                  i_nvd = iom_file(kiomid)%ndims(iiv)
552                  IF( i_nvd == size(kdimsz) ) THEN
553                     kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
554                  ELSE
555                     WRITE(ctmp1,*) i_nvd, size(kdimsz)
556                     CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
557                  ENDIF
558               ENDIF
559               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv)
560            ENDIF
561         ENDIF
562      ENDIF
563      !
564   END FUNCTION iom_varid
565
566
567   !!----------------------------------------------------------------------
568   !!                   INTERFACE iom_get
569   !!----------------------------------------------------------------------
570   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )
571      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file
572      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable
573      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field
574      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number
575      !
576      INTEGER                                         ::   idvar     ! variable id
577      INTEGER                                         ::   idmspc    ! number of spatial dimensions
578      INTEGER         , DIMENSION(1)                  ::   itime     ! record number
579      CHARACTER(LEN=100)                              ::   clinfo    ! info character
580      CHARACTER(LEN=100)                              ::   clname    ! file name
581      CHARACTER(LEN=1)                                ::   cldmspc   !
582      !
583      itime = 1
584      IF( PRESENT(ktime) ) itime = ktime
585      !
586      clname = iom_file(kiomid)%name
587      clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
588      !
589      IF( kiomid > 0 ) THEN
590         idvar = iom_varid( kiomid, cdvar )
591         IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
592            idmspc = iom_file ( kiomid )%ndims( idvar )
593            IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1
594            WRITE(cldmspc , fmt='(i1)') idmspc
595            IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
596                                 &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
597                                 &                         'Use ncwa -a to suppress the unnecessary dimensions' )
598            SELECT CASE (iom_file(kiomid)%iolib)
599            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar, itime )
600            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar, itime )
601            CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar )
602            CASE DEFAULT   
603               CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
604            END SELECT
605         ENDIF
606      ENDIF
607   END SUBROUTINE iom_g0d
608
609   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
610      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file
611      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read
612      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable
613      REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field
614      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number
615      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading
616      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis
617      !
618      IF( kiomid > 0 ) THEN
619         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   &
620              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
621      ENDIF
622   END SUBROUTINE iom_g1d
623
624   SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
625      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file
626      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read
627      CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable
628      REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field
629      INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number
630      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading
631      INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis
632      LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
633                                                                               ! look for and use a file attribute
634                                                                               ! called open_ocean_jstart to set the start
635                                                                               ! value for the 2nd dimension (netcdf only)
636      !
637      IF( kiomid > 0 ) THEN
638         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   &
639              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
640              &                                                     lrowattr=lrowattr )
641      ENDIF
642   END SUBROUTINE iom_g2d
643
644   SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
645      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file
646      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read
647      CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable
648      REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field
649      INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number
650      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading
651      INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis
652      LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to
653                                                                                 ! look for and use a file attribute
654                                                                                 ! called open_ocean_jstart to set the start
655                                                                                 ! value for the 2nd dimension (netcdf only)
656      !
657      IF( kiomid > 0 ) THEN
658         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   &
659              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, &
660              &                                                     lrowattr=lrowattr )
661      ENDIF
662   END SUBROUTINE iom_g3d
663   !!----------------------------------------------------------------------
664
665   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
666         &                  pv_r1d, pv_r2d, pv_r3d,   &
667         &                  ktime , kstart, kcount,   &
668         &                  lrowattr                )
669      !!-----------------------------------------------------------------------
670      !!                  ***  ROUTINE  iom_get_123d  ***
671      !!
672      !! ** Purpose : read a 1D/2D/3D variable
673      !!
674      !! ** Method : read ONE record at each CALL
675      !!-----------------------------------------------------------------------
676      INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file
677      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
678      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable
679      REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case)
680      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case)
681      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case)
682      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number
683      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis
684      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
685      LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to
686                                                                           ! look for and use a file attribute
687                                                                           ! called open_ocean_jstart to set the start
688                                                                           ! value for the 2nd dimension (netcdf only)
689      !
690      LOGICAL                        ::   llnoov      ! local definition to read overlap
691      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute
692      INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute
693      INTEGER                        ::   jl          ! loop on number of dimension
694      INTEGER                        ::   idom        ! type of domain
695      INTEGER                        ::   idvar       ! id of the variable
696      INTEGER                        ::   inbdim      ! number of dimensions of the variable
697      INTEGER                        ::   idmspc      ! number of spatial dimensions
698      INTEGER                        ::   itime       ! record number
699      INTEGER                        ::   istop       ! temporary value of nstop
700      INTEGER                        ::   ix1, ix2, iy1, iy2   ! subdomain indexes
701      INTEGER                        ::   ji, jj      ! loop counters
702      INTEGER                        ::   irankpv     !
703      INTEGER                        ::   ind1, ind2  ! substring index
704      INTEGER, DIMENSION(jpmax_dims) ::   istart      ! starting point to read for each axis
705      INTEGER, DIMENSION(jpmax_dims) ::   icnt        ! number of value to read along each axis
706      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable
707      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable
708      REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset
709      INTEGER                        ::   itmp        ! temporary integer
710      CHARACTER(LEN=256)             ::   clinfo      ! info character
711      CHARACTER(LEN=256)             ::   clname      ! file name
712      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !
713      LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension.
714      !---------------------------------------------------------------------
715      !
716      clname = iom_file(kiomid)%name   !   esier to read
717      clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
718      ! local definition of the domain ?
719      idom = kdom
720      ! do we read the overlap
721      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
722      llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
723      ! check kcount and kstart optionals parameters...
724      IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
725      IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
726      IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) &
727     &           CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy')
728
729      luse_jattr = .false.
730      IF( PRESENT(lrowattr) ) THEN
731         IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
732         IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true.
733      ENDIF
734      IF( luse_jattr ) THEN
735         SELECT CASE (iom_file(kiomid)%iolib)
736         CASE (jpioipsl, jprstdimg )
737             CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)')
738             luse_jattr = .false.
739         CASE (jpnf90   )   
740             ! Ok
741         CASE DEFAULT   
742            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
743         END SELECT
744      ENDIF
745
746      ! Search for the variable in the data base (eventually actualize data)
747      istop = nstop
748      idvar = iom_varid( kiomid, cdvar )
749      !
750      IF( idvar > 0 ) THEN
751         ! to write iom_file(kiomid)%dimsz in a shorter way !
752         idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 
753         inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file
754         idmspc = inbdim                                   ! number of spatial dimensions in the file
755         IF( iom_file(kiomid)%luld(idvar) )   idmspc = inbdim - 1
756         IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 
757         !
758         ! update idom definition...
759         ! Identify the domain in case of jpdom_auto(glo/dta) definition
760         IF( idom == jpdom_autoglo_xy ) THEN
761            ll_depth_spec = .TRUE.
762            idom = jpdom_autoglo
763         ELSE
764            ll_depth_spec = .FALSE.
765         ENDIF
766         IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN           
767            IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global 
768            ELSE                               ;   idom = jpdom_data
769            ENDIF
770            ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
771            ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
772            IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF
773         ENDIF
774         ! Identify the domain in case of jpdom_local definition
775         IF( idom == jpdom_local ) THEN
776            IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full
777            ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra
778            ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap
779            ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
780            ENDIF
781         ENDIF
782         !
783         ! check the consistency between input array and data rank in the file
784         !
785         ! initializations
786         itime = 1
787         IF( PRESENT(ktime) ) itime = ktime
788
789         irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
790         WRITE(clrankpv, fmt='(i1)') irankpv
791         WRITE(cldmspc , fmt='(i1)') idmspc
792         !
793         IF(     idmspc <  irankpv ) THEN
794            CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   &
795               &                         'it is impossible to read a '//clrankpv//'D array from this file...' )
796         ELSEIF( idmspc == irankpv ) THEN
797            IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   &
798               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
799         ELSEIF( idmspc >  irankpv ) THEN
800               IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
801                  CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   &
802                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   &
803                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )   
804                  idmspc = idmspc - 1
805               ELSE
806                  CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   &
807                     &                         'we do not accept data with '//cldmspc//' spatial dimensions',   &
808                     &                         'Use ncwa -a to suppress the unnecessary dimensions' )
809               ENDIF
810         ENDIF
811
812         !
813         ! definition of istart and icnt
814         !
815         icnt  (:) = 1
816         istart(:) = 1
817         istart(idmspc+1) = itime
818
819         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
820         ELSE
821            IF(           idom == jpdom_unknown ) THEN                                                ; icnt(1:idmspc) = idimsz(1:idmspc)
822            ELSE
823               IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array
824                  IF(     idom == jpdom_data    ) THEN
825                     jstartrow = 1
826                     IF( luse_jattr ) THEN
827                        CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
828                        jstartrow = MAX(1,jstartrow)
829                     ENDIF
830                     istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below
831                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below
832                  ENDIF
833                  ! we do not read the overlap                     -> we start to read at nldi, nldj
834! JMM + SM: ugly patch before getting the new version of lib_mpp)
835!                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
836                  IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
837                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej
838! JMM + SM: ugly patch before getting the new version of lib_mpp)
839!                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
840                  IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
841                  ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
842                  ENDIF
843                  IF( PRESENT(pv_r3d) ) THEN
844                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta
845                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3)
846                     ELSE                                                           ; icnt(3) = jpk
847                     ENDIF
848                  ENDIF
849               ENDIF
850            ENDIF
851         ENDIF
852
853         ! check that istart and icnt can be used with this file
854         !-
855         DO jl = 1, jpmax_dims
856            itmp = istart(jl)+icnt(jl)-1
857            IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
858               WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
859               WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)"         ) jl, idimsz(jl)
860               CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )     
861            ENDIF
862         END DO
863
864         ! check that icnt matches the input array
865         !-     
866         IF( idom == jpdom_unknown ) THEN
867            IF( irankpv == 1 )        ishape(1:1) = SHAPE(pv_r1d)
868            IF( irankpv == 2 )        ishape(1:2) = SHAPE(pv_r2d)
869            IF( irankpv == 3 )        ishape(1:3) = SHAPE(pv_r3d)
870            ctmp1 = 'd'
871         ELSE
872            IF( irankpv == 2 ) THEN
873! JMM + SM: ugly patch before getting the new version of lib_mpp)
874!               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
875               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
876               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
877               ENDIF
878            ENDIF
879            IF( irankpv == 3 ) THEN 
880! JMM + SM: ugly patch before getting the new version of lib_mpp)
881!               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
882               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
883               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
884               ENDIF
885            ENDIF
886         ENDIF
887         
888         DO jl = 1, irankpv
889            WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
890            IF( ishape(jl) /= icnt(jl) )   CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
891         END DO
892
893      ENDIF
894
895      ! read the data
896      !-     
897      IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point...
898         !
899         ! find the right index of the array to be read
900! JMM + SM: ugly patch before getting the new version of lib_mpp)
901!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
902!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
903!         ENDIF
904         IF( llnoov ) THEN
905            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
906            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
907            ENDIF
908         ELSE
909            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj
910            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
911            ENDIF
912         ENDIF
913     
914         SELECT CASE (iom_file(kiomid)%iolib)
915         CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
916            &                                         pv_r1d, pv_r2d, pv_r3d )
917         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
918            &                                         pv_r1d, pv_r2d, pv_r3d )
919         CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2,   &
920            &                                         pv_r1d, pv_r2d, pv_r3d )
921         CASE DEFAULT   
922            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
923         END SELECT
924
925         IF( istop == nstop ) THEN   ! no additional errors until this point...
926            IF(lwp .AND. nprint > 1) &
927               WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
928         
929            !--- overlap areas and extra hallows (mpp)
930            IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
931               CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
932            ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
933               ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
934               IF( icnt(3) == jpk ) THEN
935                  CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
936               ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...)
937                  DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO
938                  DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO
939               ENDIF
940            ENDIF
941           
942            ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
943            IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( pv_r2d,'Z',1. )
944            IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( pv_r3d,'Z',1. )
945   
946            !--- Apply scale_factor and offset
947            zscf = iom_file(kiomid)%scf(idvar)      ! scale factor
948            zofs = iom_file(kiomid)%ofs(idvar)      ! offset
949            IF(     PRESENT(pv_r1d) ) THEN
950               IF( zscf /= 1. )   pv_r1d(:) = pv_r1d(:) * zscf 
951               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs
952            ELSEIF( PRESENT(pv_r2d) ) THEN
953!CDIR COLLAPSE
954               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
955!CDIR COLLAPSE
956               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
957            ELSEIF( PRESENT(pv_r3d) ) THEN
958!CDIR COLLAPSE
959               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
960!CDIR COLLAPSE
961               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
962            ENDIF
963            !
964         ENDIF
965         !
966      ENDIF
967      !
968   END SUBROUTINE iom_get_123d
969
970
971   SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
972      !!--------------------------------------------------------------------
973      !!                   ***  SUBROUTINE iom_gettime  ***
974      !!
975      !! ** Purpose : read the time axis cdvar in the file
976      !!--------------------------------------------------------------------
977      INTEGER                    , INTENT(in   ) ::   kiomid     ! file Identifier
978      REAL(wp), DIMENSION(:)     , INTENT(  out) ::   ptime      ! the time axis
979      CHARACTER(len=*), OPTIONAL , INTENT(in   ) ::   cdvar      ! time axis name
980      INTEGER         , OPTIONAL , INTENT(  out) ::   kntime     ! number of times in file
981      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdunits    ! units attribute of time coordinate
982      CHARACTER(len=*), OPTIONAL , INTENT(  out) ::   cdcalendar ! calendar attribute of
983      !
984      INTEGER, DIMENSION(1) :: kdimsz
985      INTEGER            ::   idvar    ! id of the variable
986      CHARACTER(LEN=32)  ::   tname    ! local name of time coordinate
987      CHARACTER(LEN=100) ::   clinfo   ! info character
988      !---------------------------------------------------------------------
989      !
990      IF ( PRESENT(cdvar) ) THEN
991         tname = cdvar
992      ELSE
993         tname = iom_file(kiomid)%uldname
994      ENDIF
995      IF( kiomid > 0 ) THEN
996         clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
997         IF ( PRESENT(kntime) ) THEN
998            idvar  = iom_varid( kiomid, tname, kdimsz = kdimsz )
999            kntime = kdimsz(1)
1000         ELSE
1001            idvar = iom_varid( kiomid, tname )
1002         ENDIF
1003         !
1004         ptime(:) = 0. ! default definition
1005         IF( idvar > 0 ) THEN
1006            IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
1007               IF( iom_file(kiomid)%luld(idvar) ) THEN
1008                  IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
1009                     SELECT CASE (iom_file(kiomid)%iolib)
1010                     CASE (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
1011                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
1012                     CASE (jprstdimg)   ;   CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
1013                     CASE DEFAULT   
1014                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1015                     END SELECT
1016                  ELSE
1017                     WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
1018                     CALL ctl_stop( trim(clinfo), trim(ctmp1) )
1019                  ENDIF
1020               ELSE
1021                  CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
1022               ENDIF
1023            ELSE
1024               CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
1025            ENDIF
1026         ELSE
1027            CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
1028         ENDIF
1029      ENDIF
1030      !
1031   END SUBROUTINE iom_gettime
1032
1033
1034   !!----------------------------------------------------------------------
1035   !!                   INTERFACE iom_getatt
1036   !!----------------------------------------------------------------------
1037   SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
1038      INTEGER         , INTENT(in   )                 ::   kiomid    !Identifier of the file
1039      CHARACTER(len=*), INTENT(in   )                 ::   cdatt     ! Name of the attribute
1040      INTEGER         , INTENT(  out)                 ::   pvar      ! read field
1041      !
1042      IF( kiomid > 0 ) THEN
1043         IF( iom_file(kiomid)%nfid > 0 ) THEN
1044            SELECT CASE (iom_file(kiomid)%iolib)
1045            CASE (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
1046            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
1047            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
1048            CASE DEFAULT   
1049               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1050            END SELECT
1051         ENDIF
1052      ENDIF
1053   END SUBROUTINE iom_g0d_intatt
1054
1055
1056   !!----------------------------------------------------------------------
1057   !!                   INTERFACE iom_rstput
1058   !!----------------------------------------------------------------------
1059   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1060      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1061      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1062      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1063      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1064      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field
1065      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1066      INTEGER :: ivid   ! variable id
1067      IF( kiomid > 0 ) THEN
1068         IF( iom_file(kiomid)%nfid > 0 ) THEN
1069            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1070            SELECT CASE (iom_file(kiomid)%iolib)
1071            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
1072            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
1073            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
1074            CASE DEFAULT     
1075               CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1076            END SELECT
1077         ENDIF
1078      ENDIF
1079   END SUBROUTINE iom_rp0d
1080
1081   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1082      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1083      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1084      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1085      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1086      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field
1087      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1088      INTEGER :: ivid   ! variable id
1089      IF( kiomid > 0 ) THEN
1090         IF( iom_file(kiomid)%nfid > 0 ) THEN
1091            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1092            SELECT CASE (iom_file(kiomid)%iolib)
1093            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
1094            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
1095            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
1096            CASE DEFAULT     
1097               CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1098            END SELECT
1099         ENDIF
1100      ENDIF
1101   END SUBROUTINE iom_rp1d
1102
1103   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1104      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1105      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1106      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1107      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1108      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field
1109      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1110      INTEGER :: ivid   ! variable id
1111      IF( kiomid > 0 ) THEN
1112         IF( iom_file(kiomid)%nfid > 0 ) THEN
1113            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1114            SELECT CASE (iom_file(kiomid)%iolib)
1115            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
1116            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
1117            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 
1118            CASE DEFAULT     
1119               CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1120            END SELECT
1121         ENDIF
1122      ENDIF
1123   END SUBROUTINE iom_rp2d
1124
1125   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1126      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step
1127      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step
1128      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file
1129      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name
1130      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field
1131      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type
1132      INTEGER :: ivid   ! variable id
1133      IF( kiomid > 0 ) THEN
1134         IF( iom_file(kiomid)%nfid > 0 ) THEN
1135            ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1136            SELECT CASE (iom_file(kiomid)%iolib)
1137            CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
1138            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
1139            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
1140            CASE DEFAULT     
1141               CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
1142            END SELECT
1143         ENDIF
1144      ENDIF
1145   END SUBROUTINE iom_rp3d
1146
1147
1148   !!----------------------------------------------------------------------
1149   !!                   INTERFACE iom_put
1150   !!----------------------------------------------------------------------
1151   SUBROUTINE iom_p0d( cdname, pfield0d )
1152      CHARACTER(LEN=*), INTENT(in) ::   cdname
1153      REAL(wp)        , INTENT(in) ::   pfield0d
1154#if ! defined key_xios2
1155      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
1156#endif
1157#if defined key_iomput
1158#if ! defined key_xios2
1159      zz(:,:)=pfield0d
1160      CALL xios_send_field(cdname, zz)
1161#else
1162      CALL xios_send_field(cdname, (/pfield0d/)) 
1163#endif
1164#else
1165      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
1166#endif
1167   END SUBROUTINE iom_p0d
1168
1169   SUBROUTINE iom_p1d( cdname, pfield1d )
1170      CHARACTER(LEN=*)          , INTENT(in) ::   cdname
1171      REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d
1172#if defined key_iomput
1173      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
1174#else
1175      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings
1176#endif
1177   END SUBROUTINE iom_p1d
1178
1179   SUBROUTINE iom_p2d( cdname, pfield2d )
1180      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
1181      REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d
1182#if defined key_iomput
1183      CALL xios_send_field(cdname, pfield2d)
1184#else
1185      IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings
1186#endif
1187   END SUBROUTINE iom_p2d
1188
1189   SUBROUTINE iom_p3d( cdname, pfield3d )
1190      CHARACTER(LEN=*)                , INTENT(in) ::   cdname
1191      REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d
1192#if defined key_iomput
1193      CALL xios_send_field(cdname, pfield3d)
1194#else
1195      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
1196#endif
1197   END SUBROUTINE iom_p3d
1198   !!----------------------------------------------------------------------
1199
1200#if defined key_iomput
1201
1202   SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj,   &
1203      &                                    data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask,     &
1204      &                                    nvertex, bounds_lon, bounds_lat, area )
1205      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
1206      INTEGER                  , OPTIONAL, INTENT(in) ::   ni_glo, nj_glo, ibegin, jbegin, ni, nj
1207      INTEGER                  , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj
1208      INTEGER                  , OPTIONAL, INTENT(in) ::   zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex
1209      REAL(wp), DIMENSION(:)   , OPTIONAL, INTENT(in) ::   lonvalue, latvalue
1210      REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area
1211#if ! defined key_xios2
1212     LOGICAL,  DIMENSION(:,:) , OPTIONAL, INTENT(in) ::   mask
1213#else
1214      LOGICAL,  DIMENSION(:) , OPTIONAL, INTENT(in) ::   mask
1215#endif
1216
1217#if ! defined key_xios2
1218      IF ( xios_is_valid_domain     (cdid) ) THEN
1219         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
1220            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
1221            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       &
1222            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
1223            &    bounds_lat=bounds_lat, area=area )
1224     ENDIF
1225      IF ( xios_is_valid_domaingroup(cdid) ) THEN
1226         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
1227            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
1228            &    zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj,                       &
1229            &    lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon,                  &
1230            &    bounds_lat=bounds_lat, area=area )
1231      ENDIF
1232
1233#else
1234      IF ( xios_is_valid_domain     (cdid) ) THEN
1235         CALL xios_set_domain_attr     ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
1236            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
1237            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  &
1238            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
1239     ENDIF
1240      IF ( xios_is_valid_domaingroup(cdid) ) THEN
1241         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   &
1242            &    data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj ,   &
1243            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,                  &
1244            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
1245      ENDIF
1246#endif
1247      CALL xios_solve_inheritance()
1248
1249   END SUBROUTINE iom_set_domain_attr
1250
1251#if defined key_xios2
1252  SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj)
1253     CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
1254     INTEGER                  , OPTIONAL, INTENT(in) ::   ibegin, jbegin, ni, nj
1255
1256     IF ( xios_is_valid_zoom_domain     (cdid) ) THEN
1257         CALL xios_set_zoom_domain_attr     ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni,    &
1258           &   nj=nj)
1259    ENDIF
1260  END SUBROUTINE iom_set_zoom_domain_attr
1261#endif
1262
1263
1264   SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
1265      CHARACTER(LEN=*)      , INTENT(in) ::   cdid
1266      REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   paxis
1267      REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds
1268      IF ( PRESENT(paxis) ) THEN
1269#if ! defined key_xios2
1270         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, size=SIZE(paxis), value=paxis )
1271         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
1272#else
1273         IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis )
1274         IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
1275#endif
1276      ENDIF
1277      IF ( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds )
1278      IF ( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
1279      CALL xios_solve_inheritance()
1280   END SUBROUTINE iom_set_axis_attr
1281
1282   SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
1283      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
1284#if ! defined key_xios2
1285      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_op
1286      CHARACTER(LEN=*)   ,OPTIONAL , INTENT(in) ::   freq_offset
1287#else
1288      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_op
1289      TYPE(xios_duration),OPTIONAL , INTENT(in) ::   freq_offset
1290#endif
1291      IF ( xios_is_valid_field     (cdid) )   CALL xios_set_field_attr       &
1292    &     ( cdid, freq_op=freq_op, freq_offset=freq_offset )
1293      IF ( xios_is_valid_fieldgroup(cdid) )   CALL xios_set_fieldgroup_attr  &
1294    &                    ( cdid, freq_op=freq_op, freq_offset=freq_offset )
1295      CALL xios_solve_inheritance()
1296   END SUBROUTINE iom_set_field_attr
1297
1298   SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
1299      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
1300      CHARACTER(LEN=*),OPTIONAL , INTENT(in) ::   name, name_suffix
1301      IF ( xios_is_valid_file     (cdid) )   CALL xios_set_file_attr     ( cdid, name=name, name_suffix=name_suffix )
1302      IF ( xios_is_valid_filegroup(cdid) )   CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
1303      CALL xios_solve_inheritance()
1304   END SUBROUTINE iom_set_file_attr
1305
1306
1307   SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
1308      CHARACTER(LEN=*)          , INTENT(in ) ::   cdid
1309      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::   name, name_suffix
1310#if ! defined key_xios2
1311      CHARACTER(LEN=*),OPTIONAL , INTENT(out) ::    output_freq
1312#else
1313      TYPE(xios_duration)   ,OPTIONAL , INTENT(out) :: output_freq
1314#endif 
1315      LOGICAL                                 ::   llexist1,llexist2,llexist3
1316      !---------------------------------------------------------------------
1317      IF( PRESENT( name        ) )   name = ''          ! default values
1318      IF( PRESENT( name_suffix ) )   name_suffix = ''
1319#if ! defined key_xios2
1320      IF( PRESENT( output_freq ) )   output_freq = ''
1321#else
1322      IF( PRESENT( output_freq ) )   output_freq = xios_duration(0,0,0,0,0,0)
1323#endif
1324      IF ( xios_is_valid_file     (cdid) ) THEN
1325         CALL xios_solve_inheritance()
1326         CALL xios_is_defined_file_attr     ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
1327         IF(llexist1)   CALL xios_get_file_attr     ( cdid, name = name )
1328         IF(llexist2)   CALL xios_get_file_attr     ( cdid, name_suffix = name_suffix )
1329         IF(llexist3)   CALL xios_get_file_attr     ( cdid, output_freq = output_freq )
1330      ENDIF
1331      IF ( xios_is_valid_filegroup(cdid) ) THEN
1332         CALL xios_solve_inheritance()
1333         CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
1334         IF(llexist1)   CALL xios_get_filegroup_attr( cdid, name = name )
1335         IF(llexist2)   CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
1336         IF(llexist3)   CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
1337      ENDIF
1338   END SUBROUTINE iom_get_file_attr
1339
1340
1341   SUBROUTINE iom_set_grid_attr( cdid, mask )
1342      CHARACTER(LEN=*)                   , INTENT(in) ::   cdid
1343      LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) ::   mask
1344#if ! defined key_xios2
1345      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask=mask )
1346      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask=mask )
1347#else
1348      IF ( xios_is_valid_grid     (cdid) )   CALL xios_set_grid_attr     ( cdid, mask_3D=mask )
1349      IF ( xios_is_valid_gridgroup(cdid) )   CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
1350#endif
1351      CALL xios_solve_inheritance()
1352   END SUBROUTINE iom_set_grid_attr
1353
1354   SUBROUTINE iom_setkt( kt, cdname )
1355      INTEGER         , INTENT(in) ::   kt 
1356      CHARACTER(LEN=*), INTENT(in) ::   cdname
1357      !     
1358      CALL iom_swap( cdname )   ! swap to cdname context
1359      CALL xios_update_calendar(kt)
1360      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
1361      !
1362   END SUBROUTINE iom_setkt
1363
1364   SUBROUTINE iom_context_finalize( cdname )
1365      CHARACTER(LEN=*), INTENT(in) :: cdname
1366      !
1367      IF( xios_is_valid_context(cdname) ) THEN
1368         CALL iom_swap( cdname )   ! swap to cdname context
1369         CALL xios_context_finalize() ! finalize the context
1370         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context
1371      ENDIF
1372      !
1373   END SUBROUTINE iom_context_finalize
1374
1375
1376   SUBROUTINE set_grid( cdgrd, plon, plat )
1377      !!----------------------------------------------------------------------
1378      !!                     ***  ROUTINE set_grid  ***
1379      !!
1380      !! ** Purpose :   define horizontal grids
1381      !!
1382      !!----------------------------------------------------------------------
1383      CHARACTER(LEN=1)            , INTENT(in) ::   cdgrd
1384      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
1385      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
1386      !
1387      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask
1388      INTEGER  :: ni,nj
1389     
1390      ni=nlei-nldi+1 ; nj=nlej-nldj+1
1391
1392#if ! defined key_xios2
1393     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
1394#else
1395     CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
1396#endif     
1397      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
1398      CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   &
1399         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 
1400
1401      IF ( ln_mskland ) THEN
1402         ! mask land points, keep values on coast line -> specific mask for U, V and W points
1403
1404
1405         SELECT CASE ( cdgrd )
1406         ! The masks applied here are specifically used to mask out duplicate
1407         ! data points in wrap columns and N-fold rows in order to ensure bit
1408         ! reproducibility of diagnostics which have not undergone an explicit
1409         ! lbc_lnk prior to writing. Such fields are prone to junk values at
1410         ! duplicate points since those points are often excluded from the
1411         ! core field computation process.
1412         CASE('T')   
1413            zmask(:,:,:) = tmask_i_diag(:,:,:)
1414         CASE('U')     
1415            zmask(:,:,:) = umask_i_diag(:,:,:)
1416    CASE('V')   
1417            zmask(:,:,:) = vmask_i_diag(:,:,:)
1418         CASE('W')   
1419            zmask(:,:,2:jpk  ) = tmask_i_diag(:,:,1:jpkm1) + tmask_i_diag(:,:,2:jpk)   
1420            zmask(:,:,1) = tmask_i_diag(:,:,1)
1421        END SELECT
1422         !
1423#if ! defined key_xios2
1424         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj    /)) /= 0. )
1425#else
1426         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. )
1427#endif 
1428         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
1429      ENDIF
1430     
1431   END SUBROUTINE set_grid
1432
1433
1434   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
1435      !!----------------------------------------------------------------------
1436      !!                   ***  ROUTINE set_grid_bounds  ***
1437      !!
1438      !! ** Purpose :   define horizontal grid corners
1439      !!
1440      !!----------------------------------------------------------------------
1441      CHARACTER(LEN=1) , INTENT(in) :: cdgrd
1442      !
1443      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)           :: plon_cnr, plat_cnr  ! Lat/lon coordinates of a contiguous vertex of cell (i,j)
1444      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coordinates of the point of cell (i,j)
1445      !
1446      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:)   :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j)
1447      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_fld       ! Working array to determine where to rotate cells
1448      REAL(wp), ALLOCATABLE, DIMENSION(:,:)       :: z_rot       ! Lat/lon working array for rotation of cells
1449      !
1450      INTEGER :: icnr, jcnr                                      ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
1451      !                                                          ! represents the bottom-left corner of cell (i,j)
1452      INTEGER :: ji, jj, jn, ni, nj
1453
1454      ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2)  )
1455
1456      ! Offset of coordinate representing bottom-left corner
1457      SELECT CASE ( TRIM(cdgrd) )
1458         CASE ('T', 'W')
1459            icnr = -1 ; jcnr = -1
1460         CASE ('U')
1461            icnr =  0 ; jcnr = -1
1462         CASE ('V')
1463            icnr = -1 ; jcnr =  0
1464      END SELECT
1465
1466      ni = nlei-nldi+1 ; nj = nlej-nldj+1  ! Dimensions of subdomain interior
1467
1468      z_fld(:,:) = 1._wp
1469      CALL lbc_lnk( z_fld, cdgrd, -1. )    ! Working array for location of northfold
1470
1471      ! Cell vertices that can be defined
1472      DO jj = 2, jpjm1
1473         DO ji = 2, jpim1
1474            z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
1475            z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
1476            z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
1477            z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
1478            z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left
1479            z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right
1480            z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
1481            z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left
1482         END DO
1483      END DO
1484
1485      ! Cell vertices on boundries
1486      DO jn = 1, 4
1487         CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
1488         CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
1489      END DO
1490
1491      ! Zero-size cells at closed boundaries if cell points provided,
1492      ! otherwise they are closed cells with unrealistic bounds
1493      IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
1494         IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
1495            DO jn = 1, 4        ! (West or jpni = 1), closed E-W
1496               z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:)
1497            END DO
1498         ENDIF
1499         IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
1500            DO jn = 1, 4        ! (East or jpni = 1), closed E-W
1501               z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
1502            END DO
1503         ENDIF
1504         IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
1505            DO jn = 1, 4        ! South or (jpnj = 1, not symmetric)
1506               z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1)
1507            END DO
1508         ENDIF
1509         IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN
1510            DO jn = 1, 4        ! (North or jpnj = 1), no north fold
1511               z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
1512            END DO
1513         ENDIF
1514      ENDIF
1515
1516      ! Rotate cells at the north fold
1517      IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN
1518         DO jj = 1, jpj
1519            DO ji = 1, jpi
1520               IF( z_fld(ji,jj) == -1. ) THEN
1521                  z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
1522                  z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
1523                  z_bnds(:,ji,jj,:) = z_rot(:,:)
1524               ENDIF
1525            END DO
1526         END DO
1527
1528      ! Invert cells at the symmetric equator
1529      ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN
1530         DO ji = 1, jpi
1531            z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
1532            z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
1533            z_bnds(:,ji,1,:) = z_rot(:,:)
1534         END DO
1535      ENDIF
1536
1537      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           &
1538                                               bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
1539
1540      DEALLOCATE( z_bnds, z_fld, z_rot ) 
1541
1542   END SUBROUTINE set_grid_bounds
1543
1544
1545   SUBROUTINE set_grid_znl( plat )
1546      !!----------------------------------------------------------------------
1547      !!                     ***  ROUTINE set_grid_znl  ***
1548      !!
1549      !! ** Purpose :   define grids for zonal mean
1550      !!
1551      !!----------------------------------------------------------------------
1552      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
1553      !
1554      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon
1555      INTEGER  :: ni,nj, ix, iy
1556
1557     
1558      ni=nlei-nldi+1 ; nj=nlej-nldj+1            ! define zonal mean domain (jpj*jpk)
1559      ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0.
1560
1561      CALL dom_ngb( -168.7, 65.6, ix, iy, 'T' ) !  i-line that passes across Bering strait to avoid land processor (used in plots)
1562#if ! defined key_xios2
1563      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
1564      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
1565      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
1566         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 
1567      !
1568      CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
1569#else
1570! Pas teste : attention aux indices !
1571      CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
1572      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
1573      CALL iom_set_domain_attr("gznl", lonvalue = zlon,   &
1574         &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 
1575       CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
1576#endif
1577
1578      CALL iom_update_file_name('ptr')
1579      !
1580   END SUBROUTINE set_grid_znl
1581
1582   SUBROUTINE set_scalar
1583      !!----------------------------------------------------------------------
1584      !!                     ***  ROUTINE set_scalar  ***
1585      !!
1586      !! ** Purpose :   define fake grids for scalar point
1587      !!
1588      !!----------------------------------------------------------------------
1589      REAL(wp), DIMENSION(1)   ::   zz = 1.
1590      !!----------------------------------------------------------------------
1591#if ! defined key_xios2
1592      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
1593#else
1594      CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
1595#endif
1596      CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
1597     
1598      zz=REAL(narea,wp)
1599      CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
1600     
1601   END SUBROUTINE set_scalar
1602
1603   SUBROUTINE set_1point
1604      !!----------------------------------------------------------------------
1605      !!                     ***  ROUTINE set_1point  ***
1606      !!
1607      !! ** Purpose :   define zoom grid for scalar fields
1608      !!
1609      !!----------------------------------------------------------------------
1610      REAL(wp), DIMENSION(1)   ::   zz = 1.
1611      INTEGER  :: ix, iy
1612      !!----------------------------------------------------------------------
1613      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  Nearest point to north pole should be ocean
1614      CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy)
1615
1616   END SUBROUTINE set_1point
1617
1618
1619
1620   SUBROUTINE set_xmlatt
1621      !!----------------------------------------------------------------------
1622      !!                     ***  ROUTINE set_xmlatt  ***
1623      !!
1624      !! ** Purpose :   automatic definitions of some of the xml attributs...
1625      !!
1626      !!----------------------------------------------------------------------
1627      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
1628      CHARACTER(len=256)             ::   clsuff                   ! suffix name
1629      CHARACTER(len=1)               ::   cl1                      ! 1 character
1630      CHARACTER(len=2)               ::   cl2                      ! 2 characters
1631      CHARACTER(len=3)               ::   cl3                      ! 3 characters
1632      INTEGER                        ::   ji, jg                   ! loop counters
1633      INTEGER                        ::   ix, iy                   ! i-,j- index
1634      REAL(wp)        ,DIMENSION(11) ::   zlontao                  ! longitudes of tao    moorings
1635      REAL(wp)        ,DIMENSION( 7) ::   zlattao                  ! latitudes  of tao    moorings
1636      REAL(wp)        ,DIMENSION( 4) ::   zlonrama                 ! longitudes of rama   moorings
1637      REAL(wp)        ,DIMENSION(11) ::   zlatrama                 ! latitudes  of rama   moorings
1638      REAL(wp)        ,DIMENSION( 3) ::   zlonpira                 ! longitudes of pirata moorings
1639      REAL(wp)        ,DIMENSION( 9) ::   zlatpira                 ! latitudes  of pirata moorings
1640#if  defined key_xios2
1641      TYPE(xios_duration)            ::   f_op, f_of
1642#endif
1643 
1644      !!----------------------------------------------------------------------
1645      !
1646      ! frequency of the call of iom_put (attribut: freq_op)
1647#if ! defined key_xios2
1648      WRITE(cl1,'(i1)')        1   ;   CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts')
1649      WRITE(cl1,'(i1)')        2   ;   CALL iom_set_field_attr('trendT_even'      , freq_op=cl1//'ts', freq_offset='0ts')
1650      WRITE(cl1,'(i1)')        2   ;   CALL iom_set_field_attr('trendT_odd'       , freq_op=cl1//'ts', freq_offset='-1ts')
1651      WRITE(cl1,'(i1)')        2   ;   CALL iom_set_field_attr('ptrd_T_even'      , freq_op=cl1//'ts', freq_offset='0ts')
1652      WRITE(cl1,'(i1)')        2   ;   CALL iom_set_field_attr('ptrd_T_odd'       , freq_op=cl1//'ts', freq_offset='-1ts')
1653      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC'             , freq_op=cl1//'ts', freq_offset='0ts')
1654      WRITE(cl1,'(i1)')  nn_fsbc   ;   CALL iom_set_field_attr('SBC_scalar'      , freq_op=cl1//'ts', freq_offset='0ts')
1655      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('ptrc_T'          , freq_op=cl1//'ts', freq_offset='0ts')
1656      WRITE(cl1,'(i1)') nn_dttrc   ;   CALL iom_set_field_attr('diad_T'          , freq_op=cl1//'ts', freq_offset='0ts')
1657#else
1658      f_op%timestep = 1        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
1659      f_op%timestep = 2        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('trendT_even'      , freq_op=f_op, freq_offset=f_of)
1660      f_op%timestep = 2        ;  f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd'       , freq_op=f_op, freq_offset=f_of)
1661      f_op%timestep = 2        ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrd_T_even'      , freq_op=f_op, freq_offset=f_of)
1662      f_op%timestep = 2        ;  f_of%timestep = -1 ; CALL iom_set_field_attr('ptrd_T_odd'       , freq_op=f_op, freq_offset=f_of)
1663      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of)
1664      f_op%timestep = nn_fsbc  ;  f_of%timestep = 0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of)
1665      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of)
1666      f_op%timestep = nn_dttrc ;  f_of%timestep = 0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of)
1667#endif
1668       
1669      ! output file names (attribut: name)
1670      DO ji = 1, 9
1671         WRITE(cl1,'(i1)') ji 
1672         CALL iom_update_file_name('file'//cl1)
1673      END DO
1674      DO ji = 1, 99
1675         WRITE(cl2,'(i2.2)') ji 
1676         CALL iom_update_file_name('file'//cl2)
1677      END DO
1678      DO ji = 1, 999
1679         WRITE(cl3,'(i3.3)') ji 
1680         CALL iom_update_file_name('file'//cl3)
1681      END DO
1682
1683      ! Zooms...
1684      clgrd = (/ 'T', 'U', 'W' /) 
1685      DO jg = 1, SIZE(clgrd)                                                                   ! grid type
1686         cl1 = clgrd(jg)
1687         ! Equatorial section (attributs: jbegin, ni, name_suffix)
1688         CALL dom_ngb( 0., 0., ix, iy, cl1 )
1689#if ! defined key_xios2
1690         CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
1691#else
1692         CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo)
1693#endif
1694         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             )
1695         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
1696         CALL iom_update_file_name('Eq'//cl1)
1697      END DO
1698      ! TAO moorings (attributs: ibegin, jbegin, name_suffix)
1699      zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
1700      zlattao = (/  -8.0,  -5.0,  -2.0,   0.0,    2.0,    5.0,    8.0 /)
1701      CALL set_mooring( zlontao, zlattao )
1702      ! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
1703      zlonrama = (/  55.0,  67.0, 80.5, 90.0 /)
1704      zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
1705      CALL set_mooring( zlonrama, zlatrama )
1706      ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
1707      zlonpira = (/ -38.0, -23.0, -10.0 /)
1708      zlatpira = (/ -19.0, -14.0,  -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
1709      CALL set_mooring( zlonpira, zlatpira )
1710
1711     
1712   END SUBROUTINE set_xmlatt
1713
1714
1715   SUBROUTINE set_mooring( plon, plat)
1716      !!----------------------------------------------------------------------
1717      !!                     ***  ROUTINE set_mooring  ***
1718      !!
1719      !! ** Purpose :   automatic definitions of moorings xml attributs...
1720      !!
1721      !!----------------------------------------------------------------------
1722      REAL(wp), DIMENSION(:), INTENT(in) ::  plon, plat           ! longitudes/latitudes oft the mooring
1723      !
1724!!$      CHARACTER(len=1),DIMENSION(4) ::   clgrd = (/ 'T', 'U', 'V', 'W' /)   ! suffix name
1725      CHARACTER(len=1),DIMENSION(1) ::   clgrd = (/ 'T' /)        ! suffix name
1726      CHARACTER(len=256)            ::   clname                   ! file name
1727      CHARACTER(len=256)            ::   clsuff                   ! suffix name
1728      CHARACTER(len=1)              ::   cl1                      ! 1 character
1729      CHARACTER(len=6)              ::   clon,clat                ! name of longitude, latitude
1730      INTEGER                       ::   ji, jj, jg               ! loop counters
1731      INTEGER                       ::   ix, iy                   ! i-,j- index
1732      REAL(wp)                      ::   zlon, zlat
1733      !!----------------------------------------------------------------------
1734      DO jg = 1, SIZE(clgrd)
1735         cl1 = clgrd(jg)
1736         DO ji = 1, SIZE(plon)
1737            DO jj = 1, SIZE(plat)
1738               zlon = plon(ji)
1739               zlat = plat(jj)
1740               ! modifications for RAMA moorings
1741               IF( zlon ==  67. .AND. zlat ==  15. )   zlon =  65.
1742               IF( zlon ==  90. .AND. zlat <=  -4. )   zlon =  95.
1743               IF( zlon ==  95. .AND. zlat ==  -4. )   zlat =  -5.
1744               ! modifications for PIRATA moorings
1745               IF( zlon == -38. .AND. zlat == -19. )   zlon = -34.
1746               IF( zlon == -38. .AND. zlat == -14. )   zlon = -32.
1747               IF( zlon == -38. .AND. zlat ==  -8. )   zlon = -30.
1748               IF( zlon == -38. .AND. zlat ==   0. )   zlon = -35.
1749               IF( zlon == -23. .AND. zlat ==  20. )   zlat =  21.
1750               IF( zlon == -10. .AND. zlat == -14. )   zlat = -10.
1751               IF( zlon == -10. .AND. zlat ==  -8. )   zlat =  -6.
1752               IF( zlon == -10. .AND. zlat ==   4. ) THEN   ;   zlon = 0.   ;   zlat = 0.   ;   ENDIF
1753               CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
1754               IF( zlon >= 0. ) THEN 
1755                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT( zlon), 'e'
1756                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')       zlon , 'e'
1757                  ENDIF
1758               ELSE             
1759                  IF( zlon == REAL(NINT(zlon), wp) ) THEN   ;   WRITE(clon, '(i3,  a)') NINT(-zlon), 'w'
1760                  ELSE                                      ;   WRITE(clon, '(f5.1,a)')      -zlon , 'w'
1761                  ENDIF
1762               ENDIF
1763               IF( zlat >= 0. ) THEN 
1764                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT( zlat), 'n'
1765                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')       zlat , 'n'
1766                  ENDIF
1767               ELSE             
1768                  IF( zlat == REAL(NINT(zlat), wp) ) THEN   ;   WRITE(clat, '(i2,  a)') NINT(-zlat), 's'
1769                  ELSE                                      ;   WRITE(clat, '(f4.1,a)')      -zlat , 's'
1770                  ENDIF
1771               ENDIF
1772               clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
1773#if ! defined key_xios2
1774               CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
1775#else
1776               CALL iom_set_zoom_domain_attr  (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1)
1777#endif
1778               CALL iom_get_file_attr   (TRIM(clname)//cl1, name_suffix = clsuff                         )
1779               CALL iom_set_file_attr   (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
1780               CALL iom_update_file_name(TRIM(clname)//cl1)
1781            END DO
1782         END DO
1783      END DO
1784     
1785   END SUBROUTINE set_mooring
1786
1787   
1788   SUBROUTINE iom_update_file_name( cdid )
1789      !!----------------------------------------------------------------------
1790      !!                     ***  ROUTINE iom_update_file_name  ***
1791      !!
1792      !! ** Purpose :   
1793      !!
1794      !!----------------------------------------------------------------------
1795      CHARACTER(LEN=*)          , INTENT(in) ::   cdid
1796      !
1797      CHARACTER(LEN=256) ::   clname
1798      CHARACTER(LEN=20)  ::   clfreq
1799      CHARACTER(LEN=20)  ::   cldate
1800      INTEGER            ::   idx
1801      INTEGER            ::   jn
1802      INTEGER            ::   itrlen
1803      INTEGER            ::   iyear, imonth, iday, isec
1804      REAL(wp)           ::   zsec
1805      LOGICAL            ::   llexist
1806#if  defined key_xios2
1807      TYPE(xios_duration)   ::   output_freq 
1808#endif     
1809      !!----------------------------------------------------------------------
1810
1811
1812      DO jn = 1,2
1813#if ! defined key_xios2
1814         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = clfreq )
1815#else
1816         output_freq = xios_duration(0,0,0,0,0,0)
1817         IF( jn == 1 )   CALL iom_get_file_attr( cdid, name        = clname, output_freq = output_freq )
1818#endif
1819         IF( jn == 2 )   CALL iom_get_file_attr( cdid, name_suffix = clname )
1820
1821         IF ( TRIM(clname) /= '' ) THEN
1822
1823            idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
1824            DO WHILE ( idx /= 0 ) 
1825               clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
1826               idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
1827            END DO
1828
1829#if ! defined key_xios2
1830            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1831            DO WHILE ( idx /= 0 ) 
1832               IF ( TRIM(clfreq) /= '' ) THEN
1833                  itrlen = LEN_TRIM(clfreq)
1834                  IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1)
1835                  clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname))
1836               ELSE
1837                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
1838                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
1839               ENDIF
1840               idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1841            END DO
1842#else
1843            idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1844            DO WHILE ( idx /= 0 ) 
1845              IF ( output_freq%timestep /= 0) THEN
1846                  WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 
1847                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
1848              ELSE IF ( output_freq%hour /= 0 ) THEN
1849                  WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 
1850                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
1851              ELSE IF ( output_freq%day /= 0 ) THEN
1852                  WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 
1853                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
1854              ELSE IF ( output_freq%month /= 0 ) THEN   
1855                  WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 
1856                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
1857              ELSE IF ( output_freq%year /= 0 ) THEN   
1858                  WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 
1859                  itrlen = LEN_TRIM(ADJUSTL(clfreq))
1860              ELSE
1861                  CALL ctl_stop('error in the name of file id '//TRIM(cdid),   &
1862                     & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
1863              ENDIF
1864              clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
1865              idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1866            END DO
1867#endif
1868            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
1869            DO WHILE ( idx /= 0 ) 
1870               cldate = iom_sdate( fjulday - rdttra(1) / rday )
1871               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
1872               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
1873            END DO
1874
1875            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
1876            DO WHILE ( idx /= 0 ) 
1877               cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. )
1878               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
1879               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
1880            END DO
1881
1882            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
1883            DO WHILE ( idx /= 0 ) 
1884               cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
1885               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
1886               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
1887            END DO
1888
1889            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
1890            DO WHILE ( idx /= 0 ) 
1891               cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
1892               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
1893               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
1894            END DO
1895
1896            IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
1897            IF( jn == 1 )   CALL iom_set_file_attr( cdid, name        = clname )
1898            IF( jn == 2 )   CALL iom_set_file_attr( cdid, name_suffix = clname )
1899
1900         ENDIF
1901
1902      END DO
1903
1904   END SUBROUTINE iom_update_file_name
1905
1906
1907   FUNCTION iom_sdate( pjday, ld24, ldfull )
1908      !!----------------------------------------------------------------------
1909      !!                     ***  ROUTINE iom_sdate  ***
1910      !!
1911      !! ** Purpose :   send back the date corresponding to the given julian day
1912      !!
1913      !!----------------------------------------------------------------------
1914      REAL(wp), INTENT(in   )           ::   pjday         ! julian day
1915      LOGICAL , INTENT(in   ), OPTIONAL ::   ld24          ! true to force 24:00 instead of 00:00
1916      LOGICAL , INTENT(in   ), OPTIONAL ::   ldfull        ! true to get the compleate date: yyyymmdd_hh:mm:ss
1917      !
1918      CHARACTER(LEN=20) ::   iom_sdate
1919      CHARACTER(LEN=50) ::   clfmt                         !  format used to write the date
1920      INTEGER           ::   iyear, imonth, iday, ihour, iminute, isec
1921      REAL(wp)          ::   zsec
1922      LOGICAL           ::   ll24, llfull
1923      !
1924      IF( PRESENT(ld24) ) THEN   ;   ll24 = ld24
1925      ELSE                       ;   ll24 = .FALSE.
1926      ENDIF
1927
1928      IF( PRESENT(ldfull) ) THEN   ;   llfull = ldfull
1929      ELSE                         ;   llfull = .FALSE.
1930      ENDIF
1931
1932      CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
1933      isec = NINT(zsec)
1934
1935      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day
1936         CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
1937         isec = 86400
1938      ENDIF
1939
1940      IF( iyear < 10000 ) THEN   ;   clfmt = "i4.4,2i2.2"                ! format used to write the date
1941      ELSE                       ;   WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
1942      ENDIF
1943     
1944!$AGRIF_DO_NOT_TREAT     
1945! Should be fixed in the conv
1946      IF( llfull ) THEN
1947         clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
1948         ihour   = isec / 3600
1949         isec    = MOD(isec, 3600)
1950         iminute = isec / 60
1951         isec    = MOD(isec, 60)
1952         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec    ! date of the end of run
1953      ELSE
1954         WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday                          ! date of the end of run
1955      ENDIF
1956!$AGRIF_END_DO_NOT_TREAT     
1957
1958   END FUNCTION iom_sdate
1959
1960#else
1961
1962
1963   SUBROUTINE iom_setkt( kt, cdname )
1964      INTEGER         , INTENT(in)::   kt 
1965      CHARACTER(LEN=*), INTENT(in) ::   cdname
1966      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
1967   END SUBROUTINE iom_setkt
1968
1969   SUBROUTINE iom_context_finalize( cdname )
1970      CHARACTER(LEN=*), INTENT(in) ::   cdname
1971      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
1972   END SUBROUTINE iom_context_finalize
1973
1974#endif
1975
1976   LOGICAL FUNCTION iom_use( cdname )
1977      CHARACTER(LEN=*), INTENT(in) ::   cdname
1978#if defined key_iomput
1979      iom_use = xios_field_is_active( cdname )
1980#else
1981      iom_use = .FALSE.
1982#endif
1983   END FUNCTION iom_use
1984   
1985   !!======================================================================
1986END MODULE iom
Note: See TracBrowser for help on using the repository browser.