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/dev_004_VVL/NEMO/OPA_SRC/IOM – NEMO

Context Navigation

source: branches/dev_004_VVL/NEMO/OPA_SRC/IOM/iom.F90 @ 1434

Last change on this file since 1434 was 1434, checked in by rblod, 15 years ago
dev_004_VVL:sync: synchro with trunk (r1420), see ticket #412
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 50.9 KB

Rev	Line
[544]	1	MODULE iom
	2	!!=====================================================================
	3	!! * MODULE iom *
	4	!! Input/Output manager : Library to read input files
	5	!!====================================================================
	6	!! History : 9.0 ! 05 12 (J. Belier) Original code
	7	!! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO
[911]	8	!! " ! 07 07 (D. Storkey) Changes to iom_gettime
[544]	9	!!--------------------------------------------------------------------
	10	!!gm caution add !DIR nec: improved performance to be checked as well as no result changes
	11
	12	!!--------------------------------------------------------------------
	13	!! iom_open : open a file read only
	14	!! iom_close : close a file or all files opened by iom
	15	!! iom_get : read a field (interfaced to several routines)
[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 in_out_manager ! I/O manager
	21	USE dom_oce ! ocean space and time domain
[679]	22	USE lbclnk ! lateal boundary condition / mpp exchanges
[544]	23	USE iom_def ! iom variables definitions
	24	USE iom_ioipsl ! NetCDF format with IOIPSL library
	25	USE iom_nf90 ! NetCDF format with native NetCDF library
	26	USE iom_rstdimg ! restarts access direct format "dimg" style...
	27
[1434]	28	#if defined key_iomput
[1359]	29	USE mod_event_client
	30	# endif
	31
[544]	32	IMPLICIT NONE
[556]	33	PUBLIC ! must be public to be able to access iom_def through iom
[550]	34
[1359]	35	PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
[544]	36
[752]	37	PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
	38	PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
[1359]	39	PRIVATE iom_p2d, iom_p3d
[1434]	40	#if defined key_iomput
[1359]	41	PRIVATE iom_init_chkcpp
	42	PRIVATE set_grid
	43	# endif
[752]	44
[544]	45	INTERFACE iom_get
[550]	46	MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
[544]	47	END INTERFACE
	48	INTERFACE iom_rstput
[550]	49	MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
[544]	50	END INTERFACE
[1359]	51	INTERFACE iom_put
	52	MODULE PROCEDURE iom_p2d, iom_p3d
	53	END INTERFACE
[1434]	54	#if defined key_iomput
[1359]	55	INTERFACE iom_setkt
	56	MODULE PROCEDURE event__set_timestep
	57	END INTERFACE
	58	# endif
[544]	59
	60	!!----------------------------------------------------------------------
	61	!! OPA 9.0 , LOCEAN-IPSL (2006)
[1152]	62	!! $Id$
[544]	63	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
	64	!!----------------------------------------------------------------------
	65
	66	CONTAINS
	67
[1359]	68	SUBROUTINE iom_init( pjulian )
	69	!!----------------------------------------------------------------------
	70	!! * ROUTINE *
	71	!!
	72	!! ** Purpose :
	73	!!
	74	!!----------------------------------------------------------------------
	75	REAL(wp), INTENT(in) :: pjulian !: julian day at nit000 = 0
[1434]	76	#if defined key_iomput
[1359]	77	!!----------------------------------------------------------------------
	78	! read the xml file
	79	CALL event__parse_xml_file( 'iodef.xml' ) ! <- to get from the nameliste (namrun)...
	80
	81	! calendar parameters
	82	CALL event__set_time_parameters( nit000 - 1, pjulian, rdt )
	83
	84	! horizontal grid definition
	85	CALL set_grid( "grid_T", glamt, gphit )
	86	CALL set_grid( "grid_U", glamu, gphiu )
	87	CALL set_grid( "grid_V", glamv, gphiv )
	88	CALL set_grid( "grid_W", glamt, gphit )
	89
	90	! vertical grid definition
	91	CALL event__set_vert_axis( "deptht", gdept_0 )
	92	CALL event__set_vert_axis( "depthu", gdept_0 )
	93	CALL event__set_vert_axis( "depthv", gdept_0 )
	94	CALL event__set_vert_axis( "depthw", gdepw_0 )
	95
	96	! consistency regarding CPP keys...
	97	CALL iom_init_chkcpp
	98
	99	! end file definition
	100	CALL event__close_io_definition
	101	#endif
	102
	103	END SUBROUTINE iom_init
	104
	105
[1319]	106	SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
[544]	107	!!---------------------------------------------------------------------
	108	!! * SUBROUTINE iom_open *
	109	!!
	110	!! ** Purpose : open an input file (return 0 if not found)
	111	!!---------------------------------------------------------------------
	112	CHARACTER(len=*), INTENT(in ) :: cdname ! File name
	113	INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file
	114	LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.)
	115	INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written (default = jpdom_local_noovlap)
