LCOV - code coverage report
Current view: top level - inpgen - read_record.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 42 52 80.8 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_readrecord
       2             :       use m_juDFT
       3             : !***********************************************************************
       4             : !     reads in the next input section which is not an empty line and not
       5             : !     a comment. 
       6             : !     Section can be
       7             : !     
       8             : !     either
       9             : !     ---> a single line of input
      10             : !     or 
      11             : !     ---> a fortran name list ( & ... / ) 
      12             : !          & Must be the first non-space charcter in a new line. 
      13             : !          & ... / can extend over many lines, can contain comments
      14             : !          and empty lines. Maximum length is xl_buffer.
      15             : !
      16             : !     End of line comments in a section are removed.    
      17             : !     A comment is everything to the right of the first ! in a line.
      18             : !     
      19             : !***********************************************************************
      20             :       CONTAINS
      21          38 :       SUBROUTINE read_record(
      22             :      >                       infh,xl_buffer,bfh,
      23             :      X                       nline, 
      24          38 :      <                       nbuffer,buffer,ios )
      25             : 
      26             :       IMPLICIT NONE
      27             : 
      28             :       INTEGER, INTENT (IN)    :: infh            ! input filehandle (5)
      29             :       INTEGER, INTENT (IN)    :: xl_buffer       ! maximum length of read record
      30             :       INTEGER, INTENT (IN)    :: bfh
      31             :       INTEGER, INTENT (INOUT) :: nline           ! in: last line read ; on output new read lines added
      32             :       INTEGER, INTENT (OUT)   :: nbuffer, ios    ! read buffer & I/O status
      33             :       CHARACTER(len=xl_buffer), INTENT (OUT)   :: buffer
      34             : 
      35             :       INTEGER           :: i,j,l,n,nw
      36             :       LOGICAL           :: building, complete
      37          38 :       CHARACTER(len=xl_buffer)  :: line
      38             : 
      39             :       LOGICAL, SAVE :: reached_EOF = .false.
      40             : 
      41             :       INTEGER, PARAMETER  :: dbgfh=6, errfh=6
      42             : !---> initialize some variables
      43             : 
      44          38 :       building = .false.
      45          38 :       complete = .false.
      46             : 
      47             : !===> read input
      48             : 
      49             :       ! If known that one has hit END of FILE (EOF), return with EOF
      50             :       ! without trying to read behind the EOF record marker.
      51          38 :       if (reached_EOF) goto 999
      52             : 
      53             :       loop: DO 
      54             : 
      55          42 :         nline = nline + 1
      56          45 :         READ (infh,'(a)',ERR=911,END=999,IOSTAT=ios) line
      57          78 :         LINE = adjustl(line)
      58          39 :         WRITE(dbgfh,'("line:",i5,">",a71)') nline,line(1:71)
      59             : 
      60          39 :         n = SCAN(line,'!')                 ! remove end of line comments
      61             : 
      62          39 :         IF ( n>0 ) THEN
      63           0 :             line = line(1:n-1)
      64             :         ENDIF
      65             : 
      66          39 :         n = LEN_TRIM( line )               ! length of line without trailing blanks
      67          39 :         IF ( n == 0 ) CYCLE loop
      68             : 
      69          36 :         IF ( line(1:1)=='&' ) THEN         ! check if beginning of namelist
      70           6 :           IF (building) THEN
      71             :             WRITE (errfh,*) 
      72           0 :      &      'missing end of namelist marker / in  or before line', nline 
      73             :             CALL juDFT_error
      74             :      +           ("missing end of namelist marker / in  or before line"
      75           0 :      +           ,calledby ="read_record")
      76             :           ENDIF
      77           6 :           building = .true.
      78           6 :           buffer = line
      79           6 :           nbuffer = n
      80           6 :           if( line(n:n)=='/' ) complete = .true.
      81             : 
      82          30 :         ELSEIF ( line(n:n)=='/' ) THEN     ! check if end of namelist
      83           3 :           IF (building) THEN
      84           3 :             complete = .true.
      85           3 :             buffer = buffer(1:nbuffer)//' '//line
      86           3 :             nbuffer = nbuffer + 1 + n
      87             :           ELSE
      88             :             WRITE (errfh,*) 
      89           0 :      &           'out of place end of namelist marker / in line', nline 
      90             :             CALL juDFT_error
      91             :      +           ("out of place end of namelist marker / in line"
      92           0 :      +           ,calledby ="read_record")
      93             :           ENDIF
      94             : 
      95          27 :         ELSEIF ( building ) THEN           ! add line to buffer
      96           0 :           buffer = buffer(1:nbuffer)//' '//line
      97           0 :           nbuffer = nbuffer + 1 + n
      98             : 
      99          27 :         ELSEIF ( n > 0 ) THEN              ! check for non empty lines outside of namelists
     100          27 :           buffer = line
     101          27 :           nbuffer = n
     102          27 :           complete = .true.
     103             :         ENDIF
     104             : 
     105           3 :         IF ( complete ) THEN
     106             : !dbg      WRITE (dbgfh,'("buffer=>",a71)') buffer(1:71)
     107             :           EXIT
     108             :         ENDIF
     109             : !===> 
     110             :       END DO loop
     111             : 
     112             : ! internal file / namelist fix
     113          33 :       REWIND ( bfh )
     114          33 :       WRITE (bfh,'(2000a)') buffer
     115          33 :       REWIND ( bfh )
     116             : ! internal file / namelist fix
     117             : 
     118          33 :       ios = 0
     119          33 :       RETURN
     120             : 
     121             :  911  CONTINUE
     122           0 :       WRITE (errfh,*) 'lapw_input: ERROR reading input. ios  =',ios,
     123           0 :      &               ', line =',nline
     124             :       CALL juDFT_error("lapw_input: ERROR reading input",calledby
     125           2 :      +     ="read_record")
     126             : 
     127             :  999  CONTINUE
     128             : 
     129           5 :       reached_EOF = .true.
     130           5 :       ios = 1 
     131           5 :       IF ( building ) THEN
     132           0 :         ios = 2
     133             :       ELSE
     134           5 :         buffer = '&end /'
     135             :       ENDIF
     136             :       RETURN
     137             : 
     138          38 :       END SUBROUTINE read_record
     139             :       END MODULE m_readrecord

Generated by: LCOV version 1.13