initial upload
This commit is contained in:
355
src/bubble.f
Executable file
355
src/bubble.f
Executable file
@@ -0,0 +1,355 @@
|
||||
|
||||
subroutine bubble(imsgin,xmsgin,cmsgin,msgtype,nwds,ierror)
|
||||
C
|
||||
C########################################################################
|
||||
C
|
||||
C PURPOSE -
|
||||
C
|
||||
C This subroutine extrudes a pseudo-2D polygon made up of quads,
|
||||
C triangles, or hybrid polygons (normals of the curve pointing
|
||||
C in more or less the same direction) into three dimensions along
|
||||
C either the normal to the curve (default) or a user entered
|
||||
C value. It then takes the volume and makes it a closed surface.
|
||||
C (i.e., instead of being made up of volume elements, it is now a
|
||||
C shell)
|
||||
C
|
||||
C NOTES -
|
||||
C
|
||||
C Currently only for xyz coordinate system.
|
||||
C Syntax for this command:
|
||||
C bubble/sink_mesh_object/source_mesh_object/
|
||||
C const|min/
|
||||
C real|integer/
|
||||
C [norm|x1,y1,z1]
|
||||
C
|
||||
C if argument 4 is const, argument 5 is considered to be a constant
|
||||
C offset from the surface; min, it is the minimum distance
|
||||
C from the surface to a reference plane. The extruding vector is normal
|
||||
C to the reference plane.
|
||||
C
|
||||
C argument 6 states whether or not the extruding vector will be the
|
||||
C average normal to the surface, or a user specified vector. This
|
||||
C argument is optional, norm is the default. If the user specifies a
|
||||
C vector, the vector will be normalized (i.e., only the directionality
|
||||
C will be used)
|
||||
C
|
||||
C
|
||||
C INPUT ARGUMENTS -
|
||||
C
|
||||
C xmsgin() - REAL ARRAY OF COMMAND INPUT VALUES
|
||||
C cmsgin() - CHARACTER ARRAY OF COMMAND INPUT VALUES
|
||||
C imsgin() - INTEGER ARRAY OF COMMAND INPUT VALUES
|
||||
C msgtype() - INTEGER ARRAY OF COMMAND INPUT TYPE
|
||||
C nwds - NO. OF WORDS OF COMMAND INPUT VALUES
|
||||
C
|
||||
C CHANGE HISTORY -
|
||||
C$Log: bubble.f,v $
|
||||
CRevision 2.00 2007/11/05 19:45:47 spchu
|
||||
CImport to CVS
|
||||
C
|
||||
CPVCS
|
||||
CPVCS Rev 1.2 07 Feb 2000 17:37:14 dcg
|
||||
CPVCS remove unused comdict.h
|
||||
CPVCS
|
||||
CPVCS Rev 1.1 Thu Aug 13 15:08:50 1998 dcg
|
||||
CPVCS IBM changes
|
||||
CPVCS
|
||||
CPVCS Rev 1.0 Fri Aug 07 13:27:30 1998 dcg
|
||||
CPVCS Initial revision.
|
||||
C
|
||||
C
|
||||
C########################################################################
|
||||
C
|
||||
implicit none
|
||||
|
||||
C tam commented unused machine.h which now needs preprocessor
|
||||
C include "machine.h"
|
||||
|
||||
include "chydro.h"
|
||||
include "local_element.h"
|
||||
C
|
||||
C########################################################################
|
||||
C
|
||||
C Variable Declarations
|
||||
C
|
||||
C########################################################################
|
||||
C
|
||||
C Subroutine Input Variables
|
||||
C
|
||||
character*(*) cmsgin(nwds)
|
||||
real*8 xmsgin(nwds)
|
||||
integer imsgin(nwds), msgtype(nwds)
|
||||
integer nwds, ierror
|
||||
C
|
||||
integer httopt
|
||||
integer i,j,nen,ilen,icmotype,idelete
|
||||
C
|
||||
C Subroutine Input Variables save pts.
|
||||
C
|
||||
real*8 xvect
|
||||
real*8 yvect
|
||||
real*8 zvect
|
||||
real*8 offset
|
||||
|
||||
C Name Variables and Message Variables
|
||||
|
||||
character*32 cmoin, cmoout
|
||||
character*16 cmotmp1, cmotmp2
|
||||
character*132 logmess
|
||||
character*256 cmdmess
|
||||
C
|
||||
character*6 type
|
||||
character*5 vtype
|
||||
C
|
||||
C
|
||||
C
|
||||
C########################################################################
|
||||
C
|
||||
C Initialize Error Flag and other assorted goodies
|
||||
C
|
||||
ierror = 0
|
||||
cmoin = '-cmo-'
|
||||
cmoout = '-none-'
|
||||
cmotmp1 = 'cmotmp1'
|
||||
cmotmp2 = 'cmotmp2'
|
||||
C
|
||||
C#######################################################################
|
||||
C
|
||||
C Check the gross syntax of the command entered & get type info
|
||||
C
|
||||
if((nwds.ne.5).AND.(nwds.ne.6).AND.(nwds.ne.8)) then
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine bubble: The proper Syntax is:'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
write(logmess,'(a)')
|
||||
& 'bubble/cmoout/cmoin/min|const/offset/[norm|x1,y1,z1]'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
endif
|
||||
C
|
||||
C Get the Type of extrusion
|
||||
type=cmsgin(4)
|
||||
if((type.ne.'min').AND.(type.ne.'const')) then
|
||||
write(logmess,'(a)')
|
||||
& 'Warning in bubble: Extrusion type is neither min nor'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
write(logmess,'(a)')
|
||||
& 'const. Assuming const!'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
type='const'
|
||||
endif
|
||||
C
|
||||
C Get the offset
|
||||
if(msgtype(5).eq.1) then
|
||||
offset=imsgin(5)
|
||||
elseif(msgtype(5).eq.2) then
|
||||
offset=xmsgin(5)
|
||||
else
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine bubble: offset is not a number!'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
endif
|
||||
C
|
||||
C Based on the number of arguments, do the needful...
|
||||
if((nwds.ne.5).AND.(cmsgin(6).ne.'norm').AND.(nwds.ne.8)) then
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine bubble: invalid extruding vector!'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
elseif(nwds.ne.8) then
|
||||
vtype='norm'
|
||||
else
|
||||
vtype='user'
|
||||
C GET THE X PART OF THE EXTRUDING VECTOR
|
||||
if(msgtype(6).eq.1) then
|
||||
xvect=imsgin(6)
|
||||
elseif(msgtype(6).eq.2) then
|
||||
xvect=xmsgin(6)
|
||||
else
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine bubble: x vector is not a number!'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
endif
|
||||
C GET THE Y PART OF THE EXTRUDING VECTOR
|
||||
if(msgtype(7).eq.1) then
|
||||
yvect=imsgin(7)
|
||||
elseif(msgtype(7).eq.2) then
|
||||
yvect=xmsgin(7)
|
||||
else
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine bubble: y vector is not a number!'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
endif
|
||||
C GET THE Z PART OF THE EXTRUDING VECTOR
|
||||
if(msgtype(8).eq.1) then
|
||||
zvect=imsgin(8)
|
||||
elseif(msgtype(8).eq.2) then
|
||||
zvect=xmsgin(8)
|
||||
else
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine bubble: z vector is not a number!'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
endif
|
||||
endif
|
||||
C
|
||||
C
|
||||
C#######################################################################
|
||||
C
|
||||
C All the pre-processing is done...Initialize the Mesh objects
|
||||
C
|
||||
C ******************************************************************
|
||||
C Check if the input MO exists
|
||||
C
|
||||
cmoin=cmsgin(3)
|
||||
call cmo_exist(cmoin,ierror)
|
||||
if(ierror.ne.0) then
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine extract_line: input MO does not exist'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
endif
|
||||
C
|
||||
C ******************************************************************
|
||||
C Get incoming MO information & Check if it's valid
|
||||
C
|
||||
call cmo_get_info('nodes_per_element',cmoin,
|
||||
& nen,ilen,icmotype,ierror)
|
||||
if((nen.ne.3).AND.(nen.ne.4).AND.(nen.lt.9)) then
|
||||
write(logmess,'(a)')
|
||||
& 'Error in subroutine bubble: Input MO can only be made up'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
write(logmess,'(a)')
|
||||
& ' of triangles, quads, or hybrid elements!'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
ierror = 1
|
||||
go to 9999
|
||||
endif
|
||||
C
|
||||
C Figure out the proper hextotet conversion option.
|
||||
if(nen.eq.3) then
|
||||
httopt=3
|
||||
elseif(nen.eq.4) then
|
||||
httopt=5
|
||||
elseif(nen.ge.9) then
|
||||
write(logmess,'(a)')
|
||||
& 'Warning: hextotet may get confused, output may be garbled'
|
||||
call writloga('default',0,logmess,0,ierror)
|
||||
httopt=5
|
||||
endif
|
||||
C
|
||||
C ******************************************************************
|
||||
C Save the output MO name. Check if it exists, if it does, clear it
|
||||
C so we can create it.
|
||||
C
|
||||
cmoout=cmsgin(2)
|
||||
call cmo_exist(cmoout,ierror)
|
||||
if(ierror.eq.0) call cmo_release(cmoout,idelete)
|
||||
C
|
||||
C ******************************************************************
|
||||
C Ensure Temporary MO names are not in use... if they are, modify
|
||||
C them. Now... if someone decides to use cmotmp2%%%%%%%,
|
||||
C We are not responsible.
|
||||
do i=1,9
|
||||
call cmo_exist(cmotmp1,ierror)
|
||||
if(ierror.eq.0) then
|
||||
do j=7,16
|
||||
if(cmotmp1(j:j).eq.' ') then
|
||||
cmotmp1(j:j)='%'
|
||||
goto 5
|
||||
endif
|
||||
enddo
|
||||
5 continue
|
||||
else
|
||||
goto 10
|
||||
endif
|
||||
enddo
|
||||
10 continue
|
||||
do i=1,9
|
||||
call cmo_exist(cmotmp2,ierror)
|
||||
if(ierror.eq.0) then
|
||||
do j=7,16
|
||||
if(cmotmp2(j:j).eq.' ') then
|
||||
cmotmp2(j:j)='%'
|
||||
goto 15
|
||||
endif
|
||||
enddo
|
||||
15 continue
|
||||
else
|
||||
goto 20
|
||||
endif
|
||||
enddo
|
||||
20 continue
|
||||
C
|
||||
C#######################################################################
|
||||
C
|
||||
C The first command: extrude
|
||||
C
|
||||
C ******************************************************************
|
||||
C Build the command line
|
||||
C
|
||||
if(vtype.eq.'norm') then
|
||||
write(cmdmess,25) cmotmp1,cmoin,type,offset
|
||||
25 format('extrude/',A,'/',A,'/',A,'/',F13.6,'/s/norm; finish')
|
||||
call dotaskx3d(cmdmess,ierror)
|
||||
if(ierror.ne.0) then
|
||||
goto 9999
|
||||
endif
|
||||
else
|
||||
write(cmdmess,30) cmotmp1,cmoin,type,offset,xvect,yvect,zvect
|
||||
30 format('extrude/',A,'/',A,'/',A,'/',F13.6,'/s/',
|
||||
& F13.6,'/',F13.6,'/',F13.6,'; finish')
|
||||
call dotaskx3d(cmdmess,ierror)
|
||||
if(ierror.ne.0) then
|
||||
goto 9999
|
||||
endif
|
||||
endif
|
||||
C
|
||||
C#######################################################################
|
||||
C
|
||||
C HextoTet and Extract commands create the bubble
|
||||
C
|
||||
write(cmdmess,35) httopt,cmotmp2,cmotmp1
|
||||
35 format('hextotet/',I1,'/',A,'/',A,'; finish')
|
||||
call dotaskx3d(cmdmess,ierror)
|
||||
if(ierror.ne.0) then
|
||||
goto 9999
|
||||
endif
|
||||
C
|
||||
write(cmdmess,40) cmoout,cmotmp2
|
||||
40 format('extract/intrface/-all-/1 0 0/',A,'/',A,'; finish')
|
||||
call dotaskx3d(cmdmess,ierror)
|
||||
if(ierror.ne.0) then
|
||||
goto 9999
|
||||
endif
|
||||
C
|
||||
C#######################################################################
|
||||
C
|
||||
C Release Temporary Memory
|
||||
C
|
||||
9999 continue
|
||||
|
||||
call cmo_exist(cmotmp1,ierror)
|
||||
if(ierror.eq.0) call cmo_release(cmotmp1,idelete)
|
||||
call cmo_exist(cmotmp2,ierror)
|
||||
if(ierror.eq.0) call cmo_release(cmotmp2,idelete)
|
||||
return
|
||||
end
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user