WSJT-X/savetf2.F90

subroutine savetf2(id,fnamedate,savedir)

  parameter (NZ=60*96000)
  parameter (NSPP=174)
  parameter (NPKTS=NZ/NSPP)
  integer*2 id(4,NZ)
  character*80 savedir,fname
  character cdate*8,ctime2*10,czone*5,fnamedate*6
  integer  itt(8)

  call date_and_time(cdate,ctime2,czone,itt)
  nh=itt(5)-itt(4)/60
  nm=itt(6)
  ns=itt(7)
  if(ns.lt.50) nm=nm-1
  if(nm.lt.0) then
     nm=nm+60
     nh=nh-1
  endif
  if(nh.lt.0) nh=nh+24
  if(nh.ge.24) nh=nh-24
  write(fname,1001) fnamedate,nh,nm
1001 format('/',a6,'_',2i2.2,'.tf2')
  do i=80,1,-1
     if(savedir(i:i).ne.' ') go to 1
  enddo
1 iz=i
  fname=savedir(1:iz)//fname
#ifdef CVF
  open(17,file=fname,status='unknown',form='binary',err=998)
#else
  open(17,file=fname,status='unknown',access='stream',err=998)
#endif

!  write(17,err=997) id
  do i=1,1024
     i0=(i-1)*5625 + 1
     call w17(id(1,i0),ierr)
     if(ierr.ne.0) print*,'Error writing tf2 file'
  enddo

  close(17)
  go to 999

!997 print*,'Error writing tf2 file'
!  print*,fname
!  go to 999

998 print*,'Cannot open file:'
  print*,fname

999 return
end subroutine savetf2

subroutine w17(id,ierr)
  integer*2 id(4,5625)
  write(17,err=998) id
  ierr=0
  go to 999
998 ierr=1
999 return
end subroutine w17