a02a.for

ADINA84有限元编程学习的好例子

      JSTR=1
      DO 45 I=1,6
      IF (IDOF(I).EQ.1) GO TO 44
      IF (JSTR.LE.33) GO TO 38
      write(66,2034) RMSG
      JSTR=1
   38 JEND=JSTR + 10
      RMSG(JSTR:JEND) = RCMP(I)
      JSTR=JEND + 1
   44 IF (I.EQ.6) write(66,2034) RMSG(1:JEND)
   45 CONTINUE
   48 write(66,2037) IUSERL
	WRITE(66,2038) IEARTHQ
      NCARD=NCARD + 1
      write(66,2010) NCARD
      write(66,2035) IMASS,IDAMP,IMASSN
      write(66,2036) IDAMPN,RDVAR(1),RDVAR(2)
      NCARD=NCARD + 1
      write(66,2010) NCARD
      write(66,2040) IEIGG,IESTYP,NFREQ
      write(66,2042) NQ,NMODE,IFPR
      NCARD=NCARD + 1
      write(66,2010) NCARD
      write(66,2045) IMODS,IOPE
      IF (IOPE.EQ.1) write(66,2050) OPVAR(1)
      IF (IOPE.EQ.2) write(66,2055) OPVAR(1),OPVAR(2)
      write(66,2057) NMRESP,IMDAMP,IERMSU,IRSPC
      NCARD=NCARD + 1
      write(66,2010) NCARD
      write(66,2060) NSREFB,NEQITB,IMMM,IVVV
      write(66,2061) IPEQIT,ITOL,ITEMAX,ETOL
      write(66,2062) RTOL,RCTOL,STOL,RNORM,RMNORM
      IF (METHOD.NE.4) GO TO 46
      write(66,2063) NODQ,NDID,DISPM4
      write(66,2064) ADNOM,ADMAX,ICOMA,IAR
   46 CONTINUE
      NCARD=NCARD + 1
      write(66,2010) NCARD
      write(66,2065) IOUTPT,NPRIB,NPB,IDC,IVC,IAC
      write(66,2066) ISTPRT
      NCARD=NCARD + 1
      write(66,2010) NCARD
      write(66,2100) NPUTSV,NODSVB,LEMSVB
      write(66,2105) IBPORT,IFPORT,JDC,JVC,JAC,JTC
      I=KLIN + 1
      J=ISTAT + 1
      write(66,2110) WORD3(I),WORD,WORD5(J),WORD3(3)
      IF (NSREFB.NE.0 .OR. NEQITB.NE.0) GO TO 810
      IF (NPRIB.NE.0 .OR. NPB.NE.0) GO TO 810
      IF (JNPORT.NE.0 .AND. (NODSVB.NE.0 .OR. LEMSVB.NE.0)) GO TO 810
      GO TO 890
  810 write(66,2115)
  820 IF (NSREFB.EQ.0) GO TO 830
      write(66,2120)
      write(66,2130) (J,(J,ISREFB(I,J),I=1,3),J=1,NSREFB)
  830 IF (NEQITB.EQ.0) GO TO 840
      write(66,2140)
      write(66,2150) (J,(J,IEQITB(I,J),I=1,3),J=1,NEQITB)
  840 IF (NPRIB.EQ.0) GO TO 850
      write(66,2160)
      write(66,2170) (J,(J, IPRIB(I,J),I=1,3),J=1,NPRIB)
  850 IF (NPB.EQ.0) GO TO 860
      write(66,2180)
      write(66,2190) (J,(J,IPNODE(I,J),I=1,3),J=1,NPB)
  860 IF (JNPORT.EQ.0) GO TO 890
      IF (NODSVB.EQ.0) GO TO 870
      write(66,2200)
      write(66,2210) (J,(J, INODB(I,J),I=1,3),J=1,NODSVB)
  870 IF (LEMSVB.EQ.0) GO TO 890
      write(66,2220)
      write(66,2230) (J,(J, IELMB(I,J),I=1,3),J=1,LEMSVB)
  890 CONTINUE
      IF (KLIN.EQ.0) GO TO 7
      IF(IOPE.EQ.3) GO TO 7
      IF (IMODES.EQ.0) GO TO 8
      NSREFB=0
      GO TO 8
    7 NSREFB=0
      NEQITB=0
    8 IF (IOUTPT.NE.0) GO TO 6
      NPRIB=1
      IPRIB(1,1)=1
      IPRIB(2,1)=NSTE
      IPRIB(3,1)=1
      NPB=1
      IPNODE(1,1)=1
      IPNODE(2,1)=NUMNP
      IPNODE(3,1)=1
      IDC=1
      IVC=1
      IAC=1
    6 IF (NPB.NE.0) GO TO 9
      IDC=0
      IVC=0
      IAC=0
    9 IPC=IDC + IVC + IAC
      IF (IDPIPE.EQ.0) GO TO 137
      IF (IDPIPE-2) 131,133,135
  131 DO 132 I=1,3
      I6=I+6
      I9=I+9
      IDOF(I6)=0
  132 IDOF(I9)=1
      GO TO 139
  133 DO 134 I=1,3
      I6=I+6
      I9=I+9
      IDOF(I6)=1
  134 IDOF(I9)=0
      GO TO 139
  135 DO 136 I=1,6
      I6=I+6
  136 IDOF(I6)=0
      GO TO 139
  137 DO 138 I=1,6
      I6=I+6
  138 IDOF(I6)=1
  139 NDOF=6
      NDOFRO=3
      NDOFOV=6
      DO 11 I=1,6
      NDOF   = NDOF   - IDOF(I)
   11 NDOFOV = NDOFOV - IDOF(I+6)
      DO 12 I=4,6
   12 NDOFRO = NDOFRO - IDOF(I)
      NDOF12 = NDOF + NDOFOV
      IF (NDOF12.GT.0) GO TO 123
      write(66,3341)
      IF (MODEX.GT.0) STOP
  123 CONTINUE
      CALL STORE (NUMNP,NDOF12,NEQ,NWK,MA,NTGNL,MAXEST,NBLOCK,ISTOH,0)
