140 lines
3.8 KiB
FortranFixed
140 lines
3.8 KiB
FortranFixed
|
subroutine geometry_create_lg(imsgin,xmsgin,cmsgin,msgtype,
|
||
|
|
* nwds,ierror)
|
||
|
|
C
|
||
|
|
C
|
||
|
|
C#######################################################################
|
||
|
|
C
|
||
|
|
C PURPOSE -
|
||
|
|
C
|
||
|
|
C Create a new geometry entry
|
||
|
|
c geometry/create/geom_name
|
||
|
|
c
|
||
|
|
C
|
||
|
|
C INPUT ARGUMENTS -
|
||
|
|
C
|
||
|
|
C imsgin() - Integer array of command input tokens
|
||
|
|
C xmsgin() - Real array of command input tokens
|
||
|
|
C cmsgin() - Character array of command input tokens
|
||
|
|
C msgtype() - Integer array of command input token types
|
||
|
|
C nwds - Number of command input tokens
|
||
|
|
c
|
||
|
|
c OUTPUT
|
||
|
|
c ierror - return flag (0= ok, 1=error)
|
||
|
|
c
|
||
|
|
c CHANGE
|
||
|
|
C $Log: geometry_create_lg.f,v $
|
||
|
|
C Revision 2.00 2007/11/05 19:45:56 spchu
|
||
|
|
C Import to CVS
|
||
|
|
C
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.2 Wed Apr 05 11:07:04 2000 dcg
|
||
|
|
CPVCS check for null current geometry name
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.1 Mon Mar 20 17:08:22 2000 dcg
|
||
|
|
CPVCS fix mesh object/ geometry correspondence
|
||
|
|
CPVCS add geometry/release option
|
||
|
|
CPVCS
|
||
|
|
CPVCS Rev 1.0 Tue Feb 15 10:31:50 2000 dcg
|
||
|
|
CPVCS Initial revision.
|
||
|
|
C
|
||
|
|
C#######################################################################
|
||
|
|
C
|
||
|
|
implicit none
|
||
|
|
include 'geom_lg.h'
|
||
|
|
integer imsgin(*),msgtype(*),ierror,nwds
|
||
|
|
real*8 xmsgin(*)
|
||
|
|
character*32 cmsgin(*)
|
||
|
|
character*32 geom_name
|
||
|
|
c
|
||
|
|
character*132 logmess
|
||
|
|
integer i,len,lengeom,ierrw
|
||
|
|
character*32 partname
|
||
|
|
c
|
||
|
|
c if command is release call correct subroutine
|
||
|
|
c
|
||
|
|
if(cmsgin(2).eq.'release') then
|
||
|
|
call geometry_release_lg (imsgin,xmsgin,cmsgin,msgtype,
|
||
|
|
* nwds,ierror)
|
||
|
|
go to 9999
|
||
|
|
endif
|
||
|
|
c
|
||
|
|
c see if geometry name is the current one - if not save the old
|
||
|
|
c state and get the new one
|
||
|
|
c
|
||
|
|
ierror=0
|
||
|
|
geom_name=cmsgin(3)
|
||
|
|
partname='geom_lg'
|
||
|
|
call mmfindbk ('geom_names',partname,
|
||
|
|
* ipgeom_names,lengeom,ierror)
|
||
|
|
call mmfindbk ('geom_info',partname,
|
||
|
|
* ipgeom_info,len,ierror)
|
||
|
|
if(geom_name.eq.current_geom_name) then
|
||
|
|
write(logmess,'(a)') 'Geometry already the current one '
|
||
|
|
call writloga('default',0,logmess,0,ierrw)
|
||
|
|
ierror=1
|
||
|
|
go to 9999
|
||
|
|
endif
|
||
|
|
c
|
||
|
|
c new one see if enough room
|
||
|
|
c
|
||
|
|
if(number_of_geometries+1.gt.lengeom) then
|
||
|
|
call mmincblk ('geom_names',partname,
|
||
|
|
* ipgeom_names,10,ierror)
|
||
|
|
call mmincblk ('geom_info',partname,
|
||
|
|
* ipgeom_info,80,ierror)
|
||
|
|
endif
|
||
|
|
c
|
||
|
|
c save old info
|
||
|
|
c
|
||
|
|
if(current_geom_name.eq.' ') go to 10
|
||
|
|
do i=1,number_of_geometries
|
||
|
|
if(current_geom_name.eq.geom_names(i)) then
|
||
|
|
if(nsurf.ne.0) geom_info(1,i)=nsurf
|
||
|
|
if(nregs.ne.0) geom_info(2,i)=nregs
|
||
|
|
if(nmregs.ne.0) geom_info(3,i)=nmregs
|
||
|
|
if(maxdef.ne.0) geom_info(4,i)=maxdef
|
||
|
|
if(maxmdef.ne.0) geom_info(5,i)=maxmdef
|
||
|
|
if(lastregdef.ne.0) geom_info(6,i)=lastregdef
|
||
|
|
if(lastmregdef.ne.0) geom_info(7,i)=lastmregdef
|
||
|
|
if(lastsparam.ne.0) geom_info(8,i)=lastsparam
|
||
|
|
go to 10
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
write(logmess,8) current_geom_name
|
||
|
|
8 format ('cannot find current geometry: ',a32)
|
||
|
|
call writloga('default',0,logmess,0,ierrw)
|
||
|
|
ierror=1
|
||
|
|
go to 9999
|
||
|
|
c
|
||
|
|
c initialize new
|
||
|
|
c
|
||
|
|
10 number_of_geometries=number_of_geometries+1
|
||
|
|
i=number_of_geometries
|
||
|
|
geom_names(i)=geom_name
|
||
|
|
nsurf=0
|
||
|
|
nregs=0
|
||
|
|
nmregs=0
|
||
|
|
maxdef=0
|
||
|
|
maxmdef=0
|
||
|
|
lastregdef=0
|
||
|
|
lastmregdef=0
|
||
|
|
lastsparam=0
|
||
|
|
geom_info(1,i)=0
|
||
|
|
geom_info(2,i)=0
|
||
|
|
geom_info(3,i)=0
|
||
|
|
geom_info(4,i)=0
|
||
|
|
geom_info(5,i)=0
|
||
|
|
geom_info(6,i)=0
|
||
|
|
geom_info(7,i)=0
|
||
|
|
geom_info(8,i)=0
|
||
|
|
write(logmess,12) geom_name
|
||
|
|
12 format(' Current geometry name set to: ',a32)
|
||
|
|
call writloga('default',0,logmess,0,ierrw)
|
||
|
|
current_geom_name=geom_name
|
||
|
|
9999 return
|
||
|
|
end
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|