[547]	116	INTEGER , INTENT(in ), OPTIONAL :: kiolib ! library used to open the file (default = jpnf90)
[679]	117	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.)
[1319]	118	LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
[544]	119
	120	CHARACTER(LEN=100) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu]
	121	CHARACTER(LEN=100) :: cltmpn ! tempory name to store clname (in writting mode)
	122	CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg"
[550]	123	CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits)
[544]	124	CHARACTER(LEN=100) :: clinfo ! info character
	125	LOGICAL :: llok ! check the existence
[679]	126	LOGICAL :: llwrt ! local definition of ldwrt
[1200]	127	LOGICAL :: llnoov ! local definition to read overlap
[679]	128	LOGICAL :: llstop ! local definition of ldstop
[1319]	129	LOGICAL :: lliof ! local definition of ldiof
[544]	130	INTEGER :: iolib ! library do we use to open the file
	131	INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits)
	132	INTEGER :: iln, ils ! lengths of character
	133	INTEGER :: idom ! type of domain
	134	INTEGER :: istop !
	135	INTEGER, DIMENSION(2,5) :: idompar ! domain parameters:
	136	! local number of points for x,y dimensions
	137	! position of first local point for x,y dimensions
	138	! position of last local point for x,y dimensions
	139	! start halo size for x,y dimensions
	140	! end halo size for x,y dimensions
	141	!---------------------------------------------------------------------
	142	! Initializations and control
	143	! =============
[1341]	144	kiomid = -1
[544]	145	clinfo = ' iom_open ~~~ '
	146	istop = nstop
	147	! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
	148	! (could be done when defining iom_file in f95 but not in f90)
[1410]	149	#if ! defined key_agrif
[1359]	150	IF( iom_open_init == 0 ) THEN
[544]	151	iom_file(:)%nfid = 0
[1359]	152	iom_open_init = 1
[544]	153	ENDIF
[1410]	154	#else
	155	IF( Agrif_Root() ) THEN
	156	IF( iom_open_init == 0 ) THEN
	157	iom_file(:)%nfid = 0
	158	iom_open_init = 1
	159	ENDIF
	160	#endif
[544]	161	! do we read or write the file?
	162	IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt
	163	ELSE ; llwrt = .FALSE.
	164	ENDIF
[679]	165	! do we call ctl_stop if we try to open a non-existing file in read mode?
	166	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
	167	ELSE ; llstop = .TRUE.
	168	ENDIF
[544]	169	! what library do we use to open the file?
	170	IF( PRESENT(kiolib) ) THEN ; iolib = kiolib
[547]	171	ELSE ; iolib = jpnf90
[544]	172	ENDIF
[1319]	173	! are we using interpolation on the fly?
	174	IF( PRESENT(ldiof) ) THEN ; lliof = ldiof
	175	ELSE ; lliof = .FALSE.
	176	ENDIF
[1200]	177	! do we read the overlap
	178	! ugly patch SM+JMM+RB to overwrite global definition in some cases
[1202]	179	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
[544]	180	! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
	181	! =============
	182	clname = trim(cdname)
	183	#if defined key_agrif
[1319]	184	IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
[1200]	185	iln = INDEX(clname,'/')
	186	cltmpn = clname(1:iln)
	187	clname = clname(iln+1:LEN_TRIM(clname))
	188	clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
	189	ENDIF
[544]	190	#endif
	191	! which suffix should we use?
	192	SELECT CASE (iolib)
	193	CASE (jpioipsl ) ; clsuffix = '.nc'
	194	CASE (jpnf90 ) ; clsuffix = '.nc'
	195	CASE (jprstdimg) ; clsuffix = '.dimg'
	196	CASE DEFAULT ; clsuffix = ''
	197	CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	198	END SELECT
	199	! Add the suffix if needed
	200	iln = LEN_TRIM(clname)
	201	ils = LEN_TRIM(clsuffix)
[742]	202	IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 ) &
	203	& clname = TRIM(clname)//TRIM(clsuffix)
[544]	204	cltmpn = clname ! store this name
	205	! try to find if the file to be opened already exist
	206	! =============
	207	INQUIRE( FILE = clname, EXIST = llok )
	208	IF( .NOT.llok ) THEN
	209	! we try to add the cpu number to the name
[679]	210	IF( iolib == jprstdimg ) THEN ; WRITE(clcpu,*) narea
	211	ELSE ; WRITE(clcpu,*) narea-1
	212	ENDIF
[544]	213	clcpu = TRIM(ADJUSTL(clcpu))
[679]	214	iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
[544]	215	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
	216	icnt = 0
	217	INQUIRE( FILE = clname, EXIST = llok )
	218	! we try different formats for the cpu number by adding 0
	219	DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
	220	clcpu = "0"//trim(clcpu)
	221	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
	222	INQUIRE( FILE = clname, EXIST = llok )
	223	icnt = icnt + 1
	224	END DO
	225	ENDIF