C        NI1        IPNT
      READ (IIN,1010) NTFN,NPTM
      IF (IDATWR.LE.1) write(66,2250) NTFN,NPTM
      IF (JNPORT.EQ.0) GO TO 170
      IF (JNPORT.EQ.1)
     1   WRITE (IBPORT     ) 'TIMEDATA',NTFN,NPTM
      IF (JNPORT.EQ.2)
     1   WRITE (IFPORT,9030) 'TIMEDATA',NTFN,NPTM
 9030 FORMAT ( A,/,2I10 )
  170 CONTINUE
      IF (NTFN.EQ.0) GO TO 15
      NI1=N08
      NI2=NI1 + NTFN
      NI3=NI2 + NTFN*NPTM*ITWO
      NI4=NI3 + NTFN*NPTM*ITWO
      NI5=NI4 + NTFN
      NILAST=NI5 + 2*NTFN*ITWO - 1
      IF (ISTPRT.GT.0) write(66,2802)
      CALL SIZE (NILAST)
      CALL TIMFUN (A(NI1),A(NI2),A(NI3),A(NI4),A(NI5),
     1             NTFN,NPTM)
   15 MID=0
      IF (NMIDSS .GT. 0) MID=1
      NIDV=N08
      NCOSDV=NIDV + NUMNP*MID
      NDVOR=NCOSDV
      IF (IINIMP.EQ.1) NDVOR=NCOSDV + 3*NUMNP*ITWO*MID
      NGL=NDVOR + 3*NMIDSS*ITWO
      NCOMP=NGL + NUMNP
      N08R=NCOMP + 3*NUMNP*ITWO
C        N1       ID
C        N1A      NODSYS
C        N1V      IOVA
  118 N1=N08R + NDOFRO*NUMNP
      N1A=N1 + NDOF12*NUMNP
      N1V=N1A + NUMNP
      IF (NSKEWS.EQ.0) N1V=N1A
      NI1=N1V + NUMNP
      IF (IDPIPE.EQ.0) NI1=N1V
      NI2=NI1 + NUMNP*ITWO
      NI3=NI2 + NUMNP*ITWO
      NI4=NI3 + NUMNP*ITWO
      MIDM = MAX0( NIDM,4 )
      NI5 = NI4 + MIDM
      NI6 = NI5 + MIDM
      NI7 = NI6 + 2*NRLINK
      NLAST = NI7-1
      IF (IINIMP.EQ.1) NLAST = NI7 + NDOF*NUMNP*ITWO
      IF (ISTPRT.GT.0) write(66,2803)
      CALL SIZE (NLAST)
      REWIND IT3
      CALL INPUT (A(N06),A(N1A),A(NIDV),A(NCOSDV),A(NGL),
     1            A(N1),A(N1V),A(NI1),A(NI2),
     1            A(NI3),IDOF,NDOF,NDOF12,IDPIPE,NUMNP,NEQ,NSKEWS,
     2            NMIDSS)
      ISKPID=0
      IF (IEIG.EQ.0 .AND. IMODS.GT.0) ISKPID=1
      IF (ISKPID.EQ.1) write(66,2701)
      NLTH=3*NUMNP
      CALL ZEROWV (A(NCOMP),NLTH)
      NEQT = NEQ + NDISCE
      NRDOF=0
      IF (NDOFRO.EQ.0) GO TO 117
      NRDOF1=NDOFRO*NUMNP
      NDOF6=NDOF - NDOFOV
      CALL ROTIND (A(N1),A(N08R),IDOF,NDOF,NDOF6,NRDOF,NUMNP,NEQT)
      IF (NRDOF1.EQ.NRDOF) GO TO 117
      NT=N08R + NRDOF
      J=0
      NFIN=NI4 - 1
      DO 120 I=N1,NFIN
      J=J+1
  120 A(NT+J-1)=A(N1+J-1)
      N1=N08R + NRDOF
      N1A=N1 + NDOF*NUMNP
      NI1=N1A + NUMNP
      IF (NSKEWS.EQ.0) NI1=N1A
      NI2=NI1 + NUMNP*ITWO
      NI3=NI2 + NUMNP*ITWO
      NI4=NI3 + NUMNP*ITWO
      NI5 = NI4 + MIDM
      NI6 = NI5 + MIDM
      NI7 = NI6 + 2*NRLINK
  117 CONTINUE
      CALL IEQTOL
      IF (NDISCE.EQ.0) GO TO 29
      CALL CONEQN (A(N06),A(N1A),A(N1),A(N01),A(N02),A(N03),A(N03A),
     1             A(N03B),A(NI1),A(NI2),A(NI3),A(NI4),A(NI5),A(NI6),
     2             A(NGL),NDOF,NIDM,NEQT)
      NN = N1A - 1
      IF (JNPORT.EQ.0) GO TO 29
      IF (JNPORT.EQ.1)
     1   WRITE (IBPORT     ) 'ID-ARRAY',N1,NN,(IA(I),I=N1,NN)
      IF (JNPORT.EQ.2)
     1   WRITE (IFPORT,9040) 'ID-ARRAY',N1,NN,(IA(I),I=N1,NN)
 9040 FORMAT ( A,/,(8I10) )
   29 IF (IINIMP.EQ.1)
     1CALL INIMP (A(NI1),A(NI2),A(NI3),A(N1A),A(N06),A(NIDV),A(NCOSDV),
     2           A(NDVOR),A(N1),A(NI7),A(NI6),A(N03A),
     3           NUMNP,NEQ,NEQT,NDOF,NSKEWS,NMIDSS)
      IF (ISKPID.EQ.1) GO TO 39
      REWIND IT9
      NN=N1A - 1
      WRITE (IT9) (IA(I),I=N1,NN)
   39 CONTINUE
      NEQT = NEQ + NDISCE
      NI2 = NI1 + NEQT*ITWO
      NI3 = NI2 + NEQT*ITWO
      NI4 = NI3 + NEQT*ITWO
      IF (ISTAT.EQ.0) NI4=NI2
      NLAST = NI4 + NEQT*ITWO - 1
      IF (IOPE.NE.3) NLAST=NI4 - 1
      IF (ISTPRT.GT.0) write(66,2804)
      CALL SIZE (NLAST)
      REWIND IT23
      CALL NODMAS (A(N1),A(NI1),A(NI1),A(N01),A(N02),A(N03),ISUB,NDOF,
     1             NIDM,IDOF,NUMNP,NEQ,NEQT,IMASSN,IDAMPN,ISTAT)
      REWIND IT8
      CALL INITAL (A(NI1),A(NI4),A(NI2),A(NI3),A(NI3),A(N1),ISUB,NDOF,
     1             IDOF,NEQ,NEQT,NUMNP,ICONT,ICONTG)
      IF (ITP96.NE.2) GO TO 26
      CALL INITEM (A(NI1),TSTART,NUMNP,ICONT,1)
   26 IF (NTEGRA.EQ.0) GO TO 27
      CALL INITEM (A(NI1),TSTART,NUMNP,ICONTG,2)
   27 NT = IT3
      REWIND NT
      N2=NI1
      N3=N2 + NUMNP*ITWO
      N4=N3 + NUMNP*ITWO
      N5=N4 + NUMNP*ITWO
      NN=N3 - 1
      READ (NT) (A(I),I=N2,NN)
      NN=N4 - 1
      READ (NT) (A(I),I=N3,NN)
      NN=N5 - 1
      READ (NT) (A(I),I=N4,NN)
      GO TO 999
  900 continue
c 900 CALL SUBINP
  999 CONTINUE
      RETURN
 1000 FORMAT (A)
 1001 FORMAT (4I5)
 1003 FORMAT (I5,7I1,I3,3I5,2F10.0,6I5)
 1004 FORMAT (2I5,3F10.0,2I5)
 1005 FORMAT (2I5,3X,A1,A1,2I1,I3,6F10.0)
 1006 FORMAT (9I5,16I2,2X,I1)
 1008 FORMAT (4I5,2F10.0)
 1010 FORMAT (16I5)
 1011 FORMAT (5I5,10X,4I5)
 1015 FORMAT (14I5,3I2,I4)
 1020 FORMAT (2I5,2F10.0,4I5)
 1100 FORMAT (15I5,5X )
 2000 FORMAT (1H1,A,///)
 2001 FORMAT (1H1,//////////
     1 21X,92(1H*),/,21X,92(1H*),/,2(21X,2H**,88X,2H**,/),
     2 21X,2H**,30X,28HA FINITE ELEMENT PROGRAM FOR ,30X,2H**,/,
     1 21X,2H**,20X,48HAUTOMATIC DYNAMIC INCREMENTAL NONLINEAR ANALYSIS,
     2               20X,2H**,/,2(21X,2H**,88X,2H**,/),21X,2H**,9X,
     310(1HA),4X,9(1HD),6X,12(1HI),3X,2HNN,8X,2HNN,4X,10(1HA),9X,2H**,/,
     4 21X,2H**,8X,12(1HA),3X,10(1HD),5X,12(1HI),3X,3HNNN,7X,2HNN,3X,
     5 12(1HA),8X,2H**,/,21X,2H**,8X,2HAA,8X,2HAA,3X,2HDD,7X,2HDD,9X,
     6 2HII,8X,4(1HN),6X,2HNN,3X,2HAA,8X,2HAA,8X,2H**,/,21X,2H**,8X,
     7 2HAA,8X,2HAA,3X,2HDD,8X,2HDD,8X,2HII,8X,2HNN,1X,2HNN,5X,2HNN,3X,
     82HAA,8X,2HAA,8X,2H**,/,21X,2H**,8X,2HAA,8X,2HAA,3X,2HDD,8X,2HDD,