2 ! OUTPUT 2 USING "#,K";"�#INDENT<cr>REN 2,2<cr><lf>RE-STORE ""LIB""<cr>"
4 !
6 !The main section of this program is a 'scratchpad' area for
8 ! testing new additions to the LIBrary set of routines
10 !
12 Lib_lib
14 INTEGER I1,I2,I3,I4,Nan
16 WHILE 1
18 INPUT "GIMME 4 integers ",I1,I2,I3,I4
20 CALL Lib_64_to_float(I1,I2,I3,I4,Num,Nan)
22 IF Nan THEN
24 PRINT "NAN WAS SET:";I1,I2,I3,I4
26 ELSE
28 PRINT "NUM :";Num;I1,I2,I3,I4
30 END IF
32 END WHILE
34 !
36 END
38 !
40 ! PAGE ->
42 !********************************************************************
44 Lib_lib:SUB Lib_lib
46 !************************************************************************
48 !* This routine contains all the commons used in the all the library
50 !* routines. It is needed by the application loader to handle commons.
52 !************************************************************************
54 COM /Lib_c1_lbl_info/ Input_labels$(1:63)[20],Source_labels$(1:63)[20]
56 COM /Lib_c1_overload/ INTEGER Ovld_buffer(1:63)
58 COM /Lib_c1_blk_ids/ REAL Icode_id,Input_buffer_id,Module_list_id,Ovld_buffer_id
60 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$[20]
62 COM /Lib_c1_src_info/ REAL Num_sources,Cal_src_label$[20]
64 COM /Lib_c1_icode_cd/ Source$(0:100)[80],INTEGER Object(0:100)
66 COM /Lib_c1_icode_fo/ Info$(0:20)[40]
68 COM /Lib_c1_dft_coef/ REAL Dft_coef_real(0:255,1:20),Dft_coef_imag(0:255,1:20)
70 COM /Lib_c1_cal_con/ REAL Calcon_real(1:63,1:20),Calcon_imag(1:63,1:20)
72 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(-1:20),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
74 COM /Lib_c1_first/ INTEGER Runned_yet
76 COM /Lib_c1_cal_data/ REAL Error_mag(1:63,-1:20),Error_phase(1:63,-1:20),Mag_deriv(1:63,-1:20),Phase_deriv(1:63,-1:20),Freq(-1:20)
78 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
80 !
82 SUBEXIT
84 SUBEND
86!
88 Lib_float_to_64:SUB Lib_float_to_64(Float,INTEGER I1,I2,I3,I4)
90 !
92 !Converts an IEEE 64-bit floating point number
94 ! into its 4 16-bit integers. Used by the Icode Assembler
96 !
98 ASSIGN @Buff TO BUFFER [8];FORMAT OFF !8 bytes / fp word
100 OUTPUT @Buff;Float
102 ENTER @Buff;I1,I2,I3,I4
104 SUBEND
106 !
108 ! PAGE ->
110 !********************************************************************
112 Lib_fft_coefs:SUB Lib_fft_coefs(INTEGER Coef_table(*))
114 !
116 ! This routine generates a 1/2 sine and 1/2 cos table in the
118 !array Coef_table, for use by the default FFT algorithm supplied
120 !in HP35651A ROM.
122 !
124 IF SIZE(Coef_table,1)<>4096 THEN CALL User_stop("Error in Lib_fft_coefs--FFT Coefficient array must be 4096 elements long")
126 ON ERROR GOTO No_coef_file
128 ASSIGN @Cfile TO FNLib_full_path$("FFT_COEFS");FORMAT OFF
130 ENTER @Cfile;Coef_table(*)
132 SUBEXIT
134 No_coef_file:!
136 DISP "Generating FFT coefficients (could not find file), be patient"
138 OFF ERROR
140 RAD
142 Angle=2*PI/4096
144 FOR I=0 TO 4095 STEP 2
146 J=I/2
148 Coef_table(I)=32767*COS(J*Angle)
150 Coef_table(I+1)=32767*SIN(J*Angle)
152 NEXT I
154 DISP ""
156 SUBEND
158 !
160 ! PAGE ->
162 !********************************************************************
164 Lib_sizeof:DEF FNLib_sizeof(INTEGER Array(*))
166 !
168 !This routine returns the total number of an elements in an integer
170 ! array. (Depends on SIZE and RANK)
172 !
174 Num_elements=1
176 FOR I=1 TO RANK(Array)
178 Num_elements=Num_elements*SIZE(Array,I)
180 NEXT I
182 RETURN Num_elements
184 FNEND
186 !
188 ! PAGE ->
190 !********************************************************************
192 Lib_fsizeof:DEF FNLib_fsizeof(Array(*))
194 !
196 !This routine returns the total number of an elements in a floating point
198 ! array. (Depends on SIZE and RANK)
200 !
202 Num_elements=1
204 FOR I=1 TO RANK(Array)
206 Num_elements=Num_elements*SIZE(Array,I)
208 NEXT I
210 RETURN Num_elements
212 FNEND
214 !
216 ! PAGE ->
218 !********************************************************************
220 Lib_read_bin:SUB Lib_read_bin(File_name$,INTEGER File(*),Stop_on_err)
222 !
224 ! This routine reads a binary data file into an integer array
226 !
228 DIM Msg$[80]
230 ON ERROR GOTO Handle_problems
232 ASSIGN @File TO FNLib_full_path$(File_name$);FORMAT OFF
234 ENTER @File;File(*)
236 SUBEXIT
238 Handle_problems:!
240 OFF ERROR
242 Msg$=ERRM$
244 IF Stop_on_err THEN
246 CALL User_stop("***Problem in Lib_read_bin: "&Msg$&"***")
248 ELSE
250 CALL User_error("***Problem in Lib_read_bin: "&Msg$&"***")
252 END IF
254 SUBEND
256 !
258 ! PAGE ->
260 !********************************************************************
262 Lib_match1:SUB Lib_match1(Item$,Choices$(*),Found,Choice_num)
264 !************************************************************************
266 !* Searches for "Item$" in "Choices$(*)" and returns its location in
268 !* choice_num. Choices$ must have a rank of 1.
270 !************************************************************************
272 INTEGER C_start,C_stop
274 C_start=BASE(Choices$,1)
276 C_stop=C_start+SIZE(Choices$,1)-1
278 Found=0
280 IF Item$<>"" THEN
282 GOSUB Try_exact
284 IF NOT Found THEN GOSUB Try_close
286 IF NOT Found THEN GOSUB Try_anything
288 END IF
290 SUBEXIT
292 !
294 Try_exact: !
296 Choice_num=C_start-1
298 REPEAT
300 Choice_num=Choice_num+1
302 IF Item$=Choices$(Choice_num) THEN Found=1
304 UNTIL (Choice_num>=C_stop) OR Found
306 RETURN
308 !
310 Try_close: !
312 Choice_num=C_start-1
314 REPEAT
316 Choice_num=Choice_num+1
318 IF TRIM$(UPC$(Item$))=TRIM$(UPC$(Choices$(Choice_num))) THEN Found=1
320 UNTIL (Choice_num>=C_stop) OR Found
322 RETURN
324 !
326 Try_anything: !
328 C=C_start-1
330 Best_p=100 !keeps track of the position of the best match
332 REPEAT
334 C=C+1
336 P=POS(TRIM$(UPC$(Choices$(C))),TRIM$(UPC$(Item$)))
338 IF P>0 THEN
340 Found=1
342 IF P<Best_p THEN !this one is better
344 Best_p=P
346 Choice_num=C
348 END IF
350 END IF
352 UNTIL (C>=C_stop)
354 RETURN
356 !
358 SUBEND
360 ! PAGE ->
362 !********************************************************************
364 Lib_match2:SUB Lib_match2(Item$,Choices$(*),Category,Found,Choice_num)
366 !searches for "Item$" in "Choices$(category,*)" and returns its location.
368 !Choices$ must have a rank of 2.
370 !********************************************************************
372 INTEGER C_start,C_stop
374 C_start=BASE(Choices$,2)
376 C_stop=C_start+SIZE(Choices$,2)-1
378 Found=0
380 IF Item$<>"" THEN
382 GOSUB Try_exact
384 IF NOT Found THEN GOSUB Try_close
386 IF NOT Found THEN GOSUB Try_anything
388 END IF
390 SUBEXIT
392 Try_exact: !-----------------------------------------------
394 Choice_num=C_start-1
396 REPEAT
398 Choice_num=Choice_num+1
400 IF Item$=Choices$(Category,Choice_num) THEN Found=1
402 UNTIL (Choice_num>=C_stop) OR Found
404 RETURN
406 Try_close: !-----------------------------------------------
408 Choice_num=C_start-1
410 REPEAT
412 Choice_num=Choice_num+1
414 IF TRIM$(UPC$(Item$))=TRIM$(UPC$(Choices$(Category,Choice_num))) THEN Found=1
416 UNTIL (Choice_num>=C_stop) OR Found
418 RETURN
420 Try_anything: !-----------------------------------------------
422 C=C_start-1
424 Best_p=100 !keeps track of the position of the best match
426 REPEAT
428 C=C+1
430 P=POS(TRIM$(UPC$(Choices$(Category,C))),TRIM$(UPC$(Item$)))
432 IF P>0 THEN
434 Found=1
436 IF P<Best_p THEN !this one is better
438 Best_p=P
440 Choice_num=C
442 END IF
444 END IF
446 UNTIL (C>=C_stop)
448 RETURN
450 SUBEND
452 ! PAGE ->
454 !************************************************************************
456 Lib_full_path:DEF FNLib_full_path$(Filename$)
458 ! This function tries to return the full path name of a file.
460 ! Tries the filename itself first, then tries several combinations
462 ! of prefixes and suffixes. The end user will probably want to change
464 ! these to path names suitable for his/her location.
466 !
468 DIM Try_path$[160]
470 !
472 DIM Prefix$(0:1)[80]
474 DIM Suffix$(0:6)[80]
476 !
478 !change the next lines to appropriate prefixes
480 Prefix$(0)="" !the most likely prefix?
484 Prefix$(1)="" !yet another prefix
486 !
488 Suffix$(0)=""
493 Suffix$(1)=":,702,0"
494 Suffix$(2)=":,702,1"
495 Suffix$(3)=":,703,0"
496 Suffix$(4)=":,703,1"
497 Suffix$(5)=":INTERNAL,4,0"
498 Suffix$(6)=":INTERNAL,4,0"
500 !
501 FOR J=0 TO 6
502 FOR I=0 TO 1
503 Try_path$=Prefix$(I)&Filename$&Suffix$(J)
504 ASSIGN @File TO Try_path$;RETURN Error_code
505 SELECT Error_code
506 CASE 0,58 !No error, Improper File Type: We found it
507 RETURN Try_path$
519 CASE 52,56,62,72,76,80,82,93 !Errors to ignore
520 CASE ELSE
522 User_error("***In Lib_full_path$: "&VAL$(Error_code)&" ***")
524 RETURN ""
526 END SELECT
528 NEXT I
530 NEXT J
532 User_error("***Lib_full_path$: "&Filename$&" not found ***")
534 RETURN ""
536 FNEND
538 !
540 ! PAGE ->
542 !************************************************************************
544 Lib_64_to_float:SUB Lib_64_to_float(INTEGER I1,I2,I3,I4,REAL Float,OPTIONAL INTEGER Nan)
546 !
548 ! Converts 4 16-bit integers into a 64-bit IEEE floating point number.
550 !The optional parameter Nan is set if the 4 16 bit numbers are not a valid
552 !IEEE number.
554 Nan=0
556 ASSIGN @Buff TO BUFFER [8];FORMAT OFF !8 bytes / fp word
558 OUTPUT @Buff;I1,I2,I3,I4
560 ON ERROR GOTO Set_nan
562 ENTER @Buff;Float
564 Tmp$=VAL$(Float) !Need to cause an error if illegal number
566 SUBEXIT
568 Set_nan:OFF ERROR
570 Nan=1
572 SUBEND
574 !
576 ! PAGE ->
578 !********************************************************************
580 Lib_32_to_16:SUB Lib_32_to_16(Val32bit,INTEGER Ihigh,Ilow)
582 !
584 ! Converts the floating point value in Val32bit (in range -2^31 to
586 ! 2^31 - 1 ) to 2 integers: Ihigh with the upper 16 bits and Ilow
588 ! with the lower 16 bits of the 2's complement representation.
590 !
592 Float_temp=Val32bit
594 Neg=0
596 IF Float_temp=0 THEN
598 Neg=1
600 Float_temp=-Float_temp
602 Float_temp=Float_temp-1
604 END IF
606 Ihigh=INT(Float_temp/65536)
608 Float_temp=Float_temp-Ihigh*65536
610 IF Float_temp>32767 THEN
612 Ilow=INT(Float_temp-32768)
614 Ilow=BINEOR(Ilow,-32768)
616 ELSE
618 Ilow=Float_temp
620 END IF
622 IF Neg=1 THEN
624 Ihigh=BINCMP(Ihigh)
626 Ilow=BINCMP(Ilow)
628 END IF
630 SUBEND
632 !
634 !***********************************************************************
636 ! PAGE ->
638 Lib_16_to_32:SUB Lib_16_to_32(INTEGER In_high,In_low,REAL F)
640 !
642 ! Converts a 32 bit, 2'S Complement INTEGER (represented by 2 16 bit
644 ! values In_high and In_low) into a real variable.
646 !
648 INTEGER Ihigh,Ilow
650 F=0
652 Ihigh=In_high
654 Ilow=In_low
656 IF BIT(Ihigh,15)=0 THEN
658 IF BIT(Ilow,15) THEN
660 F=32768
662 Ilow=BINAND(Ilow,32767)
664 END IF
666 F=F+Ilow
668 F=F+Ihigh*65536
670 ELSE
672 F=BINCMP(Ihigh)*65536
674 Ilow=BINCMP(Ilow)
676 IF BIT(Ilow,15)=1 THEN
678 F=F+32768
680 Ilow=BINAND(Ilow,32767)
682 END IF
684 F=-(F+Ilow+1)
686 END IF
688 SUBEND
690 ! PAGE ->
692 !***********************************************************************
694 Lib_df_mag:SUB Lib_df_mag(Span,Df_mag(*),Zoom)
696 !
698 ! This subprogram generates a magnitude squared spectrum of the
700 ! digital filter response for a given span and whether zoom is
702 ! enabled or not. Span is the span to generate the spectrum
704 ! for, it should the same as what is returned from the input
706 ! module (ie: 51200, 25600, ...). Zoom is a boolean that
708 ! indicates whether the spectrum should be for a zoomed
710 ! measurement or not. The result is returned in the Df_mag
712 ! array. Df_mag should be a power of 2 in size.
714 !
716 Table_size=8
718 ALLOCATE Coef(1:Table_size,0:4)
720 INTEGER Blk_ptr,Strt_blk,End_blk
722 !
724 ! The algorithm used is a cubic spline that was generated using
726 ! a least squares fit to the actual response. The maximum
728 ! error is .002 dB over the entire response, for any span
730 ! and zoom combination. Note there is a separate set of
732 ! cubic spline coeffecients for each span.
734 !
736 Dec=INT(.5+LGT(204800/Span)/LGT(2))
738 IF NOT Zoom THEN Dec=Dec-1
740 IF Dec<1 THEN
742 MAT Df_mag= (1)
744 SUBEXIT
746 END IF
748 !
750 FOR Sp=1 TO Dec
752 READ Coef(*)
754 NEXT Sp
756 !
758 Strt_blk=BASE(Df_mag,1)
760 Bsiz=SIZE(Df_mag,1)
762 End_blk=Bsiz+Strt_blk-1
764 Zoom_ptr=End_blk
766 IF Zoom THEN End_blk=Bsiz DIV 2+Strt_blk
768 Eff_bsiz=2^INT(.9+LGT(Bsiz)/LGT(2))
770 IF Zoom THEN Eff_bsiz=Eff_bsiz DIV 2
772 Step_size=4096 DIV Eff_bsiz
774 !
776 Filter_pos=1
778 Spline_pos=1
780 GOSUB Lib_mag_new
782 FOR Blk_ptr=Strt_blk TO End_blk
784 IF Filter_pos>End_spline THEN
786 Spline_pos=Spline_pos+1
788 GOSUB Lib_mag_new
790 END IF
792 Df_mag(Blk_ptr)=((C3*Filter_pos+C2)*Filter_pos+C1)*Filter_pos+C0
794 IF Zoom THEN
796 Df_mag(Zoom_ptr)=Df_mag(Blk_ptr)
798 IF Blk_ptr<>Strt_blk THEN Zoom_ptr=Zoom_ptr-1
800 END IF
802 Filter_pos=Filter_pos+Step_size
804 NEXT Blk_ptr
806 !
808 SUBEXIT
810 Lib_mag_new: !
812 IF Spline_pos<>1 THEN
814 Filter_pos=Filter_pos-End_spline
816 END IF
818 C0=Coef(Spline_pos,1)
820 C1=Coef(Spline_pos,2)
822 C2=Coef(Spline_pos,3)
824 C3=Coef(Spline_pos,4)
826 IF Spline_pos<Table_size THEN
828 End_spline=Coef(Spline_pos+1,0)-Coef(Spline_pos,0)
830 ELSE
832 End_spline=10000
834 END IF
836 RETURN
838 !
840 ! The following data statements contain the cubic spline coefficients
842 ! for each span. Each span starts with a comment indicating the
844 ! number of passes of decimation for that span.
846 !
848 ! DECIMATE 1
850 DATA 1,.999766430811,3.02963721716E-6,-2.50640013287E-8,8.86338113035E-12
852 DATA 1578,.977337122921,-1.07122744771E-5,3.7772663643E-8,-5.46798833247E-12
854 DATA 2457,.993376255497,2.96214303106E-5,5.08105357979E-8,-2.54081025385E-10
856 DATA 2974,.986891649155,-.000129553756512,-4.20560604932E-7,-6.30585213632E-10
858 DATA 3430,.780620133168,-.000886933343419,-1.33264170258E-6,1.14508427048E-9
860 DATA 3671,.505623684407,-.00132122235079,-3.25137297129E-7,2.54136221169E-9
862 DATA 3906,.210143374002,-.0010610201331,1.46134235195E-6,3.96518868199E-10
864 DATA 4046,.0913129248093,-.000631572199697,1.54095139417E-6,-9.77855800889E-10
866 ! DECIMATE 2
868 DATA 1,.999766626573,3.08660318082E-6,-2.94539696104E-8,9.36348634869E-12
870 DATA 1554,.968952704046,-2.12861820344E-5,3.43803604713E-8,-2.96505045294E-12
872 DATA 2447,.975232552814,2.00681274904E-5,5.30830062012E-8,-2.39272252783E-10
874 DATA 2967,.96612224035,-.00012695097473,-3.91369468514E-7,-6.15728198712E-10
876 DATA 3430,.762378772997,-.000866339086494,-1.29524451214E-6,1.10907380213E-9
878 DATA 3671,.494010478932,-.001289091635,-3.18613994281E-7,2.47512397405E-9
880 DATA 3907,.204553895162,-.00103379369398,1.427706668E-6,3.78332812741E-10
882 DATA 4047,.0888264308864,-.000614747351766,1.5015949001E-6,-9.53390394518E-10
884 ! DECIMATE 3
886 DATA 1,.999766604398,3.09327471421E-6,-3.0505338504E-8,9.41835227329E-12
888 DATA 1553,.966655470186,-2.4181700245E-5,3.34894459254E-8,-2.94502379346E-12
890 DATA 2447,.96968172357,1.5741034904E-5,5.19748583174E-8,-2.37294370969E-10
892 DATA 2968,.958175091781,-.000131278463043,-3.90815767515E-7,-6.05527708749E-10
894 DATA 3430,.754442092585,-.000861273855945,-1.2770094793E-6,1.10169508932E-9
896 DATA 3671,.488248420978,-.00127663786235,-3.07926268592E-7,2.44409496751E-9
898 DATA 3906,.20293439894,-.00102415284766,1.41030364776E-6,3.81099243163E-10
900 DATA 4046,.0882233738051,-.000609788651499,1.48669230292E-6,-9.42304190568E-10
902 ! DECIMATE 4
904 DATA 1,.999766614578,3.09430610268E-6,-3.07650581249E-8,9.42761751979E-12
906 DATA 1553,.966065788414,-2.49223808635E-5,3.32538304122E-8,-2.96568556566E-12
908 DATA 2447,.968226360295,1.45621941059E-5,5.15368137784E-8,-2.36664620068E-10
910 DATA 2968,.956075882638,-.000132339435902,-3.90271098042E-7,-6.02644089395E-10
912 DATA 3430,.75225398894,-.000860015931836,-1.27192146638E-6,1.09996443948E-9
914 DATA 3671,.486634502854,-.00127327915379,-3.04479042059E-7,2.43475226402E-9
916 DATA 3906,.20217879639,-.00102070987596,1.40690334915E-6,3.77037338183E-10
918 DATA 4046,.0878720587419,-.00060752567243,1.481893432E-6,-9.41070630331E-10
920 ! DECIMATE 5
922 DATA 1,.999766626323,3.09444533275E-6,-3.08296415862E-8,9.42958060236E-12
924 DATA 1553,.965917699622,-2.51092993233E-5,3.3193457394E-8,-2.97189644459E-12
926 DATA 2447,.967858361976,1.42607258493E-5,5.14219085966E-8,-2.36505478883E-10
928 DATA 2968,.95554217373,-.000132615045922,-3.90139726787E-7,-6.01900862194E-10
930 DATA 3430,.751694455055,-.000859701849746,-1.27061698991E-6,1.09953843541E-9
932 DATA 3671,.486220398325,-.00127242354088,-3.03580367656E-7,2.43235348938E-9
934 DATA 3906,.201984230708,-.00101982637851,1.40604166624E-6,3.7597451994E-10
936 DATA 4046,.087781393549,-.000606943133495,1.48066425217E-6,-9.40770799966E-10
938 ! DECIMATE 6
940 DATA 1,.999766629832,3.09447275121E-6,-3.08457658591E-8,9.43004933698E-12
942 DATA 1553,.965880635696,-2.51561379895E-5,3.31782724094E-8,-2.97351395607E-12
944 DATA 2447,.967766103258,1.41849381137E-5,5.13928471741E-8,-2.36465586649E-10
946 DATA 2968,.955408192048,-.000132684592458,-3.90107179508E-7,-6.01713668384E-10
948 DATA 3430,.751553793937,-.000859623351729,-1.27028885136E-6,1.09943234142E-9
950 DATA 3671,.486116212099,-.0012722086455,-3.03353412353E-7,2.43174987375E-9
952 DATA 3906,.201935237605,-.00101960409039,1.40582552006E-6,3.75705881184E-10
954 DATA 4046,.08775855125,-.000606796456082,1.48035512557E-6,-9.40696367373E-10
956 ! DECIMATE 7
958 DATA 1,.999766630744,3.09447914487E-6,-3.08497955791E-8,9.43016514409E-12
960 DATA 1553,.965871367108,-2.51678544691E-5,3.31744704333E-8,-2.97392237588E-12
962 DATA 2447,.967743022394,1.41659649151E-5,5.13855609066E-8,-2.36455606903E-10
964 DATA 2968,.95537466201,-.00013270201928,-3.90099061099E-7,-6.01666783364E-10
966 DATA 3430,.75151858012,-.000859603728592,-1.27020669067E-6,1.0994058432E-9
968 DATA 3671,.486090124351,-.0012721548597,-3.032965309E-7,2.4315987251E-9
970 DATA 3906,.201922967387,-.00101954843014,1.40577143818E-6,3.75638538494E-10
972 DATA 4046,.0877528296957,-.000606759721673,1.48027772962E-6,-9.406777919E-10
974 ! DECIMATE 8
976 DATA 1,.999766630975,3.09448071473E-6,-3.08508029256E-8,9.4301940102E-12
978 DATA 1553,.965869049797,-2.51707840149E-5,3.31735195815E-8,-2.97402473367E-12
980 DATA 2447,.967737251167,1.4161219973E-5,5.13837380357E-8,-2.36453111551E-10
982 DATA 2968,.955366277337,-.000132706378498,-3.90097032636E-7,-6.01655056714E-10
984 DATA 3430,.751509773633,-.000859598822892,-1.27018614261E-6,1.09939922022E-9
986 DATA 3671,.48608359984,-.00127214140939,-3.03282301615E-7,2.43156092261E-9
988 DATA 3906,.201919898462,-.00101953450956,1.40575791488E-6,3.75621691391E-10
990 DATA 4046,.0877513986212,-.000606750534006,1.48025837347E-6,-9.40673149943E-10
992 ! DECIMATE 9
994 DATA 1,.999766631033,3.09448110508E-6,-3.08510547563E-8,9.43020122105E-12
996 DATA 1553,.96586847046,-2.51715164262E-5,3.3173281842E-8,-2.97405033587E-12
998 DATA 2447,.967735808297,1.41600336371E-5,5.13832822285E-8,-2.36452487677E-10
1000 DATA 2968,.955364181033,-.000132707468459,-3.90096525598E-7,-6.01652124705E-10
1002 DATA 3430,.751507571822,-.000859597596473,-1.2701810051E-6,1.09939756456E-9
1004 DATA 3671,.486081968552,-.00127213804656,-3.03278743749E-7,2.43155147106E-9
1006 DATA 3906,.201919131145,-.00101953102907,1.40575453387E-6,3.7561747894E-10
1008 DATA 4046,.0877510408098,-.000606748236835,1.48025353397E-6,-9.40671989467E-10
1010! DECIMATE 10
1012 DATA 1,.999766631047,3.09448120267E-6,-3.08511177139E-8,9.43020302351E-12
1014 DATA 1553,.965868325625,-2.51716995326E-5,3.31732224104E-8,-2.97405674071E-12
1016 DATA 2447,.967735447575,1.41597370448E-5,5.13831682788E-8,-2.36452331716E-10
1018 DATA 2968,.955363656949,-.00013270774096,-3.90096398837E-7,-6.01651391687E-10
1020 DATA 3430,.751507021357,-.000859597289868,-1.27017972071E-6,1.09939715068E-9
1022 DATA 3671,.486081560719,-.00127213720584,-3.0327785424E-7,2.4315491081E-9
1024 DATA 3906,.201918939311,-.00101953015893,1.40575368861E-6,3.7561642577E-10
1026 DATA 4046,.0877509513542,-.000606747662526,1.48025232403E-6,-9.40671698738E-10
1028! DECIMATE 11
1030 DATA 1,.999766631051,3.09448122771E-6,-3.08511334542E-8,9.43020347453E-12
1032 DATA 1553,.965868289416,-2.51717453096E-5,3.31732075535E-8,-2.97405834266E-12
1034 DATA 2447,.967735357394,1.41596628984E-5,5.13831397838E-8,-2.36452292714E-10
1036 DATA 2968,.955363525928,-.000132707809085,-3.9009636715E-7,-6.01651208431E-10
1038 DATA 3430,.75150688374,-.000859597213217,-1.2701793996E-6,1.09939704718E-9
1040 DATA 3671,.486081458761,-.00127213699566,-3.03277631862E-7,2.43154851736E-9
1042 DATA 3906,.201918891352,-.00101952994139,1.40575347729E-6,3.75616162472E-10
1044 DATA 4046,.0877509289902,-.000606747518948,1.48025202158E-6,-9.40671626476E-10
1046! DECIMATE 12
1048 DATA 1,.999766631052,3.09448123342E-6,-3.08511373883E-8,9.43020358689E-12
1050 DATA 1553,.965868280364,-2.51717567533E-5,3.3173203838E-8,-2.97405874225E-12
1052 DATA 2447,.967735334849,1.41596443624E-5,5.13831326567E-8,-2.36452282962E-10
1054 DATA 2968,.955363493172,-.000132707826115,-3.90096359237E-7,-6.01651162605E-10
1056 DATA 3430,.751506849336,-.000859597194054,-1.27017931932E-6,1.09939702132E-9
1058 DATA 3671,.486081433271,-.00127213694312,-3.03277576262E-7,2.43154836966E-9
1060 DATA 3906,.201918879362,-.00101952988701,1.40575342447E-6,3.75616096616E-10
1062 DATA 4046,.0877509233991,-.000606747483054,1.48025194598E-6,-9.40671608532E-10
1064! DECIMATE 13
1066 DATA 1,.999766631052,3.09448123531E-6,-3.08511383729E-8,9.43020361535E-12
1068 DATA 1553,.9658682781,-2.51717596128E-5,3.31732029045E-8,-2.97405883913E-12
1070 DATA 2447,.967735329213,1.41596397256E-5,5.13831308877E-8,-2.36452280537E-10
1072 DATA 2968,.955363484983,-.000132707830373,-3.90096357254E-7,-6.01651151155E-10
1074 DATA 3430,.751506840735,-.000859597189264,-1.27017929925E-6,1.09939701486E-9
1076 DATA 3671,.486081426899,-.00127213692998,-3.03277562359E-7,2.43154833272E-9
1078 DATA 3906,.201918876364,-.00101952987341,1.40575341125E-6,3.75616080201E-10
1080 DATA 4046,.0877509220014,-.00060674747408,1.48025192704E-6,-9.40671603599E-10
1082 ! DECIMATE 14
1084 DATA 1,.999766631052,3.09448123442E-6,-3.08511386166E-8,9.43020362157E-12
1086 DATA 1553,.965868277535,-2.51717603297E-5,3.31732026772E-8,-2.97405886719E-12
1088 DATA 2447,.967735327804,1.41596385677E-5,5.13831304406E-8,-2.36452279927E-10
1090 DATA 2968,.955363482936,-.000132707831438,-3.90096356757E-7,-6.01651148292E-10
1092 DATA 3430,.751506838584,-.000859597188066,-1.27017929424E-6,1.09939701325E-9
1094 DATA 3671,.486081425306,-.0012721369267,-3.03277558891E-7,2.43154832351E-9
1096 DATA 3906,.201918875615,-.00101952987001,1.40575340795E-6,3.75616076064E-10
1098 DATA 4046,.0877509216519,-.000606747471837,1.48025192235E-6,-9.40671602786E-10
1100 ! DECIMATE 15
1102 DATA 1,.999766631052,3.0944812342E-6,-3.08511386778E-8,9.43020362316E-12
1104 DATA 1553,.965868277393,-2.51717605069E-5,3.31732026146E-8,-2.97405887058E-12
1106 DATA 2447,.967735327452,1.41596382788E-5,5.13831303248E-8,-2.36452279769E-10
1108 DATA 2968,.955363482424,-.000132707831705,-3.90096356632E-7,-6.01651147579E-10
1110 DATA 3430,.751506838047,-.000859597187767,-1.27017929299E-6,1.09939701283E-9
1112 DATA 3671,.486081424907,-.00127213692588,-3.03277558022E-7,2.4315483212E-9
1114 DATA 3906,.201918875428,-.00101952986916,1.40575340713E-6,3.75616075054E-10
1116 DATA 4046,.0877509215646,-.000606747471276,1.48025192115E-6,-9.40671602407E-10
1118 ! DECIMATE 16
1120 DATA 1,.999766631052,3.09448123498E-6,-3.08511386943E-8,9.43020362403E-12
1122 DATA 1553,.965868277358,-2.51717605521E-5,3.31732026011E-8,-2.97405887291E-12
1124 DATA 2447,.967735327364,1.41596382053E-5,5.13831303018E-8,-2.36452279737E-10
1126 DATA 2968,.955363482296,-.000132707831773,-3.90096356591E-7,-6.01651147413E-10
1128 DATA 3430,.751506837912,-.000859597187692,-1.27017929267E-6,1.09939701272E-9
1130 DATA 3671,.486081424808,-.00127213692567,-3.03277557811E-7,2.43154832064E-9
1132 DATA 3906,.201918875381,-.00101952986895,1.40575340692E-6,3.75616074787E-10
1134 DATA 4046,.0877509215427,-.000606747471137,1.48025192091E-6,-9.4067160322E-10
1136 ! DECIMATE 17
1138 DATA 1,.999766631052,3.09448123531E-6,-3.08511386985E-8,9.43020362429E-12
1140 DATA 1553,.965868277349,-2.51717605639E-5,3.31732025989E-8,-2.9740588745E-12
1142 DATA 2447,.967735327342,1.41596381876E-5,5.13831302927E-8,-2.36452279723E-10
1144 DATA 2968,.955363482264,-.000132707831787,-3.90096356596E-7,-6.01651147351E-10
1146 DATA 3430,.751506837879,-.000859597187672,-1.27017929259E-6,1.09939701271E-9
1148 DATA 3671,.486081424783,-.00127213692562,-3.03277557749E-7,2.43154832048E-9
1150 DATA 3906,.201918875369,-.0010195298689,1.40575340687E-6,3.75616074733E-10
1152 DATA 4046,.0877509215373,-.000606747471102,1.48025192084E-6,-9.40671603111E-10
1154 ! DECIMATE 18
1156 DATA 1,.999766631052,3.09448123492E-6,-3.08511386988E-8,9.43020362408E-12
1158 DATA 1553,.965868277347,-2.51717605666E-5,3.31732025983E-8,-2.97405887428E-12
1160 DATA 2447,.967735327336,1.41596381829E-5,5.13831302914E-8,-2.36452279723E-10
1162 DATA 2968,.955363482256,-.000132707831792,-3.90096356594E-7,-6.01651147341E-10
1164 DATA 3430,.75150683787,-.000859597187668,-1.27017929258E-6,1.09939701272E-9
1166 DATA 3671,.486081424777,-.00127213692561,-3.03277557743E-7,2.43154832046E-9
1168 DATA 3906,.201918875366,-.00101952986889,1.40575340686E-6,3.75616074705E-10
1170 DATA 4046,.0877509215359,-.000606747471093,1.48025192082E-6,-9.40671603111E-10
1172 ! DECIMATE 19
1174 DATA 1,.999766631052,3.09448123437E-6,-3.08511386984E-8,9.43020362379E-12
1176 DATA 1553,.965868277346,-2.51717605666E-5,3.31732025963E-8,-2.97405887323E-12
1178 DATA 2447,.967735327335,1.41596381835E-5,5.13831302841E-8,-2.36452279713E-10
1180 DATA 2968,.955363482254,-.000132707831791,-3.900963566E-7,-6.0165114733E-10
1182 DATA 3430,.751506837868,-.000859597187667,-1.27017929256E-6,1.0993970127E-9
1184 DATA 3671,.486081424775,-.0012721369256,-3.0327755774E-7,2.43154832045E-9
1186 DATA 3906,.201918875366,-.00101952986888,1.40575340684E-6,3.75616074743E-10
1188 DATA 4046,.0877509215356,-.00060674747109,1.48025192079E-6,-9.40671602949E-10
1190 SUBEND
1192 !
1194 ! PAGE ->
1196 !********************************************************************
1198 Lib_df_phase:SUB Lib_df_phase(Span,Df_phase(*),Zoom)
1200 !
1202 ! This subprogram generates a phase spectrum (in degrees) of the
1204 ! digital filter response for a given span and whether zoom is
1206 ! enabled or not. Span is the span to generate the spectrum
1208 ! for, it should the same as what is returned from the input
1210 ! module (ie: 51200, 25600, ...). Zoom is a boolean that
1212 ! indicates whether the spectrum should be for a zoomed
1214 ! measurement or not. The result is returned in the Df_phase
1216 ! array. Df_phase should be a power of 2 in size.
1218 !
1220 Table_size=7
1222 ALLOCATE Coef(1:Table_size,0:4)
1224 INTEGER Blk_ptr,Strt_blk,End_blk
1226 !
1228 ! The algorithm used is a cubic spline that was generated using
1230 ! a least squares fit to the actual response. The maximum
1232 ! error is .02 degrees over the entire response, for any span
1234 ! and zoom combination. Note there is a separate set of
1236 ! cubic spline coeffecients for each span.
1238 !
1240 Dec=INT(.5+LGT(204800/Span)/LGT(2))
1242 IF NOT Zoom THEN Dec=Dec-1
1244 !
1246 IF Dec<1 THEN
1248 MAT Df_phase= (0)
1250 SUBEXIT
1252 END IF
1254 !
1256 FOR Sp=1 TO Dec
1258 READ Coef(*)
1260 NEXT Sp
1262 !
1264 Strt_blk=BASE(Df_phase,1)
1266 Bsiz=SIZE(Df_phase,1)
1268 End_blk=Bsiz+Strt_blk-1
1270 Zoom_ptr=End_blk
1272 IF Zoom THEN End_blk=Bsiz DIV 2+Strt_blk
1274 Eff_bsiz=2^INT(.9+LGT(Bsiz)/LGT(2))
1276 IF Zoom THEN Eff_bsiz=Eff_bsiz DIV 2
1278 Step_size=4096 DIV Eff_bsiz
1280 !
1282 Filter_pos=1
1284 Spline_pos=1
1286 GOSUB Lib_ph_new
1288 FOR Blk_ptr=Strt_blk TO End_blk
1290 IF Filter_pos>End_spline THEN
1292 Spline_pos=Spline_pos+1
1294 GOSUB Lib_ph_new
1296 END IF
1298 Df_phase(Blk_ptr)=((C3*Filter_pos+C2)*Filter_pos+C1)*Filter_pos+C0
1300 IF Zoom THEN
1302 Df_phase(Zoom_ptr)=Df_phase(Blk_ptr)
1304 IF Blk_ptr<>Strt_blk THEN Zoom_ptr=Zoom_ptr-1
1306 END IF
1308 Filter_pos=Filter_pos+Step_size
1310 NEXT Blk_ptr
1312 !
1314 SUBEXIT
1316 Lib_ph_new:!
1318 IF Spline_pos<>1 THEN
1320 Filter_pos=Filter_pos-End_spline
1322 END IF
1324 C0=Coef(Spline_pos,1)
1326 C1=Coef(Spline_pos,2)
1328 C2=Coef(Spline_pos,3)
1330 C3=Coef(Spline_pos,4)
1332 IF Spline_pos<Table_size THEN
1334 End_spline=Coef(Spline_pos+1,0)-Coef(Spline_pos,0)
1336 ELSE
1338 End_spline=10000
1340 END IF
1342 RETURN
1344 !
1346 ! The following data statements contain the cubic spline coefficients
1348 ! for each span. Each span starts with a comment indicating the
1350 ! number of passes of decimation for that span.
1352 !
1354 !
1356! DECIMATE 1
1358 DATA 1,.0809262402377,-.0733539311878,3.50003231737E-7,-1.58743670487E-9
1360 DATA 1272,-95.8468525772,-.0805269212706,-5.3565401682E-6,-4.25068508747E-9
1362 DATA 2114,-169.985962263,-.099118088131,-1.55967093841E-5,-1.14825656336E-8
1364 DATA 2752,-242.553164574,-.133696988066,-3.74067475551E-5,-2.43947648381E-8
1366 DATA 3407,-353.04244929,-.213698942485,-9.10848549132E-5,2.39840592092E-9
1368 DATA 3760,-439.723612363,-.275905252248,-8.92712645655E-5,8.20637642961E-8
1370 DATA 5000,0,0,0,0
1372! DECIMATE 2
1374 DATA 1,.117568266688,-.109975889605,3.54945909734E-7,-1.75270050907E-9
1376 DATA 1266,-141.982875769,-.117862953737,-5.95149006216E-6,-4.43920163368E-9
1378 DATA 2107,-247.955952673,-.137822796888,-1.66575710874E-5,-1.16756693293E-8
1380 DATA 2745,-345.698693803,-.173994349087,-3.88036485313E-5,-2.46799550375E-8
1382 DATA 3386,-479.687810066,-.253820070765,-9.21479229792E-5,-1.1510004911E-9
1384 DATA 3745,-582.739789923,-.319211116282,-9.44721261638E-5,7.80478932143E-8
1386 DATA 4079,-696.978775263,-.355692276986,-9.88878991848E-6,1.02503804555E-7
1388! DECIMATE 3
1390 DATA 1,.135885220472,-.128286530967,3.55303292163E-7,-1.77292134479E-9
1392 DATA 1266,-165.167884912,-.136269984832,-6.027913726E-6,-4.46094981305E-9
1394 DATA 2107,-286.68826621,-.156404675543,-1.67889735756E-5,-1.16994398813E-8
1396 DATA 2745,-396.345904776,-.192773070725,-3.89804205057E-5,-2.47062256413E-8
1398 DATA 3386,-542.45173518,-.272857900625,-9.23755970401E-5,-1.1797865844E-9
1400 DATA 3745,-652.368970714,-.338423581681,-9.47308054275E-5,7.80170182017E-8
1402 DATA 4079,-773.054927382,-.375087889875,-1.01786390587E-5,1.02471801711E-7
1404! DECIMATE 4
1406 DATA 1,.145040692818,-.137441807345,3.55320019449E-7,-1.77542328023E-9
1408 DATA 1266,-176.745192045,-.145437236601,-6.03739354749E-6,-4.46349828273E-9
1410 DATA 2107,-305.983452928,-.165593284432,-1.68048868152E-5,-1.1702047533E-8
1412 DATA 2745,-421.510578525,-.201985173266,-3.9001321789E-5,-2.47089029641E-8
1414 DATA 3386,-573.530659801,-.282100101593,-9.24016573771E-5,-1.18253063418E-9
1416 DATA 3745,-686.769331127,-.347685555844,-9.47598213363E-5,7.80142211127E-8
1418 DATA 4079,-810.55212829,-.384370183194,-1.02104627331E-5,1.02468931118E-7
1420! DECIMATE 5
1422 DATA 1,.149618335729,-.142019444156,3.55321242818E-7,-1.77573522447E-9
1424 DATA 1266,-182.531954478,-.150016368069,-6.03857620934E-6,-4.46381167175E-9
1426 DATA 2107,-315.622287813,-.170175070241,-1.68068602751E-5,-1.17023627396E-8
1428 DATA 2745,-434.073477898,-.206569862243,-3.90038984699E-5,-2.47092202877E-8
1430 DATA 3386,-589.033487094,-.286688485106,-9.24048445894E-5,-1.18284996208E-9
1432 DATA 3745,-703.919813647,-.352276351266,-9.47633524833E-5,7.80139002322E-8
1434 DATA 4079,-829.236342358,-.388963444802,-1.02143176264E-5,1.02468760588E-7
1436! DECIMATE 6
1438 DATA 1,.151907154278,-.144308262518,3.55321368647E-7,-1.77577419261E-9
1440 DATA 1266,-185.425099569,-.152305373193,-6.03872396893E-6,-4.46385068541E-9
1442 DATA 2107,-320.440613927,-.172464406682,-1.6807106469E-5,-1.17024018102E-8
1444 DATA 2745,-440.352511019,-.208859560539,-3.90042194451E-5,-2.47092594192E-8
1446 DATA 3386,-596.780359012,-.288978643131,-9.24052408298E-5,-1.18288915989E-9
1448 DATA 3745,-712.488905178,-.354566808947,-9.47637909361E-5,7.80138609841E-8
1450 DATA 4079,-838.570497128,-.391254208509,-1.02147964753E-5,1.02468703744E-7
1452! DECIMATE 7
1454 DATA 1,.153051563462,-.145452671698,3.5532138358E-7,-1.77577906288E-9
1456 DATA 1266,-186.871642607,-.153449805716,-6.03874243571E-6,-4.46385555776E-9
1458 DATA 2107,-322.849640677,-.173608880604,-1.68071372293E-5,-1.17024066821E-8
1460 DATA 2745,-443.491725917,-.210004079662,-3.9004259528E-5,-2.47092642983E-8
1462 DATA 3386,-600.653228422,-.290123219653,-9.24052902969E-5,-1.18289402752E-9
1464 DATA 3745,-716.77268416,-.355711422872,-9.47638456417E-5,7.80138560853E-8
1466 DATA 4079,-843.236583447,-.392398860633,-1.02148542283E-5,1.02468646901E-7
1468! DECIMATE 8
1470 DATA 1,.153623768087,-.146024876288,3.55321385814E-7,-1.77577967182E-9
1472 DATA 1266,-187.594910438,-.154022013223,-6.03874474497E-6,-4.46385616589E-9
1474 DATA 2107,-324.054137016,-.174181093286,-1.68071410727E-5,-1.17024072919E-8
1476 DATA 2745,-445.061295671,-.210576297993,-3.90042645371E-5,-2.4709264908E-8
1478 DATA 3386,-602.589592345,-.290695445156,-9.24052964866E-5,-1.1828946208E-9
1480 DATA 3745,-718.914477864,-.356283653048,-9.47638524833E-5,7.80138554868E-8
1482 DATA 4079,-845.569502815,-.392971095578,-1.02148605947E-5,1.02468590057E-7
1484! DECIMATE 9
1486 DATA 1,.153909870404,-.146310978583,3.55321386231E-7,-1.77577974801E-9
1488 DATA 1266,-187.956543893,-.154308115883,-6.03874503363E-6,-4.46385624189E-9
1490 DATA 2107,-324.656383057,-.174467196593,-1.68071415527E-5,-1.17024073684E-8
1492 DATA 2745,-445.846075836,-.210862402006,-3.90042651635E-5,-2.47092649841E-8
1494 DATA 3386,-603.55776546,-.290981550065,-9.24052972557E-5,-1.18289470059E-9
1496 DATA 3745,-719.985362744,-.35656975854,-9.47638533431E-5,7.80138554191E-8
1498 DATA 4079,-846.735947028,-.393257201664,-1.02148628685E-5,1.02468675323E-7
1500! DECIMATE 10
1502 DATA 1,.154052921399,-.14645402973,3.5532138476E-7,-1.77577975684E-9
1504 DATA 1266,-188.137360562,-.154451167076,-6.03874506977E-6,-4.46385625132E-9
1506 DATA 2107,-324.957505811,-.174610247866,-1.68071416151E-5,-1.17024073758E-8
1508 DATA 2745,-446.23846533,-.211005453368,-3.90042652418E-5,-2.47092649935E-8
1510 DATA 3386,-604.041850911,-.29112460154,-9.24052973517E-5,-1.18289471274E-9
1512 DATA 3745,-720.520803688,-.356712810087,-9.47638534576E-5,7.80138554295E-8
1514 DATA 4079,-847.319167201,-.393400253288,-1.02148624137E-5,1.02468675323E-7
1516! DECIMATE 11
1518 DATA 1,.154124446922,-.146525555303,3.55321384385E-7,-1.77577975784E-9
1520 DATA 1266,-188.22776889,-.154522692656,-6.03874507366E-6,-4.46385625295E-9
1522 DATA 2107,-325.108067155,-.174681773456,-1.6807141622E-5,-1.17024073771E-8
1524 DATA 2745,-446.434660003,-.211076978969,-3.90042652505E-5,-2.47092649959E-8
1526 DATA 3386,-604.283893499,-.291196127155,-9.24052973605E-5,-1.18289471794E-9
1528 DATA 3745,-720.788523973,-.356784335711,-9.47638534621E-5,7.80138554052E-8
1530 DATA 4079,-847.610777045,-.393471778916,-1.02148624137E-5,1.02468618479E-7
1532! DECIMATE 12
1534 DATA 1,.15416020986,-.146561318091,3.55321385717E-7,-1.77577975859E-9
1536 DATA 1266,-188.272973053,-.154558455443,-6.03874507488E-6,-4.46385625262E-9
1538 DATA 2107,-325.183347823,-.174717536245,-1.68071416202E-5,-1.17024073802E-8
1540 DATA 2745,-446.53275733,-.21111274176,-3.90042652503E-5,-2.47092649976E-8
1542 DATA 3386,-604.404914775,-.291231889947,-9.24052973641E-5,-1.18289471794E-9
1544 DATA 3745,-720.922384092,-.356820098506,-9.47638534567E-5,7.80138553966E-8
1546 DATA 4079,-847.756581938,-.39350754171,-1.0214861959E-5,1.02468618479E-7
1548! DECIMATE 13
1550 DATA 1,.154178091513,-.146579199486,3.55321387938E-7,-1.77577975962E-9
1552 DATA 1266,-188.295575134,-.154576336837,-6.03874507343E-6,-4.46385625393E-9
1554 DATA 2107,-325.220988156,-.174735417639,-1.68071416202E-5,-1.17024073804E-8
1556 DATA 2745,-446.581805993,-.211130623154,-3.90042652507E-5,-2.47092649972E-8
1558 DATA 3386,-604.465425412,-.291249771342,-9.2405297357E-5,-1.18289472835E-9
1560 DATA 3745,-720.989314148,-.3568379799,-9.47638534559E-5,7.80138553948E-8
1562 DATA 4079,-847.82948438,-.393525423122,-1.02148592305E-5,1.02468561636E-7
1564! DECIMATE 14
1566 DATA 1,.154187031684,-.146588140179,3.55321382678E-7,-1.77577975715E-9
1568 DATA 1266,-188.306876175,-.154585277534,-6.0387450736E-6,-4.46385625371E-9
1570 DATA 2107,-325.239808323,-.174744358335,-1.6807141624E-5,-1.17024073769E-8
1572 DATA 2745,-446.606330324,-.21113956385,-3.90042652516E-5,-2.47092649961E-8
1574 DATA 3386,-604.495680729,-.291258712038,-9.24052973614E-5,-1.18289472141E-9
1576 DATA 3745,-721.022779176,-.356846920598,-9.4763853447E-5,7.80138553706E-8
1578 DATA 4079,-847.8659356,-.393534363822,-1.02148610495E-5,1.02468590057E-7
1580! DECIMATE 15
1582 DATA 1,.154191503115,-.146592610534,3.5532139199E-7,-1.7757797614E-9
1584 DATA 1266,-188.312526695,-.154589747882,-6.03874507432E-6,-4.46385625322E-9
1586 DATA 2107,-325.249218406,-.174748828684,-1.68071416209E-5,-1.17024073799E-8
1588 DATA 2745,-446.61859249,-.211144034197,-3.90042652554E-5,-2.47092649926E-8
1590 DATA 3386,-604.510808388,-.291263182386,-9.24052973597E-5,-1.18289472315E-9
1592 DATA 3745,-721.03951169,-.356851390945,-9.47638534585E-5,7.80138554E-8
1594 DATA 4079,-847.884161211,-.393538834134,-1.02148651422E-5,1.02468760588E-7
1596 ! DECIMATE 16
1598 DATA 1,.154193734957,-.146594845688,3.55321361223E-7,-1.77577974729E-9
1600 DATA 1266,-188.315351955,-.154591983056,-6.03874507432E-6,-4.46385625317E-9
1602 DATA 2107,-325.253923448,-.174751063858,-1.68071416222E-5,-1.17024073786E-8
1604 DATA 2745,-446.624723573,-.211146269372,-3.90042652541E-5,-2.47092649941E-8
1606 DATA 3386,-604.518372218,-.29126541756,-9.24052973605E-5,-1.18289472315E-9
1608 DATA 3745,-721.047877947,-.356853626118,-9.47638534692E-5,7.80138554157E-8
1610 DATA 4079,-847.893274016,-.393541069352,-1.02148596852E-5,1.02468476371E-7
1612 ! DECIMATE 17
1614 DATA 1,.154194845298,-.146595963233,3.55321295414E-7,-1.77577971719E-9
1616 DATA 1266,-188.316764586,-.154593100644,-6.03874507177E-6,-4.46385625544E-9
1618 DATA 2107,-325.256275968,-.174752181446,-1.68071416191E-5,-1.17024073815E-8
1620 DATA 2745,-446.627789114,-.211147386959,-3.90042652547E-5,-2.47092649933E-8
1622 DATA 3386,-604.522154132,-.291266535146,-9.24052973694E-5,-1.18289470753E-9
1624 DATA 3745,-721.052061075,-.356854743705,-9.47638534727E-5,7.80138554226E-8
1626 DATA 4079,-847.897830418,-.393542186921,-1.0214861959E-5,1.02468561636E-7
1628 ! DECIMATE 18
1630 DATA 1,.154195376998,-.146596521867,3.55321044143E-7,-1.77577960143E-9
1632 DATA 1266,-188.317470901,-.154593659436,-6.03874507449E-6,-4.46385625349E-9
1634 DATA 2107,-325.257452229,-.174752740239,-1.68071416189E-5,-1.17024073819E-8
1636 DATA 2745,-446.629321885,-.211147945752,-3.90042652552E-5,-2.47092649933E-8
1638 DATA 3386,-604.52404509,-.291267093938,-9.24052973756E-5,-1.18289469712E-9
1640 DATA 3745,-721.05415264,-.356855302496,-9.47638534869E-5,7.80138554521E-8
1642 DATA 4079,-847.90010862,-.393542745664,-1.02148655969E-5,1.02468703744E-7
1644 ! DECIMATE 19
1646 DATA 1,.154195621937,-.146596801062,3.55320726453E-7,-1.7757794556E-9
1648 DATA 1266,-188.317824058,-.154593938835,-6.03874507049E-6,-4.46385625615E-9
1650 DATA 2107,-325.258040359,-.174753019633,-1.68071416262E-5,-1.17024073758E-8
1652 DATA 2745,-446.63008827,-.211148225149,-3.90042652552E-5,-2.4709264993E-8
1654 DATA 3386,-604.524990568,-.291267373336,-9.24052973703E-5,-1.1828947058E-9
1656 DATA 3745,-721.055198422,-.356855581898,-9.47638534381E-5,7.80138553445E-8
1658 DATA 4079,-847.901247721,-.393543024824,-1.02148933365E-5,1.02469613239E-7
1660 !
1662 SUBEND
1664 !
1666 ! PAGE ->
1668 !********************************************************************
1670 Lib_c1_init:SUB Lib_c1_init
1672 !***********************************************************************
1674 !* This subroutine initializes for the C1 calibration. It should be
1676 !* called before C1 calibration is attempted.
1678 !***********************************************************************
1680 COM /Lib_c1_lbl_info/ Input_labels$(*),Source_labels$(*)
1682 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
1684 COM /Lib_c1_overload/ INTEGER Ovld_buffer(*)
1686 COM /Lib_c1_blk_ids/ REAL Icode_id,Input_buffer_id,Module_list_id,Ovld_buffer_id
1688 COM /Lib_c1_cal_con/ REAL Calcon_real(*),Calcon_imag(*)
1690 COM /Lib_c1_first/ INTEGER Runned_yet
1692 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
1694 !
1696 DISP "Setting up for C1 calibration . . ."
1698 Block_size=256
1700 Errored=0
1702 !
1704 !Initialize input and source spreadsheets:
1706 Inpt_init
1708 Srce_init
1710 !
1712 !Get number of input and source modules and their names:
1714 Lib_c1_get_lbls
1716 IF No_c1_cal THEN SUBEXIT
1718 !
1720 !Initialize input modules and one source module:
1722 Lib_c1_init_mod
1724 !
1726 !Initialize calibration constants:
1728 Lib_c1_init_con
1730 !
1732 IF NOT Runned_yet THEN
1734 !Initialize and assemble ICODE program:
1736 Lib_c1_init_icd
1738 !Initialize DFT coefficients:
1740 Lib_c1_init_dft
1742 Runned_yet=1
1744 END IF
1746 !
1748 Runned_yet=1
1750 DISP ""
1752 SUBEXIT
1754 SUBEND
1756!
1758 Lib_c1_start:SUB Lib_c1_start
1760 !*********************************************************************
1762 !* This subroutine starts the measurement for the C1 calibration pass.
1764 !* The sequence of events are:
1766 !* 1) Initialize and download ICODE blocks
1768 !* 2) Start input modules
1770 !* 3) Wait for all ready
1772 !* 4) Synchronize input modules
1774 !* 5) Start ICODE
1776 !* 6) Start the ICODE data collection process (by continuing the
1778 !* ICODE program)
1780 !* 7) Unassert the system trigger line (arms system trigger).
1782 !*********************************************************************
1784 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
1786 !
1788 !Initialize, download ICODE blocks:
1790 Lib_c1_init_blk
1792 !
1794 !Hold off triggers, start and synchronize the inputs:
1796 Hw_cmd("TRGA")
1798 Inpt_cmd("ALL INPUT","STRT")
1800 DISP "Waiting for hardware ready . . ."
1802 Hw_wait_gbl_rdy
1804 DISP ""
1806 Hw_cmd("SYNC")
1808 !
1810 !Start ICODE:
1812 Lib_c1_start_ic
1814 !
1816 !Did everything start without errors?
1818 DISP "Checking for errors . . ."
1820 IF BIT(VAL(FNHw_cmd_rsp$("STC?")),9) THEN
1822 IF FNDiag_chk_errors THEN
1824 User_error("Error when starting measurement.")
1826 Errored=1
1828 END IF
1830 END IF
1832 DISP ""
1834 !
1836 SUBEXIT
1838 SUBEND
1840 !
1842 Lib_c1_get_data:SUB Lib_c1_get_data(INTEGER Input_buffer(*))
1844 !**********************************************************************
1846 !* This subroutine waits for a block of data to be available
1848 !* from the 35651. It then gets the block and returns it in
1850 !* Input_buffer. Errored is returned false if everything worked OK,
1852 !* true if the block was not available soon enough or if an input
1854 !* module error occurred.
1856 !* In order for this routine to work properly, the 35651 should have
1858 !* been previously set up to SRQ on ICODE message.
1860 !**********************************************************************
1862 COM /Lib_c1_blk_ids/ REAL Icode_id,Input_buffer_id,Module_list_id,Ovld_buffer_id
1864 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
1866 REAL Start_time,Max_time
1868 INTEGER Status,Signal,Dummy
1870 !
1872 Max_time=30. !Seconds.
1874 !
1876 Start_time=TIMEDATE
1878 DISP "Waiting for a block of data . . ."
1880 REPEAT
1882 IF (TIMEDATE-Start_time)>Max_time THEN
1884 User_error("Calibration: Block of data not ready in "&VAL$(Max_time)&" seconds.")
1886 Errored=1
1888 SUBEXIT
1890 END IF
1892 UNTIL FNHw_srq
1894 DISP ""
1896 !
1898 Signal=VAL(FNHw_cmd_rsp$("SIG?"))
1900 Status=VAL(FNHw_cmd_rsp$("STA?"))
1902 IF BIT(Status,5) THEN
1904 User_error("35651 error occurred when waiting for ICODE block ready.")
1906 Errored=1
1908 Dummy=FNDiag_chk_moderr("HP-IB")
1910 END IF
1912 IF NOT BIT(Status,7) THEN !No ICODE message.
1914 Errored=1
1916 SUBEXIT
1918 END IF
1920 !
1922 !Clear overload bit in inputs in preparation for next block:
1924 Hw_gbl_cmd(109,"STA?")
1926 !
1928 IF Signal<>2 THEN
1930 IF Signal=3 THEN
1932 User_error("Interrupt occurred when getting block.")
1934 ELSE
1936 User_error("Problem with ICODE block ready.")
1938 END IF
1940 Dummy=FNDiag_chk_errors
1942 Errored=1
1944 SUBEXIT
1946 END IF
1948 !
1950 !A block is available; get it:
1952 Hw_read_blk(Input_buffer_id,Input_buffer(*))
1954 !
1956 !Check for overloads:
1958 IF FNLib_c1_do_ovld THEN
1960 Errored=1
1962 END IF
1964 !
1966 SUBEXIT
1968 SUBEND
1970!
1972 Lib_c1_setup_c1:SUB Lib_c1_setup_c1
1974 !**********************************************************************
1976 !* This subroutine sets up all the input modules and one source module
1978 !* for calibration pass C1. This pass calibrates the 'null' path vs.
1980 !* frequency using the source module multi-frequency cal source.
1982 !**********************************************************************
1984 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
1986 DIM String$[500]
1988 !
1990 !Input setup string; some explanatory notes:
1992 ! STOP;CLR Stop inputs if they are still running; clear errors.
1994 ! BSIZ ____ Proper block size for calibration pass c1.
1996 ! SP 102400 No digital filtering; sample rate matches cal signal.
1998 ! ZOOM OFF Matches BASIC DFT. ZOOM ON would be better for FFT.
2000 ! RNG -8 'Null path' will be calibrated first.
2002 !
2004 String$="STOP;CLR;BSIZ "&VAL$(Block_size)&";SP 102400;ZOOM OFF;RNG -8"
2006 Inpt_cmd("ALL INPUT",String$)
2008 !
2010 SUBEXIT
2012 SUBEND
2014!
2016 Lib_c1_start_ic:SUB Lib_c1_start_ic
2018 !**********************************************************************
2020 !* This subroutine starts the previously downloaded ICODE program in
2022 !* the 35651. The ICODE will signal if it has started properly.
2024 !**********************************************************************
2026 COM /Lib_c1_blk_ids/ REAL Icode_id,Input_buffer_id,Module_list_id,Ovld_buffer_id
2028 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
2030 INTEGER Status,Signal
2032 !
2034 !Set 35651 to SRQ on ICODE message;Start ICODE:
2036 Hw_cmd("RQS 128;PROG "&VAL$(Icode_id))
2038 !
2040 !Wait for ICODE started:
2042 DISP "Waiting for ICODE started."
2044 Hw_wait_srq
2046 DISP ""
2048 !
2050 Signal=VAL(FNHw_cmd_rsp$("SIG?"))
2052 Status=VAL(FNHw_cmd_rsp$("STA?"))
2054 IF BIT(Status,5)<>0 THEN
2056 User_error("35651 error occurred when starting ICODE.")
2058 Errored=1
2060 END IF
2062 IF Signal<>1 THEN
2064 User_error("ICODE not started properly.")
2066 Errored=1
2068 END IF
2070 !
2072 SUBEXIT
2074 SUBEND
2076 !
2078 Lib_c1_do_ovld:DEF FNLib_c1_do_ovld
2080 !**********************************************************************
2082 !* This function checks the currently active inputs to see if any
2084 !* are overloaded.
2086 !* The function returns true if any input modules are overloaded, false
2088 !* otherwise.
2090 !**********************************************************************
2092 COM /Lib_c1_overload/ INTEGER Ovld_buffer(*)
2094 COM /Lib_c1_blk_ids/ REAL Icode_id,Input_buffer_id,Module_list_id,Ovld_buffer_id
2096 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
2098 INTEGER Input_num,Overloaded
2100 !
2102 Overloaded=0
2104 !
2106 !Get overload status block from the 35651:
2108 ALLOCATE INTEGER Ovld_temp(1:Num_inputs)
2110 Hw_read_blk(Ovld_buffer_id,Ovld_temp(*))
2112 !
2114 !Setup ovld_buffer with overload information:
2116 FOR Input_num=1 TO Num_inputs
2118 Ovld_buffer(Input_num)=BINIOR(Ovld_buffer(Input_num),Ovld_temp(Input_num))
2120 IF BIT(Ovld_temp(Input_num),7) THEN
2122 Overloaded=1
2124 END IF
2126 NEXT Input_num
2128 !
2130 RETURN Overloaded
2132 FNEND
2134!
2136 Lib_c1_init_icd:SUB Lib_c1_init_icd
2138 !**********************************************************************
2140 !* This subroutine sets up the ICODE program for the calibration
2142 !* function. The ICODE is read in from DATA statements, assembled
2144 !* and then downloaded to the 35651.
2146 !*
2148 !* Signal values: 1 ICODE is started and ready for thruput.
2150 !* 2 A data block is available for uploading.
2152 !* 3 Thruput failed; data unavailable; ICODE aborted.
2154 !**********************************************************************
2156 COM /Lib_c1_icode_cd/ Source$(*),INTEGER Object(*)
2158 COM /Lib_c1_icode_fo/ Info$(*)
2160 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
2162 DIM Listing$(1:1)[1]
2164 INTEGER Info_info,Enable_listing
2166 !
2168 Info_info=1
2170 Enable_listing=0
2172 !
2174 RESTORE Lib_c1_icode_pr
2176 I=0
2178 LOOP
2180 READ Source$(I)
2182 EXIT IF UPC$(Source$(I))="EL_COMPLETO"
2184 I=I+1
2186 END LOOP
2188 !
2190 Num_errors=FNIcode_assemble(Source$(*),Object(*),Info_info,Info$(*),(Enable_listing),Listing$(*))
2192 !
2194 IF Num_errors>0 THEN
2196 User_error("Error in ICODE program assemble.")
2198 Errored=1
2200 END IF
2202 !
2204 SUBEXIT
2206 !
2208 Lib_c1_icode_pr: !
2210 !Define variables:
2212 DATA "VAR VALID_LOOPS 0 !Counts successful thruput loops."
2214 DATA "VAR NUM_MODULES 0 !Holds number of modules for thruput."
2216 DATA "VAR MODULE_NUM 0 !Index variable for overload read loop."
2218 DATA "VAR POINTER 0 !Block addressing pointer."
2220 DATA "VAR MODULE_ADR 0 !Holds a module address."
2222 DATA "VAR STATUS 0 !Temporary variable."
2224 !
2226 !Define arrays (blocks):
2228 DATA "DEFBLK_EXT MODULE_LIST !Contains setup for thruput."
2230 DATA "DEFBLK_EXT INPUT_BUFFER !Time data from 35652s goes here."
2232 DATA "DEFBLK_EXT OVLD_STATUS !Status data from 35652s goes here."
2234 !
2236 !Start of executable ICODE.
2238 !Setup for thruput to RAM:
2240 DATA " F_READY_RAM 1,INPUT_BUFFER,0,MODULE_LIST,0,VALID_LOOPS"
2242 DATA " F_KEEP_READY_RAM !Save thruput setup for multiple uses."
2244 !
2246 !Signal to HP-IB host computer that ICODE has started:
2248 DATA " F_SIGNAL 1"
2250 DATA " F_PAUSE !Wait for HP-IB host."
2252 !
2254 !Wait for SRQ indicating that Input modules have a block available:
2256 DATA "AGAIN: "
2258 DATA " F_WAIT_SRQ"
2260 DATA " F_ASSERT_TRIG !Hold off further triggering."
2262 !
2264 !Thruput the time data:
2266 DATA " F_THRUPUT 0,1 !Thruput; no wait for SRQ; abort on IRQ."
2268 !Read the module status of the input modules to get overload info:
2270 DATA " V_GET16_INDEXED MODULE_LIST,2,NUM_MODULES"
2272 DATA " V_CEQUATE 0,MODULE_NUM"
2274 DATA "O_LOOP: "
2276 DATA " V_ADD 3,MODULE_NUM,POINTER"
2278 DATA " V_GET16_INDEXED MODULE_LIST,POINTER,MODULE_ADR"
2280 DATA " F_GET_STATUS MODULE_ADR,STATUS"
2282 DATA " V_PUT16_INDEXED OVLD_STATUS,MODULE_NUM,STATUS"
2284 DATA " V_ADD 1,MODULE_NUM,MODULE_NUM"
2286 DATA " C_BLT O_LOOP,MODULE_NUM,NUM_MODULES"
2288 !
2290 !Check for successful thruput:
2292 DATA " C_BEQ NO_VAL,VALID_LOOPS,0 !If VALID_LOOPS=0 goto NO_VAL."
2294 !Signal block available, pause; do it again when continued.
2296 DATA " F_SIGNAL 2"
2298 DATA " F_PAUSE"
2300 DATA " C_GOTO AGAIN"
2302 !
2304 !Jump here on error:
2306 DATA "NO_VAL: "
2308 DATA " F_SIGNAL 3"
2310 DATA " C_END"
2312 !
2314 DATA "EL_COMPLETO"
2316 !
2318 SUBEND
2320!
2322 Lib_c1_init_blk:SUB Lib_c1_init_blk
2324 !**********************************************************************
2326 !* This subroutine initializes the ICODE blocks and downloads the
2328 !* ICODE and module list blocks needed for thruput. This routine should
2330 !* be called before starting the ICODE program the first time. It
2332 !* should also be called if the measurement parameters have been
2334 !* changed, as there could be new blocksizes and a different module list.
2336 !**********************************************************************
2338 COM /Lib_c1_blk_ids/ REAL Icode_id,Input_buffer_id,Module_list_id,Ovld_buffer_id
2340 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
2342 COM /Lib_c1_icode_cd/ Source$(*),INTEGER Object(*)
2344 COM /Lib_c1_icode_fo/ Info$(*)
2346 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
2348 !
2350 REAL Block_id,Input_buf_size
2352 REAL Required_words,Available_words
2354 INTEGER Module_list(0:99)
2356 !
2358 !Get the 35651's undivided attention:
2360 Hw_dev_clear
2362 !Abort any running ICODE, clear errors, and clear all block assignments:
2364 Hw_cmd("ABRT;CLR;DISA")
2366 !
2368 !Allocate blocks and get some block_id's from the 35651:
2370 !Set up the module list first so that input buffer size is known:
2372 Lib_c1_mod_list(Module_list(*))
2374 Input_buf_size=Num_inputs*Block_size
2376 !
2378 !Allocate blocks and get some block_id's from the 35651:
2380 Module_list_id=FNIcode_def_ext("MODULE_LIST",(1),(SIZE(Module_list,1)),(0),(0),Info$(*))
2382 Ovld_buffer_id=FNIcode_def_ext("OVLD_STATUS",(1),(Num_inputs),(0),(0),Info$(*))
2384 !
2386 !Check that 35651 has enough memory for requested measurement:
2388 Required_words=Input_buf_size+SIZE(Object,1)+2
2390 Available_words=FNHw_mainblk_aval
2392 IF Required_words>Available_words THEN
2394 User_error("Requested measurement would overflow 35651 RAM space by "&VAL$(DROUND(((100.*(Required_words/Available_words))-100.),3))&"%")
2396 Errored=1
2398 END IF
2400 !
2402 Input_buffer_id=FNIcode_def_ext("INPUT_BUFFER",(1),(Input_buf_size),(0),(0),Info$(*))
2404 !
2406 !Download ICODE program to 35651:
2408 Icode_id=FNIcode_dld(Object(*),(1),Info$(*))
2410 !
2412 !Download the module list to the 35651:
2414 Hw_write_blk(Module_list_id,Module_list(*))
2416 !
2418 SUBEXIT
2420 SUBEND
2422!
2424 Lib_c1_mod_list:SUB Lib_c1_mod_list(INTEGER Module_list(*))
2426 !***********************************************************************
2428 !* This subroutine sets up the thruput module list for thruput to RAM.
2430 !* The 35651 module needs this list to execute the thruput ICODE command.
2432 !* The list includes the thruput block size, the number of thruput loops
2434 !* (the number of times to read data from each of the modules; for the
2436 !* C1 calibration, this is always one), the number of modules to read
2438 !* from, and the module address for each.
2440 !***********************************************************************
2442 COM /Lib_c1_lbl_info/ Input_labels$(*),Source_labels$(*)
2444 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
2446 INTEGER Input_number
2448 !
2450 Module_list(0)=Block_size
2452 Module_list(1)=1 !Number of thruput loops per thruput command.
2454 Module_list(2)=Num_inputs
2456 !
2458 !Set up the addresses of the active input modules:
2460 FOR Input_number=1 TO Num_inputs
2462 Module_list(Input_number+2)=FNCnfg_get_modnum(Input_labels$(Input_number))
2464 NEXT Input_number
2466 !
2468 REDIM Module_list(0:Num_inputs+2)
2470 !
2472 SUBEXIT
2474 SUBEND
2476 !
2478 Lib_c1_get_lbls:SUB Lib_c1_get_lbls
2480 !***********************************************************************
2482 !* This subroutine sets up the Input_labels$ array with the names of all
2484 !* the active input channels as set up in the configuration spreadsheet;
2486 !* Num_inputs is set to the number of active inputs.
2488 !***********************************************************************
2490 COM /Lib_c1_lbl_info/ Input_labels$(*),Source_labels$(*)
2492 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
2494 COM /Lib_c1_src_info/ REAL Num_sources,Cal_src_label$
2496 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
2498 !
2500 No_c1_cal=0
2502 !
2504 !Get number of INPUT modules and their names:
2506 Cnfg_labels("ALL INPUT",Input_labels$(*),Num_inputs)
2508 IF Num_inputs<1 THEN
2510 User_error("Error: There are no active inputs to calibrate.")
2512 No_c1_cal=1
2514 Errored=1
2516 ELSE
2518 Max_tdly_label$=Input_labels$(1) !All inputs the same, pick one.
2520 END IF
2522 !
2524 !Get number of SOURCE modules and their names:
2526 Cnfg_labels("ALL SOURCE",Source_labels$(*),Num_sources)
2528 IF Num_sources<1 THEN
2530 User_error("Error: calibration requires an active source module; none found.")
2532 No_c1_cal=1
2534 Errored=1
2536 ELSE
2538 Cal_src_label$=Source_labels$(1) !Any would do, pick one.
2540 END IF
2542 !
2544 SUBEXIT
2546 SUBEND
2548!
2550 Lib_c1_init_mod:SUB Lib_c1_init_mod
2552 !**********************************************************************
2554 !* This subroutine initializes all the active input modules and one
2556 !* of the active source modules for the calibration function.
2558 !**********************************************************************
2560 COM /Lib_c1_src_info/ REAL Num_sources,Cal_src_label$[20]
2562 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
2564 DIM String$[500]
2566 !
2568 !Input setup string; some explanatory notes:
2570 ! RST Input modules must be in a known state.
2572 ! INTR 32 Any module can interrupt on error (data reg over-read).
2574 ! ICAL CALFE Connect front ends of inputs to the system cal line.
2576 ! SYNC ON Synced so digital filters produce simultaneous samples.
2578 ! TSRC SYS Trigger from the system trigger line.
2580 ! RQS 0 Only one input ('slowest') will SRQ to start thruput.
2582 !
2584 String$="RST;INTR 32;ICAL CALFE;SYNC ON;TSRC SYS"
2586 !
2588 !Send to all active input modules:
2590 Inpt_cmd("ALL INPUT",String$)
2592 !
2594 !Select input with longest data collection time to generate SRQ on
2596 !BAV (block available) to start thruput:
2598 Inpt_cmd(Max_tdly_label$,"RQS 2048")
2600 !
2602 !Source setup string; some explanatory notes:
2604 ! RST Source modules must be in a known state.
2606 ! INTR ____ Source can interrupt on ooos, error, or ovld.
2608 !
2610 String$="RST;INTR "&VAL$(4+32+128)
2612 !
2614 !Send to the source module that will generate calibration signals:
2616 Srce_cmd(Cal_src_label$,String$)
2618 !
2620 !Get all the source modules off the trigger line (Note that this won't
2622 !stop their outputs):
2624 Srce_cmd("ALL SOURCE","TRIGGER MODE","IGNORE TRIGGER")
2626 !
2628 SUBEXIT
2630 SUBEND
2632!
2634 Lib_recursive:SUB Lib_recursive
2636 ! See the BASIC Language Reference.
2638 ON ERROR GOTO Nevermind
2640 CALL Lib_recursive
2642 Nevermind:OFF ERROR
2645 SUBEND
2646 !
2652 Lib_c1_init_dft:SUB Lib_c1_init_dft
2654 !**********************************************************************
2656 !* This subroutine builds the DFT coefficient array. Of course, if you
2658 !* are doing FFT's in the 35651 instead, it is not necessary to call
2660 !* this routine.
2662 !**********************************************************************
2664 COM /Lib_c1_dft_coef/ REAL Dft_coef_real(*),Dft_coef_imag(*)
2666 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(*),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
2668 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$[20]
2670 REAL W_real,W_imag,Tr,Ti,Temp
2672 INTEGER N,Harmonic_num,I
2674 !
2676 N=Block_size
2678 !
2680 RAD
2682 Two_pi_n=-2.*PI/N
2684 FOR Harmonic_num=1 TO Num_harmonics
2686 DISP "Building DFT coefficient #"&VAL$(Harmonic_num)
2688 Angle=Two_pi_n*Cal_harmonics(Harmonic_num)
2690 W_real=COS(Angle)
2692 W_imag=SIN(Angle)
2694 Dft_coef_real(0,Harmonic_num)=1.
2696 Dft_coef_imag(0,Harmonic_num)=0.
2698 Dft_coef_real(1,Harmonic_num)=W_real
2700 Dft_coef_imag(1,Harmonic_num)=W_imag
2702 Tr=W_real
2704 Ti=W_imag
2706 FOR I=2 TO N-1
2708 Temp=(Tr*W_real)-(Ti*W_imag)
2710 Ti=(Ti*W_real)+(Tr*W_imag)
2712 Tr=Temp
2714 Dft_coef_real(I,Harmonic_num)=Tr
2716 Dft_coef_imag(I,Harmonic_num)=Ti
2718 NEXT I
2720 NEXT Harmonic_num
2722 DISP ""
2724 SUBEXIT
2726 SUBEND
2728!
2730 Lib_c1_init_con:SUB Lib_c1_init_con
2732 !**********************************************************************
2734 !* This subroutine builds the multi-frequency correction constants
2736 !* array. It returns the reciprical of the correction constants in
2738 !* preparation for a complex divide.
2740 !* Note: Included in the cal constants is the nominal phase ramp of the
2742 !* AA (anti-alias) filter. This phase ramp must be removed for
2744 !* absolute phase measurements. It is not necessary to remove the ramp
2746 !* from cross-channel measurements.
2748 !**********************************************************************
2750 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
2752 COM /Lib_c1_cal_con/ REAL Calcon_real(*),Calcon_imag(*)
2754 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(*),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
2756 COM /Lib_c1_first/ INTEGER Runned_before
2758 REAL Dbv,Angle,Null_range,Magsqr,Fs,F
2760 INTEGER Input_num,Harmonic_num
2762 !
2764 DISP "Initializing calibration constants . . ."
2766 Num_harmonics=20
2768 Fs=2.^18 !Multi-frequency calibration signal sample rate.
2770 R=698 !Ohms; For calibrator RC rolloff calculation.
2772 C=1.300E-9 !F; For calibrator RC rolloff calculation.
2774 Phase_ramp=475./51200. !Degrees; Nominal phase shift of AA filter
2776 !normalized to degrees per Hz.
2778 !
2780 Hz_per_harmonic=Fs/Block_size
2782 REDIM Calcon_real(1:MAX(1,Num_inputs),1:Num_harmonics)
2784 REDIM Calcon_imag(1:MAX(1,Num_inputs),1:Num_harmonics)
2786 !
2788 DEG
2790 RESTORE Lib_c1_con_data
2792 Cal_harmonics(-1)=-1.
2794 Cal_harmonics(0)=0.
2796 FOR Harmonic_num=1 TO Num_harmonics
2798 READ Cal_harmonics(Harmonic_num),Dbv,Angle
2800 Mag=10.^(Dbv/20.)
2802 !Table is in dBV RMS; change to dBV peak:
2804 Mag=Mag*SQR(2.)
2806 !
2808 !Calibrator RC rolloff correction:
2810 F=Cal_harmonics(Harmonic_num)*Hz_per_harmonic
2812 Mag=Mag/SQR(1.+((2.*PI*F*R*C)^2))
2814 Angle=Angle-ATN(2.*PI*F*R*C)
2816 !
2818 !AA filter phase ramp:
2820 Angle=Angle-(F*Phase_ramp)
2822 !
2824 T_real=Mag*COS(Angle)
2826 T_imag=Mag*SIN(Angle)
2828 Magsqr=(T_real*T_real)+(T_imag*T_imag)
2830 T_real=T_real/Magsqr
2832 T_imag=-1.*T_imag/Magsqr
2834 FOR Input_num=1 TO Num_inputs
2836 Calcon_real(Input_num,Harmonic_num)=T_real
2838 Calcon_imag(Input_num,Harmonic_num)=T_imag
2840 NEXT Input_num
2842 NEXT Harmonic_num
2844 DISP ""
2846 SUBEXIT
2848 !
2850 Lib_c1_con_data: !
2852 !Table includes a +3 sample trigger delay that accounts for
2854 !re-clocking between the 35653 and 35652 modules.
2856 DATA 1,-27.195,-5.21 !Harmonic #1
2858 DATA 5,-28.410,-102.81 !Harmonic #5
2860 DATA 10,-27.457,-176.30 !Harmonic #10
2862 DATA 15,-28.097,62.43 !Harmonic #15
2864 DATA 20,-28.489,133.46 !Harmonic #20
2866 DATA 25,-26.952,33.48 !Harmonic #25
2868 DATA 30,-27.728,-65.05 !Harmonic #30
2870 DATA 35,-27.280,50.05 !Harmonic #35
2872 DATA 40,-27.464,-80.14 !Harmonic #40
2874 DATA 41,-26.604,-176.65 !Harmonic #41
2876 DATA 42,-28.058,-145.39 !Harmonic #42
2878 DATA 43,-27.754,153.56 !Harmonic #43
2880 DATA 44,-28.625,-69.01 !Harmonic #44
2882 DATA 45,-27.836,-15.65 !Harmonic #45
2884 DATA 46,-27.499,-57.73 !Harmonic #46
2886 DATA 47,-27.666,147.27 !Harmonic #47
2888 DATA 48,-28.020,-111.16 !Harmonic #48
2890 DATA 49,-28.740,-77.23 !Harmonic #49
2892 DATA 50,-27.352,115.85 !Harmonic #50
2894 DATA 51,-27.873,-53.67 !Harmonic #51
2896 SUBEND
2898!
2900 Lib_c1_do_cal:SUB Lib_c1_do_cal(INTEGER Init)
2902 !**********************************************************************
2904 !* This subroutine does pass C1 of the calibration sequence. It
2906 !* calibrates the anti-alias (AA) filter using one range, known as the
2908 !* 'null path'. Sufficient local memory is allocated; the more active
2910 !* input modules, the more memory will be required.
2912 !* On entry, if Init is true, an initialization is performed first.
2914 !* An initialization should be requested if this is the first time this
2916 !* subroutine has been called and whenever the hardware setup has been
2918 !* changed.
2920 !**********************************************************************
2922 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
2924 COM /Lib_c1_overload/ INTEGER Ovld_buffer(*)
2926 COM /Lib_c1_src_info/ REAL Num_sources,Cal_src_label$
2928 COM /Lib_c1_dft_coef/ REAL Dft_coef_real(*),Dft_coef_imag(*)
2930 COM /Lib_c1_cal_con/ REAL Calcon_real(*),Calcon_imag(*)
2932 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(*),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
2934 COM /Lib_c1_cal_data/ REAL Error_mag(*),Error_phase(*),Mag_deriv(*),Phase_deriv(*),Freq(*)
2936 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
2938 REAL Full_scale,Two_db_over,Dig_filt_corr,Null_path_range,Scale_factor
2940 REAL Settling_time
2942 INTEGER Num_averages,Average_num,Input_num
2944 !
2946 !Initialize if requested:
2948 IF Init THEN CALL Lib_c1_init
2950 !
2952 IF No_c1_cal THEN
2954 IF NOT Init THEN CALL User_error("Error: Unable to perform requested calibration.")
2956 SUBEXIT
2958 END IF
2960 !
2962 !Calibration pass c1 (null path, multi-frequency AA filter calibration).
2964 Null_path_range=-8 !dBV peak.
2966 Num_averages=4 !Number of averages per cal phase (total is 2x).
2968 Settling_time=.25 !Seconds; settling time for cal bus coupling cap;
2970 !(4.4uF into 15k ohm worst case load).
2972 !
2974 !Scaling factors:
2976 Two_db_over=10.^(-2./20.) !Two dB overhead in front ends.
2978 Dig_filt_corr=15094.3657/32768. !Digital filter safe-scaling factor.
2980 Full_scale=Two_db_over*Dig_filt_corr*32768.
2982 Scale_factor=(10.^(Null_path_range/20.))/Full_scale
2984 Scale_factor=Scale_factor/(Block_size/2.)
2986 Scale_factor=Scale_factor/(2.*Num_averages)
2988 !
2990 !Setup and start input modules:
2992 Lib_c1_setup_c1
2994 Hw_wait_gbl_rdy
2996 Lib_c1_start
2998 !
3000 !Allocate enough memory to upload the thruput block from the 35651;
3002 !Allocate enough memory to do the correction math:
3004 DISP "Allocating memory . . ."
3006 ALLOCATE INTEGER Input_buffer(1:MAX(1,Num_inputs),0:Block_size-1)
3008 ALLOCATE REAL Average_buffer(1:MAX(1,Num_inputs),0:Block_size-1)
3010 ALLOCATE REAL Dft_result_real(1:MAX(1,Num_inputs),1:Num_harmonics),Dft_result_imag(1:MAX(1,Num_inputs),1:Num_harmonics)
3012 ALLOCATE Error_real(1:MAX(1,Num_inputs),1:Num_harmonics),Error_imag(1:MAX(1,Num_inputs),1:Num_harmonics)
3014 ALLOCATE Error_temp(1:MAX(1,Num_inputs),1:Num_harmonics)
3016 !
3018 !Re-dimension the final results buffers:
3020 REDIM Error_mag(1:MAX(1,Num_inputs),-1:Num_harmonics),Error_phase(1:MAX(1,Num_inputs),-1:Num_harmonics)
3022 REDIM Mag_deriv(1:MAX(1,Num_inputs),-1:Num_harmonics),Phase_deriv(1:MAX(1,Num_inputs),-1:Num_harmonics)
3024 REDIM Ovld_buffer(1:MAX(1,Num_inputs))
3026 DISP ""
3028 !
3030 MAT Average_buffer= (0.)
3032 MAT Ovld_buffer= (0)
3034 !
3036 !Collect Num_averages data blocks with normal cal signal:
3038 Srce_cmd(Cal_src_label$,"ICAL ON")
3040 Hw_wait_gbl_rdy
3042 WAIT Settling_time
3044 !Clear any leftover overloads:
3046 Inpt_cmd("ALL INPUT","STA?")
3048 Hw_wait_gbl_rdy
3050 !
3052 FOR Average_num=1 TO Num_averages
3054 !Collect a block of data:
3056 Hw_cmd("CONT;TRGU")
3058 !Input c1 data:
3060 Lib_c1_get_data(Input_buffer(*))
3062 MAT Average_buffer= Average_buffer+Input_buffer
3064 NEXT Average_num
3066 !
3068 !Collect Num_averages data blocks with inverted cal signal:
3070 Srce_cmd(Cal_src_label$,"ICAL INV")
3072 Hw_wait_gbl_rdy
3074 WAIT Settling_time
3076 !Clear any leftover overloads:
3078 Inpt_cmd("ALL INPUT","STA?")
3080 Hw_wait_gbl_rdy
3082 !
3084 FOR Average_num=1 TO Num_averages
3086 !Collect a block of data:
3088 Hw_cmd("CONT;TRGU")
3090 !Input c1 data:
3092 Lib_c1_get_data(Input_buffer(*))
3094 MAT Average_buffer= Average_buffer-Input_buffer
3096 NEXT Average_num
3098 !
3100 !Check for overloads:
3102 FOR Input_num=1 TO Num_inputs
3104 IF BIT(Ovld_buffer(Input_num),7) THEN
3106 User_error("Data buffer #"&VAL$(Input_num)&" overloaded; invalid.")
3108 Errored=1
3110 END IF
3112 NEXT Input_num
3114 !
3116 !Do the DFT to get the calibration values:
3118 DISP "Doing DFT . . ."
3120 MAT Dft_result_real= Average_buffer*Dft_coef_real
3122 MAT Dft_result_imag= Average_buffer*Dft_coef_imag
3124 MAT Dft_result_real= Dft_result_real*(Scale_factor)
3126 MAT Dft_result_imag= Dft_result_imag*(Scale_factor)
3128 !
3130 DISP "Calculating error . . ."
3132 MAT Error_real= Dft_result_real . Calcon_real
3134 MAT Error_temp= Dft_result_imag . Calcon_imag
3136 MAT Error_real= Error_real-Error_temp
3138 MAT Error_imag= Dft_result_imag . Calcon_real
3140 MAT Error_temp= Dft_result_real . Calcon_imag
3142 MAT Error_imag= Error_imag+Error_temp
3144 DISP ""
3146 !
3148 !Calculate magnitude squared and phase from real and imaginary data:
3150 Lib_c1_rect_plr(Error_real(*),Error_imag(*))
3152 !Fit cubic spline to the mag and phase data:
3154 Lib_c1_cub_spln
3156 !
3158 SUBEXIT
3160 SUBEND
3162!
3164 Lib_c1_rect_plr:SUB Lib_c1_rect_plr(REAL Error_real(*),Error_imag(*))
3166 !**********************************************************************
3168 !* This routine does a rectangular to polar conversion on the
3170 !* C1 calibration pass error arrays. The routine attempts to keep the
3172 !* phase continuous (no 360 degree phase jumps); it can only do this if
3174 !* the phase jumps between points are less than Max_phase_jump.
3176 !* Two more data points are added to the beginning of the cal error
3178 !* arrays in order to keep the cubic spline well-behaved around 0 Hz.
3180 !**********************************************************************
3182 COM /Lib_c1_cal_data/ REAL Error_mag(*),Error_phase(*),Mag_deriv(*),Phase_deriv(*),Freq(*)
3184 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
3186 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(*),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
3188 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
3190 REAL Real,Imag,Angle,Previous_angle,Max_phase_jump
3192 INTEGER Input_num,Harmonic_num
3194 !
3196 DISP "Doing rectangular to polar conversion . . ."
3198 Max_phase_jump=90. !+-Degrees.
3200 !
3202 DEG
3204 FOR Input_num=1 TO Num_inputs
3206 Real=Error_real(Input_num,1)
3208 Imag=Error_imag(Input_num,1)
3210 Error_mag(Input_num,-1)=(Real*Real)+(Imag*Imag)
3212 Error_mag(Input_num,0)=(Real*Real)+(Imag*Imag)
3214 Error_mag(Input_num,1)=(Real*Real)+(Imag*Imag)
3216 Angle=FNLib_c1_phi(Real,Imag)
3218 Error_phase(Input_num,-1)=-Angle
3220 Error_phase(Input_num,0)=0.
3222 Error_phase(Input_num,1)=Angle
3224 FOR Harmonic_num=2 TO Num_harmonics
3226 Previous_angle=Angle
3228 Real=Error_real(Input_num,Harmonic_num)
3230 Imag=Error_imag(Input_num,Harmonic_num)
3232 Error_mag(Input_num,Harmonic_num)=(Real*Real)+(Imag*Imag)
3234 Angle=FNLib_c1_phi(Real,Imag)
3236 IF ABS(Angle-Previous_angle)>Max_phase_jump THEN
3238 IF ABS(Angle-360-Previous_angle)<=Max_phase_jump THEN
3240 Angle=Angle-360
3242 ELSE
3244 IF ABS(Angle+360-Previous_angle)<=Max_phase_jump THEN
3246 Angle=Angle+360
3248 ELSE
3250 User_error("Calibration error; phase jump of more than "&VAL$(Max_phase_jump)&" degrees.")
3252 Errored=1
3254 END IF
3256 END IF
3258 END IF
3260 Error_phase(Input_num,Harmonic_num)=Angle
3262 NEXT Harmonic_num
3264 NEXT Input_num
3266 DISP ""
3268 !
3270 SUBEXIT
3272 SUBEND
3274!
3276 Lib_c1_phi:DEF FNLib_c1_phi(REAL X,Y)
3278 !**********************************************************************
3280 !* This function returns the polar angle corresponding to the
3282 !* rectangular coordinates X,Y. A 'DEG' command should have been
3284 !* executed before entry.
3286 !**********************************************************************
3288 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
3290 REAL Angle,Phi
3292 !
3294 IF X=0 THEN
3296 SELECT Y
3298 CASE =0
3300 User_error("FNCAL_Phi: **ERROR** BOTH ARGUMENTS ZERO")
3302 Errored=1
3304 Phi=0.
3306 CASE >0
3308 Phi=90.
3310 CASE <0
3312 Phi=-90.
3314 END SELECT
3316 RETURN Phi
3318 END IF
3320 IF Y=0 AND X<0 THEN
3322 Phi=180
3324 RETURN Phi
3326 END IF
3328 Angle=ATN(Y/X)
3330 Phi=Angle
3332 IF Angle>0. AND X<0. THEN Phi=Phi-180.
3334 IF Angle<0. AND X<0. THEN Phi=Phi+180.
3336 RETURN Phi
3338 FNEND
3340 !
3342 Lib_c1_cub_spln:SUB Lib_c1_cub_spln
3344 !**********************************************************************
3346 !* This subroutine calculates the coefficients needed for a cubic
3348 !* spline interpolation of the C1 magnitude and phase data. The
3350 !* subroutine generates a table of the second derivatives of the
3352 !* derived spline function. The algorithm is straight out of "Numerical
3354 !* Methods" by Robert W. Hornbeck (Quantum Publishers, Inc, 257 Park
3356 !* Avenue South, New York, N.Y. 10010; Daniel Schaum, Publisher, C 1975).
3358 !* This subroutine solves the tridiagonal set of linear equations
3360 !* described by equation 4.29 on page 48. The solution is found by what
3362 !* is essentially the Gauss Elimination method described in section 6.4.
3364 !**********************************************************************
3366 COM /Lib_c1_cal_data/ REAL Error_mag(*),Error_phase(*),Mag_deriv(*),Phase_deriv(*),Freq(*)
3368 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
3370 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(*),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
3372 INTEGER I,Harmonic_num,Pass_num,Input_num
3374 REAL Del1,Del0,Temp,Temp1,Temp2,Ym1,Y,Yp1
3376 !
3378 DISP "Calculating cubic spline coefficients . . ."
3380 !
3382 !Set up frequency array:
3384 FOR Harmonic_num=-1 TO Num_harmonics
3386 Freq(Harmonic_num)=Hz_per_harmonic*Cal_harmonics(Harmonic_num)
3388 NEXT Harmonic_num
3390 !
3392 !Setup some local working memory:
3394 ALLOCATE REAL A(0:Num_harmonics-1),B(0:Num_harmonics-1),D(0:Num_harmonics-1)
3396 !
3398 FOR Pass_num=1 TO 2
3400 FOR Input_num=1 TO Num_inputs
3402 !
3404 !Calculate local working coefficients:
3406 FOR I=0 TO Num_harmonics-1
3408 IF Pass_num=1 THEN
3410 Ym1=Error_mag(Input_num,I-1)
3412 Y=Error_mag(Input_num,I)
3414 Yp1=Error_mag(Input_num,I+1)
3416 ELSE
3418 Ym1=Error_phase(Input_num,I-1)
3420 Y=Error_phase(Input_num,I)
3422 Yp1=Error_phase(Input_num,I+1)
3424 END IF
3426 Del1=Freq(I+1)-Freq(I)
3428 Del0=Freq(I)-Freq(I-1)
3430 A(I)=Del0/Del1
3432 B(I)=2.*(Freq(I+1)-Freq(I-1))/Del1
3434 D(I)=6.*(((Yp1-Y)/(Del1*Del1))-((Y-Ym1)/(Del1*Del0)))
3436 NEXT I
3438 !
3440 !Work through equations to solve for last non_zero 2nd derivative:
3442 IF Num_harmonics>3 THEN
3444 FOR I=1 TO Num_harmonics-1
3446 B(I)=B(I)-(A(I)/B(I-1))
3448 D(I)=D(I)-(A(I)*D(I-1)/B(I-1))
3450 NEXT I
3452 END IF
3454 !
3456 !Now work backwards through equations solving for 2nd derivatives:
3458 IF Pass_num=1 THEN
3460 Mag_deriv(Input_num,Num_harmonics)=0.
3462 Mag_deriv(Input_num,Num_harmonics-1)=D(Num_harmonics-1)/B(Num_harmonics-1)
3464 IF Num_harmonics>3 THEN
3466 FOR I=(Num_harmonics-2) TO 0 STEP -1
3468 Mag_deriv(Input_num,I)=(D(I)-Mag_deriv(Input_num,I+1))/B(I)
3470 NEXT I
3472 END IF
3474 Mag_deriv(Input_num,-1)=0.
3476 !
3478 ELSE
3480 Phase_deriv(Input_num,Num_harmonics)=0.
3482 Phase_deriv(Input_num,Num_harmonics-1)=D(Num_harmonics-1)/B(Num_harmonics-1)
3484 IF Num_harmonics>3 THEN
3486 FOR I=(Num_harmonics-2) TO 0 STEP -1
3488 Phase_deriv(Input_num,I)=(D(I)-Phase_deriv(Input_num,I+1))/B(I)
3490 NEXT I
3492 END IF
3494 Phase_deriv(Input_num,-1)=0.
3496 END IF
3498 NEXT Input_num
3500 NEXT Pass_num
3502 DISP ""
3504 !
3506 SUBEXIT
3508 SUBEND
3510!
3512 Lib_c1_make_mag:SUB Lib_c1_make_mag(REAL Mag(*),Start_freq,Stop_freq,INTEGER Input_num)
3514 !**********************************************************************
3516 !* This subroutine interpolates a magnitude correction array from the
3518 !* calibration data and the second derivative array. The cubic
3520 !* spline interpolation algorithm used is straight out of "Numerical
3522 !* Methods" by Robert W. Hornbeck (Quantum Publishers, Inc, 257 Park
3524 !* Avenue South, New York, N.Y. 10010; Daniel Schaum, Publisher, C 1975).
3526 !* This subroutine solves the equation 4.26 on page 48. When requested
3528 !* frequency values are outside the cal range, the default correction
3530 !* (1 at 0 degrees) is used.
3532 !**********************************************************************
3534 COM /Lib_c1_cal_data/ REAL Error_mag(*),Error_phase(*),Mag_deriv(*),Phase_deriv(*),Freq(*)
3536 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(*),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
3538 INTEGER Num_points,First_point,Last_point,Harmonic_num,Redo_coef
3540 REAL Delx,T1,T2,Del_freq,Freq_val,Y,Y1,G,G1
3542 !
3544 First_point=BASE(Mag,1)
3546 Num_points=SIZE(Mag,1)
3548 Last_point=Num_points+First_point-1
3550 Del_freq=(Stop_freq-Start_freq)/(Num_points-1.)
3552 !
3554 Freq_val=Start_freq
3556 Point_num=First_point
3558 !
3560 !Frequency values less than 0 Hz:
3562 WHILE Freq_val<0 AND Point_num<=Last_point
3564 Mag(Point_num)=1.
3566 Point_num=Point_num+1
3568 Freq_val=Freq_val+Del_freq
3570 END WHILE
3572 !
3574 !Frequency values in the cal frequency range:
3576 Harmonic_num=1
3578 Redo_coef=1
3580 LOOP
3582 EXIT IF Harmonic_num>Num_harmonics OR Point_num>Last_point
3584 IF Freq_val>Freq(Harmonic_num) THEN
3586 Harmonic_num=Harmonic_num+1
3588 Redo_coef=1
3590 ELSE
3592 IF Redo_coef THEN
3594 Delx=Freq(Harmonic_num)-Freq(Harmonic_num-1)
3596 Y=Error_mag(Input_num,Harmonic_num-1)
3598 Y1=Error_mag(Input_num,Harmonic_num)
3600 G=Mag_deriv(Input_num,Harmonic_num-1)
3602 G1=Mag_deriv(Input_num,Harmonic_num)
3604 Redo_coef=0
3606 END IF
3608 T1=Freq(Harmonic_num)-Freq_val
3610 T2=Freq_val-Freq(Harmonic_num-1)
3612 Mag(Point_num)=((G/6.)*((T1*T1*T1/Delx)-(Delx*T1)))+((G1/6.)*((T2*T2*T2/Delx)-(Delx*T2)))+(Y*(T1/Delx))+(Y1*(T2/Delx))
3614 Freq_val=Freq_val+Del_freq
3616 Point_num=Point_num+1
3618 END IF
3620 END LOOP
3622 !
3624 !Frequency values greater than the last cal frequency:
3626 WHILE Point_num<=Last_point
3628 Mag(Point_num)=1.
3630 Point_num=Point_num+1
3632 Freq_val=Freq_val+Del_freq
3634 END WHILE
3636 SUBEXIT
3638 !
3640 SUBEND
3642!
3644 Lib_c1_make_pha:SUB Lib_c1_make_pha(REAL Phase(*),Start_freq,Stop_freq,INTEGER Input_num)
3646 !**********************************************************************
3648 !* This subroutine interpolates a phase correction array from the
3650 !* calibration data and the second derivative array. The cubic
3652 !* spline interpolation algorithm used is straight out of "Numerical
3654 !* Methods" by Robert W. Hornbeck (Quantum Publishers, Inc, 257 Park
3656 !* Avenue South, New York, N.Y. 10010; Daniel Schaum, Publisher, C 1975).
3658 !* This subroutine solves the equation 4.26 on page 48. When requested
3660 !* frequency values are outside the cal range, the default correction
3662 !* (1 at 0 degrees) is used.
3664 !**********************************************************************
3666 COM /Lib_c1_cal_data/ REAL Error_mag(*),Error_phase(*),Mag_deriv(*),Phase_deriv(*),Freq(*)
3668 COM /Lib_c1_harm_dat/ REAL Cal_harmonics(*),INTEGER Num_harmonics,REAL Phase_ramp,Hz_per_harmonic
3670 INTEGER Num_points,First_point,Last_point,Harmonic_num,Redo_coef
3672 REAL Delx,T1,T2,Del_freq,Freq_val,Y,Y1,G,G1
3674 !
3676 First_point=BASE(Phase,1)
3678 Num_points=SIZE(Phase,1)
3680 Last_point=Num_points+First_point-1
3682 Del_freq=(Stop_freq-Start_freq)/(Num_points-1.)
3684 !
3686 Freq_val=Start_freq
3688 Point_num=First_point
3690 !
3692 !Frequency values less than 0 Hz:
3694 WHILE Freq_val<0 AND Point_num<=Last_point
3696 Phase(Point_num)=0.
3698 Point_num=Point_num+1
3700 Freq_val=Freq_val+Del_freq
3702 END WHILE
3704 !
3706 !Frequency values in the cal frequency range:
3708 Harmonic_num=1
3710 Redo_coef=1
3712 LOOP
3714 EXIT IF Harmonic_num>Num_harmonics OR Point_num>Last_point
3716 IF Freq_val>Freq(Harmonic_num) THEN
3718 Harmonic_num=Harmonic_num+1
3720 Redo_coef=1
3722 ELSE
3724 IF Redo_coef THEN
3726 Delx=Freq(Harmonic_num)-Freq(Harmonic_num-1)
3728 Y=Error_phase(Input_num,Harmonic_num-1)
3730 Y1=Error_phase(Input_num,Harmonic_num)
3732 G=Phase_deriv(Input_num,Harmonic_num-1)
3734 G1=Phase_deriv(Input_num,Harmonic_num)
3736 Redo_coef=0
3738 END IF
3740 T1=Freq(Harmonic_num)-Freq_val
3742 T2=Freq_val-Freq(Harmonic_num-1)
3744 Phase(Point_num)=((G/6.)*((T1*T1*T1/Delx)-(Delx*T1)))+((G1/6.)*((T2*T2*T2/Delx)-(Delx*T2)))+(Y*(T1/Delx))+(Y1*(T2/Delx))
3746 Freq_val=Freq_val+Del_freq
3748 Point_num=Point_num+1
3750 END IF
3752 END LOOP
3754 !
3756 !Frequency values greater than the last cal frequency:
3758 WHILE Point_num<=Last_point
3760 Phase(Point_num)=0.
3762 Point_num=Point_num+1
3764 Freq_val=Freq_val+Del_freq
3766 END WHILE
3768 SUBEXIT
3770 !
3772 SUBEND
3774!
3776 Lib_c1_gme_ovld:SUB Lib_c1_gme_ovld(INTEGER D_ovld_buffer(*))
3778 !**********************************************************************
3780 !* This subroutine returns the C1 calibration overload buffer array.
3782 !* The output array should have a least as many elements as there are
3784 !* active input channnels.
3786 !**********************************************************************
3788 COM /Lib_c1_overload/ INTEGER Ovld_buffer(*)
3790 COM /Lib_c1_inp_info/ REAL Num_inputs,INTEGER Block_size,Max_tdly_label$
3792 INTEGER Offset,I
3794 !
3796 Offset=BASE(D_ovld_buffer,1)-1
3798 FOR I=1 TO Num_inputs
3800 D_ovld_buffer(I+Offset)=Ovld_buffer(I)
3802 NEXT I
3804 !
3806 SUBEXIT
3808 SUBEND
3810 !
3812 Lib_c1_errored:DEF FNLib_c1_errored
3814 !**********************************************************************
3816 !* This subroutine returns true if the C1 calibration cycle errored.
3818 !**********************************************************************
3820 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
3822 RETURN Errored
3824 FNEND
3826 !
3828 Lib_c1_aborted:DEF FNLib_c1_aborted
3830 !**********************************************************************
3832 !* This subroutine returns true if the C1 calibration was aborted (no
3834 !* input or source modules).
3836 !**********************************************************************
3838 COM /Lib_c1_error/ INTEGER Errored,No_c1_cal
3840 RETURN No_c1_cal
3842 FNEND
3844 !
3846 Lib_crt_height:DEF FNLib_crt_height
3848 ! Returns CRT height (number of lines)
3850 STATUS CRT,13;Crt_height
3852 RETURN Crt_height
3854 FNEND
3856 !
3858 ! PAGE ->
3860 !**********************************************************************
3862 Lib_crt_width:DEF FNLib_crt_width
3864 ! Returns the CRT width (number of characters)
3866 STATUS CRT,9;Crt_width
3868 RETURN Crt_width
3870 FNEND
3872 !
3874 ! PAGE ->
3876 !**********************************************************************