[Fortran] 纯文本查看 复制代码
subroutine comsca(iknoel,ipodia,indexj,ivor ,necke,
& nknot ,nelem ,mknpel,laenge,nitot,miwrk)
implicit double precision(a-h,o-z)
dimension iknoel(mknpel,nelem),necke(nelem),
& ipodia(nknot),indexj(*),ivor(*)
do i=1,nknot
ipodia(i)=0
end do
c Schleife ueber alle Elemente
ipos=0
do iel=1,nelem
ne=necke(iel)
c Doppelschleife (iem,jem) ueber lokale Element-Fhgr., um globale
c besetzte Positionen (i,j) zu finden
c ipodia(i) : wird als Hilfsfeld benutzt; zeigt auf die Pos. des
c zuletzt gefundenen Eintrages der Zeile i
c ivor(ip) : zeigt auf den vorherigen Eintrag der gleichen Zeile
do iem=1,ne
i=iknoel(iem,iel)
do jem=1,ne
j=iknoel(jem,iel)
if(j.gt.i) goto 30
c Suche in Zeile i, ob Spalte j schon vorhanden
ip=ipodia(i)
20 continue
if(ip.ne.0)then
if(indexj(ip).eq.j) goto 30
ip=ivor(ip)
goto 20
end if
c neue Spalte fuer Zeile i gefunden
ipos=ipos+1
if (ipos+nitot.gt.miwrk) stop'comsto: miwrk vergroessern'
indexj(ipos)=j
ivor(ipos)=ipodia(i)
ipodia(i)=ipos
30 continue
end do
end do
end do
laenge=ipos
c indexj am Ende von ivor aufbauen und anschliessend
c nach indexj zurueckkopieren
do i=1,nknot
ip=ipodia(i)
if(ip.eq.0) stop 'Leere Zeile in comsto'
nj=0
40 continue
if(ip.ne.0)then
nj=nj+1
ivor(ipos+nj)=indexj(ip)
ip=ivor(ip)
goto 40
end if
call iasort(ivor(ipos+1),nj)
ipos=ipos+nj
ipodia(i)=ipos-laenge
if(ivor(ipos).ne.i) stop 'comsto: falsches Diagonalelement'
end do
do ip=1,laenge
indexj(ip)=ivor(ip+laenge)
end do
return
end