program triax
c
c     construct x,y,z signals from u,v,w (STS2)
c ATTENTION! Due to programmer's laziness the symbols x,y,z and
c u,v,w are interchanged, so editing of triax.f is minimized
c
c   convention for the input and output files:
c   - one header line, up to 72 characters
c   - up to 65 lines signal description and processing log
c     these lines have " }}   " as the first five characters
c     (the processing log is updated by the present program)
c   - one line specifying the number of samples, the format, the samplin
c     interval, and the start time in min and sec after midnight. this
c     line may be repeated after the data when its contents is not known
c     at the time when the file header is written; however the format
c     must always be specified.
c   - data in the specified format
c
      parameter(ndim=12000)
      dimension x(ndim),y(ndim),z(ndim),u(ndim),v(ndim),w(ndim)
      character text*72,rest*16
      character*40 prolog(24)
      character*24 nam1,nam2,nam3
        write(6,'(a)') 'enter filename without extension .u, .v, .w: '
        read(5,'(a)') nam1
      n=ndim
      nam2=trim(nam1)//'.u'
      call input(nam2,text,prolog,npro,n,dtx,tmin,tsec,rest,x)
      nam2=trim(nam1)//'.v'
      call input(nam2,text,prolog,npro,n,dty,tmin,tsec,rest,y)
      nam2=trim(nam1)//'.w'
      call input(nam2,text,prolog,npro,n,dtz,tmin,tsec,rest,z)

      if(n.eq.0.or.dtx.eq.0.) stop 'invalid data file'
      if(dtx.ne.dty.or.dtx.ne.dtz) stop 'different sampling rates'
      dt=dtx
      npro=0

c  transform x,y,z into u,v,w (MEANING OF SYMBOLS IS THE OTHER WAY!)

      call add(x,y,z,u,v,w,n) 

      nam3=trim(nam1)//'.xre'
      call output(nam3,text,prolog,npro,n,dt,tmin,tsec,rest,u)
      nam3=trim(nam1)//'.yre'
      call output(nam3,text,prolog,npro,n,dt,tmin,tsec,rest,v)
      nam3=trim(nam1)//'.zre'
      call output(nam3,text,prolog,npro,n,dt,tmin,tsec,rest,w)

      stop
      end

      subroutine add(x,y,z,u,v,w,n)
      dimension x(n),y(n),z(n),u(n),v(n),w(n)
      w2=sqrt(2.)
      w3=sqrt(3.)
      w6=sqrt(6.)
      aux=-2./w6
      avx=0.
      awx=w2/w6
      auy=1./w6
      avy=w3/w6
      awy=w2/w6
      auz=1./w6
      avz=-w3/w6
      awz=w2/w6
      do 1 i=1,n
        u(i)=aux*x(i)+auy*y(i)+auz*z(i)
        v(i)=avx*x(i)+avy*y(i)+avz*z(i)
    1   w(i)=awx*x(i)+awy*y(i)+awz*z(i)
      return
      end


c     ftn subroutines for reading and writing standard data files
c
      subroutine input(name,text,prolog,npro,n,dt,tmin,tsec,rest,x)
      dimension x(n)
      character iform*20,name*24,text*72,rest*16,pro*80
      character*40 prolog(24)
      write(6,*) 'opening file ',name
      open(7,file=name,status='old')
      read(7,'(a72)') text
      write(6,*) text
      npro=0
   21 read(7,'(a80)') pro
      if(pro(1:1).ne.'%'.and.pro(1:1).ne.'}') goto 20
      npro=npro+1
      if(npro.gt.24) stop 24
      prolog(npro)=pro(6:45)
      goto 21
   20 read(pro,1) nn,iform,dt,tmin,tsec,rest
    1 format(i10,a20,3f10.3,a16)
      write(6,5) name,nn,n
    5 format("file ",a," wird gelesen:",i7," /",i7,
     &" Punkte")
      if(n.lt.nn.or.nn.eq.0) then
      write(6,'("Punktzahl auf",i7," festgesetzt")') n
      nn=n
      endif
      n=nn
      do 97 j=1,n
   97 x(j)=0.d0
      nin=0
      read(7,iform,end=2,err=7) (x(j),j=1,n)
      goto 3
    7 read(7,1,end=2,err=7) n,iform,dt,tmin,tsec,rest
      goto 3
    2 n=j+nin-1
      write(6,'("punkzahl durch datenende bestimmt")')
    3 close(7)
      write(6,'("daten sind eingelesen:",i7," punkte")') n
      return
      end

      subroutine output(name,text,prol,npro,n,dt,tmin,tsec,rest,x)
      dimension x(n)
      character name*24,text*72,iform*20,rest*16
      character*40 prol(24)
      if(npro.gt.24) stop 24
      xmax=0.
      do 2 j=1,n
    2 xmax=max(xmax,abs(x(j)))
      nvor=log10(max(xmax,2.))+1.
      ndec=max(0,10-nvor)
        write(iform,3) ndec
    3   format('(5f13.',i1,')')
      write(6,5) name,n,iform
    5 format('File ',a,' wird geschrieben,',i7,' Punkte im Format ',a)
      open(8,file=name)
        write(8,'(a)') text
        write(8,1) n,iform,dt,tmin,tsec,rest
    1   format(i10,a20,f10.3,2f10.3,a16)
        write(8,iform) (x(j),j=1,n)
      close(8)
      write(6,'("fertig!")')
      return
      end