📄 a36.for
字号:
C
C
C
IF (KEC.EQ.KLC) GO TO 220
ISEG(JFCD)=ISEG(JLC)
ISEG(JLCD)=ISEG(JFC)
220 CONTINUE
400 CONTINUE
C
IF (IDBA.LE.1) GO TO 415
CALL EXAMIN (RMDUMY,1,1,ITS,1,NTOUCH,6,-18)
CALL EXAMIN (BETA,1,NTOUCH,IMDUMY,1,1,6,5)
CALL EXAMIN (DELTA,2,NSNOD,IMDUMY,1,1,6,9)
415 IF (IDBA.EQ.0) GO TO 420
CALL EXAMIN (RMDUMY,1,1,INODE,1,NTOUCH,6,-17)
CALL EXAMIN (RMDUMY,1,1,ISEG,1,NSEG,6,-16)
420 IF (ISTOP.EQ.0) RETURN
write(66,1150)
DO 430 K=1,NSNOD
write(66,1160) NODSF(K),(XYZS(L,K),L=1,2),(XYZ(L,K),L=1,2)
430 CONTINUE
write(66,1200)
STOP
C
1000 FORMAT(/,10X,34HCONDITIONS OF CONTACT INADMISSIBLE,/,
1 11X,33HDUE TO DETECTION OF GROSS OVERLAP,/,
1 14X,22HAT THE FOLLOWING NODES,/)
1100 FORMAT(2X,I5,22H). CONTACTOR NODE NO.= ,I5,5X,
1 16HTARGET NODE NO.= ,I5)
1150 FORMAT(//,21X,27HCURRENT SURFACE COORDINATES,13X,
1 27HINITIAL SURFACE COORDINATES,/,
1 6X,6HGLOBAL,8X,12HY-COORDINATE,8X,12HZ-COORDINATE,
1 8X,12HY-COORDINATE,8X,12HZ-COORDINATE,/,
1 5X,8HNODE NO.,/)
1160 FORMAT(I10,2X,4(8X,E12.4))
1200 FORMAT(//,10X,30HSTOPPED IN 2-D CONTACT OVERLAY,/)
C
END
SUBROUTINE YZSTF (MAXA,AA,R,
1 RSDCOS,
1 ISURFP,IFSN,NODSF,LMS,
1 INODE,ISEG,ITS,IDBUG,
1 INUMEQ,ISKEW,LMHT,
1 XLN,T,
1 CPR,BETA,DELTA,
1 NSURF,NSURFP,NTOUCH,NSNOD,NSEG)
C
C
C***ADD:DPR***
IMPLICIT DOUBLE PRECISION ( A-H,O-Z )
C***END:DPR***
COMMON /SOL/ NUMNP,NEQ,NWK,NWM,NWC,NUMEST,MIDEST,MAXEST,NSTE,MA
COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
1 ,NDFD,KLIN,IEIG,IMASSN,IDAMPN
COMMON /NORMS/ RNORM,RENORM,RTOL,DTOL,STOL,SMAX,SMIN,
1 DMAX,DMIN,ETOL
COMMON /ADDB/ NEQL,NEQR,MLA,NBLOCK
COMMON /CNTACT/ NEQI,LEADEQ,NCE2D,NCE3D
COMMON /SRFACE/ IC,KFC,KLC,KEC,JFC,JLC,JFCD,JLCD
COMMON /PAIR/ IT,KFT,KLT,KET,JFT,JLT,JFTD,JLTD
COMMON /MATCH/ ISR,IPAIR,JFSEG,JLSEG,JTSEG
COMMON /OPRATE/ ISET
C
DIMENSION MAXA(*),AA(*),R(*),
1 RSDCOS(9,*)
DIMENSION ISURFP(2,NSURFP),IFSN(*),NODSF(*),LMS(2,NSNOD),
1 INODE(*),ISEG(*),ITS(*),IDBUG(20),
1 INUMEQ(2),ISKEW(*),LMHT(*)
DIMENSION XLN(*),T(2,NSEG),
1 CPR(2,NTOUCH),BETA(*),DELTA(2,NSNOD)
DIMENSION ILMS(8),S(36),RE(8),ILSKEW(4)
DIMENSION UNITY(1),NOEQN(1)
DIMENSION RMDUMY(1,1),IMDUMY(1,1)
EQUIVALENCE ( NPAR(6),NEGSKS ),( NPAR(15),MODEL )
DATA SCALE / 1.0D+06 / , SMSQ / 1.0D-04 /
DATA UNITY / 1.0D0 /
C
IDBA=IDBUG(11)
IDBB=IDBUG(12)
IF (IDBA.GE.1) CALL EXAMIN (R,1,NEQ,IMDUMY,1,1,7,11)
C
C
C
NCEQN = MODEL
IF (NEQL.GT.1) GO TO 100
LEQEND = NEQ + 1
LAGRAN = INUMEQ(1) + 1
LSNWK = MAXA(LAGRAN)
LSTART = LAGRAN + 1
DO 120 L=LSTART,LEQEND
LSNWK = LSNWK + 1
120 MAXA(L) = LSNWK
IF (IDBB.GE.2) CALL EXAMIN (RMDUMY,1,1,MAXA,1,LEQEND,7,-19)
C
DO 140 K=1,NTOUCH
C
KSN = INODE(K)
IF (KSN.EQ.1) GO TO 140
IF (ISET.EQ.1) KSN=2
IF (NCEQN.EQ.1) KSN=3
IF (KSN.EQ.2) NCEQ=2
IF (KSN.EQ.3) NCEQ=1
LCEQ = MIN0( NCEQ,NCEQN)
C
LOCAL = (K-1)*NCEQN
LEQ = LAGRAN + LOCAL
C
DO 160 M=1,LCEQ
LEQN = LEQ + M
LTALL = LMHT(LOCAL+M)
DO 180 L=LEQN,LEQEND
MAXA(L) = MAXA(L) + LTALL
180 CONTINUE
160 CONTINUE
C
140 CONTINUE
C
IF (IDBB.LT.1) GO TO 100
LNEQ = NTOUCH*NCEQN
LONG = LNEQ + 1
CALL EXAMIN (RMDUMY,1,1,LMHT,1,LNEQ,7,-14)
CALL EXAMIN (RMDUMY,1,1,MAXA(LAGRAN),1,LONG,7,-15)
C
C
C
100 LAGRAN = INUMEQ(1) + 1
LNEXT = NCEQN - 1
C
DO 200 I=1,NSURF
IC=I
CALL TRGET2 (ISURFP,IFSN,ISEG,NSURF,NSURFP,1)
IF (ISR.EQ.0) GO TO 200
C
DO 250 K=KFC,KLC
C
DO 260 L=1,8
RE(L)=0.0D0
260 ILMS(L)=0
DO 280 L=1,36
280 S(L)=0.0D0
C
IEQY = LAGRAN
IEQZ = ( LAGRAN + 1 )*LNEXT
C
KSN=INODE(K)
IF (KSN.EQ.1) GO TO 300
IF (KEC.LT.KLC .AND. K.EQ.KLC) GO TO 300
C
C
C
IF (ISET.EQ.1) KSN=2
IF (NCEQN.EQ.1) KSN=3
BT=BETA(K)
JTSEG=ITS(K)
CALL TRGET2 (ISURFP,IFSN,ISEG,NSURF,NSURFP,2)
IT=ISURFP(1,IPAIR)
NA=JTSEG-IT
NB=NA+1
C
LNODE = NODSF(K)
IF (LNODE.EQ.NODSF(NA) .OR. LNODE.EQ.NODSF(NB)) GO TO 300
C
ILMS(1)=LMS(1,K)
ILMS(2)=LMS(2,K)
ILMS(3)=LMS(1,NA)
ILMS(4)=LMS(2,NA)
ILMS(5)=LMS(1,NB)
ILMS(6)=LMS(2,NB)
DO 320 L=1,6
320 IF (ILMS(L).GT.NEQ) ILMS(L)=0
C
ILMS(7) = IEQY
ILMS(8) = IEQZ
CALL ECHECK (ILMS,8,ICODE,IUPDT)
IF (ICODE.EQ.1) GO TO 340
C
ILSKEW(1)=ISKEW(K)
ILSKEW(2)=ISKEW(NA)
ILSKEW(3)=ISKEW(NB)
C
ILSKEW(4)=0
DO 330 L=1,3
LSK = 2*(L-1)
DO 330 M=1,2
IF (ILMS(LSK+M).NE.0) ILSKEW(4) = ILSKEW(L)
330 CONTINUE
C
C
FY=CPR(1,K)
FZ=CPR(2,K)
DELTAY=DELTA(1,K)
DELTAZ=DELTA(2,K)
C
IF (KSN.EQ.3) GO TO 360
C
C . .
C . .
C . .
C . .
BTS=SCALE*BT
ATS=SCALE-BTS
C
S(7)=-SCALE
S(15)=-SCALE
S(20)=ATS
S(26)=ATS
S(29)=BTS
S(33)=BTS
C
IF (NEGSKS.GT.0) CALL ATKA (RSDCOS,S,ILSKEW,4,2)
C
BNY=0.0D0
IF (ILMS(1).GT.0) BNY=BNY+S(7)*S(7)
IF (ILMS(3).NE.0) BNY=BNY+S(20)*S(20)
IF (ILMS(5).NE.0) BNY=BNY+S(29)*S(29)
IF (NEGSKS.EQ.0) GO TO 380
IF (ILMS(2).GT.0) BNY=BNY+S(14)*S(14)
IF (ILMS(4).NE.0) BNY=BNY+S(25)*S(25)
IF (ILMS(6).NE.0) BNY=BNY+S(32)*S(32)
380 IF (BNY.LT.SMSQ) ILMS(7)=0
C
BNZ=0.0D0
IF (ILMS(2).GT.0) BNZ=BNZ+S(15)*S(15)
IF (ILMS(4).NE.0) BNZ=BNZ+S(26)*S(26)
IF (ILMS(6).NE.0) BNZ=BNZ+S(33)*S(33)
IF (NEGSKS.EQ.0) GO TO 400
IF (ILMS(1).GT.0) BNZ=BNZ+S(8)*S(8)
IF (ILMS(3).NE.0) BNZ=BNZ+S(21)*S(21)
IF (ILMS(5).NE.0) BNZ=BNZ+S(30)*S(30)
400 IF (BNZ.LT.SMSQ) ILMS(8)=0
C
RE(7)=-DELTAY*SCALE
RE(8)=-DELTAZ*SCALE
GO TO 420
C
360 CONTINUE
ILMS(8)=0
C
C . .
C . .
C . .
C . .
D=XLN(JTSEG)
CJ=T(1,JTSEG)
SJ=T(2,JTSEG)
BEXT=(CJ*DELTAY + SJ*DELTAZ)/D + BT
BCJ=BEXT*CJ
BSJ=BEXT*SJ
ACJ=CJ-BCJ
ASJ=SJ-BSJ
C
S(7) = - SJ*SCALE
S(14) = CJ*SCALE
S(20) = ASJ*SCALE
S(25) = - ACJ*SCALE
S(29) = BSJ*SCALE
S(32) = - BCJ*SCALE
C
IF (NEGSKS.GT.0) CALL ATKA (RSDCOS,S,ILSKEW,4,2)
C
BNN=0.0D0
IF (ILMS(1).GT.0) BNN=BNN+S(7)*S(7)
IF (ILMS(2).GT.0) BNN=BNN+S(14)*S(14)
IF (ILMS(3).NE.0) BNN=BNN+S(20)*S(20)
IF (ILMS(4).NE.0) BNN=BNN+S(25)*S(25)
IF (ILMS(5).NE.0) BNN=BNN+S(29)*S(29)
IF (ILMS(6).NE.0) BNN=BNN+S(32)*S(32)
IF (BNN.LT.SMSQ) ILMS(7)=0
C
BT=BEXT
RE(7) = ( - SJ*DELTAY + CJ*DELTAZ )*SCALE
C
C
C
420 AT=1.0-BT
RE(1) = - FY
RE(2) = - FZ
RE(3) = AT*FY
RE(4) = AT*FZ
RE(5) = BT*FY
RE(6) = BT*FZ
C
IF (NEGSKS.GT.0) CALL DIRCOS (RSDCOS,RE,ILSKEW,4,2,2)
C
CALL ADDBAN (AA,MAXA,S,RE,ILMS,8,1)
CALL ADDBAN ( R,MAXA,S,RE,ILMS,8,2)
300 CONTINUE
C
NOEQN(1) = IEQY
IF (ILMS(7).EQ.0) CALL ADDBAN (AA,MAXA,UNITY,RE,NOEQN,1,1)
NOEQN(1) = IEQZ
IF (ILMS(8).EQ.0) CALL ADDBAN (AA,MAXA,UNITY,RE,NOEQN,1,1)
C
340 LAGRAN = LAGRAN + NCEQN
C
250 CONTINUE
200 CONTINUE
RETURN
C
C
END
SUBROUTINE EXAMIN (RM,NRR,NCR,IM,NRI,NCI,ISUBR,IAR)
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,ISTAT
1 ,NDOF,KLIN,IEIG,IMASSN,IDAMPN
COMMON /VAR/ NGALL,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
1 IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
COMMON /GROUPS/ NTGNL,NSGNL
DIMENSION RM(NRR,NCR),IM(NRI,NCI)
C
C
C BLANK COMMON
C
C
IF (KPRI.GT.0) NG = NGALL-NEGNL
IF (IND.EQ.0 .OR. KPRI.EQ.0) NG = NGALL-NEGNL-NEGL
IF (IABS(IAR).EQ.100) GO TO 9000
GO TO (41,42,43,44,45,46,47) ISUBR
41 write(66,100) NG,KSTEP,ITE
GO TO 70
42 write(66,200) NG,KSTEP,ITE
GO TO 70
43 write(66,300) NG,KSTEP,ITE
GO TO 70
44 write(66,400) NG,KSTEP,ITE
GO TO 70
45 write(66,500) NG,KSTEP,ITE
GO TO 70
46 write(66,600) NG,KSTEP,ITE
GO TO 70
47 write(66,700) NG,KSTEP,ITE
GO TO 70
C
100 FORMAT(/,4X,17HSUBROUTINE TODCON,
1 4X,6H( NSG=,I3,8H KSTEP=,I3,6H ITE=,I3,2H ) )
200 FORMAT(/,4X,17HSUBROUTINE TOUCH2,
1 4X,6H( NSG=,I3,8H KSTEP=,I3,6H ITE=,I3,2H ) )
300 FORMAT(/,4X,16HSUBROUTINE YZNEW,
1 4X,6H( NSG=,I3,8H KSTEP=,I3,6H ITE=,I3,2H ) )
400 FORMAT(/,4X,17HSUBROUTINE FRICT2,
1 4X,6H( NSG=,I3,8H KSTEP=,I3,6H ITE=,I3,2H ) )
500 FORMAT(/,4X,17HSUBROUTINE TRGET2,
1 4X,6H( NSG=,I3,8H KSTEP=,I3,6H ITE=,I3,2H ) )
600 FORMAT(/,4X,17HSUBROUTINE ADJOIN,
1 4X,6H( NSG=,I3,8H KSTEP=,I3,6H ITE=,I3,2H ) )
700 FORMAT(/,4X,17HSUBROUTINE YZSTF ,
1 4X,6H( NSG=,I3,8H KSTEP=,I3,6H ITE=,I3,2H ) )
C
C
70 JAR=IAR
IF (IAR.LT.0) GO TO 75
C
GO TO ( 1, 2, 3, 4, 5, 6, 7, 8, 9,10,
1 11,12,13,14,15,16) JAR
C
75 JAR=-IAR
GO TO (51,52,53,54,55,56,57,58,59,60,
1 61,62,63,64,65,66,67,68,69) JAR
C
C
C
1 write(66,1020)
GO TO 2000
2 write(66,1040)
GO TO 2020
3 write(66,1060)
GO TO 2020
4 write(66,1080)
GO TO 2020
5 write(66,1100)
GO TO 2000
6 write(66,1120)
GO TO 2000
7 write(66,1140)
GO TO 2020
8 write(66,1160)
GO TO 2020
9 write(66,1180)
GO TO 2020
10 write(66,1200)
GO TO 2000
11 write(66,1220)
GO TO 2000
12 write(66,1240)
GO TO 2020
13 write(66,1260)
GO TO 2020
14 write(66,1280)
GO TO 2000
15 write(66,1300)
GO TO 2000
16 write(66,1320)
GO TO 2000
C
1020 FORMAT(/,10X,35HFRICTION COEFFICIENTS AND TOLERANCE,/)
1040 FORMAT(/,10X,19HINITIAL COORDINATES,/)
1060 FORMAT(/,10X,19HCURRENT COORDINATES,/)
1080 FORMAT(/,10X,31HCONTACT FORCES (PAST ITERATION),/)
1100 FORMAT(/,10X,21HPARAMETER OF LOCATION,/)
1120 FORMAT(/,10X,26HLENGTH OF CONTACT SEGMENTS,/)
1140 FORMAT(/,10X,32HUNIT TANGENT VECTORS TO SEGMENTS,/)
1160 FORMAT(/,10X,34HCONTACT FORCES (CURRENT ITERATION),/)
1180 FORMAT (/,10X,27HOVERLAPS AT CONTACTOR NODES,/)
1200 FORMAT(/,10X,19HTOTAL DISPLACEMENTS,/)
1220 FORMAT(/,10X,26HOUT OF BALANCE LOAD VECTOR,/)
1240 FORMAT(/,10X,19HRECOVERED TRACTIONS,/)
1260 FORMAT(/,10X,22HUPDATED CONTACT FORCES,/)
1280 FORMAT(/,10X,16HUPDATED R VECTOR,/)
1300 FORMAT(/,10X,20HCONSTRAINT EQUATIONS,/)
1320 FORMAT(/,10X,16HSTIFFNESS MATRIX,/)
C
2000 write(66,2010) ((RM(L,M),L=1,NRR),M=1,NCR)
2010 FORMAT( (6E12.4)/(6E12.4) )
RETURN
C
2020 write(66,2030) ((RM(L,M),L=1,NRR),M=1,NCR)
2030 FORMAT( (2E12.4,3X,2E12.4,3X,2E12.4)/
1 (2E12.4,3X,2E12.4,3X,2E12.4) )
RETURN
C
C
C
51 write(66,5020)
GO TO 6000
52 write(66,5040)
GO TO 6020
53 write(66,5060)
GO TO 6020
54 write(66,5080)
GO TO 6000
55 write(66,5100)
GO TO 6020
56 write(66,5120)
GO TO 6020
57 write(66,5140)
GO TO 6020
58 write(66,5160)
GO TO 6020
59 write(66,5180)
GO TO 6020
60 write(66,5200)
GO TO 6020
61 write(66,5220)
GO TO 6020
62 write(66,5240)
GO TO 6020
63 write(66,5260)
GO TO 6020
64 write(66,5280)
GO TO 6020
65 write(66,5300)
GO TO 6020
66 write(66,5320)
GO TO 6020
67 write(66,5340)
GO TO 6020
68 write(66,5360)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -