📄 a30.for
字号:
SUBROUTINE GENSTF
C
C
C
C***ADD:DPR***
IMPLICIT DOUBLE PRECISION ( A-H,O-Z )
C***END:DPR***
COMMON /DIM / N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,
1 N14,N15
COMMON /DIMETC/ N01,N02,N03,N04,N05,N06,N07,N08,N09
COMMON /FREQIF/ ISTOH,N1A,N1B,N1C,N1S
COMMON /SOL / NUMNP,NEQ,NWK,NWM,NWC,NUMEST,MIDEST,MAXEST,NSTE,MA
COMMON /EL / IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
1 ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
COMMON /VAR / NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
1 IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
COMMON /DPR / ITWO
COMMON /ELGLTH/ NFIRST,NLAST,NBCEL
COMMON /ELSTP / TIME,IDTHF
COMMON /PRCON / IDATWR,IPRIC,NPB,IDC,IVC,IAC,IPC,IPNODE(3,15)
COMMON /PORT/ INPORT,JNPORT,NPUTSV,IBPORT,IFPORT,JDC,JVC,JAC
COMMON /TEMPRT/ TEMP1,TEMP2,ITEMPR,ITP96,N6A,N6B
COMMON /SKEW / NSKEWS
COMMON /ISUBST/ ISUBC,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
1 NODCON,NODRET,IDOFS(6),NDOFS,NEQS,NWKS,MAXESC,
2 MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
C
COMMON A(1)
REAL A
DIMENSION IA(1)
EQUIVALENCE (A(1),IA(1))
C
EQUIVALENCE (NPAR(1),NPAR1),(NPAR(2),NUME),(NPAR(3),INDNL),
1 (NPAR(6),NEGSKS),(NPAR(7),MXNODS),(NPAR(13),NSTRES),
2 (NPAR(15),MODEL),(NPAR(16),NUMPRP)
C
C
C
IF (IND.NE.0) GO TO 100
C
C
C
C
ISTOP=0
NUMNPT=NUMNP
IF (ISUBC.NE.0) NUMNPT=NUMNPS
C
C
IF (NUME.GT.0) GO TO 10
ISTOP=ISTOP+1
IF (ISTOP.EQ.1) write(66,2100) NG
ISUB=2
IRANGE=1
write(66,2400) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
C
C
10 IF (INDNL.EQ.0) GO TO 20
ISTOP=ISTOP+1
IF (ISTOP.EQ.1) write(66,2100) NG
ISUB=3
write(66,2200) ISTOP,ISUB,ISUB,NPAR(ISUB)
C
C
20 IF (MXNODS.LE.0) MXNODS=2
IF (MXNODS.LE.NUMNPT) GO TO 30
ISTOP=ISTOP+1
IF (ISTOP.EQ.1) write(66,2100) NG
ISUB=7
IRANGE=NUMNPT
write(66,2300) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
C
C
30 IF (NSTRES.LT.0) NSTRES=0
C
C
40 IF (MODEL.LE.0) MODEL=1
IF (MODEL.LE.2) GO TO 50
ISTOP=ISTOP+1
IF (ISTOP.EQ.1) write(66,2100) NG
ISUB=15
IRANGE=2
write(66,2300) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
C
C
50 IF (NUMPRP.LE.0) NUMPRP=1
IF (MODEL.EQ.1 .AND. NSTRES.GT.1) NSTRES=1
C
C
IF (NEGSKS.EQ.0) GO TO 60
IF (NSKEWS.GT.0) GO TO 60
ISTOP=ISTOP+1
IF (ISTOP.EQ.1) write(66,2100) NG
ISUB=6
write(66,2500) ISTOP,NSKEWS,ISUB,NPAR(ISUB)
C
C
60 IF (ISTOP.EQ.0) GO TO 70
write(66,2600) ISTOP
IDATWR=1
C
70 IF (IDATWR.GT.1) GO TO 80
C
C
write(66,2800) NPAR1
write(66,2900) NUME,INDNL,NEGSKS
write(66,3000) MXNODS,NSTRES,MODEL,NUMPRP
C
80 IF (ISTOP.EQ.0) GO TO 90
write(66,3100)
STOP
C
C
C
90 IF (JNPORT.EQ.0 .OR. NPUTSV.EQ.0) GO TO 100
IF (JNPORT.EQ.1)
1 WRITE (IBPORT ) 'TYPE-9 ',NSUB,NG,(NPAR(I),I=1,20)
IF (JNPORT.EQ.2)
1 WRITE (IFPORT,9000) 'TYPE-9 ',NSUB,NG,(NPAR(I),I=1,20)
C
9000 FORMAT ( A,/,(8I10) )
C
C
C
C
C
100 NDM = MXNODS*6
NCM = MXNODS*3
NDS = MXNODS*NDOF
C
NFIRST = N6
IF (IND.EQ.4) NFIRST = N10
N101 = NFIRST + 20
N102 = N101 + NUME*NDM
N103 = N102 + NUME*NCM*ITWO
N104 = N103 + 3*NUMPRP
N105 = N104 + NUME
N106 = N105 + NUME
N107 = N106 + NUME
N108 = N107 + MXNODS*NUME
C
MM = 0
IF (NEGSKS.GT.0) MM = 1
N109 = N108 + MXNODS*NUME*MM
MM = 0
IF (MODEL.EQ.1) MM = 1
N110 = N109 + NUME*2*MM
C
NDS2 = NDS*(NDS+1)/2
NDM2 = NDM*(NDM+1)/2
C
N111 = N110 + NDS2*NUMPRP*ITWO
N122 = N111 + NDS2*NUMPRP*ITWO
N112 = N122 + NDS2*NUMPRP*ITWO
C
C
NDC2 = NSTRES*NDS
N113 = N112 + NDC2*NUMPRP*ITWO
C
N121=N113 + MXNODS
N114=N121 + NUME
MM = 0
IF (NEGSKS.GT.0) MM = 1
N115 = N114 + MXNODS*2*MM
NDC=NDM
IF (NSTRES.GT.NDM) NDC=NSTRES
N116 = N115 + NDC*ITWO
N117 = N116 + NDM*ITWO
N118 = N117 + NDM2*ITWO
N119 = N118 + NDC*NDM*ITWO
C
NLAST=N114 - 1
C
NI = N119 - NLAST
IF (NBCEL.LT.NI) NBCEL=NI
C
IF (IND.NE.0) GO TO 120
C
J = NFIRST - 1
DO 110 I = 1,20
J=J+1
IA(J)=NPAR(I)
110 CONTINUE
C
MIDEST=(NLAST-NFIRST) + 1
IF (IDATWR.LE.1) write(66,2000) NG,MIDEST
CALL SIZE (N119)
C
120 IF (IND.GT.3) GO TO 130
M2 = N2
M3 = N3
M4 = N4
GO TO 140
C
130 M2 = N2
M3 = N5
M4 = N8
IF (IEQUIT.EQ.1) GO TO 140
M2 = N6
M3 = N3
C
140 CALL GEMAST (A(N06),A(N1A),A(N1),A(M2),A(M3),A(M4),A(N5),A(N101),
1 A(N102),A(N103),A(N104),A(N105),A(N106),A(N107),
2 A(N108),A(N109),A(N110),A(N111),A(N112),A(N113),
3 A(N114),A(N115),A(N116),A(N117),A(N118),A(N121),
1 A(N122),
4 NSTRES,NDM,NCM,NDS,NDC,NDC2,NDS2,NDOF,MXNODS)
C
C
RETURN
C
C
1000 FORMAT (20A4)
C
2000 FORMAT (///38H S T O R A G E I N F O R M A T I O N/
1 //49H LENGTH OF ARRAY NEEDED FOR STORING ELEMENT GROUP/
2 12H DATA (GROUP,I3,26H). . . . . . . . . . . . .,
3 15H( MIDEST ). . =,I5//)
C
2100 FORMAT (////28H *** I N P U T E R R O R -//
1 38H ERROR IN ELEMENT GROUP CONTROL CARDS /
2 36H ( GENERAL MASS/STIFFNESS ELEMENT ) /
3 16H ELEMENT GROUP =,I5/)
C
2200 FORMAT (I5,7H. NPAR(,I2,18H) SHOULD BE .EQ. 0,10H ... NPAR(,I2,
1 3H) =,I5)
C
2300 FORMAT (I5,7H. NPAR(,I2,16H) SHOULD BE .LE.,I2,10H ... NPAR(,I2,
1 3H) =,I5)
C
2400 FORMAT (I5,7H. NPAR(,I2,16H) SHOULD BE .GE.,I2,10H ... NPAR(,I2,
1 3H) =,I5)
C
2500 FORMAT (I5,10H. NSKEWS =,I2,10H AND NPAR(,I2,3H) =,I2,
1 19H ARE NOT COMPATIBLE )
C
2600 FORMAT (//25H TOTAL NUMBER OF ERRORS =,I5//)
C
2800 FORMAT (36H E L E M E N T D E F I N I T I O N ///,
1 14H ELEMENT TYPE ,13(2H .),16H( NPAR(1) ). . =,I5/,
2 25H EQ.1, TRUSS ELEMENTS/,
3 25H EQ.2, 2-DIM ELEMENTS/,
4 25H EQ.3, 3-DIM ELEMENTS/,
5 25H EQ.4, BEAM ELEMENTS/,
6 28H EQ.5, ISO/BEAM ELEMENTS/,
7 25H EQ.6, PLATE ELEMENTS/,
8 25H EQ.7, SHELL ELEMENTS/,
9 25H EQ.8, PIPE ELEMENTS/,
E 27H EQ.9, GENERAL ELEMENTS,/,
B 25H EQ.10, EMPTY /,
C 32H EQ.11, 2-DIM FLUID ELEMENTS/,
H 32H EQ.12, 3-DIM FLUID ELEMENTS ,/)
C
2900 FORMAT (20H NUMBER OF ELEMENTS.,10(2H .),16H( NPAR(2) ). . =,I5//,
1 40H TYPE OF NONLINEAR ANALYSIS . . . . . . ,
2 16H( NPAR(3) ). . =,I5/,
3 40H EQ.0, LINEAR //
4 23H SKEW COORDINATE SYSTEM/
5 40H REFERENCE INDICATOR . . . . . . . .,
6 16H( NPAR(6) ). . =,I5/
7 28H EQ.0, ALL ELEMENT NODES/
8 37H USE THE GLOBAL SYSTEM ONLY/
9 35H EQ.1, ELEMENT NODES REFER /
A 36H TO SKEW COORDINATE SYSTEM//)
C
3000 FORMAT (32H MAX NUMBER OF NODES DESCRIBING /,
1 20H ANY ONE ELEMENT,10(2H .),16H( NPAR(7) ). . =,I5//,
2 40H STRESS OUTPUT INDICATOR . . . . . . . .,
3 16H( NPAR(13)). . =,I5/,
4 40H EQ.0, FORCES AND MOMENTS ARE OUTPUT/,
5 40H GE.1, STRESSES ARE OUTPUT USING /,
F 40H STRESS TRANSFORMATION MATRIX //,
6 14H ELEMENT TYPE ,13(2H .),
7 16H( NPAR(15)). . =,I5/,
8 40H EQ.1, LINEAR ELASTIC TWO DEGREE OF /,
9 40H FREEDOM ELEMENT /,
A 40H EQ.2, LINEAR ELASTIC GENERAL /,
B 40H ELEMENT //,
C 29H NUMBER OF DIFFERENT SETS OF /,
D 36H STIFFNESS/MASS/DAMPING MATRICES,2(2H .),
E 16H( NPAR(16)). . =,I5)
C
3100 FORMAT (//// 23H STOP (ERRORS IN NPAR) )
C
END
SUBROUTINE GEMAST (RSDCOS,NODSYS,ID,X,Y,Z,HT,LM,XYZ,IMS,IELD,
1 IPS,NPROP,NODEM,ISKEW,NDIR,STF,XM,CS,NODE,ILSK,
2 RE,DISP,ST,AS,ISV,XC,
3 NSTRES,NDM,NCM,NDS,NDC,NDC2,NDS2,NDOF,MXNODS)
C
C
C
C
C***ADD:DPR***
IMPLICIT DOUBLE PRECISION ( A-H,O-Z )
C***END:DPR***
COMMON /EL / IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
1 ISTAT,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
COMMON /SOL / NUMNP,NEQ,NWK,NWM,NWC,NUMEST,MIDEST,MAXEST,NSTE,MA
COMMON /DIM / N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,
1 N14,N15
COMMON /CONST / DT,DTA,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,
1 A12,A13,A14,A15,A16,A17,A18,A19,A20,DTOD,IOPE
COMMON /ELSTP / TIME,IDTHF
COMMON /VAR / NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
1 IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
COMMON /PRCON / IDATWR,IPRIC,NPB,IDC,IVC,IAC,IPC,IPNODE(3,15)
COMMON /PORT/ INPORT,JNPORT,NPUTSV,IBPORT,IFPORT,JDC,JVC,JAC
COMMON /MDFRDM/ IDOF(12)
COMMON /TAPES / IIN,IOUT
COMMON /RANDI / N0A,N1D,IELCPL
COMMON /ADDB / NEQL,NEQR,MLA,NBLOCK
COMMON /SKEW / NSKEWS
COMMON /ISUBST/ ISUBC,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
1 NODCON,NODRET,IDOFS(6),NDOFS,NEQS,NWKS,MAXESC,
2 MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
COMMON /LOA/ NLOAD,NPR2,NPR3,NPBM,NP3DB,NPPL,NPSH,NODE3,IDGRAV,
1 NPDIS,NTEMP,IDCFGL,ISMASS
COMMON /RFORCE/ IREFOR,NEQSUM,NREQ,NBLANK
COMMON /DISCON/ NDISCE,NIDM
COMMON /SEQNCE/ IT1,IT2,IT3,IT4,IT5,IT6,IT7,IT8,IT9,IT10,IT11,
1 IT12,IT13,IT14,IT15,IT16,IT17,IT18,IT19,IT20,
2 IT21,IT22,IT23,IT24,IT50,IT56,IT57,IT59,IT60
C
COMMON A(1)
REAL A
C
DIMENSION ID(NDOF,*),X(*),Y(*),Z(*),HT(*),LM(NDM,*),XYZ(NCM,*),
1 IMS(3,*),IELD(*),IPS(*),NPROP(*),NODE(*),STF(NDS2,*),
2 XM(NDS2,*),CS(NDC2,*),RE(*),DISP(*),ST(*),AS(NDC,*),
3 NDIR(2,*),NODEM(MXNODS,*),ILSK(*),ISV(*)
DIMENSION XC(NDS2,*)
C
DIMENSION RSDCOS(9,*),NODSYS(*),ISKEW(MXNODS,*),IDIR(2),FORCE(6)
C
EQUIVALENCE (NPAR(2),NUME),(NPAR(3),INDNL),(NPAR(6),NEGSKS),
1 (NPAR(15),MODEL),(NPAR(16),NUMPRP)
C
CHARACTER*4 ANODE, ADIR, AIND(4)
DATA ANODE /'NODE'/ , ADIR /'IDIR'/
DATA AIND /'(GLO' , 'BAL)' , '( SK' , 'EW )'/
C
C
C
IELCPL=0
NEQT=NEQ+NDISCE
IF (ISUBC.EQ.1) NEQT=NEQS
IF (KPRI.EQ.0) GO TO 800
IF (IND.GT.0) GO TO 400
IJPORT=1
IF (JNPORT.EQ.0 .OR. NPUTSV.EQ.0) IJPORT=0
ISCONT=0
IF (NSKEWS.GT.0 .AND. NEGSKS.EQ.0) ISCONT=1
C
C
C
C
IF (IDATWR.LE.1) write(66,2000)
NUMNPT=NUMNP
IF (ISUBC.NE.0) NUMNPT=NUMNPS
C
IEMASS=MAX0(ISMASS,IMASS)
IDMP=0
IF (IDAMP.GT.0) IDMP=1
C
IF (MODEL.EQ.2) GO TO 20
C
C
DO 10 I = 1,NUMPRP
READ (IIN,1000) N,(IMS(K,N),K=1,3)
READ (IIN,1010) STF(1,N),XM(1,N),XC(1,N),CSS
IF (IDATWR.GT.1) GO TO 10
write(66,2010) N
IF (IMS(1,N).EQ.1) write(66,2015) STF(1,N)
IF (IMS(2,N).EQ.1) write(66,2016) XM(1,N)
IF (IMS(3,N).EQ.1) write(66,2018) XC(1,N)
IF (IMS(3,N).EQ.1 .AND. IDMP.EQ.0) GO TO 106
IF (NSTRES.EQ.1) write(66,2017) CSS
10 CONTINUE
GO TO 110
C
C
20 CONTINUE
C
DO 100 I = 1,NUMPRP
READ (IIN,1000) N,(IMS(K,N),K=1,3)
IF ( IMS(1,N).NE.1 ) GO TO 40
C
C
K=0
DO 30 J = 1,NDS
L=K + 1
LL=NDS - J + 1
K=L + LL - 1
READ (IIN,1020) (STF(I1,N),I1=L,K)
30 CONTINUE
C
40 CONTINUE
IF ( IMS(2,N).NE.1 ) GO TO 70
IF (IEMASS.NE.2) GO TO 60
C
C
K=0
DO 50 J = 1,NDS
L=K + 1
LL=NDS - J + 1
K=L + LL - 1
READ (IIN,1020) (XM(I1,N),I1=L,K)
50 CONTINUE
GO TO 70
C
C
60 CONTINUE
READ (IIN,1020) (XM(I1,N),I1=1,NDS)
C
70 CONTINUE
IF ( IMS(3,N).NE.1 ) GO TO 79
IF ( IDMP.EQ.0 ) GO TO 106
IF (IDAMP.EQ.1) GO TO 76
C
C
K=0
DO 72 J=1,NDS
L=K+1
LL=NDS-J+1
K=L+LL-1
READ (IIN,1020) (XC(I1,N),I1=L,K)
72 CONTINUE
GO TO 79
C
C
76 CONTINUE
READ (IIN,1020) (XC(I1,N),I1=1,NDS)
C
79 CONTINUE
C
C
IF (NSTRES.LE.0) GO TO 90
C
DO 80 J = 1,NSTRES
L=(J - 1)*NDS + 1
K=L + NDS - 1
READ (IIN,1020) (CS(I1,N),I1=L,K)
80 CONTINUE
C
90 CONTINUE
C
C
IF (IDATWR.GT.1) GO TO 100
C
write(66,2010) N
C
CALL PRNSTF (STF(1,N),XM(1,N),XC(1,N),CS(1,N),AS,IMS(1,N),
A NSTRES,IEMASS,IDAMP,NDS,NDC)
C
100 CONTINUE
GO TO 110
C
106 IF (ISUBC.GT.0) write(66,3801) NSUB
write(66,3802) NG,N
write(66,3001)
STOP
C
110 CONTINUE
C
C
120 CONTINUE
IREAD=IIN
IF (INPORT.GE.3) IREAD = IT59
N=1
C
IF (IDATWR.GT.1) GO TO 150
write(66,2350)
IF (MODEL.EQ.1) write(66,2360) (ANODE,I,ADIR,I,I=1,2)
NNPRI=9
IF (MXNODS.LE.9) NNPRI=MXNODS
IF (MODEL.EQ.2) write(66,2370) (ANODE,I,I=1,NNPRI)
IF (MODEL.EQ.2 .AND. MXNODS.GT.9)
1 write(66,2375) (ANODE,I,I=10,MXNODS)
C
C
150 READ (IREAD,1100) M,IELDT,IPST,MPRP,KG,ISVPH
IF (N.EQ.1 .AND. M.NE.1) GO TO 160
IF (IELDT.EQ.0) IELDT=MXNODS
C
IF (MPRP.GE.1 .AND. MPRP.LE.NUMPRP) GO TO 170
IF (ISUBC.EQ.0) write(66,3901) NG,M
IF (ISUBC.GT.0) write(66,3902) NSUB,NG,M
write(66,3905) MPRP
write(66,3920)
IF (MODEX.EQ.0) GO TO 170
STOP
170 CONTINUE
C
IF (KG.EQ.0) KG=1
IF (IELDT.GT.0 .AND. IELDT.LE.MXNODS) GO TO 180
C
write(66,2300) NSUB,NG,M,IELDT,MXNODS
STOP
C
160 write(66,2310) NSUB,NG
STOP
C
C
C
180 IF (MODEL.EQ.2) GO TO 198
C
C
READ (IREAD,1200) (NODE(I),IDIR(I),I=1,IELDT)
C
IF (NODE(1).GE.1 .AND. NODE(1).LE.NUMNPT) GO TO 190
write(66,2330) NSUB,NG,M,NODE(1),NUMNPT
IF (MODEX.EQ.0) GO TO 190
STOP
C
190 IF (IELDT.EQ.1) GO TO 192
IF (NODE(2).GE.1 .AND. NODE(2).LE.NUMNPT) GO TO 192
write(66,2330) NSUB,NG,M,NODE(2),NUMNPT
IF (MODEX.EQ.0) GO TO 192
STOP
C
192 IF (IDIR(1).GE.1 .AND. IDIR(1).LE.6) GO TO 194
write(66,2340) NSUB,NG
STOP
C
194 IF (IELDT.EQ.1) GO TO 205
IF (IDIR(2).GE.1 .AND. IDIR(2).LE.6) GO TO 205
write(66,2340) NSUB,NG
STOP
C
C
198 READ (IREAD,1200) (NODE(I),I=1,IELDT)
C
DO 200 J = 1,IELDT
IF (NODE(J).GE.1 .AND. NODE(J).LE.NUMNPT) GO TO 200
write(66,2330) NSUB,NG,M,NODE(J),NUMNPT
IF (MODEX.EQ.0) GO TO 200
STOP
200 CONTINUE
C
205 CONTINUE
IF (M.NE.N) GO TO 230
210 DO 220 I = 1,IELDT
NODEM(I,N)=NODE(I)
220 CONTINUE
C
KKK=KG
C
C
230 L=-2
DO 260 LL = 1,IELDT
L=L + 3
I=NODEM(LL,N)
IF (ISCONT.EQ.0) GO TO 240
IF (NODSYS(I).EQ.0) GO TO 250
C
write(66,2380) NSUB,NG,N
STOP
C
240 IF (NEGSKS.GT.0) ISKEW(LL,N)=NODSYS(I)
250 XYZ(L ,N)=X(I)
XYZ(L+1,N)=Y(I)
XYZ(L+2,N)=Z(I)
260 CONTINUE
C
IF (NEGSKS.EQ.0) GO TO 280
C
C
DO 270 LL = 1,IELDT
IF (ISKEW(LL,N).NE.0) GO TO 280
270 CONTINUE
ISKEW(1,N)=-1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -