[子程序] 调用f77子程序，里面假定大小的数组在主程序中如何定义

   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