subroutine savetf2(id,nsave,ntime,nutc,savedir) #ifdef CVF use dfport #endif parameter (NZ=60*96000) parameter (NSPP=174) parameter (NPKTS=NZ/NSPP) integer*2 id(4,NZ) real*4 ss(NPKTS),ss2(60) real*8 dt,t,t2 character*80 savedir,fname character cdate*8,ctime2*10,czone*5 integer it(9),itt(8) if(nsave.eq.1) then n2=ntime/60 n3=(n2-1)*60 #ifdef CVF call gmtime(n3,it) it(5)=it(5)+1 #else call date_and_time(cdate,ctime2,czone,itt) it(6)=itt(1) it(5)=itt(2) it(4)=itt(3) it(3)=itt(5)-itt(4)/60 if(it(3).lt.0) it(3)=it(3)+24 if(it(3).ge.24) it(3)=it(3)-24 it(2)=itt(6) ! it(1)=itt(7) it(1)=0 #endif it(6)=mod(it(6),100) write(fname,1000) (it(j),j=6,2,-1) 1000 format('/',3i2.2,'_',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) write(17) id close(17) #else open(17,file=fname,status='unknown',form='unformatted', & access='direct',recl=nbytes,err=998) write(17,rec=1) id close(17) #endif else dt=NSPP/96000.d0 t=0.d0 nh=nutc/100 nm=mod(nutc,100) t2=3600*nh + 60*nm fac=1.0/(4.0*NSPP) do i=1,NPKTS s=0. do n=1,NSPP s=s + float(int(id(1,i)))**2 + float(int(id(2,i)))**2 + & float(int(id(3,i)))**2 + float(int(id(4,i)))**2 enddo ss(i)=fac*s t=t+dt t2=t2+dt if(nsave.eq.3) write(24,1010) t,t2,ss(i) 1010 format(f9.6,f15.6,f10.3) enddo if(nsave.eq.2) then dt2=551*dt t=0.d0 t2=3600*nh + 60*nm k=0 do i=1,60 s=0. ns=0 do n=1,551 k=k+1 s=s + ss(k) if(ss(k).gt.0.0) ns=ns+1 enddo ss2(i)=s/ns t=t+dt t2=t2+dt2 write(25,1010) t,t2,ss2(i) enddo endif endif go to 999 998 print*,'Cannot open file:' print*,fname 999 return end subroutine savetf2