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/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 @ 8102

Last change on this file since 8102 was 8102, checked in by davestorkey, 7 years ago

NEMO 3.6_stable: tracer trends diagnostics. See ticket #1877 for more details.

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