133 lines
3.3 KiB
Fortran
133 lines
3.3 KiB
Fortran
**** Generic convenience subroutines and functions
|
|
|
|
subroutine ibaserep(x,base,rep_x,len)
|
|
implicit none
|
|
! Subroutine generating the first len digits of
|
|
! the standard representation of an integer x
|
|
! in the given base, ignoring the sign.
|
|
!
|
|
! x: Integer to be represented.
|
|
! base: Base of the representation.
|
|
! bases <= 1 yield an error.
|
|
! len: Length of the vector rep_x.
|
|
! rep_x: Vector containing the digits
|
|
! of the representation, starting
|
|
! with the 0th power.
|
|
|
|
integer len
|
|
integer base
|
|
integer x, rep_x(len)
|
|
|
|
integer z
|
|
|
|
integer k
|
|
|
|
if (base.le.1) then
|
|
stop 'ERROR: ibaserep: Invalid base.'
|
|
endif
|
|
|
|
! create working copy of x
|
|
z=iabs(x)
|
|
|
|
do k=1,len
|
|
rep_x(k) = mod(z,base)
|
|
z = z/base
|
|
enddo
|
|
end
|
|
|
|
!------------------------------------------------------------
|
|
|
|
subroutine repeatfmt32(fullfmt,unitfmt,rep,ulen)
|
|
implicit none
|
|
! Generate a 32 character format string repeating the same
|
|
! (up to) 16 character format the given number of times.
|
|
!
|
|
! Ex.: repeatfmt32(fmt,'ES23.15',50,7)
|
|
! is equivalent to
|
|
! fmt='( 50ES23.15) '
|
|
! which is a valid format string equivalent to '(50ES23.15)'.
|
|
!
|
|
!
|
|
! rep: number of repetitions
|
|
! ulen: actual length of unitfmt <=16
|
|
! fullfmt: output format string
|
|
! unitfmt: segment to be repeated rep times
|
|
|
|
integer ulen,rep
|
|
character*32 fullfmt
|
|
character unitfmt(16)
|
|
|
|
character*16 unit_tmp
|
|
|
|
if (ulen.gt.16) then
|
|
stop 'ERROR: repeatfmt32: string unit exceeding size limit'
|
|
else if (rep.ge.10**9) then
|
|
stop 'ERROR: repeatfmt32: repetition number too large'
|
|
endif
|
|
|
|
! copy desired unit string
|
|
unit_tmp=' '
|
|
write(unit_tmp,'(16(A1,:))') unitfmt(1:ulen)
|
|
|
|
write(fullfmt,'("(",I14,A16)') rep, unit_tmp
|
|
fullfmt = trim(fullfmt) // ')'
|
|
|
|
end
|
|
|
|
!------------------------------------------------------------
|
|
|
|
logical function ibetween(min,x,max)
|
|
implicit none
|
|
! Function checking whether the inequation
|
|
! min <= x <= max holds true.
|
|
|
|
integer min,max,x
|
|
|
|
ibetween=(min.le.x).and.(x.le.max)
|
|
|
|
end
|
|
|
|
!------------------------------------------------------------
|
|
|
|
logical function dbetween(min,x,max)
|
|
implicit none
|
|
! Function checking whether the inequation
|
|
! min <= x <= max holds true.
|
|
|
|
double precision min,max,x
|
|
|
|
dbetween=(min.le.x).and.(x.le.max)
|
|
|
|
end
|
|
|
|
!------------------------------------------------------------
|
|
|
|
logical function dveceq(vec1,vec2,len)
|
|
implicit none
|
|
! Function comparing two vectors of length len
|
|
! element by element, only true if all elements are
|
|
! equal
|
|
|
|
double precision vec1(*),vec2(*)
|
|
integer len
|
|
|
|
dveceq=all( vec1(1:len).eq.vec2(1:len) )
|
|
|
|
end
|
|
|
|
|
|
!------------------------------------------------------------
|
|
|
|
logical function dvecne(vec1,vec2,len)
|
|
implicit none
|
|
! Function comparing two vectors of length len
|
|
! element by element, only true if at least one
|
|
! is different.
|
|
|
|
double precision vec1(*),vec2(*)
|
|
integer len
|
|
|
|
dvecne=any( vec1(1:len).ne.vec2(1:len) )
|
|
|
|
end
|