jnshuti
/
Genetic_base
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update the fileread.f90

This commit is contained in:
jean paul nshuti 2026-02-24 16:39:56 +01:00
parent 8e88c95fbd
commit 7f527f56f3
6 changed files with 230 additions and 307 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

148
src/parser/lib/fileread.f
View File

@ -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

158
src/parser/lib/fileread.f90
View File

@ -1,89 +1,90 @@
module fileread_mod module fileread_mod
use strings_mod, only: int2string, strip_string, upcase, write_oneline
implicit none
contains contains
!------------------------------------------------------------------- !-------------------------------------------------------------------
subroutine get_datfile(datnam)
subroutine get_datfile(datnam,dnlen)
implicit none implicit none
! Get name of input data file DATNAM either from the program's first ! Get name of input data file DATNAM either from the program's first
! command line argument or ask the user. ! command line argument or ask the user.
integer, parameter :: dnlen = 1000
integer dnlen character(len=dnlen) :: tmp
character(len=dnlen) datnam character(len=:), allocatable, intent(out) :: datnam
integer argcount integer argcount
argcount = iargc() argcount = iargc()
if (argcount .gt. 0) then if (argcount .gt. 0) then
call getarg(1,datnam) call getarg(1, tmp)
datnam = trim(tmp)
else else
write (6, '(A)') 'Specify input file:' write (6, '(A)') 'Specify input file:'
read(*,*) datnam read (*, *) tmp
datnam = trim(tmp)
end if end if
if (len_trim(datnam).eq.dnlen) then if (len_trim(tmp) .eq. dnlen) then
write (6, '(A)') 'ERROR: TRUNCATED FILENAME' write (6, '(A)') 'ERROR: TRUNCATED FILENAME'
write(6,'(A)') '"' // datnam // '"' write (6, '(A)') '"'//tmp//'"'
end if end if
end subroutine get_datfile 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 implicit none
! Read input file located at DATNAM, skipping comments and blank lines. ! Read input file located at DATNAM, skipping comments and blank lines.
integer dnlen,llen,maxlines integer, intent(in) :: llen!, maxlines
integer linenum integer, intent(inout) :: linenum
character(len=dnlen) datnam character(len=:), allocatable, intent(in):: datnam
character(len=llen) infile(maxlines) character(len=llen), allocatable, intent(inout) :: infile(:)
! local variables
character(len=llen) line character(len=llen) line
character(len=32) datfmt
!character*16 int2string integer j, unit
integer, parameter :: line_increase = 10000
integer j character(len=llen) fmt
!Fabian
character(len=llen) fmt,fmt2
integer, parameter :: std_out = 6 integer, parameter :: std_out = 6
integer,parameter :: funit = 10
datfmt = '(750A)'
write (datfmt, '(1A,i0,2A)') "(", llen, "A)"
write (fmt, '(A)') 'Reading file '''//trim(datnam)//''' ...' write (fmt, '(A)') 'Reading file '''//trim(datnam)//''' ...'
call write_oneline(fmt, std_out) call write_oneline(fmt, std_out)
open(unit=funit,file=datnam) if (file_exists(datnam)) then
open (newunit=unit, file=datnam)
else
write(*,*) 'file: ', datnam
error stop 'specified inputfile does not exist'
end if
if (allocated(infile)) deallocate (infile)
allocate (character(len=llen) :: infile(line_increase))
linenum = 0 linenum = 0
do j=1,maxlines j = 0
!read(funit,fmt='(A<llen>)',end=20) line !<var> works only for ifort, not for gfortran or mpif90 do
write(fmt2,'("(A",I3,")")') llen !Fabian j = j + 1
read(funit,fmt=fmt2,end=20) line !Fabian read (unit, fmt=datfmt, end=20) line
if (line(1:3) .eq. '---') then if (line(1:3) .eq. '---') then
write (fmt, '(A)') 'EOF-mark "---" found at line'& write (fmt, '(A)') 'EOF-mark "---" found at line'&
// trim(int2string(j)) &//trim(int2string(j))
call write_oneline(fmt, std_out) call write_oneline(fmt, std_out)
exit exit
end if end if
call internalize_line(linenum,infile,line,llen,maxlines,dnlen)
! increase infile if needed
if (linenum + 1 >= size(infile, 1)) call increase_infile(infile,line_increase, llen)
call internalize_line(linenum, infile, line, llen)
end do end do
20 close(funit) 20 close (unit)
if (j.ge.maxlines) then ! decrease size of infile to actual linenum
write(6,'(A)') 'ERROR: FILE LENGTH EXCEEDING MAXLINES.' call shrink_infile(infile,linenum,llen)
stop 1
endif
write(fmt,'(A)') 'File read successfully (' &
// trim(int2string(linenum)) // ' lines).'
call write_oneline(fmt,std_out)
write (6, '(A)') 'File:'//datnam//' read successfully ('&
&//trim(int2string(linenum))//' lines).'
end subroutine internalize_datfile 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 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.
@ -93,12 +94,9 @@ module fileread_mod
! 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 linenum
integer dnlen character(len=llen), allocatable :: infile(:)
character(len=llen) infile(maxlines)
character(len=llen) line character(len=llen) line
character(len=llen) strip character(len=llen) strip
@ -106,8 +104,6 @@ module fileread_mod
integer j integer j
line_pos=linenum+1
! ignore empty lines ! ignore empty lines
if (len_trim(line) .eq. 0) then if (len_trim(line) .eq. 0) then
return return
@ -136,22 +132,23 @@ module fileread_mod
return return
end if end if
! insert included file ! insert include files "@filename"
if (strip(1:1) .eq. '@') then if (strip(1:1) == '@') then
block 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:)) 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 end block
return
end if end if
line_pos = linenum + 1
infile(line_pos) = ' ' infile(line_pos) = ' '
! turn string to uppercase and write to infile, ignoring comments ! turn string to uppercase and write to infile, ignoring comments
@ -159,10 +156,9 @@ module fileread_mod
! increment line number ! increment line number
linenum = linenum + 1 linenum = linenum + 1
end subroutine internalize_line end subroutine internalize_line
! append 1D array by a another 1D array
subroutine append_infile(array1, array2, llen) subroutine append_infile(array1, array2, llen)
integer, intent(in) :: llen integer, intent(in) :: llen
character(len=llen), dimension(:), intent(inout), allocatable :: array1 character(len=llen), dimension(:), intent(inout), allocatable :: array1
@ -177,4 +173,30 @@ module fileread_mod
call move_alloc(tmp, array1) call move_alloc(tmp, array1)
end subroutine append_infile 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

3
src/parser/lib/keyread.f
View File

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

4
src/parser/lib/long_keyread.f
View File

@ -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) > continued,broken,strpos)
use strings_mod,only:iswhitespace, downcase use strings_mod,only:iswhitespace, downcase
implicit none implicit none

46
src/parser/lib/strings.f
View File

@ -499,7 +499,51 @@ C..... Addition of the first if-loop
#ifdef mpi_version #ifdef mpi_version
endif endif
#endif #endif
end subroutine write_oneline 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 end module

10
src/parser/parser.f
View File

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