30 CHARACTER(len=20) FUNCTION str(k)
31 INTEGER,
INTENT(IN) :: k
37 CHARACTER(len=40) FUNCTION rstr(x,fm)
38 REAL(KIND=8),
INTENT(IN) :: x
39 CHARACTER(len=20),
INTENT(IN) :: fm
40 WRITE (
rstr, trim(adjustl(fm))) x
47 CHARACTER,
INTENT(IN) :: c
48 CHARACTER,
DIMENSION(:),
INTENT(IN) :: s
49 INTEGER,
DIMENSION(size(s)) :: isin
64 USE iso_fortran_env
, only: int64
67 INTEGER,
ALLOCATABLE :: seed_loc(:)
68 INTEGER :: i, n, un, istat, dt(8), pid
71 CALL random_seed(
size = n)
74 OPEN(newunit=un, file=
"/dev/urandom", access=
"stream", &
75 form=
"unformatted", action=
"read", status=
"old", iostat=istat)
85 CALL date_and_time(values=dt)
86 t = (dt(1) - 1970) * 365_int64 * 24 * 60 * 60 * 1000 &
87 + dt(2) * 31_int64 * 24 * 60 * 60 * 1000 &
88 + dt(3) * 24_int64 * 60 * 60 * 1000 &
89 + dt(5) * 60 * 60 * 1000 &
90 + dt(6) * 60 * 1000 + dt(7) * 1000 &
94 t = ieor(t, int(pid, kind(t)))
99 CALL random_seed(put=seed_loc)
109 s = mod(s, 4294967296_int64)
111 s = mod(s * 279470273_int64, 4294967291_int64)
112 lcg = int(mod(s, int(huge(0), int64)), kind(0))
117 SUBROUTINE piksrt(k,arr,par)
118 INTEGER,
INTENT(IN) :: k
119 INTEGER,
DIMENSION(k),
INTENT(INOUT) :: arr
120 INTEGER,
INTENT(OUT) :: par
139 REAL(KIND=8),
DIMENSION(:,:),
INTENT(INOUT) :: A
150 REAL(KIND=8),
DIMENSION(:,:) :: A
151 REAL(KIND=8) :: mat_trace
156 mat_trace=mat_trace+a(i,i)
162 REAL(KIND=8),
DIMENSION(:,:) :: A,B
163 REAL(KIND=8) :: mat_contract
169 mat_contract=mat_contract+a(i,j)*b(i,j)
176 REAL(KIND=8),
DIMENSION(:,:) :: a
177 REAL(KIND=8),
DIMENSION(:) :: p
186 sum=sum-a(i,k)*a(j,k)
189 IF (sum.le.0.) stop
'choldc failed' 199 SUBROUTINE printmat(A) ! to be moved to util
200 REAL(KIND=8),
DIMENSION(:,:),
INTENT(IN) :: A
208 SUBROUTINE cprintmat(A) ! to be moved to util
209 COMPLEX(KIND=16),
DIMENSION(:,:),
INTENT(IN) :: A
217 FUNCTION invmat(A) RESULT(Ainv)
218 REAL(KIND=8),
DIMENSION(:,:),
INTENT(IN) :: A
219 REAL(KIND=8),
DIMENSION(SIZE(A,1),SIZE(A,2)) :: Ainv
221 REAL(KIND=8),
DIMENSION(SIZE(A,1)) :: work
222 INTEGER,
DIMENSION(SIZE(A,1)) :: ipiv
231 CALL dgetrf(n, n, ainv, n, ipiv, info)
234 stop
'Matrix is numerically singular!' 239 CALL dgetri(n, ainv, n, ipiv, work, n, info)
242 stop
'Matrix inversion failed!' 247 REAL(KIND=8),
DIMENSION(:,:),
INTENT(IN) :: A
248 REAL(KIND=8),
DIMENSION(:,:),
INTENT(OUT) :: T
259 REAL(KIND=8),
DIMENSION(:,:),
INTENT(IN) :: A
260 REAL(KIND=8),
DIMENSION(:),
INTENT(OUT) :: d
268 SUBROUTINE cdiag(A,d)
269 COMPLEX(KIND=16),
DIMENSION(:,:),
INTENT(IN) :: A
270 COMPLEX(KIND=16),
DIMENSION(:),
INTENT(OUT) :: d
280 INTEGER :: i,j,floordiv
281 floordiv=int(floor(
real(i)/
real(j)))
285 SUBROUTINE reduce(A,Ared,n,ind,rind)
286 REAL(KIND=8),
DIMENSION(:,:),
INTENT(IN) :: A
287 REAL(KIND=8),
DIMENSION(:,:),
INTENT(OUT) :: Ared
288 INTEGER,
INTENT(OUT) :: n
289 INTEGER,
DIMENSION(:),
INTENT(OUT) :: ind,rind
290 LOGICAL,
DIMENSION(SIZE(A,1)) :: sel
298 IF (any(a(i,:)/=0))
THEN 308 IF (sel(i).and.sel(j)) ared(rind(i),rind(j))=a(i,j)
313 SUBROUTINE ireduce(A,Ared,n,ind,rind)
314 REAL(KIND=8),
DIMENSION(:,:),
INTENT(OUT) :: A
315 REAL(KIND=8),
DIMENSION(:,:),
INTENT(IN) :: Ared
316 INTEGER,
INTENT(IN) :: n
317 INTEGER,
DIMENSION(:),
INTENT(IN) :: ind,rind
322 a(ind(i),ind(j))=ared(i,j)
328 REAL(KIND=8),
DIMENSION(:),
INTENT(IN) :: u,v
329 REAL(KIND=8),
DIMENSION(:,:),
INTENT(OUT) :: A
subroutine, public choldc(a, p)
subroutine, public init_random_seed()
Random generator initialization routine.
integer function, public floordiv(i, j)
subroutine, public cdiag(A, d)
subroutine, public piksrt(k, arr, par)
Simple card player sorting function.
character(len=40) function, public rstr(x, fm)
Convert a real to string with a given format.
subroutine, public printmat(A)
subroutine, public diag(A, d)
subroutine, public ireduce(A, Ared, n, ind, rind)
real(kind=8) function, public mat_trace(A)
character(len=20) function, public str(k)
Convert an integer to string.
subroutine, public vector_outer(u, v, A)
real(kind=8) function, public mat_contract(A, B)
integer function, dimension(size(s)), public isin(c, s)
Determine if a character is in a string and where.
subroutine, public reduce(A, Ared, n, ind, rind)
subroutine, public triu(A, T)
subroutine, public init_one(A)
Initialize a square matrix A as a unit matrix.
real(kind=8) function, dimension(size(a, 1), size(a, 2)), public invmat(A)
subroutine, public cprintmat(A)