|
C*******************************************************************
C**
C** v e m c o n v e r t
C**
C** conversion between different mesh files formats
C**
C** by L. Grosz Karlsruhe, Sept. 1994
C**
C*******************************************************************
C**
PROGRAM VEMEXM
C**
C**-----------------------------------------------------------------
C**
IMPLICIT NONE
include 'bytes.h'
C**
C**-----------------------------------------------------------------
C**
C** some parameters which may be chanced:
C**
C** INPUT = name of the input file. The file extension
C** specifies the data format:
C** xxx.unv - the mesh is read from the ideas
C** universal file xxx.unv, see idevem.
C** xxx.neutral - the mesh is read from the PATRAN
C** neutral file xxx.neutral, see
C** patvem.
C** all other cases - the mesh is read from the
C** vecfem input file data, see
C** vemu02.
C** PRINT = name of the output file for the printing of the
C** mesh. If the name has not the extension 'prt' the
C** printing is skipped.
C** IDEAS = name of the output file for the ideas universal
C** file. If the name has not the extension 'unv' the
C** printing is skipped.
C** PATRAN = name of the output file for the PATRAN neutral
C** file. If the name has not the extension 'neutral'
C** the printing is skipped.
C** ISVAS = name of the output files for the ISVAS input files.
C** If the name has not the extension 'isv' the
C** is skipped. Actual the files ISVAS//'.nodes'
C** and ISVAS//'.elements' are written.
C** STORAGE = total storage of process in Mbytes.
C** COMP6 = handling of Dirichlet conditions, see vempat,
C** patvem, vemide, idevem.
C** NK = if you want to handle more than six components, you
C** have to increase the number of components NK.
C**
INTEGER STORAGE,COMP6,NK
CHARACTER*80 INPUT,PRINT,IDEAS,PATRAN,ISVAS
PARAMETER (INPUT='mesh.unv',
& PRINT='meshout.prt',
& IDEAS='meshout.unv',
& PATRAN='meshout.neutral',
& ISVAS=' ',
& STORAGE=10,
& COMP6=0,
& NK=6)
C**
C**-----------------------------------------------------------------
C**
C** special parameters explained in mesh(3):
C**
INTEGER MESH,GINFO,GINFO1,DINFO,DINFO1,LOUT,DIM
PARAMETER (MESH =310,
& DIM =3,
& GINFO =30,
& GINFO1=23+2*NK,
& DINFO =GINFO+GINFO1*100,
& DINFO1=17,
& LOUT =6)
C**
C**-----------------------------------------------------------------
C**
C** the length of the array for the mesh are set:
C** it will happen, that these lengths are to small for
C** the given mesh. then you have to enter the correct lengths
C** prescribed by the program into this declaration.
C**
INTEGER LNODN,LNOD,LNOPRM,LNEK,LRPARM,LIPARM,
& LDNOD,LIDPRM,LRDPRM,LIVEM,LBIG
PARAMETER (LNODN =1000,
& LNOD =LNODN*DIM,
& LNOPRM=1,
& LNEK =40000,
& LIPARM=1000,
& LRPARM=50,
& LDNOD =1500,
& LIDPRM=LDNOD/2,
& LRDPRM=LDNOD/2,
& LIVEM =MESH+DINFO+DINFO1*NK)
C**
C**-----------------------------------------------------------------
C**
C** RBIG should be as large as possible: the available
C** storage STORAGE is reduced by all allocated array.
C** the remaining storage is reserved for RBIG.
C**
PARAMETER ( LBIG=(STORAGE * 1 000 000)/IREAL
& - (LNOD+LNOPRM+LRPARM+LRDPRM)
& - (LIVEM+LNODN+LNEK+LIPARM+LDNOD+LIDPRM)/RPI )
C**
C**-----------------------------------------------------------------
C**
C** variables and arrays :
C** --------------------
C**
DOUBLE PRECISION NOD(LNOD),NOPARM(LNOPRM),RPARM(LRPARM),
& RDPARM(LRDPRM),RBIG(LBIG)
INTEGER IVEM(LIVEM),NODNUM(LNODN),NEK(LNEK),
& IPARM(LIPARM),DNOD(LDNOD),IDPARM(LIDPRM),
& IBIG(RPI*LBIG)
C**
C**-----------------------------------------------------------------
C**
CHARACTER*80 NAME
INTEGER MYPROC,INFO,OUTFLG
C**
C**-----------------------------------------------------------------
C**
C** The equivalence of RBIG and IBIG is very important :
C**
EQUIVALENCE (RBIG,IBIG)
C**
C**-----------------------------------------------------------------
C**
C** get task ids :
C**
NAME='a.out'
CALL COMBGN(IVEM(200),MYPROC,LIVEM-203,IVEM(204),NAME,INFO)
IF (INFO.NE.0) GOTO 9999
IVEM(201)=MYPROC
IVEM(202)=0
IVEM(203)=IVEM(204)
C**
C**-----------------------------------------------------------------
C**
C** a protocol is printed only on process 1 :
C**
IF (MYPROC.EQ.1) THEN
OUTFLG=1
ELSE
OUTFLG=0
ENDIF
C**
C**-----------------------------------------------------------------
C**
C**** the parameters are copied into IVEM :
C** -----------------------------------
C**
IVEM(1)=MESH
IVEM(MESH+ 2)=NK
IVEM(MESH+ 3)=DIM
IF (MYPROC.EQ.1) OPEN(99,FILE=INPUT,STATUS= 'UNKNOWN',
& FORM='FORMATTED')
C**
C**-----------------------------------------------------------------
C**
C**** read a universal file :
C** ----------------------
C**
IF (INDEX(INPUT,'.unv').GT.0) THEN
IVEM(120)=LOUT
IVEM(121)=OUTFLG
IVEM(122)=99
IVEM(124)=COMP6
IVEM(124)=0
CALL IDEVEM (LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,IPARM ,
& LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
C**
C**-----------------------------------------------------------------
C**
C**** read a neutral file :
C** --------------------
C**
ELSEIF (INDEX(INPUT,'.neutral').GT.0) THEN
IVEM(120)=LOUT
IVEM(121)=OUTFLG
IVEM(122)=99
IVEM(124)=COMP6
CALL PATVEM (LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,IPARM ,
& LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
ELSE
C**
C**-----------------------------------------------------------------
C**
C**** read a vecfem input file :
C** ------------------------
C**
IVEM(27)=LOUT
IVEM(28)=OUTFLG
IVEM(29)=99
CALL VEMU02 (LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,IPARM ,
& LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
ENDIF
IF (IVEM(2).NE.0) GOTO 9999
CLOSE (99)
C**
C**-----------------------------------------------------------------
C**
C**** distribute mesh :
C** ----------------
C**
IVEM(80)=LOUT
IVEM(81)=OUTFLG
IVEM(51)=5
CALL VEMDIS (LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,IPARM ,
& LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
IF (IVEM(2).NE.0) GOTO 9999
C**
C**-----------------------------------------------------------------
C**
C**** print mesh :
C** -----------
C**
IF (INDEX(PRINT,'.prt').GT.1) THEN
IF (MYPROC.EQ.1) OPEN(99,FILE=PRINT,STATUS= 'UNKNOWN',
& FORM='FORMATTED')
IVEM(20)=99
IVEM(21)=1111*OUTFLG
IVEM(22)=2
CALL VEMU01(LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,IPARM,
& LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
IF (IVEM(2).NE.0) GOTO 9999
CLOSE (99)
ENDIF
C**
C**-----------------------------------------------------------------
C**
C**** write ideas universal file :
C** --------------------------
C**
IF (INDEX(IDEAS,'.unv').GT.1) THEN
IF (MYPROC.EQ.1) OPEN(99,FILE=IDEAS,STATUS= 'UNKNOWN',
& FORM='FORMATTED')
IVEM(120)=LOUT
IVEM(121)=OUTFLG
IVEM(124)=COMP6
IVEM(125)=99
CALL VEMIDE(IDEAS,LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,
& IPARM,LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
IF (IVEM(2).NE.0) GOTO 9999
CLOSE (99)
ENDIF
C**
C**-----------------------------------------------------------------
C**
C**** write PATRAN neutral file :
C** --------------------------
C**
IF (INDEX(PATRAN,'.neutral').GT.1) THEN
IF (MYPROC.EQ.1) OPEN(99,FILE=PATRAN,STATUS= 'UNKNOWN',
& FORM='FORMATTED')
IVEM(120)=LOUT
IVEM(121)=OUTFLG
IVEM(124)=COMP6
IVEM(125)=99
CALL VEMPAT(PATRAN,LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,
& IPARM,LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
IF (IVEM(2).NE.0) GOTO 9999
CLOSE (99)
ENDIF
C**
C**-----------------------------------------------------------------
C**
C**** write ISVAS data files :
C** -----------------------
C**
IF (INDEX(ISVAS,'.isv').GT.1) THEN
NAME=ISVAS
NAME(INDEX(ISVAS,'.isv')+4:)='.nodes'
IF (MYPROC.EQ.1) OPEN(98,FILE=NAME,FORM='FORMATTED')
NAME(INDEX(ISVAS,'.isv')+4:)='.elements'
IF (MYPROC.EQ.1) OPEN(99,FILE=NAME,FORM='FORMATTED')
IVEM(120)=LOUT
IVEM(121)=OUTFLG
IVEM(125)=98
IVEM(126)=99
CALL VEMISV(ISVAS,LIVEM,IVEM,LNEK,NEK,LRPARM,RPARM,LIPARM,
& IPARM,LDNOD,DNOD,LRDPRM,RDPARM,LIDPRM,IDPARM,
& LNODN,NODNUM,LNOD,NOD,LNOPRM,NOPARM,
& LBIG,RBIG,IBIG)
IF (IVEM(2).NE.0) GOTO 9999
CLOSE (98)
CLOSE (99)
ENDIF
C**
C**-----------------------------------------------------------------
C**
C**** end of calculation
C** ------------------
C**
9999 CALL COMEND(IVEM(200),INFO)
|