2 ! OUTPUT 2 USING "#,K";"<lf>REN 2,2<cr>INDENT<cr><lf>RE-STORE ""DIAG""<cr>"
4 !
6 !*************************************************************************
8 !
10 ! DIAG file
12 !
14 ! This is the DIAG file. It contains a spreadsheet that can be used to
16 ! test the three types of modules. It also contains a command interface
18 ! that provides a convient method of sending commands and reading responses
20 ! back from the modules. Both of these subprograms use only the active
22 ! modules as defined by the CNFG file. There are also some subprograms
24 ! that provide convenient methods of checking for errors. The following
26 ! is a description of some of the subprograms in this file. These are the
28 ! only subprograms that should need to be called from other files or
30 ! applications. Additional documentation is included in-line with each
32 ! subprogram.
34 !
36 !
38 ! Subprograms available to user :
40 !
42 ! Diag_diag
44 !
46 ! 'Poweron Initialization' for the DIAG file
48 !
50 ! Diag_main
52 !
54 ! Used to invoke the Diagnostics spreadsheet.
56 !
58 ! Diag_comint
60 !
62 ! Command interface subprogram. Allows sending
64 ! commands and querying any active module.
66 !
68 ! FNDiag_chk_errors
70 !
72 ! Function checks all active modules for any errors.
74 ! If an error is found, an error message is printed
76 ! and the function returns true (1). If no errors
78 ! are found, nothing is printed and the function
80 ! returns false (0).
82 !
84 ! FNDiag_chk_moderr(M_label$)
86 !
88 ! Function checks specified module for any errors.
90 ! If an error is found, an error message is printed
92 ! and the function returns true (1). If no errors
94 ! are found, nothing is printed and the function
96 ! returns false (0).
98 !
100!*************************************************************************
102 !
104 END
106 ! PAGE ->
108 !************************************************************************
110 Diag_diag:SUB Diag_diag
112 !
114 ! Diag_diag should be called the first time this file is run after
116 ! it is loaded. It sets up the data used in the Diag spreadsheet.
118 ! It also contains a copy of every common declaration in the DIAG
120 ! file.
122 !
124 COM /Diag_com/ Active_type$[20],Module_addr$[16]
126 COM /Diag_kbd/ Kbd_string$[200]
128 COM /Diag_spread/ Row,Col,Start_row
130 COM /Diag_boxes/ Box$(1:6,1:67)[20]
132 COM /Diag_title/ Title$(1:6,0:2)[25]
134 COM /Diag_prompt/ Prompt$(1:6)[80]
136 COM /Diag_width/ Col_width(1:6)
138 COM /Diag_max/ Max_col,Max_row,Modify_col
140 COM /Diag_tests/ Tests$(0:3,0:10)[12],Max_tests
142 COM /Diag_hp_ib/ Hp_ib_addr
144 COM /Diag_meas_setup/ Zooming,Span,Cf,Range,Ovld
146 COM /Diag_wincom/ INTEGER Ncom,REAL Winval(1:1024)
148 !
150 ! Module_addr$ and Active_type$ contain the current active module
152 ! (and its type) for use in the Diag_comint subprogram.
154 !
156 ! Kbd_string$ is used in the keyboard handler subprograms of the
158 ! Diag_comint subprogram. It keeps key presses that have not been
160 ! processed.
162 !
164 ! Row, Col, and Start_row determine the cursor position in the input
166 ! spreadsheet. They are in common so that if the spreadsheet is
168 ! exited and then re-entered, the cursor will remember where it was.
170 !
172 ! Box$ is the array of boxes in the Diag spreadsheet.
174 !
176 ! Title$ is the array of titles for the top of each column of the
178 ! spreadsheet.
180 !
182 ! Prompt$ if an array of the prompts for each column of the
184 ! spreadsheet.
186 !
188 ! Column_width is an array of the column widths for each column
190 ! of the spreadsheet. Max_col and Max_row define the size of the
192 ! spreadsheet. Modify_col is the first column that the user can
194 ! modify.
196 !
198 ! Tests$ contains a list, for each type of module, of the possible
200 ! tests the user can select for that module in the Diag spreadsheet.
202 ! The first dimension is the type code of the module as returned by
204 ! the FNDiag_type_code function. Note that a 0 cooresponds to a
206 ! non-valid module type which is used for the All Modules row in the
208 ! spreadsheet. Max_tests is the maximum number of tests possible
210 ! for each type of module.
212 !
214 ! Hp_ib_addr is the module address of the Hp-ib module.
216 !
218 ! Zooming, Span, Cf, and Range are used in the Diag_do_meas
220 ! subprograms to pass the current state of the input module making
222 ! the measurement. Ovld is used to indicate that an overload has
224 ! occurred during the measurement being taken.
226 !
228 ! Winval keeps a copy of the last window array computed so that
230 ! subsequent window operations will not have to re-compute the
232 ! window. Ncom is the blocksize of the window in the Winval array.
234 !
236 Kbd_string$=""
238 Active_type$="HP-IB"
240 Module_addr$="HP-IB"
242 !
244 Row=1
246 Col=5
248 Start_row=0
250 Max_col=6
252 Max_row=67
254 Modify_col=5
256 !
258 ! read the spreadsheet data into arrays
260 Title$(1,0)="Diagnostics Spreadsheet"
262 FOR C=1 TO Max_col
264 READ Col_width(C),Title$(C,1),Title$(C,2),Prompt$(C)
266 NEXT C
268 !
270 ! These data statements define the setup and titles for each column
272 ! in the Diag spreadsheet.
274 !
276 ! col_width title1 title2 Prompt
278 ! --------- ---------- ---------- --------------------
280 DATA 18, "Module", "Name", ""
282 DATA 12, "Module", "Address", ""
284 DATA 8, "Module", "Type", ""
286 DATA 8, "Status", "", ""
288 DATA 12, "Current", "Test", "Use next/prev to select test"
290 DATA 16, "Reference", "Module", "Use next/prev to select module"
292 !
294 !
296 ! Read available tests into array
298 Max_tests=10
300 FOR Module=0 TO 3
302 FOR Test_type=0 TO Max_tests
304 READ Tests$(Module,Test_type)
306 NEXT Test_type
308 NEXT Module
310 !
312 ! These data statements define the possible tests for each
314 ! each type of module. The first set of tests is for the
316 ! All Modules row in the Diag spreadsheet, and should contain
318 ! the tests that are common to all the modules. Note that for
320 ! each module type, there must be at least one null ("") string
322 ! at the end of the list of tests.
324 !
326 ! *** Common tests ***
328 DATA "No Test","Self Test",""
330 DATA "","","","","","","",""
332 ! *** HP-IB tests ***
334 DATA "No Test","Self Test",""
336 DATA "","","","","","","",""
338 ! *** Input tests ***
340 DATA "No Test", "Self Test","Simple A/D","Complex A/D",
342 DATA "Complex FE","Digital"
344 DATA "","","","",""
346 ! *** Source tests ***
348 DATA "No Test", "Self Test","Sine","Random","Offset",""
350 DATA "","","","","",""
352 SUBEND
354 ! PAGE ->
356 !************************************************************************
358 Diag_main:SUB Diag_main
360 !
362 ! This subprogram should be called when the Diag spreadsheet is to
364 ! be displayed. It calls subprograms to initialize the spreadsheet
366 ! and then display it.
368 !
370 Diag_init
372 Diag_spread
374 SUBEND
376 ! PAGE ->
378 !************************************************************************
380 Diag_init:SUB Diag_init
382 !
384 ! This routine initializes the Diag spreadsheet. It uses the CNFG
386 ! file to determine what modules are in the system and fills in
388 ! Box$ appropriately.
390 !
392 COM /Diag_spread/ Row,Col,Start_row !keep these in com for memory
394 COM /Diag_boxes/ Box$(*)
396 COM /Diag_title/ Title$(*)
398 COM /Diag_prompt/ Prompt$(*)
400 COM /Diag_width/ Col_width(*)
402 COM /Diag_max/ Max_col,Max_row,Modify_col
404 COM /Diag_tests/ Tests$(*),Max_tests
406 COM /Diag_hp_ib/ Hp_ib_addr
408 DIM New_entry$[160],Current$[20],Def_reference$(1:3)[16]
410 !
412 ALLOCATE All_labels$(1:63)[16]
414 !
416 MAT Def_reference$= ("")
418 Cnfg_labels("ALL INPUT",All_labels$(*),Num_labels)
420 IF Num_labels<>0 THEN
422 Def_reference$(FNDiag_type_code("SOURCE"))=All_labels$(1)
424 END IF
426 !
428 Cnfg_labels("ALL SOURCE",All_labels$(*),Num_labels)
430 IF Num_labels<>0 THEN
432 Def_reference$(FNDiag_type_code("INPUT"))=All_labels$(1)
434 END IF
436 !
438 Cnfg_labels("ALL",All_labels$(*),Num_labels)
440 Num_labels=Num_labels+1 ! HP-IB
442 !
444 !fill Box$ array with initial data
446 Max_row=Num_labels+3
448 REDIM Box$(1:6,1:(Max_row))
450 MAT Box$= ("")
452 Box$(1,1)="All Modules"
454 Box$(1,2)="All Inputs "
456 Box$(3,2)="INPUT"
458 Box$(1,3)="All Sources"
460 Box$(3,3)="SOURCE"
462 !
464 Hp_ib_addr=VAL(FNHw_cmd_rsp$("MAD?"))
466 Box_posn=4
468 Put_hp_ib=0
470 FOR Label_ptr=1 TO Num_labels-1
472 Module_slot=FNCnfg_get_modnum(All_labels$(Label_ptr))
474 IF (NOT Put_hp_ib) AND (Module_slot>Hp_ib_addr) THEN
475 Box$(1,Box_posn)="HP-IB"
476 Box$(2,Box_posn)=FNDiag_cnvt_addr$(Hp_ib_addr)
477 Box$(3,Box_posn)="HP-IB"
478 Box$(4,Box_posn)="?"
479 Box$(5,Box_posn)=Tests$(0,0)
480 Box$(6,Box_posn)=""
481 Box_posn=Box_posn+1
482 Put_hp_ib=1
483 END IF
494 Box$(1,Box_posn)=All_labels$(Label_ptr)
496 Box$(2,Box_posn)=FNDiag_cnvt_addr$(Module_slot)
498 Box$(3,Box_posn)=UPC$(FNCnfg_type$(All_labels$(Label_ptr)))
500 Box$(4,Box_posn)="?"
502 Type_code=FNDiag_type_code(Box$(3,Box_posn))
504 Box$(5,Box_posn)=Tests$(Type_code,0)
506 Box$(6,Box_posn)=Def_reference$(Type_code)
508 Box_posn=Box_posn+1
510 NEXT Label_ptr
512 !
513 IF (NOT Put_hp_ib) THEN
514 Box$(1,Box_posn)="HP-IB"
515 Box$(2,Box_posn)=FNDiag_cnvt_addr$(Hp_ib_addr)
516 Box$(3,Box_posn)="HP-IB"
517 Box$(4,Box_posn)="?"
518 Box$(5,Box_posn)=Tests$(0,0)
519 Box$(6,Box_posn)=""
520 Box_posn=Box_posn+1
521 Put_hp_ib=1
522 END IF
523 SUBEXIT
524 SUBEND
525 ! PAGE ->
526 !************************************************************************
527 Diag_spread:SUB Diag_spread
528 !
529 ! This subprogram displays and allows modification of the Diag
530 ! spreadsheet. Note that this subprogram can reset the parameters
531 ! of any of the modules.
532 !
533 COM /Diag_spread/ Row,Col,Start_row
534 COM /Diag_boxes/ Box$(*)
535 COM /Diag_title/ Title$(*)
536 COM /Diag_prompt/ Prompt$(*)
537 COM /Diag_width/ Col_width(*)
538 COM /Diag_max/ Max_col,Max_row,Modify_col
539 COM /Diag_tests/ Tests$(*),Max_tests
540 DIM New_entry$[160],Current$[20],Def_reference$(1:3)[16]
541 DIM Search_type$[10],Npsearch_type$[10]
542 !
543 Num_labels=Max_row-3
544 !
545 GOSUB Diag_setup_keys
546 User_clr_scr
547 !
548 !Now call spread sheet. It returns with New_entry$ and Row and Col
549 Done=0
550 REPEAT
551 CALL User_spread(Box$(*),Title$(*),Prompt$(*),New_entry$,Col_width(*),Modify_col,Col,Row,Start_row)
552 SELECT FNUser_check_key
553 CASE 0 !no key pressed, must be a New_entry$ for Box
554 Dummy=FNUser_get_key
555 GOSUB Diag_newentry
556 CASE 1 ! Do Test
557 Dummy=FNUser_get_key !to clear the key
558 GOSUB Diag_do_tests
559 CASE 3 ! Command Interface
560 Dummy=FNUser_get_key
561 Diag_comint
562 User_clr_scr
563 CASE 5
564 Dummy=FNUser_get_key
565 Done=1
566 CASE 7 ! Previous
567 Dummy=FNUser_get_key
568 Offset=-1
569 GOSUB Diag_next_prev
570 CASE 8 ! Next
571 Dummy=FNUser_get_key
572 Offset=1
573 GOSUB Diag_next_prev
574 CASE ELSE !a softkey but not one of mine, so exit
575 Dummy=FNUser_get_key
576 BEEP
577 END SELECT
578 UNTIL Done
579 CALL User_clr_scr
580 SUBEXIT
581 !
582 ! This subroutine does the test(s) specified by the current position
583 ! of the cursor.
584 !
585 Diag_do_tests: !
586 FOR Keynum=1 TO 7
587 ON KEY Keynum LABEL "" GOSUB Diag_sprd_dum
588 NEXT Keynum
589 ON KEY 8 LABEL FNUser_keylabel$("ABORT TESTS") RECOVER Diag_tests_abrt
590 !
591 IF Row<=3 THEN
592 Strt_r=4
593 Stop_r=Max_row
594 Search_type$=Box$(3,Row)
595 ELSE
596 Strt_r=Row
597 Stop_r=Row
598 Search_type$=""
599 END IF
600 FOR R=Strt_r TO Stop_r
601 IF (Search_type$=Box$(3,R)) OR (Search_type$="") THEN
602 Diag_do_test(Box$(1,R),Box$(5,R),Box$(6,R),Box$(4,R))
603 END IF
604 NEXT R
605 !
606 Diag_tests_abrt: !
607 GOSUB Diag_setup_keys
608 RETURN
609 !
610 Diag_sprd_dum: !
611 BEEP
612 RETURN
613 !
614 ! This subroutine finds the best match to what the user entered
615 ! and updates Box$ appropriately.
616 !
617 Diag_newentry:!
618 Type_code=FNDiag_type_code(Box$(3,Row))
619 IF Col=5 THEN ! TEST
620 Lib_match2(New_entry$,Tests$(*),Type_code,Found,Choice_num)
621 IF NOT Found THEN
622 BEEP
623 Current$=""
624 ELSE
625 Current$=Tests$(Type_code,Choice_num)
626 END IF
627 ELSE ! REF MODULE
628 IF Box$(3,Row)="INPUT" THEN
629 Search_type$="SOURCE"
630 ELSE
631 IF Box$(3,Row)="SOURCE" THEN
632 Search_type$="INPUT"
633 ELSE
634 BEEP
635 RETURN
636 END IF
637 END IF
638 ALLOCATE Temp_labels$(1:(Max_row-3))[16]
639 Tr=0
640 FOR R=4 TO Max_row
641 IF Box$(3,R)=Search_type$ THEN
642 Tr=Tr+1
643 Temp_labels$(Tr)=Box$(1,R)
644 END IF
645 NEXT R
646 REDIM Temp_labels$(1:Tr)
647 Lib_match1(New_entry$,Temp_labels$(*),Found,Choice_num)
648 IF NOT Found THEN
649 BEEP
650 Current$=""
651 ELSE
652 Current$=Temp_labels$(Choice_num)
653 END IF
654 DEALLOCATE Temp_labels$(*)
655 END IF
656 !
657 IF Current$="" THEN RETURN
658 !
659 IF Row<4 THEN
660 R=3
661 Stop_r=Max_row
662 Search_type$=Box$(3,Row)
663 GOSUB Diag_set_all
664 ELSE
665 Box$(Col,Row)=Current$
666 Box$(4,Row)="?"
667 END IF
668 RETURN
669 !
670 ! This routine is called when the next or previous softkeys are
671 ! pressed. The offset variable should be set to +1 for next and
672 ! -1 for previous.
673 !
674 Diag_next_prev: !
675 IF (Box$(3,Row)="HP-IB") AND (Col=6) THEN RETURN
676 !
677 IF Row>3 THEN
678 Strt_r=Row
679 Stop_r=Row
680 Search_type$=Box$(3,Row)
681 ELSE
682 Strt_r=4
683 Stop_r=Max_row
684 IF (Row=1) AND (Col=6) THEN
685 BEEP
686 RETURN
687 END IF
688 Search_type$=Box$(3,Row)
689 END IF
690 !
691 Type_code=FNDiag_type_code(Box$(3,Row))
692 !
693 R=Strt_r
694 WHILE (Search_type$<>Box$(3,R)) AND (Search_type$<>"") AND (R<Stop_r)
695 R=R+1
696 END WHILE
697 !
698 IF (Search_type$<>Box$(3,R)) AND (Search_type$<>"") THEN RETURN
699 !
700 Current$=Box$(Col,R)
701 IF Col=5 THEN
702 GOSUB Diag_np_test
703 ELSE
704 GOSUB Diag_np_ref
705 END IF
706 Current$=Box$(Col,R)
707 Box$(4,R)="?"
708 !
709 GOSUB Diag_set_all
710 !
711 RETURN
712 !
713 ! This subroutine is used by previous subroutines to set all the
714 ! modules of a given type to a specified state. Col should be
715 ! set to the column to update. R should be set to the row previous
716 ! to the next row to update. Search_type$ should be set to the
717 ! module type to update ("" is used for all modules).
718 !
719 Diag_set_all:!
720 WHILE R<Stop_r
721 REPEAT
722 R=R+1
723 IF R>Stop_r THEN RETURN
724 UNTIL (Search_type$=Box$(3,R)) OR (Search_type$="")
725 !
726 Box$(Col,R)=Current$
727 Box$(4,R)="?"
728 END WHILE
729 !
730 RETURN
731 !
732 ! This subroutine finds the next or previous test for a given
733 ! row. R should be set to the row to update, and Col should
734 ! be the column to update. Search_type$ should be the module
735 ! type of the row.
736 !
737 Diag_np_test: !
738 Test_posn=FNDiag_test_num(Search_type$,Current$)
739 Test_posn=Test_posn+Offset
740 IF Test_posn<0 THEN
741 Test_posn=FNDiag_test_num(Search_type$,"")-1
742 END IF
743 Current$=Tests$(Type_code,Test_posn)
744 IF Current$="" THEN Current$=Tests$(Type_code,0)
745 Box$(Col,R)=Current$
746 RETURN
747 !
748 ! This subroutine finds the next or previous reference module
749 ! for a given row. R should be set to the row to update, and
750 ! Col should be the column to update. Search_type$ should be
751 ! the module type of the row.
752 !
753 Diag_np_ref: !
754 Label_posn=4
755 IF Box$(3,R)="INPUT" THEN
756 Npsearch_type$="SOURCE"
757 ELSE
758 Npsearch_type$="INPUT"
759 END IF
760 Prev_posn=0
761 Next_posn=0
762 Found_current=0
763 Found_next=0
764 WHILE Label_posn<Num_labels+4
765 IF Box$(3,Label_posn)=Npsearch_type$ THEN
766 IF Next_posn=0 THEN Next_posn=Label_posn
767 IF Found_current AND (NOT Found_next) THEN
768 Next_posn=Label_posn
769 Found_next=1
770 END IF
771 Found_current=Found_current OR (Box$(1,Label_posn)=Current$)
772 IF NOT Found_current THEN
773 Prev_posn=Label_posn
774 END IF
775 END IF
776 Label_posn=Label_posn+1
777 END WHILE
778 IF Next_posn<>0 THEN
779 IF Offset=1 THEN
780 Current$=Box$(1,Next_posn)
781 ELSE
782 IF Prev_posn=0 THEN Prev_posn=Next_posn
783 Current$=Box$(1,Prev_posn)
784 END IF
785 END IF
786 Box$(Col,R)=Current$
787 !
788 RETURN
789 !
790 ! This subroutine sets up the spreadsheet softkeys
791 !
792 Diag_setup_keys: !
793 ON KEY 1 LABEL FNUser_keylabel$("Do Test") CALL User_key1isr
794 ON KEY 2 LABEL "" CALL User_key2isr
795 ON KEY 3 LABEL FNUser_keylabel$("Command Intf.") CALL User_key3isr
796 ON KEY 4 LABEL "" CALL User_key4isr
797 ON KEY 5 LABEL FNUser_keylabel$("Done") CALL User_key5isr
798 ON KEY 6 LABEL "" CALL User_key6isr
799 ON KEY 7 LABEL FNUser_keylabel$("Previous") CALL User_key7isr
800 ON KEY 8 LABEL FNUser_keylabel$("Next") CALL User_key8isr
801 RETURN
802 !
803 !
804 SUBEND
805 ! PAGE ->
806 !************************************************************************
807 Diag_comint:SUB Diag_comint
808 !
809 ! Command interface subprogram. Allows sending commands and
810 ! reading responses from active modules (as defined by the CNFG
811 ! file). It also allows doing a 512 point FFT on data read from
812 ! an input module and will display the time and log-mag frequency
813 ! data on the screen.
814 !
815 COM /Diag_com/ Active_type$,Module_addr$
816 DIM Prompt_str$[80],Temp$[100]
817 !
818 CALL User_clr_scr
819 RESTORE Diag_com_info
820 LOOP
821 READ Temp$
822 EXIT IF Temp$=""
823 OUTPUT CRT;Temp$
824 END LOOP
825 !
826 ON KEY 0 LABEL "" GOSUB Diag_com_dummy
827 ON KEY 1 LABEL FNUser_keylabel$("SELECT LABEL") CALL User_key1isr
828 ON KEY 2 LABEL FNUser_keylabel$("SELECT ADDR") CALL User_key2isr
829 ON KEY 3 LABEL FNUser_keylabel$("") CALL User_key3isr
830 ON KEY 4 LABEL FNUser_keylabel$("Do FFT") CALL User_key4isr
831 ON KEY 5 LABEL FNUser_keylabel$("EXIT") CALL User_key5isr
832 ON KEY 6 LABEL FNUser_keylabel$("MODULE STATUS") CALL User_key6isr
833 ON KEY 7 LABEL FNUser_keylabel$("ALL ERRORS") CALL User_key7isr
834 ON KEY 8 LABEL FNUser_keylabel$("MODULE ERRORS") CALL User_key8isr
835 ON KEY 9 LABEL "" GOSUB Diag_com_dummy
836 !
837 !
838 ON KBD ALL CALL Diag_kbd_isr
839 Done_flag=0
840 REPEAT
841 Prompt_str$="Enter "&Active_type$&" Command - "&Module_addr$
842 IF Module_addr$<>"HP-IB" THEN
843 Prompt_str$=Prompt_str$&" - "&FNDiag_cnvt_addr$(FNCnfg_get_modnum(Module_addr$))
844 END IF
845 Prompt_str$=Prompt_str$
846 WAIT .02
847 DISP Prompt_str$;
848 WAIT .02
849 DISP " ?"
850 IF FNDiag_kbd_avail THEN CALL Diag_com_cmnd(Done_flag)
851 UNTIL Done_flag
852 !
853 SUBEXIT
854 !
855 Diag_com_dummy: !
856 BEEP
857 RETURN
858 !
859 !
860 Diag_com_info: !
861 DATA " "
862 DATA " Diagnostics Command Interface"
863 DATA " "
864 DATA " This command interface allows you to send commands and query modules"
865 DATA "in a convenient manner. You can select which module by using the select"
866 DATA "LABEL softkey (selects by module labels from the CNFG spreadsheet) or by"
867 DATA "SELECT ADDR softkey (selects by address within system)."
868 DATA " The MODULE STATUS and MODULE ERRORS softkeys display the info. in a"
869 DATA "verbose form for ease of use. The ALL ERRORS softkey checks all modules"
870 DATA "in the system for errors and displays any errors found in a verbose form."
871 DATA " The DO FFT softkey will get and perform an FFT on data from the currently"
872 DATA "active input module. It then displays the time and frequency spectrum."
873 DATA "If the module is not in the middle of a measurement, a start command is"
874 DATA "automatically sent. WARNING: This routine uses the DISP file routines "
875 DATA "which will destroy the display setup information of a running demo program"
876 DATA "(if one is running) and program errors will result. In this case you should"
877 DATA "re-run the program"
878 DATA ""
879 SUBEND
880 !
881 ! PAGE ->
882 !************************************************************************
883 Diag_com_cmnd:SUB Diag_com_cmnd(Done_flag)
884 !
885 ! This subprogram processes key presses when the Diag_comint subprogram
886 ! is active. It decodes the softkeys and commands to the active
887 ! module.
888 !
889 DIM Command$[200],New_module_addr$[16]
890 COM /Diag_com/ Active_type$,Module_addr$
891 COM /Diag_hp_ib/ Hp_ib_addr
892 DIM Cmd$[260]
893 !
894 Command$=FNDiag_kbd_get$
895 IF Command$="" THEN SUBEXIT
896 !
897 SELECT Command$
898 CASE CHR$(255)&"P",CHR$(255)&"I",CHR$(255)&"!"
899 PAUSE
900 CASE CHR$(255)&"0",CHR$(255)&"a",CHR$(255)&"9",CHR$(255)&"j"
901 ! IGNORE
902 CASE CHR$(255)&"1",CHR$(255)&"b"
903 REPEAT
904 Entry_ok=1
905 OUTPUT KBD USING "#,K";CHR$(255)&"#"&FNDiag_kbd_getall$
906 INPUT "Enter module label or 'HP-IB'",New_module_addr$
907 New_module_addr$=UPC$(TRIM$(New_module_addr$))
908 ALLOCATE Label_list$(1:64)[16]
909 Cnfg_labels("ALL",Label_list$(*),Num_labels)
910 REDIM Label_list$(1:Num_labels+1)
911 Label_list$(Num_labels+1)="HP-IB"
912 Lib_match1(New_module_addr$,Label_list$(*),Found,Choice_num)
913 IF Found THEN
914 Module_addr$=Label_list$(Choice_num)
915 IF Module_addr$="HP-IB" THEN
916 Active_type$="HP-IB"
917 ELSE
918 Active_type$=UPC$(FNCnfg_type$(Module_addr$))
919 END IF
920 ELSE
921 User_error("Unknown module label")
922 Entry_ok=0
923 END IF
924 DEALLOCATE Label_list$(*)
925 UNTIL Entry_ok
926 !
927 CASE CHR$(255)&"2",CHR$(255)&"c"
928 REPEAT
929 Entry_ok=1
930 IF Module_addr$="HP-IB" THEN
931 Modnum=Hp_ib_addr
932 ELSE
933 Modnum=FNCnfg_get_modnum(Module_addr$)
934 END IF
935 OUTPUT KBD USING "#,K";CHR$(255)&"#"&VAL$(Modnum)&CHR$(255)&"H"&FNDiag_kbd_getall$
936 INPUT "Enter module number",Modnum
937 IF FNDiag_good_num(Modnum) THEN
938 IF Modnum=Hp_ib_addr THEN
939 Module_addr$="HP-IB"
940 Active_type$="HP-IB"
941 ELSE
942 Module_addr$=FNCnfg_get_label$(Modnum)
943 Active_type$=UPC$(FNCnfg_type$(Module_addr$))
944 END IF
945 ELSE
946 User_error("Unknown module address")
947 Entry_ok=0
948 END IF
949 UNTIL Entry_ok
950 CASE CHR$(255)&"3",CHR$(255)&"d"
951 CASE CHR$(255)&"4",CHR$(255)&"e"
952 DISP ""
953 IF Active_type$<>"INPUT" THEN
954 User_error("Can only FFT data from an INPUT module")
955 ELSE
956 Diag_do_meas(Module_addr$,Module_addr$)
957 END IF
958 CASE CHR$(255)&"5",CHR$(255)&"f"
959 Done_flag=1
960 CASE CHR$(255)&"6",CHR$(255)&"g"
961 DISP "Checking status"
962 Diag_chk_status(Module_addr$)
963 CASE CHR$(255)&"7",CHR$(255)&"h"
964 DISP "Checking errors"
965 IF NOT FNDiag_chk_errors THEN
966 OUTPUT CRT;"No errors in any modules"
967 END IF
968 CASE CHR$(255)&"8",CHR$(255)&"i"
969 DISP "Checking errors"
970 IF NOT FNDiag_chk_moderr(Module_addr$) THEN
971 OUTPUT CRT;"No errors"
972 END IF
973 CASE ELSE
974 OUTPUT 2 USING "#,K";Command$&FNDiag_kbd_getall$
975 DISP "Enter "&Active_type$&" Command for "&Module_addr$;
976 LINPUT Cmd$
977 CALL Diag_mod_com(Module_addr$,Active_type$,Cmd$)
978 END SELECT
979 SUBEND
980 !
981 ! PAGE ->
982 !************************************************************************
983 Diag_kbd_isr:SUB Diag_kbd_isr
984 !
985 ! This subprogram is called whenever a key is pressed when in the
986 ! Diag_comint subprogram. The key press is remembered in Kbd_string$
987 ! until the program can process it.
988 !
989 COM /Diag_kbd/ Kbd_string$[200]
990 Kbd_string$=Kbd_string$&KBD$
991 SUBEND
992 !
993 ! PAGE ->
994 !************************************************************************
995 Diag_kbd_avail:DEF FNDiag_kbd_avail
996 !
997 ! This function returns a true if there are key presses waiting to
998 ! be processed.
999 !
1000 COM /Diag_kbd/ Kbd_string$
1001 RETURN (Kbd_string$<>"")
1002 FNEND
1003 !
1004 ! PAGE ->
1005 !************************************************************************
1006 Diag_kbd_get:DEF FNDiag_kbd_get$
1007 !
1008 ! This subprogram returns the oldest unprocessed key press and removes
1009 ! the key press from Kbd_string$.
1010 !
1011 COM /Diag_kbd/ Kbd_string$
1012 DIM Temp$[2]
1013 IF Kbd_string$="" THEN RETURN ""
1014 IF (Kbd_string$[1;1]=CHR$(255)&"") AND (LEN(Kbd_string$)>1) THEN
1015 Temp$=Kbd_string$[1;2]
1016 Kbd_string$=Kbd_string$[3]
1017 ELSE
1018 Temp$=Kbd_string$[1;1]
1019 Kbd_string$=Kbd_string$[2]
1020 END IF
1021 RETURN Temp$
1022 FNEND
1023 !
1024 Diag_kbd_getall:DEF FNDiag_kbd_getall$
1025 !
1026 ! This function returns all the unprocessed key presses and clears
1027 ! the Kbd_string$.
1028 !
1029 COM /Diag_kbd/ Kbd_string$
1030 DIM Temp$[200]
1031 DISABLE
1032 Temp$=Kbd_string$
1033 Kbd_string$=""
1034 ENABLE
1035 RETURN Temp$
1036 FNEND
1037 !
1038 Diag_chk_moderr:DEF FNDiag_chk_moderr(Module_addr$)
1039 !
1040 ! Function checks specified module for any errors.
1041 ! If an error is found, an error message is printed
1042 ! and the function returns true (1). If no errors
1043 ! are found, nothing is printed and the function
1044 ! returns false (0).
1045 !
1046 DIM Module_type$[10]
1047 !
1048 Got_error=0
1049 IF UPC$(Module_addr$)="HP-IB" THEN
1050 Module_type$="HP-IB"
1051 ELSE
1052 Module_type$=UPC$(FNCnfg_type$(Module_addr$))
1053 END IF
1054 !
1055 Print_ilc=0
1056 !
1057 SELECT Module_type$
1058 CASE "HP-IB"
1059 REPEAT
1060 Error_code=VAL(FNHw_cmd_rsp$("ERR?"))
1061 IF Error_code<>0 THEN
1062 Got_error=1
1063 OUTPUT CRT;"HP-IB ERROR #"&VAL$(Error_code)&": "&FNHw_get_errstr$(Error_code)
1064 END IF
1065 UNTIL Error_code=0
1066 CASE "INPUT"
1067 Mod_stat=FNCnfg_rmst(Module_addr$)
1068 IF POS(FNInpt_stat_2_str$(Mod_stat),"ERR")<>0 THEN
1069 REPEAT
1070 Error_code=VAL(FNCnfg_cmd_rsp$(Module_addr$,"ERR?"))
1071 IF Error_code<>0 THEN
1072 Got_error=1
1073 OUTPUT CRT;"INPUT "&Module_addr$&" ERROR #"&VAL$(Error_code)&": "&FNInpt_get_errstr$(Error_code)
1074 IF (Error_code<200) THEN Print_ilc=1
1075 END IF
1076 UNTIL Error_code=0
1077 END IF
1078 CASE "SOURCE"
1079 Mod_stat=FNCnfg_rmst(Module_addr$)
1080 IF POS(FNSrce_stat_2_str$(Mod_stat),"ERR")<>0 THEN
1081 REPEAT
1082 Error_code=VAL(FNCnfg_cmd_rsp$(Module_addr$,"ERR?"))
1083 IF Error_code<>0 THEN
1084 Got_error=1
1085 OUTPUT CRT;"SOURCE "&Module_addr$&" ERROR #"&VAL$(Error_code)&": "&FNSrce_get_errstr$(Error_code)
1086 IF Error_code<0 THEN Print_ilc=1
1087 END IF
1088 UNTIL Error_code=0
1089 END IF
1090 END SELECT
1091 IF Print_ilc THEN
1092 OUTPUT CRT;" ILC BUFFER = "&FNCnfg_cmd_rsp$(Module_addr$,"ILC?")
1093 END IF
1094 RETURN Got_error
1095 FNEND
1096 !
1097 Diag_chk_errors:DEF FNDiag_chk_errors
1098 !
1099 ! Function checks all active modules for any errors.
1100 ! If an error is found, an error message is printed
1101 ! and the function returns true (1). If no errors
1102 ! are found, nothing is printed and the function
1103 ! returns false (0).
1104 !
1105 DIM Labels$(1:63)[16]
1106 !
1107 Got_error=FNDiag_chk_moderr("HP-IB")
1108 !
1109 Cnfg_labels("ALL INPUT",Labels$(*),Num_labels)
1110 !
1111 FOR Label_ptr=1 TO Num_labels
1112 Got_error=Got_error OR FNDiag_chk_moderr(Labels$(Label_ptr))
1113 NEXT Label_ptr
1114 !
1115 Cnfg_labels("ALL SOURCE",Labels$(*),Num_labels)
1116 !
1117 FOR Label_ptr=1 TO Num_labels
1118 Got_error=Got_error OR FNDiag_chk_moderr(Labels$(Label_ptr))
1119 NEXT Label_ptr
1120 !
1121 RETURN Got_error
1122 !
1123 FNEND
1124 !
1125 ! PAGE ->
1126 !************************************************************************
1127 Diag_chk_status:SUB Diag_chk_status(Module_addr$)
1128 !
1129 ! This subprogram prints the status of the specified module.
1130 ! The status is printed in a verbose form by calling the
1131 ! FNDiag_stat_2_str routine.
1132 !
1133 DIM Module_type$[10]
1134 !
1135 IF UPC$(Module_addr$)="HP-IB" THEN
1136 Module_type$="HP-IB"
1137 ELSE
1138 Module_type$=UPC$(FNCnfg_type$(Module_addr$))
1139 END IF
1140 !
1141 SELECT Module_type$
1142 CASE "HP-IB"
1143 Status_code=VAL(FNHw_cmd_rsp$("STC?"))
1144 OUTPUT CRT;"HP-IB STATUS = "&VAL$(Status_code)&" = ";
1145 OUTPUT CRT;FNDiag_stat_2_str$(Module_type$,Status_code)
1146 CASE "INPUT","SOURCE"
1147 Status_code=VAL(FNCnfg_cmd_rsp$(Module_addr$,"STC?"))
1148 OUTPUT CRT;Module_type$&" "&Module_addr$&" STATUS = "&VAL$(Status_code);
1149 OUTPUT CRT;" = "&FNDiag_stat_2_str$(Module_type$,Status_code)
1150 END SELECT
1151 SUBEND
1152 !
1153 ! PAGE ->
1154 !************************************************************************
1155 Diag_stat_2_str:DEF FNDiag_stat_2_str$(Module_type$,Status_code)
1156 !
1157 ! This function returns a verbose form of the module status
1158 ! thats passed in. The Module_type$ tells the function what
1159 ! what type of module the status is from.
1160 !
1161 SELECT Module_type$
1162 CASE "HP-IB"
1163 RETURN FNHw_stat_2_str$(Status_code)
1164 CASE "INPUT"
1165 RETURN FNInpt_stat_2_str$(Status_code)
1166 CASE "SOURCE"
1167 RETURN FNSrce_stat_2_str$(Status_code)
1168 END SELECT
1169 !
1170 FNEND
1171 !
1172 ! PAGE ->
1173 !************************************************************************
1174 Diag_cnvt_addr:DEF FNDiag_cnvt_addr$(Address)
1175 !
1176 ! This function takes a module address and converts it to a
1177 ! string that contains the module address, the mainframe number,
1178 ! and the module number within the mainframe.
1179 !
1180 DIM Ret_str$[10]
1181 Ret_str$=VAL$(Address)&" ("
1182 Ret_str$=Ret_str$&TRIM$(VAL$(Address DIV 8))&","
1183 Ret_str$=Ret_str$&TRIM$(VAL$(Address MOD 8))&")"
1184 RETURN TRIM$(Ret_str$)
1185 FNEND
1186 !
1187 ! PAGE ->
1188 !************************************************************************
1189 Diag_test_num:DEF FNDiag_test_num(Module_type$,Test_name$)
1190 !
1191 ! This function returns the element number in the Tests$(*)
1192 ! array that corresponds to the Test_name$ parameter for the
1193 ! module type given. If Test_name$ is not found, the routine
1194 ! returns the first null ("") string found.
1195 !
1196 COM /Diag_tests/ Tests$(*),Max_tests
1197 !
1198 Type_code=FNDiag_type_code(Module_type$)
1199 !
1200 Test_num=0
1201 WHILE (Tests$(Type_code,Test_num)<>Test_name$) AND (Tests$(Type_code,Test_num)<>"")
1202 Test_num=Test_num+1
1203 END WHILE
1204 !
1205 RETURN Test_num
1206 FNEND
1207 !
1208 ! PAGE ->
1209 !************************************************************************
1210 Diag_mod_com:SUB Diag_mod_com(M_label$,M_type$,M_string$)
1211 !
1212 ! This subprogram accepts a command string (M_string$) to be sent
1213 ! to a module (M_label$) of given type (M_type$) and parses the
1214 ! string apart and sends each command. If a command generates
1215 ! a response, the response is read. All commands and responses
1216 ! are displayed on the CRT.
1217 !
1218 DIM Temp$[260],Temp_cmd$[260]
1219 !
1220 M_string$=TRIM$(M_string$)
1221 !
1222 ON TIMEOUT (FNHw_cur_dev_sel DIV 100),5 RECOVER Diag_com_to
1223 !
1224 REPEAT
1225 !
1226 REPEAT
1227 S_pos=POS(M_string$,";")
1228 IF S_pos=0 THEN
1229 Temp_cmd$=M_string$
1230 M_string$=""
1231 ELSE
1232 IF S_pos=1 THEN
1233 Temp_cmd$=""
1234 M_string$=M_string$[2]
1235 ELSE
1236 Temp_cmd$=M_string$[1;S_pos-1]
1237 IF S_pos=LEN(M_string$) THEN
1238 M_string$=""
1239 ELSE
1240 M_string$=M_string$[S_pos+1]
1241 END IF
1242 END IF
1243 END IF
1244 UNTIL (M_string$="") OR (Temp_cmd$<>"")
1245 !
1246 IF Temp_cmd$="" THEN SUBEXIT
1247 !
1248 IF M_type$<>"HP-IB" THEN
1249 Qpos=POS(Temp_cmd$,"?")
1250 IF (Qpos=0) OR (Qpos=LEN(Temp_cmd$)) THEN
1251 IF Qpos=LEN(Temp_cmd$) THEN
1252 Temp_cmd$=TRIM$(Temp_cmd$[1;Qpos-1])
1253 !
1254 OUTPUT CRT;M_label$&": "&Temp_cmd$&"?"
1255 IF M_type$="INPUT" THEN
1256 OUTPUT CRT;M_label$&">>>>"&FNInpt_rsp$(M_label$,Temp_cmd$)
1257 ELSE
1258 OUTPUT CRT;M_label$&">>>>"&FNSrce_rsp$(M_label$,Temp_cmd$)
1259 END IF
1260 ELSE
1261 Space_pos=LEN(Temp_cmd$)-POS(REV$(Temp_cmd$)," ")+1
1262 IF Space_pos<LEN(Temp_cmd$) THEN
1263 M_parm$=TRIM$(Temp_cmd$[Space_pos])
1264 Temp_cmd$=Temp_cmd$[1;Space_pos-1]
1265 ELSE
1266 M_parm$=""
1267 END IF
1268 !
1269 IF M_type$="INPUT" THEN
1270 Inpt_cmd(M_label$,Temp_cmd$,M_parm$)
1271 OUTPUT CRT;M_label$&": "&Temp_cmd$&" "&M_parm$
1272 ELSE
1273 Srce_cmd(M_label$,Temp_cmd$,M_parm$)
1274 OUTPUT CRT;M_label$&": "&Temp_cmd$&" "&M_parm$
1275 END IF
1276 END IF
1277 ELSE
1278 Cnfg_cmd(M_label$,Temp_cmd$)
1279 OUTPUT CRT;M_label$&": "&Temp_cmd$
1280 IF POS(Temp_cmd$,"?")<>0 THEN
1281 OUTPUT CRT;M_label$&">>>>"&FNCnfg_rsp$(M_label$)
1282 END IF
1283 END IF
1284 ELSE
1285 Hw_cmd(Temp_cmd$)
1286 OUTPUT CRT;M_label$&": "&Temp_cmd$
1287 Temp$=FNHw_rsp$(.5)
1288 IF NOT FNHw_io_error THEN OUTPUT CRT;M_label$&">>>>"&Temp$
1289 END IF
1290 !
1291 UNTIL M_string$=""
1292 !
1293 SUBEXIT
1294 !
1295 Diag_com_to: !
1296 User_error("Command/Response timeout")
1297 SUBEXIT
1298 !
1299 SUBEND
1300 !
1301 ! PAGE ->
1302 !************************************************************************
1303 Diag_good_num:DEF FNDiag_good_num(Modnum)
1304 !
1305 ! This function scans the Diag spreadsheet for a module number
1306 ! and returns a 'true' if the module number is found and a false
1307 ! if it ain't.
1308 !
1309 COM /Diag_boxes/ Box$(*)
1310 COM /Diag_max/ Max_col,Max_row,Modify_col
1311 FOR Boxptr=4 TO Max_row
1312 IF VAL(Box$(2,Boxptr))=Modnum THEN RETURN 1
1313 NEXT Boxptr
1314 RETURN 0
1315 FNEND
1316 !
1317 ! PAGE ->
1318 !************************************************************************
1319 Diag_type_code:DEF FNDiag_type_code(M_type$)
1320 !
1321 ! This function returns a code used to index into the Tests$(*)
1322 ! based on the module type. If the module type given is not
1323 ! valid, then a zero is returned (this is used for the
1324 ! All Modules row).
1325 !
1326 SELECT M_type$
1327 CASE "HP-IB"
1328 RETURN 1
1329 CASE "INPUT"
1330 RETURN 2
1331 CASE "SOURCE"
1332 RETURN 3
1333 END SELECT
1334 RETURN 0
1335 FNEND
1336 !
1337 ! PAGE ->
1338 !************************************************************************
1339 Diag_do_test:SUB Diag_do_test(M_label$,Test$,Ref_label$,Ret_status$)
1340 !
1341 ! This subprogram performs a test (Test$) on the given module
1342 ! (M_label$). Ref_label$ is the reference module to use if needed.
1343 ! Ret_status$ is the resulting status of the test.
1344 !
1345 DIM M_type$[10],Dummy$[160]
1346 !
1347 IF M_label$="HP-IB" THEN
1348 M_type$="HP-IB"
1349 Hw_cmd("CLR")
1350 ELSE
1351 M_type$=FNCnfg_type$(M_label$)
1352 Cnfg_cmd(M_label$,"CLR")
1353 END IF
1354 !
1355 Ret_status$=""
1356 User_clr_scr
1357 DISP "Doing test "&Test$&" on module "&M_label$
1358 !
1359 Ok=1
1360 Do_ret_status=0
1361 !
1362 SELECT Test$
1363 !************************ General Tests
1364 CASE "No Test"
1365 ! Do Nothing
1366 !
1367 CASE "Self Test"
1368 Diag_self_test(M_label$,Ret_status$)
1369 Do_ret_status=1
1370 !
1371 !************************ Input Tests
1372 CASE "Simple A/D"
1373 Diag_simple_ad(M_label$,Ref_label$)
1374 !
1375 CASE "Complex A/D"
1376 Diag_complex_ad(M_label$,Ref_label$)
1377 !
1378 CASE "Complex FE"
1379 Diag_complex_fe(M_label$,Ref_label$)
1380 !
1381 CASE "Digital"
1382 Diag_digital(M_label$,Ref_label$)
1383 !
1384 !************************ Source Tests
1385 CASE "Sine"
1386 Diag_sine(M_label$,Ref_label$)
1387 !
1388 CASE "Random"
1389 Diag_random(M_label$,Ref_label$)
1390 !
1391 CASE "Offset"
1392 Diag_offset(M_label$,Ref_label$)
1393 !
1394 END SELECT
1395 !
1396 IF (NOT Ok) OR (Ret_status$<>"") THEN
1397 IF Ret_status$="TIMEOUT" THEN
1398 DISP "Module timeout during test, press <ENTER> to continue.";
1399 ELSE
1400 DISP "Error during test, press <ENTER> to continue.";
1401 END IF
1402 BEEP
1403 INPUT Dummy$
1404 ELSE
1405 IF Do_ret_status THEN Ret_status$="PASSED"
1406 END IF
1407 SUBEND
1408 !
1409 ! PAGE ->
1410 !************************************************************************
1411 Diag_self_test:SUB Diag_self_test(M_label$,Ret_status$)
1412 !
1413 ! This subprogram performs a self test on the given module (M_label$).
1414 ! The Ret_status$ returns a "" if the module passed the self test.
1415 ! If the module fails, the errors are printed on the CRT and then
1416 ! pauses.
1417 !
1418 DIM Ignore$[20]
1419 Ret_status$=""
1420 IF M_label$="HP-IB" THEN
1421 DISP "Doing powerup selftest of HP-IB module"
1422 Hw_cmd("HRST",30)
1423 IF FNHw_io_error THEN Ret_status$="TIMEOUT"
1424 FOR Wait_time=1 TO 30
1425 WAIT 1
1426 NEXT Wait_time
1427 IF Ret_status$="" THEN
1428 Ignore$=FNHw_cmd_rsp$("ID?",30)
1429 IF FNHw_io_error THEN Ret_status$="TIMEOUT"
1430 END IF
1431 !
1432 IF Ret_status$="" THEN
1433 IF FNDiag_chk_moderr(M_label$) THEN
1434 Ret_status$="BROKE"
1435 END IF
1436 END IF
1437 ELSE
1438 ! Input or Source Modules
1439 Cnfg_cmd(M_label$,"TST 1",30)
1440 IF FNHw_io_error THEN Ret_status$="TIMEOUT"
1441 IF Ret_status$="" THEN
1442 Cnfg_wait_rdy(M_label$,30)
1443 IF FNHw_io_error THEN Ret_status$="TIMEOUT"
1444 END IF
1445 !
1446 IF Ret_status$="" THEN
1447 IF FNDiag_chk_moderr(M_label$) THEN
1448 Ret_status$="BROKE"
1449 END IF
1450 END IF
1451 END IF
1452 SUBEND
1453 !
1454 ! PAGE ->
1455 !************************************************************************
1456 Diag_set_serial:SUB Diag_set_serial(M_label$)
1457 !
1458 ! This routines provides a convenient method of setting the
1459 ! serial # of a module.
1460 !
1461 DIM Password$[20],Serial_num$[20]
1462 !
1463 User_clr_scr
1464 Ret_status$=""
1465 !
1466 Cnfg_cmd(M_label$,"CLR",30) ! Clear any errors
1467 IF FNHw_io_error THEN GOTO Diag_timedout
1468 !
1469 IF (M_label$<>"HP-IB") THEN
1470 Cnfg_cmd(M_label$,"TST 1",30)
1471 IF FNHw_io_error THEN GOTO Diag_timedout
1472 Cnfg_wait_rdy(M_label$,30)
1473 IF FNHw_io_error THEN GOTO Diag_timedout
1474 Needs_init=0
1475 REPEAT
1476 Errnum=VAL(FNCnfg_cmd_rsp$(M_label$,"ERR?",30))
1477 IF FNHw_io_error THEN GOTO Diag_timedout
1478 IF Errnum=630 THEN Needs_init=1
1479 UNTIL Errnum=0
1480 !
1481 ! Initialize NOVRAM if poweron error
1482 IF Needs_init THEN
1483 DISP "Enter initialization password for "&M_type$&" module";
1484 INPUT Password$
1485 Password$=TRIM$(Password$)
1486 Cnfg_cmd(M_label$,"TST 112,'"&Password$&"';",30)
1487 IF FNHw_io_error THEN GOTO Diag_timedout
1488 Cnfg_wait_rdy(M_label$,30)
1489 IF FNHw_io_error THEN GOTO Diag_timedout
1490 Cnfg_cmd(M_label$,"TST 112,'"&Password$&"';",30)
1491 IF FNHw_io_error THEN GOTO Diag_timedout
1492 Cnfg_wait_rdy(M_label$,30)
1493 IF FNHw_io_error THEN GOTO Diag_timedout
1494 Cmfg_cmd(M_label$,"TST 1",30)
1495 IF FNHw_io_error THEN GOTO Diag_timedout
1496 Cnfg_wait_rdy(M_label$,30)
1497 IF FNHw_io_error THEN GOTO Diag_timedout
1498 END IF
1499 END IF
1500 !
1501 DISP "Enter serial number password for "&M_type$&" module";
1502 LINPUT Password$
1503 Password$=TRIM$(Password$)
1504 !
1505 DISP "Enter serial number for "&M_label$&" module";
1506 LINPUT Serial_num$
1507 Serial_num$=TRIM$(Serial_num$)
1508 !
1509 Ok=1
1510 IF LEN(Serial_num$)<10 THEN Ok=0
1511 IF Ok THEN
1512 IF VAL(Serial_num$[1;4])<2605 THEN Ok=0
1513 IF Serial_num$[5;1]<>"A" THEN Ok=0
1514 Temp$=VAL$(VAL(Serial_num$[6]))
1515 Temp$=RPT$("0",LEN(Serial_num$)-5-LEN(Temp$))&Temp$
1516 IF Temp$<>Serial_num$[6] THEN Ok=0
1517 END IF
1518 !
1519 IF NOT Ok THEN
1520 OUTPUT CRT;"Illegal serial number entered, must be valid HP serial number"
1521 ELSE
1522 IF M_label$="HP-IB" THEN
1523 Hw_cmd("ZSER """&Password$&Serial_num$&"""",30)
1524 IF FNHw_io_error THEN GOTO Diag_timedout
1525 IF Ret_status$="" THEN
1526 IF FNDiag_chk_moderr(M_label$) THEN Ok=0
1527 IF FNHw_cmd_rsp$("SER?",30)<>Serial_num$ THEN
1528 OUTPUT CRT;"Serial number not correct after programming"
1529 Ok=0
1530 ELSE
1531 OUTPUT CRT;"Serial number programmed"
1532 END IF
1533 IF FNHw_io_error THEN GOTO Diag_timeout
1534 END IF
1535 ELSE ! Source or Input module
1536 Cnfg_cmd(M_label$,"ZSER """&Password$&Serial_num$&"""",30)
1537 IF FNHw_io_error THEN GOTO Diag_timedout
1538 IF Ret_status$="" THEN
1539 IF FNDiag_chk_moderr(M_label$) THEN Ok=0
1540 IF FNCnfg_cmd_rsp$(M_label$,"SER?",30)<>Serial_num$ THEN
1541 OUTPUT CRT;"Serial number not correct after programming"
1542 Ok=0
1543 ELSE
1544 OUTPUT CRT;"Serial number programmed"
1545 END IF
1546 IF FNHw_io_error THEN GOTO Diag_timedout
1547 END IF
1548 END IF
1549 END IF
1550 SUBEXIT
1551 !
1552 Diag_timeout: !
1553 User_stop("Timeout while setting serial #, press <continue>")
1554 SUBEXIT
1555 SUBEND
1556 !
1557 ! PAGE ->
1558 !************************************************************************
1559 Diag_simple_ad:SUB Diag_simple_ad(Inpt_label$,Ref_label$)
1560 !
1561 ! This input module test puts a -14 dBvp 12.8 Khz signal
1562 ! from the reference source module into A/D of the input
1563 ! module under test. A baseband measurement is made and
1564 ! displayed on the CRT.
1565 !
1566 IF Ref_label$="" THEN
1567 User_error("Must have source module to perform this test")
1568 SUBEXIT
1569 END IF
1570 !
1571 Inpt_cmd(Inpt_label$,"RESET")
1572 Inpt_cmd(Inpt_label$,"SPAN","102400")
1573 Inpt_cmd(Inpt_label$,"ZOOM","OFF")
1574 Inpt_cmd(Inpt_label$,"CAL MODE","A/D")
1575 Inpt_cmd(Inpt_label$,"RANGE","-14")
1576 !
1577 Srce_cmd(Ref_label$,"RESET")
1578 Srce_cmd(Ref_label$,"MODE","SINE")
1579 Srce_cmd(Ref_label$,"RANGE","-14")
1580 Srce_cmd(Ref_label$,"SINE FREQ","12800")
1581 Srce_cmd(Ref_label$,"CAL MODE","SOURCE")
1582 Srce_cmd(Ref_label$,"START")
1583 Cnfg_wait_rdy(Ref_label$)
1584 !
1585 Diag_do_meas(Inpt_label$,"Simple A/D test: "&Inpt_label$&" - "&Ref_label$,1)
1586 !
1587 SUBEND
1588 !
1589 ! PAGE ->
1590 !************************************************************************
1591 Diag_complex_ad:SUB Diag_complex_ad(Inpt_label$,Ref_label$)
1592 !
1593 ! This input module test puts a -14 dBvp 12.8 Khz signal
1594 ! from the reference source module into A/D of the input
1595 ! module under test. A zoomed measurement is made and
1596 ! displayed on the CRT.
1597 !
1598 IF Ref_label$="" THEN
1599 User_error("Must have source module to perform this test")
1600 SUBEXIT
1601 END IF
1602 !
1603 Inpt_cmd(Inpt_label$,"RESET")
1604 Inpt_cmd(Inpt_label$,"SPAN","12800")
1605 Inpt_cmd(Inpt_label$,"CENTER","11200")
1606 Inpt_cmd(Inpt_label$,"ZOOM","ON")
1607 Inpt_cmd(Inpt_label$,"RANGE","-14")
1608 Inpt_cmd(Inpt_label$,"CAL MODE","A/D")
1609 Inpt_cmd(Inpt_label$,"TRIG SOURCE","LOCAL INPUT")
1610 Inpt_cmd(Inpt_label$,"TRIG LEVEL","20")
1611 !
1612 Srce_cmd(Ref_label$,"RESET")
1613 Srce_cmd(Ref_label$,"MODE","SINE")
1614 Srce_cmd(Ref_label$,"RANGE","-14")
1615 Srce_cmd(Ref_label$,"SINE FREQ","12800")
1616 Srce_cmd(Ref_label$,"CAL MODE","SOURCE")
1617 Srce_cmd(Ref_label$,"START")
1618 Cnfg_wait_rdy(Ref_label$)
1619 !
1620 Diag_do_meas(Inpt_label$,"Complex A/D test: "&Inpt_label$&" - "&Ref_label$,1)
1621 !
1622 SUBEND
1623 !
1624 ! PAGE ->
1625 !************************************************************************
1626 Diag_complex_fe:SUB Diag_complex_fe(Inpt_label$,Ref_label$)
1627 !
1628 ! This input module test puts a -14 dBvp 12.8 Khz signal
1629 ! from the reference source module into the input of the
1630 ! module under test. A zoomed measurement is made and
1631 ! displayed on the CRT.
1632 !
1633 IF Ref_label$="" THEN
1634 User_error("Must have source module to perform this test")
1635 SUBEXIT
1636 END IF
1637 !
1638 Inpt_cmd(Inpt_label$,"RESET")
1639 Inpt_cmd(Inpt_label$,"SPAN","12800")
1640 Inpt_cmd(Inpt_label$,"CENTER","11200")
1641 Inpt_cmd(Inpt_label$,"ZOOM","ON")
1642 Inpt_cmd(Inpt_label$,"RANGE","-14")
1643 Inpt_cmd(Inpt_label$,"CAL MODE","FRONT END")
1644 Inpt_cmd(Inpt_label$,"TRIG SOURCE","LOCAL INPUT")
1645 Inpt_cmd(Inpt_label$,"TRIG LEVEL","20")
1646 !
1647 Srce_cmd(Ref_label$,"RESET")
1648 Srce_cmd(Ref_label$,"MODE","SINE")
1649 Srce_cmd(Ref_label$,"RANGE","-14")
1650 Srce_cmd(Ref_label$,"SINE FREQ","12800")
1651 Srce_cmd(Ref_label$,"CAL MODE","SOURCE")
1652 Srce_cmd(Ref_label$,"START")
1653 Cnfg_wait_rdy(Ref_label$)
1654 !
1655 Diag_do_meas(Inpt_label$,"Complex FE test: "&Inpt_label$&" - "&Ref_label$,1)
1656 !
1657 SUBEND
1658 !
1659 ! PAGE ->
1660 !************************************************************************
1661 Diag_digital:SUB Diag_digital(Inpt_label$,Ref_label$)
1662 !
1663 ! This input module test puts a digital sine wave into
1664 ! the Trigger GA of the input module under test. A
1665 ! measurement is made and displayed on the CRT.
1666 !
1667 DIM Out_str$[256],Temp$[256]
1668 Inpt_cmd(Inpt_label$,"RESET")
1669 Inpt_cmd(Inpt_label$,"SPAN","102400")
1670 Inpt_cmd(Inpt_label$,"TRIG DELAY","135")
1671 !
1672 Out_str$="TST 2,#I000064"
1673 FOR Cnt=0 TO 63
1674 OUTPUT Temp$ USING "#,6Z";PROUND(16384*SIN(Cnt/64*2*PI),0)
1675 Out_str$=Out_str$&Temp$
1676 IF Cnt=31 THEN
1677 Cnfg_cmd(Inpt_label$,Out_str$)
1678 Out_str$=""
1679 END IF
1680 NEXT Cnt
1681 Out_str$=Out_str$&";"
1682 Cnfg_cmd(Inpt_label$,Out_str$)
1683 !
1684 Diag_do_meas(Inpt_label$,"Digital test: "&Inpt_label$,1)
1685 SUBEND
1686 !
1687 ! PAGE ->
1688 !************************************************************************
1689 Diag_sine:SUB Diag_sine(Srce_label$,Ref_label$)
1690 !
1691 ! This source module test measures a 20 dBvp 10 Khz sine
1692 ! wave generated by the module under test. A measurement
1693 ! is made by the reference module and displayed on the CRT.
1694 !
1695 IF Ref_label$="" THEN
1696 User_error("Must have input module to perform this test")
1697 SUBEXIT
1698 END IF
1699 !
1700 Inpt_cmd(Ref_label$,"RESET")
1701 Inpt_cmd(Ref_label$,"SPAN","3200")
1702 Inpt_cmd(Ref_label$,"CENTER","10000")
1703 Inpt_cmd(Ref_label$,"ZOOM","ON")
1704 Inpt_cmd(Ref_label$,"RANGE","24")
1705 Inpt_cmd(Ref_label$,"CAL MODE","FRONT END")
1706 !
1707 Srce_cmd("ALL SOURCE","RESET")
1708 Srce_cmd(Srce_label$,"MODE","SINE")
1709 Srce_cmd(Srce_label$,"RANGE","20")
1710 Srce_cmd(Srce_label$,"SINE FREQ","10000")
1711 Srce_cmd(Srce_label$,"CAL MODE","SOURCE")
1712 Srce_cmd(Srce_label$,"RAMP RATE","100")
1713 Srce_cmd(Srce_label$,"START")
1714 Cnfg_wait_rdy(Srce_label$)
1715 !
1716 Diag_do_meas(Ref_label$,"Sine test: "&Srce_label$&" - "&Ref_label$,1)
1717 SUBEND
1718 ! PAGE ->
1719 !************************************************************************
1720 Diag_random:SUB Diag_random(Srce_label$,Ref_label$)
1721 !
1722 ! This source module test measures a -8 dBvp band limited
1723 ! random noise generated by the module under test. The
1724 ! band is a 6400 Hz wide centered at 10 Khz. A measurement
1725 ! is made by the reference module and displayed on the CRT.
1726 !
1727 IF Ref_label$="" THEN
1728 User_error("Must have input module to perform this test")
1729 SUBEXIT
1730 END IF
1731 !
1732 Inpt_cmd(Ref_label$,"RESET")
1733 Inpt_cmd(Ref_label$,"SPAN","51200")
1734 Inpt_cmd(Ref_label$,"CENTER","32768")
1735 Inpt_cmd(Ref_label$,"ZOOM","ON")
1736 Inpt_cmd(Ref_label$,"RANGE","-10")
1737 Inpt_cmd(Ref_label$,"CAL MODE","FRONT END")
1738 !
1739 Srce_cmd("ALL SOURCE","RESET")
1740 Srce_cmd(Srce_label$,"MODE","RANDOM")
1741 Srce_cmd(Srce_label$,"RANGE","-8")
1742 Srce_cmd(Srce_label$,"ZOOM","ON")
1743 Srce_cmd(Srce_label$,"CENTER","10000")
1744 Srce_cmd(Srce_label$,"SPAN","6400")
1745 Srce_cmd(Srce_label$,"CAL MODE","SOURCE")
1746 Srce_cmd(Srce_label$,"RAMP RATE","100")
1747 Srce_cmd(Srce_label$,"START")
1748 Cnfg_wait_rdy(Srce_label$)
1749 !
1750 Diag_do_meas(Ref_label$,"Random test: "&Srce_label$&" - "&Ref_label$,1)
1751 SUBEND
1752 !
1753 ! PAGE ->
1754 !************************************************************************
1755 Diag_offset:SUB Diag_offset(Srce_label$,Ref_label$)
1756 !
1757 ! This source module test measures a 2.3 volt dc signal
1758 ! generated by the module under test. A measurement
1759 ! is made by the reference module and displayed on the CRT.
1760 !
1761 DIM Dummy$[100]
1762 !
1763 IF Ref_label$="" THEN
1764 User_error("Must have input module to perform this test")
1765 SUBEXIT
1766 END IF
1767 !
1768 Srce_offset=2.3
1769 !
1770 Inpt_cmd(Ref_label$,"RESET")
1771 Inpt_cmd(Ref_label$,"RANGE","10")
1772 Inpt_cmd(Ref_label$,"CAL MODE","FRONT END")
1773 Inpt_cmd(Ref_label$,"AUTOZERO MODE","SINGLE INPUT")
1774 !
1775 Srce_cmd("ALL SOURCE","RESET")
1776 Srce_cmd(Srce_label$,"MODE","DC")
1777 Srce_cmd(Srce_label$,"DC OFFSET",VAL$(Srce_offset))
1778 Srce_cmd(Srce_label$,"CAL MODE","SOURCE")
1779 Srce_cmd(Srce_label$,"RAMP RATE","100")
1780 Srce_cmd(Srce_label$,"START")
1781 Cnfg_wait_rdy(Srce_label$)
1782 !
1783 DISP "Measuring Source"
1784 Inpt_cmd(Ref_label$,"SINGLE AUTOZERO")
1785 Cnfg_wait_rdy(Ref_label$)
1786 Meas_offset=VAL(FNInpt_rsp$(Ref_label$,"OFFSET"))
1787 !
1788 User_clr_scr
1789 DISP ""
1790 OUTPUT CRT;""
1791 OUTPUT CRT;"Source set to "&VAL$(Srce_offset)
1792 OUTPUT CRT;"Measured "&VAL$(Meas_offset)
1793 OUTPUT CRT;"Percent error = "&VAL$(100*(Meas_offset-Srce_offset)/Srce_offset)
1794 DISP "Press <ENTER> to continue";
1795 INPUT Dummy$
1796 SUBEND
1797 !
1798 ! PAGE ->
1799 !************************************************************************
1800 Diag_do_meas:SUB Diag_do_meas(Inpt_label$,Title$,OPTIONAL No_labels)
1801 !
1802 ! This subprogram makes a measurement on the given input module
1803 ! and displays the time record and logmag FFT'ed spectrum. This
1804 ! subprogram will only work on a blocksize of 1024 words.
1805 !
1806 DIM Data_array(1:2,0:1023)
1807 !
1808 OFF KBD
1809 !
1810 Skip_labels=0
1811 IF NPAR>2 THEN
1812 Skip_labels=No_labels
1813 END IF
1814 !
1815 IF NOT Skip_labels THEN
1816 FOR Keynum=1 TO 7
1817 ON KEY Keynum LABEL "" GOSUB Diag_meas_dummy
1818 NEXT Keynum
1819 ON KEY 8 LABEL FNUser_keylabel$("ABORT MEAS") RECOVER Diag_meas_abrt
1820 END IF
1821 !
1822 IF FNDiag_setup_meas(Inpt_label$) THEN SUBEXIT
1823 !
1824 IF FNDiag_get_data(Inpt_label$,Data_array(*)) THEN SUBEXIT
1825 !
1826 Diag_do_plot(Title$,Data_array(*))
1827 SUBEXIT
1828 !
1829 Diag_meas_abrt: !
1830 User_error("Measurement aborted")
1831 SUBEXIT
1832 !
1833 Diag_meas_dummy: !
1834 BEEP
1835 RETURN
1836 SUBEND
1837 !
1838 ! PAGE ->
1839 !************************************************************************
1840 Diag_do_plot:SUB Diag_do_plot(Title$,Data_array(*))
1841 !
1842 ! This subprogram is used by Diag_do_meas to plot the measurement
1843 !
1844 COM /Diag_meas_setup/ Zooming,Span,Cf,Range,Ovld
1845 DIM Plot_to_buf(1:2),Plot_titles$(1:2)[60]
1846 DIM X_units$(1:2)[10],Y_units$(1:2)[10],Start_x(1:2)
1847 DIM Per_bin_x(1:2),Start_bin(1:2),Num_bins(1:2),Y_def_max(1:2)
1848 DIM Y_def_min(1:2),Data_header(1:2,1:10),Y_max$(1:2)[10],Y_min$(1:2)[10]
1849 !
1850 MAT Data_header= (0)
1851 MAT Y_max$= ("Default")
1852 MAT Y_min$= ("Default")
1853 !
1854 Plot_titles$(1)=Title$&" time"
1855 Plot_to_buf(1)=1
1856 X_units$(1)="SECS"
1857 Y_units$(1)="V"
1858 Start_x(1)=0
1859 Per_bin_x(1)=204.8/Span/512
1860 Start_bin(1)=0
1861 Num_bins(1)=512
1862 Y_def_max(1)=10^((Range+2)/20)
1863 Y_def_min(1)=-Y_def_max(1)
1864 Data_header(1,2)=15094.3657/32768*10^((-2-Range)/20)
1865 Data_header(1,3)=Ovld
1866 !
1867 Plot_titles$(2)=Title$&" spectrum"
1868 Plot_to_buf(2)=2
1869 X_units$(2)="Hz"
1870 Y_units$(2)="dbv"
1871 Start_x(2)=Cf-Span/2
1872 Per_bin_x(2)=Span/400
1873 Start_bin(2)=0
1874 Num_bins(2)=401
1875 Y_def_max(2)=Range+2
1876 Y_def_min(2)=Range-100
1877 Data_header(2,2)=(15094.3657/32768*10^((-2-Range)/20)/2)^2
1878 Data_header(2,3)=Ovld
1879 Data_header(2,4)=10
1880 Data_header(2,5)=Data_header(2,2)*10^(-10)
1881 !
1882 Disp_put_traces(2,0,Y_max$(*),Y_min$(*))
1883 Disp_put_titles(Plot_titles$(*))
1884 !
1885 Disp_plot_set(Plot_to_buf(*),X_units$(*),Y_units$(*),Start_x(*),Per_bin_x(*),Start_bin(*),Num_bins(*),Y_def_max(*),Y_def_min(*))
1886 !
1887 Disp_plot_axis
1888 !
1889 Disp_plot_data(Data_array(*),Data_header(*))
1890 !
1891 OFF KBD
1892 ON KEY 6 LABEL FNUser_keylabel$("DONE") CALL User_key6isr
1893 Disp_do_mkr(Data_array(*),Data_header(*),0)
1894 Dummy=FNUser_get_key
1895 User_clr_scr
1896 !
1897 SUBEND
1898 !
1899 ! PAGE ->
1900 !************************************************************************
1901 Diag_setup_meas:DEF FNDiag_setup_meas(Inpt_label$)
1902 !
1903 ! This subprogram is used by Diag_do_meas to check and
1904 ! setup the measurement.
1905 !
1906 COM /Diag_meas_setup/ Zooming,Span,Cf,Range,Ovld
1907 !
1908 IF VAL(FNInpt_rsp$(Inpt_label$,"BLOCK SIZE"))<1024 THEN
1909 User_error("Illegal block size (<1024) in Diagnostics Measurement")
1910 RETURN 1
1911 END IF
1912 !
1913 IF FNInpt_rsp$(Inpt_label$,"TRANSFER MODE")="CONTINUOUS" THEN
1914 IF VAL(FNInpt_rsp$(Inpt_label$,"TRANSFER SIZE"))<1024 THEN
1915 User_error("Illegal transfer block size (<1024) in Diag. Measurement")
1916 RETURN 1
1917 END IF
1918 END IF
1919 !
1920 Zooming=(FNInpt_rsp$(Inpt_label$,"ZOOM")="ON")
1921 Span=VAL(FNInpt_rsp$(Inpt_label$,"SPAN"))
1922 IF Zooming THEN
1923 Cf=VAL(FNInpt_rsp$(Inpt_label$,"CENTER FREQ"))
1924 ELSE
1925 Cf=Span/2
1926 END IF
1927 Range=VAL(FNInpt_rsp$(Inpt_label$,"RANGE"))
1928 !
1929 IF VAL(FNInpt_rsp$(Inpt_label$,"MEASUREMENT STATE"))=0 THEN
1930 Inpt_cmd(Inpt_label$,"CLEAR ERRORS")
1931 Inpt_cmd(Inpt_label$,"START")
1932 END IF
1933 !
1934 IF FNDiag_chk_moderr(Inpt_label$) THEN
1935 User_error("Errors found at start of measurement, measurement aborted")
1936 RETURN 1
1937 END IF
1938 RETURN 0
1939 FNEND
1940 !
1941 ! PAGE ->
1942 !************************************************************************
1943 Diag_fftr:SUB Diag_fftr(X(*),Areal(*),Aimag(*),INTEGER M)
1944 ! Subroutine to compute the complex discrete
1945 ! fourier transform of a real sequence.
1946 ! X is the array of N=2^(M+1) real numbers.
1947 ! at exit, Areal,Aimag are the lower half of
1948 ! the conjugate even DFT. Note that in the
1949 ! calling program, the dimension of Areal,
1950 ! Aimag should be 1+ (MAX N)/2 .
1951 !
1952 OPTION BASE 1
1953 INTEGER I,Nj,J,N,Nv2,Nv2p2,Nv4p1,Mm1
1954 DISP "Pre FFT"
1955 S=-1.
1956 N=2^(M+1)
1957 Nv2=N/2
1958 Nv2p2=Nv2+2
1959 Nv4p1=(N/4)+1
1960 Angle=S*PI/Nv2
1961 !LOAD X INTO Areal,Aimag:
1962 FOR I=2 TO N STEP 2
1963 J=I/2
1964 Areal(J)=X(I-1)
1965 Aimag(J)=X(I)
1966 NEXT I
1967 !
1968 CALL Diag_fft(Areal(*),Aimag(*),S,M)
1969 DISP "Deinterlacing"
1970 Wreal=COS(Angle)
1971 Wimag=SIN(Angle)
1972 Ureal=0.
1973 Uimag=1.
1974 Ar=Areal(1)
1975 Ai=Aimag(1)
1976 Areal(1)=Ar+Ai
1977 Aimag(1)=0.
1978 Areal(Nv2+1)=Ar-Ai
1979 Aimag(Nv2+1)=0.
1980 FOR J=2 TO Nv4p1
1981 Nj=Nv2p2-J
1982 Ur=Wreal*Ureal-Wimag*Uimag
1983 Ui=Wreal*Uimag+Wimag*Ureal
1984 Ureal=Ur
1985 Uimag=Ui
1986 Treal=Areal(Nj)
1987 Timag=-1.*Aimag(Nj)
1988 X1real=(Treal+Areal(J))/2.
1989 X1imag=(Timag+Aimag(J))/2.
1990 Ur=(Treal-Areal(J))/2.
1991 Ui=(Timag-Aimag(J))/2.
1992 X2real=Ureal*Ur-Uimag*Ui
1993 X2imag=Ureal*Ui+Uimag*Ur
1994 Areal(J)=X1real+X2real
1995 Aimag(J)=X1imag+X2imag
1996 Areal(Nj)=X1real-X2real
1997 Aimag(Nj)=-1.*(X1imag-X2imag)
1998 NEXT J
1999 DISP ""
2000 SUBEXIT
2001 SUBEND
2002 !
2003 ! PAGE ->
2004 !************************************************************************
2005 Diag_fft:SUB Diag_fft(Areal(*),Aimag(*),S,INTEGER M)
2006 ! Subroutine to compute the complex discrete
2007 ! fourier transform of a complex sequence.
2008 ! N=2^M where n is the DFT length.
2009 ! DFT: Areal, Aimag are data and S=-1.
2010 ! IDFT: Areal, Aimag are DFT/N and S=+1.
2011 ! Areal, Aimag are replaced by the result
2012 !
2013 INTEGER I,J,K,L,N,Nv2,Nm1,Le,Le1,Ip
2014 N=2^M
2015 Nv2=N/2
2016 Nm1=N-1
2017 !bit reversal of input array
2018 !J-1 and I-1 are bit reversals of each other
2019 J=1
2020 FOR I=1 TO Nm1
2021 IF I<J THEN
2022 Treal=Areal(J)
2023 Timag=Aimag(J)
2024 Areal(J)=Areal(I)
2025 Aimag(J)=Aimag(I)
2026 Areal(I)=Treal
2027 Aimag(I)=Timag
2028 END IF
2029 K=Nv2
2030 Diag_fft1: !
2031 IF K>=J THEN GOTO Diag_fft2
2032 J=J-K
2033 K=K/2
2034 GOTO Diag_fft1
2035 Diag_fft2: !
2036 J=J+K
2037 NEXT I
2038 !start the FFT algorithm:
2039 Spi=S*PI
2040 FOR L=1 TO M
2041 DISP "FFT'ing level #",L
2042 Le=2^L
2043 Le1=Le/2
2044 Ureal=1.
2045 Uimag=0.
2046 Angle=Spi/Le1
2047 Wreal=COS(Angle)
2048 Wimag=SIN(Angle)
2049 FOR J=1 TO Le1
2050 FOR I=J TO N STEP Le
2051 Ip=I+Le1
2052 Treal=Areal(Ip)*Ureal-Aimag(Ip)*Uimag
2053 Timag=Areal(Ip)*Uimag+Aimag(Ip)*Ureal
2054 Areal(Ip)=Areal(I)-Treal
2055 Aimag(Ip)=Aimag(I)-Timag
2056 Areal(I)=Areal(I)+Treal
2057 Aimag(I)=Aimag(I)+Timag
2058 NEXT I
2059 Ur=Wreal*Ureal-Wimag*Uimag
2060 Ui=Wreal*Uimag+Wimag*Ureal
2061 Ureal=Ur
2062 Uimag=Ui
2063 NEXT J
2064 NEXT L
2065 DISP ""
2066 SUBEXIT
2067 SUBEND
2068 !
2069 ! PAGE ->
2070 !************************************************************************
2071 Diag_get_data:DEF FNDiag_get_data(Inpt_label$,Data_array(*))
2072 !
2073 ! This subprogram is used by Diag_do_meas to get the
2074 ! data from the input module, compute the spectrum of it,
2075 ! and put the results into the Data_array(*).
2076 !
2077 COM /Diag_meas_setup/ Zooming,Span,Cf,Range,Ovld
2078 !
2079 !
2080 DISP "Waiting for data"
2081 !
2082 LOOP
2083 Inpt_status=VAL(FNInpt_rsp$(Inpt_label$,"STC?"))
2084 EXIT IF POS(FNInpt_stat_2_str$(Inpt_status),"BAV")<>0
2085 EXIT IF POS(FNInpt_stat_2_str$(Inpt_status),"ERR")<>0
2086 EXIT IF POS(FNInpt_stat_2_str$(Inpt_status),"FSFAST")<>0
2087 END LOOP
2088 !
2089 Inpt_status=VAL(FNInpt_rsp$(Inpt_label$,"STA?"))
2090 !
2091 IF POS(FNInpt_stat_2_str$(Inpt_status),"ERR")<>0 THEN
2092 User_clr_scr
2093 Diag_chk_errors(Inpt_label$)
2094 User_error("Error during measurement, measurement aborted")
2095 RETURN 1
2096 END IF
2097 !
2098 IF POS(FNInpt_stat_2_str$(Inpt_status),"FSFAST")<>0 THEN
2099 User_error("Fs too fast during measurement, measurement aborted")
2100 RETURN 1
2101 END IF
2102 !
2103 Ovld=(VAL(FNInpt_rsp$(Inpt_label$,"OVRI?"))>0)
2104 !
2105 ALLOCATE INTEGER Inpt_buffer(1:1024)
2106 !
2107 Hw_read_mod_blk(FNCnfg_get_modnum(Inpt_label$),Inpt_buffer(*))
2108 !
2109 FOR Ptr=0 TO 511
2110 Data_array(1,Ptr)=Inpt_buffer(Ptr+1)/32768
2111 NEXT Ptr
2112 !
2113 DISP "Doing FFT"
2114 !
2115 ALLOCATE Areal(1:513),Aimag(1:513)
2116 !
2117 IF Zooming THEN
2118 Ptr2=1
2119 FOR Ptr=1 TO 512
2120 Areal(Ptr)=Inpt_buffer(Ptr2)/32768
2121 Aimag(Ptr)=Inpt_buffer(Ptr2+1)/32768
2122 Ptr2=Ptr2+2
2123 NEXT Ptr
2124 DEALLOCATE Inpt_buffer(*)
2125 !
2126 Diag_window(Areal(*),Aimag(*))
2127 Diag_fft(Areal(*),Aimag(*),-1,9)
2128 !
2129 ELSE
2130 ALLOCATE Inpt_real(1:1024)
2131 MAT Inpt_real= Inpt_buffer
2132 MAT Inpt_real= Inpt_real/(32768)
2133 DEALLOCATE Inpt_buffer(*)
2134 !
2135 Diag_window(Inpt_real(*))
2136 Diag_fftr(Inpt_real(*),Areal(*),Aimag(*),9)
2137 !
2138 DEALLOCATE Inpt_real(*)
2139 END IF
2140 !
2141 DISP "Doing MAG^2"
2142 !
2143 IF Zooming THEN
2144 FOR Ptr=0 TO 199
2145 Areal_e=Areal(Ptr+313)
2146 Aimag_e=Aimag(Ptr+313)
2147 Data_array(2,Ptr)=(Areal_e*Areal_e+Aimag_e*Aimag_e)/262144!=(256*2)^2
2148 NEXT Ptr
2149 FOR Ptr=200 TO 400
2150 Areal_e=Areal(Ptr-199)
2151 Aimag_e=Aimag(Ptr-199)
2152 Data_array(2,Ptr)=(Areal_e*Areal_e+Aimag_e*Aimag_e)/262144!=(256*2)^2
2153 NEXT Ptr
2154 ELSE
2155 FOR Ptr=0 TO 400
2156 Areal_e=Areal(Ptr+1)
2157 Aimag_e=Aimag(Ptr+1)
2158 Data_array(2,Ptr)=(Areal_e*Areal_e+Aimag_e*Aimag_e)/1048576!=(512*2)^2
2159 NEXT Ptr
2160 END IF
2161 !
2162 RETURN 0
2163 FNEND
2164 ! PAGE ->
2165 !************************************************************************
2166 Diag_window:SUB Diag_window(REAL Areal(*),OPTIONAL Aimag(*))
2167 !This subroutine performs a Hann window function
2168 !on either a real time record, or on
2169 !the complex array Areal,Aimag of length N.
2170 !Winval array should be of length N.
2171 !
2172 INTEGER I,J,N,N2,M
2173 COM /Diag_wincom/ INTEGER Ncom,REAL Winval(*)
2174 M=INT(LGT(SIZE(Areal,1))/LGT(2))
2175 N=2^M
2176 IF N<>Ncom THEN
2177 DISP "INITIALIZING WINDOW"
2178 Pix2n=PI/N
2179 FOR I=1 TO N
2180 Angle=I-1
2181 Y=SIN(Angle*Pix2n)
2182 Winval(I)=2.*Y*Y
2183 NEXT I
2184 Ncom=N
2185 END IF
2186 DISP "WINDOWING"
2187 IF NPAR>1 THEN
2188 !COMPLEX WINDOW:
2189 FOR I=1 TO N
2190 Areal(I)=Areal(I)*Winval(I)
2191 Aimag(I)=Aimag(I)*Winval(I)
2192 NEXT I
2193 ELSE
2194 !REAL WINDOW:
2195 FOR I=1 TO N
2196 Areal(I)=Areal(I)*Winval(I)
2197 NEXT I
2198 END IF
2199 DISP ""
2200 SUBEND