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

Last change on this file since 4 was 4, checked in by rblod, 16 years ago

First import of IOIPSL sources

File size: 74.5 KB
Line 
1!$Header: /home/ioipsl/CVSROOT/IOIPSL/src/getincom.f90,v 2.1 2006/04/05 16:18:43 adm Exp $
2!-
3MODULE getincom
4!---------------------------------------------------------------------
5  USE stringop, &
6 &   ONLY : findpos,nocomma,cmpblank,strlowercase,gensig,find_sig
7!-
8  IMPLICIT NONE
9!-
10  PRIVATE
11  PUBLIC :: getin, getin_dump
12!-
13  INTERFACE getin
14    MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
15 &                   getinis, getini1d, getini2d, &
16 &                   getincs, getinc1d, getinc2d, &
17 &                   getinls, getinl1d, getinl2d
18  END INTERFACE
19!-
20  INTEGER,PARAMETER :: max_files=100
21  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
22  INTEGER,SAVE      :: nbfiles
23!-
24  INTEGER,PARAMETER :: max_lines=500
25  INTEGER,SAVE :: nb_lines
26  CHARACTER(LEN=100),DIMENSION(max_lines),SAVE :: fichier
27  INTEGER,DIMENSION(max_lines),SAVE :: targetsiglist,fromfile,compline
28  CHARACTER(LEN=30),DIMENSION(max_lines),SAVE  :: targetlist
29!-
30! The data base of parameters
31!-
32  INTEGER,PARAMETER :: memslabs=200
33  INTEGER,PARAMETER :: compress_lim = 20
34!-
35  INTEGER,SAVE :: nb_keys=0
36  INTEGER,SAVE :: keymemsize=0
37  INTEGER,SAVE,ALLOCATABLE :: keysig(:)
38  CHARACTER(LEN=30),SAVE,ALLOCATABLE :: keystr(:)
39!-
40! keystatus definition
41! keystatus = 1 : Value comes from run.def
42! keystatus = 2 : Default value is used
43! keystatus = 3 : Some vector elements were taken from default
44!-
45  INTEGER,SAVE,ALLOCATABLE :: keystatus(:)
46!-
47! keytype definition
48! keytype = 1 : Interger
49! keytype = 2 : Real
50! keytype = 3 : Character
51! keytype = 4 : Logical
52!-
53  INTEGER,SAVE,ALLOCATABLE :: keytype(:)
54!-
55! Allow compression for keys (only for integer and real)
56! keycompress < 0 : not compresses
57! keycompress > 0 : number of repeat of the value
58!-
59  INTEGER,SAVE,ALLOCATABLE :: keycompress(:)
60  INTEGER,SAVE,ALLOCATABLE :: keyfromfile(:)
61!-
62  INTEGER,SAVE,ALLOCATABLE :: keymemstart(:)
63  INTEGER,SAVE,ALLOCATABLE :: keymemlen(:)
64!-
65  INTEGER,SAVE,ALLOCATABLE :: intmem(:)
66  INTEGER,SAVE             :: intmemsize=0, intmempos=0
67  REAL,SAVE,ALLOCATABLE :: realmem(:)
68  INTEGER,SAVE          :: realmemsize=0, realmempos=0
69  CHARACTER(LEN=100),SAVE,ALLOCATABLE :: charmem(:)
70  INTEGER,SAVE             :: charmemsize=0, charmempos=0
71  LOGICAL,SAVE,ALLOCATABLE :: logicmem(:)
72  INTEGER,SAVE             :: logicmemsize=0, logicmempos=0
73!-
74CONTAINS
75!-
76!=== REAL INTERFACES
77!-
78SUBROUTINE getinrs (TARGET,ret_val)
79!---------------------------------------------------------------------
80!-  Get a real scalar. We first check if we find it
81!-  in the database and if not we get it from the run.def
82!-
83!-  getinr1d and getinr2d are written on the same pattern
84!---------------------------------------------------------------------
85  IMPLICIT NONE
86!-
87  CHARACTER(LEN=*) :: TARGET
88  REAL :: ret_val
89!-
90  REAL,DIMENSION(1) :: tmp_ret_val
91  INTEGER :: target_sig, pos, status=0, fileorig
92!---------------------------------------------------------------------
93!-
94! Compute the signature of the target
95!-
96  CALL gensig (TARGET,target_sig)
97!-
98! Do we have this target in our database ?
99!-
100  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
101!-
102  tmp_ret_val(1) = ret_val
103!-
104  IF (pos < 0) THEN
105!-- Get the information out of the file
106    CALL getfilr (TARGET,status,fileorig,tmp_ret_val)
107!-- Put the data into the database
108    CALL getdbwr (TARGET,target_sig,status,fileorig,1,tmp_ret_val)
109  ELSE
110!-- Get the value out of the database
111    CALL getdbrr (pos,1,TARGET,tmp_ret_val)
112  ENDIF
113  ret_val = tmp_ret_val(1)
114!---------------------
115END SUBROUTINE getinrs
116!-
117!===
118!-
119SUBROUTINE getinr1d (TARGET,ret_val)
120!---------------------------------------------------------------------
121!- See getinrs for details. It is the same thing but for a vector
122!---------------------------------------------------------------------
123  IMPLICIT NONE
124!-
125  CHARACTER(LEN=*) :: TARGET
126  REAL,DIMENSION(:) :: ret_val
127!-
128  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
129  INTEGER,SAVE :: tmp_ret_size = 0
130  INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
131!---------------------------------------------------------------------
132!-
133! Compute the signature of the target
134!-
135  CALL gensig (TARGET,target_sig)
136!-
137! Do we have this target in our database ?
138!-
139  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
140!-
141  size_of_in = SIZE(ret_val)
142  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
143    ALLOCATE (tmp_ret_val(size_of_in))
144  ELSE IF (size_of_in > tmp_ret_size) THEN
145    DEALLOCATE (tmp_ret_val)
146    ALLOCATE (tmp_ret_val(size_of_in))
147    tmp_ret_size = size_of_in
148  ENDIF
149  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
150!-
151  IF (pos < 0) THEN
152!-- Ge the information out of the file
153    CALL getfilr (TARGET,status,fileorig,tmp_ret_val)
154!-- Put the data into the database
155    CALL getdbwr &
156 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
157  ELSE
158!-- Get the value out of the database
159    CALL getdbrr (pos,size_of_in,TARGET,tmp_ret_val)
160  ENDIF
161  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
162!----------------------
163END SUBROUTINE getinr1d
164!-
165!===
166!-
167SUBROUTINE getinr2d (TARGET,ret_val)
168!---------------------------------------------------------------------
169!- See getinrs for details. It is the same thing but for a matrix
170!---------------------------------------------------------------------
171  IMPLICIT NONE
172!-
173  CHARACTER(LEN=*) :: TARGET
174  REAL,DIMENSION(:,:) :: ret_val
175!-
176  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
177  INTEGER,SAVE :: tmp_ret_size = 0
178  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig
179  INTEGER :: jl, jj, ji
180!---------------------------------------------------------------------
181!-
182! Compute the signature of the target
183!-
184  CALL gensig (TARGET,target_sig)
185!-
186! Do we have this target in our database ?
187!-
188  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
189!-
190  size_of_in = SIZE(ret_val)
191  size_1 = SIZE(ret_val,1)
192  size_2 = SIZE(ret_val,2)
193  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
194    ALLOCATE (tmp_ret_val(size_of_in))
195  ELSE IF (size_of_in > tmp_ret_size) THEN
196    DEALLOCATE (tmp_ret_val)
197    ALLOCATE (tmp_ret_val(size_of_in))
198    tmp_ret_size = size_of_in
199  ENDIF
200!-
201  jl=0
202  DO jj=1,size_2
203    DO ji=1,size_1
204      jl=jl+1
205      tmp_ret_val(jl) = ret_val(ji,jj)
206    ENDDO
207  ENDDO
208!-
209  IF (pos < 0) THEN
210!-- Ge the information out of the file
211    CALL getfilr (TARGET,status,fileorig,tmp_ret_val)
212!-- Put the data into the database
213    CALL getdbwr &
214 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
215  ELSE
216!-- Get the value out of the database
217    CALL getdbrr (pos,size_of_in,TARGET,tmp_ret_val)
218  ENDIF
219!-
220  jl=0
221  DO jj=1,size_2
222    DO ji=1,size_1
223      jl=jl+1
224      ret_val(ji,jj) = tmp_ret_val(jl)
225    ENDDO
226  ENDDO
227!----------------------
228END SUBROUTINE getinr2d
229!-
230!===
231!-
232SUBROUTINE getfilr (TARGET,status,fileorig,ret_val)
233!---------------------------------------------------------------------
234!- Subroutine that will extract from the file the values
235!- attributed to the keyword target
236!-
237!- REALS
238!- -----
239!-
240!- target   : in  : CHARACTER(LEN=*)  target for which we will
241!-                                    look in the file
242!- status   : out : INTEGER tells us from where we obtained the data
243!- fileorig : out : The index of the file from which the key comes
244!- ret_val  : out : REAL(nb_to_ret) values read
245!---------------------------------------------------------------------
246  IMPLICIT NONE
247!-
248  CHARACTER(LEN=*) :: TARGET
249  INTEGER :: status, fileorig
250  REAL,DIMENSION(:) :: ret_val
251!-
252  INTEGER :: nb_to_ret
253  INTEGER :: it, pos, len_str, epos, ppos, int_tmp, status_cnt
254  CHARACTER(LEN=3)  :: cnt, tl, dl
255  CHARACTER(LEN=10) :: fmt
256  CHARACTER(LEN=30) :: full_target
257  CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp
258  INTEGER :: full_target_sig
259  REAL :: compvalue
260!-
261  INTEGER,SAVE :: max_len = 0
262  LOGICAL,SAVE,ALLOCATABLE :: found(:)
263  LOGICAL,SAVE :: def_beha
264  LOGICAL :: compressed = .FALSE.
265!---------------------------------------------------------------------
266  nb_to_ret = SIZE(ret_val)
267  CALL getin_read
268!-
269! Get the variables and memory we need
270!-
271  IF (max_len == 0) THEN
272    ALLOCATE(found(nb_to_ret))
273    max_len = nb_to_ret
274  ENDIF
275  IF (max_len < nb_to_ret) THEN
276    DEALLOCATE(found)
277    ALLOCATE(found(nb_to_ret))
278    max_len = nb_to_ret
279  ENDIF
280  found(:) = .FALSE.
281!-
282! See what we find in the files read
283!-
284  DO it=1,nb_to_ret
285!---
286!-
287!-- First try the target as it is
288!---
289    full_target = TARGET(1:len_TRIM(target))
290    CALL gensig (full_target,full_target_sig)
291    CALL find_sig (nb_lines,targetlist,full_target, &
292 &                 targetsiglist,full_target_sig,pos)
293!---
294!-- Another try
295!---
296    IF (pos < 0) THEN
297      WRITE(cnt,'(I3.3)') it
298      full_target = TARGET(1:len_TRIM(target))//'__'//cnt
299      CALL gensig (full_target,full_target_sig)
300      CALL find_sig (nb_lines,targetlist,full_target, &
301 &                   targetsiglist,full_target_sig,pos)
302    ENDIF
303!---
304!-- A priori we dont know from which file the target could come.
305!-- Thus by default we attribute it to the first file :
306!---
307    fileorig = 1
308!--
309    IF (pos > 0) THEN
310!----
311      found(it) = .TRUE.
312      fileorig = fromfile(pos)
313!-----
314!---- DECODE
315!-----
316      str_READ = TRIM(ADJUSTL(fichier(pos)))
317      str_READ_lower = str_READ
318      CALL strlowercase (str_READ_lower)
319!----
320      IF (    (     (INDEX(str_READ_lower,'def') == 1)     &
321 &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    &
322 &        .OR.(     (INDEX(str_READ_lower,'default') == 1) &
323 &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN
324        def_beha = .TRUE.
325      ELSE
326        def_beha = .FALSE.
327        len_str = LEN_TRIM(str_READ)
328        epos = INDEX(str_READ,'e')
329        ppos = INDEX(str_READ,'.')
330!------
331        IF (epos > 0) THEN
332          WRITE(tl,'(I3.3)') len_str
333          WRITE(dl,'(I3.3)') epos-ppos-1
334          fmt='(e'//tl//'.'//dl//')'
335          READ(str_READ,fmt) ret_val(it)
336        ELSE IF (ppos > 0) THEN
337          WRITE(tl,'(I3.3)') len_str
338          WRITE(dl,'(I3.3)') len_str-ppos
339          fmt='(f'//tl//'.'//dl//')'
340          READ(str_READ,fmt) ret_val(it)
341        ELSE
342          WRITE(tl,'(I3.3)') len_str
343          fmt = '(I'//tl//')'
344          READ(str_READ,fmt) int_tmp
345          ret_val(it) = REAL(int_tmp)
346        ENDIF
347      ENDIF
348!----
349      targetsiglist(pos) = -1
350!-----
351!---- Is this the value of a compressed field ?
352!-----
353      IF (compline(pos) > 0) THEN
354        IF (compline(pos) == nb_to_ret) THEN
355          compressed = .TRUE.
356          compvalue = ret_val(it)
357        ELSE
358          WRITE(*,*) 'WARNING from getfilr'
359          WRITE(*,*) 'For key ',TRIM(TARGET), &
360 & ' we have a compressed field but which does not have the right size.'
361          WRITE(*,*) 'We will try to fix that '
362          compressed = .TRUE.
363          compvalue = ret_val(it)
364        ENDIF
365      ENDIF
366    ELSE
367      found(it) = .FALSE.
368    ENDIF
369  ENDDO
370!--
371! If this is a compressed field then we will uncompress it
372!--
373  IF (compressed) THEN
374    DO it=1,nb_to_ret
375      IF (.NOT. found(it)) THEN
376        ret_val(it) = compvalue
377        found(it) = .TRUE.
378      ENDIF
379    ENDDO
380  ENDIF
381!-
382! Now we get the status for what we found
383!-
384  IF (def_beha) THEN
385    status = 2
386    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET)
387  ELSE
388    status_cnt = 0
389    DO it=1,nb_to_ret
390      IF (.NOT. found(it)) THEN
391        status_cnt = status_cnt+1
392        IF (nb_to_ret > 1) THEN
393          WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it
394        ELSE
395          str_tmp = TRIM(TARGET)
396        ENDIF
397        WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it)
398      ENDIF
399    ENDDO
400!---
401    IF (status_cnt == 0) THEN
402      status = 1
403    ELSE IF (status_cnt == nb_to_ret) THEN
404      status = 2
405    ELSE
406      status = 3
407    ENDIF
408  ENDIF
409!---------------------
410END SUBROUTINE getfilr
411!-
412!=== INTEGER INTERFACES
413!-
414SUBROUTINE getinis (TARGET,ret_val)
415!---------------------------------------------------------------------
416!- Get a interer scalar. We first check if we find it
417!- in the database and if not we get it from the run.def
418!-
419!- getini1d and getini2d are written on the same pattern
420!---------------------------------------------------------------------
421  IMPLICIT NONE
422!-
423  CHARACTER(LEN=*) :: TARGET
424  INTEGER :: ret_val
425!-
426  INTEGER,DIMENSION(1) :: tmp_ret_val
427  INTEGER :: target_sig, pos, status=0, fileorig
428!---------------------------------------------------------------------
429!-
430! Compute the signature of the target
431!-
432  CALL gensig (TARGET,target_sig)
433!-
434! Do we have this target in our database ?
435!-
436  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
437!-
438  tmp_ret_val(1) = ret_val
439!-
440  IF (pos < 0) THEN
441!-- Ge the information out of the file
442    CALL getfili (TARGET,status,fileorig,tmp_ret_val)
443!-- Put the data into the database
444    CALL getdbwi (TARGET,target_sig,status,fileorig,1,tmp_ret_val)
445    ELSE
446!-- Get the value out of the database
447    CALL getdbri (pos,1,TARGET,tmp_ret_val)
448  ENDIF
449  ret_val = tmp_ret_val(1)
450!---------------------
451END SUBROUTINE getinis
452!-
453!===
454!-
455SUBROUTINE getini1d (TARGET,ret_val)
456!---------------------------------------------------------------------
457!- See getinis for details. It is the same thing but for a vector
458!---------------------------------------------------------------------
459  IMPLICIT NONE
460!-
461  CHARACTER(LEN=*) :: TARGET
462  INTEGER,DIMENSION(:) :: ret_val
463!-
464  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
465  INTEGER,SAVE :: tmp_ret_size = 0
466  INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
467!---------------------------------------------------------------------
468!-
469! Compute the signature of the target
470!-
471  CALL gensig (TARGET,target_sig)
472!-
473! Do we have this target in our database ?
474!-
475  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
476!-
477  size_of_in = SIZE(ret_val)
478  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
479    ALLOCATE (tmp_ret_val(size_of_in))
480  ELSE IF (size_of_in > tmp_ret_size) THEN
481    DEALLOCATE (tmp_ret_val)
482    ALLOCATE (tmp_ret_val(size_of_in))
483    tmp_ret_size = size_of_in
484  ENDIF
485  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
486!-
487  IF (pos < 0) THEN
488!-- Ge the information out of the file
489    CALL getfili (TARGET,status,fileorig,tmp_ret_val)
490!-- Put the data into the database
491    CALL getdbwi &
492 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
493  ELSE
494!-- Get the value out of the database
495    CALL getdbri (pos,size_of_in,TARGET,tmp_ret_val)
496  ENDIF
497  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
498!----------------------
499END SUBROUTINE getini1d
500!-
501!===
502!-
503SUBROUTINE getini2d (TARGET,ret_val)
504!---------------------------------------------------------------------
505!- See getinis for details. It is the same thing but for a matrix
506!---------------------------------------------------------------------
507  IMPLICIT NONE
508!-
509  CHARACTER(LEN=*) :: TARGET
510  INTEGER,DIMENSION(:,:) :: ret_val
511!-
512  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
513  INTEGER,SAVE :: tmp_ret_size = 0
514  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig
515  INTEGER :: jl, jj, ji
516!---------------------------------------------------------------------
517!-
518! Compute the signature of the target
519!-
520  CALL gensig (TARGET,target_sig)
521!-
522! Do we have this target in our database ?
523!-
524  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,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!-- Ge the information out of the file
547    CALL getfili (TARGET,status,fileorig,tmp_ret_val)
548!-- Put the data into the database
549    CALL getdbwi &
550 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
551  ELSE
552!-- Get the value out of the database
553    CALL getdbri (pos,size_of_in,TARGET,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!----------------------
564END SUBROUTINE getini2d
565!-
566!===
567!-
568SUBROUTINE getfili (TARGET,status,fileorig,ret_val)
569!---------------------------------------------------------------------
570!- Subroutine that will extract from the file the values
571!- attributed to the keyword target
572!-
573!- INTEGER
574!- -------
575!-
576!- target   : in  : CHARACTER(LEN=*)  target for which we will
577!-                                    look in the file
578!- status   : out : INTEGER tells us from where we obtained the data
579!- fileorig : out : The index of the file from which the key comes
580!- ret_val  : out : INTEGER(nb_to_ret) values read
581!---------------------------------------------------------------------
582  IMPLICIT NONE
583!-
584  CHARACTER(LEN=*) :: TARGET
585  INTEGER :: status, fileorig
586  INTEGER :: ret_val(:)
587!-
588  INTEGER :: nb_to_ret
589  INTEGER :: it, pos, len_str, status_cnt
590  CHARACTER(LEN=3)  :: cnt, chlen
591  CHARACTER(LEN=10) ::  fmt
592  CHARACTER(LEN=30) :: full_target
593  CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp
594  INTEGER :: full_target_sig
595  INTEGER :: compvalue
596!-
597  INTEGER,SAVE :: max_len = 0
598  LOGICAL,SAVE,ALLOCATABLE :: found(:)
599  LOGICAL,SAVE :: def_beha
600  LOGICAL :: compressed = .FALSE.
601!---------------------------------------------------------------------
602  nb_to_ret = SIZE(ret_val)
603  CALL getin_read
604!-
605! Get the variables and memory we need
606!-
607  IF (max_len == 0) THEN
608    ALLOCATE(found(nb_to_ret))
609    max_len = nb_to_ret
610  ENDIF
611  IF (max_len < nb_to_ret) THEN
612    DEALLOCATE(found)
613    ALLOCATE(found(nb_to_ret))
614    max_len = nb_to_ret
615  ENDIF
616  found(:) = .FALSE.
617!-
618! See what we find in the files read
619!-
620  DO it=1,nb_to_ret
621!---
622!-- First try the target as it is
623!---
624    full_target = TARGET(1:len_TRIM(target))
625    CALL gensig (full_target,full_target_sig)
626    CALL find_sig (nb_lines,targetlist,full_target, &
627 &                 targetsiglist,full_target_sig,pos)
628!---
629!-- Another try
630!---
631    IF (pos < 0) THEN
632      WRITE(cnt,'(I3.3)') it
633      full_target = TARGET(1:len_TRIM(target))//'__'//cnt
634      CALL gensig (full_target,full_target_sig)
635      CALL find_sig (nb_lines,targetlist,full_target, &
636 &                   targetsiglist,full_target_sig,pos)
637    ENDIF
638!---
639!-- A priori we dont know from which file the target could come.
640!-- Thus by default we attribute it to the first file :
641!---
642    fileorig = 1
643!-
644    IF (pos > 0) THEN
645!-----
646      found(it) = .TRUE.
647      fileorig = fromfile(pos)
648!-----
649!---- DECODE
650!----
651      str_READ = TRIM(ADJUSTL(fichier(pos)))
652      str_READ_lower = str_READ
653      CALL strlowercase (str_READ_lower)
654!-----
655      IF (    (     (INDEX(str_READ_lower,'def') == 1)     &
656 &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    &
657 &        .OR.(     (INDEX(str_READ_lower,'default') == 1) &
658 &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN
659        def_beha = .TRUE.
660      ELSE
661        def_beha = .FALSE.
662        len_str = LEN_TRIM(str_READ)
663        WRITE(chlen,'(I3.3)') len_str
664        fmt = '(I'//chlen//')'
665        READ(str_READ,fmt) ret_val(it)
666      ENDIF
667!-----
668      targetsiglist(pos) = -1
669!-----
670!---- Is this the value of a compressed field ?
671!-----
672      IF (compline(pos) > 0) THEN
673        IF (compline(pos) == nb_to_ret) THEN
674          compressed = .TRUE.
675          compvalue = ret_val(it)
676        ELSE
677          WRITE(*,*) 'WARNING from getfilr'
678          WRITE(*,*) 'For key ',TRIM(TARGET), &
679 & ' we have a compressed field but which does not have the right size.'
680          WRITE(*,*) 'We will try to fix that '
681          compressed = .TRUE.
682          compvalue = ret_val(it)
683        ENDIF
684      ENDIF
685    ELSE
686      found(it) = .FALSE.
687    ENDIF
688  ENDDO
689!-
690! If this is a compressed field then we will uncompress it
691!-
692  IF (compressed) THEN
693    DO it=1,nb_to_ret
694      IF (.NOT. found(it)) THEN
695        ret_val(it) = compvalue
696        found(it) = .TRUE.
697      ENDIF
698    ENDDO
699  ENDIF
700!-
701! Now we get the status for what we found
702!-
703  IF (def_beha) THEN
704    status = 2
705    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET)
706  ELSE
707    status_cnt = 0
708    DO it=1,nb_to_ret
709      IF (.NOT. found(it)) THEN
710        status_cnt = status_cnt+1
711        IF (nb_to_ret > 1) THEN
712          WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it
713        ELSE
714          str_tmp = TRIM(TARGET)
715        ENDIF
716        WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it)
717      ENDIF
718    ENDDO
719!---
720    IF (status_cnt == 0) THEN
721      status = 1
722    ELSE IF (status_cnt == nb_to_ret) THEN
723      status = 2
724    ELSE
725      status = 3
726    ENDIF
727  ENDIF
728!---------------------
729END SUBROUTINE getfili
730!-
731!=== CHARACTER INTERFACES
732!-
733SUBROUTINE getincs (TARGET,ret_val)
734!---------------------------------------------------------------------
735!- Get a CHARACTER scalar. We first check if we find it
736!- in the database and if not we get it from the run.def
737!-
738!- getinc1d and getinc2d are written on the same pattern
739!---------------------------------------------------------------------
740  IMPLICIT NONE
741!-
742  CHARACTER(LEN=*) :: TARGET
743  CHARACTER(LEN=*) :: ret_val
744!-
745  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
746  INTEGER :: target_sig, pos, status=0, fileorig
747!---------------------------------------------------------------------
748!-
749! Compute the signature of the target
750!-
751  CALL gensig (TARGET,target_sig)
752!-
753! Do we have this target in our database ?
754!-
755  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
756!-
757  tmp_ret_val(1) = ret_val
758!-
759  IF (pos < 0) THEN
760!-- Ge the information out of the file
761    CALL getfilc (TARGET,status,fileorig,tmp_ret_val)
762!-- Put the data into the database
763    CALL getdbwc (TARGET,target_sig,status,fileorig,1,tmp_ret_val)
764  ELSE
765!-- Get the value out of the database
766    CALL getdbrc (pos,1,TARGET,tmp_ret_val)
767  ENDIF
768  ret_val = tmp_ret_val(1)
769!---------------------
770END SUBROUTINE getincs
771!-
772!===
773!-
774SUBROUTINE getinc1d (TARGET,ret_val)
775!---------------------------------------------------------------------
776!- See getincs for details. It is the same thing but for a vector
777!---------------------------------------------------------------------
778  IMPLICIT NONE
779!-
780  CHARACTER(LEN=*) :: TARGET
781  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
782!-
783  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
784  INTEGER,SAVE :: tmp_ret_size = 0
785  INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
786!---------------------------------------------------------------------
787!-
788! Compute the signature of the target
789!-
790  CALL gensig (TARGET,target_sig)
791!-
792! Do we have this target in our database ?
793!-
794  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
795!-
796  size_of_in = SIZE(ret_val)
797  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
798    ALLOCATE (tmp_ret_val(size_of_in))
799  ELSE IF (size_of_in > tmp_ret_size) THEN
800    DEALLOCATE (tmp_ret_val)
801    ALLOCATE (tmp_ret_val(size_of_in))
802    tmp_ret_size = size_of_in
803  ENDIF
804  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
805!-
806  IF (pos < 0) THEN
807!-- Ge the information out of the file
808    CALL getfilc (TARGET,status,fileorig,tmp_ret_val)
809!-- Put the data into the database
810    CALL getdbwc &
811 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
812  ELSE
813!-- Get the value out of the database
814    CALL getdbrc (pos,size_of_in,TARGET,tmp_ret_val)
815  ENDIF
816  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
817!----------------------
818END SUBROUTINE getinc1d
819!-
820!===
821!-
822SUBROUTINE getinc2d (TARGET,ret_val)
823!---------------------------------------------------------------------
824!- See getincs for details. It is the same thing but for a matrix
825!---------------------------------------------------------------------
826  IMPLICIT NONE
827!-
828  CHARACTER(LEN=*) :: TARGET
829  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
830!-
831  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
832  INTEGER,SAVE :: tmp_ret_size = 0
833  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig
834  INTEGER :: jl,jj,ji
835!---------------------------------------------------------------------
836!-
837! Compute the signature of the target
838!-
839  CALL gensig (TARGET,target_sig)
840!-
841! Do we have this target in our database ?
842!-
843  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
844!-
845  size_of_in = SIZE(ret_val)
846  size_1 = SIZE(ret_val,1)
847  size_2 = SIZE(ret_val,2)
848  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
849    ALLOCATE (tmp_ret_val(size_of_in))
850  ELSE IF (size_of_in > tmp_ret_size) THEN
851    DEALLOCATE (tmp_ret_val)
852    ALLOCATE (tmp_ret_val(size_of_in))
853    tmp_ret_size = size_of_in
854  ENDIF
855!-
856  jl=0
857  DO jj=1,size_2
858    DO ji=1,size_1
859      jl=jl+1
860      tmp_ret_val(jl) = ret_val(ji,jj)
861    ENDDO
862  ENDDO
863!-
864  IF (pos < 0) THEN
865!-- Ge the information out of the file
866    CALL getfilc (TARGET,status,fileorig,tmp_ret_val)
867!-- Put the data into the database
868    CALL getdbwc &
869 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
870  ELSE
871!-- Get the value out of the database
872    CALL getdbrc (pos,size_of_in,TARGET,tmp_ret_val)
873  ENDIF
874!-
875  jl=0
876  DO jj=1,size_2
877    DO ji=1,size_1
878      jl=jl+1
879      ret_val(ji,jj) = tmp_ret_val(jl)
880    ENDDO
881  ENDDO
882!----------------------
883END SUBROUTINE getinc2d
884!-
885!===
886!-
887SUBROUTINE getfilc (TARGET,status,fileorig,ret_val)
888!---------------------------------------------------------------------
889!- Subroutine that will extract from the file the values
890!- attributed to the keyword target
891!-
892!- CHARACTER
893!- ---------
894!-
895!- target   : in  : CHARACTER(LEN=*)  target for which we will
896!-                                    look in the file
897!- status   : out : INTEGER tells us from where we obtained the data
898!- fileorig : out : The index of the file from which the key comes
899!- ret_val  : out : CHARACTER(nb_to_ret) values read
900!---------------------------------------------------------------------
901  IMPLICIT NONE
902!-
903!-
904  CHARACTER(LEN=*) :: TARGET
905  INTEGER :: status, fileorig
906  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
907!-
908  INTEGER :: nb_to_ret
909  INTEGER :: it, pos, len_str, status_cnt
910  CHARACTER(LEN=3)  :: cnt
911  CHARACTER(LEN=30) :: full_target
912  CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp
913  INTEGER :: full_target_sig
914!-
915  INTEGER,SAVE :: max_len = 0
916  LOGICAL,DIMENSION(:),SAVE,ALLOCATABLE :: found
917  LOGICAL,SAVE :: def_beha
918!---------------------------------------------------------------------
919  nb_to_ret = SIZE(ret_val)
920  CALL getin_read
921!-
922! Get the variables and memory we need
923!-
924  IF (max_len == 0) THEN
925    ALLOCATE(found(nb_to_ret))
926    max_len = nb_to_ret
927  ENDIF
928  IF (max_len < nb_to_ret) THEN
929    DEALLOCATE(found)
930    ALLOCATE(found(nb_to_ret))
931    max_len = nb_to_ret
932  ENDIF
933  found(:) = .FALSE.
934!-
935! See what we find in the files read
936!-
937  DO it=1,nb_to_ret
938!---
939!-- First try the target as it is
940    full_target = TARGET(1:len_TRIM(target))
941    CALL gensig (full_target,full_target_sig)
942    CALL find_sig (nb_lines,targetlist,full_target, &
943 &                 targetsiglist,full_target_sig,pos)
944!---
945!-- Another try
946!---
947    IF (pos < 0) THEN
948      WRITE(cnt,'(I3.3)') it
949      full_target = TARGET(1:len_TRIM(target))//'__'//cnt
950      CALL gensig (full_target,full_target_sig)
951      CALL find_sig (nb_lines,targetlist,full_target, &
952 &                   targetsiglist,full_target_sig,pos)
953    ENDIF
954!---
955!-- A priori we dont know from which file the target could come.
956!-- Thus by default we attribute it to the first file :
957!---
958    fileorig = 1
959!---
960    IF (pos > 0) THEN
961!-----
962      found(it) = .TRUE.
963      fileorig = fromfile(pos)
964!-----
965!---- DECODE
966!-----
967      str_READ = TRIM(ADJUSTL(fichier(pos)))
968      str_READ_lower = str_READ
969      CALL strlowercase (str_READ_lower)
970!-----
971      IF (    (     (INDEX(str_READ_lower,'def') == 1)     &
972 &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    &
973 &        .OR.(     (INDEX(str_READ_lower,'default') == 1) &
974 &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN
975        def_beha = .TRUE.
976      ELSE
977        def_beha = .FALSE.
978        len_str = LEN_TRIM(str_READ)
979        ret_val(it) = str_READ(1:len_str)
980      ENDIF
981!-----
982      targetsiglist(pos) = -1
983!-----
984    ELSE
985      found(it) = .FALSE.
986    ENDIF
987  ENDDO
988!-
989! Now we get the status for what we found
990!-
991  IF (def_beha) THEN
992    status = 2
993    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET)
994  ELSE
995    status_cnt = 0
996    DO it=1,nb_to_ret
997      IF (.NOT. found(it)) THEN
998        status_cnt = status_cnt+1
999        IF (nb_to_ret > 1) THEN
1000          WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it
1001        ELSE
1002          str_tmp = TARGET(1:len_TRIM(target))
1003        ENDIF
1004        WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it)
1005      ENDIF
1006    ENDDO
1007!-
1008    IF (status_cnt == 0) THEN
1009      status = 1
1010    ELSE IF (status_cnt == nb_to_ret) THEN
1011      status = 2
1012    ELSE
1013      status = 3
1014    ENDIF
1015  ENDIF
1016!---------------------
1017END SUBROUTINE getfilc
1018!-
1019!=== LOGICAL INTERFACES
1020!-
1021SUBROUTINE getinls (TARGET,ret_val)
1022!---------------------------------------------------------------------
1023!- Get a logical scalar. We first check if we find it
1024!- in the database and if not we get it from the run.def
1025!-
1026!- getinl1d and getinl2d are written on the same pattern
1027!---------------------------------------------------------------------
1028  IMPLICIT NONE
1029!-
1030  CHARACTER(LEN=*) :: TARGET
1031  LOGICAL :: ret_val
1032!-
1033  LOGICAL,DIMENSION(1) :: tmp_ret_val
1034  INTEGER :: target_sig, pos, status=0, fileorig
1035!---------------------------------------------------------------------
1036!-
1037! Compute the signature of the target
1038!-
1039  CALL gensig (TARGET,target_sig)
1040!-
1041! Do we have this target in our database ?
1042!-
1043  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
1044!-
1045  tmp_ret_val(1) = ret_val
1046!-
1047  IF (pos < 0) THEN
1048!-- Ge the information out of the file
1049    CALL getfill (TARGET,status,fileorig,tmp_ret_val)
1050!-- Put the data into the database
1051    CALL getdbwl (TARGET,target_sig,status,fileorig,1,tmp_ret_val)
1052  ELSE
1053!-- Get the value out of the database
1054    CALL getdbrl (pos,1,TARGET,tmp_ret_val)
1055  ENDIF
1056  ret_val = tmp_ret_val(1)
1057!---------------------
1058END SUBROUTINE getinls
1059!-
1060!===
1061!-
1062SUBROUTINE getinl1d (TARGET,ret_val)
1063!---------------------------------------------------------------------
1064!- See getinls for details. It is the same thing but for a vector
1065!---------------------------------------------------------------------
1066  IMPLICIT NONE
1067!-
1068  CHARACTER(LEN=*) :: TARGET
1069  LOGICAL,DIMENSION(:) :: ret_val
1070!-
1071  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
1072  INTEGER,SAVE :: tmp_ret_size = 0
1073  INTEGER :: target_sig, pos, size_of_in, status=0, fileorig
1074!---------------------------------------------------------------------
1075!-
1076! Compute the signature of the target
1077!-
1078  CALL gensig (TARGET,target_sig)
1079!-
1080! Do we have this target in our database ?
1081!-
1082  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
1083!-
1084  size_of_in = SIZE(ret_val)
1085  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
1086    ALLOCATE (tmp_ret_val(size_of_in))
1087  ELSE IF (size_of_in > tmp_ret_size) THEN
1088    DEALLOCATE (tmp_ret_val)
1089    ALLOCATE (tmp_ret_val(size_of_in))
1090    tmp_ret_size = size_of_in
1091  ENDIF
1092  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
1093!-
1094  IF (pos < 0) THEN
1095!-- Ge the information out of the file
1096    CALL getfill (TARGET,status,fileorig,tmp_ret_val)
1097!-- Put the data into the database
1098    CALL getdbwl &
1099 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
1100  ELSE
1101!-- Get the value out of the database
1102    CALL getdbrl (pos,size_of_in,TARGET,tmp_ret_val)
1103  ENDIF
1104  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
1105!----------------------
1106END SUBROUTINE getinl1d
1107!-
1108!===
1109!-
1110SUBROUTINE getinl2d (TARGET,ret_val)
1111!---------------------------------------------------------------------
1112!- See getinls for details. It is the same thing but for a matrix
1113!---------------------------------------------------------------------
1114  IMPLICIT NONE
1115!-
1116  CHARACTER(LEN=*) :: TARGET
1117  LOGICAL,DIMENSION(:,:) :: ret_val
1118!-
1119  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
1120  INTEGER,SAVE :: tmp_ret_size = 0
1121  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig
1122  INTEGER :: jl,jj,ji
1123!---------------------------------------------------------------------
1124!-
1125! Compute the signature of the target
1126!-
1127  CALL gensig (TARGET,target_sig)
1128!-
1129! Do we have this target in our database ?
1130!-
1131  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos)
1132!-
1133  size_of_in = SIZE(ret_val)
1134  size_1 = SIZE(ret_val,1)
1135  size_2 = SIZE(ret_val,2)
1136  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
1137    ALLOCATE (tmp_ret_val(size_of_in))
1138  ELSE IF (size_of_in > tmp_ret_size) THEN
1139    DEALLOCATE (tmp_ret_val)
1140    ALLOCATE (tmp_ret_val(size_of_in))
1141    tmp_ret_size = size_of_in
1142  ENDIF
1143!-
1144  jl=0
1145  DO jj=1,size_2
1146    DO ji=1,size_1
1147      jl=jl+1
1148      tmp_ret_val(jl) = ret_val(ji,jj)
1149    ENDDO
1150  ENDDO
1151!-
1152  IF (pos < 0) THEN
1153!-- Ge the information out of the file
1154    CALL getfill (TARGET,status,fileorig,tmp_ret_val)
1155!-- Put the data into the database
1156    CALL getdbwl &
1157 &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val)
1158  ELSE
1159!-- Get the value out of the database
1160    CALL getdbrl (pos,size_of_in,TARGET,tmp_ret_val)
1161  ENDIF
1162!-
1163  jl=0
1164  DO jj=1,size_2
1165    DO ji=1,size_1
1166      jl=jl+1
1167      ret_val(ji,jj) = tmp_ret_val(jl)
1168    ENDDO
1169  ENDDO
1170!----------------------
1171END SUBROUTINE getinl2d
1172!-
1173!===
1174!-
1175SUBROUTINE getfill (TARGET,status,fileorig,ret_val)
1176!---------------------------------------------------------------------
1177!- Subroutine that will extract from the file the values
1178!- attributed to the keyword target
1179!-
1180!- LOGICAL
1181!- -------
1182!-
1183!- target   : in  : CHARACTER(LEN=*)  target for which we will
1184!-                                    look in the file
1185!- status   : out : INTEGER tells us from where we obtained the data
1186!- fileorig : out : The index of the file from which the key comes
1187!- ret_val  : out : LOGICAL(nb_to_ret) values read
1188!---------------------------------------------------------------------
1189  IMPLICIT NONE
1190!-
1191  CHARACTER(LEN=*) :: TARGET
1192  INTEGER :: status, fileorig
1193  LOGICAL,DIMENSION(:) :: ret_val
1194!-
1195  INTEGER :: nb_to_ret
1196  INTEGER :: it, pos, len_str, ipos_tr, ipos_fl, status_cnt
1197  CHARACTER(LEN=3)  :: cnt
1198  CHARACTER(LEN=30) :: full_target
1199  CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp
1200  INTEGER :: full_target_sig
1201!-
1202  INTEGER,SAVE :: max_len = 0
1203  LOGICAL,DIMENSION(:),SAVE,ALLOCATABLE :: found
1204  LOGICAL,SAVE :: def_beha
1205!---------------------------------------------------------------------
1206  nb_to_ret = SIZE(ret_val)
1207  CALL getin_read
1208!-
1209! Get the variables and memory we need
1210!-
1211  IF (max_len == 0) THEN
1212    ALLOCATE(found(nb_to_ret))
1213    max_len = nb_to_ret
1214  ENDIF
1215  IF (max_len < nb_to_ret) THEN
1216    DEALLOCATE(found)
1217    ALLOCATE(found(nb_to_ret))
1218    max_len = nb_to_ret
1219  ENDIF
1220  found(:) = .FALSE.
1221!-
1222! See what we find in the files read
1223!-
1224  DO it=1,nb_to_ret
1225!---
1226!-- First try the target as it is
1227!---
1228    full_target = TARGET(1:len_TRIM(target))
1229    CALL gensig (full_target,full_target_sig)
1230    CALL find_sig (nb_lines,targetlist,full_target, &
1231 &                 targetsiglist,full_target_sig,pos)
1232!---
1233!-- Another try
1234!---
1235    IF (pos < 0) THEN
1236      WRITE(cnt,'(I3.3)') it
1237      full_target = TARGET(1:len_TRIM(target))//'__'//cnt
1238      CALL gensig (full_target,full_target_sig)
1239      CALL find_sig (nb_lines,targetlist,full_target, &
1240 &                   targetsiglist,full_target_sig,pos)
1241    ENDIF
1242!---
1243!-- A priori we dont know from which file the target could come.
1244!-- Thus by default we attribute it to the first file :
1245!---
1246    fileorig = 1
1247!---
1248    IF (pos > 0) THEN
1249!-----
1250      found(it) = .TRUE.
1251      fileorig = fromfile(pos)
1252!-----
1253!---- DECODE
1254!-----
1255      str_READ = TRIM(ADJUSTL(fichier(pos)))
1256      str_READ_lower = str_READ
1257      CALL strlowercase (str_READ_lower)
1258!-----
1259      IF (    (     (INDEX(str_READ_lower,'def') == 1)     &
1260 &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    &
1261 &        .OR.(     (INDEX(str_READ_lower,'default') == 1) &
1262 &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN
1263        def_beha = .TRUE.
1264      ELSE
1265        def_beha = .FALSE.
1266        len_str = LEN_TRIM(str_READ)
1267        ipos_tr = -1
1268        ipos_fl = -1
1269!-------
1270        ipos_tr = MAX(INDEX(str_READ,'tru'),INDEX(str_READ,'TRU'), &
1271 &                    INDEX(str_READ,'y'),INDEX(str_READ,'Y'))
1272        ipos_fl = MAX(INDEX(str_READ,'fal'),INDEX(str_READ,'FAL'), &
1273 &                    INDEX(str_READ,'n'),INDEX(str_READ,'N'))
1274!-------
1275        IF (ipos_tr > 0) THEN
1276          ret_val(it) = .TRUE.
1277        ELSE IF (ipos_fl > 0) THEN
1278          ret_val(it) = .FALSE.
1279        ELSE
1280          WRITE(*,*) "ERROR : getfill : TARGET ", &
1281 &                   TRIM(TARGET)," is not of logical value"
1282          STOP 'getinl'
1283        ENDIF
1284      ENDIF
1285!-----
1286      targetsiglist(pos) = -1
1287!-----
1288    ELSE
1289!-
1290      found(it) = .FALSE.
1291!-
1292    ENDIF
1293!-
1294  ENDDO
1295!-
1296! Now we get the status for what we found
1297!-
1298  IF (def_beha) THEN
1299    status = 2
1300    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET)
1301  ELSE
1302    status_cnt = 0
1303    DO it=1,nb_to_ret
1304      IF (.NOT. found(it)) THEN
1305        status_cnt = status_cnt+1
1306        IF (nb_to_ret > 1) THEN
1307          WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it
1308        ELSE
1309          str_tmp = TRIM(TARGET)
1310        ENDIF
1311        WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it)
1312      ENDIF
1313    ENDDO
1314!---
1315    IF (status_cnt == 0) THEN
1316      status = 1
1317    ELSE IF (status_cnt == nb_to_ret) THEN
1318      status = 2
1319    ELSE
1320      status = 3
1321    ENDIF
1322  ENDIF
1323!---------------------
1324END SUBROUTINE getfill
1325!-
1326!===
1327!-
1328SUBROUTINE getin_read
1329!---------------------------------------------------------------------
1330  IMPLICIT NONE
1331!-
1332  INTEGER,SAVE :: allread=0
1333  INTEGER,SAVE :: current,i
1334!---------------------------------------------------------------------
1335  IF (allread == 0) THEN
1336!-- Allocate a first set of memory.
1337    CALL getin_allockeys
1338    CALL getin_allocmem (1,0)
1339    CALL getin_allocmem (2,0)
1340    CALL getin_allocmem (3,0)
1341    CALL getin_allocmem (4,0)
1342!-- Start with reading the files
1343    nbfiles = 1
1344    filelist(1) = 'run.def'
1345    current = 1
1346    nb_lines = 0
1347!--
1348    DO WHILE (current <= nbfiles)
1349      CALL getin_readdef (current)
1350      current = current+1
1351    ENDDO
1352    allread = 1
1353    CALL getin_checkcohe ()
1354  ENDIF
1355!------------------------
1356END SUBROUTINE getin_read
1357!-
1358!===
1359!-
1360  SUBROUTINE getin_readdef(current)
1361!---------------------------------------------------------------------
1362!- This subroutine will read the files and only keep the
1363!- the relevant information. The information is kept as it
1364!- found in the file. The data will be analysed later.
1365!---------------------------------------------------------------------
1366  IMPLICIT NONE
1367!-
1368  INTEGER :: current
1369!-
1370  CHARACTER(LEN=100) :: READ_str, NEW_str, new_key, last_key, key_str
1371  CHARACTER(LEN=3) :: cnt
1372  INTEGER :: nb_lastkey
1373!-
1374  INTEGER :: eof, ptn, len_str, i, it, iund
1375  LOGICAL :: check = .FALSE.
1376!---------------------------------------------------------------------
1377  eof = 0
1378  ptn = 1
1379  nb_lastkey = 0
1380!-
1381  IF (check) THEN
1382    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
1383  ENDIF
1384!-
1385  OPEN (22,file=filelist(current),ERR=9997,STATUS="OLD")
1386!-
1387  DO WHILE (eof /= 1)
1388!---
1389    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
1390    len_str = LEN_TRIM(READ_str)
1391    ptn = INDEX(READ_str,'=')
1392!---
1393    IF (ptn > 0) THEN
1394!---- Get the target
1395      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
1396!---- Make sure that if a vector keyword has the right length
1397      iund =  INDEX(key_str,'__')
1398      IF (iund > 0) THEN
1399        SELECTCASE( len_trim(key_str)-iund )
1400          CASE(2)
1401            READ(key_str(iund+2:len_trim(key_str)),'(I1)') it
1402          CASE(3)
1403            READ(key_str(iund+2:len_trim(key_str)),'(I2)') it
1404          CASE(4)
1405            READ(key_str(iund+2:len_trim(key_str)),'(I3)') it
1406          CASE DEFAULT
1407            it = -1
1408        END SELECT
1409        IF (it > 0) THEN
1410          WRITE(cnt,'(I3.3)') it
1411          key_str = key_str(1:iund+1)//cnt
1412        ELSE
1413          WRITE(*,*) &
1414 &          'getin_readdef : A very strange key has just been found'
1415          WRITE(*,*) 'getin_readdef : ',key_str(1:len_TRIM(key_str))
1416          STOP 'getin_readdef'
1417        ENDIF
1418      ENDIF
1419!---- Prepare the content
1420      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
1421      CALL nocomma (NEW_str)
1422      CALL cmpblank (NEW_str)
1423      NEW_str  = TRIM(ADJUSTL(NEW_str))
1424      IF (check) THEN
1425        WRITE(*,*) &
1426 &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
1427      ENDIF
1428!---- Decypher the content of NEW_str
1429!-
1430!---- This has to be a new key word, thus :
1431      nb_lastkey = 0
1432!----
1433      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
1434!----
1435    ELSE IF (len_str > 0) THEN
1436!---- Prepare the key if we have an old one to which
1437!---- we will add the line just read
1438      IF (nb_lastkey > 0) THEN
1439        iund =  INDEX(last_key,'__')
1440        IF (iund > 0) THEN
1441!-------- We only continue a keyword, thus it is easy
1442          key_str = last_key(1:iund-1)
1443        ELSE
1444          IF (nb_lastkey /= 1) THEN
1445            WRITE(*,*) &
1446 &   'getin_readdef : An error has occured. We can not have a scalar'
1447            WRITE(*,*) 'getin_readdef : keywod and a vector content'
1448            STOP 'getin_readdef'
1449          ENDIF
1450!-------- The last keyword needs to be transformed into a vector.
1451          targetlist(nb_lines) = &
1452 &          last_key(1:MIN(len_trim(last_key),30))//'__001'
1453          CALL gensig (targetlist(nb_lines),targetsiglist(nb_lines))
1454          key_str = last_key(1:len_TRIM(last_key))
1455        ENDIF
1456      ENDIF
1457!---- Prepare the content
1458      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
1459      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
1460    ELSE
1461!---- If we have an empty line the the keyword finishes
1462      nb_lastkey = 0
1463      IF (check) THEN
1464        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
1465      ENDIF
1466    ENDIF
1467  ENDDO
1468!-
1469  CLOSE(22)
1470!-
1471  IF (check) THEN
1472    OPEN (22,file='run.def.test')
1473    DO i=1,nb_lines
1474      WRITE(22,*) targetlist(i)," : ",fichier(i)
1475    ENDDO
1476    CLOSE(22)
1477  ENDIF
1478!-
1479  RETURN
1480!-
14819997 WRITE(*,*) "getin_readdef : Could not open file ", &
1482          & TRIM(filelist(current))
1483!---------------------------
1484END SUBROUTINE getin_readdef
1485!-
1486!===
1487!-
1488SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
1489!---------------------------------------------------------------------
1490!- This subroutine is going to decypher the line.
1491!- It essentialy checks how many items are included and
1492!- it they can be attached to a key.
1493!---------------------------------------------------------------------
1494  IMPLICIT NONE
1495!-
1496! ARGUMENTS
1497!-
1498  INTEGER :: current, nb_lastkey
1499  CHARACTER(LEN=*) :: key_str, NEW_str, last_key
1500!-
1501! LOCAL
1502!-
1503  INTEGER :: len_str, blk, nbve, starpos
1504  CHARACTER(LEN=100) :: tmp_str, new_key, mult
1505  CHARACTER(LEN=3)   :: cnt, chlen
1506  CHARACTER(LEN=10)  :: fmt
1507!---------------------------------------------------------------------
1508  len_str = LEN_TRIM(NEW_str)
1509  blk = INDEX(NEW_str(1:len_str),' ')
1510  tmp_str = NEW_str(1:len_str)
1511!-
1512! If the key is a new file then we take it up. Else
1513! we save the line and go on.
1514!-
1515  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
1516    DO WHILE (blk > 0)
1517      IF (nbfiles+1 > max_files) THEN
1518        WRITE(*,*) 'FATAL ERROR : Too many files to include'
1519        STOP 'getin_readdef'
1520      ENDIF
1521!-----
1522      nbfiles = nbfiles+1
1523      filelist(nbfiles) = tmp_str(1:blk)
1524!-----
1525      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
1526      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
1527    ENDDO
1528!---
1529    IF (nbfiles+1 > max_files) THEN
1530      WRITE(*,*) 'FATAL ERROR : Too many files to include'
1531      STOP 'getin_readdef'
1532    ENDIF
1533!---
1534    nbfiles =  nbfiles+1
1535    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
1536!---
1537    last_key = 'INCLUDEDEF'
1538    nb_lastkey = 1
1539  ELSE
1540!-
1541!-- We are working on a new line of input
1542!-
1543    nb_lines = nb_lines+1
1544    IF (nb_lines > max_lines) THEN
1545      WRITE(*,*) &
1546 &      'Too many line in the run.def files. You need to increase'
1547      WRITE(*,*) 'the parameter max_lines in the module getincom.'
1548      STOP 'getin_decrypt'
1549    ENDIF
1550!-
1551!-- First we solve the issue of conpressed information. Once
1552!-- this is done all line can be handled in the same way.
1553!-
1554    starpos = INDEX(NEW_str(1:len_str),'*')
1555    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
1556 &                    .AND.(tmp_str(1:1) /= "'") ) THEN
1557!-----
1558      IF (INDEX(key_str(1:len_TRIM(key_str)),'__') > 0) THEN
1559        WRITE(*,*) 'ERROR : getin_decrypt'
1560        WRITE(*,*) &
1561&         'We can not have a compressed field of values for in a'
1562        WRITE(*,*) &
1563&         'vector notation. If a target is of the type TARGET__1'
1564        WRITE(*,*) 'then only a scalar value is allowed'
1565        WRITE(*,*) 'The key at fault : ',key_str(1:len_TRIM(key_str))
1566        STOP 'getin_decrypt'
1567      ENDIF
1568!-
1569!---- Read the multiplied
1570!-
1571      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
1572!---- Construct the new string and its parameters
1573      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
1574      len_str = LEN_TRIM(NEW_str)
1575      blk = INDEX(NEW_str(1:len_str),' ')
1576      IF (blk > 1) THEN
1577        WRITE(*,*) &
1578 &       'This is a strange behavior of getin_decrypt you could report'
1579      ENDIF
1580      WRITE(chlen,'(I3.3)') LEN_TRIM(mult)
1581      fmt = '(I'//chlen//')'
1582      READ(mult,fmt) compline(nb_lines)
1583!---
1584    ELSE
1585      compline(nb_lines) = -1
1586    ENDIF
1587!-
1588!-- If there is no space wthin the line then the target is a scalar
1589!-- or the element of a properly written vector.
1590!-- (ie of the type TARGET__1)
1591!-
1592    IF (    (blk <= 1) &
1593 &      .OR.(tmp_str(1:1) == '"') &
1594 &      .OR.(tmp_str(1:1) == "'") ) THEN
1595!-
1596      IF (nb_lastkey == 0) THEN
1597!------ Save info of current keyword as a scalar
1598!------ if it is not a continuation
1599        targetlist(nb_lines) = key_str(1:MIN(len_trim(key_str),30))
1600        last_key = key_str(1:MIN(len_trim(key_str),30))
1601        nb_lastkey = 1
1602      ELSE
1603!------ We are continuing a vector so the keyword needs
1604!------ to get the underscores
1605        WRITE(cnt,'(I3.3)') nb_lastkey+1
1606        targetlist(nb_lines) = &
1607 &        key_str(1:MIN(len_trim(key_str),25))//'__'//cnt
1608        last_key = key_str(1:MIN(len_trim(key_str),25))//'__'//cnt
1609        nb_lastkey = nb_lastkey+1
1610      ENDIF
1611!-----
1612      CALL gensig (targetlist(nb_lines),targetsiglist(nb_lines))
1613      fichier(nb_lines) = NEW_str(1:len_str)
1614      fromfile(nb_lines) = current
1615    ELSE
1616!-
1617!---- If there are blanks whithin the line then we are dealing
1618!---- with a vector and we need to split it in many entries
1619!---- with the TRAGET__1 notation.
1620!----
1621!---- Test if the targer is not already a vector target !
1622!-
1623      IF (INDEX(TRIM(key_str),'__') > 0) THEN
1624        WRITE(*,*) 'ERROR : getin_decrypt'
1625        WRITE(*,*) 'We have found a mixed vector notation'
1626        WRITE(*,*) 'If a target is of the type TARGET__1'
1627        WRITE(*,*) 'then only a scalar value is allowed'
1628        WRITE(*,*) 'The key at fault : ',key_str(1:len_TRIM(key_str))
1629        STOP 'getin_decrypt'
1630      ENDIF
1631!-
1632      nbve = nb_lastkey
1633      nbve = nbve+1
1634      WRITE(cnt,'(I3.3)') nbve
1635!-
1636      DO WHILE (blk > 0)
1637!-
1638!------ Save the content of target__nbve
1639!-
1640        fichier(nb_lines) = tmp_str(1:blk)
1641        new_key =  key_str(1:MIN(len_trim(key_str),25))//'__'//cnt
1642        targetlist(nb_lines) = new_key(1:MIN(len_trim(new_key),30))
1643        CALL gensig (targetlist(nb_lines),targetsiglist(nb_lines))
1644        fromfile(nb_lines) = current
1645!-
1646        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
1647        blk = INDEX(TRIM(tmp_str),' ')
1648!-
1649        nb_lines = nb_lines+1
1650        IF (nb_lines > max_lines) THEN
1651          WRITE(*,*) &
1652 &          'Too many line in the run.def files. You need to increase'
1653          WRITE(*,*) 'the parameter max_lines in the module getincom.'
1654          STOP 'getin_decrypt'
1655        ENDIF
1656        nbve = nbve+1
1657        WRITE(cnt,'(I3.3)') nbve
1658!-
1659      ENDDO
1660!-
1661!---- Save the content of the last target
1662!-
1663      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
1664      new_key = key_str(1:MIN(len_trim(key_str),25))//'__'//cnt
1665      targetlist(nb_lines) = new_key(1:MIN(len_trim(new_key),30))
1666      CALL gensig (targetlist(nb_lines),targetsiglist(nb_lines))
1667      fromfile(nb_lines) = current
1668!-
1669      last_key = key_str(1:MIN(len_trim(key_str),25))//'__'//cnt
1670      nb_lastkey = nbve
1671!-
1672    ENDIF
1673!-
1674  ENDIF
1675!---------------------------
1676END SUBROUTINE getin_decrypt
1677!-
1678!===
1679!-
1680SUBROUTINE getin_checkcohe ()
1681!---------------------------------------------------------------------
1682!- This subroutine checks for redundancies.
1683!---------------------------------------------------------------------
1684  IMPLICIT NONE
1685!-
1686! Arguments
1687!-
1688!-
1689! LOCAL
1690!-
1691  INTEGER :: line,i,sig
1692  INTEGER :: found
1693  CHARACTER(LEN=30) :: str
1694!---------------------------------------------------------------------
1695  DO line=1,nb_lines-1
1696!-
1697    CALL find_sig &
1698 &    (nb_lines-line,targetlist(line+1:nb_lines),targetlist(line), &
1699 &     targetsiglist(line+1:nb_lines),targetsiglist(line),found)
1700!---
1701!-- IF we have found it we have a problem to solve.
1702!---
1703    IF (found > 0) THEN
1704      WRITE(*,*) 'COUNT : ', &
1705 &  COUNT(ABS(targetsiglist(line+1:nb_lines)-targetsiglist(line)) < 1)
1706!-----
1707      WRITE(*,*) &
1708 & 'getin_checkcohe : Found a problem on key ',targetlist(line)
1709      WRITE(*,*) &
1710 & 'getin_checkcohe : The following values were encoutered :'
1711      WRITE(*,*) &
1712 & '                ',TRIM(targetlist(line)), &
1713 &               targetsiglist(line),' == ',fichier(line)
1714      WRITE(*,*) &
1715 & '                ',TRIM(targetlist(line+found)), &
1716 &               targetsiglist(line+found),' == ',fichier(line+found)
1717      WRITE(*,*) &
1718 & 'getin_checkcohe : We will keep only the last value'
1719!-----
1720      targetsiglist(line) = 1
1721    ENDIF
1722  ENDDO
1723!-
1724END SUBROUTINE getin_checkcohe
1725!-
1726!===
1727!-
1728SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
1729!---------------------------------------------------------------------
1730  IMPLICIT NONE
1731!-
1732  INTEGER :: unit, eof, nb_lastkey
1733  CHARACTER(LEN=100) :: dummy
1734  CHARACTER(LEN=100) :: out_string
1735  CHARACTER(LEN=1) :: first
1736!---------------------------------------------------------------------
1737  first="#"
1738  eof = 0
1739  out_string = "    "
1740!-
1741  DO WHILE (first == "#")
1742    READ (unit,'(a100)',ERR=9998,END=7778) dummy
1743    dummy = TRIM(ADJUSTL(dummy))
1744    first=dummy(1:1)
1745    IF (first == "#") THEN
1746      nb_lastkey = 0
1747    ENDIF
1748  ENDDO
1749  out_string=dummy
1750!-
1751  RETURN
1752!-
17539998 WRITE(*,*) " GETIN_SKIPAFEW : Error while reading file "
1754  STOP 'getin_skipafew'
1755!-
17567778 eof = 1
1757!----------------------------
1758END SUBROUTINE getin_skipafew
1759!-
1760!=== INTEGER database INTERFACE
1761!-
1762SUBROUTINE getdbwi &
1763 &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val)
1764!---------------------------------------------------------------------
1765!- Write the INTEGER data into the data base
1766!---------------------------------------------------------------------
1767  IMPLICIT NONE
1768!-
1769  CHARACTER(LEN=*) :: target
1770  INTEGER :: target_sig, status, fileorig, size_of_in
1771  INTEGER,DIMENSION(:) :: tmp_ret_val
1772!---------------------------------------------------------------------
1773!-
1774! First check if we have sufficiant space for the new key
1775!-
1776  IF (nb_keys+1 > keymemsize) THEN
1777    CALL getin_allockeys ()
1778  ENDIF
1779!-
1780! Fill out the items of the data base
1781!-
1782  nb_keys = nb_keys+1
1783  keysig(nb_keys) = target_sig
1784  keystr(nb_keys) = target(1:MIN(len_trim(target),30))
1785  keystatus(nb_keys) = status
1786  keytype(nb_keys) = 1
1787  keyfromfile(nb_keys) = fileorig
1788!-
1789! Can we compress the data base entry ?
1790!-
1791  IF (     (MINVAL(tmp_ret_val) == MAXVAL(tmp_ret_val)) &
1792 &    .AND.(size_of_in > compress_lim)) THEN
1793    keymemstart(nb_keys) = intmempos+1
1794    keycompress(nb_keys) = size_of_in
1795    keymemlen(nb_keys) = 1
1796  ELSE
1797    keymemstart(nb_keys) = intmempos+1
1798    keycompress(nb_keys) = -1
1799    keymemlen(nb_keys) = size_of_in
1800  ENDIF
1801!-
1802! Before writing the actual size lets see if we have the space
1803!-
1804  IF (keymemstart(nb_keys)+keymemlen(nb_keys) > intmemsize) THEN
1805    CALL getin_allocmem (1,keymemlen(nb_keys))
1806  ENDIF
1807!-
1808  intmem(keymemstart(nb_keys): &
1809 &       keymemstart(nb_keys)+keymemlen(nb_keys)-1) = &
1810 &  tmp_ret_val(1:keymemlen(nb_keys))
1811  intmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1
1812!---------------------
1813END SUBROUTINE getdbwi
1814!-
1815!===
1816!-
1817SUBROUTINE getdbri (pos,size_of_in,target,tmp_ret_val)
1818!---------------------------------------------------------------------
1819!- Read the required variables in the database for INTEGERS
1820!---------------------------------------------------------------------
1821  IMPLICIT NONE
1822!-
1823  INTEGER :: pos, size_of_in
1824  CHARACTER(LEN=*) :: target
1825  INTEGER,DIMENSION(:) :: tmp_ret_val
1826!---------------------------------------------------------------------
1827  IF (keytype(pos) /= 1) THEN
1828    WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target
1829    STOP 'getdbri'
1830  ENDIF
1831!-
1832  IF (keycompress(pos) > 0) THEN
1833    IF ( keycompress(pos) /= size_of_in .OR. keymemlen(pos) /= 1 ) THEN
1834      WRITE(*,*) &
1835 &      'FATAL ERROR : Wrong compression length for keyword ',target
1836      STOP 'getdbri'
1837    ELSE
1838      tmp_ret_val(1:size_of_in) = intmem(keymemstart(pos))
1839    ENDIF
1840  ELSE
1841    IF (keymemlen(pos) /= size_of_in) THEN
1842      WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target
1843      STOP 'getdbri'
1844    ELSE
1845      tmp_ret_val(1:size_of_in) = &
1846 &      intmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1)
1847    ENDIF
1848  ENDIF
1849!---------------------
1850END SUBROUTINE getdbri
1851!-
1852!=== REAL database INTERFACE
1853!-
1854SUBROUTINE getdbwr &
1855 &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val)
1856!---------------------------------------------------------------------
1857!- Write the REAL data into the data base
1858!---------------------------------------------------------------------
1859  IMPLICIT NONE
1860!-
1861  CHARACTER(LEN=*) :: target
1862  INTEGER :: target_sig, status, fileorig, size_of_in
1863  REAL,DIMENSION(:) :: tmp_ret_val
1864!---------------------------------------------------------------------
1865!-
1866! First check if we have sufficiant space for the new key
1867!-
1868  IF (nb_keys+1 > keymemsize) THEN
1869    CALL getin_allockeys ()
1870  ENDIF
1871!-
1872! Fill out the items of the data base
1873!-
1874  nb_keys = nb_keys+1
1875  keysig(nb_keys) = target_sig
1876  keystr(nb_keys) = target(1:MIN(len_trim(target),30))
1877  keystatus(nb_keys) = status
1878  keytype(nb_keys) = 2
1879  keyfromfile(nb_keys) = fileorig
1880!-
1881! Can we compress the data base entry ?
1882!-
1883  IF (     (MINVAL(tmp_ret_val) == MAXVAL(tmp_ret_val)) &
1884&     .AND.(size_of_in > compress_lim)) THEN
1885    keymemstart(nb_keys) = realmempos+1
1886    keycompress(nb_keys) = size_of_in
1887    keymemlen(nb_keys) = 1
1888  ELSE
1889    keymemstart(nb_keys) = realmempos+1
1890    keycompress(nb_keys) = -1
1891    keymemlen(nb_keys) = size_of_in
1892  ENDIF
1893!-
1894! Before writing the actual size lets see if we have the space
1895!-
1896  IF (keymemstart(nb_keys)+keymemlen(nb_keys) > realmemsize) THEN
1897    CALL getin_allocmem (2,keymemlen(nb_keys))
1898  ENDIF
1899!-
1900  realmem(keymemstart(nb_keys): &
1901 &        keymemstart(nb_keys)+keymemlen(nb_keys)-1) = &
1902 &  tmp_ret_val(1:keymemlen(nb_keys))
1903  realmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1
1904!---------------------
1905END SUBROUTINE getdbwr
1906!-
1907!===
1908!-
1909SUBROUTINE getdbrr (pos,size_of_in,target,tmp_ret_val)
1910!---------------------------------------------------------------------
1911!- Read the required variables in the database for REALS
1912!---------------------------------------------------------------------
1913  IMPLICIT NONE
1914!-
1915  INTEGER :: pos, size_of_in
1916  CHARACTER(LEN=*) :: target
1917  REAL,DIMENSION(:) :: tmp_ret_val
1918!---------------------------------------------------------------------
1919  IF (keytype(pos) /= 2) THEN
1920    WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target
1921    STOP 'getdbrr'
1922  ENDIF
1923!-
1924  IF (keycompress(pos) > 0) THEN
1925    IF (    (keycompress(pos) /= size_of_in) &
1926 &      .OR.(keymemlen(pos) /= 1) ) THEN
1927      WRITE(*,*) &
1928 &      'FATAL ERROR : Wrong compression length for keyword ',target
1929      STOP 'getdbrr'
1930    ELSE
1931      tmp_ret_val(1:size_of_in) = realmem(keymemstart(pos))
1932    ENDIF
1933  ELSE
1934    IF (keymemlen(pos) /= size_of_in) THEN
1935      WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target
1936      STOP 'getdbrr'
1937    ELSE
1938      tmp_ret_val(1:size_of_in) = &
1939 &      realmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1)
1940    ENDIF
1941  ENDIF
1942!---------------------
1943END SUBROUTINE getdbrr
1944!-
1945!=== CHARACTER database INTERFACE
1946!-
1947SUBROUTINE getdbwc &
1948 &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val)
1949!---------------------------------------------------------------------
1950!- Write the CHARACTER data into the data base
1951!---------------------------------------------------------------------
1952  IMPLICIT NONE
1953!-
1954  CHARACTER(LEN=*) :: target
1955  INTEGER :: target_sig,status,fileorig,size_of_in
1956  CHARACTER(LEN=*),DIMENSION(:) :: tmp_ret_val
1957!---------------------------------------------------------------------
1958!-
1959! First check if we have sufficiant space for the new key
1960!-
1961  IF (nb_keys+1 > keymemsize) THEN
1962    CALL getin_allockeys ()
1963  ENDIF
1964!-
1965! Fill out the items of the data base
1966!-
1967  nb_keys = nb_keys+1
1968  keysig(nb_keys) = target_sig
1969  keystr(nb_keys) = target(1:MIN(len_trim(target),30))
1970  keystatus(nb_keys) = status
1971  keytype(nb_keys) = 3
1972  keyfromfile(nb_keys) = fileorig
1973  keymemstart(nb_keys) = charmempos+1
1974  keymemlen(nb_keys) = size_of_in
1975!-
1976! Before writing the actual size lets see if we have the space
1977!-
1978  IF (keymemstart(nb_keys)+keymemlen(nb_keys) > realmemsize) THEN
1979    CALL getin_allocmem (3,keymemlen(nb_keys))
1980  ENDIF
1981!-
1982  charmem(keymemstart(nb_keys): &
1983 &        keymemstart(nb_keys)+keymemlen(nb_keys)-1) = &
1984 &  tmp_ret_val(1:keymemlen(nb_keys))
1985  charmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1
1986!---------------------
1987END SUBROUTINE getdbwc
1988!-
1989!===
1990!-
1991SUBROUTINE getdbrc(pos,size_of_in,target,tmp_ret_val)
1992!---------------------------------------------------------------------
1993!- Read the required variables in the database for CHARACTER
1994!---------------------------------------------------------------------
1995  IMPLICIT NONE
1996!-
1997  INTEGER :: pos, size_of_in
1998  CHARACTER(LEN=*) :: target
1999  CHARACTER(LEN=*),DIMENSION(:) :: tmp_ret_val
2000!---------------------------------------------------------------------
2001  IF (keytype(pos) /= 3) THEN
2002    WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target
2003    STOP 'getdbrc'
2004  ENDIF
2005!-
2006  IF (keymemlen(pos) /= size_of_in) THEN
2007    WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target
2008    STOP 'getdbrc'
2009  ELSE
2010    tmp_ret_val(1:size_of_in) = &
2011 &    charmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1)
2012  ENDIF
2013!---------------------
2014END SUBROUTINE getdbrc
2015!-
2016!=== LOGICAL database INTERFACE
2017!-
2018SUBROUTINE getdbwl &
2019 &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val)
2020!---------------------------------------------------------------------
2021!- Write the LOGICAL data into the data base
2022!---------------------------------------------------------------------
2023  IMPLICIT NONE
2024!-
2025  CHARACTER(LEN=*) :: target
2026  INTEGER :: target_sig, status, fileorig, size_of_in
2027  LOGICAL,DIMENSION(:) :: tmp_ret_val
2028!---------------------------------------------------------------------
2029!-
2030! First check if we have sufficiant space for the new key
2031!-
2032  IF (nb_keys+1 > keymemsize) THEN
2033    CALL getin_allockeys ()
2034  ENDIF
2035!-
2036! Fill out the items of the data base
2037!-
2038  nb_keys = nb_keys+1
2039  keysig(nb_keys) = target_sig
2040  keystr(nb_keys) = target(1:MIN(len_trim(target),30))
2041  keystatus(nb_keys) = status
2042  keytype(nb_keys) = 4
2043  keyfromfile(nb_keys) = fileorig
2044  keymemstart(nb_keys) = logicmempos+1
2045  keymemlen(nb_keys) = size_of_in
2046!-
2047! Before writing the actual size lets see if we have the space
2048!-
2049  IF (keymemstart(nb_keys)+keymemlen(nb_keys) > logicmemsize) THEN
2050    CALL getin_allocmem (4,keymemlen(nb_keys))
2051  ENDIF
2052!-
2053  logicmem(keymemstart(nb_keys): &
2054 &         keymemstart(nb_keys)+keymemlen(nb_keys)-1) = &
2055 &  tmp_ret_val(1:keymemlen(nb_keys))
2056  logicmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1
2057!---------------------
2058END SUBROUTINE getdbwl
2059!-
2060!===
2061!-
2062SUBROUTINE getdbrl(pos,size_of_in,target,tmp_ret_val)
2063!---------------------------------------------------------------------
2064!- Read the required variables in the database for LOGICALS
2065!---------------------------------------------------------------------
2066  IMPLICIT NONE
2067!-
2068  INTEGER :: pos, size_of_in
2069  CHARACTER(LEN=*) :: target
2070  LOGICAL,DIMENSION(:) :: tmp_ret_val
2071!---------------------------------------------------------------------
2072  IF (keytype(pos) /= 4) THEN
2073    WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target
2074    STOP 'getdbrl'
2075  ENDIF
2076!-
2077  IF (keymemlen(pos) /= size_of_in) THEN
2078    WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target
2079    STOP 'getdbrl'
2080  ELSE
2081    tmp_ret_val(1:size_of_in) = &
2082 &    logicmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1)
2083  ENDIF
2084!---------------------
2085END SUBROUTINE getdbrl
2086!-
2087!===
2088!-
2089SUBROUTINE getin_allockeys ()
2090!---------------------------------------------------------------------
2091  IMPLICIT NONE
2092!-
2093  INTEGER,ALLOCATABLE :: tmp_int(:)
2094  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
2095!-
2096  INTEGER :: ier
2097!---------------------------------------------------------------------
2098!-
2099! Either nothing exists in these arrays and it is easy to do
2100!-
2101  IF (keymemsize == 0) THEN
2102!-
2103    ALLOCATE(keysig(memslabs),stat=ier)
2104    IF (ier /= 0) THEN
2105      WRITE(*,*) &
2106 &      'getin_allockeys : Can not allocate keysig to size ', &
2107 &      memslabs
2108      STOP
2109    ENDIF
2110!-
2111    ALLOCATE(keystr(memslabs),stat=ier)
2112    IF (ier /= 0) THEN
2113      WRITE(*,*) &
2114 &      'getin_allockeys : Can not allocate keystr to size ', &
2115 &      memslabs
2116      STOP
2117    ENDIF
2118!-
2119    ALLOCATE(keystatus(memslabs),stat=ier)
2120    IF (ier /= 0) THEN
2121      WRITE(*,*) &
2122 &      'getin_allockeys : Can not allocate keystatus to size ', &
2123 &      memslabs
2124      STOP
2125    ENDIF
2126!-
2127    ALLOCATE(keytype(memslabs),stat=ier)
2128    IF (ier /= 0) THEN
2129      WRITE(*,*) &
2130 &      'getin_allockeys : Can not allocate keytype to size ', &
2131 &      memslabs
2132      STOP
2133    ENDIF
2134!-
2135    ALLOCATE(keycompress(memslabs),stat=ier)
2136    IF (ier /= 0) THEN
2137      WRITE(*,*) &
2138 &      'getin_allockeys : Can not allocate keycompress to size ', &
2139 &      memslabs
2140      STOP
2141    ENDIF
2142!-
2143    ALLOCATE(keyfromfile(memslabs),stat=ier)
2144    IF (ier /= 0) THEN
2145      WRITE(*,*) &
2146 &      'getin_allockeys : Can not allocate keyfromfile to size ', &
2147 &      memslabs
2148      STOP
2149    ENDIF
2150!-
2151    ALLOCATE(keymemstart(memslabs),stat=ier)
2152    IF (ier /= 0) THEN
2153      WRITE(*,*) &
2154 &      'getin_allockeys : Can not allocate keymemstart to size ', &
2155 &      memslabs
2156      STOP
2157    ENDIF
2158!-
2159    ALLOCATE(keymemlen(memslabs),stat=ier)
2160    IF (ier /= 0) THEN
2161      WRITE(*,*) &
2162 &      'getin_allockeys : Can not allocate keymemlen to size ', &
2163 &      memslabs
2164      STOP
2165    ENDIF
2166!-
2167    nb_keys = 0
2168    keymemsize = memslabs
2169    keycompress(:) = -1
2170!-
2171  ELSE
2172!-
2173!-- There is something already in the memory,
2174!-- we need to transfer and reallocate.
2175!-
2176    ALLOCATE(tmp_str(keymemsize),stat=ier)
2177    IF (ier /= 0) THEN
2178      WRITE(*,*) &
2179 &      'getin_allockeys : Can not allocate tmp_str to size ', &
2180 &      keymemsize
2181      STOP
2182    ENDIF
2183!-
2184    ALLOCATE(tmp_int(keymemsize),stat=ier)
2185    IF (ier /= 0) THEN
2186      WRITE(*,*) &
2187 &      'getin_allockeys : Can not allocate tmp_int to size ', &
2188 &      keymemsize
2189      STOP
2190    ENDIF
2191!-
2192    tmp_int(1:keymemsize) = keysig(1:keymemsize)
2193    DEALLOCATE(keysig)
2194    ALLOCATE(keysig(keymemsize+memslabs),stat=ier)
2195    IF (ier /= 0) THEN
2196      WRITE(*,*) &
2197 &      'getin_allockeys : Can not allocate keysig to size ', &
2198 &      keymemsize+memslabs
2199      STOP
2200    ENDIF
2201    keysig(1:keymemsize) = tmp_int(1:keymemsize)
2202!-
2203    tmp_str(1:keymemsize) = keystr(1:keymemsize)
2204    DEALLOCATE(keystr)
2205    ALLOCATE(keystr(keymemsize+memslabs),stat=ier)
2206    IF (ier /= 0) THEN
2207      WRITE(*,*) &
2208 &      'getin_allockeys : Can not allocate keystr to size ', &
2209 &      keymemsize+memslabs
2210      STOP
2211    ENDIF
2212    keystr(1:keymemsize) = tmp_str(1:keymemsize)
2213!-
2214    tmp_int(1:keymemsize) = keystatus(1:keymemsize)
2215    DEALLOCATE(keystatus)
2216    ALLOCATE(keystatus(keymemsize+memslabs),stat=ier)
2217    IF (ier /= 0) THEN
2218      WRITE(*,*) &
2219 &      'getin_allockeys : Can not allocate keystatus to size ', &
2220 &      keymemsize+memslabs
2221      STOP
2222    ENDIF
2223    keystatus(1:keymemsize) = tmp_int(1:keymemsize)
2224!-
2225    tmp_int(1:keymemsize) = keytype(1:keymemsize)
2226    DEALLOCATE(keytype)
2227    ALLOCATE(keytype(keymemsize+memslabs),stat=ier)
2228    IF (ier /= 0) THEN
2229      WRITE(*,*) &
2230 &      'getin_allockeys : Can not allocate keytype to size ', &
2231 &      keymemsize+memslabs
2232      STOP
2233    ENDIF
2234    keytype(1:keymemsize) = tmp_int(1:keymemsize)
2235!-
2236    tmp_int(1:keymemsize) = keycompress(1:keymemsize)
2237    DEALLOCATE(keycompress)
2238    ALLOCATE(keycompress(keymemsize+memslabs),stat=ier)
2239    IF (ier /= 0) THEN
2240      WRITE(*,*) &
2241 &      'getin_allockeys : Can not allocate keycompress to size ', &
2242 &      keymemsize+memslabs
2243      STOP
2244    ENDIF
2245    keycompress(:) = -1
2246    keycompress(1:keymemsize) = tmp_int(1:keymemsize)
2247!-
2248    tmp_int(1:keymemsize) = keyfromfile(1:keymemsize)
2249    DEALLOCATE(keyfromfile)
2250    ALLOCATE(keyfromfile(keymemsize+memslabs),stat=ier)
2251    IF (ier /= 0) THEN
2252      WRITE(*,*) &
2253 &      'getin_allockeys : Can not allocate keyfromfile to size ', &
2254 &      keymemsize+memslabs
2255      STOP
2256    ENDIF
2257    keyfromfile(1:keymemsize) = tmp_int(1:keymemsize)
2258!-
2259    tmp_int(1:keymemsize) = keymemstart(1:keymemsize)
2260    DEALLOCATE(keymemstart)
2261    ALLOCATE(keymemstart(keymemsize+memslabs),stat=ier)
2262    IF (ier /= 0) THEN
2263      WRITE(*,*) &
2264 &      'getin_allockeys : Can not allocate keymemstart to size ', &
2265 &      keymemsize+memslabs
2266      STOP
2267    ENDIF
2268    keymemstart(1:keymemsize) = tmp_int(1:keymemsize)
2269!-
2270    tmp_int(1:keymemsize) = keymemlen(1:keymemsize)
2271    DEALLOCATE(keymemlen)
2272    ALLOCATE(keymemlen(keymemsize+memslabs),stat=ier)
2273    IF (ier /= 0) THEN
2274      WRITE(*,*) &
2275 &      'getin_allockeys : Can not allocate keymemlen to size ', &
2276 &      keymemsize+memslabs
2277      STOP
2278    ENDIF
2279    keymemlen(1:keymemsize) = tmp_int(1:keymemsize)
2280!-
2281    keymemsize = keymemsize+memslabs
2282!-
2283    DEALLOCATE(tmp_int)
2284    DEALLOCATE(tmp_str)
2285  ENDIF
2286!-----------------------------
2287END SUBROUTINE getin_allockeys
2288!-
2289!===
2290!-
2291SUBROUTINE getin_allocmem (type,len_wanted)
2292!---------------------------------------------------------------------
2293!- Allocate the memory of the data base for all 4 types of memory
2294!-
2295!- 1 = INTEGER
2296!- 2 = REAL
2297!- 3 = CHAR
2298!- 4 = LOGICAL
2299!---------------------------------------------------------------------
2300  IMPLICIT NONE
2301!-
2302  INTEGER :: type, len_wanted
2303!-
2304  INTEGER,ALLOCATABLE :: tmp_int(:)
2305  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
2306  REAL,ALLOCATABLE :: tmp_real(:)
2307  LOGICAL,ALLOCATABLE :: tmp_logic(:)
2308  INTEGER :: ier
2309!---------------------------------------------------------------------
2310  SELECT CASE (type)
2311  CASE(1)
2312    IF (intmemsize == 0) THEN
2313      ALLOCATE(intmem(memslabs),stat=ier)
2314      IF (ier /= 0) THEN
2315        WRITE(*,*) &
2316 &    'getin_allocmem : Unable to allocate db-memory intmem to ', &
2317 &    memslabs
2318        STOP
2319      ENDIF
2320      intmemsize=memslabs
2321    ELSE
2322      ALLOCATE(tmp_int(intmemsize),stat=ier)
2323      IF (ier /= 0) THEN
2324        WRITE(*,*) &
2325 &    'getin_allocmem : Unable to allocate tmp_int to ', &
2326 &    intmemsize
2327        STOP
2328      ENDIF
2329      tmp_int(1:intmemsize) = intmem(1:intmemsize)
2330      DEALLOCATE(intmem)
2331      ALLOCATE(intmem(intmemsize+MAX(memslabs,len_wanted)),stat=ier)
2332      IF (ier /= 0) THEN
2333        WRITE(*,*) &
2334 &    'getin_allocmem : Unable to re-allocate db-memory intmem to ', &
2335 &    intmemsize+MAX(memslabs,len_wanted)
2336        STOP
2337      ENDIF
2338      intmem(1:intmemsize) = tmp_int(1:intmemsize)
2339      intmemsize = intmemsize+MAX(memslabs,len_wanted)
2340      DEALLOCATE(tmp_int)
2341    ENDIF
2342  CASE(2)
2343    IF (realmemsize == 0) THEN
2344      ALLOCATE(realmem(memslabs),stat=ier)
2345      IF (ier /= 0) THEN
2346        WRITE(*,*) &
2347 &    'getin_allocmem : Unable to allocate db-memory realmem to ', &
2348 &    memslabs
2349        STOP
2350      ENDIF
2351      realmemsize =  memslabs
2352    ELSE
2353      ALLOCATE(tmp_real(realmemsize),stat=ier)
2354      IF (ier /= 0) THEN
2355        WRITE(*,*) &
2356 &    'getin_allocmem : Unable to allocate tmp_real to ', &
2357 &    realmemsize
2358        STOP
2359      ENDIF
2360      tmp_real(1:realmemsize) = realmem(1:realmemsize)
2361      DEALLOCATE(realmem)
2362      ALLOCATE(realmem(realmemsize+MAX(memslabs,len_wanted)),stat=ier)
2363      IF (ier /= 0) THEN
2364        WRITE(*,*) &
2365 &    'getin_allocmem : Unable to re-allocate db-memory realmem to ', &
2366 &    realmemsize+MAX(memslabs,len_wanted)
2367        STOP
2368      ENDIF
2369      realmem(1:realmemsize) = tmp_real(1:realmemsize)
2370      realmemsize = realmemsize+MAX(memslabs,len_wanted)
2371      DEALLOCATE(tmp_real)
2372    ENDIF
2373  CASE(3)
2374    IF (charmemsize == 0) THEN
2375      ALLOCATE(charmem(memslabs),stat=ier)
2376      IF (ier /= 0) THEN
2377        WRITE(*,*) &
2378 &    'getin_allocmem : Unable to allocate db-memory charmem to ', &
2379 &    memslabs
2380        STOP
2381      ENDIF
2382      charmemsize = memslabs
2383    ELSE
2384      ALLOCATE(tmp_char(charmemsize),stat=ier)
2385      IF (ier /= 0) THEN
2386        WRITE(*,*) &
2387 &    'getin_allocmem : Unable to allocate tmp_char to ', &
2388 &    charmemsize
2389        STOP
2390      ENDIF
2391      tmp_char(1:charmemsize) = charmem(1:charmemsize)
2392      DEALLOCATE(charmem)
2393      ALLOCATE(charmem(charmemsize+MAX(memslabs,len_wanted)),stat=ier)
2394      IF (ier /= 0) THEN
2395        WRITE(*,*) &
2396 &    'getin_allocmem : Unable to re-allocate db-memory charmem to ', &
2397 &    charmemsize+MAX(memslabs,len_wanted)
2398        STOP
2399      ENDIF
2400      charmem(1:charmemsize) = tmp_char(1:charmemsize)
2401      charmemsize = charmemsize+MAX(memslabs,len_wanted)
2402      DEALLOCATE(tmp_char)
2403    ENDIF
2404  CASE(4)
2405    IF (logicmemsize == 0) THEN
2406      ALLOCATE(logicmem(memslabs),stat=ier)
2407      IF (ier /= 0) THEN
2408        WRITE(*,*) &
2409 &    'getin_allocmem : Unable to allocate db-memory logicmem to ', &
2410 &    memslabs
2411        STOP
2412      ENDIF
2413      logicmemsize = memslabs
2414    ELSE
2415      ALLOCATE(tmp_logic(logicmemsize),stat=ier)
2416      IF (ier /= 0) THEN
2417        WRITE(*,*) &
2418 &    'getin_allocmem : Unable to allocate tmp_logic to ', &
2419 &    logicmemsize
2420        STOP
2421      ENDIF
2422      tmp_logic(1:logicmemsize) = logicmem(1:logicmemsize)
2423      DEALLOCATE(logicmem)
2424      ALLOCATE(logicmem(logicmemsize+MAX(memslabs,len_wanted)),stat=ier)
2425      IF (ier /= 0) THEN
2426        WRITE(*,*) &
2427 &    'getin_allocmem : Unable to re-allocate db-memory logicmem to ', &
2428 &    logicmemsize+MAX(memslabs,len_wanted)
2429        STOP
2430      ENDIF
2431      logicmem(1:logicmemsize) = tmp_logic(1:logicmemsize)
2432      logicmemsize = logicmemsize+MAX(memslabs,len_wanted)
2433      DEALLOCATE(tmp_logic)
2434    ENDIF
2435  CASE DEFAULT
2436    WRITE(*,*) 'getin_allocmem : Unknown type : ',type
2437    STOP
2438  END SELECT
2439!----------------------------
2440END SUBROUTINE getin_allocmem
2441!-
2442!===
2443!-
2444SUBROUTINE getin_dump (fileprefix)
2445!---------------------------------------------------------------------
2446!- This subroutine will dump the content of the database into  file
2447!- which has the same format as the run.def. The idea is that the user
2448!- can see which parameters were used and re-use the file for another
2449!- run.
2450!-
2451!- The argument file allows the user to change the name of the file
2452!- in which the data will be archived
2453!---------------------------------------------------------------------
2454  IMPLICIT NONE
2455!-
2456  CHARACTER(*),OPTIONAL :: fileprefix
2457!-
2458  CHARACTER(LEN=80) :: usedfileprefix = "used"
2459  INTEGER :: ikey,if,iff,iv
2460  CHARACTER(LEN=3) :: tmp3
2461  CHARACTER(LEN=100) :: tmp_str, used_filename
2462  LOGICAL :: check = .FALSE.
2463!---------------------------------------------------------------------
2464  IF (PRESENT(fileprefix)) THEN
2465    usedfileprefix = fileprefix(1:MIN(len_trim(fileprefix),80))
2466  ENDIF
2467!-
2468  DO if=1,nbfiles
2469!---
2470    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
2471    IF (check) THEN
2472      WRITE(*,*) &
2473 &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
2474      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
2475    ENDIF
2476    OPEN(unit=76,file=used_filename)
2477!-
2478!-- If this is the first file we need to add the list
2479!-- of file which belong to it
2480!-
2481    IF ( (if == 1) .AND. (nbfiles > 1) ) THEN
2482      WRITE(76,*) '# '
2483      WRITE(76,*) '# This file is linked to the following files :'
2484      WRITE(76,*) '# '
2485      DO iff=2,nbfiles
2486        WRITE(76,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
2487      ENDDO
2488      WRITE(76,*) '# '
2489    ENDIF
2490!---
2491    DO ikey=1,nb_keys
2492!-
2493!---- Is this key form this file ?
2494!-
2495      IF (keyfromfile(ikey) == if) THEN
2496!-
2497!---- Write some comments
2498!-
2499        WRITE(76,*) '#'
2500        SELECT CASE (keystatus(ikey))
2501        CASE(1)
2502          WRITE(76,*) '# Values of ', &
2503 &          TRIM(keystr(ikey)),' comes from the run.def.'
2504        CASE(2)
2505          WRITE(76,*) '# Values of ', &
2506 &          TRIM(keystr(ikey)),' are all defaults.'
2507        CASE(3)
2508          WRITE(76,*) '# Values of ', &
2509 &          TRIM(keystr(ikey)),' are a mix of run.def and defaults.'
2510        CASE DEFAULT
2511          WRITE(76,*) '# Dont know from where the value of ', &
2512 &          TRIM(keystr(ikey)),' comes.'
2513        END SELECT
2514        WRITE(76,*) '#'
2515!-
2516!---- Write the values
2517!-
2518        SELECT CASE (keytype(ikey))
2519!-
2520        CASE(1)
2521          IF (keymemlen(ikey) == 1) THEN
2522            IF (keycompress(ikey) < 0) THEN
2523              WRITE(76,*) &
2524 &              TRIM(keystr(ikey)),' = ',intmem(keymemstart(ikey))
2525            ELSE
2526              WRITE(76,*) &
2527 &              TRIM(keystr(ikey)),' = ',keycompress(ikey), &
2528 &              ' * ',intmem(keymemstart(ikey))
2529            ENDIF
2530          ELSE
2531            DO iv=0,keymemlen(ikey)-1
2532              WRITE(tmp3,'(I3.3)') iv+1
2533              WRITE(76,*) &
2534 &              TRIM(keystr(ikey)),'__',tmp3, &
2535 &              ' = ',intmem(keymemstart(ikey)+iv)
2536            ENDDO
2537          ENDIF
2538!-
2539        CASE(2)
2540          IF (keymemlen(ikey) == 1) THEN
2541            IF (keycompress(ikey) < 0) THEN
2542              WRITE(76,*) &
2543 &              TRIM(keystr(ikey)),' = ',realmem(keymemstart(ikey))
2544            ELSE
2545              WRITE(76,*) &
2546 &              TRIM(keystr(ikey)),' = ',keycompress(ikey),&
2547                   & ' * ',realmem(keymemstart(ikey))
2548            ENDIF
2549          ELSE
2550            DO iv=0,keymemlen(ikey)-1
2551              WRITE(tmp3,'(I3.3)') iv+1
2552              WRITE(76,*) &
2553 &              TRIM(keystr(ikey)),'__',tmp3, &
2554 &              ' = ',realmem(keymemstart(ikey)+iv)
2555            ENDDO
2556          ENDIF
2557        CASE(3)
2558          IF (keymemlen(ikey) == 1) THEN
2559            tmp_str = charmem(keymemstart(ikey))
2560            WRITE(76,*) TRIM(keystr(ikey)),' = ',TRIM(tmp_str)
2561          ELSE
2562            DO iv=0,keymemlen(ikey)-1
2563              WRITE(tmp3,'(I3.3)') iv+1
2564              tmp_str = charmem(keymemstart(ikey)+iv)
2565              WRITE(76,*) &
2566 &              TRIM(keystr(ikey)),'__',tmp3,' = ',TRIM(tmp_str)
2567            ENDDO
2568          ENDIF
2569        CASE(4)
2570          IF (keymemlen(ikey) == 1) THEN
2571            IF (logicmem(keymemstart(ikey))) THEN
2572              WRITE(76,*) TRIM(keystr(ikey)),' = TRUE '
2573            ELSE
2574              WRITE(76,*) TRIM(keystr(ikey)),' = FALSE '
2575            ENDIF
2576          ELSE
2577            DO iv=0,keymemlen(ikey)-1
2578              WRITE(tmp3,'(I3.3)') iv+1
2579              IF (logicmem(keymemstart(ikey)+iv)) THEN
2580                WRITE(76,*) TRIM(keystr(ikey)),'__',tmp3,' = TRUE '
2581              ELSE
2582                WRITE(76,*) TRIM(keystr(ikey)),'__',tmp3,' = FALSE '
2583              ENDIF
2584            ENDDO
2585          ENDIF
2586!-
2587        CASE DEFAULT
2588          WRITE(*,*) &
2589 &          'FATAL ERROR : Unknown type for variable ', &
2590 &          TRIM(keystr(ikey))
2591          STOP 'getin_dump'
2592        END SELECT
2593      ENDIF
2594    ENDDO
2595!-
2596    CLOSE(unit=76)
2597!-
2598  ENDDO
2599!------------------------
2600END SUBROUTINE getin_dump
2601!-
2602!===
2603!-
2604END MODULE getincom
Note: See TracBrowser for help on using the repository browser.