[cig-commits] r6586 - in short/3D/PyLith/branches/pylith-0.8: .
pylith3d/libpylith3d pylith3d/module
leif at geodynamics.org
leif at geodynamics.org
Mon Apr 16 21:37:16 PDT 2007
Author: leif
Date: 2007-04-16 21:37:14 -0700 (Mon, 16 Apr 2007)
New Revision: 6586
Added:
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/f77io.f
short/3D/PyLith/branches/pylith-0.8/pylith3d/module/f77io.pyx
Removed:
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/open_append.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_setup.F
Modified:
short/3D/PyLith/branches/pylith-0.8/configure.ac
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/Makefile.am
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/autoprestr.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/elastc.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/libpylith3d.pxd
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_cleanup.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_step.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_bc.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_connect.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_coords.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_diff.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_element_info.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_fuldat.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_global_info.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_hist.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_props.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_skew.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_slip.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_sparse_info.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split_plot.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_stateout.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_strscomp.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_subiter.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_timdat.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_tractions.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_wink.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_winkx.F
short/3D/PyLith/branches/pylith-0.8/pylith3d/module/Makefile.am
short/3D/PyLith/branches/pylith-0.8/pylith3d/module/PyLithLib.pyx
short/3D/PyLith/branches/pylith-0.8/pylith3d/module/petsc.pxd
short/3D/PyLith/branches/pylith-0.8/pylith3d/module/setup.pyx
Log:
Open output files once at the beginning of the run, and close them
once at the end (instead of repeatedly opening and appending to them).
This change elminates the need for the CIT_FC_OPEN_APPEND Autoconf
test and the FORTRAN_POSITION_APPEND and FORTRAN_ACCESS_APPEND
preprocessor macros. It also (quite incidentally) made the Fortran
routine viscos_setup() redundant.
Also, I fixed a bug I introduced. In the Pyrex call to scan_timdat(),
I wrote "len(time_units)" instead of "sizeof(time_units)". D'oh!
Mostly, the Pyrex calls are a transcription/merging of the old C++
bindings into the Python code, so hopefully this is the only bug of
its kind.
Modified: short/3D/PyLith/branches/pylith-0.8/configure.ac
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/configure.ac 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/configure.ac 2007-04-17 04:37:14 UTC (rev 6586)
@@ -81,7 +81,6 @@
CIT_HEADER_PETSC
# Checks for typedefs, structures, and compiler characteristics.
-CIT_FC_OPEN_APPEND
CIT_FC_STREAM_IO
# Checks for library functions.
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/Makefile.am
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/Makefile.am 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/Makefile.am 2007-04-17 04:37:14 UTC (rev 6586)
@@ -53,6 +53,7 @@
elas_strs_cmp_ss.f \
elas_strs_mat_cmp_ss.F \
elastc.F \
+ f77io.f \
fill.f \
fmin.f \
formdf_ss.f \
@@ -126,7 +127,6 @@
newt.f \
nfind.f \
nnblnk.f \
- open_append.F \
open_ucd.F \
plinhex.f \
plinhex2d.f \
@@ -203,7 +203,6 @@
update_state_cmp.f \
update_state_drv.f \
viscos.F \
- viscos_setup.F \
viscos_step.F \
viscos_cleanup.F \
winklf.f \
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/autoprestr.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/autoprestr.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/autoprestr.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -46,7 +46,7 @@
& rgiter, ! stresscmp
& skew, ! skew
& ncodat,nunits,nprint,istatout,nstatout, ! ioinfo
- & ofile,pfile,ucdroot, ! files
+ & ucdroot, ! files
& autoprestrStage,iterateEvent, ! PETSc logging
& ierr,errstrng) ! errcode
c
@@ -104,7 +104,7 @@
double precision gauss(*),sh(*),shj(*)
double precision histry(*),delt(*),alfa(*),utol(*),ftol(*),etol(*)
double precision skew(*)
- character ofile*(*),pfile*(*),ucdroot*(*),errstrng*(*)
+ character ucdroot*(*),errstrng*(*)
c
c... included dimension and type statements
c
@@ -152,18 +152,6 @@
ngauss=infetype(2)
nee=infetype(3)
nec=infetype(4)
- if(idout.ne.izero) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"autoprestr")
- if(ierr.ne.izero) return
- end if
- if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"autoprestr")
- if(ierr.ne.izero) return
- else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"autoprestr")
- if(ierr.ne.izero) return
- end if
skc=iskopt.ge.izero.and.iskopt.ne.ione.and.numslp.ne.izero
call fill(bextern,zero,neq*nextflag)
call fill(btraction,zero,neq*ntractflag)
@@ -577,8 +565,6 @@
write(kto,800) ntimdat(6),ntimdat(7),ntimdat(8)
if(idout.gt.0) write(kw,800) ntimdat(6),ntimdat(7),ntimdat(8)
end if
- if(idout.ne.0) close(kw)
- close(kp)
c
c... copy stresses into initial stress array
c
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/elastc.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/elastc.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/elastc.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -46,7 +46,7 @@
& rgiter, ! stresscmp
& skew, ! skew
& ncodat,nunits,nprint,istatout,nstatout, ! ioinfo
- & ofile,pfile,ucdroot, ! files
+ & ucdroot, ! files
& elasticStage, iterateEvent, ! PETSc logging
& ierr,errstrng) ! errcode
c
@@ -103,7 +103,7 @@
double precision gauss(*),sh(*),shj(*)
double precision histry(*),delt(*),alfa(*),utol(*),ftol(*),etol(*)
double precision skew(*)
- character ofile*(*),pfile*(*),ucdroot*(*),errstrng*(*)
+ character ucdroot*(*),errstrng*(*)
c
c... included dimension and type statements
c
@@ -153,18 +153,6 @@
ngauss=infetype(2)
nee=infetype(3)
nec=infetype(4)
- if(idout.ne.izero) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"elastc")
- if(ierr.ne.izero) return
- end if
- if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"elastc")
- if(ierr.ne.izero) return
- else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"elastc")
- if(ierr.ne.izero) return
- end if
c
skc=iskopt.ge.izero.and.iskopt.ne.ione.and.numslp.ne.izero
c
@@ -598,8 +586,6 @@
write(kto,800) ntimdat(6),ntimdat(7),ntimdat(8)
if(idout.gt.0) write(kw,800) ntimdat(6),ntimdat(7),ntimdat(8)
end if
- if(idout.ne.0) close(kw)
- close(kp)
c
600 format(//,'Beginning elastic solution:',/)
650 format(//,"Reforming the stiffness matrix:",/)
Added: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/f77io.f
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/f77io.f 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/f77io.f 2007-04-17 04:37:14 UTC (rev 6586)
@@ -0,0 +1,65 @@
+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 f77open(u,ios,fin,sta,acc,fm,rl)
+c
+ include "implicit.inc"
+c
+c... subroutine arguments
+c
+ integer u,ios,rl
+ character fin*(*),sta*(*),acc*(*),fm*(*)
+c
+ if(rl.eq.0) then
+ open(u,iostat=ios,file=fin,status=sta,access=acc,form=fm)
+ else
+ open(u,iostat=ios,file=fin,status=sta,access=acc,form=fm,
+ & recl=rl)
+ end if
+c
+ return
+ end
+c
+c
+c
+ subroutine f77close(u,ios)
+c
+ include "implicit.inc"
+c
+c... subroutine arguments
+c
+ integer u,ios
+c
+ close(u,iostat=ios)
+c
+ return
+ end
+c
+c End of file
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/libpylith3d.pxd
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/libpylith3d.pxd 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/libpylith3d.pxd 2007-04-17 04:37:14 UTC (rev 6586)
@@ -135,15 +135,11 @@
int *,
int *,
char *, # files
- char *,
- char *,
int *, # PETSc logging
int *,
int *, # error codes
char *,
size_t, # string lengths
- size_t,
- size_t,
size_t) except *
cdef extern void cmp_stiffsz "FC_FUNC_(cmp_stiffsz, CMP_STIFFSZ)" (
@@ -256,16 +252,31 @@
int *,
int *,
char *, # files
- char *,
- char *,
int *, # PETSc logging
int *,
int *, # error codes
char *,
size_t, # string lengths
+ size_t) except *
+
+cdef extern void f77close "FC_FUNC(f77close, F77CLOSE)" (
+ int *,
+ int *
+ ) except *
+
+cdef extern void f77open "FC_FUNC(f77open, F77OPEN)" (
+ int *,
+ int *,
+ char *,
+ char *,
+ char *,
+ char *,
+ int *,
size_t,
size_t,
- size_t) except *
+ size_t,
+ size_t
+ ) except *
cdef extern void id_split "FC_FUNC_(id_split, ID_SPLIT)" (
int *,
@@ -857,27 +868,19 @@
int *,
int *,
char *, # files
- char *,
- char *,
int *, # 90: PETSC logging
int *,
int *, # error codes
char *,
size_t, # string lengths
- size_t,
- size_t,
size_t) except *
cdef extern void viscos_setup "FC_FUNC_(viscos_setup, VISCOS_SETUP)" (
int *,
int *,
- char *,
- char *,
int *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void viscos_step "FC_FUNC_(viscos_step, VISCOS_STEP)" (
@@ -968,8 +971,6 @@
int *,
int *,
char *, # files
- char *,
- char *,
int *, # 90: PETSC logging
int *,
int *,
@@ -988,8 +989,6 @@
int *, # error codes
char *,
size_t, # string lengths
- size_t,
- size_t,
size_t) except *
cdef extern void viscos_cleanup "FC_FUNC_(viscos_cleanup, VISCOS_CLEANUP)" (
@@ -1006,10 +1005,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
cdef extern void write_connect "FC_FUNC_(write_connect, WRITE_CONNECT)" (
@@ -1025,12 +1022,8 @@
int *,
int *,
int *,
- char *,
- char *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_coords "FC_FUNC_(write_coords, WRITE_COORDS)" (
@@ -1040,12 +1033,8 @@
int *,
int *,
int *,
- char *,
- char *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_diff "FC_FUNC_(write_diff, WRITE_DIFF)" (
@@ -1057,10 +1046,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
cdef extern void write_element_info "FC_FUNC_(write_element_info, WRITE_ELEMENT_INFO)" (
@@ -1074,9 +1061,7 @@
double *,
double *,
int *,
- int *,
- char *,
- size_t) except *
+ int *) except *
cdef extern void write_fuldat "FC_FUNC_(write_fuldat, WRITE_FULDAT)" (
int *,
@@ -1088,12 +1073,8 @@
int *,
int *,
int *,
- char *,
- char *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_global_info "FC_FUNC_(write_global_info, WRITE_GLOBAL_INFO)" (
@@ -1105,10 +1086,6 @@
int *,
int *,
int *,
- char *,
- char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_hist "FC_FUNC_(write_hist, WRITE_HIST)" (
@@ -1118,10 +1095,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
cdef extern void write_props "FC_FUNC_(write_props, WRITE_PROPS)" (
@@ -1135,12 +1110,8 @@
int *,
int *,
int *,
- char *,
- char *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_skew "FC_FUNC_(write_skew, WRITE_SKEW)" (
@@ -1150,10 +1121,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
cdef extern void write_slip "FC_FUNC_(write_slip, WRITE_SLIP)" (
@@ -1164,12 +1133,8 @@
int *,
int *,
int *,
- char *,
- char *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_sparse_info "FC_FUNC_(write_sparse_info, WRITE_SPARSE_INFO)" (
@@ -1179,9 +1144,7 @@
int *,
double *,
int *,
- int *,
- char *,
- size_t) except *
+ int *) except *
cdef extern void write_split "FC_FUNC_(write_split, WRITE_SPLIT)" (
double *,
@@ -1191,21 +1154,15 @@
int *,
int *,
int *,
- char *,
- char *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_split_plot "FC_FUNC_(write_split_plot, WRITE_SPLIT_PLOT)" (
int *,
int *,
int *,
- int *,
- char *,
- size_t) except *
+ int *) except *
cdef extern void write_stateout "FC_FUNC_(write_stateout, WRITE_STATEOUT)" (
int *,
@@ -1214,12 +1171,8 @@
int *,
int *,
int *,
- char *,
- char *,
int *,
char *,
- size_t,
- size_t,
size_t) except *
cdef extern void write_strscomp "FC_FUNC_(write_strscomp, WRITE_STRSCOMP)" (
@@ -1227,16 +1180,12 @@
double *,
double *,
int *,
- int *,
- char *,
- size_t) except *
+ int *) except *
cdef extern void write_subiter "FC_FUNC_(write_subiter, WRITE_SUBITER)" (
int *,
int *,
- int *,
- char *,
- size_t) except *
+ int *) except *
cdef extern void write_tractions "FC_FUNC_(write_tractions, WRITE_TRACTIONS)" (
int *,
@@ -1245,10 +1194,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
cdef extern void write_timdat "FC_FUNC_(write_timdat, WRITE_TIMDAT)" (
@@ -1267,10 +1214,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
cdef extern void write_ucd_mesh "FC_FUNC_(write_ucd_mesh, WRITE_UCD_MESH)" (
@@ -1298,10 +1243,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
cdef extern void write_winkx "FC_FUNC_(write_winkx, WRITE_WINKX)" (
@@ -1311,10 +1254,8 @@
int *,
int *,
int *,
- char *,
int *,
char *,
- size_t,
size_t) except *
Deleted: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/open_append.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/open_append.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/open_append.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -1,126 +0,0 @@
-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 open_append(u,fin,sta,fm,ierr,errstrng,caller)
-c
-c... subroutine to open an output file in append mode
-c
-c The Autoconf 'configure' script determines whether the Fortran
-c compiler supports access="append", position="append", both, or
-c neither, at compile time. Some compilers (e.g., gfortran) accept
-c both at compile time but reject one or the other at runtime;
-c therefore, this subroutine tries each available alternative in
-c turn. If neither works, an error is returned.
-c
- include "implicit.inc"
-c
-c... subroutine arguments
-c
- integer u,ierr
- character fin*(*),sta*(*),fm*(*),errstrng*(*),caller*(*)
-c
-c... intrinsic functions
-c
- intrinsic len
-c
-c... local variables
-c
- integer lenfm,jump
- save jump
- data jump/0/
-c
- ierr=0
- lenfm=len(fm)
-c
- goto (10,20) jump
-c
- 10 continue
-#if defined FORTRAN_ACCESS_APPEND
- if(lenfm.eq.0) then
- open(u,file=fin,status=sta,access="append",err=20)
- else
- open(u,file=fin,status=sta,access="append",form=fm,err=20)
- end if
- jump=1
- goto 40
-#endif
- 20 continue
-#if defined FORTRAN_POSITION_APPEND
- if(lenfm.eq.0) then
- open(u,file=fin,status=sta,position="append",err=30)
- else
- open(u,file=fin,status=sta,position="append",form=fm,err=30)
- end if
- jump=2
- goto 40
-#endif
-c
-c... error opening output file
-c
- 30 continue
- ierr=2
- errstrng=caller
- close(u)
- return
-c
-c... normal return
-c
- 40 return
- end
-c
-c
-c
- subroutine open_append_stop(u,fin,sta,fm,caller)
-c
-c... convenience subroutine: open_append(), stop if error
-c
- include "implicit.inc"
-c
-c... subroutine arguments
-c
- integer u
- character fin*(*),sta*(*),fm*(*),caller*(*)
-c
-c... local variables
-c
- integer ierr
- character errstrng*256
-c
- call open_append(u,fin,sta,fm,ierr,errstrng,caller)
- if(ierr.ne.0) then
- write(*,*) 'in function ', caller
- write(*,*) 'error opening file ', fin, ' for writing'
- stop
- end if
-c
- return
- end
-c
-c End of file
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -46,7 +46,7 @@
& rgiter, ! stresscmp
& skew, ! skew
& iprint,ncodat,nunits,nprint,istatout,nstatout, ! ioinfo
- & ofile,pfile,ucdroot, ! files
+ & ucdroot, ! files
& viscousStage, iterateEvent, ! PETSc logging
& ierr,errstrng) ! errcode
c
@@ -105,7 +105,7 @@
double precision gauss(*),sh(*),shj(*)
double precision histry(*),delt(*),alfa(*),utol(*),ftol(*),etol(*)
double precision skew(*)
- character ofile*(*),pfile*(*),ucdroot*(*),errstrng*(*)
+ character ucdroot*(*),errstrng*(*)
c
c... included dimension and type statements
c
@@ -151,26 +151,10 @@
include "nprint_def.inc"
include "rtimdat_def.inc"
include "rgiter_def.inc"
-c
-c... open output files for appending, if necessary
-c
cdebug write(6,*) "Hello from viscos_f!"
c
call PetscLogStagePush(viscousStage, ierr)
c
- if(idout.gt.ione) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"viscos")
- if(ierr.ne.izero) return
- end if
- if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"viscos")
- if(ierr.ne.izero) return
- else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"viscos")
- if(ierr.ne.izero) return
- end if
-c
c... signal user that viscous computation is begun
c
write(kto,2000)
@@ -656,8 +640,6 @@
end do
write(kto,800) ntimdat(6),ntimdat(7),ntimdat(8)
if(idout.gt.ione) write(kw,800) ntimdat(6),ntimdat(7),ntimdat(8)
- if(idout.gt.ione) close(kw)
- close(kp)
c
650 format(//,"Reforming the stiffness matrix:",/)
700 format('STEP ',i7)
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_cleanup.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_cleanup.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_cleanup.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -32,11 +32,6 @@
& ntimdat,nprint,nunits, ! timdat
& ierr,errstrng) ! errcode
c
-c PETSC includes
-c
-#include "finclude/petsc.h"
-#include "finclude/petsclog.h"
-c
c... parameter definitions
c
include "nconsts.inc"
@@ -58,16 +53,13 @@
include "nprint_def.inc"
include "nunits_def.inc"
c
-c... close units
+c... write output, if requested
c
if(idout.gt.ione) write(kw,800) ntimdat(6),ntimdat(7),ntimdat(8)
- if(idout.gt.ione) close(kw)
- close(kp)
c
800 format(/," Total number of equilibrium iterations = ",i7,/,
& " Total number of stiffness matrix reformations = ",i7,/,
& " Total number of displacement subiterations = ",i7)
- call PetscLogStagePop(ierr)
return
end
c
Deleted: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_setup.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_setup.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_setup.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -1,96 +0,0 @@
-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 viscos_setup(
- & nprint,nunits, ! ioinfo
- & ofile,pfile, ! files
- & viscousStage, ! PETSc logging
- & ierr,errstrng) ! errcode
-c
-c...subroutine to solve the time dependent problem and perform the
-c time stepping
-c
- include "implicit.inc"
-c
-c PETSC includes
-c
-#include "finclude/petsc.h"
-#include "finclude/petsclog.h"
-#include "finclude/petscvec.h"
-#include "finclude/petscmat.h"
-c
-c PETSc objects
-c
- PetscInt viscousStage
-c
-c... parameter definitions
-c
- include "nconsts.inc"
-c
-c... subroutine arguments
-c
- integer ierr
- character ofile*(*),pfile*(*),errstrng*(*)
-c
-c... included dimension and type statements
-c
- include "nprint_dim.inc"
- include "nunits_dim.inc"
-c
-c... included variable definitions
-c
- include "nprint_def.inc"
- include "nunits_def.inc"
-c
- call PetscLogStagePush(viscousStage, ierr)
-c
-c... open output files for appending, if necessary
-c
- if(idout.gt.ione) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"viscos")
- if(ierr.ne.izero) return
- end if
- if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"viscos")
- if(ierr.ne.izero) return
- else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"viscos")
- if(ierr.ne.izero) return
- end if
- return
- end
-c
-c version
-c $Id: viscos.F,v 1.15 2005/08/05 20:17:18 willic3 Exp $
-c
-c Generated automatically by Fortran77Mill on Wed May 21 14:15:03 2003
-c
-c End of file
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_step.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_step.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/viscos_step.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -46,7 +46,7 @@
& rgiter, ! stresscmp
& skew, ! skew
& iprint,ncodat,nunits,nprint,istatout,nstatout, ! ioinfo
- & ofile,pfile,ucdroot, ! files
+ & ucdroot, ! files
& viscousStage, iterateEvent, ! PETSc logging
& ntot,pyltim,indexx,jcyc,i,j,pyskc,nfirst,pynstep,time, ! New args
& pydeltp,lgdefp,gtol, ! more new args
@@ -109,7 +109,7 @@
double precision histry(*),delt(*),alfa(*),utol(*),ftol(*),etol(*)
double precision skew(*)
double precision time, pydeltp
- character ofile*(*),pfile*(*),ucdroot*(*),errstrng*(*)
+ character ucdroot*(*),errstrng*(*)
c
c... included dimension and type statements
c
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_bc.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_bc.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_bc.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -28,7 +28,7 @@
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c
c
- subroutine write_bc(bond,ibond,numnp,kw,idout,ofile,ierr,errstrng)
+ subroutine write_bc(bond,ibond,numnp,kw,idout,ierr,errstrng)
c
c... subroutine to write boundary conditions to ascii output file.
c
@@ -50,7 +50,7 @@
integer numnp,kw,idout,ierr
integer ibond(ndof,numnp)
double precision bond(ndof,numnp)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -79,8 +79,6 @@
c
c... output BC to ascii file, if requested
c
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_bc")
- if(ierr.ne.izero) return
write(kw,1000) (labeld(i),i=1,ndof)
write(kw,2000)
nlines=0
@@ -105,7 +103,6 @@
& i=1,ndof)
end if
end do
- close(kw)
c
c... normal return
c
@@ -116,7 +113,6 @@
20 continue
ierr=4
errstrng="write_bc"
- close(kw)
return
c
1000 format(1x,///,' n o d a l f o r c e s a n d d i s p l a',
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_connect.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_connect.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_connect.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_connect(iens,ivfamily,indxiel,nen,ngauss,numelv,
- & ietypev,nvfamilies,kw,kp,idout,idsk,ofile,pfile,ierr,errstrng)
+ & ietypev,nvfamilies,kw,kp,idout,idsk,ierr,errstrng)
c
c this subroutine writes the element node array, as well as
c material model and element type.
@@ -53,7 +53,7 @@
c
integer nen,ngauss,numelv,ietypev,nvfamilies,kw,kp,idout,idsk,ierr
integer iens(nen,numelv),ivfamily(6,nvfamilies),indxiel(numelv)
- character ofile*(*),pfile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... local variables
c
@@ -74,9 +74,6 @@
c... output plot info, if desired
c
if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",
- & ierr,errstrng,"write_connect")
- if(ierr.ne.izero) return
write(kp,1000,err=50) numelv,ietypev,nen,ngauss
ielg=izero
do ifam=1,nvfamilies
@@ -90,23 +87,15 @@
& (iens(j,ielg),j=1,nen)
end do
end do
- close(kp)
else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"write_connect")
- if(ierr.ne.izero) return
write(kp,err=50) numelv,ietypev,nen,ngauss
write(kp,err=50) ivfamily
write(kp,err=50) iens
- close(kp)
end if
c
c... output ascii info, if desired
c
if(idout.gt.izero) then
- call open_append(kw,ofile,"old","",
- & ierr,errstrng,"write_connect")
- if(ierr.ne.izero) return
npage=50
ielg=izero
do ifam=1,nvfamilies
@@ -125,7 +114,6 @@
end do
end do
write(kw,4000)
- close(kw)
end if
c
c... normal return
@@ -137,8 +125,6 @@
50 continue
ierr=4
errstrng="write_connect"
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
return
c
1000 format(30i7)
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_coords.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_coords.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_coords.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -28,7 +28,7 @@
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c
c
- subroutine write_coords(x,numnp,kw,kp,idout,idsk,ofile,pfile,
+ subroutine write_coords(x,numnp,kw,kp,idout,idsk,
& ierr,errstrng)
c
c... subroutine to write nodal coordinates to plot and/or ascii files.
@@ -51,7 +51,7 @@
c
integer numnp,kw,kp,idout,idsk,ierr
double precision x(nsd,numnp)
- character ofile*(*),pfile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -72,33 +72,21 @@
c... output coordinates to plot file, if requested
c
if(idsk.eq.1) then
- call open_append(kp,pfile,"old","",
- & ierr,errstrng,"write_coords")
- if(ierr.ne.izero) return
do i=1,numnp
write(kp,"(i7,3(1pe16.8))",err=60) i,(x(j,i),j=1,nsd)
end do
- close(kp)
else if(idsk.eq.2) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"write_coords")
- if(ierr.ne.izero) return
write(kp,err=60) x
- close(kp)
end if
c
c... output coordinates to human-readable file
c
if(idout.gt.izero) then
- call open_append(kw,ofile,"old","",
- & ierr,errstrng,"write_coords")
- if(ierr.ne.izero) return
do i=1,numnp
if(i.eq.1.or.mod(i,npage).eq.0) write(kw,1000)
& (labelc(j),j=1,nsd)
write(kw,"(6x,i7,10x,3(1pe20.8))",err=60) i,(x(j,i),j=1,nsd)
end do
- close(kw)
end if
c
c... normal return
@@ -110,8 +98,6 @@
60 continue
ierr=4
errstrng="write_coords"
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
return
c
1000 format(1x,///,' n o d a l c o o r d i n a t e d a t a',///,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_diff.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_diff.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_diff.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_diff(diforc,nslip,idhist,numslp,numdif,numnp,
- & kw,idout,ofile,ierr,errstrng)
+ & kw,idout,ierr,errstrng)
c
c... prints differential forces applied to slippery nodes
c
@@ -51,7 +51,7 @@
integer numslp,numdif,numnp,kw,idout,ierr
integer nslip(nsdim,numslp),idhist(numnp)
double precision diforc(ndof,numnp)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -79,8 +79,6 @@
c
nlines=izero
npage=50
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_diff")
- if(ierr.ne.izero) return
do i=1,numnp
nonzed=.false.
do j=1,ndof
@@ -95,7 +93,6 @@
write(kw,7000,err=50) i,idhist(i),(diforc(j,i),j=1,ndof)
end if
end do
- close(kw)
c
c... normal return
c
@@ -106,7 +103,6 @@
50 continue
ierr=4
errstrng="write_diff"
- close(kw)
return
c
6000 format(//' differential forces on slippery nodes'//
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_element_info.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_element_info.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_element_info.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_element_info(numelv,nen,ngauss,ietypev,intord,
- & ipstrs,ipauto,tpois,tyoungs,kw,idout,ofile)
+ & ipstrs,ipauto,tpois,tyoungs,kw,idout)
c
c...subroutine to write element and prestress parameters
c
@@ -43,7 +43,6 @@
c
integer numelv,nen,ngauss,ietypev,intord,ipstrs,ipauto,kw,idout
double precision tpois,tyoungs
- character ofile*(*)
c
c... included dimension and type statements
c
@@ -63,10 +62,8 @@
c... echo input to output file
c
if(idout.eq.izero) return
- call open_append_stop(kw,ofile,"old","","write_element_info")
write(kw,700) elmlbl,numelv,nen,ngauss,ietypev,intorder(intord),
& ipstrs,ipauto,tpois,tyoungs
- close(kw)
c
700 format(1x,///,
&' e l e m e n t s y s t e m d a t a',///,5x,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_fuldat.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_fuldat.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_fuldat.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_fuldat(iprint,icontr,icode,ncycle,lastep,kw,kp,
- & idout,idsk,ofile,pfile,ierr,errstrng)
+ & idout,idsk,ierr,errstrng)
c
c... writes data on time steps where full outputs are desired
c
@@ -48,7 +48,7 @@
c
integer icontr,icode,ncycle,lastep,kw,kp,idout,idsk,ierr
integer iprint(icontr)
- character ofile*(*),pfile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... local variables
c
@@ -58,18 +58,6 @@
c
c... output results, if desired
c
- if(idout.gt.izero) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_fuldat")
- if(ierr.ne.izero) return
- end if
- if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"write_fuldat")
- if(ierr.ne.izero) return
- else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"write_fuldat")
- if(ierr.ne.izero) return
- end if
if(icode.ne.itwo.and.idout.gt.izero) write(kw,1000,err=50) ncycle
i1=0
if((icode.eq.itwo).or.(icontr.eq.izero)) then
@@ -95,8 +83,6 @@
& j=1,nrem)
end if
end if
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
c
c... normal return
c
@@ -107,8 +93,6 @@
50 continue
ierr=4
errstrng="write_fuldat"
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
return
c
1000 format(//5x,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_global_info.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_global_info.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_global_info.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_global_info(title,idout,idsk,numnp,
- & icode,idebug,kw,kp,ofile,pfile)
+ & icode,idebug,kw,kp)
c
c...subroutine to write global control parameters
c
@@ -43,25 +43,18 @@
c... subroutine arguments
c
integer idout,idsk,numnp,icode,idebug,kw,kp
- character title*(*),ofile*(*),pfile*(*)
+ character title*(*)
c
if(idout.gt.izero) then
- call open_append_stop(kw,ofile,"replace","","write_global_info")
write(kw,500)
write(kw,1000) title,idout,idsk,ngem,numnp,nsd,ndof,icode,idebug
- close(kw)
end if
if(idsk.eq.ione) then
- call open_append_stop(kp,pfile,"replace","","write_global_info")
write(kp,2000) title
write(kp,3000) ngem,numnp,nsd,ndof,nstr
- close(kp)
else if(idsk.eq.itwo) then
- call open_append_stop(kp,pfile,"replace","unformatted",
- & "write_global_info")
write(kp) title
write(kp) ngem,numnp,nsd,ndof,nstr
- close(kp)
end if
c
return
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_hist.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_hist.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_hist.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_hist(histry,times,nhist,lastep,kw,idout,
- & ofile,ierr,errstrng)
+ & ierr,errstrng)
c
c writes load histories to the output file.
c
@@ -49,7 +49,7 @@
c
integer nhist,lastep,kw,idout,ierr
double precision histry(nhist,lastep+1),times(lastep+1)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... local constants
c
@@ -67,10 +67,7 @@
c
ierr=izero
if(idout.eq.izero) return
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_hist")
- if(ierr.ne.izero) return
write(kw,1000,err=70) nhist
- if(nhist.eq.izero) close(kw)
if(nhist.eq.izero) return
c
c... write load histories
@@ -99,7 +96,6 @@
& '|',(star(l),l=1,nstars)
end do
end do
- close(kw)
c
c... normal return
c
@@ -110,7 +106,6 @@
60 continue
ierr=2
errstrng="write_hist"
- close(kw)
return
c
c... error writing to output file
@@ -118,7 +113,6 @@
70 continue
ierr=4
errstrng="write_hist"
- close(kw)
return
c
1000 format(///' l o a d h i s t o r y f a c t o r s'///,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_props.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_props.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_props.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_props(prop,grav,ivfamily,infmatmod,nvfamilies,
- & npropsz,idout,idsk,kw,kp,ofile,pfile,ierr,errstrng)
+ & npropsz,idout,idsk,kw,kp,ierr,errstrng)
c
c... program to print properties for each material type.
c
@@ -46,7 +46,7 @@
integer nvfamilies,npropsz,idout,idsk,kw,kp,ierr
integer ivfamily(6,nvfamilies),infmatmod(6,nmatmodmax)
double precision prop(npropsz),grav(ndof)
- character ofile*(*),pfile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -72,19 +72,12 @@
c... open output files and output number of materials
c
if(idout.gt.izero) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_props")
- if(ierr.ne.izero) return
write(kw,1000,err=20) numat
end if
if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"write_props")
- if(ierr.ne.izero) return
write(kp,"(i5)",err=20) numat
end if
if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"write_props")
- if(ierr.ne.izero) return
write(kp,err=20) numat
end if
c
@@ -170,8 +163,6 @@
c
c... normal return
c
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
return
c
c... error writing to output file
@@ -179,8 +170,6 @@
20 continue
ierr=4
errstrng="write_props"
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
return
c
1000 format(1x,///,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_skew.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_skew.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_skew.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -28,7 +28,7 @@
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c
c
- subroutine write_skew(skew,numrot,iskopt,numnp,kw,idout,ofile,
+ subroutine write_skew(skew,numrot,iskopt,numnp,kw,idout,
& ierr,errstrng)
c
c program to print the array "skew" that specifies
@@ -53,7 +53,7 @@
c
integer numrot,iskopt,numnp,kw,idout,ierr
double precision skew(nskdim,numnp)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... local constants
c
@@ -74,8 +74,6 @@
c
c... write skew BC to ascii output file, if desired
c
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_skew")
- if(ierr.ne.izero) return
write(kw,1000,err=50) iskopt,(label(i),i=1,nskdim)
write(kw,1050,err=50)
do i=1,numnp
@@ -85,7 +83,6 @@
end do
if(nonzed) write(kw,2000,err=50) i,(skew(j,i),j=1,nskdim)
end do
- close(kw)
c
c... normal return
c
@@ -96,7 +93,6 @@
50 continue
ierr=4
errstrng="write_skew"
- close(kw)
return
c
1000 format(1x,///,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_slip.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_slip.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_slip.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_slip(nslip,numslp,numsn,kw,kp,idout,idsk,
- & ofile,pfile,ierr,errstrng)
+ & ierr,errstrng)
c
c... prints data on free slip interfaces
c
@@ -49,7 +49,7 @@
c
integer numslp,numsn,kw,kp,idout,idsk,ierr
integer nslip(nsdim,numslp)
- character ofile*(*),pfile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -70,21 +70,6 @@
c
ierr=0
c
-c... open output files
-c
- if(idout.gt.izero) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_slip")
- if(ierr.ne.izero) return
- end if
- if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"write_slip")
- if(ierr.ne.izero) return
- else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"write_slip")
- if(ierr.ne.izero) return
- end if
-c
c... loop over slippery node entries, and output results if desired
c
if(idsk.eq.ione) write(kp,3000,err=60) numslp
@@ -106,8 +91,6 @@
if(idsk.eq.itwo.and.numslp.ne.izero) write(kp) nslip
if(idsk.eq.ione) write(kp,"(i7)",err=60) numsn
if(idsk.eq.itwo) write(kp,err=60) numsn
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
c
c... normal return
c
@@ -118,8 +101,6 @@
60 continue
ierr=4
errstrng="write_slip"
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
return
c
1000 format(//
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_sparse_info.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_sparse_info.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_sparse_info.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -28,8 +28,7 @@
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c
c
- subroutine write_sparse_info(neq,nnz,nmin,nmax,wavg,idout,kw,
- & ofile)
+ subroutine write_sparse_info(neq,nnz,nmin,nmax,wavg,idout,kw)
c
c...subroutine to write global control parameters
c
@@ -39,14 +38,11 @@
c
integer neq,nnz,nmin,nmax,idout,kw
double precision wavg
- character ofile*(*)
c
cdebug write(6,*) "Hello from write_sparse_info_f!"
c
if(idout.gt.0) then
- call open_append_stop(kw,ofile,"old","","write_sparse_info")
write(kw,3000) neq,nnz-1,nmin,nmax,wavg
- close(kw)
end if
c
return
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_split(fault,nfault,numfn,kw,kp,
- & idout,idsk,ofile,pfile,ierr,errstrng)
+ & idout,idsk,ierr,errstrng)
c
c... prints data on split nodes
c
@@ -56,7 +56,7 @@
integer numfn,kw,kp,idout,idsk,ierr
integer nfault(3,numfn)
double precision fault(ndof,numfn)
- character ofile*(*),pfile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... intrinsic functions
c
@@ -66,21 +66,6 @@
c
integer i,j,npage
c
-c... open output files
-c
- if(idout.gt.izero) then
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_split")
- if(ierr.ne.izero) return
- end if
- if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",ierr,errstrng,"write_split")
- if(ierr.ne.izero) return
- else if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"write_split")
- if(ierr.ne.izero) return
- end if
-c
c... output results if requested
c
if(idsk.eq.ione) write(kp,"(i7)") numfn
@@ -97,8 +82,6 @@
end if
if(idsk.eq.itwo.and.numfn.ne.izero) write(kp,err=60) nfault
if(idsk.eq.itwo.and.numfn.ne.izero) write(kp,err=60) fault
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
c
c... normal return
c
@@ -109,8 +92,6 @@
60 continue
ierr=4
errstrng="write_split"
- if(idsk.gt.izero) close(kp)
- if(idout.gt.izero) close(kw)
return
c
3000 format(1x///1x,'s p l i t n o d e d a t a'//
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split_plot.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split_plot.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_split_plot.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -28,7 +28,7 @@
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c
c
- subroutine write_split_plot(idftn,numflt,kp,idsk,pfile)
+ subroutine write_split_plot(idftn,numflt,kp,idsk)
c
c... subroutine to write out each split node.
c
@@ -38,7 +38,6 @@
c
integer numflt,kp,idsk
integer idftn(numflt)
- character pfile*(*)
c
c... local variables
c
@@ -47,16 +46,10 @@
c... write results to plot file, if requested
c
if(idsk.eq.1) then
- call open_append_stop(kp,pfile,"old","",
- & "write_split_plot")
write(kp,"(i7)") numflt
- close(kp)
else if(idsk.eq.2) then
- call open_append_stop(kp,pfile,"old","unformatted",
- & "write_split_plot")
write(kp) numflt
if(numflt.ne.0) write(kp) (idftn(i),i=1,numflt)
- close(kp)
end if
c
return
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_stateout.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_stateout.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_stateout.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_stateout(istatout,nstatout,kw,kp,idout,idsk,
- & ofile,pfile,ierr,errstrng)
+ & ierr,errstrng)
c
c... writes integer array indicating which state variables
c to output.
@@ -77,7 +77,7 @@
c
integer kw,kp,idout,idsk,ierr
integer istatout(nstatesmax,3),nstatout(3)
- character ofile*(*),pfile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -96,9 +96,6 @@
c... output results, if desired
c
if(idout.gt.izero) then
- call open_append(kw,ofile,"old","",
- & ierr,errstrng,"write_stateout")
- if(ierr.ne.izero) return
write(kw,700,err=50)
if(nstatout(1).ne.izero) then
write(kw,730,err=50) (labels(istatout(i,1)),i=1,nstatout(1))
@@ -111,24 +108,15 @@
write(kw,730,err=50)
& (labels(2*nstatesmax+istatout(i,3)),i=1,nstatout(3))
end if
- close(kw)
end if
if(idsk.eq.ione) then
- call open_append(kp,pfile,"old","",
- & ierr,errstrng,"write_stateout")
- if(ierr.ne.izero) return
do i=1,3
write(kp,810,err=50) nstatout(i),
& (istatout(j,i),j=1,nstatout(i))
end do
- close(kp)
end if
if(idsk.eq.itwo) then
- call open_append(kp,pfile,"old","unformatted",
- & ierr,errstrng,"write_stateout")
- if(ierr.ne.izero) return
write(kp,err=50) istatout
- close(kp)
end if
c
c... normal return
@@ -140,8 +128,6 @@
50 continue
ierr=4
errstrng="write_stateout"
- if(idout.gt.izero) close(kw)
- if(idsk.gt.izero) close(kp)
return
c
700 format(//,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_strscomp.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_strscomp.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_strscomp.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -28,7 +28,7 @@
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c
c
- subroutine write_strscomp(stol,dtol,epert,kw,idout,ofile)
+ subroutine write_strscomp(stol,dtol,epert,kw,idout)
c
c...subroutine to write parameters controlling the stress integration
c
@@ -38,14 +38,11 @@
c
double precision stol,dtol,epert
integer kw,idout
- character ofile*(*)
c
c... echo input to output file
c
if(idout.gt.0) then
- call open_append_stop(kw,ofile,"old","","write_strscomp")
write(kw,700) stol,dtol,epert
- close(kw)
end if
c
700 format(///' s t r e s s i n t e g r a t i o n ',
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_subiter.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_subiter.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_subiter.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -28,7 +28,7 @@
c~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
c
c
- subroutine write_subiter(nprevdflag,kw,idout,ofile)
+ subroutine write_subiter(nprevdflag,kw,idout)
c
c...subroutine to write parameters controlling the subiteration
c process
@@ -38,14 +38,11 @@
c... subroutine arguments
c
integer nprevdflag,kw,idout
- character ofile*(*)
c
c... local variables
c
if(idout.gt.0) then
- call open_append_stop(kw,ofile,"old","","write_subiter")
write(kw,700) nprevdflag
- close(kw)
end if
c
return
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_timdat.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_timdat.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_timdat.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_timdat(delt,alfa,utol,ftol,etol,times,maxstp,
- & maxit,ntdinit,lgdef,itmax,nintg,lastep,kw,idout,ofile,
+ & maxit,ntdinit,lgdef,itmax,nintg,lastep,kw,idout,
& ierr,errstrng)
c
c...program to write time step data
@@ -53,7 +53,7 @@
integer itmax(nintg)
double precision delt(nintg),alfa(nintg),utol(nintg),ftol(nintg)
double precision etol(nintg),times(lastep+1)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... intrinsic functions
c
@@ -70,8 +70,6 @@
c
c... echo input to file
c
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_timdat")
- if(ierr.ne.izero) return
write(kw,1000,err=50)
do i=1,nintg
write(kw,2000,err=50) i,maxstp(i),delt(i),alfa(i),maxit(i),
@@ -91,7 +89,6 @@
write(kw,4000,err=50) nstep,ii,times(nc)
end do
end do
- close(kw)
c
c... normal return
c
@@ -102,7 +99,6 @@
50 continue
ierr=4
errstrng="write_timdat"
- close(kw)
return
c
1000 format(///,' t i m e s t e p i n f o r m a t i o n',//,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_tractions.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_tractions.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_tractions.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_tractions(tractionverts,tractionvals,
- & numtractions,nsnodes,kw,idout,ofile,ierr,errstrng)
+ & numtractions,nsnodes,kw,idout,ierr,errstrng)
c
c program to print the traction BC info.
c
@@ -51,7 +51,7 @@
integer numtractions,nsnodes,kw,idout,ierr
integer tractionverts(nsnodes,numtractions)
double precision tractionvals(ndof,numtractions)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... local constants
c
@@ -70,9 +70,6 @@
c
c... write traction BC to ascii output file, if desired
c
- call open_append(kw,ofile,"old","",ierr,errstrng,
- & "write_tractions")
- if(ierr.ne.izero) return
write(kw,1000,err=50)
if(nsnodes.eq.3) then
do i=1,numtractions
@@ -85,7 +82,6 @@
& (tractionverts(j,i),j=1,nsnodes),(tractionvals(j,i),j=1,ndof)
end do
end if
- close(kw)
c
c... normal return
c
@@ -96,7 +92,6 @@
50 continue
ierr=4
errstrng="write_tractions"
- close(kw)
return
c
1000 format(1x,///,
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_wink.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_wink.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_wink.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_wink(winkdef,iwinkdef,iwinkid,nwinke,kw,idout,
- & ofile,ierr,errstrng)
+ & ierr,errstrng)
c
c.. program for printing data on winkler restoring forces
c
@@ -60,7 +60,7 @@
integer nwinke,kw,idout,ierr
integer iwinkdef(ndof,nwinke),iwinkid(nwinke)
double precision winkdef(ndof,nwinke)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -82,8 +82,6 @@
c
ierr=izero
if(idout.eq.izero.or.nwinke.eq.izero) return
- call open_append(kw,ofile,"old","",ierr,errstrng,"write_wink")
- if(ierr.ne.izero) return
c
c... loop over winkler forces and output results
c
@@ -99,7 +97,6 @@
nlines=nlines+1
write(kw,2020,err=50) n,(winkdef(j,i),iwinkdef(j,i),j=1,ndof)
end do
- close(kw)
c
c... normal return
c
@@ -110,7 +107,6 @@
50 continue
ierr=4
errstrng="write_wink"
- close(kw)
return
c
2005 format(/)
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_winkx.F
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_winkx.F 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/write_winkx.F 2007-04-17 04:37:14 UTC (rev 6586)
@@ -29,7 +29,7 @@
c
c
subroutine write_winkx(winkxdef,iwinkxdef,iwinkxid,nwinkxe,kw,
- & idout,ofile,ierr,errstrng)
+ & idout,ierr,errstrng)
c
c.. program for printing data on winkler restoring forces
c
@@ -60,7 +60,7 @@
integer nwinkxe,kw,idout,ierr
integer iwinkxdef(ndof,nwinkxe),iwinkxid(nwinkxe)
double precision winkxdef(ndof,nwinkxe)
- character ofile*(*),errstrng*(*)
+ character errstrng*(*)
c
c... included dimension and type statements
c
@@ -82,9 +82,6 @@
c
ierr=izero
if(idout.eq.izero.or.nwinkxe.eq.izero) return
- call open_append(kw,ofile,"old","",
- & ierr,errstrng,"write_winkx")
- if(ierr.ne.izero) return
c
c... loop over winkler forces and output results
c
@@ -100,7 +97,6 @@
nlines=nlines+1
write(kw,2020,err=50) n,(winkxdef(j,i),iwinkxdef(j,i),j=1,ndof)
end do
- close(kw)
c
c... normal return
c
@@ -111,7 +107,6 @@
50 continue
ierr=4
errstrng="write_winkx"
- close(kw)
return
c
2005 format(/)
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/module/Makefile.am
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/module/Makefile.am 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/module/Makefile.am 2007-04-17 04:37:14 UTC (rev 6586)
@@ -50,6 +50,7 @@
elementtypes.pxd \
exceptionhandler.cc \
exceptionhandler.pxd \
+ f77io.pyx \
PyLithLib.cc \
setup.pyx
@@ -70,6 +71,7 @@
PYREX_FLAGS = -I$(srcdir) -I$(top_srcdir)/pylith3d/libpylith3d
+
pyxincludes = \
$(srcdir)/constants.pxd \
$(srcdir)/elementtypes.pxd \
@@ -78,16 +80,21 @@
$(srcdir)/PyLithMeshLib.pxd \
$(srcdir)/array.pyx \
$(srcdir)/exceptionhandler.pxd \
+ $(srcdir)/f77io.pyx \
$(srcdir)/setup.pyx
+meshpyxincludes = \
+ $(srcdir)/PyLithMeshLib.pxd \
+ $(srcdir)/petsc.pxd
+
PyLithLib.cc: $(srcdir)/PyLithLib.pyx $(pyxincludes)
pyrexc $(PYREX_FLAGS) $< -o PyLithLib.cc
-PyLithMeshLib.cc: $(srcdir)/PyLithMeshLib.pyx $(srcdir)/petsc.pxd
+PyLithMeshLib.cc: $(srcdir)/PyLithMeshLib.pyx $(meshpyxincludes)
pyrexc $(PYREX_FLAGS) $< -o PyLithMeshLib.cc
-PyLithMeshLib.h: PyLithMeshLib.pxd
+PyLithMeshLib.h: PyLithMeshLib.cc
EXTRA_DIST = \
$(srcdir)/PyLithLib.pyx \
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/module/PyLithLib.pyx
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/module/PyLithLib.pyx 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/module/PyLithLib.pyx 2007-04-17 04:37:14 UTC (rev 6586)
@@ -40,6 +40,7 @@
# Pyrex code inlined in this module
include "array.pyx"
include "exceptionhandler.pxd"
+include "f77io.pyx"
include "setup.pyx"
@@ -216,13 +217,37 @@
self.sortmesh()
self.sparsesetup()
self.allocateremaining()
- self.meshwrite()
- if self.generateGreen:
- self.greenFunction(points)
+ #
+ # open output files
+ #
+
+ # xxx.ascii
+ f77open(self.kw, self.ofile)
+
+ # xxx.plot
+ if self.idsk == 0:
+ pass
+ elif self.idsk == 1:
+ f77open(self.kp, self.pfile)
+ elif self.idsk == 2:
+ f77open(self.kp, self.pfile, form="unformatted")
else:
- self.runSimulation()
-
+ raise ValueError("idsk (%d) is not in [0, 1, 2]" % idsk)
+
+ try:
+ self.meshwrite()
+
+ if self.generateGreen:
+ self.greenFunction(points)
+ else:
+ self.runSimulation()
+
+ finally:
+ # close output files
+ f77close(self.kw)
+ if self.idsk != 0: f77close(self.kp)
+
return
@@ -643,7 +668,7 @@
)
# Parameters derived from the number of entries in a file.
-
+
cdef char coord_units[30]
libpylith3d.scan_coords(
&self.numnp, # intent(out)
@@ -657,7 +682,7 @@
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
coord_units[sizeof(coord_units)-1] = 0 # null-terminate
-
+
self.cscale = uparser.parse(str(coord_units).strip()).value
cdef char displacement_units[30]
@@ -730,7 +755,7 @@
self.timeStepInputFile,
&errorcode,
errorstring,
- len(time_units),
+ sizeof(time_units),
len(self.timeStepInputFile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -1080,8 +1105,7 @@
# self.idout,
# self.kr,
# self.kw,
-# self.prestressInputFile,
-# self.ofile)
+# self.prestressInputFile)
pass
# Read traction BC
@@ -1875,11 +1899,7 @@
&self.idebug,
&self.kw,
&self.kp,
- self.ofile,
- self.pfile,
- len(self.title),
- len(self.ofile),
- len(self.pfile))
+ len(self.title))
# Write out nodal coordinates
libpylith3d.write_coords(
@@ -1889,12 +1909,8 @@
&self.kp,
&self.idout,
&self.idsk,
- self.ofile,
- self.pfile,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -1905,10 +1921,8 @@
&self.numnp,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -1920,10 +1934,8 @@
&self.numnp,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -1933,16 +1945,12 @@
&self.dtol,
&self.epert,
&self.kw,
- &self.idout,
- self.ofile,
- len(self.ofile))
+ &self.idout)
libpylith3d.write_subiter(
&self.nprevdflag,
&self.kw,
- &self.idout,
- self.ofile,
- len(self.ofile))
+ &self.idout)
# Write out time step information
libpylith3d.write_timdat(
@@ -1961,10 +1969,8 @@
&self.lastep,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -1979,12 +1985,8 @@
&self.kp,
&self.idout,
&self.idsk,
- self.ofile,
- self.pfile,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -1996,12 +1998,8 @@
&self.kp,
&self.idout,
&self.idsk,
- self.ofile,
- self.pfile,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2013,10 +2011,8 @@
&self.lastep,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2034,9 +2030,7 @@
&self.tpois,
&self.tyoungs,
&self.kw,
- &self.idout,
- self.ofile,
- len(self.ofile))
+ &self.idout)
# Write element node array and deallocate 'indxiel'
libpylith3d.write_connect(
@@ -2052,12 +2046,8 @@
&self.kp,
&self.idout,
&self.idsk,
- self.ofile,
- self.pfile,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2075,12 +2065,8 @@
&self.idsk,
&self.kw,
&self.kp,
- self.ofile,
- self.pfile,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2112,10 +2098,8 @@
&self.nsnodes,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2128,12 +2112,8 @@
&self.kp,
&self.idout,
&self.idsk,
- self.ofile,
- self.pfile,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2146,12 +2126,8 @@
&self.kp,
&self.idout,
&self.idsk,
- self.ofile,
- self.pfile,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2165,10 +2141,8 @@
&self.numnp,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2179,9 +2153,7 @@
self.idftn.ptr,
&self.numflt,
&self.kp,
- &self.idsk,
- self.pfile,
- len(self.pfile))
+ &self.idsk)
self.idftn = None ### DEALLOC
@@ -2193,10 +2165,8 @@
&self.nwinke,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2211,10 +2181,8 @@
&self.nwinkxe,
&self.kw,
&self.idout,
- self.ofile,
&errorcode,
errorstring,
- len(self.ofile),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2229,9 +2197,7 @@
&self.nmax,
&self.wavg,
&self.idout,
- &self.kw,
- self.ofile,
- len(self.ofile))
+ &self.kw)
self.trace.log("Hello from pl3dsetup.meshwrite (end)!")
@@ -2335,15 +2301,11 @@
self.nprint,
self.istatout,
self.nstatout,
- self.ofile, # files
- self.pfile,
- self.ucdroot,
+ self.ucdroot, # files
&self.elasticStage, # PETSc logging
&self.iterateEvent,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
len(self.ucdroot),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2353,6 +2315,9 @@
cdef interpolatePoints(self, points):
return self._mesh.interpolatePoints(points)
+ cdef viscos_setup(self):
+ return
+
cdef runSimulation(self):
# First define all of the lists that maintain variable values. The
# variables in these lists are altered during the running of the code
@@ -2464,15 +2429,11 @@
self.nprint,
self.istatout,
self.nstatout,
- self.ofile, # files
- self.pfile,
- self.ucdroot,
+ self.ucdroot, # files
&self.autoprestrStage, # PETSc logging
&self.iterateEvent,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
len(self.ucdroot),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2496,20 +2457,7 @@
if self.icode == 3 and self.nintg > 1:
if self.pythonTimestep:
- # Setup timestepping
- # Open output files
- libpylith3d.viscos_setup(
- self.nprint,
- self.nunits,
- self.ofile,
- self.pfile,
- &self.viscousStage,
- &errorcode,
- errorstring,
- len(self.ofile),
- len(self.pfile),
- sizeof(errorstring))
- exceptionhandler(errorcode, errorstring)
+ PetscLogStagePush(self.viscousStage)
numCycles = self.nvisdat[0]
numTimeStepGroups = self.nvisdat[1]
@@ -2644,10 +2592,8 @@
self.nprint,
self.istatout,
self.nstatout,
- self.ofile, # files
- self.pfile,
- self.ucdroot,
- &self.viscousStage, # PETSc logging
+ self.ucdroot, # files
+ &self.viscousStage, # PETSc logging
&self.iterateEvent,
&totalSteps,
<im,
@@ -2664,8 +2610,6 @@
gtol,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
len(self.ucdroot),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
@@ -2689,6 +2633,8 @@
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
+ PetscLogStagePop()
+
else:
libpylith3d.viscos(
@@ -2778,15 +2724,11 @@
self.nprint,
self.istatout,
self.nstatout,
- self.ofile, # files
- self.pfile,
- self.ucdroot,
+ self.ucdroot, # files
&self.viscousStage, # PETSc logging
&self.iterateEvent,
&errorcode,
errorstring,
- len(self.ofile),
- len(self.pfile),
len(self.ucdroot),
sizeof(errorstring))
exceptionhandler(errorcode, errorstring)
Added: short/3D/PyLith/branches/pylith-0.8/pylith3d/module/f77io.pyx
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/module/f77io.pyx 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/module/f77io.pyx 2007-04-17 04:37:14 UTC (rev 6586)
@@ -0,0 +1,95 @@
+#!/usr/bin/env python
+#
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#
+# PyLith by Charles A. Williams, Brad Aagaard, and Matt Knepley
+#
+# Copyright (c) 2004-2006 Rensselaer Polytechnic Institute
+#
+# Permission is hereby granted, free of charge, to any person obtaining
+# a copy of this software and associated documentation files (the
+# "Software"), to deal in the Software without restriction, including
+# without limitation the rights to use, copy, modify, merge, publish,
+# distribute, sublicense, and/or sell copies of the Software, and to
+# permit persons to whom the Software is furnished to do so, subject to
+# the following conditions:
+#
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+# LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+# OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#
+
+
+#cimport libpylith3d
+
+
+def f77open(unit, file, status=None, access=None, form=None, recl=None):
+
+ # status
+ if status is None:
+ status = 'unknown'
+ else:
+ status = status.lower()
+ statusChoices = ['old', 'new', 'scratch', 'unknown']
+ if not status in statusChoices:
+ raise ValueError("""status='%s': 'status' must be in %s""" % (status, statusChoices))
+
+ # access
+ if access is None:
+ access = 'sequential'
+ else:
+ access = access.lower()
+ if access == 'sequential':
+ # recl
+ if recl is not None:
+ raise ValueError("""'recl' must be omitted for 'sequential' access""")
+ else:
+ recl = 0
+ elif access == 'direct':
+ # recl
+ if recl is None:
+ raise ValueError("""'recl' must be given for 'direct' access""")
+ else:
+ raise ValueError("""access='%s': 'access' must be 'sequential' or 'direct'""" % access)
+
+ if form is None:
+ if access == 'sequential':
+ form = 'formatted'
+ else:
+ form = 'unformatted'
+ else:
+ if not form in ['formatted', 'unformatted']:
+ raise ValueError("""form='%s': 'form' must be 'formatted' or 'unformatted'""" % form)
+
+ cdef int u, ios, rl
+ u = unit
+ ios = 0
+ rl = recl
+ libpylith3d.f77open(&u, &ios, file, status, access, form, &rl,
+ len(file), len(status), len(access), len(form))
+ if ios != 0:
+ raise IOError("open: Fortran I/O error %d" % ios)
+
+ return
+
+
+def f77close(unit):
+ cdef int u, ios
+ u = unit
+ ios = 0
+ libpylith3d.f77close(&u, &ios)
+ if ios != 0:
+ raise IOError("close: Fortran I/O error %d" % ios)
+ return
+
+
+# end of file
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/module/petsc.pxd
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/module/petsc.pxd 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/module/petsc.pxd 2007-04-17 04:37:14 UTC (rev 6586)
@@ -64,6 +64,8 @@
cdef extern from "petsclog.h":
PetscErrorCode PetscLogStageRegister(int *, char *)
PetscErrorCode PetscLogEventRegister(PetscEvent *, char *, PetscCookie)
+ PetscErrorCode PetscLogStagePush(int stage)
+ PetscErrorCode PetscLogStagePop()
cdef extern from "petscsnes.h":
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/module/setup.pyx
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/module/setup.pyx 2007-04-16 23:34:45 UTC (rev 6585)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/module/setup.pyx 2007-04-17 04:37:14 UTC (rev 6586)
@@ -125,4 +125,32 @@
return event
+cdef PetscLogStagePush(int stage):
+ cdef int errnum
+ cdef petsc.const_char *text
+ cdef char *specific
+
+ errnum = petsc.PetscLogStagePush(stage)
+ if errnum != 0:
+ petsc.PetscErrorMessage(errnum, &text, &specific)
+ raise RuntimeError("PetscLogStagePush: error %d: %s (%s)" %
+ (errnum, <char*>text, specific))
+
+ return
+
+
+cdef PetscLogStagePop():
+ cdef int errnum
+ cdef petsc.const_char *text
+ cdef char *specific
+
+ errnum = petsc.PetscLogStagePop()
+ if errnum != 0:
+ petsc.PetscErrorMessage(errnum, &text, &specific)
+ raise RuntimeError("PetscLogStagePop: error %d: %s (%s)" %
+ (errnum, <char*>text, specific))
+
+ return
+
+
# end of file
More information about the cig-commits
mailing list