Update the fileread.f90

src/parser/lib/fileread.f

@@ -1,148 +0,0 @@
-      module fileread_mod
-      contains
-!-------------------------------------------------------------------
-
-      subroutine get_datfile(datnam,dnlen)
-      implicit none
-!     Get name of input data file DATNAM either from the program's first
-!     command line argument or ask the user.
-
-      integer dnlen
-      character(len=dnlen) datnam
-
-      integer argcount
-
-      argcount=iargc()
-      if (argcount.gt.0) then
-         call getarg(1,datnam)
-      else
-         write(6,'(A)') 'Specify input file:'
-         read(*,*) datnam
-      endif
-
-      if (len_trim(datnam).eq.dnlen) then
-         write(6,'(A)') 'ERROR: TRUNCATED FILENAME'
-         write(6,'(A)') '"' // datnam // '"'
-      endif
-
-      end subroutine get_datfile
-
-!-------------------------------------------------------------------
-
-      subroutine internalize_datfile(datnam,infile,linenum,llen,
-     >     maxlines,dnlen)
-      use strings_mod,only:write_oneline,int2string
-      implicit none
-
-!     Read input file located at DATNAM, skipping comments and blank lines.
-      integer dnlen,llen,maxlines
-      integer linenum
-      character(len=dnlen) datnam
-      character(len=llen) infile(maxlines)
-
-      character(len=llen) line
-
-      !character*16 int2string
-
-      integer j
-
-      !Fabian
-      character(len=llen) fmt,fmt2
-      integer,parameter  ::  std_out = 6
-      integer,parameter :: funit = 10
-      write(fmt,'(A)') 'Reading file ''' // trim(datnam) // ''' ...'
-      call write_oneline(fmt,std_out)
-
-      open(unit=funit,file=datnam)
-      linenum=0
-      do j=1,maxlines
-         !read(funit,fmt='(A<llen>)',end=20) line !<var> works only for ifort, not for gfortran or mpif90
-         write(fmt2,'("(A",I3,")")') llen !Fabian
-         read(funit,fmt=fmt2,end=20) line   !Fabian
-         if (line(1:3).eq.'---') then
-            write(fmt,'(A)') 'EOF-mark "---" found at line'
-     >           // trim(int2string(j))
-            call write_oneline(fmt,std_out)
-            exit
-         endif
-         call internalize_line(linenum,infile,line,llen,maxlines)
-      enddo
- 20   close(funit)
-
-      if (j.ge.maxlines) then
-         write(6,'(A)') 'ERROR: FILE LENGTH EXCEEDING MAXLINES.'
-         stop 1
-      endif
-
-      write(fmt,'(A)') 'File read successfully ('
-     >     // trim(int2string(linenum)) // ' lines).'
-      call write_oneline(fmt,std_out)
-
-      end subroutine internalize_datfile
-
-!-------------------------------------------------------------------
-
-      subroutine internalize_line(linenum,infile,line,llen,maxlines)
-      use strings_mod,only: strip_string,upcase
-      implicit none
-!     Parse a single line of input.  Ignore comments ("!..") and blank
-!     lines,  and turn all input to uppercase.
-!
-!     infile:      data file's internalized form
-!     line:        single verbatim line read from physical file
-!     linenum:     current number of non-commentlines read
-!                  increased by 1 if read line is not a comment
-!     llen:        maximum character length of a single line
-!     maxlines:    maximum number of lines in infile
-
-      integer llen,maxlines
-      integer linenum
-      character(len=llen) infile(maxlines)
-      character(len=llen) line
-
-      character(len=llen) strip
-      integer line_pos,text_end
-
-      integer j
-
-      line_pos=linenum+1
-
-!     ignore empty lines
-      if (len_trim(line).eq.0) then
-         return
-      endif
-
-!     strip needless whitespace
-      call strip_string(line,strip,llen)
-
-!     determine EOL
-!     ignore comments
-      text_end=0
-      do j=1,len_trim(strip)
-         if (strip(j:j).eq.'!') then
-            exit
-         endif
-         text_end=text_end+1
-      enddo
-
-      if (text_end.eq.llen) then
-         write(6,'(A,I6)') 'WARNING: POTENTIALLY TRUNCATED LINE:'
-         write(6,'(A)') '"' // strip(1:60) // '"...'
-      endif
-
-!     skip if line is a comment
-      if (text_end.eq.0) then
-         return
-      endif
-
-      infile(line_pos)=' '
-
-!     turn string to uppercase and write to infile, ignoring comments
-      call upcase(strip,infile(line_pos),text_end)
-
-!     increment line number
-      linenum=linenum+1
-
-      end subroutine internalize_line
-
-      end module

