C Subject: For sphere data files c CI Read raw real data and convert to complex data for calculation. PROGRAM CALPREP COMPLEX*8 TARGET(2,20,3,4,21) REAL GCENT(3),GSPAN(3),RAW(42) INTEGER NPTS,NTRACE,MEASFLAG(3) real kgateleft,kgateright CHARACTER FILENAME(4)*40,dscrp*4,TYPE*1 character*80 file1,file2 complex refav(3,4,21),cj real magav(3,4,21),phav(3,4,21),phas(20,3,4,21) real phdifvv(20,3,21),phdifhv(20,3,21),rav(3,4),avm(3,4) c nf=3 IF = 1 nf = 1 np=4 CI print*,'Enter name of mnt cal file:' read(*,'(a40)')filename(1) c file1 = filename(1) print*,'Enter name of ref cal file:' read(*,'(a40)')filename(2) c file2 = filename(2) c OPEN(13,FILE=filename(1)) OPEN(14,FILE=filename(2)) c OPEN(unit=13,FILE=file1) c OPEN(unit=14,FILE=file2) c print*,'Enter 4-letter descriptor for output files:' read(*,'(a4)')dscrp c c c Read data c READ(13,*) NTRACE,NFREQ,KGATELEFT,KGATERIGHT READ(14,*) NTRACE,NFREQ,KGATELEFT,KGATERIGHT c2000 format(1x,i2,12x,i1,13x,f5.1,9x,f5.1) c PRINT *,NPTS,NTRACE,MEASFLAG,GCENT,GSPAN c ndata=NPTS IF (NFREQ.EQ.1)THEN TYPE = 'l' ELSEIF(NFREQ.EQ.2)THEN TYPE = 'c' ELSE TYPE = 'x' ENDIF ndata=21 NPTS =21 ntr=NTRACE DO 25, I = 1,3 25 MEASFLAG(I)=0 C measflag(NFREQ) = 1 c II = 1 DO 10 IT=1,NTRACE c II=0 c DO 10 IF=1,3 c IF (MEASFLAG(IF).EQ.1) THEN c II=II+1 DO 12 IP=1,4 READ(13,*) (RAW(K),K=1,NPTS*2) DO 14 J=1,NPTS J2=J*2-1 14 TARGET(1,IT,II,IP,J)=CMPLX(RAW(J2),RAW(J2+1)) READ(14,*) (RAW(K),K=1,NPTS*2) DO 16 J=1,NPTS J2=J*2-1 TARGET(2,IT,II,IP,J)=CMPLX(RAW(J2),RAW(J2+1)) TARGET(2,IT,II,IP,J)=TARGET(2,IT,II,IP,J) & -TARGET(1,IT,II,IP,J) 16 continue 12 CONTINUE c END IF 10 CONTINUE CLOSE(13) CLOSE(14) c c Average complex values c do 55 if=1,nf do 55 ip=1,np rav(if,ip)=0. avm(if,ip)=0. do 55 id=1,ndata refav(if,ip,id)=(0.,0.) phav(if,ip,id)=0. magav(if,ip,id)=0. 55 continue c do 60 if=1,nf do 60 ip=1,np do 60 id=1,ndata do 70 it=1,ntr refav(if,ip,id)=refav(if,ip,id)+target(2,it,if,ip,id)/ntr magav(if,ip,id)=magav(if,ip,id)+cabs(target(2,it,if,ip,id))/ntr phas(it,if,ip,id)=phase(target(2,it,if,ip,id)) c phav(if,ip,id)=phav(if,ip,id)+phas(it,if,ip,id)/ntr c 70 continue 60 continue c c Average magnitude values c do 75 if=1,nf do 75 ip=1,np do 72 id=4,ndata-3 avm(if,ip)=avm(if,ip)+cabs(refav(if,ip,id))/(ndata-6) 72 rav(if,ip)=rav(if,ip)+magav(if,ip,id)/(ndata-6) rav(if,ip)=20.*alog10(rav(if,ip)) avm(if,ip)=20.*alog10(avm(if,ip)) 75 continue do 80 if=1,nf do 80 id=1,ndata do 80 it=1,ntr phdifvv(it,if,id)=phas(it,if,2,id)-phase(refav(if,2,id)) phdifhv(it,if,id)=phas(it,if,1,id)-phase(refav(if,1,id)) 80 continue c c Open files for output c filename(1) = dscrp//'_ref'//'.'//TYPE C filename(2) = dscrp//'_ref_c' C filename(3) = dscrp//'_ref_x' filename(4) = dscrp//'VIEW'//'.'//TYPE open(16,file=filename(1)) c open(17,file=filename(2)) c open(18,file=filename(3)) open(19,file=filename(4)) c c Print out c do 90 if=1,nf do 90 ip=1,np write(15+if,*) 'p= ',ip do 90 id=1,ndata write(15+if,*) refav(if,ip,id) 90 continue ci c Print out for reference only c write(19,*) ' HV VV HH VH' C do 96 if=1,nf if = 1 write(19,*) 'F= ',NFREQ do 97 id=1,ndata 97 write(19,220)id,(20.*alog10(magav(if,ip,id)),ip=1,4) write(19,1000)(rav(if,ip),ip=1,4) write(19,1001)(avm(if,ip),ip=1,4) 1000 FORMAT(1X,'AV. OF ABS=',3X,4(F9.4,'dB',3X)) 1001 FORMAT(1X,'ABS. OF AV=',3X,4(F9.4,'dB',3X)) 96 continue write(19,*) 'Phase difference(VV) for',TYPE,' at id =6,16' do 98 it=1,ntr write(19,200) it,(phdifvv(it,if,6),if=1,nf) & ,(phdifvv(it,if,16),if=1,nf) 98 continue write(19,*) 'Phase difference(HV) for',TYPE,' at id =6,16' do 99 it=1,ntr write(19,200) it,(phdifhv(it,if,6),if=1,nf) & ,(phdifhv(it,if,16),if=1,nf) 99 continue 200 format('#tr=',i2,2(3x,3f8.2)) 220 format(i3,1x,4(f7.2,1x)) CLOSE(16) c CLOSE(17) c CLOSE(18) CLOSE(19) STOP END C******************************************************************* C FUNCTION PHASE(Z) C C****************************************************************** COMPLEX Z PI=4.*ATAN(1.) X=REAL(Z) Y=AIMAG(Z) PHASE=(180./PI)*ATAN2(Y,X)+180. c PHASE=(180./PI)*ATAN(Y/X)+180. RETURN END C Above is for sphere data file. This program has a lot of junk lines C which can be deleted. C Next is for Sky data files.