Context Navigation

flio_rbld.f90 @ 3890

Last change on this file since 3890 was 3847, checked in by ymipsl, 10 years ago

Add IOIPSL in the configuration.
Temporary configuration.
Makefile is ready for Curie

File size: 49.2 KB

Rev	Line
[3847]	1	!$Header: /home/ioipsl/CVSROOT/IOIPSL/tools/flio_rbld.f90,v 1.1 2005/10/10 07:36:45 adm Exp $
	2	PROGRAM flio_rbld
	3	!!--------------------------------------------------------------------
	4	!! PROGRAM flio_rbld
	5	!!
	6	!! PURPOSE :
	7	!! Recombine the files of MPI version of IOIPSL
	8	!! along several dimensions.
	9	!!
	10	!! CALLING SEQUENCE :
	11	!!
	12	!! "flio_rbld" is usually invoked by the script "rebuild"
	13	!!
	14	!! rebuild -h
	15	!!
	16	!! rebuild [-v] -o outfile infile[1] ... infile[n]
	17	!!
	18	!! INPUT for "rebuild" :
	19	!!
	20	!! -h : help
	21	!! -v : writing mode (silencious/verbose)
	22	!! outfile : name of the recombined file.
	23	!! infiles : names of the files that must be recombined.
	24	!!
	25	!! INPUT for "flio_rbld" :
	26	!!
	27	!! (C) c_w_mode : writing mode (silencious/verbose)
	28	!! (I) f_nb : total number of files
	29	!! (C) f_nm(:) : names of the files
	30	!!
	31	!!
	32	!! ASSOCIATED MODULES :
	33	!! IOIPSL(fliocom)
	34	!!
	35	!! RESTRICTIONS :
	36	!!
	37	!! Cases for character are not coded.
	38	!!
	39	!! Cases for netCDF variables such as array with more
	40	!! than 5 dimensions are not coded.
	41	!!
	42	!! Input files must have the following global attributes :
	43	!!
	44	!! "DOMAIN_number_total"
	45	!! "DOMAIN_number"
	46	!! "DOMAIN_dimensions_ids"
	47	!! "DOMAIN_size_global"
	48	!! "DOMAIN_size_local"
	49	!! "DOMAIN_position_first"
	50	!! "DOMAIN_position_last"
	51	!! "DOMAIN_halo_size_start"
	52	!! "DOMAIN_halo_size_end"
	53	!! "DOMAIN_type"
	54	!!
	55	!! NetCDF files must be smaller than 2 Gb.
	56	!!
	57	!! Character variables should have less than 257 letters
	58	!!
	59	!! EXAMPLE :
	60	!!
	61	!! rebuild -v -o sst.nc sst_[0-9][0-9][0-9][0-9].nc
	62	!!
	63	!! MODIFICATION HISTORY :
	64	!! Sebastien Masson (smasson@jamstec.go.jp) March 2004
	65	!! Jacques Bellier (Jacques.Bellier@cea.fr) June 2005
	66	!!--------------------------------------------------------------------
	67	USE IOIPSL
	68	USE defprec
	69	!-
	70	IMPLICIT NONE
	71	!-
	72	! Character length
	73	INTEGER,PARAMETER :: chlen=256
	74	!-
	75	! DO loops and test related variables
	76	INTEGER :: i,ia,id,iv,iw,i_i,i_n
	77	!-
	78	! Input arguments related variables
	79	CHARACTER(LEN=15) :: c_w_mode
	80	INTEGER :: f_nb
	81	CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: f_nm
	82	INTEGER,DIMENSION(:),ALLOCATABLE :: f_a_id
	83	!-
	84	! Domains related variables
	85	INTEGER :: d_n_t,i_ntd
	86	INTEGER,DIMENSION(:),ALLOCATABLE :: dom_att,d_d_i,d_s_g
	87	INTEGER,DIMENSION(:,:),ALLOCATABLE :: d_s_l,d_p_f,d_p_l,d_h_s,d_h_e
	88	LOGICAL :: l_cgd,l_cof,l_col,l_o_f,l_o_l
	89	CHARACTER(LEN=chlen) :: c_d_n
	90	!-
	91	! Model files related variables
	92	INTEGER :: f_id_i1,f_id_i,f_id_o
	93	INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_ul_d
	94	INTEGER :: v_type,v_d_nb,v_a_nb
	95	CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: &
	96	& f_d_nm,f_v_nm,f_a_nm,v_a_nm
	97	CHARACTER(LEN=chlen) :: f_u_nm
	98	INTEGER,DIMENSION(:),ALLOCATABLE :: f_d_i,f_d_l
	99	INTEGER :: a_l
	100	INTEGER,DIMENSION(flio_max_var_dims) :: v_d_i,ib,ie
	101	INTEGER,DIMENSION(:),ALLOCATABLE :: &
	102	& io_i,io_n, ia_sf,io_sf,io_cf,ia_sm,io_sm,io_cm,ia_sl,io_sl,io_cl
	103	LOGICAL :: l_ex
	104	CHARACTER(LEN=chlen) :: c_wn1,c_wn2
	105	!-
	106	!?INTEGERS of KIND 1 are not supported on all computers
	107	!?INTEGER(KIND=i_1) :: i1_0d
	108	!?INTEGER(KIND=i_1),DIMENSION(:),ALLOCATABLE :: i1_1d
	109	!?INTEGER(KIND=i_1),DIMENSION(:,:),ALLOCATABLE :: i1_2d
	110	!?INTEGER(KIND=i_1),DIMENSION(:,:,:),ALLOCATABLE :: i1_3d
	111	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),ALLOCATABLE :: i1_4d
	112	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i1_5d
	113	INTEGER(KIND=i_2) :: i2_0d
	114	INTEGER(KIND=i_2),DIMENSION(:),ALLOCATABLE :: i2_1d
	115	INTEGER(KIND=i_2),DIMENSION(:,:),ALLOCATABLE :: i2_2d
	116	INTEGER(KIND=i_2),DIMENSION(:,:,:),ALLOCATABLE :: i2_3d
	117	INTEGER(KIND=i_2),DIMENSION(:,:,:,:),ALLOCATABLE :: i2_4d
	118	INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i2_5d
	119	INTEGER(KIND=i_4) :: i4_0d
	120	INTEGER(KIND=i_4),DIMENSION(:),ALLOCATABLE :: i4_1d
	121	INTEGER(KIND=i_4),DIMENSION(:,:),ALLOCATABLE :: i4_2d
	122	INTEGER(KIND=i_4),DIMENSION(:,:,:),ALLOCATABLE :: i4_3d
	123	INTEGER(KIND=i_4),DIMENSION(:,:,:,:),ALLOCATABLE :: i4_4d
	124	INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i4_5d
	125	REAL(KIND=r_4) :: r4_0d
	126	REAL(KIND=r_4),DIMENSION(:),ALLOCATABLE :: r4_1d
	127	REAL(KIND=r_4),DIMENSION(:,:),ALLOCATABLE :: r4_2d
	128	REAL(KIND=r_4),DIMENSION(:,:,:),ALLOCATABLE :: r4_3d
	129	REAL(KIND=r_4),DIMENSION(:,:,:,:),ALLOCATABLE :: r4_4d
	130	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r4_5d
	131	REAL(KIND=r_8) :: r8_0d
	132	REAL(KIND=r_8),DIMENSION(:),ALLOCATABLE :: r8_1d
	133	REAL(KIND=r_8),DIMENSION(:,:),ALLOCATABLE :: r8_2d
	134	REAL(KIND=r_8),DIMENSION(:,:,:),ALLOCATABLE :: r8_3d
	135	REAL(KIND=r_8),DIMENSION(:,:,:,:),ALLOCATABLE :: r8_4d
	136	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r8_5d
	137	!-
	138	! elapsed and cpu time computation variables
	139	INTEGER :: nb_cc_ini,nb_cc_end,nb_cc_sec,nb_cc_max
	140	REAL :: t_cpu_ini,t_cpu_end
	141	!---------------------------------------------------------------------
	142	!-
	143	!-------------------
	144	! INPUT arguments
	145	!-------------------
	146	!-
	147	! Retrieve the write mode
	148	READ (UNIT=*,FMT='(A)') c_w_mode
	149	!-
	150	! Retrieve the number of arguments
	151	READ (UNIT=,FMT=) f_nb
	152	!-
	153	! Retrieve the file names
	154	ALLOCATE(f_nm(f_nb))
	155	DO iw=1,f_nb
	156	READ (UNIT=*,FMT='(A)') f_nm(iw)
	157	ENDDO
	158	!-
	159	IF (TRIM(c_w_mode) == 'verbose') THEN
	160	WRITE (UNIT=*,FMT='("")')
	161	WRITE (UNIT=*,FMT='(" mode : """,A,"""")') TRIM(c_w_mode)
	162	WRITE (UNIT=*,FMT='(" nb_args : ",I4)') f_nb
	163	WRITE (UNIT=*,FMT='(" Input files :")')
	164	DO iw=1,f_nb-1
	165	WRITE (*,'(" ",A)') TRIM(f_nm(iw))
	166	ENDDO
	167	WRITE (UNIT=*,FMT='(" Output file :")')
	168	WRITE (*,'(" ",A)') TRIM(f_nm(f_nb))
	169	ENDIF
	170	!-
	171	IF (TRIM(c_w_mode) == 'verbose') THEN
	172	!-- time initializations
	173	CALL system_clock &
	174	& (count=nb_cc_ini,count_rate=nb_cc_sec,count_max=nb_cc_max)
	175	CALL cpu_time (t_cpu_ini)
	176	ENDIF
	177	!-
	178	!---------------------------------------------------
	179	! Retrieve basic informations from the first file
	180	!---------------------------------------------------
	181	!-
	182	! Open the first file
	183	CALL flioopfd (TRIM(f_nm(1)),f_id_i)
	184	!-
	185	! Get the attribute "DOMAIN_number_total"
	186	CALL fliogeta (f_id_i,"?","DOMAIN_number_total",d_n_t)
	187	!-
	188	! Validate the number of input files :
	189	! must be equal to the total number
	190	! of domains used in the simulation
	191	IF (d_n_t == (f_nb-1)) THEN
	192	!---
	193	!-- Retrieve the basic characteristics of the first input file
	194	CALL flioinqf &
	195	& (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_ul_d)
	196	!---
	197	!-- Build the list of the names
	198	!-- of the dimensions/variables/global_attributes
	199	!-- and retrieve the unlimited_dimension name
	200	!-- from the first input file
	201	ALLOCATE(f_d_nm(f_d_nb),f_v_nm(f_v_nb),f_a_nm(f_a_nb))
	202	CALL flioinqn (f_id_i,cn_dim=f_d_nm,cn_var=f_v_nm, &
	203	& cn_gat=f_a_nm,cn_uld=f_u_nm)
	204	!---
	205	!-- Build the list of the dimensions identifiers and lengths
	206	ALLOCATE(f_d_i(f_d_nb),f_d_l(f_d_nb))
	207	CALL flioinqf (f_id_i,id_dim=f_d_i,ln_dim=f_d_l)
	208	ENDIF
	209	!-
	210	! Close the file
	211	CALL flioclo (f_id_i)
	212	!-
	213	IF (d_n_t /= (f_nb-1)) THEN
	214	DEALLOCATE(f_nm)
	215	CALL ipslerr (3,"flio_rbld", &
	216	& "The number of input files", &
	217	& "is not equal to the number of DOMAINS"," ")
	218	ENDIF
	219	!-
	220	!----------------------------------------------------
	221	! Retrieve domain informations for each input file
	222	!----------------------------------------------------
	223	!-
	224	ALLOCATE(f_a_id(f_nb-1))
	225	!-
	226	!-
	227	DO iw=1,f_nb-1
	228	!---
	229	CALL flioopfd (TRIM(f_nm(iw)),f_id_i)
	230	f_a_id(iw) = f_id_i
	231	!---
	232	IF (iw > 1) THEN
	233	c_wn1 = "DOMAIN_number_total"
	234	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	235	IF (l_ex) THEN
	236	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),i_ntd)
	237	IF (i_ntd /= d_n_t) THEN
	238	CALL ipslerr (3,"flio_rbld", &
	239	& "File : "//TRIM(f_nm(iw)), &
	240	& "Attribute : "//TRIM(c_wn1), &
	241	& "not equal to the one of the first file")
	242	ENDIF
	243	ELSE
	244	CALL ipslerr (3,"flio_rbld", &
	245	& "File : "//TRIM(f_nm(iw)), &
	246	& "Attribute : "//TRIM(c_wn1),"not found")
	247	ENDIF
	248	ENDIF
	249	!---
	250	c_wn1 = "DOMAIN_dimensions_ids"
	251	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	252	IF (l_ex) THEN
	253	ALLOCATE(dom_att(a_l))
	254	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
	255	IF (iw == 1) THEN
	256	ALLOCATE (d_d_i(a_l))
	257	d_d_i(:) = dom_att(:)
	258	ELSEIF (SIZE(dom_att) /= SIZE(d_d_i)) THEN
	259	CALL ipslerr (3,"flio_rbld", &
	260	& "File : "//TRIM(f_nm(iw)), &
	261	& "size of the attribute : "//TRIM(c_wn1), &
	262	& "not equal to the one of the first file")
	263	ELSEIF (ANY(dom_att(:) /= d_d_i(:))) THEN
	264	CALL ipslerr (3,"flio_rbld", &
	265	& "File : "//TRIM(f_nm(iw)), &
	266	& "Attribute : "//TRIM(c_wn1), &
	267	& "not equal to the one of the first file")
	268	ENDIF
	269	DEALLOCATE(dom_att)
	270	ENDIF
	271	!---
	272	c_wn1 = "DOMAIN_size_global"
	273	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	274	IF (l_ex) THEN
	275	IF (a_l /= SIZE(d_d_i)) THEN
	276	CALL ipslerr (3,"flio_rbld", &
	277	& "File : "//TRIM(f_nm(iw)), &
	278	& "size of the attribute : "//TRIM(c_wn1), &
	279	& "not equal to the size of DOMAIN_dimensions_ids")
	280	ELSE
	281	ALLOCATE(dom_att(a_l))
	282	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
	283	IF (iw == 1) THEN
	284	ALLOCATE (d_s_g(a_l))
	285	d_s_g(:)=dom_att(:)
	286	ELSEIF (ANY(dom_att(:) /= d_s_g(:))) THEN
	287	CALL ipslerr (3,"flio_rbld", &
	288	& "File : "//TRIM(f_nm(iw)), &
	289	& "Attribute : "//TRIM(c_wn1), &
	290	& "not equal to the one of the first file")
	291	ENDIF
	292	DEALLOCATE(dom_att)
	293	ENDIF
	294	ELSE
	295	CALL ipslerr (3,"flio_rbld", &
	296	& "File : "//TRIM(f_nm(iw)), &
	297	& "Attribute : "//TRIM(c_wn1),"not found")
	298	ENDIF
	299	!---
	300	c_wn1 = "DOMAIN_size_local"
	301	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	302	IF (l_ex) THEN
	303	IF (a_l /= SIZE(d_d_i)) THEN
	304	CALL ipslerr (3,"flio_rbld", &
	305	& "File : "//TRIM(f_nm(iw)), &
	306	& "size of the attribute : "//TRIM(c_wn1), &
	307	& "not equal to the size of DOMAIN_dimensions_ids")
	308	ELSE
	309	ALLOCATE(dom_att(a_l))
	310	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
	311	IF (iw == 1) THEN
	312	ALLOCATE (d_s_l(a_l,f_nb-1))
	313	ENDIF
	314	d_s_l(:,iw)=dom_att(:)
	315	DEALLOCATE(dom_att)
	316	ENDIF
	317	ELSE
	318	CALL ipslerr (3,"flio_rbld", &
	319	& "File : "//TRIM(f_nm(iw)), &
	320	& "Attribute : "//TRIM(c_wn1),"not found")
	321	ENDIF
	322	!---
	323	c_wn1 = "DOMAIN_position_first"
	324	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	325	IF (l_ex) THEN
	326	IF (a_l /= SIZE(d_d_i)) THEN
	327	CALL ipslerr (3,"flio_rbld", &
	328	& "File : "//TRIM(f_nm(iw)), &
	329	& "size of the attribute : "//TRIM(c_wn1), &
	330	& "not equal to the size of DOMAIN_dimensions_ids")
	331	ELSE
	332	ALLOCATE(dom_att(a_l))
	333	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
	334	IF (iw == 1) THEN
	335	ALLOCATE (d_p_f(a_l,f_nb-1))
	336	ENDIF
	337	d_p_f(:,iw)=dom_att(:)
	338	DEALLOCATE(dom_att)
	339	ENDIF
	340	ELSE
	341	CALL ipslerr (3,"flio_rbld", &
	342	& "File : "//TRIM(f_nm(iw)), &
	343	& "Attribute : "//TRIM(c_wn1),"not found")
	344	ENDIF
	345	!---
	346	c_wn1 = "DOMAIN_position_last"
	347	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	348	IF (l_ex) THEN
	349	IF (a_l /= SIZE(d_d_i)) THEN
	350	CALL ipslerr (3,"flio_rbld", &
	351	& "File : "//TRIM(f_nm(iw)), &
	352	& "size of the attribute : "//TRIM(c_wn1), &
	353	& "not equal to the size of DOMAIN_dimensions_ids")
	354	ELSE
	355	ALLOCATE(dom_att(a_l))
	356	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
	357	IF (iw == 1) THEN
	358	ALLOCATE (d_p_l(a_l,f_nb-1))
	359	ENDIF
	360	d_p_l(:,iw)=dom_att(:)
	361	DEALLOCATE(dom_att)
	362	ENDIF
	363	ELSE
	364	CALL ipslerr (3,"flio_rbld", &
	365	& "File : "//TRIM(f_nm(iw)), &
	366	& "Attribute : "//TRIM(c_wn1),"not found")
	367	ENDIF
	368	!---
	369	c_wn1 = "DOMAIN_halo_size_start"
	370	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	371	IF (l_ex) THEN
	372	IF (a_l /= SIZE(d_d_i)) THEN
	373	CALL ipslerr (3,"flio_rbld", &
	374	& "File : "//TRIM(f_nm(iw)), &
	375	& "size of the attribute : "//TRIM(c_wn1), &
	376	& "not equal to the size of DOMAIN_dimensions_ids")
	377	ELSE
	378	ALLOCATE(dom_att(a_l))
	379	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
	380	IF (iw == 1) THEN
	381	ALLOCATE (d_h_s(a_l,f_nb-1))
	382	ENDIF
	383	d_h_s(:,iw)=dom_att(:)
	384	DEALLOCATE(dom_att)
	385	ENDIF
	386	ELSE
	387	CALL ipslerr (3,"flio_rbld", &
	388	& "File : "//TRIM(f_nm(iw)), &
	389	& "Attribute : "//TRIM(c_wn1),"not found")
	390	ENDIF
	391	!---
	392	c_wn1 = "DOMAIN_halo_size_end"
	393	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	394	IF (l_ex) THEN
	395	IF (a_l /= SIZE(d_d_i)) THEN
	396	CALL ipslerr (3,"flio_rbld", &
	397	& "File : "//TRIM(f_nm(iw)), &
	398	& "size of the attribute : "//TRIM(c_wn1), &
	399	& "not equal to the size of DOMAIN_dimensions_ids")
	400	ELSE
	401	ALLOCATE(dom_att(a_l))
	402	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
	403	IF (iw == 1) THEN
	404	ALLOCATE (d_h_e(a_l,f_nb-1))
	405	ENDIF
	406	d_h_e(:,iw)=dom_att(:)
	407	DEALLOCATE(dom_att)
	408	ENDIF
	409	ELSE
	410	CALL ipslerr (3,"flio_rbld", &
	411	& "File : "//TRIM(f_nm(iw)), &
	412	& "Attribute : "//TRIM(c_wn1),"not found")
	413	ENDIF
	414	!---
	415	c_wn1 = "DOMAIN_type"
	416	c_wn2 = " "
	417	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
	418	IF (l_ex) THEN
	419	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),c_wn2)
	420	CALL strlowercase (c_wn2)
	421	IF (iw == 1) THEN
	422	IF ( (TRIM(c_wn2) == "box") &
	423	& .OR.(TRIM(c_wn2) == "apple") ) THEN
	424	c_d_n = c_wn2
	425	ELSE
	426	CALL ipslerr (3,"flio_rbld", &
	427	& "File : "//TRIM(f_nm(iw)), &
	428	& "Attribute : "//TRIM(c_wn1), &
	429	& "type "//TRIM(c_wn2)//" not (yet) supported")
	430	ENDIF
	431	ELSEIF (TRIM(c_wn2) /= TRIM(c_d_n)) THEN
	432	CALL ipslerr (3,"flio_rbld", &
	433	& "File : "//TRIM(f_nm(iw)), &
	434	& "Attribute : "//TRIM(c_wn1), &
	435	& "not equal to the one of the first file")
	436	ENDIF
	437	ELSE
	438	CALL ipslerr (3,"flio_rbld", &
	439	& "File : "//TRIM(f_nm(iw)), &
	440	& "Attribute : "//TRIM(c_wn1),"not found")
	441	ENDIF
	442	!---
	443	!xxxxxxx
	444	!xxxxxxx CALL flioclo (f_id_i)
	445	!xxxxxxx
	446	ENDDO
	447	!-
	448	IF (TRIM(c_w_mode) == 'verbose') THEN
	449	WRITE (UNIT=*,FMT='("")')
	450	WRITE (*,'(" From the first file : ")')
	451	WRITE (*,'(" Number of dimensions : ",I2)') f_d_nb
	452	WRITE (*,'(" Idents : ",(10(1X,I4),:))') f_d_i(1:f_d_nb)
	453	WRITE (*,'(" Lengths : ",(10(1X,I4),:))') f_d_l(1:f_d_nb)
	454	WRITE (*,'(" Names: ")')
	455	DO i=1,f_d_nb
	456	WRITE (*,'(" """,A,"""")') TRIM(f_d_nm(i))
	457	ENDDO
	458	IF (f_ul_d > 0) THEN
	459	WRITE (*,'(" Unlimited dimension id : ",I2)') f_d_i(f_ul_d)
	460	ENDIF
	461	WRITE (*,'(" Number of variables : ",I2)') f_v_nb
	462	WRITE (*,'(" Names: ")')
	463	DO i=1,f_v_nb
	464	WRITE (*,'(" """,A,"""")') TRIM(f_v_nm(i))
	465	ENDDO
	466	WRITE (*,'(" Number of global attributes : ",I2)') f_a_nb
	467	WRITE (*,'(" Names: ")')
	468	DO i=1,f_a_nb
	469	WRITE (*,'(" """,A,"""")') TRIM(f_a_nm(i))
	470	ENDDO
	471	WRITE (UNIT=*,FMT='("")')
	472	WRITE (*,'(" From input files : ")')
	473	WRITE (*,'(" Total number of DOMAINS : ",I4)') d_n_t
	474	WRITE (*,'(" DOMAIN_dimensions_ids :",(10(1X,I5),:))') d_d_i(:)
	475	WRITE (*,'(" DOMAIN_size_global :",(10(1X,I5),:))') d_s_g(:)
	476	WRITE (*,'(" DOMAIN_type : """,(A),"""")') TRIM(c_d_n)
	477	DO iw=1,f_nb-1
	478	WRITE (*,'(" File : ",A)') TRIM(f_nm(iw))
	479	WRITE (*,'(" d_s_l :",(10(1X,I5),:))') d_s_l(:,iw)
	480	WRITE (*,'(" d_p_f :",(10(1X,I5),:))') d_p_f(:,iw)
	481	WRITE (*,'(" d_p_l :",(10(1X,I5),:))') d_p_l(:,iw)
	482	WRITE (*,'(" d_h_s :",(10(1X,I5),:))') d_h_s(:,iw)
	483	IF (TRIM(c_d_n) == "apple") THEN
	484	IF (COUNT(d_h_s(:,iw) /= 0) > 1) THEN
	485	CALL ipslerr (3,"flio_rbld", &
	486	& "Beginning offset is not yet supported", &
	487	& "for more than one dimension"," ")
	488	ENDIF
	489	ENDIF
	490	WRITE (*,'(" d_h_e :",(10(1X,I5),:))') d_h_e(:,iw)
	491	IF (TRIM(c_d_n) == "apple") THEN
	492	IF (COUNT(d_h_e(:,iw) /= 0) > 1) THEN
	493	CALL ipslerr (3,"flio_rbld", &
	494	& "Ending offset is not yet supported", &
	495	& "for more than one dimension"," ")
	496	ENDIF
	497	ENDIF
	498	ENDDO
	499	ENDIF
	500	!-
	501	!---------------------------------------
	502	! Create the dimensionned output file
	503	!---------------------------------------
	504	!-
	505	! Define the dimensions used in the output file
	506	DO id=1,f_d_nb
	507	DO i=1,SIZE(d_d_i)
	508	IF (f_d_i(id) == d_d_i(i)) THEN
	509	f_d_l(id) = d_s_g(i)
	510	ENDIF
	511	ENDDO
	512	ENDDO
	513	!-
	514	IF (f_ul_d > 0) THEN
	515	i = f_d_l(f_ul_d); f_d_l(f_ul_d) = -1;
	516	ENDIF
	517	!-
	518	! Create the the output file
	519	CALL fliocrfd (TRIM(f_nm(f_nb)),f_d_nm,f_d_l,f_id_o,c_f_n=c_wn1)
	520	!-
	521	IF (TRIM(c_w_mode) == 'verbose') THEN
	522	WRITE (UNIT=*,FMT='("")')
	523	WRITE (UNIT=,FMT=) "Output file : ",TRIM(c_wn1)
	524	ENDIF
	525	!-
	526	IF (f_ul_d > 0) THEN
	527	f_d_l(f_ul_d) = i
	528	ENDIF
	529	!xxxxxxx
	530	!-
	531	! open the first input file used to build the output file
	532	!-
	533	!xxxxxxx CALL flioopfd (TRIM(f_nm(1)),f_id_i1)
	534	f_id_i1 = f_a_id(1)
	535	!xxxxxxx
	536	!-
	537	! define the global attributes in the output file
	538	! copy all global attributes except those beginning by "DOMAIN_"
	539	! eventually actualize the "file_name" attribute
	540	!-
	541	DO ia=1,f_a_nb
	542	IF (INDEX(TRIM(f_a_nm(ia)),"DOMAIN_") == 1) CYCLE
	543	IF (TRIM(f_a_nm(ia)) == "file_name") THEN
	544	CALL flioputa (f_id_o,"?",TRIM(f_a_nm(ia)),TRIM(c_wn1))
	545	ELSE
	546	CALL fliocpya (f_id_i1,"?",TRIM(f_a_nm(ia)),f_id_o,"?")
	547	ENDIF
	548	ENDDO
	549	!-
	550	! define the variables in the output file
	551	!-
	552	DO iv=1,f_v_nb
	553	!-- get variable informations
	554	CALL flioinqv &
	555	& (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type, &
	556	& nb_dims=v_d_nb,id_dims=v_d_i,nb_atts=v_a_nb)
	557	!-- define the new variable
	558	IF (v_d_nb == 0) THEN
	559	CALL fliodefv &
	560	& (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type)
	561	ELSE
	562	CALL fliodefv &
	563	& (f_id_o,TRIM(f_v_nm(iv)),v_d_i(1:v_d_nb),v_t=v_type)
	564	ENDIF
	565	!-- copy all variable attributes
	566	ALLOCATE(v_a_nm(v_a_nb))
	567	CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
	568	DO ia=1,v_a_nb
	569	CALL fliocpya &
	570	& (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
	571	& f_id_o,TRIM(f_v_nm(iv)))
	572	ENDDO
	573	DEALLOCATE(v_a_nm)
	574	ENDDO
	575	!-
	576	!------------------------
	577	! Fill the output file
	578	!------------------------
	579	!-
	580	DO iv=1,f_v_nb
	581	!-- get variable informations
	582	CALL flioinqv &
	583	& (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type, &
	584	& nb_dims=v_d_nb,id_dims=v_d_i)
	585	IF (TRIM(c_w_mode) == 'verbose') THEN
	586	WRITE (UNIT=*,FMT='("")')
	587	WRITE (UNIT=,FMT=) "variable : ",TRIM(f_v_nm(iv))
	588	ENDIF
	589	!-- do the variable contains dimensions to be recombined ?
	590	l_cgd = .FALSE.
	591	i_n = 1
	592	DO i=1,SIZE(d_d_i)
	593	l_cgd = ANY(v_d_i(1:v_d_nb) == d_d_i(i))
	594	l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb-1) /= d_s_g(i))
	595	IF (l_cgd) THEN
	596	i_n = f_nb-1
	597	EXIT
	598	ENDIF
	599	ENDDO
	600	IF (v_d_nb > 0) THEN
	601	!---- Allocate io_i,io_n,ia_sm,io_sm,io_cm
	602	ALLOCATE(io_i(v_d_nb),io_n(v_d_nb))
	603	ALLOCATE(ia_sm(v_d_nb),io_sm(v_d_nb),io_cm(v_d_nb))
	604	!---- Default definition of io_i,io_n,io_sm,io_cm
	605	io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb));
	606	ia_sm(:) = 1; io_sm(:) = 1; io_cm(:) = io_n(:);
	607	!---- If needed, allocate offset
	608	l_o_f = .FALSE.; l_o_l = .FALSE.;
	609	IF (TRIM(c_d_n) == "apple") THEN
	610	ALLOCATE(ia_sf(v_d_nb),io_sf(v_d_nb),io_cf(v_d_nb))
	611	ALLOCATE(ia_sl(v_d_nb),io_sl(v_d_nb),io_cl(v_d_nb))
	612	ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:);
	613	ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:);
	614	ENDIF
	615	ENDIF
	616	!--
	617	DO i_i=1,i_n
	618	IF (l_cgd) THEN
	619	!------ the variable contains dimensions to be recombined
	620	!------
	621	!xxxxxxx
	622	!------ open each file containing a small piece of data
	623	!xxxxxxx CALL flioopfd (TRIM(f_nm(i_i)),f_id_i)
	624	f_id_i = f_a_id(i_i)
	625	!xxxxxxx
	626	!------
	627	!------ do the variable has offset at first/last block ?
	628	l_cof = .FALSE.; l_col = .FALSE.;
	629	IF (TRIM(c_d_n) == "apple") THEN
	630	L_BF: DO id=1,v_d_nb
	631	DO i=1,SIZE(d_d_i)
	632	IF (v_d_i(id) == d_d_i(i)) THEN
	633	l_cof = (d_h_s(i,i_i) /= 0)
	634	IF (l_cof) EXIT L_BF
	635	ENDIF
	636	ENDDO
	637	ENDDO L_BF
	638	L_BL: DO id=1,v_d_nb
	639	DO i=1,SIZE(d_d_i)
	640	IF (v_d_i(id) == d_d_i(i)) THEN
	641	l_col = (d_h_e(i,i_i) /= 0)
	642	IF (l_col) EXIT L_BL
	643	ENDIF
	644	ENDDO
	645	ENDDO L_BL
	646	ENDIF
	647	!------ if needed, redefine start and count for dimensions
	648	l_o_f = .FALSE.; l_o_l = .FALSE.;
	649	DO id=1,v_d_nb
	650	DO i=1,SIZE(d_d_i)
	651	IF (v_d_i(id) == d_d_i(i)) THEN
	652	io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1
	653	ia_sm(id) = 1
	654	io_sm(id) = d_p_f(i,i_i)
	655	io_cm(id) = io_n(id)
	656	IF (TRIM(c_d_n) == "box") THEN
	657	ia_sm(id) = ia_sm(id)+d_h_s(i,i_i)
	658	io_sm(id) = io_sm(id)+d_h_s(i,i_i)
	659	io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i)
	660	ELSEIF (TRIM(c_d_n) == "apple") THEN
	661	IF (l_cof) THEN
	662	IF (d_h_s(i,i_i) /= 0) THEN
	663	ia_sf(id) = 1+d_h_s(i,i_i)
	664	io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i)
	665	io_cf(id) = io_n(id)-d_h_s(i,i_i)
	666	ELSE
	667	io_sf(id) = d_p_f(i,i_i)
	668	io_cf(id) = 1
	669	ia_sm(id) = ia_sm(id)+1
	670	io_sm(id) = io_sm(id)+1
	671	io_cm(id) = io_cm(id)-1
	672	l_o_f = .TRUE.
	673	ENDIF
	674	ENDIF
	675	IF (l_col) THEN
	676	IF (d_h_e(i,i_i) /= 0) THEN
	677	ia_sl(id) = 1
	678	io_sl(id) = d_p_f(i,i_i)
	679	io_cl(id) = io_n(id)-d_h_e(i,i_i)
	680	ELSE
	681	io_cm(id) = io_cm(id)-1
	682	ia_sl(id) = 1+io_n(id)-1
	683	io_sl(id) = d_p_f(i,i_i)+io_n(id)-1
	684	io_cl(id) = 1
	685	l_o_l = .TRUE.
	686	ENDIF
	687	ENDIF
	688	ENDIF
	689	ENDIF
	690	ENDDO
	691	ENDDO
	692	ELSE
	693	!------ the data can be read/write in one piece
	694	f_id_i = f_id_i1
	695	ENDIF
	696	!-----
	697	IF (TRIM(c_w_mode) == 'verbose') THEN
	698	WRITE (UNIT=,FMT=) TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
	699	WRITE (UNIT=,FMT=) "io_i : ",io_i(:)
	700	WRITE (UNIT=,FMT=) "io_n : ",io_n(:)
	701	WRITE (UNIT=,FMT=) "l_o_f : ",l_o_f
	702	IF (l_o_f) THEN
	703	WRITE (UNIT=,FMT=) "ia_sf : ",ia_sf(:)
	704	WRITE (UNIT=,FMT=) "io_sf : ",io_sf(:)
	705	WRITE (UNIT=,FMT=) "io_cf : ",io_cf(:)
	706	ENDIF
	707	WRITE (UNIT=,FMT=) "ia_sm : ",ia_sm(:)
	708	WRITE (UNIT=,FMT=) "io_sm : ",io_sm(:)
	709	WRITE (UNIT=,FMT=) "io_cm : ",io_cm(:)
	710	WRITE (UNIT=,FMT=) "l_o_l : ",l_o_l
	711	IF (l_o_l) THEN
	712	WRITE (UNIT=,FMT=) "ia_sl : ",ia_sl(:)
	713	WRITE (UNIT=,FMT=) "io_sl : ",io_sl(:)
	714	WRITE (UNIT=,FMT=) "io_cl : ",io_cl(:)
	715	ENDIF
	716	ENDIF
	717	!-----
	718	!---- Cases according to the type, shape and offsets of the data
	719	!-----
	720	SELECT CASE (v_type)
	721	!?INTEGERS of KIND 1 are not supported on all computers
	722	!? CASE (flio_i1) !--- INTEGER 1
	723	!? SELECT CASE (v_d_nb)
	724	!? CASE (0) !--- Scalar
	725	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
	726	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
	727	!? CASE (1) !--- 1d array
	728	!? ALLOCATE(i1_1d(io_n(1)))
	729	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
	730	!? & start=io_i(:),count=io_n(:))
	731	!? IF (l_o_f) THEN
	732	!? ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
	733	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	734	!? & i1_1d(ib(1):ie(1)), &
	735	!? & start=io_sf(:),count=io_cf(:))
	736	!? ENDIF
	737	!? ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
	738	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	739	!? & i1_1d(ib(1):ie(1)), &
	740	!? & start=io_sm(:),count=io_cm(:))
	741	!? IF (l_o_l) THEN
	742	!? ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
	743	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	744	!? & i1_1d(ib(1):ie(1)), &
	745	!? & start=io_sl(:),count=io_cl(:))
	746	!? ENDIF
	747	!? DEALLOCATE(i1_1d)
	748	!? CASE (2) !--- 2d array
	749	!? ALLOCATE(i1_2d(io_n(1),io_n(2)))
	750	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
	751	!? & start=io_i(:),count=io_n(:))
	752	!? IF (l_o_f) THEN
	753	!? ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
	754	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	755	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
	756	!? & start=io_sf(:),count=io_cf(:))
	757	!? ENDIF
	758	!? ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
	759	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	760	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
	761	!? & start=io_sm(:),count=io_cm(:))
	762	!? IF (l_o_l) THEN
	763	!? ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
	764	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	765	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
	766	!? & start=io_sl(:),count=io_cl(:))
	767	!? ENDIF
	768	!? DEALLOCATE(i1_2d)
	769	!? CASE (3) !--- 3d array
	770	!? ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
	771	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
	772	!? & start=io_i(:),count=io_n(:))
	773	!? IF (l_o_f) THEN
	774	!? ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
	775	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	776	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	777	!? & start=io_sf(:),count=io_cf(:))
	778	!? ENDIF
	779	!? ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
	780	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	781	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	782	!? & start=io_sm(:),count=io_cm(:))
	783	!? IF (l_o_l) THEN
	784	!? ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
	785	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	786	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	787	!? & start=io_sl(:),count=io_cl(:))
	788	!? ENDIF
	789	!? DEALLOCATE(i1_3d)
	790	!? CASE (4) !--- 4d array
	791	!? ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
	792	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
	793	!? & start=io_i(:),count=io_n(:))
	794	!? IF (l_o_f) THEN
	795	!? ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
	796	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	797	!? & i1_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	798	!? & start=io_sf(:),count=io_cf(:))
	799	!? ENDIF
	800	!? ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
	801	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	802	!? & i1_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	803	!? & start=io_sm(:),count=io_cm(:))
	804	!? IF (l_o_l) THEN
	805	!? ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
	806	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	807	!? & i1_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	808	!? & start=io_sl(:),count=io_cl(:))
	809	!? ENDIF
	810	!? DEALLOCATE(i1_4d)
	811	!? CASE (5) !--- 5d array
	812	!? ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
	813	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
	814	!? & start=io_i(:),count=io_n(:))
	815	!? IF (l_o_f) THEN
	816	!? ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
	817	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	818	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	819	!? & ib(4):ie(4),ib(5):ie(5)), &
	820	!? & start=io_sf(:),count=io_cf(:))
	821	!? ENDIF
	822	!? ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
	823	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	824	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	825	!? & ib(4):ie(4),ib(5):ie(5)), &
	826	!? & start=io_sm(:),count=io_cm(:))
	827	!? IF (l_o_l) THEN
	828	!? ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
	829	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	830	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	831	!? & ib(4):ie(4),ib(5):ie(5)), &
	832	!? & start=io_sl(:),count=io_cl(:))
	833	!? ENDIF
	834	!? DEALLOCATE(i1_5d)
	835	!? END SELECT
	836	!? CASE (flio_i2) !--- INTEGER 2
	837	CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
	838	SELECT CASE (v_d_nb)
	839	CASE (0) !--- Scalar
	840	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
	841	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
	842	CASE (1) !--- 1d array
	843	ALLOCATE(i2_1d(io_n(1)))
	844	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
	845	& start=io_i(:),count=io_n(:))
	846	IF (l_o_f) THEN
	847	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
	848	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	849	& i2_1d(ib(1):ie(1)), &
	850	& start=io_sf(:),count=io_cf(:))
	851	ENDIF
	852	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
	853	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	854	& i2_1d(ib(1):ie(1)), &
	855	& start=io_sm(:),count=io_cm(:))
	856	IF (l_o_l) THEN
	857	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
	858	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	859	& i2_1d(ib(1):ie(1)), &
	860	& start=io_sl(:),count=io_cl(:))
	861	ENDIF
	862	DEALLOCATE(i2_1d)
	863	CASE (2) !--- 2d array
	864	ALLOCATE(i2_2d(io_n(1),io_n(2)))
	865	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
	866	& start=io_i(:),count=io_n(:))
	867	IF (l_o_f) THEN
	868	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
	869	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	870	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
	871	& start=io_sf(:),count=io_cf(:))
	872	ENDIF
	873	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
	874	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	875	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
	876	& start=io_sm(:),count=io_cm(:))
	877	IF (l_o_l) THEN
	878	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
	879	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	880	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
	881	& start=io_sl(:),count=io_cl(:))
	882	ENDIF
	883	DEALLOCATE(i2_2d)
	884	CASE (3) !--- 3d array
	885	ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
	886	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
	887	& start=io_i(:),count=io_n(:))
	888	IF (l_o_f) THEN
	889	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
	890	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	891	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	892	& start=io_sf(:),count=io_cf(:))
	893	ENDIF
	894	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
	895	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	896	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	897	& start=io_sm(:),count=io_cm(:))
	898	IF (l_o_l) THEN
	899	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
	900	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	901	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	902	& start=io_sl(:),count=io_cl(:))
	903	ENDIF
	904	DEALLOCATE(i2_3d)
	905	CASE (4) !--- 4d array
	906	ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
	907	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
	908	& start=io_i(:),count=io_n(:))
	909	IF (l_o_f) THEN
	910	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
	911	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	912	& i2_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	913	& start=io_sf(:),count=io_cf(:))
	914	ENDIF
	915	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
	916	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	917	& i2_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	918	& start=io_sm(:),count=io_cm(:))
	919	IF (l_o_l) THEN
	920	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
	921	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	922	& i2_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	923	& start=io_sl(:),count=io_cl(:))
	924	ENDIF
	925	DEALLOCATE(i2_4d)
	926	CASE (5) !--- 5d array
	927	ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
	928	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
	929	& start=io_i(:),count=io_n(:))
	930	IF (l_o_f) THEN
	931	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
	932	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	933	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	934	& ib(4):ie(4),ib(5):ie(5)), &
	935	& start=io_sf(:),count=io_cf(:))
	936	ENDIF
	937	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
	938	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	939	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	940	& ib(4):ie(4),ib(5):ie(5)), &
	941	& start=io_sm(:),count=io_cm(:))
	942	IF (l_o_l) THEN
	943	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
	944	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	945	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	946	& ib(4):ie(4),ib(5):ie(5)), &
	947	& start=io_sl(:),count=io_cl(:))
	948	ENDIF
	949	DEALLOCATE(i2_5d)
	950	END SELECT
	951	CASE (flio_i4) !--- INTEGER 4
	952	SELECT CASE (v_d_nb)
	953	CASE (0) !--- Scalar
	954	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
	955	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
	956	CASE (1) !--- 1d array
	957	ALLOCATE(i4_1d(io_n(1)))
	958	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
	959	& start=io_i(:),count=io_n(:))
	960	IF (l_o_f) THEN
	961	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
	962	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	963	& i4_1d(ib(1):ie(1)), &
	964	& start=io_sf(:),count=io_cf(:))
	965	ENDIF
	966	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
	967	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	968	& i4_1d(ib(1):ie(1)), &
	969	& start=io_sm(:),count=io_cm(:))
	970	IF (l_o_l) THEN
	971	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
	972	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	973	& i4_1d(ib(1):ie(1)), &
	974	& start=io_sl(:),count=io_cl(:))
	975	ENDIF
	976	DEALLOCATE(i4_1d)
	977	CASE (2) !--- 2d array
	978	ALLOCATE(i4_2d(io_n(1),io_n(2)))
	979	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
	980	& start=io_i(:),count=io_n(:))
	981	IF (l_o_f) THEN
	982	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
	983	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	984	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
	985	& start=io_sf(:),count=io_cf(:))
	986	ENDIF
	987	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
	988	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	989	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
	990	& start=io_sm(:),count=io_cm(:))
	991	IF (l_o_l) THEN
	992	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
	993	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	994	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
	995	& start=io_sl(:),count=io_cl(:))
	996	ENDIF
	997	DEALLOCATE(i4_2d)
	998	CASE (3) !--- 3d array
	999	ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
	1000	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
	1001	& start=io_i(:),count=io_n(:))
	1002	IF (l_o_f) THEN
	1003	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
	1004	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1005	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1006	& start=io_sf(:),count=io_cf(:))
	1007	ENDIF
	1008	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
	1009	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1010	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1011	& start=io_sm(:),count=io_cm(:))
	1012	IF (l_o_l) THEN
	1013	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
	1014	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1015	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1016	& start=io_sl(:),count=io_cl(:))
	1017	ENDIF
	1018	DEALLOCATE(i4_3d)
	1019	CASE (4) !--- 4d array
	1020	ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
	1021	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
	1022	& start=io_i(:),count=io_n(:))
	1023	IF (l_o_f) THEN
	1024	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
	1025	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1026	& i4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1027	& start=io_sf(:),count=io_cf(:))
	1028	ENDIF
	1029	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
	1030	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1031	& i4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1032	& start=io_sm(:),count=io_cm(:))
	1033	IF (l_o_l) THEN
	1034	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
	1035	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1036	& i4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1037	& start=io_sl(:),count=io_cl(:))
	1038	ENDIF
	1039	DEALLOCATE(i4_4d)
	1040	CASE (5) !--- 5d array
	1041	ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
	1042	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
	1043	& start=io_i(:),count=io_n(:))
	1044	IF (l_o_f) THEN
	1045	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
	1046	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1047	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1048	& ib(4):ie(4),ib(5):ie(5)), &
	1049	& start=io_sf(:),count=io_cf(:))
	1050	ENDIF
	1051	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
	1052	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1053	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1054	& ib(4):ie(4),ib(5):ie(5)), &
	1055	& start=io_sm(:),count=io_cm(:))
	1056	IF (l_o_l) THEN
	1057	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
	1058	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1059	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1060	& ib(4):ie(4),ib(5):ie(5)), &
	1061	& start=io_sl(:),count=io_cl(:))
	1062	ENDIF
	1063	DEALLOCATE(i4_5d)
	1064	END SELECT
	1065	CASE (flio_r4) !--- REAL 4
	1066	SELECT CASE (v_d_nb)
	1067	CASE (0) !--- Scalar
	1068	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
	1069	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
	1070	CASE (1) !--- 1d array
	1071	ALLOCATE(r4_1d(io_n(1)))
	1072	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
	1073	& start=io_i(:),count=io_n(:))
	1074	IF (l_o_f) THEN
	1075	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
	1076	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1077	& r4_1d(ib(1):ie(1)), &
	1078	& start=io_sf(:),count=io_cf(:))
	1079	ENDIF
	1080	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
	1081	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1082	& r4_1d(ib(1):ie(1)), &
	1083	& start=io_sm(:),count=io_cm(:))
	1084	IF (l_o_l) THEN
	1085	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
	1086	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1087	& r4_1d(ib(1):ie(1)), &
	1088	& start=io_sl(:),count=io_cl(:))
	1089	ENDIF
	1090	DEALLOCATE(r4_1d)
	1091	CASE (2) !--- 2d array
	1092	ALLOCATE(r4_2d(io_n(1),io_n(2)))
	1093	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
	1094	& start=io_i(:),count=io_n(:))
	1095	IF (l_o_f) THEN
	1096	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
	1097	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1098	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
	1099	& start=io_sf(:),count=io_cf(:))
	1100	ENDIF
	1101	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
	1102	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1103	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
	1104	& start=io_sm(:),count=io_cm(:))
	1105	IF (l_o_l) THEN
	1106	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
	1107	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1108	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
	1109	& start=io_sl(:),count=io_cl(:))
	1110	ENDIF
	1111	DEALLOCATE(r4_2d)
	1112	CASE (3) !--- 3d array
	1113	ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
	1114	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
	1115	& start=io_i(:),count=io_n(:))
	1116	IF (l_o_f) THEN
	1117	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
	1118	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1119	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1120	& start=io_sf(:),count=io_cf(:))
	1121	ENDIF
	1122	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
	1123	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1124	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1125	& start=io_sm(:),count=io_cm(:))
	1126	IF (l_o_l) THEN
	1127	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
	1128	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1129	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1130	& start=io_sl(:),count=io_cl(:))
	1131	ENDIF
	1132	DEALLOCATE(r4_3d)
	1133	CASE (4) !--- 4d array
	1134	ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
	1135	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
	1136	& start=io_i(:),count=io_n(:))
	1137	IF (l_o_f) THEN
	1138	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
	1139	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1140	& r4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1141	& start=io_sf(:),count=io_cf(:))
	1142	ENDIF
	1143	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
	1144	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1145	& r4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1146	& start=io_sm(:),count=io_cm(:))
	1147	IF (l_o_l) THEN
	1148	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
	1149	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1150	& r4_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1151	& start=io_sl(:),count=io_cl(:))
	1152	ENDIF
	1153	DEALLOCATE(r4_4d)
	1154	CASE (5) !--- 5d array
	1155	ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
	1156	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
	1157	& start=io_i(:),count=io_n(:))
	1158	IF (l_o_f) THEN
	1159	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
	1160	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1161	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1162	& ib(4):ie(4),ib(5):ie(5)), &
	1163	& start=io_sf(:),count=io_cf(:))
	1164	ENDIF
	1165	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
	1166	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1167	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1168	& ib(4):ie(4),ib(5):ie(5)), &
	1169	& start=io_sm(:),count=io_cm(:))
	1170	IF (l_o_l) THEN
	1171	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
	1172	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1173	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1174	& ib(4):ie(4),ib(5):ie(5)), &
	1175	& start=io_sl(:),count=io_cl(:))
	1176	ENDIF
	1177	DEALLOCATE(r4_5d)
	1178	END SELECT
	1179	CASE (flio_r8) !--- REAL 8
	1180	SELECT CASE (v_d_nb)
	1181	CASE (0) !--- Scalar
	1182	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
	1183	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
	1184	CASE (1) !--- 1d array
	1185	ALLOCATE(r8_1d(io_n(1)))
	1186	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
	1187	& start=io_i(:),count=io_n(:))
	1188	IF (l_o_f) THEN
	1189	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
	1190	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1191	& r8_1d(ib(1):ie(1)), &
	1192	& start=io_sf(:),count=io_cf(:))
	1193	ENDIF
	1194	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
	1195	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1196	& r8_1d(ib(1):ie(1)), &
	1197	& start=io_sm(:),count=io_cm(:))
	1198	IF (l_o_l) THEN
	1199	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
	1200	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1201	& r8_1d(ib(1):ie(1)), &
	1202	& start=io_sl(:),count=io_cl(:))
	1203	ENDIF
	1204	DEALLOCATE(r8_1d)
	1205	CASE (2) !--- 2d array
	1206	ALLOCATE(r8_2d(io_n(1),io_n(2)))
	1207	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
	1208	& start=io_i(:),count=io_n(:))
	1209	IF (l_o_f) THEN
	1210	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
	1211	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1212	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
	1213	& start=io_sf(:),count=io_cf(:))
	1214	ENDIF
	1215	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
	1216	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1217	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
	1218	& start=io_sm(:),count=io_cm(:))
	1219	IF (l_o_l) THEN
	1220	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
	1221	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1222	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
	1223	& start=io_sl(:),count=io_cl(:))
	1224	ENDIF
	1225	DEALLOCATE(r8_2d)
	1226	CASE (3) !--- 3d array
	1227	ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
	1228	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
	1229	& start=io_i(:),count=io_n(:))
	1230	IF (l_o_f) THEN
	1231	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
	1232	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1233	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1234	& start=io_sf(:),count=io_cf(:))
	1235	ENDIF
	1236	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
	1237	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1238	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1239	& start=io_sm(:),count=io_cm(:))
	1240	IF (l_o_l) THEN
	1241	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
	1242	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1243	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
	1244	& start=io_sl(:),count=io_cl(:))
	1245	ENDIF
	1246	DEALLOCATE(r8_3d)
	1247	CASE (4) !--- 4d array
	1248	ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
	1249	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
	1250	& start=io_i(:),count=io_n(:))
	1251	IF (l_o_f) THEN
	1252	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
	1253	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1254	& r8_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1255	& start=io_sf(:),count=io_cf(:))
	1256	ENDIF
	1257	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
	1258	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1259	& r8_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1260	& start=io_sm(:),count=io_cm(:))
	1261	IF (l_o_l) THEN
	1262	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
	1263	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1264	& r8_4d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3),ib(4):ie(4)), &
	1265	& start=io_sl(:),count=io_cl(:))
	1266	ENDIF
	1267	DEALLOCATE(r8_4d)
	1268	CASE (5) !--- 5d array
	1269	ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
	1270	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
	1271	& start=io_i(:),count=io_n(:))
	1272	IF (l_o_f) THEN
	1273	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
	1274	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1275	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1276	& ib(4):ie(4),ib(5):ie(5)), &
	1277	& start=io_sf(:),count=io_cf(:))
	1278	ENDIF
	1279	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
	1280	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1281	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1282	& ib(4):ie(4),ib(5):ie(5)), &
	1283	& start=io_sm(:),count=io_cm(:))
	1284	IF (l_o_l) THEN
	1285	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
	1286	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
	1287	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
	1288	& ib(4):ie(4),ib(5):ie(5)), &
	1289	& start=io_sl(:),count=io_cl(:))
	1290	ENDIF
	1291	DEALLOCATE(r8_5d)
	1292	END SELECT
	1293	END SELECT
	1294	!----
	1295	IF (l_cgd) THEN
	1296	!------ Close each file containing a small piece of data
	1297	!xxxxxxx
	1298	!xxxxxxx CALL flioclo(f_id_i)
	1299	!xxxxxxx
	1300	ENDIF
	1301	ENDDO
	1302	!---
	1303	!-- If needed, deallocate io_* arrays
	1304	IF (v_d_nb > 0) THEN
	1305	DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
	1306	IF (TRIM(c_d_n) == "apple") THEN
	1307	DEALLOCATE(ia_sf,io_sf,io_cf)
	1308	DEALLOCATE(ia_sl,io_sl,io_cl)
	1309	ENDIF
	1310	ENDIF
	1311	ENDDO
	1312	!-
	1313	!-------------------
	1314	! Ending the work
	1315	!-------------------
	1316	!-
	1317	! Close files
	1318	!xxxxxxx
	1319	!xxxxxxx CALL flioclo (f_id_i1)
	1320	!xxxxxxx CALL flioclo (f_id_o)
	1321	CALL flioclo ()
	1322	!xxxxxxx
	1323	!-
	1324	! Deallocate
	1325	DEALLOCATE(f_nm)
	1326	DEALLOCATE(f_a_id)
	1327	DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
	1328	DEALLOCATE(f_d_i,f_d_l)
	1329	DEALLOCATE(d_d_i,d_s_g)
	1330	DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
	1331	!-
	1332	IF (TRIM(c_w_mode) == 'verbose') THEN
	1333	!-- elapsed and cpu time computation
	1334	CALL cpu_time (t_cpu_end)
	1335	CALL system_clock(count=nb_cc_end)
	1336	WRITE (UNIT=*,FMT='("")')
	1337	WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
	1338	& REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
	1339	WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
	1340	& t_cpu_end-t_cpu_ini
	1341	ENDIF
	1342	!--------------------
	1343	END PROGRAM flio_rbld

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

Download in other formats:

Original Format