src/parser/lib/fileread.f90

@@ -1,168 +1,164 @@
 module fileread_mod
-    contains
+  use strings_mod, only: int2string, strip_string, upcase, write_oneline
-    !-------------------------------------------------------------------
-
-    subroutine get_datfile(datnam,dnlen)
   implicit none
-        !     Get name of input data file DATNAM either from the program's first
+contains
-        !     command line argument or ask the user.
+!-------------------------------------------------------------------
-
+  subroutine get_datfile(datnam)
-        integer dnlen
+    implicit none
-        character(len=dnlen) datnam
+!     Get name of input data file DATNAM either from the program's first
-
+!     command line argument or ask the user.
+    integer, parameter :: dnlen = 1000
+    character(len=dnlen) :: tmp
+    character(len=:), allocatable, intent(out) :: datnam
     integer argcount
-
+    argcount = iargc()
-        argcount=iargc()
+    if (argcount .gt. 0) then
-        if (argcount.gt.0) then
+      call getarg(1, tmp)
-        call getarg(1,datnam)
+      datnam = trim(tmp)
     else
-        write(6,'(A)') 'Specify input file:'
+      write (6, '(A)') 'Specify input file:'
-        read(*,*) datnam
+      read (*, *) tmp
-        endif
+      datnam = trim(tmp)
-
+    end if
-        if (len_trim(datnam).eq.dnlen) then
-        write(6,'(A)') 'ERROR: TRUNCATED FILENAME'
-        write(6,'(A)') '"' // datnam // '"'
-        endif
 
+    if (len_trim(tmp) .eq. dnlen) then
+      write (6, '(A)') 'ERROR: TRUNCATED FILENAME'
+      write (6, '(A)') '"'//tmp//'"'
+    end if
   end subroutine get_datfile
-
+!-------------------------------------------------------------------
-    !-------------------------------------------------------------------
+  recursive subroutine internalize_datfile(datnam, infile, linenum, llen)
-
-    recursive subroutine internalize_datfile(datnam,infile,linenum,llen, &
-                                    maxlines,dnlen)
-        use strings_mod,only:write_oneline,int2string
     implicit none
+!     Read input file located at DATNAM, skipping comments and blank lines.
+    integer, intent(in) :: llen!, maxlines
+    integer, intent(inout) :: linenum
+    character(len=:), allocatable, intent(in):: datnam
+    character(len=llen), allocatable, intent(inout) :: infile(:)
 
-        !     Read input file located at DATNAM, skipping comments and blank lines.
+    ! local variables
-        integer dnlen,llen,maxlines
-        integer linenum
-        character(len=dnlen) datnam
-        character(len=llen) infile(maxlines)
-
     character(len=llen) line
+    character(len=32) datfmt
+    integer j, unit
+    integer, parameter :: line_increase = 10000
+    character(len=llen) fmt
+    integer, parameter  ::  std_out = 6
 
-        !character*16 int2string
+    datfmt = '(750A)'
+    write (datfmt, '(1A,i0,2A)') "(", llen, "A)"
 
-        integer j
+    write (fmt, '(A)') 'Reading file '''//trim(datnam)//''' ...'
+    call write_oneline(fmt, std_out)
 
-        !Fabian
+    if (file_exists(datnam)) then
-        character(len=llen) fmt,fmt2
+      open (newunit=unit, file=datnam)
-        integer,parameter  ::  std_out = 6
+    else
-        integer,parameter :: funit = 10
+      write(*,*) 'file: ', datnam
-        write(fmt,'(A)') 'Reading file ''' // trim(datnam) // ''' ...'
+      error stop 'specified inputfile does not exist'
-        call write_oneline(fmt,std_out)
+    end if
 
