1 SUBROUTINE svdinv(m, a, wcut, file)
9 CHARACTER(LEN=*) :: file
10 REAL(rprec),
DIMENSION(m,m) :: a
14 REAL(rprec) :: zero = 0
18 INTEGER :: nonzero, nlast, istat, i, j, iunit
19 REAL(rprec),
ALLOCATABLE :: u(:,:), w(:), v(:,:)
20 REAL(rprec) :: wmax, wcuta
42 ALLOCATE (u(m,m), w(m), v(m,m), stat=istat)
43 IF (istat .eq. 0)
THEN
51 IF (wcut .lt. zero)
THEN
52 CALL safe_open(iunit, istat, file,
'old',
'formatted')
53 IF (istat .ne. 0)
GOTO 98
54 READ (iunit, *, err=98)
55 READ (iunit, *, err=98)
56 READ (iunit, *, err=98) m, nonzero
59 READ (iunit, *, err=98) w(i)
61 READ (iunit, *, err=98) v(j,i), u(j,i)
68 nlast = min(nonzero,nlast)
82 CALL svdcmp (u, m, m, m, m, w, v)
86 CALL sortsvd (m, m, m, m, w, u, v)
91 IF (w(nonzero) .ne. 0)
EXIT
93 IF (nonzero .le. 0)
GOTO 999
96 IF (wcut .eq. zero)
THEN
97 CALL safe_open(iunit, istat, file,
'unknown',
'formatted')
98 WRITE (iunit, *)
'Max w = ', w(1),
', Min w = ', w(nonzero)
99 WRITE (iunit, *)
'Ratio = ', w(1)/w(nonzero)
100 WRITE (iunit, *) m, nonzero
103 WRITE (iunit, *) w(i)
105 WRITE (iunit, *) v(j,i), u(j,i)
115 IF (wcuta .gt. 1)
THEN
121 IF (w(i) .gt. wmax*wcuta)
THEN
132 IF (nlast.le.0 .or. nlast.gt.nonzero) nlast = nonzero
135 u(:m,i) = u(:m,i)/w(i)
145 a(i,j) = sum(v(i,:m)*u(j,:m))
152 DEALLOCATE (u, w, v, stat=istat)
154 END SUBROUTINE svdinv