diff options
Diffstat (limited to 'src/matinv.F90')
| -rw-r--r-- | src/matinv.F90 | 65 |
1 files changed, 40 insertions, 25 deletions
diff --git a/src/matinv.F90 b/src/matinv.F90 index 24bed20..9a95e86 100644 --- a/src/matinv.F90 +++ b/src/matinv.F90 @@ -17,12 +17,13 @@ module matinv contains - subroutine calc_posinv3 (g3, gu3) - CCTK_REAL, intent(in) :: g3(3,3) - CCTK_REAL, intent(out) :: gu3(3,3) + subroutine calc_posinv3 (g3, gu3, lerr) + CCTK_REAL, intent(in) :: g3(3,3) + CCTK_REAL, intent(out) :: gu3(3,3) + logical, optional, intent(out) :: lerr CCTK_REAL :: tmp(3,3) integer :: info - character :: msg*1000 + character :: msg*100 tmp = g3 gu3 = delta3 @@ -30,17 +31,20 @@ contains if (info /= 0) then write (msg, '("Error in call to POSV, info=",i4)') info - call CCTK_WARN (1, trim(msg)) + call CCTK_WARN (1, msg) end if + + if (present(lerr)) lerr = info /= 0 end subroutine calc_posinv3 - subroutine calc_syminv3 (g3, gu3) - CCTK_REAL, intent(in) :: g3(3,3) - CCTK_REAL, intent(out) :: gu3(3,3) + subroutine calc_syminv3 (g3, gu3, lerr) + CCTK_REAL, intent(in) :: g3(3,3) + CCTK_REAL, intent(out) :: gu3(3,3) + logical, optional, intent(out) :: lerr CCTK_REAL :: tmp(3,3) integer :: ipiv(3) integer :: info - character :: msg*1000 + character :: msg*100 integer, parameter :: lwork = 1000 CCTK_REAL :: work(lwork) @@ -51,17 +55,20 @@ contains if (info /= 0) then write (msg, '("Error in call to SYSV, info=",i4)') info - call CCTK_WARN (1, trim(msg)) + call CCTK_WARN (1, msg) end if + + if (present(lerr)) lerr = info /= 0 end subroutine calc_syminv3 - subroutine calc_inv3 (g3, gu3) - CCTK_REAL, intent(in) :: g3(3,3) - CCTK_REAL, intent(out) :: gu3(3,3) + subroutine calc_inv3 (g3, gu3, lerr) + CCTK_REAL, intent(in) :: g3(3,3) + CCTK_REAL, intent(out) :: gu3(3,3) + logical, optional, intent(out) :: lerr CCTK_REAL :: tmp(3,3) integer :: ipiv(3) integer :: info - character :: msg*1000 + character :: msg*100 tmp = g3 gu3 = delta3 @@ -69,19 +76,22 @@ contains if (info /= 0) then write (msg, '("Error in call to GESV, info=",i2)') info - call CCTK_WARN (1, trim(msg)) + call CCTK_WARN (1, msg) end if + + if (present(lerr)) lerr = info /= 0 end subroutine calc_inv3 - subroutine calc_syminv4 (g4, gu4) - CCTK_REAL, intent(in) :: g4(0:3,0:3) - CCTK_REAL, intent(out) :: gu4(0:3,0:3) + subroutine calc_syminv4 (g4, gu4, lerr) + CCTK_REAL, intent(in) :: g4(0:3,0:3) + CCTK_REAL, intent(out) :: gu4(0:3,0:3) + logical, optional, intent(out) :: lerr CCTK_REAL :: tmp(0:3,0:3) integer :: ipiv(0:3) integer :: info - character :: msg*1000 + character :: msg*100 integer, parameter :: lwork = 1000 CCTK_REAL :: work(lwork) @@ -92,17 +102,20 @@ contains if (info /= 0) then write (msg, '("Error in call to SYSV, info=",i4)') info - call CCTK_WARN (1, trim(msg)) + call CCTK_WARN (1, msg) end if + + if (present(lerr)) lerr = info /= 0 end subroutine calc_syminv4 - subroutine calc_inv4 (g4, gu4) - CCTK_REAL, intent(in) :: g4(0:3,0:3) - CCTK_REAL, intent(out) :: gu4(0:3,0:3) + subroutine calc_inv4 (g4, gu4, lerr) + CCTK_REAL, intent(in) :: g4(0:3,0:3) + CCTK_REAL, intent(out) :: gu4(0:3,0:3) + logical, optional, intent(out) :: lerr CCTK_REAL :: tmp(0:3,0:3) integer :: ipiv(0:3) integer :: info - character :: msg*1000 + character :: msg*100 tmp = g4 gu4 = delta4 @@ -110,8 +123,10 @@ contains if (info /= 0) then write (msg, '("Error in call to GESV, info=",i2)') info - call CCTK_WARN (1, trim(msg)) + call CCTK_WARN (1, msg) end if + + if (present(lerr)) lerr = info /= 0 end subroutine calc_inv4 end module matinv |