[cig-commits] r4432 - short/3D/PyLith/branches/pylith-0.8/pylith3d/utils

[willic3 at geodynamics.org]

Author: willic3
Date: 2006-08-25 11:41:14 -0700 (Fri, 25 Aug 2006)
New Revision: 4432

Modified:
   short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makefile
   short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makeucd.f
Log:
Replaced BLAS call in makeucd.f with call to an included subroutine.
Makefile has been modified so that BLAS is no longer linked.



Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makefile
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makefile	2006-08-25 02:36:10 UTC (rev 4431)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makefile	2006-08-25 18:41:14 UTC (rev 4432)
@@ -60,7 +60,7 @@
 	$(FCOMPL) $(opt) -o blockrot blockrot.o
 
 makeucd: makeucd.o
-	$(FCOMPL) $(opt) -o makeucd makeucd.o ${LINALG}
+	$(FCOMPL) $(opt) -o makeucd makeucd.o
 
 pylith2ucd: pylith2ucd.o
 	$(FCOMPL) $(opt) -o pylith2ucd pylith2ucd.o

Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makeucd.f
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makeucd.f	2006-08-25 02:36:10 UTC (rev 4431)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/makeucd.f	2006-08-25 18:41:14 UTC (rev 4432)
@@ -224,6 +224,31 @@
       end
 c
 c
+      subroutine abtrans(a,b,c,nra,nca,nrb,lda,ldb,ldc)
+c
+c...subroutine to multiply the matrix a by b-transpose.  Results
+c   are stored in matrix c.
+c
+      implicit none
+      integer nra,nca,nrb,lda,ldb,ldc
+      double precision a(lda,nca),b(ldb,nca),c(ldc,nrb)
+c
+      integer i,j,k
+      double precision sum
+c
+      do i=1,nra
+        do j=1,nrb
+          sum=0.0d0
+          do k=1,nca
+            sum=sum+a(i,k)*b(j,k)
+          end do
+          c(i,j)=sum
+        end do
+      end do
+      return
+      end
+c
+c
       subroutine centout(
      & numel,ngauss,
      & velemt,neattr,nteattr,
@@ -445,7 +470,8 @@
 c
 c...calculate jacobian matrix for (x,y,z) to (r,s,t) transformation
 c
-      call dgemm("n","t",nsd,nsd,nen,1.0d0,x,nsd,shj,nsd+1,0.0d0,xs,nsd)
+cblas      call dgemm("n","t",nsd,nsd,nen,1.0d0,x,nsd,shj,nsd+1,0.0d0,xs,nsd)
+      call abtrans(x,shj,xs,nsd,nen,nsd,nsd,nsd+1,nsd)
 c
 c...form determinant of jacobian matrix and check for error condition
 c