-        open(unit=funit,file=datnam)
+    if (allocated(infile)) deallocate (infile)
-        linenum=0
+    allocate (character(len=llen) :: infile(line_increase))
-        do j=1,maxlines
+    linenum = 0
-            !read(funit,fmt='(A<llen>)',end=20) line !<var> works only for ifort, not for gfortran or mpif90
+    j = 0
-            write(fmt2,'("(A",I3,")")') llen !Fabian
+    do
-            read(funit,fmt=fmt2,end=20) line   !Fabian
+      j = j + 1
-            if (line(1:3).eq.'---') then
+      read (unit, fmt=datfmt, end=20) line
-                write(fmt,'(A)') 'EOF-mark "---" found at line' &
+
-                           // trim(int2string(j))
+      if (line(1:3) .eq. '---') then
-                call write_oneline(fmt,std_out)
+        write (fmt, '(A)') 'EOF-mark "---" found at line'&
+        &//trim(int2string(j))
+        call write_oneline(fmt, std_out)
         exit
-            endif
+      end if
-            call internalize_line(linenum,infile,line,llen,maxlines,dnlen)
-        enddo
- 20   close(funit)
 
-        if (j.ge.maxlines) then
+      ! increase infile if needed
-            write(6,'(A)') 'ERROR: FILE LENGTH EXCEEDING MAXLINES.'
+      if (linenum + 1 >= size(infile, 1))  call increase_infile(infile,line_increase, llen)
-            stop 1
+      call internalize_line(linenum, infile, line, llen)
-        endif
+    end do
+20  close (unit)
 
-        write(fmt,'(A)') 'File read successfully (' &
+!     decrease size of infile to actual linenum
-             // trim(int2string(linenum)) // ' lines).'
+    call shrink_infile(infile,linenum,llen)
-        call write_oneline(fmt,std_out)
 
+    write (6, '(A)') 'File:'//datnam//' read successfully ('&
+    &//trim(int2string(linenum))//' lines).'
   end subroutine internalize_datfile
-
+!-------------------------------------------------------------------
-    !-------------------------------------------------------------------
+  recursive subroutine internalize_line(linenum, infile, line, llen)
-
-    recursive subroutine internalize_line(linenum,infile,line,llen,maxlines,dnlen)
-        use strings_mod,only: strip_string,upcase
     implicit none
-        !     Parse a single line of input.  Ignore comments ("!..") and blank
+!     Parse a single line of input.  Ignore comments ("!..") and blank
-        !     lines,  and turn all input to uppercase.
+!     lines,  and turn all input to uppercase.
-        !
+!
-        !     infile:      data file's internalized form
+!     infile:      data file's internalized form
-        !     line:        single verbatim line read from physical file
+!     line:        single verbatim line read from physical file
-        !     linenum:     current number of non-commentlines read
+!     linenum:     current number of non-commentlines read
-        !                  increased by 1 if read line is not a comment
+!                  increased by 1 if read line is not a comment
-        !     llen:        maximum character length of a single line
+!     llen:        maximum character length of a single line
-        !     maxlines:    maximum number of lines in infile
+    integer llen
-
-        integer llen,maxlines
     integer linenum
-        integer dnlen
+    character(len=llen), allocatable :: infile(:)
-        character(len=llen) infile(maxlines)
     character(len=llen) line
 
     character(len=llen) strip
-        integer line_pos,text_end
+    integer line_pos, text_end
 
     integer j
 
-        line_pos=linenum+1
-
     !     ignore empty lines
-        if (len_trim(line).eq.0) then
+    if (len_trim(line) .eq. 0) then
       return
-        endif
+    end if
 
     !     strip needless whitespace
-        call strip_string(line,strip,llen)
+    call strip_string(line, strip, llen)
 
     !     determine EOL
     !     ignore comments
