a02a.for

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

      SUBROUTINE ADINI
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 /ISUBST/ ISUB,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
     1                NODCON,NODRET,IDOFS(12),NDOFS,NEQS,NWKS,MAXES,
     2                MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
      COMMON /DIM/ N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1           ,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /CONST/ DT,DTA,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11
     1              ,A12,A13,A14,A15,A16,A17,A18,A19,A20,DTOD,IOPE
      COMMON /SEQNCE/ IT1,IT2,IT3,IT4,IT5,IT6,IT7,IT8,IT9,IT10,IT11,
     1                IT12,IT13,IT14,IT15,IT16,IT17,IT18,IT19,IT20,
     1                IT21,IT22,IT23,IT24,IT50,IT56,IT57,IT59,IT60
      COMMON /TEMP/ ISPEC
      COMMON /MSUPER/ IMODES,NMODES,IMDAMP,IERMSU
      COMMON /DIMETC/ N01,N02,N03,N04,N05,N06,N07,N08,N09
      COMMON /DIMNEG/ N0B,N03A,N03B
      COMMON /LOA/ NLOAD,NPR2,NPR3,NPBM,NP3DB,NPPL,NPSH,NODE3,IDGRAV,
     1             NPDIS,NTEMP,IDCFGL,ISMASS
      COMMON /USUPLD/ IUSERL
      COMMON /DISCON/ NDISCE,NIDM
      COMMON /RLINK/ NRLINK,NRNLIN,NCES,NRLID
      COMMON /TIMFN/ TEND,NTFN,NPTM
      COMMON /JUNK/ MTOT,NBCST
      COMMON /VAR/ NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
     1             IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /EQIT/ METHOD,ILNSCH,NLSTPD,NLSTEP,ITEDIV,IPEQIT
      COMMON /DICS/ DISPM4,ADNOM,ADMAX,ADCOM,NODQ,NDID,NEDPM4,N1CRLO,IAR
      COMMON /ITRATE/ RCENRM,RCNORM,RCONSM,RCTOL
      COMMON /EIGIF/ COFQ,RBMSH,IESTYP,NFREQ,NMODE,IFPR,IRBM,
     1               IRSPA,IRSPC,NDIR
      COMMON /FAST/ SHIFT1,SHIFT2,IOVER,IRPC,NSTV,IINTER,JROLD,NSCH1,
     1              IACCN,NJUNK,ISVTYP
      COMMON /RESPEC/ NMRESP
      COMMON /SCRAP/ SHIFT,RLQ1,NLQ,NITE,NSTEP,JR,ICONV,NCEV,NP,NQ,IFSS
      COMMON /FREQIF/ ISTOH,N1A,N1B,N1C,N1S
      COMMON /NORMS/ RNORM,RENORM,RTOL,DTOL,STOL,SMAX,SMIN,
     1               DMAX,DMIN,ETOL
      COMMON /DNORMS/ DNORM,DMNORM,ITOL
      COMMON /PRCON/ IDATWR,IPRIC,NPB,IDC,IVC,IAC,IPC,IPNODE(3,15)
      COMMON /PRCONS/ IPRICS
      COMMON /ADINAI/ OPVAR(7),TSTART,IRINT,ISTOTE
      COMMON /TEMPRT/ TEMP1,TEMP2,ITEMPR,ITP96,N6A,N6B
      COMMON /ROTDI/  RMNORM,NRDOF
      COMMON /TEGRSH/ NTEGRA,N6C
      COMMON /MDFRDM/ IDOF(12)
      COMMON /PIPEID/ IDPIPE
      COMMON /DAMP/   RDVAR(2)
      COMMON /BUCKLE/ IINIMP
      COMMON /CNTACT/ NEQI,LEADEQ,NCE2D,NCE3D
      COMMON /GROUPS/ NTGNL,NSGNL
      COMMON /ISSAC/ NEWREF
      COMMON /TAPES/ IIN,IOUT
      COMMON /DPR/ ITWO
      COMMON /BLOCKS/ NSREFB,NEQITB,NPRIB,NODSVB,LEMSVB,ISREFB(3,10),
     1                IEQITB(3,10),IPRIB(3,10),INODB(3,10),IELMB(3,10)
      COMMON /SKEW/ NSKEWS
      COMMON /RESAVC/ ISVFK,ISVUKM,KSTOP,ISTATP,ISTLFP,IRINTP,NTUSUM,
     1                NTGNLP,NSUBSP,ISVFKP,IRECHK,IARINT
      COMMON /PORT/ INPORT,JNPORT,NPUTSV,IBPORT,IFPORT,JDC,JVC,JAC
      COMMON /PORTT/ JTC
      COMMON /RANDI/ N0A,N1D,IELCPL
      COMMON /USDIVC/ NMIDSS,NIDV,NCOSDV,NGL,NCOMP
      COMMON /MPRNT/ IOUTPT,ISTPRT
      COMMON /INFORM/ IDINFO(16)
      COMMON /NMDATA/ KSET
      COMMON /PRNDAT/ IPDATA
      COMMON /RFORCE/ IREFOR,NEQSUM,NREQ,NBLANK
      COMMON /RANDAC/ NR(5),LR(5),LRECFA
      COMMON /ADIIN/ IADIN
      COMMON /CALIGN/ NOALIG
      COMMON /CJUNK/ CHEAD
	COMMON /ZYX/ IEARTHQ
      CHARACTER CHEAD*80
      COMMON A(1)
      REAL A
      INTEGER IA(1)
      EQUIVALENCE (A(1),IA(1))
      DIMENSION METHAR(4)
      CHARACTER METH(7)*1, WORD3(3)*3, WORD5(2)*5, WORD*6, IMMM*1,
     1          IVVV*1
      CHARACTER BLKNAM(5)*8
      CHARACTER RMSG*33,RCMP(6)*11
      DATA METHAR / 1, 2, 3, 4 /
      DATA METH /'1' , '2' , '3' , 'A' , ' ' , '0' , '-'/
      DATA WORD3 /'   ' , 'NON' , 'IC '/
      DATA WORD5 /' STAT' , 'DYNAM'/ , WORD /'LINEAR'/
      DATA BLKNAM /'STIFNESS' , 'ITERATON' , 'PRINTOUT' ,
     1             'NODESAVE' , 'ELMTSAVE'/
      DATA RCMP / 'FORCE-XX   ' , 'FORCE-YY   ' , 'FORCE-ZZ   ' ,
     1            'MOMENT-XX  ' , 'MOMENT-YY  ' , 'MOMENT-ZZ  ' /
      IF (ISUB.GT.0) GO TO 900
      IF (KSET.GT.0) GO TO 201
      write(66,2001)
      write(66,2002)
      write(66,2003)
