From 9733f6f9c4c684cfaa1664167e6431283343b678 Mon Sep 17 00:00:00 2001 From: Shaoping Chu Date: Thu, 14 Feb 2019 16:32:43 -0700 Subject: [PATCH 01/19] FEHM V3.3.2 --- src/Makefile.depends | 25 +- src/Makefile.fehm | 126 ++ src/PC/fehmn.f | 2317 -------------------------- src/PC/fehmn_pcx.f | 98 +- src/add_gdpm.f | 94 +- src/allocmem.f | 23 +- src/anonp.f | 8 +- src/avs_io.f | 8 +- src/avsio.f | 2 +- src/bnswer.f | 10 +- src/check_rlp.f | 30 +- src/cntlin.f | 2 + src/co2ctr.f | 9 +- src/comai.f | 26 +- src/combi.f | 19 +- src/comci.f | 3 +- src/comdi.f | 33 + src/comsi.f | 36 +- src/comxi.f | 2 +- src/coneq1.f | 96 +- src/csolve.f | 6 +- src/data.f | 12 +- src/dated.template | 2 +- src/den_vis_spatial.f | 6 +- src/dvacalc.f | 15 +- src/enthp.f | 12 + src/fehmn.f | 98 +- src/flow_boun.f | 12 +- src/flow_boundary_conditions.f | 96 +- src/flow_humidity_bc.f | 21 +- src/gdkm_calc.f | 2 + src/gdkm_connect.f | 9 +- src/gdkm_volume_fraction_interface.f | 317 ++++ src/geneq1.f | 141 +- src/geneq2.f | 72 +- src/geneq2_uz_wt.f | 34 +- src/geneqc.f | 96 +- src/gncf3.f | 27 +- src/h2o_properties_new.f90 | 118 ++ src/hyddiss.f | 8 +- src/infiles.f | 2 +- src/ingdpm.f | 144 +- src/initdata2.f | 71 +- src/innode.f | 5 +- src/inpres.f | 3 +- src/input.f | 75 +- src/inrlp.f90 | 8 +- src/inrock.f | 6 +- src/interpolate_2.f90 | 2289 +++++++++++++++++++++++++ src/iofile.f | 15 +- src/model_setup.f | 7 +- src/outbnd.f | 18 +- src/porosi.f | 10 +- src/psatl.f | 52 +- src/read_avs_io.f | 19 +- src/rlperm.f | 40 +- src/saltctr.f | 23 +- src/scanin.f | 73 +- src/setparams.f | 35 +- src/setzone.f | 6 +- src/solve_dual.f | 12 +- src/startup.f | 78 +- src/sther.f | 11 +- src/storsx_write.f | 3 +- src/stress_3D_post.f | 15 +- src/stress_mech_props.f | 321 +++- src/stressctr.f | 268 ++- src/stressperm_22.f | 47 +- src/stressperm_222.f | 4 +- src/structured.f | 2 +- src/thermw.f | 151 +- src/thrmwc.f | 387 ++++- src/user_ymp.f | 68 +- src/varchk.f | 131 +- src/vrock_ctr.f | 549 ++++++ src/write_avs_head_s.f | 28 +- src/write_avs_node_con.f | 806 +++++++-- src/write_avs_node_s.f | 450 ++++- src/write_avs_node_v.f | 151 +- src/writeio.f | 5 +- src/wrtout.f | 20 +- src/zone.f | 2127 ++++++++++++++--------- 82 files changed, 8636 insertions(+), 3970 deletions(-) create mode 100755 src/Makefile.fehm delete mode 100755 src/PC/fehmn.f create mode 100755 src/gdkm_volume_fraction_interface.f create mode 100755 src/h2o_properties_new.f90 create mode 100755 src/interpolate_2.f90 create mode 100755 src/vrock_ctr.f diff --git a/src/Makefile.depends b/src/Makefile.depends index e29d0060..609f9fd2 100755 --- a/src/Makefile.depends +++ b/src/Makefile.depends @@ -182,9 +182,9 @@ explicit.o: comgi.o comji.o davidi.o fd_calc_heat.o: comai.o combi.o comci.o comdi.o comdti.o comji.o comki.o fd_calc_heat.o: davidi.o fehmn.o: comai.o combi.o comci.o comco2.o comcomp.o comdi.o comdti.o comei.o -fehmn.o: comevap.o comfem.o comfi.o comflow.o compart.o comriv.o comrtd.o -fehmn.o: comrxni.o comsi.o comsk.o comsplitts.o comsptr.o comuserc.o comwt.o -fehmn.o: comxi.o davidi.o interpolate.o +fehmn.o: comevap.o comfem.o comfi.o comflow.o comii.o compart.o comriv.o +fehmn.o: comrtd.o comrxni.o comsi.o comsk.o comsplitts.o comsptr.o comuserc.o +fehmn.o: comwt.o comxi.o davidi.o interpolate.o interpolate_2.o fem_DruckerPrager_stiffness.o: comai.o comfem.o comsi.o fem_DruckerPrager_stress_update.o: comai.o comdi.o comfem.o comsi.o fem_elastic_stiffness.o: comai.o comfem.o comsi.o @@ -217,6 +217,7 @@ ftime.o: compfrac.o gdkm_calc.o: comai.o combi.o comci.o comdi.o comdti.o comji.o comki.o davidi.o gdkm_connect.o: comai.o combi.o comci.o comdi.o comdti.o comji.o comki.o gdkm_connect.o: davidi.o +gdkm_volume_fraction_interface.o: comai.o combi.o comco2.o comdi.o comdti.o gdpm_corr.o: comai.o combi.o comdti.o comei.o comki.o davidi.o gdpm_geneqh.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o gdpm_geneqh.o: comflow.o comgi.o comhi.o comji.o davidi.o @@ -340,6 +341,7 @@ gp_global_coord.o: comai.o combi.o comfem.o grad_array.o: comai.o combi.o comsptr.o gradctr.o: comai.o combi.o comco2.o comdi.o comdti.o comfi.o commeth.o h2o_properties.o: comai.o comco2.o comrxni.o +h2o_properties_new.o: comai.o comco2.o comrxni.o interpolate_2.o head_2phase.o: comai.o combi.o comdi.o comdti.o comfi.o comgi.o comii.o head_2phase.o: comrxni.o headctr.o: comai.o combi.o comdi.o comdti.o comfi.o comgi.o comii.o comrxni.o @@ -466,7 +468,7 @@ porosity_gradient_log.o: comai.o combi.o comdi.o comsptr.o porosity_gradient_omr.o: comai.o combi.o comdi.o comsptr.o porosity_wrt_displacements.o: comai.o comdi.o comsi.o psat.o: comai.o comdti.o comii.o -psatl.o: comai.o comdti.o comii.o +psatl.o: comai.o comdti.o comii.o interpolate_2.o ptrac1.o: comai.o combi.o comci.o comdi.o comflow.o compart.o comsk.o comsptr.o ptrac1.o: comwt.o comxi.o davidi.o ptrac3.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o comflow.o @@ -620,7 +622,7 @@ ther_meth_h2o.o: comgi.o comii.o commeth.o comrxni.o thermc.o: comai.o combi.o comchem.o comci.o comcouple.o comdi.o comdti.o thermc.o: comfi.o comgi.o comrxni.o davidi.o thermw.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o comgi.o -thermw.o: comii.o comrlp.o comrxni.o comsi.o comtable.o +thermw.o: comii.o comrlp.o comrxni.o comsi.o comtable.o interpolate_2.o thickness.o: comai.o combi.o comdi.o comdti.o comfi.o comgi.o comrxni.o thomeercap.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o comhi.o thomeercap.o: comki.o @@ -658,13 +660,13 @@ velocity_derivatives.o: comsptr.o velocity_derivatives_lsq.o: comai.o combi.o comci.o comdi.o comflow.o comsk.o velocity_derivatives_lsq.o: comsptr.o vfcal.o: comai.o combi.o comdi.o comdti.o -vg.o: comai.o comco2.o comdi.o comrlp.o vg_regions.o: comai.o comdi.o comdti.o -vgcap_fit2.o: comai.o comrlp.o vgcap_inv_calc.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o vgcap_inv_calc.o: comhi.o comii.o comki.o comwt.o vonMises_stiffness.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o vonMises_stiffness.o: comflow.o comgi.o comji.o comsi.o davidi.o +vrock_ctr.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o comgi.o +vrock_ctr.o: comii.o comki.o wellimped_ctr.o: comai.o combi.o comci.o comdi.o comdti.o comei.o comfi.o wellimped_ctr.o: comflow.o comgi.o comii.o comji.o comki.o comxi.o davidi.o wellphysicsctr.o: comai.o combi.o comci.o comco2.o comdi.o comdti.o comei.o @@ -672,17 +674,17 @@ wellphysicsctr.o: comfi.o comflow.o comgi.o comii.o comki.o commeth.o comrxni.o wellphysicsctr.o: comwellphys.o comxi.o davidi.o write_avs_head_s.o: avsio.o comai.o comdi.o comsi.o davidi.o write_avs_node_con.o: avsio.o comai.o combi.o comchem.o comdi.o comdti.o -write_avs_node_con.o: compart.o comrxni.o +write_avs_node_con.o: compart.o comriv.o comrxni.o write_avs_node_h.o: comai.o write_avs_node_hf.o: avsio.o comai.o combi.o comdi.o comflow.o write_avs_node_mat.o: avsio.o comai.o combi.o comchem.o comdi.o comriv.o write_avs_node_mat.o: comrxni.o davidi.o write_avs_node_s.o: avsio.o comai.o combi.o comci.o comco2.o comdi.o comfem.o write_avs_node_s.o: comfi.o comflow.o comii.o comriv.o comsi.o comwt.o davidi.o -write_avs_node_v.o: avsio.o comai.o combi.o comdi.o +write_avs_node_v.o: avsio.o comai.o combi.o comdi.o comriv.o write_copyright.o: comai.o write_rlp_hyd.o: comai.o commeth.o -writeio.o: comai.o comxi.o +writeio.o: comai.o comco2.o comxi.o wrtcon.o: comai.o combi.o comchem.o comdi.o comdti.o comgi.o comrxni.o comxi.o wrtout.o: comai.o combi.o comci.o comco2.o comdi.o comdti.o comei.o comfi.o wrtout.o: comflow.o comgi.o comii.o comwt.o comxi.o davidi.o @@ -691,5 +693,6 @@ wtrise.o: comai.o combi.o comdi.o comflow.o compart.o wtsi_column.o: comai.o combi.o comdi.o comdti.o comwt.o comxi.o wtsictr.o: comai.o combi.o comci.o comdi.o comdti.o comfi.o comii.o comwt.o wtsictr.o: comxi.o -zone.o: comai.o combi.o comdti.o trxnvars.o +zone.o: avsio.o comai.o combi.o comdi.o comdti.o trxnvars.o property_interpolate.mod: interpolate.o +property_interpolate_1.mod: interpolate_2.o diff --git a/src/Makefile.fehm b/src/Makefile.fehm new file mode 100755 index 00000000..5f491961 --- /dev/null +++ b/src/Makefile.fehm @@ -0,0 +1,126 @@ +#*********************************************************************** +# +# Makefile for FEHM +# +#*********************************************************************** +# Usage: gmake -f Makefile.fehm [FLAGS] [TARGET] +# +# Command line flags: BIT (Linux only), DEBUG +# BIT=32 PGI 32 bit compiler (default) +# BIT=64 PGI 64 bit compiler +# DEBUG=OFF Compile without -g flag (default) +# DEBUG=ON Compile with -g, -C flags +#*********************************************************************** +# GNU Make version 3.79.1 or later should be used +# gmake (make) should be executed from the directory where the objects +# will reside. +# Edit SRCDIR to point to the directory where the source code is located +# Edit FC,LIBRARY,FFLAGS for your environment and compiler +#*********************************************************************** + +SRCDIR = /scratch/ymp/zvd/FEHM_V3.00open/src/ +WORKDIR = ./ +INCDIR = ./ +OBJDIR = ./ +DEPEND = ${SRCDIR}Makefile.depends + +OPSYS = UNKNOWN +BIT = 32 +STATIC = +OPSYS_FULL = $(shell uname -a ) +OPSYS = $(shell uname -s ) +OPSYS_PROCESSOR = $(shell uname -p ) +DATETAG = $(shell date '+%y-%m-%d') + +ifeq (${DEBUG}, ON) +DATE = dbg +else +DATE = $(shell date '+.%d%b%y') +endif + +# Linux OS ------------------------------ +ifeq (${OPSYS}, Linux) +OSTAG = pgi${BIT} +ifeq (${BIT},64) +FC = /opt/pgi/linux86-64/6.2/bin/pgf90 +LIBRARY = -L/opt/pgi/linux86-64/6.2/lib +TARGET = k8-64e +else +FC = /opt/pgi/linux86/6.2/bin/pgf90 +LIBRARY = -L/opt/pgi/linux86/6.2/lib +TARGET = px +endif +DFLAG = +LD = /usr/bin/ld +ifeq (${DEBUG}, ON) +FFLAGS = -g -C -Kieee -Mlfs -tp ${TARGET} +else +#FFLAGS = -O1 -Kieee -Mlfs -tp ${TARGET} +FFLAGS = -fast -Kieee -Mlfs -tp ${TARGET} +endif +STATIC = -Bstatic +endif +# Linux OS ------------------------------ + +# MAC OS ------------------------------ +ifeq (${OPSYS}, Darwin) +OSTAG = mac +ifeq (${OPSYS_PROCESSOR}, i386) +FC = /Applications/Absoft11.1/bin/f95 +LIBRARY = -L/Applications/Absoft11.1/lib -lm -lU77 -lV77 +else +FC = /Applications/Absoft11.1/bin/f95 +LIBRARY = -L/Applications/Absoft11.1/lib -lm -lU77 -lV77 +endif +DFLAG = +LD = /usr/bin/ld +ifeq (${DEBUG}, ON) +FFLAGS = -g +else +FFLAGS = -O2 -B18 -w +endif +STATIC = +endif +# MAC OS ------------------------------ + +# SUN OS ------------------------------ +ifeq (${OPSYS}, SunOS) +OSTAG = sun +FC = /n/local_SunOS/studio12/SUNWspro/bin/f90 +LD = /usr/ccs/bin/ld +LIBRARY = -L/n/local_SunOS/studio12/SUNWspro/lib +DFLAG = +ifeq (${DEBUG}, ON) +FFLAGS = -g -C +else +FFLAGS = -O1 -xtarget=ultra2 +endif +STATIC = -Bstatic +endif +# SUN OS ------------------------------ + +OBJECTS := $(patsubst ${SRCDIR}%.f,%.o,$(wildcard ${SRCDIR}*.f)) +OBJECTS_F90 := $(patsubst ${SRCDIR}%.f90,%.o,$(wildcard ${SRCDIR}*.f90)) + +all: dated xfehm + +dated: + rm -f ${SRCDIR}dated.f + sed s/OS\ DATE/${OSTAG}\ ${DATETAG}/ ${SRCDIR}dated.template > ${SRCDIR}dated.f + +xfehm : ${OBJECTS} ${OBJECTS_F90} + ${FC} ${FFLAGS} ${OBJECTS} ${OBJECTS_F90} ${LIBRARY} ${STATIC} -o xfehm_v3.1${OSTAG}${DATE} + +test: + echo ${OSTAG} ${FFLAGS} ${DATETAG} ${DATE} + +%.o : ${SRCDIR}%.f + ${FC} ${DFLAG} ${FFLAGS} $< -c + +%.o : ${SRCDIR}%.f90 + ${FC} ${DFLAG} ${FFLAGS} $< -c + +clean : + rm -f *.o *.mod + +include ${DEPEND} diff --git a/src/PC/fehmn.f b/src/PC/fehmn.f deleted file mode 100755 index affe3f09..00000000 --- a/src/PC/fehmn.f +++ /dev/null @@ -1,2317 +0,0 @@ - subroutine fehmn(method, state, ing, out) -!*********************************************************************** -! Copyright, 1993, 2004, The Regents of the University of California. -! This program was prepared by the Regents of the University of -! California at Los Alamos National Laboratory (the University) under -! contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE). -! All rights in the program are reserved by the DOE and the University. -! Permission is granted to the public to copy and use this software -! without charge, provided that this Notice and any statement of -! authorship are reproduced on all copies. Neither the U.S. Government -! nor the University makes any warranty, express or implied, or -! assumes any liability or responsibility for the use of this software. -C*********************************************************************** -CD1 -CD1 PURPOSE -CD1 -CD1 Finite Element Heat and Mass Transfer in porous media. -CD1 -C*********************************************************************** -CD2 -CD2 REVISION HISTORY -CD2 -CD2 Revision ECD -CD2 Date Programmer Number Comments -CD2 -CD2 06-DEC-93 Z. Dash 22 Add prolog. -CD2 1980 G. Zyvoloski Initial implementation. -CD2 -CD2 $Log: /pvcs.config/fehm90/src/fehmn.f_a $ -CD2 -!D2 -!D2 Rev 2.5 06 Jan 2004 10:42:58 pvcs -!D2 FEHM Version 2.21, STN 10086-2.21-00, Qualified October 2003 -!D2 -!D2 Rev 2.4 29 Jan 2003 09:03:24 pvcs -!D2 FEHM Version 2.20, STN 10086-2.20-00 -!D2 -!D2 Rev 2.3 14 Nov 2001 13:03:50 pvcs -!D2 FEHM Version 2.12, STN 10086-2.12-00 -!D2 Update the GoldSim / FEHM interface -!D2 -!D2 Rev 2.2 06 Jun 2001 13:23:44 pvcs -!D2 FEHM Version 2.11, STN 10086-2.11-00 -!D2 -!D2 Rev 2.1 30 Nov 2000 12:01:16 pvcs -!D2 FEHM Version 2.10, STN 10086-2.10-00 -!D2 -!D2 Rev 2.0 Fri May 07 14:41:16 1999 pvcs -!D2 FEHM Version 2.0, SC-194 (Fortran 90) -CD2 -CD2 Rev 1.16 Fri Jun 21 15:33:06 1996 hend -CD2 Fixed Ultimately Lame Mistake in the Last Revision -CD2 That Is Not Even Worth Describing -CD2 -CD2 Rev 1.15 Fri Jun 21 15:28:46 1996 hend -CD2 Fixed possible division by 0 -CD2 -CD2 Rev 1.14 Tue May 14 14:32:18 1996 hend -CD2 Updated output -CD2 -CD2 Rev 1.13 Wed May 08 14:09:20 1996 hend -CD2 Rearranged and added output -CD2 -CD2 Rev 1.12 Thu Feb 15 10:20:50 1996 zvd -CD2 Added requirement. -CD2 -CD2 Rev 1.11 Tue Jan 30 09:24:28 1996 hend -CD2 Updated Requirements Traceability -CD2 -CD2 Rev 1.10 08/16/95 16:27:54 robinson -CD2 Changed name of variable to set print out interval -CD2 -CD2 Rev 1.9 06/01/95 17:04:18 gaz -CD2 added another call to diagnostics -CD2 -CD2 Rev 1.8 03/20/95 08:25:22 gaz -CD2 un commented call to velocity . this will allow the velocties to be used -CD2 in the transport solution. -CD2 -CD2 Rev 1.7 03/10/95 10:34:46 llt -CD2 commented out call to velocity - gaz -CD2 -CD2 Rev 1.6 02/22/95 10:13:24 llt -CD2 in cont macro, CONTIM was not recognized when avs was used. -CD2 -CD2 Rev 1.5 11/30/94 12:20:18 llt -CD2 Added verno definition to dated_*.f routines, so would also tell which -CD2 platform running on. -CD2 -CD2 Rev 1.4 11/29/94 18:22:04 llt -CD2 Changed length of jdate to 11 characters for ibm -CD2 -CD2 Rev 1.3 08/23/94 15:24:12 llt -CD2 Made a subroutine, so that all array allocation can be done before used, -CD2 required for the ibm. -CD2 -CD2 Rev 1.2 03/18/94 15:53:26 gaz -CD2 Added solve_new and cleaned up memory management. -CD2 -CD2 Rev 1.1 02/28/94 11:54:04 zvd -CD2 Corrected problem so contour and restart files are always updated for last -CD2 time step. -CD2 -CD2 Rev 1.0 01/20/94 10:23:46 pvcs -CD2 original version in process of being certified -CD2 -c 3/20/95 gaz un-commented out call to velocity -C*********************************************************************** -CD3 -CD3 INTERFACES -CD3 -CD3 Formal Calling Parameters -CD3 -CD3 None -CD3 -CD3 Interface Tables -CD3 -CD3 None -CD3 -CD3 Files -CD3 -CD3 Name Use Description -CD3 -CD3 iout O File used for general code output -CD3 -C*********************************************************************** -CD4 -CD4 GLOBAL OBJECTS -CD4 -CD4 Global Constants -CD4 -CD4 None -CD4 -CD4 Global Types -CD4 -CD4 None -CD4 -CD4 Global Variables -CD4 -CD4 COMMON -CD4 Identifier Type Block Description -CD4 -CD4 b REAL*8 array containing the incomplete lu -CD4 decomposition of the jacobian matrix -CD4 day REAL*8 faar Current time step size in days -CD4 deneh REAL*8 fdd Last time step energy accumulation term -CD4 at each node -CD4 denei REAL*8 fcc Energy accumulation term -CD4 denej REAL*8 fdd Last time step energy accumulation time -CD4 derivative at each node -CD4 denh REAL*8 fdd Last time step mass accumulation term at -CD4 each node -CD4 deni REAL*8 fcc Mass accumulation term -CD4 denj REAL*8 fdd Last time step mass accumulation time -CD4 derivative at each node -CD4 dstm REAL*8 fcc Steam mass -CD4 dtot REAL*8 faar Current time step size in seconds -CD4 eflow REAL*8 fdd Energy flow at each source node -CD4 enlf REAL*8 fcc Liquid enthalpy -CD4 envf REAL*8 fcc Vapor enthalpy -CD4 esk REAL*8 fdd Inlet enthalpy associated with a source -CD4 ex LOGICAL faay Logical for existence check (T/F) -CD4 iout INT faai Unit number for output file -CD4 iptty INT faai Unit number for selected tty output -CD4 jdate CHAR faac1 Contains the date (mm/dd/yr) -CD4 jtime CHAR faac1 Contains the time (hr:mn:sc) -CD4 l INT faai Current time step number -CD4 n INT faai Total number of nodes -CD4 nmat INT david2 Array used in the reduced degree of -CD4 freedom method -CD4 nstep INT faai Maximum number of time steps -CD4 phi REAL*8 fdd Pressure at each node -CD4 pho REAL*8 fdd Last time step pressure at each node -CD4 ps REAL*8 fdd Porosity at each node -CD4 qh REAL*8 fdd Energy source term at each node -CD4 rolf REAL*8 fcc Liquid density -CD4 rovf REAL*8 fcc Vapor density -CD4 s REAL*8 fdd Liquid saturation at each node -CD4 sk REAL*8 fdd Source strength of each node -CD4 so REAL*8 fdd Last time step saturation at each node -CD4 t REAL*8 fdd Temperature at each node -CD4 to REAL*8 fdd Last time step temperature at each node -CD4 verno CHAR faac Contains version number of FEHMN code -CD4 volume REAL*8 fdd Volume associated at each node -CD4 -CD4 Global Subprograms -CD4 -CD4 Identifier Type Description -CD4 -CD4 allocmem Allocate memory to dynamic variable arrays -CD4 bnswer Invoke thermodynamics and solution routines -CD4 bcon Adjust/manage boundary conditions -CD4 co2ctr Control isothermal air-water simulation -CD4 concen Control trace simulation -CD4 contr Write contour plot data -CD4 data Zero all arrays and load thermo coefficients -CD4 datchk Analyze input data and some generated quantities -CD4 dated Find current date and time -CD4 disk Read/write initial/final state data -CD4 dual Find dual porosity contributions to nodes -CD4 enthp REAL*8 Calculate enthalpy at a node as a function of -CD4 temperature and pressure -CD4 fimpf Calculate fraction of variables over a given -CD4 tolerance -CD4 infiles Control reading of input data files -CD4 iofile Manage the opening of input and output files -CD4 plot Write history plot data -CD4 resetv Reset variables to old time step values -CD4 setparams Initialize/set parameter values -CD4 sice Control ice simulation -CD4 startup Perform miscellaneous startup calculations -CD4 timcrl Procedure to adjust timestep -CD4 flow_boundary_conditions Procedure to adjust timestep and BCs -CD4 tyming REAL*8 Calculate the elapsed cpu time -CD4 user User programmed special calculations -CD4 varchk Determine variable set and make n-r corrections -CD4 veloc Calculate fluid velocities -CD4 wellbor Wellbore input and simulation -CD4 wrtout Control output to files and tty -CD4 -C*********************************************************************** -CD5 -CD5 LOCAL IDENTIFIERS -CD5 -CD5 Local Constants -CD5 -CD5 None -CD5 -CD5 Local Types -CD5 -CD5 None -CD5 -CD5 Local variables -CD5 -CD5 Identifier Type Description -CD5 -CD5 caz REAL*8 Dummy argument to function tyming -CD5 deneht REAL*8 -CD5 denht REAL*8 -CD5 eskd REAL*8 -CD5 enthp REAL*8 -CD5 flemax REAL*8 -CD5 flmax REAL*8 -CD5 ichk INT -CD5 im INT -CD5 ja INT -CD5 mi INT -CD5 prav REAL*8 -CD5 pravg REAL*8 -CD5 tajj REAL*8 Elapsed cpu time (for reading input and -CD5 coefficient generation) -CD5 tas REAL*8 Total elapsed cpu time -CD5 tassem REAL*8 Elapsed cpu time for time step -CD5 tasii REAL*8 Cpu time at start of solution computations -CD5 teinfl REAL*8 -CD5 tinfl REAL*8 -CD5 tmav REAL*8 -CD5 tmavg REAL*8 -CD5 tyming REAL*8 -CD5 -CD5 Local Subprograms -CD5 -CD5 None -CD5 -C*********************************************************************** -CD6 -CD6 FUNCTIONAL DESCRIPTION -CD6 -C*********************************************************************** -CD7 -CD7 ASSUMPTIONS AND LIMITATIONS -CD7 -CD7 None -CD7 -C*********************************************************************** -CD8 -CD8 SPECIAL COMMENTS -CD8 -CD8 This routine handles the entire functioning of the code by calling -CD8 the necessary routines and computations. -CD8 -CD8 Requirements from SDN: 10086-RD-2.20-00 -CD8 SOFTWARE REQUIREMENTS DOCUMENT (RD) for the -CD8 FEHM Application Version 2.20 -CD8 -C*********************************************************************** -CD9 -CD9 REQUIREMENTS TRACEABILITY -CD9 -CD9 2.5.1 Implement time-step mechanism -CD9 2.7 Provide Restart Capability -CD9 2.7.3 Resume the calculation -CD9 2.8 Provide Multiple Realization Option -CD9 2.9 Interface with GoldSim -CD9 -C*********************************************************************** -CDA -CDA REFERENCES -CDA -CDA None -CDA -C*********************************************************************** -CPS -CPS PSEUDOCODE -CPS -CPS BEGIN fehmn -CPS -CPS call tyming and dated to setup starting time and date -CPS call iofile to manage the opening of input and output files -CPS call setparams to calculate/set parameter values -CPS call allocmem to allocate memory to dynamic variable arrays -CPS call data to zero all arrays and load thermodynamic coefficients -CPS call startup to perform miscellaneous startup calculations -CPS call datchk to analyze input data and some generated quantities -CPS -CPS FOR each time step -CPS -CPS call timcrl to adjust timestep -CPS IF user subroutine should be called -CPS call user to invoke user subroutine -CPS END IF -CPS call welbor to compute wellbore solution if enabled -CPS -CPS FOR each node -CPS calculate inflowing enthalpy -CPS IF source input is a temperature -CPS convert to enthalpy -CPS END IF -CPS END FOR -CPS -CPS IF heat and mass transfer solution is disabled -CPS -CPS set last time step size and compute elapsed CPU time -CPS -CPS ELSE if heat and mass transfer solution is enabled -CPS -CPS compute CPU time -CPS call bnswer to invoke thermodynamic and solution routines -CPS -CPS IF any variables are out of bounds -CPS IF maximum number of iterations was exceeded -CPS write timestep, iterations, and timestep size to tty -CPS if being used -CPS END IF -CPS reset days and call resetv to set variables to old -CPS timestep values -CPS IF dual porosity or double porosity/double permability is -CPS enabled -CPS call resetv to set dp/dpdp variables to old timestep -CPS values -CPS END IF -CPS call varchk to determine variable set and make n-r corrections -CPS call dual to invoke varchk for dual porosity nodes -CPS set new day parameter and increment global iteration count -CPS return to beginning of loop to adjust timestep (timcrl) -CPS -CPS END IF -CPS -CPS set last time step size and compute elapsed CPU time for -CPS this timestep and total elapsed time -CPS IF total elapsed time exceeds maximum allowed runtime -CPS write message to tty if being used about terminating -CPS program and exit time step loop -CPS END IF -CPS -CPS initalize time step parameters and calculate outflows and -CPS update coefficients for next time step -CPS call varchk to update variable set and make n-r corrections -CPS call dual to invoke varchk for dual porosity nodes -CPS call fimpf to calculate fraction of variables over a given -CPS tolerance -CPS call bcon to adjust boundary conditions -CPS -CPS FOR each node -CPS IF porosity is present -CPS compute timestep fluid outflow and energy outflow -CPS ELSE -CPS compute timestep energy outflow -CPS END IF -CPS IF this is a source/sink -CPS compute fluid outflow, energy outflow, average -CPS pressure and temperature, and cumulative fluid -CPS and energy outflow -CPS END IF -CPS compute mass and energy accumulation -CPS set variable last timestep values -CPS END FOR -CPS -CPS call co2ctr to update co2 arrays -CPS call sice to update sice arrays -CPS -CPS END IF -CPS -CPS call veloc to calculate velocities -CPS call concen to obtain concentration solution -CPS -CPS compute intermediate flow total -CPS IF flow total is greater than 0 -CPS compute average temperature, pressure per flow volume -CPS compute intermediate energy flow and enrgy flow for timestep -CPS END IF -CPS -CPS set printout flag to 0 (no printout for this time step) -CPS IF tty output is enabled -CPS set printout flag to 1 (tty printout only) -CPS END IF -CPS IF this isn't the finish time and we haven't exceeded the -CPS maximum number of timesteps -CPS increment print-out interval counter -CPS IF the counter is greater than or equal to the number of -CPS timesteps per printout interval -CPS set printout flag to 2 and reinitialize interval counter -CPS END IF -CPS ELSE -CPS set printout flag to 2 -CPS END IF -CPS -CPS IF printout is enabled -CPS FOR each node -CPS set last timestep pressure -CPS END FOR -CPS calculate mass and energy balance errors -CPS call co2ctr to calculate gas mass balance error -CPS call wrtout to initiate output file writes -CPS END IF -CPS -CPS call plot to write history plot data -CPS IF contour plots enabled or using intervals or time for plot -CPS call contr to write contour plot data -CPS call disk to write a restart file at this time -CPS IF this is the final timestep -CPS set flag to indicate contour and restart files already -CPS written -CPS END IF -CPS END IF -CPS -CPS IF the final time has been reached -CPS exit the time step loop -CPS END IF -CPS -CPS END FOR -CPS -CPS write final solution (call disk, contr, plot) and messages to -CPS output files and tty if using -CPS -CPS END fehmn -CPS -C*********************************************************************** - - use comai - use combi - use comci - use comco2 - use comcomp - use comdi - use comdti - use comei - use comevap, only : evaporation_flag - use comfi, only : qtc, qtotc, pci, pcio - use comflow, only : a_axy - use compart - use comriv - use comrtd, only : maxmix_flag - use comrxni - use comsi - use comsk, only : save_omr - use comsplitts - use comsptr - use comuserc, only : in - use comwt - use comxi - use davidi - use comfem, only : edgeNum1, NodeElems, ifem, flag_element_perm - use comfem, only : fem_strain, conv_strain, conv_pstrain - use property_interpolate -c added combi and comflow to get izonef and a_axy arrays -c in subroutine computefluxvalues - implicit none - -c These are PC attributes used as compiler directives. They -c should be set as follows for the PC-RIP version of fehm. - -c If the stand-alone pc version of the code is being used, then -c the fehmn attribute line should be omitted and the method -c variable should be passed by reference. - -c For UNIX versions, these lines are ignored as comments. -C!DEC$ ATTRIBUTES dllexport, c :: fehmn -C!DEC$ ATTRIBUTES value :: method -C!DEC$ ATTRIBUTES reference :: method -C!DEC$ ATTRIBUTES reference :: state -C!DEC$ ATTRIBUTES reference :: ing -C!DEC$ ATTRIBUTES reference :: out - - integer(4) method, state - real(8) ing(*), out(*) - -c irun is a counter for each realization in a multiple simulation -c run of fehm. It is initialized to 0 in comai - - character*80 filename - integer open_file, ifail - - logical used, die - real*8 tims_save, day_saverip, in3save - real*8 deneht, denht, eskd, enthp, flemax, flmax, prav, - * pravg, tajj, tas, teinfl, tinfl, tmav, tmavg, tyming - real(8) :: inflow_thstime = 0., inen_thstime = 0. - real(8) :: contr_riptot = 1.0d+30 - real(8) :: tasii = 0., tassem = 0. - real*4 caz(2) -c*** water table rise modification - real*8 water_table_old - real*8 prop,dpropt,dpropp,p_energy -c*** water table rise modification - logical it_is_open, intfile_ex - integer im, ja, mi, i - integer :: ichk = 0, tscounter = 0, flowflag = 0 - integer number_of_outbuffers, jpr - integer :: n_input_arguments = 0 - integer index_N_large, index_in_species - integer index_in_flag, index_out_buffer - integer is_ch - integer :: is_ch_t = 0 - integer :: out_flag = 0 - integer ntty_save -c -c gaz debug 121415 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -c - real*8 rel_hum,qin,qin_ng,qin_h2o,qin_enth,enth_avg,pl_dum - - save flowflag, ichk, tassem, tasii, tscounter, - & contr_riptot, tims_save, day_saverip, in3save, - & water_table_old, ntty_save - -c zvd 09-Sep-2011 change size of in array to be consistent with iofile -c modification for GoldSim - if (.not. allocated(in)) allocate(in(4)) - in = ing(1:4) - - inquire(unit=6,opened=it_is_open) - if(method.eq.2) then -c When run from Goldsim, the normal fehm screen output gets -c written to fehmn.log instead by opening unit 6 as a file -c with this name - if(.not.it_is_open) then - open(6,file='fehmn.log') - iptty = 6 - end if -c Version number (updated in subroutine dated) - out(1) = vernum - return - elseif(method.eq.99) then -c Cleanup - close all files before starting a new realization - - do i = 1, 99 - inquire(unit=i,opened=it_is_open) - if(it_is_open) then - close(i) - end if - end do -c Release all dynamic array memory at the end of a GoldSim simulation - - call releasemem - - elseif(method.eq.3) then -c write(6,*) 'You are running fehm as a dll from rip.' -c write(6,*) 'This requires that you input the number' -c write(6,*) 'of input arguments that you are using' -c write(6,*) 'in this rip simulation.' -c write(6,*) -c write(6,*) 'The input arguments are time (mandatory)' -c write(6,*) 'plus the number of index parameters you' -c write(6,*) 'in the rip input.' -c write(6,*) 'Please input the number of input arguments:' -c read(*,*) n_input_arguments -c out(1) = n_input_arguments -c out(2) = 0 - ripfehm = 1 - do i = 1, 80 - filename(i:i) = ' ' - end do - filename(1:10)='fehmn.gold' - iread = open_file(filename,'old') - - read(iread,*) n_input_arguments, out_flag - out(1) = n_input_arguments -c out(2) = number_of_outbuffers - out(2) = 0 - call ingold - close(iread) -c System call to run batch file fehmn_real.bat - if(iptty.ne.0) then - write(iptty,*) 'Running fehmn_real.bat' - end if - call system('fehmn_real') -c out(1) = 3 -c n_input_arguments = 3 -c out(2) = 12 -c number_of_outbuffers = out(2) - elseif(method.eq.0) then -c Initialize - tscounter = 0 - flowflag = 0 - tassem = 0.0 -c*** water table rise modification - water_table_old = -1.d+10 -c*** water table rise modification -c bhl_5/15/08 - ipmbal = 0 -c bhl_5/15/08 - -c Increase counter for simulation number - - if (ripfehm .ne. 0) then - irun = irun + 1 - else - irun = in(1) - end if - -c**** set version number **** -ccc verno = 'FEHMN XX-XX-XX ' - tajj = tyming(caz) - call dated (jdate, jtime) -c--Add copyright write out - call write_copyright (6) - call iofile (ichk) - -c**** initialize/set parameter values - call setparams - -c**** allocate memory **** - if(irun.eq.1) call allocmem - -c**** call data initialization routine **** - call data - -c**** call co2_properties_interpolation_lookup_table RJP 04/09/07 - if (icarb .ne. 0) then - inquire(file=nmfil(29), exist=intfile_ex) - if(.not.intfile_ex) then - write(ierr, 6010) trim(nmfil(29)) - write(ierr, 6012) - if (iout .ne. 0) then - write(iout, 6010) trim(nmfil(29)) - write(iout, 6012) - end if - if (iptty .ne. 0) then - write(iptty, 6010) trim(nmfil(29)) - write(iptty, 6012) - end if - stop - endif - - call read_interpolation_data(ifail,nmfil(29)) - - end if - - 6010 format('CO2 Properties Interpolation Table File not found: ', - & /, a, /, 'Stopping') - 6012 format('Input correct name in control file using, co2in : ', - & 'filename') - -c**** read and write data **** - in3save = in(3) - if(in(3).eq.0) then - in(3) = irun + .0001 - end if - - call infiles(in(3)) - if (nriver .ne. 0) call river_ctr(33) - - in(3) = in3save -c**** modify gravity to reflect vector value **** - -c transferred to fehmn.f(GAZ 2/19/97) - grav = -abs(grav) * 1.0d-06 -c -c**** call time varing boundary conditions **** -c - call flow_boundary_conditions(2) -c -c 10/22/99 -c moving ,the volumes are not defined yet(need for distributed source) -c call flow_boundary_conditions(3) -c -c *** intialize chemistry if needed ** - if(rxn_flag.eq.1) call initchem -c**** call startup calculations **** - call startup (tajj, tasii) -c moved flow_boundary_conditions(3) from above(could be dangerous!) - call flow_boundary_conditions(3) -c**** call to set up area coefficients for md nodes - call md_nodes(6,0,0) -c**** call data checking routine **** - call datchk -c**** initial active base variables if necessarhy - call active_nodes_ctr(-1) -c gaz 050809 moved to startup -c calculate initial stress field and displacements -c -c call stress_uncoupled(1) -c -c reset boundary conditions for principal stresses (fraction of lithostatic) -c -c call stressctr(3,0) -c - if(ico2.lt.0) then - if (iout .ne. 0) write(iout,834) ifree1 - if (iptty .ne. 0) write(iptty,834) ifree1 - endif - 834 format('Initial number of partially filled cells: ', i8,/) - -c Store final simulation time so that for a rip simulation -c we know when the simulation is over - - tims_save = tims - -c rip avs output flag - initialize - - contr_riptot = contim_rip - - if(.not.compute_flow .and. iccen .ne. 1 .and. - & .not. sptrak) then - if(allocated(sx)) deallocate(sx) - if(allocated(istrw)) deallocate(istrw) - end if - - if(sptrak) then -! Moved opening of "isptr*" files to insptr -! open(isptr1, file = nmfil(17), status = cstats(17)) -! open(isptr2, file = nmfil(18), status = cstats(18)) -! open(isptr3, file = nmfil(19), status = cstats(19)) -c s kelkar may 20 09 moved call to load_omr_flux_array from ptrac1 here -c s kelkar may 28 09 moved call to init_sptr_params from ptrac1 here -c where ptrac1 used to be called -c zvd - 19Nov2010 -c Moved call to sptr_save here, needs to be called after call -c to load_omr_flux_array - call init_sptr_params - if (.not. compute_flow) then - if (.not. sptr_exists) then - call load_omr_flux_array - if (save_omr) call sptr_save (1) - endif - if(.not.random_flag) then -c if(allocated(sx)) deallocate(sx) -c if(allocated(istrw)) deallocate(istrw) - end if - end if -c call ptrac1 - endif - -c If block only entered if the code is being called to -c perform the calculation (other options are initialization -c only, return the version number, etc.) -c change to 4 in new version of rip - elseif(method.eq.1) then - ex = .FALSE. - if(maxmix_flag.ne.0) then - call generate_flow - end if - -c stop simulation after stress calc for certain stress input -c set up time-spaced coupling - if(istrs_coupl.eq.-4) then - timestress0 = days - timestress = timestress0 + daystress - endif - if(istrs.ne.0.and.istrs_coupl.eq.0) go to 170 -c Before the time step loop create the partitions for zones - - call paractr(1) -c Check for submodel BCs - call paractr(5) - -c -c restart after steady state has been achieved -c - 999 continue - if(ifinsh.eq.2) then - l = 0 - call flow_boundary_conditions(3) - daynew = day - days =0.0 - qt = 0.0 - qtot = 0.0 - qte = 0.0 - qtote = 0.0 - qtc = 0.0 - qtotc = 0.0 - amass = 0.0 - asteam = 0.0 - aener = 0.0 - toutfl = 0.0 - teoutf = 0.0 - dtot_next = day*86400. - if(iporos.ne.0) call porosi(4) - endif - -c Call evaporation routine if this is an evaporation problem - if (evaporation_flag) call evaporation(1) -c -c set counter for restarted timesteps to zer0 -c - nrestart_ts = 0 - -c ************** major time step loop *************************** - do l = 1, nstep -c -c counter that keeps accumulating when rip is the time step driver -c Or in a conventional simulation with heat and mass solution -c gaz debug 082714 - tscounter = tscounter + 1 -c Don't use input value of initial time step anymore -c if(abs(tscounter).eq.1.and.in(3).ne.0.) then -c day_saverip = overf -c end if - -c**** time step control via iteration count **** - - 100 continue - call riptime -c -c Set current index for flow field catalog number (rip option) -c - flowflag = int(in(2)) -cHari 3/1/07 -c*** water table rise modification - if (ripfehm .ne. 0) water_table_old = in(7) -c*** adjust timestep size - call timcrl - -c -c manage the stress calls when ihms = istrs_coupl = -4 -c - istresscall = 0 -c - if(ihms.eq.-4) then - if(days.ge.timestress) then - istrs_coupl = -3 - timestress0 = timestress - timestress = timestress0 + daystress - else - istrs_coupl = ihms - endif - endif - -c Call evaporation routine if this is an evaporation problem - if (evaporation_flag) call evaporation(2) - - if (ichk .ne. 0) call user (ichk) -c -c check for possible source movement -c - if(move_wt.eq.1) call wtsictr(7) - - dtot = day * 86400.0 -c No longer do this because GoldSim enters with in(1) = 0 -c the first time, so we don't need to have the user input the -c initial delta time -c if(abs(tscounter).eq.1.and.in(1).ne.0.) then -c dtot = 86400.*day_saverip -c end if - -c**** call welbore simulator **** -c call welbor (1) - -c**** calculate inflowing enthalpy **** - if(ico2.ge.0.and.ice.eq.0) then - if(icarb.eq.1) then - call icectrco2(-4,0) - else - - do mi = 1, n - eskd = esk(mi) -c**** if source input is a temp convert to enthalpy **** - if (itsat.le.10 .and. eskd .lt. 0.0) then -c potential energy added to inflow energy in function enthp - eskd = enthp(mi, -eskd) -c below lines commented out -c if(ps(mi).eq.0.0.or.idof.le.1) then -c eskd=cpr(mi)*(-eskd) -c endif - else if(itsat.gt.10.and.eskd.lt.0.0) then -c enthalpy and derivatives -c itsats gt 10 always convert the temperature - if(igrav.ne.0) then - p_energy = -grav*cord(mi,igrav) - else - p_energy = 0.0d0 - endif - eskd = abs(eskd) - if(eskd.ne.0.0) then - call eos_aux(itsat,eskd,phi(mi),1,1,prop, - & dpropt,dpropp) - eskd = prop + p_energy - if(ps(mi).eq.0.0.or.idof.le.1) then - eskd=cpr(mi)*eskd - endif - endif - end if - eflow(mi) = eskd - end do - end if - else if (ice.ne.0) then - call icectr(-4,0) - endif - -c**** if heat and mass transfer solution is disabled **** - if ((ihf .ne. ihs) .or. .not. compute_flow ) then - - dtotdm = dtot - tassem = tyming(caz) - tassem - -c**** if heat and mass transfer solution is enabled **** - else - dtotdm = dtot - - tassem = tyming(caz) - -c**** form equations, calculate corrections. **** - irestart_ts = 0 - if(ipara.eq.0) then - call bnswer - else - call bnswer_part - endif - -c**** decrease time step if necessary **** -c**** mlz.ne.0 means thermo variable is out of bounds **** - - if (mlz .le. -1) then - irestart_ts = 1 - if (mlz .eq. -1) then - if (iout .ne. 0) write(iout, 6020) l, iad, day - if (iptty .gt. 0) write(iptty, 6020) l, iad, day - 6020 format(/, 1x, 'timestep = ', i6, ' iterations = ', - * i4, ' timestep size = ', g15.4) - else if(mlz.eq.-2) then - if (iout .ne. 0) write(iout, *) - & 'restart - normalization failed' - if (iptty .ne. 0) write(iptty, *) - & 'restart - normalization failed' - end if - days = days - day -c Check for submodel BCs - call resetv (0) - if(l.eq.1) call paractr(5) -c -c gaz added code so counter is correct for restarted time steps -c -C zvd commented out, now reset if necessary in timcrl -c if(icontr.ne.0) then -c nicg=nicg-1 -c ditnd=dit(nicg) -c endif - if (idualp .ne. 0) then - call resetv (neq) - call resetv (neq + neq) -c Check for submodel BCs -c gaz debug 102314 see "if(l.eq.1) call paractr(5)" above - if(l.eq.1) call paractr(5) - end if - if (idpdp .ne. 0) then - call resetv (neq) -c Check for submodel BCs - if(l.eq.1) call paractr(5) - end if - call varchk (0, 0) - call dual (1) - daynew = day - iad = abs(maxit) + 1 - ntty_save = ntty - ntty = 2 - call diagnostics(-1) - call diagnostics(1) - ntty = ntty_save -c -c count restarted timestep -c - nrestart_ts = nrestart_ts + 1 - go to 100 - end if - -c - if (mlz .ge. 1) then - if (iout .ne. 0) write(iout, 6021) l - if (iptty .gt. 0) write(iptty, 6021) l - 6021 format(/, 1x, 'timestep = ', i6, ' timestep ', - & 'restarted because of balance errors', - & ' or variable out of bounds') - days = days - day - call resetv (0) - if(icontr.ne.0) then - nicg=nicg-1 - ditnd=dit(nicg) - endif - if (idualp .ne. 0) then - call resetv (neq) - call resetv (neq + neq) - end if - if (idpdp .ne. 0) then - call resetv (neq) - end if - if(ice.eq.0) then - call varchk (0, 0) - endif - call dual (1) - daynew = day - iad = abs(maxit) + 1 - ntty_save = ntty - ntty = 2 - call diagnostics(-1) - call diagnostics(1) - ntty = ntty_save -c -c count restarted timestep -c - nrestart_ts = nrestart_ts + 1 - go to 100 - end if - -c**** stress routine calls **** - - dtotdm = dtot - - tassem = tyming(caz) - tassem - -c**** solve for heat and mass transfer solution **** - tas = tyming(caz) - tasii - - if (tas .gt. rnmax) then - - if (iout .ne. 0) write(iout, 6030) trim(nmfil(7)) - if (iptty .gt. 0) write(iptty, 6030) trim(nmfil(7)) - 6030 format(/, 1x, '**** allotted time gone, terminating ', - * 'run : restart = ', a, ' ****') -c Make sure fin file is written if we are stopping - if (isave .ne. 0) call diskwrite - if(isalt.ne.0) call saltctr(21,0,0.0d00,0.0d00) - go to 170 - - end if - -c zero variables used for current time step data - amass = 0.0 - asteam = 0.0 - aener = 0.0 - tmav = 0.0 - prav = 0.0 - tmavg = 0.0 - pravg = 0.0 - pow = 0.0 - inflow_thstime=0.0 - inen_thstime=0.0 - -c**** calculate outflows and update coefficients for next time step **** -c qtoti and qtotei will have this value subtracted to get values for -c this time step only - qtoti = qtot - qtotei = qtote - aw = awt - ay = 1.0 - aw - -c**** update variables and parameters **** - -c gaz 12-30-99 -c call varchk (0, 0) - call dual (1) - -c**** calculate AIM factor **** - - call fimpf - -c delete infinite reservoir nodes from mass balance calcs - - call bcon(2) - -c check for steady state solution - if(isteady.ne.0) then - call steady(1,0.,0.) - endif - -c -c correct mass correction -c - call bcon(4) -c -c calculate phase change information -c - is_ch = 0 - nphase_liq = 0 - nphase_2 = 0 - nphase_gas = 0 - do i=1,n - if(ieos(i).eq.1) nphase_liq = nphase_liq + 1 - if(ieos(i).eq.2) nphase_2 = nphase_2 + 1 - if(ieos(i).eq.3) nphase_gas = nphase_gas + 1 - if (irdof .ne. 13 .or. ifree .ne. 0) then - if(s(i).lt.1.0.and.so(i).ge.1.0) then - is_ch=is_ch +1 - else if(s(i).gt.0.0.and.so(i).le.0.0) then - is_ch=is_ch +1 - else if(s(i).ge.1.0.and.so(i).lt.1.0) then - is_ch=is_ch +1 - else if(s(i).le.0.0.and.so(i).gt.0.0) then - is_ch=is_ch +1 - endif - endif - enddo - is_ch_t = is_ch_t + is_ch - if(l.ne.1) then - dnphase_liq = nphase_liq - nphase_liq_0 - dnphase_2 = nphase_2 - nphase_2_0 - dnphase_gas = nphase_gas - nphase_gas_0 - else - dnphase_liq = 0 - dnphase_2 = 0 - dnphase_gas = 0 - endif - nphase_liq_0 = nphase_liq - nphase_2_0 = nphase_2 - nphase_gas_0 = nphase_gas -c -c call thermo because the solver is overwriting the deni and denei arrays -c - if(istrs_coupl.gt.0.and.ico2.eq.0) then - call thermw(0) - endif - -c dtotdm is the current time step size in seconds - do ja = 1, n - - if (abs(ps(ja)) .gt. zero_t) then -c qt = kg out - kg in -c qte = MJ out - MJ in - qt = qt + sk(ja) * dtotdm - qte = qte + qh(ja) * dtotdm - else -c check with gaz -- it seems like this should be qh(ja) or the code -c below is wrong - qte = qte + sk(ja) * dtotdm - end if - if (sk(ja) .gt. 0.0 .and. ps(ja).gt.0.0) then -c there is outflow at this node -c toutfl = summation of kg out of system -c qtot = summation of kg out of system - toutfl = toutfl + sk(ja) * dtotdm - prav = prav + sk(ja) * phi(ja) * dtotdm - tmav = tmav + sk(ja) * t (ja) * dtotdm - qtot = qtot + sk(ja) * dtotdm - else if (sk(ja).lt.0.0 .and. ps(ja).gt.0.0) then -c there is inflow at this node - inflow_thstime=inflow_thstime+sk(ja)*dtotdm - endif - if (qh(ja).gt.0.0 .and. ps(ja).gt.0.0) then -c there is outflow of energy at this node -c teoutf = summation of MJ out of system -c qtote = summation of MJ out of system - teoutf = teoutf + qh(ja) * dtotdm - qtote = qtote + qh(ja) * dtotdm - else if (qh(ja).lt.0.0 .and. ps(ja).gt.0.0) then -c there is inflow of energy at this node - inen_thstime=inen_thstime+qh(ja)*dtotdm - end if - denht = denh(ja) -c to (ja) = t(ja) - denh (ja) = denh (ja) + deni (ja) * dtot -c asteam = kg of steam in system -c amass = kg of mass in system -c aener = energy in system - - amass = amass + denh(ja) * volume(ja) - if(irdof.ne.13) then - asteam = asteam + dstm(ja) - deneht = deneh(ja) - deneh(ja) = deneh(ja) + denei(ja) * dtot - aener = aener + deneh(ja) * volume(ja) - denei(ja) = 0.0 - endif -c pho (ja) = phi(ja) - if(abs(irdof).eq.14) then - denej (ja) = denj(ja) - else - denj (ja) = 0.0 - endif - deni (ja) = 0.0 - if (irdof .ne. 13) then - if(ifree.ne.0) then - so (ja) = rlxyf(ja) - else - so (ja) = max(0.0d00,min(1.0d00,s(ja))) - end if - end if - - end do - if(istrs_coupl.gt.0.or.istrs_coupl.eq.-3) then -c save flow residuals - call stressctr(17,0) -c**** update stress arrays **** -c solve for displacements -c....... s kelkar 22 Aug 2012 - if(istrs_coupl.ge.5) then - if(ifem.eq.1) conv_strain = fem_strain - if(iPlastic.eq.1) conv_pstrain = plastic_strain - endif -c........ - if(istrs_coupl.eq.-3) then - istresscall = 1 - call stress_uncoupled(3) -c update volume strains - call stressctr(6,0) -c update porosity -c s kelkar 22 Aug 2012. if pore_factor>0 this is done in -c porosity_wrt_displacements which is called from from -c bnswer and gensl_stress_coupled_3D - if(pore_factor.eq.0) call stressctr(-7,0) - endif -c add displacements to total displacements - call stressctr(10,0) -c update displacements - call stressctr(12,0) -c update volume strains - call stressctr(-6,0) -c calculate stresses - call stressctr(13,0) - endif -c calculate subsidence - call subsidence(1) -c update peaceman term for wellbore pressure - if(isubwd.ne.0) call wellimped_ctr(1) - do ja = 1,n - to (ja) = t(ja) - pho (ja) = phi(ja) - enddo -c**** update co2 arrays **** - call co2ctr (3) - -c**** update component arrays or mixtures **** -c added call for balance error - call icectr (9,0) - call icectr (8,0) - if(icarb.eq.1) call icectrco2 (9,0) - if(icarb.eq.1) call icectrco2 (8,0) - -c**** update ice arrays **** -c gaz 10-18-2001 call sice (3) - -c**** call diagnostics **** -c call diagnostics(1) -c call diagnostics(2) - -c end if block for heat and mass transfer solution - endif -c -c find max residuals for flow (H +M) solution -c - call diagnostics(-1) -c -c**** calculate velocities **** - if(compute_flow .or. iccen .eq. 1) call veloc - -c**** obtain concentration solution **** - in3save = in(3) - if(in(3).eq.0) then - in(3) = irun + .0001 - end if -c save permeability and porosity if this can change with chemical transport -c now just for salt -c gaz debug 091414 average -c -c save old ps and pnx -c - if(isalt.ne.0) call saltctr(3,0,0.0d00,0.0d00) -c - call concen (1,tscounter) -c -c average and updates new porosities and perms if necessary -c - if(isalt.ne.0) call saltctr(4,0,0.0d00,0.0d00) -c save new ps and perms for restart file - if(isalt.ne.0) call saltctr(5,0,0.0d00,0.0d00) -c - in(3) = in3save - -c compute kg out of system this time step - qtoti = qtot - qtoti -c compute MJ out of system this time step - qtotei=qtote-qtotei -c compute MJ/s out of system this time step - pow=qtotei/dtotdm - - if (qtoti .gt. 0.0) then - tmavg = tmav / qtoti - pravg = prav / qtoti -c qtotei = qtote - qtotei -c pow = qtotei / dtotdm - endif - -c**** printout at specified intervals **** - - ntty = 0 - if (iptty .eq. 6) ntty = 1 - if (ifinsh .eq. 0 .and. l .lt. nstep) then - iac = iac + 1 - if (iac .ge. iprtout) then - ntty = 2 - iac = 0 - end if - else - ntty = 2 - end if - - do im = 1, n - pho(im) = phi(im) - end do - - if(ice.eq.0) then - -c**** calculate mass balance error **** -c tinfl = -total kg in -c teinfl = -total MJ in - tinfl = qt - toutfl - flmax = max(abs(tinfl), abs(toutfl)) - teinfl = qte - teoutf - flemax = max(abs(teinfl), abs(teoutf)) - - if (idof .le. 1) flmax = 0.0 - dife = 0.0 - if (flemax .ne. 0.0) dife = (aener-ame + qte)/flemax -c [(kg in system)-(kg originally in system)+(total kg left system - -c total kg entered system)]/ max(total kg in, total kg out) - if (flmax .ne. 0.0) difm = (amass-am0 + qt)/flmax - -c mass balance for air - call co2ctr (4) -c material balance for component mixtures - endif - -c**** call output routine **** - if (ntty .gt. 0 .and. iout .ne. 0) then -c retrieve flow residuals - if(istrs_coupl.gt.0.or.istrs_coupl.eq.-3) then - call stressctr(18,0) - endif - call wrtout(tassem,tas,dabs(tinfl),dabs(teinfl), - & dabs(inflow_thstime),dabs(inen_thstime), - & is_ch,is_ch_t) - if(istrs_coupl.gt.0.or.istrs_coupl.eq.-3) then -c output displacements and stresses - call stressctr(11,0) - endif - - end if - -c**** call history plot **** - - if (hist_flag) then - call plot_new (1, dabs(tinfl), dabs(teinfl), - & dabs(inflow_thstime), dabs(qtoti)) -c & dabs(inflow_thstime), dabs(inen_thstime)) - if(istrs.ne.0) call stressctr(14,0) - else - call plot (1, tmavg, pravg) - end if -c**** call wellbore pressures - if(isubwd. ne.0) call wellimped_ctr(4) -c check for steady state solution - if(isteady.ne.0) then - call steady(2,dabs(inflow_thstime),dabs(inen_thstime)) - endif - -c Move call to before the contour output routines -c BAR 7-20-99 - - if(sptrak) then -c........... s kelkar nov 13, 02.................... -c if freez_time is gt.0, then ptrac3 is called only at the end of the -c flow calculations, and for a velocity frozen at that time, -c particle tracks are calculated for freez_time days - if(freez_time.eq.0.) then - call ptrac3 - endif - endif -c........................................ - -c**** call contour plot **** - dayscn = dayscn + day - - if (icontr .ne. 0 .or. mod(l, ncntr) .eq. 0 .or. - * dayscn .ge. abs(contim)) then - -! if(contim.ge.0) then - call contr (1) - call contr (-1) - call river_ctr(6) - call active_nodes_ctr(4) -! else -! call contr_days (1) -! call contr_days (-1) -! endif - if (allocated(itc) .and. nicg .gt. 1) then - if (itc(nicg-1).gt.0) then -! call disk (1) - if (isave .ne. 0) call diskwrite - if(isalt.ne.0) call saltctr(21,0,0.0d00,0.0d00) - if (iflxn .eq. 1) call flxn - endif - else -! call disk (1) - if (isave .ne. 0) call diskwrite - if(isalt.ne.0) call saltctr(21,0,0.0d00,0.0d00) - if (iflxn .eq. 1) call flxn - end if - call pest(1) - if(isalt.ne.0) call saltctr(6,0,0.0d00,0.0d00) - if (ifinsh .ne. 0) ex = .TRUE. - if (dayscn .ge. abs(contim)) dayscn = 0. - - end if - - - if (ifinsh .eq. 1) then -c standard simulation finish - istea_pest = 0 - - go to 170 - else if (ifinsh .eq. 2) then - -! Make sure last steady state time step is output - if (hist_flag) then - call plot_new (1, dabs(tinfl), dabs(teinfl), - & dabs(inflow_thstime), dabs(qtoti)) - end if - call contr (1) - call contr (-1) - call river_ctr(6) - call active_nodes_ctr(4) -c finished the steady state simulation, now doing transient - days = 0.0 - istea_pest = 0 - call pest(1) - istea_pest = 1 - call flow_boundary_conditions(4) - go to 999 - endif -c EHK check for kill file - inquire(file='kill.file',exist=die) - if(die) goto 170 - end do - -c ******************* end major time step loop **************** - -c**** write solution to plot tapes **** - - l = l - 1 - - 170 continue - -c check for steady state solution - if(isteady.ne.0) then - ntty = 2 - call steady(3,dabs(inflow_thstime),dabs(inen_thstime)) - endif - -c...... s kelkar nov 13, 02........ -c if freez_time is gt.0, then ptrac3 is called only at the end of the -c flow calculations, and for a velocity frozen at that time, -c particle tracks are calculated for freez_time days - if(sptrak) then - if(freez_time.gt.0.) then - call ptrac3 - endif - endif -c................................................ - - if(sptrak) then - close(isptr1) - close(isptr2) - close(isptr3) - if (pod_flag) then -! Call to write out derivatives for model reduction basis functions - call pod_derivatives - end if - endif -c call subsidence for last time, iflg = 2 - call subsidence(2) - -c -c gaz 1-6-2002 -c printout submodel boundary conditions if necessary -c - if(isubbc.ne.0) call submodel_bc(2) -c -c For a rip simulation, write avs output info every -c contim_rip days - if(tims.ge.contr_riptot .and. ripfehm .ne. 0) then - contr_riptot = contr_riptot + contim_rip -! if(contim.ge.0) then - call contr (1) - call contr (-1) - call river_ctr(6) - call active_nodes_ctr(4) -! else -! call contr_days (1) -! call contr_days (-1) -! endif - end if - - if(die) then - if (iout .ne. 0) then - write(iout, '(a40)') 'Kill file present; simulation terminated' - endif - if (iptty .gt. 0) then - write(iptty, '(a40)')'Kill file present; simulation terminated' - endif - endif - - if (iout .ne. 0) write(iout, 6040) days, l - if (iptty .gt. 0) write(iptty, 6040) days, l - 6040 format(//, 1x, 'simulation ended: days ', 1pg30.23, - * ' timesteps ', i5) - -c -c calculate final stress field and displacements -c output contour information -c - if(istresscall.eq.0.and.ihms.eq.-4)then - istrs_coupl = -2 - endif - - call stress_uncoupled(2) - -c zvd 30-Jun-10 -c Move call to disk_write and contr after call to stress_uncoupled - nsave = 1 - - if (.not. ex) then - if(in(1).eq.0) then - if( tscounter .eq. 1 .or. in(1) .eq. 0 - 2 .or. tims .eq. tims_save) then - if (allocated(itc) .and. nicg .gt. 1) then - if (itc(nicg-1).gt.0) then -! call disk (nsave) - if (isave .ne. 0) call diskwrite - if(isalt.ne.0) call saltctr(21,0,0.0d00,0.0d00) - if (iflxn .eq. 1) call flxn - endif - else -! call disk (nsave) - if (isave .ne. 0) call diskwrite - if(isalt.ne.0) call saltctr(21,0,0.0d00,0.0d00) - if (iflxn .eq. 1) call flxn - end if -! if(contim.ge.0) then - if(istrs_coupl.ne.-2.and.istrs_coupl.ne.-1) then -! contr will be called below in stress_uncoupled for a stress solution -c contr was called in stress_uncoupled above - call contr (1) - call contr (-1) - end if - call river_ctr(6) - call active_nodes_ctr(4) -! else -! call contr_days (1) -! call contr_days (-1) -! endif - istea_pest = 0 - call pest(1) -c **** call pest to calculate sensitivities if necessary - call pest(2) - end if - end if - end if -c New convention is to make days the - of its value to -c write to the output history file, then change it back -c after calling plot. days needs to be correct if the -c code is being called in "rip" mode - - days = -days -c - if (hist_flag) then - call plot_new (1, dabs(tinfl), dabs(teinfl), - & dabs(inflow_thstime), dabs(inen_thstime)) -! Add call to plot_new so all dummy variables will be deallocated -! after final history data is output - call plot_new (2, dabs(tinfl), dabs(teinfl), - & dabs(inflow_thstime), dabs(inen_thstime)) - if(istrs.ne.0) call stressctr(14,0) - else - call plot (1, tmavg, pravg) - end if - -c Change it back - - days = -days - - if (iout .ne. 0) write(iout, 6041) itotal,itotals - if (iptty .gt. 0) write(iptty, 6041) itotal,itotals - 6041 format(//, 1x, 'total N-R iterations = ', i10 - & ,/,1x, 'total solver iterations = ', i10) - - if (iout .ne. 0) write(iout, 6042) tyming(caz) - tasii - if (iptty .gt. 0) write(iptty, 6042) tyming(caz) - tasii - 6042 format(//, 1x, 'total code time(timesteps) = ', f13.6) - - call dated (jdate, jtime) - - if (iout .ne. 0) write(iout, 6052) verno, jdate, jtime - if (iptty .gt. 0) write(iptty, 6052) verno, jdate, jtime - if (ripfehm .eq. 0) then - close (inpt) - if (iout .ne. 0) close (iout) - end if - 6052 format(//, 1x, '****----------------------------------------', - * '-----------------****', - * /, 1x, '**** This program for ', 35x, ' ****', - * /, 1x, '**** Finite Element Heat and Mass Transfer ', - * 'in porous media ****', - * /, 1x, '****-------------------------------------------', - * '--------------****', - * /, 1x, '**** ', 12x, ' Version : ', a30, ' ****', - * /, 1x, '**** ', 12x, ' End Date : ', a11, 18x, ' ****', - * /, 1x, '**** ', 12x, ' Time : ', a8, 20x, ' ****', - * /, 1x, '****-------------------------------------------', - * '--------------****') - -c Add call to routine to transfer particle information to out(i) -c array for rip simulations - - if(n_input_arguments .ne. 0) then - if(int(in(n_input_arguments+1)).ne.0 - 2 .and.int(in(n_input_arguments+4)).ne.0) - 3 call loadoutarray - end if - -c RJP 04/10/07 this is for co2 properties table look-up - call interpolation_arrays_deallocate() -c -c gaz 031314 split hexes into tets -c - if (sv_hex_tet.and.ns.eq.8) then - rewind incoor - call incoord - ivf_sv = ivf - ivf = -1 - call split(0) - ivf = ivf_sv - endif -c -c no more method = 4 -c elseif(method.eq.4) then - -c routine computes fluid flux values exiting each output buffer -c Routine no longer needed. These are computed in part_track -c and stored in the array idflux - -c call computefluxvalues - -c End if around the part of code for performing the simulation - else - continue - end if - -c Add statement to set return flag - -c For the RIP version, set so that no error -c is passed back to rip - state = 0 - - return - - contains - -c Subroutine riptime - scope is local to fehmn - - subroutine riptime - implicit none - logical used - real(8) daystmp - integer ncall, ichloc - character*23 string_call - character*10 ffname - character*5 ch5 - - wtrise_flag = .false. - if(in(1).ne.0.) then - tims = abs(in(1))*365.25 - -c Read in new flow field if the input flag has changed from the -c Previous time step - -c if(int(in(2)).ne.flowflag) then -c*** water table rise modification - if( (int(in(2)).ne.flowflag) .or. - & (abs(in(7)-water_table_old).gt.1.d-6) ) then -c*** water table rise modification - -c Flag adjusted to tell particle tracker that new -c flow field is being read in - - tscounter = -tscounter - -c*** water table rise modification -c zvd 21-Jul-08 Always make water table adjustment when a new flow -c field is read - water_table = in(7) - wtrise_flag = .true. -c*** water table rise modification - -c Define file name except for the number - - ffname = 'ff .ini' - -c Create number such that 1 is 10001, 2 is 10002, etc. - - ncall = int(in(2)) + 10000 -c Write then number to ch5 character string - - write(ch5,'(i5)') ncall -c Place the number in the empty space of ffname, one -c character at a time. Start w/ digit 2, so that the -c file name for #1 is ff00001.ini, etc. - - do ichloc = 2, 5 - ffname(1+ichloc:1+ichloc)=ch5(ichloc:ichloc) - end do - - if (iptty .gt. 0) write(iptty,*) - 2 'Reading a new restart file: ', ffname - write(iptty,*) - 2 'Reading a new restart file: ', ffname - - -c Check to see if file is already open, if so get file -c number and rewind file - - used = .false. - inquire(file=ffname,opened=used) - if(used) then - inquire(file=ffname, number = iread) - rewind (iread) - else - - - do i = 1,80 - filename(i:i) = ' ' - end do - do i = 1, 10 - filename(i:i) = ffname(i:i) - end do - iread = open_file(filename,'old') - - - end if - nmfil(6) = '' - nmfil(6) = ffname - - daystmp = days -! call disk(0) - if (iread .gt. 0) call diskread - days = daystmp -! zvd 22-Mar-02 -! File is now closed after data is read in call disk(0) -! close(iread) - - - end if - elseif(in(3).ne.0) then -c bhl 2005 -c Read in new flow field if the input flag has changed from the -c Previous time step - -c if(int(in(2)).ne.flowflag) then -c*** water table rise modification - if( (int(in(2)).ne.flowflag) .or. - & (abs(in(7)-water_table_old).gt.1.d-6) ) then -c*** water table rise modification - write(ierr,*)'in(2):',in(2) - write(ierr,*)'flowflag:',flowflag - - -c Flag adjusted to tell particle tracker that new -c flow field is being read in - - tscounter = -tscounter - -c*** water table rise modification - if(abs(in(7)-water_table_old).gt.1.d-6) then - water_table = in(7) - wtrise_flag = .true. - else - wtrise_flag = .false. - end if -c*** water table rise modification - -c Define file name except for the number - - ffname = 'ff .ini' - -c Create number such that 1 is 10001, 2 is 10002, etc. - - ncall = int(in(2)) + 10000 -c Write then number to ch5 character string - - write(ch5,'(i5)') ncall -c Place the number in the empty space of ffname, one -c character at a time. Start w/ digit 2, so that the -c file name for #1 is ff00001.ini, etc. - - do ichloc = 2, 5 - ffname(1+ichloc:1+ichloc)=ch5(ichloc:ichloc) - end do - - if (iptty .gt. 0) write(iptty,*) - 2 'Reading a new restart file: ', ffname - write(iptty,*) - 2 'Reading a new restart file: ', ffname - - -c Check to see if file is already open, if so get file -c number and rewind file - - used = .false. - inquire(file=ffname,opened=used) - if(used) then - inquire(file=ffname, number = iread) - rewind (iread) - else - - - do i = 1,80 - filename(i:i) = ' ' - end do - do i = 1, 10 - filename(i:i) = ffname(i:i) - end do - iread = open_file(filename,'old') - - - end if - nmfil(6) = '' - nmfil(6) = ffname - - - daystmp = days -! call disk(0) - if (iread .gt. 0) call diskread - days = daystmp -! zvd 22-Mar-02 -! File is now closed after data is read in call disk(0) -! close(iread) - - - end if - -c bhl 2005 -c tims = overf -c We are here if it is a GoldSim run and in(1) = 0 -c Here we want the code to take a very small time step, essentially -c zero. This is done by the user setting a low value of daymin -c in the ctrl macro - tims = daymin -c Run batch file on first timestep - if(abs(tscounter).eq.1) then - string_call(1:14) = 'fehmn_ts0.bat ' - - ncall = int(in(2)) + 10000 - -c Write then number to ch5 character string - - write(ch5,'(i5)') ncall -c Place the number in the empty space of string, one -c character at a time. Start w/ digit 15 - - do ichloc = 2, 5 - string_call(13+ichloc:13+ichloc)=ch5(ichloc:ichloc) - end do - string_call(19:19) = ' ' - -c Do the same with in(3) - - ncall = int(in(3)) + 10000 - -c Write then number to ch5 character string - - write(ch5,'(i5)') ncall -c Place the number in the empty space of string, one -c character at a time. Start w/ digit 20 - - do ichloc = 2, 5 - string_call(18+ichloc:18+ichloc)=ch5(ichloc:ichloc) - end do - - - if(iptty.ne.0) then - write(iptty,*) 'Running fehmn_ts0.bat' - write(iptty,*) - 2 'Calling arguments are ', - 3 string_call(15:18),' ',string_call(20:23) - end if - call system(string_call(1:23)) - end if - end if - return - end subroutine riptime -c Subroutine loadoutarray - scope is local to fehmn - - subroutine loadoutarray - implicit none - real*8, allocatable :: out_save(:) - real*8, allocatable :: time_dump(:) - integer ispecies - integer number_of_species - integer ns2,izones - integer nflow_frac, number_of_zones,indexout,indexmzone - integer add_spots, add_spots2 - integer index_temp - real*8 cur_time, prev_time, del_time - real*8 :: cur_time_save = 0. - save out_save, time_dump, cur_time_save - -cHari 3/1/07 -c Before V 2.23, in(4) was the correct index, but now it is -c in(8) because two random number seeds, a flag, and the -c water table elevation were added to the interface before M_fine -c Now, M_fine is in(8). The number added to get to index_N_large -c is now 9 instead of 5 -c BAR 2-9-2005 - - index_N_large=int(in(8))*2+9 - -c As of V 2.23, we now use a flag to decide whether there are -c nflow_frac inputs of fracture fractional flow data to -c handle, or if the array skips that input and proceeds -c directly to number_of_species. This flag is used in the -c if block below. BAR 2-9-2005 - - if(int(in(6)).eq.1) then -c flow fraction data exists - index_temp = index_N_large+int(in(index_N_large))+1 - nflow_frac = int(in(index_temp)) - index_in_species=index_N_large+int(in(index_N_large))+ - 2 nflow_frac+2 - number_of_species = int(in(index_in_species)) - else -c no flow fraction data - index_in_species=index_N_large+int(in(index_N_large))+1 - number_of_species = int(in(index_in_species)) - end if -c index_in_species=index_N_large+int(in(index_N_large))+1 -c number_of_species = int(in(index_in_species)) -CHari if number of species is > 45 then we assume that flow -CHari fractions are in use and we are really being passed nspecies*nlarge - -c if(number_of_species.gt.45)then -c nflow_frac = number_of_species -c index_in_species=index_N_large+int(in(index_N_large))+ -c 2 nflow_frac+2 -c number_of_species = int(in(index_in_species)) -c endif - index_in_flag=index_in_species+1 - index_out_buffer=index_in_flag+2 - number_of_outbuffers = int(in(index_out_buffer)) - - -c Number of output buffers is the total number -c The water table is split into zones, and for -c dual perm. problems there is a fracture and matrix -c exit buffer for each zone. Therefore, rip will pass -c the total number of buffers, and we divide by 2 to -c get the number of output zones - - if(idpdp.ne.0) then - number_of_zones = number_of_outbuffers/2 - else - number_of_zones = number_of_outbuffers - end if - -c Allocate local array that saves the previous out array -c time_dump is the time at which the previous particles from -c this region have been dumped to the out array - - if(.not.allocated(out_save)) then - allocate(out_save(number_of_outbuffers*number_of_species)) - allocate(time_dump(number_of_outbuffers*number_of_species)) - out_save = 0 - time_dump = 0 - end if - -c cur_time = current time in years -c prev_time = time at previous time step (years) - - - cur_time = days/365.25 - del_time = dtot/(365.25*86400.) - prev_time = cur_time - del_time - -c Reinitialize the out_save and time_dump arrays -c when a new realization is initiated (i.e. the cur_time -c "clock" is reset to a low value - - if(cur_time_save.gt.cur_time) then - out_save = 0 - time_dump = 0 - end if - cur_time_save = cur_time - - - if(out_flag.eq.0) then - add_spots = 0 - indexout = 0 - else - add_spots = 2*number_of_outbuffers*number_of_species - add_spots2 = number_of_outbuffers*number_of_species - indexout = add_spots - end if - - do izones = 1, number_of_zones - -c Buffer associated with the fractures is done in the loop below - - do ispecies = 1, number_of_species - indexout = indexout+1 - out(indexout)=0. - if(ispecies <= nspeci)then - -c if block makes sure time_dump is set properly if this is the first -c time step in a realization other than the first realization - - if(tscounter.eq.1) then - time_dump(indexout-add_spots) = prev_time - end if - -c This if block checks that at least 2 particles have exited since -c the last time particles have exited the system. If they have, -c out array is updated and the dump time is set to the current time -c The normal conversion to grams is gmol*pcount. This new -c method accounts for the gradual trickling out of particles by -c multiplying this value by del_time/(cur_time-time_dump(indexout)) -c to account for the exiting of two particles over more than a single -c time step. The out value remains at the previous value until at -c least 2 particles have left, then computes the average mass exiting -c at the time step. - -c In part_track, the pcount value only gets reset when 2 particles -c have accumulated in the exit bin. - - - !per the request of Dave Sevougian, cli removed the smoothing scheme implement - !below. - - !cli if(pcount(izones,ispecies).gt.0) then - out(indexout) = del_time*gmol(ispecies)* - 2 pcount(izones,ispecies)/ - 3 (cur_time-time_dump(indexout-add_spots)) - time_dump(indexout-add_spots) = cur_time - !cli else - -c Set output mass to the previous value until at least 2 particles -c have accumulated at the output bin - - !cli out(indexout) = out_save(indexout-add_spots) - !cli added this statement so that we do not smear the first non-zero mass output - !cli if(out(indexout).eq.0.)then - !cli time_dump(indexout-add_spots) = cur_time - !cli end if - !cli end if - -c Store new value of out in the out_save array - - out_save(indexout-add_spots) = out(indexout) - endif - -c If output for max and avg concentration are to be passed back, -c do that here - - if(out_flag.ne.0) then -c average concentration - out(indexout-add_spots) = idcavg(izones,ispecies) - -c maximum concentration - out(indexout-add_spots2) = idcmax(izones,ispecies) - - end if - - end do - - - - if(idpdp.ne.0) then -c Buffer associated with the matrix is done in the loop below -c First, compute the index of the pcount array corresponding to -c the matrix exiting particles. For this, we need to realize that -c the first (number_of_zones+1) are the fracture data. The 1 -c is because the remaining particles not leaving any of the zones -c are in the pcount array also. However, these are not passed -c through in the out array in this version of the code. - - indexmzone = number_of_zones+1+izones - - do ispecies = 1, number_of_species - indexout = indexout+1 - out(indexout)=0. - if(ispecies <= nspeci)then - -c if block makes sure time_dump is set properly if this is the first -c time step in a realization other than the first realization - - if(tscounter.eq.1) then - time_dump(indexout-add_spots) = prev_time - end if - -c See comments above for fracture nodes for an explanation of this -cli removed confactor from the out() calculations because, pcount is -cli already in mols. - - !per the request of Dave Sevougian, cli removed the smoothing scheme - !implemnted. 09-05-03 - - !cli if(pcount(indexmzone,ispecies).gt.0) then - out(indexout) = del_time*gmol(ispecies)* - 2 pcount(indexmzone,ispecies)/ - 4 (cur_time-time_dump(indexout-add_spots)) - time_dump(indexout-add_spots) = cur_time - !cli else - -c Set output mass to the previous value until at least 2 particles -c have accumulated at the output bin - - !cli out(indexout) = out_save(indexout-add_spots) - !cli added this statement so that we do not smear the first non-zro mass output - !cli if(out(indexout).eq.0.)then - !cli time_dump(indexout-add_spots) = cur_time - !cli end if - !cli end if - -c Store new value of out in the out_save array - - out_save(indexout-add_spots) = out(indexout) - endif - -c If output for max and avg concentration are to be passed back, -c do that here - - if(out_flag.ne.0) then -c average concentration - out(indexout-add_spots) = idcavg(indexmzone,ispecies) - -c maximum concentration - out(indexout-add_spots2) = idcmax(indexmzone,ispecies) - - end if - - - end do - end if - - end do - - - return - end subroutine loadoutarray - -c computefluxvalues - passes fluid mass fluxes to rip -c scope is local to fehmn - - subroutine computefluxvalues - - implicit none - real*8 fluxfrac, fluxmat - integer iznum, inode, nmedia, indexarray - integer number_of_zones - -c number_of_outbuffers = int(in(n_input_arguments+4)) - -c Number of output buffers is the total number -c The water table is split into zones, and for -c dual perm. problems there is a fracture and matrix -c exit buffer for each zone. Therefore, rip will pass -c the total number of buffers, and we divide by 2 to -c get the number of output zones - - if(idpdp.ne.0) then - number_of_zones = number_of_outbuffers/2 - nmedia = 2 - else - number_of_zones = number_of_outbuffers - nmedia = 1 - end if - -c zero out all flux values - - out(1:number_of_outbuffers) = 0. - -c We can only do this calculation if the particle tracking -c has begun, otherwise idzone is not yet allocated and -c is undefined - - if(allocated(idzone)) then - -c Loop over each output zone - both fracture and matrix -c fluxes get computed and stored at the same time - - do iznum = 1, number_of_zones - -c indexarray is the position in the out array for the fracture flux -c for this zone. indexarray+1 is the corresponding matrix -c matrix - - indexarray = nmedia*(iznum-1)+1 - -c Need to loop through each node in the modelto see if it is -c in this output zone - - do inode = 1, neq - - if(izonef(inode).eq.idzone(iznum)) then - -c This is one of the fracture output zones - add to flux - - fluxfrac = a_axy(nelmdg(inode)-neq-1) - -c Filter out the extremely large out flows, which denote -c nodes connected to no other nodes in the grid - - if(fluxfrac.lt.1.e8) then - out(indexarray) = out(indexarray) + fluxfrac - 2 * 31557.600 - end if - -c If dual perm., add matrix output flux to the next position in -c the out array - - if(idpdp.ne.0) then - fluxmat = a_axy(nelm(neq+1)-neq-1+ - 2 nelmdg(inode)-neq-1) - if(fluxmat.lt.1.e8) then - out(indexarray+1) = out(indexarray+1) + fluxmat - 2 * 31557.600 - end if - end if - - end if - - end do - - - end do - - end if - return - - end subroutine computefluxvalues - -c Routine called fehmn for GoldSim runs - - subroutine ingold - implicit none - logical more - character(80) single_line - integer print_flag, iread1, iread2 - - used = .true. - iread = 1 - do while(used) - inquire(unit = iread, opened = used) - if(.not.used) then - -c Open file to read - - used = .false. - open(iread,file = 'fehmn_real.bat') - iread1=iread - else - used = .true. - iread = iread + 1 - end if - end do - - used = .true. - iread = 1 - do while(used) - inquire(unit = iread, opened = used) - if(.not.used) then - -c Open file to read - - used = .false. - open(iread,file = 'fehmn_ts0.bat') - iread2=iread - else - used = .true. - iread = iread + 1 - end if - end do - - more = .true. - print_flag = iread1 - do while(more) - read(1,'(a80)',end=1000) single_line - if(single_line(1:4).ne.'ts0') then - write(print_flag,*) single_line - else - print_flag = iread2 - end if - end do - 1000 more = .false. - close(iread1) - close(iread2) - - return - end subroutine ingold - - end subroutine fehmn - diff --git a/src/PC/fehmn_pcx.f b/src/PC/fehmn_pcx.f index bdd0e005..b30b0442 100755 --- a/src/PC/fehmn_pcx.f +++ b/src/PC/fehmn_pcx.f @@ -458,6 +458,7 @@ subroutine fehmn(method, state, ing, out) use comevap, only : evaporation_flag use comfi, only : qtc, qtotc, pci, pcio use comflow, only : a_axy + use comii, only : pmin,pmax,tmin,tmax use compart use comriv use comrtd, only : maxmix_flag @@ -473,8 +474,12 @@ subroutine fehmn(method, state, ing, out) use comfem, only : edgeNum1, NodeElems, ifem, flag_element_perm use comfem, only : fem_strain, conv_strain, conv_pstrain use property_interpolate +c gaz 121117 added new interpolation for water + use property_interpolate_1 + c added combi and comflow to get izonef and a_axy arrays c in subroutine computefluxvalues + implicit none c These are PC attributes used as compiler directives. They @@ -524,9 +529,7 @@ subroutine fehmn(method, state, ing, out) integer :: is_ch_t = 0 integer :: out_flag = 0 integer ntty_save -c -c gaz debug 121415 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -c + real*8 rel_hum,qin,qin_ng,qin_h2o,qin_enth,enth_avg,pl_dum save flowflag, ichk, tassem, tasii, tscounter, @@ -626,16 +629,20 @@ subroutine fehmn(method, state, ing, out) call write_copyright (6) call iofile (ichk) -c**** initialize/set parameter values +c**** initialize/set parameter values (this routine calls scanin) call setparams c**** allocate memory **** if(irun.eq.1) call allocmem - c**** call data initialization routine **** +c gaz debug 032318 + if(i.eq.-999) then + i = node_model(1) + endif call data - +c c**** call co2_properties_interpolation_lookup_table RJP 04/09/07 +c if (icarb .ne. 0) then inquire(file=nmfil(29), exist=intfile_ex) if(.not.intfile_ex) then @@ -654,13 +661,47 @@ subroutine fehmn(method, state, ing, out) call read_interpolation_data(ifail,nmfil(29)) - end if + endif +c read h2o_property table +c**** call h2o_properties_interpolation_lookup_table GAZ 103115 + if(iwater_table.ne.0) then + inquire(file=nmfil(31), exist=intfile_ex) + if(.not.intfile_ex) then + write(ierr, 7010) trim(nmfil(31)) + write(ierr, 7012) + if (iout .ne. 0) then + write(iout, 7010) trim(nmfil(31)) + write(iout, 7012) + end if + if (iptty .ne. 0) then + write(iptty, 7010) trim(nmfil(31)) + write(iptty, 7012) + end if + stop + endif + call read_interpolation_data_1(ifail,nmfil(31),tmin(1), + & tmax(1),pmin(1),pmax(1)) + endif 6010 format('CO2 Properties Interpolation Table File not found: ', & /, a, /, 'Stopping') 6012 format('Input correct name in control file using, co2in : ', & 'filename') + 7010 format('H2O Properties Interpolation Table File not found: ', + & /, a, /, 'Stopping') + 7012 format('Input correct name in control file using, h2oin : ', + & 'filename') + if(icarb.ne.0) then + if(iout.ne.0) write(iout, 6200) nmfil(29) + if(iptty.ne.0) write(iptty, 6200) nmfil(29) + endif + if(iwater_table.ne.0) then + if(iout.ne.0) write(iout, 6300) nmfil(31) + if(iptty.ne.0) write(iptty, 6300) nmfil(31) + endif + 6200 format(/,'>>> co2 property interpolation table -',3x, a100) + 6300 format(/,'>>> h2o property interpolation table -',3x, a100) c**** read and write data **** in3save = in(3) if(in(3).eq.0) then @@ -669,6 +710,16 @@ subroutine fehmn(method, state, ing, out) call infiles(in(3)) if (nriver .ne. 0) call river_ctr(33) + +c gaz 110715 +c +c gaz new allocate an if ngas enabled (031515) +c this is so salt vapor lowering can be consistent with psatl +c +c gaz 121217 commented out (did not exist in LANL version +c deallocate(an) +c allocate(an(max(n0,nspeci*n0))) + in(3) = in3save c**** modify gravity to reflect vector value **** @@ -689,12 +740,19 @@ subroutine fehmn(method, state, ing, out) c**** call startup calculations **** call startup (tajj, tasii) c moved flow_boundary_conditions(3) from above(could be dangerous!) - call flow_boundary_conditions(3) + call flow_boundary_conditions(3) +c call sx_combine to break connections to fixed type BCs +c gaz 090618 + if(ianpe.eq.0) then + if (irun.eq.1.and.inobr.eq.0) call sx_combine(1) + else + if (irun.eq.1.and.inobr.eq.0) call sx_combine_ani(1) + endif c**** call to set up area coefficients for md nodes call md_nodes(6,0,0) c**** call data checking routine **** call datchk -c**** initial active base variables if necessarhy +c**** initial active base variables if necessary call active_nodes_ctr(-1) c gaz 050809 moved to startup c calculate initial stress field and displacements @@ -1093,10 +1151,12 @@ subroutine fehmn(method, state, ing, out) nphase_liq = 0 nphase_2 = 0 nphase_gas = 0 + nphase_sc = 0 do i=1,n if(ieos(i).eq.1) nphase_liq = nphase_liq + 1 if(ieos(i).eq.2) nphase_2 = nphase_2 + 1 if(ieos(i).eq.3) nphase_gas = nphase_gas + 1 + if(ieos(i).eq.4) nphase_sc = nphase_sc + 1 if (irdof .ne. 13 .or. ifree .ne. 0) then if(s(i).lt.1.0.and.so(i).ge.1.0) then is_ch=is_ch +1 @@ -1114,14 +1174,17 @@ subroutine fehmn(method, state, ing, out) dnphase_liq = nphase_liq - nphase_liq_0 dnphase_2 = nphase_2 - nphase_2_0 dnphase_gas = nphase_gas - nphase_gas_0 + dnphase_sc = nphase_sc - nphase_sc_0 else dnphase_liq = 0 dnphase_2 = 0 dnphase_gas = 0 + dnphase_sc = 0 endif nphase_liq_0 = nphase_liq nphase_2_0 = nphase_2 nphase_gas_0 = nphase_gas + nphase_sc_0 = nphase_sc c c call thermo because the solver is overwriting the deni and denei arrays c @@ -1507,7 +1570,7 @@ subroutine fehmn(method, state, ing, out) ! call contr_days (-1) ! endif end if - + if(die) then if (iout .ne. 0) then write(iout, '(a40)') 'Kill file present; simulation terminated' @@ -1609,6 +1672,21 @@ subroutine fehmn(method, state, ing, out) if (iout .ne. 0) write(iout, 6052) verno, jdate, jtime if (iptty .gt. 0) write(iptty, 6052) verno, jdate, jtime +c +c gaz 111216 combine flux and scalar files for soilvision +c + call zone_saved_manage(0,i,im,ja,mi,it_is_open) +c + call zone_saved_manage(2,i,im,ja,mi,it_is_open) +c +c gaz 111216 close and delete zaved zone files +c + call zone_saved_manage(-1,i,im,ja,mi,it_is_open) +c + call zone_saved_manage(3,i,im,ja,mi,it_is_open) + + call zone_saved_manage(4,i,im,ja,mi,it_is_open) +c no more method = 4 if (ripfehm .eq. 0) then close (inpt) if (iout .ne. 0) close (iout) diff --git a/src/add_gdpm.f b/src/add_gdpm.f index cf495b35..0cd326a7 100755 --- a/src/add_gdpm.f +++ b/src/add_gdpm.f @@ -86,6 +86,7 @@ subroutine add_gdpm real*8 length_total, coord_primary real*8 length_cell, length_pri, length_sec, gdpm_len real*8 gdpm_left, gdpm_right + real*8 dis_p, dis_s c Set actual size of neq c gdpm_flag: if nonzero, determines the geometry of the matrix. @@ -441,11 +442,11 @@ subroutine add_gdpm c The corresponding position of the connection from i to c connected_node is nelm(i)+1 - connected_node = nelm(nelm(i)+1) istrw(nelm(connected_node+1)-neq-1) = nposition istrw(nelm(i)-neq) = nposition - +c identify original gridblock volume + sx1save =sx1(connected_node) +sx1(i) c Compute area/distance term, stor in sx array @@ -581,7 +582,7 @@ subroutine gdpm_volume implicit none real*8 delx_low, delx_high, x_centered real*8 r_low, r_high - + real*8 frac_num if(gdpm_flag.eq.6.or.gdpm_flag.eq.4) then c Linear 1-d column model (based on total area) @@ -739,6 +740,10 @@ subroutine gdpm_area implicit none real*8 sumr_gdpm, r_high, r_low, delr_gdpm + real*8 frac_num, tolf + parameter (tolf= 1.d-12) + integer int + c Linear 1-D column model (based on total area) @@ -853,8 +858,85 @@ subroutine gdpm_area end if -c Physical fracture model (model 11) - +c Parallel fracture model for gdkm + else if(gdkm_flag.eq.1) then +c retired :Physical fracture model (model 11) +c gaz 090816 need to retire this model (replaced by gdkm models +c 1,2,3, 0 + if(connected_node.le.neq_primary) then + primary_node = connected_node + imodel = igdpm(primary_node) + if(gdkm_dir(imodel).eq.1) then + length_total = dxrg(primary_node) + elseif(gdkm_dir(imodel).eq.2) then + length_total = dyrg(primary_node) + elseif(gdkm_dir(imodel).eq.3) then + length_total = dzrg(primary_node) + else +c generic fracture model + if(icnl.eq.0) then + length_total = sx1save**(0.333333) + else + length_total = sx1save**(0.5) + endif + endif + if(gdkm_dir(imodel).ne.0) then + length_pri = vfrac_primary(imodel) + delx_gdpm = gdpm_x(imodel,1) +c frac_num = delx_gdpm gaz 031317 + frac_num = max(int(length_total/delx_gdpm+tolf),1) +c A/d for primary-secondary connection is +c Ax = Volume_total/gridblock_length in x dir (Ax = sx1save/length_total) +c Compute sx, stor in sx(iposition,isox) (- sign for FEHM sign convention) +c 1/2 distance primary volume(dis_p) = length_pri*length_total/2 +c 1/2 distance secondary volume(dis_s) = (1.-length_pri)*length_total/2 +c assuming sec volume is centered, divide dis_p again by 2 for the center(2*2 = 4) +c delx_gdpm = gdpm_x(imodel,1) not used as frac spacing (inputs fracture number) + if(frac_num.eq.1.0) then + dis_p = 0.25*length_pri*length_total + dis_s = 0.5*(1.-length_pri)*length_total + else + dis_p = 0.25*length_pri*length_total + + dis_s = 0.5*(1.-length_pri)*length_total + endif +c multiply by 2 because centered secondary volume has 2 area faces +c multiply by frac_num because of added surface area +c this is affected by number of fractures present (length_total/gdpm_x(imodel,1)) +c gaz 042218 + sx(nposition,isox) = -2.*frac_num*(sx1save/length_total)/ + & (dis_p+dis_s) + continue + else +c older generic fracture model - like dpdp + sx1gdpm = sx1(primary_node)*(1.-vfrac_primary(imodel)) + & /vfrac_primary(imodel) +c sx1gdpm = sx1(primary_node)/vfrac_primary(imodel) +c sx1gdpm = sx1(primary_node)*(vfrac_primary(imodel)) +c & /(1.-vfrac_primary(imodel)) +c note that length_total and delx_gdpm are the same (gives dpdp result) + length_total = gdpm_x(imodel,ngdpm_layers(imodel)) + gdpm_counter = 1 +c use older model + delx_gdpm = gdpm_x(imodel,1) +c delx_gdpm = gdpm_x(imodel,1)/2.0 +c gaz debug 031718 +c need to use full volume "sx1(primary_node)/vfrac_primary(imodel)" for symmetry +c sx(nposition,isox) = -sx1gdpm/(delx_gdpm*length_total) + sx(nposition,isox) = -(sx1(primary_node)/vfrac_primary(imodel)) + & /(delx_gdpm*length_total) + endif + if(isoy.eq.1) then + if(icnl.eq.0) then + sx(nposition,isox) = sx(nposition,isox)/3. + else + sx(nposition,isox) = sx(nposition,isox)/2. + end if + else + sx(nposition,isoy) = 0. + sx(nposition,isoz) = 0. + end if + endif else if(gdpm_flag.eq.11) then if(connected_node.le.neq_primary) then primary_node = connected_node @@ -917,7 +999,7 @@ subroutine gdpm_area 2 -gdpm_x(imodel,gdpm_counter-1) end if -c Compute sx, stor in sx(iposition,isox) +c Compute sx, stor in sx(iposition,isox) sx(nposition,isox) = -sx1gdpm/(delx_gdpm*length_total) if(isoy.eq.1) then if(icnl.eq.0) then diff --git a/src/allocmem.f b/src/allocmem.f index 49551d5b..8b9f6646 100755 --- a/src/allocmem.f +++ b/src/allocmem.f @@ -522,7 +522,11 @@ subroutine allocmem endif c*** allocate memory to all arrays in combi *** - allocate(izonef(n0)) + if(gdkm_flag.ne.0) then + allocate(izonef(max(2*neq_primary,neq))) + else + allocate(izonef(n0)) + endif izonef = 0 if(interface_flag.ne.0) then allocate(izonef_itfc(n0)) @@ -582,6 +586,7 @@ subroutine allocmem c ***** COMMON Block place ***** allocate(pcpnt(ncpnt),pimm(nimm),pvap(nvap)) c ***** COMMON Block print_flag ***** +c allocate(cpntprt(ncpnt),cplxprt(101:ncplx+100)) allocate(cpntprt(ncpnt+nimm),cplxprt(101:ncplx+100)) allocate(immprt(nimm),vapprt(nvap)) c ***** COMMON Block chem_name ***** @@ -688,7 +693,9 @@ subroutine allocmem allocate(pflow(n0)) allocate(phi(n0)) allocate(pho(n0)) - if (idoff .ne. -1) then +c gaz 021517 (added just in case of soilvision combining of countour files) + sv_combine = .true. + if (idoff .ne. -1 .or. sv_combine ) then if (irdof .ne. 13 .or. ifree .ne. 0) then allocate(pnx(n3)) allocate(pny(n3)) @@ -730,6 +737,9 @@ subroutine allocmem allocate(t(n0)) allocate(cpr(n0)) allocate(denr(n0)) +c gaz 090217 + allocate(urock(n0)) + allocate(durockt(n0)) allocate(denh(n0)) allocate(denj(n0)) c gaz 090515 @@ -757,8 +767,13 @@ subroutine allocmem allocate(volume(n0)) allocate(wellim(n0)) c ***** COMMON Block fddi ***** - allocate(nskw(n0)) - allocate(nskw2(n0)) + if(gdkm_flag.ne.0.and.ngdpmnodes.eq.0) then + allocate(nskw(2*n0)) + allocate(nskw2(2*n0)) + else + allocate(nskw(n0)) + allocate(nskw2(n0)) + endif c ***** COMMON Block fdd1 ***** totcom = nvap+nimm+ncpnt totcomalloc = max(totcom,1) diff --git a/src/anonp.f b/src/anonp.f index 2b560bab..cfa9916a 100755 --- a/src/anonp.f +++ b/src/anonp.f @@ -734,6 +734,8 @@ subroutine anonp real*8 x56, x58, x67, x78, y1, y2, y3, y12, y13, y14, y15, y23 real*8 y34, y37, y45, y46, y56, y58, y67, y78, z1, z2, z3, z12 real*8 z13, z14, z15, z23, z34, z37, z45, z46, z56, z58, z67, z78 +c gaz 051017 + real*8 vol_tol, vol_tol_chk, vol_chk_default integer i, i1, i2, i3, i4, i5, i6, ib, icode, iconn, id integer idiff, ie, ied, ig1, ij, ik, in, in1, in2, incon, int integer iortho, ipiv, is1, is2, isx, iu, j, je, jj, k, kb, kc, kj @@ -742,6 +744,7 @@ subroutine anonp integer nj, nsc, nsl, nslu, nt, ncoef, numgb(8) integer ii, ipivkb, neq_total, n0_save, ipmax, lcnt, lcnt2 integer ib_min, ib_max + parameter (vol_chk_default = 1.e-4) c using storage for a matrix real*8, allocatable :: vole(:) @@ -787,7 +790,7 @@ subroutine anonp n0 = neq_primary endif - tol = 1.e-10 + vol_tol_chk = vol_chk_default c determine if orthogonal elements should be fully connected iconn = 0 @@ -949,7 +952,8 @@ subroutine anonp alen3 = al(x15, y15, z15) vlorth = alen1*alen2*alen3 c compare with calculated volume - if(abs(vlorth-volest)/volest.le.tol) then + vol_tol = (abs(vlorth)-abs(volest))/abs(volest) + if(vol_tol.le.vol_tol_chk) then iorth(ie) = 1 else iorth(ie) = 0 diff --git a/src/avs_io.f b/src/avs_io.f index 7c4def0e..065c03a2 100755 --- a/src/avs_io.f +++ b/src/avs_io.f @@ -889,9 +889,11 @@ subroutine avs_io(inj) else c PHS 4/27/2000 added altc and days to the pass to write_avs_node_con -c gaz 111414 - call write_avs_node_con(icall,npt,neq_primary, - & nspeci,lu,ifdual) +c gaz 111414 and 070118 +c call write_avs_node_con(icall,npt,neq_primary, +c & nspeci,lu,ifdual) + call write_avs_node_con(icall,npt,neq, + & nspeci,lu,ifdual) endif endif diff --git a/src/avsio.f b/src/avsio.f index 7404a588..b79a1e66 100755 --- a/src/avsio.f +++ b/src/avsio.f @@ -151,7 +151,7 @@ module avsio integer ioconcentration,iodisplacement,iohead,ioformat integer iofw,iofh,ioporosity,iosource,iodensity,iocord integer iopermeability,iogeo,iozone,iowt,iokd,iozid,iogrid - integer iocapillary,ioco2,iogdkm,ioheatflux + integer iocapillary,ioco2,iogdkm,iogdkmblank,ioheatflux integer iodisp, iostrain, iostress integer iaroot, timec_flag diff --git a/src/bnswer.f b/src/bnswer.f index c321b643..64f6b80e 100755 --- a/src/bnswer.f +++ b/src/bnswer.f @@ -277,13 +277,13 @@ subroutine bnswer integer iad_min, iad_mult, i real*8 fdum_mult parameter (fdum_mult=1.d02,iad_mult= 100) -c gaz debug - i = l -c - itert=0 + + itert=0 minkt=0 strd=1. iad=0 + mlz_save= 0 +c gaz 110715 mlz = 0 if(g1.lt.0.0) then iad_min = 0 @@ -498,7 +498,7 @@ subroutine bnswer endif if(fdum.le.f0.and.iad.ge.iad_min) goto 2000 - if(mlz.eq.-2) goto 2000 + if(mlz.lt.0) goto 2000 iad=iad+1 itotal=itotal+1 c diff --git a/src/check_rlp.f b/src/check_rlp.f index 6c4f6627..261dff67 100755 --- a/src/check_rlp.f +++ b/src/check_rlp.f @@ -37,6 +37,7 @@ subroutine check_rlp real*8, allocatable :: rvftemp(:) logical :: frac_model = .false. character*100 form_string, title_string + neqtemp = neq if (idpdp .ne. 0) then allocate (stemp(2*neq), ieostemp(2*neq), irlptemp(2*neq)) @@ -49,13 +50,13 @@ subroutine check_rlp end if ndummy = 0 - stemp = s - ieostemp = ieos - irlptemp = irlp - icaptemp = icap - pcptemp = pcp - rlftemp = rlf - rvftemp = rvf + stemp(1:neq) = s(1:neq) + ieostemp(1:neq) = ieos(1:neq) + irlptemp(1:neq) = irlp(1:neq) + icaptemp(1:neq) = icap(1:neq) + pcptemp(1:neq) = pcp(1:neq) + rlftemp(1:neq) = rlf(1:neq) + rvftemp(1:neq) = rvf(1:neq) if (num_sat .eq. 0) then neq = 1 / delta_sat + 1 @@ -150,15 +151,16 @@ subroutine check_rlp end if end do - s = stemp - ieos = ieostemp - irlp = irlptemp - icap = icaptemp - pcp = pcptemp - rlf = rlftemp - rvf = rvftemp neq = neqtemp + s(1:neq) = stemp(1:neq) + ieos(1:neq) = ieostemp(1:neq) + irlp(1:neq) = irlptemp(1:neq) + icap(1:neq) = icaptemp(1:neq) + pcp(1:neq) = pcptemp(1:neq) + rlf(1:neq) = rlftemp(1:neq) + rvf(1:neq) = rvftemp(1:neq) + deallocate (stemp, ieostemp, irlptemp, icaptemp, & pcptemp, rlftemp, rvftemp) close (ishisrlp) diff --git a/src/cntlin.f b/src/cntlin.f index 597833ff..887c6472 100755 --- a/src/cntlin.f +++ b/src/cntlin.f @@ -332,6 +332,8 @@ subroutine cntlin nmfil(28) = filename case ('co2i') nmfil(29) = filename + case ('h2oi') + nmfil(31) = filename case ('look') lookup_file = filename case default diff --git a/src/co2ctr.f b/src/co2ctr.f index 970fe28c..e561ab10 100755 --- a/src/co2ctr.f +++ b/src/co2ctr.f @@ -648,7 +648,14 @@ subroutine co2ctr(iflg) wellima(i) = aiped(i)*1.d06 endif enddo - +c +c gaz new allocate an if ngas enabled (031515) +c this is so salt vapor lowering can be consistent with psatl +c +c gaz 093017 (might need next 2 lines) +c deallocate(an) +c allocate(an(max(n0,nspeci*n0))) + deallocate (aiped) elseif(iflg.eq.6) then diff --git a/src/comai.f b/src/comai.f index ac2ef953..5ea11b3f 100755 --- a/src/comai.f +++ b/src/comai.f @@ -341,6 +341,8 @@ module comai !D4 macroread(20) LOGICAL macro Flag denoting if macro mdno has been read !D4 macroread(21) LOGICAL macro Flag denoting if macro ptrk has been read !D4 macroread(22) LOGICAL macro Flag denoting if macro fper has been read +!D4 macroread(23) LOGICAL macro Flag denoting if macro perm_olivella has been read +!D4 macroread(24) LOGICAL macro Flag denoting if macro den(spatial density) has been read !D4 tpor_flag LOGICAL Flag denoting if tracer porosity has been read !D4 !D4 Global Subprograms @@ -422,7 +424,7 @@ module comai integer time_flag, nhist, glob_flag, icont, istea_pest integer icoef_replace c RJP 12/13/06 added nriver below - integer nstep_save, nriver, nrlp, nei_in, ns_in + integer nstep_save, nriver, nrlp, nei_in, ns_in, i_rlp c ZVD 05/01/07 added form_flag, ishisc, ishiswc c ZVD 08/05/09 added ishisp2, ishisp3, ishiscsl, ishiscsg integer form_flag, ishisc, ishiswc, ishisp2, ishisp3 @@ -462,13 +464,24 @@ module comai integer nrestart_ts c gaz 081415 integer mlz_save - integer nphase_liq, nphase_2, nphase_gas - integer nphase_liq_0, nphase_2_0, nphase_gas_0 + integer nphase_liq, nphase_2, nphase_gas, nphase_sc + integer nphase_liq_0, nphase_2_0, nphase_gas_0 + integer nphase_sc_0 integer dnphase_liq, dnphase_2, dnphase_gas + integer dnphase_sc +c gaz 110715 + integer iwater_table integer :: irun = 0 c gaz 013116 integer iaprf - + logical gdkm_new +c gaz 111216 + integer izone_sv_cnt, num_sv_zones, icflux, icconc + logical sv_combine +c gaz 081117 + integer ivrock +c gaz 100318 + integer initdata_pad real*8 aener, aiaa, am0, amass, ame, an0, asteam real*8 astmo, aw, awc, awt, ay, ayc, contim, day real*8 daycf, daycm, daycmm, daycmx, daycs, dayhf @@ -504,8 +517,9 @@ module comai character* 8 jtime character*11 jdate, flux_flag character*30 verno - character*80 wdd, wdd1 - character*70 salt_read_file, salt_write_file +c gaz 100318 added wdd2 + character*80 wdd, wdd1,wdd2 + character*80 salt_read_file, salt_write_file integer nmacros parameter( nmacros = 60 ) diff --git a/src/combi.f b/src/combi.f index 3ef49307..b555b3bf 100755 --- a/src/combi.f +++ b/src/combi.f @@ -227,7 +227,21 @@ module combi integer, allocatable :: izonefree(:) integer, allocatable :: izonegrad(:) integer, allocatable :: izonesubm(:) +c gaz 102716 saving zones + integer, allocatable :: izonesave(:) + integer, allocatable :: ncord(:) + integer, allocatable :: ncord_inv(:) + integer, allocatable :: elem_temp(:,:) + integer, allocatable :: izonesavenum(:) + character*30, allocatable :: zonesavenames(:) + character*200, allocatable :: contour_flux_files(:) + character*200, allocatable :: contour_conc_files(:) + integer maxsvzone + parameter (maxsvzone = 200) + integer, allocatable :: izonef_itfc(:) +c zone related integers + integer izone_save integer, allocatable :: ka(:) integer, allocatable :: nar(:) integer, allocatable :: nelm(:) @@ -257,6 +271,9 @@ module combi real*8, allocatable :: areat_gdpm(:) integer, allocatable :: iconn_gdkm(:,:) integer, allocatable :: nelm_gdkm(:,:) +c gaz 08102016 + real*8, allocatable :: gdkm_volume_fraction(:) + integer, allocatable :: gdkm_dir(:) real*8, allocatable :: sx(:,:) real*8, allocatable :: sx_primary(:,:) @@ -311,7 +328,7 @@ module combi real*8, allocatable :: itfcprobsize(:,:) integer, allocatable :: nflxc(:) - + integer ik_gdkm_red c c arrays for use with rate-limited processes (gdpm etc) c diff --git a/src/comci.f b/src/comci.f index a6a5d394..4fe775dc 100755 --- a/src/comci.f +++ b/src/comci.f @@ -330,7 +330,8 @@ module comci real*8, allocatable :: comp_spatial(:) real*8, allocatable :: deng_spatial(:) real*8, allocatable :: visg_spatial(:) - +c gaz 100517 + real*8, allocatable :: dva_save(:) c gaz debug 090511 real*8, allocatable :: denei_ch(:) real*8, allocatable :: deni_ch(:) diff --git a/src/comdi.f b/src/comdi.f index 999b8e20..d6d9c4ef 100755 --- a/src/comdi.f +++ b/src/comdi.f @@ -715,6 +715,8 @@ module comdi integer ixperm,iyperm,izperm real*8 fac_sec_days, fac_min_days, fac_year_days real*8, allocatable :: qa(:) +c gaz 111418 added qaxf for air fraction in water + real*8, allocatable :: qaxf(:) real*8, allocatable :: qw(:) real*8, allocatable :: qw0(:) real*8, allocatable :: qco2b(:) @@ -930,5 +932,36 @@ module comdi real*8 por_salt_min real*8 pressure_std,temperature_std parameter(pressure_std = 0.1,temperature_std = 20.0) +c gaz 080817 + real*8 energy_conv + parameter(energy_conv = 1.d-6) + integer ntable_roc + character*200, allocatable :: table_vroc(:) + integer, allocatable :: ivrn(:) + integer, allocatable :: ivroc(:) + integer, allocatable :: itroc(:) + integer, allocatable :: ivrov(:) + integer, allocatable :: ntable_vroc(:) + integer, allocatable :: tblindx_roc(:,:) + real*8, allocatable :: roc_table(:,:) + real*8, allocatable :: temp_table(:,:) + + real*8, allocatable :: vroc1f(:) + real*8, allocatable :: vroc2f(:) + real*8, allocatable :: vroc3f(:) + real*8, allocatable :: vroc4f(:) + real*8, allocatable :: vroc5f(:) + real*8, allocatable :: vroc6f(:) + real*8, allocatable :: vroc7f(:) + real*8, allocatable :: vroc8f(:) + real*8, allocatable :: vroc9f(:) + real*8, allocatable :: dcprt(:) + real*8, allocatable :: ddenrt(:) + + real*8, allocatable :: urock(:) + real*8, allocatable :: durockt(:) +c gaz 111118 +c sk_temp() used in sub thrmwc + real*8, allocatable :: sk_temp(:) end module comdi diff --git a/src/comsi.f b/src/comsi.f index cc13be11..68a06c52 100755 --- a/src/comsi.f +++ b/src/comsi.f @@ -44,6 +44,8 @@ module comsi integer cnum_stress, ilithgrad, permfile integer isNonlinear, Nonlin_model_flag, flag_principal +c gaz 031017 + integer isbiotNonLin integer flag_excess_shear @@ -128,6 +130,9 @@ module comsi c......................................... real*8, allocatable :: bulk(:) real*8, allocatable :: alp(:) +c gaz 042917 added initial thermal and bulk modulus + real*8, allocatable :: bulk0(:) + real*8, allocatable :: alp0(:) real*8, allocatable :: du(:) real*8, allocatable :: dv(:) real*8, allocatable :: dw(:) @@ -377,7 +382,30 @@ module comsi real*8, allocatable :: xtan_min(:) real*8, allocatable :: disp0(:,:) real*8, allocatable :: k_strs91(:,:) - real*8, allocatable :: e_temp91(:,:) +c real*8, allocatable :: e_temp91(:,:) +c gaz 042116 +c + real*8, allocatable :: e_temp91(:,:,:) + real*8, allocatable :: t_non_ref(:) + integer, allocatable :: i_tab_youngs(:) + integer, allocatable :: iy_tab(:) + integer, allocatable :: istr_non_model(:) + integer max_y_tab, n_young_table, nentries_young_max + integer max_non_str, nentries_biot + parameter (max_non_str = 100) + parameter (max_y_tab = 100,nentries_young_max = 10000) +c +c gaz 042116 +c + real*8, allocatable :: biot_temp91(:,:,:) + real*8, allocatable :: biot_t_non_ref(:) + integer, allocatable :: i_tab_biot(:) + integer, allocatable :: iy_tab_biot(:) + integer, allocatable :: istr_non_model_biot(:) + integer max_y_tab_b, n_biot_table, nentries_biot_max + integer max_non_str_biot + parameter (max_non_str_biot = 100) + parameter (max_y_tab_b = 100,nentries_biot_max = 10000) real*8 knx_stressperm, kny_stressperm,knz_stressperm @@ -414,8 +442,10 @@ module comsi real*8, allocatable :: perm_mult3(:) real*8 str25_density(1000) integer str25_N_obs - - + + +c gaz 110517 + real*8 eigenvec(3,3),alambda(3), eigenvec_deg(3) end module comsi diff --git a/src/comxi.f b/src/comxi.f index 6d1ab484..45b9ee8e 100755 --- a/src/comxi.f +++ b/src/comxi.f @@ -191,7 +191,7 @@ module comxi parameter(nmmax = 14) integer nmmaxa - parameter(nmmaxa = 16) + parameter(nmmaxa = 17) integer isw(nmmax+nmmaxa), nufilb(nmmax+nmmaxa) diff --git a/src/coneq1.f b/src/coneq1.f index 23e51cb4..863896c8 100755 --- a/src/coneq1.f +++ b/src/coneq1.f @@ -429,6 +429,9 @@ subroutine coneq1(ndummy, matnum, spec_num) real*8 pnxavg,pnyavg,pnzavg,vmagavg,tolvel,toldisp integer strindex,endindex,sehindexl,sehindexv integer pntr +c gaz 082616 + integer kb_pri + real*8 reduction_factor character*120 fname, root character*7 fsuffix integer iroot @@ -538,8 +541,9 @@ subroutine coneq1(ndummy, matnum, spec_num) newdiff = concadiff(1,mflagl(1,itrcdsp(insp)), & sehdiff(itrcdsp(insp)),ps(i),satr,phi(i),t(i)) endif + dumi = satr*newdiff*ps(i) - +c c c liquid phase calculations c @@ -635,9 +639,24 @@ subroutine coneq1(ndummy, matnum, spec_num) newdiffkb = concadiff(1,mflagl(nsp,itrc(kbnsp)), & diffmfl(nsp,itrc(kbnsp)),ps(kb),satrkb, & phi(kb),t(kb)) - - dumkb = satrkb*newdiffkb*ps(kb) - dum_bar = 2*dumi*dumkb/(dumi+dumkb + toldisp) +c gaz 081116 to 082616 + reduction_factor=red_factor(istrw_itfc(it11(jm))) + + if(gdkm_flag.eq.0) then + dumkb = satrkb*newdiffkb*ps(kb) + dum_bar = 2.*dumi*dumkb/(dumi+dumkb + toldisp) + else if(gdkm_flag.ne.0) then + dumkb = satrkb*newdiff*ps(kb) + if(reduction_factor.gt.2.) then + kb_pri = reduction_factor - 2. +c gaz 051618 always use harmonic weighting +c if(kb_pri.eq.i) dumkb = dumi + reduction_factor= 1.0 + endif + dum_bar = reduction_factor*2.* + & dumi*dumkb/(dumi+dumkb + toldisp) + endif + c------- PHS ---------- 9/3/2004 ----------------------------- kz=kb-icd @@ -739,8 +758,26 @@ subroutine coneq1(ndummy, matnum, spec_num) newdiffkb = concadiff(1,mflagl(nsp,itrc(kbnsp)), & diffmfl(nsp,itrc(kbnsp)),ps(kb),satrkb, & phi(kb),t(kb)) - dumkb = satrkb*newdiffkb*ps(kb) - dum_bar = 2*dumi*dumkb/(dumi+dumkb + toldisp) +c gaz 081116 +c dumkb = satrkb*newdiffkb*ps(kb) + +c gaz 081116 to 082616 + reduction_factor=red_factor(istrw_itfc(it11(jm))) + + if(gdkm_flag.eq.0) then + dumkb = satrkb*newdiffkb*ps(kb) + dum_bar = 2.*dumi*dumkb/(dumi+dumkb + toldisp) + else if(gdkm_flag.ne.0) then + dumkb = satrkb*newdiff*ps(kb) + if(reduction_factor.gt.2.) then + kb_pri = reduction_factor - 2. + if(kb_pri.eq.i) dumkb = dumi + reduction_factor= 1.0 + endif + dum_bar = reduction_factor*2.* + & dumi*dumkb/(dumi+dumkb + toldisp) + endif + c------- PHS ---------- 9/3/2004 ----------------------------- kz=kb-icd neighc=it9(jm) @@ -850,8 +887,10 @@ subroutine coneq1(ndummy, matnum, spec_num) else newdiff = concadiff(2,mflagv(1,itrcdsp(insp)), & sehdiffv(itrcdsp(insp)),ps(i),satr,phi(i),t(i)) - endif - dumi = (1-satr) *newdiff*ps(i) + endif + dumi = (1-satr) *newdiff*ps(i) + + c----------------------------------------------------------------- c @@ -936,8 +975,24 @@ subroutine coneq1(ndummy, matnum, spec_num) newdiffkb = concadiff(2,mflagv(nsp,itrc(kbnsp)), & diffmfv(nsp,itrc(kbnsp)),ps(kb),satrkb, & phi(kb),t(kb)) - dumkb = (1-satrkb)*newdiffkb*ps(kb) - dum_bar = 2*dumi*dumkb/(dumi+dumkb + toldisp) + +c gaz 081116 to 082616 + reduction_factor=red_factor(istrw_itfc(it11(jm))) + + if(gdkm_flag.eq.0) then + dumkb = (1-satr)*newdiffkb*ps(kb) + dum_bar = 2.*dumi*dumkb/(dumi+dumkb + toldisp) + else if(gdkm_flag.ne.0) then + dumkb = (1-satr)*newdiff*ps(kb) + if(reduction_factor.gt.2.) then + kb_pri = reduction_factor - 2. + if(kb_pri.eq.i) dumkb = dumi + reduction_factor= 1.0 + endif + dum_bar = reduction_factor*2.* + & dumi*dumkb/(dumi+dumkb + toldisp) + endif + c----------------------------------------------------------------- kz=kb-icd neighc=it9(jm) @@ -1014,8 +1069,25 @@ subroutine coneq1(ndummy, matnum, spec_num) newdiffkb = concadiff(2,mflagv(nsp,itrc(kbnsp)), & diffmfv(nsp,itrc(kbnsp)),ps(kb),satrkb, & phi(kb),t(kb)) - dumkb = (1-satrkb)*newdiffkb*ps(kb) - dum_bar = 2*dumi*dumkb/(dumi+dumkb + toldisp) + + +c gaz 081116 to 082616 + reduction_factor=red_factor(istrw_itfc(it11(jm))) + + if(gdkm_flag.eq.0) then + dumkb = (1-satr)*newdiffkb*ps(kb) + dum_bar = 2.*dumi*dumkb/(dumi+dumkb + toldisp) + else if(gdkm_flag.ne.0) then + dumkb = (1-satr)*newdiff*ps(kb) + if(reduction_factor.gt.2.) then + kb_pri = reduction_factor - 2. + if(kb_pri.eq.i) dumkb = dumi + reduction_factor= 1.0 + endif + dum_bar = reduction_factor*2.* + & dumi*dumkb/(dumi+dumkb + toldisp) + endif + c----------------------------------------------------------------- kz=kb-icd neighc=it9(jm) diff --git a/src/csolve.f b/src/csolve.f index aa5ccd44..3a0d0828 100755 --- a/src/csolve.f +++ b/src/csolve.f @@ -999,7 +999,10 @@ subroutine csolve(hmon) sehindexv=1 neqp1=neq+1 nmatavw = nelm(neqp1)-neqp1 - if(idualp.eq.0) then +c gaz 100917 + if(gdkm_flag.ne.0) then + nfinal = neq + else if(idualp.eq.0) then nfinal = n0 else nfinal = neq @@ -1561,6 +1564,7 @@ subroutine csolve(hmon) else if (ifinsh .ne. 2 .and. ptime .lt. (last_time + histime) & .and. l .lt. (last_step) +c & .and. l .lt. (last_step + nhist) & .and. iprttrc .lt. nprttrc) then time2print = .FALSE. else diff --git a/src/data.f b/src/data.f index 433a6d48..0fc5df86 100755 --- a/src/data.f +++ b/src/data.f @@ -253,7 +253,14 @@ subroutine data tflag = 0 hflag = 0 eflag = 0 - +c initialize number of saved zones + izone_sv_cnt = 0 + num_sv_zones = 0 +c initialize number of flux countour files + icflux = 0 + icconc = 0 +c initialize soilvision output to false + sv_combine = .false. c initialize character and boolean variables in comai accm = ' ' @@ -322,6 +329,7 @@ subroutine data ivapl = 0 c 23-Feb-12 Default value for thermal conductivity models ivcond = 0 + ivrock = 0 ivf = 1 ivfcal = 0 ithic = 0 @@ -434,6 +442,8 @@ subroutine data dtot = 0.0 dtotc = 0.0 dtotdm = 0.0 +c gaz 100318 + initdata_pad = 0 C new variables in comsplitts dtot_split = 0.0 dtot_next = 0.0 diff --git a/src/dated.template b/src/dated.template index a5b1470c..a916486b 100755 --- a/src/dated.template +++ b/src/dated.template @@ -242,6 +242,6 @@ c write(jtimex,'(i2.2,1h:,i2.2,1h:,i2.2)') jjtime ! Version number passed to GoldSim vernum = 3.3 ! Code version identifier - verno = "FEHM V3.3.1OS DATE QA:QA" + verno = "FEHM V3.3.2OS DATE QA:NA" end diff --git a/src/den_vis_spatial.f b/src/den_vis_spatial.f index 1b43505a..dcfeb664 100755 --- a/src/den_vis_spatial.f +++ b/src/den_vis_spatial.f @@ -106,9 +106,9 @@ subroutine den_vis_spatial(iflg) default(2) = 0. default(3) = 0. igroup = 1 - +c gaz 110418 cmacroread(12) to macroread(24) call initdata2 (inpt, ischk, n0, narrays, itype, - * default, macroread(12), macro, igroup, ireturn, + * default, macroread(24), macro, igroup, ireturn, * r8_1=den_spatial(1:n0),r8_2=vis_spatial(1:n0), * r8_3 =comp_spatial(1:n0)) @@ -121,7 +121,7 @@ subroutine den_vis_spatial(iflg) igroup = 1 call initdata2 (inpt, ischk, n0, narrays, itype, - * default, macroread(12), macro, igroup, ireturn, + * default, macroread(24), macro, igroup, ireturn, * r8_1=deng_spatial(1:n0),r8_2=visg_spatial(1:n0)) c c check if values are physical diff --git a/src/dvacalc.f b/src/dvacalc.f index 1d86d089..559fa294 100755 --- a/src/dvacalc.f +++ b/src/dvacalc.f @@ -216,8 +216,9 @@ subroutine dvacalc real*8 dva0,theta,p0,t0,rat,dratp,dratt,dva0d,dva0p,dva0c,dva0e real*8 t_min, t_max, atort, dratc, temp, temp2, diffcoeff real*8 tort2, dvas_denom_min, dvas_denom, s_dva_term, dva_tiny - real*8, allocatable :: dva_save(:) +c real*8, allocatable :: dva_save(:) real*8 dpsatt,dpsats,pv,dum_dva, psatl + real*8 dva_t integer i parameter(dva0=2.23e-5) parameter(theta=1.810) @@ -225,7 +226,7 @@ subroutine dvacalc parameter(t0=273.15) parameter(t_min=10.0,t_max=350.0) parameter(dvas_denom_min = 1.d-18, dva_tiny = 1.d-18) - save dva_save +c save dva_save if(.not.allocated(dva_save)) allocate (dva_save(n)) if(iadif.ne.0.and.tort.ge.0.0.and.tort.le.1.0) then @@ -238,7 +239,12 @@ subroutine dvacalc c New stuff PHS took out density from rat c now no derivatives wrt density! c dgvc dgvp dgve go away! -c +c gaz 081116 + if(gdkm_flag.eq.0) then + dva_t = dva0 + else + dva_t = dva0*gdkm_volume_fraction(i) + endif if(t(i).ge.t_min.and.t(i).le.t_max) then rat=(p0/phi(i))*((t(i)+t0)/t0)**theta dratp=-rat/phi(i) @@ -257,7 +263,8 @@ subroutine dvacalc dratc=-rat/phi(i) endif c - dva0d=tort*ps(i)*(1.0-s(i))*dva0 +c dva0d=tort*ps(i)*(1.0-s(i))*dva0 + dva0d=tort*ps(i)*(1.0-s(i))*dva_t c c parts of derivatives for ieos=2 TotPres, Temp, GasPres c P E C diff --git a/src/enthp.f b/src/enthp.f index 545c9a52..ca0a06dd 100755 --- a/src/enthp.f +++ b/src/enthp.f @@ -228,6 +228,9 @@ real*8 function enthp(mi,td) real*8 eltb2,eltb3,elptb,elp2tb,elpt2b,x,x2,x3,tl2,tl3,enwn1,enwn2 real*8 enwn3,enwn,enwd1,enwd2,enwd3,enwd,enw real*8 p_energy +c gaz 110715 + real*8 dum1,dumb,dumc,value(9) + integer istate c c calculates enthalpy as a function of t and p c @@ -238,9 +241,12 @@ real*8 function enthp(mi,td) endif psd=ps(mi) cprd=cpr(mi) +c gaz 081317 + cprd=1.0d0 tl=td if(psd.ne.0.0.and.idof.ge.2) then pl=phi(mi) - phi_inc + if(iwater_table.ne.1) then iieosd=iieos(mi) c liquid enthalpy c numerator coefficients @@ -280,6 +286,12 @@ real*8 function enthp(mi,td) enwd=enwd1+enwd2+enwd3 enw=enwn/enwd enthp=enw + p_energy + else +c gaz 110915 (calculates too many variables) + call h2o_properties_new(4,1,pl,tl,dum1,1, + & dumb,value,dumc) + enthp = value(4) + p_energy + endif endif if(psd.eq.0.0.or.idof.le.1) then enthp=cprd*tl diff --git a/src/fehmn.f b/src/fehmn.f index affe3f09..67f1d5b5 100755 --- a/src/fehmn.f +++ b/src/fehmn.f @@ -458,6 +458,7 @@ subroutine fehmn(method, state, ing, out) use comevap, only : evaporation_flag use comfi, only : qtc, qtotc, pci, pcio use comflow, only : a_axy + use comii, only : pmin,pmax,tmin,tmax use compart use comriv use comrtd, only : maxmix_flag @@ -473,8 +474,12 @@ subroutine fehmn(method, state, ing, out) use comfem, only : edgeNum1, NodeElems, ifem, flag_element_perm use comfem, only : fem_strain, conv_strain, conv_pstrain use property_interpolate +c gaz 121117 added new interpolation for water + use property_interpolate_1 + c added combi and comflow to get izonef and a_axy arrays c in subroutine computefluxvalues + implicit none c These are PC attributes used as compiler directives. They @@ -524,9 +529,7 @@ subroutine fehmn(method, state, ing, out) integer :: is_ch_t = 0 integer :: out_flag = 0 integer ntty_save -c -c gaz debug 121415 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -c + real*8 rel_hum,qin,qin_ng,qin_h2o,qin_enth,enth_avg,pl_dum save flowflag, ichk, tassem, tasii, tscounter, @@ -626,16 +629,20 @@ subroutine fehmn(method, state, ing, out) call write_copyright (6) call iofile (ichk) -c**** initialize/set parameter values +c**** initialize/set parameter values (this routine calls scanin) call setparams c**** allocate memory **** if(irun.eq.1) call allocmem - c**** call data initialization routine **** +c gaz debug 032318 + if(i.eq.-999) then + i = node_model(1) + endif call data - +c c**** call co2_properties_interpolation_lookup_table RJP 04/09/07 +c if (icarb .ne. 0) then inquire(file=nmfil(29), exist=intfile_ex) if(.not.intfile_ex) then @@ -654,13 +661,47 @@ subroutine fehmn(method, state, ing, out) call read_interpolation_data(ifail,nmfil(29)) - end if + endif +c read h2o_property table +c**** call h2o_properties_interpolation_lookup_table GAZ 103115 + if(iwater_table.ne.0) then + inquire(file=nmfil(31), exist=intfile_ex) + if(.not.intfile_ex) then + write(ierr, 7010) trim(nmfil(31)) + write(ierr, 7012) + if (iout .ne. 0) then + write(iout, 7010) trim(nmfil(31)) + write(iout, 7012) + end if + if (iptty .ne. 0) then + write(iptty, 7010) trim(nmfil(31)) + write(iptty, 7012) + end if + stop + endif + call read_interpolation_data_1(ifail,nmfil(31),tmin(1), + & tmax(1),pmin(1),pmax(1)) + endif 6010 format('CO2 Properties Interpolation Table File not found: ', & /, a, /, 'Stopping') 6012 format('Input correct name in control file using, co2in : ', & 'filename') + 7010 format('H2O Properties Interpolation Table File not found: ', + & /, a, /, 'Stopping') + 7012 format('Input correct name in control file using, h2oin : ', + & 'filename') + if(icarb.ne.0) then + if(iout.ne.0) write(iout, 6200) nmfil(29) + if(iptty.ne.0) write(iptty, 6200) nmfil(29) + endif + if(iwater_table.ne.0) then + if(iout.ne.0) write(iout, 6300) nmfil(31) + if(iptty.ne.0) write(iptty, 6300) nmfil(31) + endif + 6200 format(/,'>>> co2 property interpolation table -',3x, a100) + 6300 format(/,'>>> h2o property interpolation table -',3x, a100) c**** read and write data **** in3save = in(3) if(in(3).eq.0) then @@ -669,6 +710,16 @@ subroutine fehmn(method, state, ing, out) call infiles(in(3)) if (nriver .ne. 0) call river_ctr(33) + +c gaz 110715 +c +c gaz new allocate an if ngas enabled (031515) +c this is so salt vapor lowering can be consistent with psatl +c +c gaz 121217 commented out (did not exist in LANL version +c deallocate(an) +c allocate(an(max(n0,nspeci*n0))) + in(3) = in3save c**** modify gravity to reflect vector value **** @@ -689,12 +740,19 @@ subroutine fehmn(method, state, ing, out) c**** call startup calculations **** call startup (tajj, tasii) c moved flow_boundary_conditions(3) from above(could be dangerous!) - call flow_boundary_conditions(3) + call flow_boundary_conditions(3) +c call sx_combine to break connections to fixed type BCs +c gaz 090618 + if(ianpe.eq.0) then + if (irun.eq.1.and.inobr.eq.0) call sx_combine(1) + else + if (irun.eq.1.and.inobr.eq.0) call sx_combine_ani(1) + endif c**** call to set up area coefficients for md nodes call md_nodes(6,0,0) c**** call data checking routine **** call datchk -c**** initial active base variables if necessarhy +c**** initial active base variables if necessary call active_nodes_ctr(-1) c gaz 050809 moved to startup c calculate initial stress field and displacements @@ -1093,10 +1151,12 @@ subroutine fehmn(method, state, ing, out) nphase_liq = 0 nphase_2 = 0 nphase_gas = 0 + nphase_sc = 0 do i=1,n if(ieos(i).eq.1) nphase_liq = nphase_liq + 1 if(ieos(i).eq.2) nphase_2 = nphase_2 + 1 if(ieos(i).eq.3) nphase_gas = nphase_gas + 1 + if(ieos(i).eq.4) nphase_sc = nphase_sc + 1 if (irdof .ne. 13 .or. ifree .ne. 0) then if(s(i).lt.1.0.and.so(i).ge.1.0) then is_ch=is_ch +1 @@ -1114,14 +1174,17 @@ subroutine fehmn(method, state, ing, out) dnphase_liq = nphase_liq - nphase_liq_0 dnphase_2 = nphase_2 - nphase_2_0 dnphase_gas = nphase_gas - nphase_gas_0 + dnphase_sc = nphase_sc - nphase_sc_0 else dnphase_liq = 0 dnphase_2 = 0 dnphase_gas = 0 + dnphase_sc = 0 endif nphase_liq_0 = nphase_liq nphase_2_0 = nphase_2 nphase_gas_0 = nphase_gas + nphase_sc_0 = nphase_sc c c call thermo because the solver is overwriting the deni and denei arrays c @@ -1507,7 +1570,7 @@ subroutine fehmn(method, state, ing, out) ! call contr_days (-1) ! endif end if - + if(die) then if (iout .ne. 0) then write(iout, '(a40)') 'Kill file present; simulation terminated' @@ -1609,6 +1672,21 @@ subroutine fehmn(method, state, ing, out) if (iout .ne. 0) write(iout, 6052) verno, jdate, jtime if (iptty .gt. 0) write(iptty, 6052) verno, jdate, jtime +c +c gaz 111216 combine flux and scalar files for soilvision +c + call zone_saved_manage(0,i,im,ja,mi,it_is_open) +c + call zone_saved_manage(2,i,im,ja,mi,it_is_open) +c +c gaz 111216 close and delete zaved zone files +c + call zone_saved_manage(-1,i,im,ja,mi,it_is_open) +c + call zone_saved_manage(3,i,im,ja,mi,it_is_open) + + call zone_saved_manage(4,i,im,ja,mi,it_is_open) +c no more method = 4 if (ripfehm .eq. 0) then close (inpt) if (iout .ne. 0) close (iout) diff --git a/src/flow_boun.f b/src/flow_boun.f index 148213f4..8342d6e9 100755 --- a/src/flow_boun.f +++ b/src/flow_boun.f @@ -249,7 +249,7 @@ subroutine flow_boun(iz,n,ico2,idof c c node_model - model number for each node c - use comai, only : boun_out + use comai, only : boun_out, neq_primary use combi use comci use comdi @@ -736,8 +736,6 @@ subroutine flow_boun(iz,n,ico2,idof endif enddo -c calculate uppermost node - do i=1,n iimodel=node_model(i) if(iimodel.gt.0) then @@ -922,11 +920,17 @@ subroutine flow_boun(iz,n,ico2,idof & imodel) endif endif - if(iqa.ne.0.or.ixa.ne.0) then + if(iqa.ne.0) then if(sourcea_type(imodel).gt.0) then qa(i)=sourcea(abs(time_type(imodel)),imodel) endif endif +c gaz 111418 need separate arrays for "air fraction of sw" and "sa" : uses lt.0 + if(ixa.ne.0) then + if(sourcea_type(imodel).lt.0) then + qaxf(i)=sourcea(abs(time_type(imodel)),imodel) + endif + endif if(iha.ne.0) then if(humid_type(imodel).lt.0) then huma(i)=-humid(abs(time_type(imodel)),imodel) diff --git a/src/flow_boundary_conditions.f b/src/flow_boundary_conditions.f index 7248eeba..6eebf033 100755 --- a/src/flow_boundary_conditions.f +++ b/src/flow_boundary_conditions.f @@ -88,7 +88,7 @@ subroutine flow_boundary_conditions(iflg) integer, allocatable :: idum(:) real*8 days0,qair,qwat - real*8 t_hum,p_hum + real*8 huma_temp, t_hum, p_hum C real*8 sdum,pdum,denhdum,denehdum real*8 denhold,denehold,diffmass,diffener real*8 qa_temp, pf_temp @@ -103,6 +103,7 @@ subroutine flow_boundary_conditions(iflg) c if (.not. allocated (node_model)) allocate(node_model(n0)) node_model = 0 + if (.not. allocated (min_model)) & allocate(min_model(maxmodel)) min_model = 0 @@ -131,7 +132,7 @@ subroutine flow_boundary_conditions(iflg) fac_sec_days = 1./86400. fac_min_days = 1./1440. fac_year_days = 365.25 - if(iqa.ne.0.or.ixa.ne.0) then + if(iqa.ne.0) then if (.not. allocated (qa)) allocate(qa(n0)) if (.not. allocated (sourcea)) . allocate(sourcea(maxtimes,maxmodel)) @@ -141,6 +142,17 @@ subroutine flow_boundary_conditions(iflg) sourcea = 0.0d00 sourcea_type = 0 endif +c gaz 111418 add coding for qaxf(air fraction in water flowrate) + if(ixa.ne.0) then + if (.not. allocated (qaxf)) allocate(qaxf(n0)) + if (.not. allocated (sourcea)) + . allocate(sourcea(maxtimes,maxmodel)) + if (.not. allocated (sourcea_type)) + . allocate(sourcea_type(maxmodel)) + qaxf = 0.0d00 + sourcea = 0.0d00 + sourcea_type = 0 + endif if(iqf.ne.0) then if (.not. allocated (qw)) allocate(qw(n0)) if (.not. allocated (qw0)) allocate(qw0(n0)) @@ -194,7 +206,7 @@ subroutine flow_boundary_conditions(iflg) sourceco2_type = 0 endif if(iqenth.ne.0) then - if (.not. allocated (qenth)) allocate(qenth(n0)) + if (.not. allocated (qenth)) allocate(qenth(n0)) if (.not. allocated (sourcee)) . allocate(sourcee(maxtimes,maxmodel)) if (.not. allocated (sourcee_type)) @@ -257,6 +269,8 @@ subroutine flow_boundary_conditions(iflg) if (.not. allocated (huma)) allocate(huma(n0)) if (.not. allocated (xnva)) allocate(xnva(n0)) if (.not. allocated (entha)) allocate(entha(n0)) + if (.not. allocated (phuma)) allocate(phuma(n0)) + if (.not. allocated (thuma)) allocate(thuma(n0)) if (.not. allocated (humid)) . allocate(humid(maxtimes,maxmodel)) if (.not. allocated (humid_type)) @@ -422,9 +436,9 @@ subroutine flow_boundary_conditions(iflg) macro = "boun" igroup = 1 call initdata2( inpt, ischk, n0, narrays, - 2 itype, default, macroread(7), macro, igroup, ireturn, + 2 itype, default, macroread(24), macro, igroup, ireturn, 3 i4_1=idum(1:n0) ) - macroread(7) = .TRUE. + macroread(24) = .TRUE. do i=1,n0 if(idum(i).ne.0) then node_model(i)=idum(i)+mmodel_old @@ -480,17 +494,21 @@ subroutine flow_boundary_conditions(iflg) & ,inpt,iptty,iout,ierr,l,igrav,ihead) do i=1,n if(idum(i).ne.0) then - if(iqenth.ne.0) then - if(qenth(i).ne.0.0) then +c gaz 113018 added "if(iqenth.ne.0) then " to avoid unallocated arrays + if(iqenth.ne.0.or.itempb.ne.0) then + if(iqenth.ne.0) then + if(qenth(i).ne.0.0) then qflux(i)=qenth(i) qflxm(i)= 0.0 - endif - else if(itempb.ne.0) then - if(tempb(i).gt.0.0) then + endif + endif + if(itempb.ne.0) then + if(tempb(i).gt.0.0) then qflux(i)=tempb(i) qflxm(i)= sx1(i) if(wellim(i).ne.0.0) qflxm(i)=wellim(i) - endif + endif + endif endif endif enddo @@ -513,17 +531,21 @@ subroutine flow_boundary_conditions(iflg) & ,inpt,iptty,iout,ierr,l,igrav,ihead) do i=1,n if(idum(i).ne.0) then - if(iqenth.ne.0) then - if(qenth(i).ne.0.0) then + if(iqenth.ne.0.or.itempb.ne.0) then +c gaz 113018 added "if(iqenth.ne.0) then " to avoid unallocated arrays + if(iqenth.ne.0) then + if(qenth(i).ne.0.0) then qflux(i)=qenth(i) qflxm(i)= 0.0 - endif - else if(itempb.ne.0) then - if(tempb(i).gt.0.0) then + endif + endif + if(itempb.ne.0) then + if(tempb(i).gt.0.0) then qflux(i)=tempb(i) qflxm(i)= sx1(i) if(wellim(i).ne.0.0) qflxm(i)=wellim(i) - endif + endif + endif else if(isatb.ne.0) then if(satb(i).gt.0.0) then qflux(i)=satb(i) @@ -646,18 +668,22 @@ subroutine flow_boundary_conditions(iflg) & ,inpt,iptty,iout,ierr,l,igrav,ihead) do i=1,n if(idum(i).ne.0) then - if(iqenth.ne.0) then - if(qenth(i).ne.0.0) then + if(iqenth.ne.0.or.itempb.ne.0) then +c gaz 113018 added "if(iqenth.ne.0) then " to avoid unallocated arrays + if(iqenth.ne.0) then + if(qenth(i).ne.0.0) then qflux(i)=qenth(i) qflxm(i)= 0.0 - endif - else if(itempb.ne.0) then - if(tempb(i).gt.0.0) then + endif + endif + if(itempb.ne.0) then + if(tempb(i).gt.0.0) then qflux(i)=tempb(i) qflxm(i)= sx1(i) if(wellim(i).ne.0.0) qflxm(i)=wellim(i) - endif - endif + endif + endif + endif endif enddo do i=1,n @@ -781,8 +807,8 @@ subroutine flow_boundary_conditions(iflg) do i=1,n if(idum(i).ne.0) then if(ixa.ne.0) then - if(qa(i).ne.0.0) then - xairfl(i)=qa(i) + if(qaxf(i).ne.0.0) then + xairfl(i)=qaxf(i) endif endif endif @@ -802,13 +828,21 @@ subroutine flow_boundary_conditions(iflg) endif if(ixa.ne.0.or.iqa.ne.0.or.ipresa.ne.0.or.iha.ne.0) then if(qa_temp.ne.0.0.or.pf_temp.ne.0.0.or.iha.ne.0) then - t_hum = thuma(i) - p_hum = phuma(i) - if(iha.ne.0.and.huma(i).gt.0.0) then +c gaz debug 82918 +c t_hum = thuma(i) +c p_hum = phuma(i) + if(allocated(huma)) then + huma_temp = huma(i) + else + huma_temp = 0.0d0 + endif + if(iha.ne.0.and.huma_temp.gt.0.0) then c flow humidity has less calls now - call flow_humidity_bc(1,t_hum,p_hum,huma(i), + t_hum = thuma(i) + p_hum = phuma(i) + call flow_humidity_bc(1,t_hum,p_hum,huma_temp, & xnva(i),entha(i)) - else if(abs(huma(i)).gt.0.0) then + else if(abs(huma_temp).gt.0.0) then c c fixed humidity may need impedance factor (aiped) c diff --git a/src/flow_humidity_bc.f b/src/flow_humidity_bc.f index 4e4fd588..e01bfb4e 100755 --- a/src/flow_humidity_bc.f +++ b/src/flow_humidity_bc.f @@ -1,4 +1,23 @@ subroutine flow_humidity_bc(iflg,tl,pl,h,qin_ng,enth_avg) +!*********************************************************************** +! Copyright 2016. Los Alamos National Security, LLC. This material was +! produced under U.S. Government contract DE-AC52-06NA25396 for Los +! Alamos National Laboratory (LANL), which is operated by Los Alamos +! National Security, LLC for the U.S. Department of Energy. The U.S. +! Government has rights to use, reproduce, and distribute this software. +! Neither the U.S. Government nor Los Alamos National Security, LLC or +! persons acting on their behalf, make any warranty, express or implied, +! or assumes any liability for the accuracy, completeness, or usefulness +! of the software, any information pertaining to the software, or +! represents that its use would not infringe privately owned rights. +! +! The software being licensed may be Export Controlled. It may not be +! distributed or used by individuals or entities prohibited from having +! access to the software package, pursuant to United States export +! control laws and regulations. An export control review and +! determination must be completed before LANS will provide access to the +! identified Software. +!*********************************************************************** CD1 CD1 PURPOSE CD1 @@ -216,4 +235,4 @@ subroutine h2o_v_enth(iflg,pl,tl,env) endif return - end \ No newline at end of file + end diff --git a/src/gdkm_calc.f b/src/gdkm_calc.f index 71651948..a8005ea2 100755 --- a/src/gdkm_calc.f +++ b/src/gdkm_calc.f @@ -77,9 +77,11 @@ subroutine gdkm_calc(iflg) real*8 dis2min,aream real*8 cord1,cord2,cord3,cord1j,cord2j,cord3j real*8 cord1jg,cord2jg,cord3jg + real*8 fac_nop real*8 sx1_primary,vfrac,sx1_total,vol_frac,perm parameter (rlp_min = 1.d-2) parameter (ngdkm_con = 6) + neqp1 = neq +1 if(gdkm_flag.eq.0) return if(iflg.eq.1) then diff --git a/src/gdkm_connect.f b/src/gdkm_connect.f index 929d8868..220725ed 100755 --- a/src/gdkm_connect.f +++ b/src/gdkm_connect.f @@ -69,6 +69,7 @@ subroutine gdkm_connect(iflg) real*8 cord_kb_pos_neg, cord_i_pos, area_kb_pos real*8 cord_i_neg, area_kb_neg real*8 disx_max,disx_min +c gaz 060117 added volume fraction cals real*8 a11,vfrac,vfrac2,sx1_primary,sx1_total,vf_gdpm integer, allocatable :: idum1(:) integer, allocatable :: idump(:) @@ -134,7 +135,7 @@ subroutine gdkm_connect(iflg) iconn_gdkm(i,2) = kb_neg if(igdpm(i).gt.0) then c gdkm nodes -c iconn_gdkm(3 has a different meaning +c iconn_gdkm(3) has a different meaning i_gdkm = nelm(nelm(i+1))-1 do kk = 1,ngdpm_layers(igdpm(i)) i_gdkm = i_gdkm +1 @@ -386,13 +387,17 @@ subroutine gdkm_connect(iflg) pnx(i) = pnx(i)*vfrac pny(i) = pny(i)*vfrac pnz(i) = pnz(i)*vfrac +c save gdkm volume fraction for node + gdkm_volume_fraction(i) = vfrac sx1_total = sx1_primary/vfrac do jk = 1, ngdpm_layers(imodel) kc = kb+jk-1 vfrac2 = sx1(kc)/sx1_total pnx(kc) = pnx(kc)*vfrac2 pny(kc) = pny(kc)*vfrac2 - pnz(kc) = pnz(kc)*vfrac2 + pnz(kc) = pnz(kc)*vfrac2 +c save gdkm volume fraction for node + gdkm_volume_fraction(kc) = vfrac2 enddo endif enddo diff --git a/src/gdkm_volume_fraction_interface.f b/src/gdkm_volume_fraction_interface.f new file mode 100755 index 00000000..54da33f9 --- /dev/null +++ b/src/gdkm_volume_fraction_interface.f @@ -0,0 +1,317 @@ + subroutine gdkm_volume_fraction_interface(iflg) +!************************************************************************* +! Copyright 2015. Los Alamos National Security, LLC. This material was +! produced under U.S. Government contract DE-AC52-06NA25396 for Los Alamos +! National Laboratory (LANL), which is operated by Los Alamos National +! Security, LLC for the U. S. Department of Energy. The U. S. Government +! has rights to use, reproduce, and distribute this software. Neither the +! U. S. Government nor Los Alamos National Security, LLC or persons acting +! on their behalf, make any warranty, express or implied, or assumes any +! liability for the accuracy, completeness, or usefulness of the software, +! any information pertaining to the software, or represents that its use +! would not infringe privately owned rights. + +! The software being licensed may be Export Controlled. It may not be +! distributed or used by individuals or entities prohibited from having +! access to the software package, pursuant to United States export control +! laws and regulations. An export control review and determination must be +! completed before LANS will provide access to the identified Software. +!************************************************************************* + +c gaz 080816 +c caculates volume ratios for gdkm model +c applies volume ratios to flow and diffusion parameters +c selectively to achieve various gdkm conceptualizations of fracture +c orientation +c +c + use comai + use combi + use comco2 + use comdi + use comdti + implicit none + + integer iflg,i,ncon_size,i1,i2,kb,ik,i_pri,i_sec + integer jk,kc,j,jj,n_loop + integer neqp1,imodel, i_dir_gdkm +c gaz 041718 + integer i_pri_kb, i_dir_gdkm_kb + real*8 vfrac,vfrac2,vfrac_sec,tol_dir,tol_dis + real*8 cordxa,cordya,cordza,cordxb,cordyb,cordzb + real*8 dl2,dx2,dy2,dz2 + real*8 sx1_primary, sx1_total, red_factor_old + real*8 cord1,cord2,cord3,cord1j,cord2j,cord3j + real*8 disx1, disy1, disz1, disx2, disy2, disz2 + real*8 length_total, length_pri, dis_p + parameter(tol_dir = 1.d-12,tol_dis = 1.d-6) + if(gdkm_flag.eq.0) return + + if(iflg.eq.-1) then +c allocate memory and other initialization tasks + if (.not. allocated(gdkm_volume_fraction)) then + allocate(gdkm_volume_fraction(n0)) + gdkm_volume_fraction = 1.0d00 + endif + else if(iflg.eq.0) then +c add previous required space to gdkm required space + ncon_size=nelm(neq+1) + nitfcpairs+1 + if (allocated(istrw_itfc)) deallocate (istrw_itfc) + allocate(istrw_itfc(ncon_size)) + istrw_itfc = 0 +c + if (allocated (red_factor)) deallocate (red_factor) + allocate(red_factor(0:ncon_size)) + red_factor = 1.0 + else if(iflg.eq.1) then +c calculate cell lengths for GDPM and GDKM calculations + if(.not.allocated(dzrg)) allocate(dzrg(n)) + if(.not.allocated(dyrg)) allocate(dyrg(n)) + if(.not.allocated(dxrg)) allocate(dxrg(n)) + if(gdkm_flag.ne.0) then + n_loop = neq_primary + else if(idpdp.ne.0) then + n_loop = neq_primary + else + n_loop = n + endif + do i = 1, n_loop + cord1 = cord(i,1) + cord2 = cord(i,2) + cord3 = 0.0 + if(icnl.eq.0) then + cord3 = cord(i,3) + endif +c find lengths of all connecting primary gridblocks + disx1 = 0.0 + disy1 = 0.0 + disz1 = 0.0 + disx2 = 1.e20 + disy2 = 1.e20 + disz2 = 1.e20 + i1 = nelm(i)+1 + i2 = nelm(i+1) + do jj = i1,i2 + kb = nelm(jj) + cord1j = cord(kb,1) + cord2j = cord(kb,2) + cord3j = 0.0 + if(icnl.eq.0) then + cord3j = cord(kb,3) + endif + disx1=max(cord1j-cord1,disx1) + disx2=min(cord1j-cord1,disx2) + disy1=max(cord2j-cord2,disy1) + disy2=min(cord2j-cord2,disy2) + disz1=max(cord3j-cord3,disz1) + disz2=min(cord3j-cord3,disz2) + enddo + if(ivf.eq.-1) then + if(disx1.eq.0.0.and.disx2.eq.0.0) + & disx1 = abs(cord1-x_orig)*2. + if(disy1.eq.0.0.and.disy2.eq.0.0) + & disy1 = abs(cord2-y_orig)*2. + if(disz1.eq.0.0.and.disz1.eq.0.0) + & disz1 = abs(cord3-z_orig)*2. + dzrg(i) = max(disz1,abs(disz2)) + dyrg(i) = max(disy1,abs(disy2)) + dxrg(i) = max(disx1,abs(disx2)) + continue + else + dzrg(i) = abs(disz1-disz2)/2. + dyrg(i) = abs(disy1-disy2)/2. + dxrg(i) = abs(disx1-disx2)/2. + endif + enddo + + else if(iflg.eq.2) then +c transport (tracer) related parameters done in coneqi.f +c not used + else if(iflg.eq.3) then +c calculate and store volume fractions + do i = 1,neq_primary + imodel= igdpm(i) +c first gdpm node is given last connection of primary node +c check this logic + kb = nelm(nelm(i+1)) + if(imodel.ne.0) then + sx1_primary = sx1(i) + vfrac = vfrac_primary(imodel) +c save gdkm volume fraction for node + gdkm_volume_fraction(i) = vfrac + sx1_total = sx1_primary/vfrac + do jk = 1, ngdpm_layers(imodel) + kc = kb+jk-1 + vfrac2 = sx1(kc)/sx1_total +c save gdkm volume fraction for node + gdkm_volume_fraction(kc) = vfrac2 + enddo + endif + enddo + else if(iflg.eq.4) then +c calculate interface factors + ik_gdkm_red = 0 + neqp1 = neq +1 + ik = nitfcpairs+1 + do i = 1,neq + i1 = nelmdg(i) + 1 + i2 = nelm(i+1) + if(i.le.neq_gdkm) then + i_dir_gdkm = gdkm_dir(igdpm(i)) + else + i_pri = nelm(nelm(i)+1) + i_dir_gdkm = gdkm_dir(igdpm(i_pri)) + endif + cordxa=cord(i,1) + cordya=cord(i,2) + cordza=cord(i,3) +c identify secondary node associated with primary node i + i_pri = nelm(nelmdg(i)) + i_sec = nelm(nelm(i+1)) +c insure that the full area is used for gdkm models +c neq_gdkm is the original primary nodes + if(i.le.neq_gdkm.and.i_sec.gt.neq_gdkm) then + vfrac_sec = 2.0 + i + else + vfrac_sec = 0.0 + endif + vfrac = gdkm_volume_fraction(i) + do j = i1,i2 + kb = nelm(j) + vfrac2 = gdkm_volume_fraction(kb) +c gaz 041718 defined gdkm model for node kb + if(kb.le.neq_gdkm) then + i_dir_gdkm = max(i_dir_gdkm,gdkm_dir(igdpm(kb))) + else + i_pri_kb = nelm(nelm(kb)+1) + i_dir_gdkm = max(i_dir_gdkm,gdkm_dir(igdpm(i_pri_kb))) + endif + cordxb=cord(kb,1) + cordyb=cord(kb,2) + cordzb=cord(kb,3) + dx2 = (cordxb-cordxa)**2 + dy2 = (cordyb-cordya)**2 + dz2 = (cordzb-cordza)**2 + dl2 = dx2+dy2+dz2 + if(gdkm_flag.eq.1.and.i_dir_gdkm.eq.1) then +c fracture plane is orthogonal to x axis + ik = ik + 1 + istrw_itfc(j-neqp1) = ik +c check for primary-secondary connection + if(vfrac.eq.1.0.and.vfrac2.eq.1.0) then +c non gdkm node to non gdkm node connection + red_factor(ik) = 1.0 +c vfrac_sec represents the sum i + 2 (so the primary node can be extracted) + else if(kb.eq.i_sec.and.vfrac_sec.gt.2.) then + red_factor(ik) = vfrac_sec +c check for primary-primary connection in x direction where +c node i is gdkm and kb is non-gdkm node +c gaz 091016 the next line commented out because orthogonality not required + else if(dl2.gt.tol_dis.and.abs(dx2-dl2).le.tol_dir) then +c else if(dl2.gt.tol_dis) then +c correction for centered distance for gdkm node to cell edge + length_total = 0.5*(dxrg(i) + dxrg(kb)) + if(vfrac.lt.1.0) then +c node i is gdkm node + length_pri = vfrac + dis_p = length_pri*dxrg(i)/4. + red_factor(ik) = length_total/(dis_p + 0.5*dxrg(kb)) +c gaz 1015016 debug gaz debug 041718 +c red_factor(ik)=1.0 + else +c node kb is gdkm node + length_pri = vfrac2 + dis_p = length_pri*dxrg(kb)/4. + red_factor(ik) = length_total/(0.5*dxrg(i)+dis_p) +c gaz 1015016 debug gaz debug 041718 +c red_factor(ik)=1.0 + endif + else +c whats left is primary-primary in non-gdkm direction or 2nd-2nd in non-gdkm direction +c gdkm direction : 1 = x, 2 = y, 3 = z + red_factor(ik) = 0.5*(vfrac + vfrac2) + continue + endif + elseif(gdkm_flag.eq.1.and.i_dir_gdkm.eq.2) then +c fracture plane is orthogonal to y axis + ik = ik + 1 + istrw_itfc(j-neqp1) = ik +c check for primary-secondary connection +c vfrac_sec represents the sum i + 2 (so the primary node can be extracted) + if(kb.eq.i_sec.and.vfrac_sec.gt.2.) then + red_factor(ik) = vfrac_sec +c check for primary-primary connection in x direction + else if(dl2.gt.tol_dis.and.abs(dy2-dl2).le.tol_dir) then +c else if(dl2.gt.tol_dis) then +c correction for centered distance for gdkm node to cell edge + length_total = 0.5*(dyrg(i) + dyrg(kb)) + if(vfrac.lt.1.0) then +c node i is gdkm node + length_pri = vfrac + dis_p = length_pri*dyrg(i)/4. + red_factor(ik) = length_total/(dis_p + 0.5*dyrg(kb)) +c gaz 1015016 debug + red_factor(ik)=1.0 + else +c node kb is gdkm node + length_pri = vfrac2 + dis_p = length_pri*dyrg(kb)/4. + red_factor(ik) = length_total/(0.5*dyrg(i)+dis_p) +c gaz 1015016 debug + red_factor(ik)=1.0 + endif + else +c whats left is primary-primary in non-z direction or 2nd-2nd in non-x direction + red_factor(ik) = 0.5*(vfrac + vfrac2) + endif + elseif(gdkm_flag.eq.1.and.i_dir_gdkm.eq.3) then +c fracture plane is orthogonal to z axis + ik = ik + 1 + istrw_itfc(j-neqp1) = ik +c check for primary-secondary connection + if(kb.eq.i_sec.and.vfrac_sec.gt.2.) then + red_factor(ik) = vfrac_sec +c check for primary-primary connection in z direction + else if(dl2.gt.tol_dis.and.abs(dz2-dl2).le.tol_dir) then +c else if(dl2.gt.tol_dis) then +c correction for centered distance for gdkm node to cell edge + length_total = 0.5*(dzrg(i) + dzrg(kb)) + if(vfrac.lt.1.0) then +c node i is gdkm node + length_pri = vfrac + dis_p = length_pri*dzrg(i)/4. + red_factor(ik) = length_total/(dis_p + 0.5*dzrg(kb)) +c gaz 1015016 debug + red_factor(ik)=1.0 + else +c node kb is gdkm node + length_pri = vfrac2 + dis_p = length_pri*dzrg(kb)/4. + red_factor(ik) = length_total/(0.5*dzrg(i)+dis_p) +c gaz 1015016 debug + red_factor(ik)=1.0 + endif + else +c whats left is primary-primary in non-z direction or 2nd-2nd in non-z direction + red_factor(ik) = 0.5*(vfrac + vfrac2) + endif + else +c fracture plane is "general or non directional" + ik = ik + 1 + istrw_itfc(j-neqp1) = ik +c gaz 020217 + if(kb.eq.i_sec.and.vfrac_sec.gt.2.) then + red_factor(ik) = vfrac_sec + else + red_factor(ik) = 0.5*(vfrac + vfrac2) + endif + endif + enddo + enddo + ik_gdkm_red = ik + else if(iflg.eq.5) then + + endif + + return + end diff --git a/src/geneq1.f b/src/geneq1.f index afe0df2e..f3c8c83c 100755 --- a/src/geneq1.f +++ b/src/geneq1.f @@ -189,7 +189,7 @@ subroutine geneq1 ( i ) real*8 delx2 real*8 dely2 real*8 delz2 - real*8 reduction_factor + real*8 reduction_factor, reduction_factor_t real*8 aexy, aexyf, alxi, alxkb, alyi, alykb, alzi, alzkb real*8 avxi, avyi, avzi, axi, axkb, axy, axyd, axyf real*8 ayi, aykb, azi, azkb @@ -206,9 +206,8 @@ subroutine geneq1 ( i ) real*8 swi, sx1d, sx2c, sx2t, sx3c, sx3t, sx4d, sx4h, sxzt real*8 thxi, thxkb, thyi, thykb, thzi, thzkb, ti real*8 vexy, vexyf, vxy, vxyd, vxyf - real*8 heatt - + integer kb_pri,i_dir_gdkm parameter(dis_tol=1.d-12) c c @@ -222,7 +221,6 @@ subroutine geneq1 ( i ) else nmatavw=0 endif - sx1d=sx1(i) axi=pnx(i) ayi=pny(i) @@ -253,6 +251,17 @@ subroutine geneq1 ( i ) thzi=thz(i) ti=t(i) swi=s(i) +c gaz 020217 +c determine direction of model (define for both materials) in geneg2 and other geneq etc + if(gdkm_flag.eq.1) then + if(i.le.neq_primary) then + i_dir_gdkm = gdkm_dir(igdpm(i)) + else + i_dir_gdkm = gdkm_dir(igdpm(i-neq_primary)) + endif + else + i_dir_gdkm = -1 + endif c c form constants for i>neq c @@ -322,6 +331,7 @@ subroutine geneq1 ( i ) alykb=aykb alzkb=azkb reduction_factor = red_factor(istrw_itfc(it11(jm))) + reduction_factor_t = reduction_factor perml(1)=2.*alxkb*alxi/(alxkb+alxi) perml(2)=2.*alykb*alyi/(alykb+alyi) perml(3)=2.*alzkb*alzi/(alzkb+alzi) @@ -350,49 +360,62 @@ subroutine geneq1 ( i ) sx2c = 0.0 endif dis2=delx2+dely2+delz2 - if(gdkm_flag.eq.2.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) then - pxy = sx2c*alxkb - elseif(gdkm_flag.eq.2.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxkb + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 +c use directional harmonic weighting to match high res solution + if(i_dir_gdkm.eq.1) then +c pxy = sx2c*pnx(kb_pri) + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then +c pxy = sx2c*pny(kb_pri) + pxy = sx2c*perml(2) + else if(i_dir_gdkm.eq.3) then +c pxy = sx2c*pnz(kb_pri) + pxy = sx2c*perml(3) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)+delz2/perml(3)) + endif elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)+delz2/perml(3)) else pxy=sx2c*sx_mult*max(perml(1),perml(2),perml(3)) endif + if(reduction_factor.gt.2.) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) pxyh=pxy*(pvikb-pvii) - if(gdkm_flag.eq.2.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) then - sx3c = sx2t*thxkb - elseif(gdkm_flag.eq.2.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - sx3c = sx2t*thxi - elseif(gdkm_flag.eq.3.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) - & then - sx3c = sx2t*thxi - elseif(gdkm_flag.eq.3.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - sx3c = sx2t*thxkb - else if(dis2.gt.dis_tol.and.iwd.gt.0) then + + if(i_dir_gdkm.ge.0.and.reduction_factor_t.gt.2) then + kb_pri = reduction_factor_t -2 + reduction_factor_t = 1.0 + if(i_dir_gdkm.eq.1) then + sx3c = sx2c*sx2t + else if(i_dir_gdkm.eq.2) then + sx3c = sx2c*sx3t + else if(i_dir_gdkm.eq.3) then + sx3c = sx2c*sxzt + else if(dis2.gt.dis_tol) then + sx3c=sx2c*dis2/ + & (delx2/sx2t+dely2/sx3t+ + & delz2/sxzt) + endif + elseif(dis2.gt.dis_tol.and.iwd.gt.0) then sx3c=sx2c*dis2/ & (delx2/sx2t+dely2/sx3t+ & delz2/sxzt) else - sx3c=sx2c*sx_mult*max(sx2t,sx3t,sxzt) - endif + sx3c=sx2c*sx_mult*max(sx2t,sx3t,sxzt) + endif + if(reduction_factor_t.gt.2) reduction_factor_t = 1.0 + sx3c = reduction_factor_t*sx3c t1(neighc)=pxyi t2(neighc)=pxyh t3(neighc)=pxy t4(neighc)=pxy - t5(neighc)=sx3c + t5(neighc)=sx3c t6(neighc)=-grav*t3(neighc) t7(neighc)=-grav_air*t4(neighc) 59 continue @@ -412,6 +435,7 @@ subroutine geneq1 ( i ) alxkb=axkb alykb=aykb reduction_factor = red_factor(istrw_itfc(it11(jm))) + reduction_factor_t = reduction_factor perml(1)=2.*alxkb*alxi/(alxkb+alxi) perml(2)=2.*alykb*alyi/(alykb+alyi) radkb=0.5*(radi+cord(kz,3)) @@ -425,48 +449,55 @@ subroutine geneq1 ( i ) delx2=(cord(kz,1)-cord(iz,1))**2 dely2=(cord(kz,2)-cord(iz,2))**2 dis2=delx2+dely2 - if(gdkm_flag.eq.2.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) then - pxy = sx2c*alxkb - elseif(gdkm_flag.eq.2.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxkb + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 +c gaz 050118 harmonic weightging to match high resolution grid + if(i_dir_gdkm.eq.1) then +c pxy = sx2c*pnx(kb_pri) + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then +c pxy = sx2c*pnx(kb_pri) + pxy = sx2c*perml(2) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)+delz2/perml(3)) + endif elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)) else pxy=sx2c*sx_mult*max(perml(1),perml(2)) endif + if(reduction_factor.gt.2) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) - pxyh=pxy*(pvikb-pvii) - if(gdkm_flag.eq.2.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) then - sx3c = sx2t*thxkb - elseif(gdkm_flag.eq.2.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - sx3c = sx2t*thxi - elseif(gdkm_flag.eq.3.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) - & then - sx3c = sx2t*thxi - elseif(gdkm_flag.eq.3.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - sx3c = sx2t*thxkb + pxyh=pxy*(pvikb-pvii) + + if(i_dir_gdkm.ge.0.and.reduction_factor_t.gt.2) then + kb_pri = reduction_factor_t -2 + reduction_factor = 1.0 + if(i_dir_gdkm.eq.1) then + sx3c = sx2c*sx2t + else if(i_dir_gdkm.eq.2) then + sx3c = sx2c*sx3t + else if(dis2.gt.dis_tol) then + sx3c=sx2c*dis2/ + & (delx2/sx2t+dely2/sx3t) + endif elseif(dis2.gt.dis_tol.and.iwd.gt.0) then sx3c=sx2c*dis2/ & (delx2/sx2t+dely2/sx3t) else - sx3c=sx2c*sx_mult*max(sx2t,sx3t) + sx3c=sx2c*sx_mult*max(sx2t,sx3t) endif + if(reduction_factor_t.gt.2) reduction_factor_t = 1. + sx3c = reduction_factor_t*sx3c t1(neighc)=pxyi t2(neighc)=pxyh t3(neighc)=pxy t4(neighc)=pxy - t5(neighc)=sx3c + t5(neighc)=sx3c t6(neighc)=-grav*t3(neighc) t7(neighc)=-grav_air*t4(neighc) 69 continue diff --git a/src/geneq2.f b/src/geneq2.f index 1898cff9..933e6dd1 100755 --- a/src/geneq2.f +++ b/src/geneq2.f @@ -549,12 +549,14 @@ subroutine geneq2(i) logical bit integer isl integer iz4m1 - integer imd,iwd + integer imd, iwd + integer kb_pri, i_dir_gdkm c following variables are associated with the drift flux nodel real*8 mdrifti,dmdriftpi,dmdriftei,mdrift_part real*8 mdriftkb,dmdriftpkb,dmdriftekb real*8 area_face,dmdrpkb,dmdrekb,dmdrpi,dmdrei - +c gaz debug + alxi = ps(1) c changed by avw -- entered here by seh neqp1=neq+1 if(i.gt.neq) then @@ -597,6 +599,18 @@ subroutine geneq2(i) swi = 1.0d0 endif ti=t(i) +c gaz 020217 +c determine direction of model (define for both materials) in geneg2 and other geneq etc + if(gdkm_flag.eq.1) then + if(i.le.neq_primary) then + i_dir_gdkm = gdkm_dir(igdpm(i)) + else + i_dir_gdkm = gdkm_dir(igdpm(i-neq_primary)) + endif + else + i_dir_gdkm = -1 + endif + c c form constants for i>neq c @@ -678,23 +692,27 @@ subroutine geneq2(i) dely2=(cord(kz,2)-cord(iz,2))**2 delz2=(cord(kz,3)-cord(iz,3))**2 dis2=delx2+dely2+delz2 - if(gdkm_flag.eq.2.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) then - pxy = sx2c*alxkb - elseif(gdkm_flag.eq.2.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxkb + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 +c gaz 050118 harmonic weighting to match hi res grid + if(i_dir_gdkm.eq.1) then + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then + pxy = sx2c*perml(2) + else if(i_dir_gdkm.eq.3) then + pxy = sx2c*perml(3) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)+delz2/perml(3)) + endif elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)+delz2/perml(3)) else pxy=sx2c*sx_mult*max(perml(1),perml(2),perml(3)) endif + if(reduction_factor.gt.2) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) pxyh=pxy*(pvikb-pvii) @@ -930,12 +948,9 @@ subroutine geneq2(i) endif c c -c 2-d geometry +c 2-d geometry (including radial) c elseif(icnl.ne.0) then - if(i.ge.223) then - continue - endif radi=cord(iz,3) do 69 jm=1,iq kb=it8(jm) @@ -961,23 +976,24 @@ subroutine geneq2(i) delx2=(cord(kz,1)-cord(iz,1))**2 dely2=(cord(kz,2)-cord(iz,2))**2 dis2=delx2+dely2 - if(gdkm_flag.eq.2.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) then - pxy = sx2c*alxkb - elseif(gdkm_flag.eq.2.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.le.neq_gdkm.and.kb.gt.neq_gdkm) - & then - pxy = sx2c*alxi - elseif(gdkm_flag.eq.3.and.i.gt.neq_gdkm.and.kb.le.neq_gdkm) - & then - pxy = sx2c*alxkb + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 + if(i_dir_gdkm.eq.1) then + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then + pxy = sx2c*perml(2) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)) + endif elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)) else pxy=sx2c*sx_mult*max(perml(1),perml(2)) endif + if(reduction_factor.gt.2) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) pxyh=pxy*(pvikb-pvii) diff --git a/src/geneq2_uz_wt.f b/src/geneq2_uz_wt.f index 0932dffc..366f9222 100755 --- a/src/geneq2_uz_wt.f +++ b/src/geneq2_uz_wt.f @@ -164,7 +164,7 @@ subroutine geneq2_uz_wt(i) logical bit integer isl integer iz4m1 - integer imd,iwd + integer imd,iwd,i_dir_gdkm,kb_pri c changed by avw -- entered here by seh neqp1=neq+1 @@ -283,12 +283,27 @@ subroutine geneq2_uz_wt(i) dely2=(cord(kz,2)-cord(iz,2))**2 delz2=(cord(kz,3)-cord(iz,3))**2 dis2=delx2+dely2+delz2 - if(dis2.gt.dis_tol.and.iwd.gt.0) then + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 +c gaz 050118 harmonic weighting to match hi res grid + if(i_dir_gdkm.eq.1) then + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then + pxy = sx2c*perml(2) + else if(i_dir_gdkm.eq.3) then + pxy = sx2c*perml(3) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)+delz2/perml(3)) + endif + elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)+delz2/perml(3)) else pxy=sx2c*sx_mult*max(perml(1),perml(2),perml(3)) endif + if(reduction_factor.gt.2) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) pxyh=pxy*(pvikb-pvii) @@ -527,12 +542,25 @@ subroutine geneq2_uz_wt(i) delx2=(cord(kz,1)-cord(iz,1))**2 dely2=(cord(kz,2)-cord(iz,2))**2 dis2=delx2+dely2 - if(dis2.gt.dis_tol.and.iwd.gt.0) then +c gaz 051818 + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 + if(i_dir_gdkm.eq.1) then + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then + pxy = sx2c*perml(2) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)) + endif + elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)) else pxy=sx2c*sx_mult*max(perml(1),perml(2)) endif + if(reduction_factor.gt.2) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) pxyh=pxy*(pvikb-pvii) diff --git a/src/geneqc.f b/src/geneqc.f index cb30f0f0..a68c16ed 100755 --- a/src/geneqc.f +++ b/src/geneqc.f @@ -145,7 +145,7 @@ subroutine geneqc(i) integer jm, jmi, jmia, jml, kb, kz integer neighc, neqp1, nmatavw integer imd,iwd - real*8 reduction_factor + real*8 reduction_factor, reduction_factor_t real*8 acxy, acxyf real*8 aexy, aexyf, alxi, alxkb, alyi, alykb, alzi, alzkb real*8 avxi, avyi, avzi, axi, axkb, axy, axyd, axyf @@ -187,6 +187,8 @@ subroutine geneqc(i) real*8 mpv_airi,mpv_airkb,mpv_wvi,mpv_wvkb,delmpv_air,delmpv_wv real*8 heatt + + integer kb_pri, i_dir_gdkm parameter(dis_tol=1.d-12) @@ -233,6 +235,17 @@ subroutine geneqc(i) devci=devcf(i) dilci=dilc(i) divci=divc(i) +c gaz 020217 +c determine direction of model (define for both materials) in geneg2 and other geneq etc + if(gdkm_flag.eq.1) then + if(i.le.neq_primary) then + i_dir_gdkm = gdkm_dir(igdpm(i)) + else + i_dir_gdkm = gdkm_dir(igdpm(i-neq_primary)) + endif + else + i_dir_gdkm = -1 + endif c c form constants for i>neq c @@ -310,6 +323,7 @@ subroutine geneqc(i) alykb=aykb alzkb=azkb reduction_factor = red_factor(istrw_itfc(it11(jm))) + reduction_factor_t = reduction_factor perml(1)=2.*alxkb*alxi/(alxkb+alxi) perml(2)=2.*alykb*alyi/(alykb+alyi) perml(3)=2.*alzkb*alzi/(alzkb+alzi) @@ -327,23 +341,55 @@ subroutine geneqc(i) dely2=(cord(kz,2)-cord(iz,2))**2 delz2=(cord(kz,3)-cord(iz,3))**2 dis2=delx2+dely2+delz2 - if(dis2.gt.dis_tol.and.iwd.gt.0) then + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 +c gaz 051416 harmonic weighting in coordinate directions + if(i_dir_gdkm.eq.1) then + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then + pxy = sx2c*perml(2) + else if(i_dir_gdkm.eq.3) then + pxy = sx2c*perml(3) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)+delz2/perml(3)) + endif + elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)+delz2/perml(3)) else pxy=sx2c*sx_mult*max(perml(1),perml(2),perml(3)) endif + if(reduction_factor.gt.2.) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) pxyh=pxy*(pvikb-pvii) - if(dis2.gt.dis_tol.and.iwd.gt.0) then - sx3c=sx2c*dis2/ - & (delx2/sx2t+dely2/sx3t+ - & delz2/sxzt) + if(i_dir_gdkm.ge.0.and.reduction_factor_t.gt.2) then + kb_pri = reduction_factor_t -2 + reduction_factor_t = 1.0 + if(i_dir_gdkm.eq.1) then + sx3c = sx2c*sx2t + else if(i_dir_gdkm.eq.2) then + sx3c = sx2c*sx3t + else if(i_dir_gdkm.eq.3) then + sx3c = sx2c*sxzt + else if(dis2.gt.dis_tol) then + sx3c=sx2c*dis2/ + & (delx2/sx2t+dely2/sx3t+ + & delz2/sxzt) + endif + elseif(dis2.gt.dis_tol.and.iwd.gt.0) then + sx3c=sx2c*dis2/ + & (delx2/sx2t+dely2/sx3t+ + & delz2/sxzt) else sx3c=sx2c*sx_mult*max(sx2t,sx3t,sxzt) - sx2c = sx2c*sx_mult endif + if(reduction_factor_t.gt.2) reduction_factor_t = 1.0 + sx3c = reduction_factor_t*sx3c +c gaz 080118 added reduction factor to sx2c for air-water vapor diffusion + sx2c = reduction_factor_t*sx2c t1(neighc)=pxyi t2(neighc)=pxyh t3(neighc)=pxy @@ -369,6 +415,7 @@ subroutine geneqc(i) alxkb=axkb alykb=aykb reduction_factor = red_factor(istrw_itfc(it11(jm))) + reduction_factor_t = reduction_factor perml(1)=2.*alxkb*alxi/(alxkb+alxi) perml(2)=2.*alykb*alyi/(alykb+alyi) radkb=0.5*(radi+cord(kz,3)) @@ -384,22 +431,47 @@ subroutine geneqc(i) dely2=(cord(kz,2)-cord(iz,2))**2 dis2=delx2+dely2 dis2=delx2+dely2 - if(dis2.gt.dis_tol.and.iwd.gt.0) then + if(i_dir_gdkm.ge.0.and.reduction_factor.gt.2) then + kb_pri = reduction_factor -2 + reduction_factor = 1.0 + if(i_dir_gdkm.eq.1) then + pxy = sx2c*perml(1) + else if(i_dir_gdkm.eq.2) then + pxy = sx2c*perml(2) + else if(dis2.gt.dis_tol) then + pxy=sx2c*dis2/(delx2/perml(1)+ + & dely2/perml(2)) + endif + elseif(dis2.gt.dis_tol.and.iwd.gt.0) then pxy=sx2c*dis2/(delx2/perml(1)+ & dely2/perml(2)) else pxy=sx2c*sx_mult*max(perml(1),perml(2)) endif + if(reduction_factor.gt.2) reduction_factor = 1.0 pxy = pxy*reduction_factor pxyi=pxy*(phikb-phii) pxyh=pxy*(pvikb-pvii) - if(dis2.gt.dis_tol.and.iwd.gt.0) then - sx3c=sx2c*dis2/ - & (delx2/sx2t+dely2/sx3t) + if(i_dir_gdkm.ge.0.and.reduction_factor_t.gt.2) then + kb_pri = reduction_factor_t -2 + reduction_factor_t = 1.0 + if(i_dir_gdkm.eq.1) then + sx3c = sx2c*sx2t + else if(i_dir_gdkm.eq.2) then + sx3c = sx2c*sx3t + else if(dis2.gt.dis_tol) then + sx3c=sx2c*dis2/ + & (delx2/sx2t+dely2/sx3t) + endif + elseif(dis2.gt.dis_tol.and.iwd.gt.0) then + sx3c=sx2c*dis2/ + & (delx2/sx2t+dely2/sx3t) else sx3c=sx2c*sx_mult*max(sx2t,sx3t) - sx2c=sx2c*sx_mult endif + if(reduction_factor_t.gt.2) reduction_factor_t = 1. + sx3c = reduction_factor_t*sx3c + sx2c = reduction_factor_t*sx2c t1(neighc)=pxyi t2(neighc)=pxyh t3(neighc)=pxy diff --git a/src/gncf3.f b/src/gncf3.f index 2fdcec63..96593101 100755 --- a/src/gncf3.f +++ b/src/gncf3.f @@ -304,6 +304,7 @@ subroutine gncf3(nrq,nele,nga,neu,nsl,icsh,neumax,aj) integer icsh, nele, neu, neumax, nga, nrq, nsl, i, j integer ij, indx(4), iq, ir, jz, k, kb, kjz, knum + integer ich_pebi_sv real*8 aj(neumax,*) real*8 cpb(4,4), vpebi(4) real*8 a1, a2, a3, a4, a5, a6, a7 @@ -313,12 +314,14 @@ subroutine gncf3(nrq,nele,nga,neu,nsl,icsh,neumax,aj) real*8 cord1, cord2, cord3, detja, dnga, dterm real*8 sa11, sa12, sa13, sa21, sa22, sa23, sa31, sa32, sa33 real*8 vold, vold4, volt, wxnga, wynga, wznga + real*8 vol_tol + parameter (vol_tol = -1.d-12) c if icsh=1 calculate jacobian information c if ( icsh.eq.1 ) then -c +c if ( nsl.eq.8 ) then c procedure for 8 node brick elements call shap3r(nga) @@ -916,10 +919,29 @@ subroutine gncf3(nrq,nele,nga,neu,nsl,icsh,neumax,aj) zt(jz)=cord(kb,3) enddo if(nrq.eq.1) then + ich_pebi_sv = ich_pebi if(ireord.eq.10) then call area_vol_tet(xt,yt,zt,cpb,vpebi) +c check for all negative volumes + if(vpebi(1).lt.vol_tol.and.vpebi(2).lt.vol_tol.and. + & vpebi(3).lt.vol_tol.and.vpebi(4).lt.vol_tol) then + ich_pebi_sv = ich_pebi + ich_pebi = 1 +c write element number to err file + write(ierr,*) 'element ',nele,' has all neg node vols, ', + & 'negative rule applied' + endif else call pebi3(xt,yt,zt,cpb,vpebi) +c check for all negative volumes + if(vpebi(1).lt.vol_tol.and.vpebi(2).lt.vol_tol.and. + & vpebi(3).lt.vol_tol.and.vpebi(4).lt.vol_tol) then + ich_pebi_sv = ich_pebi + ich_pebi = 1 +c write element number to err file + write(ierr,*) 'element ',nele,' has all neg node vols, ', + & 'negative rule applied' + endif endif if(ich_pebi.ne.0) then do i = 1, 4 @@ -928,7 +950,8 @@ subroutine gncf3(nrq,nele,nga,neu,nsl,icsh,neumax,aj) cpb(i,j) = - cpb(i,j) enddo enddo - endif + endif + ich_pebi = ich_pebi_sv c calculate volumes bcoef(neu,1)=vpebi(1) bcoef(neu,2)=0.0 diff --git a/src/h2o_properties_new.f90 b/src/h2o_properties_new.f90 new file mode 100755 index 00000000..91b30573 --- /dev/null +++ b/src/h2o_properties_new.f90 @@ -0,0 +1,118 @@ +subroutine h2o_properties_new(iflg,iphase,var1,var2,var3,istate,var4,var5,var6) +!*********************************************************************** +! Copyright 2011 Los Alamos National Security, LLC All rights reserved +! Unless otherwise indicated, this information has been authored by an +! employee or employees of the Los Alamos National Security, LLC (LANS), +! operator of the Los Alamos National Laboratory under Contract No. +! DE-AC52-06NA25396 with the U. S. Department of Energy. The U. S. +! Government has rights to use, reproduce, and distribute this +! information. The public may copy and use this information without +! charge, provided that this Notice and any statement of authorship are +! reproduced on all copies. Neither the Government nor LANS makes any +! warranty, express or implied, or assumes any liability or +! responsibility for the use of this information. +!*********************************************************************** + +! Nov 2 2015 gaz modified from Rajesh Pawar's co2_properties +! + use property_interpolate_1 + use comco2, only: co2_prop + use comai, only : itsat + use comrxni, only : cden_flag + + implicit none + real*8 mol, mco2, mco22 + real*8 var1,var2,var3,var4,var5(9),var6 + real*8 a1,a2,a3,a4,a5,t1,t2,t3,t4,t5,sum,sum2,t11,t21 + real*8 a6,x,x2,x3,x4,x5,fn,dfn, ps, p1, t, p, nu, ps1, ps2 + real*8 c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15 + real*8 tc,pc,fg,dfgdp,dfgdt,liq_cp,dliq_cpdp,dliq_cpdt + real*8 lambdaco2_na, dlambdaco2_nadp, dlambdaco2_nadt + real*8 tauco2_na_cl, dtauco2_na_cldp, dtauco2_na_cldt + real*8 temperature, pressure,rhs,drhsdp,drhsdt,dmco2dp,dmco2dt + real*8 mco21, dmco21dp,dmco21dt,dmco21dxc,dmco2dx,dvar4dt,dvar4dp + real*8 :: cden_correction + integer iflg, iphase, iphase1, ifail, istate, icode(9) + character*200 interpfile, amessage + ! units are P : MPa + ! T : degree celsius + ! h(enthalpy) : MJ/Kg + ! dhdt : MJ/kg/C + ! dhdp : MJ/Kg/MPa + ! rho(density) : kg/m3 + ! dddt : kg/m3/C + ! dddp : kg/m3/MPa + ! visc(viscosity) : Pa.s + ! dvdt: Pa.s/C + ! dvdp : Pa.s/Mpa + + temperature = var2 + pressure = var1 + var5 = 0.0 + + if (iflg .eq. 1) then + ! determine co2 state + call get_h2o_state(ifail,temperature,pressure,istate) + if(ifail.ne.0) go to 9890 + elseif(iflg.eq.2) then + ! determine sat temperature given pressure + call get_h2o_sat_temperature(ifail,pressure,var4,var5(1)) + elseif(iflg.eq.3) then + ! determine sat pressure given temprature + call get_h2o_sat_pressure(ifail,temperature,var4,var5(1)) + elseif(iflg.eq.4) then + ! determine properties and derivatives for liquid,vapor,supercritical phases + icode=1 ! an array + if(iphase.eq.4) iphase=1 + call get_h2o_properties(ifail,iphase,9,icode,temperature,pressure,var5) + ! change units to density-kg/m3 (done) , enthalpy-Mj/kg, and vis-cp + var5(4)=var5(4)*1.d-3 + var5(5)=var5(5)*1.d-3 + var5(6)=var5(6)*1.d-3 + var5(7)=var5(7) + var5(8)=var5(8) + var5(9)=var5(9) + if(ifail.ne.0) go to 9890 + elseif(iflg.eq.5) then + ! determine properties and derivatives for liquid phase of 2-phase + icode=1 ! an array + call get_h2o_sat_line_props_pressure(ifail,1,9,icode,pressure,var5) + var5(4)=var5(4)*1.d-3 + var5(5)=var5(5)*1.d-3 + var5(6)=var5(6)*1.d-3 + var5(7)=var5(7) + var5(8)=var5(8) + var5(9)=var5(9) + elseif(iflg.eq.6) then + icode=1 ! an array + call get_h2o_sat_line_props_pressure(ifail,2,9,icode,pressure,var5) + var5(4)=var5(4)*1.d-3 + var5(5)=var5(5)*1.d-3 + var5(6)=var5(6)*1.d-3 + var5(7)=var5(7) + var5(8)=var5(8) + var5(9)=var5(9) + ! determine properties and derivatives for vapor phase of 2-phase + elseif(iflg.eq.7) then + var5(1) = 0.0 + var5(2) = 0.0 + var5(3) = 0.0 + elseif(iflg.eq.8) then + if(iphase.eq.1) then + var5(1) = 1.-var1 + var5(2) = 0.0 + var5(3) = -1. + else + var5(1) = var1 + var5(2) = 0.0 + var5(3) = 1. + endif + else if (iflg.eq.10) then + + endif + +9890 continue + +end subroutine h2o_properties_new + + diff --git a/src/hyddiss.f b/src/hyddiss.f index 2bfc76cd..3af6ca79 100755 --- a/src/hyddiss.f +++ b/src/hyddiss.f @@ -230,17 +230,17 @@ subroutine hyddiss(ndummy,iz) c read in nodal capillary type - +c gaz 110518 macroread(7) changed macroread(25) narrays = 1 itype(1) = 4 default(1) = 1 macro = "methdisv " igroup = 2 call initdata2( inpt, ischk, n0, narrays, - 2 itype, default, macroread(7), macro, igroup, ireturn, - 3 i4_1=idissp(1:n0) ) + 2 itype, default, macroread(25), macro(1:4), igroup, ireturn, + 3 i4_1=idissp(1:n0) ) - macroread(7) = .TRUE. + macroread(25) = .TRUE. do i=1,n0 if(idisst(idissp(i)).lt.1) then diff --git a/src/infiles.f b/src/infiles.f index f9b64653..4cb52889 100755 --- a/src/infiles.f +++ b/src/infiles.f @@ -289,7 +289,7 @@ subroutine infiles(simnum) call zone(cnum, inzone) goto 105 - else if (macro .eq. 'stop') then + else if (macro .eq.'stop'.or.macro .eq.' ') then if (iout .ne. 0) write(iout, 6010) macro, 'inzone', inzone if (iptty .gt. 0) write(iptty, 6010) macro, 'inzone', diff --git a/src/ingdpm.f b/src/ingdpm.f index 77edacac..706282a7 100755 --- a/src/ingdpm.f +++ b/src/ingdpm.f @@ -14,7 +14,7 @@ subroutine ingdpm !D1 !D1 PURPOSE !D1 -!D1 To read generalized dual porosity model parameters and check the +!D1 To read generalized dual porosity and dual permeability model parameters and check the !D1 size of arrays. !D1 !********************************************************************** @@ -64,8 +64,8 @@ subroutine ingdpm integer i, idum_gdpm, imodel logical null1 character*80 dummy_string - integer n_n_n, j - real*8 gdpm_left, gdpm_right + integer n_n_n, j, i_chk_nodes, icount + real*8 gdpm_left, gdpm_right, vol_2nd c gdpm_flag: if nonzero, determines the geometry of the matrix. @@ -78,18 +78,66 @@ subroutine ingdpm c 11: parallel plate fractures x dir is orthogonal to fracture c 12: parallel plate fractures y dir is orthogonal to fracture c 13: parallel plate fractures y dir is orthogonal to fracture - read(inpt,*) idum_gdpm, ngdpmnodes - - imodel = 0 - neq_primary = n0-ngdpmnodes - + i_chk_nodes = 0 +c gaz 022617 skip this for now + i_chk_nodes = 1 + go to 998 +999 if(i_chk_nodes.eq.0) then + call backtrack(1,inpt,icount) + igdpm = 0 + ngdpm_layers= 1 + go to 901 + else + call backtrack(2,inpt,icount) + imodel = 0 + idum_gdpm = 1 + ngdpmnodes = ngdpm_actual +c neq_primary = n0-ngdpmnodes # neq_primary already calculated + go to 1000 + endif +998 continue + if(.not.gdkm_new) then + read(inpt,*) idum_gdpm, ngdpmnodes + neq_primary = n0-ngdpmnodes + endif + imodel = 0 1000 continue read(inpt,'(a80)') dummy_string if(.not. null1(dummy_string)) then imodel = imodel + 1 - backspace inpt + backspace inpt +c gaz 091116 +c gdkm_dir = 0 older gdkm model (0,1,11) dpdp equivalent +c gdkm_dir = 1 frac orth x dir +c gdkm_dir = 2 frac orth y dir +c gdkm_dir = 3 frac orth z dir + if(gdkm_flag.ne.0) then + if(gdkm_new) then +c input and directional models (including older model + read(inpt,*) gdkm_dir(imodel), vol_2nd, + 2 gdpm_x(imodel,1) + if(gdkm_dir(imodel).eq.4) gdkm_dir(imodel) = 0 + ngdpm_layers(imodel) = 1 + vfrac_primary(imodel) = 1.0 - vol_2nd + else + read(inpt,*) gdkm_dir(imodel), vfrac_primary(imodel), + 2 gdpm_x(imodel,1) + gdkm_dir(imodel) = 0 + ngdpm_layers(imodel) = 1 +c gaz 031918 print out that old format detected + if(iout.ne.0) then + write(iout,*)'>> old gdkm input, non-directional(dpdp-like)', + & ' model' + endif + if(iptty.ne.0) then + write(iptty,*)'>> old gdkm input, non-directional(dpdp-like)', + & ' model' + endif + endif + else read(inpt,*) ngdpm_layers(imodel), vfrac_primary(imodel), - 2 (gdpm_x(imodel,i),i=1,ngdpm_layers(imodel)) + 2 (gdpm_x(imodel,i),i=1,ngdpm_layers(imodel)) + endif goto 1000 end if c Change from edge coordinates to block centers @@ -129,6 +177,7 @@ subroutine ingdpm enddo endif c Set flag to identify which nodes have each gdpm model +901 continue narrays = 1 itype(1) = 4 default(1) = 0 @@ -146,12 +195,30 @@ subroutine ingdpm imodel = igdpm(i) ngdpm_actual = ngdpm_actual + ngdpm_layers(imodel) end do - +c gaz 022617 and 042918 +c write out actual number of gdkm or gdpm nodes + if(gdkm_flag.ne.0) then + if(iptty.ne.0) then + write(iptty,*) + & 'number of gdkm nodes ', ngdpm_actual + endif + if(iout.ne.0) then + write(iout,*) + & 'number of gdkm nodes ', ngdpm_actual + endif + endif + neq = neq_primary+ngdpm_actual +c n0 = neq + if(i_chk_nodes.eq.0) then + i_chk_nodes = 1 + go to 999 + endif c Check to see if ngdpmnodes is set large enough, if c not, fatal error. If value is set larger than needed, c write warning message - - if(ngdpm_actual .lt. ngdpmnodes) then + if(gdkm_new) then +c gaz 040517 do nothing here + else if(ngdpm_actual .lt. ngdpmnodes) then if(iout .ne. 0) then write(iout,*) 'In gdpm macro, ngdpmnodes must be reduced' @@ -192,6 +259,17 @@ subroutine ingdpm stop end if + if(gdkm_flag.ne.0) then + n_n_n = neq_primary + do i = 1, neq_primary + imodel = igdpm(i) + if(imodel.gt.0) then +c gaz 032218 a secondary node zone always get the primary node value +100 + n_n_n = n_n_n +1 + izonef(n_n_n) = izonef(i) + 100 + endif + enddo + else if(gdpm_flag.ne.0) then c Set zones for GDPM nodes for the case in which zone has c already been called @@ -219,7 +297,45 @@ subroutine ingdpm end do end do - + endif + return + end + subroutine backtrack(iflg,iunit,icount) +c +c counts lines and backspaces lines in file +c + implicit none + character*80 dummy_string + logical null1 + integer iflg,iunit,icount,i, max_lines + parameter (max_lines = 10000) + if(iflg.eq.0) then + else if(iflg.eq.1) then +c read and count lines until a blank is found + icount = 0 + do i = 1, max_lines + read(iunit,'(a80)') dummy_string + if(.not. null1(dummy_string)) then + icount = icount +1 + else + return + endif + enddo + else if(iflg.eq.2) then +c back space lines +100 continue + backspace iunit + read(iunit,'(a80)') dummy_string(1:80) + if(dummy_string(1:4).ne.'gdkm') then + backspace iunit + go to 100 + endif +c read(iunit,'(a80)') dummy_string(1:80) + + return + else if(iflg.eq.3) then +c call initdata2 here + endif return end diff --git a/src/initdata2.f b/src/initdata2.f index 6f4ac23c..f6c37832 100755 --- a/src/initdata2.f +++ b/src/initdata2.f @@ -368,6 +368,8 @@ subroutine initdata2( in_number, logical null1,readflag integer inode,max_arrays + integer i,ii,izunit,nin + integer open_file parameter(max_arrays = 10 ) integer in_number,out_number,npoints,narrays,ireturn integer itype(*),iarray,ipoint,inumber,ja,jb,jc,icode,nfound @@ -376,6 +378,7 @@ subroutine initdata2( in_number, integer n_realcount, n_intcount character*80 strtot character*4 macro + character*30 zonesavename integer, allocatable :: ifind(:) integer, allocatable :: isset(:) integer, allocatable :: notset(:) @@ -389,6 +392,7 @@ subroutine initdata2( in_number, integer, optional :: i4_3(:) integer, optional :: i4_4(:) integer, optional :: i4_5(:) + logical ex,op allocate(ifind(npoints),isset(npoints),notset(npoints)) ifind=0 @@ -430,7 +434,7 @@ subroutine initdata2( in_number, n_intcount = n_intcount + 1 if( .not. readflag ) then if(n_intcount.eq.1) then - i4_1(1:npoints) = nint(default(iarray)) + i4_1(1:npoints) = nint(default(iarray))+initdata_pad elseif(n_intcount.eq.2) then i4_2(1:npoints) = nint(default(iarray)) elseif(n_intcount.eq.3) then @@ -474,6 +478,27 @@ subroutine initdata2( in_number, ireturn = ireturn + 1 c Input by zones is first, or else input is by node if( ja .lt. 0 ) then +c gaz 060617 +c check for saved zonefile + zonesavename(1:14) = 'zone00000.save' + write(zonesavename(5:9),'(i5)') abs(ja)+10000 + zonesavename(5:5) = '0' + ex = .false. + op = .false. + inquire (file = zonesavename, exist = ex) + if(ex) then + inquire (file = zonesavename, opened = op) + if(.not.op) izunit=open_file(zonesavename,'unknown') + read(izunit,*) + read(izunit,*) + read(izunit,*) nin + if(allocated(ncord)) deallocate(ncord) + allocate(ncord(nin)) + backspace izunit + read(izunit,*) nin, (ncord(i), i =1, nin) + close(izunit) + endif + if(.not.ex) then do inode = 1, npoints if( izonef(inode) .eq. abs(ja) ) then ifind(inode) = 1 @@ -497,6 +522,7 @@ subroutine initdata2( in_number, n_intcount = n_intcount + 1 if(n_intcount.eq.1) then i4_1(inode) = nint(values(iarray)) + & +initdata_pad elseif(n_intcount.eq.2) then i4_2(inode) = nint(values(iarray)) elseif(n_intcount.eq.3) then @@ -510,6 +536,47 @@ subroutine initdata2( in_number, end do end if end do + else +c gaz 111716 + do ii = 1, nin + inode = ncord(ii) + ifind(inode) = 1 + n_realcount = 0 + n_intcount = 0 + do iarray = 1, narrays + if( itype(iarray) .eq. 8 ) then + n_realcount = n_realcount + 1 + if(n_realcount.eq.1) then + r8_1(inode) = values(iarray) + elseif(n_realcount.eq.2) then + r8_2(inode) = values(iarray) + elseif(n_realcount.eq.3) then + r8_3(inode) = values(iarray) + elseif(n_realcount.eq.4) then + r8_4(inode) = values(iarray) + elseif(n_realcount.eq.5) then + r8_5(inode) = values(iarray) + end if + else + n_intcount = n_intcount + 1 + if(n_intcount.eq.1) then + i4_1(inode) = nint(values(iarray)) + & +initdata_pad + elseif(n_intcount.eq.2) then + i4_2(inode) = nint(values(iarray)) + elseif(n_intcount.eq.3) then + i4_3(inode) = nint(values(iarray)) + elseif(n_intcount.eq.4) then + i4_4(inode) = nint(values(iarray)) + elseif(n_intcount.eq.5) then + i4_5(inode) = nint(values(iarray)) + end if + end if + end do +c end if + end do + deallocate(ncord) + endif else if( ja .eq. 1 .and. jb .eq. 0 .and. jc .eq. 0 ) then ja = 1 @@ -539,7 +606,7 @@ subroutine initdata2( in_number, else n_intcount = n_intcount + 1 if(n_intcount.eq.1) then - i4_1(ja:jb:jc) = nint(values(iarray)) + i4_1(ja:jb:jc) = nint(values(iarray))+initdata_pad elseif(n_intcount.eq.2) then i4_2(ja:jb:jc) = nint(values(iarray)) elseif(n_intcount.eq.3) then diff --git a/src/innode.f b/src/innode.f index d8c3e216..4c31d964 100755 --- a/src/innode.f +++ b/src/innode.f @@ -397,7 +397,7 @@ end subroutine innode subroutine get_nodes (node_array, cnt, m, ierr_flag) - use comai, only : inpt, ierr, iout, iptty + use comai, only : inpt, ierr, iout, iptty, gdkm_flag use comdti, only : n0 use comki, only : macro implicit none @@ -413,7 +413,8 @@ subroutine get_nodes (node_array, cnt, m, ierr_flag) read (inpt, *) xc, yc, zc call near3 (xc, yc, zc, nodew, 0) node_array(i) = nodew - else if (node_array(i) .gt. n0) then +c gaz 022717 + else if (node_array(i) .gt. n0. and . gdkm_flag.eq.0) then ierr_flag = 2 write (ierr, 400) macro write (ierr, 300) node_array(i), n0 diff --git a/src/inpres.f b/src/inpres.f index 69f91886..09850a24 100755 --- a/src/inpres.f +++ b/src/inpres.f @@ -267,7 +267,8 @@ subroutine inpres do i = 1, n0 if (tmp(i) .ne. default(2)) then - if (abs (ieos(i)) .eq. 1) then +c gaz 110715 added sc phase + if (abs (ieos(i)) .eq. 1.or.abs (ieos(i)).eq.4) then to(i) = tmp(i) c single phase set saturation for wtsi if(pho(i).le.0.) then diff --git a/src/input.f b/src/input.f index b5414301..7e9d4a91 100755 --- a/src/input.f +++ b/src/input.f @@ -498,12 +498,15 @@ subroutine input(cnum, simnum) real tmpli logical null1, found_end, macro_end, end_macro logical :: mptr_call = .false. +c gaz 062718 + logical zone_sv_ex character*80 input_msg, dummy_line character*4 macro, macro1, chard, last_macro integer cnum,iieosd,inptorig,kk,msg(20),nwds,imsg(20) real*8 xmsg(20), simnum character*5 cden_type character*32 cmsg(20) + character*30 zonesavename sssol = 'no ' altc = 'fehm' @@ -545,6 +548,9 @@ subroutine input(cnum, simnum) if (nwds .gt. 1) then found_end = .false. +c check if necassary to save zone +c check done only in zone +c izone_save = 0 do i = 2, nwds if (msg(i) .eq. 3) then if (cmsg(i) .eq. 'off' .or. cmsg(i) .eq. 'OFF') then @@ -552,7 +558,10 @@ subroutine input(cnum, simnum) c of of this macro (flagged as 'end macro') call skip_macro (macro, inptorig, found_end) exit +c else if (cmsg(i) .eq.'save'.or.cmsg(i) .eq.'SAVE') then +c izone_save = 1 end if + end if end do if (found_end) then @@ -1020,14 +1029,19 @@ subroutine input(cnum, simnum) read(inpt,*)(iflxz(i),i=1,nflxz) c Loop over each zone for determining izoneflxz array - +c gaz 062718 modified so saved zones can be used izoneflxz = 0 do izone = 1, nflxz + call readsavedzone(1,zone_sv_ex,izone,iflxz(izone)) +c if the zone is a saved zone, then izoneflxz filled in readsavedzone +c izoneflxz is in module combi + if (zone_sv_ex .eqv. .false.) then do inode = 1, n0 if(izonef(inode).eq.iflxz(izone)) then izoneflxz(inode) = izone end if end do + endif end do @@ -1386,11 +1400,14 @@ subroutine input(cnum, simnum) schng = 0.005 599 continue -c**** rock densities, etc **** else if (macro .eq. 'rock') then -c**** rock densities, etc **** +c**** rock densities and heat capacities etc **** call inrock - + + else if (macro. eq. 'vroc') then + ivrock = 1 + call vrock_ctr(0,0) + else if(macro .eq. 'rxn ') then c**** Multiple reaction data **** rxn_flag = 1 @@ -1576,7 +1593,6 @@ subroutine input(cnum, simnum) c**** set zone information **** cnum = cnum + 1 call zone(cnum, inpt) - else if (macro .eq. 'zonn') then c**** set zone information **** cnum = cnum + 1 @@ -1634,9 +1650,56 @@ subroutine input(cnum, simnum) if(icarb.ne.0) call ther_co2_h2o(10,0) if (.not. mptr_call) close (inpt) - +c deallocate memory from save zone algorthm (msg is +c used as a dummy integer array here) +c gaz 102918 changed msg to 0 + call zone_elem(-1,0,zonesavename,0,0) end subroutine input + subroutine readsavedzone(iflg,ex,izone,ja) +c +c this routine checks for and reads a saved zone +c +c gaz 062718 +c + use combi + use comdti + use comai + implicit none + + character*30 zonesavename + logical ex, op + integer iflg, izone, ja, izunit, nin + integer open_file, i + +c gaz 060617 (copied from initdata2) +c check for saved zonefile + if(iflg.eq.1) then + zonesavename(1:14) = 'zone00000.save' + write(zonesavename(5:9),'(i5)') abs(ja)+10000 + zonesavename(5:5) = '0' + ex = .false. + op = .false. + inquire (file = zonesavename, exist = ex) + if(ex) then + inquire (file = zonesavename, opened = op) + if(.not.op) izunit=open_file(zonesavename,'unknown') + read(izunit,*) + read(izunit,*) + read(izunit,*) nin + if(allocated(ncord)) deallocate(ncord) + allocate(ncord(nin)) + backspace izunit + read(izunit,*) nin, (ncord(i), i =1, nin) + close(izunit) +c fill array izoneflxz() + do i = 1, nin + izoneflxz(ncord(i)) = izone + enddo + deallocate(ncord) + endif + endif + end subroutine readsavedzone diff --git a/src/inrlp.f90 b/src/inrlp.f90 index d7be25c4..318e99cd 100644 --- a/src/inrlp.f90 +++ b/src/inrlp.f90 @@ -178,6 +178,8 @@ subroutine inrlp tblnum = imsg(2) ! first param is table index ; not sure this is used if(nwds==6) then ! older style input; ignore all parameters except last (phase couple) couple=ic(cmsg(6), ictype) +! gaz debug 120317 +! couple = 25 else couple=ic(cmsg(2), ictype) ! couple will be >20; ictype will include each phase endif @@ -243,9 +245,9 @@ subroutine inrlp cmsg(2) = 'tabular' ! End of case 'tabular' case ('rlp', 'RLP') - write(*,*) 'blah 228 ',cmsg(3) +! write(*,*) 'blah 228 ',cmsg(3) if(cmsg(3).ne.'same') then - write(*,*) 'not same' +! write(*,*) 'not same' ! **************** REL PERMS ****************************** ! increment rlp index nrlp_phases = nrlp_phases+1 @@ -378,7 +380,7 @@ subroutine inrlp stop end select else - write(*,*) 'about to err' +! write(*,*) 'about to err' write(ierr,20) 'option "same" is obselete and is ignored' endif diff --git a/src/inrock.f b/src/inrock.f index dc5daad6..6970c9d4 100755 --- a/src/inrock.f +++ b/src/inrock.f @@ -201,9 +201,9 @@ subroutine inrock itype(1) = 8 itype(2) = 8 itype(3) = 8 - default(1) = 2500. - default(2) = 1000. - default(3) = 1.0 + default(1) = 2500.d0 + default(2) = 1000.d0 + default(3) = 1.0d0 igroup = 1 call initdata2 (inpt, ischk, n0, narrays, itype, diff --git a/src/interpolate_2.f90 b/src/interpolate_2.f90 new file mode 100755 index 00000000..ca4d74eb --- /dev/null +++ b/src/interpolate_2.f90 @@ -0,0 +1,2289 @@ +! Last change: JD 12 Oct 2006 4:56 am +! GAZ Oct 30 2015 changer co2 to h2o +module property_interpolate_1 +!*********************************************************************** +! Copyright 2011 Los Alamos National Security, LLC All rights reserved +! Unless otherwise indicated, this information has been authored by an +! employee or employees of the Los Alamos National Security, LLC (LANS), +! operator of the Los Alamos National Laboratory under Contract No. +! DE-AC52-06NA25396 with the U. S. Department of Energy. The U. S. +! Government has rights to use, reproduce, and distribute this +! information. The public may copy and use this information without +! charge, provided that this Notice and any statement of authorship are +! reproduced on all copies. Neither the Government nor LANS makes any +! warranty, express or implied, or assumes any liability or +! responsibility for the use of this information. +!*********************************************************************** + + + private + + public read_interpolation_data_1, & + write_interpolation_data_1, & + get_error_message_1, & + get_property_type_1, & + get_h2o_state, & + get_h2o_sat_pressure, & + get_h2o_sat_temperature, & + get_h2o_properties, & + get_h2o_sat_properties_pressure, & + get_h2o_sat_props_temperature, & + get_h2o_sat_line_props_pressure, & + get_h2o_sat_line_props_temperat, & + interpolation_arrays_deallocate_1 + + ! Reduced name length (<31 max) + !get_h2o_sat_properties_temperature, & + !get_h2o_sat_line_props_temperature, & + + + ! -- Global variables + + character*1 :: at ! "u" if inform grid; "n" if nonuniform + + integer :: nt ! Number of temperatures in array + integer :: np ! Number of pressures in array + integer :: na ! Number of arrays + real*8, allocatable :: t(:) ! Temperatures at array points + real*8, allocatable :: p(:) ! Pressures at array points + + real*8 :: t_index_offset ! Temperature offset + real*8 :: t_index_factor ! Temperature index factor + real*8 :: p_index_offset ! Pressure offset + real*8 :: p_index_factor ! Pressure offset factor + real*8 :: t_table_min ! Minimum of scaled temperatures + real*8 :: t_table_max ! Maximum of scaled temperatures + real*8 :: p_table_min ! Minimum of scaled pressures + real*8 :: p_table_max ! Maximum of scaled pressures + + character*20, allocatable :: property_type(:) ! Property type in each array + real*8, allocatable :: rarray(:,:,:) ! Array of properties + logical, allocatable :: satline(:,:) ! Cells intersected by saturation line + + integer :: nsat ! Number of saturation line vertices + real*8 :: tsat_min ! Minimum scaled temperature along sat. line + real*8 :: tsat_max ! Maximum scaled temperature along sat. line + real*8 :: psat_min ! Minimum scaled pressure along sat. line + real*8 :: psat_max ! Maximum scaled pressure along sat. line + real*8, allocatable :: tsat(:) ! Scaled temperatures along saturation line + real*8, allocatable :: psat(:) ! Scaled pressures along saturation line + integer, allocatable :: csat(:) ! Array cell number + integer, allocatable :: ssat(:) ! Type of intersection + real*8, allocatable :: msat(:) ! Scaled slope of p vs t along saturation line segment + real*8, allocatable :: lpsat(:,:) ! Liquid properties along sat. line for all arrays + real*8, allocatable :: gpsat(:,:) ! Vapour properties along sat. line for all arrays + integer :: sat_index_last_tt=0 ! Used to expedite array searching + integer :: sat_index_last_pp=0 ! Used to expedite array searching + integer :: sat_index_last_ic=0 ! Used to expedite array searching + integer :: ic_last=0 ! Used to expedite array searching + integer :: it_last=0 ! Used to expedite array searching + integer :: ip_last=0 ! Used to expedite array searching + + integer :: isatclose ! Times saturation line is numerically close to grid node + integer, allocatable :: satclose(:,:) ! Saturation line closeness index array + + character*500 :: amessage=' ' ! Error message text + + +contains + + + subroutine get_h2o_error_message(astring) + + ! -- Subroutine get_error_message gets an error message. + + implicit none + character*(*), intent(out) :: astring + + integer :: l1,l2,l + + l1=len(astring) + l2=len_trim(amessage) + if(l2.eq.0)then + astring=' ' + else + l=min(l1,l2) + astring=amessage(1:l) + end if + return + end subroutine get_h2o_error_message + + + + + subroutine read_interpolation_data_1(ifail,infile,v_1,v_2,v_3,v_4) + + ! -- Subroutine read_interpolation_data reads an interpolation dataset. + + implicit none + integer, intent(out) :: ifail + character*(*), intent(in) :: infile + + integer :: iunit,ierr,it,ip,ia,isat + real*8 :: rtemp + real*8,intent(out) :: v_1,v_2,v_3,v_4 + character*20 :: atemp + character*200 :: afile + + ifail=0 + + iunit=nextunit_1() + call addquote_1(infile,afile) + open(unit=iunit,file=infile,status='old',iostat=ierr) + if(ierr.ne.0)then + write(amessage,20) trim(afile) +20 format('Cannot open file ',a,' to read interpolation data.') + go to 9890 + end if + + ! -- The grid type is read. + + read(iunit,*) atemp + call lowcase_1(atemp) + if(atemp.eq.'uniform')then + at='u' + else if(atemp.eq.'nonuniform')then + at='n' + else + write(amessage,22) trim(afile) +22 format('First line of interpolation data file ',a,' should be "uniform" or "nonuniform".') + go to 9890 + end if + + ! -- Array table dimensions are read. + + read(iunit,*,iostat=ierr) nt,np,na + if(ierr.ne.0)then + write(amessage,40) trim(afile) +40 format('Error reading dimensional information from second line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if((nt.le.0).or.(np.le.0).or.(na.le.0))then + write(amessage,50) trim(afile) +50 format('Illegal values for one or more dimensions on second line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + + ! -- Temperature and pressure index factors and offsets are read. + + read(iunit,*,iostat=ierr) t_index_factor, t_index_offset + if(ierr.ne.0)then + write(amessage,60) trim(afile) +60 format('Error reading temperature factor and/or offset from third line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if(t_index_factor.le.0.0)then + write(amessage,70) trim(afile) +70 format('Illegal value for temperature factor on third line of interpolation data file ',a,'.') + go to 9890 + end if + + read(iunit,*,iostat=ierr) p_index_factor, p_index_offset + if(ierr.ne.0)then + write(amessage,80) trim(afile) +80 format('Error reading pressure factor and/or offset from fourth line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if(p_index_factor.le.0.0)then + write(amessage,90) trim(afile) +90 format('Illegal value for pressure factor on fourth line of interpolation data file ',a,'.') + go to 9890 + end if + + ! -- The saturation line closeness flag is read. + + read(iunit,*,iostat=ierr) isatclose + if(ierr.ne.0) then + write(amessage,92) trim(afile) +92 format('Error reading saturation line closeness index from fifth line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if(isatclose.lt.0)then + write(amessage,93) trim(afile) +93 format('Illegal value for saturation line closeness index on fifth line of ', & + 'interpolation data file ',a,'.') + go to 9890 + end if + + ! -- The temperature and pressure vectors are read. + + allocate(t(nt),p(np),stat=ierr) + if(ierr.ne.0) go to 9400 + read(iunit,*,err=9200,end=9250) + read(iunit,*,err=9200,end=9250) (t(it),it=1,nt) + read(iunit,*,err=9300,end=9350) + read(iunit,*,err=9300,end=9350) (p(ip),ip=1,np) + + ! -- The property type held within each array is now read. + + allocate(property_type(na),stat=ierr) + if(ierr.ne.0) go to 9400 + read(iunit,*,iostat=ierr) + if(ierr.ne.0)then + write(amessage,95) trim(afile) + go to 9890 + end if + do ia=1,na + read(iunit,'(a)',iostat=ierr) property_type(ia) + if(ierr.ne.0)then + write(amessage,95) trim(afile) +95 format('Error reading property type names from interpolation data file ',a,'.') + go to 9890 + end if + property_type(ia)=adjustl(property_type(ia)) + call lowcase_1(property_type(ia)) + end do + + ! -- The arrays are read. + + allocate(rarray(nt,np,na),satline(nt,np),stat=ierr) + if(ierr.ne.0) go to 9400 + if(isatclose.gt.0)then + allocate(satclose(nt,np),stat=ierr) + if(ierr.ne.0) go to 9400 + end if + + do ia=1,na + read(iunit,*,err=9100,end=9150) + do ip=1,np + read(iunit,*,err=9100,end=9150) (rarray(it,ip,ia),it=1,nt) + end do + end do + read(iunit,*,err=9120,end=9170) + do ip=1,np + read(iunit,*,err=9120,end=9170) (satline(it,ip),it=1,nt) + end do + if(isatclose.gt.0)then + read(iunit,*,err=9050,end=9070) + do ip=1,np + read(iunit,*,err=9050,end=9070) (satclose(it,ip),it=1,nt) + end do + end if + + ! -- Now we read information pertaining to intersections of the saturation line with the table. + ! -- First the dimension of the intersection table. + + read(iunit,*,iostat=ierr) + if(ierr.ne.0)then + write(amessage,97) trim(afile) + go to 9890 + end if + read(iunit,*,iostat=ierr) nsat + if(ierr.ne.0)then + write(amessage,97) trim(afile) +97 format('Error reading number of saturation line vertices from interpolation data file ',a,'.') + go to 9890 + end if + if(nsat.le.0)then + write(amessage,120) trim(afile) +120 format('Number of saturation line vertices supplied as zero or less in interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + + ! -- Saturation Data is read. + + allocate(tsat(nsat),psat(nsat),stat=ierr) + if(ierr.ne.0) go to 9400 + allocate(csat(nsat),ssat(nsat),msat(nsat),stat=ierr) + if(ierr.ne.0) go to 9400 + read(iunit,*,err=9450,end=9450) + do isat=1,nsat + read(iunit,*,err=9450,end=9450) psat(isat),tsat(isat),msat(isat),csat(isat),ssat(isat) + end do + + ! -- The extremes are evaluated. + + tsat_min=tsat(1) + tsat_max=tsat(nsat) + psat_min=psat(1) + psat_max=psat(nsat) + + ! -- Liquid properties along the saturation line are now read. + + allocate(lpsat(nsat,na),gpsat(nsat,na),stat=ierr) + if(ierr.ne.0) go to 9400 + atemp='liquid properties' + read(iunit,*,err=9500,end=9500) + read(iunit,*,err=9500,end=9500) + read(iunit,*,err=9500,end=9500) + do isat=1,nsat + read(iunit,*,err=9500,end=9500) (lpsat(isat,ia),ia=1,na) + end do + + atemp='vapour properties' + read(iunit,*,err=9500,end=9500) + read(iunit,*,err=9500,end=9500) + read(iunit,*,err=9500,end=9500) + do isat=1,nsat + read(iunit,*,err=9500,end=9500) (gpsat(isat,ia),ia=1,na) + end do + + ! -- The coordinates of intersection of the saturation line are now scaled for the uniform case. + + if(at.eq.'u')then + do isat=1,nsat + tsat(isat)=(tsat(isat)-t_index_offset)*t_index_factor + end do + do isat=1,nsat + psat(isat)=(psat(isat)-p_index_offset)*p_index_factor + end do + + ! -- Slopes of saturation line segments are now scaled. + + rtemp=p_index_factor/t_index_factor + do isat=1,nsat + msat(isat)=msat(isat)*rtemp + end do + + ! -- Table coordinates are now scaled for the uniform case. + + do it=1,nt + t(it)=(t(it)-t_index_offset)*t_index_factor + end do + do ip=1,np + p(ip)=(p(ip)-p_index_offset)*p_index_factor + end do + + end if + + ! -- The scaled saturation line limits are now calculated. + + tsat_min=tsat(1) + tsat_max=tsat(nsat) + psat_min=psat(1) + psat_max=psat(nsat) + + ! -- The scaled table limits are now calculated + + t_table_min=t(1) + t_table_max=t(nt) + p_table_min=p(1) + p_table_max=p(np) + + v_1 = t_table_min + v_2 = t_table_max + v_3 = p_table_min + v_4 = p_table_max + + close(unit=iunit) + + return + + +9050 write(amessage,9060) trim(afile) +9060 format('Error reading saturation line closeness array from interpolation data ', & + 'file ',a,'.') + go to 9890 +9070 write(amessage,9080) trim(afile) +9080 format('Premature end encountered to interpolation data file ',a, & + ' while reading saturation line closeness array.') + go to 9890 +9100 write(amessage,9010) trim(property_type(ia)),trim(afile) +9010 format('Error reading ',a,' array from interpolation data file ',a,'.') + go to 9890 +9120 write(amessage,9130) trim(afile) +9130 format('Error reading saturation line intersection array from interpolation data ', & + 'file ',a,'.') + go to 9890 +9150 write(amessage,9160) trim(afile),trim(property_type(ia)) +9160 format('Premature end encountered to interpolation data file ',a, & + ' while reading ',a,' array.') + go to 9890 +9170 write(amessage,9180) trim(afile) +9180 format('Premature end encountered to interpolation data file ',a, & + ' while reading saturation line intersection array.') + go to 9890 +9200 write(amessage,9210) trim(afile) +9210 format('Error reading table temperatures from interpolation data file ',a,'.') + go to 9890 +9250 write(amessage,9260) trim(afile) +9260 format('Premature end to file ',a,' encountered while reading table temperatures.') + go to 9890 +9300 write(amessage,9310) trim(afile) +9310 format('Error reading table pressures from interpolation array file ',a,'.') + go to 9890 +9350 write(amessage,9360) trim(afile) +9360 format('Premature end to file ',a,' encountered while reading table pressures.') + go to 9890 +9400 write(amessage,9410) +9410 format('Error in allocating memory for h2o interpolation data arrays.') + go to 9890 +9450 write(amessage,9460) trim(afile) +9460 format('Error reading saturation line data from interpolation ', & + 'data file ',a,'.') + go to 9890 +9500 write(amessage,9510) trim(atemp),trim(afile) +9510 format('Error reading saturation line ',a,' from interpolation data file ',a,'.') + go to 9890 + + + +9890 ifail=1 + close(unit=iunit,iostat=ierr) + return + + + end subroutine read_interpolation_data_1 + + + + subroutine get_h2o_property_type(ifail,ind,astring) + + ! -- Subroutine GET_h2o_PROPERTY_TYPE retrieves the property type pertaining to an array index. + + implicit none + + integer, intent(out) :: ifail + integer, intent(in) :: ind + character*(*), intent(out) :: astring + + integer :: l1,l2,l + + ifail=0 + if((ind.lt.1).or.(ind.gt.na))then + write(amessage,10) +10 format('Error in subroutine GET_h2o_PROPERTY_TYPE: supplied index out of range.') + ifail=1 + return + end if + + l1=len(astring) + l2=len_trim(property_type(ind)) + l=min(l1,l2) + astring=property_type(ind)(1:l) + + return + end subroutine get_h2o_property_type + + + + subroutine get_h2o_state(ifail,temperature,pressure,state) + + ! -- Subroutine GET_h2o_STATE returns the state of h2o at the requested + ! (unscaled) temperature and pressure. + + ! -- States are as follows:- + ! 1 - liquid + ! 2 - vapour + ! 3 - supercritical + ! 4 - exactly on saturation line + + implicit none + integer, intent(out) :: ifail + real*8, intent(in) :: temperature, pressure + integer, intent(out) :: state + + real*8 tt,pp + + ifail=0 + tt=(temperature-t_index_offset)*t_index_factor + pp=(pressure-p_index_offset)*p_index_factor + + call get_state_1(ifail,tt,pp,state) + + return + + end subroutine get_h2o_state + + + + subroutine get_state_1(ifail,tt,pp,state) + + ! -- Subroutine GET_STATE_1 returns the state of h2o at the requested + ! scaled temperature and pressure. + + ! -- States are as follows:- + ! 1 - liquid (new state: liquid, old state liquid) + ! 2 - vapour (new state: 2-phase, old state: vapor) + ! 3 - supercritical (new state: vapor, old state: supercritical) + ! 4 - exactly on saturation line (new state: supercritical, old state: 2-phase) + + implicit none + integer, intent(out) :: ifail + real*8, intent(in) :: tt,pp + integer, intent(out) :: state + + integer isat + real*8 p_ref + + ! -- Easy selections are made first. + + ifail=0 + + if(tt.gt.tsat_max)then + if(pp.lt.psat_max)then + state=3 + return + else + state=4 + return + end if + else + if(pp.gt.psat_max)then + state=1 + return + end if + end if + + if((pp.lt.p_table_min).or.(tt.lt.t_table_min))then + write(amessage,20) +20 format('Error in subroutine GET_STATE_1. Temperature and/or pressure out of range of ', & + 'interpolation table.') + go to 9890 + end if + ! -- Note that the above test assumes that the table extends to higher temperatures and pressures + ! than those prevailing at the end of the saturation line. + + ! -- We now determine what column of the table we are in. + + call which_index_1(tt,nsat,tsat,isat,sat_index_last_tt) + + if (isat .eq. 0) then + ! Failed to find valid table index + write(amessage,20) + go to 9890 + end if + + p_ref=psat(isat)+msat(isat)*(tt-tsat(isat)) + if(pp.gt.p_ref)then + state=1 + else if(pp.lt.p_ref)then + state=3 + else + state=2 + end if + + return + +9890 ifail=1 + return + + end subroutine get_state_1 + + + + subroutine which_sat_index_array_1(it,ip,isat) + + ! -- Subroutine WHICH_SAT_INDEX_ARRAY_1 finds the index of the saturation-line cells + ! pertaining to a particular cell in the interpolation table. It is assumed that + ! the saturation line actually passes through this cell. So this is not checked + ! in order to speed execution time. + + implicit none + integer, intent(in) :: it,ip + integer, intent(out) :: isat + + integer :: ic,i + + call tp2cell_1(it,ip,ic) + if(sat_index_last_ic.eq.0) then + sat_index_last_ic=1 + end if + + if(ic.eq.ic_last)then + isat=sat_index_last_ic + return + end if + if(sat_index_last_ic.ne.1)then + if(ic.eq.csat(sat_index_last_ic-1))then + isat=sat_index_last_ic-1 + go to 200 + end if + else if(sat_index_last_ic.ne.nsat)then + if(ic.eq.csat(sat_index_last_ic+1))then + isat=sat_index_last_ic+1 + go to 200 + end if + end if + +100 continue + do i=sat_index_last_ic,nsat-1 ! hopefully the "-1" is ok here. + if(ic.eq.csat(i))then + isat=i + go to 200 + end if + end do + do i=sat_index_last_ic-1,1,-1 + if(ic.eq.csat(i))then + isat=i + go to 200 + end if + end do + + write(*,*) 'Error in subroutine WHICH_SAT_INDEX_ARRAY_1.' + write(*,*) 'it = ',it + write(*,*) 'ip = ',ip + write(*,*) 'ic = ',ic + stop + +200 ic_last=ic + sat_index_last_ic=isat + return + + end subroutine which_sat_index_array_1 + + + + + subroutine which_index_1(rr,nr,r,ind,ind_last) + + ! -- Subroutine WHICH_INDEX_1 calculates the segment of an array of numbers in which a current number lies. + ! For speed of execution, it is assumed that rr is within range of the search domain (i.e. it is assumed + ! that this has been previously tested.) + + implicit none + real*8, intent(in) :: rr + integer, intent(in) :: nr + real*8, intent(in) :: r(nr) + integer, intent(out) :: ind + integer, intent(inout) :: ind_last + + integer :: i + + if((ind_last.le.0).or.(ind_last.ge.nr)) then + ind_last=1 + end if + + if(rr.ge.r(ind_last))then + do i=ind_last+1,nr + if(rr.le.r(i))then + ind=i-1 + ind_last=ind + return + end if + end do + else + do i=ind_last-1,1,-1 + if(rr.ge.r(i))then + ind=i + ind_last=ind + return + end if + end do + end if + + ind = 0 + + end subroutine which_index_1 + + + + subroutine get_h2o_sat_pressure(ifail,temperature,pressure,dp_dt) + + ! -- Subroutine GET_h2o_SAT_PRESSURE gets the saturation pressure corresponding to a certain + ! temperature. + + ! -- Note carefully. The return value of ifail is -1 if temperature is above end of saturation line. + + ! -- Question - will FEHM be supplying variables like temperature in double precision. + + implicit none + integer, intent(out) :: ifail + real*8, intent(in) :: temperature + real*8, intent(out) :: pressure + real*8, intent(out) :: dp_dt + + real*8 :: tt,pp,mm + + ifail=0 + tt=(temperature-t_index_offset)*t_index_factor + call get_sat_pressure_1(ifail,tt,pp,mm) + if(ifail.ne.0) return + pressure=pp/p_index_factor+p_index_offset + dp_dt=mm*t_index_factor/p_index_factor + + return + + end subroutine get_h2o_sat_pressure + + + + subroutine get_sat_pressure_1(ifail,tt,pp,mm) + + ! -- Subroutine GET_SAT_PRESSURE_1 gets the scaled saturation pressure corresponding to a certain + ! scaled temperature. + + implicit none + integer, intent(out) :: ifail + real*8, intent(in) :: tt + real*8, intent(out) :: pp + real*8, intent(out) :: mm + + integer :: isat + + ifail=0 + if(tt.gt.tsat_max)then + ifail=-1 ! No error message as this is likely to be a common occurrence. + return + else if(tt.lt.tsat_min)then + ifail=1 + write(amessage,10) +10 format('Error in subroutine GET_SAT_PRESSURE_1: supplied temperature is out of ', & + 'range of interpolation table.') + return + else + call which_index_1(tt,nsat,tsat,isat,sat_index_last_tt) + pp=psat(isat)+msat(isat)*(tt-tsat(isat)) + mm=msat(isat) + end if + + return + + end subroutine get_sat_pressure_1 + + + + subroutine get_h2o_sat_temperature(ifail,pressure,temperature,dt_dp) + + ! -- Subroutine GET_h2o_SAT_TEMPERATURE gets the saturation temperature corresponding to a certain + ! pressure. + + ! -- Note carefully. The return value of ifail is -1 if pressure is above end of saturation line. + + ! -- Question - will FEHM be supplying variables like temperature in double precision. + + implicit none + integer, intent(out) :: ifail + real*8, intent(in) :: pressure + real*8, intent(out) :: temperature + real*8, intent(out) :: dt_dp + + real*8 :: pp,tt,mm + + ifail=0 + pp=(pressure-p_index_offset)*p_index_factor + call get_sat_temperature_1(ifail,pp,tt,mm) + if(ifail.ne.0) return + temperature=tt/t_index_factor+t_index_offset + dt_dp=p_index_factor/mm/t_index_factor + + return + + end subroutine get_h2o_sat_temperature + + + + subroutine get_sat_temperature_1(ifail,pp,tt,mm) + + ! -- Subroutine GET_SAT_TEMPERATURE_1 gets the scaled saturation temperature corresponding to a certain + ! scaled pressure. + + implicit none + integer, intent(out) :: ifail + real*8, intent(in) :: pp + real*8, intent(out) :: tt + real*8, intent(out) :: mm + + integer :: isat + + ifail=0 + if(pp.gt.psat_max)then + ifail=-1 ! No error message as this is likely to be a common occurrence. + return + else if(pp.lt.psat_min)then + ifail=1 + write(amessage,10) +10 format('Error in subroutine GET_SAT_TEMPERATURE_1: supplied pressure is out of ', & + 'range of interpolation table.') + return + else + call which_index_1(pp,nsat,psat,isat,sat_index_last_pp) + tt=tsat(isat)+(pp-psat(isat))/msat(isat) + mm=msat(isat) + end if + return + + end subroutine get_sat_temperature_1 + + + + subroutine rectangle_interpolation_factors_1(x1,x2,y1,y2,xp,yp,fac) + + ! -- Subroutine RECTANGULAR_INTERPOLATION_FACTORS_1 computes factors for rectangular interpolation. + + implicit none + real*8, intent(in) :: x1,x2,y1,y2 + real*8, intent(in) :: xp,yp + real*8, intent(out) :: fac(4) + + real*8 :: y2_yp,x2_xp,xp_x1,yp_y1,den + + y2_yp=y2-yp + x2_xp=x2-xp + xp_x1=xp-x1 + yp_y1=yp-y1 + den=1.0/((x2-x1)*(y2-y1)) + + fac(1)=y2_yp*x2_xp*den + fac(2)=y2_yp*xp_x1*den + fac(3)=yp_y1*x2_xp*den + fac(4)=yp_y1*xp_x1*den + + + return + + end subroutine rectangle_interpolation_factors_1 + + + + subroutine quad_interpolate_1(fac,z1,z2,z3,z4,rval) + + ! -- Subroutine QUAD_INTERPOLATE_1 performs interpolation where there are four interpolation factors. + + implicit none + real*8, intent(in) :: fac(4) + real*8, intent(in) :: z1,z2,z3,z4 + real*8, intent(out) :: rval + + rval=fac(1)*z1+fac(2)*z2+fac(3)*z3+fac(4)*z4 + return + + end subroutine quad_interpolate_1 + + + + + subroutine triangle_interpolation_factors_1 (x1,x2,x3,y1,y2,y3,xp,yp,fac) + + ! -- Subroutine TRIANGE_INTERPOLATION_FACTORS_1 computes interpolation factors for a triangle. + + implicit none + real*8, intent(in) :: x1,x2,x3,y1,y2,y3 + real*8, intent(in) :: xp,yp + real*8, intent(out) :: fac(3) + + real*8 :: det,x1_xp,x2_xp,x3_xp,y1_yp,y2_yp,y3_yp + + det=1.0/((x2-x1)*(y3-y1)-(x3-x1)*(y2-y1)) + x1_xp=x1-xp + x2_xp=x2-xp + x3_xp=x3-xp + y1_yp=y1-yp + y2_yp=y2-yp + y3_yp=y3-yp + fac(1)=(x2_xp*y3_yp-x3_xp*y2_yp)*det + fac(2)=(x3_xp*y1_yp-x1_xp*y3_yp)*det + fac(3)=(x1_xp*y2_yp-x2_xp*y1_yp)*det + return + + end subroutine triangle_interpolation_factors_1 + + + + subroutine triangle_interpolate_1(fac,z1,z2,z3,rval) + + ! -- Subroutine TRIANGLE_INTERPOLATE_1 performs triangle interpolation on the basis of pre-calculated + ! interpolation factors. + + implicit none + real*8, intent(in) :: fac(3) + real*8, intent(in) :: z1,z2,z3 + real*8, intent(out) :: rval + + + rval=fac(1)*z1+fac(2)*z2+fac(3)*z3 + return + + end subroutine triangle_interpolate_1 + + + + subroutine linear_interpolation_factors_1(x1,x2,xp,fac) + + ! -- Subroutine LINEAR_INTERPOLATION_FACTORS_1 computes interpolation factors along a line. + + implicit none + real*8, intent(in) :: x1,x2 + real*8, intent(in) :: xp + real*8, intent(out) :: fac(2) + + real*8 :: x2_x1 + + x2_x1=x2-x1 + fac(1)=(x2-xp)/x2_x1 + fac(2)=(xp-x1)/x2_x1 + + return + + end subroutine linear_interpolation_factors_1 + + !parallelepiped_interpolation_factors + subroutine parallelepiped_interp_factors_1(itype,jtype,x1,x2,x3,x4,y1,y2,y3,y4,xp,yp,fac) + + ! -- Subroutine PARALLELEPIPED_INTERPOLATION_FACTORS_1 computes interpolation factors for a pararallelepiped + ! in which the parallel lines are horizontal (itype=2) or vertical (itype=4). The jtype variable + ! indicates which of the other sides is non-vertical. + + implicit none + integer, intent(in) :: itype,jtype + real*8, intent(in) :: x1,x2,x3,x4,y1,y2,y3,y4 + real*8, intent(in) :: xp,yp + real*8, intent(out) :: fac(4) + + real*8 :: x5_x1,x2_x1,x4_x1,x2_x5,x2_x3,xp_x1,x2_xp + real*8 :: w1,w2,x5,y5 + real*8 :: l1,l2,l3,l4,l5,l6 + real*8 :: yp_y1,y3_yp,y3_y1,y3_y2,y3_y5,y4_y1,y5_y1 + real*8 :: a + + + if(itype.eq.2)then + if(jtype.eq.1)then + x5=x2+(yp-y1)/(y3-y1)*(x4-x2) + x5_x1=x5-x1 + x2_x1=x2-x1 + x4_x1=x4-x1 + w1=(xp-x1)/x5_x1 + w2=(x5-xp)/x5_x1 + l1=w1*x2_x1 + l2=w2*x2_x1 + l3=w1*x4_x1 + l4=w2*x4_x1 + l5=w1*x5_x1 + l6=w2*x5_x1 + else + x5=x1+(yp-y1)/(y3-y1)*(x3-x1) + x2_x5=x2-x5 + x2_x1=x2-x1 + x2_x3=x2-x3 + w1=(xp-x5)/x2_x5 + w2=(x2-xp)/x2_x5 + l1=w1*x2_x1 + l2=w2*x2_x1 + l3=w1*x2_x3 + l4=w2*x2_x3 + l5=w1*x2_x5 + l6=w2*x2_x5 + end if + yp_y1=yp-y1 + y3_yp=y3-yp + y3_y1=y3-y1 + a=1.0/(l1+l2+l3+l4)/y3_y1 + fac(1)=(l4+l6)*y3_yp*a + fac(2)=(l3+l5)*y3_yp*a + fac(3)=(l2+l6)*yp_y1*a + fac(4)=(l1+l5)*yp_y1*a + else if(itype.eq.4)then + if(jtype.eq.1)then + y5=y1+(xp-x1)/(x2-x1)*(y2-y1) + y3_y1=y3-y1 + y3_y2=y3-y2 + y3_y5=y3-y5 + w1=(yp-y5)/y3_y5 + w2=(y3-yp)/y3_y5 + l1=w1*y3_y1 + l2=w2*y3_y1 + l3=w1*y3_y2 + l4=w2*y3_y2 + l5=w1*y3_y5 + l6=w2*y3_y5 + else + y5=y3+(xp-x1)/(x2-x1)*(y4-y3) + y3_y1=y3-y1 + y4_y1=y4-y1 + y5_y1=y5-y1 + w1=(yp-y1)/y5_y1 + w2=(y5-yp)/y5_y1 + l1=w1*y3_y1 + l2=w2*y3_y1 + l3=w1*y4_y1 + l4=w2*y4_y1 + l5=w1*y5_y1 + l6=w2*y5_y1 + end if + xp_x1=xp-x1 + x2_xp=x2-xp + x2_x1=x2-x1 + a=1.0/(l1+l2+l3+l4)/(x2_x1) + fac(1)=(l4+l6)*x2_xp*a + fac(2)=(l2+l6)*xp_x1*a + fac(3)=(l3+l5)*x2_xp*a + fac(4)=(l1+l5)*xp_x1*a + end if + + return + + end subroutine parallelepiped_interp_factors_1 + ! parallelepiped_interpolation_factors + + + + subroutine project_to_saturation_line_1(itype,xc,xa,xb,yc,ya,yb,xp,yp,xi,yi) + + ! -- Subroutine PROJECT_TO_SATURATION_LINE_1 is used in modified rectangular interplation for + ! cells in which type 1 or type 3 intersection of the saturation line occurs. It calculates + ! the projection of interpolation points into the saturation line. + + implicit none + integer, intent(in) :: itype + real*8, intent(in) :: xc,xa,xb,yc,ya,yb + real*8, intent(in) :: xp,yp + real*8, intent(out) :: xi,yi + + real*8 :: xc_xp,mp,mi + + xc_xp=xc-xp + if(abs(xc_xp).lt.1e-4*(xc+xp))then ! arbitrary + xi=xc + if(itype.eq.1)then + yi=ya + else + yi=yb + end if + return + end if + mp=(yc-yp)/(xc-xp) + mi=(yb-ya)/(xb-xa) + xi=(mp*xp-mi*xa-(yp-ya))/(mp-mi) + yi=mi*(xi-xa)+ya + + return + + end subroutine project_to_saturation_line_1 + + + + subroutine get_h2o_properties(ifail,iphase,ncode,icode,temperature,pressure,value) + + ! -- Subroutine GET_h2o_PROPERTIES obtains h2o properties through interpolation from a table. + + implicit none + + integer, intent(out) :: ifail + integer, intent(in) :: iphase + integer, intent(in) :: ncode + integer, intent(in) :: icode(ncode) + real*8, intent(in) :: temperature + real*8, intent(in) :: pressure + real*8, intent(out) :: value(ncode) + + integer :: it,ip,isat,itype,istart,i,ii,iit,iip + real*8 :: tt,pp,ti,pi,zi + real*8 :: z1,z2,z3,z4 + real*8 :: fac(5),faci(4),facp(4),facl(2),rarr(4) + + ! -- We will not check that NCODE is no greater than NA - it would take too much time to do this + ! on every occasion that this subroutine is called. + + ifail=0 + + if(iphase.eq.4)then + write(amessage,5) +5 format('Error calling subroutine TABLE_INTERPOLATION_1; this subroutine should ', & + 'not be called with IPHASE equal to 4.') + go to 9890 + end if + tt=(temperature-t_index_offset)*t_index_factor + pp=(pressure-p_index_offset)*p_index_factor + if((tt.lt.t_table_min).or.(tt.gt.t_table_max).or. & + (pp.lt.p_table_min).or.(pp.gt.p_table_max))then + write(amessage,10) +10 format('Temperature or pressure out of interpolation range in call to ', & + 'subroutine GET_h2o_PROPERTIES.') + go to 9890 + end if + if(at.eq.'u')then + it_last=int(tt) + ip_last=int(pp) + end if + call which_index_1(tt,nt,t,it,it_last) + call which_index_1(pp,np,p,ip,ip_last) + + do i=1,ncode + if(icode(i).ne.0)then + istart=i + go to 50 + end if + end do + write(amessage,40) +40 format('Ilegal call to subroutine GET_h2o_PROPERTIES. No interpolation ', & + 'has been requested.') + go to 9890 +50 continue + + if(.not.satline(it,ip))then + + ! The saturation line does not intersect this cell. + ! Note that we won't even check that the phase is correct. We will assume for the sake + ! of speed that it is already so. + + call rectangle_interpolation_factors_1(t(it),t(it+1),p(ip),p(ip+1),tt,pp,fac) + do i=istart,ncode + if(icode(i).ne.0)then + if(isatclose.eq.0)then + call quad_interpolate_1(fac,rarray(it,ip,i),rarray(it+1,ip,i),rarray(it,ip+1,i), & + rarray(it+1,ip+1,i),value(i)) + else + ii=0 + do iip=ip,ip+1 + do iit=it,it+1 + ii=ii+1 + isat=satclose(iit,iip) + if(isat.eq.0)then + rarr(ii)=rarray(iit,iip,i) + else + if(iphase.eq.1)then + rarr(ii)=lpsat(isat,i) + else + rarr(ii)=gpsat(isat,i) + end if + end if + end do + end do + call quad_interpolate_1(fac,rarr(1),rarr(2),rarr(3),rarr(4),value(i)) + end if + end if + end do + return + else + call which_sat_index_array_1(it,ip,isat) + itype=ssat(isat) + + if(iphase.eq.1)then + if((itype.eq.1).or.(itype.eq.5).or.(itype.eq.6).or.(itype.eq.8))then + call triangle_interpolation_factors_1(tsat(isat),t(it), tsat(isat+1), & + psat(isat),p(ip+1),psat(isat+1),tt,pp,fac) + do i=istart,ncode + call triangle_interpolate_1(fac,lpsat(isat,i),rarray(it,ip+1,i),lpsat(isat+1,i),value(i)) + end do + return + else if(itype.eq.3)then + call project_to_saturation_line_1(3,t(it+1),tsat(isat),tsat(isat+1), & + p(ip),psat(isat),psat(isat+1),tt,pp,ti,pi) + call rectangle_interpolation_factors_1(t(it),t(it+1),p(ip),p(ip+1),ti,pi,faci) + call rectangle_interpolation_factors_1(t(it),t(it+1),p(ip),p(ip+1),tt,pp,facp) + call linear_interpolation_factors_1(tsat(isat),tsat(isat+1),ti,facl) ! Assumes sat line not too steep. + do i=istart,ncode + if(icode(i).ne.0)then + z1=rarray(it,ip,i) + z3=rarray(it,ip+1,i) + z4=rarray(it+1,ip+1,i) + if(abs(faci(2)).gt.1.0e-5)then ! arbitrary + zi=facl(1)*lpsat(isat,i)+facl(2)*lpsat(isat+1,i) + z2=(zi-faci(1)*z1-faci(3)*z3-faci(4)*z4)/faci(2) + else + z2=0.5*(lpsat(isat,i)+lpsat(isat+1,i)) + end if + call quad_interpolate_1(facp,z1,z2,z3,z4,value(i)) + end if + end do + return + else if((itype.eq.2).or.(itype.eq.9))then + ! parallelepiped_interpolation_factors + call parallelepiped_interp_factors_1(2,1,t(it),tsat(isat),t(it),tsat(isat+1), & + p(ip),psat(isat),p(ip+1),p(isat+1),tt,pp,fac) + do i=istart,ncode + if(icode(i).ne.0)then + call quad_interpolate_1(fac,rarray(it,ip,i),lpsat(isat,i),rarray(it,ip+1,i),lpsat(isat+1,i),value(i)) + end if + end do + return + else if((itype.eq.4).or.(itype.eq.7))then + call parallelepiped_interp_factors_1(4,1,tsat(isat),tsat(isat+1),t(it),t(it+1), & + psat(isat),psat(isat+1),p(ip+1),p(ip+1),tt,pp,fac) + do i=istart,ncode + if(icode(i).ne.0)then + call quad_interpolate_1(fac,lpsat(isat,i),lpsat(isat+1,i),rarray(it,ip+1,i), & + rarray(it+1,ip+1,i),value(i)) + end if + end do + return + end if + else + if(itype.eq.1)then + call project_to_saturation_line_1(1,t(it),tsat(isat),tsat(isat+1), & + p(ip+1),psat(isat),psat(isat+1),tt,pp,ti,pi) + call rectangle_interpolation_factors_1(t(it),t(it+1),p(ip),p(ip+1),ti,pi,faci) + call rectangle_interpolation_factors_1(t(it),t(it+1),p(ip),p(ip+1),tt,pp,facp) + call linear_interpolation_factors_1(tsat(isat),tsat(isat+1),ti,facl) ! assumes sat line not too steep + do i=istart,ncode + if(icode(i).ne.0)then + z1=rarray(it,ip,i) + z2=rarray(it+1,ip,i) + z4=rarray(it+1,ip+1,i) + if(abs(faci(3)).gt.1.0e-5)then + zi=facl(1)*gpsat(isat,i)+facl(2)*gpsat(isat+1,i) + z3=(zi-faci(1)*z1-faci(2)*z2-faci(4)*z4)/faci(3) + else + z3=0.5*(gpsat(isat,i)+gpsat(isat+1,i)) + end if + call quad_interpolate_1(facp,z1,z2,z3,z4,value(i)) + end if + end do + return + else if((itype.eq.3).or.(itype.eq.6).or.(itype.eq.7).or.(itype.eq.9))then + call triangle_interpolation_factors_1(tsat(isat),tsat(isat+1),t(it+1), & + psat(isat),psat(isat+1),p(ip),tt,pp,fac) + do i=istart,ncode + if(icode(i).ne.0)then + call triangle_interpolate_1(fac,gpsat(isat,i),gpsat(isat+1,i),rarray(it+1,ip,i),value(i)) + end if + end do + return + else if((itype.eq.2).or.(itype.eq.5))then + call parallelepiped_interp_factors_1(2,2,tsat(isat),t(it+1),tsat(isat+1),t(it+1), & + psat(isat),p(ip),psat(isat+1),p(ip+1),tt,pp,fac) + do i=istart,ncode + if(icode(i).ne.0)then + call quad_interpolate_1(fac,gpsat(isat,i),rarray(it+1,ip,i),gpsat(isat+1,i), & + rarray(it+1,ip+1,i),value(i)) + end if + end do + return + else if((itype.eq.4).or.(itype.eq.8))then + call parallelepiped_interp_factors_1(4,2,t(it),t(it+1),tsat(isat),tsat(isat+1), & + p(ip),p(ip),psat(isat),psat(isat+1),tt,pp,fac) + do i=istart,ncode + if(icode(i).ne.0)then + call quad_interpolate_1(fac,rarray(it,ip,i),rarray(it+1,ip,i),gpsat(isat,i), & + gpsat(isat+1,i),value(i)) + end if + end do + return + end if + end if + end if + + return +9890 ifail=1 + return + + end subroutine get_h2o_properties + + + + subroutine get_h2o_sat_properties_pressure(ifail,iphase,ncode,icode,pressure,value) + + ! -- Subroutine GET_h2o_SAT_PROPERTIES_PRESSURE gets saturation properties pertaining to a certain + ! pressure. + + implicit none + + integer, intent(out) :: ifail + integer, intent(in) :: iphase + integer, intent(in) :: ncode + integer, intent(in) :: icode(ncode) + real*8, intent(in) :: pressure + real*8, intent(out) :: value(ncode) + + integer :: isat,i + real*8 :: pp + real*8 :: fac(2) + + ifail=0 + + pp=(pressure-p_index_offset)*p_index_factor + if(pp.gt.psat_max)then + ifail=-1 + return + else if(pp.lt.psat_min)then + write(amessage,10) +10 format('Error in subroutine GET_h2o_SAT_PROPERTIES_PRESSURE: pressure out of table ', & + 'interpolation range.') + ifail=1 + return + else + call which_index_1(pp,nsat,psat,isat,sat_index_last_pp) + call linear_interpolation_factors_1(psat(isat),psat(isat+1),pp,fac) + if(iphase.eq.1)then + do i=1,ncode + if(icode(i).ne.0)then + value(i)=lpsat(isat,i)*fac(1)+lpsat(isat+1,i)*fac(2) + end if + end do + else if(iphase.eq.2)then + do i=1,ncode + if(icode(i).ne.0)then + value(i)=gpsat(isat,i)*fac(1)+gpsat(isat+1,i)*fac(2) + end if + end do + else + write(amessage,20) +20 format('Error in subroutine GET_h2o_SAT_PROPERTIES_PRESSURE: phase code must be "1" or "2".') + ifail=1 + return + end if + end if + + return + + end subroutine get_h2o_sat_properties_pressure + + + !get_h2o_sat_properties_temperature + subroutine get_h2o_sat_props_temperature(ifail,iphase,ncode,icode,temperature,value) + + ! -- Subroutine GET_h2o_SAT_PROPERTIES_TEMPERATURE gets saturation properties pertaining to a certain + ! temperature. + + implicit none + + integer, intent(out) :: ifail + integer, intent(in) :: iphase + integer, intent(in) :: ncode + integer, intent(in) :: icode(ncode) + real*8, intent(in) :: temperature + real*8, intent(out) :: value(ncode) + + integer :: isat,i + real*8 :: tt + real*8 :: fac(2) + + ifail=0 + + tt=(temperature-t_index_offset)*t_index_factor + if(tt.gt.tsat_max)then + ifail=-1 + return + else if(tt.lt.tsat_min)then + write(amessage,10) +10 format('Error in subroutine GET_h2o_SAT_PROPERTIES_TEMPERATURE: temperature out of table ', & + 'interpolation range.') + ifail=1 + return + else + call which_index_1(tt,nsat,tsat,isat,sat_index_last_tt) + call linear_interpolation_factors_1(tsat(isat),tsat(isat+1),tt,fac) + if(iphase.eq.1)then + do i=1,ncode + if(icode(i).ne.0)then + value(i)=lpsat(isat,i)*fac(1)+lpsat(isat+1,i)*fac(2) + end if + end do + else if(iphase.eq.2)then + do i=1,ncode + if(icode(i).ne.0)then + value(i)=gpsat(isat,i)*fac(1)+gpsat(isat+1,i)*fac(2) + end if + end do + else + write(amessage,20) +20 format('Error in subroutine GET_h2o_SAT_PROPERTIES_TEMPERATURE: phase code must be "1" or "2".') + ifail=1 + return + end if + end if + + return + + end subroutine GET_h2o_SAT_PROPS_TEMPERATURE + ! get_h2o_sat_properties_temperature + + + + subroutine get_h2o_sat_line_props_pressure(ifail,iphase,ncode,icode,pressure,value) + + ! -- Subroutine GET_h2o_SAT_LINE_PROPS_PRESSURE gets saturation properties pertaining + ! to a certain pressure. However derivatives are taken along the actual saturation line. + + implicit none + + integer, intent(out) :: ifail + integer, intent(in) :: iphase + integer, intent(in) :: ncode + integer, intent(in) :: icode(ncode) + real*8, intent(in) :: pressure + real*8, intent(out) :: value(ncode) + + integer :: isat,i + real*8 :: pp + real*8 :: delta_p,delta_t + real*8 :: fac(2) + + ifail=0 + + pp=(pressure-p_index_offset)*p_index_factor + if(pp.gt.psat_max)then + ifail=-1 + return + else if(pp.lt.psat_min)then + write(amessage,10) +10 format('Error in subroutine GET_h2o_SAT_LINE_PROPS_PRESSURE: ', & + 'pressure out of table interpolation range.') + ifail=1 + return + else + call which_index_1(pp,nsat,psat,isat,sat_index_last_pp) + call linear_interpolation_factors_1(psat(isat),psat(isat+1),pp,fac) + delta_p=psat(isat+1)-psat(isat) + delta_t=tsat(isat+1)-tsat(isat) + if(iphase.eq.1)then + do i=1,ncode + if(icode(i).ne.0)then + if((i.eq.3).or.(i.eq.6).or.(i.eq.9))then + value(i)=(lpsat(isat+1,i-2)-lpsat(isat,i-2))/delta_p + else if((i.eq.2).or.(i.eq.5).or.(i.eq.8))then + value(i)=(lpsat(isat+1,i-1)-lpsat(isat,i-1))/delta_t + else + value(i)=lpsat(isat,i)*fac(1)+lpsat(isat+1,i)*fac(2) + end if + end if + end do + else if(iphase.eq.2)then + do i=1,ncode + if(icode(i).ne.0)then + if((i.eq.3).or.(i.eq.6).or.(i.eq.9))then + value(i)=(gpsat(isat+1,i-2)-gpsat(isat,i-2))/delta_p + else if((i.eq.2).or.(i.eq.5).or.(i.eq.8))then + value(i)=(gpsat(isat+1,i-1)-gpsat(isat,i-1))/delta_t + else + value(i)=gpsat(isat,i)*fac(1)+gpsat(isat+1,i)*fac(2) + end if + end if + end do + else + write(amessage,20) +20 format('Error in subroutine GET_h2o_SAT_LINE_PROPS_PRESSURE: ', & + 'phase code must be "1" or "2".') + ifail=1 + return + end if + end if + + return + + end subroutine get_h2o_sat_line_props_pressure + + + ! get_h2o_sat_line_props_temperature + subroutine get_h2o_sat_line_props_temperat(ifail,iphase,ncode,icode,temperature,value) + + ! -- Subroutine GET_h2o_SAT_LINE_PROPS_TEMPERATURE gets saturation properties pertaining ', + ! to a certain temperature. However derivatives are taken along the actual saturation line. + + implicit none + + integer, intent(out) :: ifail + integer, intent(in) :: iphase + integer, intent(in) :: ncode + integer, intent(in) :: icode(ncode) + real*8, intent(in) :: temperature + real*8, intent(out) :: value(ncode) + + integer :: isat,i + real*8 :: tt + real*8 :: delta_p,delta_t + real*8 :: fac(2) + + ifail=0 + + tt=(temperature-t_index_offset)*t_index_factor + if(tt.gt.tsat_max)then + ifail=-1 + return + else if(tt.lt.tsat_min)then + write(amessage,10) +10 format('Error in subroutine GET_h2o_SAT_LINE_PROPS_TEMPERATURE: ', & + 'temperature out of table interpolation range.') + ifail=1 + return + else + call which_index_1(tt,nsat,tsat,isat,sat_index_last_tt) + call linear_interpolation_factors_1(tsat(isat),tsat(isat+1),tt,fac) + delta_p=psat(isat+1)-psat(isat) + delta_t=tsat(isat+1)-tsat(isat) + if(iphase.eq.1)then + do i=1,ncode + if(icode(i).ne.0)then + if((i.eq.3).or.(i.eq.6).or.(i.eq.9))then + value(i)=(lpsat(isat+1,i-2)-lpsat(isat,i-2))/delta_p + else if((i.eq.2).or.(i.eq.5).or.(i.eq.8))then + value(i)=(lpsat(isat+1,i-1)-lpsat(isat,i-1))/delta_t + else + value(i)=lpsat(isat,i)*fac(1)+lpsat(isat+1,i)*fac(2) + end if + end if + end do + else if(iphase.eq.2)then + do i=1,ncode + if(icode(i).ne.0)then + if((i.eq.3).or.(i.eq.6).or.(i.eq.9))then + value(i)=(gpsat(isat+1,i-2)-gpsat(isat,i-2))/delta_p + else if((i.eq.2).or.(i.eq.5).or.(i.eq.8))then + value(i)=(gpsat(isat+1,i-1)-gpsat(isat,i-1))/delta_t + else + value(i)=gpsat(isat,i)*fac(1)+gpsat(isat+1,i)*fac(2) + end if + end if + end do + else + write(amessage,20) +20 format('Error in subroutine GET_h2o_SAT_LINE PROPS_TEMPERATURE: ', & + 'phase code must be "1" or "2".') + ifail=1 + return + end if + end if + + return + + end subroutine get_h2o_sat_line_props_temperat + ! get_h2o_sat_line_props_temperature + + + + subroutine interpolation_arrays_deallocate_1 + + implicit none + + integer ierr + + if(allocated(t)) deallocate(t,stat=ierr) + if(allocated(p)) deallocate(p,stat=ierr) + if(allocated(property_type)) deallocate(property_type,stat=ierr) + if(allocated(rarray)) deallocate(rarray,stat=ierr) + if(allocated(satline)) deallocate(satline,stat=ierr) + if(allocated(satclose)) deallocate(satclose,stat=ierr) + if(allocated(tsat)) deallocate(tsat,stat=ierr) + if(allocated(psat)) deallocate(psat,stat=ierr) + if(allocated(csat)) deallocate(csat,stat=ierr) + if(allocated(ssat)) deallocate(ssat,stat=ierr) + if(allocated(msat)) deallocate(msat,stat=ierr) + if(allocated(lpsat)) deallocate(lpsat,stat=ierr) + if(allocated(gpsat)) deallocate(gpsat,stat=ierr) + + return + + end subroutine interpolation_arrays_deallocate_1 + + + + + subroutine addquote_1(afile,aqfile) + + ! -- Subroutine ADDQUOTE_1 adds quotes to a filename if it has a space in it. + + character (len=*), intent(in) :: afile + character (len=*), intent(out) :: aqfile + integer nbb + + if(index(trim(afile),' ').eq.0)then + aqfile=afile + else + aqfile(1:1)='"' + aqfile(2:)=trim(afile) + nbb=len_trim(aqfile)+1 + aqfile(nbb:nbb)='"' + end if + + return + end subroutine addquote_1 + + + integer function nextunit_1() + + ! -- Function nextunit determines the lowest unit number available for + ! -- opening. + + logical::lopen + + do nextunit_1=10,300 + inquire(unit=nextunit,opened=lopen) + if(.not.lopen) return + end do + + end function nextunit_1 + + + subroutine tp2cell_1(it,ip,ic) + + ! -- Subroutine TP2CELL_1 converts temperature and pressure to cell number. + + implicit none + integer, intent(in) :: it,ip + integer, intent(out) :: ic + + ic=(ip-1)*nt+it + + end subroutine tp2cell_1 + + + + + SUBROUTINE LOWCASE_1(ASTRNG) + + ! -- Subroutine LOWCASE_1 converts a string to lower case. + + INTEGER I,J + CHARACTER*(*) ASTRNG + + DO 10 I=1,len_trim(ASTRNG) + J=ICHAR(ASTRNG(I:I)) + IF((J.GE.65).AND.(J.LE.90)) ASTRNG(I:I)=CHAR(J+32) +10 CONTINUE + RETURN + END SUBROUTINE LOWCASE_1 + + subroutine write_interpolation_data_1(ifail,infile,outfile,auxfile) + + ! -- Subroutine write_interpolation_data_1 reads an interpolation dataset. + ! -- Subroutine write_interpolation_data_1 writes a modified interpolation dataset. + + implicit none + integer, intent(out) :: ifail + character*(*), intent(in) :: infile + character*(*), intent(in) :: outfile + character*(*), intent(in) :: auxfile + + integer :: iunit,ierr,it,ip,ia,isat,ic + integer :: iunito,iunita,npa,nta,na_add + real*8 t_min,t_max,p_min,p_max,dum_max,dum_min + integer it_min,it_max,ip_min,ip_max + integer ita_min,ita_max,ipa_min,ipa_max + integer nt_new, np_new + integer ita, ipa, ita_dum, ipa_dum, ita_last, ipa_last + real*8 :: rtemp + character*200 :: wdd_gaza ! gaz-temp character variable + character*200 :: wdd_gazb ! gaz-temp character variable + character*20 :: atemp + character*200 :: afile + character*200 :: wdd_gaz ! gaz-temp character variable + character*200 :: wdd_gaz1 ! gaz-temp character variable + character*200 :: wdd_gaz2 ! gaz-temp character variable + + real*8 , allocatable :: paux(:) + real*8 , allocatable :: taux(:) + real*8 , allocatable :: p_new(:) + real*8 , allocatable :: t_new(:) + real*8, allocatable :: rarray_new(:,:,:) + logical, allocatable :: satline_new(:,:) + integer, allocatable :: satclose_new(:,:) + integer, allocatable :: ip_map(:) + integer, allocatable :: it_map(:) + + character*100, allocatable :: aux_prop(:) + character*200, allocatable :: wdd_dum(:) + + ifail=0 + + iunit=nextunit_1() + call addquote_1(infile,afile) + open(unit=iunit,file=infile,status='unknown',iostat=ierr) + iunito=nextunit_1() + call addquote_1(outfile,afile) + open(unit=iunito,file=outfile,status='unknown',iostat=ierr) + iunita=nextunit_1() + call addquote_1(auxfile,afile) + open(unit=iunita,file=auxfile,status='unknown',iostat=ierr) + if(ierr.ne.0)then + write(amessage,20) trim(afile) +20 format('Cannot open file ',a,' to write interpolation data.') + go to 9890 + end if + + ! -- The grid type is read. + + read(iunit,'(a200)') wdd_gaz + write(iunito,'(a200)') wdd_gaz + read(wdd_gaz,*) atemp + call lowcase_1(atemp) + if(atemp.eq.'uniform')then + at='u' + else if(atemp.eq.'nonuniform')then + at='n' + else + write(amessage,22) trim(afile) +22 format('First line of interpolation data file ',a,' should be "uniform" or "nonuniform".') + go to 9890 + end if + + + ! -- Array table dimensions are read. +! read(iunit,*,iostat=ierr) nt,np,na + read(iunit,'(a200)') wdd_gaz +! write(iunito,'(a200)') wdd_gaz + read(wdd_gaz,*,iostat=ierr) nt,np,na + if(ierr.ne.0)then + write(amessage,40) trim(afile) +40 format('Error reading dimensional information from second line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if((nt.le.0).or.(np.le.0).or.(na.le.0))then + write(amessage,50) trim(afile) +50 format('Illegal values for one or more dimensions on second line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + +! Read in new P and T values +! Must be in order low to high + read (iunita,*) + read (iunita,*) npa,nta + + allocate(paux(npa)) + allocate(taux(nta)) + read (iunita,*) + read (iunita,*) (paux(it),it = 1, npa) + read (iunita,*) + read (iunita,*) (taux(it),it = 1, nta) + read (iunita,*) + read (iunita,*) na_add + if(na_add.gt.0) then + allocate(aux_prop(na_add)) + do it = 1, na_add + read (iunita,'(a100)') aux_prop(it) + enddo + endif + +! redefine na_add (each new variable add 3 to rarray 3rd dimension) + + na_add = na + 3*na_add + allocate(wdd_dum(na_add)) + wdd_dum = ' ' + ic = 0 + do it = na+1,na_add,3 + ic = ic +1 + wdd_dum(it)(1:100) = aux_prop(ic) + wdd_dum(it+1)(1:6) = ' d/dt ' + wdd_dum(it+2)(1:6) = ' d/dp ' + enddo + +! -- Temperature and pressure index factors and offsets are read. + +! read(iunit,*,iostat=ierr) t_index_factor, t_index_offset + read(iunit,'(a200)') wdd_gaz +! write(iunito,'(a200)') wdd_gaz + read(wdd_gaz,*,iostat=ierr) t_index_factor, t_index_offset + if(ierr.ne.0)then + write(amessage,60) trim(afile) +60 format('Error reading temperature factor and/or offset from third line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if(t_index_factor.le.0.0)then + write(amessage,70) trim(afile) +70 format('Illegal value for temperature factor on third line of interpolation data file ',a,'.') + go to 9890 + end if + +! read(iunit,*,iostat=ierr) p_index_factor, p_index_offset + read(iunit,'(a200)') wdd_gaz +! write(iunito,'(a200)') wdd_gaz + read(wdd_gaz,*,iostat=ierr) p_index_factor, p_index_offset + if(ierr.ne.0)then + write(amessage,80) trim(afile) +80 format('Error reading pressure factor and/or offset from fourth line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if(p_index_factor.le.0.0)then + write(amessage,90) trim(afile) +90 format('Illegal value for pressure factor on fourth line of interpolation data file ',a,'.') + go to 9890 + end if + + + ! -- The saturation line closeness flag is read. + +! read(iunit,*,iostat=ierr) isatclose + read(iunit,'(a200)') wdd_gaz +! write(iunito,'(a200)') wdd_gaz + read(wdd_gaz,*,iostat=ierr) isatclose + if(ierr.ne.0) then + write(amessage,92) trim(afile) +92 format('Error reading saturation line closeness index from fifth line of interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + if(isatclose.lt.0)then + write(amessage,93) trim(afile) +93 format('Illegal value for saturation line closeness index on fifth line of ', & + 'interpolation data file ',a,'.') + go to 9890 + end if + + + ! -- The temperature and pressure vectors are read. + + allocate(t(nt),p(np),stat=ierr) + if(ierr.ne.0) go to 9400 +! read(iunit,*,err=9300,end=9350) + read(iunit,'(a200)',err=9200,end=9250) wdd_gaza +! write(iunito,'(a200)') wdd_gaz + read(iunit,*,err=9200,end=9250) (t(it),it=1,nt) +! write(iunito,'(1p,8g15.7)',err=9200) (t(it),it=1,nt) +! read(iunit,*,err=9300,end=9350) + read(iunit,'(a200)',err=9200,end=9250) wdd_gazb +! write(iunito,'(a200)') wdd_gaz + read(iunit,*,err=9300,end=9350) (p(ip),ip=1,np) +! write(iunito,'(1p,8g15.7)',err=9300) (p(ip),ip=1,np) + +! find max and mins + + t_min = 1.e6 + t_max = -1.e6 + p_min = 1.e6 + p_max = -1.e6 + it_min = 0 + it_max = 0 + ip_min = 0 + ip_max = 0 + do it = 1,np + if(p_min.gt.p(it))then + p_min = p(it) + ip_min = it + endif + enddo + do it = 1,np + if(p_max.lt.p(it))then + p_max = p(it) + ip_max = it + endif + enddo + do it = 1,nt + if(t_min.gt.t(it))then + t_min = t(it) + it_min = it + endif + enddo + do it = 1,nt + if(t_max.lt.t(it))then + t_max = t(it) + it_max = it + endif + enddo + +! modify p and t arrays + + ita_min = 0 + ita_max = 0 + ipa_min = 0 + ipa_max = 0 + dum_min = 1.e6 + dum_max = -1.e6 + do it = 1,npa + if(p_min.gt.paux(it))then + if(dum_max.lt.paux(it)) then + dum_max = paux(it) + ipa_max = it + endif + endif + enddo + do it = 1,npa + if(p_max.lt.paux(it))then + if(dum_min.gt.paux(it)) then + dum_min = paux(it) + ipa_min = it + endif + endif + enddo + dum_min = 1.e6 + dum_max = -1.e6 + do it = 1,nta + if(t_min.gt.taux(it))then + if(dum_max.lt.taux(it)) then + dum_max = taux(it) + ita_max = it + endif + endif + enddo + do it = 1,nta + if(t_max.lt.taux(it))then + if(dum_min.gt.taux(it)) then + dum_min = taux(it) + ita_min = it + endif + endif + enddo + +! set new dimensions + + np_new = np + nt_new = nt + if(ipa_min.ne.0) np_new = np_new + (npa - ipa_min+1) + if(ipa_max.ne.0) np_new = np_new + (ipa_max) + if(ita_min.ne.0) nt_new = nt_new + (nta - ita_min+1) + if(ita_max.ne.0) nt_new = nt_new + (ita_max) +! map new numbering + allocate (ip_map(np_new)) + allocate (it_map(nt_new)) + ip_map = 0 + it_map = 0 + ipa = 0 + do ip = 1, np_new + if(ip.le.ipa_max) then + ip_map(ip) = ip + elseif(ip.le.np+ipa_max) then + ipa = ipa +1 + ip_map(ip) = -ipa + else + ip_map(ip) = ip -(np+ipa_min+1) + ipa_min + endif + enddo + ita = 0 + do it = 1, nt_new + if(it.le.ita_max) then + it_map(it) = it + elseif(it.le.nt+ita_max) then + ita = ita +1 + it_map(it) = -ita + else + it_map(it) = it -(nt+ita_max+1) + ita_min + endif + enddo + +! printout modified information + + write(iunito,*) nt_new,np_new, na_add + write(iunito,*) t_index_factor, t_index_offset + write(iunito,*) p_index_factor, p_index_offset + write(iunito,*) isatclose + allocate(p_new(np_new),t_new(nt_new)) + p_new = -999. + t_new = -999. + +! populate new P and T arrays + + do ipa = 1,np_new + ip = ip_map(ipa) + if(ip.gt.0) then + p_new(ipa) = paux(ip) + else + p_new(ipa) = p(abs(ip)) + endif + enddo + + do ita = 1,nt_new + it = it_map(ita) + if(it.gt.0) then + t_new(ita) = taux(it) + else + t_new(ita) = t(abs(it)) + endif + enddo + + write(iunito,'(a200)') wdd_gaza + write(iunito,'(1p,8g15.7)',err=9200) (t_new(it),it=1,nt_new) + write(iunito,'(a200)') wdd_gazb + write(iunito,'(1p,8g15.7)',err=9200) (p_new(it),it=1,np_new) + +! -- The property type held within each array is now read. + + allocate(property_type(na_add),stat=ierr) + if(ierr.ne.0) go to 9400 +! read(iunit,*,iostat=ierr) + read(iunit,'(a200)',iostat=ierr) wdd_gaz + write(iunito,'(a200)') wdd_gaz + if(ierr.ne.0)then + write(amessage,95) trim(afile) + go to 9890 + end if + do ia=1,na + read(iunit,'(a)',iostat=ierr) property_type(ia) + write(iunito,'(a)') property_type(ia) + if(ierr.ne.0)then + write(amessage,95) trim(afile) +95 format('Error reading property type names from interpolation data file ',a,'.') + go to 9890 + end if + property_type(ia)=adjustl(property_type(ia)) + call lowcase_1(property_type(ia)) + end do + +! add additional vaiables to propert types + + do it = na+1,na_add,3 + write(iunito,'(a)') wdd_dum(it)(1:100) + write(iunito,'(a)') wdd_dum(it+1)(1:6) + write(iunito,'(a)') wdd_dum(it+2)(1:6) + enddo + + ! -- The arrays are read. + + allocate(rarray(nt,np,na),satline(nt,np),stat=ierr) + if(ierr.ne.0) go to 9400 + if(isatclose.gt.0)then + allocate(satclose(nt,np),stat=ierr) + if(ierr.ne.0) go to 9400 + end if + + do ia=1,na + read(iunit,'(a200)',err=9100,end=9150) wdd_dum(ia) +! write(iunito,'(a200)') wdd_gaz + do ip=1,np + read(iunit,*,err=9100,end=9150) (rarray(it,ip,ia),it=1,nt) +! write(iunito,'(1p,8g15.7)') (rarray(it,ip,ia),it=1,nt) + end do + end do + +! read(iunit,*,err=9120,end=9170) + read(iunit,'(a200)',err=9100,end=9150) wdd_gaz1 +! write(iunito,'(a200)') wdd_gaz1 + do ip=1,np + read(iunit,*,err=9120,end=9170) (satline(it,ip),it=1,nt) +! write(iunito,*) (satline(it,ip),it=1,nt) + end do + if(isatclose.gt.0)then +! read(iunit,*,err=9050,end=9070) + read(iunit,'(a200)',err=9100,end=9150) wdd_gaz2 +! write(iunito,'(a200)') wdd_gaz2 + do ip=1,np + read(iunit,*,err=9050,end=9070) (satclose(it,ip),it=1,nt) +! write(iunito,'(20i5)') (satclose(it,ip),it=1,nt) + end do + end if + +! allocate new arrays + + allocate(rarray_new(nt_new,np_new,na_add),satline_new(nt_new,np_new)) + rarray_new = -999. + satline_new = .false. + if(isatclose.gt.0)then + allocate(satclose_new(nt_new,np_new)) + satclose_new = 0 + endif + +! We can now populate the property arrays + + do ia=1,na_add + if(ia.le.na) then + do ipa=1,np_new + if(ip_map(ipa).lt.0) then + ipa_dum = abs(ip_map(ipa)) + else + ipa_dum = 0 + endif + do ita = 1,nt_new + if(it_map(ita).lt.0) then + ita_dum = abs(it_map(ita)) + else + ita_dum = 0 + endif + if(ipa_dum.ne.0.and.ita_dum.ne.0) then + rarray_new(ita,ipa,ia) = rarray(ita_dum,ipa_dum,ia) + else + rarray_new(ita,ipa,ia) = -777. + endif + enddo + end do + else + do ipa=1,np_new + do ita = 1,nt_new + rarray_new(ita,ipa,ia) = -888. + enddo + end do + endif + end do + +! write out new array + + do ia=1,na_add + write(iunito,'(a)') wdd_dum(ia) + do ip=1,np_new + write(iunito,'(1p,8g15.7)') (rarray_new(it,ip,ia),it=1,nt_new) + end do + end do + + + + ! -- Now we read information pertaining to intersections of the saturation line with the table. + ! -- First the dimension of the intersection table. + + write(iunito,'(a200)') wdd_gaz1 + do ip=1,np + write(iunito,*) (satline(it,ip),it=1,nt) + end do + + if(isatclose.gt.0)then + write(iunito,'(a200)') wdd_gaz2 + do ip=1,np + write(iunito,'(20i5)') (satclose(it,ip),it=1,nt) + end do + end if + +! read(iunit,*,iostat=ierr) + read(iunit,'(a200)',iostat=ierr) wdd_gaz + write(iunito,'(a200)') wdd_gaz + if(ierr.ne.0)then + write(amessage,97) trim(afile) + go to 9890 + end if + read(iunit,'(a200)',iostat=ierr) wdd_gaz + write(iunito,'(a200)') wdd_gaz + read(wdd_gaz,*) nsat + if(ierr.ne.0)then + write(amessage,97) trim(afile) +97 format('Error reading number of saturation line vertices from interpolation data file ',a,'.') + go to 9890 + end if + if(nsat.le.0)then + write(amessage,120) trim(afile) +120 format('Number of saturation line vertices supplied as zero or less in interpolation ', & + 'data file ',a,'.') + go to 9890 + end if + + ! -- Saturation Data is read. + + allocate(tsat(nsat),psat(nsat),stat=ierr) + if(ierr.ne.0) go to 9400 + allocate(csat(nsat),ssat(nsat),msat(nsat),stat=ierr) + if(ierr.ne.0) go to 9400 +! read(iunit,*,err=9450,end=9450) +! write(iunito,*) + read(iunit,'(a200)',err=9100,end=9150) wdd_gaz + write(iunito,'(a200)') wdd_gaz + do isat=1,nsat + read(iunit,*,err=9450,end=9450) psat(isat),tsat(isat),msat(isat),csat(isat),ssat(isat) + end do + + do isat=1,nsat + write(iunito,'(1p,8g15.7)') psat(isat),tsat(isat),msat(isat),csat(isat),ssat(isat) + end do + + ! -- The extremes are evaluated. + + tsat_min=tsat(1) + tsat_max=tsat(nsat) + psat_min=psat(1) + psat_max=psat(nsat) + + ! -- Liquid properties along the saturation line are now read. + + allocate(lpsat(nsat,na),gpsat(nsat,na),stat=ierr) + if(ierr.ne.0) go to 9400 + atemp='liquid properties' + read(iunit,'(a200)',err=9500,end=9500) wdd_gaz + write(iunito,'(a200)') wdd_gaz + read(iunit,'(a200)',err=9500,end=9500) wdd_gaz + write(iunito,'(a200)') wdd_gaz + read(iunit,'(a200)',err=9500,end=9500) wdd_gaz + write(iunito,'(a200)') wdd_gaz + do isat=1,nsat + read(iunit,*,err=9500,end=9500) (lpsat(isat,ia),ia=1,na) + end do + + do isat=1,nsat + write(iunito,'(1p,9g15.7)') (lpsat(isat,ia),ia=1,na) + end do + + atemp='vapour properties' + read(iunit,'(a200)',err=9500,end=9500) wdd_gaz + write(iunito,'(a200)') wdd_gaz + read(iunit,'(a200)',err=9500,end=9500) wdd_gaz + write(iunito,'(a200)') wdd_gaz + read(iunit,'(a200)',err=9500,end=9500) wdd_gaz + write(iunito,'(a200)') wdd_gaz + + do isat=1,nsat + read(iunit,*,err=9500,end=9500) (gpsat(isat,ia),ia=1,na) + end do + + do isat=1,nsat + write(iunito,'(1p,9g15.7)') (gpsat(isat,ia),ia=1,na) + end do + + ! -- The coordinates of intersection of the saturation line are now scaled for the uniform case. + + if(at.eq.'u')then + do isat=1,nsat + tsat(isat)=(tsat(isat)-t_index_offset)*t_index_factor + end do + do isat=1,nsat + psat(isat)=(psat(isat)-p_index_offset)*p_index_factor + end do + + ! -- Slopes of saturation line segments are now scaled. + + rtemp=p_index_factor/t_index_factor + do isat=1,nsat + msat(isat)=msat(isat)*rtemp + end do + + ! -- Table coordinates are now scaled for the uniform case. + + do it=1,nt + t(it)=(t(it)-t_index_offset)*t_index_factor + end do + do ip=1,np + p(ip)=(p(ip)-p_index_offset)*p_index_factor + end do + + end if + + ! -- The scaled saturation line limits are now calculated. + + tsat_min=tsat(1) + tsat_max=tsat(nsat) + psat_min=psat(1) + psat_max=psat(nsat) + + ! -- The scaled table limits are now calculated + + t_table_min=t(1) + t_table_max=t(nt) + p_table_min=p(1) + p_table_max=p(np) + + close(unit=iunit) + + return + + +9050 write(amessage,9060) trim(afile) +9060 format('Error reading saturation line closeness array from interpolation data ', & + 'file ',a,'.') + go to 9890 +9070 write(amessage,9080) trim(afile) +9080 format('Premature end encountered to interpolation data file ',a, & + ' while reading saturation line closeness array.') + go to 9890 +9100 write(amessage,9010) trim(property_type(ia)),trim(afile) +9010 format('Error reading ',a,' array from interpolation data file ',a,'.') + go to 9890 +9120 write(amessage,9130) trim(afile) +9130 format('Error reading saturation line intersection array from interpolation data ', & + 'file ',a,'.') + go to 9890 +9150 write(amessage,9160) trim(afile),trim(property_type(ia)) +9160 format('Premature end encountered to interpolation data file ',a, & + ' while reading ',a,' array.') + go to 9890 +9170 write(amessage,9180) trim(afile) +9180 format('Premature end encountered to interpolation data file ',a, & + ' while reading saturation line intersection array.') + go to 9890 +9200 write(amessage,9210) trim(afile) +9210 format('Error reading table temperatures from interpolation data file ',a,'.') + go to 9890 +9250 write(amessage,9260) trim(afile) +9260 format('Premature end to file ',a,' encountered while reading table temperatures.') + go to 9890 +9300 write(amessage,9310) trim(afile) +9310 format('Error reading table pressures from interpolation array file ',a,'.') + go to 9890 +9350 write(amessage,9360) trim(afile) +9360 format('Premature end to file ',a,' encountered while reading table pressures.') + go to 9890 +9400 write(amessage,9410) +9410 format('Error in allocating memory for h2o interpolation data arrays.') + go to 9890 +9450 write(amessage,9460) trim(afile) +9460 format('Error reading saturation line data from interpolation ', & + 'data file ',a,'.') + go to 9890 +9500 write(amessage,9510) trim(atemp),trim(afile) +9510 format('Error reading saturation line ',a,' from interpolation data file ',a,'.') + go to 9890 + + + +9890 ifail=1 + close(unit=iunit,iostat=ierr) + return + + + end subroutine write_interpolation_data_1 + + +end module property_interpolate_1 + + + diff --git a/src/iofile.f b/src/iofile.f index bf8a3dd1..3eb778ea 100755 --- a/src/iofile.f +++ b/src/iofile.f @@ -286,7 +286,8 @@ subroutine iofile (usub_num) nufilb(27)=36 nufilb(28)=37 nufilb(29)=38 - nufilb(30)=39 + nufilb(30)=39 + nufilb(31)=40 suffix(1)='.files' suffix(2)='.dat' suffix(3)='.dat' @@ -317,6 +318,7 @@ subroutine iofile (usub_num) suffix(28)='.nop' suffix(29)='.txt' suffix(30)='.well2' + suffix(31)='.txt' iowork(1)='iocntl' iowork(2)='inpt ' iowork(3)='incoor' @@ -346,7 +348,8 @@ subroutine iofile (usub_num) iowork(27)='iswt ' iowork(28)='ionop ' iowork(29)='ioco2 ' - iowork(30)='well2 ' + iowork(30)='well2 ' + iowork(31)='ioh2o ' cstats(1)='old ' cstats(2)='old ' cstats(3)='old ' @@ -376,7 +379,8 @@ subroutine iofile (usub_num) cstats(27)='unknown' cstats(28)='unknown' cstats(29)='old ' - cstats(30)='unknown' + cstats(30)='unknown' + cstats(31)='old ' cform(1)='formatted' cform(2)='formatted' ! Coordinate file can be formatted or unformatted @@ -407,7 +411,7 @@ subroutine iofile (usub_num) cform(27)='formatted' cform(28)='unformatted' cform(29)='formatted' - cform(30)='formatted' + cform(31)='unformatted' blank=' ' if(in(4).NE.666) nmfil( 1) = 'fehmn.files' nmfil( 2) = 'fehmn.dat' @@ -438,7 +442,8 @@ subroutine iofile (usub_num) nmfil(27) = '' nmfil(28) = 'nop.temp' nmfil(29) = 'co2_interp_table.txt' - nmfil(30) = 'fehmn.well2' + nmfil(30) = 'fehmn.well2' + nmfil(31) = 'h2o_interp_table.txt' nmfily( 1) = 'terminal console input' nmfily( 2) = 'terminal console output' nmfily( 3) = 'not using' diff --git a/src/model_setup.f b/src/model_setup.f index 17df1836..ea10f73a 100755 --- a/src/model_setup.f +++ b/src/model_setup.f @@ -214,8 +214,9 @@ subroutine model_setup(inpt, iptty, iout, ierr) c fxa is air mass fraction of inflow c gaz I think I can use array sourcea because air flowrate c and air fraction cannot both be set for the same node +c gaz 111418 can exist in different model read(inpt,*) (sourcea(i,imod),i=1,ntimes) - sourcea_type(imod)=1 + sourcea_type(imod)=-1 do i=1,ntimes sourcea(i,imod)= sourcea(i,imod)+tol_boun enddo @@ -377,6 +378,10 @@ subroutine model_setup(inpt, iptty, iout, ierr) read(inpt,*) (impedance(i,imod),i=1,ntimes) impedance_type(imod)=1 if(isubmod.le.1) go to 30 + else if(key(1:3).eq.'fen') then + read(inpt,*) (enthalpy(i,imod),i=1,ntimes) + enthalpy_type(imod)=1 + if(isubmod.le.1) go to 30 else if(key(1:2).eq.'en' .and. key(1:3).ne.'end') then read(inpt,*) (enthalpy(i,imod),i=1,ntimes) enthalpy_type(imod)=1 diff --git a/src/outbnd.f b/src/outbnd.f index bf4fdab2..123753a5 100755 --- a/src/outbnd.f +++ b/src/outbnd.f @@ -279,15 +279,15 @@ subroutine outbnd c tl=tco2(i) sl=fw(i) - sco2g=fg(i) - sco2l=fl(i) + sco2g=fg(i) + sco2l=fl(i) if(pl.lt.pmin_co2 ) mlz=1 if(pl.gt.pmax_co2 ) mlz=1 if(sl.lt.sminc) mlz=1 if(sl.gt.smaxc) mlz=1 - if(sco2g.lt.sminc) mlz=1 + if(sco2g.lt.sminc) mlz=1 if(sco2g.gt.smaxc) mlz=1 - if(sco2l.lt.sminc) mlz=1 + if(sco2l.lt.sminc) mlz=1 if(sco2l.gt.smaxc) mlz=1 if(tl.lt.tmin_co2 ) mlz=1 if(tl.gt.tmax_co2 ) mlz=1 @@ -346,15 +346,15 @@ subroutine outbnd c tl=tco2(i) sl=fw(i) - sco2g=fg(i) - sco2l=fl(i) + sco2g=fg(i) + sco2l=fl(i) if(pl.lt.pmin_co2 ) mlz=1 if(pl.gt.pmax_co2 ) mlz=1 if(sl.lt.smind) mlz=1 if(sl.gt.smaxd) mlz=1 - if(sco2g.lt.smind) mlz=1 + if(sco2g.lt.smind) mlz=1 if(sco2g.gt.smaxd) mlz=1 - if(sco2l.lt.smind) mlz=1 + if(sco2l.lt.smind) mlz=1 if(sco2l.gt.smaxd) mlz=1 if(tl.lt.tmin_co2 ) mlz=1 if(tl.gt.tmax_co2 ) mlz=1 @@ -436,7 +436,7 @@ subroutine outbnd & cord(ii,3) write(iout, 9012) pl, tl, sl if(ico2.gt.0 .and. icarb .eq. 0) write(iout, 9013) pci(i) - write(iout, 9015) ps(i),pnx(i),ieos(i), iad + write(iout, 9015) ps(i),pnx(i)*1.d-6,ieos(i), iad if (rxn_flag.ne.0)then write(iout, 9016) ps_delta_rxn(i) endif diff --git a/src/porosi.f b/src/porosi.f index 4753e6a8..de89d2b4 100755 --- a/src/porosi.f +++ b/src/porosi.f @@ -1010,18 +1010,22 @@ subroutine porosi(iz) & pwv,dvas(md),ps_delta_rxn_s(md) end do - write(iout,*) 'Total change in volume: ', psdelta, + if(iout.ne.0) then + write(iout,*) 'Total change in volume: ', psdelta, & ' m' - write(iout,*) 'Percent change in total volume: ', + write(iout,*) 'Percent change in total volume: ', & psdelta/psvol*100, ' %' - write(iout,*) 'Total Volume involved in ppor ', + write(iout,*) 'Total Volume involved in ppor ', & psvol + endif + if(iatty.ne.0) then write(iatty,*) 'Total change in volume: ', psdelta, & ' m' write(iatty,*) 'Percent change in total volume: ', & psdelta/psvol*100, ' %' write(iatty,*) 'Total Volume involved in ppor ', & psvol + endif diff --git a/src/psatl.f b/src/psatl.f index 7e899fa4..d8b19e26 100755 --- a/src/psatl.f +++ b/src/psatl.f @@ -283,28 +283,33 @@ real*8 function psatl(tl,pcaps,dpcaps,dpsatt,dpsats, use comii use comdti use comai + use property_interpolate_1 implicit none - integer isatf,k,maxitp + integer isatf,k,maxitp,ifail real*8 tl,pcaps,dpcaps,dpsatt,dpsats real*8 x,x2,x3,x4,pfun,pfunn,pfund,dpst,dptsn,dpstd,psatl0,delp real*8 ddelt,ddels,tfun,tfunn,tfund,pfun0,resid,drlp real*8 salt_con,pv_sc,dsct,dscc - - psatl=0.0 - dpsatt=0.0 + real*8 dtps,dtpsn,dtpsd + psatl=0.0d0 + dpsatt=0.0d0 if(ice.ne.0) then goto 9000 end if c ev3 is the reference value for vapor density,initialized(1.) in main.s c sat pressure as function of sat temp - if(isatf.le.0) then + if(isatf.le.0.and.ipsat.eq.0) then c check for limiting values - if(tl.lt.5.) then + if(iwater_table.ne.1) then +c gaz debug 112717 +c if(tl.lt.10.) then +c psatl=0.00123 + if(tl.lt.5.0) then psatl=0.000752 else if(tl.gt.340.0) then psatl=14.5941 - elseif(ipsat.eq.0) then + else x=tl x2=x*x x3=x2*x @@ -319,17 +324,23 @@ real*8 function psatl(tl,pcaps,dpcaps,dpsatt,dpsats, psatl=pfun dpsatt=dpst dpsats=0.0 + endif + else + call get_h2o_sat_pressure(ifail,tl,psatl,dpst) + dpsatt=dpst + dpsats=0.0 + endif c c get vapor pressure lowering (salt concentration) c if(isalt.ne.0.and.ivaprsalt.gt.1) then call vaporl_salt(tl,salt_con,pv_sc,dsct,dscc) c psatl = psatl + pv_sc -c dpsatt= dpsatt + dsct -c gaz debug 060316 (embedded sparrow) -c - psatl = pv_sc - dpsatt= dsct +c dpsatt= dpsatt + dsct +c gaz debug 060316 (embedded sparrow) +c + psatl = pv_sc + dpsatt= dsct endif c c get vapor pressure lowering (capillary pressure) @@ -341,12 +352,13 @@ real*8 function psatl(tl,pcaps,dpcaps,dpsatt,dpsats, dpsatt=dpsatt*delp+psatl0*ddelt dpsats=psatl0*ddels endif - end if + c c sat temp as function of sat pres c else c here tl=is the pressure + if(iwater_table.ne.1) then x=tl if(x.lt.0.00123) then psatl=10.0 @@ -359,8 +371,14 @@ real*8 function psatl(tl,pcaps,dpcaps,dpsatt,dpsats, tfunn=tsa0+tspa1*x+tspa2*x2+tspa3*x3+tspa4*x4 tfund=tsb0+tspb1*x+tspb2*x2+tspb3*x3+tspb4*x4 tfun=tfunn/tfund +c calculate derivative wrt p + dtpsn=((tspa1+2.*tspa2*x+3.*tspa3*x2+4.*tspa4*x3)*tfund)- + & (tfunn*(tspb1+2.*tspb2*x+3.*tspb3*x2+4.*tspb4*x3)) + dtpsd=tfund**2 + dtps=dtpsn/dtpsd + dpsatt = dtps c psatl is the saturation temp - x=tfun + x=tfun c do this for co2 systems if(ico2.gt.0) then c this is the initial guess @@ -402,9 +420,13 @@ real*8 function psatl(tl,pcaps,dpcaps,dpsatt,dpsats, endif psatl=x end if + else +c tl is the pressure,psatl = temp + call get_h2o_sat_temperature(ifail,tl,psatl,dpsatt) + dpsats=0.0 + endif endif 9000 continue - return end diff --git a/src/read_avs_io.f b/src/read_avs_io.f index bd7d25bf..0958711b 100755 --- a/src/read_avs_io.f +++ b/src/read_avs_io.f @@ -151,7 +151,7 @@ subroutine read_avs_io(lu) use avsio use comai, only : altc, ichead, ihead, ierr, iptty, icnl, istrs, - & idpdp, idualp, gdkm_flag + & idpdp, idualp, gdkm_flag, sv_combine use combi, only : izonef use comco2, only : icarb use comdi, only : nsurf, izone_surf, izone_surf_nodes, ifree @@ -175,6 +175,7 @@ subroutine read_avs_io(lu) iovapor = 0 iodual = 0 iogdkm = 0 + iogdkmblank = 0 iovelocity = 0 iopressure = 0 iocapillary = 0 @@ -337,7 +338,13 @@ subroutine read_avs_io(lu) & write(iptty, *) ' iotemperature ', iotemperature elseif((chdum(1:1) .eq. 's').or.(chdum(1:1) .eq. 'S'))then - if ((chdum(2:2) .eq. 'o').or.(chdum(2:2) .eq. 'O'))then + if ((chdum(2:3) .eq. 'oi').or.(chdum(2:3) .eq. 'OI'))then +c SOILVISION OUTPUT + sv_combine = .true. + iovelocity = 1 + write(iptty, *) + & ' Soil Vision output (with velocity output enabled) ' + else if ((chdum(2:2) .eq. 'o').or.(chdum(2:2) .eq. 'O'))then c output source, keyword: source iosource = 1 if (iptty .ne. 0) @@ -374,7 +381,8 @@ subroutine read_avs_io(lu) allocate(izone_surf(max(1,nsurf))) allocate(izone_surf_nodes(n0)) end if - read(lu,*) (izone_surf(i),i=1,nsurf) + backspace lu + read(lu,*) nsurf, (izone_surf(i),i=1,nsurf) c Loop over each zone for determining izone_surf array izone_surf_nodes = 0 do izone = 1, nsurf @@ -423,6 +431,11 @@ subroutine read_avs_io(lu) iogdkm = 1 if (iptty .ne. 0) & write(iptty, *) ' iogdkm ', iogdkm + if ((chdum(5:5) .eq. 'b').or.(chdum(5:5) .eq. 'B'))then + iogdkmblank = 1 + if (iptty .ne. 0) + & write(iptty, *) ' blanking option for gdkm enabled ' + endif else if ((chdum(2:2) .eq. 'e').or.(chdum(2:2) .eq. 'E'))then c output avs geometry file, keyword: geo iogeo = 1 diff --git a/src/rlperm.f b/src/rlperm.f index be14daad..29f2ffbc 100755 --- a/src/rlperm.f +++ b/src/rlperm.f @@ -460,6 +460,9 @@ subroutine rlperm(ndummy,iz) real*8, allocatable :: xfptmp(:), yfptmp(:), zfptmp(:) logical null1,ex integer ireg0 +c gaz 100118 + integer i1, i2, i3, i4, ic, iunit_rlp, open_file + character*80 rlp_temp_file save ireg,ireg0 if(l.eq.0) ireg0 = 0 @@ -470,7 +473,7 @@ subroutine rlperm(ndummy,iz) c check for read from other file icapp = 0 - i = 0 + i = i_rlp j = 0 ex = .false. do @@ -480,7 +483,6 @@ subroutine rlperm(ndummy,iz) read(inpt,*) irlpd backspace inpt i = i+1 - if (irlpd .eq. 1) then read(inpt,*) irlpt(i),rp1f(i),rp2f(i),rp3f(i), & rp4f(i),cp1f(i),cp3f(i) @@ -695,7 +697,8 @@ subroutine rlperm(ndummy,iz) c ****** end of input loop 20 num_models=max(i,j-1) - do i=1,num_models +c gaz 100118 reset model numbers + do i=i_rlp+1,num_models if(irlpt(i).ge.3 .and. irlpt(i) & .le. 9. or. irlpt(i) .eq. -4 ) then @@ -793,15 +796,12 @@ subroutine rlperm(ndummy,iz) endif enddo -c c return if read data from a file c if(ex) return - -c read in nodal capillary type - -c read in nodal capillary type - + +c read in nodal rlp type + if(i_rlp.eq.0) then narrays = 1 itype(1) = 4 default(1) = 1 @@ -812,9 +812,23 @@ subroutine rlperm(ndummy,iz) 3 i4_1=irlp(1:n0) ) macroread(7) = .TRUE. - + else + initdata_pad = i_rlp + narrays = 1 + itype(1) = 4 + default(1) = 1 + macro = "rlp " + igroup = 2 + call initdata2(inpt, ischk, n0, narrays, + 2 itype, default, macroread(7), macro, igroup, ireturn, + 3 i4_1=irlp(1:n0) ) + + initdata_pad = 0 + endif +c count models so far + i_rlp = num_models do i=1,n0 - if(irlpt(irlp(i)).le.2) then + if(irlpt(irlp(i)).le.2) then icap(i)=irlp(i) else if(irlpt(irlp(i)).eq.21) then icap(i) = 1 @@ -891,6 +905,10 @@ subroutine rlperm(ndummy,iz) ireg0 = ireg mi = i+ndummy ieosd = ieos(mi) +c +c gaz 112115 +c + if(ieosd.eq.4) ieosd =1 if (rlp_flag .eq. 0) then it = 0 else diff --git a/src/saltctr.f b/src/saltctr.f index c9e46834..03efb950 100755 --- a/src/saltctr.f +++ b/src/saltctr.f @@ -258,12 +258,13 @@ subroutine saltctr(iflg,ndummy,dum_salt,dum_salt1) itype(2) = 8 itype(3) = 8 igroup = 1 + c c Other values are the same as above c call initdata2(inpt,ischk, n0, narrays, itype, - & default, macroread(2), macro, igroup, ireturn, - & r8_1=k0f(1:n0),r8_2=bkf(1:n0),r8_3=por0f(1:n0)) + & default, macroread(23), macro1(1:4), igroup, ireturn, + & r8_1=k0f(1:n0),r8_2=bkf(1:n0),r8_3=por0f(1:n0)) do i = 1,n0 if(k0f(i).eq.default(1)) then @@ -279,7 +280,7 @@ subroutine saltctr(iflg,ndummy,dum_salt,dum_salt1) por0f(i) = 0.0 endif enddo - + macroread(23) = .true. elseif (macro1.eq.'saltvapr') then c manage vapor pressure lowering with salt c Sparrow (2003) Desalination @@ -825,14 +826,18 @@ subroutine saltctr(iflg,ndummy,dum_salt,dum_salt1) & write(iatty,6017) md,permsb,ps(md),thx(md)*1.e6, & pwv,dvas(md),ps_delta_rxn_s(md) enddo - write(iout,*) 'Total change in volume: ', psdelta, - & ' m' - write(iatty,*) 'Total change in volume: ', psdelta, - & ' m' + if(iout.ne.0) write(iout,*) + & 'Total change in volume: ', psdelta,' m' + + if(iatty.ne.0) write(iatty,*) + & 'Total change in volume: ', psdelta,' m' + if(psvol.gt.1.e-30) then - write(iout,*) 'Percent change in total volume: ', + if(iout.ne.0) write(iout,*) + & 'Percent change in total volume: ', & psdelta/psvol*100, ' %' - write(iatty,*) 'Percent change in total volume: ', + if(iatty.ne.0) write(iatty,*) + & 'Percent change in total volume: ', & psdelta/psvol*100, ' %' endif enddo diff --git a/src/scanin.f b/src/scanin.f index 3638a9c9..11abe535 100755 --- a/src/scanin.f +++ b/src/scanin.f @@ -303,7 +303,7 @@ subroutine scanin use compart use comriv use comrlp, only: rlpnew, ntable, ntblines,nphases,rlp_phase, - + rlp_group + + rlp_group use comrxni use comsi use comsk @@ -345,6 +345,7 @@ subroutine scanin integer icount, tprp_num integer jjj, isimnum, realization_num,maxrp logical nulldum, found_end +c logical gdkm_new real*8 rflag maxrp = 30 @@ -357,6 +358,8 @@ subroutine scanin ice = 0 ico2 = 0 icarb = 0 +c gaz 112817 + iwater_table = 0 icgts = 0 idoff = 1 ihead = 0 @@ -429,6 +432,8 @@ subroutine scanin nflxz = 0 sv_hex_tet = .false. ipr_tets = 0 +c gaz 100118 set nrlp here to enable mulpiple rlp macros + nrlp = 0 c zvd 17-Aug-09 move boun flag initializations here if(allocated(izone_free_nodes)) izone_free_nodes = 0 @@ -627,8 +632,8 @@ subroutine scanin c check for read from other file rlp_flag = 1 call start_macro(inpt, locunitnum, macro) - - nrlp = 0 +c gaz 100118 will set nrlp = 0 at start on routine so multiple rlp macros can be used +c nrlp = 0 11 continue read(locunitnum,'(a80)') wdd1 if(.not. null1(wdd1)) then @@ -754,18 +759,19 @@ subroutine scanin if (msg(1) .ne. 3) ntblines = ntblines + 1 end do 24 close (idum) - else + else backspace (locunitnum) do read (locunitnum, '(a80)') dumstring if (null_new(dumstring) .or. dumstring(1:3) .eq. & 'end' .or. dumstring(1:3) .eq. 'END') exit - ntblines = ntblines + 1 + ntblines = ntblines + 1 end do end if end if end do call done_macro(locunitnum) + else if (macro.eq.'boun') then c find number of boun models c @@ -792,7 +798,7 @@ subroutine scanin else if(wdd1(1:3).eq.'huf') then iha=1 else if(wdd1(1:2).eq.'hu') then - iha=1 + iha=1 else if(wdd1(1:2).eq.'ph') then ipha=1 else if(wdd1(1:2).eq.'th') then @@ -881,6 +887,8 @@ subroutine scanin ienth=1 else if(wdd1(1:2).eq.'ft') then ienth=1 + else if(wdd1(1:2).eq.'fen') then + ienth=1 else if(wdd1(1:2).eq.'kx') then ixperm=1 else if(wdd1(1:2).eq.'ky') then @@ -906,8 +914,14 @@ subroutine scanin else if (macro(1:3) .eq. 'nap' .or. macro .eq. 'szna') then c need to know if napl-water is envoked - ico2 = -3 - + ico2 = -3 +c gaz 112817 + else if (macro(1:3) .eq. 'eos') then +c need to know if a table with water props is read + call start_macro(inpt, locunitnum, macro) + read(locunitnum,'(a80)') wdd1(1:80) + call done_macro(locunitnum) + if(wdd1(1:5).eq.'table') iwater_table = 1 else if (macro(1:3) .eq. 'air') then c need to know if air-water is envoked ico2 = -2 @@ -1003,11 +1017,30 @@ subroutine scanin c and Generalized Dual Permeability Model (GDKM) parameters else if(macro .eq. 'gdpm' .or. macro .eq. 'gdkm') then - if(macro .eq. 'gdkm') gdkm_flag = 1 - call start_macro(inpt, locunitnum, macro) - read (locunitnum, *) gdpm_flag, ngdpmnodes + if(macro .eq. 'gdkm') then + gdkm_flag = 1 + backspace locunitnum + read(locunitnum,'(a80)') dumstring + gdkm_new = .false. +c---------------------------------------- +c Shaoping add, 10/23/2017 +c do i = 1, 80 + do i = 1, 78 +c---------------------------------------- + if(dumstring(i:i+2).eq.'new') then + gdkm_new =.true. + go to 690 + endif + enddo + endif +690 call start_macro(inpt, locunitnum, macro) + if(.not.gdkm_new) then + read (locunitnum, *) gdpm_flag, ngdpmnodes + else + ngdpmnodes = -999 + endif + if(gdkm_flag.eq.1) then - gdkm_flag = gdpm_flag gdpm_flag = 1 endif maxgdpmlayers = 0 @@ -1022,8 +1055,14 @@ subroutine scanin if (.not.null1(dumstring)) then backspace locunitnum ngdpm_models = ngdpm_models + 1 - read(locunitnum,*) nsize_layer,adumm,(adumm,i=1, +c gaz 091516 + if(gdkm_flag.eq.0) then + read(locunitnum,*) nsize_layer,adumm,(adumm,i=1, & nsize_layer) + else + read(locunitnum,*) nsize_layer,adumm + nsize_layer = 1 + endif maxgdpmlayers = max(nsize_layer,maxgdpmlayers) goto 1000 end if @@ -1046,6 +1085,12 @@ subroutine scanin vfrac_primary = 0. gdpm_x = 0. end if + if(gdkm_flag.ne.0) then + if(.not.allocated(gdkm_dir)) then + allocate(gdkm_dir(0:ngdpm_models)) + gdkm_dir = 0 + endif + endif call done_macro(locunitnum) @@ -2437,7 +2482,7 @@ subroutine scanin stop end if end if - + return 50 write (ierr, 55) 'STOP' diff --git a/src/setparams.f b/src/setparams.f index 2b52dcfa..a4b0b329 100755 --- a/src/setparams.f +++ b/src/setparams.f @@ -348,6 +348,7 @@ subroutine setparams gdkm_flag = 0 iwellp_flag = 0 nwellphy = 0 + i_rlp = 0 call scanin @@ -398,6 +399,9 @@ subroutine setparams end if 4105 continue +c gaz 0226 first discovery of neq + if(ngdpmnodes.eq.-999) ngdpmnodes = neq +c if (nei .eq. 0) then macro = ' ' do while (macro .ne. 'elem' .and. macro .ne. 'fdm ') @@ -474,13 +478,32 @@ subroutine setparams n0 = neq endif - - if (iptty .gt. 0) write(iptty, *) 'n0 = ', n0 - if(ngdpmnodes.ne.0.and.iptty.gt.0) - 2write(iptty,*) neq_primary,' primary nodes' - if(ngdpmnodes.ne.0.and.iptty.gt.0) - 2write(iptty,*) ngdpmnodes,' gdpm nodes' + if(.not.gdkm_new) then + if (iptty .gt. 0) write(iptty, *) 'n0 = ', n0 + if(ngdpmnodes.ne.0.and.iptty.gt.0) + & write(iptty,*) neq_primary,' primary nodes' + if(ngdpmnodes.ne.0.and.iptty.gt.0) + & write(iptty,*) ngdpmnodes,' gdpm nodes' + if (iout .gt. 0) write(iout, *) 'n0 = ', n0 + if(ngdpmnodes.ne.0.and.iout.gt.0) + & write(iout,*) neq_primary,' primary nodes' + if(ngdpmnodes.ne.0.and.iout.gt.0) + & write(iout,*) ngdpmnodes,' gdpm nodes' + else + if (iptty .gt. 0) write(iptty, *) 'n0 = ', n0 + if(iptty.gt.0) + & write(iptty,'(t1,i10,1x,a20)') neq_primary,'primary nodes' + if(iptty.gt.0) + & write(iptty,'(t12,a)') + & 'number gdkm nodes calculated after gdkm macro' + if (iout .gt. 0) write(iout, *) 'n0 = ', n0 + if(iout.gt.0) + & write(iout,'(t1,i10,1x,a)') neq_primary,'primary nodes' + if(iout.gt.0) + & write(iout,'(t12,a)') + & 'number gdkm nodes calculated after gdkm macro' + endif if (nspeci .ne. 0) then n7 = nspeci * n0 else if(ico2.ge.0) then diff --git a/src/setzone.f b/src/setzone.f index 97a98196..4404f1db 100755 --- a/src/setzone.f +++ b/src/setzone.f @@ -1,4 +1,5 @@ - subroutine setzone(izone, nin, ncord, nsl, xz, yz, zz, irad) + subroutine setzone(izone, nin, nsl, xz, yz, zz, irad) +c subroutine setzone(izone, nin, ncord, nsl, xz, yz, zz, irad) !*********************************************************************** ! Copyright, 1993, 2004, The Regents of the University of California. ! This program was prepared by the Regents of the University of @@ -326,7 +327,8 @@ subroutine setzone(izone, nin, ncord, nsl, xz, yz, zz, irad) implicit none logical eleb - integer i, ij, in, izone, jz, maxitz, ncord(*), nin, nsl +c integer i, ij, in, izone, jz, maxitz, ncord(*), nin, nsl + integer i, ij, in, izone, jz, maxitz,nin, nsl integer i_warn, irad real*8 a11, a12, a13, a21, a22, a23, a31, a32, a33 real*8 delx, dely, delz, detja diff --git a/src/solve_dual.f b/src/solve_dual.f index b697e66e..12797547 100755 --- a/src/solve_dual.f +++ b/src/solve_dual.f @@ -51,7 +51,7 @@ subroutine solve_dual(neq_primary,neq,a,b,bp,na,nb !*********************************************************************** implicit none - integer idof, neq_primary, neq, maxor, mdof_sol + integer idof, neq_primary, neq, maxor, mdof_sol, iarr_size real*8 a(*),b(*),bp(*) real*8 stor1(*),piv(neq,*) real*8 h(maxor,*),c(*),s(*),g(*),y(*), epn, anorm @@ -96,17 +96,23 @@ subroutine solve_dual(neq_primary,neq,a,b,bp,na,nb na_ratio = na(i)/ncon_size na_primary(i) = na_ratio*ncon_primary_size enddo + iarr_size = ncon_primary_size*idof*idof if(.not.allocated(iarr)) then - allocate(iarr(ncon_primary_size*idof*idof)) +c allocate(iarr(ncon_primary_size*idof*idof)) + allocate(iarr(iarr_size)) allocate(a_primary(1), adum(1), idum(1)) call simplify_gdpm(4,neq,neq_primary,ncon & ,idum,ncon_primary,a,adum,a_primary,na & ,na_primary,ngdpm_layers,igdpm,iarr,idof) + deallocate(adum) + allocate (adum(iarr_size)) endif c call neq by neq solution - call solve_new(neq_primary,a(iarr),b,bp,na_primary, +c call solve_new(neq_primary,a(iarr),b,bp,na_primary, gaz 102416 + adum(1:iarr_size) = a(iarr) + call solve_new(neq_primary,adum,b,bp,na_primary, & nb,nrhs,ncon_primary,nop,inorth, & epn,irb,iirb,npvt,stor1,dum,piv, & h,c,s,g,y,iter,iback,idof,iptty,maxor,accm) diff --git a/src/startup.f b/src/startup.f index 6610d7aa..54d88454 100755 --- a/src/startup.f +++ b/src/startup.f @@ -426,6 +426,7 @@ subroutine startup(tajj, tasii) c fac_nop = wellim(1) fac_nop = anl(1) + c c Calculate rho1grav c rho1grav = crl(1,1)*(9.81d-6) @@ -441,8 +442,10 @@ subroutine startup(tajj, tasii) c restart uses 0.0 for vapor (in case restart is 2-phase) c if(jswitch.ne.0) then +c gaz debug 041416 (affects rich flxz and his output) vflux_flag = .false. -c gaz debug 041416 (affects avs output) +c gaz debug 041416 (affects rich avs and other contour output!) +c gaz debug 041416 now left as is for correct verification output c iovapor = 0 endif @@ -661,34 +664,60 @@ subroutine startup(tajj, tasii) c neq_primary still defined as gdpm primary grid c gaz 122311 moved lower c call area_length_calc(3) -c +c gaz 051616 change calls for gdkm +c need drxg,dryg,drzg here +c gaz 091118 removed this line +c i = sx(1,1) + + if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) +c calculate gridblock dimensions + & call gdkm_volume_fraction_interface(1) if (gdpm_flag .ne. 0) call add_gdpm -c modify permeabilities if necessary - if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) call gdkm_connect(3) +c allocate memory for gdkm volume factors + if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) + & call gdkm_volume_fraction_interface(-1) +c if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) call gdkm_connect(3) +c gdkm_connect now called from add_gdpm1 +c gaz 081617 + if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) + & call gdkm_volume_fraction_interface(3) c c calculate connectivity for generalized permeability mode c if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) call gdkm_calc(1) -c neq_primary now defined as full grid +c +c neq_primary now defined as full grid + if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) + & call gdkm_volume_fraction_interface(0) + if (gdkm_flag .ne. 0.and.gdkm_flag .le. 3) + & call gdkm_volume_fraction_interface(4) c +c gaz 081116 apply volume fraction to some flow and transport parameters (thx,thy,thz,diff) +c call gdkm_volume_fraction_apply(1) c gaz 11-09-2001 allocation of istrw_itfc and istrw_cold c done here after call to anonp,storsx, or structured c still could ne changed in add_gdpm ncon_size=nelm(neq+1) nelmd = ncon_size if(idpdp.eq.0) then - if (.not. allocated (istrw_itfc)) - & allocate(istrw_itfc(ncon_size)) - if (.not. allocated (istrw_cold)) - & allocate(istrw_cold(ncon_size)) + if (.not. allocated (istrw_itfc)) then + allocate(istrw_itfc(ncon_size)) + istrw_itfc = 0 + endif + if (.not. allocated (istrw_cold)) then + allocate(istrw_cold(ncon_size)) + istrw_cold = 0 + endif else - if (.not. allocated (istrw_itfc)) - & allocate(istrw_itfc(2*ncon_size)) - if (.not. allocated (istrw_cold)) - & allocate(istrw_cold(2*ncon_size)) - end if - istrw_itfc = 0 - istrw_cold = 0 + if (.not. allocated (istrw_itfc)) then + allocate(istrw_itfc(2*ncon_size)) + istrw_itfc = 0 + endif + if (.not. allocated (istrw_cold)) then + allocate(istrw_cold(2*ncon_size)) + istrw_cold = 0 + endif + end if c add river or well connections if (nriver .ne. 0) then c river_ctr(1) call is made in incoord @@ -713,12 +742,13 @@ subroutine startup(tajj, tasii) ico2 = i c if(interface_flag.ne.0) call setconnarray +c gaz 090618 c call sx_combine to break connections to fixed type BCs - if(ianpe.eq.0) then - if (irun.eq.1.and.inobr.eq.0) call sx_combine(1) - else - if (irun.eq.1.and.inobr.eq.0) call sx_combine_ani(1) - endif +c if(ianpe.eq.0) then +c if (irun.eq.1.and.inobr.eq.0) call sx_combine(1) +c else +c if (irun.eq.1.and.inobr.eq.0) call sx_combine_ani(1) +c endif c c call fluxo now to calculate neighbors if necessary c @@ -1279,12 +1309,14 @@ subroutine startup(tajj, tasii) call subsidence(-2) c**** initialize coeffients adjust volumes in dual porosity calcs **** call dual (2) - +c gaz 101518 debug only +c to(1) = 85. +c to(20) =5. c**** initialize coefficients adjust volumes in dpdp calcs **** call dpdp (1) do i = 1, n volume(i) = sx1(i) -c gaz 01-18-2011 chane code to allow for negative temperatures +c gaz 01-18-2011 change code to allow for negative temperatures c if (to (i) .le. zero_t) to (i) = tin0 if(irdof.ne.13) then if (pho(i) .le. zero_t) pho (i) = pein diff --git a/src/sther.f b/src/sther.f index 4c9f5213..4e09019c 100755 --- a/src/sther.f +++ b/src/sther.f @@ -268,7 +268,16 @@ subroutine sther(iieosd) enddo c for now start with ieos_aux = 1 allocate(ieos_aux(n0)) - ieos_aux = 1 + ieos_aux = 1 + else if(wdd1(1:5).eq.'table') then + iwater_table = 1 +c gaz 110715 +c +c set very high bounds for table +c + do i=1,n0 + iieos(i)=1 + enddo else c classic simplt thermo read(wdd1,*) iieosd,itsat diff --git a/src/storsx_write.f b/src/storsx_write.f index 4713ace4..45d47dd1 100755 --- a/src/storsx_write.f +++ b/src/storsx_write.f @@ -70,7 +70,7 @@ subroutine storsx_write integer ilen, rlen, flen integer ityp integer :: max_con = 0 - character*100 filename, tail + character*1000 filename, tail character*72 cline character*32 sxformat character*3 stat_var @@ -79,6 +79,7 @@ subroutine storsx_write stat_var='old' inquire(unit=isstor,name=filename,form=sxformat) c If the file already contains data we don't want to overwrite it + filename = trim(filename) if(sxformat(1:9).eq.'FORMATTED') then read(isstor,'(a72)',end=900) cline else if(sxformat(1:11).eq.'UNFORMATTED') then diff --git a/src/stress_3D_post.f b/src/stress_3D_post.f index 435e0482..6fe2476f 100755 --- a/src/stress_3D_post.f +++ b/src/stress_3D_post.f @@ -203,7 +203,8 @@ subroutine stress_3D_post(i) real*8 shtixy,shtiz,shpixy,shpiz, e4i,e4kb,e4bar real*8 sheari, shearkb,shearbar,efac_ks,betat,efac_betat c.................................................................. - real*8 eigenvec(3,3),alambda(3) +c gaz 052017 +c real*8 eigenvec(3,3),alambda(3) real*8 onedV, fac integer j @@ -611,7 +612,9 @@ subroutine stress_3D_post(i) endif if(flag_principal.eq.1) then - call principal_stress_3D(i,alambda,eigenvec) +c gaz 052017 +c call principal_stress_3D(i,alambda,eigenvec) + call principal_stress_3D(i) c save the eigenvlaues in str_z,str)y,str_x in decreasing order c str_z is the max principal stress str_x(i)= alambda(1) @@ -634,14 +637,18 @@ subroutine stress_3D_post(i) c................................................................ - subroutine principal_stress_3D(i,alambda,eigenvec) +c gaz 052017 +c subroutine principal_stress_3D(i,alambda,eigenvec) + subroutine principal_stress_3D(i) use comai use comsi implicit none integer i - real*8 AMAT(3,3), eigenvec(3,3),alambda(3) +c gaz 052017 +c real*8 AMAT(3,3), eigenvec(3,3),alambda(3) + real*8 AMAT(3,3) real*8 AI1,AI2,AI3 AMAT=0.0 diff --git a/src/stress_mech_props.f b/src/stress_mech_props.f index 384ff5a9..7ea42d40 100755 --- a/src/stress_mech_props.f +++ b/src/stress_mech_props.f @@ -74,7 +74,7 @@ subroutine stress_mech_props(iflg,model_flag,ndummy) use comfem, only : ifem implicit none - integer ndummy,mid,mi,ieosd,kq,iflg, i, model_flag + integer ndummy,mid,mi,ieosd,kq,iflg, i, model_flag, i_tab real*8 pl,tl,dtin c s kelkar may 2010, tmeperature dependant properties real*8 ddsdde(6,6) @@ -87,21 +87,24 @@ subroutine stress_mech_props(iflg,model_flag,ndummy) c c misc. constants - +c c dtin=1.0/dtot c c generate mechanical properties as function of c s kelkar, April 20, 2010 if(isNonlinear.eq.1) then -c stiffness moduli as function of temperature only +c stiffness moduli and poisson ratio as function of temperature only do mid=1,neq i=mid+ndummy pl = phi(i) tl = t(i) - if(model_flag.eq.1) then - elastic_mod(i) = e_ini(i) + dEdt(i)*(tl - tini(i)) - poisson(i) = poisson_ini(i) + dNuedt(i)*(tl - tini(i)) + i_tab = iy_tab(i) + if(istr_non_model(i_tab).eq.1) then + elastic_mod(i) = e_ini(i_tab) + + & dEdt(i_tab)*(tl - t_non_ref(i_tab)) + poisson(i) = poisson_ini(i_tab) + + & dNuedt(i_tab)*(tl - t_non_ref(i_tab)) if(istrs.ne.2) then e1(i) = elastic_mod(i)*(1.0d0-poisson(i))/ & (1.d0+poisson(i))/(1.0d0-2.0d0*poisson(i)) @@ -113,13 +116,26 @@ subroutine stress_mech_props(iflg,model_flag,ndummy) e2(i) = e1(i)*poisson(i) e3(i) = e1(i)*(1.0d0-poisson(i))/2.0d0 endif - elseif(model_flag.eq.91) then + else c s kelkar Oct 2010, table lookup - call young_temp_table(i) + call young_temp_table(1,i,i_tab) + endif + enddo + endif + if(isbiotNonLin.eq.1) then +c stiffness thermal expansion and biot term as function of temperature only + do mid=1,neq + i=mid+ndummy + pl = phi(i) + tl = t(i) + i_tab = iy_tab_biot(i) + if(istr_non_model_biot(i_tab).eq.1.or. + & istr_non_model_biot(i_tab).eq.91) then + call biot_temp_table(1,i,i_tab) endif - - enddo - elseif(iPlastic.eq.1) then + enddo + endif + if(iPlastic.eq.1) then do mid=1,neq i=mid+ndummy itmp = modelNumber(i) @@ -128,66 +144,279 @@ subroutine stress_mech_props(iflg,model_flag,ndummy) c endif enddo - endif -c + endif +c +c calculate elastic constants +c + call elastic_constants(1) +c return end c.............................................................. - subroutine young_temp_table(i) + subroutine young_temp_table(iflg,j,i) +c c table lookup for young's modulus as function of temperature - - use comai, only:istrs +c gaz 042216 modified for multiple tables +c iflg = 0, read input. = 1, evaluate table +c j = node number +c i = table number +c + use comai use comdi, only: t use comsi implicit none - integer i,itable + integer i,j,itable,ifile,iflg,i91,j91, idum + integer open_file real*8 youngt, fact,tempi, poisst + character*80 young_temp_file + character*100 temp_junk + if(iflg.eq.0) then +c read input - tempi = t(i) + read(inpt,*) idum, young_temp_file + ifile = open_file( young_temp_file, 'old') +c read title + read(ifile,'(a)') temp_junk +c check size of table + do i91=1,nentries_young_max + read(ifile,*,end=91913) temp_junk + enddo + write(iptty,*)'error in stress input. Too many entries' + write(iptty,*)' in the E vs Temperature file. STOP' + write(ierr,*)'error in stress input. Too many entries' + write(ierr,*)' in the E vs Temperature file. STOP' + stop +91913 nentries_young = i91-1 +c +c this is where loop on tables should end +c + rewind (ifile) + read(ifile,'(a)') temp_junk + do i91=1,nentries_young + read(ifile,*)(e_temp91(i91,j91,i),j91=1,3) + enddo + close (ifile) + + else +c evaluate table + + tempi = t(j) - if(tempi.le.e_temp91(1,1)) then - youngt=e_temp91(1,2) - poisst=e_temp91(1,3) + if(tempi.le.e_temp91(1,1,i)) then + youngt=e_temp91(1,2,i) + poisst=e_temp91(1,3,i) else do itable=2,nentries_young - if(tempi.lt.e_temp91(itable,1)) then - fact=(e_temp91(itable,2)-e_temp91(itable-1,2)) - & /(e_temp91(itable,1)-e_temp91(itable-1,1)) - youngt=(tempi-e_temp91(itable-1,1))*fact - & +e_temp91(itable-1,2) - fact=(e_temp91(itable,3)-e_temp91(itable-1,3)) - & /(e_temp91(itable,1)-e_temp91(itable-1,1)) - poisst=(tempi-e_temp91(itable-1,1))*fact - & +e_temp91(itable-1,3) + if(tempi.lt.e_temp91(itable,1,i)) then + fact=(e_temp91(itable,2,i)-e_temp91(itable-1,2,i)) + & /(e_temp91(itable,1,i)-e_temp91(itable-1,1,i)) + youngt=(tempi-e_temp91(itable-1,1,i))*fact + & +e_temp91(itable-1,2,i) + fact=(e_temp91(itable,3,i)-e_temp91(itable-1,3,i)) + & /(e_temp91(itable,1,i)-e_temp91(itable-1,1,i)) + poisst=(tempi-e_temp91(itable-1,1,i))*fact + & +e_temp91(itable-1,3,i) goto 9193 endif enddo - youngt=e_temp91(nentries_young,2) - poisst=e_temp91(nentries_young,3) - + youngt=e_temp91(nentries_young,2,i) + poisst=e_temp91(nentries_young,3,i) + 9193 continue endif +c gaz after testing, comment out next lines +c write +c & (97,'(t1,i6,t10,f10.3,t20,f12.4,t40,f12.4)')j,t(j),youngt,poisst + + elastic_mod(j) = youngt + poisson(j) = poisst + + + endif + return + + end +c.............................................................. - write(97,*)i,youngt,poisst + subroutine biot_temp_table(iflg,j,i) +c +c table lookup for bulk() and alp() as function of temperature +c gaz modified for multiple tables +c iflg = 0, read input. = 1, evaluate table +c j = node number +c i = table number +c + use comai + use comdi, only: t + use comsi + + implicit none + integer i,j,itable,ifile,iflg,i91,j91, idum + integer open_file + real*8 bulkt, bulk_tol, bulk_mod, fact, tempi, alpt + parameter(bulk_tol=1.d-12) + character*80 biot_temp_file + character*100 temp_junk + if(iflg.eq.0) then +c read input (T,alp,bulk) + + read(inpt,*) idum, biot_temp_file + ifile = open_file(biot_temp_file, 'old') +c read title + read(ifile,'(a)') temp_junk +c check size of table + do i91=1,nentries_biot_max + read(ifile,*,end=91913) temp_junk + enddo + write(iptty,*)'error in biot input. Too many entries' + write(iptty,*)' in the biot vs Temperature file. STOP' + write(ierr,*)'error in biot input. Too many entries' + write(ierr,*)' in the biot vs Temperature file. STOP' + stop +91913 nentries_biot = i91-1 +c +c this is where loop on tables should end +c + rewind (ifile) + read(ifile,'(a)') temp_junk + do i91=1, nentries_biot + read(ifile,*)(biot_temp91(i91,j91,i),j91=1,3) + enddo + close (ifile) + + else +c evaluate table - elastic_mod(i) = youngt - poisson(i) = poisst + tempi = t(j) - if(istrs.ne.2) then - e1(i) = youngt*(1.0d0-poisst)/ - & (1.d0+poisst)/(1.0d0-2.0d0*poisst) - e2(i) = e1(i)*poisst/(1.0d0-poisst) - e3(i) = e1(i)*(1.0d0-2.0d0*poisst)/ - & 2.0d0/(1.0d0-poisst) + if(tempi.le.biot_temp91(1,1,i)) then + alpt=biot_temp91(1,2,i) + bulkt=biot_temp91(1,3,i) else - e1(i) = youngt/(1.d0-poisst*poisst) - e2(i) = e1(i)*poisst - e3(i) = e1(i)*(1.0d0-poisst)/2.0d0 + do itable=2,nentries_biot + if(tempi.lt.biot_temp91(itable,1,i)) then + fact=(biot_temp91(itable,2,i)-biot_temp91(itable-1,2,i)) + & /(biot_temp91(itable,1,i)-biot_temp91(itable-1,1,i)) + alpt=(tempi-biot_temp91(itable-1,1,i))*fact + & +biot_temp91(itable-1,2,i) + fact=(biot_temp91(itable,3,i)-biot_temp91(itable-1,3,i)) + & /(biot_temp91(itable,1,i)-biot_temp91(itable-1,1,i)) + bulkt=(tempi-biot_temp91(itable-1,1,i))*fact + & +biot_temp91(itable-1,3,i) + goto 9193 + endif + enddo + alpt=biot_temp91(nentries_biot,2,i) + bulkt=biot_temp91(nentries_biot,3,i) + 9193 continue + endif + alp0(j) = alpt + bulk0(j) = bulkt endif - return end c.............................................................. + subroutine elastic_constants(iflg) +c +c calculate elastic constants +c + use comai + use comdi, only: t + use comdti + use comsi + + implicit none + integer i,j,itable,ifile,iflg,i91,j91, idum + integer open_file + real*8 bulkt, bulk_tol, bulk_mod, fact, tempi, alpt + real*8 young_p , young_t, pois_p, pois_t, pois_sq + real*8 fac1,fac2,fac3, ezzi,ezzkb,ezzbar,efacxy,efacz + parameter(bulk_tol=1.d-12) + if(iflg.eq.1) then +c.............................................................. +c +c linear isotropic or anisotropic (at present plain strain and 3D) +c plain stress has different combinations +c + do i = 1,n0 +c change from volumetric to linear coef. of thermal expansion +c + alp(i) = alp0(i)/3.0 + if(istrs.ne.2) then +c plain strain and 3-D +c s kelkar 12/6/09 axisymmetric anisotropy +c in the notation used in the notes +c e1=c11, e2=c12=c21, e3=c66=Gp, e4=c13, and ezz=c33 +c these goto isotropic limit when Ep=Et and Nue-p=Nue-t + if(stress_anisotropy_in) then + young_p= elastic_mod(i) + young_t= elastic_mod_t(i) + pois_p= poisson(i) + pois_t= poisson_t(i) + pois_sq= pois_t*pois_t + fac1= young_p/young_t + fac2= 1.0d0- pois_p -2.0d0*fac1*pois_sq + fac3= fac2*(1.0d0+pois_p) + e1(i)= young_p*(1.0d0-fac1*pois_sq)/fac3 + e2(i)= young_p*(pois_p+fac1*pois_sq)/fac3 + e3(i)= 0.5d0*young_p/(1.d0+pois_p) + e4(i)= young_p*pois_t/fac2 + ezz(i)= young_t*(1.0d0-pois_p)/fac2 +c for thermal expansion, we input Alpha which is a small number, but +c for pore pressure +c we want to be able to input number such that 0<=beta_p<=1 and also +c have the temperature and pore pressure terms look similalr in the +c balance equations.Hence the term beta_p/3Hp is saved, not beta_p +c See Keita's notes dated 2/25/2010, Here bulk_mod is +c defined as bulk_mod=Hp=(C11+C12+C13)/3 and biot=beta_p/3Hp. Then +c Ks=Hp/(1-beta_p)=bulk_mod/(1-3*bulk_mod*biot). +c later beta_t calculated from +c =1-Ht/Ks where Ht=(2C13+C33)/3 + bulk_mod=(e1(i)+e2(i)+e4(i))/3. + if(bulk_mod.gt.bulk_tol) then + bulk(i) = bulk0(i)/(3.0*bulk_mod) + else + bulk(i) = bulk_tol + endif +c.................................................. + elseif(stress_anisotropy_use) then +c calculate the Biot term + bulk_mod = elastic_mod(i)/(3. + & *(1.0d0-2.0d0*poisson(i))) +c bulk will be biot/(3K) + bulk_mod=(e1(i)+e2(i)+e4(i))/3. + if(bulk_mod.gt.bulk_tol) then + bulk(i) = bulk0(i)/(3.0*bulk_mod) + else + bulk(i) = bulk_tol + endif + else + e1(i) = elastic_mod(i)*(1.0d0-poisson(i))/ + & (1.d0+poisson(i))/(1.0d0-2.0d0*poisson(i)) + e2(i) = e1(i)*poisson(i)/(1.0d0-poisson(i)) + e3(i) = e1(i)*(1.0d0-2.0d0*poisson(i))/ + & 2.0d0/(1.0d0-poisson(i)) +c calculate the Biot term + bulk_mod = elastic_mod(i)/(3. + & *(1.0d0-2.0d0*poisson(i))) +c bulk will be biot/(3K) + if(bulk_mod.gt.bulk_tol) then + bulk(i) = bulk0(i)/(3.0*bulk_mod) + else + bulk(i) = bulk_tol + endif + endif + else +c plain strain + e1(i) = elastic_mod(i)/(1.d0-poisson(i)*poisson(i)) + e2(i) = e1(i)*poisson(i) + e3(i) = e1(i)*(1.0d0-poisson(i))/2.0d0 + endif + enddo + endif + + return + end \ No newline at end of file diff --git a/src/stressctr.f b/src/stressctr.f index 0433566a..4bfa1f7c 100755 --- a/src/stressctr.f +++ b/src/stressctr.f @@ -63,7 +63,7 @@ subroutine stressctr(iflg,ndummy) integer iflg,i,ndummy,md,j,k,isstr_temp, neqp1 integer i1,i2,jj,kb,kc,iforce,nr1,nr2,ieosd - integer il,ilev,mlev, node, inptorig + integer il,ilev,mlev, node, inptorig, num_tab, i_non_strs character*10 macro1, macro2 real*8 dis_tol,aiter,aminkt real*8, allocatable :: stressboun(:) @@ -139,7 +139,7 @@ subroutine stressctr(iflg,ndummy) integer i91,j91 c s kelkar nov 5 2010 real*8 pi - real*8 eigenvec(3,3),alambda(3), eigenvec_deg(3) +c real*8 eigenvec(3,3),alambda(3), eigenvec_deg(3) real*8 friction, strength, pp_fac integer iispmd integer ishear @@ -179,11 +179,11 @@ subroutine stressctr(iflg,ndummy) allocate (e1(n0)) allocate (e2(n0)) allocate (e3(n0)) -c s kelkar 4/20/2010 - allocate (e_ini(1:n0)) - allocate (dEdt(1:n0)) - allocate (dNuedt(1:n0)) - allocate (poisson_ini(1:n0)) +c s kelkar 4/20/2010 gaz 042916 allocated later +c allocate (e_ini(1:n0)) +c allocate (dEdt(1:n0)) +c allocate (dNuedt(1:n0)) +c allocate (poisson_ini(1:n0)) c d dempsey 3/11/2014 allocate (bodyforce_x(n0)) allocate (bodyforce_y(n0)) @@ -194,6 +194,8 @@ subroutine stressctr(iflg,ndummy) c...................................... allocate (bulk(n0)) allocate (alp(n0)) + allocate (bulk0(n0)) + allocate (alp0(n0)) allocate (du(n0)) allocate (dv(n0)) allocate (dw(n0)) @@ -303,6 +305,8 @@ subroutine stressctr(iflg,ndummy) c...................................... bulk = 0.0d0 alp = 0.0d0 + alp0 = 0.0d0 + bulk0 = 0.0d0 du = 0.0d0 dv = 0.0d0 dw = 0.0d0 @@ -353,7 +357,7 @@ subroutine stressctr(iflg,ndummy) abs_tol_stress = 1.d-10 c Sai: initially set nonlinear flag to zero isNonlinear = 0 - + isbiotNonLin = 0 c c temporary unit number for stress contour @@ -1238,61 +1242,61 @@ subroutine stressctr(iflg,ndummy) & itype, default, macroread(8), macro, igroup, ireturn, & r8_1 = elastic_mod(1:n0),r8_2 = poisson(1:n0)) c s kelkar 4/20/2010 E and Nue as functions of temperature - else if(macro1.eq.'nonlinear') then + else if(macro1.eq.'nonlinear '.or.macro1.eq.'elastic no') then +c +c read in tables or functions and attributes +c isNonlinear = 1 - read(inpt,*)Nonlin_model_flag - if(Nonlin_model_flag.eq.1) then -c this model is nonlinear but isotropic - igroup = 1 - narrays = 4 - itype(1) = 8 - itype(2) = 8 - itype(3) = 8 - itype(4) = 8 - default(1) =0. - default(2) = 0. - default(3) = 0. - default(4) = 0. - call initdata2( inpt, ischk, n0, narrays,itype,default, - & macroread(8), macro, igroup,ireturn, - & r8_1 = e_ini(1:n0), r8_2 = dEdt(1:n0), - & r8_3 = poisson_ini(1:n0), r8_4 = dNuedt(1:n0) ) - - do node=1,n0 - elastic_mod(node) = e_ini(node) - poisson(node)=poisson_ini(node) - enddo - elseif(Nonlin_model_flag.eq.91) then - read(inpt,'(a100)') young_temp_file - ifile = open_file( young_temp_file, 'old') - read(ifile,'(a)') input_msg - backspace (ifile) - call parse_string(input_msg, imsg, msg, xmsg, cmsg, nwds) - if(nwds.eq.1) then - read(ifile,*)nentries_young - endif - do i91=1,1000000 - read(ifile,*,end=91913) temp_junk - enddo - write(iptty,*)'error in stress input. Too many entries' - write(iptty,*)' in the E vs Temperature file. STOP' - write(ierr,*)'error in stress input. Too many entries' - write(ierr,*)' in the E vs Temperature file. STOP' - stop -91913 nentries_young = i91-1 - rewind (ifile) - read(ifile,'(a)') input_msg - call parse_string(input_msg, imsg, msg, xmsg, cmsg, nwds) - if(nwds.gt.1) backspace (ifile) - allocate (e_temp91(nentries_young,3)) - e_temp91 = 0.0 - do i91=1,nentries_young - read(ifile,*)(e_temp91(i91,j91),j91=1,3) - enddo - close (ifile) - call stress_mech_props(0,Nonlin_model_flag,0) + allocate(i_tab_youngs(max_y_tab)) + allocate(iy_tab(n0)) + iy_tab = 0 + allocate (e_temp91(nentries_young_max,3,max_y_tab)) + e_temp91 = 0.0d0 + allocate(e_ini(max_non_str)) + allocate(poisson_ini(max_non_str)) + allocate(t_non_ref(max_non_str)) + allocate(dEdt(max_non_str)) + allocate(dNuedt(max_non_str)) + allocate(istr_non_model(max_non_str)) + e_ini = 0.0d0 + poisson_ini = 0.0d0 + dEdt = 0.0d0 + t_non_ref = 0.0d0 + dNuedt = 0.0d0 + num_tab = 0 + 211 continue + read(inpt,'(a80)') wdd1 + if(.not. null1(wdd1)) then +c gaz 042916 need to put on one line + backspace inpt + read(inpt,*) i_non_strs + backspace inpt + num_tab = num_tab + 1 + istr_non_model(num_tab) = i_non_strs + if(i_non_strs.eq.1)then + read(inpt,*) i_non_strs,e_ini(num_tab), + & poisson_ini(num_tab),t_non_ref(num_tab),dEdt(num_tab), + & dNuedt(num_tab) + else +c read nonlinear youngs table (function of T) + call young_temp_table(0,0,num_tab) + endif + go to 211 endif + go to 210 +c read in nodal capillary type + 210 continue +c assign tables to nodes + narrays = 1 + itype(1) = 4 + default(1) = 0 + macro = "etab" + igroup = 2 + call initdata2( inpt, ischk, n0, narrays, + & itype, default, macroread(9), macro, igroup, ireturn, + 2 i4_1=iy_tab(1:n0) ) +c endif c s kelkar 12/6/09 axisymmetric anisotropy else if(macro1.eq.'anisotropy') then stress_anisotropy_in = .true. @@ -1424,7 +1428,7 @@ subroutine stressctr(iflg,ndummy) poisson(i) = nu(modelNumber(i)) enddo c.................................................................... - else if(macro1(1:4).eq.'biot') then + else if(macro1(1:10).eq.'biot ') then igroup = 1 narrays = 2 itype(1) = 8 @@ -1434,7 +1438,50 @@ subroutine stressctr(iflg,ndummy) call initdata2( inpt, ischk, n0, narrays, & itype, default, macroread(8), macro, igroup, ireturn, - & r8_1 = alp(1:n0),r8_2 = bulk(1:n0)) + & r8_1 = alp0(1:n0),r8_2 = bulk0(1:n0)) +c.................................................................... + else if(macro1(1:10).eq.'nonlinbiot'.or. + & macro1(1:10).eq.'biot nonli') then +c +c read in tables of biot parameters as function of temperature +c + isbiotNonLin = 1 + allocate(i_tab_biot(max_y_tab_b)) + allocate(iy_tab_biot(n0)) + iy_tab_biot = 0 + allocate (biot_temp91(nentries_biot_max,3,max_y_tab_b)) + biot_temp91 = 0.0d0 + allocate(istr_non_model_biot(max_non_str_biot)) + num_tab = 0 + 311 continue + read(inpt,'(a80)') wdd1 + if(.not. null1(wdd1)) then +c gaz 042916 need to put on one line + backspace inpt + read(inpt,*) i_non_strs + backspace inpt + num_tab = num_tab + 1 + istr_non_model_biot(num_tab) = i_non_strs +c read nonlinear biot table (function of T) + call biot_temp_table(0,0,num_tab) + go to 311 + endif + go to 310 +c read in nodal capillary type + 310 continue +c assign tables to nodes + narrays = 1 + itype(1) = 4 + default(1) = 0 + macro = "etab" + igroup = 2 + + call initdata2( inpt, ischk, n0, narrays, + & itype, default, macroread(9), macro, igroup, ireturn, + 2 i4_1=iy_tab_biot(1:n0) ) + + + else if(macro1(1:5).eq.'toler') then read(inpt,*) tol_stress c @@ -1525,80 +1572,7 @@ subroutine stressctr(iflg,ndummy) c linear isotropic or anisotropic (at present plain strain and 3D) c plain stress has different combinations c - do i = 1,n0 -c change from volumetric to linear coef. of thermal expansion - alp(i) = alp(i)/3.0 - if(istrs.ne.2) then -c plain strain and 3-D -c s kelkar 12/6/09 axisymmetric anisotropy -c in the notation used in the notes -c e1=c11, e2=c12=c21, e3=c66=Gp, e4=c13, and ezz=c33 -c these goto isotropic limit when Ep=Et and Nue-p=Nue-t - if(stress_anisotropy_in) then - young_p= elastic_mod(i) - young_t= elastic_mod_t(i) - pois_p= poisson(i) - pois_t= poisson_t(i) - pois_sq= pois_t*pois_t - fac1= young_p/young_t - fac2= 1.0d0- pois_p -2.0d0*fac1*pois_sq - fac3= fac2*(1.0d0+pois_p) - e1(i)= young_p*(1.0d0-fac1*pois_sq)/fac3 - e2(i)= young_p*(pois_p+fac1*pois_sq)/fac3 - e3(i)= 0.5d0*young_p/(1.d0+pois_p) - e4(i)= young_p*pois_t/fac2 - ezz(i)= young_t*(1.0d0-pois_p)/fac2 -c for thermal expansion, we input Alpha which is a small number, but -c for pore pressure -c we want to be able to input number such that 0<=beta_p<=1 and also -c have the temperature and pore pressure terms look similalr in the -c balance equations.Hence the term beta_p/3Hp is saved, not beta_p -c See Keita's notes dated 2/25/2010, Here bulk_mod is -c defined as bulk_mod=Hp=(C11+C12+C13)/3 and biot=beta_p/3Hp. Then -c Ks=Hp/(1-beta_p)=bulk_mod/(1-3*bulk_mod*biot). -c later beta_t calculated from -c =1-Ht/Ks where Ht=(2C13+C33)/3 - bulk_mod=(e1(i)+e2(i)+e4(i))/3. - if(bulk_mod.gt.bulk_tol) then - bulk(i) = bulk(i)/(3.0*bulk_mod) - else - bulk(i) = bulk_tol - endif -c.................................................. - elseif(stress_anisotropy_use) then -c calculate the Biot term - bulk_mod = elastic_mod(i)/(3. - & *(1.0d0-2.0d0*poisson(i))) -c bulk will be biot/(3K) - bulk_mod=(e1(i)+e2(i)+e4(i))/3. - if(bulk_mod.gt.bulk_tol) then - bulk(i) = bulk(i)/(3.0*bulk_mod) - else - bulk(i) = bulk_tol - endif - else - e1(i) = elastic_mod(i)*(1.0d0-poisson(i))/ - & (1.d0+poisson(i))/(1.0d0-2.0d0*poisson(i)) - e2(i) = e1(i)*poisson(i)/(1.0d0-poisson(i)) - e3(i) = e1(i)*(1.0d0-2.0d0*poisson(i))/ - & 2.0d0/(1.0d0-poisson(i)) -c calculate the Biot term - bulk_mod = elastic_mod(i)/(3. - & *(1.0d0-2.0d0*poisson(i))) -c bulk will be biot/(3K) - if(bulk_mod.gt.bulk_tol) then - bulk(i) = bulk(i)/(3.0*bulk_mod) - else - bulk(i) = bulk_tol - endif - endif - else -c plain strain - e1(i) = elastic_mod(i)/(1.d0-poisson(i)*poisson(i)) - e2(i) = e1(i)*poisson(i) - e3(i) = e1(i)*(1.0d0-poisson(i))/2.0d0 - endif - enddo + call elastic_constants(1) macroread(8) = .TRUE. if(iptty.ne.0) then @@ -1634,7 +1608,27 @@ subroutine stressctr(iflg,ndummy) inobr = 1 ivf = 0 mlz = 0 - +c +c check that all elastic parameters are defined +c + j = 0 + do i = 1, n0 + if(elastic_mod(i). gt. 0.1) then + go to 811 + elseif (isNonlinear.eq.1) then + if(iy_tab(i).ne.0) go to 811 + else + j = j + 1 + endif +811 continue + enddo + if(j.gt.0) then + if(iout.ne.0) write(iout,812) j + if(iptty.ne.0) write(iptty,812) j + if(iout.ne.0) write(iout,105) + if(iptty.ne.0) write(iptty,105) + endif +812 format(' Warning: ',i8,' nodes without elastic params defined') else if(iflg.eq.2) then c c sort out applied forces diff --git a/src/stressperm_22.f b/src/stressperm_22.f index 08b02548..2ea3d4ad 100755 --- a/src/stressperm_22.f +++ b/src/stressperm_22.f @@ -21,7 +21,9 @@ subroutine stressperm_22(jpt) integer jpt,fail_flag,iispmd real*8 shear_max,stress_norm - real*8 eigenvec(3,3),alambda(3),rm(3,3) +c gaz 052017 +c real*8 eigenvec(3,3),alambda(3),rm(3,3) + real*8 rm(3,3) real*8 friction,strength real*8 fac(3,3),fac_E(3), fac_por real*8 porosity_damage_factor @@ -81,7 +83,9 @@ subroutine stressperm_22_failure(jpt,fail_flag,rm) integer jpt,iispmd,fail_flag real*8 shear_max,stress_norm - real*8 eigenvec(3,3),alambda(3),rm(3,3) +c gaz 052017 +c real*8 eigenvec(3,3),alambda(3),rm(3,3) + real*8 rm(3,3) real*8 friction,strength, pi, pp_fac, cossh, sinsh real*8 stress_factor_initial, shear_threshold @@ -100,15 +104,23 @@ subroutine stressperm_22_failure(jpt,fail_flag,rm) c find the principal stresses. eigenvec(j=1 to 3,k) contains the x,y,z c components of the eigenvector for the k-th eigenvalue. +c gaz 052017 if(incremental_shear_permmodel.eq.1) then - call principal_incremental_stress_3D(jpt,alambda,eigenvec - & ,stress_factor_initial) +c call principal_incremental_stress_3D(jpt,alambda,eigenvec +c & ,stress_factor_initial) + call principal_incremental_stress_3D(jpt, + & stress_factor_initial) else - call principal_stress_3D(jpt,alambda,eigenvec) +c gaz 052017 +c call principal_stress_3D(jpt,alambda,eigenvec) + call principal_stress_3D(jpt) endif c max shear stress,and normal stress on this plane (45deg to principal) - call max_excess_shear(jpt,friction,strength,alambda, - & pp_fac,stress_factor_initial, eigenvec) +c gaz 052017 +c call max_excess_shear(jpt,friction,strength,alambda, +c & pp_fac,stress_factor_initial, eigenvec) + call max_excess_shear(jpt,friction,strength, + & pp_fac,stress_factor_initial) cossh=dcos(shear_angle(jpt)) sinsh=dsin(shear_angle(jpt)) c choose z-prime=normal to the failure plane, and @@ -219,8 +231,10 @@ subroutine stressperm_22_emod(jpt,rm,fac_E) end c..................................................................... - subroutine max_excess_shear(jpt,friction,strength,alambda, - & pp_fac,stress_factor_initial, eigenvec) +c subroutine max_excess_shear(jpt,friction,strength,alambda, +c & pp_fac,stress_factor_initial, eigenvec) + subroutine max_excess_shear(jpt,friction,strength, + & pp_fac,stress_factor_initial) use comsi use comdi @@ -228,7 +242,8 @@ subroutine max_excess_shear(jpt,friction,strength,alambda, integer jpt,iispmd real*8 shear_max ,stress_norm - real*8 eigenvec(3,3),alambda(3) +c gaz 052017 +c real*8 eigenvec(3,3),alambda(3) real*8 friction,strength, pi, pp_fac real*8 stress_factor_initial @@ -252,15 +267,19 @@ subroutine max_excess_shear(jpt,friction,strength,alambda, end c..................................................................... - - subroutine principal_incremental_stress_3D(i,alambda,eigenvec - & ,stress_factor_initial) +c gaz 052017 +c subroutine principal_incremental_stress_3D(i,alambda,eigenvec +c & ,stress_factor_initial) + subroutine principal_incremental_stress_3D(i, + & stress_factor_initial) use comai use comsi implicit none integer i - real*8 AMAT(3,3), eigenvec(3,3),alambda(3) +c gaz 052017 +c real*8 AMAT(3,3), eigenvec(3,3),alambda(3) + real*8 AMAT(3,3) real*8 AI1,AI2,AI3 real*8 stress_factor_initial real*8 str_init_temp(3,3) diff --git a/src/stressperm_222.f b/src/stressperm_222.f index f9ca4a70..5f1f499f 100755 --- a/src/stressperm_222.f +++ b/src/stressperm_222.f @@ -30,8 +30,8 @@ subroutine stressperm_222(i) real*8 xperm_stry,xperm_strz, yperm_strx,yperm_strz real*8 zperm_strx,zperm_stry real*8 fac(3,3),fac_E(3) - real*8 eigenvec(3,3),alambda(3),rm(3,3) - +c real*8 eigenvec(3,3),alambda(3),rm(3,3) + real*8 rm(3,3) c c calculate components of volume strain c diff --git a/src/structured.f b/src/structured.f index 02d7e3d3..dace6806 100755 --- a/src/structured.f +++ b/src/structured.f @@ -777,7 +777,7 @@ subroutine structured (iflg) end if write (nunit,'(a)') & 'Coordinates & volumes for primary finite difference gridblocks' - write(nunit,*) neq_primary + write(nunit,*) neq_primary, nx, ny, nz do i=1,neq_primary write(nunit,'(i9,1x,1p,3(g15.6,1x),g12.4)') & i,(cord(i,j),j=1,3),sx1(i) diff --git a/src/thermw.f b/src/thermw.f index 618977fe..57e6df09 100755 --- a/src/thermw.f +++ b/src/thermw.f @@ -793,6 +793,7 @@ subroutine thermw(ndummy) use comii use comrlp, only : rlpnew use comrxni + use property_interpolate_1 use comsi, only : ihms, density, internal_energy use comtable @@ -802,6 +803,7 @@ subroutine thermw(ndummy) c include 'comtable.h' ! phs 4/23/99 C***** integer ndummy,iieosl,mid,mi,ieosd,iieosd,kq + real*8 psatl,dtsatp,dpsats real*8 dtin,dporpl,dportl,xrl,xrv,drl,drv,drlp,drvp,ela0,elpa1 real*8 elpa2,elpa3,elta1,elta2,elta3,elpta,elp2ta,elpt2a real*8 elb0,elpb1,elpb2,elpb3,eltb1,eltb2,eltb3,elptb @@ -838,6 +840,8 @@ subroutine thermw(ndummy) real*8 tfunn,tfund,dtpsn,dtpsd,dpldt,psat,vfcal,rop2,daep2 real*8 dqv,dhflxe,drovp,drovt real*8 cden_correction, cden_cor +c gaz 081317,082917 + real*8 ur, dur_dt C***** C***** AF 11/15/10 real*8 zwp, zwt ! phs 4/23/99 @@ -848,6 +852,9 @@ subroutine thermw(ndummy) real*8, allocatable :: sto1(:) real(8) :: damh = 0., damp = 0., daep = 0., daeh = 0. real(8) :: dtps = 0., dtd = 0. +c gaz 110715 + real*8 dum1,dumb,dumc,value(9) + integer istate, ifail integer i_mem_rlp save i_mem_rlp @@ -914,11 +921,20 @@ subroutine thermw(ndummy) if(iporos.ne.0) call porosi(1) c call capillary pressure models if (.not. rlpnew) call cappr(1,ndummy) +c gaz 103017 +c call variable rock properties if appropriate +c rock state started at last time step temperatures + if(iad.eq.0) call vrock_ctr(3,0) + call vrock_ctr(1,0) + call vrock_ctr(2,0) + ifree1 = 0 do mid=1,neq mi=mid+ndummy avgmolwt(mi) = mw_water ieosd=ieos(mi) +c gaz 111415 modification to include supercritical + if(ieosd.eq.4) ieosd = 1 iieosd=iieos(mi) if(ieosd.ge.2) ifree1 = ifree1 + 1 @@ -1084,6 +1100,7 @@ subroutine thermw(ndummy) vvpt2b=cvv(20,iieosd) iieosl=iieosd endif + pl=phi(mi) c evaluate thermo functions and derivatives @@ -1094,20 +1111,17 @@ subroutine thermw(ndummy) xa=pl xa2=xa*xa xa3=xa2*xa - xa4=xa3*xa + xa4=xa3*xa + pl=phi(mi) + if(ieosd.eq.2) then c two phase conditions c calculate temperature and dt/dp - tfunn=tsa0+tspa1*xa+tspa2*xa2+tspa3*xa3+tspa4*xa4 - tfund=tsb0+tspb1*xa+tspb2*xa2+tspb3*xa3+tspb4*xa4 - tfun=tfunn/tfund - tl=tfun - dtpsn=((tspa1+2.*tspa2*xa+3.*tspa3*xa2+4.*tspa4*xa3)*tfund)- - & (tfunn*(tspb1+2.*tspb2*xa+3.*tspb3*xa2+4.*tspb4*xa3)) - dtpsd=tfund**2 - dtps=dtpsn/dtpsd + tl=psatl(pl,pcp(mi),dpcef(mi), + 2 dtsatp,dpsats,1,an(mi)) + dtps = dtsatp else tl=t(mi) endif @@ -1122,11 +1136,10 @@ subroutine thermw(ndummy) c----------------------------------------- c phs Lookup table if tableFLAG = 1 c----------------------------------------- -c - if(tableFLAG.NE.1) then +c + if(tableFLAG.NE.1.and.iwater_table.ne.1) then c***** c liquid enthalpy - enwn1=ela0+elpa1*x+elpa2*x2+elpa3*x3 enwn2=elta1*tl+elta2*tl2+elta3*tl3 enwn3=elpta*tlx+elpt2a*tl2x+elp2ta*tlx2 @@ -1216,10 +1229,40 @@ subroutine thermw(ndummy) dvlen=dvlen1-dvlen2 dviled=vild**2 dvislt=dvlen/dviled +c gaz 110715 +c new supercritical table similiar to doherty fast table as modified by rajesh pawar + else if(iwater_table.ne.0) then +c subroutine h2o_properties_new(iflg,iphase,var1,var2,var3,istate,var4,var5,var6) +c real*8 var1,var2,var3,var4,var5(9),var6 + if(ieosd.eq.1.or.ieosd.eq.4)then + call h2o_properties_new(4,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + elseif (ieosd.eq.2) then + call h2o_properties_new(5,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + endif + rol = value(1) + drolt = value(2) + drolp = value(3) + enl = value(4) + p_energy + dhlt = value(5) + dhlp = value(6) + xvisl = value(7) + dvislt = value(8) + dvislp = value(9) +c chain rule not needed for table (d/dp already includes) + if(ieosd.eq.2) then + drolt = 0.0 + dhlt = 0.0 + dvislt = 0.0 + endif + C***** C*****AF 11/15/10 c-------------------------------------------------------------------------- - else ! USE LOOKUP TABLE phs 4/23/99 LOOKUP + else ! USE LOOKUP TABLE phs 4/23/99 LOOKUP izerrFLAG = 0. @@ -1319,7 +1362,7 @@ subroutine thermw(ndummy) endif if(ieosd.ne.1) then - + if(iwater_table.eq.0) then c vapor enthalpy ensn1=eva0+evpa1*x+evpa2*x2+evpa3*x3 ensn2=evta1*tl+evta2*tl2+evta3*tl3 @@ -1403,8 +1446,36 @@ subroutine thermw(ndummy) dvsen=dvsen1-dvsen2 dvised=visd**2 dvisvt=dvsen/dvised - endif + else if(iwater_table.ne.0) then +c subroutine h2o_properties_new(iflg,iphase,var1,var2,var3,istate,var4,var5,var6) +c real*8 var1,var2,var3,var4,var5(9),var6 + if(ieosd.eq.3)then + call h2o_properties_new(4,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + elseif (ieosd.eq.2) then + call h2o_properties_new(6,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + endif + rov = value(1) + drovt = value(2) + drovp = value(3) + env = value(4) + p_energy + dhvt = value(5) + dhvp = value(6) + xvisv = value(7) + dvisvt = value(8) + dvisvp = value(9) +c chain rule not needed for table (d/dp already includes) + if(ieosd.eq.2) then + drovt = 0.0 + dhvt = 0.0 + dvisvt = 0.0 + endif + endif + endif c modify derivatives for 2-phase if(ieosd.eq.2) then drolp=drolp+drolt*dtps @@ -1414,7 +1485,7 @@ subroutine thermw(ndummy) dvisvp=dvisvp+dvisvt*dtps dvislp=dvislp+dvislt*dtps drolt=0.0 - drovt=0.0 + drovt=0.0 dhlt=0.0 dhvt=0.0 dvisvt=0.0 @@ -1442,7 +1513,16 @@ subroutine thermw(ndummy) dvislt = dpropt dvislp = dpropp endif - +c gaz 081317 (gaz moved 102917) + if(ivrock.ne.0) then + ur = urock(mi) + dur_dt = durockt(mi) + else + urock(mi) = denr(mi)*cpr(mi)*tl + durockt(mi) = denr(mi)*cpr(mi) + ur = urock(mi) + dur_dt = durockt(mi) + endif sl=s(mi) dq(mi)=0.0 qh(mi)=0.0 @@ -1497,14 +1577,16 @@ subroutine thermw(ndummy) c accumulation terms den=por*(sl*rol+sv*rov) eqdum=sl*rol*enl+sv*rov*env-pl - dene=((1.-por)*cp*tl+por*eqdum) + dene=((1.-por)*ur+por*eqdum) c production of steam rag=rol*xvisv/rov/xvisl sig=xrv/(xrv+rag*xrl) c derivatives of accumulation terms rop=por*(sv*drovp+sl*drolp) damp =rop*dtin - daep =((1.d0-por)*cp*dtps+por*(sv*drovp*env+sv*rov*dhvp+ +c gaz 081317 + daep =((1.d0-por)*(dur_dt*dtps)+ + & por*(sv*drovp*env+sv*rov*dhvp+ & sl*drolp*enl+sl*rol*dhlp)-por)*dtin damh =por*(rol-rov)*dtin daeh =por*(rol*enl-rov*env)*dtin @@ -1524,6 +1606,7 @@ subroutine thermw(ndummy) end if end if + c compressed liquid if(ieosd.eq.1) then dtps=0.0 @@ -1544,7 +1627,7 @@ subroutine thermw(ndummy) c accumulation terms den1=rol den=den1*por - dene=(1.d0-por)*cp*tl+den*enl-por*pl + dene=(1.d0-por)*ur+den*enl-por*pl c...................................................... c s kelkar, 28 feb 2011, for derivatives pore volume wrt displacements @@ -1560,15 +1643,16 @@ subroutine thermw(ndummy) rop1=rop damp=(rop1+rop2)*dtin daep1=(rop*enl+por*rol*dhlp-por) - daep2=dporpl*(-cp*tl+rol*enl-pl) + daep2=dporpl*(-ur+rol*enl-pl) daep=(daep1+daep2)*dtin roe=por*drolt damh=(rol*dportl+drolt*por)*dtin - daeh=(-dportl*cp*tl+(1.-por)*cp+ +c gaz 081317 + daeh=(-dportl*ur+(1.-por)*dur_dt + & dportl*(enl*rol-pl)+por*(rol*dhlt+enl*drolt))*dtin - end if + c superheated vapour if(ieosd.eq.3) then dtps=0.0 @@ -1589,7 +1673,7 @@ subroutine thermw(ndummy) c accumulation terms den1=rov den=den1*por - dene=(1.d0-por)*cp*tl+den*env-por*pl + dene=(1.d0-por)*ur+den*env-por*pl c derivatives of accumulation terms rop=por*drovp @@ -1597,7 +1681,8 @@ subroutine thermw(ndummy) daep=(env*rop-por)*dtin roe=por*drovt damh =roe*dtin - daeh =((1.d0-por)*cp+por*rov*dhvt+env*roe)*dtin +c gaz 081317 + daeh =((1.d0-por)*dur_dt+por*rov*dhvt+env*roe)*dtin end if if(ieosd.ne.-1) then @@ -1721,21 +1806,25 @@ subroutine thermw(ndummy) if(ieosd.eq.0) then c heat conduction only - cprd=cpr(mi) + cprd=cpr(mi) +c eflow should have fixed temperature (no cprd) if(kq.lt.0) then eskd=eflow(mi) - edif=cprd*tl-eskd + edif=tl-eskd permsd=wellim(mi) qh(mi)=permsd*edif - deqh(mi)=permsd*cprd +c gaz 081317 + deqh(mi)=permsd endif if(kq.ge.0.and.qflux(mi).eq.0.0) deqh(mi)=0. dtpae(mi)=1. - denrd=denr(mi)*cprd +c gaz 082917 +c denrd=denr(mi)*cprd sto1(mi)=0.0 - sto1(mi+neq)=denrd*tl - deef(mi)=denrd*dtin + sto1(mi+neq)=ur + deef(mi)=dur_dt*dtin endif + if(kq.eq.1) then c c check for peaceman calculation diff --git a/src/thrmwc.f b/src/thrmwc.f index ccdbcf1f..93560b87 100755 --- a/src/thrmwc.f +++ b/src/thrmwc.f @@ -1435,13 +1435,25 @@ subroutine thrmwc(ndummy) real*8 dsk_hump,dsk_humpc,dsk_humt,psatld,pdiff,huma_fixed c gaz 062916 real*8 psatl_100, dpsatt_100, dhumidp, dhumidpc, dhumidt - real*8 dsk_hums, dsk_airp, dsk_h2op, deh_airp + real*8 dsk_hums, dsk_airp, dsk_h2op, deh_airp, deh_airt, deh_airpc + real*8 dsk_airt, dsk_airpc, dsk_h2ot, dsk_h2opc real*8 sk_humf, dsk_humfp, dsk_humfpc, dsk_humft real*8 sk_airhf, dsk_airhfp, huma_tol real*8 pv_hum, t_hum, p_hum +c gaz 081317,082917 + real*8 ur, dur_dt integer kang, ipv_tol +c gaz 110715 + real*8 dum1,dumb,dumc,value(9) + integer istate, ifail parameter (kang = 1, pflowa_tol= 1.d-12, huma_tol = 1.d-12) - parameter (permd_air_mult = 1.d-2, permd_hum_mult = 1.d03) + parameter (permd_air_mult = 1.d-2, permd_hum_mult = 1.d-3) + +c gaz 081917 + real*8 dcp_dt, dcprt_dum +c gaz 112718 + integer isk_key + save isk_key c c rol - density liquid c ros - density steam @@ -1477,7 +1489,8 @@ subroutine thrmwc(ndummy) real*8, allocatable :: drlfs0(:) real*8, allocatable :: rvf0(:) real*8, allocatable :: drvfs0(:) - +c gaz 112818 + dcp_dt = 0.0 if(abs(iexrlp).ne.0.and.i_mem_rlp.eq.0) then i_mem_rlp=1 @@ -1523,8 +1536,18 @@ subroutine thrmwc(ndummy) c call cappr(1,ndummy) if (.not. rlpnew) call cappr(1,ndummy) c - if(rlpnew) call rlp_cap(ndummy) - + if(rlpnew) call rlp_cap(ndummy) +c +c call variable rock properties if appropriate +c rock state started at last time step temperatures + if(iad.eq.0) call vrock_ctr(3,0) + call vrock_ctr(1,0) + call vrock_ctr(2,0) +c gaz 111118 +c allocate temp storage for sources/sinks +c + if(.not.allocated(sk_temp)) allocate(sk_temp(neq)) + do 100 mid=1,neq mi=mid+ndummy if(igrav.ne.0) then @@ -1532,8 +1555,19 @@ subroutine thrmwc(ndummy) else p_energy = 0.0d0 endif +c gaz 081317 + if(ivrock.ne.0) then + ur = urock(mi) + dur_dt = durockt(mi) + else + urock(mi) = denr(mi)*cpr(mi)*t(mi) + durockt(mi) = denr(mi)*cpr(mi) + ur = urock(mi) + dur_dt = durockt(mi) + endif ieosd=ieos(mi) iieosd=iieos(mi) + if(ieosd.ge.2) ifree1 = ifree1 + 1 c c undo equivalence relations for relative perms c @@ -1752,6 +1786,8 @@ subroutine thrmwc(ndummy) c two phase conditions c dpsatt=0.0 + dpct = 0.0 + psatl_100 = 0.0 if(ieosd.eq.2) then c if(isalt.ne.0) then c DRH 12/03/12 @@ -1828,6 +1864,9 @@ subroutine thrmwc(ndummy) c c liquid enthalpy c + if(iwater_table.ne.1) then +c***** +c liquid enthalpy enwn1=ela0+elpa1*x+elpa2*x2+elpa3*x3 enwn2=elta1*tl+elta2*tl2+elta3*tl3 enwn3=elpta*tlx+elpt2a*tl2x+elp2ta*tlx2 @@ -1926,6 +1965,46 @@ subroutine thrmwc(ndummy) dviled=vild**2 dvislt=dvlen/dviled dvlpc=0.0 + +c gaz 110715 +c new supercritical table similiar to doherty fast table as modified by rajesh pawar + else if(iwater_table.ne.0) then +c subroutine h2o_properties_new(iflg,iphase,var1,var2,var3,istate,var4,var5,var6) +c real*8 var1,var2,var3,var4,var5(9),var6 + if(ieosd.eq.1.or.ieosd.eq.4)then + call h2o_properties_new(4,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + elseif (ieosd.eq.2) then + call h2o_properties_new(5,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + endif + rol = value(1) + drolt = value(2) + drolp = value(3) + enl = value(4) + p_energy + dhlt = value(5) + dhlp = value(6) + xvisl = value(7) + dvislt = value(8) + dvislp = value(9) +c chain rule not needed for table (d/dp already includes) + if(ieosd.eq.2) then + drolt = 0.0 + dhlt = 0.0 + dvislt = 0.0 + endif +c gaz 110117 +c might need the following un commented +c if(ieosd.ne.3) then +c drolpc=0. +c dhlpc=0. +c dvlpc=0. +c endif +c----------------------------------------------------------------------- +C***** + endif c c set derivatives wrt pc equal to 0 in compressed liquid c @@ -1989,6 +2068,8 @@ subroutine thrmwc(ndummy) c c water vapor enthalpy c + if(iwater_table.eq.0) then +c vapor enthalpy ensn1=eva0+evpa1*xv+evpa2*xv2+evpa3*xv3 ensn2=evta1*tl+evta2*tl2+evta3*tl3 ensn3=evpta*tlxv+evpt2a*tl2xv+evp2ta*tlxv2 @@ -2080,6 +2161,37 @@ subroutine thrmwc(ndummy) dvised=visd**2 dvisvt=dvsen/dvised dvvpc=-dvisvp + else if(iwater_table.ne.0) then +c subroutine h2o_properties_new(iflg,iphase,var1,var2,var3,istate,var4,var5,var6) +c real*8 var1,var2,var3,var4,var5(9),var6 + if(ieosd.eq.3)then + call h2o_properties_new(4,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + elseif (ieosd.eq.2) then + call h2o_properties_new(6,ieosd,pl,tl,dum1,istate, + & dumb,value,dumc) + + endif + rov = value(1) + drovt = value(2) + drovp = value(3) + env = value(4) + p_energy + dhvt = value(5) + dhvp = value(6) + xvisv = value(7) + dvisvt = value(8) + dvisvp = value(9) +c chain rule not needed for table (d/dp already includes) + if(ieosd.eq.2) then + drovt = 0.0 + dhvt = 0.0 + dvisvt = 0.0 + endif + endif +c term needed for air pressure derivative +c + dvvpc=-dvisvp c c gaz 111915 c also changed pv_tol to 1.e-3 @@ -2334,8 +2446,10 @@ subroutine thrmwc(ndummy) c water balance rop=por*(sv*drovp*(1.0-xnv)+sl*drolp*(1.0-xnl)) damp =rop*dtin + por*(sv*rov*(-dxnvp) - & +sl*rol*(-dxnlp))*dtin - daep =((1.d0-por)*cp*dtps+por*(sv*drovp*env+sv*rov*dhvp+ + & +sl*rol*(-dxnlp))*dtin +c gaz 081917 + daep =((1.d0-por)*(dur_dt*dtps)+ + & por*(sv*drovp*env+sv*rov*dhvp+ & sl*drolp*enl+sl*rol*dhlp)-por)*dtin dacp =(por*(sv*drovp*xnv+sv*rov*dxnvp+sl*drolp*xnl+sl*rol & *dxnlp))*dtin @@ -2349,11 +2463,13 @@ subroutine thrmwc(ndummy) dach =por*dtin*((rol*xnl-rov*xnv) & +(sl*drolt*xnl+sv*drovt*xnv) & +(sl*rol*dxnlt+sv*rov*dxnvt)) -c water balance +c water balance +c gaz 081917 ropc=por*(sv*drovpc*(1.0-xnv)+sl*drolpc*(1.0-xnl)) dampc =ropc*dtin+por*(sv*rov*(-dxnvpc)+sl*rol*(-dxnlpc))*dtin - daepc =((1.d0-por)*cp*dtpcs+por*(sv*drovpc*env+sv*rov*dhvpc - & +sl*drolpc*enl+sl*rol*dhlpc))*dtin + daepc =((1.d0-por)*(cp*dtpcs+dcp_dt*tl*dtpcs)+ + & por*(sv*drovpc*env+sv*rov*dhvpc+ + & sl*drolpc*enl+sl*rol*dhlpc))*dtin dacpc =por*(sv*drovpc*xnv+sv*rov*dxnvpc & +sl*drolpc*xnl+sl*rol*dxnlpc)*dtin c @@ -2387,7 +2503,7 @@ subroutine thrmwc(ndummy) c water balance c den=rol*por*(1.0-xnl) - dene=(1.d0-por)*cp*tl+rol*por*enl-por*pl + dene=(1.d0-por)*ur+rol*por*enl-por*pl denc=rol*por*xnl c c derivatives of accumulation terms @@ -2400,7 +2516,7 @@ subroutine thrmwc(ndummy) roe=por*drolt c water balance damh =(roe*(1.0-xnl)-por*rol*dxnlt)*dtin - daeh =(por*rol*dhlt+roe*enl+(1.d0-por)*cp)*dtin + daeh =(por*rol*dhlt+roe*enl+(1.d0-por)*dur_dt)*dtin dach =(por*rol*dxnlt+roe*xnl)*dtin c water balance c assumes drolpc=0.0 @@ -2438,7 +2554,7 @@ subroutine thrmwc(ndummy) c water balance den=rov*por*(1.0-xnv) c enthalpy balance - dene=(1.d0-por)*cp*tl+rov*por*env-por*pl + dene=(1.d0-por)*ur+rov*por*env-por*pl c air balance denc=rov*por*xnv c @@ -2453,7 +2569,8 @@ subroutine thrmwc(ndummy) roe=por*drovt c enthalpy balance damh =(roe*(1.0-xnv)-por*rov*dxnvt)*dtin - daeh =((1.d0-por)*cp+por*rov*dhvt+env*roe)*dtin +c gaz 090117 + daeh =((1.d0-por)*dur_dt+por*rov*dhvt+env*roe)*dtin dach =(por*rov*dxnvt+xnv*roe)*dtin ropc=por*(drovpc) c air balance @@ -2540,10 +2657,13 @@ subroutine thrmwc(ndummy) c ********** source term code start ***************** c c gaz debug terms (so intel debugger recognizes fdum and l from use module) - dum_gaz=fdum - dum_gaz = l + dum_gaz=fdum+l c - qc(mi)=0.0 +c gaz 110218 fix for not zeroing out qng(mi) + if(abs(pflowa(mi)).gt.pflowa_tol) qng(mi) = 0.0 + if(xairfl(mi).gt.0.0) qng(mi) = 0.0 +c gaz 111418 can now set qc for specified air flowrate(qng ne 0) + qc(mi)=qng(mi) dqc(mi)=0.0 deqc(mi) = 0.0 dcqc(mi) = 0.0 @@ -2567,8 +2687,12 @@ subroutine thrmwc(ndummy) c kq=ka(mi) sk_hum = 0.0 + dsk_hums = 0.0 + dsk_humpc = 0.0 + dsk_humt = 0.0 sk_air = 0.0 sk_h2o = 0.0 +c start loop on specified pressure if(kq.lt.0 .and. compute_flow) then c pflow >= 0 , specified pressure c pflow < 0 , specified saturation (sometimes resulting from humidity ) @@ -2579,31 +2703,39 @@ subroutine thrmwc(ndummy) c basically for two phase conditions, saturation is managed (fixed BC) with water flow c pressure is managed (fixed BC) with airflow c -888 disables humidity:dqt is d/ds for 2 phase, d/dt for 1 phase - if(sl+pflow(mi).gt.0.0.and.pflow(mi).ne.-888.) then +c gaz 112418 try allowing flow in or out +c if(sl+pflow(mi).gt.0.0.and.pflow(mi).ne.-888.) then satdif = sl+pflow(mi) sk_hum = permsd*(satdif) dsk_hums = permsd dsk_humpc = 0.0 dsk_humt = 0.0 - else - sk_hum = 0.0 - dsk_hums = 0.0 - dsk_humpc = 0.0 - dsk_humt = 0.0 - endif +c gaz 112418 send to different loops +c qdis = sk_hum +c sk(mi) = qdis +c dqt(mi) = dsk_hums +c else +c sk_hum = 0.0 +c dsk_hums = 0.0 +c dsk_humpc = 0.0 +c dsk_humt = 0.0 +c endif c gaz debug 081815 -c only outflow - if(pflowa(mi).gt.pflowa_tol) then - if(phi(mi)-pflowa(mi).gt.0.0) then - permsda = permsd*permd_air_mult - sk_air = permsda*(phi(mi)-pflowa(mi)) - dsk_airp= permsda - else +c only outflow +c gaz 112518 do nothing here pflowa addressed later +c if(pflowa(mi).gt.pflowa_tol) then +c if(phi(mi)-pflowa(mi).gt.0.0) then +c permsda = permsd*permd_air_mult +c sk_air = permsda*(phi(mi)-pflowa(mi)) +c dsk_airp= permsda +c qc(mi) = permsda*(phi(mi)-pflowa(mi)) +c dqc(mi) = permsda +c else c do nothing - sk_air = 0.0 - dsk_airp = 0.0 - endif - endif +c sk_air = 0.0 +c dsk_airp = 0.0 +c endif +c endif else if(ieosd.eq.3) then c do nothing here endif @@ -2616,9 +2748,34 @@ subroutine thrmwc(ndummy) permsd=wellim(mi) c kq=-2 means inflow not allowed if(pldif.le.0.0d00.and.kq.eq.-2) permsd=0.0 - qdis=permsd*(pldif) - sk(mi)=qdis - dq(mi)=permsd +c gaz 092418 - can't hold fixed pressure if air partial pressure (pcl) is larger than pl +c gaz 110518 - changed definition +c gaz 111818 - changed definition again +c if air pressure gets larger than the specified total pressure; turn off specified +c pressure +c gaz 112718 changed pflow to only inflow + if(ieosd.eq.2) then + if(phi(mi).gt.pflow(mi).and.qc(mi).lt.0.0) then + sk(mi)=0.0 + dq(mi)=0.0 + qdis = 0.0 + else + qdis=permsd*(pldif) + sk(mi)=qdis + dq(mi)=permsd + endif +c not 2-phase + else + if(phi(mi).gt.pflow(mi).and.qc(mi).lt.0.0) then + sk(mi)=0.0 + dq(mi)=0.0 + qdis = 0.0 + else + qdis=permsd*(pldif) + sk(mi)=qdis + dq(mi)=permsd + endif + endif c gaz debug 122814 c check for air fraction of water source sk();(only for inflow) c if we assume dry air, then we could calculate humidity @@ -2628,6 +2785,7 @@ subroutine thrmwc(ndummy) xair = xairfl(mi) sk(mi) = (1.0-xair)*qdis qc(mi) = xair*qdis + qng(mi) = qc(mi) dqc(mi) = dq(mi)*xair dq(mi) = dq(mi)*(1.0-xair) qdis = sk(mi) @@ -2635,7 +2793,30 @@ subroutine thrmwc(ndummy) c need to add conditional 2 for enthalpy calc (no d/dp,d/dy etc) endif endif +c end loop on specified saturation or total pressure + else +c +c gaz 111118 add "xfa" capability to specified water flow +c water flow, however is split into water and air flow +c + if(xairfl(mi).gt.0.0.and.sk(mi).lt.0.0) then + if(iad.eq.0) then +c save source info + sk_temp(mi) = sk(mi) + endif + sk(mi) = sk_temp(mi) + qdis = sk(mi) + xair = xairfl(mi) + sk(mi) = (1.0-xair)*qdis + qc(mi) = xair*qdis + qng(mi) = qc(mi) + dqc(mi) = dq(mi)*xair + dq(mi) = dq(mi)*(1.0-xair) + qdis = sk(mi) + endif + continue end if +c end loop specified pressure c c start section on air inflow with specified humidity (inflow only) c no derivatives because of inflow only condition @@ -2651,35 +2832,97 @@ subroutine thrmwc(ndummy) qng_old = qng(mi) dq_air = 0.0 c check if pflowa exists and inflow exists +c gaz 092518 changed so specified pa uses pci(mi) significant +c need derivatives of pci when ieosd = 2 +c with pa the partial pressure pa means dry +c gaz 111318 need to zero permsda + permsda = 0.0 if(pflowa(mi).gt.pflowa_tol) then - if(phi(mi)-pflowa(mi).lt.0.0) then + if(pci(mi)-pflowa(mi).lt.0.0) then permsd=abs(wellim(mi)) permsda = permsd*permd_air_mult - qng_old = permsda*(phi(mi)-pflowa(mi)) - dq_air = permsda + qc(mi) = permsda*(pci(mi)-pflowa(mi)) + if(ieosd.eq.2) then +c gaz 111318 pci = phi - pv(t) + dqc(mi) = permsda + dcqc(mi) = 0.0 + deqc(mi) = permsda*dpct + else + dqc(mi) = 0.0 + dcqc(mi) = permsda + deqc(mi) = 0.0 + endif else permsd=abs(wellim(mi)) permsda = permsd*permd_air_mult - sk_air = permsda*(phi(mi)-pflowa(mi)) - dq_air = permsda - dsk_airp = permsda - qng_old = 0.0 +c sk_air should be non zero only if air is not dry +c pflowa represents the partial pressure of dry air +c sk_air = permsda*(pci(mi)-pflowa(mi)) + qc(mi) = permsda*(pci(mi)-pflowa(mi)) + if(ieosd.eq.2) then + dqc(mi) = permsda + deqc(mi) = permsda*dpct + else + dqc(mi) = 0.0 + dcqc(mi) = permsda + deqc(mi) = 0.0 + endif +c gaz 092518 might be not needed +c dq_air = permsda +c dsk_airp = 0.0 +c qng_old = 0.0 endif endif if(iha.ne.0) then - if(huma(mi).gt.0.0) then -c only for inflow of gas phase - if(qng_old.lt.0.0) then +c gaz 111318 allow humidity flow (h20)to be calculated +c if no humidity or air fraction then dry air assumed + if(huma(mi).gt.0.0.and.xairfl(mi).eq.0.0) then +c only for inflow of gas phase + if(qc(mi).lt.0.0) then c water flow in rate sk() c air flow in is sk_air c entha() is correct mixture enthalpy - sk_h2o = (1.0-xnva(mi))*qng_old - dsk_h2op = (1.0-xnva(mi))*dq_air - sk_air = xnva(mi)*qng_old - dsk_airp = xnva(mi)*dq_air - eh_air = entha(mi)*qng_old - deh_airp = entha(mi)*dq_air +c if qc() is from a specified air pressure then permsda ne 0 +c if qc() is from a specified air flowrate then permsda eq 0 +c at this point sk is calculated and if qc <0 , then qc is split + if(pflowa(mi).gt.pflowa_tol) then +c specified air pressure + if(ieosd.eq.2) then + dqc(mi) = permsda + deqc(mi) = permsda*dpct + else + dqc(mi) = 0.0 + dcqc(mi) = permsda + deqc(mi) = 0.0 + endif +c specified air flowrate (no derivatives) + else + dqc(mi) = 0.0 + dcqc(mi) = 0.0 + dcqh(mi) = 0.0 + endif + + sk_h2o = (1.0-xnva(mi))*qc(mi) + dsk_h2op = (1.0-xnva(mi))*dqc(mi) + dsk_h2ot = (1.0-xnva(mi))*deqc(mi) + dsk_h2opc = (1.0-xnva(mi))*dcqc(mi) + sk_air = xnva(mi)*qc(mi) + dsk_airp = xnva(mi)*dqc(mi) + dsk_airt = xnva(mi)*deqc(mi) + dsk_airpc = xnva(mi)*dcqc(mi) + eh_air = entha(mi)*qc(mi) + deh_airp = entha(mi)*dqc(mi) + deh_airt = entha(mi)*deqc(mi) + deh_airpc = entha(mi)*dcqc(mi) qng_old = 0.0 +c gaz 111318 +c new air source and derivatives here +c they will be added later so zero out +c air flow and derivatives + qc(mi) = 0.0 + dqc(mi) = 0.0 + deqc(mi) = 0.0 + dcqc(mi) = 0.0 endif endif endif @@ -2704,9 +2947,16 @@ subroutine thrmwc(ndummy) & dpsats,0,an(mi)) pdiff = p_hum-pci(mi) sk_humf = permsd*(pdiff-huma_fixed*pv_hum) - dsk_humfp = 0.0 - dsk_humfpc = -permsd - dsk_humft = 0.0 + if(ieosd.eq.2) then + dsk_humfp = -permsd + dsk_humfpc = 0.0 +c dsk_humft uses pci = p - pv(t) (pci is not a variable for ieosd = 2) + dsk_humft = -permsd*dpct + else + dsk_humfp = 0.0 + dsk_humfpc = -permsd + dsk_humft = 0.0 + endif if(p_hum.gt.pflowa_tol) then permsda = permsd*permd_air_mult sk_airhf = permsda*(phi(mi)-p_hum) @@ -2726,7 +2976,7 @@ subroutine thrmwc(ndummy) cprod=0.0 c -c derivatives of sink terms +c derivatives of sink terms for outflow c if(ieosd.eq.2.and.qdis.gt.0.0) then dragp=(rov*xvisl*(drolp*xvisv+rol*dvisvp)-rol*xvisv*(drovp @@ -2912,7 +3162,15 @@ subroutine thrmwc(ndummy) qh(mi) = qh(mi) + sk_hum*enl dqh(mi) = dqh(mi) + dhlp*sk_hum deqh(mi)=deqh(mi) + enl*dsk_hums - dcqh(mi)=dcqh(mi) + dhlpc*sk_hum + dcqh(mi)=dcqh(mi) + dhlpc*sk_hum +c gaz 112518 inflow or outflow + else if(sk_hum.le.0.0) then + sk(mi) = sk(mi) + sk_hum + dqt(mi) = dqt(mi) + dsk_hums + qh(mi) = qh(mi) + sk_hum*enl + dqh(mi) = dqh(mi) + dhlp*sk_hum + deqh(mi)=deqh(mi) + enl*dsk_hums + dcqh(mi)=dcqh(mi) + dhlpc*sk_hum endif c air and water leave in the gas phase (outflow) c need energy term here @@ -2930,13 +3188,20 @@ subroutine thrmwc(ndummy) c air and water enter in the gas phase (inflow) c includes specified humidity in inflow c need energy term here -c no derivatives because inflow +c no derivatives wrt T or pci because inflow +c gaz corrected 111318 pci = p-pv(t) need more derivatives for ieosd =2 sk(mi) = sk(mi) + sk_h2o dq(mi) = dq(mi) + dsk_h2op + dqt(mi) = dqt(mi) + dsk_h2ot + dqpc(mi) = dqpc(mi) + dsk_h2opc qc(mi) = qc(mi) + sk_air dqc(mi) = dqc(mi) + dsk_airp + deqc(mi) = deqc(mi) + dsk_airt + dcqc(mi) = dcqc(mi) + dsk_airpc qh(mi) = qh(mi)+ eh_air dqh(mi) = dqh(mi) + deh_airp + deqh(mi) = deqh(mi) + deh_airt + dcqh(mi) = dcqh(mi) + deh_airpc endif c c section on fixed relative humidity @@ -2964,7 +3229,6 @@ subroutine thrmwc(ndummy) c c add heat source term c - htc = 0.0 if(qflux(mi).ne.0.0.or.t_hum.ne.0.0) then if(qflxm(mi).gt.0.0) then @@ -2974,7 +3238,6 @@ subroutine thrmwc(ndummy) tbound = t_hum htc = abs(wellim(mi)) endif - if(htc.gt.0.0) then hflux=htc*(tl-tbound) if(ieosd.ne.2) then diff --git a/src/user_ymp.f b/src/user_ymp.f index 7c4f983d..249b59c4 100755 --- a/src/user_ymp.f +++ b/src/user_ymp.f @@ -104,7 +104,7 @@ subroutine user(k) integer, allocatable :: idum_c(:) integer, allocatable :: nel_node(:) integer, allocatable :: izone_awt(:) - integer, allocatable :: elem_temp(:,:) +c integer, allocatable :: elem_temp(:,:) real*8, allocatable :: cons(:,:) real*8, allocatable :: cord_add(:,:) real*8, allocatable :: times(:) @@ -1532,6 +1532,72 @@ subroutine user(k) close (99) stop endif + case(-909) +c +c compare temperatures for nts_thermal verification +c + if(l.eq.1) then + ex = .false. + inquire(file = 'temp_test.txt', exist = ex) + if(.not.ex) then + if(iout.ne.0) + & write (iout,*)'file 1 for nts_thermal comp missing' + if(iptty.ne.0) + & write (iptty,*)'file 1 for nts_thermal comp missing' + stop + endif + open(unit = 98,file='temp_test.txt',status='unknown') + ex = .false. + inquire(file = 'temp_test_LANL.txt', exist = ex) + if(.not.ex) then + if(iout.ne.0) + & write (iout,*)'file 2 for nts_thermal comp missing' + if(iptty.ne.0) + & write (iptty,*)'file 2 for nts_thermal comp missing' + stop + endif + open(unit = 99,file='temp_test_LANL.txt',status='unknown') +c + allocate(temp1(7)) + read(98,*) + read(98,*) + read(98,*) + read(98,*) + read(98,*) + read(99,*) + read(99,*) + read(99,*) + read(99,*) + read(99,*) +c + temp1(4) = 0.0 + ntimes = 0 + kb_max = 0 +985 continue + read (98,*, end = 986) i, dumx, temp1(1) + read (99,*, end = 986) j, dumx, temp1(2) + ntimes = ntimes + 1 + temp1(3) = abs(temp1(1)-temp1(2)) + temp1(7) = temp1(7) + temp1(3) + if(temp1(3).gt.temp1(4)) then + temp1(4) = temp1(3) + temp1(5) = temp1(1) + temp1(6) = temp1(2) + kb_max = i + endif + go to 985 +986 continue + + + if(iout.ne.0) write(iout,*) + & 'max temp diff node ',kb_max,' diff = ', temp1(4) + if(iptty.ne.0) write(iptty,*) + & 'max temp diff node ',kb_max,' diff = ', temp1(4) + write (iout,*) ntimes,' lines , end of data,stopping' + if(iptty.ne.0) + & write (iptty,*) ntimes,' lines , end of data,stopping' + stop + endif case(-910) c c vap_press fit diff --git a/src/varchk.f b/src/varchk.f index 492de77c..629ed453 100755 --- a/src/varchk.f +++ b/src/varchk.f @@ -421,7 +421,7 @@ subroutine varchk(ifl,ndummy) parameter(psatmn=0.0001) parameter(eosmg=1.0001) c parameter(eosml=0.95) - parameter(eosml=0.99) +c parameter(eosml=0.99) parameter(eostol=0.0001) c parameter(stepl=0.95) parameter(pcimin=0.0) @@ -429,12 +429,13 @@ subroutine varchk(ifl,ndummy) parameter(phase_sat=1.0d-9) c gaz debug 092115 c parameter(satml=1.0d-4) - parameter(xdiff_tol=1.0d-4) c parameter(satml=1.0d-6) c parameter(phase_mult=1.01) + parameter(xdiff_tol=1.0d-4) + real*8 pcrit_h2o, tcrit_h2o + parameter(pcrit_h2o=22.00d0, tcrit_h2o=373.95) c ich_max should be odd or even but don't know which c parameter(ich_max = 2) - real*8 psatl integer i real*8 pl @@ -463,35 +464,38 @@ subroutine varchk(ifl,ndummy) integer i3 integer ifl integer ndummy,k + real*8 stepl_hm, phase_mult_hm, satml_hm, eosml_hm + real*8 stepl_hma, phase_mult_hma, satml_hma, eosml_hma + parameter(stepl_hm = 0.95, phase_mult_hm = 1.00001) +c gaz debug 051516 (optimized for geothermal;satml = 1.0d-2 may be too large) + parameter(satml_hm = 1.0d-2, eosml_hm = 0.9) + parameter(stepl_hma = 0.95, phase_mult_hma = 1.05) + parameter(satml_hma = 1.0d-7, eosml_hma = 0.99) c c c ich_m1 and ich_m2 are in comai but are adjusted here c these are maybe best for geothermal systems c -c gaz debug 051516 - if (ico2.eq.0) then - satml=1.0d-2 - phase_mult=1.01 + if(ico2.eq.0) then + satml = satml_hm + phase_mult = phase_mult_hm + eosml = eosml_hm else -c satml=1.0d-6 to 1.0d-7 about the same -c satml=1.0d-4 #bad -c satml=1.0d-2 #bad - satml=1.0d-7 -c phase_mult=1.01 -c phase_mult=1.001 #bad - phase_mult=1.15 + satml = satml_hma + phase_mult = phase_mult_hma + eosml = eosml_hma endif ich_m1 = 10 ich_m2 = 10 - ich_max = 6 + ich_max = 6 c -c determine variable set +c determine nr correction multiplier c if(nr_stop.eq.0) then if(ico2.eq.0) then - stepl = 0.99 + stepl = stepl_hm else - stepl = 0.95 + stepl = stepl_hma endif else stepl = strd_iter @@ -511,9 +515,7 @@ subroutine varchk(ifl,ndummy) c c evaluate eos status of each node. change status as prescribed c by phase change instructions - - - + c set newton raphson step length to 1.0 at beginning of timestep if(iad.eq.0) then strd =1.0 @@ -523,12 +525,14 @@ subroutine varchk(ifl,ndummy) c c new loop to check on degree of freedom c if idof=1, the problem is either heat conduction or saturated only +c c if(idof.ne.1) then if(ico2.eq.0) then c c determine phase state for pure water c +c gaz 111015 added super crtical phase if(icarb.eq.0) then do i=1,neq ij=i+ndummy @@ -544,23 +548,34 @@ subroutine varchk(ifl,ndummy) c if(ps(ij).eq.0.0.or.idof.le.1) then c ieosdc=-1 gaz 10-17-2001 do nothing - elseif(ieosd.eq.1) then + elseif(ieosd.eq.1) then c c liquid only state c - tboil=psatl(pl,pcp(ij),dpcef(ij),dtsatp,dpsats, + tboil = 2000. + if(pl.ge.pcrit_h2o.and.tl.ge.tcrit_h2o) then + ieosdc = 4 + else if(pl.lt.pcrit_h2o.and.tl.ge.tcrit_h2o) then + ieosdc = 3 + s(ij) = 0.0 + else if(pl.lt.pcrit_h2o) then + tboil=psatl(pl,pcp(ij),dpcef(ij),dtsatp,dpsats, & 1,an(ij)) + endif + C***** C***** AF 11/15/10 -C***** - if(tableFLAG.EQ.1) tboil = 1201. ! phs 4/27/99 +C**** + if(tableFLAG.EQ.1) tboil = 1201. ! phs 4/27/99 C***** c change to 2-phase if(tl.ge.tboil*phase_mult. & and.days.ge.time_ieos(ij)) then ieosdc=2 c s(ij)=eosml - s(ij)=1. +c gaz debug 121817 +c s(ij)=0.999 + s(ij) = eosml t(ij)=tboil time_ieos(ij) = days + time_ch c call phase_balance_ctr(1,ij,phi(ij),t(ij),s(ij)) @@ -570,21 +585,28 @@ subroutine varchk(ifl,ndummy) c c 2-phase conditions c +c gaz 102917 update temperature earlier in iteration + t(ij)=psatl(pl,pcp(ij),dpcef(ij), + & dtsatp,dpsats,1,an(ij)) +c + if(sl.gt.1..and.days.ge.time_ieos(ij)) then c change to liquid only conditions ieosdc=1 -c t(ij)=psatl(pl,pcp(ij),dpcef(ij), -c 2 dtsatp,dpsats,1,an(ij))*eosml - t(ij)=psatl(pl,pcp(ij),dpcef(ij), - 2 dtsatp,dpsats,1,an(ij)) +c gaz 102917 calculated above +c t(ij)=psatl(pl,pcp(ij),dpcef(ij), +c 2 dtsatp,dpsats,1,an(ij)) s(ij)=1.0 time_ieos(ij) = days + time_ch elseif(s(ij).le.0.0.and.days.ge.time_ieos(ij)) & then c change to gas only ieosdc=3 - t(ij)=psatl(pl,pcp(ij),dpcef(ij), - 2 dtsatp,dpsats,1,an(ij))*eosmg +c t(ij)=psatl(pl,pcp(ij),dpcef(ij), +c 2 dtsatp,dpsats,1,an(ij))*eosmg +c gaz debug 121817 +c t(ij) = t(ij)*eosmg + t(ij) = t(ij)*eosmg s(ij)=0.0 time_ieos(ij) = days + time_ch endif @@ -592,7 +614,14 @@ subroutine varchk(ifl,ndummy) elseif(ieosd.eq.3) then c c gas conditions -c +c + if(pl.ge.pcrit_h2o.and.tl.ge.tcrit_h2o) then + ieosdc = 4 + s(ij) = 1 + else if(pl.ge.pcrit_h2o.and.tl.lt.tcrit_h2o) then + ieosdc = 1 + s(ij) = 1.0 + endif tboil=psatl(pl,pcp(ij),dpcef(ij),dtsatp,dpsats, & 1,an(ij)) if(tl.le.tboil/phase_mult. @@ -603,12 +632,36 @@ subroutine varchk(ifl,ndummy) ieosdc=2 time_ieos(ij) = days + time_ch endif + elseif(ieosd.eq.4) then +c +c sc conditions +c +c sufficient to go to gas or liquid + if(pl.lt.pcrit_h2o.and.tl.ge.tcrit_h2o) then + ieosdc = 3 + s(ij) = 0.0 + else if(pl.ge.pcrit_h2o.and.tl.lt.tcrit_h2o) then + ieosdc = 1 + s(ij) = 1.0 + else if(pl.lt.pcrit_h2o.and.tl.lt.tcrit_h2o) then + tboil=psatl(pl,pcp(ij),dpcef(ij),dtsatp,dpsats, + & 1,an(ij)) + if(tl.ge.tboil) then + ieosdc = 3 + s(ij) = 0.0 + else + ieosdc = 1 + s(ij) = 1.0 + endif + else + ieosdc = 4 endif + endif c c c remember if danl eos change occured c tally eos numbers -c +c if(ieosd.ne.ieosdc) then strd =stepl ieos_ch(ij) = ieos_ch(ij) +1 @@ -618,7 +671,7 @@ subroutine varchk(ifl,ndummy) endif ieos(ij)=ieosdc enddo - 233 format('>> phase chng/ts gt 3 >>>> ', 2i8,1p,3g14.4) + 233 format('$$$$$$$ >>>>>> ', 2i8,1p,3g14.4) else if(icarb.ne.0) then call icectrco2(-1,0) c ieos = 1 @@ -690,7 +743,7 @@ subroutine varchk(ifl,ndummy) s(ij)=1.0 strd = stepl time_ieos(ij) = days + time_ch -c else +c else c s(ij) = 0.999 endif endif @@ -700,7 +753,7 @@ subroutine varchk(ifl,ndummy) pboil = psatl(tl,pcp(ij),dpcef(ij), & dpsatt,dpsats,0,an(ij)) c if(sl.le.0.0.and.so(ij).lt.0.05) then - if(sl.le.0.0) then + if(sl.le.0.0) then denei_ch(ij) = denei(ij) deni_ch(ij) = deni(ij) denpci_ch(ij) = denpci(ij) @@ -842,6 +895,8 @@ subroutine varchk(ifl,ndummy) i1=i+nr1 i2=i+nr2 ieosd=ieos(i) +c gaz 112115 + if(ieosd.eq.4) ieosd = 1 if(ps(i).eq.0.0.or.ieosd.eq.0) then c gaz 10-18-2001 t(i)=t(i)-bp(i2)*strd @@ -898,7 +953,7 @@ subroutine varchk(ifl,ndummy) c endif pci(i)=max(0.0d00,pci(i)) s(i)=min(1.d00,max(0.0d00,s(i))) - enddo + enddo else if(ico2.lt.0.and.ice.eq.0) then c c make corrections for isothermal air-water mixture diff --git a/src/vrock_ctr.f b/src/vrock_ctr.f new file mode 100755 index 00000000..3856ce93 --- /dev/null +++ b/src/vrock_ctr.f @@ -0,0 +1,549 @@ + subroutine vrock_ctr(iflg,ndummy) +!*********************************************************************** +! Copyright 2010 Los Alamos National Security, LLC All rights reserved +! Unless otherwise indicated, this information has been authored by an +! employee or employees of the Los Alamos National Security, LLC (LANS), +! operator of the Los Alamos National Laboratory under Contract No. +! DE-AC52-06NA25396 with the U. S. Department of Energy. The U. S. +! Government has rights to use, reproduce, and distribute this +! information. The public may copy and use this information without +! charge, provided that this Notice and any statement of authorship are +! reproduced on all copies. Neither the Government nor LANS makes any +! warranty, express or implied, or assumes any liability or +! responsibility for the use of this information. +!*********************************************************************** +CD1 +CD1 PURPOSE +CD1 +CD1 To calculate variable rock density and heat capacity. +CD1 +CD1 +C********************************************************************** +CD2 +CD2 REVISION HISTORY +CD2 +CD2 Started 080417 George Zyvoloski (Consultant) +CD2 Based on subroutine vcon for variable thermal conductivity +CD2 gaz 080117 +CDA +CDA REFERENCES +CDA +CDA +C********************************************************************** +CPS +C********************************************************************** + + use combi + use comci + use comdi + use comei + use comfi + use comgi + use comii + use comdti + use comai + use comki + implicit none + + integer iflg,ndummy,i,ivrc,mid,mi,it,itp, i1, i2, itbl,iparam + integer ntblines_roc, lu, itrocd + real*8 vr1,vr2,vr3,vr4, vr5, vr6, vr7, vr8, vr12, sqrsat, tmpPor + real*8 t_dum, cpr_t1, cpr_t2, denr_t1, denr_t2 + real*8 ddenr1t,ddenr2t,dcpr1t,dcpr2t + real*8 cprmi,dcprmit,denrmi,ddenrmit + real*8 term_t1, term_t2, diff_term + real*8 tl, tmelt0, tmelt1, tmelt2, tmeltdt, heat_latent + character*200 chdum, file_flux + integer max_vrock_model, max_vrock_tabl + parameter (max_vrock_model = 2000, max_vrock_tabl = 100) + real*8 strd_vroc + parameter (strd_vroc = 0.9) + integer open_file + + logical null1 + +c read in data + if(ivrock.ne.0) then + if(iflg.eq.0) then + allocate(ivroc(max_vrock_model), table_vroc(max_vrock_tabl)) + allocate(vroc1f(max_vrock_model), vroc2f(max_vrock_model)) + allocate(vroc3f(max_vrock_model), vroc4f(max_vrock_model)) + allocate(vroc5f(max_vrock_model), vroc6f(max_vrock_model)) + allocate(vroc7f(max_vrock_model), vroc8f(max_vrock_model)) + allocate(vroc9f(max_vrock_model),itroc(n0)) + allocate(ntable_vroc(max_vrock_model)) + allocate(tblindx_roc(max_vrock_tabl,2)) + allocate(ddenrt(n0),dcprt(n0)) + allocate(ivrn(n0)) + if(.not.allocated(urock)) allocate(urock(n0),durockt(n0)) + ntable_roc = 0 + i=0 + 10 continue + read(inpt,'(a80)') wdd1 + if(.not. null1(wdd1)) then + backspace inpt + read(inpt,*) ivrc + backspace inpt + if(isalt.ne.0) then + if(ivrc.ne.6) then + write(ierr,*) + & 'warning non salt vrock model entered ' + if(iout.ne.0) write(iout,*) + & 'warning non salt vrock model entered ' + if(iptty.ne.0) write(iptty,*) + & 'warning non salt vrock model entered ' + endif + endif + i=i+1 + if(ivrc .eq. 1) then +c constant model for rock density and heat capacity + read(inpt,*) ivroc(i), + & vroc1f(i),vroc2f(i) + else if(ivrc .eq. 2) then +c linear expansion model for rock density and heat capacity + read(inpt,*) ivroc(i), + & vroc1f(i),vroc2f(i),vroc3f(i),vroc4f(i),vroc5f(i), + & vroc6f(i) + else if(ivrc .eq. 3) then +c linear model for rock density and quadratic model for heat capacity + read(inpt,*) ivroc(i), + & vroc1f(i),vroc2f(i),vroc3f(i),vroc4f(i),vroc5f(i), + & vroc6f(i),vroc7f(i) + elseif(ivrc .eq. 4) then +c tablular data for density and heat capacity + ntable_roc = ntable_roc + 1 + read(inpt,'(a)') chdum + chdum=trim(chdum) + read(chdum,*) ivroc(i), file_flux + file_flux = trim(file_flux) + table_vroc(ntable_roc) = file_flux + ntable_vroc(i) = ntable_roc + lu = open_file(file_flux,'old') + call manage_rock_tables(0,lu, + & ntable_roc,0,0.d0,0.d0,0.d0,0.d0,0.d0) + + else if(ivrc .eq. 5) then +c linear model for rock density and heat capacity, with melting +c reference temperature is 20 C for solid phase +c vroc1f(i) density denr +c vroc2f(i) derivative denr wrt temperature +c vroc3f(i) specific heat capacity for solid phase (Cps) +c vroc4f(i) derivative Cps wrt temperature +c reference temperature is melt temperature for melt phase +c vroc5f(i) specific heat capacity for liquid (melt) phase (Cpl, set = Cps at tmelt) +c vroc6f(i) derivative Cpl wrt temperature +c vroc7f(i) melt temperature (tmelt0) +c vroc8f(i) latent_heat +c vroc9f(i) spead temperature + + read(inpt,*) ivroc(i), + & vroc1f(i),vroc2f(i),vroc3f(i),vroc4f(i), + & vroc6f(i),vroc7f(i),vroc8f(i),vroc9f(i) +c the internal energy derivative wrt temperature must be positive +c therfore set liquid cpr(tmelt) tp solid(tmelt) + vr3=vroc3f(i) + vr4=vroc4f(i) + tmelt0 = vroc7f(i) + cpr_t1 =(vr4*(tmelt0-20.)+vr3) + vroc5f(i) = cpr_t1 + else if(ivrc .eq. 6) then +c tables and latent heat +c tablular data for density and heat capacity + ntable_roc = ntable_roc + 1 + read(inpt,'(a)') chdum + chdum=trim(chdum) + read(chdum,*) ivroc(i),file_flux,vroc7f(i),vroc8f(i), + & vroc9f(i) + file_flux = trim(file_flux) + table_vroc(ntable_roc) = file_flux + ntable_vroc(i) = ntable_roc + lu = open_file(file_flux,'old') + call manage_rock_tables(0,lu, + & ntable_roc,0,0.d0,0.d0,0.d0,0.d0,0.d0) + endif + else + if(i.eq.0) ivrc=0 + go to 20 + endif + go to 10 +c read in nodal capillary type + 20 continue + + narrays = 1 + itype(1) = 4 + default(1) = 0 + macro = "vroc" + igroup = 2 + + call initdata2( inpt, ischk, n0, narrays, + & itype, default, macroread(9), macro, igroup, ireturn, + & i4_1=ivrn(1:n0)) + + macroread(9) = .TRUE. + + if(ntable_roc.ne.0) then + ntblines_roc = tblindx_roc(ntable_roc,2) + allocate(roc_table(ntblines_roc,3)) + do i = 1, ntblines_roc + roc_table(i,1:3) = temp_table(i,1:3) + enddo + call manage_rock_tables(3,0,0,0.d0,0.d0,0.d0,0.d0,0.d0) + endif + + + else if(iflg.eq.1) then + +c load heat capacity + do mi=1,n0 + it=ivrn(mi) + if(it.ne.0) then + itp=ivroc(it) + if(itp.eq.1) then +c constant rock density and heat capacity + tl = t(mi) + denr(mi) = vroc1f(it) + cpr(mi) = vroc2f(it)*energy_conv + ddenrt(mi) = 0.0 + dcprt(mi) = 0.0 + urock(mi) = denr(mi)*cpr(mi)*(tl) + durockt(mi) = denr(mi)*cpr(mi) + elseif(itp.eq.2) then +c linear variation with temperature +c vroc1f=reference temperature,vroc2f=reference rock density +c vroc3f=d(density)/d(temp) at reference conditions + tl = t(mi) + vr1=vroc1f(it) + vr2=vroc2f(it) + vr3=vroc3f(it) + denr(mi)=(vr3*(t(mi)-vr1) + vr2) + ddenrt(mi) = vr3 + vr4=vroc4f(it) + vr5=vroc5f(it) + vr6=vroc6f(it) + cpr(mi)=(vr6*(t(mi)-vr4) + vr5)*energy_conv + dcprt(mi) = vr6*energy_conv + urock(mi) = denr(mi)*cpr(mi)*(tl) + durockt(mi) = denr(mi)*(dcprt(mi)*(tl)+ + & cpr(mi)) + ddenrt(mi)*cpr(mi)*(tl) + else if(itp.eq.3) then +c linear variation with temperature +c vroc1f=reference temperature,vroc2f=reference rock density +c vroc3f=d(density)/d(temp) at reference conditions + tl = t(mi) + vr1=vroc1f(it) + vr2=vroc2f(it) + vr3=vroc3f(it) + denr(mi)=(vr3*(t(mi)-vr1) +vr2) + vr4=vroc4f(it) + vr5=vroc5f(it) + vr6=vroc6f(it) + vr7=vroc7f(it) + cpr(mi)=(vr6*(t(mi)-vr4) +vr7*(t(mi)-vr4)**2 +vr5)* + & energy_conv + dcprt(mi) = (vr6 + 2.*vr7*(t(mi)-vr4))*energy_conv + urock(mi) = denr(mi)*cpr(mi)*(tl) + durockt(mi) = denr(mi)*(dcprt(mi)*(tl)+ + & cpr(mi)) + ddenrt(mi)*cpr(mi)*(tl) + else if(itp.eq.4) then + tl = t(mi) + ntable_roc = ntable_vroc(it) + call manage_rock_tables(1,0, + & ntable_roc,10,tl,cpr(mi),dcprt(mi),denr(mi), + & ddenrt(mi)) + urock(mi) = denr(mi)*cpr(mi)*(tl) + durockt(mi) = denr(mi)*(dcprt(mi)*(tl)+ + & cpr(mi)) + ddenrt(mi)*cpr(mi)*(tl) + else if(itp.eq.5) then +c internal energy formulation +c linear model for rock density and heat capacity, with melting +c reference temperature is 20 C for solid phase +c vroc1f(i) density denr +c vroc2f(i) derivative denr wrt temperature +c vroc3f(i) specific heat capacity for solid phase (Cps) +c vroc4f(i) derivative Cps wrt temperature +c reference temperature is melt temperature for melt phase +c vroc5f(i) specific heat capacity for liquid (melt) phase (Cpl) reference value +c vroc6f(i) derivative Cpl wrt temperature +c vroc7f(i) melt temperature +c vroc8f(i) latent_heat (aready input in Mj/kg, typical value 1 to 2) +c vroc9f(i) spead temperature + tl = t(mi) + vr1=vroc1f(it) + vr2=vroc2f(it) + denr(mi)=vr2*(tl-20.) + vr1 + ddenrt(mi) = vr2 + tmelt0 = vroc7f(it) +c center the temperature ramp + tmeltdt = vroc9f(it)/2. + tmelt1 = tmelt0 - tmeltdt + tmelt2 = tmelt0 + tmeltdt + heat_latent = vroc8f(it) + if(tl.lt.tmelt1) then + vr3=vroc3f(it) + vr4=vroc4f(it) + cpr(mi)=(vr4*(tl-20.)+vr3)*energy_conv + dcprt(mi) = vr4*energy_conv + urock(mi) = 0.0 + denr(mi)*cpr(mi)*(tl) + durockt(mi) = denr(mi)*(dcprt(mi)*(tl)+ + & cpr(mi)) + ddenrt(mi)*cpr(mi)*(tl) + continue + else if(tl.gt.tmelt2) then + vr5=vroc5f(it) + vr6=vroc6f(it) + cpr(mi)=(vr6*(tl-tmelt0)+vr5)*energy_conv + dcprt(mi) = vr6*energy_conv + urock(mi)=denr(mi)*(heat_latent+cpr(mi)* + & (tl)) + durockt(mi)=denr(mi)*(dcprt(mi)*(tl)+cpr(mi)) + & + ddenrt(mi)*(cpr(mi)*(tl)+heat_latent) + continue + else +c average both density and internal energy + vr3=vroc3f(it) + vr4=vroc4f(it) + cpr_t1 =(vr4*(tmelt1-20.)+vr3)*energy_conv + denr_t1 = vr2*(tmelt1 -20.) + vr1 + vr5=vroc5f(it) + vr6=vroc6f(it) + cpr_t2 =(vr6*(tmelt2-tmelt0) + & +vr5)*energy_conv + denr_t2 = vr2*(tmelt2 -20.) + vr1 + term_t1 = denr_t1*cpr_t1*(tmelt1) + term_t2 = denr_t2*(cpr_t2*(tmelt2)+ + & heat_latent) + diff_term = term_t2-term_t1 + urock(mi)= term_t1 + diff_term*(tl-tmelt1)/ + & (2.*tmeltdt) + durockt(mi) = diff_term/(2.*tmeltdt) + continue + endif + + else if(itp.eq.6) then +c internal energy formulation with tables and latent heat +c denrmi density denr +c ddenrmit derivative denr wrt temperature +c cprmi specific heat capacity for solid phase (Cps) +c dcprmit derivative Cps wrt temperature +c vroc7f(i) melt temperature +c vroc8f(i) latent_heat (aready input in Mj/kg, typical value 1 to 2 +c vroc9f(i) spread temperature difference + tl = t(mi) + ntable_roc = ntable_vroc(it) + call manage_rock_tables(1,0, + & ntable_roc,10,tl,denrmi,ddenrmit,cprmi,dcprmit) +c cpr and denr available from table + denr(mi) = denrmi + ddenrt(mi) = ddenrmit + cpr(mi) = cprmi + dcprt(mi) = dcprmit + tmelt0 = vroc7f(it) +c center the temperature difference + tmeltdt = vroc9f(it)/2. + tmelt1 = tmelt0 - tmeltdt + tmelt2 = tmelt0 + tmeltdt + heat_latent = vroc8f(it) + if(tl.lt.tmelt1) then + urock(mi) = 0.0 + denr(mi)*cpr(mi)*(tl) + durockt(mi) = denr(mi)*(dcprt(mi)*(tl)+ + & cpr(mi)) + ddenrt(mi)*cpr(mi)*(tl) + continue + else if(tl.gt.tmelt2) then + continue + urock(mi)=denr(mi)*(heat_latent+cpr(mi)*tl) + durockt(mi)=denr(mi)*(dcprt(mi)*(tl)+cpr(mi)) + & + ddenrt(mi)*(cpr(mi)*(tl)+heat_latent) + else +c tmelt1 - tmelt - dt +c denr_t1 = rock density (tmelt1) +c ddenr1t = deriv wrt T denr(tmelt1) +c cpr_t1 = heat capacity (tmelt1) +c dcpr1t = deriv wrt T heat capacity(tmelt1) + ntable_roc = ntable_vroc(it) + call manage_rock_tables(1,0, + & ntable_roc,10,tmelt1,denr_t1,ddenr1t,cpr_t1,dcpr1t) + + call manage_rock_tables(1,0, + & ntable_roc,10,tmelt2,denr_t2,ddenr2t,cpr_t2,dcpr2t) + + term_t1 = denr_t1*cpr_t1*(tmelt1) + term_t2 = denr_t2*(cpr_t2*(tmelt2)+ + & heat_latent) + diff_term = term_t2-term_t1 + urock(mi)= term_t1 + diff_term*(tl-tmelt1)/ + & (2.*tmeltdt) + durockt(mi) = diff_term/(2.*tmeltdt) + continue + endif + end if + endif + enddo + else if(iflg.eq.2) then +c calculate rock phase state + do mi = 1, n0 + it=ivrn(mi) + if(it.ne.0) then + itp=ivroc(it) + if(itp.ge.5) then + tmelt0 = vroc7f(it) + tmeltdt = vroc9f(it)/2. + tmelt1 = tmelt0 - tmeltdt + tmelt2 = tmelt0 + tmeltdt + tl = t(mi) + itrocd = itroc(mi) + if(tl.lt.tmelt1.and.itrocd.ne.1) then + itroc(mi) = 1 + strd = min(strd,strd_vroc) + else if(tl.gt.tmelt2.and.itrocd.ne.3) then + itroc(mi) = 3 + strd = min(strd,strd_vroc) + else if(tl.ge.tmelt1.and.tl.le.tmelt2. + & and.itrocd.ne.2) then + itroc(mi) = 2 + strd = min(strd,strd_vroc) + endif + endif + endif + enddo + else if(iflg.eq.3) then +c calculate rock phase state + do mi = 1, n0 + it=ivrn(mi) + if(it.ne.0) then + itp=ivroc(it) + if(itp.ge.5) then + tmelt0 = vroc7f(it) + tmeltdt = vroc9f(it)/2. + tmelt1 = tmelt0 - tmeltdt + tmelt2 = tmelt0 + tmeltdt + tl = t(mi) + if(tl.lt.tmelt1) then + itroc(mi) = 1 + else if(tl.gt.tmelt2) then + itroc(mi) = 3 + else if(tl.ge.tmelt1.and.tl.le.tmelt2) then + itroc(mi) = 2 + endif + endif + endif + enddo + end if + end if + +c endif + return + end + + subroutine manage_rock_tables(iflg,table_unit,i_table,iparam,t_dum + & ,var1_dum, dvar1_dumt, var2_dum, dvar2_dumt) +c +c manage rock tables +c +c Data is found on the following lines + use comai + use comdi + implicit none + integer iflg,lu,table_unit,ndx,cn,nparams,maxlines + integer i_table,iparam, lasttbl,i1,i2,mi,i + real*8 t_dum, dvar1_dumt, var1_dum, dvar2_dumt, var2_dum + real*8 var_dum, dvar_dumt + parameter(nparams = 3,maxlines = 100000) + character*300 chdum + + if(iflg.eq.0) then +c read table input +c table are appended into one large table + if(.not.allocated(temp_table)) allocate(temp_table(maxlines,3)) +c read 1 title line + read (table_unit,'(a)') chdum + ndx = 0 + if (i_table .eq. 1) then +c first line is a text header (hence table data starts at line 2) + tblindx_roc(i_table,1) = 2 + ndx = 0 + else + tblindx_roc(i_table, 1) = tblindx_roc(i_table - 1, 2) + 1 + ndx = tblindx_roc(i_table - 1, 2) + end if + do + read (table_unit, '(a)', end = 5) chdum +c Input is terminated with a blank line or 'end' or end-of-file) + if (len_trim(chdum) .eq.0 .or. + & chdum(1:3) .eq. 'end') exit + ndx = ndx + 1 + read (chdum, *) (temp_table(ndx,cn), cn = 1, nparams) + end do + 5 lasttbl = i_table + tblindx_roc(i_table, 2) = ndx + if (table_unit .ne. inpt) close (table_unit) + else if(iflg.eq.1) then +c Extract Tabular data +c iparam = 2: rock density iparam = 3: rock specific heat +c + i1 = tblindx_roc(i_table , 1) + i2 = tblindx_roc(i_table , 2) + if(iparam.ne.10) then + do i = i1, i2 - 1 + if (t_dum .le. roc_table(i, 1) .and. i .eq. i1) then + var_dum = roc_table(i1, iparam) + dvar_dumt = 0. + go to 10 + else if (t_dum.ge.roc_table(i + 1, 1).and.i + 1 .eq. i2)then + var_dum = roc_table(i2, iparam) + dvar_dumt = 0. + go to 10 + else if (t_dum .ge. roc_table(i, 1) .and. + & t_dum .lt. roc_table(i + 1, 1)) then + dvar_dumt =(roc_table(i + 1,iparam)-roc_table(i, iparam))/ + & (roc_table(i + 1,1) - roc_table(i, 1)) + var_dum = roc_table(i,iparam) + + & dvar_dumt* (t_dum - roc_table(i, 1)) + go to 10 + end if + end do + else + do i = i1, i2 - 1 + if (t_dum .le. roc_table(i, 1) .and. i .eq. i1) then + var1_dum = roc_table(i1, 2) + dvar1_dumt = 0. + var2_dum = roc_table(i1, 3) + dvar2_dumt = 0. + go to 10 + else if (t_dum.ge.roc_table(i + 1, 1).and.i + 1 .eq. i2)then + var1_dum = roc_table(i2, 2) + dvar1_dumt = 0. + var2_dum = roc_table(i2, 3) + dvar2_dumt = 0. + go to 10 + else if (t_dum .ge. roc_table(i, 1) .and. + & t_dum .lt. roc_table(i + 1, 1)) then + dvar1_dumt =(roc_table(i + 1,2)-roc_table(i, 2))/ + & (roc_table(i + 1,1) - roc_table(i, 1)) + var1_dum = roc_table(i,2) + + & dvar1_dumt* (t_dum - roc_table(i, 1)) + dvar2_dumt =(roc_table(i + 1,3)-roc_table(i, 3))/ + & (roc_table(i + 1,1) - roc_table(i, 1)) + var2_dum = roc_table(i,3) + + & dvar2_dumt* (t_dum - roc_table(i, 1)) + go to 10 + end if + end do + endif + return +10 if(iparam.eq.2) then + var1_dum = var_dum + dvar1_dumt = dvar_dumt + else if(iparam.eq.3) then + var2_dum = var_dum*energy_conv + dvar2_dumt = dvar_dumt*energy_conv + else if(iparam.eq.10) then + var2_dum = var2_dum*energy_conv + dvar2_dumt = dvar2_dumt*energy_conv + endif + + else if (iflg.eq.3) then +c release memory for temp_table + if(allocated(temp_table)) deallocate(temp_table) + endif + return + end + diff --git a/src/write_avs_head_s.f b/src/write_avs_head_s.f index a45fdc3a..8de97494 100755 --- a/src/write_avs_head_s.f +++ b/src/write_avs_head_s.f @@ -58,7 +58,7 @@ subroutine write_avs_head_s(icall, use comai, only : altc, contim, days, iadif, icnl, jdate, jtime, & verno, wdd use comdi, only : head - use comsi, only : iPlastic,flag_excess_shear + use comsi, only : iPlastic,flag_excess_shear, flag_principal use davidi implicit none @@ -203,14 +203,24 @@ subroutine write_avs_head_s(icall, title(25) = trim(dual_char) // 'CO2 Phase State' title(26) = 'X displacement (m)' title(27) = 'Y displacement (m)' - title(28) = 'Z displacement (m)' - title(29) = 'X stress (MPa)' - title(30) = 'Y stress (MPa)' - title(31) = 'Z stress (MPa)' - title(32) = 'Volume Strain' - title(33) = 'XY stress (MPa)' - title(34) = 'XZ stress (MPa)' - title(35) = 'YZ stress (MPa)' + title(28) = 'Z displacement (m)' +c gaz 052317 + if(flag_principal.eq.0) then + title(29) = 'X stress (MPa)' + title(30) = 'Y stress (MPa)' + title(31) = 'Z stress (MPa)' + title(33) = 'XY stress (MPa)' + title(34) = 'XZ stress (MPa)' + title(35) = 'YZ stress (MPa)' + else if(flag_principal.eq.1) then + title(29) = 'Sigma Max (MPa)' + title(30) = 'Sigma 2 (MPa)' + title(31) = 'Sigma Min (MPa)' + title(33) = 'Ang Sigma Max-Z' + title(34) = 'Ang Sigma Max-X' + title(35) = 'Ang Sigma Max-Y' + endif + title(32) = 'Volume Strain' title(36) = 'Plastic strain (no dim)' title(37) = 'Youngs Mod (MPa)' title(38) = 'Excess Shear (MPa)' diff --git a/src/write_avs_node_con.f b/src/write_avs_node_con.f index ad70347d..b492fe24 100755 --- a/src/write_avs_node_con.f +++ b/src/write_avs_node_con.f @@ -169,14 +169,18 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, C*********************************************************************** use avsio - use comai, only : altc, days, icnl, jdate, jtime, nei_in, - & ns_in, verno, wdd, neq_primary, ivf, ifdm_elem - use combi, only : corz, izonef, nelm + use comai, only : altc, days, grav, iadif, icnl, ico2, idof, + & ichead, ihead, nei_in, ns_in, phi_inc, istrs, ivf, + & neq_primary, rho1grav, ifdm_elem, igrav, ns, gdkm_flag, + & verno,jdate,jtime,wdd, icconc + use combi, only : corz, izonef, nelm, ncord, ncord_inv, elem_temp, + & contour_conc_files use comchem use comdi, only : nsurf, izone_surf, izone_surf_nodes, icns, & an, anv use compart, only : ptrak, pout + use comriv, only : npoint_riv, nnelm_riv, nelm_riv, iriver use comrxni use comdti implicit none @@ -184,32 +188,70 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, integer add_dual, maxcon, iz, idz, iendz, il, open_file integer neq,nspeci,lu,ifdual,icall,length,i1,i2 integer icord1, icord2, icord3, iaq, ivap, isolid - integer npt(*), ip1, ip2 + integer npt(*), ip1, ip2, ic1, ic2 integer, allocatable :: nelm2(:) parameter (maxcon = 100) real*8, allocatable :: an_dum(:,:) real*8, allocatable :: anv_dum(:,:) real*8, allocatable :: antmp(:,:) - character*60, allocatable :: title(:) +c gaz 062717 +c character*60, allocatable :: title(:) character*14 tailstring character*8 dual_char - character*3 dls, snum - character*5 char_type +c gaz 062717 +c character*3 dls, snum + character*3 snum +c character*5 char_type character*60 fstring character*35 tmpname character*30 cordname(3) - character*150 :: string = '', tecstring = '', sharestring = '' +c character*150 :: string = '', tecstring = '', sharestring = '' real*8 write_array(maxcon) - integer i, ic, im, in, iv, ix, istep, j, k, n - integer t1(maxcon),itotal2,write_total, iocord_temp + integer i, ic, im, in, iv, ix, istep, j, k, n, iblanking_value + integer t1(maxcon),itotal2,write_total, iocord_temp,ns_in0 + + logical zone_saved + integer izunit,nin,ii,n_elem,ns_elem,ie, e_mem(8) + integer neq_sv, nei_in_sv, icall_sv, neq_p + integer i_pri,i_sec,nscalar + +c character*80 title(2*maxscalar+3) + character*150 :: tecstring = '' + character*150 :: tecstring_riv = '' + character*500 string + character*20 vstring + character*43 tstring + character*5 char_type + character*3 dls + character*30 zonesavename, char_temp + character*6 zonestring + character*500 sharestring + character*6 share_string + character*150 :: tec_string = '' +c character*45 title(3*maxvector), title2(2) + integer maxvector + parameter (maxvector = 3) + character*60, allocatable :: title(:) + parameter(iblanking_value = -9999) + real*8 pi + parameter (pi=3.1415926535) + integer nadd, istart, iend, irivp, iocord_tmp , offset, iriver2 integer irxn_title + integer i_wrt + real*8 complex_conc real*8 minc, maxc -c gaz debug -c parameter (minc = 1.0d-20, maxc = 1.0d+20) +c gaz 072917 + character*200 file_flux + parameter (minc = 1.0d-90, maxc = 1.0d+20) - save tecstring, sharestring + save tecstring, sharestring, tecstring_riv + +c-------------------------------------------- +c Shaoping add 10-19-2017 + zone_saved =.false. +c------------------------------------------- data cordname(1) / 'X (m)' /, & cordname(2) / 'Y (m)' /, @@ -225,6 +267,64 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, anv_dum(1:n0,i) = anv(ip1:ip2) enddo iocord_temp = iocord + + irivp = 0 + iriver2 = iriver + + iocord_tmp = iocord + + if (iogdkm .ne. 0 .and. ifdual .ne. 0) then +c Output for gdkm nodes + if(iogdkmblank.eq.0) then + istart = neq_primary + 1 +c gaz 070118 +c iend = n0 + iend = neq + offset = 0 + nadd = 0 + else +c gaz 040917 gdkm blanking + istart = 1 + iend = neq_primary + offset = 0 + nadd = 0 + endif + irivp = 0 + if (icnl .eq. 0) then + iocord = 3 + else + iocord = 2 + end if + else if (ifdual .ne. 0)then + istart = neq + 1 + iend = neq * 2 + nadd = nelm(neq+1)-neq-1 + offset = neq + else + if (iriver2 .ne. 0) then +c Output for river/well nodes + istart = neq_primary + 1 + iend = neq_primary + npoint_riv + nadd = 0 + offset = 0 + if(iriver2.eq.2) then + irivp = 2 + ns_in0 = ns_in + ns_in = 2 + endif + else + istart = 1 + iend = neq_primary + nadd = 0 + offset = 0 + irivp = 0 + end if + endif + + if (icall .eq. 1.and.irivp.eq.0) tecstring = '' + if (icall .eq. 1.and.irivp.ne.0) tecstring_riv = '' + + if(ifdual .eq. 0)then istep = 0 add_dual=0 @@ -232,11 +332,13 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, tailstring = '_con_node' else istep = maxcon - add_dual=neq +c gaz add_dual=neq if (iodual .eq. 1) then + add_dual=neq dual_char = 'Dual ' tailstring = '_con_dual_node' else if (iogdkm .eq. 1) then + add_dual=0 dual_char = 'GDKM ' tailstring = '_con_gdkm_node' if (icnl .eq. 0) then @@ -274,79 +376,229 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, iendz = 1 idz = iozone end if - - if (altc(1:4) .eq. 'avsx') then +c different than scalars + if (altc(1:4) .eq. 'avsx') then dls = ' : ' else if (altc(1:3) .eq. 'sur') then dls = ', ' else dls = ' ' - end if - + end if +c +c if (altc(1:3) .ne. 'sur') then call namefile2(icall,lu,ioformat,tailstring,0) ! file will be opened in zone loop for surfer end if + icall_sv = icall +c gaz 062717 + do iz = 1, iendz +c Zone loop +c if block 1 + if (iozone .ne. 0) then + idz = izone_surf(iz) +c open and read saved zone file if they exist + call zone_saved_manage(1,izunit,idz,nin,n_elem,zone_saved) +c gaz 062717 + if(zone_saved) then + zonestring = ' ' + write(zonestring(1:5),'(i5)') idz + neq_sv = neq + nei_in_sv = nei_in + icall_sv = icall + neq = nin + nei_in = n_elem + icall = 1 + iogeo = 1 +c irivp = 0 +c gaz 112716 FE geometry goes here + if (altc(1:3) .eq. 'tec') then + string = '' + if (icall .eq. 1 .and. iogeo .eq. 1) then + select case (ns_in) + case (5,6,8) + write (string, 135) neq, nei_in, 'FEBRICK' + case (4) + if (icnl .eq. 0) then + write (string, 135) neq, nei_in, + & 'FETETRAHEDRON' + else + write (string, 135) neq, nei_in, + & 'FEQUADRILATERAL' + end if + case (3) + write (string, 135) neq, nei_in, 'FETRIANGLE' + case (2) + if(irivp.eq.0) then + write (string, 135) neq, nei_in, 'FELINESEG' + ns_in=ns_in0 + else if(irivp.eq.2)then + write (string, 135) npoint_riv, npoint_riv-1, + & 'FELINESEG' + ns_in=ns_in0 + endif + case (0) +c fdm grid + write (string, '(a)') '' + end select +c endif + - if (altc(1:3) .eq. 'tec') then - if (icall .eq. 1 .and. iogeo .eq. 1) then - iz = 1 - tecstring = '' - select case (ns_in) - case (5,6,8) - write (tecstring, 135) neq, nei_in, 'FEBRICK' - case (4) - if (icnl .eq. 0) then - write (tecstring, 135) neq, nei_in, - & 'FETETRAHEDRON' - else - write (tecstring, 135) neq, nei_in, - & 'FEQUADRILATERAL' - end if - case (3) - write (tecstring, 135) neq, nei_in, 'FETRIANGLE' - case (2) - write (tecstring, 135) neq, nei_in, 'FELINESEG' - case (0) -! fdm grid - write (tecstring, '(a)') '' - write (string, '(a)') '' - end select - if (icnl .eq. 0 .and. ns_in .ne. 0) then - if (iozid .eq. 0) then - write (string, 140) '1-3', iz - else - write (string, 140) '1-3, 5', iz + endif +c end copy FETYPE + endif +c endif +c gaz end FE geometry +c if block 1 + else if (altc(1:3) .eq. 'tec') then + if (icall .gt. 1 .and. iocord .ne. 0) then + string = '' + if (icnl .eq. 0) then + if (iozid .eq. 0) then + write (string, 125) '1-3', iz + else + write (string, 125) '1-3,5', iz + end if + else + if (iozid .eq. 0) then + write (string, 125) '1-2', iz + else + write (string, 125) '1-2, 4', iz + end if + end if + if(irivp.eq.0) then + tecstring = trim(string) + else + tecstring_riv = trim(string) + endif end if - else if (icnl .ge. 1 .and. ns_in .ne. 0) then - if (iozid .eq. 0) then - write (string, 140) '1-2', iz + write (lu, 118) trim(timec_string) + if(irivp.eq.0) then + write (lu, 120) idz, trim(tecstring) else - write (string, 140) '1-2, 4', iz - end if - end if - else if (icall .eq. 1 .and. iocord .ne. 0) then - if (icnl .eq. 0) then - if (iozid .eq. 0) then - string = '1-3' + write (lu, 120) idz, trim(tecstring_riv) + endif +c end id block 1 + end if + else + if (altc(1:3) .eq. 'tec') then +c gaz 040517 gdkm needs small modification + if(gdkm_flag.ne.0) then + neq_p = neq_primary else - string = '1-3, 5' - end if - else - if (iozid .eq. 0) then - string = '1-2' + neq_p = neq + endif + string = '' + if (icall .eq. 1 .and. iogeo .eq. 1) then + select case (ns_in) + case (5,6,8) + write (string, 135) neq_p, nei_in, 'FEBRICK' + case (4) + if (icnl .eq. 0) then + write (string, 135) neq_p, nei_in, + & 'FETETRAHEDRON' + else + write (string, 135) neq_p, nei_in, + & 'FEQUADRILATERAL' + end if + case (3) + write (string, 135) neq_p, nei_in, 'FETRIANGLE' + case (2) + if(irivp.eq.0) then + write (string, 135) neq_p, nei_in, 'FELINESEG' + ns_in=ns_in0 + else if(irivp.eq.2)then + write (string, 135) npoint_riv, npoint_riv-1, + & 'FELINESEG' + ns_in=ns_in0 + endif + case (0) +c fdm grid + write (string, '(a)') '' + end select +c not needed below + +c not needed above + if (ns_in .eq. 0) then + if (iozid .eq. 0) then + write (string, 125) '1-3', iz + else + write (string, 125) '1-3, 5', iz + end if + else if (icnl .eq. 0) then + if (iozid .eq. 0) then + write (string, 140) '1-3', iz + else + write (string, 140) '1-3, 5', iz + end if + else + if (iozid .eq. 0) then + write (string, 140) '1-2', iz + else + write (string, 140) '1-2, 4', iz + end if + end if + if(irivp.eq.0) then + tecstring = trim(tecstring) // trim(string) + string = '' + else + tecstring_riv = trim(tecstring_riv) // trim(string) + string = '' + endif + else if (icall .eq. 1 .and. iocord .ne. 0) then +c gaz 062518 might need to comment out next line +c write (lu, 130) trim(timec_string) + if (icnl .eq. 0) then + if (iozid .eq. 0) then + write (string, 125) '1-3', iz + else + write (string, 125) '1-3, 5', iz + end if + else + if (iozid .eq. 0) then + write (string, 125) '1-2', iz + else + write (string, 125) '1-2, 4', iz + end if + end if + if(irivp.eq.0) then + tecstring = trim(string) + else + tecstring_riv = trim(string) + endif + else if (icall .eq. 1 .and. iozid .ne. 0) then + write (lu, 130) trim(timec_string) + write (string, 125) '2', iz + if(irivp.eq.0) then + tecstring = trim(string) + else + tecstring_riv = trim(string) + endif else - string = '1-2, 4' + if(irivp.eq.0) then + if (iogeo .eq. 1) then + write (lu, 130) trim(timec_string), + & trim(tecstring) + else if (iogrid .eq. 1) then + write (lu, 130) trim(timec_string), + & trim(tecstring), + & trim(gridstring), trim(times_string) + else +c gaz 063018 should not write +c if(icall.ne.1) write (lu, 130) +c & trim(timec_string), trim(tecstring) + end if + else + write (lu, 130) trim(timec_string), + & trim(tecstring_riv), trim(gridstring), + & trim(times_string) + endif end if end if - if (iozone .ne. 0) sharestring = string - else if (icall .eq. 1 .and. iozid .ne. 0) then - string = '2' - if (iozone .ne. 0) sharestring = string end if - end if - if(rxn_flag.eq.0)then + + if(rxn_flag.eq.0)then if(nspeci .gt. maxcon)then write(lu,*)'--------------------------------------------' write(lu,*)'ERROR: WRITE_AVS_NODE_CON' @@ -359,9 +611,6 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, return endif - -c error -c c Formatted write to accomodate the different way fortran 90 c does unformatted writes (f77 way no longer worked because @@ -451,31 +700,77 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, else if (altc(1:3) .eq. 'avs') then write(lu,'(i3, 100(1x, i1))') itotal2,(1,i=1,nspeci+iocord) write(lu, '(a)') (trim(title(i)),i=1,itotal2) +c first write else if (altc(1:3) .eq. 'tec') then - if (icall .eq. 1 .or. iogrid .eq. 1) then +c iz is the increment of the zone loop + if (icall_sv .eq. 1 .or. iogrid .eq. 1) then + if(iz.eq.1) then write(lu, 98) verno, jdate, jtime, trim(wdd) if (iogrid .eq. 1) write(lu, 100) write (fstring, 99) itotal2 write(lu, fstring) 'VARIABLES = ', (trim(title(i)), & i=1,itotal2) + endif end if - if (iozone .ne. 0) write (lu, 97) trim(timec_string) + if(iozone.ne.0) then + if(irivp.eq.0) then +c gaz 111516 mods to write zone number + if (iogeo .eq. 1) then + tecstring = trim(string) + write (lu, 131) trim(zonestring), + & trim(timec_string), trim(tecstring) + else if (iogrid .eq. 1) then + tecstring = trim(string) + write (lu, 130) trim(timec_string), + & trim(gridstring), trim(times_string) + else + write (lu, 130) trim(timec_string), + & trim(tecstring) + end if + else + tecstring_riv = trim(string) + write (lu, 130) trim(timec_string), + & trim(tecstring_riv), trim(gridstring), + & trim(times_string) + endif + endif end if - - do iz = 1, iendz -c Zone loop - if (iozone .ne. 0) then - idz = izone_surf(iz) - end if + if (altc(1:3) .eq. 'sur') then + call write_avs_head_s(icall,nscalar,lu,ifdual,idz,iriver2) + dls = ', ' + k = 2 + else if (altc(1:4) .eq. 'avsx') then + dls = ' : ' + k = 3 + else + dls = ' ' + k = 1 + end if + +c if saved zone exists use 1, nin form +c start ifblock 1 + if(zone_saved) then + istart = 1 + iend = nin + endif +c start do loop 1 +c writes too much here "tecstring" if (altc(1:3) .eq. 'tec') then if (iozone .eq. 0 .or. iogrid .eq. 1) then - write (lu, 94) trim(timec_string), trim(tecstring), - & trim(gridstring), trim(times_string) + if(icall.eq.1) then + write (lu, 94) trim(timec_string) +c gaz 070118 this could be the problem + else + write (lu, 94) trim(timec_string) +c write (lu, 94) trim(timec_string), trim(tecstring), +c & trim(gridstring), trim(times_string) + endif else if (icall .gt. 1 .and. iozone .ne. 0) then write (tecstring, 125) trim(sharestring), iz +c gaz debug 072717 + write (lu, 95) idz, trim(tecstring) end if - write (lu, 95) idz, trim(tecstring) end if if (icall .eq. 1 .and. iz .eq. iendz) then if (iogeo .eq. 1) then @@ -516,63 +811,229 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, & nspeci, dls else if (icall .eq. 1) then - write (fstring, 105) iocord, nspeci + write (fstring, 106) iocord, nspeci else write (fstring, 333) itotal2, dls end if end if - end if - - do i = 1, neq - if (iozone .ne. 0) then - if (izone_surf_nodes(i).ne.idz) goto 199 + end if + + + + + do ii = istart, iend +c Node loop + string = '' + if (iozone .ne. 0) then + if(zone_saved) then + i = ncord(ii) + else + i = ii + if (izone_surf_nodes(i).ne.idz) goto 199 + endif + else + i = ii + end if +c Node number will be written first for avs and sur files +c gaz 040517 this is where gdkm number is changed + if (altc(1:3) .eq. 'avs' .or. altc(1:3) .eq. 'sur') then + if (ifdual .eq. 0) then +c------------------------------------ +c Shaoping change 10-20-2017 +c write(string, 100) i + write(string, 109) i +c------------------------------------ + else if (iogdkm .eq. 1.and.iogdkmblank.ne.0) then +c------------------------------------ +c Shaoping change 10-20-2017 +c write(string, 100) i + write(string, 109) i +c------------------------------------ + else +c------------------------------------ +c Shaoping change 10-20-2017 +c write(string, 100) i - neq + write(string, 109) i - neq +c------------------------------------ end if - if (altc(1:3) .eq. 'tec' .and. iocord .ne. 0) then +c ic1 positions the column for printout + ic1 = 11 + else + ic1 = 1 + end if + if (iocord .ne. 0) then +c Only output coordinates that are used + if (altc(1:3) .eq. 'tec' .and. icall .ne. 1) then +c Coordinates will only be output in the first file for tecplot +c (do nothing) + else + select case (icnl) + case (1, 4) + icord1 = 1 + icord2 = 2 + icord3 = 1 + case (2, 5) + icord1 = 1 + icord2 = 3 + icord3 = 2 + case(3, 6) + icord1 = 1 + icord2 = 3 + icord3 = 1 + case default + icord1 = 1 + icord2 = 3 + icord3 = 1 + end select + do j = icord1, icord2, icord3 + write(vstring,110) dls(1:k), corz(i - offset,j) + ic2 = ic1 + len_trim(vstring) + string(ic1:ic2) = vstring + ic1 = ic2 + 1 + end do + end if + end if +c Node numbers are written after coordinates for tec files +c start endif ***** + if (altc(1:3) .eq. 'tec') then + if(ifdual.ne.0.and. iogdkm .eq. 1. + & and. iogdkmblank .eq. 1) then +c gaz 040817 if blanking use primary grid node number (and blank variable) +c gaz identify secondary node variable (i_sec) + write(vstring, 105) dls(1:k), i + i_wrt = i + i_pri = i + if(nelm(nelm(i_pri+1)).gt.neq_primary) then + i_sec = nelm(nelm(i_pri+1)) + i = i_sec + else +c gaz use a blanking value + i_sec = iblanking_value + i = i_sec + endif + else if (ifdual .eq. 0 .or. iogdkm .eq. 1) then + write(vstring, 105) dls(1:k), i + i_wrt = i + else + write(vstring, 105) dls(1:k), i - neq + i_wrt = i -neq + end if + ic2 = ic1 + len_trim(vstring) + string(ic1:ic2) = vstring + ic1 = ic2 + 1 + end if + if (iozid .eq. 1) then + if (altc(1:4) .eq. 'avs' .or. altc(1:3) .eq. 'sur' + & .or. icall .eq. 1 .or. iogrid .eq. 1) then + write(vstring, 115) dls(1:k), izonef(i) + ic2 = ic1 + len_trim(vstring) + string(ic1:ic2) = vstring + ic1 = ic2 + 1 + end if + end if +c end endif ***** + + + + if (altc(1:3) .eq. 'tec' .and. iocord .ne. 0) then if (icall .eq. 1 .and. iozid .eq. 0) then - write(lu, fstring) (corz(i,j), j = icord1, icord2, - + icord3), i, (min(maxc, max(minc, + if(i.ne.iblanking_value) then + write(lu, fstring) (corz(i_wrt,j), j =icord1,icord2, + + icord3), i_wrt, (min(maxc, max(minc, + antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) (corz(i_wrt,j), j =icord1,icord2, + + icord3), i_wrt, (iblanking_value, n=1,nspeci) + endif else if (icall .eq. 1 .and. iozid .eq. 1) then - write(lu, fstring) (corz(i,j), j = icord1, icord2, - + icord3), i,izonef(i), (min(maxc, - + max(minc,antmp(i+add_dual,n))), n=1,nspeci) + if(i.ne.iblanking_value) then + write(lu, fstring) (corz(i_wrt,j), j =icord1,icord2, + + icord3), i_wrt, (min(maxc, max(minc, + + antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) (corz(i_wrt,j), j =icord1,icord2, + + icord3), i_wrt, (iblanking_value, n=1,nspeci) + endif else - write(lu, fstring) i, (min(maxc, max(minc, + if(i.ne.iblanking_value) then + write(lu, fstring) i_wrt, (min(maxc, max(minc, + antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) i_wrt, + + (iblanking_value, n=1,nspeci) + endif end if + else if (altc(1:3) .eq. 'tec' .and. iozid .ne. 0) then if (icall .eq. 1 .or. iogrid .eq. 1) then - write(lu, fstring) i, izonef(i), (min(maxc, + if(i.ne.iblanking_value) then + write(lu, fstring) i_wrt, izonef(i), (min(maxc, + max(minc, antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) i_wrt, izonef(i), + + (iblanking_value, n=1,nspeci) + endif else - write(lu, fstring) i, (min(maxc, max(minc, + if(i.ne.iblanking_value) then + write(lu, fstring) i_wrt, (min(maxc, max(minc, + antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) i_wrt, + + (iblanking_value, n=1,nspeci) + endif end if else if (iocord .ne. 0) then if (iozid .eq. 0) then - write(lu, fstring) i, (corz(i,j), j = icord1, + if(i.ne.iblanking_value) then + write(lu, fstring) i_wrt,(corz(i_wrt,j), j = icord1, + icord2, icord3), (min(maxc, max(minc, + antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) i_wrt,(corz(i_wrt,j), j = icord1, + + icord2, icord3), (iblanking_value, n=1,nspeci) + endif else - write(lu, fstring) i, (corz(i,j), j = icord1, + if(i.ne.iblanking_value) then + write(lu, fstring) i_wrt, (corz(i_wrt,j), j =icord1, + icord2, icord3), izonef(i), (min(maxc, + max(minc, antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) i_wrt, (corz(i_wrt,j), j =icord1, + + icord2, icord3), izonef(i), + + (iblanking_value, n=1,nspeci) + endif end if else +c------------------------------- +c Shaoping temporary fix + i_wrt =i +c---------------------------------------- if (iozid .eq. 0) then - write(lu, fstring) i,(min(maxc, max(minc, + if(i.ne.iblanking_value) then + write(lu, fstring) i_wrt,(min(maxc, max(minc, + antmp(i+add_dual,n))), n=1,nspeci) + else + write(lu, fstring) i_wrt, + + (iblanking_value, n=1,nspeci) + endif else - write(lu, fstring) i, izonef(i), (min(maxc, - + max(minc, antmp(i+add_dual,n))), n=1,nspeci) + if(i.ne.iblanking_value) then + write(lu, fstring) i_wrt, izonef(i), + + (min(maxc, max(minc, antmp(i+add_dual,n))), + + n=1,nspeci) + else + write(lu, fstring) i_wrt, izonef(i), + + (iblanking_value, n=1,nspeci) + endif end if end if - 199 enddo + 199 enddo if (altc(1:3) .eq. 'sur') close (lu) - end do + + deallocate (title) c--------------------------------------------------- @@ -580,6 +1041,7 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, c PHS 8/10/2000 more changes for xpress below. . . c for when rxn_flag NE zero c--------------------------------------------------- +c middle ifblock 2 else ! IF rxn_flag NE zero fstring = '' @@ -712,15 +1174,29 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, c Write out node info to the _con file c================================================= - do iz = 1, iendz -! Zone loop +c start do loop 1 +c istart = 1 +c iend = 1 + do ii = istart, iend +c Node loop + string = '' if (iozone .ne. 0) then - idz = izone_surf(iz) + if(zone_saved) then + i = ncord(ii) + else + i = ii + if (izone_surf_nodes(i).ne.idz) goto 299 + endif + else + i = ii end if if (altc(1:3) .eq. 'tec') then if (iozone .eq. 0 .or. iogrid .eq. 1) then +c gaz writes every ii should be ii = start + if(ii.eq.istart) then write (lu, 94) trim(timec_string), trim(tecstring), & trim(gridstring), trim(times_string) + endif else if (icall .gt. 1 .and. iozone .ne. 0) then write (tecstring, 125) trim(sharestring), iz @@ -739,10 +1215,13 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, write (fstring, 96) itotal2 write(lu, fstring) (trim(title(i)), i=1,itotal2) end if - do in = 1,neq - if (iozone .ne. 0) then - if (izone_surf_nodes(in).ne.idz) goto 299 - end if + +c-------------------------------------------- +c Shaoping add 10-20-2017 +c do in = 1,neq +c gaz 063018 + do in = i,i +c------------------------------------------- j=0 if (iocord .ne. 0) then do i = icord1, icord2, icord3 @@ -782,8 +1261,10 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, write_array(j)=min(1.0d+40, 2 max(1.0d-90,complex_conc)) enddo + write_total = j fstring = '' + if (iozid .eq. 0 .and. iocord .eq. 0) then write (fstring, 333) write_total, dls else if (iozid .eq. 0 .and. iocord .ne. 0) then @@ -809,7 +1290,7 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, & write_total - iocord, dls else if (icall .eq. 1) then - write (fstring, 105) iocord, write_total-iocord + write (fstring, 106) iocord, write_total-iocord else write (fstring, 333) write_total - iocord, dls end if @@ -856,33 +1337,82 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, & i=1,write_total) end if end if - 299 enddo - if(altc(1:3) .eq. 'sur') close (lu) - end do - deallocate (title) + enddo + 299 enddo +c end ifblock 2 + endif +c end do loop 1 +c endif +c end if block 1 +c +c add element information here for saved zones and then exit +c + if(zone_saved) then + do i = 1, n_elem + write(lu,'(9(1x,i7))') + & (ncord_inv(elem_temp(i,j)),j = 1,ns_in) + enddo + neq = neq_sv + nei_in = nei_in_sv + icall = icall_sv + deallocate(elem_temp) + endif + if (altc(1:3) .eq. 'sur') close (lu) + enddo + if(zone_saved) then + if(.not.allocated(contour_conc_files)) + & allocate(contour_conc_files(100)) + icconc = icconc + 1 + inquire(unit=lu,name = file_flux) + contour_conc_files(icconc) = file_flux endif - +c gaz 073017 don't think flush(lu) is needed + call flush(lu) + if(zone_saved) return if (icall .eq. 1 .and. altc(1:3) .eq. 'tec' .and. iogeo .eq. 1) & then -! Read the element connectivity and write to tec file +c Read the element connectivity and write to tec file if (ifdual .eq. 1 .and. iogdkm .eq. 1) then -c Do nothing, no connectivity defined - else +c Do nothing unless blanking used + if(iogdkmblank.ne.0) then +c gaz 040817 attach geometry to gdkm file il = open_file(geoname,'old') -! avsx geometry file has an initial line that starts with neq_primary - allocate(nelm2(ns_in)) +c avsx geometry file has an initial line that starts with neq_primary + read(il,*) i + if (i .ne. neq_primary) backspace il + do i = 1, neq_primary + read(il,*) + end do + allocate (nelm2(ns_in)) + do i = 1, nei_in + read (il,*) i1,i2,char_type,(nelm2(j), j=1,ns_in) + write(lu, '(8(i8))') (nelm2(j), j=1,ns_in) + end do + deallocate(nelm2) + close (il) + endif + else if(irivp.eq.0) then + il = open_file(geoname,'old') +c avsx geometry file has an initial line that starts with neq_primary read(il,*) i if (i .ne. neq_primary) backspace il do i = 1, neq read(il,*) end do + allocate (nelm2(ns_in)) do i = 1, nei_in read (il,*) i1,i2,char_type,(nelm2(j), j=1,ns_in) write(lu, '(8(i8))') (nelm2(j), j=1,ns_in) end do deallocate(nelm2) close (il) - end if + else +c river segments (2 node elements) + do i = 1,nnelm_riv + write(lu,'(2(i8))') nelm_riv(i,1)-neq, + & nelm_riv(i,2)-neq + enddo + endif end if c gaz added element output (hex only) for fdm generated grid if (icall .eq. 1 .and. altc(1:3) .eq. 'tec' .and. ivf .eq. -1 @@ -893,16 +1423,16 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, read(il,*) read(il,*) ns_in , nei_in allocate (nelm2(ns_in)) - read(il,*) nei_in, ns_in do i = 1, nei_in read (il,*) i1, (nelm2(j), j=1,ns_in) write(lu, '(8(i8))') (nelm2(j), j=1,ns_in) end do deallocate(nelm2) close (il) - end if + end if + if (altc(1:3) .ne. 'sur') close (lu) - iocord = iocord_temp + iocord = iocord_tmp c 94 format('ZONE T = "Simulation time ',1p,g16.9,' days"', a) 94 format('ZONE T = ', a, a, a, a) @@ -913,9 +1443,9 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, 98 format ('TITLE = "', a30, 1x, a11, 1x, a8, 1x, a, '"') 99 format ('(a11, ', i3, "('",' "',"', a, '",'"',"'))") 100 format ('FILETYPE = "SOLUTION"') + 109 format ('FILETYPE = "SOLUTION"', i6) 104 format ('(1x, ', i3, '(g16.9, 1x), i10.10, ', i3, '(1x, g16.9))') - 105 format ('(1x, ', i3, '(g16.9, 1x), i10.10, 1x, i4, ', i3, - & '(1x, g16.9))') + 125 format(', VARSHARELIST = ([', a,'] = ', i4, ')') 135 format(', N = ', i8, ', E = ', i8, ', DATAPACKING = POINT', & ', ZONETYPE = ', a) @@ -933,6 +1463,22 @@ subroutine write_avs_node_con(icall,npt,neq,nspeci, C Coordinates and zid 335 format("(1x, i10.10, ", i3, "('", a, "', g16.9), '", a, "', i4,", & i3, "('", a, "', g16.9))") - deallocate(anv_dum,an_dum,antmp) + 130 format('ZONE T =', a, a, a, a) + 131 format('ZONE ',a,',',' T =', a, a, a, a) + 303 format(', VARSHARELIST = ([', a,'] = ', i4, ')') + 304 format('FILETYPE = "SOLUTION"') + 305 format(', VARSHARELIST = ([', a,'] = ', i4, '), ', + & 'CONNECTIVITYSHAREZONE = 1') + 118 format('TEXT T = ', a) + 120 format('ZONE T = "',i4.4, '"', a) + 110 format(a, g16.9) + 115 format(a, i4) + 106 format ('(1x, ', i3, '(g16.9, 1x), i10.10, 1x, i4, ', i3, + & '(1x, g16.9))') + 105 format(a, i10.10) +c deallocate(anv_dum,an_dum,antmp) + if(allocated(anv_dum)) deallocate(anv_dum) + if(allocated(an_dum)) deallocate(an_dum) + if(allocated(antmp)) deallocate(antmp) return end diff --git a/src/write_avs_node_s.f b/src/write_avs_node_s.f index 412ad6c0..b227c097 100755 --- a/src/write_avs_node_s.f +++ b/src/write_avs_node_s.f @@ -221,15 +221,16 @@ subroutine write_avs_node_s(icall, use avsio use comai, only : altc, days, grav, iadif, icnl, ico2, idof, & ichead, ihead, nei_in, ns_in, phi_inc, istrs, ivf, - & neq_primary, rho1grav, ifdm_elem, igrav + & neq_primary, rho1grav, ifdm_elem, igrav, ns, gdkm_flag c & neq_primary, rho1grav, ifdm_elem, i_subsid, igrav - use combi, only : corz, izonef, nelm, nelmdg, sx1 - use comci, only : rolf, rovf + use combi, only: corz, izonef, nelm, nelmdg, sx1, ncord, + & ncord_inv, elem_temp + use comci, only: rolf, rovf use comdi use comfi, only : pci use comflow, only : a_axy, a_vxy use comfem - use comii, only : crl + use comii, only : crl use comwt, only : sattol, head_id, rlptol use comsi use davidi @@ -245,8 +246,14 @@ subroutine write_avs_node_s(icall, integer size_head, size_pcp, istart, iend, ic1, ic2, length, nadd integer icord1, icord2, icord3, ns_in0, irivp, iocord_tmp integer, allocatable :: nelm2(:) + integer izunit,nin,ii,n_elem,ns_elem,ie, e_mem(8) + integer neq_sv, nei_in_sv, icall_sv, neq_p, iblanking_value + integer i_pri,i_sec + logical zone_saved real*8 hdum, sdum, px, py, pz, flxdum real*8 pdum, tdum, rolconv, dumconv, dumconv1 + real*8 sxx_dum, syy_dum, szz_dum, sxy_dum, sxz_dum, syz_dum + real*8 pi character*80 title(2*maxscalar+3) character*150 :: tecstring = '' character*150 :: tecstring_riv = '' @@ -255,7 +262,10 @@ subroutine write_avs_node_s(icall, character*43 tstring character*5 char_type character*3 dls - + character*30 zonesavename, char_temp + character*6 zonestring + parameter(iblanking_value = -9999) + parameter (pi=3.1415926535) save tecstring, tecstring_riv C BEGIN size_head = size(head) @@ -265,6 +275,10 @@ subroutine write_avs_node_s(icall, ioLP = ioliquid*iopressure ioVP = iovapor*iopressure +c-------------------------------------------- +c Shaoping add 10-19-2017 + zone_saved =.false. +c------------------------------------------- C ERROR checking: if(nscalar .gt. maxscalar)then @@ -280,10 +294,19 @@ subroutine write_avs_node_s(icall, iocord_tmp = iocord if (iogdkm .ne. 0 .and. ifdual .ne. 0) then c Output for gdkm nodes + if(iogdkmblank.eq.0) then istart = neq_primary + 1 iend = neq offset = 0 nadd = 0 + else +c gaz 040917 gdkm blanking + istart = 1 + iend = neq_primary + offset = 0 + nadd = 0 + endif + irivp = 0 if (icnl .eq. 0) then iocord = 3 else @@ -336,7 +359,75 @@ subroutine write_avs_node_s(icall, c Zone loop if (iozone .ne. 0) then idz = izone_surf(iz) +c open and read saved zone file if they exist + call zone_saved_manage(1,izunit,idz,nin,n_elem,zone_saved) +c + if(zone_saved) then + zonestring = ' ' + write(zonestring(1:5),'(i5)') idz + neq_sv = neq + nei_in_sv = nei_in + icall_sv = icall + neq = nin + nei_in = n_elem + icall = 1 + iogeo = 1 +c copy FETYPE stuff in here if (altc(1:3) .eq. 'tec') then + string = '' + if (icall .eq. 1 .and. iogeo .eq. 1) then + select case (ns_in) + case (5,6,8) + write (string, 135) neq, nei_in, 'FEBRICK' + case (4) + if (icnl .eq. 0) then + write (string, 135) neq, nei_in, + & 'FETETRAHEDRON' + else + write (string, 135) neq, nei_in, + & 'FEQUADRILATERAL' + end if + case (3) + write (string, 135) neq, nei_in, 'FETRIANGLE' + case (2) + if(irivp.eq.0) then + write (string, 135) neq, nei_in, 'FELINESEG' + ns_in=ns_in0 + else if(irivp.eq.2)then + write (string, 135) npoint_riv, npoint_riv-1, + & 'FELINESEG' + ns_in=ns_in0 + endif + case (0) +c fdm grid + write (string, '(a)') '' + end select + if(irivp.eq.0) then +c gaz 111516 mods to write zone number + if (iogeo .eq. 1) then + tecstring = trim(string) + write (lu, 131) trim(zonestring), + & trim(timec_string), trim(tecstring) + else if (iogrid .eq. 1) then + tecstring = trim(string) + write (lu, 130) trim(timec_string), + & trim(gridstring), trim(times_string) + else + write (lu, 130) trim(timec_string), + & trim(tecstring) + end if + else + tecstring_riv = trim(string) + write (lu, 130) trim(timec_string), + & trim(tecstring_riv), trim(gridstring), + & trim(times_string) + endif + endif +c end copy FETYPE + endif +c endif +c an else here???? + else if (altc(1:3) .eq. 'tec') then if (icall .gt. 1 .and. iocord .ne. 0) then string = '' if (icnl .eq. 0) then @@ -367,24 +458,30 @@ subroutine write_avs_node_s(icall, end if else if (altc(1:3) .eq. 'tec') then +c gaz 040517 gdkm needs small modification + if(gdkm_flag.ne.0) then + neq_p = neq_primary + else + neq_p = neq + endif string = '' if (icall .eq. 1 .and. iogeo .eq. 1) then select case (ns_in) case (5,6,8) - write (string, 135) neq, nei_in, 'FEBRICK' + write (string, 135) neq_p, nei_in, 'FEBRICK' case (4) if (icnl .eq. 0) then - write (string, 135) neq, nei_in, + write (string, 135) neq_p, nei_in, & 'FETETRAHEDRON' else - write (string, 135) neq, nei_in, + write (string, 135) neq_p, nei_in, & 'FEQUADRILATERAL' end if case (3) - write (string, 135) neq, nei_in, 'FETRIANGLE' + write (string, 135) neq_p, nei_in, 'FETRIANGLE' case (2) if(irivp.eq.0) then - write (string, 135) neq, nei_in, 'FELINESEG' + write (string, 135) neq_p, nei_in, 'FELINESEG' ns_in=ns_in0 else if(irivp.eq.2)then write (string, 135) npoint_riv, npoint_riv-1, @@ -511,22 +608,35 @@ subroutine write_avs_node_s(icall, crl(4,1)=pres0 rho1grav = rolconv*9.81d-6 end if - - do i = istart, iend +c if saved zone exists use 1, nin form + if(zone_saved) then + istart = 1 + iend = nin + endif + do ii = istart, iend c Node loop string = '' if (iozone .ne. 0) then - if (izone_surf_nodes(i).ne.idz) goto 200 + if(zone_saved) then + i = ncord(ii) + else + i = ii + if (izone_surf_nodes(i).ne.idz) goto 200 + endif + else + i = ii end if c Node number will be written first for avs and sur files +c gaz 040517 this is where gdkm number is changed if (altc(1:3) .eq. 'avs' .or. altc(1:3) .eq. 'sur') then if (ifdual .eq. 0) then write(string, 100) i - else if (iogdkm .eq. 1) then - write(string, 100) i - neq_primary + else if (iogdkm .eq. 1.and.iogdkmblank.ne.0) then + write(string, 100) i else - write(string, 100) i - neq + write(string, 100) i - neq_primary end if +c ic1 positions the column for printout ic1 = 11 else ic1 = 1 @@ -565,7 +675,21 @@ subroutine write_avs_node_s(icall, end if c Node numbers are written after coordinates for tec files if (altc(1:3) .eq. 'tec') then - if (ifdual .eq. 0 .or. iogdkm .eq. 1) then + if(ifdual.ne.0.and. iogdkm .eq. 1. + & and. iogdkmblank .eq. 1) then +c gaz 040817 if blanking use primary grid node number (and blank variable) +c gaz identify secondary node variable (i_sec) + write(vstring, 105) dls(1:k), i + i_pri = i + if(nelm(nelm(i_pri+1)).gt.neq_primary) then + i_sec = nelm(nelm(i_pri+1)) + i = i_sec + else +c gaz use a blanking value + i_sec = iblanking_value + i = i_sec + endif + else if (ifdual .eq. 0 .or. iogdkm .eq. 1) then write(vstring, 105) dls(1:k), i else write(vstring, 105) dls(1:k), i - neq @@ -584,40 +708,65 @@ subroutine write_avs_node_s(icall, end if end if if (iopressure .eq. 1 .and. ioliquid .eq. 1) then + if(i.ne.iblanking_value)then if (size_pcp .ne. 1) then write(vstring,110) dls(1:k), phi(i)-pcp(i) else write(vstring,110) dls(1:k), phi(i)-phi_inc end if + else + if (size_pcp .ne. 1) then + write(vstring,110) dls(1:k), iblanking_value + else + write(vstring,110) dls(1:k), iblanking_value + end if + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if if (iopressure .eq. 1 .and. iovapor .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), phi(i) + else + write(vstring,110) dls(1:k), iblanking_value + end if ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 if (iadif .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), phi(i)-pci(i) + else + write(vstring,110) dls(1:k), iblanking_value + end if ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if end if if (iocapillary .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), pcp(i) + else + write(vstring,110) dls(1:k), iblanking_value + end if ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if if (iotemperature .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), t(i) + else + write(vstring,110) dls(1:k), iblanking_value + end if ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if if (iosaturation .eq. 1) then + if(i.ne.iblanking_value)then if (ps(i) .le. 0.) then sdum = 0.d0 else if (irdof .ne. 13 .or. ifree .ne. 0) then @@ -629,6 +778,9 @@ subroutine write_avs_node_s(icall, sdum = 1.0d0 end if write(vstring,110) dls(1:k), sdum + else + write(vstring,110) dls(1:k), iblanking_value + end if ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 @@ -636,74 +788,130 @@ subroutine write_avs_node_s(icall, if (ioco2 .eq. 1) then if (ps(i) .le. 0.) then sdum = 0.d0 + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), sdum + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), sdum + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), sdum + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), sdum + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), sdum + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), sdum + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,115) dls(1:k), int(sdum) + else + write(vstring,115) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 else ! Water volume fraction + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), fw(i) + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 ! Liquid co2 fraction + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), fl(i) + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 ! Gaseous co2 fraction + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), fg(i) + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 ! Dissolved co2 mass fraction + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), yc(i) + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 ! Liquid co2 density + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), co2_prop(i) + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 ! Gaseous co2 density + if(i.ne.iblanking_value)then write(vstring,112) dls(1:k), co2_prop(9*neq_primary+i) + else + write(vstring,112) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 ! Phase state of co2 + if(i.ne.iblanking_value)then write(vstring,115) dls(1:k), ices(i) + else + write(vstring,115) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if end if if (iohead .eq. 1) then -c zvd - 12-Jul-2010 distinguish between regular head output and chead +c zvd - 12-Jul-2010 distinguish between regular head output and chead if (ichead .eq. 1) then if (ps(i) .le. 0.) then hdum = 0.d0 @@ -711,7 +919,11 @@ subroutine write_avs_node_s(icall, call headctr(4, i ,pho(i), hdum) c hdum = max(hdum,0.0d00) end if + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), hdum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 @@ -726,31 +938,48 @@ subroutine write_avs_node_s(icall, if (s(i).lt.sattol+rlptol) hdum = head_id endif end if + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), hdum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if end if if (ioporosity .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), ps(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if if (iodensity .eq. 1 .and. ioliquid .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), rolf(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if if (iodensity .eq. 1 .and. iovapor .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), rovf(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if if (iopermeability .eq. 1) then + if(i.ne.iblanking_value)then if (idof .ne. 0) then if(ihms.gt.0) then if(allocated(permfac_out)) then @@ -773,23 +1002,39 @@ subroutine write_avs_node_s(icall, pz = 0. end if - if(allocated(permfactor_nodal))px=permfactor_nodal(i) - + if(allocated(permfactor_nodal))px=permfactor_nodal(i) + endif + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), px + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), py + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), pz + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 endif if (iosource .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), sk(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 @@ -806,7 +1051,11 @@ subroutine write_avs_node_s(icall, else flxdum = a_axy(iaxy) end if + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), flxdum + else + write(vstring,110) dls(1:k), iblanking_value + endif else i1 = nelm(i) + 1 i2 = nelm(i+1) @@ -824,7 +1073,11 @@ subroutine write_avs_node_s(icall, flxdum = 0.d0 end if end if + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), flxdum + else + write(vstring,110) dls(1:k), iblanking_value + endif end if ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring @@ -832,102 +1085,206 @@ subroutine write_avs_node_s(icall, end if if (ioflx .eq. 1 .and. iovapor .eq. 1) then iaxy = nelmdg (i) - (neq + 1) + nadd - write(vstring,110) dls(1:k), a_vxy(iaxy) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), a_vxy(iaxy) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if if (iodisp .eq. 1.and.idisp_rel.ne.0) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), du(i)-du_ini(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), dv(i)-dv_ini(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 if (icnl .eq. 0) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), dw(i)-dw_ini(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if else if (iodisp .eq. 1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), du(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), dv(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 if (icnl .eq. 0) then - write(vstring,110) dls(1:k), dw(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), dw(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if endif if (iostress .ne. 0) then - write(vstring,110) dls(1:k), str_x(i) +c gaz 052317 + if(flag_principal.eq.0) then + sxx_dum = str_x(i) + syy_dum = str_y(i) + szz_dum = str_z(i) + sxy_dum = str_xy(i) + sxz_dum = str_xz(i) + syz_dum = str_yz(i) + else if(flag_principal.eq.1) then + call principal_stress_3D(i) + eigenvec_deg(1)=dacos(eigenvec(3,3))*180./pi + eigenvec_deg(2)=dacos(eigenvec(1,3))*180./pi + eigenvec_deg(3)=dacos(eigenvec(1,1))*180./pi + sxx_dum = alambda(3) + syy_dum = alambda(2) + szz_dum = alambda(1) + sxy_dum = eigenvec_deg(1) + sxz_dum = eigenvec_deg(2) + syz_dum = eigenvec_deg(3) + endif + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), sxx_dum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 - write(vstring,110) dls(1:k), str_y(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), syy_dum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 if(icnl.eq.0) then - write(vstring,110) dls(1:k), str_z(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), szz_dum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 end if - write(vstring,110) dls(1:k), str_xy(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), sxy_dum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 if(icnl.eq.0) then - write(vstring,110) dls(1:k), str_xz(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), sxz_dum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 - write(vstring,110) dls(1:k), str_yz(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), syz_dum + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 endif if(iPlastic.eq.1) then + if(i.ne.iblanking_value)then write(vstring,110) dls(1:k), pstrain(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 endif if(flag_excess_shear.eq.1) then - write(vstring,110) dls(1:k), elastic_mod(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), elastic_mod(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 - write(vstring,110) dls(1:k), excess_shear(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), excess_shear(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 - write(vstring,110) dls(1:k), shear_angle(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), shear_angle(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 endif endif if (iostrain .eq. 1) then - write(vstring,110) dls(1:k), vol_strain(i) + if(i.ne.iblanking_value)then + write(vstring,110) dls(1:k), vol_strain(i) + else + write(vstring,110) dls(1:k), iblanking_value + endif ic2 = ic1 + len_trim(vstring) string(ic1:ic2) = vstring ic1 = ic2 + 1 endif length = len_trim(string) - write(lu,'(a)') string(1:length) - 200 enddo - + write(lu,'(a)') string(1:length) + 200 enddo +c +c add element information here for saved zones and then exit +c + if(zone_saved) then + do i = 1, n_elem + write(lu,'(9(1x,i7))') + & (ncord_inv(elem_temp(i,j)),j = 1,ns_in) + enddo + neq = neq_sv + nei_in = nei_in_sv + icall = icall_sv + deallocate(elem_temp) + endif if (iohead .eq. 1 .and. ichead .eq. 1) then crl(1,1)= dumconv crl(4,1)= dumconv1 @@ -942,12 +1299,29 @@ subroutine write_avs_node_s(icall, call flush(lu) if (altc(1:3) .eq. 'sur') close (lu) enddo - + if(zone_saved) return if (icall .eq. 1 .and. altc(1:3) .eq. 'tec' .and. iogeo .eq. 1) & then c Read the element connectivity and write to tec file if (ifdual .eq. 1 .and. iogdkm .eq. 1) then -c Do nothing, no connectivity defined +c Do nothing unless blanking used + if(iogdkmblank.ne.0) then +c gaz 040817 attach geometry to gdkm file + il = open_file(geoname,'old') +c avsx geometry file has an initial line that starts with neq_primary + read(il,*) i + if (i .ne. neq_primary) backspace il + do i = 1, neq_primary + read(il,*) + end do + allocate (nelm2(ns_in)) + do i = 1, nei_in + read (il,*) i1,i2,char_type,(nelm2(j), j=1,ns_in) + write(lu, '(8(i8))') (nelm2(j), j=1,ns_in) + end do + deallocate(nelm2) + close (il) + endif else if(irivp.eq.0) then il = open_file(geoname,'old') c avsx geometry file has an initial line that starts with neq_primary @@ -991,6 +1365,7 @@ subroutine write_avs_node_s(icall, iocord = iocord_tmp 100 format(i10.10) +c 100 format(i10) 105 format(a, i10.10) 110 format(a, g16.9) 112 format(a, f10.4) @@ -1002,6 +1377,7 @@ subroutine write_avs_node_s(icall, 125 format(', VARSHARELIST = ([', a,'] = ', i4, ')') c 130 format('ZONE T = "Simulation time ',1p,g16.9,' days"', a) 130 format('ZONE T =', a, a, a, a) + 131 format('ZONE ',a,',',' T =', a, a, a, a) 135 format(', N = ', i8, ', E = ', i8, ', DATAPACKING = POINT', & ', ZONETYPE = ', a) 140 format(', VARSHARELIST = ([', a,'] = ', i4, '), ', diff --git a/src/write_avs_node_v.f b/src/write_avs_node_v.f index d1a0a306..6b26f8ea 100755 --- a/src/write_avs_node_v.f +++ b/src/write_avs_node_v.f @@ -142,9 +142,11 @@ subroutine write_avs_node_v(icall,pnxv,pnyv,pnzv, use avsio use comai, only : altc, days, icnl, jdate, jtime, verno, wdd, - & nei_in, ns_in, neq_primary - use combi, only : corz, izonef, nelm + & nei_in, ns_in, neq_primary, ns, icflux + use combi, only : corz, izonef, nelm, ncord, ncord_inv, elem_temp, + & contour_flux_files use comdi, only : nsurf, izone_surf, izone_surf_nodes + use comriv, only : npoint_riv, nnelm_riv, nelm_riv implicit none integer maxvector @@ -157,17 +159,33 @@ subroutine write_avs_node_v(icall,pnxv,pnyv,pnzv, character*45 title(3*maxvector), title2(2) character*50 fstring character*500 tstring + integer icall, neq, nvector, lu, ifdual, length integer i, istep, nout, iz, idz, iendz, j, k, iocord_temp integer icord1, icord2, icord3, il, i1, i2, open_file integer, allocatable :: nelm2(:) +c gaz 111616 + integer izunit,nin,ii,n_elem,ns_elem,ie, e_mem(8) + integer neq_sv, nei_in_sv, icall_sv, istart, iend + integer ns_in0, irivp + character*500 string + logical zone_saved real*8 write_array(9) real*8 pnxv(neq), pnyv(neq), pnzv(neq) real*8 pnxl(neq), pnyl(neq), pnzl(neq) character*5 char_type +c gaz 111616 + character*30 zonesavename, char_temp + character*6 zonestring + character*200 file_flux save tec_string +c-------------------------------------------- +c Shaoping add 10-19-2017 + zone_saved =.false. +c------------------------------------------- + if(nvector .gt. maxvector)then write(lu,*)'--------------------------------------------' write(lu,*)'ERROR: WRITE_AVS_NODE_V' @@ -381,7 +399,9 @@ subroutine write_avs_node_v(icall,pnxv,pnyv,pnzv, tstring = trim(tstring) // '"' write(lu, '(a)') trim(tstring) end if - if (iozone .ne. 0) write(lu,302) trim(timec_string) +c gaz 112716 : this needs to be moved down +c with zone and FE info +c if (iozone .ne. 0) write(lu,302) trim(timec_string) else if(altc(1:3).eq.'sur') then c write(tstring,400) (trim(title2(i)), i = 1, k), c & (trim(title(i)), j = 1, nout) @@ -398,8 +418,75 @@ subroutine write_avs_node_v(icall,pnxv,pnyv,pnzv, ! Zone loop if (iozone .ne. 0) then idz = izone_surf(iz) - end if - if (altc(1:3) .eq. 'tec') then +c open and read saved zone file if they exist + call zone_saved_manage(1,izunit,idz,nin,n_elem,zone_saved) +c + if(zone_saved) then + zonestring = ' ' + write(zonestring(1:5),'(i5)') idz + neq_sv = neq + nei_in_sv = nei_in + icall_sv = icall + neq = nin + nei_in = n_elem + icall = 1 + iogeo = 1 + irivp = 0 +c gaz 112716 FE geometry goes here + if (altc(1:3) .eq. 'tec') then + string = '' + if (icall .eq. 1 .and. iogeo .eq. 1) then + select case (ns_in) + case (5,6,8) + write (string, 135) neq, nei_in, 'FEBRICK' + case (4) + if (icnl .eq. 0) then + write (string, 135) neq, nei_in, + & 'FETETRAHEDRON' + else + write (string, 135) neq, nei_in, + & 'FEQUADRILATERAL' + end if + case (3) + write (string, 135) neq, nei_in, 'FETRIANGLE' + case (2) + if(irivp.eq.0) then + write (string, 135) neq, nei_in, 'FELINESEG' + ns_in=ns_in0 + else if(irivp.eq.2)then + write (string, 135) npoint_riv, npoint_riv-1, + & 'FELINESEG' + ns_in=ns_in0 + endif + case (0) +c fdm grid + write (string, '(a)') '' + end select + endif + + if(irivp.eq.0) then +c gaz 111516 mods to write zone number + if (iogeo .eq. 1) then + tec_string = trim(string) + write (lu, 131) trim(zonestring), + & trim(timec_string), trim(tec_string) + else if (iogrid .eq. 1) then + tec_string = trim(string) + write (lu, 130) trim(timec_string), + & trim(gridstring), trim(times_string) + else + write (lu, 130) trim(timec_string), + & trim(tec_string) + end if + else + + endif + + endif +c gaz end FE geometry + endif + endif + if (.not.zone_saved.and.altc(1:3) .eq. 'tec') then if (iozone .ne. 0) then write (lu, 95) idz, trim(tec_string) else @@ -425,10 +512,27 @@ subroutine write_avs_node_v(icall,pnxv,pnyv,pnzv, call namefile2(icall,lu,ioformat,tailstring,idz) write(lu, '(a)') trim(tstring) end if - do i = 1,neq -! Node loop +c gaz 112116 +c if saved zone exists use 1, nin form + if(zone_saved) then + istart = 1 + iend = nin + else + istart = 1 + iend = neq + endif + do ii = istart, iend +c Node loop + string = '' if (iozone .ne. 0) then - if (izone_surf_nodes(i).ne.idz) goto 199 + if(zone_saved) then + i = ncord(ii) + else + i = ii + if (izone_surf_nodes(i).ne.idz) goto 199 + endif + else + i = ii end if if (iocord .ne. 0) then k = 1 @@ -497,9 +601,30 @@ subroutine write_avs_node_v(icall,pnxv,pnyv,pnzv, write (fstring, 110) j write(lu, fstring) i, (write_array(k), k = 1, j) end if + 199 enddo - end do - +c +c add element information here for saved zones and then exit +c + if(zone_saved) then + do i = 1, n_elem + write(lu,'(9(1x,i7))') + & (ncord_inv(elem_temp(i,j)),j = 1,ns_in) + enddo + neq = neq_sv + nei_in = nei_in_sv + icall = icall_sv + deallocate(elem_temp) + endif + enddo + if(zone_saved) then + if(.not.allocated(contour_flux_files)) + & allocate(contour_flux_files(100)) + icflux = icflux + 1 + inquire(unit=lu,name = file_flux) + contour_flux_files(icflux) = file_flux + return + endif if (icall .eq. 1 .and. altc(1:3) .eq. 'tec' .and. iogeo .eq. 1) & then c Read the element connectivity and write to tec file @@ -536,7 +661,11 @@ subroutine write_avs_node_v(icall,pnxv,pnyv,pnzv, 110 format("(i10.10, ", i1, "(1x, g16.9))") 120 format("(", i1, "(g16.9, 1x), i10.10, ", i1, "(1x, g16.9))" ) 130 format("(", i1, "(g16.9, 1x), i10.10, 1x, i4,", i1, - & "(1x, g16.9))") + & "(1x, g16.9))") + 131 format('ZONE ',a,',',' T =', a, a, a, a) + 135 format(', N = ', i8, ', E = ', i8, ', DATAPACKING = POINT', + & ', ZONETYPE = ', a) + 200 format('nodes at ', g16.9,' days', 9(a)) 210 format("(i10.10, ", i1, "('", a, "',g16.9))") 220 format("(i10.10, '", a, "', i4, ", i1, "('", a, "',g16.9))") diff --git a/src/writeio.f b/src/writeio.f index b189e124..3b4916e3 100755 --- a/src/writeio.f +++ b/src/writeio.f @@ -177,6 +177,7 @@ subroutine writeio(unit) use comai use comxi + use comco2, only : icarb implicit none integer unit @@ -211,5 +212,5 @@ subroutine writeio(unit) * /,4x, 'fe coef stor - isstor -', i3, ' - ', a100, * /,4x, 'input check - ischk -', i3, ' - ', a100, * /,1x, 'Value provided to subroutine user: ', a9, /) - - end + + end \ No newline at end of file diff --git a/src/wrtout.f b/src/wrtout.f index b7d48a06..5d6a3d05 100755 --- a/src/wrtout.f +++ b/src/wrtout.f @@ -1,7 +1,7 @@ subroutine wrtout (tassem,tas,totalflin,totalein,curinflow, & cureinflow,is_ch,is_ch_t) !*********************************************************************** -! Copyright, 2004, The Regents of the University of California. +! Copyright, 2004, The Regents of the University of California.s ! This program was prepared by the Regents of the University of ! California at Los Alamos National Laboratory (the University) under ! contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE). @@ -179,7 +179,8 @@ subroutine wrtout (tassem,tas,totalflin,totalein,curinflow, write(iout,704) itotal,itotals write(iout,705) is_ch, is_ch_t write(iout,706) nphase_liq, dnphase_liq, nphase_2, - & dnphase_2, nphase_gas, dnphase_gas + & dnphase_2, nphase_gas, dnphase_gas, nphase_sc, + & dnphase_sc endif if (iptty.gt.0) then write(iptty,772) @@ -193,7 +194,8 @@ subroutine wrtout (tassem,tas,totalflin,totalein,curinflow, write(iptty,704) itotal,itotals write(iptty,705) is_ch, is_ch_t write(iptty,706) nphase_liq, dnphase_liq, nphase_2, - & dnphase_2, nphase_gas, dnphase_gas + & dnphase_2, nphase_gas, dnphase_gas, nphase_sc, + & dnphase_sc endif if(fimp.le.1.0d00) then message_ts = ' ' @@ -230,9 +232,9 @@ subroutine wrtout (tassem,tas,totalflin,totalein,curinflow, 704 format(1x,'Total Number of Iterations, N-R: ',i10, & ' , Solver: ',i10) 705 format(1x,'Phase Changes This Time Step: ',i8,' Total ',i11) - 706 format(1x,'Nodes Liq Phase: ',i8,' change ',i8,/, +706 format(1x,'Nodes Liq Phase: ',i8,' change ',i8,/, & ' Nodes Two Phase: ',i8,' change ',i8,/,' Nodes Gas Phase: ', - & i9,' change ', i8) + & i9,' change ', i8,/,' Nodes SC Phase: ',i8,' change ',i8) if(ifree.ne.0) then if(ntty.eq.2) then write(iout,*) 'Number of partially filled cells ', ifree1 @@ -377,10 +379,18 @@ subroutine wrtout (tassem,tas,totalflin,totalein,curinflow, if(ico2.lt.0.and.ice.eq.0) then eqd=0.0 else + if(ieos(md).ne.0.and.ps(md).ne.0.) then eqd=0.0 rhomd = sl * rolf(md) + sv * rovf(md) hmd=sl*rolf(md)*enlf(md)+sv*rovf(md)*envf(md) if (abs(rhomd) .gt. zero_t) eqd = hmd/rhomd + else + if(ivrock.ne.0) then + eqd = urock(md)/denr(md) + else + eqd = cpr(md)*t(md) + endif + endif endif rqd = sk(md) c rqhd = 0.0 diff --git a/src/zone.f b/src/zone.f index 938e3838..1dfc77a8 100755 --- a/src/zone.f +++ b/src/zone.f @@ -1,742 +1,1385 @@ - subroutine zone(cnum, infile) -!*********************************************************************** -! Copyright, 1993, 2004, The Regents of the University of California. -! This program was prepared by the Regents of the University of -! California at Los Alamos National Laboratory (the University) under -! contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE). -! All rights in the program are reserved by the DOE and the University. -! Permission is granted to the public to copy and use this software -! without charge, provided that this Notice and any statement of -! authorship are reproduced on all copies. Neither the U.S. Government -! nor the University makes any warranty, express or implied, or -! assumes any liability or responsibility for the use of this software. -C*********************************************************************** -CD1 -CD1 PURPOSE -CD1 -CD1 Enter properties using geometric description. -CD1 -C*********************************************************************** -CD2 -CD2 REVISION HISTORY -CD2 -CD2 Revision ECD -CD2 Date Programmer Number Comments -CD2 -CD2 03-JAN-94 Z. Dash 22 Add prolog/major cleanup. -CD2 G. Zyvoloski Initial implementation. -CD2 -CD2 $Log: /pvcs.config/fehm90/src/zone.f_a $ -CD2 -!D2 -!D2 Rev 2.5 06 Jan 2004 10:44:32 pvcs -!D2 FEHM Version 2.21, STN 10086-2.21-00, Qualified October 2003 -!D2 -!D2 Rev 2.4 29 Jan 2003 09:25:24 pvcs -!D2 FEHM Version 2.20, STN 10086-2.20-00 -!D2 -!D2 Rev 2.3 14 Nov 2001 13:29:30 pvcs -!D2 FEHM Version 2.12, STN 10086-2.12-00 -!D2 -!D2 Rev 2.2 06 Jun 2001 13:28:56 pvcs -!D2 FEHM Version 2.11, STN 10086-2.11-00 -!D2 -!D2 Rev 2.1 30 Nov 2000 12:13:44 pvcs -!D2 FEHM Version 2.10, STN 10086-2.10-00 -!D2 -!D2 Rev 2.0 Fri May 07 14:48:36 1999 pvcs -!D2 FEHM Version 2.0, SC-194 (Fortran 90) -CD2 -CD2 Rev 1.9 Wed Jun 12 15:21:26 1996 zvd -CD2 Modified optional input file routines and reduced number of calls -CD2 -CD2 Rev 1.8 Mon Jun 03 11:18:46 1996 hend -CD2 Added macro name & comment capabi. to new input -CD2 -CD2 Rev 1.7 Fri May 31 10:55:24 1996 hend -CD2 Added optional input from specified file -CD2 -CD2 Rev 1.6 Fri Feb 16 13:59:46 1996 zvd -CD2 Added requirement. -CD2 -CD2 Rev 1.5 Fri Feb 02 14:34:12 1996 hend -CD2 Updated Requirements Traceability -CD2 -CD2 Rev 1.4 Fri Jan 12 18:04:06 1996 llt -CD2 changed mmgetblk arguments -CD2 -CD2 Rev 1.3 08/22/95 13:47:30 llt -CD2 quotes around internal read name doesn't work on IBM. -CD2 -CD2 Rev 1.2 08/18/95 10:32:26 llt -CD2 needed quotes around ltest for cray to read -CD2 -CD2 Rev 1.1 03/18/94 16:04:00 gaz -CD2 Added solve_new and cleaned up memory management. -CD2 -CD2 Rev 1.0 01/20/94 10:29:42 pvcs -CD2 original version in process of being certified -CD2 -C*********************************************************************** -CD3 -CD3 INTERFACES -CD3 -CD3 Formal Calling Parameters -CD3 -CD3 Identifier Type Use Description -CD3 -CD3 cnum INT I Number of times zone has been called -CD3 infile INT I Unit number of file to be read. -CD3 -CD3 Interface Tables -CD3 -CD3 None -CD3 -CD3 Files -CD3 -CD3 Name Use Description -CD3 -CD3 inpt I Main input data file. -CD3 inzone I Zone input file. -CD3 iout O General output file. -CD3 -C*********************************************************************** -CD4 -CD4 GLOBAL OBJECTS -CD4 -CD4 Global Constants -CD4 -CD4 None -CD4 -CD4 Global Types -CD4 -CD4 None -CD4 -CD4 Global Variables -CD4 -CD4 COMMON -CD4 Identifier Type Block Description -CD4 -CD4 icnl INT faai Problem dimension -CD4 idpdp INT faai Parameter which indicates if the double -CD4 porosity / double permeability -CD4 solution is enabled -CD4 idualp INT faai Parameter which indicates if the dual -CD4 porosity solution is enabled -CD4 inpt INT faai Unit number for input file -CD4 inzone INT faai Unit number for zone input file -CD4 izonef INT fbb Zone in which each node is located -CD4 lenintg INT param Converts bits to words for allocating -CD4 memory -CD4 macroread(18) LOGICAL macro Flag denoting if macro zone has been read -CD4 wdd1 CHAR faac Alternate character input string -CD4 -CD4 Global Subprograms -CD4 -CD4 Identifier Type Description -CD4 -CD4 mmgetblk Allocate memory to an array -CD4 mmrelblk Deallocate array memory -CD4 null1 LOGICAL Check for null lines or 0's in lines -CD4 -C*********************************************************************** -CD5 -CD5 LOCAL IDENTIFIERS -CD5 -CD5 Local Constants -CD5 -CD5 None -CD5 -CD5 Local Types -CD5 -CD5 None -CD5 -CD5 Local variables -CD5 -CD5 Identifier Type Description -CD5 -CD5 i INT Loop index -CD5 icode INT Return value from mmgetblk, mmrelblk routines -CD5 ipncord POINTER Pointer to variable array ncord -CD5 izone INT Identifier for zone being defined -CD5 izonel INT Identifier for last zone defined -CD5 ltest CHAR Variable for reading character input -CD5 macro CHAR Current macro being read -CD5 ncord REAL*8 Nodes found within a zone -CD5 nin INT Number of nodes assigned to zone -CD5 nodez INT Number of node nearest given coordinates -CD5 nsl INT Number of coordinates in element -CD5 xg REAL*8 X coordinate defining node -CD5 xz REAL*8 X coordinates defining zone -CD5 yg REAL*8 Y coordinate defining node -CD5 yz REAL*8 Y coordinates defining zone -CD5 zg REAL*8 Z coordinate defining node -CD5 zz REAL*8 Z coordinates defining zone -CD5 -CD5 Local Subprograms -CD5 -CD5 None -CD5 -C*********************************************************************** -CD6 -CD6 FUNCTIONAL DESCRIPTION -CD6 -C*********************************************************************** -CD7 -CD7 ASSUMPTIONS AND LIMITATIONS -CD7 -CD7 None -CD7 -C*********************************************************************** -CD8 -CD8 SPECIAL COMMENTS -CD8 -CD8 Zones are a convenient way to group nodes and specify properties, -CD8 but they are not an essential function of the code. -CD8 -CD8 Requirements from SDN: 10086-RD-2.20-00 -CD8 SOFTWARE REQUIREMENTS DOCUMENT (RD) for the -CD8 FEHM Application Version 2.20 -CD8 -C*********************************************************************** -CD9 -CD9 REQUIREMENTS TRACEABILITY -CD9 -CD9 2.6 Provide Input/Output Data Files -CD9 3.0 INPUT AND OUTPUT REQUIREMENTS -CD9 -C*********************************************************************** -CDA -CDA REFERENCES -CDA -CDA None -CDA -C*********************************************************************** -CPS -CPS PSEUDOCODE -CPS -CPS BEGIN zone -CPS -CPS backup a line in file to be read -CPS -CPS FOR each node -CPS set zone to zero -CPS END FOR -CPS -CPS END IF -CPS -CPS IF this is a 3D problem -CPS set nsl to 8 -CPS ELSE -CPS set nsl to 4 -CPS END IF -CPS -CPS REPEAT -CPS read input line -CPS IF macro read is zone -CPS REPEAT -CPS read input line -CPS EXIT IF null line is read -CPS reread the input line to get zone identification number -CPS IF the zone id is > 0 -CPS read input line -CPS IF macros list and nnum are not read -CPS IF this zone isn't the same as the last zone -CPS set node count to zero -CPS END IF -CPS read zone X coordinates -CPS read zone Y coordinates -CPS IF this is a 3D problem -CPS read zone Z coordinates -CPS END IF -CPS call setzone to find nodes in zone -CPS ELSE IF macro read is list -CPS set node count to zero -CPS REPEAT -CPS read input line -CPS IF this is a 3D problem -CPS read node X, Y, and Z coordinates from input line -CPS ELSE IF this is a 2D problem -CPS read node X and Y coordinates from input line, . . . -CPS . . . set Z coordinate to 0 -CPS END IF -CPS call near3 to determine number of node closest to . . . -CPS . . . coordinates read -CPS set zone id number for identified node -CPS UNTIL null line is read -CPS ELSE IF macro read is nnum -CPS read number of nodes belonging to zone and the node numbers -CPS FOR each node read -CPS set zone id number for the node -CPS END FOR -CPS END IF -CPS write zone number and each node in zone to data check file -CPS END IF -CPS UNTIL null line is read -CPS END IF -CPS -CPS set node count to zero -CPS FOR each node in the problem -CPS IF the node is not in a defined zone -CPS save its number and increment count of nodes not in a zone -CPS END IF -CPS END FOR -CPS -CPS IF there were nodes that were not in a zone -CPS write warning and node numbers of unassigned nodes to the . . . -CPS . . . data check file -CPS END IF -CPS -CPS IF this is a dual porosity problem -CPS set number of dual porosity nodes -CPS FOR each node -CPS set zone for first and second matrix level dual porosity node -CPS END FOR -CPS ELSE IF this a dual porosity/dual permeability problem -CPS set number of dual porosity/dual permeability nodes -CPS FOR each node -CPS set zone for first matrix level dual porosity/dual . . . -CPS . . . permeability node -CPS END FOR -CPS ELSE -CPS set number of nodes -CPS END IF -CPS -CPS UNTIL zone macro has been read -CPS -CPS END zone -CPS -C*********************************************************************** - - use combi - use comdti - use comai - use trxnvars - implicit none - - logical null1, null_new, cdum - integer cnum, i, infile, izone, izonel, nin, nodez, nsl - integer nxy, icnl_old, nin_old, i_old, ja, jb, jc, izonn - character* 4 macro, cmacro - character(20), allocatable :: znametmp(:) - character*80 ltest - real*8 xg, xz(8), yg, yz(8), zg, zz(8) - real*8 tol_zone, zxy_min, zxy_max - integer imodel, j, n_n_n, zmaxtmp - integer zone_dpadd, i3d_2d, i3d_rad, num_zones, lsize - integer, allocatable :: znumtmp(:) - - integer, allocatable :: ncord(:) - integer, allocatable :: izonef_old(:) - integer, allocatable :: zone_list(:), tmp_list(:) - character*20 zonetmp - integer k, curzone - - save zmaxtmp - allocate(ncord(n0)) - -c Dual perm or dual porosity value to add to get zones - zone_dpadd = 100 - lsize = 100 - allocate (zone_list(lsize)) - num_zones = 0 - - izonel = 0 - nin = 0 - backspace infile - - if (icnl .eq. 0) then - nsl = 8 - else - nsl = 4 - end if - - 50 continue - i3d_2d = 0 - i3d_rad = 0 - read (infile, '(a80)') wdd1 - read (wdd1,*) macro - do i = 5,77 - if(wdd1(i:i+3).eq.'conv') i3d_2d = 1 - if(wdd1(i:i+2).eq.'rad') i3d_rad = 1 - enddo - if(i3d_2d.eq.1.and.icnl.eq.0) then - write(ierr,*) 'i3d_2d parameter ignored for 3d problem' - if(iout.ne.0) - & write(iout,*) 'i3d_2d parameter ignored for 3d problem' - if(iptty.ne.0) - & write(iptty,*) 'i3d_2d parameter ignored for 3d problem' - endif - if (.not. allocated(zonenames)) then - zmaxtmp = 100 - allocate (zonenames(zmaxtmp), zonenums(zmaxtmp)) - end if - if (macro .eq. 'zone'.or.macro .eq. 'zonn') then - cmacro = macro - if(macro .ne. 'zonn') then - izonef = 0 - izonn = 0 - numzones = 0 - zonenames = '*' - zonenums = 0 - zonemax = 0 - else - allocate(izonef_old(n0)) - izonef_old = izonef - izonn = 1 - endif - endif - 60 continue - read (infile, '(a80)') wdd1 - if (null1(wdd1)) go to 90 - backspace infile - !read(infile, *) izone - read(infile, *) zonetmp - do k = 1, numzones - if (zonenames(k) .eq. zonetmp) then - curzone = k - goto 63 - endif - enddo - curzone = numzones + 1 - if (zonetmp(1:1) .ne. '-') numzones = numzones + 1 - 63 if (curzone .gt. zmaxtmp) then - allocate (znametmp(zmaxtmp),znumtmp(zmaxtmp)) - znametmp = zonenames - znumtmp = zonenums - deallocate (zonenames, zonenums) - allocate (zonenames(zmaxtmp*10), zonenums(zmaxtmp*10)) - zonenames(1:zmaxtmp) = znametmp - zonenums(1:zmaxtmp) = znumtmp - deallocate (znametmp, znumtmp) - zmaxtmp = zmaxtmp*10 - end if - zonenames(curzone) = zonetmp - read(zonenames(curzone), *, err=61) zonenums(curzone) - goto 62 - 61 zonenums(curzone) = zonemax + 1 - 62 zonemax = max(zonemax + 1, zonenums(curzone)) - izone = zonenums(curzone) - -c zvd 01/04/2012 Keep track of zones that are defined so auto generated double permeability or porosity nodes can be reported - num_zones = num_zones + 1 - if (num_zones .gt. lsize) then - allocate (tmp_list(lsize)) - tmp_list = zone_list - deallocate (zone_list) - allocate (zone_list(lsize*2)) - zone_list(1:lsize) = tmp_list - lsize = lsize*2 - deallocate (tmp_list) - end if - zone_list(num_zones) = izone - -c Determine if zone_dpadd needs to be increased to 1000 - if(izone.gt.99) zone_dpadd = 1000 - - if (izone .gt. 0) then -c check if list or nnum occurs - read(infile, '(a4)') macro - if (macro .ne. 'list' .and. macro .ne. 'nnum' .and. - & macro .ne. 'xyli'.and. macro.ne. 'all ' .and. - & macro .ne. 'jajb') then - backspace infile - if (izone .ne. izonel) nin = 0 - if(i3d_rad.eq.1.and.icnl.eq.0) then -c radial input for 3D problems (uses 2D input) - read (infile, *) (xz(i), i = 1, 4) - read (infile, *) (yz(i), i = 1, 4) - call setzone(izone, nin, ncord, 4, xz, yz, zz, 1) - else if(i3d_2d.eq.0.or.icnl.eq.0) then - read (infile, *) (xz(i), i = 1, nsl) - read (infile, *) (yz(i), i = 1, nsl) - if (icnl .eq. 0) then -c**** 3-d calculation **** - read (infile, *) (zz(i), i = 1, nsl) - end if - call setzone(izone, nin, ncord, nsl, xz, yz, zz, 0) - else -c 3-d zones in 2D model (for consistency when extracting slices in 3d) - read (infile, *) (xz(i), i = 1, 8) - xz(3) = xz(2) - xz(4) = xz(1) - xz(1) = xz(5) - xz(2) = xz(6) - read (infile, *) (yz(i), i = 1, 8) -c note we overwrite yz with zz - read (infile, *) (zz(i), i = 1, 8) - yz(1) = zz(5) - yz(2) = zz(6) - yz(3) = zz(2) - yz(4) = zz(1) - call setzone(izone, nin, ncord, nsl, xz, yz, zz, 0) - endif - else if(macro .eq. 'xyli') then -c read in nodes in zone from xy list - nxy = 0 - nin = 0 - i = 0 - read(infile,*) tol_zone, zxy_min, zxy_max - 71 read(infile, '(a80)') ltest - if(.not.null1(ltest)) then - read(ltest, *, end = 81, err = 81) xg, yg - i_old = i - icnl_old=icnl - icnl=1 - call near3(xg,yg,0.0,i,0) - icnl=icnl_old - if(i_old.eq.i) go to 71 - xg=cord(i,1) - yg=cord(i,2) - nxy = nxy + 1 - else - goto 81 - end if - xz(1)=xg-tol_zone - xz(2)=xg+tol_zone - xz(3)=xg+tol_zone - xz(4)=xg-tol_zone - xz(5)=xg-tol_zone - xz(6)=xg+tol_zone - xz(7)=xg+tol_zone - xz(8)=xg-tol_zone - yz(1)=yg-tol_zone - yz(2)=yg-tol_zone - yz(3)=yg+tol_zone - yz(4)=yg+tol_zone - yz(5)=yg-tol_zone - yz(6)=yg-tol_zone - yz(7)=yg+tol_zone - yz(8)=yg+tol_zone - zz(1)=zxy_max - zz(2)=zxy_max - zz(3)=zxy_max - zz(4)=zxy_max - zz(5)=zxy_min - zz(6)=zxy_min - zz(7)=zxy_min - zz(8)=zxy_min - nin_old = 0 - call setzone(izone, nin_old, ncord(nin+1:neq), - & nsl, xz, yz, zz, 0) - nin=nin+nin_old - go to 71 - 81 continue - else if(macro .eq. 'list') then -c read in coordinates for nodes in zone - nin = 0 - 70 read(infile, '(a80)') ltest - if(.not.null_new(ltest)) then - if(icnl .eq. 0) then - read(ltest, *, end = 80, err = 80) xg, yg, zg - else - if(i3d_2d.eq.1) then - read(ltest, *, end = 80, err = 80) xg, yg, zg - yg = zg - zg = 0.0 - else - read(ltest, *, end = 80, err = 80) xg, yg - zg = 0.0 - endif - end if - else - goto 80 - endif - nin = nin + 1 - call near3(xg, yg, zg, nodez, 0) - ncord(nin) = nodez - izonef(nodez) = izone - go to 70 - 80 continue - else if(macro .eq. 'nnum') then -c read in nodes belonging to zone - read(infile, *) nin, (ncord (i), i = 1, nin) - do i = 1, nin - if (ncord(i) .gt. n0) then - write (ierr, 6008) cmacro - write (ierr, 6009) ncord(i), n0 - if (iout .ne. 0) write (iout, 6009) ncord(i), n0 - if (iptty .gt. 0) write (iptty, 6009) ncord(i), n0 - stop - else - izonef(ncord(i)) = izone - end if - end do - else if(macro .eq. 'all ') then - do i = 1, n0 - izonef(i) = izone - enddo - else if(macro .eq. 'jajb') then - do - read (infile, '(a80)') ltest - if(null_new(ltest)) exit - read (ltest, *) ja, jb, jc - do i = ja, jb, jc - izonef(i) = izone - end do - end do - endif - 6008 format (' **** Invalid input: macro ', a4, ' ****') - 6009 format(' **** Invalid node specified, ', i8, - . ' is greater than ', 'n0 (', i8, ' ): stopping ****') -c**** print out nodes in izone **** - nin = 0 -c Change to n0 (used to be neq) - BAR 12-15-99 - do i = 1, n0 - if(izonef(i) .eq. izone) then - nin = nin + 1 - ncord(nin) = i - endif - end do - if (ischk .ne. 0) then - write(ischk, 6010) nin, izone - 6010 format(/, 1x, i8,' nodes contained in zone = ', - & i10, /) - write(ischk, 6011) (ncord(i), i = 1, nin) - 6011 format (10i8) - end if - izonel = izone - go to 60 - endif -c check which nodes don't belong to a zone - 90 nin = 0 -c Changed to neq_primary (used to be neq) BAR - 12-15-99 - do i = 1, neq_primary - if(izonef(i) .eq. 0) then - nin = nin + 1 - ncord(nin) = i - endif - end do - if (nin .ne. 0) then - if (ischk .ne. 0) write(ischk, 6012) nin, cnum -c write(ischk, 6011) (ncord(i), i = 1, nin) - end if - 6012 format(/, 1x, i8, - & ' nodes not assigned to a zone in call # ', i10) - - -c Assign zones for GDPM nodes - - if(gdpm_flag.ne.0) then - -c Set zones for GDPM nodes for the case in which zone has -c already been called -c Convention: all GDPM nodes are assigned a zone that -c is 100 + the zone number of the primary node -c unless the zone numbers declared are greater than 100, -c then we use 1000 (zone_dpadd is the variable) - - n_n_n = neq_primary - do i = 1, neq_primary - -c Loop over all GDPM nodes for primary node i -c ngdpm_layers(imodel) = 0 for imodel = 0 (i.e. no GDPM nodes) - imodel = igdpm(i) - do j = 1, ngdpm_layers(imodel) - n_n_n = n_n_n + 1 - if(izonn.eq.1) then - if(izonef(i).ne.izonef_old(i)) then -c Only assign the zone number this way if -c it hasn't already been assigned a non-zero value -c for example, in a zone with the nnum option - izonef(n_n_n) = izonef(i) + zone_dpadd - endif - endif - end do - end do - - end if - - - -c check for dual porosity or dpdp solution - if(idualp .eq. 1) then -c dual porosity solution - n = neq+neq+neq - if (ischk .ne. 0) then - write(ischk, *) 'dual porosity solution' - write(ischk, *) 'first matrix level zone = ', - . 'fracture level zone + ',zone_dpadd - write(ischk, *) 'second matrix level zone = ', - . 'fracture level zone + ',zone_dpadd*2 - end if - -c This loop changed to set zones to their value plus 100 -c only if the nodes have not been explicitly set in the -c zone definition. This allows the user to set the matrix -c nodes in the zone macro and not have the code default -c to zone number plus 100 (or 200). -c Loop changed to accomodate the new zone_dpadd variable - - do i = 1, neq - if(izonn.eq.1)then - if(izonef(i).ne.izonef_old(i)) then - izonef(i + neq) = izonef(i) + zone_dpadd - endif - else - izonef(i + neq) = izonef(i) + zone_dpadd - end if - if(izonn.eq.1)then - if(izonef(i).ne.izonef_old(i)) then - izonef(i + neq + neq) = izonef(i) + 2*zone_dpadd - endif - else - izonef(i + neq + neq) = izonef(i) + 2*zone_dpadd - end if - end do - else if(idpdp .ne. 0) then -c dpdp solution - n = neq+neq - if (ischk .ne. 0) then - write(ischk, *) 'dual porosity/dual permeability ', - & 'solution' - write(ischk, *) 'first matrix level zone = ', - . 'fracture level zone + ',zone_dpadd - end if -c This loop changed to set zones to their value plus 100 -c only if the nodes have not been explicitly set in the -c zone definition. This allows the user to set the matrix -c nodes in the zone macro and not have the code default -c to zone number plus 100. -c Loop changed to accomodate the new zone_dpadd variable - - do i = 1, neq - if(izonn.eq.1)then - if(izonef(i).ne.izonef_old(i)) then - izonef(i + neq) = izonef(i) + zone_dpadd - endif - else - if(izonef(i+neq).eq.0) then - izonef(i + neq) = izonef(i) + zone_dpadd - endif - end if - end do - if (ischk .ne. 0) then - do i = 1, num_zones - nin = 0 - do j = neq + 1, 2 * neq - if(izonef(j) .eq. zone_list(i) + zone_dpadd) then - nin = nin + 1 - ncord(nin) = j - endif - end do - if (nin .ne. 0) then - write(ischk, 6010) nin, zone_list(i) + zone_dpadd - write(ischk, 6011) (ncord(j), j = 1, nin) - end if - end do - end if - else - n = neq - endif - go to 100 -c end if - go to 50 - 100 continue - deallocate (zone_list) - - macroread(18) = .TRUE. - deallocate(ncord) - if(allocated(izonef_old)) deallocate(izonef_old) - return - end + subroutine zone(cnum, infile) +!*********************************************************************** +! Copyright, 1993, 2004, The Regents of the University of California. +! This program was prepared by the Regents of the University of +! California at Los Alamos National Laboratory (the University) under +! contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE). +! All rights in the program are reserved by the DOE and the University. +! Permission is granted to the public to copy and use this software +! without charge, provided that this Notice and any statement of +! authorship are reproduced on all copies. Neither the U.S. Government +! nor the University makes any warranty, express or implied, or +! assumes any liability or responsibility for the use of this software. +C*********************************************************************** +CD1 +CD1 PURPOSE +CD1 Create FEHM zones using geometry or node lists +CD1 Enter properties using geometric description. +CD1 +C*********************************************************************** +CD2 +CD2 REVISION HISTORY +CD2 +CD2 Revision ECD +CD2 Date Programmer Number Comments +CD2 +CD2 03-JAN-94 Z. Dash 22 Add prolog/major cleanup. +CD2 G. Zyvoloski Initial implementation. +CD2 +CD2 $Log: /pvcs.config/fehm90/src/zone.f_a $ +CD2 +!D2 +!D2 Rev 2.5 06 Jan 2004 10:44:32 pvcs +!D2 FEHM Version 2.21, STN 10086-2.21-00, Qualified October 2003 +!D2 +!D2 Rev 2.4 29 Jan 2003 09:25:24 pvcs +!D2 FEHM Version 2.20, STN 10086-2.20-00 +!D2 +!D2 Rev 2.3 14 Nov 2001 13:29:30 pvcs +!D2 FEHM Version 2.12, STN 10086-2.12-00 +!D2 +!D2 Rev 2.2 06 Jun 2001 13:28:56 pvcs +!D2 FEHM Version 2.11, STN 10086-2.11-00 +!D2 +!D2 Rev 2.1 30 Nov 2000 12:13:44 pvcs +!D2 FEHM Version 2.10, STN 10086-2.10-00 +!D2 +!D2 Rev 2.0 Fri May 07 14:48:36 1999 pvcs +!D2 FEHM Version 2.0, SC-194 (Fortran 90) +CD2 +CD2 Rev 1.9 Wed Jun 12 15:21:26 1996 zvd +CD2 Modified optional input file routines and reduced number of calls +CD2 +CD2 Rev 1.8 Mon Jun 03 11:18:46 1996 hend +CD2 Added macro name & comment capabi. to new input +CD2 +CD2 Rev 1.7 Fri May 31 10:55:24 1996 hend +CD2 Added optional input from specified file +CD2 +CD2 Rev 1.6 Fri Feb 16 13:59:46 1996 zvd +CD2 Added requirement. +CD2 +CD2 Rev 1.5 Fri Feb 02 14:34:12 1996 hend +CD2 Updated Requirements Traceability +CD2 +CD2 Rev 1.4 Fri Jan 12 18:04:06 1996 llt +CD2 changed mmgetblk arguments +CD2 +CD2 Rev 1.3 08/22/95 13:47:30 llt +CD2 quotes around internal read name doesn't work on IBM. +CD2 +CD2 Rev 1.2 08/18/95 10:32:26 llt +CD2 needed quotes around ltest for cray to read +CD2 +CD2 Rev 1.1 03/18/94 16:04:00 gaz +CD2 Added solve_new and cleaned up memory management. +CD2 +CD2 Rev 1.0 01/20/94 10:29:42 pvcs +CD2 original version in process of being certified +CD2 +C*********************************************************************** +CD3 +CD3 INTERFACES +CD3 +CD3 Formal Calling Parameters +CD3 +CD3 Identifier Type Use Description +CD3 +CD3 cnum INT I Number of times zone has been called +CD3 infile INT I Unit number of file to be read. +CD3 +CD3 Interface Tables +CD3 +CD3 None +CD3 +CD3 Files +CD3 +CD3 Name Use Description +CD3 +CD3 inpt I Main input data file. +CD3 inzone I Zone input file. +CD3 iout O General output file. +CD3 +C*********************************************************************** +CD4 +CD4 GLOBAL OBJECTS +CD4 +CD4 Global Constants +CD4 +CD4 None +CD4 +CD4 Global Types +CD4 +CD4 None +CD4 +CD4 Global Variables +CD4 +CD4 COMMON +CD4 Identifier Type Block Description +CD4 +CD4 icnl INT faai Problem dimension +CD4 idpdp INT faai Parameter which indicates if the double +CD4 porosity / double permeability +CD4 solution is enabled +CD4 idualp INT faai Parameter which indicates if the dual +CD4 porosity solution is enabled +CD4 inpt INT faai Unit number for input file +CD4 inzone INT faai Unit number for zone input file +CD4 izonef INT fbb Zone in which each node is located +CD4 lenintg INT param Converts bits to words for allocating +CD4 memory +CD4 macroread(18) LOGICAL macro Flag denoting if macro zone has been read +CD4 wdd1 CHAR faac Alternate character input string +CD4 +CD4 Global Subprograms +CD4 +CD4 Identifier Type Description +CD4 +CD4 mmgetblk Allocate memory to an array +CD4 mmrelblk Deallocate array memory +CD4 null1 LOGICAL Check for null lines or 0's in lines +CD4 +C*********************************************************************** +CD5 +CD5 LOCAL IDENTIFIERS +CD5 +CD5 Local Constants +CD5 +CD5 None +CD5 +CD5 Local Types +CD5 +CD5 None +CD5 +CD5 Local variables +CD5 +CD5 Identifier Type Description +CD5 +CD5 i INT Loop index +CD5 icode INT Return value from mmgetblk, mmrelblk routines +CD5 ipncord POINTER Pointer to variable array ncord +CD5 izone INT Identifier for zone being defined +CD5 izonel INT Identifier for last zone defined +CD5 ltest CHAR Variable for reading character input +CD5 macro CHAR Current macro being read +CD5 ncord REAL*8 Nodes found within a zone +CD5 nin INT Number of nodes assigned to zone +CD5 nodez INT Number of node nearest given coordinates +CD5 nsl INT Number of coordinates in element +CD5 xg REAL*8 X coordinate defining node +CD5 xz REAL*8 X coordinates defining zone +CD5 yg REAL*8 Y coordinate defining node +CD5 yz REAL*8 Y coordinates defining zone +CD5 zg REAL*8 Z coordinate defining node +CD5 zz REAL*8 Z coordinates defining zone +CD5 +CD5 Local Subprograms +CD5 +CD5 None +CD5 +C*********************************************************************** +CD6 +CD6 FUNCTIONAL DESCRIPTION +CD6 +C*********************************************************************** +CD7 +CD7 ASSUMPTIONS AND LIMITATIONS +CD7 +CD7 None +CD7 +C*********************************************************************** +CD8 +CD8 SPECIAL COMMENTS +CD8 +CD8 Zones are a convenient way to group nodes and specify properties, +CD8 but they are not an essential function of the code. +CD8 +CD8 Requirements from SDN: 10086-RD-2.20-00 +CD8 SOFTWARE REQUIREMENTS DOCUMENT (RD) for the +CD8 FEHM Application Version 2.20 +CD8 +C*********************************************************************** +CD9 +CD9 REQUIREMENTS TRACEABILITY +CD9 +CD9 2.6 Provide Input/Output Data Files +CD9 3.0 INPUT AND OUTPUT REQUIREMENTS +CD9 +C*********************************************************************** +CDA +CDA REFERENCES +CDA +CDA None +CDA +C*********************************************************************** +CPS +CPS PSEUDOCODE +CPS +CPS BEGIN zone +CPS +CPS backup a line in file to be read +CPS +CPS FOR each node +CPS set zone to zero +CPS END FOR +CPS +CPS END IF +CPS +CPS IF this is a 3D problem +CPS set nsl to 8 +CPS ELSE +CPS set nsl to 4 +CPS END IF +CPS +CPS REPEAT +CPS read input line +CPS IF macro read is zone +CPS REPEAT +CPS read input line +CPS EXIT IF null line is read +CPS reread the input line to get zone identification number +CPS IF the zone id is > 0 +CPS read input line +CPS IF macros list and nnum are not read +CPS IF this zone isn't the same as the last zone +CPS set node count to zero +CPS END IF +CPS read zone X coordinates +CPS read zone Y coordinates +CPS IF this is a 3D problem +CPS read zone Z coordinates +CPS END IF +CPS call setzone to find nodes in zone +CPS ELSE IF macro read is list +CPS set node count to zero +CPS REPEAT +CPS read input line +CPS IF this is a 3D problem +CPS read node X, Y, and Z coordinates from input line +CPS ELSE IF this is a 2D problem +CPS read node X and Y coordinates from input line, . . . +CPS . . . set Z coordinate to 0 +CPS END IF +CPS call near3 to determine number of node closest to . . . +CPS . . . coordinates read +CPS set zone id number for identified node +CPS UNTIL null line is read +CPS ELSE IF macro read is nnum +CPS read number of nodes belonging to zone and the node numbers +CPS FOR each node read +CPS set zone id number for the node +CPS END FOR +CPS END IF +CPS write zone number and each node in zone to data check file +CPS END IF +CPS UNTIL null line is read +CPS END IF +CPS +CPS set node count to zero +CPS FOR each node in the problem +CPS IF the node is not in a defined zone +CPS save its number and increment count of nodes not in a zone +CPS END IF +CPS END FOR +CPS +CPS IF there were nodes that were not in a zone +CPS write warning and node numbers of unassigned nodes to the . . . +CPS . . . data check file +CPS END IF +CPS +CPS IF this is a dual porosity problem +CPS set number of dual porosity nodes +CPS FOR each node +CPS set zone for first and second matrix level dual porosity node +CPS END FOR +CPS ELSE IF this a dual porosity/dual permeability problem +CPS set number of dual porosity/dual permeability nodes +CPS FOR each node +CPS set zone for first matrix level dual porosity/dual . . . +CPS . . . permeability node +CPS END FOR +CPS ELSE +CPS set number of nodes +CPS END IF +CPS +CPS UNTIL zone macro has been read +CPS +CPS END zone +CPS +C*********************************************************************** + + use combi + use comdti + use comai + use trxnvars + implicit none + + logical null1, null_new, cdum + integer cnum, i, infile, izone, izonel, nin, nodez, nsl + integer nxy, icnl_old, nin_old, i_old, ja, jb, jc, izonn + integer izunit, open_file + character* 4 macro, cmacro + character(20), allocatable :: znametmp(:) + character*80 ltest + real*8 xg, xz(8), yg, yz(8), zg, zz(8) + real*8 tol_zone, zxy_min, zxy_max + integer imodel, j, n_n_n, zmaxtmp +c gaz 022818 + integer neq_t + integer zone_dpadd, i3d_2d, i3d_rad, num_zones, lsize + integer, allocatable :: znumtmp(:) +c ncord now in combi +c integer, allocatable :: ncord(:) + integer, allocatable :: izonef_old(:) + integer, allocatable :: zone_list(:), tmp_list(:) + character*20 zonetmp + character*30 zonesavename + integer k, curzone + logical ex, zone_check + + save zmaxtmp + allocate(ncord(n0)) + +c Dual perm or dual porosity value to add to get zones + zonesavename(1:4) = 'zone' + izone_save = 0 + zone_dpadd = 100 + lsize = 100 + allocate (zone_list(lsize)) + num_zones = 0 + + izonel = 0 + nin = 0 + backspace infile + + if (icnl .eq. 0) then + nsl = 8 + else + nsl = 4 + end if + + 50 continue + i3d_2d = 0 + i3d_rad = 0 + read (infile, '(a80)') wdd1 + read (wdd1,*) macro + do i = 5,77 + if(wdd1(i:i+3).eq.'conv') i3d_2d = 1 + if(wdd1(i:i+2).eq.'rad') i3d_rad = 1 + if(wdd1(i:i+3).eq.'save') izone_save = 1 + enddo + if(i3d_2d.eq.1.and.icnl.eq.0) then + write(ierr,*) 'i3d_2d parameter ignored for 3d problem' + if(iout.ne.0) + & write(iout,*) 'i3d_2d parameter ignored for 3d problem' + if(iptty.ne.0) + & write(iptty,*) 'i3d_2d parameter ignored for 3d problem' + endif + if (.not. allocated(zonenames)) then + zmaxtmp = 100 + allocate (zonenames(zmaxtmp), zonenums(zmaxtmp)) + end if + if (macro .eq. 'zone'.or.macro .eq. 'zonn') then + cmacro = macro + if(macro .ne. 'zonn') then + izonef = 0 + izonn = 0 + numzones = 0 + zonenames = '*' + zonenums = 0 + zonemax = 0 + else + allocate(izonef_old(n0)) + izonef_old = izonef + izonn = 1 + endif + endif + 60 continue + read (infile, '(a80)') wdd1 + if (null1(wdd1)) go to 90 + backspace infile + !read(infile, *) izone + read(infile, *) zonetmp + do k = 1, numzones + if (zonenames(k) .eq. zonetmp) then + curzone = k + goto 63 + endif + enddo + curzone = numzones + 1 + if (zonetmp(1:1) .ne. '-') numzones = numzones + 1 + 63 if (curzone .gt. zmaxtmp) then + allocate (znametmp(zmaxtmp),znumtmp(zmaxtmp)) + znametmp = zonenames + znumtmp = zonenums + deallocate (zonenames, zonenums) + allocate (zonenames(zmaxtmp*10), zonenums(zmaxtmp*10)) + zonenames(1:zmaxtmp) = znametmp + zonenums(1:zmaxtmp) = znumtmp + deallocate (znametmp, znumtmp) + zmaxtmp = zmaxtmp*10 + end if + zonenames(curzone) = zonetmp + read(zonenames(curzone), *, err=61) zonenums(curzone) + goto 62 + 61 zonenums(curzone) = zonemax + 1 + 62 zonemax = max(zonemax + 1, zonenums(curzone)) + izone = zonenums(curzone) + +c zvd 01/04/2012 Keep track of zones that are defined so auto generated double permeability or porosity nodes can be reported + num_zones = num_zones + 1 + if (num_zones .gt. lsize) then + allocate (tmp_list(lsize)) + tmp_list = zone_list + deallocate (zone_list) + allocate (zone_list(lsize*2)) + zone_list(1:lsize) = tmp_list + lsize = lsize*2 + deallocate (tmp_list) + end if + zone_list(num_zones) = izone + +c Determine if zone_dpadd needs to be increased to 1000 + if(izone.gt.99) zone_dpadd = 1000 + + if (izone .gt. 0) then +c first check if saved already +c check if list or nnum occurs + call check_save_zone(1,izone,zone_check) + read(infile, '(a4)') macro + if (macro .ne. 'list' .and. macro .ne. 'nnum' .and. + & macro .ne. 'xyli'.and. macro.ne. 'all ' .and. + & macro .ne. 'jajb') then + backspace infile + if (izone .ne. izonel) nin = 0 + if(i3d_rad.eq.1.and.icnl.eq.0) then +c radial input for 3D problems (uses 2D input) + read (infile, *) (xz(i), i = 1, 4) + read (infile, *) (yz(i), i = 1, 4) +c call setzone(izone, nin, ncord, 4, xz, yz, zz, 1) + call setzone(izone, nin, 4, xz, yz, zz, 1) + else if(i3d_2d.eq.0.or.icnl.eq.0) then + read (infile, *) (xz(i), i = 1, nsl) + read (infile, *) (yz(i), i = 1, nsl) + if (icnl .eq. 0) then +c**** 3-d calculation **** + read (infile, *) (zz(i), i = 1, nsl) + end if +c call setzone(izone, nin, ncord, nsl, xz, yz, zz, 0) + call setzone(izone, nin, nsl, xz, yz, zz, 0) + else +c 3-d zones in 2D model (for consistency when extracting slices in 3d) + read (infile, *) (xz(i), i = 1, 8) + xz(3) = xz(2) + xz(4) = xz(1) + xz(1) = xz(5) + xz(2) = xz(6) + read (infile, *) (yz(i), i = 1, 8) +c note we overwrite yz with zz + read (infile, *) (zz(i), i = 1, 8) + yz(1) = zz(5) + yz(2) = zz(6) + yz(3) = zz(2) + yz(4) = zz(1) +c call setzone(izone, nin, ncord, nsl, xz, yz, zz, 0) + call setzone(izone, nin, nsl, xz, yz, zz, 0) + endif + else if(macro .eq. 'xyli') then +c read in nodes in zone from xy list + nxy = 0 + nin = 0 + i = 0 + read(infile,*) tol_zone, zxy_min, zxy_max + 71 read(infile, '(a80)') ltest + if(.not.null1(ltest)) then + read(ltest, *, end = 81, err = 81) xg, yg + i_old = i + icnl_old=icnl + icnl=1 + call near3(xg,yg,0.0,i,0) + icnl=icnl_old + if(i_old.eq.i) go to 71 + xg=cord(i,1) + yg=cord(i,2) + nxy = nxy + 1 + else + goto 81 + end if + xz(1)=xg-tol_zone + xz(2)=xg+tol_zone + xz(3)=xg+tol_zone + xz(4)=xg-tol_zone + xz(5)=xg-tol_zone + xz(6)=xg+tol_zone + xz(7)=xg+tol_zone + xz(8)=xg-tol_zone + yz(1)=yg-tol_zone + yz(2)=yg-tol_zone + yz(3)=yg+tol_zone + yz(4)=yg+tol_zone + yz(5)=yg-tol_zone + yz(6)=yg-tol_zone + yz(7)=yg+tol_zone + yz(8)=yg+tol_zone + zz(1)=zxy_max + zz(2)=zxy_max + zz(3)=zxy_max + zz(4)=zxy_max + zz(5)=zxy_min + zz(6)=zxy_min + zz(7)=zxy_min + zz(8)=zxy_min + nin_old = 0 +c call setzone(izone, nin_old, ncord(nin+1:neq), + call setzone(izone, nin_old, + & nsl, xz, yz, zz, 0) + nin=nin+nin_old + go to 71 + 81 continue + else if(macro .eq. 'list') then +c read in coordinates for nodes in zone + nin = 0 + 70 read(infile, '(a80)') ltest + if(.not.null_new(ltest)) then + if(icnl .eq. 0) then + read(ltest, *, end = 80, err = 80) xg, yg, zg + else + if(i3d_2d.eq.1) then + read(ltest, *, end = 80, err = 80) xg, yg, zg + yg = zg + zg = 0.0 + else + read(ltest, *, end = 80, err = 80) xg, yg + zg = 0.0 + endif + end if + else + goto 80 + endif + nin = nin + 1 + call near3(xg, yg, zg, nodez, 0) + ncord(nin) = nodez + izonef(nodez) = izone + go to 70 + 80 continue + else if(macro .eq. 'nnum') then +c read in nodes belonging to zone + read(infile, *) nin, (ncord (i), i = 1, nin) + do i = 1, nin + if (ncord(i) .gt. n0) then + write (ierr, 6008) cmacro + write (ierr, 6009) ncord(i), n0 + if (iout .ne. 0) write (iout, 6009) ncord(i), n0 + if (iptty .gt. 0) write (iptty, 6009) ncord(i), n0 + stop + else + izonef(ncord(i)) = izone + end if + end do + else if(macro .eq. 'all ') then +c check for multiple porosity models + if(gdpm_flag.ne.0.or.gdkm_flag.ne.0.or. + & idualp.ne.0.or.idpdp.ne.0) then + if(gdpm_flag.ne.0) neq_t = neq_primary + if(gdkm_flag.ne.0) neq_t = neq_primary + if(idualp.ne.0) neq_t = neq + if(idpdp.ne.0) neq_t = neq + do i = 1, neq_t + izonef(i) = izone + enddo + else + do i = 1, n0 + izonef(i) = izone + enddo + endif + else if(macro .eq. 'jajb') then + do + read (infile, '(a80)') ltest + if(null_new(ltest)) exit + read (ltest, *) ja, jb, jc + do i = ja, jb, jc + izonef(i) = izone + end do + end do + endif + 6008 format (' **** Invalid input: macro ', a4, ' ****') + 6009 format(' **** Invalid node specified, ', i8, + . ' is greater than ', 'n0 (', i8, ' ): stopping ****') +c**** print out nodes in izone **** + nin = 0 +c Change to n0 (used to be neq) - BAR 12-15-99 + do i = 1, n0 + if(izonef(i) .eq. izone) then + nin = nin + 1 + ncord(nin) = i + endif + end do + if (ischk .ne. 0) then + write(ischk, 6010) nin, izone + 6010 format(/, 1x, i8,' nodes contained in zone = ', + & i10, /) + write(ischk, 6011) (ncord(i), i = 1, nin) + 6011 format (10i8) + end if +c if zonesave ne 0, then save it to a file +c first check if saved already +c call check_save_zone(1,izone,zone_check) + if(izone_save.ne.0) then +c create a file to save the zone information + write(zonesavename(5:9),'(i5)') izone+10000 + zonesavename(5:5) = '0' + zonesavename(10:14) = '.save' + ex = .false. +c inquire (file = zonesavename, exist = ex) + if(ex) then +c abort zone save because zonefile exists + if (ischk .ne. 0) then + write(ischk, 6014) izone, zonesavename(1:14) +6014 format(1x, 'zone 'i5,' file creation aborted, ',a14,' exists') + endif + if (iout .ne. 0) then + write(iout, 6014) izone, zonesavename(1:14) + endif + if (iptty .ne. 0) then + write(iptty, 6014) izone, zonesavename(1:14) + endif + go to 6015 + endif + izunit=open_file(zonesavename,'unknown') +c write zone in nnum style + if (ischk .ne. 0) then + write(ischk, 6013) izone, zonesavename(1:14) +6013 format(1x, 'zone 'i5,' saved in file ', a14) + endif + if (iout .ne. 0) then + write(iout, 6013) izone, zonesavename(1:14) + endif + if (iptty .ne. 0) then + write(iptty, 6013) izone, zonesavename(1:14) + endif + write(izunit,*) izone + write(izunit,*) 'nnum' +c write out nodes belonging to zone + nin = 0 + do i = 1, n0 + if(izonef(i) .eq. izone) then + nin = nin + 1 + ncord(nin) = i + endif + end do + write(izunit,*) nin, (ncord(i), i = 1,nin) +c add elements to saved zone + call zone_elem(1,izunit,zonesavename,izone,nin) + call zone_elem(2,izunit,zonesavename,izone,nin) + close(izunit) +6015 continue + endif +c end of saved zones + izonel = izone + go to 60 + endif +c check which nodes don't belong to a zone +c gaz 022818 +90 nin = 0 +c Changed to neq_primary (used to be neq) BAR - 12-15-99 + do i = 1, neq_primary + if(izonef(i) .eq. 0) then + nin = nin + 1 + ncord(nin) = i + endif + end do + if (nin .ne. 0) then + if (ischk .ne. 0) write(ischk, 6012) nin, cnum +c write(ischk, 6011) (ncord(i), i = 1, nin) + end if + 6012 format(/, 1x, i8, + & ' nodes not assigned to a zone in call # ', i10) + + +c Assign zones for GDPM nodes + + if(gdpm_flag.ne.0.and.gdkm_flag.eq.0) then + +c Set zones for GDPM nodes for the case in which zone has +c already been called +c Convention: all GDPM nodes are assigned a zone that +c is 100 + the zone number of the primary node +c unless the zone numbers declared are greater than 100, +c then we use 1000 (zone_dpadd is the variable) + + n_n_n = neq_primary + do i = 1, neq_primary + +c Loop over all GDPM nodes for primary node i +c ngdpm_layers(imodel) = 0 for imodel = 0 (i.e. no GDPM nodes) + imodel = igdpm(i) + do j = 1, ngdpm_layers(imodel) + n_n_n = n_n_n + 1 + if(izonn.eq.1) then + if(izonef(i).ne.izonef_old(i)) then +c Only assign the zone number this way if +c it hasn't already been assigned a non-zero value +c for example, in a zone with the nnum option + izonef(n_n_n) = izonef(i) + zone_dpadd + endif + else +c gaz new 061817 to make consistent with dpdp + if(izonef(i).eq.0) then + izonef(n_n_n) = izonef(i) + zone_dpadd + endif + endif + end do + end do + + end if + + + +c check for dual porosity or dpdp solution + if(idualp .eq. 1) then +c dual porosity solution + n = neq+neq+neq + if (ischk .ne. 0) then + write(ischk, *) 'dual porosity solution' + write(ischk, *) 'first matrix level zone = ', + . 'fracture level zone + ',zone_dpadd + write(ischk, *) 'second matrix level zone = ', + . 'fracture level zone + ',zone_dpadd*2 + end if + +c This loop changed to set zones to their value plus 100 +c only if the nodes have not been explicitly set in the +c zone definition. This allows the user to set the matrix +c nodes in the zone macro and not have the code default +c to zone number plus 100 (or 200). +c Loop changed to accomodate the new zone_dpadd variable + + do i = 1, neq + if(izonn.eq.1)then + if(izonef(i).ne.izonef_old(i)) then + izonef(i + neq) = izonef(i) + zone_dpadd + endif + else + izonef(i + neq) = izonef(i) + zone_dpadd + end if + if(izonn.eq.1)then + if(izonef(i).ne.izonef_old(i)) then + izonef(i + neq + neq) = izonef(i) + 2*zone_dpadd + endif + else + izonef(i + neq + neq) = izonef(i) + 2*zone_dpadd + end if + end do + else if(idpdp .ne. 0. or. gdkm_flag .ne. 0) then +c dpdp solution or gdkm solution + if(idpdp.ne.0) then + n = neq+neq + neq_t = neq + else +c gdkm : neq is total nodes + n = neq + neq_t = neq_primary + endif + if (ischk .ne. 0) then + write(ischk, *) 'dual porosity/dual permeability ', + & 'solution' + write(ischk, *) 'first matrix level zone = ', + . 'fracture level zone + ',zone_dpadd + end if +c This loop changed to set zones to their value plus 100 +c only if the nodes have not been explicitly set in the +c zone definition. This allows the user to set the matrix +c nodes in the zone macro and not have the code default +c to zone number plus 100. +c Loop changed to accomodate the new zone_dpadd variable + k = neq_t + do i = 1, neq_t +c first check for gdkm primary node + if(gdkm_flag.ne.0) then + if(igdpm(i).ne.0) then + k = k+1 + if(izonn.eq.1)then + if(izonef(i).ne.izonef_old(i)) then + izonef(k) = izonef(i) + zone_dpadd + endif + else + if(izonef(k).eq.0.and.izonef(i).ne.0) then + izonef(k) = izonef(i) + zone_dpadd + endif + end if + endif + else + if(izonn.eq.1)then + if(izonef(i).ne.izonef_old(i)) then + izonef(i+neq_t) = izonef(i) + zone_dpadd + endif + else + if(izonef(i+neq_t).eq.0.and.izonef(i).ne.0) then + izonef(i+neq_t) = izonef(i) + zone_dpadd + endif + end if + endif + end do + if (ischk .ne. 0) then + do i = 1, num_zones + nin = 0 + k = neq_t + do j = 1, neq_t + if(gdkm_flag.ne.0) then + if(igdpm(j).gt.0) then + k = k +1 + if(izonef(k) .eq. zone_list(i) + zone_dpadd) then + nin = nin + 1 + ncord(nin) = k + endif + endif + else + if(izonef(j+neq_t) .eq. zone_list(i) + zone_dpadd) then + nin = nin + 1 + ncord(nin) = j+neq_t + endif + endif + end do + if (nin .ne. 0) then + write(ischk, 6010) nin, zone_list(i) + zone_dpadd + write(ischk, 6011) (ncord(j), j = 1, nin) + end if + end do + end if + else + n = neq + endif + go to 100 +c end if + go to 50 + 100 continue + deallocate(zone_list) + macroread(18) = .TRUE. + deallocate(ncord) + if(allocated(izonef_old)) deallocate(izonef_old) + return + end + subroutine zone_elem(iflg,izunit,zonesavename,izone,nin) +c add element information to saved zones +c + use combi + use comdti + use comai + + implicit none + integer iflg,izone,izunit,i_elem_cover + integer i,ii,j,ie,nin,ic,ic1,k,ib,id +c ncord now in combi +c integer ncord(*) + integer, allocatable :: nopdum(:,:) + integer, allocatable :: noodum(:,:) + integer, allocatable :: iplace(:) + integer, allocatable :: iplace1(:) + integer, allocatable :: ielem_used(:) + integer, allocatable :: nei_list(:) + integer, allocatable :: ncord_new(:) + character*30 zonesavename + save nopdum,noodum,iplace,ielem_used,iplace1 + save nei_list,ncord_new + parameter(i_elem_cover = 0) + if(iflg.eq.1) then +c +c find elements associated with each node +c +c calculate # connections for each node +c + if(.not.allocated(iplace)) then + allocate(iplace(n0)) + else +c only need to do this section once +c this idicates the arrays are ready to use for iflg = 2 + return + endif + iplace = 0 + do ie=1,nei + do j=1,ns + i=nelm((ie-1)*ns+j) + if (i .ne. 0) then + iplace(i)=iplace(i)+1 + endif + enddo + enddo + nemx = 0 + do i = 1, n0 + nemx = max(nemx,iplace(i)) + enddo + allocate(nopdum(n0,nemx)) + allocate(ielem_used(nei)) + iplace=0 + do ie=1,nei + do j=1,ns + i=nelm((ie-1)*ns+j) + if (i .ne. 0) then + iplace(i)=iplace(i)+1 + nopdum(i,iplace(i))=ie + endif + enddo + enddo + else if(iflg.eq.2) then +c just use element - node relationship + if(.not.allocated(iplace1)) allocate (iplace1(n0)) + iplace1 = 0 + ielem_used = 0 + do ii = 1, nin + i = ncord(ii) + iplace1(i) = 1 + do j = 1, iplace(i) + ie = nopdum(i,j) + ielem_used(ie) = ielem_used(ie) + 1 + enddo + enddo +c iplace is the element list connected to node i in the current zone +c iplace1 is list of nodes in current, (izone) zone +c look for elements that contain only nodes in current zone + if(.not.allocated(nei_list)) allocate(nei_list(nei)) + nei_list = 0 + ic = 0 + ib = 0 + id = 0 + do ie = 1, nei + if(ielem_used(ie).gt.0) then + if(ielem_used(ie).eq.ns) id = id +1 + ib = ib + 1 + do j= 1, ns + i=nelm((ie-1)*ns+j) + if(iplace1(i).eq.0.and.i_elem_cover.eq.0) go to 201 + enddo +c decide on elemnt coverage option (i_elem_cover) + ic = ic + 1 + nei_list(ic) = ie + go to 202 +201 continue + write(ierr,*) 'zone = ',izone,' elem no = ',ie,' node = ',i, + & ' mixed zones' +202 continue + endif + enddo + write(ierr,*) 'number of elements that contain at least one ' + & ,'node in zone ', izone, ' num elements ', ib + write(ierr,*) 'number of elements that contain only ' + & ,'nodes in zone ', izone, ' num elements ', id +c now add element information + write(izunit,*) 'elem' + write(izunit,*) ic, ns + if(.not.allocated(ncord_new)) allocate (ncord_new(n0)) +c check for expanded node + ncord_new(1:nin) = ncord(1:nin) + ic1 = nin + do j = 1, ic + ie = nei_list(j) + write(izunit,*) ie, (nelm((ie-1)*ns+k),k = 1,ns) + do k = 1,ns + i = nelm((ie-1)*ns+k) + if(iplace1(i).eq.0) then + ic1 = ic1 + 1 + iplace1(i) = -1 + ncord_new(ic1) = i + endif + enddo + enddo +c check consistency +c do j = 1, ic +c ie = nei_list(j) +c enddo +c correct for expanded node list + if (ic1.gt.nin) then + write(izunit,'(a13)') 'nnum expanded' + write(izunit,*) ic1-nin + write (izunit,*) (ncord_new(i),i = nin + 1, ic1) + write(izunit,*) ' ' + endif +c close file + if(.not.allocated(zonesavenames)) + & allocate(zonesavenames(maxsvzone)) + izone_sv_cnt = izone_sv_cnt + 1 + zonesavenames(izone_sv_cnt) = zonesavename + close(izunit) + else if(iflg.eq.-1) then +c deallocate memory +c gz 103018 check allocate status (some arrays may not have been allocated) + if(allocated(iplace)) deallocate(iplace) + if(allocated(iplace1)) deallocate(iplace1) + if(allocated(nopdum)) deallocate(nopdum) + if(allocated(ielem_used)) deallocate(ielem_used) + if(allocated(nei_list)) deallocate(nei_list) + if(allocated(ncord_new)) deallocate(ncord_new) + endif + return + end + subroutine check_save_zone(iflg,izone,zone_check) +c +c check for saved zones +c + use comai + use combi, only : izonesavenum, izone_save, maxsvzone + + implicit none + + integer iflg,izone,i + logical zone_check + if(iflg.eq.1) then + if(.not.allocated(izonesavenum)) + & allocate(izonesavenum(maxsvzone)) +c check for previous zone usage for a saved zone + do i = 1, num_sv_zones + if(izone.eq.izonesavenum(i)) then +c write error messages if a preveous saved zone exists + write(ierr,10) izone + if(iout.ne.0) write(iout,10) izone + if(iptty.ne.0) write(iptty,10) izone + stop + endif + enddo +c increment the number of saved zones if this is a sved zone + if(izone_save.ne.0) then + num_sv_zones = num_sv_zones + 1 + izonesavenum(num_sv_zones) = izone + endif + else + endif +10 format('saved zone',1x,i6,1x,'exists, cannot define again', + & ' stopping') + return + end + subroutine zone_saved_manage(iflg,izunit,idz,nin, + & n_elem,zone_saved) +c +c manage saved zone files +c + use comai + use combi + use avsio, only : ioconcentration + use comdi, only : nspeci + + implicit none + + integer iflg,i,izunit,idz,nin,n_elem,ns_sv,j,ie,k,k1,k2,k3,ij + integer izunit1,izunit2,izunit3, max_lines,var_count,n_n,n_e,il + integer n_n_c,n_e_c, var_node, var_count2, max_line_char,length + integer open_file + integer node_temp, n_xyz_node, n_zone, n_zone_max, nzone_cnt + integer n_zone_last, iop_conc + character*30 zonesavename, char_temp + character*200 file_flux, file_scalar + character*1100 line_temp1, line_temp2 + character*200 string_temp + logical ex,op,zone_saved + parameter (max_lines = 100000000, max_line_char = 1000) + real*8 dum_v1(20), dum_v2(20), dum_var, time_temp + real*8 time_temp_last + real*4 caz(2) + real*8 tajj,tyming + integer idum_v1(20) + save tajj +c gaz 080417 might want zone saved in general +c if(.not.sv_combine) return +c + if(iflg.eq.0) then + if(.not.sv_combine) return +c call timing function + if(iout.ne.0) then + write(iout,100) + endif + if(iptty.ne.0) then + write(iptty,100) + endif +100 format(1x,/,'>> Combining files for SoilVision application <<') + tajj = tyming(caz) + elseif(iflg.eq.3) then + if(.not.sv_combine) return +c write out cpu time for combing files + tajj = tyming(caz) - tajj + if(iout.ne.0) then + write(iout,101) tajj + endif + if(iptty.ne.0) then + write(iptty,101) tajj + endif +101 format(1x,'CPU time for combining SV files = ',1p,g12.4,' sec') + else if(iflg.eq.1) then +c open and read saved zone file if they exist + zonesavename(1:14) = 'zone00000.save' + write(zonesavename(5:9),'(i5)') idz+10000 + zonesavename(5:5) = '0' +c inquire here and if saved file exists then use it +c otehrwise revert to old form + zone_saved =.false. + inquire (file = zonesavename, exist = zone_saved) + if(zone_saved) then + izunit=open_file(zonesavename,'old') + read(izunit,*) + read(izunit,*) + if(.not.allocated(ncord)) allocate(ncord(neq)) + if(.not.allocated(ncord_inv)) allocate(ncord_inv(neq)) + read(izunit,*) nin, (ncord(i), i =1, nin) + ncord_inv = 0 + do i = 1, nin + ncord_inv(ncord(i)) = i + enddo + read(izunit,*) + read(izunit,*) n_elem, ns_sv + allocate(elem_temp(n_elem,ns_sv)) + do j = 1, n_elem + read(izunit,*) ie, (elem_temp(j,i), i = 1, ns_sv) + enddo + read(izunit,'(a13)',end = 402) char_temp + if(char_temp(1:13).eq.'nnum expanded') then + read(izunit,*) j + read(izunit,*) (ncord(i), i = nin+1, nin+j) + do i = nin+1, nin+j + ncord_inv(ncord(i)) = i + enddo + nin = nin +j + endif +402 close(izunit) + endif + else if(iflg.eq.2) then +c combine SV flux files with scalar files + if (sv_combine) then + izunit2 = open_file('soil_vision_beta.dat','unknown') + do i = 1, icflux + file_flux = contour_flux_files(i) + izunit = open_file(file_flux,'old') + do j = 1, max_line_char + if(file_flux(j:j+4).eq.'_vec_') then + file_scalar = file_flux + file_scalar(j:j+4) = '_sca_' + ex = .false. + inquire(file = file_scalar, exist = ex) + if(ex) then +c now we can combine files + izunit1 = open_file(file_scalar,'old') +c modify 2nd line variables + if(icnl.eq.0) then + line_temp2(1:37) = '"Liquid X Volume Flux (m3/[m2 s])"' + line_temp2(38:74) = '"Liquid Y Volume Flux (m3/[m2 s])"' + line_temp2(75:111) ='"Liquid Z Volume Flux (m3/[m2 s])"' + else + line_temp2(1:37) = '"Liquid X Volume Flux (m3/[m2 s])"' + line_temp2(38:74) = '"Liquid Y Volume Flux (m3/[m2 s])"' + line_temp2(75:111) =' ' + endif +c the first countour file contains header information + if(i.eq.1) then + read(izunit1,'(a)', end = 501) line_temp1 + write(izunit2,'(a)') line_temp1 + read(izunit1,'(a)', end = 501) line_temp1 + read(izunit,*) + read(izunit,*) + var_count = 0 + do k = 1, max_line_char + if(line_temp1(k:k).eq.'"') var_count = var_count+1 + if(line_temp1(k:k+5).eq.'"node"') var_node =var_count + if(line_temp1(k:k+3).eq.'" ') then + line_temp1(k+2:k+111) = line_temp2(1:111) + go to 500 + endif + enddo + 500 continue + var_node = var_node/2 + 1 + var_count = var_count/2 +c calculate number of flux variables + if(icnl.eq.0) then + var_count2 = var_node + 3 + else + var_count2 = var_node + 2 + endif + write(izunit2,'(a)') line_temp1 +c other files all set + else + + endif + do k = 1, max_lines + read(izunit1,'(a)', end = 501) line_temp1 + read(izunit,'(a)', end = 501) line_temp2 + if(line_temp1(1:4).eq.'ZONE') then +c find node and element numbers + do k1 = 1, max_line_char + if(line_temp1(k1:k1+2).eq.'N =') then + read(line_temp1(k1+3:k1+11),'(i9)') n_n + n_n_c = 1 + elseif(line_temp1(k1:k1+2).eq.'E =') then + read(line_temp1(k1+3:k1+11),'(i9)') n_e + n_e_c = 1 + go to 502 + endif + enddo +502 continue + write(izunit2,'(a)') line_temp1 + else + backspace izunit1 + backspace izunit + if(n_n_c.le.n_n) then + read(izunit1,*, end = 501) + & (dum_v1(k1), k1 = 1, var_count) + write(line_temp2,504) + & (dum_v1(k1), k1 = 1, var_count) + k2 = 14*(var_node-1)+1 + ij = dum_v1(var_node) + write(line_temp2(k2:k2+13),'(i14)') ij + read(izunit,*, end = 501) + & (dum_v2(k1), k1 = 1, var_count2) + k2 = var_count*14 + if(icnl.eq.0)then + k3 = (var_count+3)*14 + il = var_count2 -2 + else + k3 = (var_count+2)*14 + il = var_count2 -1 + endif + write(line_temp2(k2+1:k3),503) + & (dum_v2(k1),k1 =il, var_count2) + write(izunit2,'(a)') line_temp2(1:k3) +c write(izunit2,503) +c & (dum_v1(k1), k1 = 1, var_count), +c & (dum_v2(k1), k1 = 4, 5) + n_n_c = n_n_c + 1 +503 format(40(1x,1p,g13.6)) +504 format(40(1x,1p,g13.6)) + else +c read and print element information + read(izunit1,*, end = 501) + & (idum_v1(k1), k1 = 1, ns_in) + read(izunit,*, end = 501) + & (idum_v1(k1), k1 = 1, ns_in) + write(izunit2,'(50(1x,i10))') + & (idum_v1(k1), k1 = 1, ns_in) + n_e_c = n_e_c + 1 + endif + endif + enddo + endif + endif + enddo +501 continue + enddo +c + else +c no Soil Vision files + return + endif + else if(iflg.eq.4) then +c add transport output to SV file + if (sv_combine.and.ioconcentration.eq.1) then + if(icnl.eq.0) then + n_xyz_node = 4 + else + n_xyz_node = 3 + endif + izunit2 = open_file('soil_vision_beta.dat','unknown') + izunit3 = open_file('soil_vision_beta_conc.dat','unknown') + read(izunit2,'(a)') line_temp1 + write(izunit3,'(a)') line_temp1 + read(izunit2,'(a)') line_temp1 + line_temp2 = trim(line_temp1) +c adjust header in SV file + write(string_temp,'(a)') ' "Aqueous_Species_000"' + do i = 1, nspeci + write(string_temp(19:21),'(i3)') i+100 + string_temp(19:19) = '0' + line_temp2 = trim(line_temp2) // trim(string_temp) + enddo + write(izunit3,'(a)') line_temp2 +c i is time count (different conc files-outer loop) + i = 0 + n_zone_max = 0 +c nzone_cnt is zone count same conc file - inner loop) + nzone_cnt = 0 + time_temp_last = -1.0 + iop_conc = 0 +599 continue +c gaz use soil_vision_beta.dat(izunit2) as the template + read(izunit2,'(a)') line_temp1 + write(izunit3,'(a)') trim(line_temp1) + read(line_temp1,'(a4,i6,a21,f17.1,a10,i10,a5,i9)') + & string_temp(1:4), + & n_zone, string_temp(11:32),time_temp,string_temp (1:10), + & node_temp,string_temp(1:5), n_elem + if(time_temp.eq.time_temp_last) then + nzone_cnt = nzone_cnt + 1 + else + n_zone_max = max(nzone_cnt,n_zone_max) + time_temp_last = time_temp + nzone_cnt = 1 + i = i + 1 + iop_conc = 0 + endif +c gaz 070418 need zone number (first zone,second zone,..) + if(n_zone.ne.0) then + + file_scalar = contour_conc_files(i) + ex = .false. + inquire(file = file_scalar, exist = ex) + if(ex.and.iop_conc.eq.0) then +c now we can combine files + izunit1 = open_file(file_scalar,'old') + iop_conc = 1 + endif + if(i.eq.1.and.nzone_cnt.eq.1) then + read(izunit1,'(a)') line_temp1 + read(izunit1,'(a)') line_temp1 + endif + endif + read(izunit1,'(a)') line_temp1 + do j = 1, node_temp + read(izunit1,*,end = 601) (dum_var, k = 1, n_xyz_node), + & (dum_v1(k), k = 1, nspeci) + read(izunit2,'(a)') line_temp1 + length = len_trim(line_temp1) + write(line_temp1(length+2:length+202),*) + & (dum_v1(k), k = 1, nspeci) + write(izunit3,'(a)') trim(line_temp1) + enddo +c read element list from both files, write element list + do j = 1, n_elem + read(izunit1,'(a)') line_temp1 + read(izunit2,'(a)') line_temp1 + write(izunit3,'(a)') trim(line_temp1) + enddo +c icconc is the number of printout times (in use module comai) +c gaz 070718 +c if(i.eq.icconc.and.nzone_cnt.eq.n_zone_max) go to 602 +c if(i.eq.icconc*n_zone_max) go to 602 +c gaz debug 070818set i max = 15 + if(i.eq.icconc.and.nzone_cnt.eq.n_zone_max) go to 602 + go to 599 +c + +c + go to 602 +601 continue + if(iptty.ne.0) write(iptty,*) 'read error in ' + & ,'subroutine zone_saved_manage. stopping' + if(iout.ne.0) write(iout,*) 'read error in ' + & ,'subroutine zone_saved_manage. stopping' + stop +602 continue +c rename file + close(izunit3) + call rename('soil_vision_beta_conc.dat','soil_vision.dat') + continue +c + endif + else if(iflg.eq.-1) then +c delete saved zone files + do i = 1, izone_sv_cnt + zonesavename = zonesavenames(i) + ex = .false. + op = .false. + inquire (file = zonesavename, exist = ex) + if(ex) then + inquire (file = zonesavename, opened = op) + if(.not.op) izunit=open_file(zonesavename,'unknown') + close(izunit, status = 'delete') + endif + enddo + endif + return + end + + \ No newline at end of file From 8ba2924f2504f3c48190b1649f0e1358c0dd1504 Mon Sep 17 00:00:00 2001 From: Daniel Reece Livingston Date: Thu, 14 Mar 2019 16:16:05 -0600 Subject: [PATCH 02/19] minor makefile changes: dated.o excluded? --- src/Makefile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Makefile b/src/Makefile index dc39041d..96b3a002 100644 --- a/src/Makefile +++ b/src/Makefile @@ -154,5 +154,8 @@ inrestart.o : ${ALTDIR}inrestart.f insptr.o : ${ALTDIR}insptr.f ${FC} ${FFLAGS} $< -c -o ${SRCDIR}$@ +dated.o : ${SRCDIR}dated.f + ${FC} ${FFLAGS} $< -c -o ${SRCDIR}$@ + # Include `Makefile.depends` include ${DEPEND} \ No newline at end of file From c8764a92be3b80db2a6151e43a6c9f7569130de3 Mon Sep 17 00:00:00 2001 From: Daniel Reece Livingston Date: Thu, 14 Mar 2019 17:03:49 -0600 Subject: [PATCH 03/19] Modified makefile.fehm to include dated.f --- src/Makefile.fehm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Makefile.fehm b/src/Makefile.fehm index 5f491961..07b439b5 100755 --- a/src/Makefile.fehm +++ b/src/Makefile.fehm @@ -120,6 +120,9 @@ test: %.o : ${SRCDIR}%.f90 ${FC} ${DFLAG} ${FFLAGS} $< -c +dated.o : ${SRCDIR}dated.f + ${FC} ${FFLAGS} $< -c -o ${SRCDIR}$@ + clean : rm -f *.o *.mod From e557782988932edfe44d9e6bb3bfbbfb10f89e15 Mon Sep 17 00:00:00 2001 From: Daniel Reece Livingston Date: Fri, 15 Mar 2019 14:27:47 -0600 Subject: [PATCH 04/19] Fixed Makefile to work when dated.f is missing --- src/Makefile | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/Makefile b/src/Makefile index 96b3a002..1aa8dd47 100644 --- a/src/Makefile +++ b/src/Makefile @@ -40,6 +40,7 @@ DATE = $(shell date '+.%d%b%y') FFLAGS = -O2 -frecord-marker=4 DEBUGFLAGS = -g -O0 -frecord-marker=4 -fbounds-check -Wall + # Define the written OS tag ifeq (${OPSYS}, Linux) OSTAG = lbUbuntu16 @@ -53,6 +54,7 @@ else OSTAG = OPSYS endif + # Define special permissions for gfortran # Namely, accessing two Fortran files from an # alternate directory due to compatibility issues @@ -62,6 +64,7 @@ else ALTDIR = ${SRCDIR} endif + # Define the helpscreen that will show on `make help` define help #==================================================================================== @@ -93,9 +96,12 @@ MAKEFILE CONFIGURATION endef export help + # Define FORTRAN and FORTRAN90 objects OBJECTS := $(patsubst ${SRCDIR}%.f,${SRCDIR}%.o,$(wildcard ${SRCDIR}*.f)) OBJECTS_F90 := $(patsubst ${SRCDIR}%.f90,${SRCDIR}%.o,$(wildcard ${SRCDIR}*.f90)) +OBJECTS += ${SRCDIR}dated.o + # Define targets .PHONY: all @@ -131,7 +137,7 @@ test: .PHONY: dated dated: rm -f ${SRCDIR}dated.f - sed s/OS\ DATE/${OSTAG}\ ${DATETAG}/ ${SRCDIR}dated.template > ${SRCDIR}dated.f + sed s/OS\ DATE/${OSTAG}\ ${DATETAG}/ ${SRCDIR}dated.template > ${SRCDIR}dated.f xfehm: ${OBJECTS} ${OBJECTS_F90} ${FC} ${FFLAGS} ${OBJECTS} ${OBJECTS_F90} -o ${EXE} @@ -147,6 +153,10 @@ debug: dated ${OBJECTS} ${OBJECTS_F90} %.o : ${SRCDIR}%.f90 ${FC} ${FFLAGS} $< -c +dated.o : ${SRCDIR}dated.f + ${FC} ${FFLAGS} $< -c + + # Special handling of two files inrestart.o : ${ALTDIR}inrestart.f ${FC} ${FFLAGS} $< -c -o ${SRCDIR}$@ @@ -154,8 +164,6 @@ inrestart.o : ${ALTDIR}inrestart.f insptr.o : ${ALTDIR}insptr.f ${FC} ${FFLAGS} $< -c -o ${SRCDIR}$@ -dated.o : ${SRCDIR}dated.f - ${FC} ${FFLAGS} $< -c -o ${SRCDIR}$@ # Include `Makefile.depends` include ${DEPEND} \ No newline at end of file From 1b945a8f7a1de93b8cb4f118a7219bf469954d92 Mon Sep 17 00:00:00 2001 From: Daniel Reece Livingston Date: Thu, 4 Apr 2019 10:58:07 -0600 Subject: [PATCH 05/19] Moved documentation to gh-pages branch --- README.md | 3 +- docs/.nojekyll | 0 docs/fehmpytests/.DS_Store | Bin 6148 -> 0 bytes .../doctrees/creating_new_test_cases.doctree | Bin 33539 -> 0 bytes docs/fehmpytests/doctrees/environment.pickle | Bin 20421 -> 0 bytes docs/fehmpytests/doctrees/index.doctree | Bin 3788 -> 0 bytes .../fehmpytests/doctrees/installation.doctree | Bin 4554 -> 0 bytes .../fehmpytests/doctrees/introduction.doctree | Bin 4575 -> 0 bytes .../doctrees/test_case_desc.doctree | Bin 59349 -> 0 bytes .../fehmpytests/doctrees/testing_fehm.doctree | Bin 17834 -> 0 bytes docs/fehmpytests/html/.buildinfo | 4 - .../_sources/creating_new_test_cases.rst.txt | 132 - docs/fehmpytests/html/_sources/index.rst.txt | 21 - .../html/_sources/installation.rst.txt | 12 - .../html/_sources/introduction.rst.txt | 18 - .../html/_sources/test_case_desc.rst.txt | 25 - .../html/_sources/testing_fehm.rst.txt | 74 - docs/fehmpytests/html/_static/ajax-loader.gif | Bin 673 -> 0 bytes docs/fehmpytests/html/_static/basic.css | 676 - docs/fehmpytests/html/_static/classic.css | 261 - .../html/_static/comment-bright.png | Bin 756 -> 0 bytes .../html/_static/comment-close.png | Bin 829 -> 0 bytes docs/fehmpytests/html/_static/comment.png | Bin 641 -> 0 bytes docs/fehmpytests/html/_static/default.css | 1 - docs/fehmpytests/html/_static/doctools.js | 315 - .../html/_static/documentation_options.js | 296 - .../fehmpytests/html/_static/down-pressed.png | Bin 222 -> 0 bytes docs/fehmpytests/html/_static/down.png | Bin 202 -> 0 bytes docs/fehmpytests/html/_static/file.png | Bin 286 -> 0 bytes docs/fehmpytests/html/_static/jquery-3.1.0.js | 10074 --------------- docs/fehmpytests/html/_static/jquery-3.2.1.js | 10253 ---------------- docs/fehmpytests/html/_static/jquery.js | 4 - docs/fehmpytests/html/_static/minus.png | Bin 90 -> 0 bytes docs/fehmpytests/html/_static/plus.png | Bin 90 -> 0 bytes docs/fehmpytests/html/_static/pygments.css | 69 - docs/fehmpytests/html/_static/searchtools.js | 482 - docs/fehmpytests/html/_static/sidebar.js | 159 - .../html/_static/underscore-1.3.1.js | 999 -- docs/fehmpytests/html/_static/underscore.js | 31 - docs/fehmpytests/html/_static/up-pressed.png | Bin 214 -> 0 bytes docs/fehmpytests/html/_static/up.png | Bin 203 -> 0 bytes docs/fehmpytests/html/_static/websupport.js | 808 -- .../html/creating_new_test_cases.html | 281 - docs/fehmpytests/html/genindex.html | 213 - docs/fehmpytests/html/index.html | 113 - docs/fehmpytests/html/installation.html | 123 - docs/fehmpytests/html/introduction.html | 125 - docs/fehmpytests/html/objects.inv | 9 - docs/fehmpytests/html/search.html | 102 - docs/fehmpytests/html/searchindex.js | 1 - docs/fehmpytests/html/test_case_desc.html | 314 - docs/fehmpytests/html/testing_fehm.html | 194 - docs/index.html | 7 - 53 files changed, 2 insertions(+), 26197 deletions(-) delete mode 100644 docs/.nojekyll delete mode 100644 docs/fehmpytests/.DS_Store delete mode 100644 docs/fehmpytests/doctrees/creating_new_test_cases.doctree delete mode 100644 docs/fehmpytests/doctrees/environment.pickle delete mode 100644 docs/fehmpytests/doctrees/index.doctree delete mode 100644 docs/fehmpytests/doctrees/installation.doctree delete mode 100644 docs/fehmpytests/doctrees/introduction.doctree delete mode 100644 docs/fehmpytests/doctrees/test_case_desc.doctree delete mode 100644 docs/fehmpytests/doctrees/testing_fehm.doctree delete mode 100644 docs/fehmpytests/html/.buildinfo delete mode 100644 docs/fehmpytests/html/_sources/creating_new_test_cases.rst.txt delete mode 100644 docs/fehmpytests/html/_sources/index.rst.txt delete mode 100644 docs/fehmpytests/html/_sources/installation.rst.txt delete mode 100644 docs/fehmpytests/html/_sources/introduction.rst.txt delete mode 100644 docs/fehmpytests/html/_sources/test_case_desc.rst.txt delete mode 100644 docs/fehmpytests/html/_sources/testing_fehm.rst.txt delete mode 100644 docs/fehmpytests/html/_static/ajax-loader.gif delete mode 100644 docs/fehmpytests/html/_static/basic.css delete mode 100644 docs/fehmpytests/html/_static/classic.css delete mode 100644 docs/fehmpytests/html/_static/comment-bright.png delete mode 100644 docs/fehmpytests/html/_static/comment-close.png delete mode 100644 docs/fehmpytests/html/_static/comment.png delete mode 100644 docs/fehmpytests/html/_static/default.css delete mode 100644 docs/fehmpytests/html/_static/doctools.js delete mode 100644 docs/fehmpytests/html/_static/documentation_options.js delete mode 100644 docs/fehmpytests/html/_static/down-pressed.png delete mode 100644 docs/fehmpytests/html/_static/down.png delete mode 100644 docs/fehmpytests/html/_static/file.png delete mode 100644 docs/fehmpytests/html/_static/jquery-3.1.0.js delete mode 100644 docs/fehmpytests/html/_static/jquery-3.2.1.js delete mode 100644 docs/fehmpytests/html/_static/jquery.js delete mode 100644 docs/fehmpytests/html/_static/minus.png delete mode 100644 docs/fehmpytests/html/_static/plus.png delete mode 100644 docs/fehmpytests/html/_static/pygments.css delete mode 100644 docs/fehmpytests/html/_static/searchtools.js delete mode 100644 docs/fehmpytests/html/_static/sidebar.js delete mode 100644 docs/fehmpytests/html/_static/underscore-1.3.1.js delete mode 100644 docs/fehmpytests/html/_static/underscore.js delete mode 100644 docs/fehmpytests/html/_static/up-pressed.png delete mode 100644 docs/fehmpytests/html/_static/up.png delete mode 100644 docs/fehmpytests/html/_static/websupport.js delete mode 100644 docs/fehmpytests/html/creating_new_test_cases.html delete mode 100644 docs/fehmpytests/html/genindex.html delete mode 100644 docs/fehmpytests/html/index.html delete mode 100644 docs/fehmpytests/html/installation.html delete mode 100644 docs/fehmpytests/html/introduction.html delete mode 100644 docs/fehmpytests/html/objects.inv delete mode 100644 docs/fehmpytests/html/search.html delete mode 100644 docs/fehmpytests/html/searchindex.js delete mode 100644 docs/fehmpytests/html/test_case_desc.html delete mode 100644 docs/fehmpytests/html/testing_fehm.html delete mode 100644 docs/index.html diff --git a/README.md b/README.md index 05707b34..17e9b4b4 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,8 @@ The numerical background of the FEHM computer code can be traced to the early 1970s when it was used to simulate geothermal and hot dry rock reservoirs. The primary use over a number of years was to assist in the understanding of flow fields and mass transport in the saturated and unsaturated zones below the potential Yucca Mountain repository. Today FEHM is used to simulate groundwater and contaminant flow and transport in deep and shallow, fractured and un-fractured porous media throughout the US DOE complex. FEHM has proved to be a valuable asset on a variety of projects of national interest including Environmental Remediation of the Nevada Test Site, the LANL Groundwater Protection Program, geologic CO2 sequestration, Enhanced Geothermal Energy (EGS) programs, Oil and Gas production, Nuclear Waste Isolation, and Arctic Permafrost. Subsurface physics has ranged from single fluid/single phase fluid flow when simulating basin scale groundwater aquifers to complex multifluid/ multi-phase fluid flow that includes phase change with boiling and condensing in applications such as unsaturated zone surrounding nuclear waste storage facility or leakage of CO2/brine through faults or wellbores. The numerical method used in FEHM is the control volume method (CV) for fluid flow and heat transfer equations which allows FEHM to exactly enforce energy/mass conservation; while an option is available to use the finite element (FE) method for displacement equations to obtain more accurate stress calculations. In addition to these standard methods, an option to use FE for flow is available, as well as a simple Finite Difference scheme. -[FEHM Home at fehm.lanl.gov](https://fehm.lanl.gov) • [Fehmpytests](http://lanl.github.io/FEHM/fehmpytests/html/index.html) + +#### [FEHM Homepage](https://fehm.lanl.gov) • [FEHM Documentation](http://lanl.github.io/FEHM/) • [Fehmpytests Documentation](http://lanl.github.io/FEHM/fehmpytests/html/index.html) ## License ## diff --git a/docs/.nojekyll b/docs/.nojekyll deleted file mode 100644 index e69de29b..00000000 diff --git a/docs/fehmpytests/.DS_Store b/docs/fehmpytests/.DS_Store deleted file mode 100644 index 7f5cb87138f65a1c3145bd088bdf0f854eb3d269..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6148 zcmeHK-A)rh6g~q*wngmnQvu_}#>RvME+7yIF@#z$+7Lsv1dD)Ww;jrc?M}11r9!Rg zD|n|DJ^1TLFi!^K*X3m-$(BzpDIBtg2)C!PL}e($yX5xz?*`F)h{~+s^H= zdM+@7nx8hkP2S3y!Jeh`HO8D%-L%$iS}*9sOUw;S+ohfewo4RUww~K=iPh7r=9YXh zPEK}cT2zY`^pQqmdTxHwn4f7*8jZQRsYzpY=3cWI)kf}4FJyKqhewUq%{T8vra*9C z6B1Y0hWDtP@?aMaRDR@RJHM~G-p()@>$~26Bd!k&4h;+sBoc|6BZ<+mTVn-%$TExj zWsm>YCFU?M?bPUI*|STzs#&z%az3E1f}DLs3;N)1uFq)c<(X;iu!=szX9h9cBac#7 zjJLYG>(d~APTwf#alhy>$H_9^4s7ObZ28D~CZLs!yUTFK17vx%%Den^>iLKrG5HPC z^Gvr)(}&xRX;Ej@O|u|imAqYKuKee5F)TK-9_2$O7r#pulc|-qGA$OM@s3uKWzCK<9qvg9dw zA;Y`ckMeeV3W;PB@$^w1 zwj_$J11oU_K#ZVS24taB!+d!K*+#F2D)Wa=jZ=JT*H^#|1SoGt&o9`fh)xTi7e-q)0mPv zTRW2DXRU!{2MZVO*ODkguu{jdQ20?iibV+a8C*e3DQrnZ3rhGQAZQ4ykb!^7z%QT| Boccg(kF= zwiF5-l+u<`x+qE~Y)^xnPiv)||4@4fG~JxBAE z(OR`oa(l~_yyYhNI&PJ#31^S4>zzG4XRpq5TRAswRi`E_*O~1(b2>8z&YCrARIFUp zN>y$AZ@JZ;(VT0g#ww+}CC=Qz%)S9gp}Z+owkGR9t}|~ia~P5XR=H}SQcmF?>10W# zvnvILb|vr3_bJufYGu4|HHqcwq@1?F%)y{EX4&HtQ$%-r`Me%ay&*Lxu|1OnR4$(n z#SQ2$7_6oDc55SUwNQl_D&=h68gre6p0g;ucp@jRl^wTSH@6A8FCKQ5bjI!FPPtWU zJOD~KOJTLWJ!cuLCb>zsQj<~3Nv3C|=YksS>a@oxAU?NAauasK*$2qWJ!jueJDI8M zIcpY^U8m(ISRH2-QS=0x5 zJGSJckQ*skZbx6LRB)>sKz>z9e|md+hZ7yu0eo?q&fhV%@@YTEad2@)sd=5BJm$G z>(R&Wf?X4d4jFgjB6mz!G8&CcCvt&rxz2u`vwvrLe!e!r((gJ445#OfmU6C(=L3h+ z^G9-{n}ucNpyBjhg}m#m7*5YIpa&1v>?Sv7c4iAGD+%WixOvKRR>IBGvurRrw9`Id z*gkOBK4{opF>JTQAE}i}Ry9j93Fk0SINWoN2q_%73lzo*Rw3+1i7sGs~g*m6g+qm^=1>)~Sn zeXQpkHxqQiIUZ0ac+QCd6f4(AweF&@p>|6+Cjstc&*}5wY`&l3Ij08id#305mDbwK zI4aHEaqDbD4ZqsZU9AlV>WnN}g=|H(o164Exvb=KwJLC)Fsyj(3kyHqG!PXEB3@MOPbbI!5xHfk42c@$sg++pXu zrdl1XLCH!u=fgM`c+LQfqYc_Rwt1}X2GO9cC&zVYtz73qyWKv;UTdFbpPrthxXwkC zd9Xod^=pV?LjW6WFOIha>#eQu?V%Z2U2?VFxUpqc_IyVd4s{$tHI)# zFjA_FZq7QjN)-+;3}as9Iawg1rqWCvL>@1Q0680}YOaN8ewNsdXHY#il`e=2hW{ArHfb_@}R;z7&S4ev3KSa(sR*a z7%7Z8MO47{Rdlk=oi?l6lIM)mBMyQ`s28{Hx%E0_YEx;}rrpky+=Tj<<2gcmmcgZD z{NC0acbgIW2j&s6irn5Q^BVGMi|0%Rv>nZ%94y`zHXqJbI5}0C@|>%w(mr(Z=B{0D zf|^{@ERe6swW^8dIZq;y_GySX*FnXpsEXT~DfSP{r;67@#cAn08LBJJJVgrD*k_TVAgcd;D(sOL{PT8wBSmh|_%_uzUSpI{HA}9P)ru$K zya@KV%X3~#ZkIvS4Po;)oJisCTJxLTP$*B-s(xHOo=@2g>|scy6vJR28I}KV-Dc@U z4cwi(S+HJ$0nXO(QlC4K!vN==^nBDy7*}kuoR@}`m8qcUYfA##z6`c~j0ARGjx4y> zb6x?XXi2%N?mPE+&MRrFf528}mP!~Cz$~e;0!A8W(X2eiA!y>HhA}8Sio>4NSgovG zrW}-?qE9g;G;?ZG1w>p7xDt%_>1hG!O_76dT%Sh>tyIFa26#1l!pPJ~5R4sHrQqn* zicGCa<;wX~rB;R9T_A!HA6w|n<;o;vuB1jRa1=o=uPzyRCH(C4OG&SDe?4DKmHnz# zWnteSzg~^}`k&EW1J8P`=e!OsWZ&OVTJNj-*aM#PdivN(RvqX#S=Cf+0yR-XkIB!6 zKIg%BKD?n-J{%O}!yAzgyGHm;koC=;^A^hbV1uj=7+KlZc*t|!3IHu8L0x_Wi}l+& z?S}q_9riQqf{k89|G>e4NN+bii+6a=I|H@PWubsKvPk&Va(84}pu5+37u0^pZ#=e= z;k#R?9d?}FqiytiJ?DMYhPdyDHpTC6feZQ26n~%-_TrpR3yGW$!a^VNoDWm#X<)$V zy|w0U+xUc?a|>?5`3P+IQP24pNh|`J1}&-9$D2h1Ns9IfNVWhd5xY2_ghZe6oKJ(C zX30m9Q|J=Rw|s`qXVB*v%IpEOUVwhqb3RAT`ffzEOy06z^m)(u0#gS8?YHB(FgH#O zYp~P0QK8iAf)(!Be!=X~Wc6Xx?#XZUIh zVFnJN#lJ>pSlYrG&evhgZ+Ol(DPb!BDEwtup1J)k&-pgNG`FJ`V{U(^nKv-W`@4Q_ zM=+d+!S#Ed^L>!h-2Rs4wr%ow9^~{h#`ysNf9N?sBHu`SM5-Tq&QGS5>Zj96^|KaI z{T$4G;W@tyr227Gsuh%KCf9I&1@vEg&TlBqPN9tk5ug37=lqVC=YY@o+N`D;+;UaQ z^lNoUYHAi2qgl)dJgG4{SeH>YiD2Tc*0#Ei+WFsp1L`B6bYj4?KArCN+VI2&ZDPW|4$f26tL~Y?lNl|0)EY^eDE;I&ZDOJ=n&(!25Y6FMSCC<{spaR!^tE@vD%yl*bPx=)g zsL2%o*+s^_N1mf#=lWnx*>#>K#JL*^6ySWM$Fl1JM1lVR0#7bfe3M;d70s@dQLmiV z!WRJxYZ~a-+7o6?`et-F+(7?m0F& zE%2vcP*YFo?rzm{_3`3k8Y!r3aog2BuZVQ@yv?dg>2ak>k@k&x{!hvYy+DOrNeo^|aPoG2g77oAyP*sq)+J+o8uOS`I z%is4|JbldVd}6aq5WLQo8ypZyQt-(yQpL*yx06$Tmbmf$I@?@?@o86d=Qx0vr;|R5;`*hS*b;*bRo54hd$$ z3iB;e@NZNKPxC4CgKyAR@JDY!XSUvs`E#n#Ioh#`XcMdxw3w~!mF=JyZ#;G=m$=#L zMffJ-u<>|09z1!5f+vfHRFRTKi_p!Q+(d1lgO2n}O>FEx+=4h{z_So|@@xf&_aDgE z?>{_8!ETL!MFvgJ)#y0y_9F4g{x*iuantRH0Pp7^@Z=8sqBiCnLy>GW^ZjXt6Pfdm z(&l#>CeK$UFEC6pyFn1*8G}Up<%LT8MLzKhBK{JL)mlhzk_s-il9_4r7SrRsiA3CA z?ouvsE7$$y#Yk6wxm$&Li7(W7|3;x;0%{!fyL*&PlT_G?fQ)~sCN}!r%MgdWe>nnA z?p1)e-%$bI?_Qx`_xWH=qu^I+LY#YhkrXJv{R|ENU?BV|M1lXS5qR<%{06>9R#D$O zskQIzQtruX4VTv`mj?`&%5W;8_u&`+xGhFruRI>h?q#; zh?sN|8zt(?uVx#gya_2>e3duj!Cs*2udDotba{&s!V;`JgeOnls_$lQI#}4|Ds1W^ z-4iKqBaQYV#q%A8%dqlxMT^Meuf&FY-a!O2E#8XkJCTh1dlv#v-mS!vMdcOQWm2Sw z$V`}sHRyX3_`L>L_pM;%0|wAqnp4gGKFdCNA7C1V=1Q!*Us0Qd?hTCd0pgi0G1HO$ zAV47ahY)!3VI`O>D!-`U6x9fh1rYg&0)Ny1YYiDOCs#t`W16;;#gH|Dm>*YYOux$~ zl=3GH<;;HY^@}I0vOnwzHmOcbapdzU0Kq1d#m`7CiO8oFx5*~Ks)&4s@U;GC@!-kl z6g*k`36!T&^Hly@+~D}nl!T3YNg&G zLyV3_zOBIDF~Av(4JD5>GT&9OhkdY<5k@ASbgyHog9Xp+Se2R-tiWS6&lKoXH=R3s zD#x{vg%tl4D@2^9i>{#%T(_t7rq1K`Dh!q}%CWZQ#wSW#D>MC??%bAqrCca?>q2u- zcKQ;D6#k4rDoya1+veK-6 zYyWd4^b4Pm4mRjMfdjLI{!$a;niwin=2u8Z3FV|g1XX^GXh`}S1fKj>X_(?kmeE!} zI#~LhLHfNS{lOr`21^m)|EOSp^19qF|ai2t1jq_{KD36*UcAsG*XQc?Na9qP7`SUE*p03l(4|3%i&k zq3{cQ`0XIOOZ8k>0X?$%ZD(~`NEQ!`rJb9eWTA?AkKJmE({U^$ivR$VKAzN&#gGYk zx&(nIOH~7tr!+nC)O2{+b=g}%mKl%?3v*a&aqSlshTm{t5d?GjiNwZ@Y#Zud+H`hA z*10>nHf~HLc5#n^8H%Q+Dm8zlHy<{N+SH_Hw=vpR;PZOG)y3JU zH1bw8hwq#810!sR+GLfvlg_BasY73<85`z^?xcx{$Dp8f_w82myfcSngL|0its@J# znVoa!w7zz+o0VzVq?1ZKr+fuEy6Sy}X&UmRIz+r4sW;^9n$CuNA9bMRz5{U^z>E$g z`vMZhjD8nwRQFQ?O$-N4V-ee*z(cynU}oY601$qEAOcSgQj*D{&yj+v>uW!Hg@PPx zKr$;K_D&sJ4gquv(NjvKS@bg~`bs2Dv#~QFhawRsJPd&+hbx(6QMsVvIYQs#WZR3B zoRp7bXp9oi=Y|p~9RP$;IuUr%h2LP1PQF^fr|0>*J*C@3`9r;<6lIk`$$Sq+`v0J4 zx5(ihwLm;8`UlQpKJ;p$>1`PE$ZABv;%g9ia<@A{j^Bd%L#~v7$+j|%5$3UF8J2`#mFx=TO=sb#fb~G6w?bdNQj?~yL7sqg7(Y5L z*nlY5_=yNS8CHB#dytv2aUR`8)M92yxDUWrDR9;R>m*EHC~MIB->5J-ALc>G`pA0! zJL^8}e%C49oW{CMW}Fb|!00$(L=|d1PB@qTJqiGr>c3NA$wPW%u!R6?{;I3-24*L` zp+2J6q#(8d$vhWf*k{A~KEEbTbzjEM4!c*S@cB7DQRKuKc8}x>dMH3QI=V;-W|Ywe zl`50`43RxyzvGR*ntr$lAa?&d`Qu_FVrJ@kbWX0Lt6?w_O=`J2All#On52mF2RJbX zu6Z+1NHovjK>&)TTlDJV12fP-r=9Vn+oR$J!v=b=Ms#v4vPvQJ41~yxo2IAM!a|W* zzssm}XQcOD7{j;#!h?Q5#X5teY!Ux4`7EQNtYH^ceYq>sCs7 zT*9s+kxdpKp^j%KDpDa{1GjJ-Z&z?u1We@@G-Ey*JMVv`(`d)~yrm9uT6uzM8J61^ z-)Y7?1$EhY9a$gq6g8b=p3Qjjq@?f3%!R1J{+%w48k1!xIyxFxR!yP}T*8W_tcgRJ zy<5p4JW~P%cLD+SX((v2H7NK}F~3_Xis1SPY#97f%jTr2(Q$bUK1He_9d#Xd>Z;Gm z7DPabNd(wpq1dMSAe(4cbU9F3*9$UbXk4u{t}!$+)5ABabFE@|J{ASjdWOn8Nh7CM z<~pQ9nZ1C6GA7&b3RSL0fXx<)Yg8eNs4DxbD)3?T?N~h~PcdYks$_03WHK|NgbJ}G z#aGI5qvAfz;9@}wx@^~%W?j^wkTE-uuH)aE6!+-{SEreGxlWa5kVt!x?4wS4vl5H* z?jN{}9`Q^h2K~re@a)O66g*i}Y7qU|Ez#SHl#~>n!*D2b1gzS!nu=Hcaw`y!QEY)c zxedQTCz1S32PW(!;?o;@Bh1RueY+w&&md%O2ESm``?zRBVEK6UaEHp;Z22_pcBdvb zj8C7BC|KqN2t0YArpLyow1Hm{yhx$$@}YG5VS}l4i}H&#IW9qak#s1;-3*6xZnyzi zUV;ROat{JeUW(r!lgKt&n${y9T8&Xz(+6u?kEYp{ml+9Ot`gj9B*;8g+>m+3v_a4P z70UKLpKXht`ztkRdduFAbXYdpbAJ`0VAEG4z^)9%H#HQQ8OINM?p&;%uDc?yHH2QL zgdQ-2ba{I^j8MIxv;TTUeb7f8#du+7ogXdRGj@EY@AR~+7pCp-ObkZ89F+< z-^rPtZL1EB8J$FG2pyfgL35z>=p@4e`bGf2jsBNIkER>?h;vBZ1aqT^z8QfhZ_&&# zMU({wMO24VEJSRO9#W{c8Yta$cWJGREd!gP=WnGZ3s@k)x8e94ceGT)sbK6h2dn>P zAw}K>8YrWYeJ{Er=j}>5UdQwgSix48cMxxAw^+XuB%txT5MZm3GQ?IR(v9xep{jxU zx*_X53jbaM-@GB~eVP!FT;7iuoD)<(Jgz5KKNUkhfK=U-^+7z?ZMrGT4z&D`662<< z597&`kLbI93{agQc7&|wm~I_LUh+}WX)jVtzb~X4vp%M%5xM-0Ss|~F6Tv_BXByI< z00=DhNd%sJN(m;5$}eg$imDbY_sG#RQ=4b;Dce^p6dd=WR7)9 z4Pl^97tMj3IaEQW^h@!C*+&ydkuxWH;M^z70N{XwO?ng|xl|@G0)+6vNk$k?yEs6u zFgBI)2aGOGVn9v+4BKlk&V(A{9IUU0=hyq&o2{wIisTIxj!UR)Di^NCN2DWD^^tdH z7bmJBxv1shvuelYTr372^Em|=$}B`H8a1?h9tp_1FCg&biwc!&f@<)5=A7T-`jTRO z*~hBy-0)4te*RZ9F)mqqkyKcnf0bcm=Y~O*uOS*@eI0=(-@tFs+agQt8TfmJr`Rp{ zPdSKu(}?*k74zFh%*=mOr0KHiJ1XLLeGyw`)x(-NeO7%B=`FJA`-nzX{Qv>>NhuA} zLXc%Nt8QXeJ#I>o{K&}tW0m_SM()hxOU4$N84Rg^s$&1lh^>1>O`U)f!0e4Ict6*q zcy87wiGG1}8%Gt&FO|}-B9utmUr<^QIoVKt&3KUh4Pn!BO_KZ;Z#sj1REx89DlFr_ zBRr4AlHcRWlRxOYIoGP;R87p1@hC0%BLK+gPYM{+%Zbt2>);RCf*@umwuNlSM^u zFOpeQ-FccEr`A6(LCei2aHy^d6{s4D)dm=-n?T^n0;Lu*qXbRrE>y@x2GXd@ee>a= zroOt10YG(^C}3Q`y1GjVM|JncgD1-rJXuuq_9B@@)lF)0oLc{YLv`B;9I9Iv%GX(Q zVIROi-Q@^8*;lEB%qT&Vy89{Q{svM{dgIxv=7d(wTysvV8~_OFd!RzbC9Lav5aFor z3Osmnu!1Lxir!u%x2V2{XmXrd|A0{66oH3ymJZ%*q>ALPo*yeK0R)8)Mc~O{N-pF^ z5t#0iX&)=m^_CFjviix(4z}51?R)UId=3R(i>z&yM0nErAL+_`qO| z!XItmGbQk7?9Vl?!uZ`nb~icbsXO8-9Et3oE^JQIVh=G_O|ZX9$nNf7B?MoLQjNY= z-N0j1lx9=Zf^Oik3SicmA2V6yIB&%ZC%Z7%M*;4-q;6#<;Bwq^l zf1|dfr=F~7ajUf#Nryhv$8aday}dyu$SH_}il-v*WG#M!{wdkPL+sP*8~?ex*W{U; zX3$Pov@;Bv?zb`NEz}6+r_NNAvwW1<7%v^hflI1s)Dj&kpkrLMQ{k|}cpt_c3C?Y4 zVF(n8?xPQeHZCT&uJLpsER5RFQTN%7VE}CCn8Z<`(qRtji@=5c3^0Wo*xC$ayj%%& zh{X}v7OTUoy~WqI14;3@L&&A8aVT^*b90@VsPzQW)}S1m4IpIc|IEnK^xZD$hdtoV z=OFOpT(zL-!_)1w!lNIa%pW~S*nDJmo&rV+j+~E}^vd8cV;x}kRLb>f4c%H($;$AWkTd|G z=jBS~3PVQcjv#zy3+j#CIpI3GIq8v|hc8@1#2IgMR7|;&Zzx(%PyvI}e*F`E=fQ)d zV7bGxfyp?90j(Q$XFU;bx?HFAj2YIaI-@cLd!qeCkuE!to;6sNVIa~Wf=|leb0?_d z6@95@<0^WBTcsOT4Y>AE*ZmnXH(7+C+ik)PB_ndO~@udA&YGUo)n0Jp+E;X1?tzg zgm-c~$f{KRVuiKWc&Os+6aKT#P=wHMhQ*DV$!10)14^pXieVXNL?V}->+jDi<2}Bk zSgZ+r8ebU2bsh<+03bZ*!~ZBxCJ>2|&AzJ~19Gybo$<;*gKX3`C z^Xm-ex4pLL+is!S&Zi*PFb$TwR&iT4Re|%1M_6-=LP%bogh<%vIs~3kqg4;3 zYhCrIC`Oa(0R&B+taP4Y=;)_9VVP~xq%B03rvia$+@Odvt8pV?jT#|sc^V?2#&!gr z>`*FkH7ME)YJ^3FBe;az1Ze2p4HmN&uDI!_js&TDY;Uog2u}At`hUmV)qlqTB;T?v&9f2p$ z!*9?VB^#J8EWM#1a)+iAeR1wo%;y_SUHlFqT~tDp>jj!Pvs^C(4CLbMVgtUs2ni7I zE(D&uSSgwQ1sSV=MI#U@de-&FnhL+6^zhgwwl#MHg#x`q$uu?TVad5i(>b1gDV{ue znZ748X-GF@rr_CqraQ7DkuxVN*H;G2$$hy3?oi<8uxH|O5vlfzU_^$6U7Qz{7}HO8 zI6NbfUU@kb{}tA>~RHQ7|v>+tIy<7&x1D7=3*#;`n)j^vH5fLMQ!sv@{onkj9~M4##tQhNnVe@ zlLyrf$)cJm>Lhdu<0LFuZ&2Vj8sN-vFv^)VT#Y4eU+SWqY))O6D{rzA>4`kAljuub zP{Su;$E-Q}I4)_`0pv{}&>}P5taO_*W4|CX-a@>gN6+^m;6vrNBJkvG$}L$`VWKKi zNmaR_7mCBsd1H@G9ljk9tdicLB$@;ctE6`lZWX7GP>H{b!14Z(Axd9L$h!dm8@~sE zC+{UR`WXqS^FNHuK3Ko!$Xe>4QD4y)Y+1mJ$@H!*;SeX8CJehTXPvFUuPwG2qL(os@ zOI*-)ThGD!G!nH=`ivre)*xn9!x+>y)rks5?;m3gr7=xs;+s!|ddcc@tyvW*74`T$ z)05%_>dGWG=s_wc43-gawBeuHGd{#Ids z*9vweV0Y@n@_R$)4@&2chK_z3x^vV&0lHzJV8lduwy#jNb@3{N_ac}3OjY$~A}xov zX(EjI7xFCnCE%}k@#Jre@++u%1J9iKyQXM4F#Z#DeS0}G=N|xprC7Puapj+gg}MHP zz>`@hT0tI>qY7J$d;1=M0?M8Uu%1>&v6t6feYPgf2@@gWT)yng)d4e$TSR0Yo*t>M z8$IU(v*^2V8=i6WG=AyEq)B5f(D!CHrqHz1LWZV>P+1n?9SSc-fE6|T1~wvjW1|_o zcB!K6T}Pvx8eDc6(m+3{fbB6rb^-R$l;tKRa|Ud*yLUj!z95E{ZF$(TnSS(s$|G(X zUg2c!ER+3-H}vn3;Q-Kr-UlMU2inRRA83<7v}-`+VPx2h+uT!&Sj1gABCM*N-6l zQ07Ze9zE-DK|xpUVg`74+r7gHuJG{+&N@KjC7c0JeYsny)Gy);0P1TTby8?F{L4NA zsK~OaxsY?36-Hdji4;IbuCoMPT+As)LPL022Lewz)fUO3Z!LO2-M6|Fq}za)9@A0! z61SaiW|(gk(zVmnqqw~WSHDZxr5iV8H3_sA$vT#8Ym`=;HLp?v-=hg{4i60$p!cg8aoP7Hv#%C%z8LUdhuut7f+S(A)#J&ECYxiOk@2MGZVUoBo}JT zvRtiN8LL#Pn2fNpEwCCD4+4Jmm_Wa@n?7FlS zxnI{#;J*b$o~Kx&MneF#Ps#C=)AWL>CD;1yz7b3}nFn-tAv;(Xj^#j8(UDd06Ss2;;m z4U>lXgkCc3CZve;ifqO&7A^>zUKZFh%S(fyys}mbs*i zG~`_gGaEJByp5}HF&$PxWO`4lEE9ZagMCIVy@S}n`*vK`ZB0-kb0xDYqBItxNhwT# zz__l$imS1Us+G}*C{+@i!+FmssquNCj4>T|f7hfWTNrhaU9C>IeXCbjD;3<8Ua+cT zy%pKC+OCe5R?8$o+BgFPw;rF6t#}^<8O@}u)`&8NI9x-UbjRWNdcCNd#Z{v@OqCTw1w+>)zEob)1JF>@iaJc)4jMT6;s;1U(d!jKg` z1;f1JMD;w@3*|a;SW2t8K(rwr?`4o}jGmLXMrxbndQwU+wZ=zqIjLKnf_S!t<0_tv z_#NpL<_5ay=s$&oct$+C@K5E-BHrPP`$@A~SuW)U#39$00URHUFJWGig#V1^=mWP((C3&_+ zFU1)i6}TI^NtTpzC0CxK@ylpEoK&w@3j0>MRcS6Tl`ZDR%A4i63cQ$J8z}*|Y3!0% zj>+waPS2@T$9hhZ=kYn=lcKNRVJPX*+hHclodj!BlpZX*%JccY1U(CvceV4TY8vqc zira>o$Xrn?FC^Hk^omg%lWDl?U5xReB`dlt%E9K^guDn)I2fgx8_7-<@;DXbE<_B> zPcLrtWO*^E%}K962Xf!d=XpVc^Afz-r={D>VOY$$dk`~-)l_;}-KH}=% zybN*Md8W%my}-X5ap_c0;3p?1aSSPDT+3SE@d?6eK)b8uUV@>;z~%K@vvy&VUBdrW zc?F|qmoR@N_wn(dMq_3hOXMp7Qq+>Nm^F5`ZoT`7yk{XVuj0dE6pg4Cyc&_X?bXx* zR>{)p4F;^*SzV8XhrR|NC{up+XjyUPwTK)}FV})oD08_5)eLf)8JU;YA$2<@(sGkw z)B}iOd!n`s+kn@Tc5NiRPrTJL&H95x!rYW6Z@^P08u3%K$u=Jw-DKZrn)H+Hgf8N0 z%dQ_>)Y8k~?x_E&db&W?w9sz^5l`NPUvx*$VMpi9N){bGGxg{9GI1}ib}?(|wxGpv b39U<=g@i diff --git a/docs/fehmpytests/doctrees/environment.pickle b/docs/fehmpytests/doctrees/environment.pickle deleted file mode 100644 index 1a84a7ef4f7dae08dd593d0fdae199cbe21fcdfe..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 20421 zcmb_k2Y4LC^>>qGpJZ9?1`Ii28)QHd5HN&<7-M4$vPH2ML^+Pt-AZ%kyW5+$d$t5w z0!eU5@4fe42_Zcp3F!gSdm#zwmDE2e|KEGFbGJI_Ec1QwXYG_%=grKUH?y;M>%3f0 zRfWpLfLGa9Aiq-fDq-rvTA`G`C{dy3ZoEy;i}d_Hrz2k)E0nxIFR+xguuw{E^Y>Ru zzMJ39u#|2CetV=lMxFU?wW=2mJB!I9&&_Au(tdX`(2H`}>?p*9g-SM?3cN6-Q<>YZ z)SXUySO}SaSELvBjkL{~GpA6=dlR}lm-lllD;TKwc?c1_lwJZ+J&|78=PV+3f8f_B z=jmn694F<5Ar(ezA($($qfSJS7n?wQ@c9j%rE2vy(Z%< z9CdSh$r}swF`1gPFsEP<@+$h+j6SYekv-l7)L%QY5xQROm2!UBONV}XyQj*RPww%8 zFnHkBmjr26pUvxr1;5g(kH7skeL|!k)u)z?oZOP~#t9A+QcS$U2SxvOAHr;ZmA>!^?JpY+7RiJAkmqlV3L#j)XI!nl~JoRYE4F=r3&rq zQ)`9#l1hSlBeXpw(x2(vktjomL= z3`BacuEpsyYH9bg&BjKG5-3A)Eb%SMHoh*h? zPHz&G&WZH7b(J17qe|yNrB$G>YmwdtdMZ@8Lj(O-X!N*9pU)Z{0qyZn=$wW^rk_Ic z^R*oF(VIn`3nIOxuFi!ssD`AF~X!@RBdm6AK^m4Zm`!K^L&dE){cr?WcQZ;Q^H1J1&6uVP?VsjIl6J@8!0 zDSfrN8pWE^;g1%*To~w)$XS#tn8_DJPP-LwO`mFJYaLt3&$%TpmEA*bB`~w-a`Go8 zQ~KJzW}K3H(_}V`5xtbY4w{H#)z>>6P|_o}q%%&}F7$KBOJ5=`?S}9+omJPV>s3bG za8TcPVDzApcBpInOtsTyFkN7d#+dFwonuUCVgs{tx3oNcxjXLZJn+33KYvh<0Ux&5 z=TX2zYCwXuM1DxlvFreTPveiP>(jwKR-F< zvqvu~za(kQ%cUe}sPj%}q9VL_VI`O z>Qkm@6Tf)%x zsGO~0Ea{t@=y-jfaZ2R;Qpqpmvk0l+JjDM$p^3Jo%|`uNMMq88t;Yy7+?T`Tzom&H z-AcE7ArKR@$9Q5BQA;sYfR`Y|P`4f}#i&bucAr<$w@syhzk;WSvkdf;te+`jMR>CK z9a}Y@0(hvWGgE!7qp z5A-vJoz5iNXAUEZ_Hz=mJqyeVn2h0NbXiqDd$=~rE>*3DlU-1DLlx=g)Y~SjW-cVp z%NIyLcjOxM+@KS{sSlP4`>+lNp_O8eh_smA<)lr+6!f@C4qjvHJ?QK9O1L-PNkr?6>^AtUjPffP)YdyqETn@c*!5l zhL+8X4d5ltig@+mXanOgUy#xMQZ})l!vq+w)XJl1i+)+8U+yeo3uYxectxaNiRH?# z04Ix(G^_>sRYP;tc%)z5=PZl&FNvf1jAPd}{W@SSZ-TPf_3Hs> zW{m(vzXA00NF!h^Ie@qj0(cR~os8PQe;FV2abdJJ=d&|(=8rncP?&`OW zT=Bo{>Ufv*HmBW~RlnVKu_>pvinUYv9q8J3M*3ZSPLDT{E7kH|wu)_)M~HXdozd@c zx~r4pyr~J$Gm|AxzgNB1S*pTvNqMDemKO~f=I?X5w>Lrpj4^$OlVY?iyfU^f@5hYr z#$5PyeW#Nuy8%S-@YEl0+Dv?Rm$TStoegSZ7|!~GId-0i?Kt>OT}FBAFY{(Vekh|q zoY5cYa~2G6FMM>^bFsDjn6otWCJL1?zdrB-{qcB}l!x>Ue}HyiP0A?=T) z5pQv1I^ZncRS0;6bt|5aq5Y{)f7(U-S#oHOr~Q!@JVeNH#ePb>z0Zh*1$7o2YLOmrKVnlCy_jH#jaUQ_iY zr`rV9qyB`c`LY)@0?MyA^UoMKUEk|0D!Ubo5cV4PW%T`GS@uG)%Tae{^jAmLw>I9? zhJ4K(nj7k`yG{x_Y_GzxYoNc8(ci33P1Fy#wb19G@-5d{3?IT?0wE)2vHo_Xzte|J zu{(;9`Q4F)kh_QT=?&05FhfUwZzP5K-KNBlc5tYXr@uea0l@ac_yE_YayWG8AH|+v zul|9M>@1kg&xWAZSSA9VA4>l)qkrV2u<@PCgz<4^U!4mk^C zeE+)+=HYC;$A5+u1D2U)`sJ#d3$rEkXrTXlNI**jgaJmbC`xnY&Y6>;xp*2luM8MrqR&e-6ohTJ!PF-=cDi}>6bqRyTmcireXIo4(i~P%UP`c880JmTDGVvb!_4>u?v!}a)2SkqJ5DAdycti#)40}}V3jpNlgxhR%vL(s|ug$fnrQ6c07#wZrhqk&Z)A01fcJp^QQ7HZYKw#7ZB z!!X|B6_(BhJfcl30S#W-7*_DRdl8}2IRFi{F|fzD`NViR7qARH#t^IbsXG`g6_x_* z@u)C1N#_An*J+7eA+w`ce8xR`EEBTXMtZQqjC+VRCoo=d631~KJ&uWGU5-I?J`=!q z3Le&Uvx~4j{&+y0c>`(MjErq@X8?B+>Y9(EBD#P%#t`*!^$Ahe3`u?uL0bSH;q7i> zwM!$|nR=Wb_mFzGdXJT|41=T0ogoKOV(|$dm9$fWx$H) zay;3jT{0x%Ei7Gu+KVsXcoP3C3lmFlRDdH@xFh%jx{}GQ+9slq4UdT^b_1HBJ$Q;4 zSL0a1II^Zy#}T}%@U*N>5KrJuz+o2Tol+^wHD_n{!vjF>)xb3?-3r0P;bXOi(4&GV z7A}iM0C(DI;aLB2?Xvdd4rdy>lkNbK7bs| zT#phAwy-|@GF)L5U(*;8qd1~~Z?-nQ0cg(LGt8Q>*Ym2`{Vw5<71JgQ&|%A=yHW_N zg~lRxBY+ulSqQ|gU>izEk!`&Gqfx=h;c2;;2x-jSC#zAOsZAd=^phn8M>{#p&wxCj z92VtFsF9O^c?`AnP@@MYs=Vvvr9FW4JQ}xr752r#zuQKQW}{8YVmQlK0Skyw?<}ZQ5IzM731(nQlN!5C z3Ym%Mm{@mgAJnXb)eY@ZS9{T8m&5u|AedngAf_cjKKF z!acLoqDdfR=q5&so$RmGZ$v>8n@9udn{~Pwh(>>2k>s$Ug7XG1bPFX+)EYej2-2ge z3B;a|6NZx%G1UyF-#f|?0o?+y36|Q#)6x@B;aG*@O^op?HkQ8?7!louC+n(ysD30m zFA?_?uaS5)OiuzveQI@Kkjb7yq&^v-`n+8gFZ7MgiHUZf0;CMx&ZwAuOW7;Pdv!kI zLqHMI0f3w~siT9)+g7FYgVu404Kw`sNbsJiPGYbr$s8y1)fAI&qGG~%B&~m*d>eLnAel% zGZvd#{aHO^O=*^Ud)7uTUN6m?LNe-xVW_UMx~X ziDOK^W7A#oa7dqxPfd6Yc?qy&XTLP4RWXopI8pc5FBL&AO9<-8d;6xG3DU~}6+K7z zm5p6^65HR9+l(jJYXHTS2;Ld=Frj(zU>rHU7Qp)Cj1O_xV3^(cNqQZiGD_Dp;^f$0*=^YC zfs&y&u#9;(^wJxVak+aE9xlWxjy0Oz1emd@!~(c3Q@_JPZx%Lh!P9o$@e*Q=Ve42y zEXyx)v1(Lu*zd^d^H!iXMsPBSjCZU7y$vW4y&X?npRp@;K<_|BhTe&%Gq32`N^g%|0apTiviQzwlx}ywb zSJ)V|?D5-(EKZs*?LN#hQZC|DTuZ=d8+`;7aU0bK)yHgeyKLl&oux+~WmPPw9gI29 z{}@wtHpuN+Ya=%MIDpO~iOu@4ve73J$Sab@s~_Ba5*QKPji;FJIAb3kqb4WsOL1CW zD_7`Kz%u<{T_c~u(Wg=ET(82g8k{#cn9Em+cuQ9DYiw5X1`rMox;X5@i>A?FFs2+l zbKsnTGX{5o{!({hpcrg6LCyJlypjGbyLR{Q+O;#gW6!RgJ|Rb+vHGpDHjdpz0Wk={ zH1`0ZKGFEB9K=%P$w}?4kOT0y(`vFb{FLL9@ zI?@^+5q_2V$KiXt;S6v@grldgHPPa&O~D=y*&yQUz=`M^j2Xv1zfivvZOzIeFD?sX z1$5sxr?Hc@hqohqL;{EE(YJtudFfN(CIkm=iN4K5?7A^um&Zrcl zHQx$hS;mp8IeFS&$OGrQjAIpa68%M9nY|+W_wTWcMEuu?*S-&ky2mOZ;SrzdS_}LD z;D~<6NW3^K6Ah+DT0at$ALD7c9M>2#^H$DZ=-6;Vc-w%+ z;!XjE(oX@;(9c+q>5azwtj5^>Il#_ByCl$qDDntTm<8)FR*G>xMEC_Gw|SL*oWK7P zd9lz^p50kbV>OB2qtLIIixt`_@Hj~NH6Zl?Y6b<4NlpI*^cz6y3s9FRX}n-SzfFSb zM}Vf+e+Ssmd@C;wvrXt_`{nmQiRce_a=+AyXL0Ucrw#X&a4h;ql<+1UH^&fn^E+hv z6KbZsFN_^E4iv)_{h6W3`>3Y+AynUfCH)0SpX!e2ugIwN5&ezR{)qn0>86PO!Rh9R z{>kZ%i2e_0%~`^)wP7YWcH@yAMs-C0!V}!^{(3$B`iI)oCZwD3w_~Wi<}3vT)*YM? zf?Qt2)4!Q5zg?&QAm^mU_}#vo^3i_{h~^-&N!*pCxhRV>C?xK1(mbv`!sSew&j{0R zNYa7^yT)xoYO}R`z{Qh%4DW-e9km{G?LdmRKt5g;$bDW~hzh*Mz!S|^J!-w$p!(H- z+N91=o7Dws2kr+tSU~yY89@yD@Dz}X+&L-*j-5%dlwCF4VD0k*TK}o_?sAi=@Idl#rVsS7P-wv+zKvoV@+`-ay6$X?lgFJ zd08IND%3}`n(?|bv<7Kk+%XAD9)s%X-F2+3onqhPxb{e$xRw!S=)~huk9W2UW7YC> z0xBBTeH2Ov;c#|LX=Een#S=Z%eA#)lhL`Tvq^QL)*87`b!pw1Y*B3YZjf6PtU;?1K;0RBw^hWZ7qP`Uvls(J(1yKA7w)GL=xGaH>Jz+&9vk3}h>$KhFT@lAb2gqqs*s1HI&81wqyO+#!2-TraX9W-^NB)$+su=P(79NT+zDCYaPOxhUKTR6 zjU@~h*$Et=i|`yS^3*>-+a=Ev{s3Jpd7j$`Xouu^J|Cb<@bsK^t4l}Dm7Ac$PFJj@ zZ2U8HDe(G4hA=NO*CMkkieJDN0Jw0*=XErM%ArmSIWs;w6BC|x0#+OKV4_9!IZL~w z5|{sr2CUZGQ8EljM3>=NA0?Mdp?Q>Gd|v@TF`oTb3f=A`-JTigdW$TAr-y^I7|-mh zkdNqUp@^LaZ~dp=WbZAqBqqNGX)&I^*CHR$bwUx7U(bcv=I{C$=PxV65;B}l|FD8? zKs}~t7D+@m;>lAKA5;`s4e5eneO?yLBxF-hGkU)@x+|PU4JS+?jNzOVW-xjl0Bdwl z=*E(C<1^Cr7Fh(hNip17y?{bQMInjJwpR+xa(jy`is?&8t<}rOM^q7tnB3>WY*z1| z(dw)WOQ>>s#1BbG0|gyGNFoaGXpE`%NuhO<_cPp@d_w3a zlk_*Wpl4Cspqr6ei$4MRh$5kgO?HbEri*7uO#Vcq*5bD!k0WBCh{>PCg(((ayH393 z@%pjp>E}SCpTFbjAM^PnX!;s9b8oPsEd9xxt{vf9^72^^K9f>jdJl8uk9yMEg)2P; zXy}pKkwkO=PxQ!aMCdPW&&>VRm@wAz2Zi?`!`t-SVJS>EowfW^0k@Wanvg#|N&bu$ z2__(OQ|6WXZ4LH1;wL zj%l|swCS}#fu&!EB%;^j$(EMy)@CMvwYd#PYwb4(-!~e*#@cU^LThWk8E|Xuw+Q)L zljLt}LC%u6&2L9)t^E$)=A!yqnXt zav679l6Ts#q}f-=XFz=$?Pz}w(9s9)MH12b@Z>(=o4iLsjQ-$O&ek6Yjp8VXbGzyk zJ0+(!*_GoClp}gSp3uSc*PT*m?k}|R0{~dRb(he6FiH2J8R>e9EP{>nVWhU7KZ1Nj z9~FvN?8l_gEVj4El9>GCNNqoV0{MtODHJjJ-CUT`&ok_7HqE$3vob8q1n155twea=Krj4`kdip%>Q{QG}{5{eE|S#{x1sMmy&c} zo{_G%$RfCPUqNcke=qV8-6s^W{qC1Sv)JAuOJee`BDLoK8uAf+T_|GmZ*XBY^KYKf z{HzR1_$H?|Fijjvd<*q3`nQop^c_6e==g%P$Z9+Sqwlar|E_TQp5bJS{(UJlw;oFU z003+B9}3-%l5{_wk*>GMBDhUIVYs#W11LoFQz41X_A@Co%k3?)D5n28Qfu`Gk&oyX zLJ^byk_)q0eaDPeXJuHzuQ)YU=lBN;P@2Ebph<=MFTOA+I7Fms%t#0l6 zJE8f#p)vOTgA`h~^N$R-cK(yl|2awjPz!n%#jW@YQfubFB9F6Cp@{ADcPUI4&ytw@ zA4sj4|A{<~PK6>Sf0zqX%)DkDyLDcz3zh!(2$#PH_NK4cGn=24WXb>H)U4Rn{DlfW z=avi6>0SJ`;@?0)Py7c-ME}JTJs~T03j*{Jw_)Z!njV49!F{QS=HdyyrnlxvVY<1j zwdVtFt-V0V+mht%Ey!6Cx48qUwe~{faTqHUvGf!drdWGb(%NnwH^3i}tyx8u+sWzL zk(F3z6QdmJ0HV^DRw?KX=l8i@k)FV`VrZh)nwVna=KPNUrN|| zo8@WjeH@Tr@3lxGIv!89H-GWek_0yAmK?3kPY}+JGMtUg(^6<{^IpKM%}*5abxHE| zEy!6Cw|fIpYx9$kkLYBfh;81-g()^)nY1}RbM+sQxmiONyOGni@~$CayWL=CEPV># zu=J@&B03FEwlu$)m7BU2{}>>^%;zDA=&^WO2Qni%?9AHFX6GY^^7uO0Tz?GcaV(b4Tk!>geb;xssPcGG zr8}e6XH&m3H7!HHUI2Q{dXE>B`*v4MGbQP z8jwF_pOrEa%I#Ar`G*WnvnS;=cczN0~YCX-M5a(`AnPY^zrH29nf zK8dgFXJzn2VQ^`K!8&H(d$SVWB!oi^!jqU#ev@KWS}n9Y8?@YE{QDHMQj$>aYEZJ- z>pucAD|t!Cha2Q9n13i@R?7WCd0B(CWOP~4GtT?L4MO>R?>Y!dPRej zXP5n1gjuO?73wP+)B~WN`s)(2^0--e>~8R24VVZ2{==-)w+Qu~ChGVXMrNfBgxYCP zv*B>cTL@+)ofOim8l>#g;-6-jmDm^Jt3m9k%^9@=ud^27ezUnI!QUoCbPaP>-4}29 z=7X0lz3<8IRO?Ol{x1=d=&W}q0?2xhZTI!jqgP{ zX?x*s|Ni|0=9dQsd>S7_5IP9NU=ZK;1Hb-?IKc0?*;}Hx;f;OQ!}wtUTv)-aHU9h` zSL(g+uzb|2<~dz7mTSmbYh}sp?ty|Aj)^S31vTiblJE3zT?M!1a5V{+X81~Y9<5*| z2?c8SVGrC)lI!KTZhF1+Kn72zM_zT}-VD&?sw&+ez$|xZ#i=4a% z<&%o+Te;Tyq-ue|R}6vj6}9 diff --git a/docs/fehmpytests/doctrees/index.doctree b/docs/fehmpytests/doctrees/index.doctree deleted file mode 100644 index f75147f59efcb69110e085885879b91d6c4b3c90..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 3788 zcmds4d4Jqi6?L3=nThQ+|tFTfxE{VdH}&OP_sdylRT`+@Q^6GnPA zR)Nq}``8h&snV7c*JwDWtuw3=^NujRL}=QU)5!esp`oEA5&5bk9HX3;ke#Gwgf{xP zb_NG<6RP+KjW#sfsk5dwp}{>W_5#t;G?vpin@V`9h1U^U^EM8zxKw3RewL;H;Axem zzM$<5RtG-MOMg&f?SJjCO<8F7&Bi&WR6 za1pm?qvCoJ@m@PsSsc_Y)0SXeYlYqV#e433pm#&_&ZgSXK{jT1 z+h&q(Vq+!obTg}RW6}@-K_`cDI*bf-JJAK5aA@QyY&=N?KrIS-D%)x`;J9qO$^C`Y zs_h6Kf-JG8YP!Y6xe?bI|KIAek^bAGZpOAnVJzs_+z3{eWk9#dVF^tf-zy%DJrhgNmNBGr`f^sVR=9vlt^E>g6a|} zJ2fM3apkS9JmN~nrPFen%cCxxk)u45$L7XlN%iedDnGQ2NL1-8t~r;}GjL7Of-YZg zLF)JWqyR73D%yK)3bq3 z-XRY(HVOE0M;^fleR4tZs5IX%y!fBuco zR|X`$0O;2pbPu3i%;|*|+T9zV-E~7~wx`%?uF}0gc3)2SV`m|S0g>Z_B{XNzyr@J& z53n6&GpQ{hwnU`V;Qf^M8SZm}l6tYP?9+*qXtap_BPdgtXk+ot2pY>%U4RF9z~}>2TVhBibq^}#Y|&9K1#okD~sV z@|NjJ|FxZqXp^4pi^P|y*_hvtLy9?I-^XIfvuiw`+m7TfQ_z^7!iu$*n3&opu}m$& zM$6dRt8Ai-*3K18(xq@ly3&(e`ceos-r?OqBu3J!=C)X6Z$}?1k}a~Pu-RnWP0C~4 zQfUWST4=DzwV_&c%_yf18^^!>4jJd9*tG6-nkw=JD>Wr95!<<8Bp16=mo(e6X}MSY zWL(Nv#Scxvm8M0PmaK5u#9;Opjkt?ZzlQL-OX#`uY6~k-DaIgt ztB4orON}zFM2jpy9G!^1Z0YMJ3epIn=rrb$rmvvVEGO{kMIS69{^}~*-ZyBT)ir$$ zFs-oG3G?f?ViWQ74K|XQR_#1}lU2*@R)ycf?l4}TBKkI~6f0{QBz%YM@PbhDCa5fV z`EG+%P}}f!@RIaBw5-Fv#MJZwyiX&7u)V^AJQuQrzQ2k>;!STU4AA&~Fo$o9jY^{* zvJrOaBEbEKjSW6Aek>2NN?XJN-x#3&CjeT=;W|M-MNt$b;Pq>Oezw9UY~t5y?B~oG z)Y#I}(k$$*RB=&bfmp0#sjky6Z2N@u?s_t8%LsplehJs9;x_$?9ok6FrkeP*e4I_$ z&gNYwYJiGcpN!nWgE2X)nd{*!I71wCtx^3RQ|$@Xq;^~EO*{bg=QIywDSPRp8x z%GQ4g_UFpqa{9Zx3H=`<{fWXx^ha{}%>gF~&uHy=WzcCg{lleyvQaAwSp9$H^zW=W F`(ID&b_oCg diff --git a/docs/fehmpytests/doctrees/installation.doctree b/docs/fehmpytests/doctrees/installation.doctree deleted file mode 100644 index fa040deb6ec0ce4827e91f89837fc3e4921b5bf1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4554 zcmd5=2a_B}6+WGGVOOWqDF;jT2qAoub-OmmU<4R2wy-#~0<1PNW|*6u>D?Y~W_sRq z&jrkY1sLwg8IyC4Cg+@^$vLOL!Pm31tJB`u*i=#FDyiyrxBK)q#v@xS`k< zl{J+PG=j<4@p((pNKT_{JaJRSoro*twh^IXQdu!icCrCB47@-_yTl+HF2CP>wh790rg*CAVK5iOZKY*gPeOOGoysis z>n$##DTt@0TERm7#C6x7D!xh=Ap}P_coI3c#J36c^j#5?ffdIADu|b|!GDD9@_(A9aQ=z<%}B@h`va99@yq z197;xOzdumLyaQHE^#<(x>>V75RYMHSc>~j7%0Si5YQjX=}H7(11rF8?psL@Hn1Nu z2?Jy;uLr%2te-P1p4CJhaw1A9fas6fT<8V&W7F8Z3Z4a%&^?hW%=+`iW*2x zpm|iKM*!E=IX%*-dMBKAx~bhDwzS}uagvqtM5;i`bg^cg;8AHR3r4kq*b6hC`__D* z#hN>+XQU3mz%DknWEjeMc-!)16uGgF;96R)rFj|!u^S$*R%d1eehy{KEunRy zj@RpM>BiilvVbSOW=wIEX-y=YeHT17vgFZ|H?k7e4zD?_KsK)7>9&f7A zP`tLNL1EHzDyN1?%ausW|Ku1teO@zB2=#=ugc>nIJ+Z&+Lljl&hE;kJpxltt8H4b& zQJbv}vP+yYL2iWFR{-t3b~im4GMvrnCLB`SDK|g{+59o%a}p`L^qylO4~g<~;)cV$*at+;8jqGJ5v~eUm0HMZJ11enZUvmx=`zj>R`Wny z!{h0oF@b&kS*BUw4ReYRxG+|`W2{l!|HaW1!&CLM7WV!(Ly$zQBquT;@5zP^X=7Sb z&S_4nyK`pd?wv)tKZV(9>W8Ms4D~r-Ds(=l1ws$F^M1s}{R&v+4P4d*5=W_~`{UEwPFh=%N)=v~1H0O_#vNx=nG> zm%Ru*a1Y`6_W8v&y~MyuWQtpkUfN)zfnWB=FGGL4X(bj#FSqFxY*Y8J4uDtY^eQ$H z#D0*X8+OoIx4BmIYMWleMitlEw72xy70=#QDr3!Kzj~t^W*8Fab&_t+>GhLrYgY=# zw4DGxtLP1Yu??YR>SGSTz2)=R3(%du5h9~cXlED%91r6Ly@?H?QGYY5fT_n#2ztvB zMh2c3s2q*Bhkb8tuyKX{H^HXJ3@3`-hEQ61D^7ho8^SN?BE5r+r7iOdrj9HP>78s} zw^h+nV$cb=Zq;Pkt_vN7b$S=8__%5@VnhkOyMf(>xK7CDcu4O-d%R6WX8g!7i6|$O zo*M$xdu@6j8v{WMJ#lAjc|WEY;fA{0`hn>owyDHj_U9jLh@%a*kEf|j9gvegw01fl z1#a~aDg6+eFhVG75r7gx82T_9@_93B(?=R?f=5ksv`Q}mhTvS&N0-@tndv0ccNOzv z=wu};=F?}`7QPT*)PvzO=vT=4S!grt$+#7?>2qaz z;l;V2XmjcFh>R}NoppHR2BG8nnCOZL=L<`0KbSyWo}#H$^c7T^(F6l*F|?G7zq-secIGrp5AiI04KR(dRv7c^ zIHFH@`UV@ybZhD=`X;NE+l>pqh225CGDY-lRw-6aDTweLw%PFmY7+tJq{9qBw+c+U?Swt?nsq5jSWr zyxUjOet4JrD>aM*Y=n&iFObneG0Mj4?+;zL zmy2W`$*{=Gdx~yy*+dZgO5yLDT{hYAgQeWi@3?H6Vd}U`C&aAJ#;W&k zap@Ui+%MSnI7&I4TpWe5I_mUHF)F~@v*xxEhsegfL35z(R7uaC69=pe&JD}pR&h}5 z6NkiMafFT819Vyd?);p%$rU%d!g0lMSKQ(j0=J6#uIAROF7Q>zuXU~c+a9|@&nfA4 zTrO@EhuY#~+Zs72P8A)$=xjBFNcz3p&qRZs3*2W)dY-|(ZFFR00pY4+<3!5wos_RQ zCRC0pBF&wy%pDWNrgKg!rzic`yr!kYQ@;~)`^*XXGLK~jQ8dgGUqx}hGGeR+$S227 zL&p!pb@R$v=Bp7>CG9!5rCaDC$Av{|mFdTk?l&73q?2&29WA)x_I`ER83tV-+~%qC zKwk@)Iwy)W(#C-kPJ+AyM0>T<<0;SmxM6)m77H2Tn6I6{Pn{0Oe{syi3Y8y-b)a~l zc+A-PViYlZGKlD+GClHER#?DIwI;>7==ik`mw4E{g*)c|79M$6ztzy(#s6{_iSSS?(4RNPAr2Zj|vPH4Z07J zSt#k{ILt;is9-yW-lF?WNjP^MUaJ0shWQE`;>D6)X+pdYA-;5}j>Y_Z9gRzu=sa#% zs5)dtcKbR;7k8N!{Hm?p42{87a(V!eA1vwB#^3V>*=w#fa!@Q9BNq^@S%BFJg%~({ zsHE2p+*11KXZ*Swrp|SpN|ES?n9Vk{cp7Cs)qbEWC91yC zJVEn=&d}{p(PiGGM>Z&~2zdRq*iSC*9;nR){{Q^aH^5o1q)UddM>YxMVe2M0&YRh9 z2VkbkbT6Kh-)1}42T(gubxI1@B>t=hsjwu@W>r7w$k-dasi^BxkL}(xzS`5mrHJj@ z^15dqz0sv5HWftLPKSzOml8t(n;y)`c2r9-7Ox}Rn5d;onSqtb910<7v&kr|N9G(O z^Uh%`ij+&5?HpWI0VqmZX0uTmMmg$^hiSXVwW1Z5R@tQD+6*g-`a@G;H%G8}8a5vC z;{tmFy-CuWOM1&3+cTiTGm|KQFDWVkV=qk0Jj7~{;T%tc2m|X|K{C33ufT5LnTd%W zWuutgFS99l8gOHRu3W_y!7~FDBS?zwPj73p8Hg&%a40eRilVo}l$OEJt?yuCc#`+& zF*cod%@ZslMIO^T*-@c&rp~rnT1xCb5!cn2it6xCmn7=-UkeU zxsg7!#*WECXNCS(Hb0E*1_TD0o&Y37JuMP%)o7nSf@tjuizM^b)u!m9pciXGly+tP z+Q;zP%!;3<1~6=KKcSDe*?tqMZWLRpJ=6f;)to-TCh=hY_zV z%`>{DF9N0!){rp2ge$fXPhVzZh3?MZMPFf!`nXZyS8+N@heJePV^j9cc?A-_&USfW zq)eZO$}KP7XtOEgc7_Y1Rr)4M*0Dff%L$P96^(Gh)Cv#sTq-j9)*2GY?|3Uws0Dp{ z5&QUNrO|iT7`w0laNlJUgLV9S;xL=4HU~rf_W{((VS}I_ASrALRDD#@53jOm6ZrKU z`w?>nIkvL0(yTg=%`wd4Exf8)^kY*#(KA*(5%oljf0}-Ry;P<>`YAiQnVc;-@iXxR zn=zHm+aToUY%~h#7eFhqOkrWI zU{xHYSo`gd8rAL>(r>S_9r)1znPp-V((g=>wFIq~%HOw(4%@%A*jGPe{9$oK953mQ zVpi-^(An_sCRJzoQ%QdoN6-P#-2Y-5B-UoE^Y!l$Sg^57V~u80gIcTTuP*(KjT>QL N<^Ow0|0p`me*$Okil6`h diff --git a/docs/fehmpytests/doctrees/test_case_desc.doctree b/docs/fehmpytests/doctrees/test_case_desc.doctree deleted file mode 100644 index a9f5ee6fabd40e55ce00999ef3b9d2daca093b7e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 59349 zcmeHw34k0$*>(uzn%vilX2J;sGj%cq^WGD=32Eef-b+RA1B6GrI~VeBbwHVQQx8t+$?f ztE%g%vo9Lkm#_5IYlTv^yIjdz)s*}kw92)Vv)i1Dow2U7dq;LsIX7t4hKH=Gvxn=9 z>o5-iQ4BjX z+9WhMR8!8(9p<5}R1DTjwL(v|QmWT1XI7iEYPMCVI(zOg_iLppU$LCMc9`i_;niFT z^}$kuJwqrjXYU>6QLRM#Dy34Tknia)lxiv`)x_DSO)h&Y^|G^XyFx+ITl%17za6I0 zD$#tQN;^nu`?pc13Vn7?<*UvCZG?Jrs?xK?Dmk-v)Uz|I_1l-8_KDw)iY>StGNL*sDn2-hs4`pb+}ry27Q^7W1uA->N=IR-MCL=ZKE%#C&~7T5Huga#MC($pV~JW3#�R5;Tz0%xZf=3W=4Gpvs?IAFwiL<()mo)IZ>W?T9#AlRex9`WE<7u$ zUHye^^G-eG^wsq89thFz-9y7mMG!#C14gCaNPKXFmA@-Hp|6yyR*{8nWI<5RH)W^3MiJ8vlyzDxX!UqWp0L{IybIev39Ak z(JoXCdEOal6;-2LsTs-|u*w!{vz0ecfePhr;5k%FLbzJNW7QV3)a+c%NR=%s4;2-o z*D_#ML@JaKgdg=bl}NtI>=m`VgEo$lAm{yHLub<~eIOIqN#&l@D#dWTl)J!6fTlX9G;a4soM& zh|8rzToLUMH`*C{xqXU#s(o5^9HTl}L3~yNV%Ab1v5~%wRL_nly3yK(p4)7f(m9u2 z?40X5F9slcqkYO6d-WQs%h>Ddy}5dCQ-vv%^VYVM^Acoalk1%4mo3n)5wHw)dIaqG z9nzA}o^-=Pqn&_CrV3VdlauQ}T|iYYSxzrI0k3oJm}7J#JrN9P8kPJUJCz-?rsnkJ z>ORo5o9ex`)X2Q+STQtvNGUq~0%o8iJE2_B=b=`G5W z#VMNOA)r%tHlxg;kpU%pa|DAk*wJJu5$&lKQ1_&{rkpZBR$OOD%6=A<1~e(iJ4!uo zpJLXYW!s1va8!?5pBXtQ!D)@K9VOPQN>MsBJB2=Bu#&H%*y{1hrmP`VFBkg28&l2} zbF!C1uMcpxqM~hco#EbSjc{HnDkt{WOC`3@?dFUG!(_*?3vga$PK<0-7tOyO-^hug*Nb_I4>6qyaK)Lw!zZU>QD~7 z?IqcXL&`#jxW#fVjn$nfn#*jnF%jo-m|=(OT%l`fw7p%F+};R9L%$NxuX3GN3iJtp z?iE`E_@qGExmr-as>8m-ZU^wy02oo_TmyKoah+?M;a$}R9(r8Zwq_~m7E{i3!1-F& zd7V}gnspY@H3&Pe7npAt0cO3|LL-;X>3Y|BqpucCB~n^mALiU33g49QoYc=XJSN}V z^l%nP11dLUr<@y+$W5;E7P0XH*toM(9?|S}*XQzuT*){cgBl}O&Ks*iON@;wSFZM3 z%2=l=y(Md~v(vd51#%0@@ux}PU?`qbQv2T*z=iR7E-LTldXD{bA)VTM!&U^h*y%qHg_{VDm&ih#HY$=x8 zUFZE$EKeYj<&{BX5WGtGP=r;1$bb*Cc)-6fDjWuNDv4ahsFXmvA_A$Hgpe-iG&Ywj zTS2tQyZS0hfzEUrr&d%DnHuLBm2zoV(ocZ~Vo<}Uys;%$sv|k5sucz;V*xb^t+4W1 zNkgJ@ja;c@Bq{(9FPifKU7>80tIfi^qqz`PuiD)&%nza<{?FOyL#Re~y3U8CqJE%( z$K0+TTrrZ`R~gjv8XrN;y32L$mYTIEYSywkh=!^zMe|mhjWcuQ0V^~=1|vG2^HFIG zA8Ya4S~bxxi;tr$T4;4X0mz?poqPP6f0wT60_a}X`IG=U9DuSzc^NS*HO{D)QK9B% z78$+65p)Lrg$Qi|yRQ|nNj|Vo1K4P_JD&m4&$`a%e5CghDW1vlSQaLDzw12U2Wlp0 zlLCIe4F&u{huv#-AcOuuc|`6vo80e<3Eb~N*Lf(GK3U(FI&Aw2y9LR!8@S!WcFBG? z+IN4s!xqN&i0gbsib6^;U~C~|SpGpg>+1;JsUu_`f%8>76v)xOMvnG%dv?yQ+s*vz z8z{qXy3V&6`Pa8ae7iX_DRXus-?AHt)^|E=p;C{!&UeK;aVqr)I%k1K^7OqH)iLOj zzmMA3puzb8;Qr8cexyq^%99?|%|yu1W3KaKNnB{5Zx9rSpEfDbPew}nr${@h!1)=H z{<-V?qB-fubkf3ae(5^D(gI<6WFCxwIj8D%*S79j^2y*-@2pveE~ zI)C$v;~5k*;6=#C-(BY)V()9AeFXBM3CGq#%_ch$+M&H7#3B_C3xNuH0!UL1gGYA&(Cx_|J2242S)u@vyDQE zpvLSrW(-XA{LGBn4d^btSdE3_s@?G^CI8QcPW|t?C8DoXdr)kg7HienM$97}q#950 z#Iez;30@zmCO`;QYSDkIi3kSFNpM`1qC%NW%oGJth;K5(r|59bJx6+UFv#W}Jq~s% z<0gaknTDDMA%HbdKS$E9rb8CUXTWjQOlsH21uKzDvA^7 z`qgYILGP~)#5Y$R#NTOiFXSTR0RF;M#~hTopu*#Hr_YoJMpXw30?h@~Aq0HXCS{1{ z#6(7*4n-Jh!C`P*mBwcSHBg6pQMWfvRs{*Rr3dN=#3n;fM^gV${N2P8ieg~VzjUbTk}S&7~HpAQAFV6fnAJfl5_u7y-ReXCTp_aEnn3uOggg3;XjJ>P(4h?p(O5ktXcA29B%N5@EW?JVc)& zVo%*vg@CN1@Qbvtxi736%pt7EZ7Jljv@2U3ysjF{MnSB>|n$OZ_( z7HyQPjSvC!EF4#zMWwn^7knYwvl(vcaPu&r4d}w^T*yW?*tyD(wAJNyy#?@ds3RG8 zz@g5C5P**^9ra>JBM&cuekPyd$0B*)-h&Vk70 zfe|^$zT_mmh?c-f`rz%VJarPV4~3k>qW@?)Nk62)NyLeAk^w3aPGaMms|x&`Hm9Qm zBb-EXf_f%^@Gx}{xO1l^U`kb##62dmnJ~dbO5(Y1G7}j@7>d0N$5j=4HZqYRFY0!4 zYCN;;Nr;1pnuI8-uJU&?2@#8egm}0~LTVIEtlR+!sY|pt3E2Wq`Fzjd8-WsKcLN+(y@`2B7n$oQUy(A??OXWDn<;#w z7H&1W(PTApm75qTvDJsuCU1cdEZ1t<}7!>J}>0eZ1fbQNE4gZ`a}RX^q5% zkYvd3poV0~!Q{!U5CUWawK-rzEtXrB@FNldh!clIc)O$iHpBRv% zyqEqhIm-JOtT~G87aftKOe06R9nlgv%KPE%st-^n0sBzMQSPAsXgSIUAq|cqPL!j3 zh)RT`+=*|l`Y?aTIEu~*3QGX(ibt^kP#=-RJ&tl0VS=OFEuPboIm$;7hGPF199MlD zpN$;l6JFF9N0GGJbCgdaqUI>~Q1!k1-ON$MqTnbVZgP}QQ8ck?2fgNf5-rYAJ`GRg z4WP&r$MzElFy@jAe?AsK`+spj3NQpN9-k2}faRd;z}!=!RNI1$vl>Aa48An2n@-TzjA_+Olm#OiQh(=vMeT$Q$e1*YHy+&Z|uQFUX z%Gapw>sp<85;7X$D9bCD$H!JU?p?(2aLB@@x^m4p8Jl8dCt$fMlO}Nn^9?9Nvk{=X ztl4~1689L)x0tymV}uOm+afFs<~#V}sz)iGE;1irFyBp#pDBvzgu#4IT+@63Y!@(? z|G;wU`_O~R^#eGr`XN4jej~6@r5gFok0|z-7BjaY@qpii`%D@(ark>nVxA4$Mr2ah z#~UpB1mp$<&(iicj)eO@)QB7n5Fi_STF1ZyY)vTDAP$${))IUf^w2?vMs|5+}-? z_Mj5sPUG+mE0p}54vrbgBd|LuU#MCF4_(5As3JRcwx=16njla-UNwTXna~XWZf03xd$24o7i3v8DVo?w zgMNROM2oYmJ>iL*?FGkGds9oC)Cd^;SP_=B4<+~2l3aCbHZV%N5hFR*evH!|P=K8c$5jVXT^y{y(_n>x9Yo241IaipGO$A!+!j~Jzzk|UG@?=0Yrize zzz$<@Q_mNaM4I8kzz(OnBeXisoRdW?*9XgtQ-gzL>PX1Iu9E)qq!k?{P&}H|!5lQ@ zIHXx~L|Cs4w8~*8L{Pd%!@sA&^+i4>|TuKc|KEZ&U3(TG7{DNub^50)v(n(FrEpwzJQeD0UvPyeU%>Da zbaFH7kPJDXEhj<r!7Cp$O|u@l(A>F{>dN~$Jq9}(HX8T215 zJ6Hv2umf?T?BGl)5q7W|-(0nZzx5fiVD+aVL#Sl4tRraf zfftGA{>gk`J;G2IHo$S!MtnB%fvgvGd*f!DNRsV|z*&f|iNM)RLC$}H(>3lsh3&-5 zAOaqI5`l9lnpo|F?&n;I7AFEPh9|Q05;$1Zq?UN!DqwU&6(VpRC400aPf|tm7Y9cM za6X0GgUdk%;N)ahM4#$~H{kWb!5Sv@#Ni1b4Ntm$i<13;WE>E?{s9KJ1r&DuHZ>L^ z8gc>_%Skc6%KYt>LqE-NHxKUOOQ|zT$%zOxSZ5d9=SY3JSaK%hVrHms~nE5JK zaRorls1|VjfSv}!wpQ$2#;#?{=vbaxK7V0Hb-4by2` za7-N=ov{n459fc3RLLq2)NGuzL26bBhk0<2n%iyX8e0oEeZyH9o+ip0xd9vs^^SYx zfONQ4045{l-wM#Jwj*OfO({kT>t)Pxb72LX#g(Y$|2~skfPA5TTnNWi7tspoBJC6< zOj0lOBSc#0#T0(I7B+7~Em>jJu-&LCyPI(c9=nV%-sRybIW&k{4Z`E^a=n0Y)`IQ@ z8RIOh?&5TeG-X!c)Vh*vO)48ha+`v2+`_KojxjnrHf&t8)X2=Af9&EeiPklL{#;|d zwWWJarQ4A2E4*7yjFl^v8YwM!*2ZhbA6G$rGFXl5t+Mp4($ z4;lyw=9d33)d1M%nxPEH{|C(ADGjjuVC1+-; zpP4s72$}i!(o=6nEad4%IIg;h>F7L3E|{mt0OT!{x;d2c={^S_Z>4|B0mv;3?xnT! z6>G$S$6g$GybZAu1|DyRx2xVkmBi~K;lSfo`j2+t@lHr%;2}b{`Wna9Ik(E-KUQ;g-f^#UJ4BMVjV575&hsODV%S^(pixdyL!S%%TZ z7oi8n7L2>9wLBy0}eVOv-_XA$wfilDd(9)IJLNr+BeJ{6WOq*@VgkGS9lTxj6txnv4~FdSY5I?r-TfZY zV0Yp~+1($gMA+Rk_~xoV@^`xNJ^(*2C@_J9E~|YU0-aipl)4YFC`52I&q#ovNwYoXGS#Y zdg@!9WN#LOoBFZ9;(Ib&$lhL5x3^Yj&PP@~vbRDFcdf;FH%w9GjCDCx!*x(t(AuDT zZA?(fgZE1=Z=A}l2D0DN)PY|5vL%n3-| zfr;@mMKP9;yo1Cw&AG4^N!}=Jr4B|sRG&lOxXQq%&+G&SDorD^JCtIFX)$vv5*vZp zwK;r{xF(IuIC0!Dq+!8~v%Z%B)5V-R?pA4F2uipZwe;ac*HqDh`{Dk})r!ie${eBKJZF0rRMmQHvmq92^4&N4Ke7 z=Rhzs2N5Q+gi^aJY))a$nl7lz(ZaDZ&#f_odoPd zArE;W{YT3~PJ}dgh&WLmauSsY4_St9*aN`dv4aCTCnzlegvaVmKint))N)DO;~*;t z6CC6e@tl&(K~6;&iv2V=t~wo`jT~g97d3WpK+zLEOlqb)sEV5mKlao8h>s zgioJWNTR3?jl5!zVr4C6Uiz$f1uyRo?vWh%P-8gLlb7@N(TN^a0ivL6i%}~N5o@!R zgJ~H@qMFa6yeI%diB#cWX9D4;i_BoOwMt3o)+(H%PT?(DxD_>MG7ve(Rz^x}!y)I` z1|b-!73Ua6Fd)Aaj;pp)q3*E-SBUau40m<-=*U1a<_oAI8FRonE`$&;kB)O(1YzXh zVmPjPIo0bN2xjIW!Z}_+sY^mBzoRGTxRm}aImcxT)&~OcXx8uj7?F64C-Jx(aTAEg z4tTrj3My_U9#_(Tw8Y~oNP~EY6D1z6q!J+>SK}K_S@U=7rl&}DP;P<>589o6(^G&# zy;=}>6yzEL1_gPIc#cn|AlD)cwct89u6iv#8!5=^yr{98o`MA1^N`mgw&o#kp#JOm zyP1cGfx$yO@Z=$Hq-bJ&4|>KMBwCz@ya}Gj(3|17>PBjb^AG`}o2c-Rn<)7fEy-z> zFn5_^BQ%ncn7d5^+qEXjb-}YoAw=uY>0}1T@9)=4ec`wzyPpgYE64@?xy4;4n4zKv}SGq9! zaXUoOPz1)VZ7A;-1RgE<0P#2FH>4$Zh_KL-58{ifK1BI+k(mK4xic|-rYP1CTJm9W zBeW#ZIO-#iLhZNTJlkfeN2m)y{&0U!$nLDoAC7nNMx=fxSGjW zhS?0Cd_+ziejLdKrB{ra@Dl{mY{GzZd{UyCI}7MNNDa2U7Y>%0i7j0u`Y53g8|ua; zb@@IDe_9K3Th#h9*R3}2b{=_aNY&ViJ2nk#TVJW3$9!I|)t9T|-5e;(VQfys*Sx{q zXE@C{r0^aD+{Rg}RE)t~c^I#28Nkxr7R%UzS1I8(&u;Y@B$I5(&k{hhC4>8(J||K2 zUa|io!26L3EcgH%SACwC(nX?^t;tNyi>#u$}^vSAdPk#AcF-eHYOZ znArE=?W*rnCjt9VI0f_r`j3{0{SeY%V&X)Z*pH}0nAl_Z=Bgj_cWeqs=LBUXfOf@b zR{*G=Na7y<`YB<8fBj56XD0KnpCb&#{tGy+`XxRa`PZ+!sIe&^Nvl2e`ZXeI>h(BP zKf&M4)JrT1>gC}k_4*A(6Ki%r0e&md;?(O&cp@*qgM-CMYKik30i&CuP_L&c`FkzN znHy#-Q*1;<*7XNUwMX>~WPnPhfLI!T#BTul6C79lnF`{71cC-6gzGPq{A(Z?M?%8& zHwL#w5)!VzQ{z7(8g>2jEl$GqPX;$V^8;)Di{a8qjX~aU+8Cc;2fU$PZyc%Xm=&n(}gXzoJ8T27Jl~U18-eiTWIzVoX3a4XR2O>%gFw0G({jjw)0ygg*eD z2**_?QBfSAK+*t(3@oGM$$?}X5y`-E2De2Nl7SV}cuGX0uD^Z>kPMv4;HIu2u>NTb zmk#W7s#~emnTwHOZ#T+nO$YeiUi}&}o~YyKf4OZ9^5oijIR%H~QJ9rE11ex}fw#*W z(<%Ys(S$RZwI)-9G-0&}%f!qYe8H{El*g^i;*E)!b^INVkJHZ*j)|EUiEHv&m?+B_ zo!!)W#72eM00+mB@##<42pCi&3O^wb-A66Oes!M|$+#WDS0i8Jm!6 zaLOh)?Z|>nn!!06=?5iUjM`dQbJ8xLfRUUdQO#Y3{9GgtYrhzdt6oB|=_0ceWi4W5 z-GYU+Y@+aaTDTRtXfg*WKo27&w(F3!oDU(Gq!nw)AsCQ*;kc@g3U#k9xI&b9hFdy3 z&L>*!kJW9}FF``?r-o$60c#n65Fi_PSd6s$McI%A{sJ6V6{%h07sSLLVJ({}RSKni zia^#fNdK0srOe=7^9aD=d&@_pD>Fz}Du|arSBBv2Du+sm*vCS;qUb+bx>AKS=!!T| zx>BPOp(}NKbJZ69PB*@!)XNHLm>|NVRUv;nm8TGa+A67g1Z5k6f}jkG=Zs{6@=}DM zh{L7UQDb#Gr0gUH8Z)8x-a7IW@aKr1vBx0lbKvh(ZuQ<^o=i< zXmMup3V0$jm%wq=rPLDd_yvq^kitwZqvYjU(j4d4NfcuvEK-sk6l)Lb3djIfph;Z` z4?wyKj;mft4RJ^ULPHWRay2Di6-dURkc+&U!EK?0T;v*Rd`(27uA{!q$wjVZaJ&Nz zk3n6>aN#1arMlN?bv$F~agmMTNf!Oev9qmGsTc1fi>wO09?@W3fwb!y$r~hfk9b_q zd^F`dBpz=RVIdwj;0vx-raZ1!7H<%bH}iKqex@i^65?^AxF(MSka&z}By|&FpvJrf zj;n6Qr%yHn0P0C2*?23(ZqZ`q?@@zWkd6QNn3KF>Y=n2B$}*R)pKQi^FKS8xA_trT zp3?Hgs1l*!5Z0((j;h{<{0G&l7%kto(=ze$iM$2v9TL_2KWn*Lk$u#*cfxViyJ)O* zk>-q&EvaSt5hY~n-4wn}3%BA#O~pax@*YM?d~gNtOI7cM5Q?M~*?J#>0r_?~u6jQe zYO*4@LX;n1_#HZYR5U0V@&~CQ8FFxb>O&9$WCQJQM6z`!WP$&~a9s5fYS;J$G4V&p z)?JjkJCyPX4$0O>>EDuUeT>2S1*@viXXjMDIwIdXfPCxYh?>B+J^^o6eUf?!+J{5F zbr1bV%eU@@H29V{QNHylDiOYQAHKQj)BGKK_iC6M6q-sF= zf^~gPJP$}_UH2mlRp0?QSaZc^BkTHt7d7@yRzJP=#OsTQtcllyRR0ivHxn1U*DnRqk&``4e8f+8Qd04NWZ>E zjo*)G)b-W3Jn7dD7~IrN1y=td!-anRi0U5G>Ue8YXXkpaZ5tNe6UvKlYPdKD(>*_i z7#fH`*rg5RCj!7@Tt6lBrmTjH>t`Y?jO*w4f=i<*k4vM)8;t9h{2h;NNcc`9*YFO#_ za9s5V0!bGMHOdUcI=b};GkAu=f7HU}=_rEWGMVVR#O4ZH#1&m~3s=9Y3>xQFRL)qD ztJ+6lP191Pu3nf9H+0GMPkK*IlYK}h{=}3L8)7(j^JfUbM$aW0^%v-basCR&RevK2 z-G_?>LVNt3;s4O#=3!BG(C$5Jy1n`}fjRvrbtLCBnDY4-gpkwGrK84Rl!`p;2FF!n z@#!}MLCriwc*yRQ+9Q*X)J?s<{%j1zT#c2Q$@`5!uMzWFr%x zAc2icgtx0EQF}8RNzs3_Y-BQ|!A8W1vXLoNB5Y(TzPV}|f2Ym;k(FS*CY~o$R)K~` z?skan)M=nbC~CUE@R-RALI*RMDV}>LGm}{eL#5agj;r>{0*a(82@&Jhz=O?q_iCi5B2QTuamN*R%FuLIi zKRK9^hiFO8eZ{hvDK_FGOEDM!3~q}lL9E<vo_$mzlR?cq3Mtc%u&x7_fPhfaNWfzBZe%n@Q;QK16=?|^R~?H_|G_ReP<RH)xWQ#35|W3rltY(1s)G{h_ui++gV3Zfyh&3kvhK(`mlw)8Wmq*Mm8*3d z9k?uU@tn@^&Q7CVmG_C}aOdYXO@y$87H^jw#5J5X+fP-tHjx+b#rCqFBn#c!O4V($c7}J?;!;muF6!Mi>fJJl ztRjaLHvH^$2NkXuE%4)Mqviq+7S3Kk0h4z_JqshM6QBnL_(C|YI+04#&sJ%}{ftuP z_1@wRToi%oc@ooE=A|RVIk^~xeVQsFC zbyGmFZWgZrD%^r-ns)%n|G287PSZI&ojF{obND|qD+yHwjL?=R`x(sLsz~m1m6>at zGuJrHSXZz1*}To_EZnh*+kDHtIe6&D0Ur7_RT;8}tK6L+PyJM1ZV1=#=J3i+JP*(y zYw`%-t-iQTEqKP@5fEG&jAk!=1uprO3paAzMr!e*xyDepkvZP(t7*5W%hATUb0 zNTp~eFG^IADT?8wovatvG~bUZ&UW%Y$8c%`prZ+IgyX6#KK&*vmWVdtoOhS$S(H3m zOLB{RFe+S;c$aBYsc;A+t7;u~B9jU4F+B%Du&eCDA0ZKSE<}-!7sJ6m11i^JIKit~ z7Pl5K{5%~#su|v7_&wB+3_rNJ^n3^bz5)0n&Lig_3;exsu<3x>HU3TbPW+MaTb@!@ zDAh22>!*Lq@!J4{^*plluUpWcjyQ7Lk0Uo5Q4>aP1$bkp0re8J4~O%}o9RE=ky{DU z7`cfP9k~rsiHzLJ_=ZIn0e3LO4oJknM`OG9QU@1b{bWQ^brRTU9*wOCGY- z5QchChlAY-_-q`qZS|tYCX@a2+7H&YA+jE<4O9I~`MY_rCML#U&BM;Y+IEU2*7snj z@G^-OAFR3XM1C%SgLhR^OMDz8U~~(W!P-TXyjV+e{x`^6rr3y#!?c%EvOTg_KnBQU zGTB$AE`c9_T?)rlmr+R^m_X6MWPo-#C3ggpaWovDUBTeCXu<*7mDG4uM5C^+zU4VU zdnJRLy05_MS2J9?@mEpZtF=0gG~xravv8Mb4g?+dnwD|Y4QJcrt(5-Y>>9*Gn-NsI zw9ULm0C>Z)Ynhv-+=s)m>qJ_nCqL6{c}W_9lwGS&Nygyp(VqJ_cs;dW6^r21B2c%&3Ot zBg{$FF+RfE3_!0682$8NNG3J8Tipn~L7^3+rn`wLHk&RO;Jihmn$J0+o1qrgc`F>e z4Voa*MZ%0uHH%er+d2+~_cjW@T?=QMGL)U3xB3g^f=s>llnT|FdIv;h1am8+G-Wbq z9q(lLVkGe{e8bzF`8#dik78J<4Jme9nmYgd&D#pb3C8B0?X|9j^XI!A_?WkG&Uu;c z%%bzpPj#-Ym*pB@j8StXjDl{$}%F<>X<06rD;}`wcFrrSW_aO*Yyd4hK>8T{m&Dv2bst+IlfW+1zpglx`xFnvNN)mf(0eERQKvo(2dnJVkS=gzvA&>VXf9dzQZK7JtRXd?C~gtzpI5?*yDSY`MxJJTkO&L z=`7j(0YzJ9_lF2ac4ZB!r6Tns2q8C*!NEalYSg(AIMLi-lnDNjO@*C+`Uyp3vPb&C zpHjuovko*`~aI;4ZtGq}sD=+y@CMswX?_T=RE2}aj~CG$In?814Aj$Y_}TiBIZ zxR`zmj?Q!+Bj1ib=KS-GROiW7pIxhz@;7@jFWNX6}t^foKObKsakju5GI#F ze(HFYx*EXjP&tpT5Z9#*$z(SBLiW2VmoHT0P|Oy~*veiO(@6xK>g+gq+3J(C8;q4J zWiCoC@Sii+I3>FtFaBA)AT!rkx#8qB#&HX}jy-Ns*ODcRmvkN1nQH1%i+<<%b6PE4 zl&e?G46d;jfuh$}{*spdm1pTiC|^t?|J#;UzlH)ltEAk5=XufZO&_QBBt&?yJ|R&| z^FL1cH;9i)_ggrwdXg!niyj=w9I6^BmGrv5qsUWQMEAN+^G6(+mk)sZJ;K@R{(*6y z(Q(a3VJ7KQ{&&_bl%tp`C`a8d|B-o*n`-r{snR?CNdk*r|NCeBaMfQZpXSlA|IAkM zT>5Kbs+ppcha~(rarG&yf4?}?-w_*i=O1uf^-p~Iy|rXPKd^#M8cPIYjFkG9jxq*U zQRA#UJ`u&#VX&LP3j6A@6x!VrVqg929xP&!J*X~T4xvTHAsiNwzWP}urp7}Nj57fa zj=eKg{WO8pNE= z#!;eC=rU3VgHDS73XH&YX3t z!;nOB{Z2FS=K8&_U%wBRsHXW}1a|~dKqWmAj;oF$o^+9jqZ49cE7VwTm92xqbF}bi z7QmWv&sDZgDoC7;UUh(PfukV=3yfx!Z7xKSl`c50>ZWr2a232E`gshWufs>R{*??r zLk-FBXZ!FMKnU;+)UFX%*%m?;_!q%()iKnr@e5+&M=u~9!Anqk7gK6UDCI9}ahK$= z^l!P!b{vDfRkn&6lBvrPSJ|d=m2D}aCakg@4{uk!fO-kqhr?C26X-wMRkjyG8mnyL zL|55Pq!L+WI|<)hwT!>xt877TP-p^bmn;@|Ak@hMz*}HjPPkZLTOpoPlNZ=dK^UsQ zsc>9%8a^8r*iQGN#uwPU^x7}5twdzKz;*`Juj23K1varR`e6?{7ue3EXkt|lCbL&d zwDQsU!|eplD#Sz$WjYan(72WE>3_*v@5eTQuPU+l#63B@vCfzWSEu z0^24AH}w#K)z4$NbZ0$OcfMA~>nFSgwzXw>%XauSY<))urXx1Q?xesejvS(+;Rv){ z+HiUWfVaxl$1F9OAY5h3i?FP+S@`0re#)nd%nNwkKw|t%Q4A)$&KB3?j&ZKCjoMzS zfS9O6ML4e7j8C872@q7B#-+9r#Rjz)PwlrjKihCI2UxkxM>Y6GF6#*H1smmE9c3gR z6mT(W<_du|n>kpK8= zr#2gB%5W(evr84pn1h2G7eEM@4{ahO3CXAnA&eYc1jkhuQ@zfCU}g>?jO68%dPOMZ zQvfoOOX%N{kzC4PeOU*{bYbMfqkEE$T!wfFbmVe)yJ`oO60whkbmR*9kCu*H32D#~ zaiVnODk>2=@=APj)z$nRyR5^@3d&0m;gP!2FY6!z^(sl-BOqU)S*1^Quvyj&zre-0pr|viKcQXqSqk@Haz{x_cr)XmR4*J74 zO0+l&xdEQY%$wlg8U<>JclH8CH%Vb3H&XH@Eoow2VvNpNrq~FJ6yz-wYY*#Y$N*NL zNxc;wfOHESSG|oI;*bP{h9vys?UZ~+AQ^{3{&6dV+d>KX$2+O7U-E%{&`??Xg169KjB zn#t{wx<@JPG+Bm3QMxv+yodNv^5Cr)KjA# z5cOS2-(w`-BVsU;?~CW8WJdA>grO4r5RR*UgwIAs@|YKOd*f|sUUKa@$&V3NbCRD> z`%n41nUjcp!AU&mh}jn70h>bmONoxJ3a3~uT$0-OJd;lfM)Om%dYfyx5&ohjk=8+8@E=v z*6|XBkdgcqQD9qvvnw0Q-z0sHll&dulkU?D-m3c#5f)DJPkeFJzbKzBGArODV^Gx1 z@iRrSk#LgT5RM9Q7>pEbIBsboH5SsSE4#zN@-$WJ$Fd}j8q&x{#!+m%7Hc<)&`3NQ z-Y(M^H*cL8wsA3mv_^uhBigeHKRuhnXP^QJGX(tj`Q-um&qdQ5W zww?ZHMEBeRPa$>KdNLfm_L^AJMdl{TI>g4hX$tF@O5tf*xD`2QvIbelbVf>Sup#T1 z0U=nV73-LZU_hP)$5ne$p{^c+D@3^$!}r$VaXyfE^LaAleW)QBa=<$Fg%BVcsNfOS zk(i3w53<0&KO9#bKah9E`2ryN86xu zRfq6*>@{&%r!4XEl8!lc#y$zps4d9WPVLMC2+9CLzdJvaXwjV?CZ5xiyYn={VBN#v z;1YOzHg@MndQoHVhzk;I-=QCc*t$dSp#C}h-Q1yzbEd^t25uyp-Y6eIJi+ zSXkumv^ftoJkotHM-%8enHTspy`RKbjmwWpm{~XhanV3duurkO{Eqa6)Yp`LIJiGi zB1uPj624%qk@D#xb)h3YIWay~93>h$(&gfs=Fxx~bfhDLRVxq;1$7D>99hSwKfV_f zD4xb1^)!l|uEosjkXDQF{peoT7U@M(iSKID@1!?WrBX9+Q3JNI;tnv3`SXSTe!Ry_ z_Woc)thc!+SC$(Uj_Fn_fiG_UGl;p_{K0U4l|(Y1w|P1f@K8>x;karIGm|bdqtV`2 z%15`UrMC3PYbm}?i?`}FBc@_c{341cwlW-xS!0it>b4$2FjuRdcmsj~cOx7eqozXL zlL;b?Q1G3_@UwOJsQSn_SQ$#RIyXJp2YU{L0Mb8Y2g~0?-PaCQUIOFiVz8H7?m58$t-h49Ac3;&hl8b1>PmBiW~c0Vv+04Zx_~eC z+??IH$<~&ew<$YL;apqZo>K?mk}QiIisI^hpPeX}&G?D;UE|Y#Qb|I5Qe`JcaHv6g zBj#!HNPKRLrOHqW5EVGC8p0<)JeLW0`PRMILaAx6fP-|n6;mR{kzS@Fne&mGm1Uf9z=pU%xm{4IYAvT~T{zw-wN*wp z=vEA?ocFxCr9QcgAJ0q1K2*}WK+-b*Bi-sk#6{LFf`gSvrlKDNf}8ctzC~BNY1Ltz zWgP6mD>19N0ZYAH3uLGD)iFdY*Ltd$>c-13UIG6#SsX>d(2-{u)g|$nl4y0f&&)LXob~3gAl&f<4 zkfqcW2w0Py8o)$Lt*R@D>MDF@C&EL(R@E!%d9`@Xs16VIR!Tj7tg3nyyf>*=OW@3g zY*XJg41JA+?iGvLLxF24aGeND>MPV}#j1KOeP4%9dE#fM_;#1tq+Sp2HQ8A~Ui@OJ zsy8s&_4pL@a^e*Ed?Upt7V=&}+<@P!cF#_Yf~~4IG3uKo>QoL#%qZa8 zs>~7epdJrcwW@jxqunfl6R`ujhI(C9Z^h5Z6BTzum2sy`K6O^ERJW=rbqm5P>TUSM z>y||}JIl9c4{n~>j9hN6s&^m+6=qMQS5f(%yfp+JU`RM2t8PUY%C3Zk{5mRVPak-y zdM7-yW394!mwcJT?H-~|y&J!GWTy>TLy{v+v#RPg>X;^taR>?qvAYKudJlc4)+&7w zDDM@8;}EWf)%)c86xA=`Rja42O6qp;I?%4whN?^F&BNPeOV#dzRqOArsDXKQZLl;? zys1g;`14CBwD6Jm- z6Wh}BC49Y0QkWrDt0JNed?k77&E4WXE^qbL2h>MJQ+9?m*lS6Z8U{SM*-L#4{#RrV z(nPtH{*Q~I@dB-{ramD*rdCm(%JspXZPG5)C*g-upPsJ|4)p|8ysGYjKT150?ZLP{ z%oDy>3s2jcQ)S5u^jf(=^(o5kE#)ou+e;bs$i4R1OK++B5SX2au&yKKFUqS=%g>qC zwgMh%Xnl2ZU`c&}-ZQLi zI232~;BEj*Vdb}~zDWOBVm-VHxmKtlquPWIQs-p-jK*pD@@DlAg{MiajkJI-(RX^R z#MHy^&W@|s`n!%*UzYDFPnFd5N3^Cwd8l3s3R!(c#3nIHR~6>^s{EeblP^@|HVU*Z z8u4q4I|)xBtaYMuS6>&gG1-IUu5-CJN@?RGm-3+NK|9!7A5!0d)D>vYx!#_wg?!Cc z--O4iiP>q5HCcU2w2jMdJQcXVE#D{j{nU5x%RV(b$)k~&=X?}CYqHZ=%R-xem%dZj z0DE)`RNsT&j_eevOhJSHKK!zV-{7}y-P%1gjJ~|g2A{XK%!71wp8A1^p~t`m_ia6P zVZbio|C;)tc<)iF;QgOJlCK9g8Z*`+AA?AdEoGWKv3o-6{a7N8E#%ct3tUznZ!loZ?&sFWkvsm8Br_ z>K6#zk)5n^TLZ6O!V4{SDs36`0lyO6_1^5>@m^1}fnQ6cG4@fedK}-t0E$=3J5VPU z55#dOdy-y_nNnOPo+-OxPcA-#gJSmFVn4*~IUqw*^;XtB^>&hJ#XBY9bUo)YL%$Ga zrhZ@TEd9p1y^B-jbj)7GcZ;S~SVY{XI8MIqTeKzae){s6{fn!`^8kIX`E2`2QE>qg6%{vBR8-thQBiS2T)+)i#1%Ib7u@~seN{Ep%S=p!bNtWw&q?Z4zjyC_ z_kM5ts_MPDWOg=J$<}N6qTgSx$D;x7vNp}pVmm)7qo+}D&Iq4BqC|RtG z>(1fy@|XgQ<-9SsUaVPrT~;?%mzyg=NGeMVr&l)X?(~Y4sz+8}-f+5;Yp#@Qh{)IT zhwIK_zdj1bYlyj0&Y&`1FEF~>>8`rudzq5w`|dabT{xl_Io;Vh5mYmNrA}E-FCKOh zIWJowL{cg1CBx1Vw_dA^RVuY|rRHV)noBi(@X!HH2Sb+6`T7u}m-ec;&LKezefe@9 z*Zn;me>SL@{s4i!DC=4?JQr6N+m2j5E3I!)yv`Wo$ zR>q2QUVxGiD7Z#T??+hmPpOnmdT^WjXkSehm6Y(&)p{KggX35K1|- zoVkD!py?hp+nF2WuT77lB?cVdBY&Wn--({%*DB?KYSEn>r%Jt?8{qK!(Ea?rvHY%q zv(7x{Jjtp~vg`gpChVDl{eZPQ5QLRs<$m&OdY#izbH^Edz24~voYhA-3Aa|G{Ae8t zy4UCpy-sJYUS&C7Zya$tvPIYTaew59(>dy9cM$iCqeh$qxe@zDbiZ2eI&-Z2z=%Ft zb+~ospklu4=}kkkVJsLo`WQ7^0k>m&n}I{8D|!jN8L%B^^zpqaC1YhnYxLvbj5L()3CmH?Z(BYxB(T&!NMX#1A=6#^`6nJsI(c3~5 zR6UGVnHLk%4hMQc8#gS9@Z_n@2(s}^zUGw@I*l4GH2P__23UG}tEC=wKKG`JT6z=4 zm^)5xRVDNY>|AVgCbF}=ot+EWj@#@GdXb00nnlMPg_*3;xyX#iolcLblcmv`dY)Qd zM|)h%M#q6R&-x8LSpo69(FIsT&+1WGAP)Gtq6+nnASa4M7we;nVJ{h7j=ZQ$8%(uV zF@)M^ilqH^(k1q?rWmKX(K{pIiFU%8g?A}NW76nnM8eM$G@ixd?HFy^Lb8$}sk8pG z0ST{bAtYF`&Is1E^LU+n4$!&8=-seBqug_0a8htm7A^&h1jnc!=}Unc<8YbLmq*?{ zuU%+@!}A4)Jw{&<3BRD7@MRpw3k8QOjeb!i{9?i3C5*$d`l_}#tYRGYu>MPd126tD z98Qx3Tu^u!PY|h;C&3har&0F z04!qwZesoS0|2IpF#yhInkcb<0I`42=nrx1(+YhUrf!}o>|2fgNaWl{+eIQ_e@w!@ z&FGIu!k=g-d@H;CNeTOQqdyf1e_F!+42ONZzN2l}D>&@iSpTy@hu<1wyJrg9Jr@k_ zbBO!%Mt_0h<__Op>WeUT`!s=jYQ1vmqnx1oV}v6xG9e16 zQ?gb`*1$57S>=|&ZTUB|4NkqXUnegKN=x8%Nk3nz7lmN;C(epl$bz(wdP%C6neUH* z4JUK?FSwiThDWp`QFZpqa=i=MwUeFro5UmGoR(*p{30y;`y|ChqzD$*q=d z7bhcYtZEGkr5CN5@)ACXTZ6I)Mh_w^=d*e6%%Uge`!NH@pAM3FKMB&F$d{@`kDqwF zTyhfLfFdR*^2K84ARZU2kM_xff%NyD1L6a$LO!y0Y24?M{qNKqoEn~H`Pj^sozpvLQ@xn z4f<_MQ|~qUJ6sX3)Az)=>34b3h!b|TMH%L&k%jM}OUy(OzK=M5VDt~I`8YMd*T%u4 z{yw9B1cCG_o@s+oj^PoG#iU;c)!d@*kGUtk^~Vii2GqGb4DKgzZ7&vo3h#bq^v~J5 z`x{WcPrPg9nO+%h74X>XR)lQ{JIxUlJzk>80z0R z2lPkS;#rfQgLdiP!iaq^>SP1_vO+)T%mqmv#RJLj82LqEc)z#2@gbxCz}OuN?1tT) z`EhtBQzh^ls}ys1i?A^^i*DqZ&&5H|TWU&>DYsST*ngTS9R49;_^cl_t!o6NRwUg~U(-SN5}wpbZvlBUVTz$23ng<_8*A z!SptCktB~5v~{sE!LPEil~Re-`vrn*Pm$WO|(FKZ3a4cJ_pv_ zQjST07D{Z3g4p`@H8xrdP1RFih+<}oT1(zZ*v`nf< z6#@@9kZ5kB2f1lzDM#2Vg@ft2QKhs2S%_mJ5<^Eyc`8

bce(+AKM+u@)ZuCu5n8g9eNrkHpXkxbighpK3?wVET&wF>9d{#okHQ zUi`(IV(vm)q#%X_os1l{iWv-@!nX+_F)M;R4qcBQ*3l zDQn?0SMkak89a@ZW_aSK(;)z0wjwcfhM45)V(g~Cu1rk=XNu%mRx-T;4G^a}mXceN zLuW&%(Q#f`=^W9Gp%Sp2l_3g`XT8ChZ9f4r@Oub}p>xGzsvs4{U1w*l>tHu@o(KxIF7m31N zXikA0!?ehRW<=C34%FHbnv4`Sd)OmZ*vaiE59W{9(oZh3;TJ#D8On+cJAZJMGJh0i zWHLFc?}`4H)o;&af_P$NW?Yn1pmZ${ibsab^!3>h6`LskTT;`~zw+XCGu~6YrXc0q z!FEWP#URXmry3<_qJuM9@h({wgDnmWt>M~6DTYMJZ2Z}4NZ!8svy=d7d@k`dQXA9Wed;b zbTGXEovl5OY2z$C3rYaRATji8Tthy?KG;FhNMoKOl9yP?|C+`$xBPCg+X_*V1AML& zHqe+$kp=fJLt^N1DQ}`N>~DRv5b%}fiQw}C!D;x)9w}~iqNl*7*pDkXwa-woVMs4P zHhg&@5<^$w8bZmHS}6COr@Y7-eX$sQi8Z<}JjI3|krdnrPq|9$z0}%k@>dZqkMDZCgja9wepa;=oL@RS>vr$h!{#Y%g5 zK~L8~2#CKLiJ{ksS*|j^;IlhZ1N*fidA*fPuW8~c(d*FQr3}3ef{g(PUwOUg$IuD* z%GwZ(H?ZE|-tFH2Ir#rZB!=E3R#OG3G#&ywZ9`zr@@5f!ixn2m62n(G%Uh*vFPvq4 z=C!7Sn|?__yiQr?9dL+=*xR3Wg&uEiIK zo29tL+R%C)p6`*unK{dQAp_*!hs4k=qOdp4!j1);<^7`efk3S-XZfHMHhb7pU@Pq8 zhd6D05A$JU!>?PB82SjV;T*zM+Bu{{?x5S|r3!r%h0y;P5<|D)%8xZ|1kpk^o)~BO zxF~%hP`c)keF=JP zg1Sr0wFb3;gZeTGL%#AA+#C9;h^Go-4SeNmZPj}U>?>Qio72Jc5i{_WCRgbmr~r_! zBQf+1T*KkP9@yd0$X327lHanD|211_ZuM`A-By5(+t!(81DTpCJzeJ8&CT!(bd^=azN`JWK{aO^5t^5Xe zhJGu*Qwra+3tU&6tvo1YEo|i$W-F1w-?7s4U(@OLCS9$hiYCQi@ zB>!Y3)7SG{%x|ZulEv;vybmY&V9IaA8@`|>vo1a?<15J2XI8w}#wX)^(S?fr`~CO+|^CcGer9=<5Mxm=$261v6c)jMyfOS&{Jdr*^Q&&zqae)=<9 zZA4F~(!&x#tZ4$OG!Qn$Us!MO|3ZX+g{Nr4zacU7cZn-ikg(&;$PG8ujQ?6H46VjBTmiUBy8_I}HP=}ELq-2E zt3M6bwDH8a=3_)D87STJ$Z^fs19|ck-U%XuYwsWaij}Nvs*$ZOm=T*k{>k2zn7u^s zy^wbshbmERNo>Vel^lOCZ0VbaOUTV_HN{j@QqG;TM<7}oK(y~nbsaR}03#jm&g;cs zivvT)aZfpdh4+W4_CgVTX#)~N8>Na=A@G0$nVJ%h6p^E>NP5!@Om*6(q&{f339Vm@ zwuW{Bhc*&MFl~k+z&Q?yq2qB4 z2O9ff2U;U*JwYT-w32BJjAr~)_-ORqHt?P#{!G0-It#PUEzd?VgTo__7rVzG~qbHUU>^n;>Gl7Xk0^ z8{(q@EuCqdIZK>5+d7kev};9!TDT*2-TXCu!lg2ELpld8VFG%*`1gdszw?308R7Ok zKUu0{w_>o_FgWEBZ7T#j#e-Yym=884g0k`+#!?A%5_Ocl3H-`={cvlFQ#c)g4>W{Y z`TN_sQhRfAPfeHSu^i8q!??lcIuTE$A0=n$NnBk|fsu*NsZW+_Tf7`Pm3!nJ7qzZwb42sOW!7fz(LVbY1 zGuK=kze~EK73@5X4#)96B$<~JdF+tQ%0aXo9-k`7ajz^p>850HIE;q}Y=T?(6Zsmp z*KS1S#-uxjJuHch@m*Zlw1gc=Y(5w_O?xW(ljlr5p?SMp-X6Q95pH?-@+9I|TLuqb zTf?>+6M@0><^L;?&^SCo+bSf6^5S0Vf5*LsKE}N&;OGT$cSqpv9H1#}%U!-Gnayp` zQ($eL9ZH-IrVoS;x&xK*6Y*D&7^>nLu2WovU8f>W-T|GU`;fMJBznHpOUDG-cpiQd ztBFoM&{@LHw{%91WT!|>AISvD5lJ@;#J<9#FVilRAgD=w7_rBFpnybOt|6HfYB6~Yu1+U1I^g79XJ+6$mGe11`%x~l94amkp=O~uwj5OUKYH!4qy{}dX ziw(U=#5?mjdm5VFjNd~Y&VsnJKD|X$-^!{BLO-mBHzLo_+qh&=zMRYRxs(jfRgZf$ zpWZHN@8H5t9Lr#~=hIF289N_2hCPHh@109r;1=sR(N6C~d4=AED?a_Ptg|GC^kgMmP2p=BqGJ;v*+MeL!*-)GFDSD<5Qob5Kr`^dY{V zPh(t;^XYXe(uX-~jjGkE{+5A(TBU-+`+2W6)?cCV0aYs%2k2H7>B?b8JC3B6s`L^3 z9)=ldq)d_dGkp|!IJtbVU*bdSb(~-KGyFtSM8F?I*$CanR^|f=KIt!Ag+4BZ63Q*& zoUEAn1e=-TEC>R#$EfL(ET>K!cGk%G^$dWl-2KiSwhk`U!>$U0Z-@%4>A7?&WqtEh> z1$-nNCj>IPcwExwkcU=Zn5&nnnW&5V^m*i?#c`@TUmmLj!e6k$-NADNyum525`9r* zmvVbE(c?DC;D9ee!Fae6g-$2R`qmx2IY(dOpNqX+dHhWQjJ`S`7ZmSe({r4;IEO!$ zAEz&iN$D);{X6r1zJ?Q8Uy9RE+=Hg7o$8 zSWEeGypid9|eLmp&9{*mL$>n|COOMedAbwwTyD$^kLn8D87MtZ9igR!ntcc8l zk0^Pf%U~Srs8{KSkh%in*&WSHmA&6G1=5 zFSX9;3Ya=t?kC6@cDkjPO=0>|$(=6)Fk?p`{S0|~ocY|Dq5=PNSJfZ`U+}*)$@51(AY`ly07} zGgIjOnw4kgbMza&>Bi8A_k!Od^9pCRodrC5qRt0^HI)hev;sW{5sayzd1S2k^gCpZ zILl<<+j#J;7D#O0~j1Se~r1YPH>6w90OVUXBBQ zYw#BcR;qjI&XR^dBVyO>Kf|=4hjGQ}%ww3<{zWPSt&ykF@Q-2OuRF+5rMlAx>!bbu2AnOj;Q#;t diff --git a/docs/fehmpytests/html/.buildinfo b/docs/fehmpytests/html/.buildinfo deleted file mode 100644 index d0db86fd..00000000 --- a/docs/fehmpytests/html/.buildinfo +++ /dev/null @@ -1,4 +0,0 @@ -# Sphinx build info version 1 -# This file hashes the configuration used when building these files. When it is not found, a full rebuild will be done. -config: 0016432a887880a6288bdd3937596fc9 -tags: 645f666f9bcd5a90fca523b33c5a78b7 diff --git a/docs/fehmpytests/html/_sources/creating_new_test_cases.rst.txt b/docs/fehmpytests/html/_sources/creating_new_test_cases.rst.txt deleted file mode 100644 index 72da20d5..00000000 --- a/docs/fehmpytests/html/_sources/creating_new_test_cases.rst.txt +++ /dev/null @@ -1,132 +0,0 @@ -Creating New Test-Cases -======================================= - -A developer can add new test-cases to the suite. There are two steps -to adding new test-cases: - - 1. Create the test-case folder. - 2. Add the test method. - -Create the Test-Case Folder -^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -This is the folder structure of a test-case:: - - [test-case] - | - |_[input] - | | - | |_[control] - | - |_[compare] - -All input files needed to run the FEHM functionality of the test-case go inside -the input folder. All control files go inside the control folder. All compare -files (contour, history, and output) that are known to be correct go inside the -compare folder. - -To set up a new test-case folder: - -1. Go into the folder *fehmpytests*. -2. Create a folder ** where ** is the name of the new - case. -3. Inside **, create two folders called *input* and *compare*. -4. Inside the *input* folder, create a folder called *control*. -5. In the *control* folder, place all control files. -6. If there is only one control file, rename it to **fehmn.files**. -7. If there are more than one control file, rename each file to - **.files** where **** is the name of the subcase. -8. In the *input* folder, place all input files needed for the FEHM run. -9. In the *compare* folder, place all comparison files known to be correct. - - -Add the Test Method -^^^^^^^^^^^^^^^^^^^ - -To add the test method: - -1. Open **fehmpytests.py**. -2. Inside the class 'Tests', write a method *test_* where ** is - the name of the test-case. Here is an example for the *avdonin* test method:: - - class Tests(unittest.TestCase): - - ... - - #This is the new test method for avdonin. - def test_avdonin(self): - ... - - ... - -3. Inside this test method, call - - ``self.test_case('')`` - - where ** is the name of the folder you created for the new - test-case. Click :meth:`fehmpytests.fehmTest.test_case` for details on the - general test case method. Here is an example for the test method for - **avdonin**:: - - class Tests(unittest.TestCase): - - ... - - def test_avdonin(self): - #Add this line to call the general test case for avdonin. - self.test_case('avdonin') - - ... - -4. Inside the class *Suite*, under the condition *all*, add the following line: - - ``suite.addTest(Tests(''))`` - - where ** is the name of the test method you just defined. Here - is an example for adding the **avdonin** test to the test-suite:: - - def suite(case, test_case): - suite = unittest.TestSuite() - - if case == 'all': - suite.addTest(Tests('test_saltvcon')) - suite.addTest(Tests('test_dissolution')) - suite.addTest(Tests('test_salt_perm_poro')) - - #This is how the avdonin test is added to the test-suite. - suite.addTest(Tests('test_avdonin')) - - ... - -Running fehmpytests will now include the new test-case. - -Customizing a Test-Case -^^^^^^^^^^^^^^^^^^^^^^^ - -By default, *test_case()* will check for a maximum difference less than 1.e-4 -on all attributes of the FEHM simulation. Passing a dictionary into -*test_case()* as the second argument allows a developer to specify how these -tests are performed. The following keywords are recognized by test_case(): - - + 'variables': list - + 'nodes': list - + 'components': list - + 'maxerr': float - + 'test_measure': string - -The following is an example for specifying the components, variables, and format -for the **saltvcon** test:: - - #Pass a dictionary into test_case() with keywords specifed. - def test_saltvcon(self): - arguments = {} - arguments['components'] = ['water'] - arguments['variables'] = ['Kx'] - arguments['format'] = 'relative' - - self.test_case('saltvcon', arguments) - -Documentation on test_case() Method -^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - -.. automethod:: fehmpytests.fehmTest.test_case diff --git a/docs/fehmpytests/html/_sources/index.rst.txt b/docs/fehmpytests/html/_sources/index.rst.txt deleted file mode 100644 index d38064d6..00000000 --- a/docs/fehmpytests/html/_sources/index.rst.txt +++ /dev/null @@ -1,21 +0,0 @@ -.. FehmPyTests documentation master file, created by - sphinx-quickstart on Wed Jun 18 15:23:59 2014. - You can adapt this file completely to your liking, but it should at least - contain the root `toctree` directive. - -Welcome to FehmPyTests's documentation! -======================================= - -Topics - -.. toctree:: - :maxdepth: 1 - :titlesonly: - - introduction - installation - testing_fehm - creating_new_test_cases - test_case_desc - - diff --git a/docs/fehmpytests/html/_sources/installation.rst.txt b/docs/fehmpytests/html/_sources/installation.rst.txt deleted file mode 100644 index 3a41c0c0..00000000 --- a/docs/fehmpytests/html/_sources/installation.rst.txt +++ /dev/null @@ -1,12 +0,0 @@ -Installation -======================================= - -1. Obtain the FEHM repository. Fempytests are included with the FEHM repository. - To obtain the FEHM repository, type the following command into a terminal: - - ``hg clone https://ancho.lanl.gov/fehm/hg/fehm-open`` - -2. Build FEHM. In a terminal, navigate to *fehm-open/source* and type the - following command: - - ``gmake xfehm -f Makefile.fehm`` diff --git a/docs/fehmpytests/html/_sources/introduction.rst.txt b/docs/fehmpytests/html/_sources/introduction.rst.txt deleted file mode 100644 index 63e877b7..00000000 --- a/docs/fehmpytests/html/_sources/introduction.rst.txt +++ /dev/null @@ -1,18 +0,0 @@ -Introduction -============ - -Fehmpytests is a new test suite for FEHM. Its goal is to enable FEHM developers -to easily test new code and add new tests for existing or future functionality. -To meet these goals, Fehmpytests uses the Python "unittest" module and a general -test method that can be called for each new test case. Currently, there are -twenty tests that Fehmpytests performs through a command line interface. -Future plans are to integrate it into the FEHM build process and provide more -modularity by improving the devloper interface. - -Fehmpytests uses python 2.7 and expects the scipy module to be available. -To verify your python version enter the following in a terminal: - - ``python --version`` - -If scipy is not available, contact your system administrator. - diff --git a/docs/fehmpytests/html/_sources/test_case_desc.rst.txt b/docs/fehmpytests/html/_sources/test_case_desc.rst.txt deleted file mode 100644 index 65a26e41..00000000 --- a/docs/fehmpytests/html/_sources/test_case_desc.rst.txt +++ /dev/null @@ -1,25 +0,0 @@ -Test-Case Descriptions -======================================= - -.. automethod:: fehmpytests.fehmTest.avdonin -.. automethod:: fehmpytests.fehmTest.baro_vel -.. automethod:: fehmpytests.fehmTest.bodyforce -.. automethod:: fehmpytests.fehmTest.boun -.. automethod:: fehmpytests.fehmTest.cden -.. automethod:: fehmpytests.fehmTest.cellbased -.. automethod:: fehmpytests.fehmTest.colloid_filtration -.. automethod:: fehmpytests.fehmTest.dissolution -.. automethod:: fehmpytests.fehmTest.doe -.. automethod:: fehmpytests.fehmTest.dryout -.. automethod:: fehmpytests.fehmTest.head -.. automethod:: fehmpytests.fehmTest.heat_pipe -.. automethod:: fehmpytests.fehmTest.mptr -.. automethod:: fehmpytests.fehmTest.multi_solute -.. automethod:: fehmpytests.fehmTest.ramey -.. automethod:: fehmpytests.fehmTest.richards -.. automethod:: fehmpytests.fehmTest.salt_perm_poro -.. automethod:: fehmpytests.fehmTest.saltvcon -.. automethod:: fehmpytests.fehmTest.sorption -.. automethod:: fehmpytests.fehmTest.theis -.. automethod:: fehmpytests.fehmTest.toronyi - diff --git a/docs/fehmpytests/html/_sources/testing_fehm.rst.txt b/docs/fehmpytests/html/_sources/testing_fehm.rst.txt deleted file mode 100644 index 921be0b8..00000000 --- a/docs/fehmpytests/html/_sources/testing_fehm.rst.txt +++ /dev/null @@ -1,74 +0,0 @@ -Testing FEHM -======================================= -.. contents:: - :depth: 2 - -Use fehmpytests to test changes to FEHM to ensure correct simulation. -Fehmpytests can be run in four different modes, default, admin, developer, and -solo which each run a set of tests. Currently, default and admin mode run the -same set of tests and solo mode runs a single test. Developer mode is not -implemented yet but will run a subset of admin tests. - -Testing in Default Mode -^^^^^^^^^^^^^^^^^^^^^^^^ -To test the default suite: - -1. Navigate to the folder *fehmpytests* in a terminal. -2. Type the following command into the terminal: - - ``python fehmpytests.py `` - - where **** is the path to the FEHM executable. - -Testing in Admin Mode -^^^^^^^^^^^^^^^^^^^^^^ -To test the admin suite: - -1. Navigate to the folder *fehmpytests* in a terminal. -2. Type the following command into the terminal: - - ``python fehmpytests.py --admin `` - - where **** is the path to the FEHM executable. - -Testing in Developer Mode -^^^^^^^^^^^^^^^^^^^^^^^^^ -To test the developer suite: - -1. Navigate to the folder *fehmpytests* in a terminal. -2. Type the following command into the terminal: - - ``python fehmpytests.py --dev `` - - where **** is the path to the FEHM executable. - -Testing in Solo Mode -^^^^^^^^^^^^^^^^^^^^ -The process for testing a single test case in solo mode is similar to testing -a suite in the other modes. There is an additional command line argument needed. - -To test a singe test-case: - -1. Navigate to the folder *fehmpytests* in a terminal. -2. Type the following command into the terminal: - - ``python fehmpytests.py `` - - where **** is the location of the FEHM executable and - is the name of the test-case method. - -.. warning:: - - Developers must run in default, admin, or developer mode before commiting - new code. - -Creating an Error Log -^^^^^^^^^^^^^^^^^^^^^ -An error log .txt file can be created to show details about an error and where -it occurred. To generate an error log, add the switch *log* after -**fehmpytests.py** and before ****. Here is an example: - -``python fehmpytests.py --admin --log `` - - - diff --git a/docs/fehmpytests/html/_static/ajax-loader.gif b/docs/fehmpytests/html/_static/ajax-loader.gif deleted file mode 100644 index 61faf8cab23993bd3e1560bff0668bd628642330..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 673 zcmZ?wbhEHb6krfw_{6~Q|Nno%(3)e{?)x>&1u}A`t?OF7Z|1gRivOgXi&7IyQd1Pl zGfOfQ60;I3a`F>X^fL3(@);C=vM_KlFfb_o=k{|A33hf2a5d61U}gjg=>Rd%XaNQW zW@Cw{|b%Y*pl8F?4B9 zlo4Fz*0kZGJabY|>}Okf0}CCg{u4`zEPY^pV?j2@h+|igy0+Kz6p;@SpM4s6)XEMg z#3Y4GX>Hjlml5ftdH$4x0JGdn8~MX(U~_^d!Hi)=HU{V%g+mi8#UGbE-*ao8f#h+S z2a0-5+vc7MU$e-NhmBjLIC1v|)9+Im8x1yacJ7{^tLX(ZhYi^rpmXm0`@ku9b53aN zEXH@Y3JaztblgpxbJt{AtE1ad1Ca>{v$rwwvK(>{m~Gf_=-Ro7Fk{#;i~+{{>QtvI yb2P8Zac~?~=sRA>$6{!(^3;ZP0TPFR(G_-UDU(8Jl0?(IXu$~#4A!880|o%~Al1tN diff --git a/docs/fehmpytests/html/_static/basic.css b/docs/fehmpytests/html/_static/basic.css deleted file mode 100644 index 104f076a..00000000 --- a/docs/fehmpytests/html/_static/basic.css +++ /dev/null @@ -1,676 +0,0 @@ -/* - * basic.css - * ~~~~~~~~~ - * - * Sphinx stylesheet -- basic theme. - * - * :copyright: Copyright 2007-2018 by the Sphinx team, see AUTHORS. - * :license: BSD, see LICENSE for details. - * - */ - -/* -- main layout ----------------------------------------------------------- */ - -div.clearer { - clear: both; -} - -/* -- relbar ---------------------------------------------------------------- */ - -div.related { - width: 100%; - font-size: 90%; -} - -div.related h3 { - display: none; -} - -div.related ul { - margin: 0; - padding: 0 0 0 10px; - list-style: none; -} - -div.related li { - display: inline; -} - -div.related li.right { - float: right; - margin-right: 5px; -} - -/* -- sidebar --------------------------------------------------------------- */ - -div.sphinxsidebarwrapper { - padding: 10px 5px 0 10px; -} - -div.sphinxsidebar { - float: left; - width: 230px; - margin-left: -100%; - font-size: 90%; - word-wrap: break-word; - overflow-wrap : break-word; -} - -div.sphinxsidebar ul { - list-style: none; -} - -div.sphinxsidebar ul ul, -div.sphinxsidebar ul.want-points { - margin-left: 20px; - list-style: square; -} - -div.sphinxsidebar ul ul { - margin-top: 0; - margin-bottom: 0; -} - -div.sphinxsidebar form { - margin-top: 10px; -} - -div.sphinxsidebar input { - border: 1px solid #98dbcc; - font-family: sans-serif; - font-size: 1em; -} - -div.sphinxsidebar #searchbox form.search { - overflow: hidden; -} - -div.sphinxsidebar #searchbox input[type="text"] { - float: left; - width: 80%; - padding: 0.25em; - box-sizing: border-box; -} - -div.sphinxsidebar #searchbox input[type="submit"] { - float: left; - width: 20%; - border-left: none; - padding: 0.25em; - box-sizing: border-box; -} - - -img { - border: 0; - max-width: 100%; -} - -/* -- search page ----------------------------------------------------------- */ - -ul.search { - margin: 10px 0 0 20px; - padding: 0; -} - -ul.search li { - padding: 5px 0 5px 20px; - background-image: url(file.png); - background-repeat: no-repeat; - background-position: 0 7px; -} - -ul.search li a { - font-weight: bold; -} - -ul.search li div.context { - color: #888; - margin: 2px 0 0 30px; - text-align: left; -} - -ul.keywordmatches li.goodmatch a { - font-weight: bold; -} - -/* -- index page ------------------------------------------------------------ */ - -table.contentstable { - width: 90%; - margin-left: auto; - margin-right: auto; -} - -table.contentstable p.biglink { - line-height: 150%; -} - -a.biglink { - font-size: 1.3em; -} - -span.linkdescr { - font-style: italic; - padding-top: 5px; - font-size: 90%; -} - -/* -- general index --------------------------------------------------------- */ - -table.indextable { - width: 100%; -} - -table.indextable td { - text-align: left; - vertical-align: top; -} - -table.indextable ul { - margin-top: 0; - margin-bottom: 0; - list-style-type: none; -} - -table.indextable > tbody > tr > td > ul { - padding-left: 0em; -} - -table.indextable tr.pcap { - height: 10px; -} - -table.indextable tr.cap { - margin-top: 10px; - background-color: #f2f2f2; -} - -img.toggler { - margin-right: 3px; - margin-top: 3px; - cursor: pointer; -} - -div.modindex-jumpbox { - border-top: 1px solid #ddd; - border-bottom: 1px solid #ddd; - margin: 1em 0 1em 0; - padding: 0.4em; -} - -div.genindex-jumpbox { - border-top: 1px solid #ddd; - border-bottom: 1px solid #ddd; - margin: 1em 0 1em 0; - padding: 0.4em; -} - -/* -- domain module index --------------------------------------------------- */ - -table.modindextable td { - padding: 2px; - border-collapse: collapse; -} - -/* -- general body styles --------------------------------------------------- */ - -div.body { - min-width: 450px; - max-width: 800px; -} - -div.body p, div.body dd, div.body li, div.body blockquote { - -moz-hyphens: auto; - -ms-hyphens: auto; - -webkit-hyphens: auto; - hyphens: auto; -} - -a.headerlink { - visibility: hidden; -} - -h1:hover > a.headerlink, -h2:hover > a.headerlink, -h3:hover > a.headerlink, -h4:hover > a.headerlink, -h5:hover > a.headerlink, -h6:hover > a.headerlink, -dt:hover > a.headerlink, -caption:hover > a.headerlink, -p.caption:hover > a.headerlink, -div.code-block-caption:hover > a.headerlink { - visibility: visible; -} - -div.body p.caption { - text-align: inherit; -} - -div.body td { - text-align: left; -} - -.first { - margin-top: 0 !important; -} - -p.rubric { - margin-top: 30px; - font-weight: bold; -} - -img.align-left, .figure.align-left, object.align-left { - clear: left; - float: left; - margin-right: 1em; -} - -img.align-right, .figure.align-right, object.align-right { - clear: right; - float: right; - margin-left: 1em; -} - -img.align-center, .figure.align-center, object.align-center { - display: block; - margin-left: auto; - margin-right: auto; -} - -.align-left { - text-align: left; -} - -.align-center { - text-align: center; -} - -.align-right { - text-align: right; -} - -/* -- sidebars -------------------------------------------------------------- */ - -div.sidebar { - margin: 0 0 0.5em 1em; - border: 1px solid #ddb; - padding: 7px 7px 0 7px; - background-color: #ffe; - width: 40%; - float: right; -} - -p.sidebar-title { - font-weight: bold; -} - -/* -- topics ---------------------------------------------------------------- */ - -div.topic { - border: 1px solid #ccc; - padding: 7px 7px 0 7px; - margin: 10px 0 10px 0; -} - -p.topic-title { - font-size: 1.1em; - font-weight: bold; - margin-top: 10px; -} - -/* -- admonitions ----------------------------------------------------------- */ - -div.admonition { - margin-top: 10px; - margin-bottom: 10px; - padding: 7px; -} - -div.admonition dt { - font-weight: bold; -} - -div.admonition dl { - margin-bottom: 0; -} - -p.admonition-title { - margin: 0px 10px 5px 0px; - font-weight: bold; -} - -div.body p.centered { - text-align: center; - margin-top: 25px; -} - -/* -- tables ---------------------------------------------------------------- */ - -table.docutils { - border: 0; - border-collapse: collapse; -} - -table.align-center { - margin-left: auto; - margin-right: auto; -} - -table caption span.caption-number { - font-style: italic; -} - -table caption span.caption-text { -} - -table.docutils td, table.docutils th { - padding: 1px 8px 1px 5px; - border-top: 0; - border-left: 0; - border-right: 0; - border-bottom: 1px solid #aaa; -} - -table.footnote td, table.footnote th { - border: 0 !important; -} - -th { - text-align: left; - padding-right: 5px; -} - -table.citation { - border-left: solid 1px gray; - margin-left: 1px; -} - -table.citation td { - border-bottom: none; -} - -/* -- figures --------------------------------------------------------------- */ - -div.figure { - margin: 0.5em; - padding: 0.5em; -} - -div.figure p.caption { - padding: 0.3em; -} - -div.figure p.caption span.caption-number { - font-style: italic; -} - -div.figure p.caption span.caption-text { -} - -/* -- field list styles ----------------------------------------------------- */ - -table.field-list td, table.field-list th { - border: 0 !important; -} - -.field-list ul { - margin: 0; - padding-left: 1em; -} - -.field-list p { - margin: 0; -} - -.field-name { - -moz-hyphens: manual; - -ms-hyphens: manual; - -webkit-hyphens: manual; - hyphens: manual; -} - -/* -- hlist styles ---------------------------------------------------------- */ - -table.hlist td { - vertical-align: top; -} - - -/* -- other body styles ----------------------------------------------------- */ - -ol.arabic { - list-style: decimal; -} - -ol.loweralpha { - list-style: lower-alpha; -} - -ol.upperalpha { - list-style: upper-alpha; -} - -ol.lowerroman { - list-style: lower-roman; -} - -ol.upperroman { - list-style: upper-roman; -} - -dl { - margin-bottom: 15px; -} - -dd p { - margin-top: 0px; -} - -dd ul, dd table { - margin-bottom: 10px; -} - -dd { - margin-top: 3px; - margin-bottom: 10px; - margin-left: 30px; -} - -dt:target, span.highlighted { - background-color: #fbe54e; -} - -rect.highlighted { - fill: #fbe54e; -} - -dl.glossary dt { - font-weight: bold; - font-size: 1.1em; -} - -.optional { - font-size: 1.3em; -} - -.sig-paren { - font-size: larger; -} - -.versionmodified { - font-style: italic; -} - -.system-message { - background-color: #fda; - padding: 5px; - border: 3px solid red; -} - -.footnote:target { - background-color: #ffa; -} - -.line-block { - display: block; - margin-top: 1em; - margin-bottom: 1em; -} - -.line-block .line-block { - margin-top: 0; - margin-bottom: 0; - margin-left: 1.5em; -} - -.guilabel, .menuselection { - font-family: sans-serif; -} - -.accelerator { - text-decoration: underline; -} - -.classifier { - font-style: oblique; -} - -abbr, acronym { - border-bottom: dotted 1px; - cursor: help; -} - -/* -- code displays --------------------------------------------------------- */ - -pre { - overflow: auto; - overflow-y: hidden; /* fixes display issues on Chrome browsers */ -} - -span.pre { - -moz-hyphens: none; - -ms-hyphens: none; - -webkit-hyphens: none; - hyphens: none; -} - -td.linenos pre { - padding: 5px 0px; - border: 0; - background-color: transparent; - color: #aaa; -} - -table.highlighttable { - margin-left: 0.5em; -} - -table.highlighttable td { - padding: 0 0.5em 0 0.5em; -} - -div.code-block-caption { - padding: 2px 5px; - font-size: small; -} - -div.code-block-caption code { - background-color: transparent; -} - -div.code-block-caption + div > div.highlight > pre { - margin-top: 0; -} - -div.code-block-caption span.caption-number { - padding: 0.1em 0.3em; - font-style: italic; -} - -div.code-block-caption span.caption-text { -} - -div.literal-block-wrapper { - padding: 1em 1em 0; -} - -div.literal-block-wrapper div.highlight { - margin: 0; -} - -code.descname { - background-color: transparent; - font-weight: bold; - font-size: 1.2em; -} - -code.descclassname { - background-color: transparent; -} - -code.xref, a code { - background-color: transparent; - font-weight: bold; -} - -h1 code, h2 code, h3 code, h4 code, h5 code, h6 code { - background-color: transparent; -} - -.viewcode-link { - float: right; -} - -.viewcode-back { - float: right; - font-family: sans-serif; -} - -div.viewcode-block:target { - margin: -1px -10px; - padding: 0 10px; -} - -/* -- math display ---------------------------------------------------------- */ - -img.math { - vertical-align: middle; -} - -div.body div.math p { - text-align: center; -} - -span.eqno { - float: right; -} - -span.eqno a.headerlink { - position: relative; - left: 0px; - z-index: 1; -} - -div.math:hover a.headerlink { - visibility: visible; -} - -/* -- printout stylesheet --------------------------------------------------- */ - -@media print { - div.document, - div.documentwrapper, - div.bodywrapper { - margin: 0 !important; - width: 100%; - } - - div.sphinxsidebar, - div.related, - div.footer, - #top-link { - display: none; - } -} \ No newline at end of file diff --git a/docs/fehmpytests/html/_static/classic.css b/docs/fehmpytests/html/_static/classic.css deleted file mode 100644 index 6cfbfb9c..00000000 --- a/docs/fehmpytests/html/_static/classic.css +++ /dev/null @@ -1,261 +0,0 @@ -/* - * classic.css_t - * ~~~~~~~~~~~~~ - * - * Sphinx stylesheet -- classic theme. - * - * :copyright: Copyright 2007-2018 by the Sphinx team, see AUTHORS. - * :license: BSD, see LICENSE for details. - * - */ - -@import url("basic.css"); - -/* -- page layout ----------------------------------------------------------- */ - -body { - font-family: sans-serif; - font-size: 100%; - background-color: #11303d; - color: #000; - margin: 0; - padding: 0; -} - -div.document { - background-color: #1c4e63; -} - -div.documentwrapper { - float: left; - width: 100%; -} - -div.bodywrapper { - margin: 0 0 0 230px; -} - -div.body { - background-color: #ffffff; - color: #000000; - padding: 0 20px 30px 20px; -} - -div.footer { - color: #ffffff; - width: 100%; - padding: 9px 0 9px 0; - text-align: center; - font-size: 75%; -} - -div.footer a { - color: #ffffff; - text-decoration: underline; -} - -div.related { - background-color: #133f52; - line-height: 30px; - color: #ffffff; -} - -div.related a { - color: #ffffff; -} - -div.sphinxsidebar { -} - -div.sphinxsidebar h3 { - font-family: 'Trebuchet MS', sans-serif; - color: #ffffff; - font-size: 1.4em; - font-weight: normal; - margin: 0; - padding: 0; -} - -div.sphinxsidebar h3 a { - color: #ffffff; -} - -div.sphinxsidebar h4 { - font-family: 'Trebuchet MS', sans-serif; - color: #ffffff; - font-size: 1.3em; - font-weight: normal; - margin: 5px 0 0 0; - padding: 0; -} - -div.sphinxsidebar p { - color: #ffffff; -} - -div.sphinxsidebar p.topless { - margin: 5px 10px 10px 10px; -} - -div.sphinxsidebar ul { - margin: 10px; - padding: 0; - color: #ffffff; -} - -div.sphinxsidebar a { - color: #98dbcc; -} - -div.sphinxsidebar input { - border: 1px solid #98dbcc; - font-family: sans-serif; - font-size: 1em; -} - - - -/* -- hyperlink styles ------------------------------------------------------ */ - -a { - color: #355f7c; - text-decoration: none; -} - -a:visited { - color: #355f7c; - text-decoration: none; -} - -a:hover { - text-decoration: underline; -} - - - -/* -- body styles ----------------------------------------------------------- */ - -div.body h1, -div.body h2, -div.body h3, -div.body h4, -div.body h5, -div.body h6 { - font-family: 'Trebuchet MS', sans-serif; - background-color: #f2f2f2; - font-weight: normal; - color: #20435c; - border-bottom: 1px solid #ccc; - margin: 20px -20px 10px -20px; - padding: 3px 0 3px 10px; -} - -div.body h1 { margin-top: 0; font-size: 200%; } -div.body h2 { font-size: 160%; } -div.body h3 { font-size: 140%; } -div.body h4 { font-size: 120%; } -div.body h5 { font-size: 110%; } -div.body h6 { font-size: 100%; } - -a.headerlink { - color: #c60f0f; - font-size: 0.8em; - padding: 0 4px 0 4px; - text-decoration: none; -} - -a.headerlink:hover { - background-color: #c60f0f; - color: white; -} - -div.body p, div.body dd, div.body li, div.body blockquote { - text-align: justify; - line-height: 130%; -} - -div.admonition p.admonition-title + p { - display: inline; -} - -div.admonition p { - margin-bottom: 5px; -} - -div.admonition pre { - margin-bottom: 5px; -} - -div.admonition ul, div.admonition ol { - margin-bottom: 5px; -} - -div.note { - background-color: #eee; - border: 1px solid #ccc; -} - -div.seealso { - background-color: #ffc; - border: 1px solid #ff6; -} - -div.topic { - background-color: #eee; -} - -div.warning { - background-color: #ffe4e4; - border: 1px solid #f66; -} - -p.admonition-title { - display: inline; -} - -p.admonition-title:after { - content: ":"; -} - -pre { - padding: 5px; - background-color: #eeffcc; - color: #333333; - line-height: 120%; - border: 1px solid #ac9; - border-left: none; - border-right: none; -} - -code { - background-color: #ecf0f3; - padding: 0 1px 0 1px; - font-size: 0.95em; -} - -th { - background-color: #ede; -} - -.warning code { - background: #efc2c2; -} - -.note code { - background: #d6d6d6; -} - -.viewcode-back { - font-family: sans-serif; -} - -div.viewcode-block:target { - background-color: #f4debf; - border-top: 1px solid #ac9; - border-bottom: 1px solid #ac9; -} - -div.code-block-caption { - color: #efefef; - background-color: #1c4e63; -} \ No newline at end of file diff --git a/docs/fehmpytests/html/_static/comment-bright.png b/docs/fehmpytests/html/_static/comment-bright.png deleted file mode 100644 index 15e27edb12ac25701ac0ac21b97b52bb4e45415e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 756 zcmVgfIX78 z$8Pzv({A~p%??+>KickCb#0FM1rYN=mBmQ&Nwp<#JXUhU;{|)}%&s>suq6lXw*~s{ zvHx}3C%<;wE5CH!BR{p5@ml9ws}y)=QN-kL2?#`S5d*6j zk`h<}j1>tD$b?4D^N9w}-k)bxXxFg>+#kme^xx#qg6FI-%iv2U{0h(Y)cs%5a|m%Pn_K3X_bDJ>EH#(Fb73Z zfUt2Q3B>N+ot3qb*DqbTZpFIn4a!#_R-}{?-~Hs=xSS6p&$sZ-k1zDdtqU`Y@`#qL z&zv-~)Q#JCU(dI)Hf;$CEnK=6CK50}q7~wdbI->?E07bJ0R;!GSQTs5Am`#;*WHjvHRvY?&$Lm-vq1a_BzocI^ULXV!lbMd%|^B#fY;XX)n<&R^L z=84u1e_3ziq;Hz-*k5~zwY3*oDKt0;bM@M@@89;@m*4RFgvvM_4;5LB!@OB@^WbVT zjl{t;a8_>od-~P4 m{5|DvB&z#xT;*OnJqG}gk~_7HcNkCr0000W zanA~u9RIXo;n7c96&U)YLgs-FGlx~*_c{Jgvesu1E5(8YEf&5wF=YFPcRe@1=MJmi zag(L*xc2r0(slpcN!vC5CUju;vHJkHc*&70_n2OZsK%O~A=!+YIw z7zLLl7~Z+~RgWOQ=MI6$#0pvpu$Q43 zP@36QAmu6!_9NPM?o<1_!+stoVRRZbW9#SPe!n;#A_6m8f}|xN1;H{`0RoXQ2LM47 zt(g;iZ6|pCb@h2xk&(}S3=EVBUO0e90m2Lp5CB<(SPIaB;n4))3JB87Or#XPOPcum z?<^(g+m9}VNn4Y&B`g8h{t_$+RB1%HKRY6fjtd-<7&EsU;vs0GM(Lmbhi%Gwcfs0FTF}T zL{_M6Go&E0Eg8FuB*(Yn+Z*RVTBE@10eIOb3El^MhO`GabDll(V0&FlJi2k^;q8af zkENdk2}x2)_KVp`5OAwXZM;dG0?M-S)xE1IKDi6BY@5%Or?#aZ9$gcX)dPZ&wA1a< z$rFXHPn|TBf`e?>Are8sKtKrKcjF$i^lp!zkL?C|y^vlHr1HXeVJd;1I~g&Ob-q)& z(fn7s-KI}G{wnKzg_U5G(V%bX6uk zIa+<@>rdmZYd!9Y=C0cuchrbIjuRB_Wq{-RXlic?flu1*_ux}x%(HDH&nT`k^xCeC ziHi1!ChH*sQ6|UqJpTTzX$aw8e(UfcS^f;6yBWd+(1-70zU(rtxtqR%j z-lsH|CKQJXqD{+F7V0OTv8@{~(wp(`oIP^ZykMWgR>&|RsklFMCnOo&Bd{le} zV5F6424Qzl;o2G%oVvmHgRDP9!=rK8fy^!yV8y*4p=??uIRrrr0?>O!(z*g5AvL2!4z0{sq%vhG*Po}`a<6%kTK5TNhtC8}rXNu&h^QH4A&Sk~Autm*s~45(H7+0bi^MraaRVzr05hQ3iK?j` zR#U@^i0WhkIHTg29u~|ypU?sXCQEQgXfObPW;+0YAF;|5XyaMAEM0sQ@4-xCZe=0e z7r$ofiAxn@O5#RodD8rh5D@nKQ;?lcf@tg4o+Wp44aMl~c47azN_(im0N)7OqdPBC zGw;353_o$DqGRDhuhU$Eaj!@m000000NkvXXu0mjfjZ7Z_ diff --git a/docs/fehmpytests/html/_static/default.css b/docs/fehmpytests/html/_static/default.css deleted file mode 100644 index 81b93636..00000000 --- a/docs/fehmpytests/html/_static/default.css +++ /dev/null @@ -1 +0,0 @@ -@import url("classic.css"); diff --git a/docs/fehmpytests/html/_static/doctools.js b/docs/fehmpytests/html/_static/doctools.js deleted file mode 100644 index ffadbec1..00000000 --- a/docs/fehmpytests/html/_static/doctools.js +++ /dev/null @@ -1,315 +0,0 @@ -/* - * doctools.js - * ~~~~~~~~~~~ - * - * Sphinx JavaScript utilities for all documentation. - * - * :copyright: Copyright 2007-2018 by the Sphinx team, see AUTHORS. - * :license: BSD, see LICENSE for details. - * - */ - -/** - * select a different prefix for underscore - */ -$u = _.noConflict(); - -/** - * make the code below compatible with browsers without - * an installed firebug like debugger -if (!window.console || !console.firebug) { - var names = ["log", "debug", "info", "warn", "error", "assert", "dir", - "dirxml", "group", "groupEnd", "time", "timeEnd", "count", "trace", - "profile", "profileEnd"]; - window.console = {}; - for (var i = 0; i < names.length; ++i) - window.console[names[i]] = function() {}; -} - */ - -/** - * small helper function to urldecode strings - */ -jQuery.urldecode = function(x) { - return decodeURIComponent(x).replace(/\+/g, ' '); -}; - -/** - * small helper function to urlencode strings - */ -jQuery.urlencode = encodeURIComponent; - -/** - * This function returns the parsed url parameters of the - * current request. Multiple values per key are supported, - * it will always return arrays of strings for the value parts. - */ -jQuery.getQueryParameters = function(s) { - if (typeof s === 'undefined') - s = document.location.search; - var parts = s.substr(s.indexOf('?') + 1).split('&'); - var result = {}; - for (var i = 0; i < parts.length; i++) { - var tmp = parts[i].split('=', 2); - var key = jQuery.urldecode(tmp[0]); - var value = jQuery.urldecode(tmp[1]); - if (key in result) - result[key].push(value); - else - result[key] = [value]; - } - return result; -}; - -/** - * highlight a given string on a jquery object by wrapping it in - * span elements with the given class name. - */ -jQuery.fn.highlightText = function(text, className) { - function highlight(node, addItems) { - if (node.nodeType === 3) { - var val = node.nodeValue; - var pos = val.toLowerCase().indexOf(text); - if (pos >= 0 && - !jQuery(node.parentNode).hasClass(className) && - !jQuery(node.parentNode).hasClass("nohighlight")) { - var span; - var isInSVG = jQuery(node).closest("body, svg, foreignObject").is("svg"); - if (isInSVG) { - span = document.createElementNS("http://www.w3.org/2000/svg", "tspan"); - } else { - span = document.createElement("span"); - span.className = className; - } - span.appendChild(document.createTextNode(val.substr(pos, text.length))); - node.parentNode.insertBefore(span, node.parentNode.insertBefore( - document.createTextNode(val.substr(pos + text.length)), - node.nextSibling)); - node.nodeValue = val.substr(0, pos); - if (isInSVG) { - var bbox = span.getBBox(); - var rect = document.createElementNS("http://www.w3.org/2000/svg", "rect"); - rect.x.baseVal.value = bbox.x; - rect.y.baseVal.value = bbox.y; - rect.width.baseVal.value = bbox.width; - rect.height.baseVal.value = bbox.height; - rect.setAttribute('class', className); - var parentOfText = node.parentNode.parentNode; - addItems.push({ - "parent": node.parentNode, - "target": rect}); - } - } - } - else if (!jQuery(node).is("button, select, textarea")) { - jQuery.each(node.childNodes, function() { - highlight(this, addItems); - }); - } - } - var addItems = []; - var result = this.each(function() { - highlight(this, addItems); - }); - for (var i = 0; i < addItems.length; ++i) { - jQuery(addItems[i].parent).before(addItems[i].target); - } - return result; -}; - -/* - * backward compatibility for jQuery.browser - * This will be supported until firefox bug is fixed. - */ -if (!jQuery.browser) { - jQuery.uaMatch = function(ua) { - ua = ua.toLowerCase(); - - var match = /(chrome)[ \/]([\w.]+)/.exec(ua) || - /(webkit)[ \/]([\w.]+)/.exec(ua) || - /(opera)(?:.*version|)[ \/]([\w.]+)/.exec(ua) || - /(msie) ([\w.]+)/.exec(ua) || - ua.indexOf("compatible") < 0 && /(mozilla)(?:.*? rv:([\w.]+)|)/.exec(ua) || - []; - - return { - browser: match[ 1 ] || "", - version: match[ 2 ] || "0" - }; - }; - jQuery.browser = {}; - jQuery.browser[jQuery.uaMatch(navigator.userAgent).browser] = true; -} - -/** - * Small JavaScript module for the documentation. - */ -var Documentation = { - - init : function() { - this.fixFirefoxAnchorBug(); - this.highlightSearchWords(); - this.initIndexTable(); - if (DOCUMENTATION_OPTIONS.NAVIGATION_WITH_KEYS) { - this.initOnKeyListeners(); - } - }, - - /** - * i18n support - */ - TRANSLATIONS : {}, - PLURAL_EXPR : function(n) { return n === 1 ? 0 : 1; }, - LOCALE : 'unknown', - - // gettext and ngettext don't access this so that the functions - // can safely bound to a different name (_ = Documentation.gettext) - gettext : function(string) { - var translated = Documentation.TRANSLATIONS[string]; - if (typeof translated === 'undefined') - return string; - return (typeof translated === 'string') ? translated : translated[0]; - }, - - ngettext : function(singular, plural, n) { - var translated = Documentation.TRANSLATIONS[singular]; - if (typeof translated === 'undefined') - return (n == 1) ? singular : plural; - return translated[Documentation.PLURALEXPR(n)]; - }, - - addTranslations : function(catalog) { - for (var key in catalog.messages) - this.TRANSLATIONS[key] = catalog.messages[key]; - this.PLURAL_EXPR = new Function('n', 'return +(' + catalog.plural_expr + ')'); - this.LOCALE = catalog.locale; - }, - - /** - * add context elements like header anchor links - */ - addContextElements : function() { - $('div[id] > :header:first').each(function() { - $('\u00B6'). - attr('href', '#' + this.id). - attr('title', _('Permalink to this headline')). - appendTo(this); - }); - $('dt[id]').each(function() { - $('\u00B6'). - attr('href', '#' + this.id). - attr('title', _('Permalink to this definition')). - appendTo(this); - }); - }, - - /** - * workaround a firefox stupidity - * see: https://bugzilla.mozilla.org/show_bug.cgi?id=645075 - */ - fixFirefoxAnchorBug : function() { - if (document.location.hash && $.browser.mozilla) - window.setTimeout(function() { - document.location.href += ''; - }, 10); - }, - - /** - * highlight the search words provided in the url in the text - */ - highlightSearchWords : function() { - var params = $.getQueryParameters(); - var terms = (params.highlight) ? params.highlight[0].split(/\s+/) : []; - if (terms.length) { - var body = $('div.body'); - if (!body.length) { - body = $('body'); - } - window.setTimeout(function() { - $.each(terms, function() { - body.highlightText(this.toLowerCase(), 'highlighted'); - }); - }, 10); - $('

' + _('Hide Search Matches') + '

') - .appendTo($('#searchbox')); - } - }, - - /** - * init the domain index toggle buttons - */ - initIndexTable : function() { - var togglers = $('img.toggler').click(function() { - var src = $(this).attr('src'); - var idnum = $(this).attr('id').substr(7); - $('tr.cg-' + idnum).toggle(); - if (src.substr(-9) === 'minus.png') - $(this).attr('src', src.substr(0, src.length-9) + 'plus.png'); - else - $(this).attr('src', src.substr(0, src.length-8) + 'minus.png'); - }).css('display', ''); - if (DOCUMENTATION_OPTIONS.COLLAPSE_INDEX) { - togglers.click(); - } - }, - - /** - * helper function to hide the search marks again - */ - hideSearchWords : function() { - $('#searchbox .highlight-link').fadeOut(300); - $('span.highlighted').removeClass('highlighted'); - }, - - /** - * make the url absolute - */ - makeURL : function(relativeURL) { - return DOCUMENTATION_OPTIONS.URL_ROOT + '/' + relativeURL; - }, - - /** - * get the current relative url - */ - getCurrentURL : function() { - var path = document.location.pathname; - var parts = path.split(/\//); - $.each(DOCUMENTATION_OPTIONS.URL_ROOT.split(/\//), function() { - if (this === '..') - parts.pop(); - }); - var url = parts.join('/'); - return path.substring(url.lastIndexOf('/') + 1, path.length - 1); - }, - - initOnKeyListeners: function() { - $(document).keyup(function(event) { - var activeElementType = document.activeElement.tagName; - // don't navigate when in search box or textarea - if (activeElementType !== 'TEXTAREA' && activeElementType !== 'INPUT' && activeElementType !== 'SELECT') { - switch (event.keyCode) { - case 37: // left - var prevHref = $('link[rel="prev"]').prop('href'); - if (prevHref) { - window.location.href = prevHref; - return false; - } - case 39: // right - var nextHref = $('link[rel="next"]').prop('href'); - if (nextHref) { - window.location.href = nextHref; - return false; - } - } - } - }); - } -}; - -// quick alias for translations -_ = Documentation.gettext; - -$(document).ready(function() { - Documentation.init(); -}); diff --git a/docs/fehmpytests/html/_static/documentation_options.js b/docs/fehmpytests/html/_static/documentation_options.js deleted file mode 100644 index 837eacf3..00000000 --- a/docs/fehmpytests/html/_static/documentation_options.js +++ /dev/null @@ -1,296 +0,0 @@ -var DOCUMENTATION_OPTIONS = { - URL_ROOT: document.getElementById("documentation_options").getAttribute('data-url_root'), - VERSION: '1.0', - LANGUAGE: 'None', - COLLAPSE_INDEX: false, - FILE_SUFFIX: '.html', - HAS_SOURCE: true, - SOURCELINK_SUFFIX: '.txt', - NAVIGATION_WITH_KEYS: false, - SEARCH_LANGUAGE_STOP_WORDS: ["a","and","are","as","at","be","but","by","for","if","in","into","is","it","near","no","not","of","on","or","such","that","the","their","then","there","these","they","this","to","was","will","with"] -}; - - - -/* Non-minified version JS is _stemmer.js if file is provided */ -/** - * Porter Stemmer - */ -var Stemmer = function() { - - var step2list = { - ational: 'ate', - tional: 'tion', - enci: 'ence', - anci: 'ance', - izer: 'ize', - bli: 'ble', - alli: 'al', - entli: 'ent', - eli: 'e', - ousli: 'ous', - ization: 'ize', - ation: 'ate', - ator: 'ate', - alism: 'al', - iveness: 'ive', - fulness: 'ful', - ousness: 'ous', - aliti: 'al', - iviti: 'ive', - biliti: 'ble', - logi: 'log' - }; - - var step3list = { - icate: 'ic', - ative: '', - alize: 'al', - iciti: 'ic', - ical: 'ic', - ful: '', - ness: '' - }; - - var c = "[^aeiou]"; // consonant - var v = "[aeiouy]"; // vowel - var C = c + "[^aeiouy]*"; // consonant sequence - var V = v + "[aeiou]*"; // vowel sequence - - var mgr0 = "^(" + C + ")?" + V + C; // [C]VC... is m>0 - var meq1 = "^(" + C + ")?" + V + C + "(" + V + ")?$"; // [C]VC[V] is m=1 - var mgr1 = "^(" + C + ")?" + V + C + V + C; // [C]VCVC... is m>1 - var s_v = "^(" + C + ")?" + v; // vowel in stem - - this.stemWord = function (w) { - var stem; - var suffix; - var firstch; - var origword = w; - - if (w.length < 3) - return w; - - var re; - var re2; - var re3; - var re4; - - firstch = w.substr(0,1); - if (firstch == "y") - w = firstch.toUpperCase() + w.substr(1); - - // Step 1a - re = /^(.+?)(ss|i)es$/; - re2 = /^(.+?)([^s])s$/; - - if (re.test(w)) - w = w.replace(re,"$1$2"); - else if (re2.test(w)) - w = w.replace(re2,"$1$2"); - - // Step 1b - re = /^(.+?)eed$/; - re2 = /^(.+?)(ed|ing)$/; - if (re.test(w)) { - var fp = re.exec(w); - re = new RegExp(mgr0); - if (re.test(fp[1])) { - re = /.$/; - w = w.replace(re,""); - } - } - else if (re2.test(w)) { - var fp = re2.exec(w); - stem = fp[1]; - re2 = new RegExp(s_v); - if (re2.test(stem)) { - w = stem; - re2 = /(at|bl|iz)$/; - re3 = new RegExp("([^aeiouylsz])\\1$"); - re4 = new RegExp("^" + C + v + "[^aeiouwxy]$"); - if (re2.test(w)) - w = w + "e"; - else if (re3.test(w)) { - re = /.$/; - w = w.replace(re,""); - } - else if (re4.test(w)) - w = w + "e"; - } - } - - // Step 1c - re = /^(.+?)y$/; - if (re.test(w)) { - var fp = re.exec(w); - stem = fp[1]; - re = new RegExp(s_v); - if (re.test(stem)) - w = stem + "i"; - } - - // Step 2 - re = /^(.+?)(ational|tional|enci|anci|izer|bli|alli|entli|eli|ousli|ization|ation|ator|alism|iveness|fulness|ousness|aliti|iviti|biliti|logi)$/; - if (re.test(w)) { - var fp = re.exec(w); - stem = fp[1]; - suffix = fp[2]; - re = new RegExp(mgr0); - if (re.test(stem)) - w = stem + step2list[suffix]; - } - - // Step 3 - re = /^(.+?)(icate|ative|alize|iciti|ical|ful|ness)$/; - if (re.test(w)) { - var fp = re.exec(w); - stem = fp[1]; - suffix = fp[2]; - re = new RegExp(mgr0); - if (re.test(stem)) - w = stem + step3list[suffix]; - } - - // Step 4 - re = /^(.+?)(al|ance|ence|er|ic|able|ible|ant|ement|ment|ent|ou|ism|ate|iti|ous|ive|ize)$/; - re2 = /^(.+?)(s|t)(ion)$/; - if (re.test(w)) { - var fp = re.exec(w); - stem = fp[1]; - re = new RegExp(mgr1); - if (re.test(stem)) - w = stem; - } - else if (re2.test(w)) { - var fp = re2.exec(w); - stem = fp[1] + fp[2]; - re2 = new RegExp(mgr1); - if (re2.test(stem)) - w = stem; - } - - // Step 5 - re = /^(.+?)e$/; - if (re.test(w)) { - var fp = re.exec(w); - stem = fp[1]; - re = new RegExp(mgr1); - re2 = new RegExp(meq1); - re3 = new RegExp("^" + C + v + "[^aeiouwxy]$"); - if (re.test(stem) || (re2.test(stem) && !(re3.test(stem)))) - w = stem; - } - re = /ll$/; - re2 = new RegExp(mgr1); - if (re.test(w) && re2.test(w)) { - re = /.$/; - w = w.replace(re,""); - } - - // and turn initial Y back to y - if (firstch == "y") - w = firstch.toLowerCase() + w.substr(1); - return w; - } -} - - - - - -var splitChars = (function() { - var result = {}; - var singles = [96, 180, 187, 191, 215, 247, 749, 885, 903, 907, 909, 930, 1014, 1648, - 1748, 1809, 2416, 2473, 2481, 2526, 2601, 2609, 2612, 2615, 2653, 2702, - 2706, 2729, 2737, 2740, 2857, 2865, 2868, 2910, 2928, 2948, 2961, 2971, - 2973, 3085, 3089, 3113, 3124, 3213, 3217, 3241, 3252, 3295, 3341, 3345, - 3369, 3506, 3516, 3633, 3715, 3721, 3736, 3744, 3748, 3750, 3756, 3761, - 3781, 3912, 4239, 4347, 4681, 4695, 4697, 4745, 4785, 4799, 4801, 4823, - 4881, 5760, 5901, 5997, 6313, 7405, 8024, 8026, 8028, 8030, 8117, 8125, - 8133, 8181, 8468, 8485, 8487, 8489, 8494, 8527, 11311, 11359, 11687, 11695, - 11703, 11711, 11719, 11727, 11735, 12448, 12539, 43010, 43014, 43019, 43587, - 43696, 43713, 64286, 64297, 64311, 64317, 64319, 64322, 64325, 65141]; - var i, j, start, end; - for (i = 0; i < singles.length; i++) { - result[singles[i]] = true; - } - var ranges = [[0, 47], [58, 64], [91, 94], [123, 169], [171, 177], [182, 184], [706, 709], - [722, 735], [741, 747], [751, 879], [888, 889], [894, 901], [1154, 1161], - [1318, 1328], [1367, 1368], [1370, 1376], [1416, 1487], [1515, 1519], [1523, 1568], - [1611, 1631], [1642, 1645], [1750, 1764], [1767, 1773], [1789, 1790], [1792, 1807], - [1840, 1868], [1958, 1968], [1970, 1983], [2027, 2035], [2038, 2041], [2043, 2047], - [2070, 2073], [2075, 2083], [2085, 2087], [2089, 2307], [2362, 2364], [2366, 2383], - [2385, 2391], [2402, 2405], [2419, 2424], [2432, 2436], [2445, 2446], [2449, 2450], - [2483, 2485], [2490, 2492], [2494, 2509], [2511, 2523], [2530, 2533], [2546, 2547], - [2554, 2564], [2571, 2574], [2577, 2578], [2618, 2648], [2655, 2661], [2672, 2673], - [2677, 2692], [2746, 2748], [2750, 2767], [2769, 2783], [2786, 2789], [2800, 2820], - [2829, 2830], [2833, 2834], [2874, 2876], [2878, 2907], [2914, 2917], [2930, 2946], - [2955, 2957], [2966, 2968], [2976, 2978], [2981, 2983], [2987, 2989], [3002, 3023], - [3025, 3045], [3059, 3076], [3130, 3132], [3134, 3159], [3162, 3167], [3170, 3173], - [3184, 3191], [3199, 3204], [3258, 3260], [3262, 3293], [3298, 3301], [3312, 3332], - [3386, 3388], [3390, 3423], [3426, 3429], [3446, 3449], [3456, 3460], [3479, 3481], - [3518, 3519], [3527, 3584], [3636, 3647], [3655, 3663], [3674, 3712], [3717, 3718], - [3723, 3724], [3726, 3731], [3752, 3753], [3764, 3772], [3774, 3775], [3783, 3791], - [3802, 3803], [3806, 3839], [3841, 3871], [3892, 3903], [3949, 3975], [3980, 4095], - [4139, 4158], [4170, 4175], [4182, 4185], [4190, 4192], [4194, 4196], [4199, 4205], - [4209, 4212], [4226, 4237], [4250, 4255], [4294, 4303], [4349, 4351], [4686, 4687], - [4702, 4703], [4750, 4751], [4790, 4791], [4806, 4807], [4886, 4887], [4955, 4968], - [4989, 4991], [5008, 5023], [5109, 5120], [5741, 5742], [5787, 5791], [5867, 5869], - [5873, 5887], [5906, 5919], [5938, 5951], [5970, 5983], [6001, 6015], [6068, 6102], - [6104, 6107], [6109, 6111], [6122, 6127], [6138, 6159], [6170, 6175], [6264, 6271], - [6315, 6319], [6390, 6399], [6429, 6469], [6510, 6511], [6517, 6527], [6572, 6592], - [6600, 6607], [6619, 6655], [6679, 6687], [6741, 6783], [6794, 6799], [6810, 6822], - [6824, 6916], [6964, 6980], [6988, 6991], [7002, 7042], [7073, 7085], [7098, 7167], - [7204, 7231], [7242, 7244], [7294, 7400], [7410, 7423], [7616, 7679], [7958, 7959], - [7966, 7967], [8006, 8007], [8014, 8015], [8062, 8063], [8127, 8129], [8141, 8143], - [8148, 8149], [8156, 8159], [8173, 8177], [8189, 8303], [8306, 8307], [8314, 8318], - [8330, 8335], [8341, 8449], [8451, 8454], [8456, 8457], [8470, 8472], [8478, 8483], - [8506, 8507], [8512, 8516], [8522, 8525], [8586, 9311], [9372, 9449], [9472, 10101], - [10132, 11263], [11493, 11498], [11503, 11516], [11518, 11519], [11558, 11567], - [11622, 11630], [11632, 11647], [11671, 11679], [11743, 11822], [11824, 12292], - [12296, 12320], [12330, 12336], [12342, 12343], [12349, 12352], [12439, 12444], - [12544, 12548], [12590, 12592], [12687, 12689], [12694, 12703], [12728, 12783], - [12800, 12831], [12842, 12880], [12896, 12927], [12938, 12976], [12992, 13311], - [19894, 19967], [40908, 40959], [42125, 42191], [42238, 42239], [42509, 42511], - [42540, 42559], [42592, 42593], [42607, 42622], [42648, 42655], [42736, 42774], - [42784, 42785], [42889, 42890], [42893, 43002], [43043, 43055], [43062, 43071], - [43124, 43137], [43188, 43215], [43226, 43249], [43256, 43258], [43260, 43263], - [43302, 43311], [43335, 43359], [43389, 43395], [43443, 43470], [43482, 43519], - [43561, 43583], [43596, 43599], [43610, 43615], [43639, 43641], [43643, 43647], - [43698, 43700], [43703, 43704], [43710, 43711], [43715, 43738], [43742, 43967], - [44003, 44015], [44026, 44031], [55204, 55215], [55239, 55242], [55292, 55295], - [57344, 63743], [64046, 64047], [64110, 64111], [64218, 64255], [64263, 64274], - [64280, 64284], [64434, 64466], [64830, 64847], [64912, 64913], [64968, 65007], - [65020, 65135], [65277, 65295], [65306, 65312], [65339, 65344], [65371, 65381], - [65471, 65473], [65480, 65481], [65488, 65489], [65496, 65497]]; - for (i = 0; i < ranges.length; i++) { - start = ranges[i][0]; - end = ranges[i][1]; - for (j = start; j <= end; j++) { - result[j] = true; - } - } - return result; -})(); - -function splitQuery(query) { - var result = []; - var start = -1; - for (var i = 0; i < query.length; i++) { - if (splitChars[query.charCodeAt(i)]) { - if (start !== -1) { - result.push(query.slice(start, i)); - start = -1; - } - } else if (start === -1) { - start = i; - } - } - if (start !== -1) { - result.push(query.slice(start)); - } - return result; -} - - diff --git a/docs/fehmpytests/html/_static/down-pressed.png b/docs/fehmpytests/html/_static/down-pressed.png deleted file mode 100644 index 5756c8cad8854722893dc70b9eb4bb0400343a39..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 222 zcmeAS@N?(olHy`uVBq!ia0vp^0wB!61|;P_|4#%`OFdm2Ln;`PZ^+1>KjR?B@S0W7 z%OS_REiHONoJ6{+Ks@6k3590|7k9F+ddB6!zw3#&!aw#S`x}3V3&=A(a#84O-&F7T z^k3tZB;&iR9siw0|F|E|DAL<8r-F4!1H-;1{e*~yAKZN5f0|Ei6yUmR#Is)EM(Po_ zi`qJR6|P<~+)N+kSDgL7AjdIC_!O7Q?eGb+L+qOjm{~LLinM4NHn7U%HcK%uoMYO5 VJ~8zD2B3o(JYD@<);T3K0RV0%P>BEl diff --git a/docs/fehmpytests/html/_static/down.png b/docs/fehmpytests/html/_static/down.png deleted file mode 100644 index 1b3bdad2ceffae91cee61b32f3295f9bbe646e48..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 202 zcmeAS@N?(olHy`uVBq!ia0vp^0wB!60wlNoGJgf6CVIL!hEy=F?b*7pIY7kW{q%Rg zx!yQ<9v8bmJwa`TQk7YSw}WVQ()mRdQ;TC;* diff --git a/docs/fehmpytests/html/_static/file.png b/docs/fehmpytests/html/_static/file.png deleted file mode 100644 index a858a410e4faa62ce324d814e4b816fff83a6fb3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 286 zcmV+(0pb3MP)s`hMrGg#P~ix$^RISR_I47Y|r1 z_CyJOe}D1){SET-^Amu_i71Lt6eYfZjRyw@I6OQAIXXHDfiX^GbOlHe=Ae4>0m)d(f|Me07*qoM6N<$f}vM^LjV8( diff --git a/docs/fehmpytests/html/_static/jquery-3.1.0.js b/docs/fehmpytests/html/_static/jquery-3.1.0.js deleted file mode 100644 index f2fc2747..00000000 --- a/docs/fehmpytests/html/_static/jquery-3.1.0.js +++ /dev/null @@ -1,10074 +0,0 @@ -/*eslint-disable no-unused-vars*/ -/*! - * jQuery JavaScript Library v3.1.0 - * https://jquery.com/ - * - * Includes Sizzle.js - * https://sizzlejs.com/ - * - * Copyright jQuery Foundation and other contributors - * Released under the MIT license - * https://jquery.org/license - * - * Date: 2016-07-07T21:44Z - */ -( function( global, factory ) { - - "use strict"; - - if ( typeof module === "object" && typeof module.exports === "object" ) { - - // For CommonJS and CommonJS-like environments where a proper `window` - // is present, execute the factory and get jQuery. - // For environments that do not have a `window` with a `document` - // (such as Node.js), expose a factory as module.exports. - // This accentuates the need for the creation of a real `window`. - // e.g. var jQuery = require("jquery")(window); - // See ticket #14549 for more info. - module.exports = global.document ? - factory( global, true ) : - function( w ) { - if ( !w.document ) { - throw new Error( "jQuery requires a window with a document" ); - } - return factory( w ); - }; - } else { - factory( global ); - } - -// Pass this if window is not defined yet -} )( typeof window !== "undefined" ? window : this, function( window, noGlobal ) { - -// Edge <= 12 - 13+, Firefox <=18 - 45+, IE 10 - 11, Safari 5.1 - 9+, iOS 6 - 9.1 -// throw exceptions when non-strict code (e.g., ASP.NET 4.5) accesses strict mode -// arguments.callee.caller (trac-13335). But as of jQuery 3.0 (2016), strict mode should be common -// enough that all such attempts are guarded in a try block. -"use strict"; - -var arr = []; - -var document = window.document; - -var getProto = Object.getPrototypeOf; - -var slice = arr.slice; - -var concat = arr.concat; - -var push = arr.push; - -var indexOf = arr.indexOf; - -var class2type = {}; - -var toString = class2type.toString; - -var hasOwn = class2type.hasOwnProperty; - -var fnToString = hasOwn.toString; - -var ObjectFunctionString = fnToString.call( Object ); - -var support = {}; - - - - function DOMEval( code, doc ) { - doc = doc || document; - - var script = doc.createElement( "script" ); - - script.text = code; - doc.head.appendChild( script ).parentNode.removeChild( script ); - } -/* global Symbol */ -// Defining this global in .eslintrc would create a danger of using the global -// unguarded in another place, it seems safer to define global only for this module - - - -var - version = "3.1.0", - - // Define a local copy of jQuery - jQuery = function( selector, context ) { - - // The jQuery object is actually just the init constructor 'enhanced' - // Need init if jQuery is called (just allow error to be thrown if not included) - return new jQuery.fn.init( selector, context ); - }, - - // Support: Android <=4.0 only - // Make sure we trim BOM and NBSP - rtrim = /^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g, - - // Matches dashed string for camelizing - rmsPrefix = /^-ms-/, - rdashAlpha = /-([a-z])/g, - - // Used by jQuery.camelCase as callback to replace() - fcamelCase = function( all, letter ) { - return letter.toUpperCase(); - }; - -jQuery.fn = jQuery.prototype = { - - // The current version of jQuery being used - jquery: version, - - constructor: jQuery, - - // The default length of a jQuery object is 0 - length: 0, - - toArray: function() { - return slice.call( this ); - }, - - // Get the Nth element in the matched element set OR - // Get the whole matched element set as a clean array - get: function( num ) { - return num != null ? - - // Return just the one element from the set - ( num < 0 ? this[ num + this.length ] : this[ num ] ) : - - // Return all the elements in a clean array - slice.call( this ); - }, - - // Take an array of elements and push it onto the stack - // (returning the new matched element set) - pushStack: function( elems ) { - - // Build a new jQuery matched element set - var ret = jQuery.merge( this.constructor(), elems ); - - // Add the old object onto the stack (as a reference) - ret.prevObject = this; - - // Return the newly-formed element set - return ret; - }, - - // Execute a callback for every element in the matched set. - each: function( callback ) { - return jQuery.each( this, callback ); - }, - - map: function( callback ) { - return this.pushStack( jQuery.map( this, function( elem, i ) { - return callback.call( elem, i, elem ); - } ) ); - }, - - slice: function() { - return this.pushStack( slice.apply( this, arguments ) ); - }, - - first: function() { - return this.eq( 0 ); - }, - - last: function() { - return this.eq( -1 ); - }, - - eq: function( i ) { - var len = this.length, - j = +i + ( i < 0 ? len : 0 ); - return this.pushStack( j >= 0 && j < len ? [ this[ j ] ] : [] ); - }, - - end: function() { - return this.prevObject || this.constructor(); - }, - - // For internal use only. - // Behaves like an Array's method, not like a jQuery method. - push: push, - sort: arr.sort, - splice: arr.splice -}; - -jQuery.extend = jQuery.fn.extend = function() { - var options, name, src, copy, copyIsArray, clone, - target = arguments[ 0 ] || {}, - i = 1, - length = arguments.length, - deep = false; - - // Handle a deep copy situation - if ( typeof target === "boolean" ) { - deep = target; - - // Skip the boolean and the target - target = arguments[ i ] || {}; - i++; - } - - // Handle case when target is a string or something (possible in deep copy) - if ( typeof target !== "object" && !jQuery.isFunction( target ) ) { - target = {}; - } - - // Extend jQuery itself if only one argument is passed - if ( i === length ) { - target = this; - i--; - } - - for ( ; i < length; i++ ) { - - // Only deal with non-null/undefined values - if ( ( options = arguments[ i ] ) != null ) { - - // Extend the base object - for ( name in options ) { - src = target[ name ]; - copy = options[ name ]; - - // Prevent never-ending loop - if ( target === copy ) { - continue; - } - - // Recurse if we're merging plain objects or arrays - if ( deep && copy && ( jQuery.isPlainObject( copy ) || - ( copyIsArray = jQuery.isArray( copy ) ) ) ) { - - if ( copyIsArray ) { - copyIsArray = false; - clone = src && jQuery.isArray( src ) ? src : []; - - } else { - clone = src && jQuery.isPlainObject( src ) ? src : {}; - } - - // Never move original objects, clone them - target[ name ] = jQuery.extend( deep, clone, copy ); - - // Don't bring in undefined values - } else if ( copy !== undefined ) { - target[ name ] = copy; - } - } - } - } - - // Return the modified object - return target; -}; - -jQuery.extend( { - - // Unique for each copy of jQuery on the page - expando: "jQuery" + ( version + Math.random() ).replace( /\D/g, "" ), - - // Assume jQuery is ready without the ready module - isReady: true, - - error: function( msg ) { - throw new Error( msg ); - }, - - noop: function() {}, - - isFunction: function( obj ) { - return jQuery.type( obj ) === "function"; - }, - - isArray: Array.isArray, - - isWindow: function( obj ) { - return obj != null && obj === obj.window; - }, - - isNumeric: function( obj ) { - - // As of jQuery 3.0, isNumeric is limited to - // strings and numbers (primitives or objects) - // that can be coerced to finite numbers (gh-2662) - var type = jQuery.type( obj ); - return ( type === "number" || type === "string" ) && - - // parseFloat NaNs numeric-cast false positives ("") - // ...but misinterprets leading-number strings, particularly hex literals ("0x...") - // subtraction forces infinities to NaN - !isNaN( obj - parseFloat( obj ) ); - }, - - isPlainObject: function( obj ) { - var proto, Ctor; - - // Detect obvious negatives - // Use toString instead of jQuery.type to catch host objects - if ( !obj || toString.call( obj ) !== "[object Object]" ) { - return false; - } - - proto = getProto( obj ); - - // Objects with no prototype (e.g., `Object.create( null )`) are plain - if ( !proto ) { - return true; - } - - // Objects with prototype are plain iff they were constructed by a global Object function - Ctor = hasOwn.call( proto, "constructor" ) && proto.constructor; - return typeof Ctor === "function" && fnToString.call( Ctor ) === ObjectFunctionString; - }, - - isEmptyObject: function( obj ) { - - /* eslint-disable no-unused-vars */ - // See https://github.com/eslint/eslint/issues/6125 - var name; - - for ( name in obj ) { - return false; - } - return true; - }, - - type: function( obj ) { - if ( obj == null ) { - return obj + ""; - } - - // Support: Android <=2.3 only (functionish RegExp) - return typeof obj === "object" || typeof obj === "function" ? - class2type[ toString.call( obj ) ] || "object" : - typeof obj; - }, - - // Evaluates a script in a global context - globalEval: function( code ) { - DOMEval( code ); - }, - - // Convert dashed to camelCase; used by the css and data modules - // Support: IE <=9 - 11, Edge 12 - 13 - // Microsoft forgot to hump their vendor prefix (#9572) - camelCase: function( string ) { - return string.replace( rmsPrefix, "ms-" ).replace( rdashAlpha, fcamelCase ); - }, - - nodeName: function( elem, name ) { - return elem.nodeName && elem.nodeName.toLowerCase() === name.toLowerCase(); - }, - - each: function( obj, callback ) { - var length, i = 0; - - if ( isArrayLike( obj ) ) { - length = obj.length; - for ( ; i < length; i++ ) { - if ( callback.call( obj[ i ], i, obj[ i ] ) === false ) { - break; - } - } - } else { - for ( i in obj ) { - if ( callback.call( obj[ i ], i, obj[ i ] ) === false ) { - break; - } - } - } - - return obj; - }, - - // Support: Android <=4.0 only - trim: function( text ) { - return text == null ? - "" : - ( text + "" ).replace( rtrim, "" ); - }, - - // results is for internal usage only - makeArray: function( arr, results ) { - var ret = results || []; - - if ( arr != null ) { - if ( isArrayLike( Object( arr ) ) ) { - jQuery.merge( ret, - typeof arr === "string" ? - [ arr ] : arr - ); - } else { - push.call( ret, arr ); - } - } - - return ret; - }, - - inArray: function( elem, arr, i ) { - return arr == null ? -1 : indexOf.call( arr, elem, i ); - }, - - // Support: Android <=4.0 only, PhantomJS 1 only - // push.apply(_, arraylike) throws on ancient WebKit - merge: function( first, second ) { - var len = +second.length, - j = 0, - i = first.length; - - for ( ; j < len; j++ ) { - first[ i++ ] = second[ j ]; - } - - first.length = i; - - return first; - }, - - grep: function( elems, callback, invert ) { - var callbackInverse, - matches = [], - i = 0, - length = elems.length, - callbackExpect = !invert; - - // Go through the array, only saving the items - // that pass the validator function - for ( ; i < length; i++ ) { - callbackInverse = !callback( elems[ i ], i ); - if ( callbackInverse !== callbackExpect ) { - matches.push( elems[ i ] ); - } - } - - return matches; - }, - - // arg is for internal usage only - map: function( elems, callback, arg ) { - var length, value, - i = 0, - ret = []; - - // Go through the array, translating each of the items to their new values - if ( isArrayLike( elems ) ) { - length = elems.length; - for ( ; i < length; i++ ) { - value = callback( elems[ i ], i, arg ); - - if ( value != null ) { - ret.push( value ); - } - } - - // Go through every key on the object, - } else { - for ( i in elems ) { - value = callback( elems[ i ], i, arg ); - - if ( value != null ) { - ret.push( value ); - } - } - } - - // Flatten any nested arrays - return concat.apply( [], ret ); - }, - - // A global GUID counter for objects - guid: 1, - - // Bind a function to a context, optionally partially applying any - // arguments. - proxy: function( fn, context ) { - var tmp, args, proxy; - - if ( typeof context === "string" ) { - tmp = fn[ context ]; - context = fn; - fn = tmp; - } - - // Quick check to determine if target is callable, in the spec - // this throws a TypeError, but we will just return undefined. - if ( !jQuery.isFunction( fn ) ) { - return undefined; - } - - // Simulated bind - args = slice.call( arguments, 2 ); - proxy = function() { - return fn.apply( context || this, args.concat( slice.call( arguments ) ) ); - }; - - // Set the guid of unique handler to the same of original handler, so it can be removed - proxy.guid = fn.guid = fn.guid || jQuery.guid++; - - return proxy; - }, - - now: Date.now, - - // jQuery.support is not used in Core but other projects attach their - // properties to it so it needs to exist. - support: support -} ); - -if ( typeof Symbol === "function" ) { - jQuery.fn[ Symbol.iterator ] = arr[ Symbol.iterator ]; -} - -// Populate the class2type map -jQuery.each( "Boolean Number String Function Array Date RegExp Object Error Symbol".split( " " ), -function( i, name ) { - class2type[ "[object " + name + "]" ] = name.toLowerCase(); -} ); - -function isArrayLike( obj ) { - - // Support: real iOS 8.2 only (not reproducible in simulator) - // `in` check used to prevent JIT error (gh-2145) - // hasOwn isn't used here due to false negatives - // regarding Nodelist length in IE - var length = !!obj && "length" in obj && obj.length, - type = jQuery.type( obj ); - - if ( type === "function" || jQuery.isWindow( obj ) ) { - return false; - } - - return type === "array" || length === 0 || - typeof length === "number" && length > 0 && ( length - 1 ) in obj; -} -var Sizzle = -/*! - * Sizzle CSS Selector Engine v2.3.0 - * https://sizzlejs.com/ - * - * Copyright jQuery Foundation and other contributors - * Released under the MIT license - * http://jquery.org/license - * - * Date: 2016-01-04 - */ -(function( window ) { - -var i, - support, - Expr, - getText, - isXML, - tokenize, - compile, - select, - outermostContext, - sortInput, - hasDuplicate, - - // Local document vars - setDocument, - document, - docElem, - documentIsHTML, - rbuggyQSA, - rbuggyMatches, - matches, - contains, - - // Instance-specific data - expando = "sizzle" + 1 * new Date(), - preferredDoc = window.document, - dirruns = 0, - done = 0, - classCache = createCache(), - tokenCache = createCache(), - compilerCache = createCache(), - sortOrder = function( a, b ) { - if ( a === b ) { - hasDuplicate = true; - } - return 0; - }, - - // Instance methods - hasOwn = ({}).hasOwnProperty, - arr = [], - pop = arr.pop, - push_native = arr.push, - push = arr.push, - slice = arr.slice, - // Use a stripped-down indexOf as it's faster than native - // https://jsperf.com/thor-indexof-vs-for/5 - indexOf = function( list, elem ) { - var i = 0, - len = list.length; - for ( ; i < len; i++ ) { - if ( list[i] === elem ) { - return i; - } - } - return -1; - }, - - booleans = "checked|selected|async|autofocus|autoplay|controls|defer|disabled|hidden|ismap|loop|multiple|open|readonly|required|scoped", - - // Regular expressions - - // http://www.w3.org/TR/css3-selectors/#whitespace - whitespace = "[\\x20\\t\\r\\n\\f]", - - // http://www.w3.org/TR/CSS21/syndata.html#value-def-identifier - identifier = "(?:\\\\.|[\\w-]|[^\0-\\xa0])+", - - // Attribute selectors: http://www.w3.org/TR/selectors/#attribute-selectors - attributes = "\\[" + whitespace + "*(" + identifier + ")(?:" + whitespace + - // Operator (capture 2) - "*([*^$|!~]?=)" + whitespace + - // "Attribute values must be CSS identifiers [capture 5] or strings [capture 3 or capture 4]" - "*(?:'((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\"|(" + identifier + "))|)" + whitespace + - "*\\]", - - pseudos = ":(" + identifier + ")(?:\\((" + - // To reduce the number of selectors needing tokenize in the preFilter, prefer arguments: - // 1. quoted (capture 3; capture 4 or capture 5) - "('((?:\\\\.|[^\\\\'])*)'|\"((?:\\\\.|[^\\\\\"])*)\")|" + - // 2. simple (capture 6) - "((?:\\\\.|[^\\\\()[\\]]|" + attributes + ")*)|" + - // 3. anything else (capture 2) - ".*" + - ")\\)|)", - - // Leading and non-escaped trailing whitespace, capturing some non-whitespace characters preceding the latter - rwhitespace = new RegExp( whitespace + "+", "g" ), - rtrim = new RegExp( "^" + whitespace + "+|((?:^|[^\\\\])(?:\\\\.)*)" + whitespace + "+$", "g" ), - - rcomma = new RegExp( "^" + whitespace + "*," + whitespace + "*" ), - rcombinators = new RegExp( "^" + whitespace + "*([>+~]|" + whitespace + ")" + whitespace + "*" ), - - rattributeQuotes = new RegExp( "=" + whitespace + "*([^\\]'\"]*?)" + whitespace + "*\\]", "g" ), - - rpseudo = new RegExp( pseudos ), - ridentifier = new RegExp( "^" + identifier + "$" ), - - matchExpr = { - "ID": new RegExp( "^#(" + identifier + ")" ), - "CLASS": new RegExp( "^\\.(" + identifier + ")" ), - "TAG": new RegExp( "^(" + identifier + "|[*])" ), - "ATTR": new RegExp( "^" + attributes ), - "PSEUDO": new RegExp( "^" + pseudos ), - "CHILD": new RegExp( "^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\(" + whitespace + - "*(even|odd|(([+-]|)(\\d*)n|)" + whitespace + "*(?:([+-]|)" + whitespace + - "*(\\d+)|))" + whitespace + "*\\)|)", "i" ), - "bool": new RegExp( "^(?:" + booleans + ")$", "i" ), - // For use in libraries implementing .is() - // We use this for POS matching in `select` - "needsContext": new RegExp( "^" + whitespace + "*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\(" + - whitespace + "*((?:-\\d)?\\d*)" + whitespace + "*\\)|)(?=[^-]|$)", "i" ) - }, - - rinputs = /^(?:input|select|textarea|button)$/i, - rheader = /^h\d$/i, - - rnative = /^[^{]+\{\s*\[native \w/, - - // Easily-parseable/retrievable ID or TAG or CLASS selectors - rquickExpr = /^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/, - - rsibling = /[+~]/, - - // CSS escapes - // http://www.w3.org/TR/CSS21/syndata.html#escaped-characters - runescape = new RegExp( "\\\\([\\da-f]{1,6}" + whitespace + "?|(" + whitespace + ")|.)", "ig" ), - funescape = function( _, escaped, escapedWhitespace ) { - var high = "0x" + escaped - 0x10000; - // NaN means non-codepoint - // Support: Firefox<24 - // Workaround erroneous numeric interpretation of +"0x" - return high !== high || escapedWhitespace ? - escaped : - high < 0 ? - // BMP codepoint - String.fromCharCode( high + 0x10000 ) : - // Supplemental Plane codepoint (surrogate pair) - String.fromCharCode( high >> 10 | 0xD800, high & 0x3FF | 0xDC00 ); - }, - - // CSS string/identifier serialization - // https://drafts.csswg.org/cssom/#common-serializing-idioms - rcssescape = /([\0-\x1f\x7f]|^-?\d)|^-$|[^\x80-\uFFFF\w-]/g, - fcssescape = function( ch, asCodePoint ) { - if ( asCodePoint ) { - - // U+0000 NULL becomes U+FFFD REPLACEMENT CHARACTER - if ( ch === "\0" ) { - return "\uFFFD"; - } - - // Control characters and (dependent upon position) numbers get escaped as code points - return ch.slice( 0, -1 ) + "\\" + ch.charCodeAt( ch.length - 1 ).toString( 16 ) + " "; - } - - // Other potentially-special ASCII characters get backslash-escaped - return "\\" + ch; - }, - - // Used for iframes - // See setDocument() - // Removing the function wrapper causes a "Permission Denied" - // error in IE - unloadHandler = function() { - setDocument(); - }, - - disabledAncestor = addCombinator( - function( elem ) { - return elem.disabled === true; - }, - { dir: "parentNode", next: "legend" } - ); - -// Optimize for push.apply( _, NodeList ) -try { - push.apply( - (arr = slice.call( preferredDoc.childNodes )), - preferredDoc.childNodes - ); - // Support: Android<4.0 - // Detect silently failing push.apply - arr[ preferredDoc.childNodes.length ].nodeType; -} catch ( e ) { - push = { apply: arr.length ? - - // Leverage slice if possible - function( target, els ) { - push_native.apply( target, slice.call(els) ); - } : - - // Support: IE<9 - // Otherwise append directly - function( target, els ) { - var j = target.length, - i = 0; - // Can't trust NodeList.length - while ( (target[j++] = els[i++]) ) {} - target.length = j - 1; - } - }; -} - -function Sizzle( selector, context, results, seed ) { - var m, i, elem, nid, match, groups, newSelector, - newContext = context && context.ownerDocument, - - // nodeType defaults to 9, since context defaults to document - nodeType = context ? context.nodeType : 9; - - results = results || []; - - // Return early from calls with invalid selector or context - if ( typeof selector !== "string" || !selector || - nodeType !== 1 && nodeType !== 9 && nodeType !== 11 ) { - - return results; - } - - // Try to shortcut find operations (as opposed to filters) in HTML documents - if ( !seed ) { - - if ( ( context ? context.ownerDocument || context : preferredDoc ) !== document ) { - setDocument( context ); - } - context = context || document; - - if ( documentIsHTML ) { - - // If the selector is sufficiently simple, try using a "get*By*" DOM method - // (excepting DocumentFragment context, where the methods don't exist) - if ( nodeType !== 11 && (match = rquickExpr.exec( selector )) ) { - - // ID selector - if ( (m = match[1]) ) { - - // Document context - if ( nodeType === 9 ) { - if ( (elem = context.getElementById( m )) ) { - - // Support: IE, Opera, Webkit - // TODO: identify versions - // getElementById can match elements by name instead of ID - if ( elem.id === m ) { - results.push( elem ); - return results; - } - } else { - return results; - } - - // Element context - } else { - - // Support: IE, Opera, Webkit - // TODO: identify versions - // getElementById can match elements by name instead of ID - if ( newContext && (elem = newContext.getElementById( m )) && - contains( context, elem ) && - elem.id === m ) { - - results.push( elem ); - return results; - } - } - - // Type selector - } else if ( match[2] ) { - push.apply( results, context.getElementsByTagName( selector ) ); - return results; - - // Class selector - } else if ( (m = match[3]) && support.getElementsByClassName && - context.getElementsByClassName ) { - - push.apply( results, context.getElementsByClassName( m ) ); - return results; - } - } - - // Take advantage of querySelectorAll - if ( support.qsa && - !compilerCache[ selector + " " ] && - (!rbuggyQSA || !rbuggyQSA.test( selector )) ) { - - if ( nodeType !== 1 ) { - newContext = context; - newSelector = selector; - - // qSA looks outside Element context, which is not what we want - // Thanks to Andrew Dupont for this workaround technique - // Support: IE <=8 - // Exclude object elements - } else if ( context.nodeName.toLowerCase() !== "object" ) { - - // Capture the context ID, setting it first if necessary - if ( (nid = context.getAttribute( "id" )) ) { - nid = nid.replace( rcssescape, fcssescape ); - } else { - context.setAttribute( "id", (nid = expando) ); - } - - // Prefix every selector in the list - groups = tokenize( selector ); - i = groups.length; - while ( i-- ) { - groups[i] = "#" + nid + " " + toSelector( groups[i] ); - } - newSelector = groups.join( "," ); - - // Expand context for sibling selectors - newContext = rsibling.test( selector ) && testContext( context.parentNode ) || - context; - } - - if ( newSelector ) { - try { - push.apply( results, - newContext.querySelectorAll( newSelector ) - ); - return results; - } catch ( qsaError ) { - } finally { - if ( nid === expando ) { - context.removeAttribute( "id" ); - } - } - } - } - } - } - - // All others - return select( selector.replace( rtrim, "$1" ), context, results, seed ); -} - -/** - * Create key-value caches of limited size - * @returns {function(string, object)} Returns the Object data after storing it on itself with - * property name the (space-suffixed) string and (if the cache is larger than Expr.cacheLength) - * deleting the oldest entry - */ -function createCache() { - var keys = []; - - function cache( key, value ) { - // Use (key + " ") to avoid collision with native prototype properties (see Issue #157) - if ( keys.push( key + " " ) > Expr.cacheLength ) { - // Only keep the most recent entries - delete cache[ keys.shift() ]; - } - return (cache[ key + " " ] = value); - } - return cache; -} - -/** - * Mark a function for special use by Sizzle - * @param {Function} fn The function to mark - */ -function markFunction( fn ) { - fn[ expando ] = true; - return fn; -} - -/** - * Support testing using an element - * @param {Function} fn Passed the created element and returns a boolean result - */ -function assert( fn ) { - var el = document.createElement("fieldset"); - - try { - return !!fn( el ); - } catch (e) { - return false; - } finally { - // Remove from its parent by default - if ( el.parentNode ) { - el.parentNode.removeChild( el ); - } - // release memory in IE - el = null; - } -} - -/** - * Adds the same handler for all of the specified attrs - * @param {String} attrs Pipe-separated list of attributes - * @param {Function} handler The method that will be applied - */ -function addHandle( attrs, handler ) { - var arr = attrs.split("|"), - i = arr.length; - - while ( i-- ) { - Expr.attrHandle[ arr[i] ] = handler; - } -} - -/** - * Checks document order of two siblings - * @param {Element} a - * @param {Element} b - * @returns {Number} Returns less than 0 if a precedes b, greater than 0 if a follows b - */ -function siblingCheck( a, b ) { - var cur = b && a, - diff = cur && a.nodeType === 1 && b.nodeType === 1 && - a.sourceIndex - b.sourceIndex; - - // Use IE sourceIndex if available on both nodes - if ( diff ) { - return diff; - } - - // Check if b follows a - if ( cur ) { - while ( (cur = cur.nextSibling) ) { - if ( cur === b ) { - return -1; - } - } - } - - return a ? 1 : -1; -} - -/** - * Returns a function to use in pseudos for input types - * @param {String} type - */ -function createInputPseudo( type ) { - return function( elem ) { - var name = elem.nodeName.toLowerCase(); - return name === "input" && elem.type === type; - }; -} - -/** - * Returns a function to use in pseudos for buttons - * @param {String} type - */ -function createButtonPseudo( type ) { - return function( elem ) { - var name = elem.nodeName.toLowerCase(); - return (name === "input" || name === "button") && elem.type === type; - }; -} - -/** - * Returns a function to use in pseudos for :enabled/:disabled - * @param {Boolean} disabled true for :disabled; false for :enabled - */ -function createDisabledPseudo( disabled ) { - // Known :disabled false positives: - // IE: *[disabled]:not(button, input, select, textarea, optgroup, option, menuitem, fieldset) - // not IE: fieldset[disabled] > legend:nth-of-type(n+2) :can-disable - return function( elem ) { - - // Check form elements and option elements for explicit disabling - return "label" in elem && elem.disabled === disabled || - "form" in elem && elem.disabled === disabled || - - // Check non-disabled form elements for fieldset[disabled] ancestors - "form" in elem && elem.disabled === false && ( - // Support: IE6-11+ - // Ancestry is covered for us - elem.isDisabled === disabled || - - // Otherwise, assume any non-