This subroutine performs a modified jordan elimination on the l-ll+1 by k matrix consisting of rows ll through l of v and columns 1 through k of v. The resolvent is v(ir,is).
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| integer, | intent(in) | :: | l | |||
| integer, | intent(in) | :: | Ll | |||
| integer, | intent(in) | :: | k | |||
| integer, | intent(in) | :: | Ir | |||
| integer, | intent(in) | :: | Is | |||
| integer, | intent(in) | :: | Nparm | |||
| integer, | intent(in) | :: | Numgr | |||
| real(kind=wp), | intent(inout) | :: | v(Numgr+2*Nparm+1,Nparm+2) |
subroutine sjelim(l, Ll, k, Ir, Is, Nparm, Numgr, v) implicit none integer, intent(in) :: l integer, intent(in) :: Ll integer, intent(in) :: k integer, intent(in) :: Ir integer, intent(in) :: Is integer, intent(in) :: Nparm integer, intent(in) :: Numgr real(wp), intent(inout) :: v(Numgr + 2*Nparm + 1, Nparm + 2) integer :: i, j real(wp) :: fact, resol ! DIVIDE THE ENTRIES IN THE RESOLVENT ROW (EXCEPT FOR THE ! RESOLVENT) BY THE RESOLVENT. resol = v(Ir, Is) do j = 1, k if (j /= Is) v(Ir, j) = v(Ir, j)/resol end do ! SWEEP OUT IN ALL BUT ROW IR AND COLUMN IS. do i = Ll, l if (i /= Ir) then fact = -v(i, Is) do j = 1, k if (j /= Is) v(i, j) = v(i, j) + v(Ir, j)*fact end do end if end do ! DIVIDE THE ENTRIES IN THE RESOLVENT COLUMN (EXCEPT FOR THE ! RESOLVENT) BY THE NEGATIVE OF THE RESOLVENT. do i = Ll, l if (i /= Ir) v(i, Is) = -v(i, Is)/resol end do ! REPLACE THE RESOLVENT BY ITS RECIPROCAL. v(Ir, Is) = one/resol end subroutine sjelim