기말고사. 。 Fortran 을 사용하여 구조 역학 주제 만들기
정수 *2 li( 100000)
실수 *4 a( 1000000)
논리 *4 가지 결과
문자 *20 NAM 1, NAM2
! 쓰기 (*,' (A\)')' 날짜-파일 이름->' 을 입력하십시오
! 읽기 (*,' (A)') NAM 1
! 읽기 (*, *)
! 열기 (1, FILE = name 1, STATUS='OLD')
! 쓰기 (*,' (/,A\)')' 출력 파일 이름->' 을 입력하십시오
! 읽기 (*,' (A)') NAM2
! 열기 (2, 파일 = 이름 2, 상태 =' 알 수 없음')
열기 (1, file='trus3.in', STATUS='unknown')
Open(2, file='trus3.out', STATUS='unknown')
열기 (3, file='trus3.mout', STATUS='unknown')
읽기 (1, *) nn, ne, NC, NP
! Nn: 총 노드 수; Ne: 총 단위 수; Nc: 지지 구속조건의 수; Np: 총 부하
쓰기 (2,' (a)')' 초기 매개변수'
쓰기 (2,' (4x, 4A6/4x, 4I6)') 'nn',' ne',' NC',' NP', nn, ne, NC
N3=nn*3! 총 자유도
N=n3-nc
Iu= 1
Iaa=iu+n3
Iea=iaa+ne
Ix=iea+ne
Iy=ix+nn
Iz=iy+nn
Isq=iz+nn
Ish=isq+3
Idc=ish+3
Ist=idc+3
Mal=ist+36
지아 = 1
Jja=jia+ne
Jns=jja+ne
Nal=jns+2*nc
Na = 10000- 말
Nli= 1000-nal
트리 3 (a (iu), a(iaa), a(iea), a(ix) 를 호출합니다.
& ampa(iy), a(iz), a(isq), a(ish), a(idc),
& ampa(ist), a(mal), 리 (nal), 리 (Jia), 리 (jja),
& amp 리 (jns), nn, ne, NC, NP, n3, n, na, nli)
끄기 (1)
닫기 (2)
닫기 (3)
Results= SYSTEMQQ('d:\\TEDIT. 실행 파일의 확장자입니다
& ampe: \ \ workfor90 \ \ SPT1_ ok \ \ trus3.out')
Results= SYSTEMQQ('d:\\TEDIT. 실행 파일의 확장자입니다
& ampe: \ \ workfor90 \ \ SPT1_ ok \ \ trus3.mout') 을 참조하십시오.
멈추다
끝
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
서브루틴 트리 3 (u, aa, ea, x, y, z, sq, sh,
& ampdc, sk, a, Li, ia, ja, ns, nn, ne, NC, NP,
& ampn3, n, na, nli)
Integer*2 ia(ne), ja(ne), ns(nc, 2), li(nli), jod(np, 2)
Real*4 u(n3), aa(ne), ea(ne), x(nn), y(nn), z(nn),
& ampsq(3), sh(3), dc(3), sk(6, 6), a(na), qd(np)
! 노드 좌표, 베어링 구속조건, 왼쪽 및 오른쪽 노드 번호, 횡단면 제품 및 탄성 계수 정보를 읽습니다.
읽기 (1, *) (x(i), y(i), z(i), i= 1, nn),
& amp(ns(i, 1), ns(i, 2), i= 1, NC),
& amp(ia(i), ja(i), aa(i), ea(i), i= 1, ne)
쓰기 (2,' (1x, a)')' 노드 좌표'
쓰기 (2,' (4x, a4, 3a 12)')' 번호',' X-COOR',' Y-COOR',' z'
쓰기 (2,' (4x, i4, 3f 12.3)') (i, x(i), y(i), z(i), I =
쓰기 (2,' (/1x, a)')' 변위점 억제'
쓰기 (2,' (2a 10/(2i 10))')' 번호',' 방향',
& amp(ns(i, 1), ns(i, 2), i= 1, NC)
쓰기 (2,' (/1x, a)')' 멤버 세부 정보'
쓰기 (2,' (4x, a4, a6, a3, 2a 12/
& amp(3x,'' (',i3,'')'', i6,'-'',I2,
& amp2e12.3)')' ne.. ,' 나',' -J',' a',' e',
& amp(I, ia(I), ja(i), aa(i), ea(i), i= 1, ne)
! 로드 데이터 읽기:
! Jod(i, 1) 하중 노드 번호; Jod(i, 2) 하중 방향 (1 x 방향 표시; 2 는 x 방향을 나타냅니다. 3 은 x 방향을 나타냄); Qd(i) 하중 크기,
쓰기 (2,' (/1x, a)')' 외부 하중'
Do 999 i= 1, NP
Jod(i, 1)=0
Jod(i, 2)=0
Qd(i)=0.0 입니다
999 계속
읽기 (1, *) (jod(i, 1), jod(i, 2), qd(i), I =/kloc
쓰기 (2,' (a 10, 3x, a 10, a13/(2i/kloc-0)
& amp' 번호',' 방향',' 값',
& amp(jod(i, 1), jod(i, 2), qd(i), i= 1, NP)
! 최대 대역폭 찾기
Mx=0
Do 400 i= 1, ne
Io=iabs(ja(i)-ia(i))! 왼쪽 및 오른쪽 최대 노드 수 차이
If(io.gt.mx) mx=io
400 계속
Nb=(mx+ 1)*3
Nt=n3+nb
Iia= 1
Iq=iia+nt*nb
Ic=iq+nt
Iqd=ic+nt
Mal=iqd+np+na
Jjod= 1
Nal=jjod+2*np+nli
전화 S4 10(u, aa, ea, x, y, z, sq, sh,
& ampdc, sk, a, q, c, qd, jod, ia, ja, ns, nn, ne,
& ampnc, NP, n3, n, nb, nt)
돌아오다
끝
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
서브루틴 S4 10(u, aa, ea, x, y, z, sq, sh,
& ampdc, sk, a, q, c, qd, jod, ia, ja, ns, nn, ne,
& ampnc, NP, n3, n, nb, nt)
Integer*2 ia(ne), ja(ne), ns(nc, 2), jod(np, 2)
Real*4 u(n3), aa(ne), ea(ne), x(nn), y(nn),
& ampz(nn), sq(3), sh(3), dc(3), sk(6, 6),
& ampa(nt, nb), q(nt), c(nt), qd(np), L.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* 들어오는 데이터 확인 *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! 쓰기 (*,' (a)')' 초기 매개변수'
! 쓰기 (*,' (4x, 4A6/4x, 4I6)') 'nn',' ne',' NC',' NP', nn, ne, NC
! 쓰기 (*,' (1x, a)')' 노드 좌표'
! 쓰기 (*,' (4x, a4, 3a 12)')' 번호',' X-COOR',' Y-COOR',' z'
! 쓰기 (*,' (4x, i4, 3f 12.3)') (i, x(i), y(i), z(i), I =
! 쓰기 (*,' (/1x, a)')' 변위점 억제'
! 쓰기 (*,' (2a 10/(2i 10))')' 번호',' 방향',
! & amp(ns(i, 1), ns(i, 2), i= 1, NC)
! 쓰기 (*,' (/1x, a)')' 멤버 세부 정보'
! 쓰기 (*,' (4x, a4, a6, a3, 2a 12/
! & amp(3x,'' (',i3,'')'', i6,'-'',I2,
! & amp2f12.3)')' ne.. ,' 나',' -J',' a',' e',
! & amp(I, ia(I), ja(i), aa(i), ea(i), i= 1, ne)
! 쓰기 (*,' (a 10, 3x, a 10, a13/(2i/kloc-0)
! & amp' 번호',' 방향',' 값',
! & amp(jod(i, 1), jod(i, 2), qd(i), i= 1, NP)
!
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
! 일시 중지 1
! 전체 강성 매트릭스와 하중 배열을 지웁니다.
Do 480 i= 1, nt
Do 450 j= 1, nb
A(i, j)=0.0 입니다
450 계속
Q(i)=0.0 입니다
480 계속
! 성형 하중 벡터
Do 544 i= 1, NP
Npd=jod(i, 1)*3+jod(i, 2)-3! 해당 하중 위치 = 노드 번호 *3+ 노드 방향 번호 (1 2 3)-3
Q(npd)=q(npd)+qd(i)
계속하다
! 해당 셀을 순환하여 셀 강성 매트릭스를 형성하고 총 강성 매트릭스를 추가합니다.
Do1120 me =1,ne
나에게 편지를 쓰다
나 = 아이아 (나)! 단위 왼쪽 끝 번호
J=ja (나)! 단위 오른쪽 끝 번호
Ao=aa (나)! 단위 면적
E=ea (나)! 단위 탄성 계수
! 셀 방향의 코사인을 구하다
L = sqrt ((x (j)-x (I)) * * 2+(y (j)-y (I)) * * 2+(z (j)-z)
Xc = (x (j)-x (I))/L.
Yc = (y (j)-y (I))/L.
Zc = (z (j)-z (I))/L.
! 단추 원소를 구하다
Sk( 1, 1)=xc**2
Sk( 1, 2)=xc*yc
Sk(2, 1)=sk( 1, 2)
Sk (2,2) = YC * * 2
Sk( 1, 3)=xc*zc
Sk(3, 1)=sk( 1, 3)
Sk (3,2) = YC * ZC
Sk (2,3) = sk (3,2)
Sk (3,3) = ZC * * 2
Sk(4, 1)=-xc**2
Sk (4,2) =-xc * YC
Sk (4,3) =-xc * ZC
Sk(5, 1)=-xc*yc
Sk (5,2) =-YC * * 2
Sk (5,3) =-YC * ZC
Sk(6, 1)=-xc*zc
Sk (6,2) =-YC * ZC
Sk (6,3) =-ZC * * 2
Do 870 ii= 1, 3
Do 870 jj= 1, 3
Sk(ii+3, jj+3)=sk(ii, jj)
Sk(ii, jj+3)=sk(jj+3, ii)
870 계속
Cn=ao*e/l
Do 930 ii= 1, 6
Do 930 jj= 1, 6
Sk(ii, jj)=sk(ii, jj)*cn
! 쓰기 (3, *) sk(ii, jj)! ! ! ! ! !
930 계속
! 단강 행렬은 총 강성 행렬을 보냅니다.
I 1=3*i-3
J 1=3*j-3
! 일시 중지 4! 중단점 탐지
Do1114jj =1,2
(jj.eq. 1) nr=i 1 인 경우
(jj.eq.2) nr=j 1
Do1112j9 =1,3
Nr=nr+ 1
Ii=(jj- 1)*3+j9
Do1110 kk =1,2
(kk.eq. 1) n9=i 1
(kk.eq.2) n9=j 1
Do 1 100 k= 1, 3
Ll=(kk- 1)*3+k
Nk=n9+k+ 1-nr
(nk.le.0) 가 1 100 으로 이동하는 경우
A(nr, nk)=a(nr, nk)+sk(ii, ll)
1 100 계속
1 1 10 계속
1 1 12 계속
* 일시 중지 4! 중단점 탐지
1 1 14 계속
1 120 계속
! 베어링 구속조건 도입
Do 1 150 i= 1, nc.
Npd=ns(i, 1)*3+ns(i, 2)-3
A(npd, 1)=a(npd,1) * (1e+12)
Q(npd)=0
1 150 계속
! 하중 배열은 방정식의 오른쪽에 제공됩니다.
N=n3
Do1190 ii =1,n3
C(ii)=q(ii)
쓰기 (3, *) c(ii)! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
1 190 계속
! 서브루틴을 호출하여 방정식을 풀다
S2000(a 호출 (a, c, n, nb, nt)
! 변위 항목을 찾고 변위 배열을 제공하십시오.
1220 do1230 ii =1,n3
1230 u(ii)=c(ii)
! 변위 결과 출력
쓰기 (2,' (/1x, a)')' 노드 오프셋'
쓰기 (2,' (A8, a 10, 2a 12/(i8, 3f 12.5))'
& amp(ii, u(3*ii-2), u(3*ii- 1), u(3*ii), ii =/kloc
! 내부 힘 결과 내보내기
쓰기 (2,' (/1x, a)')' 구성원 강제 추가'
쓰기 (2,' (4x, a4, a6, a3, a 16)') 'ne',' I',' -j',' force
Do1610 me =1,ne
I=ia (나)
J=ja (나)
Ao=aa (나)
E=ea(me)
L = sqrt ((x (j)-x (I)) * * 2+(y (j)-y (I)) * * 2+(z (j)-z)
Xc = (x (j)-x (I))/L.
Yc = (y (j)-y (I))/L.
Zc = (z (j)-z (I))/L.
Dc( 1)=xc
Dc(2)=yc
Dc(3)=zc
I 1=3*i-3
J 1=3*j-3
Do1510 i3 =1,3
J3=i 1+i3
J2=j 1+i3
Sq(i3)=u(j3)
Sh(i3)=u(j2)
15 10 계속
A 1=0.0
A2=0.0
Do 1570 ii= 1, 3
A1= a1+DC (ii) * sq (ii)
A2=a2+dc(ii)*sh(ii)
1570 계속
! 내부 힘 = 면적 * 탄성 계수 * 변형 (총 길이에 대한 양단 변위 차이 비율)
Fc = ao * e * (a2-a1)/L.
Write(2,' (4x,'' (',I2,'')', i6,'-'',I2, f16
& amp 나, ia (나), ja (나), fc
16 10 계속
돌아오다
끝
서브 루틴 s2000(a, cc, n, nb, nt)! 선형 방정식을 풀기위한 반 대역폭 서브 루틴
실수 *4 a(nt, nb), cc(nt)
2000 do 2940 ii= 1, n.
Ik=ii
Do2920jj = 2,nb
Ik=ik+ 1
Cn=a(ii, jj)/a(ii, 1)
Jk=0
Do 2890 kk=jj, nb
Jk=jk+ 1
2890 a(ik, jk)=a(ik, jk)-cn*a(ii, kk)
A(ii, jj)=cn
2920 cc(ik)=cc(ik)-cn*cc(ii)
2940 cc(ii)=cc(ii)/a(ii, 1)
Do3010iz = 2,n
Ii=n-iz+ 1
Do3000 kk = 2,nb
Jj=ii+kk- 1
3000 cc(ii)=cc(ii)-a(ii, kk)*cc(jj)
30 10 계속
돌아오다
끝
Trus3.in
6,9,9,2
0, 0, 4.0 입니다.
0, 0,-4.0,
0, 10.0, 0,
12.0,0, 4.0,
12.0,0,-4.0,
12.0,-7.0,0,
1,1,1,2,1,3,
2, 1,2,2,2,3,
3, 1,3,2,3,3,
5,3,3.0e-4, 1.2e+ 12,
4,3,3.0e-4, 1.2e+ 12,
4 1, 3.0e-4 1.2e+ 12,
4,5,3.0e-4, 1.2e+ 12,
5,2,3.0e-4, 1.2e+ 12,
6, 1, 3.0e-4, 1.2e+ 12,
4,6,3.0e-4, 1.2e+ 12,
5,6,3.0e-4, 1.2e+ 12,
6,2,3.0e-4, 1.2e+ 12,
6, 1, 2500.0,
6,2,-4330. 1,