648 lines
22 KiB
FortranFixed
648 lines
22 KiB
FortranFixed
|
subroutine readdatex(ifile,ierror)
|
||
|
|
C
|
||
|
|
C #####################################################################
|
||
|
|
C
|
||
|
|
c PURPOSE -
|
||
|
|
C
|
||
|
|
C THIS ROUTINE READ A DATEX1.2 FORMATED ASCII FILE.
|
||
|
|
C
|
||
|
|
C INPUT ARGUMENTS -
|
||
|
|
C
|
||
|
|
C ifile - INPUT DATEX FILE BASE NAME. THE .GEO AND .DAT ARE
|
||
|
|
C APPENDED TO THE BASE NAME TO GET BOTH THE
|
||
|
|
C GEOMETRY FILE NAME AND THE FIELD DATA FILE NAME.
|
||
|
|
C
|
||
|
|
C OUTPUT ARGUMENTS -
|
||
|
|
C
|
||
|
|
C ierror - RETURN ERROR CODE (== 0 ==> OK, <> 0 ==> AN ERROR)
|
||
|
|
C
|
||
|
|
C CHANGE HISTORY -
|
||
|
|
C
|
||
|
|
C $Log: readdatex.f,v $
|
||
|
|
C Revision 2.00 2007/11/09 20:03:59 spchu
|
||
|
|
C Import to CVS
|
||
|
|
C
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.1 Tue Mar 07 08:24:16 2000 dcg
|
||
|
|
CPVCS remove references to ign1
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.0 Mon Jan 31 12:02:08 2000 dcg
|
||
|
|
CPVCS Initial revision.
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.12 Wed Sep 01 13:25:06 1999 dcg
|
||
|
|
CPVCS fix typo ie should have been id
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.11 Tue May 13 12:56:22 1997 dcg
|
||
|
|
CPVCS set itetclr, itetoff, jtetoff; fix cmo calls
|
||
|
|
CPVCS check for eof on reads
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.9 Tue Mar 05 12:50:26 1996 dcg
|
||
|
|
CPVCS remove int1, icn1
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.8 Fri Feb 23 13:52:52 1996 dcg
|
||
|
|
CPVCS remove uic,vic,wic,pic,ric,eic
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.7 11/07/95 17:23:10 dcg
|
||
|
|
CPVCS change flag to 2 in mmgetblk calls
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.6 07/14/95 23:31:40 het
|
||
|
|
CPVCS Correct an error with the CMO name
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.5 05/26/95 13:17:32 het
|
||
|
|
CPVCS Replace subroutine parameter list with subroutine calles.
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.4 01/23/95 12:45:20 het
|
||
|
|
CPVCS Delete the call to cmo_increment with cmo_newlen.
|
||
|
|
CPVCS
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.3 01/04/95 22:04:22 llt
|
||
|
|
CPVCS unicos changes (made by het)
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.2 12/09/94 22:47:18 het
|
||
|
|
CPVCS Added calles to the new cmo_ routines.
|
||
|
|
CPVCS
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.1 12/06/94 19:04:16 het
|
||
|
|
CPVCS Added "call cmo_get_name" to return the current mesh object name.
|
||
|
|
CPVCS
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.0 11/13/94 11:44:38 pvcs
|
||
|
|
CPVCS Orginal Version
|
||
|
|
C
|
||
|
|
C ######################################################################
|
||
|
|
C
|
||
|
|
implicit real*8 (a-h,o-z)
|
||
|
|
C
|
||
|
|
C ######################################################################
|
||
|
|
C
|
||
|
|
include "cmo.h"
|
||
|
|
include "chydro.h"
|
||
|
|
include 'local_element.h'
|
||
|
|
C
|
||
|
|
C ######################################################################
|
||
|
|
C
|
||
|
|
character*132 logmess, cbuff
|
||
|
|
C
|
||
|
|
character ifile*(*)
|
||
|
|
C
|
||
|
|
pointer (ipxmic, xmic)
|
||
|
|
pointer (iptic, tic)
|
||
|
|
real*8 xmic(1), tic(1)
|
||
|
|
pointer(ipout,out)
|
||
|
|
real*8 out(*)
|
||
|
|
C
|
||
|
|
pointer (ipielmclr, ielmclr)
|
||
|
|
pointer (ipielmicn, ielmicn)
|
||
|
|
pointer (ipielm, ielm)
|
||
|
|
pointer (ipjelm1, jelm1)
|
||
|
|
pointer (ipjelm2, jelm2)
|
||
|
|
integer ielmicn(1000000), ielmclr(1000000), ielm(1000000),
|
||
|
|
* jelm1(1000000), jelm2(1000000)
|
||
|
|
pointer (ipvels,vels)
|
||
|
|
pointer (ipdens,dens)
|
||
|
|
pointer (ippres,pres)
|
||
|
|
pointer (ipener,ener)
|
||
|
|
real*8 vels(3,1000000),ener(1000000),pres(1000000),dens(1000000)
|
||
|
|
pointer (ipicn1, icn1)
|
||
|
|
integer icn1(1000000)
|
||
|
|
pointer (ipitetoff,itetoff)
|
||
|
|
pointer (ipjtetoff,jtetoff)
|
||
|
|
integer itetoff(1000000),jtetoff(1000000)
|
||
|
|
character*80 iword
|
||
|
|
character*80 jword
|
||
|
|
character*32 isubname, cmonam, jfile, cvelnm, cdensnm, cpresnm,
|
||
|
|
* cenernm
|
||
|
|
character*8 sbname,defname
|
||
|
|
integer iconn(100)
|
||
|
|
C
|
||
|
|
parameter (nentri=3, nfacetri=3)
|
||
|
|
parameter (nentet=4, nfacetet=4)
|
||
|
|
parameter (nenprism=6, nfaceprism=5)
|
||
|
|
parameter (nenhex=8, nfacehex=6)
|
||
|
|
C
|
||
|
|
integer ihexface0(nfacehex), ihexface1(4,nfacehex)
|
||
|
|
C top,bottom,front,right,back,left
|
||
|
|
data ihexface0 / 4, 4, 4, 4, 4, 4 /
|
||
|
|
data ihexface1 / 1, 2, 3, 4,
|
||
|
|
* 5, 8, 7, 6,
|
||
|
|
* 1, 5, 6, 2,
|
||
|
|
* 2, 6, 7, 3,
|
||
|
|
* 3, 7, 8, 4,
|
||
|
|
* 1, 4, 8, 5 /
|
||
|
|
integer iprismface0(nfaceprism), iprismface1(4,nfaceprism)
|
||
|
|
C top,bottom,right,back,left
|
||
|
|
data iprismface0 / 3, 3, 4, 4, 4 /
|
||
|
|
data iprismface1 / 1, 2, 3, 0,
|
||
|
|
* 4, 6, 5, 0,
|
||
|
|
* 1, 4, 5, 2,
|
||
|
|
* 2, 5, 6, 3,
|
||
|
|
* 1, 3, 6, 4 /
|
||
|
|
C
|
||
|
|
integer intpairhex(2,12)
|
||
|
|
data intpairhex / 1,2, 2,3, 3,4, 4,1, 5,6, 6,7, 7,8,
|
||
|
|
* 8,5, 1,5, 2,6, 3,7, 4,8 /
|
||
|
|
|
||
|
|
integer itetface0(nfacetet), itetface1(4,nfacetet)
|
||
|
|
C top,back,left,right
|
||
|
|
data itetface0 / 3, 3, 3, 3 /
|
||
|
|
data itetface1 / 2, 3, 4, 0,
|
||
|
|
* 1, 4, 3, 0,
|
||
|
|
* 1, 2, 4, 0,
|
||
|
|
* 1, 3, 2, 0 /
|
||
|
|
integer itriface0(nfacetri), itriface1(3,nfacetri)
|
||
|
|
C top,back,left,right
|
||
|
|
data itriface0 / 2, 2, 2 /
|
||
|
|
data itriface1 / 2, 3, 1,
|
||
|
|
* 3, 1, 2,
|
||
|
|
* 1, 2, 3 /
|
||
|
|
integer intpairtet(2,6)
|
||
|
|
data intpairtet / 1,2, 1,3, 1,4, 2,3, 2,4, 3,4 /
|
||
|
|
C
|
||
|
|
integer jshape(6)
|
||
|
|
data jshape / 3, 4, 4, 5, 6, 6 /
|
||
|
|
integer x3d_to_simul_hex(8), simul_to_x3d_hex(8)
|
||
|
|
C 1 2 3 4 5 6 7 8
|
||
|
|
data x3d_to_simul_hex / 1, 2, 4, 5, 3, 6, 8, 7 /
|
||
|
|
data simul_to_x3d_hex / 1, 2, 5, 3, 4, 6, 8, 7 /
|
||
|
|
|
||
|
|
C
|
||
|
|
C
|
||
|
|
sbname='sbcmoprm'
|
||
|
|
defname='default'
|
||
|
|
ierror=0
|
||
|
|
isubname='readdatex'
|
||
|
|
C
|
||
|
|
iunit=-1
|
||
|
|
lenfile=icharlnf(ifile)
|
||
|
|
jfile=ifile(1:lenfile) // '.geo'
|
||
|
|
call hassign(iunit,jfile,ierror)
|
||
|
|
if (iunit.lt.0 .or. ierror.lt.0) then
|
||
|
|
call x3d_error(isubname,'hassign bad file unit')
|
||
|
|
write(logmess,*)
|
||
|
|
1 'WARNING: file not written ' // jfile
|
||
|
|
call writloga('default',0,logmess,0,ierror)
|
||
|
|
ierror = -1
|
||
|
|
goto 9999
|
||
|
|
endif
|
||
|
|
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
read(iunit,*) ndim,npoints,nelms,nregions
|
||
|
|
length=npoints
|
||
|
|
nnodes_inc=npoints
|
||
|
|
nelements_inc=0
|
||
|
|
C
|
||
|
|
nnodes=npoints
|
||
|
|
call cmo_get_name(cmonam,ierror)
|
||
|
|
call cmo_set_info('nnodes',cmonam,nnodes,1,1,ierror)
|
||
|
|
C
|
||
|
|
call cmo_newlen(cmonam,ierror)
|
||
|
|
call cmo_get_info('itp1',cmonam,ipitp1,len,itype,ierr)
|
||
|
|
call cmo_get_info('imt1',cmonam,ipimt1,len,itype,ierr)
|
||
|
|
call cmo_get_info('icr1',cmonam,ipicr1,len,itype,ierr)
|
||
|
|
call cmo_get_info('isn1',cmonam,ipisn1,len,itype,ierr)
|
||
|
|
call cmo_get_info('icn1',cmonam,ipicn1,len,itype,ierr)
|
||
|
|
if (ierr.ne.0) then
|
||
|
|
cbuff='cmo/addatt/-def-/icn1/VINT/scalar/nnodes' //
|
||
|
|
* '/min/permanent/ /0/ ; finish'
|
||
|
|
call dotaskx3d(cbuff,ierror)
|
||
|
|
call cmo_get_info('icn1',cmonam,ipicn1,len,itype,ierr)
|
||
|
|
endif
|
||
|
|
call cmo_get_info('xic',cmonam,ipxic,len,itype,ierr)
|
||
|
|
call cmo_get_info('yic',cmonam,ipyic,len,itype,ierr)
|
||
|
|
call cmo_get_info('zic',cmonam,ipzic,len,itype,ierr)
|
||
|
|
call cmo_get_info('itetclr',cmonam,ipitetclr,len,itype,ierr)
|
||
|
|
call cmo_get_info('itet',cmonam,ipitet,len,itype,ierr)
|
||
|
|
call cmo_get_info('itetoff',cmonam,ipitetoff,len,itype,ierr)
|
||
|
|
call cmo_get_info('jtet',cmonam,ipjtet,len,itype,ierr)
|
||
|
|
call cmo_get_info('jtetoff',cmonam,ipjtetoff,len,itype,ierr)
|
||
|
|
call cmo_get_info('itettyp',cmonam,ipitettyp,len,itype,ierr)
|
||
|
|
C
|
||
|
|
call mmgetblk("xmic",isubname,ipxmic,length,2,icscode)
|
||
|
|
call mmgetblk("tic",isubname,iptic,length,2,icscode)
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
do i=1,npoints
|
||
|
|
imt1(i)=0
|
||
|
|
itp1(i)=0
|
||
|
|
icr1(i)=0
|
||
|
|
isn1(i)=0
|
||
|
|
icn1(i)=0
|
||
|
|
xic(i)=0
|
||
|
|
yic(i)=0
|
||
|
|
zic(i)=0
|
||
|
|
xmic(i)=0
|
||
|
|
tic(i)=0
|
||
|
|
if(ndim.eq.3) then
|
||
|
|
read(iunit,*) xic(i),yic(i),zic(i)
|
||
|
|
elseif(ndim.eq.2) then
|
||
|
|
read(iunit,*) xic(i),yic(i)
|
||
|
|
zic(i)=0.0
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
do it=1,nelms
|
||
|
|
read(iunit,*) ishape,icontact,iclr
|
||
|
|
if(ndim.eq.2.and.ishape.eq.1) then
|
||
|
|
nen=3
|
||
|
|
nef=3
|
||
|
|
elseif(ndim.eq.3.and.ishape.eq.1) then
|
||
|
|
nen=3
|
||
|
|
nef=3
|
||
|
|
elseif(ndim.eq.2.and.ishape.eq.2) then
|
||
|
|
nen=4
|
||
|
|
nef=4
|
||
|
|
elseif(ndim.eq.3.and.ishape.eq.3) then
|
||
|
|
nen=4
|
||
|
|
nef=4
|
||
|
|
elseif(ndim.eq.3.and.ishape.eq.4) then
|
||
|
|
nen=5
|
||
|
|
nef=5
|
||
|
|
elseif(ndim.eq.3.and.ishape.eq.5) then
|
||
|
|
nen=6
|
||
|
|
nef=5
|
||
|
|
elseif(ndim.eq.3.and.ishape.eq.6) then
|
||
|
|
nen=6
|
||
|
|
nef=8
|
||
|
|
else
|
||
|
|
write(logmess,'(a,2i10)')
|
||
|
|
* "Invalid Simul element: ",it,ishape
|
||
|
|
call writloga('default',0,logmess,0,ierrw)
|
||
|
|
endif
|
||
|
|
backspace(iunit)
|
||
|
|
read(iunit,*) ishape,icontact,iclr,
|
||
|
|
* (iconn(i),i=1,nen)
|
||
|
|
if(it.eq.1) then
|
||
|
|
length=nelms
|
||
|
|
call mmgetblk("ielmclr",isubname,ipielmclr,length,2,
|
||
|
|
* icscode)
|
||
|
|
call mmgetblk("ielmicn",isubname,ipielmicn,length,2,
|
||
|
|
* icscode)
|
||
|
|
length=max(4,nen)*nelms
|
||
|
|
call mmgetblk("ielm",isubname,ipielm,length,2,icscode)
|
||
|
|
length=max(4,nef)*nelms
|
||
|
|
call mmgetblk("jelm1",isubname,ipjelm1,length,2,icscode)
|
||
|
|
call mmgetblk("jelm2",isubname,ipjelm2,length,2,icscode)
|
||
|
|
endif
|
||
|
|
ielmicn(it)=icontact+1
|
||
|
|
ielmclr(it)=iclr+1
|
||
|
|
if(ishape.eq.6) then
|
||
|
|
do i=1,nen
|
||
|
|
ielm(i)=iconn(simul_to_x3d_hex(i))+1
|
||
|
|
enddo
|
||
|
|
else
|
||
|
|
do i=1,nen
|
||
|
|
ielm(nen*(it-1)+i)=iconn(i)+1
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
do i=1,nef
|
||
|
|
jelm1(nef*(it-1)+i)=-1
|
||
|
|
jelm2(nef*(it-1)+i)=-1
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
do ir=1,nregions
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
enddo
|
||
|
|
C
|
||
|
|
mbndry=16000000
|
||
|
|
C
|
||
|
|
if(ndim.eq.2.and.nen.eq.3.and.nef.eq.3) then
|
||
|
|
ntets=nelms
|
||
|
|
call geniee(ielm,jelm1,jelm2,nen,nef,
|
||
|
|
* ntets,npoints,ndim,npoints,ntets)
|
||
|
|
call cmo_set_info('ndimensions_geom',cmonam,
|
||
|
|
* ndim,1,1,ierror)
|
||
|
|
call cmo_set_info('ndimensions_topo',cmonam,
|
||
|
|
* ndim,1,1,ierror)
|
||
|
|
call cmo_set_info('nodes_per_element',cmonam,
|
||
|
|
* nen,1,1,ierror)
|
||
|
|
call cmo_set_info('faces_per_element',cmonam,
|
||
|
|
* nef,1,1,ierror)
|
||
|
|
C
|
||
|
|
nelements=ntets
|
||
|
|
call cmo_get_name(cmonam,ierror)
|
||
|
|
call cmo_set_info('nelements',cmonam,nelements,1,1,ierror)
|
||
|
|
C
|
||
|
|
call cmo_newlen(cmonam,ierror)
|
||
|
|
call cmo_get_info('itp1',cmonam,ipitp1,len,itype,ierr)
|
||
|
|
call cmo_get_info('imt1',cmonam,ipimt1,len,itype,ierr)
|
||
|
|
call cmo_get_info('icr1',cmonam,ipicr1,len,itype,ierr)
|
||
|
|
call cmo_get_info('isn1',cmonam,ipisn1,len,itype,ierr)
|
||
|
|
call cmo_get_info('icn1',cmonam,ipicn1,len,itype,ierr)
|
||
|
|
call cmo_get_info('xic',cmonam,ipxic,len,itype,ierr)
|
||
|
|
call cmo_get_info('yic',cmonam,ipyic,len,itype,ierr)
|
||
|
|
call cmo_get_info('zic',cmonam,ipzic,len,itype,ierr)
|
||
|
|
call cmo_get_info('itetclr',cmonam,ipitetclr,len,itype,ierr)
|
||
|
|
call cmo_get_info('itet',cmonam,ipitet,len,itype,ierr)
|
||
|
|
call cmo_get_info('itetoff',cmonam,ipitetoff,len,itype,ierr)
|
||
|
|
call cmo_get_info('jtet',cmonam,ipjtet,len,itype,ierr)
|
||
|
|
call cmo_get_info('jtetoff',cmonam,ipjtetoff,len,itype,ierr)
|
||
|
|
call cmo_get_info('itettyp',cmonam,ipitettyp,len,itype,ierr)
|
||
|
|
C
|
||
|
|
do it=1,ntets
|
||
|
|
itetclr(it)=ielmclr(it)
|
||
|
|
do i=1,nen
|
||
|
|
itet1(4*(it-1)+i)=ielm(3*(it-1)+i)
|
||
|
|
enddo
|
||
|
|
itet1(4*(it-1)+4)=itet1(4*(it-1)+1)
|
||
|
|
do i=1,nef
|
||
|
|
if(jelm1(4*(it-1)+i).eq.0) then
|
||
|
|
jtet1(4*(it-1)+i)=mbndry
|
||
|
|
else
|
||
|
|
jtet1(4*(it-1)+i)=nef*(jelm1(nef*(it-1)+i)-1)+
|
||
|
|
* jelm2(nef*(it-1)+i)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
do i=1,nef
|
||
|
|
jtet1(4*(it-1)+i)=1
|
||
|
|
enddo
|
||
|
|
jtet1(4*(it-1)+4)=4*ntets+1
|
||
|
|
enddo
|
||
|
|
do it=1,ntets
|
||
|
|
index=4*(it-1)
|
||
|
|
do i=1,4
|
||
|
|
imt1(itet1(index+i))=itetclr(it)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
do i=1,npoints
|
||
|
|
itp1(i)=0
|
||
|
|
enddo
|
||
|
|
do it=1,ntets
|
||
|
|
index=4*(it-1)
|
||
|
|
i1=itet1(index+1)
|
||
|
|
i2=itet1(index+2)
|
||
|
|
i3=itet1(index+3)
|
||
|
|
i4=itet1(index+4)
|
||
|
|
do i=1,4
|
||
|
|
index=4*(it-1)+i
|
||
|
|
if(jtet1(index).le.0.or.jtet1(index).ge.mbndry) then
|
||
|
|
jndex=4*(it-1)
|
||
|
|
j1=itet1(jndex+itetface1(4,i))
|
||
|
|
j2=itet1(jndex+itetface1(1,i))
|
||
|
|
j3=itet1(jndex+itetface1(2,i))
|
||
|
|
j4=itet1(jndex+itetface1(3,i))
|
||
|
|
itp1(j2)=ifitprfl
|
||
|
|
itp1(j3)=ifitprfl
|
||
|
|
itp1(j4)=ifitprfl
|
||
|
|
icn1(j2)=ielmicn(it)
|
||
|
|
icn1(j3)=ielmicn(it)
|
||
|
|
icn1(j4)=ielmicn(it)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
do it=1,ntets
|
||
|
|
index=4*(it-1)
|
||
|
|
i1=itet1(index+1)
|
||
|
|
i2=itet1(index+2)
|
||
|
|
i3=itet1(index+3)
|
||
|
|
i4=itet1(index+4)
|
||
|
|
do i=1,3
|
||
|
|
index=3*(it-1)+i
|
||
|
|
if(jelm1(index).gt.0.and.jelm1(index).le.ntets) then
|
||
|
|
jt=jelm1(index)
|
||
|
|
jf=jelm2(index)
|
||
|
|
if(itetclr(it).ne.itetclr(jt)) then
|
||
|
|
jndex=3*(it-1)
|
||
|
|
j1=ielm(jndex+itriface1(3,i))
|
||
|
|
j2=ielm(jndex+itriface1(1,i))
|
||
|
|
j3=ielm(jndex+itriface1(2,i))
|
||
|
|
if(itp1(j2).eq.ifitprfl) then
|
||
|
|
itp1(j2)=ifitpinb
|
||
|
|
else
|
||
|
|
itp1(j2)=ifitpini
|
||
|
|
endif
|
||
|
|
if(itp1(j3).eq.ifitprfl) then
|
||
|
|
itp1(j3)=ifitpinb
|
||
|
|
else
|
||
|
|
itp1(j3)=ifitpini
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
elseif(ndim.eq.3.and.nen.eq.4.and.nef.eq.4) then
|
||
|
|
ntets=nelms
|
||
|
|
call geniee(ielm,jelm1,jelm2,nen,nef,
|
||
|
|
* ntets,npoints,3,npoints,ntets)
|
||
|
|
call cmo_set_info('ndimensions_geom',cmonam,
|
||
|
|
* ndim,1,1,ierror)
|
||
|
|
call cmo_set_info('ndimensions_topo',cmonam,
|
||
|
|
* ndim,1,1,ierror)
|
||
|
|
call cmo_set_info('nodes_per_element',cmonam,
|
||
|
|
* nen,1,1,ierror)
|
||
|
|
call cmo_set_info('faces_per_element',cmonam,
|
||
|
|
* nef,1,1,ierror)
|
||
|
|
C
|
||
|
|
nelements=ntets
|
||
|
|
call cmo_get_name(cmonam,ierror)
|
||
|
|
call cmo_set_info('nelements',cmonam,nelements,1,1,ierror)
|
||
|
|
C
|
||
|
|
call cmo_newlen(cmonam,ierror)
|
||
|
|
call cmo_get_info('itp1',cmonam,ipitp1,len,itype,ierr)
|
||
|
|
call cmo_get_info('imt1',cmonam,ipimt1,len,itype,ierr)
|
||
|
|
call cmo_get_info('icr1',cmonam,ipicr1,len,itype,ierr)
|
||
|
|
call cmo_get_info('isn1',cmonam,ipisn1,len,itype,ierr)
|
||
|
|
call cmo_get_info('icn1',cmonam,ipicn1,len,itype,ierr)
|
||
|
|
call cmo_get_info('xic',cmonam,ipxic,len,itype,ierr)
|
||
|
|
call cmo_get_info('yic',cmonam,ipyic,len,itype,ierr)
|
||
|
|
call cmo_get_info('zic',cmonam,ipzic,len,itype,ierr)
|
||
|
|
call cmo_get_info('itetclr',cmonam,ipitetclr,len,itype,ierr)
|
||
|
|
call cmo_get_info('itet',cmonam,ipitet,len,itype,ierr)
|
||
|
|
call cmo_get_info('itetoff',cmonam,ipitetoff,len,itype,ierr)
|
||
|
|
call cmo_get_info('jtet',cmonam,ipjtet,len,itype,ierr)
|
||
|
|
call cmo_get_info('jtetoff',cmonam,ipjtetoff,len,itype,ierr)
|
||
|
|
call cmo_get_info('itettyp',cmonam,ipitettyp,len,itype,ierr)
|
||
|
|
C
|
||
|
|
do it=1,ntets
|
||
|
|
itetclr(it)=ielmclr(it)
|
||
|
|
itettyp(it)=ifelmtet
|
||
|
|
itetoff(it)=4*(it-1)
|
||
|
|
jtetoff(it)=4*(it-1)
|
||
|
|
do i=1,nen
|
||
|
|
itet1(4*(it-1)+i)=ielm(4*(it-1)+i)
|
||
|
|
enddo
|
||
|
|
do i=1,nef
|
||
|
|
if(jelm1(4*(it-1)+i).eq.0) then
|
||
|
|
jtet1(4*(it-1)+i)=mbndry
|
||
|
|
else
|
||
|
|
jtet1(4*(it-1)+i)=nef*(jelm1(nef*(it-1)+i)-1)+
|
||
|
|
* jelm2(nef*(it-1)+i)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
do it=1,ntets
|
||
|
|
index=4*(it-1)
|
||
|
|
do i=1,4
|
||
|
|
imt1(itet1(index+i))=itetclr(it)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
do i=1,npoints
|
||
|
|
itp1(i)=0
|
||
|
|
enddo
|
||
|
|
do it=1,ntets
|
||
|
|
index=4*(it-1)
|
||
|
|
i1=itet1(index+1)
|
||
|
|
i2=itet1(index+2)
|
||
|
|
i3=itet1(index+3)
|
||
|
|
i4=itet1(index+4)
|
||
|
|
do i=1,4
|
||
|
|
index=4*(it-1)+i
|
||
|
|
if(jtet1(index).le.0.or.jtet1(index).ge.mbndry) then
|
||
|
|
jndex=4*(it-1)
|
||
|
|
j1=itet1(jndex+itetface1(4,i))
|
||
|
|
j2=itet1(jndex+itetface1(1,i))
|
||
|
|
j3=itet1(jndex+itetface1(2,i))
|
||
|
|
j4=itet1(jndex+itetface1(3,i))
|
||
|
|
itp1(j2)=ifitprfl
|
||
|
|
itp1(j3)=ifitprfl
|
||
|
|
itp1(j4)=ifitprfl
|
||
|
|
icn1(j2)=ielmicn(it)
|
||
|
|
icn1(j3)=ielmicn(it)
|
||
|
|
icn1(j4)=ielmicn(it)
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
do it=1,ntets
|
||
|
|
index=4*(it-1)
|
||
|
|
i1=itet1(index+1)
|
||
|
|
i2=itet1(index+2)
|
||
|
|
i3=itet1(index+3)
|
||
|
|
i4=itet1(index+4)
|
||
|
|
do i=1,4
|
||
|
|
index=4*(it-1)+i
|
||
|
|
if(jtet1(index).gt.0.and.jtet1(index).lt.mbndry) then
|
||
|
|
jt=1+(jtet1(index)-1)/4
|
||
|
|
jf=jtet1(index)-4*(jt-1)
|
||
|
|
if(itetclr(it).ne.itetclr(jt)) then
|
||
|
|
jndex=4*(it-1)
|
||
|
|
j1=itet1(jndex+itetface1(4,i))
|
||
|
|
j2=itet1(jndex+itetface1(1,i))
|
||
|
|
j3=itet1(jndex+itetface1(2,i))
|
||
|
|
j4=itet1(jndex+itetface1(3,i))
|
||
|
|
if(itp1(j2).eq.ifitprfl) then
|
||
|
|
itp1(j2)=ifitpinb
|
||
|
|
else
|
||
|
|
itp1(j2)=ifitpini
|
||
|
|
endif
|
||
|
|
if(itp1(j3).eq.ifitprfl) then
|
||
|
|
itp1(j3)=ifitpinb
|
||
|
|
else
|
||
|
|
itp1(j3)=ifitpini
|
||
|
|
endif
|
||
|
|
if(itp1(j4).eq.ifitprfl) then
|
||
|
|
itp1(j4)=ifitpinb
|
||
|
|
else
|
||
|
|
itp1(j4)=ifitpini
|
||
|
|
endif
|
||
|
|
jtet1(index)=mbndry
|
||
|
|
jtet1(4*(jt-1)+jf)=mbndry
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
elseif(ndim.eq.3.and.nen.eq.8.and.nef.eq.6) then
|
||
|
|
call cmo_set_info('ndimensions_geom',cmonam,
|
||
|
|
* ndim,1,1,ierror)
|
||
|
|
call cmo_set_info('ndimensions_topo',cmonam,
|
||
|
|
* ndim,1,1,ierror)
|
||
|
|
call cmo_set_info('nodes_per_element',cmonam,
|
||
|
|
* nen,1,1,ierror)
|
||
|
|
call cmo_set_info('faces_per_element',cmonam,
|
||
|
|
* nef,1,1,ierror)
|
||
|
|
ioption=24
|
||
|
|
call hextotet_att(ioption,nelms,ipielmclr,ipielm)
|
||
|
|
endif
|
||
|
|
close(iunit)
|
||
|
|
iunit=-1
|
||
|
|
lenfile=icharlnf(ifile)
|
||
|
|
jfile=ifile(1:lenfile) // '.dat'
|
||
|
|
call hassign(iunit,jfile,ierror)
|
||
|
|
read(iunit,'(a8)') jword
|
||
|
|
read(iunit,'(a10)') jword
|
||
|
|
read(iunit,'(a8)') jword
|
||
|
|
read(iunit,'(a27)') jword
|
||
|
|
read(iunit,*) ndata
|
||
|
|
read(iunit,*) jword
|
||
|
|
read(iunit,"(a80)") jword
|
||
|
|
read(iunit,"(a80)") jword
|
||
|
|
read(iunit,"(a80)") jword
|
||
|
|
do id=1,ndata
|
||
|
|
if(id.eq.1) then
|
||
|
|
call cmo_get_attinfo('densname',cmonam,iout,rout,cdensnm,
|
||
|
|
* ipout,lout,itype,ierror_return)
|
||
|
|
call cmo_get_info(cdensnm,cmonam,ipdens,lth,itype,ier)
|
||
|
|
if(ier.ne.0) then
|
||
|
|
cbuff='cmo/addatt/-def-/dens/VDOUBLE/scalar/nnodes' //
|
||
|
|
* '/linear/permanent/ /0/ ; finish'
|
||
|
|
call dotaskx3d(cbuff,ierror)
|
||
|
|
endif
|
||
|
|
elseif (id.eq.2) then
|
||
|
|
call cmo_get_attinfo('presname',cmonam,iout,rout,cpresnm,
|
||
|
|
* ipout,lout,itype,ierror_return)
|
||
|
|
call cmo_get_info(cpresnm,cmonam,ippres,lth,itype,ier)
|
||
|
|
if(ier.ne.0) then
|
||
|
|
cbuff='cmo/addatt/-def-/pres/VDOUBLE/scalar/nnodes' //
|
||
|
|
* '/linear/permanent/ /0/ ; finish'
|
||
|
|
call dotaskx3d(cbuff,ierror)
|
||
|
|
endif
|
||
|
|
elseif (id.eq.3) then
|
||
|
|
call cmo_get_attinfo('enername',cmonam,iout,rout,cenernm,
|
||
|
|
* ipout,lout,itype,ierror_return)
|
||
|
|
call cmo_get_info(cenernm,cmonam,ipener,lth,itype,ier)
|
||
|
|
if(ier.ne.0) then
|
||
|
|
cbuff='cmo/addatt/-def-/ener/VDOUBLE/scalar/nnodes' //
|
||
|
|
* '/linear/permanent/ /0/ ; finish'
|
||
|
|
call dotaskx3d(cbuff,ierror)
|
||
|
|
endif
|
||
|
|
elseif (id.eq.4) then
|
||
|
|
call cmo_get_attinfo('velname',cmonam,iout,rout,cvelnm,
|
||
|
|
* ipout,lout,itype,ierror_return)
|
||
|
|
call cmo_get_info(cvelnm,cmonam,ipvels,lth,itype,ier)
|
||
|
|
if(ier.ne.0) then
|
||
|
|
cbuff='cmo/addatt/-def-/vels/VDOUBLE/vector/nnodes' //
|
||
|
|
* '/linear/permanent/ /0/ ; finish'
|
||
|
|
call dotaskx3d(cbuff,ierror)
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
read(iunit,"(a80)",end=9998) iword
|
||
|
|
do i=1,npoints
|
||
|
|
read(iunit,*) value1
|
||
|
|
value2=value1
|
||
|
|
C****** if(abs(value1).le.1.0d-30) then
|
||
|
|
C****** value2=0.0d+00
|
||
|
|
C****** else
|
||
|
|
C****** value2=sign(log(abs(value1)),value1)
|
||
|
|
C****** endif
|
||
|
|
if(id.eq.1) then
|
||
|
|
dens(i)=value2
|
||
|
|
elseif(id.eq.2) then
|
||
|
|
pres(i)=value2
|
||
|
|
elseif(id.eq.3) then
|
||
|
|
ener(i)=value2
|
||
|
|
elseif(id.eq.4) then
|
||
|
|
vels(1,i)=value2
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
read(iunit,"(a80)") iword
|
||
|
|
enddo
|
||
|
|
9998 close(iunit)
|
||
|
|
goto 9999
|
||
|
|
9999 continue
|
||
|
|
|
||
|
|
if (npoints.gt.0) then
|
||
|
|
call cmo_get_name(cmonam,ierror)
|
||
|
|
call cmo_set_info('nnodes',cmonam,npoints,1,1,ier)
|
||
|
|
call cmo_set_info('nelements',cmonam,ntets,1,1,ier)
|
||
|
|
call cmo_set_info('mbndry',cmonam,mbndry,1,1,ier)
|
||
|
|
else
|
||
|
|
write(logmess,*)
|
||
|
|
* "readdatex error: early exit writing for " // cmonam
|
||
|
|
call writloga('default',0,logmess,0,ierrw)
|
||
|
|
endif
|
||
|
|
|
||
|
|
call mmrelprt(isubname,icscode)
|
||
|
|
return
|
||
|
|
end
|