c
c**********************************************************************
c**********************************************************************
c
c         Verwaltung von verketteten Strukturen (Cray-compatibel)
c         =======================================================
c
c
c
c  Mit diesen Routinen kann man einfach und zweifach verkettete
c  Ring-Strukturen (1- bzw. 2-Strukturen) aufbauen und wieder abbauen.
c  Bei 1-Strukturen muß der Zeiger (integer*4) auf die nächste
c  1-Struktur das erste Strukturelement sein;
c  bei 2-Strukturen müssen der Zeiger auf die vorangegangene
c  2-Struktur das erste, der Zeiger auf die nächste 2-Struktur das
c  zweite Strukturelement sein:
c
c  1-Struktur:
c
c     structure /a/
c       integer*4 next
c       (weitere Felddefinitionen)
c     endstructure
c     record /a/ a
c     pointer (a_,a)
c
c  2-Struktur:
c
c     structure /a/
c       integer*4 back,next
c       (weitere Felddefinitionen)
c     endstructure
c     record /a/ a
c     pointer (a_,a)
c
c  Bei
c
c     i=inew2a_(ianf,l)
c
c  ist ianf der Zeiger auf die aktuelle 2-Struktur; es wird eine neue
c  2-Struktur der Länge l erzeugt und angekettet. Der Funktionswert ist
c  der Zeiger auf die neue 2-Struktur.
c  Der Fall ianf=0 bedeutet das Erzeugen einer ersten 2-Struktur.
c  Bei
c
c     i=inew2b_(ianf,l)
c
c  wird analog zu inew2a_ verfahren, jedoch wird die erzeugte
c  2-Struktur vorgekettet.
c  Bei
c
c     i=inew1a_(ianf,l)
c
c  ist ianf der Zeiger auf die aktuelle 1-Struktur; es wird ein neue
c  1-Struktur der Länge l erzeugt und angekettet. Der Funktionswert ist
c  der Zeiger auf die neue 1-Struktur.
c  Der Fall ianf=0 bedeutet das Erzeugen einer ersten 1-Struktur.
c  Bei
c
c     i=inew1b_(ianf,l)
c
c  wird analog zu inew1a_ verfahren; die erzeugte 1-Struktur wird
c  lediglich vorgekettet.
c  Bei
c
c     i=ifree1a_(ianf)
c
c  wird die 1-Struktur, auf die ianf zeigt, freigegeben; der
c  Funktionswert ist der Zeiger auf die nächste 1-Struktur bzw.
c  gleich 0, falls keine existiert.
c  Bei
c
c     i=ifree1b_(ianf)
c
c  wird die 1-Struktur, auf die ianf zeigt, freigegeben; der
c  Funktionswert ist der Zeiger auf die vorangegangene 1-Struktur
c  bzw. gleich 0, falls keine existiert.
c  Bei
c
c     i=ifree2a_(ianf)
c
c  wird die 2-Struktur, auf die ianf zeigt, freigegeben; der
c  Funktionswert ist der Zeiger auf die nächste 2-Struktur bzw.
c  gleich 0, falls keine existiert.
c  Bei
c
c     i=ifree2b_(ianf)
c
c  wird die 2-Struktur, auf die ianf zeigt, freigegeben; der
c  Funktionswert ist der Zeiger auf die vorangegangene 2-Struktur
c  bzw. gleich 0, falls keine existiert.
c  Ein Beispiel.
c  Die folgende Aufgabe sei gestellt:
c  Die Struktur B enthalte eine ganze, eine reelle (doppelt genaue)
c  Zahl und sei vorwärts zu verketten (n Strukturen).
c  Die ganzen und reellen Zahlen sind fortlaufend - mit 1 beginnend -
c  zu belegen, danach in gleicher Folge zu drucken; die verketteten
c  Strukturen sind wieder freizugeben.
c  Das folgende Programm löst diese Aufgabe.
c
c     program main
c     parameter (n=3)
c     structure /a/
c       integer*4 next,i
c       real*8 x
c     endstructure
c     record /a/ c
c     pointer (c_,c)
c
c     c_=0
c     do k=1,n
c       c_=inew1a_(c_,16)
c       c.i=k
c       c.x=k
c     enddo
c     c_=c.next
c     do while (c_.ne.0)
c       print *, c.i,c.x
c       c_=ifree1a_(c_)
c     enddo
c     end
c
c**********************************************************************
c**********************************************************************
      integer*4 function inew2a_(ianf,l)
      integer*4 ianf,l,i,j
      structure /a/
        integer*4 back,next
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.eq.0)then
        a_=malloc(l)
        a.back=a_
        a.next=a_
      else
        a_=ianf
        j=a.next
        a.next=malloc(l)
        a_=a.next
        a.next=j
        a.back=ianf
        i=a_
        a_=j
        a.back=i
        a_=i
      endif
      inew2a_=a_
      return
      end
c
      integer*4 function inew1a_(ianf,l)
      integer*4 ianf,l,i
      structure /a/
        integer*4 next
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.eq.0)then
        a_=malloc(l)
        a.next=a_
      else
        a_=ianf
        i=a.next
        a.next=malloc(l)
        a_=a.next
        a.next=i
      endif
      inew1a_=a_
      return
      end
c
      integer*4 function inew1b_(ianf,l)
      integer*4 ianf,l
      structure /a/
        integer*4 next
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.eq.0)then
        a_=malloc(l)
        a.next=a_
      else
        a_=ianf
        do while(a.next.ne.ianf)
          a_=a.next
        enddo
        a.next=malloc(l)
        a_=a.next
        a.next=ianf
      endif
      inew1b_=a_
      return
      end
c
      integer*4 function inew2b_(ianf,l)
      integer*4 ianf,l,i,j
      structure /a/
        integer*4 back,next
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.eq.0)then
        a_=malloc(l)
        a.back=a_
        a.next=a_
      else
        a_=ianf
        i=a.back
        a.back=malloc(l)
        a_=a.back
        a.next=ianf
        a.back=i
        j=a_
        a_=i
        a.next=j
        a_=j
      endif
      inew2b_=a_
      return
      end
c
      integer*4 function ifree1a_(ianf)
      integer*4 ianf,i
      structure /a/
        integer*4 next
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.ne.0)then
        a_=ianf
        i=a.next
        if(a.next.eq.ianf)then
          call free(ianf)
          ifree1a_=0
        else
          do while(a.next.ne.ianf)
            a_=a.next
          enddo
          call free(ianf)
          a.next=i
          ifree1a_=i
        endif
      else
        ifree1a_=0
      endif
      return
      end
c
      integer*4 function ifree1b_(ianf)
      integer*4 ianf,i
      structure /a/
        integer*4 next
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.ne.0)then
        a_=ianf
        i=a.next
        if(a.next.eq.ianf)then
          call free(ianf)
          ifree1b_=0
        else
          do while(a.next.ne.ianf)
            a_=a.next
          enddo
          a.next=i
          call free(ianf)
          ifree1b_=a_
        endif
      else
        ifree1b_=0
      endif
      return
      end
c
      integer*4 function ifree2a_(ianf)
      integer*4 ianf,i,j
      structure /a/
        integer*4 back,next
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.eq.0)then
        ifree2a_=0
      else
        a_=ianf
        i=a.back
        j=a.next
        if(j.ne.ianf)then
          a_=i
          a.next=j
          a_=j
          a.back=i
        else
          a_=0
        endif
        call free(ianf)
        ifree2a_=a_
      endif
      return
      end
c
      integer*4 function ifree2b_(ianf)
      integer*4 ianf,i,j
      structure /a/
        integer*4 back,next,anker
      endstructure
      record /a/ a
      pointer(a_,a)
c
      if(ianf.eq.0)then
        ifree2b_=0
      else
        a_=ianf
        i=a.back
        j=a.next
        if(j.ne.ianf)then
          a_=j
          a.back=i
          a_=i
          a.next=j
        else
          a_=0
        endif
        call free(ianf)
        ifree2b_=a_
      endif
      return
      end
