Context Navigation

getincom.f90 @ 6851

Last change on this file since 6851 was 6619, checked in by jgipsl, 10 months ago

Correction needed for nvida compilers : ERR and IOSTAT can not be used at the same time. No change in the functioning of the subroutine.
New arch for compilation with nvida on MESO-IPSL cluster (spirit,spiritx,hal).

Done by Kazem Ardaneh

Property svn:keywords set to Id

File size: 67.2 KB

Line
1	MODULE getincom
2	!-
3	!$Id$
4	!-
5	! This software is governed by the CeCILL license
6	! See IOIPSL/IOIPSL_License_CeCILL.txt
7	!---------------------------------------------------------------------
8	USE errioipsl, ONLY : ipslerr,ipsldbg,ipslout
9	USE stringop, &
10	& ONLY : nocomma,cmpblank,strlowercase,nocomment, COMMENT_TAG
11	!-
12	IMPLICIT NONE
13	!-
14	PRIVATE
15	PUBLIC :: getin_name, getin, getin_dump, getin_dump_para
16	!-
17	!!--------------------------------------------------------------------
18	!! The "getin_name" routine allows the user to change the name
19	!! of the definition file in which the data will be read.
20	!! ("run.def" by default)
21	!!
22	!! SUBROUTINE getin_name (file_name)
23	!!
24	!! OPTIONAL INPUT argument
25	!!
26	!! (C) file_name : the name of the file
27	!! in which the data will be read
28	!!--------------------------------------------------------------------
29	!-
30	!-
31	INTERFACE getin
32	!!--------------------------------------------------------------------
33	!! The "getin" routines get a variable.
34	!! We first check if we find it in the database
35	!! and if not we get it from the definition file.
36	!!
37	!! SUBROUTINE getin (targetname,ret_val)
38	!!
39	!! INPUT
40	!!
41	!! (C) targetname : Name of the variable
42	!!
43	!! OUTPUT
44	!!
45	!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
46	!! that will contain the (standard)
47	!! integer/real/character/logical values
48	!!--------------------------------------------------------------------
49	MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
50	& getinis, getini1d, getini2d, &
51	& getincs, getinc1d, getinc2d, &
52	& getinls, getinl1d, getinl2d
53	END INTERFACE
54	!-
55	!!--------------------------------------------------------------------
56	!! The "getin_dump" routine will dump the content of the database
57	!! into a file which has the same format as the definition file.
58	!! The idea is that the user can see which parameters were used
59	!! and re-use the file for another run.
60	!!
61	!! SUBROUTINE getin_dump (fileprefix)
62	!!
63	!! OPTIONAL INPUT argument
64	!!
65	!! (C) fileprefix : allows the user to change the name of the file
66	!! in which the data will be archived
67	!!--------------------------------------------------------------------
68	!-
69	!!------------------------------------------------------------------------
70	!! Parallel version of getin_dump : user must give a fileprefix and a rank.
71	!! It may be usefull to verify that only the root proc is reading the input
72	!! def files.
73	!!
74	!! SUBROUTINE getin_dump_para (fileprefix,rank)
75	!!
76	!! INPUT argument
77	!!
78	!! (C) fileprefix : allows the user to change the name of the file
79	!! in which the data will be archived
80	!! (I) rank : the rank of the parallel process (only 0-999 files will be created)
81	!!--------------------------------------------------------------------
82	!-
83	INTEGER,PARAMETER :: max_files=100
84	CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
85	INTEGER,SAVE :: nbfiles
86	!-
87	INTEGER,SAVE :: allread=0
88	CHARACTER(LEN=100),SAVE :: def_file = 'run.def'
89	!-
90	INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
91	INTEGER,SAVE :: nb_lines,i_txtsize=0
92	CHARACTER(LEN=255),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
93	CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
94	INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
95	!-
96	INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=30
97	CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
98	!-
99	! The data base of parameters
100	!-
101	INTEGER,PARAMETER :: memslabs=300
102	INTEGER,PARAMETER :: compress_lim=20
103	!-
104	INTEGER,SAVE :: nb_keys=0
105	INTEGER,SAVE :: keymemsize=0
106	!-
107	! keystr definition
108	! name of a key
109	!-
110	! keystatus definition
111	! keystatus = 1 : Value comes from the file defined by 'def_file'
112	! keystatus = 2 : Default value is used
113	! keystatus = 3 : Some vector elements were taken from default
114	INTEGER,PARAMETER :: nondefault=1, default=2, vectornondefault=3
115	!-
116	! keytype definition
117	! keytype = 1 : Integer
118	! keytype = 2 : Real
119	! keytype = 3 : Character
120	! keytype = 4 : Logical
121	!-
122	INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
123	!-
124	! Allow compression for keys (only for integer and real)
125	! keycompress < 0 : not compressed
126	! keycompress > 0 : number of repeat of the value
127	!-
128	TYPE :: t_key
129	CHARACTER(LEN=l_n) :: keystr
130	INTEGER :: keystatus, keytype, keycompress, &
131	& keyfromfile, keymemstart, keymemlen
132	END TYPE t_key
133	!-
134	TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
135	!-
136	INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
137	INTEGER,SAVE :: i_memsize=0, i_mempos=0
138	REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
139	INTEGER,SAVE :: r_memsize=0, r_mempos=0
140	CHARACTER(LEN=300),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
141	INTEGER,SAVE :: c_memsize=0, c_mempos=0
142	LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
143	INTEGER,SAVE :: l_memsize=0, l_mempos=0
144	!-
145	CONTAINS
146	!-
147	!=== DEFINITION FILE NAME INTERFACE
148	!-
149	SUBROUTINE getin_name (cname)
150	!---------------------------------------------------------------------
151	IMPLICIT NONE
152	!-
153	CHARACTER(LEN=*) :: cname
154	!---------------------------------------------------------------------
155	IF (allread == 0) THEN
156	def_file = ADJUSTL(cname)
157	ELSE
158	CALL ipslerr (3,'getin_name', &
159	& 'The name of the database file (any_name.def)', &
160	& 'must be changed before any attempt','to read the database.')
161	ENDIF
162	!------------------------
163	END SUBROUTINE getin_name
164	!-
165	!=== INTEGER INTERFACE
166	!-
167	SUBROUTINE getinis (targetname,ret_val)
168	!---------------------------------------------------------------------
169	IMPLICIT NONE
170	!-
171	CHARACTER(LEN=*) :: targetname
172	INTEGER :: ret_val
173	!-
174	INTEGER,DIMENSION(1) :: tmp_ret_val
175	INTEGER :: pos,status=0,fileorig, size_of_in
176	!---------------------------------------------------------------------
177	!-
178	! Do we have this targetname in our database ?
179	!-
180	CALL get_findkey (1,targetname,pos)
181	!-
182	tmp_ret_val(1) = ret_val
183	size_of_in = SIZE(tmp_ret_val)
184
185	!-
186	IF (pos < 0) THEN
187	!-- Get the information out of the file
188	CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
189	!-- Put the data into the database
190	CALL get_wdb &
191	& (targetname,status,fileorig,1,i_val=tmp_ret_val)
192	ELSE
193	!-- Get the value out of the database
194	CALL get_rdb (pos,1,targetname,i_val=tmp_ret_val)
195	ENDIF
196	ret_val = tmp_ret_val(1)
197	!---------------------
198	END SUBROUTINE getinis
199	!===
200	SUBROUTINE getini1d (targetname,ret_val)
201	!---------------------------------------------------------------------
202	IMPLICIT NONE
203	!-
204	CHARACTER(LEN=*) :: targetname
205	INTEGER,DIMENSION(:) :: ret_val
206	!-
207	INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
208	INTEGER,SAVE :: tmp_ret_size = 0
209	INTEGER :: pos,size_of_in,status=0,fileorig
210	!---------------------------------------------------------------------
211	!-
212	! Do we have this targetname in our database ?
213	!-
214	CALL get_findkey (1,targetname,pos)
215	!-
216	size_of_in = SIZE(ret_val)
217	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
218	ALLOCATE (tmp_ret_val(size_of_in))
219	ELSE IF (size_of_in > tmp_ret_size) THEN
220	DEALLOCATE (tmp_ret_val)
221	ALLOCATE (tmp_ret_val(size_of_in))
222	tmp_ret_size = size_of_in
223	ENDIF
224	tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
225	!-
226	IF (pos < 0) THEN
227	!-- Get the information out of the file
228	CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
229	!-- Put the data into the database
230	CALL get_wdb &
231	& (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
232	ELSE
233	!-- Get the value out of the database
234	CALL get_rdb (pos,size_of_in,targetname,i_val=tmp_ret_val)
235	ENDIF
236	ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
237	!----------------------
238	END SUBROUTINE getini1d
239	!===
240	SUBROUTINE getini2d (targetname,ret_val)
241	!---------------------------------------------------------------------
242	IMPLICIT NONE
243	!-
244	CHARACTER(LEN=*) :: targetname
245	INTEGER,DIMENSION(:,:) :: ret_val
246	!-
247	INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
248	INTEGER,SAVE :: tmp_ret_size = 0
249	INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
250	INTEGER :: jl,jj,ji
251	!---------------------------------------------------------------------
252	!-
253	! Do we have this targetname in our database ?
254	!-
255	CALL get_findkey (1,targetname,pos)
256	!-
257	size_of_in = SIZE(ret_val)
258	size_1 = SIZE(ret_val,1)
259	size_2 = SIZE(ret_val,2)
260	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
261	ALLOCATE (tmp_ret_val(size_of_in))
262	ELSE IF (size_of_in > tmp_ret_size) THEN
263	DEALLOCATE (tmp_ret_val)
264	ALLOCATE (tmp_ret_val(size_of_in))
265	tmp_ret_size = size_of_in
266	ENDIF
267	!-
268	jl=0
269	DO jj=1,size_2
270	DO ji=1,size_1
271	jl=jl+1
272	tmp_ret_val(jl) = ret_val(ji,jj)
273	ENDDO
274	ENDDO
275	!-
276	IF (pos < 0) THEN
277	!-- Get the information out of the file
278	CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
279	!-- Put the data into the database
280	CALL get_wdb &
281	& (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val)
282	ELSE
283	!-- Get the value out of the database
284	CALL get_rdb (pos,size_of_in,targetname,i_val=tmp_ret_val)
285	ENDIF
286	!-
287	jl=0
288	DO jj=1,size_2
289	DO ji=1,size_1
290	jl=jl+1
291	ret_val(ji,jj) = tmp_ret_val(jl)
292	ENDDO
293	ENDDO
294	!----------------------
295	END SUBROUTINE getini2d
296	!-
297	!=== REAL INTERFACE
298	!-
299	SUBROUTINE getinrs (targetname,ret_val)
300	!---------------------------------------------------------------------
301	IMPLICIT NONE
302	!-
303	CHARACTER(LEN=*) :: targetname
304	REAL :: ret_val
305	!-
306	REAL,DIMENSION(1) :: tmp_ret_val
307	INTEGER :: pos,status=0,fileorig, size_of_in
308	!---------------------------------------------------------------------
309	!-
310	! Do we have this targetname in our database ?
311	!-
312	CALL get_findkey (1,targetname,pos)
313	!-
314	tmp_ret_val(1) = ret_val
315	size_of_in = SIZE(tmp_ret_val)
316	!-
317	IF (pos < 0) THEN
318	!-- Get the information out of the file
319	CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
320	!-- Put the data into the database
321	CALL get_wdb &
322	& (targetname,status,fileorig,1,r_val=tmp_ret_val)
323	ELSE
324	!-- Get the value out of the database
325	CALL get_rdb (pos,1,targetname,r_val=tmp_ret_val)
326	ENDIF
327	ret_val = tmp_ret_val(1)
328	!---------------------
329	END SUBROUTINE getinrs
330	!===
331	SUBROUTINE getinr1d (targetname,ret_val)
332	!---------------------------------------------------------------------
333	IMPLICIT NONE
334	!-
335	CHARACTER(LEN=*) :: targetname
336	REAL,DIMENSION(:) :: ret_val
337	!-
338	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
339	INTEGER,SAVE :: tmp_ret_size = 0
340	INTEGER :: pos,size_of_in,status=0,fileorig
341	!---------------------------------------------------------------------
342	!-
343	! Do we have this targetname in our database ?
344	!-
345	CALL get_findkey (1,targetname,pos)
346	!-
347	size_of_in = SIZE(ret_val)
348	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
349	ALLOCATE (tmp_ret_val(size_of_in))
350	ELSE IF (size_of_in > tmp_ret_size) THEN
351	DEALLOCATE (tmp_ret_val)
352	ALLOCATE (tmp_ret_val(size_of_in))
353	tmp_ret_size = size_of_in
354	ENDIF
355	tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
356	!-
357	IF (pos < 0) THEN
358	!-- Get the information out of the file
359	CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
360	!-- Put the data into the database
361	CALL get_wdb &
362	& (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
363	ELSE
364	!-- Get the value out of the database
365	CALL get_rdb (pos,size_of_in,targetname,r_val=tmp_ret_val)
366	ENDIF
367	ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
368	!----------------------
369
370	END SUBROUTINE getinr1d
371	!===
372	SUBROUTINE getinr2d (targetname,ret_val)
373	!---------------------------------------------------------------------
374	IMPLICIT NONE
375	!-
376	CHARACTER(LEN=*) :: targetname
377	REAL,DIMENSION(:,:) :: ret_val
378	!-
379	REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
380	INTEGER,SAVE :: tmp_ret_size = 0
381	INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
382	INTEGER :: jl,jj,ji
383	!---------------------------------------------------------------------
384	!-
385	! Do we have this targetname in our database ?
386	!-
387	CALL get_findkey (1,targetname,pos)
388	!-
389	size_of_in = SIZE(ret_val)
390	size_1 = SIZE(ret_val,1)
391	size_2 = SIZE(ret_val,2)
392	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
393	ALLOCATE (tmp_ret_val(size_of_in))
394	ELSE IF (size_of_in > tmp_ret_size) THEN
395	DEALLOCATE (tmp_ret_val)
396	ALLOCATE (tmp_ret_val(size_of_in))
397	tmp_ret_size = size_of_in
398	ENDIF
399	!-
400	jl=0
401	DO jj=1,size_2
402	DO ji=1,size_1
403	jl=jl+1
404	tmp_ret_val(jl) = ret_val(ji,jj)
405	ENDDO
406	ENDDO
407	!-
408	IF (pos < 0) THEN
409	!-- Get the information out of the file
410	CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
411	!-- Put the data into the database
412	CALL get_wdb &
413	& (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val)
414	ELSE
415	!-- Get the value out of the database
416	CALL get_rdb (pos,size_of_in,targetname,r_val=tmp_ret_val)
417	ENDIF
418	!-
419	jl=0
420	DO jj=1,size_2
421	DO ji=1,size_1
422	jl=jl+1
423	ret_val(ji,jj) = tmp_ret_val(jl)
424	ENDDO
425	ENDDO
426	!----------------------
427	END SUBROUTINE getinr2d
428	!-
429	!=== CHARACTER INTERFACE
430	!-
431	SUBROUTINE getincs (targetname,ret_val)
432	!---------------------------------------------------------------------
433	IMPLICIT NONE
434	!-
435	CHARACTER(LEN=*) :: targetname
436	CHARACTER(LEN=*) :: ret_val
437	!-
438	CHARACTER(LEN=:),ALLOCATABLE,DIMENSION(:) :: tmp_ret_val
439	INTEGER :: pos,status=0,fileorig,size_of_in,ier
440	!---------------------------------------------------------------------
441	!-
442	ALLOCATE(CHARACTER(LEN(ret_val)) :: tmp_ret_val(1), stat=ier)
443	IF (ier /= 0) CALL ipslerr(3, 'getincs', 'Allocation memory problem for', &
444	'tmp_ret_val' ,'')
445	!-
446	! Do we have this targetname in our database ?
447	!-
448	CALL get_findkey (1,targetname,pos)
449	!-
450	tmp_ret_val(1) = ret_val
451	size_of_in = SIZE(tmp_ret_val)
452	!-
453	IF (pos < 0) THEN
454	!-- Get the information out of the file
455	CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
456	!-- Put the data into the database
457	CALL get_wdb &
458	& (targetname,status,fileorig,1,c_val=tmp_ret_val)
459	ELSE
460	!-- Get the value out of the database
461	CALL get_rdb (pos,1,targetname,c_val=tmp_ret_val)
462	ENDIF
463	ret_val = tmp_ret_val(1)
464	!--
465	DEALLOCATE(tmp_ret_val)
466	!---------------------
467	END SUBROUTINE getincs
468	!===
469	SUBROUTINE getinc1d (targetname,ret_val)
470	!---------------------------------------------------------------------
471	IMPLICIT NONE
472	!-
473	CHARACTER(LEN=*) :: targetname
474	CHARACTER(LEN=*),DIMENSION(:) :: ret_val
475	!-
476	CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
477	INTEGER,SAVE :: tmp_ret_size = 0
478	INTEGER :: pos,size_of_in,status=0,fileorig
479	!---------------------------------------------------------------------
480	!-
481	! Do we have this targetname in our database ?
482	!-
483	CALL get_findkey (1,targetname,pos)
484	!-
485	size_of_in = SIZE(ret_val)
486	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
487	ALLOCATE (tmp_ret_val(size_of_in))
488	ELSE IF (size_of_in > tmp_ret_size) THEN
489	DEALLOCATE (tmp_ret_val)
490	ALLOCATE (tmp_ret_val(size_of_in))
491	tmp_ret_size = size_of_in
492	ENDIF
493	tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
494	!-
495	IF (pos < 0) THEN
496	!-- Get the information out of the file
497	CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
498	!-- Put the data into the database
499	CALL get_wdb &
500	& (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
501	ELSE
502	!-- Get the value out of the database
503	CALL get_rdb (pos,size_of_in,targetname,c_val=tmp_ret_val)
504	ENDIF
505	ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
506	!----------------------
507	END SUBROUTINE getinc1d
508	!===
509	SUBROUTINE getinc2d (targetname,ret_val)
510	!---------------------------------------------------------------------
511	IMPLICIT NONE
512	!-
513	CHARACTER(LEN=*) :: targetname
514	CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
515	!-
516	CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
517	INTEGER,SAVE :: tmp_ret_size = 0
518	INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
519	INTEGER :: jl,jj,ji
520	!---------------------------------------------------------------------
521	!-
522	! Do we have this targetname in our database ?
523	!-
524	CALL get_findkey (1,targetname,pos)
525	!-
526	size_of_in = SIZE(ret_val)
527	size_1 = SIZE(ret_val,1)
528	size_2 = SIZE(ret_val,2)
529	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
530	ALLOCATE (tmp_ret_val(size_of_in))
531	ELSE IF (size_of_in > tmp_ret_size) THEN
532	DEALLOCATE (tmp_ret_val)
533	ALLOCATE (tmp_ret_val(size_of_in))
534	tmp_ret_size = size_of_in
535	ENDIF
536	!-
537	jl=0
538	DO jj=1,size_2
539	DO ji=1,size_1
540	jl=jl+1
541	tmp_ret_val(jl) = ret_val(ji,jj)
542	ENDDO
543	ENDDO
544	!-
545	IF (pos < 0) THEN
546	!-- Get the information out of the file
547	CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
548	!-- Put the data into the database
549	CALL get_wdb &
550	& (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val)
551	ELSE
552	!-- Get the value out of the database
553	CALL get_rdb (pos,size_of_in,targetname,c_val=tmp_ret_val)
554	ENDIF
555	!-
556	jl=0
557	DO jj=1,size_2
558	DO ji=1,size_1
559	jl=jl+1
560	ret_val(ji,jj) = tmp_ret_val(jl)
561	ENDDO
562	ENDDO
563	!----------------------
564	END SUBROUTINE getinc2d
565	!-
566	!=== LOGICAL INTERFACE
567	!-
568	SUBROUTINE getinls (targetname,ret_val)
569	!---------------------------------------------------------------------
570	IMPLICIT NONE
571	!-
572	CHARACTER(LEN=*) :: targetname
573	LOGICAL :: ret_val
574	!-
575	LOGICAL,DIMENSION(1) :: tmp_ret_val
576	INTEGER :: pos,status=0,fileorig,size_of_in
577	!---------------------------------------------------------------------
578	!-
579	! Do we have this targetname in our database ?
580	!-
581	CALL get_findkey (1,targetname,pos)
582	!-
583	tmp_ret_val(1) = ret_val
584	size_of_in = SIZE(tmp_ret_val)
585	!-
586	IF (pos < 0) THEN
587	!-- Get the information out of the file
588	CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
589	!-- Put the data into the database
590	CALL get_wdb &
591	& (targetname,status,fileorig,1,l_val=tmp_ret_val)
592	ELSE
593	!-- Get the value out of the database
594	CALL get_rdb (pos,1,targetname,l_val=tmp_ret_val)
595	ENDIF
596	ret_val = tmp_ret_val(1)
597	!---------------------
598	END SUBROUTINE getinls
599	!===
600	SUBROUTINE getinl1d (targetname,ret_val)
601	!---------------------------------------------------------------------
602	IMPLICIT NONE
603	!-
604	CHARACTER(LEN=*) :: targetname
605	LOGICAL,DIMENSION(:) :: ret_val
606	!-
607	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
608	INTEGER,SAVE :: tmp_ret_size = 0
609	INTEGER :: pos,size_of_in,status=0,fileorig
610	!---------------------------------------------------------------------
611	!-
612	! Do we have this targetname in our database ?
613	!-
614	CALL get_findkey (1,targetname,pos)
615	!-
616	size_of_in = SIZE(ret_val)
617	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
618	ALLOCATE (tmp_ret_val(size_of_in))
619	ELSE IF (size_of_in > tmp_ret_size) THEN
620	DEALLOCATE (tmp_ret_val)
621	ALLOCATE (tmp_ret_val(size_of_in))
622	tmp_ret_size = size_of_in
623	ENDIF
624	tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
625	!-
626	IF (pos < 0) THEN
627	!-- Get the information out of the file
628	CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
629	!-- Put the data into the database
630	CALL get_wdb &
631	& (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
632	ELSE
633	!-- Get the value out of the database
634	CALL get_rdb (pos,size_of_in,targetname,l_val=tmp_ret_val)
635	ENDIF
636	ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
637	!----------------------
638	END SUBROUTINE getinl1d
639	!===
640	SUBROUTINE getinl2d (targetname,ret_val)
641	!---------------------------------------------------------------------
642	IMPLICIT NONE
643	!-
644	CHARACTER(LEN=*) :: targetname
645	LOGICAL,DIMENSION(:,:) :: ret_val
646	!-
647	LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
648	INTEGER,SAVE :: tmp_ret_size = 0
649	INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
650	INTEGER :: jl,jj,ji
651	!---------------------------------------------------------------------
652	!-
653	! Do we have this targetname in our database ?
654	!-
655	CALL get_findkey (1,targetname,pos)
656	!-
657	size_of_in = SIZE(ret_val)
658	size_1 = SIZE(ret_val,1)
659	size_2 = SIZE(ret_val,2)
660	IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
661	ALLOCATE (tmp_ret_val(size_of_in))
662	ELSE IF (size_of_in > tmp_ret_size) THEN
663	DEALLOCATE (tmp_ret_val)
664	ALLOCATE (tmp_ret_val(size_of_in))
665	tmp_ret_size = size_of_in
666	ENDIF
667	!-
668	jl=0
669	DO jj=1,size_2
670	DO ji=1,size_1
671	jl=jl+1
672	tmp_ret_val(jl) = ret_val(ji,jj)
673	ENDDO
674	ENDDO
675	!-
676	IF (pos < 0) THEN
677	!-- Get the information out of the file
678	CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
679	!-- Put the data into the database
680	CALL get_wdb &
681	& (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val)
682	ELSE
683	!-- Get the value out of the database
684	CALL get_rdb (pos,size_of_in,targetname,l_val=tmp_ret_val)
685	ENDIF
686	!-
687	jl=0
688	DO jj=1,size_2
689	DO ji=1,size_1
690	jl=jl+1
691	ret_val(ji,jj) = tmp_ret_val(jl)
692	ENDDO
693	ENDDO
694	!----------------------
695	END SUBROUTINE getinl2d
696	!-
697	!=== Generic file/database INTERFACE
698	!-
699	SUBROUTINE get_fil (targetname,status,fileorig,nb_to_ret,i_val,r_val,c_val,l_val)
700	!---------------------------------------------------------------------
701	!- Subroutine that will extract from the file the values
702	!- attributed to the keyword targetname
703	!-
704	!- (C) targetname : target for which we will look in the file
705	!- (I) status : tells us from where we obtained the data
706	!- (I) fileorig : index of the file from which the key comes
707	!- (I) nb_to_ret : size of output vector
708	!- (I) i_val(:) : INTEGER(nb_to_ret) values
709	!- (R) r_val(:) : REAL(nb_to_ret) values
710	!- (L) l_val(:) : LOGICAL(nb_to_ret) values
711	!- (C) c_val(:) : CHARACTER(nb_to_ret) values
712	!---------------------------------------------------------------------
713	IMPLICIT NONE
714	!-
715	CHARACTER(LEN=*) :: targetname
716	INTEGER,INTENT(IN) :: nb_to_ret
717	INTEGER,INTENT(OUT) :: status,fileorig
718	INTEGER,DIMENSION(:),OPTIONAL :: i_val
719	REAL,DIMENSION(:),OPTIONAL :: r_val
720	LOGICAL,DIMENSION(:),OPTIONAL :: l_val
721	CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
722	!-
723	INTEGER :: k_typ,it,pos,len_str,status_cnt,io_err
724	CHARACTER(LEN=n_d_fmt) :: cnt
725	CHARACTER(LEN=:), ALLOCATABLE :: str_READ,str_READ_lower
726	CHARACTER(LEN=9) :: c_vtyp
727	LOGICAL,DIMENSION(:),ALLOCATABLE :: found
728	LOGICAL :: def_beha,compressed
729	CHARACTER(LEN=10) :: c_fmt
730	INTEGER :: i_cmpval
731	REAL :: r_cmpval
732	INTEGER :: ipos_tr,ipos_fl
733	LOGICAL :: l_dbg
734	!---------------------------------------------------------------------
735	CALL ipsldbg (old_status=l_dbg)
736	!---------------------------------------------------------------------
737	!-
738	! Get the type of the argument
739	CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
740	IF ( (k_typ.NE.k_i) .AND. (k_typ.NE.k_r) .AND. (k_typ.NE.k_c) .AND. (k_typ.NE.k_l) ) THEN
741	CALL ipslerr (3,'get_fil', &
742	& 'Internal error','Unknown type of data',' ')
743	ENDIF
744	!-
745	! Read the file(s)
746	CALL getin_read
747	!-
748	! Allocate and initialize the memory we need
749	ALLOCATE(found(nb_to_ret))
750	found(:) = .FALSE.
751	!-
752	! See what we find in the files read
753	!---
754	!-- We dont know from which file the target could come.
755	!-- Thus by default we attribute it to the first file :
756	fileorig = 1
757	!-
758	DO it=1,nb_to_ret
759	!---
760	!-- First try the target as it is
761	CALL get_findkey (2,targetname,pos)
762	!---
763	!-- Another try
764	!---
765	IF (pos < 0) THEN
766	WRITE(UNIT=cnt,FMT=c_i_fmt) it
767	CALL get_findkey (2,TRIM(targetname)//'__'//cnt,pos)
768	ENDIF
769	!---
770	IF (pos > 0) THEN
771	!-----
772	found(it) = .TRUE.
773	fileorig = fromfile(pos)
774	!
775	IF (l_dbg) THEN
776	WRITE(,) &
777	& 'getin_fil : read key ',targetname,' from file ',fileorig,' has type ',k_typ
778	ENDIF
779	!-----
780	!---- DECODE
781	!-----
782	str_READ = ADJUSTL(fichier(pos))
783	str_READ_lower = str_READ
784	CALL strlowercase (str_READ_lower)
785	IF (l_dbg) THEN
786	WRITE(,) &
787	& ' value ',str_READ_lower
788	ENDIF
789	!-----
790	IF ( (TRIM(str_READ_lower) == 'def') &
791	& .OR.(TRIM(str_READ_lower) == 'default') ) THEN
792	def_beha = .TRUE.
793	ELSE
794	def_beha = .FALSE.
795	len_str = LEN_TRIM(str_READ)
796	io_err = 0
797	SELECT CASE (k_typ)
798	CASE(k_i)
799	WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
800	READ (UNIT=str_READ(1:len_str), &
801	& FMT=c_fmt,IOSTAT=io_err) i_val(it)
802	CASE(k_r)
803	READ (UNIT=str_READ(1:len_str), &
804	& FMT=*,IOSTAT=io_err) r_val(it)
805	CASE(k_c)
806	c_val(it) = str_READ(1:len_str)
807	CASE(k_l)
808	ipos_tr = -1
809	ipos_fl = -1
810	ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
811	& INDEX(str_READ_lower,'y'))
812	ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
813	& INDEX(str_READ_lower,'n'))
814	IF (ipos_tr > 0) THEN
815	l_val(it) = .TRUE.
816	ELSE IF (ipos_fl > 0) THEN
817	l_val(it) = .FALSE.
818	ELSE
819	io_err = 100
820	ENDIF
821	END SELECT
822	IF (io_err /= 0) THEN
823	CALL ipslerr (3,'get_fil', &
824	& 'Target '//TRIM(targetname), &
825	& 'is not of '//TRIM(c_vtyp)//' type',' ')
826	ENDIF
827	ENDIF
828	!-----
829	IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
830	!-------
831	!------ Is this the value of a compressed field ?
832	compressed = (compline(pos) > 0)
833	IF (compressed) THEN
834	IF (compline(pos) /= nb_to_ret) THEN
835	CALL ipslerr (2,'get_fil', &
836	& 'For key '//TRIM(targetname)//' we have a compressed field', &
837	& 'which does not have the right size.', &
838	& 'We will try to fix that.')
839	ENDIF
840	IF (k_typ == k_i) THEN
841	i_cmpval = i_val(it)
842	ELSE IF (k_typ == k_r) THEN
843	r_cmpval = r_val(it)
844	ENDIF
845	ENDIF
846	ENDIF
847	ELSE
848	found(it) = .FALSE.
849	def_beha = .FALSE.
850	compressed = .FALSE.
851	ENDIF
852	ENDDO
853	!-
854	IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
855	!---
856	!-- If this is a compressed field then we will uncompress it
857	IF (compressed) THEN
858	DO it=1,nb_to_ret
859	IF (.NOT.found(it)) THEN
860	IF (k_typ == k_i) THEN
861	i_val(it) = i_cmpval
862	ELSE IF (k_typ == k_r) THEN
863	r_val(it) = r_cmpval
864	ENDIF
865	found(it) = .TRUE.
866	ENDIF
867	ENDDO
868	ENDIF
869	ENDIF
870	!-
871	! Now we set the status for what we found
872	IF (def_beha) THEN
873	status = default
874	CALL ipslerr (1,'USING DEFAULT BEHAVIOUR FOR', &
875	& TRIM(targetname),' ',' ')
876	WRITE(ipslout,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(targetname)
877	ELSE
878	status_cnt = 0
879	DO it=1,nb_to_ret
880	IF (.NOT.found(it)) THEN
881	status_cnt = status_cnt+1
882	IF (status_cnt <= max_msgs) THEN
883	WRITE (UNIT=ipslout,FMT='(" USING DEFAULTS : ",A)', &
884	& ADVANCE='NO') TRIM(targetname)
885	IF (nb_to_ret > 1) THEN
886	WRITE (UNIT=ipslout,FMT='("__")',ADVANCE='NO')
887	WRITE (UNIT=ipslout,FMT=c_i_fmt,ADVANCE='NO') it
888	ENDIF
889	SELECT CASE (k_typ)
890	CASE(k_i)
891	WRITE (UNIT=ipslout,FMT=*) "=",i_val(it)
892	CASE(k_r)
893	WRITE (UNIT=ipslout,FMT=*) "=",r_val(it)
894	CASE(k_c)
895	WRITE (UNIT=ipslout,FMT=*) "=",c_val(it)
896	CASE(k_l)
897	WRITE (UNIT=ipslout,FMT=*) "=",l_val(it)
898	END SELECT
899	ELSE IF (status_cnt == max_msgs+1) THEN
900	WRITE (UNIT=ipslout,FMT='(" USING DEFAULTS ... ",A)')
901	ENDIF
902	ENDIF
903	ENDDO
904	!---
905	IF (status_cnt == 0) THEN
906	status = nondefault
907	ELSE IF (status_cnt == nb_to_ret) THEN
908	status = default
909	ELSE
910	status = vectornondefault
911	ENDIF
912	ENDIF
913	! Deallocate the memory
914	DEALLOCATE(found)
915	!---------------------
916	END SUBROUTINE get_fil
917	!===
918	SUBROUTINE get_rdb (pos,size_of_in,targetname,i_val,r_val,c_val,l_val)
919	!---------------------------------------------------------------------
920	!- Read the required variable in the database
921	!---------------------------------------------------------------------
922	IMPLICIT NONE
923	!-
924	INTEGER :: pos,size_of_in
925	CHARACTER(LEN=*) :: targetname
926	INTEGER,DIMENSION(:),OPTIONAL :: i_val
927	REAL,DIMENSION(:),OPTIONAL :: r_val
928	LOGICAL,DIMENSION(:),OPTIONAL :: l_val
929	CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
930	!-
931	INTEGER :: k_typ,k_beg,k_end
932	CHARACTER(LEN=9) :: c_vtyp
933	!---------------------------------------------------------------------
934	!-
935	! Get the type of the argument
936	CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
937	IF ( (k_typ /= k_i).AND.(k_typ /= k_r) &
938	& .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
939	CALL ipslerr (3,'get_rdb', &
940	& 'Internal error','Unknown type of data',' ')
941	ENDIF
942	!-
943	IF (key_tab(pos)%keytype /= k_typ) THEN
944	CALL ipslerr (3,'get_rdb', &
945	& 'Wrong data type for keyword '//TRIM(targetname), &
946	& '(NOT '//TRIM(c_vtyp)//')',' ')
947	ENDIF
948	!-
949	IF (key_tab(pos)%keycompress > 0) THEN
950	IF ( (key_tab(pos)%keycompress /= size_of_in) &
951	& .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
952	CALL ipslerr (3,'get_rdb', &
953	& 'Wrong compression length','for keyword '//TRIM(targetname),' ')
954	ELSE
955	SELECT CASE (k_typ)
956	CASE(k_i)
957	i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
958	CASE(k_r)
959	r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
960	END SELECT
961	ENDIF
962	ELSE
963	IF (key_tab(pos)%keymemlen /= size_of_in) THEN
964	CALL ipslerr (3,'get_rdb', &
965	& 'Wrong array length','for keyword '//TRIM(targetname),' ')
966	ELSE
967	k_beg = key_tab(pos)%keymemstart
968	k_end = k_beg+key_tab(pos)%keymemlen-1
969	SELECT CASE (k_typ)
970	CASE(k_i)
971	i_val(1:size_of_in) = i_mem(k_beg:k_end)
972	CASE(k_r)
973	r_val(1:size_of_in) = r_mem(k_beg:k_end)
974	CASE(k_c)
975	c_val(1:size_of_in) = c_mem(k_beg:k_end)
976	CASE(k_l)
977	l_val(1:size_of_in) = l_mem(k_beg:k_end)
978	END SELECT
979	ENDIF
980	ENDIF
981	!---------------------
982	END SUBROUTINE get_rdb
983	!===
984	SUBROUTINE get_wdb &
985	& (targetname,status,fileorig,size_of_in, &
986	& i_val,r_val,c_val,l_val)
987	!---------------------------------------------------------------------
988	!- Write data into the data base
989	!---------------------------------------------------------------------
990	IMPLICIT NONE
991	!-
992	CHARACTER(LEN=*) :: targetname
993	INTEGER :: status,fileorig,size_of_in
994	INTEGER,DIMENSION(:),OPTIONAL :: i_val
995	REAL,DIMENSION(:),OPTIONAL :: r_val
996	LOGICAL,DIMENSION(:),OPTIONAL :: l_val
997	CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
998	!-
999	INTEGER :: k_typ
1000	CHARACTER(LEN=9) :: c_vtyp
1001	INTEGER :: k_mempos,k_memsize,k_beg,k_end
1002	LOGICAL :: l_cmp
1003	LOGICAL :: l_dbg
1004	!---------------------------------------------------------------------
1005	CALL ipsldbg (old_status=l_dbg)
1006	!---------------------------------------------------------------------
1007	!-
1008	! Get the type of the argument
1009	CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
1010	IF ( (k_typ /= k_i).AND.(k_typ /= k_r) &
1011	& .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
1012	CALL ipslerr (3,'get_wdb', &
1013	& 'Internal error','Unknown type of data',' ')
1014	ENDIF
1015	!-
1016	! First check if we have sufficiant space for the new key
1017	IF (nb_keys+1 > keymemsize) THEN
1018	CALL getin_allockeys ()
1019	ENDIF
1020	!-
1021	SELECT CASE (k_typ)
1022	CASE(k_i)
1023	k_mempos = i_mempos; k_memsize = i_memsize;
1024	l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
1025	& .AND.(size_of_in > compress_lim)
1026	CASE(k_r)
1027	k_mempos = r_mempos; k_memsize = r_memsize;
1028	l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
1029	& .AND.(size_of_in > compress_lim)
1030	CASE(k_c)
1031	k_mempos = c_mempos; k_memsize = c_memsize;
1032	l_cmp = .FALSE.
1033	CASE(k_l)
1034	k_mempos = l_mempos; k_memsize = l_memsize;
1035	l_cmp = .FALSE.
1036	END SELECT
1037	!-
1038	! Fill out the items of the data base
1039	nb_keys = nb_keys+1
1040	key_tab(nb_keys)%keystr = targetname(1:MIN(LEN_TRIM(targetname),l_n))
1041	key_tab(nb_keys)%keystatus = status
1042	key_tab(nb_keys)%keytype = k_typ
1043	key_tab(nb_keys)%keyfromfile = fileorig
1044	key_tab(nb_keys)%keymemstart = k_mempos+1
1045	IF (l_cmp) THEN
1046	key_tab(nb_keys)%keycompress = size_of_in
1047	key_tab(nb_keys)%keymemlen = 1
1048	ELSE
1049	key_tab(nb_keys)%keycompress = -1
1050	key_tab(nb_keys)%keymemlen = size_of_in
1051	ENDIF
1052	IF (l_dbg) THEN
1053	WRITE(,) &
1054	& "get_wdb : nb_keys ",nb_keys," key_tab keystr ",key_tab(nb_keys)%keystr,&
1055	& ",keystatus ",key_tab(nb_keys)%keystatus,&
1056	& ",keytype ",key_tab(nb_keys)%keytype,&
1057	& ",keycompress ",key_tab(nb_keys)%keycompress,&
1058	& ",keyfromfile ",key_tab(nb_keys)%keyfromfile,&
1059	& ",keymemstart ",key_tab(nb_keys)%keymemstart
1060	ENDIF
1061
1062	!-
1063	! Before writing the actual size lets see if we have the space
1064	IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
1065	& > k_memsize) THEN
1066	CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
1067	ENDIF
1068	!-
1069	k_beg = key_tab(nb_keys)%keymemstart
1070	k_end = k_beg+key_tab(nb_keys)%keymemlen-1
1071	SELECT CASE (k_typ)
1072	CASE(k_i)
1073	i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
1074	i_mempos = k_end
1075	CASE(k_r)
1076	r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
1077	r_mempos = k_end
1078	CASE(k_c)
1079	c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
1080	c_mempos = k_end
1081	CASE(k_l)
1082	l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
1083	l_mempos = k_end
1084	END SELECT
1085	!---------------------
1086	END SUBROUTINE get_wdb
1087	!-
1088	!===
1089	!-
1090	SUBROUTINE getin_read
1091	!---------------------------------------------------------------------
1092	IMPLICIT NONE
1093	!-
1094	INTEGER,SAVE :: current
1095	!---------------------------------------------------------------------
1096	IF (allread == 0) THEN
1097	!-- Allocate a first set of memory.
1098	CALL getin_alloctxt ()
1099	CALL getin_allockeys ()
1100	CALL getin_allocmem (k_i,0)
1101	CALL getin_allocmem (k_r,0)
1102	CALL getin_allocmem (k_c,0)
1103	CALL getin_allocmem (k_l,0)
1104	!-- Start with reading the files
1105	nbfiles = 1
1106	filelist(1) = TRIM(def_file)
1107	current = 1
1108	!--
1109	DO WHILE (current <= nbfiles)
1110	CALL getin_readdef (current)
1111	current = current+1
1112	ENDDO
1113	allread = 1
1114	CALL getin_checkcohe ()
1115	ENDIF
1116	!------------------------
1117	END SUBROUTINE getin_read
1118	!-
1119	!===
1120	!-
1121	SUBROUTINE getin_readdef(current)
1122	!---------------------------------------------------------------------
1123	!- This subroutine will read the files and only keep the
1124	!- the relevant information. The information is kept as it
1125	!- found in the file. The data will be analysed later.
1126	!---------------------------------------------------------------------
1127	IMPLICIT NONE
1128	!-
1129	INTEGER :: current
1130	!-
1131	CHARACTER(LEN=:), ALLOCATABLE :: READ_str, NEW_str
1132	CHARACTER(LEN=300) :: last_key,key_str
1133	CHARACTER(LEN=n_d_fmt) :: cnt
1134	CHARACTER(LEN=10) :: c_fmt
1135	INTEGER :: nb_lastkey
1136	!-
1137	INTEGER :: eof,ptn,len_str,i,it,iund,io_err
1138	LOGICAL :: l_dbg
1139	!---------------------------------------------------------------------
1140	CALL ipsldbg (old_status=l_dbg)
1141	!---------------------------------------------------------------------
1142	eof = 0
1143	ptn = 1
1144	nb_lastkey = 0
1145	!-
1146	IF (l_dbg) THEN
1147	WRITE(ipslout,*) 'getin_readdef : Open file ',TRIM(filelist(current))
1148	ENDIF
1149	!-
1150	OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
1151	IF (io_err /= 0) THEN
1152	CALL ipslerr (2,'getin_readdef', &
1153	& 'Could not open file '//TRIM(filelist(current)),' ',' ')
1154	RETURN
1155	ENDIF
1156	!-
1157	DO WHILE (eof /= 1)
1158	!---
1159	CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
1160	len_str = LEN_TRIM(READ_str)
1161	ptn = INDEX(READ_str,'=')
1162	!---
1163	IF (ptn > 0) THEN
1164	!---- Get the target
1165	key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
1166	!---- Make sure that a vector keyword has the right length
1167	iund = INDEX(key_str,'__')
1168	IF (iund > 0) THEN
1169	WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
1170	& LEN_TRIM(key_str)-iund-1
1171	READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
1172	& FMT=c_fmt,IOSTAT=io_err) it
1173	IF ( (io_err == 0).AND.(it > 0) ) THEN
1174	WRITE(UNIT=cnt,FMT=c_i_fmt) it
1175	key_str = key_str(1:iund+1)//cnt
1176	ELSE
1177	CALL ipslerr (3,'getin_readdef', &
1178	& 'A very strange key has just been found :', &
1179	& TRIM(key_str),' ')
1180	ENDIF
1181	ENDIF
1182	!---- Prepare the content
1183	NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
1184	CALL nocomma (NEW_str)
1185	CALL cmpblank (NEW_str)
1186	NEW_str = TRIM(ADJUSTL(NEW_str))
1187	IF (l_dbg) THEN
1188	WRITE(ipslout,*) &
1189	& '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
1190	ENDIF
1191	!---- Decypher the content of NEW_str
1192	!-
1193	!---- This has to be a new key word, thus :
1194	nb_lastkey = 0
1195	!----
1196	CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
1197	!----
1198	ELSE IF (len_str > 0) THEN
1199	!---- Prepare the key if we have an old one to which
1200	!---- we will add the line just read
1201	IF (nb_lastkey > 0) THEN
1202	iund = INDEX(last_key,'__')
1203	IF (iund > 0) THEN
1204	!-------- We only continue a keyword, thus it is easy
1205	key_str = last_key(1:iund-1)
1206	ELSE
1207	IF (nb_lastkey /= 1) THEN
1208	CALL ipslerr (3,'getin_readdef', &
1209	& 'We can not have a scalar keyword', &
1210	& 'and a vector content',' ')
1211	ENDIF
1212	!-------- The last keyword needs to be transformed into a vector.
1213	WRITE(UNIT=cnt,FMT=c_i_fmt) 1
1214	targetlist(nb_lines) = &
1215	& last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
1216	key_str = last_key(1:LEN_TRIM(last_key))
1217	ENDIF
1218	ENDIF
1219	!---- Prepare the content
1220	NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
1221	CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
1222	ELSE
1223	!---- If we have an empty line then the keyword finishes
1224	nb_lastkey = 0
1225	IF (l_dbg) THEN
1226	WRITE(ipslout,*) 'getin_readdef : Have found an emtpy line '
1227	ENDIF
1228	ENDIF
1229	ENDDO
1230	!-
1231	CLOSE(UNIT=22)
1232	!-
1233	IF (l_dbg) THEN
1234	OPEN (UNIT=22,file=TRIM(def_file)//'.test')
1235	DO i=1,nb_lines
1236	WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
1237	ENDDO
1238	CLOSE(UNIT=22)
1239	ENDIF
1240	!-
1241	IF (l_dbg) THEN
1242	WRITE(ipslout,*) "nb_lines ",nb_lines,"nb_keys ",nb_keys
1243	WRITE(ipslout,*) "fichier ",fichier(1:nb_lines)
1244	WRITE(ipslout,*) "targetlist ",targetlist(1:nb_lines)
1245	WRITE(ipslout,*) "fromfile ",fromfile(1:nb_lines)
1246	WRITE(ipslout,*) "compline ",compline(1:nb_lines)
1247	WRITE(ipslout,*) '<-getin_readdef'
1248	ENDIF
1249	!---------------------------
1250	END SUBROUTINE getin_readdef
1251	!-
1252	!===
1253	!-
1254	SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
1255	!---------------------------------------------------------------------
1256	!- This subroutine is going to decypher the line.
1257	!- It essentialy checks how many items are included and
1258	!- it they can be attached to a key.
1259	!---------------------------------------------------------------------
1260	IMPLICIT NONE
1261	!-
1262	! ARGUMENTS
1263	!-
1264	INTEGER :: current,nb_lastkey
1265	CHARACTER(LEN=*) :: key_str,NEW_str
1266	CHARACTER(LEN=*),INTENT(out) :: last_key
1267	!-
1268	! LOCAL
1269	!-
1270	INTEGER :: len_str,blk,nbve,starpos
1271	CHARACTER(LEN=:), ALLOCATABLE :: tmp_str,new_key,mult
1272	CHARACTER(LEN=n_d_fmt) :: cnt
1273	CHARACTER(LEN=10) :: c_fmt
1274	LOGICAL :: l_dbg
1275	!---------------------------------------------------------------------
1276	CALL ipsldbg (old_status=l_dbg)
1277	!---------------------------------------------------------------------
1278	len_str = LEN_TRIM(NEW_str)
1279	blk = INDEX(NEW_str(1:len_str),' ')
1280	tmp_str = NEW_str(1:len_str)
1281	!-
1282	! If the key is a new file then we take it up. Else
1283	! we save the line and go on.
1284	!-
1285	IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
1286	DO WHILE (blk > 0)
1287	IF (nbfiles+1 > max_files) THEN
1288	CALL ipslerr (3,'getin_decrypt', &
1289	& 'Too many files to include',' ',' ')
1290	ENDIF
1291	!-----
1292	nbfiles = nbfiles+1
1293	filelist(nbfiles) = tmp_str(1:blk)
1294	!-----
1295	tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
1296	blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
1297	ENDDO
1298	!---
1299	IF (nbfiles+1 > max_files) THEN
1300	CALL ipslerr (3,'getin_decrypt', &
1301	& 'Too many files to include',' ',' ')
1302	ENDIF
1303	!---
1304	nbfiles = nbfiles+1
1305	filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
1306	!---
1307	last_key = 'INCLUDEDEF'
1308	nb_lastkey = 1
1309	ELSE
1310	!-
1311	!-- We are working on a new line of input
1312	!-
1313	IF (nb_lines+1 > i_txtsize) THEN
1314	CALL getin_alloctxt ()
1315	ENDIF
1316	nb_lines = nb_lines+1
1317	!-
1318	!-- First we solve the issue of conpressed information. Once
1319	!-- this is done all line can be handled in the same way.
1320	!-
1321	starpos = INDEX(NEW_str(1:len_str),'*')
1322	IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
1323	& .AND.(tmp_str(1:1) /= "'") ) THEN
1324	!-----
1325	IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
1326	CALL ipslerr (3,'getin_decrypt', &
1327	& 'We can not have a compressed field of values', &
1328	& 'in a vector notation (TARGET__n).', &
1329	& 'The key at fault : '//TRIM(key_str))
1330	ENDIF
1331	!-
1332	!---- Read the multiplied
1333	!-
1334	mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
1335	!---- Construct the new string and its parameters
1336	NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
1337	len_str = LEN_TRIM(NEW_str)
1338	blk = INDEX(NEW_str(1:len_str),' ')
1339	IF (blk > 1) THEN
1340	CALL ipslerr (2,'getin_decrypt', &
1341	& 'This is a strange behavior','you could report',' ')
1342	ENDIF
1343	WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
1344	READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
1345	!---
1346	ELSE
1347	compline(nb_lines) = -1
1348	ENDIF
1349	!-
1350	!-- If there is no space wthin the line then the target is a scalar
1351	!-- or the element of a properly written vector.
1352	!-- (ie of the type TARGET__00001)
1353	!-
1354	IF ( (blk <= 1) &
1355	& .OR.(tmp_str(1:1) == '"') &
1356	& .OR.(tmp_str(1:1) == "'") ) THEN
1357	!-
1358	IF (nb_lastkey == 0) THEN
1359	!------ Save info of current keyword as a scalar
1360	!------ if it is not a continuation
1361	targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
1362	last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
1363	nb_lastkey = 1
1364	ELSE
1365	!------ We are continuing a vector so the keyword needs
1366	!------ to get the underscores
1367	WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
1368	targetlist(nb_lines) = &
1369	& key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
1370	last_key = &
1371	& key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
1372	nb_lastkey = nb_lastkey+1
1373	ENDIF
1374	!-----
1375	fichier(nb_lines) = NEW_str(1:len_str)
1376	fromfile(nb_lines) = current
1377	ELSE
1378	!-
1379	!---- If there are blanks whithin the line then we are dealing
1380	!---- with a vector and we need to split it in many entries
1381	!---- with the TARGET__n notation.
1382	!----
1383	!---- Test if the targer is not already a vector target !
1384	!-
1385	IF (INDEX(TRIM(key_str),'__') > 0) THEN
1386	CALL ipslerr (3,'getin_decrypt', &
1387	& 'We have found a mixed vector notation (TARGET__n).', &
1388	& 'The key at fault : '//TRIM(key_str),' ')
1389	ENDIF
1390	!-
1391	nbve = nb_lastkey
1392	nbve = nbve+1
1393	WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
1394	!-
1395	DO WHILE (blk > 0)
1396	!-
1397	!------ Save the content of target__nbve
1398	!-
1399	fichier(nb_lines) = tmp_str(1:blk)
1400	new_key = &
1401	& key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
1402	targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
1403	fromfile(nb_lines) = current
1404	!-
1405	tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
1406	blk = INDEX(TRIM(tmp_str),' ')
1407	!-
1408	IF (nb_lines+1 > i_txtsize) THEN
1409	CALL getin_alloctxt ()
1410	ENDIF
1411	nb_lines = nb_lines+1
1412	nbve = nbve+1
1413	WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
1414	compline(nb_lines)=compline(nb_lines-1)
1415	!-
1416	ENDDO
1417	!-
1418	!---- Save the content of the last target
1419	!-
1420	fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
1421	new_key = &
1422	& key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
1423	targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
1424	fromfile(nb_lines) = current
1425	!-
1426	last_key = &
1427	& key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
1428	nb_lastkey = nbve
1429	!-
1430	ENDIF
1431	!-
1432	ENDIF
1433
1434	IF (l_dbg) THEN
1435	WRITE(ipslout,*) "getin_decrypt ->",TRIM(NEW_str), " : "
1436	WRITE(ipslout,*) "getin_decrypt ->", nb_lines,&
1437	& SIZE(fichier), &
1438	& SIZE(fromfile), &
1439	& SIZE(filelist)
1440	IF (nb_lines > 0) THEN
1441	WRITE(ipslout,*) "getin_decrypt ->", &
1442	& TRIM(fichier(nb_lines)), &
1443	& fromfile(nb_lines), &
1444	& TRIM(filelist(fromfile(nb_lines)))
1445	WRITE(ipslout,*) " compline : ",compline(nb_lines)
1446	WRITE(ipslout,*) " targetlist : ",TRIM(targetlist(nb_lines))
1447	ENDIF
1448	WRITE(ipslout,*) " last_key : ",last_key
1449	ENDIF
1450	!---------------------------
1451	END SUBROUTINE getin_decrypt
1452	!-
1453	!===
1454	!-
1455	SUBROUTINE getin_checkcohe ()
1456	!---------------------------------------------------------------------
1457	!- This subroutine checks for redundancies.
1458	!---------------------------------------------------------------------
1459	IMPLICIT NONE
1460	!-
1461	INTEGER :: line,n_k,k
1462	!---------------------------------------------------------------------
1463	DO line=1,nb_lines-1
1464	!-
1465	n_k = 0
1466	DO k=line+1,nb_lines
1467	IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
1468	n_k = k
1469	EXIT
1470	ENDIF
1471	ENDDO
1472	!---
1473	!-- IF we have found it we have a problem to solve.
1474	!---
1475	IF (n_k > 0) THEN
1476	WRITE(ipslout,*) 'COUNT : ',n_k
1477	WRITE(ipslout,*) &
1478	& 'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
1479	WRITE(ipslout,*) &
1480	& 'getin_checkcohe : The following values were encoutered :'
1481	WRITE(ipslout,*) &
1482	& ' ',TRIM(targetlist(line)),' == ',fichier(line)
1483	WRITE(ipslout,*) &
1484	& ' ',TRIM(targetlist(k)),' == ',fichier(k)
1485	WRITE(ipslout,*) &
1486	& 'getin_checkcohe : We will keep only the last value'
1487	CALL ipslerr (2,'getin_checkcohe','Found a problem on key ', &
1488	& TRIM(targetlist(line)), fichier(line)//" "//fichier(k))
1489	targetlist(line) = ' '
1490	ENDIF
1491	ENDDO
1492	!-----------------------------
1493	END SUBROUTINE getin_checkcohe
1494	!-
1495	!===
1496	!-
1497	SUBROUTINE getin_readline(unitf, out_string, is_eof)
1498	!---------------------------------------------------------------------
1499	USE ISO_FORTRAN_ENV,ONLY : IOSTAT_EOR,IOSTAT_END
1500	!-
1501	IMPLICIT NONE
1502	!-
1503	INTEGER, PARAMETER :: CHARLEN = 100 ! buffer size
1504	INTEGER, INTENT(in) :: unitf
1505	INTEGER, INTENT(out) :: is_eof
1506	CHARACTER(LEN=:),INTENT(out),ALLOCATABLE :: out_string
1507	!-
1508	CHARACTER(LEN=CHARLEN) :: dummy
1509	!-
1510	CHARACTER(LEN=:), ALLOCATABLE :: buff1 ! buffer
1511	INTEGER :: ioerr ! error code
1512	INTEGER :: readlength ! number of chars read from file
1513	LOGICAL :: is_eol, is_first_ite ! end of line?
1514
1515	is_eof = 0
1516	is_eol = .FALSE.
1517	buff1 = ""
1518
1519	DO WHILE (.NOT. is_eol)
1520	!-
1521	dummy = ""
1522	READ (UNIT=unitf,FMT='(A)', ADVANCE='NO', SIZE=readlength,END=7778,IOSTAT=ioerr) dummy
1523
1524	IF ((ioerr==IOSTAT_EOR).OR.(ioerr==IOSTAT_END)) ioerr = 0
1525	!-
1526	! keep looping if line is commented
1527	dummy = TRIM(ADJUSTL(dummy))
1528	!-
1529	! is end of line?
1530	is_eol = (readlength .LT. CHARLEN)
1531	!-
1532	! merge with previous buffer
1533	buff1 = TRIM(buff1)//TRIM(dummy)
1534	ENDDO
1535	!-
1536	out_string=TRIM(buff1)
1537	!-
1538	RETURN
1539	!-
1540	! IOSTAT gives a positive value if an error occurs.
1541	IF (ioerr.GT. 0) CALL ipslerr (3,'getin_readline','Error while reading file',' ',' ')
1542
1543	!-
1544	7778 CONTINUE
1545	out_string = TRIM(dummy)
1546	is_eof = 1
1547
1548	END SUBROUTINE getin_readline
1549	!-
1550	! getin_skipafew: reads
1551	!-
1552	SUBROUTINE getin_skipafew (unit,out_string,is_eof,nb_lastkey)
1553	!---------------------------------------------------------------------
1554	USE ISO_FORTRAN_ENV,ONLY : IOSTAT_EOR,IOSTAT_END
1555	!-
1556	IMPLICIT NONE
1557	!-
1558	INTEGER :: unit,is_eof,nb_lastkey
1559	CHARACTER(LEN=:),INTENT(out),ALLOCATABLE :: out_string
1560	!-
1561	CHARACTER(LEN=1) :: first
1562	CHARACTER(LEN=:), ALLOCATABLE :: dummy
1563	!---------------------------------------------------------------------
1564	first=COMMENT_TAG
1565	is_eof = 0
1566	dummy = ""
1567	!-
1568	! Loop until a non commented line is found
1569	DO WHILE (first == COMMENT_TAG .AND. is_eof == 0)
1570	!-
1571	CALL getin_readline(unit, dummy, is_eof)
1572	!-
1573	! Is first char a comment? #
1574	IF (LEN(dummy) > 0) THEN
1575	first=dummy(1:1)
1576	IF (first == COMMENT_TAG) THEN
1577	nb_lastkey = 0
1578	ENDIF
1579	ENDIF
1580	!-
1581	ENDDO
1582	!-
1583	CALL nocomment(dummy)
1584	out_string = TRIM(dummy)
1585	!-
1586	RETURN
1587	!-
1588	9998 CONTINUE
1589	CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
1590	!-
1591	7778 CONTINUE
1592	CALL nocomment(dummy)
1593	out_string = TRIM(dummy)
1594	is_eof = 1
1595	!----------------------------
1596	END SUBROUTINE getin_skipafew
1597	!-
1598	!===
1599	!-
1600	SUBROUTINE getin_allockeys ()
1601	!---------------------------------------------------------------------
1602	IMPLICIT NONE
1603	!-
1604	TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
1605	!-
1606	INTEGER :: ier
1607	CHARACTER(LEN=20) :: c_tmp
1608	!---------------------------------------------------------------------
1609	IF (keymemsize == 0) THEN
1610	!---
1611	!-- Nothing exists in memory arrays and it is easy to do.
1612	!---
1613	WRITE (UNIT=c_tmp,FMT=*) memslabs
1614	ALLOCATE(key_tab(memslabs),stat=ier)
1615	IF (ier /= 0) THEN
1616	CALL ipslerr (3,'getin_allockeys', &
1617	& 'Can not allocate key_tab', &
1618	& 'to size '//TRIM(ADJUSTL(c_tmp)),' ')
1619	ENDIF
1620	nb_keys = 0
1621	keymemsize = memslabs
1622	key_tab(:)%keycompress = -1
1623	!---
1624	ELSE
1625	!---
1626	!-- There is something already in the memory,
1627	!-- we need to transfer and reallocate.
1628	!---
1629	WRITE (UNIT=c_tmp,FMT=*) keymemsize
1630	ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
1631	IF (ier /= 0) THEN
1632	CALL ipslerr (3,'getin_allockeys', &
1633	& 'Can not allocate tmp_key_tab', &
1634	& 'to size '//TRIM(ADJUSTL(c_tmp)),' ')
1635	ENDIF
1636	WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
1637	tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
1638	DEALLOCATE(key_tab)
1639	ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
1640	IF (ier /= 0) THEN
1641	CALL ipslerr (3,'getin_allockeys', &
1642	& 'Can not allocate key_tab', &
1643	& 'to size '//TRIM(ADJUSTL(c_tmp)),' ')
1644	ENDIF
1645	key_tab(:)%keycompress = -1
1646	key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
1647	DEALLOCATE(tmp_key_tab)
1648	keymemsize = keymemsize+memslabs
1649	ENDIF
1650	!-----------------------------
1651	END SUBROUTINE getin_allockeys
1652	!-
1653	!===
1654	!-
1655	SUBROUTINE getin_allocmem (type,len_wanted)
1656	!---------------------------------------------------------------------
1657	!- Allocate the memory of the data base for all 4 types of memory
1658	!- INTEGER / REAL / CHARACTER / LOGICAL
1659	!---------------------------------------------------------------------
1660	IMPLICIT NONE
1661	!-
1662	INTEGER :: type,len_wanted
1663	!-
1664	INTEGER,ALLOCATABLE :: tmp_int(:)
1665	REAL,ALLOCATABLE :: tmp_real(:)
1666	CHARACTER(LEN=300),ALLOCATABLE :: tmp_char(:)
1667	LOGICAL,ALLOCATABLE :: tmp_logic(:)
1668	INTEGER :: ier
1669	CHARACTER(LEN=20) :: c_tmp
1670	!---------------------------------------------------------------------
1671	SELECT CASE (type)
1672	CASE(k_i)
1673	IF (i_memsize == 0) THEN
1674	ALLOCATE(i_mem(memslabs),stat=ier)
1675	IF (ier /= 0) THEN
1676	WRITE (UNIT=c_tmp,FMT=*) memslabs
1677	CALL ipslerr (3,'getin_allocmem', &
1678	& 'Unable to allocate db-memory', &
1679	& 'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1680	ENDIF
1681	i_memsize=memslabs
1682	ELSE
1683	ALLOCATE(tmp_int(i_memsize),stat=ier)
1684	IF (ier /= 0) THEN
1685	WRITE (UNIT=c_tmp,FMT=*) i_memsize
1686	CALL ipslerr (3,'getin_allocmem', &
1687	& 'Unable to allocate tmp_int', &
1688	& 'to size '//TRIM(ADJUSTL(c_tmp)),' ')
1689	ENDIF
1690	tmp_int(1:i_memsize) = i_mem(1:i_memsize)
1691	DEALLOCATE(i_mem)
1692	ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
1693	IF (ier /= 0) THEN
1694	WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
1695	CALL ipslerr (3,'getin_allocmem', &
1696	& 'Unable to re-allocate db-memory', &
1697	& 'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1698	ENDIF
1699	i_mem(1:i_memsize) = tmp_int(1:i_memsize)
1700	i_memsize = i_memsize+MAX(memslabs,len_wanted)
1701	DEALLOCATE(tmp_int)
1702	ENDIF
1703	CASE(k_r)
1704	IF (r_memsize == 0) THEN
1705	ALLOCATE(r_mem(memslabs),stat=ier)
1706	IF (ier /= 0) THEN
1707	WRITE (UNIT=c_tmp,FMT=*) memslabs
1708	CALL ipslerr (3,'getin_allocmem', &
1709	& 'Unable to allocate db-memory', &
1710	& 'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1711	ENDIF
1712	r_memsize = memslabs
1713	ELSE
1714	ALLOCATE(tmp_real(r_memsize),stat=ier)
1715	IF (ier /= 0) THEN
1716	WRITE (UNIT=c_tmp,FMT=*) r_memsize
1717	CALL ipslerr (3,'getin_allocmem', &
1718	& 'Unable to allocate tmp_real', &
1719	& 'to size '//TRIM(ADJUSTL(c_tmp)),' ')
1720	ENDIF
1721	tmp_real(1:r_memsize) = r_mem(1:r_memsize)
1722	DEALLOCATE(r_mem)
1723	ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
1724	IF (ier /= 0) THEN
1725	WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
1726	CALL ipslerr (3,'getin_allocmem', &
1727	& 'Unable to re-allocate db-memory', &
1728	& 'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1729	ENDIF
1730	r_mem(1:r_memsize) = tmp_real(1:r_memsize)
1731	r_memsize = r_memsize+MAX(memslabs,len_wanted)
1732	DEALLOCATE(tmp_real)
1733	ENDIF
1734	CASE(k_c)
1735	IF (c_memsize == 0) THEN
1736	ALLOCATE(c_mem(memslabs),stat=ier)
1737	IF (ier /= 0) THEN
1738	WRITE (UNIT=c_tmp,FMT=*) memslabs
1739	CALL ipslerr (3,'getin_allocmem', &
1740	& 'Unable to allocate db-memory', &
1741	& 'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1742	ENDIF
1743	c_memsize = memslabs
1744	ELSE
1745	ALLOCATE(tmp_char(c_memsize),stat=ier)
1746	IF (ier /= 0) THEN
1747	WRITE (UNIT=c_tmp,FMT=*) c_memsize
1748	CALL ipslerr (3,'getin_allocmem', &
1749	& 'Unable to allocate tmp_char', &
1750	& 'to size '//TRIM(ADJUSTL(c_tmp)),' ')
1751	ENDIF
1752	tmp_char(1:c_memsize) = c_mem(1:c_memsize)
1753	DEALLOCATE(c_mem)
1754	ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
1755	IF (ier /= 0) THEN
1756	WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
1757	CALL ipslerr (3,'getin_allocmem', &
1758	& 'Unable to re-allocate db-memory', &
1759	& 'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1760	ENDIF
1761	c_mem(1:c_memsize) = tmp_char(1:c_memsize)
1762	c_memsize = c_memsize+MAX(memslabs,len_wanted)
1763	DEALLOCATE(tmp_char)
1764	ENDIF
1765	CASE(k_l)
1766	IF (l_memsize == 0) THEN
1767	ALLOCATE(l_mem(memslabs),stat=ier)
1768	IF (ier /= 0) THEN
1769	WRITE (UNIT=c_tmp,FMT=*) memslabs
1770	CALL ipslerr (3,'getin_allocmem', &
1771	& 'Unable to allocate db-memory', &
1772	& 'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1773	ENDIF
1774	l_memsize = memslabs
1775	ELSE
1776	ALLOCATE(tmp_logic(l_memsize),stat=ier)
1777	IF (ier /= 0) THEN
1778	WRITE (UNIT=c_tmp,FMT=*) l_memsize
1779	CALL ipslerr (3,'getin_allocmem', &
1780	& 'Unable to allocate tmp_logic', &
1781	& 'to size '//TRIM(ADJUSTL(c_tmp)),' ')
1782	ENDIF
1783	tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
1784	DEALLOCATE(l_mem)
1785	ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
1786	IF (ier /= 0) THEN
1787	WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
1788	CALL ipslerr (3,'getin_allocmem', &
1789	& 'Unable to re-allocate db-memory', &
1790	& 'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
1791	ENDIF
1792	l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
1793	l_memsize = l_memsize+MAX(memslabs,len_wanted)
1794	DEALLOCATE(tmp_logic)
1795	ENDIF
1796	CASE DEFAULT
1797	CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
1798	END SELECT
1799	!----------------------------
1800	END SUBROUTINE getin_allocmem
1801	!-
1802	!===
1803	!-
1804	SUBROUTINE getin_alloctxt ()
1805	!---------------------------------------------------------------------
1806	IMPLICIT NONE
1807	!-
1808	CHARACTER(LEN=300),ALLOCATABLE :: tmp_fic(:)
1809	CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
1810	INTEGER,ALLOCATABLE :: tmp_int(:)
1811	!-
1812	INTEGER :: ier
1813	CHARACTER(LEN=20) :: c_tmp1,c_tmp2
1814	!---------------------------------------------------------------------
1815	IF (i_txtsize == 0) THEN
1816	!---
1817	!-- Nothing exists in memory arrays and it is easy to do.
1818	!---
1819	WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
1820	ALLOCATE(fichier(i_txtslab),stat=ier)
1821	IF (ier /= 0) THEN
1822	CALL ipslerr (3,'getin_alloctxt', &
1823	& 'Can not allocate fichier', &
1824	& 'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
1825	ENDIF
1826	!---
1827	ALLOCATE(targetlist(i_txtslab),stat=ier)
1828	IF (ier /= 0) THEN
1829	CALL ipslerr (3,'getin_alloctxt', &
1830	& 'Can not allocate targetlist', &
1831	& 'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
1832	ENDIF
1833	!---
1834	ALLOCATE(fromfile(i_txtslab),stat=ier)
1835	IF (ier /= 0) THEN
1836	CALL ipslerr (3,'getin_alloctxt', &
1837	& 'Can not allocate fromfile', &
1838	& 'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
1839	ENDIF
1840	!---
1841	ALLOCATE(compline(i_txtslab),stat=ier)
1842	IF (ier /= 0) THEN
1843	CALL ipslerr (3,'getin_alloctxt', &
1844	& 'Can not allocate compline', &
1845	& 'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
1846	ENDIF
1847	!---
1848	nb_lines = 0
1849	i_txtsize = i_txtslab
1850	ELSE
1851	!---
1852	!-- There is something already in the memory,
1853	!-- we need to transfer and reallocate.
1854	!---
1855	WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
1856	WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
1857	ALLOCATE(tmp_fic(i_txtsize),stat=ier)
1858	IF (ier /= 0) THEN
1859	CALL ipslerr (3,'getin_alloctxt', &
1860	& 'Can not allocate tmp_fic', &
1861	& 'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
1862	ENDIF
1863	tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
1864	DEALLOCATE(fichier)
1865	ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
1866	IF (ier /= 0) THEN
1867	CALL ipslerr (3,'getin_alloctxt', &
1868	& 'Can not allocate fichier', &
1869	& 'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
1870	ENDIF
1871	fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
1872	DEALLOCATE(tmp_fic)
1873	!---
1874	ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
1875	IF (ier /= 0) THEN
1876	CALL ipslerr (3,'getin_alloctxt', &
1877	& 'Can not allocate tmp_tgl', &
1878	& 'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
1879	ENDIF
1880	tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
1881	DEALLOCATE(targetlist)
1882	ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
1883	IF (ier /= 0) THEN
1884	CALL ipslerr (3,'getin_alloctxt', &
1885	& 'Can not allocate targetlist', &
1886	& 'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
1887	ENDIF
1888	targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
1889	DEALLOCATE(tmp_tgl)
1890	!---
1891	ALLOCATE(tmp_int(i_txtsize),stat=ier)
1892	IF (ier /= 0) THEN
1893	CALL ipslerr (3,'getin_alloctxt', &
1894	& 'Can not allocate tmp_int', &
1895	& 'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
1896	ENDIF
1897	tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
1898	DEALLOCATE(fromfile)
1899	ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
1900	IF (ier /= 0) THEN
1901	CALL ipslerr (3,'getin_alloctxt', &
1902	& 'Can not allocate fromfile', &
1903	& 'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
1904	ENDIF
1905	fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
1906	!---
1907	tmp_int(1:i_txtsize) = compline(1:i_txtsize)
1908	DEALLOCATE(compline)
1909	ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
1910	IF (ier /= 0) THEN
1911	CALL ipslerr (3,'getin_alloctxt', &
1912	& 'Can not allocate compline', &
1913	& 'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
1914	ENDIF
1915	compline(1:i_txtsize) = tmp_int(1:i_txtsize)
1916	DEALLOCATE(tmp_int)
1917	!---
1918	i_txtsize = i_txtsize+i_txtslab
1919	ENDIF
1920	!----------------------------
1921	END SUBROUTINE getin_alloctxt
1922	!-
1923	!===
1924	!-
1925	SUBROUTINE getin_dump (fileprefix)
1926	!---------------------------------------------------------------------
1927	IMPLICIT NONE
1928	!-
1929	CHARACTER(*),OPTIONAL :: fileprefix
1930	!-
1931	CHARACTER(LEN=80) :: usedfileprefix
1932	INTEGER :: ikey,if,iff,iv
1933	CHARACTER(LEN=20) :: c_tmp
1934	CHARACTER(LEN=300) :: tmp_str,used_filename
1935	INTEGER :: io_err
1936	LOGICAL :: l_dbg
1937	!---------------------------------------------------------------------
1938	CALL ipsldbg (old_status=l_dbg)
1939	!---------------------------------------------------------------------
1940	IF (PRESENT(fileprefix)) THEN
1941	usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
1942	ELSE
1943	usedfileprefix = "used"
1944	ENDIF
1945	!-
1946	DO if=1,nbfiles
1947	!---
1948	used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
1949	IF (l_dbg) THEN
1950	WRITE(ipslout,*) &
1951	& 'getin_dump : opens file : ',TRIM(used_filename),' if = ',if
1952	WRITE(ipslout,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
1953	ENDIF
1954	OPEN (UNIT=22,FILE=used_filename,iostat=io_err)
1955	IF (io_err /= 0) THEN
1956	CALL ipslerr (3,'getin_dump', &
1957	& 'Could not open file :',TRIM(used_filename), &
1958	& '')
1959	ENDIF
1960	!---
1961	!-- If this is the first file we need to add the list
1962	!-- of file which belong to it
1963	IF ( (if == 1).AND.(nbfiles > 1) ) THEN
1964	WRITE(22,*) '# '
1965	WRITE(22,*) '# This file is linked to the following files :'
1966	WRITE(22,*) '# '
1967	DO iff=2,nbfiles
1968	WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
1969	ENDDO
1970	WRITE(22,*) '# '
1971	IF (l_dbg) THEN
1972	WRITE(ipslout,*) '# '
1973	WRITE(ipslout,*) '# This file is linked to the following files :'
1974	WRITE(ipslout,*) '# '
1975	DO iff=2,nbfiles
1976	WRITE(ipslout,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
1977	ENDDO
1978	WRITE(ipslout,*) '# '
1979	ENDIF
1980	ENDIF
1981	!---
1982	DO ikey=1,nb_keys
1983	!-----
1984	!---- Is this key from this file ?
1985	IF (key_tab(ikey)%keyfromfile == if) THEN
1986	!-------
1987	!------ Write some comments
1988	WRITE(22,*) '#'
1989	SELECT CASE (key_tab(ikey)%keystatus)
1990	CASE(nondefault)
1991	WRITE(22,*) '# Values of ', &
1992	& TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file)
1993	CASE(default)
1994	WRITE(22,*) '# Values of ', &
1995	& TRIM(key_tab(ikey)%keystr),' are all defaults.'
1996	CASE(vectornondefault)
1997	WRITE(22,*) '# Values of ', &
1998	& TRIM(key_tab(ikey)%keystr), &
1999	& ' are a mix of ',TRIM(def_file),' and defaults.'
2000	CASE DEFAULT
2001	WRITE(22,*) '# Dont know from where the value of ', &
2002	& TRIM(key_tab(ikey)%keystr),' comes.'
2003	END SELECT
2004	WRITE(22,*) '#'
2005	!-
2006	IF (l_dbg) THEN
2007	WRITE(ipslout,*) '#'
2008	WRITE(ipslout,*) '# Status of key ', ikey, ' : ',&
2009	& TRIM(key_tab(ikey)%keystr),key_tab(ikey)%keystatus
2010	ENDIF
2011	!-------
2012	!------ Write the values
2013	SELECT CASE (key_tab(ikey)%keytype)
2014	CASE(k_i)
2015	IF (key_tab(ikey)%keymemlen == 1) THEN
2016	IF (key_tab(ikey)%keycompress < 0) THEN
2017	WRITE(22,*) &
2018	& TRIM(key_tab(ikey)%keystr), &
2019	& ' = ',i_mem(key_tab(ikey)%keymemstart)
2020	ELSE
2021	WRITE(22,*) &
2022	& TRIM(key_tab(ikey)%keystr), &
2023	& ' = ',key_tab(ikey)%keycompress, &
2024	& ' * ',i_mem(key_tab(ikey)%keymemstart)
2025	ENDIF
2026	ELSE
2027	DO iv=0,key_tab(ikey)%keymemlen-1
2028	WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
2029	WRITE(22,*) &
2030	& TRIM(key_tab(ikey)%keystr), &
2031	& '__',TRIM(ADJUSTL(c_tmp)), &
2032	& ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
2033	ENDDO
2034	ENDIF
2035	CASE(k_r)
2036	IF (key_tab(ikey)%keymemlen == 1) THEN
2037	IF (key_tab(ikey)%keycompress < 0) THEN
2038	WRITE(22,*) &
2039	& TRIM(key_tab(ikey)%keystr), &
2040	& ' = ',r_mem(key_tab(ikey)%keymemstart)
2041	ELSE
2042	WRITE(22,*) &
2043	& TRIM(key_tab(ikey)%keystr), &
2044	& ' = ',key_tab(ikey)%keycompress, &
2045	& ' * ',r_mem(key_tab(ikey)%keymemstart)
2046	ENDIF
2047	ELSE
2048	DO iv=0,key_tab(ikey)%keymemlen-1
2049	WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
2050	WRITE(22,*) &
2051	& TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
2052	& ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
2053	ENDDO
2054	ENDIF
2055	CASE(k_c)
2056	IF (key_tab(ikey)%keymemlen == 1) THEN
2057	tmp_str = c_mem(key_tab(ikey)%keymemstart)
2058	WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
2059	& ' = ',TRIM(tmp_str)
2060	ELSE
2061	DO iv=0,key_tab(ikey)%keymemlen-1
2062	WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
2063	tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
2064	WRITE(22,*) &
2065	& TRIM(key_tab(ikey)%keystr), &
2066	& '__',TRIM(ADJUSTL(c_tmp)), &
2067	& ' = ',TRIM(tmp_str)
2068	ENDDO
2069	ENDIF
2070	CASE(k_l)
2071	IF (key_tab(ikey)%keymemlen == 1) THEN
2072	IF (l_mem(key_tab(ikey)%keymemstart)) THEN
2073	WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
2074	ELSE
2075	WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
2076	ENDIF
2077	ELSE
2078	DO iv=0,key_tab(ikey)%keymemlen-1
2079	WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
2080	IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
2081	WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
2082	& TRIM(ADJUSTL(c_tmp)),' = TRUE '
2083	ELSE
2084	WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
2085	& TRIM(ADJUSTL(c_tmp)),' = FALSE '
2086	ENDIF
2087	ENDDO
2088	ENDIF
2089	CASE DEFAULT
2090	CALL ipslerr (3,'getin_dump', &
2091	& 'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
2092	& ' ',' ')
2093	END SELECT
2094	ENDIF
2095	ENDDO
2096	!-
2097	CLOSE(UNIT=22)
2098	!-
2099	ENDDO
2100	!------------------------
2101	END SUBROUTINE getin_dump
2102	!===
2103	SUBROUTINE getin_dump_para (fileprefix,rank)
2104	!---------------------------------------------------------------------
2105	IMPLICIT NONE
2106	!-
2107	CHARACTER(*) :: fileprefix
2108	INTEGER,INTENT(IN) :: rank
2109	!-
2110	CHARACTER(LEN=80) :: usedfileprefix
2111	LOGICAL :: l_dbg
2112	INTEGER :: isize
2113	!---------------------------------------------------------------------
2114	CALL ipsldbg (old_status=l_dbg)
2115	!---------------------------------------------------------------------
2116	IF ( rank < 1000 ) THEN
2117	isize=MIN(LEN_TRIM(fileprefix),75)
2118	usedfileprefix = fileprefix(1:isize)
2119	usedfileprefix((isize+1):(isize+1))='_'
2120	WRITE(usedfileprefix((isize+2):(isize+5)),'(I4.4)') rank
2121	IF (l_dbg) &
2122	WRITE(ipslout,*) 'Dump getin to file ',usedfileprefix
2123	CALL getin_dump(usedfileprefix)
2124	ENDIF
2125	!------------------------
2126	END SUBROUTINE getin_dump_para
2127
2128	!===
2129	SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
2130	!---------------------------------------------------------------------
2131	!- Returns the type of the argument (mutually exclusive)
2132	!---------------------------------------------------------------------
2133	IMPLICIT NONE
2134	!-
2135	INTEGER,INTENT(OUT) :: k_typ
2136	CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
2137	INTEGER,DIMENSION(:),OPTIONAL :: i_v
2138	REAL,DIMENSION(:),OPTIONAL :: r_v
2139	LOGICAL,DIMENSION(:),OPTIONAL :: l_v
2140	CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
2141	!---------------------------------------------------------------------
2142	k_typ = 0
2143	IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
2144	& /= 1) THEN
2145	CALL ipslerr (3,'get_qtyp', &
2146	& 'Invalid number of optional arguments','(/= 1)',' ')
2147	ENDIF
2148	!-
2149	IF (PRESENT(i_v)) THEN
2150	k_typ = k_i
2151	c_vtyp = 'INTEGER'
2152	ELSEIF (PRESENT(r_v)) THEN
2153	k_typ = k_r
2154	c_vtyp = 'REAL'
2155	ELSEIF (PRESENT(c_v)) THEN
2156	k_typ = k_c
2157	c_vtyp = 'CHARACTER'
2158	ELSEIF (PRESENT(l_v)) THEN
2159	k_typ = k_l
2160	c_vtyp = 'LOGICAL'
2161	ENDIF
2162	!----------------------
2163	END SUBROUTINE get_qtyp
2164	!===
2165	SUBROUTINE get_findkey (i_tab,c_key,pos)
2166	!---------------------------------------------------------------------
2167	!- This subroutine looks for a key in a table
2168	!---------------------------------------------------------------------
2169	!- INPUT
2170	!- i_tab : 1 -> search in key_tab(1:nb_keys)%keystr
2171	!- 2 -> search in targetlist(1:nb_lines)
2172	!- c_key : Name of the key we are looking for
2173	!- OUTPUT
2174	!- pos : -1 if key not found, else value in the table
2175	!---------------------------------------------------------------------
2176	IMPLICIT NONE
2177	!-
2178	INTEGER,INTENT(in) :: i_tab
2179	CHARACTER(LEN=*),INTENT(in) :: c_key
2180	INTEGER,INTENT(out) :: pos
2181	!-
2182	INTEGER :: ikey_max,ikey
2183	CHARACTER(LEN=l_n) :: c_q_key
2184	!---------------------------------------------------------------------
2185	pos = -1
2186	IF (i_tab == 1) THEN
2187	ikey_max = nb_keys
2188	ELSEIF (i_tab == 2) THEN
2189	ikey_max = nb_lines
2190	ELSE
2191	ikey_max = 0
2192	ENDIF
2193	IF ( ikey_max > 0 ) THEN
2194	DO ikey=1,ikey_max
2195	IF (i_tab == 1) THEN
2196	c_q_key = key_tab(ikey)%keystr
2197	ELSE
2198	c_q_key = targetlist(ikey)
2199	ENDIF
2200	IF (TRIM(c_q_key) == TRIM(c_key)) THEN
2201	pos = ikey
2202	EXIT
2203	ENDIF
2204	ENDDO
2205	ENDIF
2206	!-------------------------
2207	END SUBROUTINE get_findkey
2208	!===
2209	!------------------
2210	END MODULE getincom

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

Context Navigation

source: IOIPSL/trunk/src/getincom.f90 @ 6851

Download in other formats: