搜索
C************************************************C*FINITEELEMENTPROGRAM*C*FORTwoDIMENSIONALELASticityPROBLEM*C*WITH4NODE*C************************************************PROGRAMELASTICITYcharacter*32dat,cchDIMENSIONSK(80000),COOR(2,300),AE(4,11),MEL(5,200),&WG(4),JR(2,300),MA(600),R(600),iew(30),STRE(3,200)COMMON/CMN1/NP,NE,NM,NRCOMMON/CMN2/N,MX,NHCOMMON/CMN3/RF(8),SKE(8,8),NN(8)WRITE(*,*)'PLEASEENTERINPUTFILENAME'READ(*,'(A)')DATOPEN(4,FILE=dat,STATUS='OLD')OPEN(7,FILE='OUT',STATUS='UNKNOWN')READ(4,*)NP,NE,NM,NRWRITE(7,'(A,I6)')'NUMBEROFNODE---------------------NP=',npWRITE(7,'(A,I6)')'NUMBEROFELEMENT------------------NE=',neWRITE(7,'(A,I6)')'NUMBEROFMATERIAL-----------------NM=',nmWRITE(7,'(A,I6)')'NUMBEROFsurporting---------------NC=',NrCALLINPUT(JR,COOR,AE,MEL)CALLCBAND(MA,JR,MEL)DOI=1,NHSK(I)=0.0enddoCALLSK0(SK,MEL,COOR,JR,MA,AE)doI=1,NR(I)=0.0enddopause'aaa'stopREAD(4,*)NCP,NBE,izWRITE(*,'(5i8)')NCP,NBE,izWRITE(7,'(5i8)')NCP,NBE,izIF(NCP.GT.0)CALLCONCR(NCP,R,JR)IF(NBE.GT.0)CALLBODYR(NBE,R,MEL,COOR,JR,AE)IF(iz.GT.0)thendojj=1,izREAD(4,*)Js,nse,(WG(I),I=1,4)read(4,*)(iew(m),m=1,nse)CALLFACER(iew,NSE,R,MEL,COOR,JR,WG)enddoendifCALLDECOP(SK,MA)CALLFOBA(SK,MA,R)CALLOUTDISP(NP,R,JR)CALLSTRESS(COOR,MEL,JR,AE,R,STRE)WRITE(7,'(A)')'PROGRAMSAFFHASBEENENDED'WRITE(*,'(A)')'PROGRAMSAFFHASBEENENDED'STOPcRETURNENDC*********************************************SUBROUTINEINPUT(JR,COOR,AE,MEL)DIMENSIONJR(2,*),COOR(2,*),AE(4,*),MEL(5,*)COMMON/CMN1/NP,NE,NM,NRCOMMON/CMN2/N,MX,NHDO70I=1,NPREAD(4,*)IP,X,YCOOR(1,IP)=XCOOR(2,IP)=Y70CONTINUEDO11J=1,NEREAD(4,*)NEE,NME,(MEL(I,NEE),I=1,4)MEL(5,NEE)=NME11CONTINUEDO10I=1,NPDO10J=1,210JR(J,I)=1DO20I=1,NRREAD(4,*)IP,IX,IYJR(1,IP)=IXJR(2,IP)=IY20CONTINUEN=0DO30I=1,NPDO30J=1,2IF(JR(J,I))30,30,2525N=N+1JR(J,I)=N30CONTINUEDO55J=1,NMREAD(4,*)JJ,(AE(I,JJ),I=1,4)WRITE(*,910)JJ,(AE(I,JJ),I=1,4)55CONTINUE910FORMAT(/20X,'MATERIALPROPERTIES'/(3X,I5,4(1x,E8.3)))RETURNENDC**********************************************SUBROUTINECBAND(MA,JR,MEL)DIMENSIONMA(*),JR(2,*),MEL(5,*),NN(8)COMMON/CMN1/NP,NE,NM,NRCOMMON/CMN2/N,MX,NHDO65I=1,N65MA(I)=0DO90IE=1,NEDO75K=1,4IEK=MEL(K,IE)DO95M=1,2JJ=2*(K-1)+MNN(JJ)=JR(M,IEK)95CONTINUE75CONTINUEL=NDO80I=1,2*4NNI=NN(I)IF(NNI.EQ.0)GOTO80IF(NNI.LT.L)L=NNI80CONTINUEDO85M=1,2*4JP=NN(M)IF(JP.EQ.0)GOTO85JPL=JP-L+1IF(JPL.GT.MA(JP))MA(JP)=JPL85CONTINUE90CONTINUEMX=0MA(1)=1DO10I=2,NIF(MA(I).GT.MX)MX=MA(I)MA(I)=MA(I)+MA(I-1)10CONTINUENH=MA(N)WRITE(7,'(A,I8)')'TOTALDEGREESOFFREEDOM-----------N=',NWRITE(7,'(A,I8)')'MAX-SEMI-BANDWIDTH-----------------MX=',MXWRITE(7,'(A,I8)')'TOTAL-STORAGE----------------------NH=',NH500FORMAT(/5X,'FREEDOMN='*,I5,3X,'SEMI-BANDWI.MX=',I5,3X,*'STORAGENH=',I7)RETURNENDC**********************************************SUBROUTINESK0(SK,MEL,COOR,JR,MA,AE)DIMENSIONSK(*),MEL(5,*),COOR(2,*),JR(2,*),MA(*),*AE(4,*),XYZ(2,4),iven(4)COMMON/CMN1/NP,NE,NM,NRCOMMON/CMN2/N,MX,NHCOMMON/CMN3/RF(8),SKE(8,8),NN(8)COMMON/CMN4/NEE,NMECOMMON/GAUSS/RSTG(3),H(3)H(1)=0.5555555555555560H(2)=0.8888888888888890H(3)=H(1)RSTG(1)=-0.7745966692414830RSTG(2)=0.00RSTG(3)=-RSTG(1)DO10IE=1,NENEE=IENME=MEL(5,IE)DO75K=1,4IEK=MEL(K,IE)iven(k)=IEKDO95M=1,2JJ=2*(K-1)+MNN(JJ)=JR(M,IEK)95XYZ(M,K)=COOR(M,IEK)75CONTINUECALLSTIF(XYZ,AE,iven)DO60I=1,8DO60J=1,8II=NN(I)JJ=NN(J)IF((JJ.EQ.0).OR.(II.LT.JJ))GOTO60JN=MA(II)-(II-JJ)SK(JN)=SK(JN)+SKE(I,J)60CONTINUE70CONTINUEwrite(7,1111)((ske(i,j),j=1,8),i=1,8)1111format(2x,8f12.2)10CONTINUERETURNENDC*********************************************SUBROUTINESTIF(XYZ,AE,iven)DIMENSIONAE(4,*),DNX(2,4),XYZ(2,*),iven(*),*RJAC(2,2)COMMON/CMN1/NP,NE,NM,NRCOMMON/CMN2/N,MX,NHCOMMON/CMN3/RF(8),SKE(8,8),NN(8)COMMON/CMN4/NEE,NMECOMMON/GAUSS/RSTG(3),H(3)DO40I=1,8RF(I)=0.00DO30J=1,8SKE(I,J)=0.0030CONTINUE40CONTINUEE=AE(1,NME)U=AE(2,NME)GAMA=AE(3,NME)D1=E*(1.00-U)/((1.00+U)*(1.00-2.00*U))D2=E*U/((1.00+U)*(1.00-2.00*U))D3=E*0.50/(1.00+U)DO120I=1,4II=2*(I-1)I1=II+1I2=II+2DO115J=1,4JJ=2*(J-1)J1=JJ+1J2=JJ+2DXX=0DXY=0DYX=0DYY=0DO99IS=1,3S=RSTG(IS)SH=H(IS)DO98IR=1,3R=RSTG(IR)RH=H(IR)CALLFDNX(XYZ,DNX,DET,R,S,RJAC,iven,NEE)DNIX=DNX(1,I)DNIY=DNX(2,I)DNJX=DNX(1,J)DNJY=DNX(2,J)DXX=DXX+DNIX*DNJX*DET*RH*SHDXY=DXY+DNIX*DNJY*DET*RH*SHDYX=DYX+DNIY*DNJX*DET*RH*SHDYY=DYY+DNIY*DNJY*DET*RH*SH98CONTINUE99CONTINUESKE(I1,J1)=DXX*D1+DYY*D3SKE(I2,J2)=DYY*D1+DXX*D3SKE(I1,J2)=DXY*D2+DYX*D3SKE(I2,J1)=DYX*D2+DXY*D3115CONTINUE120CONTINUERETURNENDC*********************************************SUBROUTINECONCR(NCP,R,JR)DIMENSIONR(*),JR(2,*),XYZ(2)DO100I=1,NCPREAD(4,*)IP,PX,PYXYZ(1)=PXXYZ(2)=PYDO95J=1,2L=JR(J,IP)IF(L.EQ.0)GOTO95R(L)=R(L)+XYZ(J)95CONTINUE100CONTINUERETURNENDC**********************************************SUBROUTINEBODYR(NBE,R,MEL,COOR,JR,AE)DIMENSIONR(*),MEL(5,*),COOR(2,*),JR(2,*),&AE(4,*),XYZ(2,4),iven(4)COMMON/CMN1/NP,NE,NM,NRCOMMON/CMN2/N,MX,NHCOMMON/CMN3/RF(8),SKE(8,8),NN(8)COMMON/CMN5/FUN(4),PN(2,4),XJAC(2,2)COMMON/GAUSS/RSTG(3),H(3)H(1)=1.0H(2)=1.0RSTG(1)=-0.5773502691896260RSTG(2)=-RSTG(1)DO10IE=1,NBEDOI=1,8RF(I)=0.00ENDDOcREAD(4,*)NEENEE=ieNME=MEL(5,NEE)GAMA=AE(3,NME)DO75K=1,4IEK=MEL(