181 lines
5.2 KiB
Fortran
181 lines
5.2 KiB
Fortran
c-----------------------------------------------------------------------
|
|
c Auxilliary subroutines.
|
|
c-----------------------------------------------------------------------
|
|
|
|
subroutine getline(unit, line, stat)
|
|
implicit none
|
|
integer, intent(in) :: unit
|
|
integer, intent(out) :: stat
|
|
character(72), intent(out) :: line
|
|
integer :: size
|
|
integer :: i,j
|
|
integer :: stat2
|
|
character(72) :: buffer
|
|
character(2) :: pattern
|
|
c List of characers where blanks after/before will be eliminated.
|
|
character(*), parameter :: killtrail = "=,>[*+"
|
|
character(*), parameter :: killlead = "=,>]*+"
|
|
|
|
c Read the full line.
|
|
line = ''
|
|
do
|
|
read(unit, "(A)", iostat=stat) line
|
|
if (stat > 0) return
|
|
exit
|
|
end do
|
|
|
|
c Replace all `tab` characters by a blank.
|
|
do
|
|
i = index(line, char(9))
|
|
if (i.eq.0) exit
|
|
line(i:i) = " "
|
|
end do
|
|
|
|
c Kill leading blanks.
|
|
line = trim(adjustl( line ))
|
|
c Kill possible comments.
|
|
i = index(line, "!")
|
|
c Kill trailing blanks.
|
|
if (i.gt.0) line = trim(adjustl(line(:i-1)))
|
|
|
|
c Kill blanks before special characters.
|
|
do j=1,len(killlead)
|
|
pattern = ' ' // killlead(j:j)
|
|
do
|
|
i = index(line,pattern)
|
|
if (i.eq.0) exit
|
|
line = line(:i-1) // killtrail(j:j) // line(i+2:)
|
|
end do
|
|
end do
|
|
|
|
c Kill blanks after special characters.
|
|
do j=1,len(killlead)
|
|
pattern = killlead(j:j) // ' '
|
|
do
|
|
i = index(line,pattern)
|
|
if (i.eq.0) exit
|
|
line = line(:i-1) // killlead(j:j) // line(i+2:)
|
|
end do
|
|
end do
|
|
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
|
|
subroutine readmode(cmode, var, def)
|
|
implicit none
|
|
character(12), intent(in) :: cmode
|
|
integer, intent(in) :: def
|
|
integer, intent(out) :: var
|
|
integer :: i, imode
|
|
character(12) :: keys(20),settings(20)
|
|
c Common blocks.
|
|
common/runcard/keys,settings
|
|
|
|
c Try to find mode with name 'cmode' in settings.
|
|
imode = -1
|
|
do i=1,20
|
|
if (keys(i).eq.cmode)then
|
|
imode = i
|
|
exit
|
|
endif
|
|
end do
|
|
c If not found, set to default.
|
|
if (imode.lt.0) var = def
|
|
c Otherwise set to value present in settings.
|
|
if (imode.ge.0) call readInt(settings(imode), var)
|
|
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
|
|
subroutine readparm(cparm, var, def)
|
|
implicit none
|
|
character(12), intent(in) :: cparm
|
|
real(8), intent(in) :: def
|
|
real(8), intent(out) :: var
|
|
integer :: i,iparm
|
|
character(12) :: keys(20),settings(20)
|
|
c Common blocks.
|
|
common/runcard/keys,settings
|
|
|
|
c Try to find mode with name 'cparm' in settings.
|
|
iparm = -1
|
|
do i=1,20
|
|
if (keys(i).eq.cparm) iparm = i
|
|
end do
|
|
c If not found, set to default.
|
|
if (iparm.lt.0) var = def
|
|
c Otherwise set to value present in settings.
|
|
if (iparm.ge.0) read(settings(iparm),*) var
|
|
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
|
|
c Auxiliary helper subroutine to read integers in different formats.
|
|
|
|
subroutine readint(string,var)
|
|
implicit none
|
|
integer, intent(out) :: var
|
|
character(8), intent(in) :: string
|
|
integer :: iposk,iposm,ipose,iposd
|
|
real(8) :: helper
|
|
|
|
iposk = index(string,'k')
|
|
if (iposk.eq.0) iposk = index(string,'K')
|
|
iposm = index(string,'m')
|
|
if (iposm.eq.0) iposm = index(string,'M')
|
|
ipose = index(string,'e')
|
|
if (ipose.eq.0) ipose = index(string,'E')
|
|
iposd = index(string,'d')
|
|
if (iposd.eq.0) iposd = index(string,'D')
|
|
|
|
if (iposk.ne.0)then
|
|
read(string(1:iposk-1),'(I16)') var
|
|
var = 1000*var
|
|
elseif (iposm.ne.0)then
|
|
read(string(1:iposm-1),'(I16)') var
|
|
var = 1000000*var
|
|
elseif (ipose.ne.0 .or. iposd.ne.0)then
|
|
read(string,'(F16.0)') helper
|
|
var = helper
|
|
else
|
|
read(string, '(I16)') var
|
|
endif
|
|
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
|
|
c Auxiliary helper subroutine to create output folder
|
|
|
|
SUBROUTINE CREATEOUT(PATH)
|
|
IMPLICIT NONE
|
|
CHARACTER*40 PATH
|
|
|
|
INTEGER L,EXITSTAT
|
|
CHARACTER*40 OPATH
|
|
COMMON /FPATH/ OPATH
|
|
|
|
OPATH = PATH
|
|
L = LEN_TRIM(OPATH)
|
|
|
|
IF (L == 0) THEN
|
|
OPATH = './'
|
|
ELSE IF (OPATH(L:L) /= '/') THEN
|
|
OPATH(L+1:L+1) = '/'
|
|
END IF
|
|
|
|
CALL EXECUTE_COMMAND_LINE("mkdir -p " // TRIM(OPATH),
|
|
$ exitstat=EXITSTAT)
|
|
IF (EXITSTAT /= 0) THEN
|
|
PRINT *, "Error creating directory:", TRIM(OPATH)
|
|
STOP
|
|
END IF
|
|
|
|
END |