[679]	226	IF( llwrt ) THEN
	227	! check the domain definition
	228	! JMM + SM: ugly patch before getting the new version of lib_mpp)
	229	! idom = jpdom_local_noovlap ! default definition
[1200]	230	IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition
	231	ELSE ; idom = jpdom_local_full ! default definition
[679]	232	ENDIF
	233	IF( PRESENT(kdom) ) idom = kdom
	234	! create the domain informations
	235	! =============
	236	SELECT CASE (idom)
	237	CASE (jpdom_local_full)
	238	idompar(:,1) = (/ jpi , jpj /)
	239	idompar(:,2) = (/ nimpp , njmpp /)
	240	idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1 /)
	241	idompar(:,4) = (/ nldi - 1 , nldj - 1 /)
	242	idompar(:,5) = (/ jpi - nlei , jpj - nlej /)
	243	CASE (jpdom_local_noextra)
	244	idompar(:,1) = (/ nlci , nlcj /)
	245	idompar(:,2) = (/ nimpp , njmpp /)
	246	idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
	247	idompar(:,4) = (/ nldi - 1 , nldj - 1 /)
	248	idompar(:,5) = (/ nlci - nlei , nlcj - nlej /)
	249	CASE (jpdom_local_noovlap)
	250	idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
	251	idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
	252	idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
	253	idompar(:,4) = (/ 0 , 0 /)
	254	idompar(:,5) = (/ 0 , 0 /)
	255	CASE DEFAULT
	256	CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
	257	END SELECT
	258	ENDIF
[544]	259	! Open the NetCDF or RSTDIMG file
	260	! =============
	261	! do we have some free file identifier?
	262	IF( MINVAL(iom_file(:)%nfid) /= 0 ) &
[679]	263	& CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
	264	! if no file was found...
	265	IF( .NOT. llok ) THEN
	266	IF( .NOT. llwrt ) THEN ! we are in read mode
	267	IF( llstop ) THEN ; CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
	268	ELSE ; istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file
	269	ENDIF
	270	ELSE ! we are in write mode so we
	271	clname = cltmpn ! get back the file name without the cpu number
	272	ENDIF
	273	ENDIF
[544]	274	IF( istop == nstop ) THEN ! no error within this routine
	275	SELECT CASE (iolib)
	276	CASE (jpioipsl ) ; CALL iom_ioipsl_open( clname, kiomid, llwrt, llok, idompar )
	277	CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar )
	278	CASE (jprstdimg) ; CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
	279	CASE DEFAULT
	280	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	281	END SELECT
	282	ENDIF
	283	!
	284	END SUBROUTINE iom_open
	285
	286
	287	SUBROUTINE iom_close( kiomid )
	288	!!--------------------------------------------------------------------
	289	!! * SUBROUTINE iom_close *
	290	!!
	291	!! ** Purpose : close an input file, or all files opened by iom
	292	!!--------------------------------------------------------------------
[1131]	293	INTEGER, INTENT(inout), OPTIONAL :: kiomid ! iom identifier of the file to be closed
	294	! ! return 0 when file is properly closed
	295	! ! No argument: all files opened by iom are closed
[544]	296
	297	INTEGER :: jf ! dummy loop indices
	298	INTEGER :: i_s, i_e ! temporary integer
	299	CHARACTER(LEN=100) :: clinfo ! info character
	300	!---------------------------------------------------------------------
	301	!
	302	clinfo = ' iom_close ~~~ '
	303	IF( PRESENT(kiomid) ) THEN
	304	i_s = kiomid
	305	i_e = kiomid
	306	ELSE
	307	i_s = 1
	308	i_e = jpmax_files
[1434]	309	#if defined key_iomput
[1359]	310	CALL event__stop_ioserver
	311	#endif
[544]	312	ENDIF
	313
	314	IF( i_s > 0 ) THEN
	315	DO jf = i_s, i_e
	316	IF( iom_file(jf)%nfid > 0 ) THEN
	317	SELECT CASE (iom_file(jf)%iolib)
	318	CASE (jpioipsl ) ; CALL iom_ioipsl_close( jf )
	319	CASE (jpnf90 ) ; CALL iom_nf90_close( jf )
	320	CASE (jprstdimg) ; CALL iom_rstdimg_close( jf )
	321	CASE DEFAULT
	322	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	323	END SELECT
[1131]	324	iom_file(jf)%nfid = 0 ! free the id
	325	IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed
[679]	326	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
[544]	327	ELSEIF( PRESENT(kiomid) ) THEN
	328	WRITE(ctmp1,*) '--->', kiomid
	329	CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
	330	ENDIF
	331	END DO
	332	ENDIF
	333	!
	334	END SUBROUTINE iom_close
	335
	336
