Statistiques
| Révision :

root / src / valid.f90 @ 8

Historique | Voir | Annoter | Télécharger (4,09 ko)

1
! This function returns true or false depending on the string you give as a parameter
2
! Its purpose is to centralize the debugging flags into only one external file
3
! so that debugging can be turned on or off easily at runtime.
4
! (basically as it was done in ADF...
5
! except that my version is much more basic (much much much more !) )
6

    
7
      function valid(string) result (isValid)
8

    
9
      use Io_module
10

    
11
      IMPLICIT NONE
12

    
13
      interface
14
         subroutine upcase(string)
15
           character(*), intent(inout) :: string
16
         end subroutine upcase
17
      end interface
18

    
19
      CHARACTER(*), intent(in) :: string
20
      logical                  :: isValid
21
      INTEGER(4), PARAMETER :: NMax=500
22

    
23
      CHARACTER(64),save :: List(NMax)
24
      LOGICAL,save       :: Value(NMax)
25
      LOGICAL,save       :: TInit=.False.
26
      CHARACTER(132) :: LINE, ValTMP, LString
27
      LOGICAL       :: ValueTMP, Found
28
      LOGICAL,SAVE       :: Tall=.False., FValidFile, ValAll
29
      INTEGER(4) :: ios, i, j
30
      INTEGER(4), SAVE ::  NEntries
31
      LOGICAL, SAVE :: Debug=.FALSE.
32

    
33
      IF (.not.TInit) THEN
34
         NEntries=0
35
         TInit=.TRUE.
36
         INQUIRE(FILE=DebugFile,EXIST=FValidFile)
37
         if (FValidFile) THEN
38
            OPEN(IOTMP,File=DebugFile,IOSTAT=ios)
39

    
40
! The file exists so we will read it !
41
            DO While (ios==0)
42
               READ(IOTMP,'(A)',ERR=999,END=999) LINE
43
               if (Debug) WRITE(*,*) 'LINE READ',trim(Line)
44
               if (ios==0) THEN
45
                  Line=AdjustL(Line)
46
                  if (debug) WRITE(*,*) 'LINE ADJ',trim(Line)
47
                  call Upcase(Line)
48
                  if (debug) WRITE(*,*) 'LINE UP',trim(Line)
49
                  if (Line(1:1)/='#') THEN
50
! This is not a comment, we go on
51
                     i=index(Line,' ')
52
! We take the first word, it will be our value
53
                     ValTMP=Line(1:i-1)
54
                     j=len_trim(line)
55
                     Line=adjustL((Line(i+1:j)))
56
                     if (debug) WRITE(*,*) 'VALID INIT ',NEntries,trim(ValTMP), &
57
        ' - ',trim(Line)
58
                     if (ValTMP(1:1)=='.') ValTmp=ValTMP(2:)
59
                     if (ValTMP(1:1)=='F') ValueTMP=.False.
60
                     if (ValTMP(1:1)=='T') ValueTMP=.True.
61
                     if (Line(1:1)=='*') THEN
62
                        ValAll=ValueTMP
63
                        TAll=.True.
64
                     ELSE
65
                        if (Tall) ValueTMP=ValAll
66
                        NEntries=NEntries+1
67
                        Value(NEntries)=ValueTMP
68
                        Line=AdjustL(Line)
69
                        List(NEntries)=Line(1:64)
70
                     END IF
71
                  END IF
72
               END IF
73
            END DO
74
 999     CONTINUE
75
         CLOSE(IOTMP)
76
         if (debug) THEN
77
            WRITE(*,*) "DBG Valid, " // Trim(DebugFile) // "read, with " &
78
                 ,NEntries
79
            DO I=1,NEntries
80
               WRITE(*,*) List(I),Value(I)
81
            END DO
82
         END IF
83
       END IF
84
      END IF
85

    
86
      IF (.NOT.FValidFile) THEN
87
         isValid=.FALSE.
88
         Return
89
      END IF
90

    
91
! The INIT file has been read !
92
      LString=trim(adjustL(String))
93
      Call UPcase(LString)
94
      Found=.false.
95
      Do I=1,NEntries
96
         if (trim(List(I)).eq.trim(LString)) THEN
97
            Found=.TRUE.
98
            isValid=Value(I)
99
!            WRITE(*,*) 'zoeurezoiru'
100
         END IF
101
!         WRITE(*,*) I,' : ',trim(list(I)),' - ',trim(LSTRING),' *'
102
      END DO
103

    
104
!      WRITE(*,*) 'Found:',Found,'isval',isvalid
105
!      WRITE(*,*) 'Debug is ',isvalid," for ",Trim(LString)
106

    
107
      if (.NOT.Found) THEN
108
         IF (Tall) THEN
109
            if (debug) THEN
110
               WRITE(*,*) 'The option ',String,' is not recognized.'
111
               WRITE(*,*) 'Assigning value ',ValAll
112
            END IF
113
            isValid=ValAll
114
         ELSE
115
            isValid=.FALSE.
116
         END IF
117
         NEntries=Nentries+1
118
         If (NEntries>NMax) THEN
119
            WRITE(*,*) 'Error: NEntries > NMax in Valid ! recompile'
120
            STOP
121
         END IF
122
         List(Nentries)=Trim(LString)
123
         Value(Nentries)=Valall
124
      END IF
125

    
126
      END function valid