C***DEL:MASSCOMP***
      OPEN (UNIT=IT50,BLANK='ZERO')
C***END:MASSCOMP***
      CALL INLIST
      GO TO 203
  201 CALL FILECL (NSUBST,ITP96,NTEGRA,JNPORT,IBPORT,IFPORT,INPORT)
  203 CONTINUE
C     READ HEADING CARD
      READ (IIN,1000,END=200) CHEAD
      IF (CHEAD(1:4).EQ.'STOP') STOP
      GO TO 202
  200 write(66,2004)
      STOP
  202 READ (IIN,1003) NUMNP,(IDOF(I),I=1,6),IDPIPE,NEGL,NEGNL,MODEX,
     1                NSTE,DT,TSTART,IPDATA,NSUBST,NSKEWS,NMIDSS,NSGNL,
     2                ISTOTE
      IF (NUMNP.EQ.0) STOP
      READ (IIN,1006) IRINT,ITP96,INPORT,JNPORT,IINIMP,ISVFK,IADIN,
     1                MTOTK,LREC,(IDINFO(I),I=1,16),NOALIG
      READ (IIN,1015) NLOAD,NPR2,NPR3,NPBM,NP3DB,NPPL,NPSH,
     1                IDGRAV,NPDIS,NTEMP,NCES,NIDM,NRLINK,NTEGRA,
     1                IDCFGL,IREFOR,IUSERL,IEARTHQ
      READ (IIN,1008) IMASS,IDAMP,IMASSN,IDAMPN,RDVAR(1),RDVAR(2)
      READ (IIN,1010) IEIGG,IESTYP,NFREQ,NQ,NMODE,IFPR
      READ (IIN,1020) IMODS,IOPE,OPVAR(1),OPVAR(2),NMODES,IMDAMP,
     1                IERMSU,IRSPC
      READ (IIN,1005) NSREFB,NEQITB,IMMM,IVVV,IPEQIT,ITOL,ITEMAX,
     1                ETOL,RTOL,RCTOL,STOL,RNORM,RMNORM
      IF (IVVV.EQ.METH(5) .OR. IVVV.EQ.METH(6)) IVVV=METH(2)
      IF (IMMM.EQ.METH(7) .AND. (IVVV.EQ.METH(2) .OR. IVVV.EQ.METH(4)))
     1    GO TO 216
      DO 211 I=1,4
      IF (IVVV.EQ.METH(I)) GO TO 215
  211 CONTINUE
  216 write(66,2301)
      write(66,2391) IMMM,IVVV
      STOP
  215 METHOD=METHAR(I)
      ILNSCH=1
      IF (IMMM.EQ.METH(7) .OR. IVVV.EQ.METH(4)) ILNSCH=0
      IF (METHOD.EQ.4)
     1READ (IIN,1004) NODQ,NDID,DISPM4,ADNOM,ADMAX,ICOMA,IAR
      READ (IIN,1010) IOUTPT,NPRIB,NPB,IDC,IVC,IAC,ISTPRT
      READ (IIN,1011) NPUTSV,NODSVB,LEMSVB,LUPORT,LFPORT,
     1                JDC,JVC,JAC,JTC
      NTGNL = NEGNL + NSGNL
      IF (LREC.LE.0) LREC=3000
      DO 64 I=1,5
   64 LR(I)=LREC
C***DEL:CDY,UDY,CRDY***
      MTOTK=MTOT/1000
C***END:CDY,UDY,CRDY***
      N0 = 1 + NBCST
      IF (KSET.EQ.0) MTOT=MTOT + NBCST
      IF (IADIN.LT.0) IADIN=0
      IF (IADIN.GT.1) IADIN=1
      IINTER=0
      IEIG=0
      IF (IEIGG.EQ.0) GO TO 80
      IF (IEIGG-2) 65,66,67
   66 IF (IESTYP.EQ.0) GO TO 99
      IINTER=1
   65 IEIG=1
      GO TO 80
   67 IEIG=2
      GO TO 80
   99 write(66,3155)
      STOP
   80 IRSPA=0
      NMRESP=NMODES
      IF (IMODS.EQ.2) GO TO 81
      IMODES=IMODS
      IF (IMODES.NE.1 .OR. IERMSU.LT.0) IERMSU=0
      GO TO 82
   81 IRSPA=1
      NMODES=0
      IMODES=0
      IF (IEIG.NE.1 .OR. NMRESP.LE.NFREQ) GO TO 82
      write(66,3157)
      STOP
   82 CONTINUE
      IARINT=IABS(IRINT)
      IF (IARINT.EQ.0 .OR. IARINT.GT.NSTE) IARINT=NSTE
      IF (JNPORT.LE.0 .AND. IRSPA.EQ.1) JNPORT=1
      IF (IEIG.EQ.2) NSTE=2
   13 IF (IRSPA.EQ.0) GO TO 17
      IMODES=0
      IOPE=2
      NDIR=3
      DO 16 I=1,3
   16 NDIR=NDIR - IDOF(I)
      IF (NDIR.EQ.0) write(66,3220)
      IF (NDIR.EQ.0) STOP
      NUMTO=NSREFB + NEQITB
      IF (NUMTO.EQ.0) GO TO 18
      write(66,3201)
      STOP
   18 IF (IEIG.EQ.1) GO TO 17
      write(66,3210)
      STOP
   17 IF (METHOD.NE.4) GO TO 47
      IF (IMASS.EQ.0) GO TO 88
      write(66,3100)
      STOP
   88 IF (NEGNL.GE.1) GO TO 60
      write(66,3110)
      STOP
   60 IF (NSUBST.EQ.0) GO TO 61
      write(66,3310)
      STOP
   61 IF (IDGRAV.EQ.0) GO TO 62
      write(66,3320)
      STOP
   62 IF (NPDIS.EQ.0) GO TO 63
      write(66,3330)
      STOP
   63 IF (IDCFGL.EQ.0) GO TO 91
      write(66,3340)
      STOP
   91 IF (NODQ.GE.1 .AND. NODQ.LE.NUMNP) GO TO 92
      write(66,2301)
      write(66,2392) NODQ
      STOP
   92 IF (NDID.GE.1 .AND. NDID.LE.6) GO TO 93
      write(66,2301)
      write(66,2393) NDID
      STOP
   93 IF (ADNOM .LE. 0.D0) ADNOM=2.D0
      IF (ADMAX .GT. 0.D0) GO TO 94
      write(66,2301)
      write(66,2394) ADMAX
      STOP
   94 N1CRLO=1
      IF (ICOMA.GT.0) N1CRLO=0
   47 IF (NSREFB.EQ.0) GO TO 250
      READ (IIN,1100) ((ISREFB(I,J),I=1,3),J=1,NSREFB)
      IF (NSTE.GT.0 .AND. ISREFB(1,1).EQ.0) ISREFB(1,1)=1
      IF (ISREFB(2,1) .EQ. 0) ISREFB(2,1) = NSTE
      IF (ISREFB(3,1) .EQ. 0) ISREFB(3,1) = 1
      INDEX=1
      IF (NSREFB.LE.1) GO TO 240
      DO 230 I=2,NSREFB
      J=I - 1
      IF (ISREFB(1,J).GT.ISREFB(2,J)) GO TO 235
      IF (ISREFB(1,I).GE.ISREFB(2,J)) GO TO 230
      write(66,3000) BLKNAM(INDEX),I,J
      STOP
  230 CONTINUE
  240 J=NSREFB
      IF (ISREFB(1,J).LE.ISREFB(2,J)) GO TO 245
  235 write(66,3004) BLKNAM(INDEX),J,J
      STOP
  245 IF (ISREFB(2,NSREFB).GE.NSTE) GO TO 250
      write(66,3001) BLKNAM(INDEX),ISREFB(2,NSREFB),NSTE
      STOP
  250 IF (NEQITB.EQ.0) GO TO 350
      READ (IIN,1100) ((IEQITB(I,J),I=1,3),J=1,NEQITB)
      IF (NSTE.GT.0 .AND. IEQITB(1,1).EQ.0) IEQITB(1,1)=1
      IF (IEQITB(2,1) .EQ. 0) IEQITB(2,1) = NSTE
      IF (IEQITB(3,1) .EQ. 0) IEQITB(3,1) = 1
      INDEX=2
      IF (NEQITB.LE.1) GO TO 340
      DO 330 I=2,NEQITB
      J=I - 1
      IF (IEQITB(1,J).GT.IEQITB(2,J)) GO TO 335
      IF (IEQITB(1,I).GE.IEQITB(2,J)) GO TO 330
      write(66,3000) BLKNAM(INDEX),I,J
      STOP
  330 CONTINUE
  340 J=NEQITB
      IF (IEQITB(1,J).LE.IEQITB(2,J)) GO TO 345
  335 write(66,3004) BLKNAM(INDEX),J,J
      STOP
  345 IF (IEQITB(2,NEQITB).GE.NSTE) GO TO 350
      write(66,3001) BLKNAM(INDEX),IEQITB(2,NEQITB),NSTE
      STOP
  350 IF (NPRIB .EQ.0) GO TO 450
      READ (IIN,1100) ((IPRIB(I,J),I=1,3),J=1,NPRIB)
      IF (NSTE.GT.0 .AND. IPRIB(1,1).EQ.0) IPRIB(1,1)=1
      IF ( IPRIB(2,1) .EQ. 0)  IPRIB(2,1) = NSTE
      IF ( IPRIB(3,1) .EQ. 0)  IPRIB(3,1) = 1
      INDEX=3
      IF (NPRIB.LE.1) GO TO 440
      DO 430 I=2,NPRIB
      J=I - 1
      IF (IPRIB(1,J).GT.IPRIB(2,J)) GO TO 435
      IF (IPRIB(1,I).GE.IPRIB(2,J)) GO TO 430
      write(66,3000) BLKNAM(INDEX),I,J
      STOP
  430 CONTINUE
  440 J=NPRIB
      IF (IPRIB(1,J).LE.IPRIB(2,J)) GO TO 445
  435 write(66,3004) BLKNAM(INDEX),J,J
      STOP
  445 IF (IPRIB(2,NPRIB).GE.NSTE) GO TO 450
      write(66,3001) BLKNAM(INDEX),IPRIB(2,NPRIB),NSTE
      STOP