From 40ed1e1875d1e0042773bebe6665a62811114f59 Mon Sep 17 00:00:00 2001
From: schnetter <schnetter@b716e942-a2de-43ad-8f52-f3dfe468e4e7>
Date: Wed, 27 Jul 2005 19:15:06 +0000
Subject: Add routine calc_inv2.

Add optional status return values.


git-svn-id: http://svn.einsteintoolkit.org/cactus/EinsteinUtils/TGRtensor/trunk@27 b716e942-a2de-43ad-8f52-f3dfe468e4e7
---
 src/matinv.F90 | 35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

diff --git a/src/matinv.F90 b/src/matinv.F90
index 9a95e86..6814d23 100644
--- a/src/matinv.F90
+++ b/src/matinv.F90
@@ -8,6 +8,8 @@ module matinv
   implicit none
   private
   
+  public calc_inv2
+  
   public calc_posinv3
   public calc_syminv3
   public calc_inv3
@@ -17,6 +19,29 @@ module matinv
   
 contains
   
+  subroutine calc_inv2 (g2, gu2, lerr)
+    CCTK_REAL,           intent(in)  :: g2(2,2)
+    CCTK_REAL,           intent(out) :: gu2(2,2)
+    logical,   optional, intent(out) :: lerr
+    CCTK_REAL :: tmp(2,2)
+    integer   :: ipiv(2)
+    integer   :: info
+    character :: msg*100
+    
+    tmp = g2
+    gu2 = delta2
+    call gesv (2, 2, tmp, 2, ipiv, gu2, 2, info)
+    
+    if (.not. present(lerr) .and. info /= 0) then
+       write (msg, '("Error in call to GESV, info=",i2)') info
+       call CCTK_WARN (1, msg)
+    end if
+    
+    if (present(lerr)) lerr = info /= 0
+  end subroutine calc_inv2
+  
+  
+  
   subroutine calc_posinv3 (g3, gu3, lerr)
     CCTK_REAL,           intent(in)  :: g3(3,3)
     CCTK_REAL,           intent(out) :: gu3(3,3)
@@ -29,7 +54,7 @@ contains
     gu3 = delta3
     call posv ('u', 3, 3, tmp, 3, gu3, 3, info)
     
-    if (info /= 0) then
+    if (.not. present(lerr) .and. info /= 0) then
        write (msg, '("Error in call to POSV, info=",i4)') info
        call CCTK_WARN (1, msg)
     end if
@@ -53,7 +78,7 @@ contains
     gu3 = delta3
     call sysv ('u', 3, 3, tmp, 3, ipiv, gu3, 3, work, lwork, info)
     
-    if (info /= 0) then
+    if (.not. present(lerr) .and. info /= 0) then
        write (msg, '("Error in call to SYSV, info=",i4)') info
        call CCTK_WARN (1, msg)
     end if
@@ -74,7 +99,7 @@ contains
     gu3 = delta3
     call gesv (3, 3, tmp, 3, ipiv, gu3, 3, info)
     
-    if (info /= 0) then
+    if (.not. present(lerr) .and. info /= 0) then
        write (msg, '("Error in call to GESV, info=",i2)') info
        call CCTK_WARN (1, msg)
     end if
@@ -100,7 +125,7 @@ contains
     gu4 = delta4
     call sysv ('u', 4, 4, tmp, 4, ipiv, gu4, 4, work, lwork, info)
     
-    if (info /= 0) then
+    if (.not. present(lerr) .and. info /= 0) then
        write (msg, '("Error in call to SYSV, info=",i4)') info
        call CCTK_WARN (1, msg)
     end if
@@ -121,7 +146,7 @@ contains
     gu4 = delta4
     call gesv (4, 4, tmp, 4, ipiv, gu4, 4, info)
     
-    if (info /= 0) then
+    if (.not. present(lerr) .and. info /= 0) then
        write (msg, '("Error in call to GESV, info=",i2)') info
        call CCTK_WARN (1, msg)
     end if
-- 
cgit v1.2.3