|
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) |