[cig-commits] r4632 - short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d

[willic3 at geodynamics.org]

Author: willic3
Date: 2006-09-27 13:08:30 -0700 (Wed, 27 Sep 2006)
New Revision: 4632

Added:
   short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/getjac2d.f
Log:
Initial version of routine to compute Jacobian for a 2D surface in 3D.


Added: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/getjac2d.f
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/getjac2d.f	2006-09-27 00:24:45 UTC (rev 4631)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/getjac2d.f	2006-09-27 20:08:30 UTC (rev 4632)
@@ -0,0 +1,93 @@
+c -*- Fortran -*-
+c
+c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c  PyLith by Charles A. Williams, Brad Aagaard, and Matt Knepley
+c
+c  Copyright (c) 2004-2006 Rensselaer Polytechnic Institute
+c
+c  Permission is hereby granted, free of charge, to any person obtaining
+c  a copy of this software and associated documentation files (the
+c  "Software"), to deal in the Software without restriction, including
+c  without limitation the rights to use, copy, modify, merge, publish,
+c  distribute, sublicense, and/or sell copies of the Software, and to
+c  permit persons to whom the Software is furnished to do so, subject to
+c  the following conditions:
+c
+c  The above copyright notice and this permission notice shall be
+c  included in all copies or substantial portions of the Software.
+c
+c  THE  SOFTWARE IS  PROVIDED  "AS  IS", WITHOUT  WARRANTY  OF ANY  KIND,
+c  EXPRESS OR  IMPLIED, INCLUDING  BUT NOT LIMITED  TO THE  WARRANTIES OF
+c  MERCHANTABILITY,    FITNESS    FOR    A   PARTICULAR    PURPOSE    AND
+c  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+c  LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+c  OF CONTRACT, TORT OR OTHERWISE,  ARISING FROM, OUT OF OR IN CONNECTION
+c  WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+c
+c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+c
+c
+      subroutine getjac2d(x,xs,det,sh,nsnodes,ientry,ierr,errstrng)
+c
+c...  subroutine to compute the jacobian determinant given the face
+c     coordinates and the shape functions in natural coordinates.
+c
+c       x(nsd,nsnodes)              = local nodal coordinates
+c       xs(nsd,nsd)                 = jacobian matrix
+c       det                         = determinant of jacobian matrix
+c       sh(1,nsnodes),sh(2,nsnodes) = r,s derivatives of shape functions
+c       sh(3,nsnodes)               = shape functions in (r,s)
+c                                     coordinates
+c       nsnodes                     = number of nodes per face
+c       ientry                      = entry number
+c
+      include "implicit.inc"
+c
+c...  parameter definitions
+c
+      include "ndimens.inc"
+      include "nconsts.inc"
+      include "rconsts.inc"
+c
+c...  subroutine arguments
+c
+      integer nsnodes,ientry,ierr
+      character errstrng*(*)
+      double precision x(nsd,nsnodes),xs(nsd-1,nsd-1),det
+      double precision sh(nsd,nsnodes)
+c
+c...  local variables
+c
+      double precision xstmp(4,2)
+cdebug      integer idb,jdb
+c
+cdebug      write(6,*) "Hello from getjac2d_f!"
+c
+      ierr=izero
+c
+c...calculate jacobian matrix for (x,y,z) to (r,s,t) transformation
+c
+      call dgemm("n","t",nsd,nsd-1,nsnodes,
+     & one,x,nsd,sh,nsd,zero,xstmp,4)
+      call dgemm("t","n",nsd-1,nsd-1,nsd,
+     & one,xstmp,4,xstmp,4,zero,xs,nsd-1)
+c
+c...form determinant of jacobian matrix and check for error condition
+c
+      det=xs(1,1)*xs(2,2)-xs(1,2)*xs(2,1)
+      if(det.le.zero) then
+        ierr=113
+        write(errstrng,700) ientry,det
+      end if
+c
+ 700  format("getjac2d:  entry # ",i7,2x,1pe15.8)
+      return
+      end
+c
+c version
+c $Id: getjac2d.f,v 1.8 2005/03/19 01:49:49 willic3 Exp $
+c
+c Generated automatically by Fortran77Mill on Wed May 21 14:15:03 2003
+c
+c End of file