-        text_end=0
+    text_end = 0
-        do j=1,len_trim(strip)
+    do j = 1, len_trim(strip)
-            if (strip(j:j).eq.'!') then
+      if (strip(j:j) .eq. '!') then
         exit
-            endif
+      end if
-            text_end=text_end+1
+      text_end = text_end + 1
-        enddo
+    end do
 
-        if (text_end.eq.llen) then
+    if (text_end .eq. llen) then
-            write(6,'(A,I6)') 'WARNING: POTENTIALLY TRUNCATED LINE:'
+      write (6, '(A,I6)') 'WARNING: POTENTIALLY TRUNCATED LINE:'
-            write(6,'(A)') '"' // strip(1:60) // '"...'
+      write (6, '(A)') '"'//strip(1:60)//'"...'
-        endif
+    end if
 
     !     skip if line is a comment
-        if (text_end.eq.0) then
+    if (text_end .eq. 0) then
       return
-        endif
+    end if
 
-        ! insert included file 
+    !     insert include files "@filename"
-        if (strip(1:1) .eq. '@') then 
+    if (strip(1:1) == '@') then
       block
-                character(len=llen),allocatable:: tmp_file(:) 
+        character(len=llen), allocatable :: tmp_infile(:)
-                character(len=:),allocatable:: tmp_name
+        character(len=:), allocatable :: tmp_name
-                integer:: tmp_linenum 
+        integer :: tmp_linenum
 
         tmp_name = trim(strip(2:))
-                call internalize_datfile(tmp_name,tmp_file,tmp_linenum,llen,maxlines,dnlen)
+        call internalize_datfile(tmp_name, tmp_infile, tmp_linenum, llen)
-                call append_infile(infile,tmp_file,llen)
+        call shrink_infile(infile, linenum, llen) !     decrease size of infile to actual linenum
+        call append_infile(infile, tmp_infile, llen)
+        linenum = size(infile, 1)
       end block
+      return
+    end if
 
+    line_pos = linenum + 1
+    infile(line_pos) = ' '
 
+!     turn string to uppercase and write to infile, ignoring comments
+    call upcase(strip, infile(line_pos), text_end)
 
-        endif 
+!     increment line number
-
+    linenum = linenum + 1
-        infile(line_pos)=' '
-
-        !     turn string to uppercase and write to infile, ignoring comments
-        call upcase(strip,infile(line_pos),text_end)
-
-        !     increment line number
-        linenum=linenum+1
-
   end subroutine internalize_line
 
-
+!  append 1D array by a another 1D array
   subroutine append_infile(array1, array2, llen)
     integer, intent(in) :: llen
     character(len=llen), dimension(:), intent(inout), allocatable :: array1
@@ -177,4 +173,30 @@ module fileread_mod
     call move_alloc(tmp, array1)
   end subroutine append_infile
 
-end module
+  subroutine shrink_infile(infile,linenum,llen)
+    integer,intent(in) :: linenum, llen
+    character(len=llen),dimension(:),allocatable,intent(inout) :: infile
+    character(len=llen),dimension(:),allocatable :: tmp_file
+    allocate(character(len=llen) :: tmp_file(1:linenum))
+    tmp_file(1:linenum) = infile(1:linenum)
+    call move_alloc(tmp_file, infile)
+  end subroutine shrink_infile
+
+  subroutine increase_infile(infile, line_increase, llen)
+    integer,intent(in) :: llen, line_increase
+    character(len=llen), dimension(:),intent(inout),allocatable :: infile
+    character(len=llen), dimension(:),allocatable :: tmp_file
+    integer :: linenum
+    linenum = size(infile,1)
+    allocate (character(len=llen) :: tmp_file(linenum + line_increase))
+    tmp_file(1:linenum) = infile(1:linenum)
+    call move_alloc(tmp_file, infile)
+  end subroutine increase_infile
+
+  function file_exists(filename) result(res)
+    character(len=*), intent(in) :: filename
+    logical                     :: res
+    inquire (file=trim(filename), exist=res)
+  end function file_exists
+
+end module fileread_mod

src/parser/lib/keyread.f