[745]	337	FUNCTION iom_varid ( kiomid, cdvar, kdimsz, ldstop )
[544]	338	!!-----------------------------------------------------------------------
	339	!! * FUNCTION iom_varid *
	340	!!
	341	!! ** Purpose : get the id of a variable in a file (return 0 if not found)
	342	!!-----------------------------------------------------------------------
	343	INTEGER , INTENT(in ) :: kiomid ! file Identifier
	344	CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable
	345	INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions
[745]	346	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.)
[544]	347	!
	348	INTEGER :: iom_varid, iiv, i_nvd
	349	LOGICAL :: ll_fnd
	350	CHARACTER(LEN=100) :: clinfo ! info character
[745]	351	LOGICAL :: llstop ! local definition of ldstop
[544]	352	!!-----------------------------------------------------------------------
	353	iom_varid = 0 ! default definition
[745]	354	! do we call ctl_stop if we look for non-existing variable?
	355	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
	356	ELSE ; llstop = .TRUE.
	357	ENDIF
[544]	358	!
	359	IF( kiomid > 0 ) THEN
[679]	360	clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
[544]	361	IF( iom_file(kiomid)%nfid == 0 ) THEN
	362	CALL ctl_stop( trim(clinfo), 'the file is not open' )
	363	ELSE
	364	ll_fnd = .FALSE.
	365	iiv = 0
	366	!
	367	DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
	368	iiv = iiv + 1
	369	ll_fnd = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
	370	END DO
	371	!
	372	IF( .NOT.ll_fnd ) THEN
	373	iiv = iiv + 1
	374	IF( iiv <= jpmax_vars ) THEN
	375	SELECT CASE (iom_file(kiomid)%iolib)
	376	CASE (jpioipsl ) ; iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
[745]	377	CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz )
	378	CASE (jprstdimg) ; iom_varid = -1 ! all variables are listed in iom_file
[544]	379	CASE DEFAULT
	380	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	381	END SELECT
	382	ELSE
	383	CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name, &
	384	& 'increase the parameter jpmax_vars')
	385	ENDIF
[745]	386	IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' )
[544]	387	ELSE
	388	iom_varid = iiv
	389	IF( PRESENT(kdimsz) ) THEN
	390	i_nvd = iom_file(kiomid)%ndims(iiv)
	391	IF( i_nvd == size(kdimsz) ) THEN
	392	kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
	393	ELSE
	394	WRITE(ctmp1,*) i_nvd, size(kdimsz)
	395	CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
	396	ENDIF
	397	ENDIF
	398	ENDIF
	399	ENDIF
	400	ENDIF
	401	!
	402	END FUNCTION iom_varid
	403
	404
	405	!!----------------------------------------------------------------------
	406	!! INTERFACE iom_get
	407	!!----------------------------------------------------------------------
[550]	408	SUBROUTINE iom_g0d( kiomid, cdvar, pvar )
[544]	409	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
	410	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
	411	REAL(wp) , INTENT( out) :: pvar ! read field
	412	!
	413	INTEGER :: idvar ! variable id
	414	!
[679]	415	IF( kiomid > 0 ) THEN
	416	idvar = iom_varid( kiomid, cdvar )
	417	IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
	418	SELECT CASE (iom_file(kiomid)%iolib)
	419	CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar )
	420	CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar )
	421	CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar )
	422	CASE DEFAULT
	423	CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	424	END SELECT
	425	ENDIF
	426	ENDIF
[550]	427	END SUBROUTINE iom_g0d
[544]	428
[550]	429	SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
[544]	430	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
	431	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
	432	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
	433	REAL(wp) , INTENT( out), DIMENSION(:) :: pvar ! read field
	434	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
	435	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading
	436	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis
	437	!
[679]	438	IF( kiomid > 0 ) THEN
	439	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, &
	440	& ktime=ktime, kstart=kstart, kcount=kcount )
	441	ENDIF
[550]	442	END SUBROUTINE iom_g1d
[544]	443
[550]	444	SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
[544]	445	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
	446	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
	447	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
	448	REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field
	449	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
	450	INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading
	451	INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis
	452	!
[679]	453	IF( kiomid > 0 ) THEN
	454	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, &
	455	& ktime=ktime, kstart=kstart, kcount=kcount )
	456	ENDIF
[550]	457	END SUBROUTINE iom_g2d
[544]	458
[550]	459	SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
[544]	460	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
	461	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
	462	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
	463	REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field
	464	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
	465	INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading
	466	INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis
	467	!
[679]	468	IF( kiomid > 0 ) THEN
	469	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, &
	470	& ktime=ktime, kstart=kstart, kcount=kcount )
	471	ENDIF
