read_record.f 4.26 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
      MODULE m_readrecord
      use m_juDFT
!***********************************************************************
!     reads in the next input section which is not an empty line and not
!     a comment. 
!     Section can be
!     
!     either
!     ---> a single line of input
!     or 
!     ---> a fortran name list ( & ... / ) 
!          & Must be the first non-space charcter in a new line. 
!          & ... / can extend over many lines, can contain comments
!          and empty lines. Maximum length is xl_buffer.
!
!     End of line comments in a section are removed.    
!     A comment is everything to the right of the first ! in a line.
!     
!***********************************************************************
      CONTAINS
      SUBROUTINE read_record(
22
     >                       infh,xl_buffer,bfh,
23 24 25 26 27 28 29
     X                       nline, 
     <                       nbuffer,buffer,ios )

      IMPLICIT NONE

      INTEGER, INTENT (IN)    :: infh            ! input filehandle (5)
      INTEGER, INTENT (IN)    :: xl_buffer       ! maximum length of read record
30
      INTEGER, INTENT (IN)    :: bfh
31 32 33 34 35 36 37 38 39 40
      INTEGER, INTENT (INOUT) :: nline           ! in: last line read ; on output new read lines added
      INTEGER, INTENT (OUT)   :: nbuffer, ios    ! read buffer & I/O status
      CHARACTER(len=xl_buffer), INTENT (OUT)   :: buffer

      INTEGER           :: i,j,l,n,nw
      LOGICAL           :: building, complete
      CHARACTER(len=xl_buffer)  :: line

      LOGICAL, SAVE :: reached_EOF = .false.

41
      INTEGER, PARAMETER  :: dbgfh=6, errfh=6
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
!---> initialize some variables

      building = .false.
      complete = .false.

!===> read input

      ! If known that one has hit END of FILE (EOF), return with EOF
      ! without trying to read behind the EOF record marker.
      if (reached_EOF) goto 999

      loop: DO 

        nline = nline + 1
        READ (infh,'(a)',ERR=911,END=999,IOSTAT=ios) line
        LINE = adjustl(line)
58
        WRITE(dbgfh,'("line:",i5,">",a71)') nline,line(1:71)
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139

        n = SCAN(line,'!')                 ! remove end of line comments

        IF ( n>0 ) THEN
            line = line(1:n-1)
        ENDIF

        n = LEN_TRIM( line )               ! length of line without trailing blanks
        IF ( n == 0 ) CYCLE loop

        IF ( line(1:1)=='&' ) THEN         ! check if beginning of namelist
          IF (building) THEN
            WRITE (errfh,*) 
     &      'missing end of namelist marker / in  or before line', nline 
            CALL juDFT_error
     +           ("missing end of namelist marker / in  or before line"
     +           ,calledby ="read_record")
          ENDIF
          building = .true.
          buffer = line
          nbuffer = n
          if( line(n:n)=='/' ) complete = .true.

        ELSEIF ( line(n:n)=='/' ) THEN     ! check if end of namelist
          IF (building) THEN
            complete = .true.
            buffer = buffer(1:nbuffer)//' '//line
            nbuffer = nbuffer + 1 + n
          ELSE
            WRITE (errfh,*) 
     &           'out of place end of namelist marker / in line', nline 
            CALL juDFT_error
     +           ("out of place end of namelist marker / in line"
     +           ,calledby ="read_record")
          ENDIF

        ELSEIF ( building ) THEN           ! add line to buffer
          buffer = buffer(1:nbuffer)//' '//line
          nbuffer = nbuffer + 1 + n

        ELSEIF ( n > 0 ) THEN              ! check for non empty lines outside of namelists
          buffer = line
          nbuffer = n
          complete = .true.
        ENDIF

        IF ( complete ) THEN
!dbg      WRITE (dbgfh,'("buffer=>",a71)') buffer(1:71)
          EXIT
        ENDIF
!===> 
      END DO loop

! internal file / namelist fix
      REWIND ( bfh )
      WRITE (bfh,'(2000a)') buffer
      REWIND ( bfh )
! internal file / namelist fix

      ios = 0
      RETURN

 911  CONTINUE
      WRITE (errfh,*) 'lapw_input: ERROR reading input. ios  =',ios,
     &               ', line =',nline
      CALL juDFT_error("lapw_input: ERROR reading input",calledby
     +     ="read_record")

 999  CONTINUE

      reached_EOF = .true.
      ios = 1 
      IF ( building ) THEN
        ios = 2
      ELSE
        buffer = '&end /'
      ENDIF
      RETURN

      END SUBROUTINE read_record
      END MODULE m_readrecord