Shalom napisał(a)
Wstaw moze z łaski swojej kod tego co napisałeś?
Nie jestem autorem tego programu. Właścicielem kodu jest mój Promotor. Struktura programu wygląda tak, iż jest jeden plik główny, który włącza inne pliki. Włączany plik może odwoływać się do innego pliku itd. Istna wieża Babel.
Kod programu jest zawarty w 37 plikach. Poniżej listing kodu pliku głównego:
C
C ******************************************************************
C
SUBROUTINE CRACKS
C
C ******************************************************************
C PROCESS DEGENERATED GEOMETRIES.
INCLUDE 'CRACK.INC'
COMMON NNOD,NNEL,NITP,NPTM,NEQN,NTIP
COMMON/GENRL/ XINT(MAXI),YINT(MAXI),VBC(2,3,MAXE),BTR(2,3,MAXE),
1 RTP(MUKN),ASK(MAXN),ICU(MUKN),ITP(MUKN),
2 ISK(MAXN),ITRC(MAXE),IBC(2,3,MAXE)
COMMON/MESHS/ X(MAXN),Y(MAXN),XX(MAXN),YY(MAXN),IELG(3,MAXE),
1 IDEL(MAXE),NCRK(MAXN),ITIP(2,MXTP),IEL(3,MAXE)
COMMON/ELMNT/ XP,YP,XE(3),YE(3),XM(3),YM(3),HW1(6),HW2(6),GW1(6),
1 GW2(6),TT(2,2),UT(2,2),DW(6),SW(6),DT(6),ST(6),
2 AESK(3),MDEL,ISLF,IETRC,IESK(3),IJK(3),MJK(3)
COMMON/SFJAC/ H,SHAPF(3),SHAPD(3),SF(3,MXGP),SD(3,MXGP),RJAC,
1 UN(2),DSHAPF(3),DSF(3,MXGP),DSHAPD(3)
COMMON/EQTNS/ CUN1(MAXN),CUN2(MAXN),CTS(6),CUN1N,CUN2N,
1 IEQT(MAXN),IEQ
C
C-----INITIALIZATIONS
DO 20 I=1,NPTM
ITP(I)=0
20 CONTINUE
DO 30 M=1,NNEL
IDEL(M)=0
30 CONTINUE
NTIP=0
C-----SET UP DISCONTINUOUS ELEMENTS ALONG CRACKS
ITMP=0
DO 120 I=1,NPTM
N=I+1
IF (ITP(I).EQ.0.AND.N.LE.NPTM) THEN
DO 115 J=N,NPTM
IF (ITP(J).EQ.0.AND.
1 ABS(XX(I)-XX(J)).LT.1.E-5.AND.
2 ABS(YY(I)-YY(J)).LT.1.E-5) THEN
C-----------------TWO COINCIDENT NODES AT A POINT
ITP(I)=1
ITP(J)=1
ITMP=ITMP+1
GOTO 120
ENDIF
115 CONTINUE
ENDIF
120 CONTINUE
IF (ITMP.NE.0) THEN
IF (MAXI.LT.35) THEN
WRITE(2,'(A)')' TO IMPROVE THE J-INTEGRAL ACCURACY'
WRITE(2,'(A)')' INCREASE MAXI TO 35 IN *PARAMETER*'
STOP
ENDIF
DO 125 I=1,NNEL
IF (ITP(IELG(1,I)).NE.0.OR.
1 ITP(IELG(2,I)).NE.0.OR.
2 ITP(IELG(3,I)).NE.0) THEN
C--------------DISCONTINUOUS ELEMENTS
IDEL(I)=1
ENDIF
125 CONTINUE
C--------INITIALIZE
DO 65 I=1,NPTM
ITP(I)=0
65 CONTINUE
ENDIF
C-----SCAN THE ELEMENTS TO DEFINE FUNCTIONAL NODES
N=0
DO 10 I=1,NNEL
IF (IDEL(I).EQ.0) THEN
DO 8 J=1,3
ITMP=IELG(J,I)
C--------------CONTINUOUS ELEMENTS
IF (ITP(ITMP).EQ.0) THEN
N=N+1
ITP(ITMP)=N
X(N)=XX(ITMP)
Y(N)=YY(ITMP)
ENDIF
IEL(J,I)=ITP(ITMP)
C--------------INITIALIZE THE FLAG FOR DISPLACEMENT EQUATION
IEQT(IEL(J,I))=0
8 CONTINUE
ELSE
C-----------DISCONTINUOUS ELEMENTS
HTMP=2./3.
DO 5 K=-1,+1
IF (K.NE.0) THEN
H=HTMP*K
CALL SHAPES(0)
XTMP=0.
YTMP=0.
DO 15 J=1,3
ITMP=IELG(J,I)
XTMP=XTMP+SHAPF(J)*XX(ITMP)
YTMP=YTMP+SHAPF(J)*YY(ITMP)
15 CONTINUE
ELSE
ITMP=IELG(2,I)
XTMP=XX(ITMP)
YTMP=YY(ITMP)
ENDIF
N=N+1
X(N)=XTMP
Y(N)=YTMP
IEL(K+2,I)=N
C--------------INITIALIZE THE FLAG FOR DISPLACEMENT EQUATION
IEQT(N)=-2
5 CONTINUE
ENDIF
10 CONTINUE
C-----TOTAL NUMBER OF NODES
NNOD=N
IF (NNOD.GT.MAXN) THEN
WRITE(2,*) ' TOTAL NUMBER OF GENERATED NODES =',NNOD
WRITE(2,'(A)') ' INCREASE MAXN IN *PARAMETER*'
STOP
ENDIF
NEQN=2*NNOD
C-----ON DISCONTINUOUS ELEMENTS, SET UP FLAGS FOR CRACK NODES
IF (NPTM.NE.NNOD) THEN
C--------INITIALIZE
DO 25 I=1,NNOD
NCRK(I)=0
25 CONTINUE
DO 50 I=1,NNEL
M=I+1
IF (IDEL(I).NE.0.AND.M.LE.NNEL) THEN
ITMP=IEL(2,I)
DO 55 J=M,NNEL
JTMP=IEL(2,J)
IF (IDEL(J).NE.0.AND.
1 ABS(X(ITMP)-X(JTMP)).LT.1.E-6.AND.
2 ABS(Y(ITMP)-Y(JTMP)).LT.1.E-6) THEN
C--------------------CRACK NODES:
NCRK(IEL(1,I))=IEL(3,J)
NCRK(IEL(3,J))=IEL(1,I)
NCRK(IEL(2,I))=IEL(2,J)
NCRK(IEL(2,J))=IEL(2,I)
NCRK(IEL(3,I))=IEL(1,J)
NCRK(IEL(1,J))=IEL(3,I)
DO 40 K=1,3
C-----------------------TRACTION EQUATIONS ON ONE SIDE OF THE CRACK
IEQT(IEL(K,J))=1
C-----------------------DISPLACEMENT EQUATIONS ON THE OTHER SIDE
IEQT(IEL(K,I))=-1
40 CONTINUE
ENDIF
55 CONTINUE
ENDIF
50 CONTINUE
C--------OUTWARD NORMALS FOR THE TRACTION EQUATION
DO 128 M=1,NNEL
IF (IDEL(M).NE.0) THEN
CALL ARRAYS(M,-1)
IF (IEQT(IJK(2)).EQ.1) THEN
DO 228 J=1,3
C--------------------NORMALS AT THE NODE
H=(J-2)*2./3.
CALL SHAPES(0)
CALL JACOBI(0)
I=IJK(J)
CUN1(I)=UN(1)
CUN2(I)=UN(2)
228 CONTINUE
C-----------------SET UP CRACK-TIP NODES
DO 200 N=1,NNEL
I=IEL(2,N)
IF (I.EQ.NCRK(IJK(2))) THEN
DO 300 J=1,3,2
K=J+2
IF (K.GT.3) K=1
IF (IELG(K,N).EQ.IELG(J,M)) THEN
IF (NTIP.LT.MXTP) THEN
NTIP=NTIP+1
IF (K.GT.J) THEN
ITIP(1,NTIP)=IEL(K,N)
ITIP(2,NTIP)=IEL(J,M)
ELSE
ITIP(2,NTIP)=IEL(K,N)
ITIP(1,NTIP)=IEL(J,M)
ENDIF
ELSE
WRITE(2,'(A)')
1 ' INCREASE MXTP IN *PARAMETER*'
ENDIF
ENDIF
300 CONTINUE
ENDIF
200 CONTINUE
ENDIF
ENDIF
128 CONTINUE
ENDIF
RETURN
END
Niestety nie wiem czy z tego miejsca jest generowany komunikat, o tym, że nie znaleziono któregoś z załączonych plików.