[550]	472	END SUBROUTINE iom_g3d
[544]	473	!!----------------------------------------------------------------------
	474
	475	SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , &
[679]	476	& pv_r1d, pv_r2d, pv_r3d, &
	477	& ktime , kstart, kcount )
[544]	478	!!-----------------------------------------------------------------------
	479	!! * ROUTINE iom_get_123d *
	480	!!
	481	!! ** Purpose : read a 1D/2D/3D variable
	482	!!
	483	!! ** Method : read ONE record at each CALL
	484	!!-----------------------------------------------------------------------
	485	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
	486	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
	487	CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable
	488	REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case)
	489	REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case)
	490	REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case)
	491	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
	492	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis
	493	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis
	494	!
[1200]	495	LOGICAL :: llnoov ! local definition to read overlap
[544]	496	INTEGER :: jl ! loop on number of dimension
	497	INTEGER :: idom ! type of domain
	498	INTEGER :: idvar ! id of the variable
	499	INTEGER :: inbdim ! number of dimensions of the variable
	500	INTEGER :: idmspc ! number of spatial dimensions
	501	INTEGER :: itime ! record number
	502	INTEGER :: istop ! temporary value of nstop
[679]	503	INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
	504	INTEGER :: ji, jj ! loop counters
	505	INTEGER :: irankpv !
	506	INTEGER :: ind1, ind2 ! substring index
[544]	507	INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis
	508	INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis
	509	INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable
[679]	510	INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable
[544]	511	REAL(wp) :: zscf, zofs ! sacle_factor and add_offset
	512	INTEGER :: itmp ! temporary integer
	513	CHARACTER(LEN=100) :: clinfo ! info character
[679]	514	CHARACTER(LEN=100) :: clname ! file name
	515	CHARACTER(LEN=1) :: clrankpv, cldmspc !
[544]	516	!---------------------------------------------------------------------
	517	!
[679]	518	clname = iom_file(kiomid)%name ! esier to read
	519	clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
[544]	520	! local definition of the domain ?
	521	idom = kdom
[1200]	522	! do we read the overlap
	523	! ugly patch SM+JMM+RB to overwrite global definition in some cases
[1202]	524	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
[544]	525	! check kcount and kstart optionals parameters...
[679]	526	IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
	527	IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
	528	IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
[544]	529
	530	! Search for the variable in the data base (eventually actualize data)
	531	istop = nstop
	532	idvar = iom_varid( kiomid, cdvar )
	533	!
	534	IF( idvar > 0 ) THEN
	535	! to write iom_file(kiomid)%dimsz in a shorter way !
	536	idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)
	537	inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file
	538	idmspc = inbdim ! number of spatial dimensions in the file
	539	IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1
[679]	540	IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')
	541	!
	542	! update idom definition...
	543	! Identify the domain in case of jpdom_auto(glo/dta) definition
	544	IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN
	545	IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global
	546	ELSE ; idom = jpdom_data
[544]	547	ENDIF
[679]	548	ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
	549	ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
	550	IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF
[544]	551	ENDIF
[679]	552	! Identify the domain in case of jpdom_local definition
	553	IF( idom == jpdom_local ) THEN
	554	IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full
	555	ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra
	556	ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap
	557	ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
	558	ENDIF
	559	ENDIF
[544]	560	!
[679]	561	! check the consistency between input array and data rank in the file
[544]	562	!
	563	! initializations
	564	itime = 1
	565	IF( PRESENT(ktime) ) itime = ktime
[679]	566
	567	irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
	568	WRITE(clrankpv, fmt='(i1)') irankpv
	569	WRITE(cldmspc , fmt='(i1)') idmspc
[544]	570	!
[679]	571	IF( idmspc < irankpv ) THEN
	572	CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', &
	573	& 'it is impossible to read a '//clrankpv//'D array from this file...' )
	574	ELSEIF( idmspc == irankpv ) THEN
	575	IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) &
	576	& CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
	577	ELSEIF( idmspc > irankpv ) THEN
	578	IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
	579	CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &
	580	& 'As the size of the z dimension is 1 and as we try to read the first record, ', &
	581	& 'we accept this case, even if there is a possible mix-up between z and time dimension' )
	582	idmspc = idmspc - 1
[544]	583	ELSE
[679]	584	CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , &
	585	& 'we do not accept data with more than '//cldmspc//' spatial dimension', &
	586	& 'Use ncwa -a to suppress the unnecessary dimensions' )
[544]	587	ENDIF
[679]	588	ENDIF
	589
	590	!
	591	! definition of istart and icnt
	592	!
	593	icnt (:) = 1
	594	istart(:) = 1
	595	istart(idmspc+1) = itime
	596
	597	IF( PRESENT(kstart) ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
	598	ELSE
	599	IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)
	600	ELSE
	601	IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array
	602	IF( idom == jpdom_data ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /) ! icnt(1:2) done bellow
	603	ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done bellow
[544]	604	ENDIF
[679]	605	! we do not read the overlap -> we start to read at nldi, nldj
	606	! JMM + SM: ugly patch before getting the new version of lib_mpp)
	607	! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
[1200]	608	IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
[679]	609	! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej
	610	! JMM + SM: ugly patch before getting the new version of lib_mpp)
	611	! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
[1200]	612	IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
	613	ELSE ; icnt(1:2) = (/ nlci , nlcj /)
[544]	614	ENDIF
[679]	615	IF( PRESENT(pv_r3d) ) THEN
	616	IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta
	617	ELSE ; icnt(3) = jpk
[544]	618	ENDIF
	619	ENDIF
	620	ENDIF
[679]	621	ENDIF
[544]	622	ENDIF
	623
	624	! check that istart and icnt can be used with this file
	625	!-
	626	DO jl = 1, jpmax_dims
	627	itmp = istart(jl)+icnt(jl)-1
[679]	628	IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
	629	WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
	630	WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)
[544]	631	CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )
	632	ENDIF
	633	END DO
	634
	635	! check that icnt matches the input array
	636	!-
[679]	637	IF( idom == jpdom_unknown ) THEN
	638	IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d)
	639	IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)
	640	IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)
	641	ctmp1 = 'd'
	642	ELSE
	643	IF( irankpv == 2 ) THEN
	644	! JMM + SM: ugly patch before getting the new version of lib_mpp)
	645	! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)'
[1200]	646	IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
	647	ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)'
[544]	648	ENDIF
[679]	649	ENDIF
	650	IF( irankpv == 3 ) THEN
	651	! JMM + SM: ugly patch before getting the new version of lib_mpp)
	652	! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
[1200]	653	IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
	654	ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
[544]	655	ENDIF
[679]	656	ENDIF
[544]	657	ENDIF
[679]	658
	659	DO jl = 1, irankpv
	660	WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
	661	IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
	662	END DO
	663
[544]	664	ENDIF
	665
	666	! read the data
	667	!-
[679]	668	IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...
[544]	669	!
[679]	670	! find the right index of the array to be read
	671	! JMM + SM: ugly patch before getting the new version of lib_mpp)
	672	! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
	673	! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
	674	! ENDIF
[1200]	675	IF( llnoov ) THEN
[679]	676	IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
	677	ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
	678	ENDIF
	679	ELSE
	680	IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj
	681	ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
	682	ENDIF
	683	ENDIF
	684
[544]	685	SELECT CASE (iom_file(kiomid)%iolib)
[679]	686	CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
	687	& pv_r1d, pv_r2d, pv_r3d )
	688	CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
	689	& pv_r1d, pv_r2d, pv_r3d )
	690	CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, &
	691	& pv_r1d, pv_r2d, pv_r3d )
[544]	692	CASE DEFAULT
	693	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	694	END SELECT
[679]	695
	696	IF( istop == nstop ) THEN ! no additional errors until this point...
[1191]	697	IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
	698
[679]	699	!--- overlap areas and extra hallows (mpp)
	700	IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
	701	CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
	702	ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
	703	! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
	704	IF( icnt(3) == jpk ) THEN
	705	CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
	706	ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...)
	707	DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO
	708	DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO
	709	ENDIF
	710	ENDIF
	711
	712	!--- Apply scale_factor and offset
	713	zscf = iom_file(kiomid)%scf(idvar) ! scale factor
	714	zofs = iom_file(kiomid)%ofs(idvar) ! offset
	715	IF( PRESENT(pv_r1d) ) THEN
	716	IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf
	717	IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs
	718	ELSEIF( PRESENT(pv_r2d) ) THEN
	719	!CDIR COLLAPSE
	720	IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf
	721	!CDIR COLLAPSE
	722	IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs
	723	ELSEIF( PRESENT(pv_r3d) ) THEN
	724	!CDIR COLLAPSE
	725	IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
	726	!CDIR COLLAPSE
	727	IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
	728	ENDIF
	729	!
[544]	730	ENDIF
	731	!
	732	ENDIF
	733	!
	734	END SUBROUTINE iom_get_123d
	735
	736
[911]	737	SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
[544]	738	!!--------------------------------------------------------------------
	739	!! * SUBROUTINE iom_gettime *
	740	!!
	741	!! ** Purpose : read the time axis cdvar in the file
	742	!!--------------------------------------------------------------------
[911]	743	INTEGER , INTENT(in ) :: kiomid ! file Identifier
	744	REAL(wp), DIMENSION(:) , INTENT( out) :: ptime ! the time axis
	745	CHARACTER(len=*), OPTIONAL , INTENT(in ) :: cdvar ! time axis name
	746	INTEGER , OPTIONAL , INTENT( out) :: kntime ! number of times in file
	747	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdunits ! units attribute of time coordinate
	748	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdcalendar ! calendar attribute of
[544]	749	!
[911]	750	INTEGER, DIMENSION(1) :: kdimsz
[544]	751	INTEGER :: idvar ! id of the variable
[911]	752	CHARACTER(LEN=32) :: tname ! local name of time coordinate
[544]	753	CHARACTER(LEN=100) :: clinfo ! info character
	754	!---------------------------------------------------------------------
	755	!
[911]	756	IF ( PRESENT(cdvar) ) THEN
	757	tname = cdvar
	758	ELSE
	759	tname = iom_file(kiomid)%uldname
	760	ENDIF
[679]	761	IF( kiomid > 0 ) THEN
[911]	762	clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
	763	IF ( PRESENT(kntime) ) THEN
	764	idvar = iom_varid( kiomid, tname, kdimsz = kdimsz )
	765	kntime = kdimsz(1)
	766	ELSE
	767	idvar = iom_varid( kiomid, tname )
	768	ENDIF
[679]	769	!
	770	ptime(:) = 0. ! default definition
	771	IF( idvar > 0 ) THEN
	772	IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
	773	IF( iom_file(kiomid)%luld(idvar) ) THEN
	774	IF( iom_file(kiomid)%dimsz(1,idvar) == size(ptime) ) THEN
	775	SELECT CASE (iom_file(kiomid)%iolib)
[911]	776	CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
	777	CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
[679]	778	CASE (jprstdimg) ; CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
	779	CASE DEFAULT
	780	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	781	END SELECT
	782	ELSE
	783	WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
	784	CALL ctl_stop( trim(clinfo), trim(ctmp1) )
	785	ENDIF
[544]	786	ELSE
[679]	787	CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
[544]	788	ENDIF
	789	ELSE
[679]	790	CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
[544]	791	ENDIF
	792	ELSE
[679]	793	CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
[544]	794	ENDIF
	795	ENDIF
	796	!
	797	END SUBROUTINE iom_gettime
	798
	799
	800	!!----------------------------------------------------------------------
	801	!! INTERFACE iom_rstput
	802	!!----------------------------------------------------------------------
[550]	803	SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	804	INTEGER , INTENT(in) :: kt ! ocean time-step
	805	INTEGER , INTENT(in) :: kwrite ! writing time-step
	806	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	807	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[556]	808	REAL(wp) , INTENT(in) :: pvar ! written field
[544]	809	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	810	INTEGER :: ivid ! variable id
[679]	811	IF( kiomid > 0 ) THEN
	812	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	813	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	814	SELECT CASE (iom_file(kiomid)%iolib)
	815	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
	816	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
	817	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
	818	CASE DEFAULT
	819	CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	820	END SELECT
	821	ENDIF
	822	ENDIF
[550]	823	END SUBROUTINE iom_rp0d
[544]	824
[550]	825	SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	826	INTEGER , INTENT(in) :: kt ! ocean time-step
	827	INTEGER , INTENT(in) :: kwrite ! writing time-step
	828	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	829	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[556]	830	REAL(wp) , INTENT(in), DIMENSION( jpk) :: pvar ! written field
[544]	831	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	832	INTEGER :: ivid ! variable id
[679]	833	IF( kiomid > 0 ) THEN
	834	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	835	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	836	SELECT CASE (iom_file(kiomid)%iolib)
	837	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
	838	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
	839	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
	840	CASE DEFAULT
	841	CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	842	END SELECT
	843	ENDIF
	844	ENDIF
[550]	845	END SUBROUTINE iom_rp1d
[544]	846
[550]	847	SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	848	INTEGER , INTENT(in) :: kt ! ocean time-step
	849	INTEGER , INTENT(in) :: kwrite ! writing time-step
	850	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	851	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[556]	852	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj ) :: pvar ! written field
[544]	853	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	854	INTEGER :: ivid ! variable id
[679]	855	IF( kiomid > 0 ) THEN
	856	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	857	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	858	SELECT CASE (iom_file(kiomid)%iolib)
	859	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
	860	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
	861	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar )
	862	CASE DEFAULT
	863	CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	864	END SELECT
	865	ENDIF
	866	ENDIF
[550]	867	END SUBROUTINE iom_rp2d
[544]	868
[550]	869	SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	870	INTEGER , INTENT(in) :: kt ! ocean time-step
	871	INTEGER , INTENT(in) :: kwrite ! writing time-step
	872	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	873	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[556]	874	REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvar ! written field
[544]	875	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	876	INTEGER :: ivid ! variable id
[679]	877	IF( kiomid > 0 ) THEN
	878	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	879	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	880	SELECT CASE (iom_file(kiomid)%iolib)
	881	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
	882	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
	883	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
	884	CASE DEFAULT
	885	CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
	886	END SELECT
	887	ENDIF
	888	ENDIF