@@ -127,6 +127,7 @@
             call long_realkey(infile,inpos,key_end,
      >           ddat,dstart,readlen,llen,maxdat,linenum)
          else if (intype.eq.4) then
+            datlen=maxdat-cstart+1
             call long_strkey(infile,inpos,key_end,
      >           cdat,cstart,readlen,llen,maxdat,linenum,clen)
          else if (intype.eq.5) then
@@ -173,7 +174,7 @@
             dstart=dstart+inlen
          else if (intype.eq.4) then
             datpos(2,j)=cstart
-            dstart=cstart+inlen
+            cstart=cstart+inlen
          else if (intype.eq.5) then
 !           remember where you last found the key in infile
             datpos(2,j)=inpos

src/parser/lib/long_keyread.f

@@ -452,8 +452,8 @@
 
 !---------------------------------------------------------------------------
 
-      subroutine long_strline(inline,linelen,line_start,
+      subroutine long_strline(inline,linelen,line_start,cdat,
-     >                        cdat,cpos,datlen,readlen,clen,
+     >                        cpos,datlen,readlen,clen,
      >                        continued,broken,strpos)
       use strings_mod,only:iswhitespace, downcase
       implicit none

src/parser/lib/strings.f

@@ -499,7 +499,51 @@ C.....   Addition of the first if-loop
 #ifdef mpi_version
       endif
 #endif
-
       end subroutine write_oneline
 
+      Pure Function to_upper (str) Result (string)
+
+      !   ==============================
+      !   Changes a string to upper case
+      !   ==============================
+          Implicit None
+          Character(*), Intent(In) :: str
+          Character(LEN(str))      :: string
+      
+          Integer :: ic, i
+      
+          Character(26), Parameter :: cap = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+          Character(26), Parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
+      
+      !   Capitalize each letter if it is lowecase
+          string = str
+          do i = 1, LEN_TRIM(str)
+              ic = INDEX(low, str(i:i))
+              if (ic > 0) string(i:i) = cap(ic:ic)
+          end do
+      
+      End Function to_upper
+      
+      Pure Function to_lower (str) Result (string)
+
+      !   ==============================
+      !   Changes a string to upper case
+      !   ==============================
+          Implicit None
+          Character(*), Intent(In) :: str
+          Character(LEN(str))      :: string
+      
+          Integer :: ic, i
+      
+          Character(26), Parameter :: cap = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+          Character(26), Parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
+      
+      !   Capitalize each letter if it is lowecase
+          string = str
+          do i = 1, LEN_TRIM(str)
+              ic = INDEX(cap, str(i:i))
+              if (ic > 0) string(i:i) = low(ic:ic)
+          end do
+      
+      End Function to_lower
       end module

src/parser/parser.f

@@ -43,7 +43,7 @@
 !     weighting parameters
 
 !     Declare INTERNAL variables
-      character(len=dnlen) :: datname, dbgdatname !< name of the input File
+      character(len=:),allocatable :: datname, dbgdatname !< name of the input File
       character(len=llen), dimension(:), allocatable :: infile !< internalized array of capitalized input file without comments, blanklines
       integer  linenum          !< linenumber in infile
       double precision gspread
@@ -91,9 +91,12 @@
 !     Read input file
 !############################################################
 
-      call get_datfile(datname,dnlen)
+      !call get_datfile(datname,dnlen)
+      call get_datfile(datname)
+      !call internalize_datfile
+      !>     (datname,infile,linenum,llen,maxlines,dnlen)
       call internalize_datfile
-     >     (datname,infile,linenum,llen,maxlines,dnlen)
+     >     (datname,infile,linenum,llen)
       dbgdatname='.internal_input'
 #ifndef mpi_version
       write(6,'(A)') 'Writing internalized version of input to '''
@@ -503,6 +506,7 @@
             ndata(j)=idat(datIdx(j,key_id))
          enddo
          numdatpt=sum(ndata(1:sets))
+         write(6,*) 'THE TOTAL NUMBER OF POINTS:', numdatpt
       else
          write(*,*)'WARNING: NO NPOINTS CARD GIVEN'
       endif