贡献一个BLOCK划分网格的程序
C PROGRAM GENDYNE VERSION 3.0 (2\1992)C ***********************************************************
C * PROGRAM TO GENERATE TWO DIMENSIONAL FINITE ELEMENT *
C * MESHES USING A MACRO BLOCK TECHNIQUE. *
C ***********************************************************
C FEATURES :
C * GENERATES 3,4,6,8 AND 9 NODED ISOPARAMETRIC
C ELEMENTS.
C * CONTAINS EXTENSIVE INTERACTIVE PLOTTING
C FACILITIES.
C * FRONTAL WIDTH MINIMISATION OPTION
C * GENERATION OF 4 AND 6 NODED JOINT ELEMENTS
C * GENERATION OF 4,5 AND 6 NODED INFINITE ELEMENTS
C * SPECIAL SPLITTING MACRO BLOCKS
C **********************************************************
DIMENSION COORD(4000,2),LNODS(2500,9),MATNO(2500),
. JOINT(2500),ITITL(80),NONOD(2500),TITLT(80)
LOGICAL ALL
C
CALL IOFILE
WRITE (6,800)
800FORMAT(/,' WELCOME TO THE MESH GENERATOR',/,/,
. ' *************************',/,
. ' * G E N G O L D *',/,
. ' *************************')
C
READ(15,1000)ITITL !-
READ(15,1000)TITLT !-
WRITE(12,900)
READ(15,*)ISWIT,IPLOT,ISUP1,IDRAW,ISUP2,NSECT
WRITE(12,920)ISWIT,IPLOT,ISUP1,IDRAW,ISUP2,NSECT
CALL DIME(MELEM,MDIME,MNODE,MPOIN,ALL)
DO 20 IELEM=1,MELEM
DO 20 INODE=1,MNODE
20 LNODS(IELEM,INODE)=0
c IF(ISWIT.EQ.1)GOTO 40
WRITE (6,810)
810FORMAT(/,1X,40('*'),//,' I AM BEGINNING MESH GENERATION')
CALL PLTMAN(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
. NDIME,MDIME,LNODS,COORD,MATNO,IPLOT,ALL,
. ISUP2,JOINT,NONOD,ITITL,NSECT)
WRITE (6,820)
820FORMAT(/,' MESH GENERATION HAS BEEN COMPLETED')
c 10IF(IPLOT.EQ.1.OR.IPLOT.EQ.4)GO TO 25
c WRITE (6,830)
c830FORMAT(/,1X,40('*'),/,/,' I AM BEGINNING FRONTWIDTH',
c . ' MINIMISATION')
C CALL RENUMB(NPOIN,NELEM,NNODE,NDIME,LNODS,COORD,
c . ALL,MELEM,MPOIN,MNODE,IPLOT,MATNO,
c . JOINT,NONOD,ISUP2)
c WRITE (6,840)
c840FORMAT(/,' FRONTWIDTH MINIMISATION HAS BEEN COMPLETED')
C 25 CONTINUE
c25 WRITE (6,850)
c850FORMAT(/,1X,40('*'),//,' I AM CREATING THE OUTPUT FILE')
c30 CALL REGENE(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
c . NDIME,MDIME,LNODS,COORD,MATNO,ALL,
c . 0,JOINT,NONOD,ITITL)
c IF(IDRAW.EQ.1)STOP
c WRITE (6,860)
c860FORMAT(/,1X,40('*'),//,' INTERACTIVE GRAPHIC ROUTINES')
c CALL ALLOCA(NELEM,MELEM,NPOIN,MPOIN,NNODE,MNODE,
C . MDIME,LNODS,COORD,ALL,JOINT,NONOD,ITITL)
c STOP
c40 READ (15,*)IRENUM
c WRITE (12,950)IRENUM
c CALL REGENE(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
c . NDIME,MDIME,LNODS,COORD,MATNO,ALL,
c . 1,JOINT,NONOD,ITITL)
c IF(IRENUM.EQ.1)GO TO 10
c IF(IRENUM.EQ.2)GO TO 30
c CALL NEWCOO(COORD,NDIME,MDIME,MPOIN)
c GO TO 30
900 FORMAT(/,20X,'MASTER SEGMENT CONTROL PARAMETERS',/,
. 20X,33(1H=),/)
920 FORMAT(/,9X,'MASTER CONTROL SWITCH ISWIT: ISWIT =',I4,
. /,9X,'MASTER CONTROL SWITCH IPLOT: IPLOT =',I4,
. /,9X,'SUPPRESSION ON GENERATED TOPOLOGY:ISUP1 =',I4,
. /,9X,'SUPPRESSION ON PLOTTING: IDRAW =',I4,
. /,9X,'SUPRRESSION ON RENUMBERED TOPOLOGY: ISUP2 =',I4,
. /,9X,'NUMBER OF SECTION IN 3DMESH: NSECT =',I4)
950 FORMAT(/,9X,'SWITCH FOR RENUMBERING: IRENUM =',I4)
1000FORMAT(80A1)
END
C
SUBROUTINE DIME(MELEM,MDIME,MNODE,MPOIN,ALL)
C**************************************************************
C SUBROUTINE DIM-CONSTANT LOCATIONS ASSIGNED *
C**************************************************************
LOGICAL ALL
MELEM=2500
MDIME=2
MNODE=9
MPOIN=4000
ALL=.FALSE.
RETURN
END
C
SUBROUTINE PLTMAN(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
. NDIME,MDIME,LNODS,COORD,MATNO,IPLOT,
. ALL,ISUP2,JOINT,NONOD,ITITL,NSECT)
C***********************************************************
C MESH GENERATION SEGMENT *
C***********************************************************
LOGICAL ALL
DIMENSION COORD(MPOIN,MDIME),LNODS(MELEM,MNODE),MATNO(MELEM),
. JOINT(MELEM),ITITL(80),NONOD(MELEM),TITLT(80)
DO 162 ISECT=1,NSECT
DO 2 IELEM=1,MELEM
2 JOINT(IELEM)=0
CALL INBLOC(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
. NDIME,MDIME,LNODS,COORD,MATNO,ALL,
. JOINT,NONOD,ITITL,XCOOR)
IF(IPLOT.EQ.4)RETURN
CALL GENER(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
. NDIME,MDIME,LNODS,COORD,MATNO)
C IF(NNODE.EQ.3.OR.NNODE.EQ.6)CALL SPLIT(NELEM,NNODE,LNODS,NDIME,
C . COORD,MATNO,MPOIN,MELEM,MDIME,MNODE)
DO 5 IELEM=1,NELEM
JOINT(IELEM)=0
5 NONOD(IELEM)=NNODE
C READ(15,1000) TITLT !-
C READ (15,*)NJOIN
C IF(NJOIN.EQ.0)GO TO 300
C WRITE (12,950)
C WRITE (12,810)NJOIN
C810FORMAT(/,' NUMBER OF JOINT OR INFINITE LINES',I4)
C DO 290 IJOIN=1,NJOIN
C WRITE (12,940)IJOIN
C CALL JOININ(COORD,JOINT,LNODS,MATNO,MDIME,MELEM,
C . MNODE,MPOIN,NELEM,NNODE,NONOD,NPOIN,
C . NDIME)
C290CONTINUE
300IF(ISECT.EQ.1) THEN
WRITE (12,900)
WRITE(21,960) NELEM,NPOIN,NNODE,NSECT,ISUP2
DO 10 IELEM=1,NELEM
LNODE=NONOD(IELEM)
WRITE (21,910)IELEM,MATNO(IELEM),
. (LNODS(IELEM,INODE),INODE=1,LNODE)
10 WRITE (12,910)IELEM,MATNO(IELEM),
. (LNODS(IELEM,INODE),INODE=1,LNODE)
ENDIF
WRITE (21,*)XCOOR
WRITE (12,902)XCOOR,NPOIN
WRITE (12,920)
DO 20 IPOIN=1,NPOIN
WRITE (21,930)IPOIN,(COORD(IPOIN,IDIME),IDIME=1,NDIME)
20 WRITE (12,930)IPOIN,(COORD(IPOIN,IDIME),IDIME=1,NDIME)
162CONTINUE
902FORMAT(/,' X-COORDAT',/,F10.5,I5)
900FORMAT(/,/,' GENERATED MESH DATA',/,1X,19(1H-),/,
. /,' ELEMENT NODAL POINTS')
910FORMAT(1X,I7,3X,12I5)
920FORMAT(/,' NODE X-COORDINATE Y-COORDINATE')
930FORMAT(1X,6X,I4,3F15.5)
940FORMAT(/' LINE NUMBER',I5,/,1X,16('-'))
950FORMAT(/,' JOINT AND INFINITE ELEMENT DATA',/,1X,31('='))
960FORMAT(5X,I5,5X,I5,5X,I5,5X ,I5,5X,I5)
1000FORMAT(80A1)
RETURN
END
C
SUBROUTINE INBLOC(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
. NDIME,MDIME,LNODS,COORD,MATNO,ALL,
. JOINT,NONOD,TITLE,XCOOR)
C********************************************************************
CSUBROUTINE INBLOC-ACCEPTS DATA DEFINING THE STRUCTURAL COUTLINE*
C********************************************************************
LOGICAL ALL
DIMENSION COORD(MPOIN,MDIME),LNODS(MELEM,MNODE),MATNO(MELEM),
. TITLE(80),NONOD(MELEM),JOINT(MELEM),TITLT(80)
DATA LNODE/8/
C
C *** THIS SUBROUTINE ACCEPTS THE INPUT DATA DEFINING
C *** THE STRUCTURAL OUTLINE
C
WRITE (12,950)
950 FORMAT(/,' PARENTAL BLOCK DATA',/,1X,20(1H=),/,/,
. ' TITLE',/,1X,5(1H=))
WRITE(12,1000) TITLE
READ (15,1000) TITLT !-
READ (15,*)NPOIN,NELEM,NNODE
NDIME=2
WRITE (12,915)NNODE
915 FORMAT(/,29HNUMBER OF NODES PER ELEMENT =,I3)
WRITE (12,920)
IF(NNODE.LT.6)ALL=.TRUE.
920 FORMAT(/,' BLOCK TOPOLOGY',/,1X,14(1H=))
WRITE (12,925)
925FORMAT(/,' BLOCK NO.MAT. NO. DEFINITION POINTS')
READ (15,1000) TITLT !-
DO 10 IELEM=1,NELEM
READ (15,*) NUMEL,MATNO(NUMEL),(LNODS(NUMEL,INODE),INODE=1,LNODE)
NONOD(NUMEL)=LNODE
10 WRITE (12,906) NUMEL,MATNO(NUMEL),
. (LNODS(NUMEL,INODE),INODE=1,LNODE)
906 FORMAT(I5,I10,I10,10I5)
WRITE (12,930)
WRITE (12,935)
930 FORMAT(/,15HLOCATION POINTS,/,15(1H=))
935 FORMAT(/,7X,'NODE',7X,'X-COORD',8X,'Y-COORD')
READ (15,1000) TITLT !-
READ (15,*)XCOOR
READ (15,1000) TITLT !-
DO 35 IPOIN=1,NPOIN
DO 35 IDIME=1,NDIME
35COORD(IPOIN,IDIME)=0.0
20READ (15,*) JPOIN,(COORD(JPOIN,IDIME),IDIME=1,NDIME)
IF(JPOIN.NE.NPOIN) GOTO 20
CALL NODEXY(MPOIN,LNODE,MNODE,NELEM,MELEM,
. MDIME,LNODS,COORD,JOINT,NONOD)
do 94 j=1,npoin
94WRITE (12,940)J,(COORD(J,IDIME),IDIME=1,NDIME)
940 FORMAT(I10,2F15.5)
1000 FORMAT(80A1)
RETURN
END
C
SUBROUTINE NODEXY(MPOIN,LNODE,MNODE,NELEM,MELEM,
. MDIME,LNODS,COORD,JOINT,NONOD)
C****************************************************************
CSUBROUTINE NODEXY-INTERPOLATES MIDSIDE NODES WHICH ARE NOT *
C ALREADY INPUTTED *
C****************************************************************
DIMENSION LNODS(MELEM,MNODE),JOINT(MELEM),COORD(MPOIN,MDIME),
. NONOD(MELEM),TITLT(80)
DO 30 IELEM=1,NELEM
IF(JOINT(IELEM).NE.0.OR.NONOD(IELEM).NE.LNODE)GOTO 30
DO 20 INODE=1,LNODE,2
NODST=LNODS(IELEM,INODE)
IGASH=INODE+2
IF(IGASH.GT.LNODE) IGASH=1
NODFN=LNODS(IELEM,IGASH)
MIDPT=INODE+1
NODMD=LNODS(IELEM,MIDPT)
TOTAL=ABS(COORD(NODMD,1))+
.ABS(COORD(NODMD,2))
IF(TOTAL.GT.0.0) GO TO 20
KOUNT=1
10COORD(NODMD,KOUNT)=(COORD(NODST,KOUNT)+
.COORD(NODFN,KOUNT))/2.0
KOUNT=KOUNT+1
IF(KOUNT.EQ.2) GO TO 10
20CONTINUE
30CONTINUE
RETURN
END
C
SUBROUTINE GENER(NPOIN,MPOIN,NNODE,MNODE,NELEM,MELEM,
. NDIME,MDIME,LNODS,COORD,MATNO)
C***************************************************************
C SUBROUTINE GENER-UNDERTAKES THE MESH SUBDIVISION *
C***************************************************************
DIMENSION WEITX(50),WEITY(50),TCORD(300,2),TNODS(50,8),
. TMATO(50),LREPN(700),LASOC(700),LFINN(700),LFASC(700),
. COORD(MPOIN,MDIME),LNODS(MELEM,MNODE),MATNO(MELEM),
. SHAPE(8)
DATA MREPN/700/,LNODE/8/
C
C *** THIS SUBROUTINE PERFORMS THE MESH SUBDIVISION
C
C *** INITIALISATION SECTION
C
DO 10 IREPN=1,MREPN
10 LREPN(IREPN)=0
DO 15 IWETX = 1,50
WEITX( IWETX ) = 0.0
15 WEITY( IWETX ) = 0.0
NPONT=NPOIN
NBLOC=NELEM
NPOIN=0
NELEM=0
KNODE=1
IF(NNODE.EQ.8)KNODE=2
IF(NNODE.EQ.9.OR.NNODE.EQ.6)KNODE=3
FNODE=1
IF(KNODE.GT.1)FNODE=2
DO 20 IPONT=1,NPONT
DO 20 IDIME=1,NDIME
20 TCORD(IPONT,IDIME)=COORD(IPONT,IDIME)
DO 30 IPOIN=1,MPOIN
DO 30 IDIME=1,NDIME
30 COORD(IPOIN,IDIME)=0.0
DO 40 IBLOC=1,NBLOC
TMATO(IBLOC)=MATNO(IBLOC)
DO 40 INODE=1,LNODE
40 TNODS(IBLOC,INODE)=LNODS(IBLOC,INODE)
C
C *** READ AND WRITE BLOCK SUBDIVISION DATA
C
WRITE (12,871)
871FORMAT(//,' PARENTAL BLOCK DIVISION DATA',
. /,1X,28(1H=),/)
READ (15,1000) TITLT !-
DO 170 IBLOC=1,NBLOC
READ (15,*) KBLOC,NDIVX,NDIVY,MTYPE
READ (15,*) (WEITX(IDIVX),IDIVX=1,NDIVX)
READ (15,*) (WEITY(IDIVY),IDIVY=1,NDIVY)
DO 44 IDIVX=1,NDIVX
IF(WEITX(IDIVX).EQ.0.0)WEITX(IDIVX)=1.0
44 CONTINUE
DO 46 IDIVY=1,NDIVY
IF(WEITY(IDIVY).EQ.0.0)WEITY(IDIVY)=1.0
46 CONTINUE
WRITE (12,910) KBLOC
WRITE (12,915)
WRITE (12,920) NDIVX,NDIVY,MTYPE
WRITE (12,925)
WRITE (12,905) (WEITX(IDIVX),IDIVX=1,NDIVX)
WRITE (12,930)
WRITE (12,905) (WEITY(IDIVY),IDIVY=1,NDIVY)
905 FORMAT(8F10.3)
910 FORMAT(/,5X,15H DATA BLOCK NO.,I3)
915 FORMAT(6X,17H-----------------)
920 FORMAT(/,' NUMBER OF DIVISIONS IN FIRST DIRECTION=',I4,
. /,' NUMBER OF DIVISIONS IN SECOND DIRECTION =',I4,
. /,' MTYPE =',I4)
925 FORMAT(/,5X,44HLIST OF WEIGHTING FACTORS IN FIRST DIRECTION)
930 FORMAT(/,5X,45HLIST OF WEIGHTING FACTORS IN SECOND DIRECTION)
C
C *** DIVIDE EACH BLOCK INTO ELEMENTS
C
TOTAL=0.0
DO 50 IDIVX=1,NDIVX
50 TOTAL=TOTAL+WEITX(IDIVX)
XNORM=2.0/TOTAL
TOTAL=0.0
DO 60 IDIVY=1,NDIVY
60 TOTAL=TOTAL+WEITY(IDIVY)
YNORM=2.0/TOTAL
NXTWO=NDIVX*FNODE+1
NYTWO=NDIVY*FNODE+1
IF (MTYPE.NE.0) GO TO 5000
IASEY=0
ETASP=-1.0
KWETY=0
KONTY=-1
DO 160 IYTWO=1,NYTWO
IASEY=IASEY+1
IF(NNODE.LT.6.AND.IASEY.EQ.3) IASEY=2
IF(NNODE.GE.6.AND.IASEY.EQ.4) IASEY=2
IASEX=0
EXISP=-1.0
KWETX=0
KONTX=-1
DO 130 IXTWO=1,NXTWO
IASEX=IASEX+1
IF(NNODE.LT.6.AND.IASEX.EQ.3) IASEX=2
IF(NNODE.GE.6.AND.IASEX.EQ.4) IASEX=2
IF(IASEX.EQ.2.AND.IASEY.EQ.2.AND.NNODE.EQ.8) GO TO 100
NPOIN=NPOIN+1
CALL SFRQ(EXISP,ETASP,SHAPE)
DO 70 INODE=1,LNODE
JTEMP=TNODS(IBLOC,INODE)
DO 70 IDIME=1,NDIME
70 COORD(NPOIN,IDIME)=COORD(NPOIN,IDIME)+SHAPE(INODE)*TCORD(JTEMP,
. IDIME)
GO TO(80,90,95),KNODE
80 IF(IASEX.NE.2.OR.IASEY.NE.2) GO TO 100
NELEM=NELEM+1
JPOIN=NPOIN-NXTWO
LNODS(NELEM,1)=JPOIN-1
LNODS(NELEM,2)=JPOIN
LNODS(NELEM,3)=NPOIN
LNODS(NELEM,4)=NPOIN-1
MATNO(NELEM)=TMATO(IBLOC)
GO TO 100
90 IF(IASEX.NE.3.OR.IASEY.NE.3) GO TO 100
NELEM=NELEM+1
IPOIN=NPOIN-IXTWO-NDIVX+(IXTWO-1)/2
JPOIN=NPOIN-NXTWO-NDIVX-1
LNODS(NELEM,1)=JPOIN-2
LNODS(NELEM,2)=JPOIN-1
LNODS(NELEM,3)=JPOIN
LNODS(NELEM,4)=IPOIN
LNODS(NELEM,5)=NPOIN
LNODS(NELEM,6)=NPOIN-1
LNODS(NELEM,7)=NPOIN-2
LNODS(NELEM,8)=IPOIN-1
MATNO(NELEM)=TMATO(IBLOC)
GO TO 100
95 IF(IASEX.NE.3.OR.IASEY.NE.3)GO TO 100
NELEM=NELEM+1
JPOIN=NPOIN-NXTWO
IPOIN=NPOIN-NXTWO-NXTWO
LNODS(NELEM,1)=IPOIN-2
LNODS(NELEM,2)=IPOIN-1
LNODS(NELEM,3)=IPOIN
LNODS(NELEM,4)=JPOIN
LNODS(NELEM,5)=NPOIN
LNODS(NELEM,6)=NPOIN-1
LNODS(NELEM,7)=NPOIN-2
LNODS(NELEM,8)=JPOIN-2
LNODS(NELEM,9)=JPOIN-1
MATNO(NELEM)=TMATO(IBLOC)
GO TO 100
100 CONTINUE
GO TO(110,120,120),KNODE
110 KWETX=KWETX+1
GO TO 130
120 IF(KONTX.LT.0) KWETX=KWETX+1
KONTX=KONTX*(-1)
130 EXISP=EXISP+XNORM*WEITX(KWETX)/FNODE
GO TO(140,150,150),KNODE
140 KWETY=KWETY+1
GO TO 160
150 IF(KONTY.LT.0) KWETY=KWETY+1
KONTY=KONTY*(-1)
160 ETASP=ETASP+YNORM*WEITY(KWETY)/FNODE
GO TO 170
5000 continue
c5000 CALL SPECL(COORD,FNODE,KNODE,LNODE,LNODS,MATNO,MDIME,MELEM,
c . MNODE,MPOIN,MTYPE,NDIME,NELEM,NPOIN,
c . NXTWO,NYTWO,TCORD,TMATO,TNODS,WEITX,WEITY,XNORM,
c . YNORM,IBLOC,NNODE)
170CONTINUE
C
C *** ELIMINATE REPEATED NODES AT BLOCK INTERFACES
C
READ (15,1000) TITLT !-
READ (15,*)TOLER
WRITE (12,440)TOLER
IF(KNODE.EQ.1)NENOD=4
IF(KNODE.EQ.2)NENOD=8
IF(KNODE.EQ.3)NENOD=9
440FORMAT(/,//,1X,'THE TOLERANCE FOR REPEATED NODE',
. ' IDENTIFICATION= ',F6.4)
NREPN=0
NLESS=NPOIN-1
DO 210 IPOIN=1,NLESS
IF(NREPN.EQ.0) GO TO 190
DO 180 IREPN=1,NREPN
IF(IPOIN.EQ.LREPN(IREPN)) GO TO 210
180 CONTINUE
190 CONTINUE
LPOIN=IPOIN+1
DO 200 JPONT=LPOIN,NPOIN
TOTAL=ABS(COORD(IPOIN,1)-COORD(JPONT,1))+ABS(COORD(IPOIN,2)-COORD(
. JPONT,2))
IF(TOTAL.GT.TOLER) GO TO 200
NREPN=NREPN+1
LREPN(NREPN)=JPONT
LASOC(NREPN)=IPOIN
200 CONTINUE
210 CONTINUE
IF(NREPN.EQ.0) GO TO 360
INDEX=0
DO 240 IPOIN=1,NPOIN
DO 220 IREPN=1,NREPN
IF(LREPN(IREPN).EQ.IPOIN) GO TO 230
220 CONTINUE
GO TO 240
230 INDEX=INDEX+1
LFINN(INDEX)=LREPN(IREPN)
LFASC(INDEX)=LASOC(IREPN)
240 CONTINUE
DO 250 IREPN=1,NREPN
LREPN(IREPN)=LFINN(IREPN)
250 LASOC(IREPN)=LFASC(IREPN)
DO 260 IREPN=1,NREPN
DO 260 IELEM=1,NELEM
DO 260 INODE=1,NENOD
260 IF(LNODS(IELEM,INODE).EQ.LREPN(IREPN)) LNODS(IELEM,INODE)=
. LASOC(IREPN)
DO 310 IPOIN=1,NPOIN
DO 270 IREPN=1,NREPN
IF(IPOIN.EQ.LREPN(IREPN)) GO TO 310
270 CONTINUE
IF(IPOIN.LT.LREPN(1)) GO TO 310
IDIFF=IPOIN-NREPN
IF(IPOIN.GT.LREPN(NREPN)) GO TO 290
DO 280 IREPN=1,NREPN
KREPN=NREPN-IREPN+1
280 IF(IPOIN.LT.LREPN(KREPN)) IDIFF=IPOIN-KREPN+1
290 DO 300 IDIME=1,NDIME
300 COORD(IDIFF,IDIME)=COORD(IPOIN,IDIME)
310 CONTINUE
DO 350 IELEM=1,NELEM
DO 350 INODE=1,NENOD
NPOSI=LNODS(IELEM,INODE)
DO 320 IREPN=1,NREPN
IF(NPOSI.EQ.LREPN(IREPN)) GO TO 350
320 CONTINUE
IF(NPOSI.LT.LREPN(1)) GO TO 350
IDIFF=NPOSI-NREPN
IF(NPOSI.GT.LREPN(NREPN)) GO TO 340
DO 330 IREPN=1,NREPN
KREPN=NREPN-IREPN+1
330 IF(NPOSI.LT.LREPN(KREPN)) IDIFF=NPOSI-KREPN+1
340 LNODS(IELEM,INODE)=IDIFF
350 CONTINUE
360 CONTINUE
NPOIN=NPOIN-NREPN
1000 FORMAT(80A1)
RETURN
END
C
SUBROUTINE SFRQ(S,T,SHAPE)
C***********************************************************
C SUBROUTINE SFRQ-SHAPE FUNCTIONS FOR THE *
C EIGHT NODED ISOPARAME ELEMENT *
C***********************************************************
DIMENSION SHAPE(8)
C
C *** SHAPE FUNCTIONS FOR 8-NODE ISOPARAMETRIC ELEMENT
C
SS=S*S
TT=T*T
ST=S*T
SST=S*S*T
STT=S*T*T
SHAPE(1)=(-1.0+ST+SS+TT-SST-STT)/4.0
SHAPE(2)=(1.0-T-SS+SST)/2.0
SHAPE(3)=(-1.0-ST+SS+TT-SST+STT)/4.0
SHAPE(4)=(1.0+S-TT-STT)/2.0
SHAPE(5)=(-1.0+ST+SS+TT+SST+STT)/4.0
SHAPE(6)=(1.0+T-SS-SST)/2.0
SHAPE(7)=(-1.0-ST+SS+TT+SST-STT)/4.0
SHAPE(8)=(1.0-S-TT+STT)/2.0
RETURN
END
C
subroutine IOFILE
c chanel 15input file
c chanel 15 output file
c chanel 15plot file
c
CHARACTER*15 FNAME
WRITE(*,*)' PLEASE TYPEINPUT FILE NAME: '
READ (*,*) FNAME
OPEN(15,FILE=FNAME)
WRITE(*,*)' PLEASE TYPE OUTPUT FILE NAME: '
READ (*,*) FNAME
OPEN(12,FILE=FNAME)
WRITE(*,*)' PLEASE TYPE PLOT FILE NAME: '
READ (*,*) FNAME
OPEN(21,FILE=FNAME)
RETURN
END 有大虾给简单解释一下吗看不太懂 关键是怎么运行啊？ 两个黄鹂鸣翠柳，不知所云。 fortran编的吗？ 还是fortran77的！！ 不错呀，谢谢分享，能加一下备注就更好啦
页:
[1]