program testsig3 c c Generation of triangular test signals. c parameter(ndim= 66000 ) c real*4 x(ndim) character name*10,par*20,text*35,noisfi*10,ja character*50 prolog(64) data par/' '/ text=' Test signal' write(6,*) text 6 write(6,*) 'Filename for the test signal?' read(5,'(a)') name write(6,*) 'Number of samples?' read(5,*) n if(n.gt.ndim) stop write(6,*) 'Sampling interval?' read(5,*) dt zpi=8.*atan(1.) npro=0 do 4 j=1,n 4 x(j)=0. 1 write(6,*) 'Triangle. Period? [0=no more]:' read(5,*) per write(6,*) 'Amplitude?' read(5,*) amp npro=npro+1 write(prolog(npro),5) per,amp 5 format('% triangle per=',f10.3,' amp=',f10.3) np=nint(per/dt) nh=nint(per/dt/2.) nv=nint(per/dt/4.) do 3 j=1,nv t=(j-1)*dt 3 x(j)=amp*t/per*4. do 8 j=nv+1,n m=mod(j+np-nv,np) if(m.le.nh) then x(j)=amp*(1.-2.*m/nh) else x(j)=amp*(2.*m/nh-3.) endif 8 continue 7 write(6,'(a)') 'format? =(8f9.3):' read(5,'(a20)') par call output(name,prolog,npro,par,text,n,dt,x) write(6,'(a)') 'Done. Another signal? (y/n)' read(5,'(a)') ja if(ja.eq.'y') goto 6 stop end subroutine output(name,prolog,npro,par,text,n,dt,x) real*4 x(n) character name*10,text*35,par*20,iform*20 character*50 prolog(64) iform='(5f12.3) ' if(par(1:1).eq.'(') read(par,'(a20)') iform write(6,5) name,iform 5 format('Signal is written into file ',a10/' format: ',a20) open(8,file=name) write(8,'(a)') text do j=1,npro write(8,'(a)') prolog(j) enddo write(8,1) n,iform,dt 1 format(i10,a20,3f10.3,2i5,a10) write(8,iform) (x(j),j=1,n) close(8) return end