Chimie Théorique » Opt'n Path

      function valid(string) result (isValid)

! This function returns true or false depending on the string you give as a parameter

! Its purpose is to centralize the debugging flags into only one external file

! so that debugging can be turned on or off easily at runtime.

! (basically as it was done in ADF...

! except that my version is much more basic (much much much more !) )

!----------------------------------------------------------------------

!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon,

!  Centre National de la Recherche Scientifique,

!  Université Claude Bernard Lyon 1. All rights reserved.

!

!  This work is registered with the Agency for the Protection of Programs

!  as IDDN.FR.001.100009.000.S.P.2014.000.30625

!

!  Authors: P. Fleurat-Lessard, P. Dayal

!  Contact: optnpath@gmail.com

!

! This file is part of "Opt'n Path".

!

!  "Opt'n Path" is free software: you can redistribute it and/or modify

!  it under the terms of the GNU Affero General Public License as

!  published by the Free Software Foundation, either version 3 of the License,

!  or (at your option) any later version.

!

!  "Opt'n Path" is distributed in the hope that it will be useful,

!  but WITHOUT ANY WARRANTY; without even the implied warranty of

!

!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

!  GNU Affero General Public License for more details.

!

!  You should have received a copy of the GNU Affero General Public License

!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.

!

! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,

! for commercial licensing opportunities.

!----------------------------------------------------------------------

      use Io_module

      IMPLICIT NONE

      interface

         subroutine upcase(string)

           character(*), intent(inout) :: string

         end subroutine upcase

      end interface

      CHARACTER(*), intent(in) :: string

      logical                  :: isValid

      INTEGER(4), PARAMETER :: NMax=500

      CHARACTER(64),save :: List(NMax)

      LOGICAL,save       :: Value(NMax)

      LOGICAL,save       :: TInit=.False.

      CHARACTER(132) :: LINE, ValTMP, LString

      LOGICAL       :: ValueTMP, Found

      LOGICAL,SAVE       :: Tall=.False., FValidFile, ValAll

      INTEGER(4) :: ios, i, j

      INTEGER(4), SAVE ::  NEntries

      LOGICAL, SAVE :: Debug=.FALSE.

      IF (.not.TInit) THEN

         NEntries=0

         TInit=.TRUE.

         INQUIRE(FILE=DebugFile,EXIST=FValidFile)

         if (FValidFile) THEN

            OPEN(IOTMP,File=DebugFile,IOSTAT=ios)

! The file exists so we will read it !

            DO While (ios==0)

               READ(IOTMP,'(A)',ERR=999,END=999) LINE

               if (Debug) WRITE(*,*) 'LINE READ',trim(Line)

               if (ios==0) THEN

                  Line=AdjustL(Line)

                  if (debug) WRITE(*,*) 'LINE ADJ',trim(Line)

                  call Upcase(Line)

                  if (debug) WRITE(*,*) 'LINE UP',trim(Line)

                  if (Line(1:1)/='#') THEN

! This is not a comment, we go on

                     i=index(Line,' ')

! We take the first word, it will be our value

                     ValTMP=Line(1:i-1)

                     j=len_trim(line)

                     Line=adjustL((Line(i+1:j)))

                     if (debug) WRITE(*,*) 'VALID INIT ',NEntries,trim(ValTMP), &

        ' - ',trim(Line)

                     if (ValTMP(1:1)=='.') ValTmp=ValTMP(2:)

                     if (ValTMP(1:1)=='F') ValueTMP=.False.

                     if (ValTMP(1:1)=='T') ValueTMP=.True.

                     if (Line(1:1)=='*') THEN

                        ValAll=ValueTMP

                        TAll=.True.

                     ELSE

                        if (Tall) ValueTMP=ValAll

                        NEntries=NEntries+1

                        Value(NEntries)=ValueTMP

                        Line=AdjustL(Line)

                        List(NEntries)=Line(1:64)

                     END IF

                  END IF

               END IF

            END DO

 999     CONTINUE

         CLOSE(IOTMP)

         if (debug) THEN

            WRITE(*,*) "DBG Valid, " // Trim(DebugFile) // "read, with " &

                 ,NEntries

            DO I=1,NEntries

               WRITE(*,*) List(I),Value(I)

            END DO

         END IF

       END IF

      END IF

      IF (.NOT.FValidFile) THEN

         isValid=.FALSE.

         Return

      END IF

! The INIT file has been read !

      LString=trim(adjustL(String))

      Call UPcase(LString)

      Found=.false.

      Do I=1,NEntries

         if (trim(List(I)).eq.trim(LString)) THEN

            Found=.TRUE.

            isValid=Value(I)

!            WRITE(*,*) 'zoeurezoiru'

         END IF

!         WRITE(*,*) I,' : ',trim(list(I)),' - ',trim(LSTRING),' *'

      END DO

!      WRITE(*,*) 'Found:',Found,'isval',isvalid

!      WRITE(*,*) 'Debug is ',isvalid," for ",Trim(LString)

      if (.NOT.Found) THEN

         IF (Tall) THEN

            if (debug) THEN

               WRITE(*,*) 'The option ',String,' is not recognized.'

               WRITE(*,*) 'Assigning value ',ValAll

            END IF

            isValid=ValAll

         ELSE

            isValid=.FALSE.

         END IF

         NEntries=Nentries+1

         If (NEntries>NMax) THEN

            WRITE(*,*) 'Error: NEntries > NMax in Valid ! recompile'

            STOP

         END IF

         List(Nentries)=Trim(LString)

         Value(Nentries)=Valall

      END IF

      END function valid