[550]	889	END SUBROUTINE iom_rp3d
[1359]	890
	891
[544]	892	!!----------------------------------------------------------------------
[1359]	893	!! INTERFACE iom_rstput
	894	!!----------------------------------------------------------------------
	895	SUBROUTINE iom_p2d( cdname, pfield2d )
	896	CHARACTER(LEN=*) , INTENT(in) :: cdname
	897	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfield2d
[1434]	898	#if defined key_iomput
[1359]	899	CALL event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) )
	900	#endif
	901	END SUBROUTINE iom_p2d
[544]	902
[1359]	903	SUBROUTINE iom_p3d( cdname, pfield3d )
	904	CHARACTER(LEN=*) , INTENT(in) :: cdname
	905	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pfield3d
[1434]	906	#if defined key_iomput
[1359]	907	CALL event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) )
	908	#endif
	909	END SUBROUTINE iom_p3d
	910	!!----------------------------------------------------------------------
[544]	911
[1359]	912
[1434]	913	#if defined key_iomput
[1359]	914
	915	SUBROUTINE set_grid( cdname, plon, plat )
	916	!!----------------------------------------------------------------------
	917	!! * ROUTINE *
	918	!!
	919	!! ** Purpose :
	920	!!
	921	!!----------------------------------------------------------------------
	922	CHARACTER(LEN=*) , INTENT(in) :: cdname
	923	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon
	924	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
	925
	926	CALL event__set_grid_dimension( cdname, jpiglo, jpjglo)
	927	CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, &
	928	& plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) )
	929	CALL event__set_grid_type_nemo( cdname )
	930
	931	END SUBROUTINE set_grid
	932
	933
	934	SUBROUTINE iom_init_chkcpp
	935	!!---------------------------------------------------------------------
	936	!! * SUBROUTINE *
	937	!!
	938	!! ** Purpose :
	939	!!---------------------------------------------------------------------
	940	USE zdfddm, ONLY : lk_zdfddm ! vertical physics: double diffusion
	941
	942	#if defined key_dynspg_rl
	943	CALL event__disable_field( "sossheig" )
	944	#else
	945	CALL event__disable_field( "sobarstf" )
	946	#endif
	947
	948	!!#if ! ( ! defined key_dynspg_rl && defined key_ice_lim)
	949	!! CALL disable_field( "iowaflup" )
	950	!! CALL disable_field( "sowaflep" )
	951	!!#endif
	952
	953	#if ! defined key_coupled
	954	CALL event__enable_field( "sohefldp" )
	955	CALL event__enable_field( "sowafldp" )
	956	CALL event__enable_field( "sosafldp" )
	957	#endif
	958
	959	#if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 )
	960	CALL event__enable_field( "sohefldp" )
	961	CALL event__enable_field( "sowafldp" )
	962	CALL event__enable_field( "sosafldp" )
	963	#endif
	964
	965	#if ! defined key_diaspr
	966	CALL event__disable_field( "sosurfps" )
	967	#endif
	968
	969	#if ! defined key_diahth
	970	CALL event__disable_field( "sothedep" )
	971	CALL event__disable_field( "so20chgt" )
	972	CALL event__disable_field( "so28chgt" )
	973	CALL event__disable_field( "sohtc300" )
	974	#endif
	975
	976	#if defined key_coupled
	977	# if defined key_lim3
	978	Must be adapted to LIM3
	979	# else
	980	CALL event__enable_field( "soicetem" )
	981	CALL event__enable_field( "soicealb" )
	982	# endif
	983	#endif
	984
	985	#if ! defined key_diaeiv
	986	CALL event__disable_field( "vozoeivu" )
	987	CALL event__disable_field( "vomeeivv" )
	988	CALL event__disable_field( "voveeivw" )
	989	#endif
	990
	991	#if ! defined key_dynspg_rl
	992	CALL event__disable_field( "sozospgx" )
	993	CALL event__disable_field( "somespgy" )
	994	#endif
	995
	996	IF( lk_zdfddm ) CALL event__enable_field( "voddmavs" )
	997
	998	#if ! defined key_traldf_c2d
	999	CALL event__disable_field( "soleahtw" )
	1000	#endif
	1001
	1002	#if ! defined key_traldf_eiv
	1003	CALL event__disable_field( "soleaeiw" )
	1004	#endif
	1005
	1006	END SUBROUTINE iom_init_chkcpp
	1007
	1008	#else
	1009
	1010	SUBROUTINE iom_setkt( kt )
	1011	INTEGER, INTENT(in ):: kt
	1012	END SUBROUTINE iom_setkt
	1013
	1014	#endif
	1015
	1016
[544]	1017	!!======================================================================
	1018	END MODULE iom

Note: See TracBrowser for help on using the repository browser.

Download in other formats: