* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                              ReaPT                              *
*-----------------------------------------------------------------*
*                           VERSION 1.00                          *
*                   Created in 2000 by T.Reinhold                 *
*                                                                 *
*	         Official Release Date: 12.09.2000                *
*  		       Last Update: 12.09.2000	                  *
*                       ("El Barto wuz here!")                    *
*-----------------------------------------------------------------*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
* Dieses kleine Programm liesst die Koordinaten alle Punkte des
* Modells aus und schreibt sie in eine Datei mit Namen "list.txt".
* Diese Datei ist im selben Verzeichnis wie das Modell.
*
* This little program reads the coordinates of all points of the
* current model und writes them into a File named "list.txt".
* This file is saved in the current model-directory.
*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*                       What's new in V1.00?	                  *
*-----------------------------------------------------------------*
*                                                                 *
*  - first release                                                *
*    ADDED TEXT 10.9.2003 Inderbitzin
* *-----------------------------------------------------------------*
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*
                         INTERNAL
*------------------------------------------------------------------
*
   INTEGER	x,
%		mnum init 1,
%       	ier,
%		jadp init 0,  
%		jele,
%      	 	jadf,
%		itypw,
%       	iend,
%		niden,
%		nstk,
%       	n,
%		i,
%               k,
%		ilen,
%		itmop,
%               lmat,
%               nbchar,
%               isize,
%               idir
*
   REAL		origin	FORMAT 8/0,
%		xmat(8),
%		cordx(1000) FORMAT 4/2,
%		cordy(1000) FORMAT 4/2,
%               cordz(1000) FORMAT 4/2,
%               txtpt(3)
*
   CHAR*72 	liden
   CHAR*16 	liden2(250)
   CHAR*72	ddname
   CHAR*70	title
   CHAR*8	title3
   CHAR*8	txt1
   CHAR*8	txt2
   CHAR*8	txt3
   CHAR*8	set
   CHAR*12	item
   CHAR*1       ltxt(80)
   CHAR*72      pttext(1000) FORMAT 72
*
   LOGICAL	ja	INIT true,
%		nein	INIT false
*
*------------------------END INTERNAL------------------------------
*
 	                   EXTERNAL
*------------------------------------------------------------------
*
*
*------------------------END EXTERNAL------------------------------
*
                         PROC
*------------------------------------------------------------------
LABEL Lstart
*
*******************************************************************
*---Read the jele of all PTs---------------------------------------
*******************************************************************
   LET i=0
*     --- Scan the PTs of the model   
   LOAD GUMSEL mnum,3,'*pt',2,1,0,0,nstk,ier
   DO
      LET i=i+1
      LOAD GUSPOP nstk,jele,iend,ier
      BLOCKIF (iend NE 1) THEN
	LOAD GIRMAT mnum,jele,lmat,xmat,ier
	LET cordx(i) = xmat(1)
	LET cordy(i) = xmat(2)
	LET cordz(i) = xmat(3)
	LOAD GIRTEX mnum,jele,1,nbchar,ltxt,txtpt,isize,idir,ier
	  BLOCKIF (nbchar gt 0) THEN
	    LET k=0
	    DO
	      LET k=k+1
	      LET pttext(i)(k:k) = ltxt(k)
	    WHILE (k lt nbchar)

	    DUMP pttext(i)
	  ELSE
	    LET pttext(i) = ' '
	  ENDIF
      ENDIF
   WHILE (iend NE 1)

*
*******************************************************************
*---Read the modelname and its directory---------------------------
*******************************************************************
*  --- Modell-Titel und -Verzeichnis auslesen
   LOAD GIMNAM mnum,ddname,title,ier
*
*******************************************************************
*---Open report-file and write data--------------------------------
*******************************************************************
*  --- Open a file for writing
   LET set=ddname
   LET ilen=80
   LET title3=title
   LET item=title3//'.txt' 
   LET item='list.txt'
   LOAD GUFSOP set,item,1,ilen,itmop,ier
*  --- Write data

   LET x=0
   DO
      LET x=x+1
      LET txt1=CHCONV(cordx(x))
      LET txt2=CHCONV(cordy(x))
      LET txt3=CHCONV(cordz(x))
      LET liden=txt1//'@'//txt2//'@'//txt3//' '//pttext(x)
      IF (x NE i) LOAD GUFSWR set,liden,ier
   WHILE (x NE i)
*  --- Close file
   LOAD GUFSCL set,item,1,ier
END