1 ! -------------------------------------------------------------------------- 2 ! 3 ! PROGRAM FR_END8562: HP 8562 E-SERIES FRONT END CALIBRATION REV A.00.01 4 ! 5 ! REV A.00.01 Removes printer subprogram calls. 6 ! 960728:1800 7 ! 9 ! REV A.00.00 Provides Front End Calibration for HP8562E Spectrum Analyzers 10 ! 960626:0730 11 ! Leveraged from Hewlett-Packard OPVER (VERIFY_6XE, Rev C.01.00), 12 ! SUB Fr_end_cl_f (Rev 2.15), and other supplied subprograms. 13 !--------------------------------------------------------------------------- 14 COM /Equipment/Present(1:20),Power_mtr_avail,Counter_avail,Sensor_avail(1:20),Source_avail(1:20),Source2_avail(1:20),Enough_equip(1:20) 15 COM /Test_flags/Test_number,Sequence_type,Last_test 16 COM /Sensor/Current_channel,Sensor(1:2),Cal_time(1:2),Cal_data(1:2,1:65) 17 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 18 COM /Sum_errors/Sum_error$[128] 19 COM /Conditions/Conditions$(0:26,1:2)[160] 20 COM /Tests/Tests$(0:128,1:2)[37],Short_name$(1:128)[16],Conn_check(1:128) 21 COM /Trace_data/Trace_data(0:600) 22 COM /Bandwidths/Bw(1:14),Bw$(1:14)[7] 23 COM /Menu/Menu$[50] 24 COM /Coupling/ INTEGER Ac_dc 25 ! 26 ! COM BLOCKS From FR_END CAL 27 COM /Frendcal/Options$[37],Test_mode$[16],Jan_mode$[16],INTEGER Test_result,Depend 28 COM /Variations/Model$[20],INTEGER Short_moved 29 COM /Ee_data/ INTEGER Ee_data(0:2401) 30 ! 31 ! COM BLOCKS From STATN_DRVRS 32 COM /Power_sensors/ REAL Head_cal_data(1:2,1:6,1:600),REAL Time_checked(1:6) 33 COM /Power_sensors/ INTEGER Sensor_address(1:6),REAL Sr_num(1:6) 34 COM /Power_sensors/Sensor_model$(1:4)[10],Low_freq(1:4),Freq_increment(1:4) 35 COM /Pm_filter/Filter(1:4) 36 COM /Synth_8340_mem/Disable_8340err$(1:4,1:2)[80] 37 ! 38 ! COM BLOCKS From ADJ_SLOP 39 ! 40 ! COM BLOCKS From BLK_DRVRS 41 COM /Dut_data/Status$(1:99)[6],INTEGER Num_pass(1:99),Num_fail(1:99) 42 COM /Dut_data/ REAL Total_test_time(1:99),Start_test_time 43 COM /Identification/Serial_num$[10],Option$(1:16)[3],Tech_num$[8] 44 COM /Identification/ INTEGER Station_num,Batch 45 COM /Mixer_bias/Mixer_voltage(1:4) 46 COM /Font_data/Font_data(1:1000,1:3),Char_index(0:127) 47 COM /Prefix/Prefix$[5] 48 COM /Status_com/Status_com$[32767] 49 ! 50 !---------------------------------------------------------------------------- 51 OUTPUT KBD;"ÿK";"GCLEARÿX";"SCRATCH KEYÿX";"PRINTER IS CRTÿX"; 52 CONTROL 2,1;0 ! Printall OFF 53 CONTROL 1,12;2 ! Softkeys ON 54 STATUS KBD,9;Kbd_status 55 IF BIT(Kbd_status,5) AND NOT BIT(Kbd_status,1) THEN CONTROL KBD,15;1 ! Turn keyboard compatibility on for HP46020A HIL keyboard 56 Comp$=SYSTEM$("SYSTEM ID") !Turn display compatibility in- 57 IF Comp$[1,4]="S300" THEN CONTROL CRT,21;0 !terface off if computer is 310 58 CONTROL CRT,13;25 ! Set screen to 25 lines 59 Conditions_menu ! Call Conditions_menu subprogram 60 ! which will call Adj_menu subprogram 61 OUTPUT KBD;"ÿK";"GCLEARÿX";"ÿMÿM";!Clr text,graphics,alpha on 62 ! 63 END 64 ! 65 ! 66 Conditions_menu: SUB Conditions_menu ! Set test condition information 67 ! 68 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 69 COM /Conditions/Conditions$(*) 70 COM /Sensor/Current_channel,Sensor(*),Cal_time(*),Cal_data(*) 71 COM /Menu/Menu$ 72 ! 73 DIM Mode$[80],File$[80],Key$[160] ! Mode=Key_pressed$&" mode";File$=Sensor file$ 74 DIM Catalog$(1:1000)[80] ! Used to see if mass storage device is present 75 DIM Input$[160] 76 DIM Comp$[7] 77 DIM Default_msus$[160] 78 ! 79 STATUS KBD,9;Kbd_status 80 IF BIT(Kbd_status,5) THEN ! HIL keyboard 81 Ul$=CHR$(132) 82 Clr$=CHR$(128) 83 ELSE 84 Ul$=CHR$(132) 85 Clr$=CHR$(128) 86 END IF 87 ! 88 Comp$=SYSTEM$("SYSTEM ID") ! Select default mass storage file location 89 SELECT Comp$[1,4] ! based upon the computer being used. 90 CASE "S300" ! 91 Default_msus$=":,700,1" ! The first attempt to load the FR_CNDTNS 92 CASE "9816" ! file will be from the default msus. 93 Default_msus$=":,700,1" ! Refer to Load_conds 94 CASE "9836" 95 Default_msus$=":,700,1" 96 END SELECT 97 Default_msus$=SYSTEM$("MSI") 98 ! 99 ! LOAD FR_CNDTNS$(*) 100 ! 101 RESTORE Conditions_data ! Read Conditions$(*) 102 READ Cond_menu_len ! # of lines in conditions menu 103 REDIM Conditions$(0:Cond_menu_len,1:2) 104 RESTORE Conditions_data 105 READ Conditions$(*) 106 Conditions$(3,2)=DATE$(TIMEDATE) ! Set current time and date 107 Conditions$(4,2)=TIME$(TIMEDATE) 108 GOSUB Query_dut_sn 109 Init_load_attpt=1 110 GOSUB Load_conds 111 Init_load_attpt=0 112 Menu$="Conditions Menu" 113 ! 114 ! CONDITIONS_MENU MAIN LOOP 115 ! 116 REPEAT ! Main menu loop 117 Quit=0 ! Set to 1 to exit program 118 Next_menu=0 ! Set to 1 to go to Test menu 119 Draw_alpha_hdr("Conditions Menu") ! Draw Menu graphics header 120 ! 121 REPEAT ! Key press loop 122 STATUS KBD,9;Kbd_status 123 IF BIT(Kbd_status,5) THEN 124 Key$="Adjust Menu,Load Conds,Sensor Utils,Change Entry,Verify Bus,Query DUT S/N,,Exit Program,,Store Conds," 125 ELSE 126 Key$="Adjust Menu,Load Conds,Sensor Utils,,Store Conds,Change Entry,Verify Bus,Query DUT S/N,Exit Program,," 127 END IF 128 Conditions$(3,2)=DATE$(TIMEDATE) 129 Conditions$(4,2)=TIME$(TIMEDATE) 130 Label_keys(Key$,Key_pressed$,Conditions$(*),Selection,Page) 131 GOSUB Interpret_keys ! Process key selection 132 UNTIL Quit OR Next_menu 133 ! 134 IF Next_menu THEN ! Check for errors before leaving 135 Checking_cond=1 136 Cond_error=0 137 Verify ! Verify instruments on HPIB 138 Check_addresses("",Cond_error) ! Check address non-duplicity 139 ! GOSUB Prntr_available ! Removed per customer direction REV A.00.01 140 GOSUB Query_dut_sn ! Checks that DUT's there and responding 141 GOSUB Check_model_num ! Check that DUT is 8562 E-Series 142 GOSUB Check_sensors ! Check sensor data availability 143 Checking_cond=0 144 Result=FNRom_date("SET") 145 ! 146 Cal_it: ! 147 IF NOT Cond_error THEN CALL Adj_menu 148 END IF 149 ! 150 UNTIL Quit ! Head for the next menu 151 ! 152 SUBEXIT ! 153 ! 154 Prntr_available: ! Cannot allow entry to Test Menu if printer is not 155 ! available; results only go to printer 156 IF Conditions$(13,2)[6,6]<>"*" THEN ! Printer is not available 157 Cond_error=1 158 Prompt_user("ERROR: Printer not available; cannot perform tests.") 159 ELSE ! Printer is available, assign IO path 160 ASSIGN @Printer TO VAL(Conditions$(13,2)[1,4]) 161 END IF 162 RETURN ! from Prntr_available 163 ! 164 Check_sensors: ! 165 DISP "Checking availability of sensor files..." 166 FOR Line=9 TO 10 ! Acommodate 8481A and 8485A 167 IF NOT POS(Conditions$(Line,2),"NA") THEN 168 OUTPUT File$ USING "#,K,2A,5Z";"SEN",Conditions$(Line,1)[3,4],VAL(Conditions$(Line,2)[1,5]) 169 ON ERROR GOTO Cs_no_file 170 ASSIGN @File TO FNFile$(File$,Conditions$(7,2)) 171 OFF ERROR 172 ON ERROR GOTO Cs_load_err 173 ENTER @File;Cal_data(*) 174 OFF ERROR 175 Check_cal_data(File$,Cond_error) 176 GOTO Check_sen_cont 177 ! 178 Cs_no_file: OFF ERROR 179 Prompt_user("ERROR: "&FNFile$(File$,Conditions$(7,2))&" file not found.",Cond_error) 180 GOTO Check_sen_cont 181 ! 182 Cs_load_err:! off error 183 Prompt_user("ERROR: Unable to load data from "&FNFile$(File$,Conditions$(7,2))&".",Cond_error) 184 ! 185 Check_sen_cont: ! 186 END IF 187 NEXT Line 188 DISP 189 RETURN 190 ! 191 ! INTERPRET CONDITIONS MENU SFKs 192 ! 193 Interpret_keys: ! Take action indicated by key press and pointer position 194 Mode$=Ul$&Key_pressed$&" Mode"&RPT$(" ",13-MIN(LEN(Key_pressed$),13))&Clr$ 195 SELECT Key_pressed$ 196 CASE "Adjust Menu","Adjust Menu" ! Go to Adj_menu subprogram 197 PRINT TABXY(61,4); 198 OUTPUT CRT;Ul$&"Adjust Menu mode ";Clr$ 199 Next_menu=1 200 CASE "Load Conds","Load Conds" 201 PRINT TABXY(61,4); 202 OUTPUT CRT;Ul$&"Load Conds mode ";Clr$ 203 GOSUB Load_conds 204 CASE "Store Conds","Store Conds" 205 PRINT TABXY(61,4); 206 OUTPUT CRT;Ul$&"Store Conds mode ";Clr$ 207 GOSUB Store_conds 208 CASE "Sensor Utils" 209 CALL Sensorutilities 210 Draw_alpha_hdr("Conditions Menu") 211 CASE "Change Entry" 212 PRINT TABXY(61,4); 213 OUTPUT CRT;Mode$ 214 GOSUB Change_key 215 CASE "Verify Bus" ! Verify presence of instruments on HPIB 216 PRINT TABXY(61,4); 217 OUTPUT CRT;Mode$ 218 Verify 219 CASE "Query DUT S/N","Query DUT S/N" 220 PRINT TABXY(61,4); 221 OUTPUT CRT;Ul$;"Query DUT S/N mode ";Clr$ 222 GOSUB Query_dut_sn 223 CASE "Exit Program","Exit Program" ! Quit the program 224 Quit=1 225 KBD CMODE OFF 226 END SELECT 227 RETURN 228 ! 229 Load_conds: ! Load conditions data 230 ON ERROR GOTO Lc_no_cond_file 231 DISP "Checking availability of conditions file..." 232 IF Init_load_attpt THEN ! Load from default_msus$ 233 ASSIGN @Path TO FNFile$("FR_CNDTNS",Default_msus$) 234 DISP "Loading conditions from ";FNFile$("FR_CNDTNS",Default_msus$);"..." 235 ELSE 236 ASSIGN @Path TO FNFile$("FR_CNDTNS",Conditions$(7,2)) 237 DISP "Loading conditions from ";FNFile$("FR_CNDTNS",Conditions$(7,2));"..." 238 END IF 239 ENTER @Path;Conditions$(*) 240 OFF ERROR 241 IF VAL(Conditions$(0,1))<>18 THEN ! Conditions file is not compatible with 242 RESTORE Conditions_data ! Rev C.00.00; use defaults instead. 243 READ Conditions$(*) 244 Prompt_user("WARNING: FR_CNDTNS file from system file location is not compatible!") 245 END IF 246 Verify ! Overwrite stored verification data 247 GOSUB Query_dut_sn ! See if DUT at HPIB address 248 Conditions$(3,2)=DATE$(TIMEDATE) ! Set current time and date 249 Conditions$(4,2)=TIME$(TIMEDATE) 250 RETURN 251 ! 252 Lc_no_cond_file: ! 253 OFF ERROR 254 IF VAL(Conditions$(0,1))<>18 THEN ! Conditions file is not compatible with 255 RESTORE Conditions_data ! Rev C.00.00; use defaults instead. 256 READ Conditions$(*) 257 Conditions$(3,2)=DATE$(TIMEDATE) ! Set current time and date 258 Conditions$(4,2)=TIME$(TIMEDATE) 259 GOSUB Query_dut_sn 260 Prompt_user("WARNING: FR_CNDTNS file from system file location is not compatible!") 261 END IF 262 IF Init_load_attpt THEN Conditions$(7,2)=Default_msus$ 263 IF NOT Init_load_attpt THEN CALL Prompt_user("ERROR: Unable to load FR_CNDTNS file from system file location.") 264 RETURN 265 ! 266 Store_conds: ! Store Conditions$(*) onto file 267 ON ERROR GOTO Sc_no_sys_file 268 DISP "Checking availability of conditions file..." 269 CAT Conditions$(7,2) TO Catalog$(*) 270 ON ERROR GOTO Sc_create_file 271 ASSIGN @Path TO FNFile$("FR_CNDTNS",Conditions$(7,2)) 272 OFF ERROR 273 Output_conditns: DISP "Storing conditions onto ";FNFile$("FR_CNDTNS",Conditions$(7,2));"..." 274 OUTPUT @Path;Conditions$(*) 275 ASSIGN @Path TO * 276 RETURN 277 Sc_create_file: ! 278 OFF ERROR 279 CREATE BDAT FNFile$("FR_CNDTNS",Conditions$(7,2)),9,256 280 ASSIGN @Path TO FNFile$("FR_CNDTNS",Conditions$(7,2)) 281 GOTO Output_conditns 282 Sc_no_sys_file: ! 283 OFF ERROR 284 Prompt_user("ERROR: System mass storage file location catalog cannot be read.") 285 RETURN 286 ! 287 Query_dut_sn: ! 288 DISP "Querying DUT S/N..." 289 IF POS(Conditions$(12,2),"NA") THEN ! DUT HPIB address location 290 Conditions$(1,2)="No HPIB address listed for DUT" 291 IF Checking_cond THEN CALL Prompt_user("ERROR: No HPIB address listed for DUT",Cond_error) 292 ELSE 293 Full_address=VAL(Conditions$(12,2)) 294 Select_code=INT(Full_address/100) 295 ON ERROR GOTO Nothing_there 296 LOCAL Select_code 297 REMOTE Select_code 298 OFF ERROR 299 Address=Full_address MOD 100 300 ON TIMEOUT Select_code,1 GOTO Nothing_there 301 ASSIGN @Dut TO Full_address 302 OUTPUT @Dut;"IP" 303 WAIT 2 304 OUTPUT @Dut;"ID?" 305 ENTER @Dut;Model_num$ 306 IF LEN(Model_num$)>23 THEN Model_num$=Model_num$[1,23] 307 ! 308 OUTPUT @Dut;"SER?" 309 ENTER @Dut;Ser_num$ 310 OFF TIMEOUT 311 Conditions$(1,2)=Model_num$&" "&Ser_num$ 312 DISP 313 RETURN 314 ! 315 Check_model_num: ! Added in Rev B.00.00 316 IF Conditions$(1,2)[7;1]<>"E" THEN 317 Cond_error=1 318 Prompt_user("ERROR: This program does not support the current DUT") 319 END IF 320 RETURN 321 ! 322 Nothing_there: ! 323 Conditions$(1,2)="DUT doesn't respond at address listed" 324 IF Checking_cond THEN CALL Prompt_user("ERROR: DUT doesn't respond at address listed.",Cond_error) 325 END IF 326 DISP 327 RETURN 328 ! 329 ! PROCESS CHANGES IN THE CONDITIONS MENU 330 ! 331 Change_key: ! Change selection pointed to 332 ON ERROR GOTO Entry_error ! Blanket error trapping command 333 IF Selection=2 THEN GOSUB Change_id ! Operator id 334 IF Selection=3 THEN GOSUB Change_date ! System date 335 IF Selection=4 THEN GOSUB Change_time ! System time 336 IF Selection=5 THEN GOSUB Change_cond ! Test conditions 337 IF Selection=6 THEN GOSUB Change_comment ! User comment 338 IF Selection=7 THEN GOSUB Change_file ! System mass storage file 339 IF Selection>=9 AND Selection<=10 THEN GOSUB Change_sensor ! Rev C.00.00 340 IF Selection>=11 THEN GOSUB Change_address ! HPIB addresses 341 OFF ERROR ! ON ERROR GOTO entry_error 342 RETURN ! from Change_key 343 ! 344 Change_date: ! 345 DISP "Enter the new system date:"; 346 Input$=Conditions$(3,2) ! Rev C.00.00 347 Input(Input$) 348 IF Input$<>"" THEN 349 Time=TIMEDATE MOD 86400 350 SET TIMEDATE DATE(Input$) 351 SET TIME (Time) 352 Conditions$(3,2)=DATE$(TIMEDATE) 353 END IF 354 RETURN 355 ! 356 Change_time: ! 357 DISP "Enter the new system time:"; 358 Input$=Conditions$(4,2) ! Rev C.00.00 359 Input(Input$) 360 IF Input$<>"" THEN 361 SET TIME TIME(Input$) 362 Conditions$(4,2)=TIME$(TIMEDATE) 363 END IF 364 RETURN 365 ! 366 Change_id:! 367 DISP "Enter the new operator ID |<=MAX"; 368 Input$=Conditions$(2,2) ! Rev C.00.00 369 Input(Input$) 370 IF Input$<>"" THEN Conditions$(2,2)=Input$[1,37] 371 RETURN 372 ! 373 Change_sensor: ! 374 Sensor_type=VAL(Conditions$(Selection,1)[3,4]) ! 8481A or 8485A 375 Sensor_sn=-1 376 DISP "Enter the last 5 digits of Sensor serial number or 0 if not available:"; 377 I$="" 378 Input(I$) 379 IF LEN(I$)=0 OR POS(I$,"NA") THEN I$="0" 380 Sensor_sn=VAL(I$) 381 IF Sensor_sn>=0 AND Sensor_sn<100000 THEN 382 IF Sensor_sn=0 THEN 383 Conditions$(Selection,2)=" NA" 384 ELSE 385 ON ERROR GOTO No_sensor_warn 386 ASSIGN @File TO FNSensor_file$(Sensor_type,Sensor_sn) 387 OUTPUT Conditions$(Selection,2) USING "#,5Z";INT(Sensor_sn) 388 OFF ERROR 389 END IF 390 ELSE 391 IF Sensor_sn<>-1 THEN CALL Prompt_user("ERROR: Sensor serial number must be from 1 to 99999.") 392 END IF 393 RETURN 394 No_sensor_warn: OFF ERROR 395 Prompt_user("ERROR: No sensor file found for "&Conditions$(Selection,1)[1,5]&" S/N "&VAL$(INT(Sensor_sn))) 396 RETURN 397 ! 398 Change_comment: ! 399 DISP "Enter your comments |<=MAX"; 400 Input$=Conditions$(6,2) ! Rev C.00.00 401 Input(Input$) 402 IF Input$<>"" THEN Conditions$(6,2)=Input$[1,37] 403 RETURN 404 ! 405 Change_cond: ! 406 DISP "Enter test conditions description |<=MAX"; 407 Input$=Conditions$(5,2) ! Rev C.00.00 408 Input(Input$) 409 IF Input$<>"" THEN Conditions$(5,2)=Input$[1,37] 410 RETURN 411 ! 412 Change_file: ! system mass storage file 413 DISP "Enter mass storage file location"; 414 Input$=Conditions$(7,2) ! Rev C.00.00 415 Input(Input$) 416 IF Input$<>"" THEN 417 Input$=Input$[1,160] ! Rev C.00.00 418 ON ERROR GOTO Bad_file 419 DISP 420 DISP "Checking availability of mass storage file..." 421 CAT Input$ TO Catalog$(*) 422 Conditions$(7,2)=Input$ 423 END IF 424 RETURN 425 ! 426 Bad_file: Prompt_user("ERROR: Unable to obtain catalog from """&Input$&""".") 427 RETURN 428 ! 429 Change_address: ! Change HPIB addresses 430 Address_ok=1 431 Full_address=-1 432 DISP "Enter the HPIB address, or 0 if device not applicable: "; 433 I$="" ! Rev C.00.00 434 Input(I$) 435 IF LEN(I$)=0 OR POS(I$,"NA") THEN I$="0" 436 Full_address=VAL(I$) 437 IF Full_address=-1 THEN RETURN 438 IF Full_address=0 THEN 439 Conditions$(Selection,2)=" NA " 440 ELSE 441 Select_code=MIN(99,INT(Full_address/100)) 442 Address=Full_address MOD 100 443 ON ERROR GOTO Bad_select_code 444 LOCAL Select_code 445 REMOTE Select_code 446 GOTO Check_address 447 Bad_select_code: ! 448 Address_ok=0 449 Prompt_user("ERROR: Select code "&VAL$(Select_code)&" does not currently support HP-IB operations.") 450 Check_address:! 451 IF Address<0 OR Address>30 THEN 452 Address_ok=0 453 Prompt_user("ERROR: Address must be from 0 to 30 inclusive.") 454 END IF 455 IF Address_ok THEN 456 OUTPUT Conditions$(Selection,2) USING "#,4D,X,K";Full_address,"?" 457 Check_addresses("ERROR:") 458 END IF 459 END IF 460 RETURN 461 ! 462 Entry_error: ! 463 Prompt_user("ERROR: Data not accepted, check entry format.") 464 RETURN 465 ! 466 ! CONDITIONS$(*) AND TEST_CONDITIONS$(*) DATA 467 ! 468 Conditions_data: ! 469 DATA 18,2 ! Number of lines,pages 470 DATA "Spectrum Analyzer Under Test.......","" 471 DATA "Operator ..........................","" 472 DATA "Date ..............................","" 473 DATA "Time ..............................","" 474 DATA "Test Conditions ...................","" 475 DATA "Other comments ....................","" 476 DATA "System mass storage file location .",":,700,1" 477 DATA " POWER SENSOR SERIAL NUMBERS ","" 478 DATA "8481A ............................."," NA" 479 DATA "8485A ............................."," NA" 480 DATA " HP-IB ADDRESSES ","" 481 DATA "Spectrum Analyzer Under Test - - -"," 718 ?" 482 DATA "HPIB Printer - - - - - - - - - - -"," 701 ?" 483 DATA "436A Power Meter - - - - - - - - -"," 713 ?" 484 DATA "438A Power Meter - - - - - - - - -"," 712 ?" 485 DATA "8902A Measuring Receiver - - - - -"," 714 ?" 486 DATA "8340A/B Synthesized Sweeper - - - -"," 719 ?" 487 DATA "83640A/650A Synthesized Sweeper - -"," 716 ?" 488 ! 489 SUBEND 490 ! 491 ! 492 Adj_menu: SUB Adj_menu !Selects an adjustment 493 ! 494 ! Sequence type: 1=Run all tests once 495 ! 2=Single sequence 496 ! 3=Single test 497 ! 4=Repeat sequence 498 ! 5=Repeat test 499 ! 500 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 501 COM /Test_flags/Test_number,Sequence_type,Last_test 502 COM /Conditions/Conditions$(*) 503 COM /Tests/Tests$(*),Short_name$(*),Conn_check(*) 504 COM /Menu/Menu$ 505 COM /Frendcal/Options$,Test_mode$,Jan_mode$,INTEGER Test_result,Depend 506 COM /Variations/Model$,INTEGER Short_moved 507 COM /Ee_data/ INTEGER Ee_data(*) 508 COM /Rom_date/Rom_date$[6],No_tam,Set 509 ! 510 DIM Key_title$[160],Mode$[80],Test_link$[3000],Working_link$[160] 511 ! 512 Last_test=0 ! Reset last_test when entering Test_menu 513 STATUS KBD,9;Kbd_status 514 IF BIT(Kbd_status,5) THEN ! HIL keyboard 515 Ul$=CHR$(132) 516 Clr$=CHR$(128) 517 ELSE 518 Ul$=CHR$(132) 519 Clr$=CHR$(128) 520 END IF 521 ! 522 Menu$="Adjust Menu" 523 ! Header_prnt ! Removed per customer direction REV A.00.01 524 ! 525 ! LOAD TEST$(*), SHORT_NAME$(*) 526 ! 527 READ Tests$(0,1),Tests$(0,2) ! Num entries, pages 528 FOR I=1 TO VAL(Tests$(0,1)) 529 READ Tests$(I,1),Short_name$(I),Tests$(I,2),Conn_check(I) 530 NEXT I 531 ! 532 Check_equipment(1) ! Check for sufficient equip 533 Check_options 534 ! 535 ! ADJ_MENU MAIN LOOP 536 ! 537 REPEAT ! Selection loop 538 Draw_alpha_hdr("Adjust Menu") 539 STATUS KBD,9;Kbd_status 540 IF BIT(Kbd_status,5) THEN ! HP46020A keyboard 541 Key_title$="Single test,,,,,,Cal sensor,List equip,,Cond menu," 542 ELSE 543 Key_title$="Single test,,,,,Cal sensor,,List equipment,,Cond menu," 544 END IF 545 Page=1+(Test_number>10) 546 Label_keys(Key_title$,Key_pressed$,Tests$(*),Test_number,Page) ! Write page and label soft keys 547 GOSUB Inter_test_keys ! Decode key press selection 548 UNTIL Quit ! Abort key exits this loop by setting Quit to 1. 549 SUBEXIT ! 550 ! 551 ! INTERPRET TEST MENU SFKs 552 ! 553 Inter_test_keys: ! Decodes selection and mode and calls proper routines 554 Mode$=Ul$&Key_pressed$&" Mode"&RPT$(" ",14-MIN(LEN(Key_pressed$),14))&Clr$ ! Mode annotation on menu 555 IF Key_pressed$<>"Cond menu" AND Key_pressed$<>"Cond menu" AND Key_pressed$<>"List equip" AND Key_pressed$<>"List equipment" THEN 556 IF Key_pressed$<>"Cal sensor" AND Key_pressed$<>"Cal sensor" THEN 557 OUTPUT @Dut;"IP ID?" ! First check instrument identity 558 ENTER @Dut;Model_num$ 559 IF LEN(Model_num$)>23 THEN Model_num$=Model_num$[1,23] 560 ! 561 OUTPUT @Dut;"SER?" 562 ENTER @Dut;Ser_num$ 563 IF Conditions$(1,2)<>Model_num$&" "&Ser_num$ THEN 564 Prompt_user("ERROR: Conditions Menu DUT ID disagrees with responding DUT ID.") 565 Prompt_user("Conditions Menu ID: "&Conditions$(1,2)) 566 Prompt_user("Responding DUT ID: "&Model_num$&" "&Ser_num$) 567 Prompt_user("Change Conditions Menu ID or cycle DUT power if bus hangup suspected.") 568 RETURN 569 END IF 570 END IF 571 END IF 572 SELECT Key_pressed$ ! The name of the key pressed 573 CASE "Single test" 574 PRINT TABXY(61,4); 575 OUTPUT CRT;Mode$ 576 Sequence_type=3 577 Model$=Conditions$(1,2)[3,7] 578 Do_test 579 CASE "List equipment","List equip" 580 PRINT TABXY(61,4); 581 OUTPUT CRT;Ul$&"List equipment mode";Clr$ 582 Check_equipment(2) 583 Prompt_user("Press") 584 CASE "Cal sensor","Cal sensor" 585 PRINT TABXY(61,4); 586 OUTPUT CRT;Ul$&"Cal sensor mode ";Clr$ 587 Power_meter("USER CAL") 588 CASE "Cond menu","Cond menu" 589 Quit=1 590 END SELECT 591 RETURN 592 ! 593 ! LINKED TESTS ROUTINE 594 ! 595 Link_it: ! Allows entry of a list of tests that run in entry order 596 PRINT TABXY(61,4); 597 OUTPUT CRT;Mode$ 598 Offset=4 ! Top 4 lines of page are for header 599 IF Last_test=0 THEN Last_test=Offset+1 600 Test_link$="" ! Clear test sequence string 601 ! Rev B.00.00 Added 17th test, FADC Accy, and reordered for better flow during 602 ! All Tests 603 IF Sequence_type=1 THEN Test_link$="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,*," 604 IF Sequence_type=2 OR Sequence_type=4 THEN CALL Linker(Test_link$,VAL(Tests$(0,1))) 605 ! 606 Repeat_seq: ! 607 STATUS KBD,9;Kbd_status 608 IF BIT(Kbd_status,5) THEN ! HIL keyboard 609 ON KEY 6 LABEL "ABORT SEQUENC" RECOVER Seq_abort 610 ELSE 611 ON KEY 6 LABEL "ABORT SEQUENCE" RECOVER Seq_abort 612 END IF 613 Working_link$=Test_link$ 614 Comma=POS(Working_link$,",") 615 Test_num$=Working_link$[1,Comma-1] ! Parse out test # 616 WHILE Test_num$<>"*" ! Decode test_link$, call tests 617 Working_link$=Working_link$[Comma+1] 618 Test_number=VAL(Test_num$) 619 IF Test_num$<>"*" THEN ! Not done with tests 620 Draw_alpha_hdr("Test Menu") 621 Page=1+(Test_number>10) 622 Last_page=1+(Last_test>10) 623 Point_pos=Test_number-(10*(Page-1))+Offset 624 Last_point=Last_test-(10*(Last_page-1))+Offset 625 PRINT TABXY(2,Last_point);" " ! Clear last pointer 626 Write_page(Tests$(*),Page) ! Write new page 627 PRINT TABXY(2,Point_pos);"=>" 628 PRINT TABXY(61,4); 629 OUTPUT CRT;Mode$;Clr$ 630 END IF 631 Do_test ! Perform test 632 Comma=POS(Working_link$,",") 633 Test_num$=Working_link$[1,Comma-1] ! Parse out test # 634 END WHILE 635 IF Sequence_type=4 THEN GOTO Repeat_seq 636 ! 637 Seq_abort: ! 638 Test_link$="" 639 OFF KEY 6 640 RETURN 641 ! 642 Repeat_it: ! Allows a single test to be repeated until aborted 643 PRINT TABXY(61,4); 644 OUTPUT CRT;Mode$ 645 ! 646 Do_it_again: ! 647 STATUS KBD,9;Kbd_status 648 IF BIT(Kbd_status,5) THEN ! HIL keyboard 649 ON KEY 6 LABEL "ABORT REPEAT " RECOVER Rep_abort 650 ELSE 651 ON KEY 6 LABEL "ABORT REPEAT " RECOVER Rep_abort 652 END IF 653 Do_test ! Perform test 654 GOTO Do_it_again 655 ! 656 Rep_abort: ! 657 OFF KEY 6 658 RETURN 659 ! 660 ! Rev B.00.00 Following data reorganized for better flow when 661 ! running All Tests 662 ! 663 Test_data: DATA 1,1 ! Test title, Short name, Conn check 664 DATA " 1) Front End Cal for HP8562E","Fr_end_cl_f","",4 665 ! 666 SUBEND ! Test_menu 667 ! 668 ! 669 Prompt_user: SUB Prompt_user(Message$,OPTIONAL Flag)! 670 ! REV C.01.00 Added call to Beeper for audible prompts 671 ! 672 DIM Append$[25],Key$[160] 673 ! 674 IF NPAR=2 THEN 675 IF Flag=3 THEN SUBEXIT 676 END IF 677 ! 678 IF POS(Message$,"ERROR:") THEN 679 Beeper("ERROR") 680 ELSE 681 Beeper("PROMPT") 682 END IF 683 ! 684 Append$=" (any key)" 685 IF NPAR=2 THEN 686 IF Flag=2 THEN Append$=" (any key or 'Q' to quit)" 687 END IF 688 DISP ! Rev C.00.00 689 DISP Message$&Append$ 690 CONTROL 1,12;1 ! SFKs OFF 691 ON KBD ALL,15 GOTO Kbd_cont 692 GOTO 691 693 Kbd_cont: Key$=KBD$ 694 OFF KBD 695 CONTROL 1,12;2 ! SFKs ON 696 DISP 697 ! 698 IF NPAR=2 THEN 699 IF Flag=2 THEN ! Quit flag 700 IF UPC$(Key$[1,1])="Q" THEN Flag=3 ! See if Q key pressed 701 ELSE 702 Flag=1 703 END IF 704 END IF 705 ! 706 SUBEND !Prompt_user 707 ! 708 Label_keys: SUB Label_keys(Label$,Key_pressed$,Page_info$(*),Pointer,Page) 709 ! 710 ! Labels the softkeys according to Label$, which is in the form: 711 ! "Keys_name1,...,Key_name10," 712 ! Returns the literal name of the softkey selected in Key_pressed$ 713 ! Prints an array of selections held in Page_info$ (Conditions or 714 ! Test menu). Page_info$(0,1) = # of lines. Page_info$(0,2) = 715 ! # of pages (10 lines/page). Page_info$(1:# lines) is 37 716 ! characters long 717 ! Pointer keeps track of the line in Page_info$(*) a pointer is set to. 718 ! 719 DIM Defined(0:15),Key_label$(0:11)[14],Kbd_buffer$[200] 720 ! 721 Offset=4 ! First line of Page_info$(*) is printed with 4 blank lines between it and the top of screen 722 Num_entries=VAL(Page_info$(0,1)) ! Length of Page_info$(*) 723 Delta_page=10 ! SH arrow keys move ptr 10 lines 724 Total_pages=VAL(Page_info$(0,2)) ! Total pages in Page_info$(*) 725 Items_per_page=MIN(10,Num_entries) 726 Pointer=MIN(MAX(1,Pointer),Num_entries)! Ensure pointer is in range 727 Page=MIN(MAX(1,Page),Total_pages) ! Set correct page 728 Point=Pointer-(10*(Page-1))+Offset ! Line # for TABXY function 729 ! 730 ON KBD ALL GOSUB Read_keyboard ! Read keyboard entries 731 GOSUB Wrt_softkeys ! Write special function keys 732 GOSUB Write_new_page ! Write page 733 GOSUB Wrt_pointer ! Write the pointer indicator 734 ! 735 Clear: Keyboard$="" 736 Wait: ! 737 IF Page_info$(3,1)[1,4]="Date" THEN 738 Page_info$(3,2)=DATE$(TIMEDATE) 739 Page_info$(4,2)=TIME$(TIMEDATE) 740 IF Page=1 THEN 741 PRINT TABXY(40,7);Page_info$(3,2) 742 PRINT TABXY(40,8);Page_info$(4,2) 743 END IF 744 END IF 745 IF LEN(Keyboard$)=0 THEN Wait ! Wait for a key press 746 Softkey=POS("0123456789^VWTÿ",Keyboard$[2,2])-1!SFK0-9,up,down,shup,shdn 747 IF Softkey=14 THEN ! CNTL tkey pressed 748 Softkey=POS("WT",Keyboard$[3,3])-1 ! CNTL-SHIFT up & down arrow 749 IF Softkey>=0 THEN Softkey=Softkey+14 ! Valid CNTL key pressd 750 END IF 751 IF Softkey=-1 THEN Clear ! Undefined key pressed 752 IF (Softkey>9) THEN ! Motion of 1 to 6 indicates 753 Motion=Softkey-9 ! up,down,pageup,pagedown,top page, middle of pages 754 GOSUB Position_point ! Set new pointer position 755 GOSUB Wrt_pointer ! Print the pointer 756 END IF 757 IF NOT Defined(Softkey) THEN Clear ! Ignore undefined softkeys and 758 Key_pressed$=Key_label$(Softkey) ! don't exit subprogram 759 Pointer=(Delta_page*(Page-1))+(Point)-Offset ! Set pointer based on Page 760 SUBEXIT ! and Point 761 ! 762 Wrt_softkeys: ! Write the softkeys 763 FOR Key=0 TO 9 764 Comma=POS(Label$,",") 765 Key_label$(Key)=Label$[1,Comma-1] ! Parse out next label 766 Label$=Label$[Comma+1] 767 Defined(Key)=(Key_label$(Key)<>"") ! Does key have non-blank def.? 768 ON KEY Key LABEL Key_label$(Key) GOSUB Ignore 769 NEXT Key 770 RETURN 771 ! 772 Position_point: ! Determine a new pointer pos. 773 IF Motion=1 THEN Point=Point-1 ! Up 774 IF Motion=2 THEN Point=Point+1 ! Down 775 IF Motion=3 THEN Page=MAX(1,Page-1) ! Page up 776 IF Motion=4 THEN Page=MIN(Total_pages,Page+1) ! Page down 777 IF Motion=4 THEN Point=MIN(Point,Num_entries-(Page-1)*Delta_page+Offset) ! Make sure you don't go beyond last test 778 IF Motion=5 THEN Page=1 ! Top page 779 IF Motion=5 THEN Point=Offset+1 780 IF Motion=6 THEN Page=MIN(5,Total_pages) ! Page 2 (Conditions menu) or Page 5 (HF sequence on Tests menu) 781 IF Motion=6 THEN Point=Offset+1 782 ! 783 IF Motion<=2 THEN GOSUB Check_position ! Up or Down 784 IF Motion>=3 THEN GOSUB Write_new_page ! Have possibly jumped a page 785 RETURN 786 ! 787 Check_position: ! Determine what needs to be changed from new pos. 788 Change_page=0 789 IF Point1 ! Change the page if page > 1 791 Page=MAX(1,Page-1) ! Determine new page # 792 IF Change_page THEN Point=Delta_page+Offset ! If Change page, then Point is at top, 793 IF NOT Change_page THEN Point=Offset+1 ! otherwise Move point by 1 794 END IF 795 ! 796 IF (Point-Offset)>Items_per_page OR (Page-1)*Delta_page+Point-Offset>Num_entries THEN ! Off end of page or Beyond last entry 797 Change_page=Page" ! Write new pointer 833 Last_point=Point 834 RETURN 835 ! 836 SUBEND ! Label_keys 837 ! 838 ! 839 Write_page: SUB Write_page(Page_info$(*),Page) 840 ! 841 ! Writes page # Page of Page_info$(*). Assumes pages are 10 lines long, 842 ! but that each page starts at 10 line intervals. Thus, page 3 consists 843 ! of lines 31-40 of Page_info$(*). 844 ! 845 DIM T$[37] 846 COM /Test_flags/Test_number,Sequence_type,Last_test 847 ! 848 PRINT TABXY(1,5); 849 FOR Item=Page*10-9 TO Page*10 ! For items on the page 850 T$="" 851 IF Item<=VAL(Page_info$(0,1)) THEN Item_len=LEN(Page_info$(Item,2)) 852 IF Item<=VAL(Page_info$(0,1)) AND Item_len<=37 THEN T$=Page_info$(Item,2) 853 IF Item<=VAL(Page_info$(0,1)) AND Item_len>37 THEN 854 T$[1,17]=Page_info$(Item,2)[1,17] 855 T$=T$&"..."&Page_info$(Item,2)[(Item_len-16),Item_len] 856 END IF 857 IF Item>VAL(Page_info$(0,1)) THEN PRINT RPT$(" ",80) 858 IF Item<=VAL(Page_info$(0,1)) THEN PRINT " ";Page_info$(Item,1);" ";T$;RPT$(" ",MAX(0,37-LEN(Page_info$(Item,2)))) 859 ! IF Item<=VAL(Page_info$(0,1)) THEN PRINT " ";Page_info$(Item,1);" ";Page_info$(Item,2);RPT$(" ",37-LEN(Page_info$(Item,2))) 860 NEXT Item 861 DISP 862 DISP "Use arrow keys to move pointer, softkeys to select." 863 ! 864 SUBEND !Write_page 865 ! 866 ! 867 Verify: SUB Verify !Writes '*' for instruments found on bus 868 COM /Equipment/Present(*),Power_mtr_avail,Counter_avail,Sensor_avail(*),Source_avail(*),Source2_avail(*),Enough_equip(*) 869 COM /Conditions/Conditions$(*) 870 ! 871 DISP "Checking the bus ..." 872 MAT Present=(0) 873 FOR Line=12 TO VAL(Conditions$(0,1)) ! Rev C.00.00 874 IF POS(Conditions$(Line,2),"NA") THEN GOTO Next_line 875 DISP "Checking for an instrument at HPIB location ";Conditions$(Line,2)[1,4] 876 Bus=VAL(Conditions$(Line,2)[1,2]) ! Select code 877 ON ERROR GOTO No_sel_code 878 LOCAL Bus 879 REMOTE Bus 880 OFF ERROR 881 ON TIMEOUT Bus,.5 GOTO Not_there ! Skip the non-responding ones 882 ON ERROR GOTO Not_there 883 OUTPUT VAL(Conditions$(Line,2)[1,4]) 884 OFF ERROR 885 OFF TIMEOUT Bus 886 Conditions$(Line,2)[6,6]="*" ! Device present 887 Present(Line-11)=1 888 GOTO Next_line 889 Not_there: ! 890 OFF ERROR 891 OFF TIMEOUT Bus 892 No_sel_code: OFF ERROR 893 Conditions$(Line,2)[6,6]=" " 894 Next_line: NEXT Line 895 DISP 896 ! 897 FOR Line=9 TO 10 898 IF NOT POS(Conditions$(Line,2),"NA") THEN Present(Line-1)=1 899 NEXT Line 900 ! 901 Power_mtr_avail=0 902 IF Present(5) THEN Power_mtr_avail=8902 903 IF Present(3) THEN Power_mtr_avail=436 904 IF Present(4) THEN Power_mtr_avail=438 905 Counter_avail=0 906 ! 907 ! 908 SUBEND ! Verify 909 ! 910 ! 911 Setup_graph: SUB Setup_graph(X_units,Xmin,Xmax,Xdiv,X_title$,Y_units,Ymin,Ymax,Ydiv,Y_title$,Graph_title$) 912 ! 913 ! Sets up the graphics area for plotting. 914 ! * Prints horizontal, vertical and graph labels 915 ! * Scales the X and Y coordinates to units of X_units & Y_units 916 ! * Sets the start & stop coordinates, Xmin, Xmax, Ymin & Ymax 917 ! * Draws tick marks every Xdiv & Ydiv scaled to Xunits & Y units 918 ! 919 IF X_units<0 THEN Xmin=LGT(Xmin) ! Semilog graph 920 IF X_units<0 THEN Xmax=LGT(Xmax) 921 Plot_ratio=FNPlot_ratio 922 OUTPUT KBD;"ÿK";"DEGÿX";"GCLEARÿX";"GINITÿX";"GRAPHICS ONÿX";"ALPHA OFFÿX"; 923 PLOTTER IS CRT,"INTERNAL" 924 CSIZE FNCsize_val(5,Plot_ratio) 925 IF Plot_ratio>1 THEN 926 VIEWPORT 0,90,35,95 927 Label_off=.01 928 ELSE 929 VIEWPORT 0,100*RATIO,8,100 930 Label_off=.15 931 END IF 932 MOVE (100*RATIO+5)/2,0 ! X title 933 LORG 4 934 LABEL X_title$ 935 MOVE (100*RATIO+5)/2,100 ! Graph title 936 LORG 6 937 LABEL Graph_title$ 938 MOVE 0,50 ! Y title 939 LDIR 90 940 LABEL Y_title$ 941 IF Plot_ratio>1 THEN 942 VIEWPORT 7,80,43,89 943 ELSE 944 VIEWPORT 10,RATIO*100-5,18,100-5 ! Area applied to WINDOW 945 END IF 946 WINDOW Xmin,Xmax,Ymin,Ymax ! Normal grid 947 FRAME ! Frame & Grid 948 LINE TYPE 3 949 IF X_units>0 THEN GRID Xdiv,Ydiv,0,0 ! Normal grid 950 IF X_units<0 THEN GRID Xmax-Xmin,Ydiv,Xmin,0 ! Y grid for semi-log 951 IF X_units<0 THEN 952 FOR X=INT(Xmin*Xdiv+.99)/Xdiv TO Xmax STEP 1/Xdiv 953 MOVE LGT(DROUND(10^X,1)),Ymin 954 DRAW LGT(DROUND(10^X,1)),Ymax 955 NEXT X 956 END IF 957 LINE TYPE 1 ! Y labels 958 CLIP OFF 959 LORG 4 960 FOR Y=PROUND(Ymin,INT(LGT(Ydiv))) TO PROUND(Ymax,INT(LGT(Ydiv))) STEP Ydiv*SGN(Ymax-Ymin) 961 MOVE Xmin,Y 962 IF (YYmin) THEN 963 LABEL PROUND(Y,INT(LGT(Ydiv))) 964 END IF 965 NEXT Y 966 LDIR 0 ! X labels 967 LORG 6 968 IF X_units>0 THEN 969 FOR X=PROUND(Xmin,INT(LGT(Xdiv))) TO PROUND(Xmax,INT(LGT(Xdiv))) STEP Xdiv 970 MOVE X,Ymin 971 LABEL PROUND(X,INT(LGT(Xdiv))) 972 NEXT X 973 ELSE 974 FOR X=INT(Xmin*Xdiv+.99)/Xdiv TO Xmax STEP 1/Xdiv 975 MOVE LGT(DROUND(10^X,1)),Ymin 976 LABEL DROUND(10^X,1) 977 NEXT X 978 END IF 979 CLIP Xmin,Xmax,Ymin,Ymax ! Clip area for plotting 980 ! 981 SUBEND 982 ! 983 ! 984 Sensor_file: DEF FNSensor_file$(Sensor_type,Sensor_sn) 985 ! 986 COM /Conditions/Conditions$(*) 987 ! 988 DIM File$[80],Msi$[80],Units$[6],Test$[2] 989 ! 990 OUTPUT File$ USING "#,K,DD,5Z";"SEN",Sensor_type,Sensor_sn 991 RETURN FNFile$(File$,Conditions$(7,2)) 992 ! 993 FNEND 994 ! 995 ! 996 Parse: SUB Parse(Input$,Return$,OPTIONAL Value) 997 ! 998 ! Take the Input$, return in Return$ all characters up to an "=" or ",", 999 ! return in Value the numeric value of the characters from "=" to ",", 1000 ! and return in Input$ all characters after the ",". 1001 ! 1002 IF NPAR=3 THEN Value=-999 1003 IF POS(Input$,",") THEN 1004 Return$=Input$[1,POS(Input$,",")-1] ! All characters up to a "," 1005 Input$=Input$[POS(Input$,",")+1] ! All characters after a "," 1006 ELSE ! No "," present 1007 Return$=Input$ 1008 Input$="" 1009 END IF 1010 IF POS(Return$,"=") THEN 1011 Value=VAL(Return$[POS(Return$,"=")+1]) ! Characters after "=" 1012 Return$=Return$[1,POS(Return$,"=")-1] ! Stip characters after "=" 1013 END IF 1014 ! 1015 SUBEND 1016 ! 1017 ! 1018 Power_meter: SUB Power_meter(Input$,OPTIONAL Val1,Val2) ! Handles 436,438 & 8902 1019 ! 1020 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 1021 COM /Sensor/Current_channel,Sensor(*),Cal_time(*),Cal_data(*) 1022 COM /Conditions/Conditions$(*) 1023 COM /Test_flags/Test_number,Sequence_type,Last_test 1024 COM /Equipment/Present(*),Power_mtr_avail,Counter_avail,Sensor_avail(*),Source_avail(*),Source2_avail(*),Enough_equip(*) 1025 COM /Menu/Menu$ 1026 DIM Function$[80],I$[160] 1027 ! 1028 IF Power_mtr_avail=438 THEN 1029 IF Current_channel=0 THEN Current_channel=1 1030 ELSE 1031 Current_channel=1 1032 END IF 1033 ! 1034 REPEAT 1035 Parse(Input$,Function$,Parse_value) 1036 SELECT Function$ 1037 CASE "INITIALIZE" !Preset=chan A, Osc off, Watt changed to 1038 SELECT Power_mtr_avail 1039 CASE 436 1040 CLEAR @Pwr_mtr 1041 OUTPUT @Pwr_mtr;"9D+V" 1042 CASE 438 1043 OUTPUT @Pwr_mtr;"PRLG" !dBm, 100% Cal, Auto filter and range 1044 IF Current_channel=2 THEN OUTPUT @Pwr_mtr;"BP" 1045 CASE 8902 1046 OUTPUT @Pwr_mtr;"IP M4 LG 10.0SP" 1047 END SELECT 1048 CASE "CHECK CAL" 1049 IF Power_mtr_avail=438 AND Sensor(Current_channel)<>Sensor_avail(Test_number) THEN 1050 IF Sensor(3-Current_channel)=Sensor_avail(Test_number) THEN 1051 Current_channel=3-Current_channel 1052 Load_cal_data(Sensor(Current_channel)) 1053 END IF 1054 END IF 1055 IF Sensor(Current_channel)<>Sensor_avail(Test_number) OR (TIMEDATE>(Cal_time(Current_channel)+7200) AND Sequence_type<>4) THEN 1056 Cal_sensor=Sensor_avail(Test_number) 1057 GOSUB Cal_power_meter 1058 END IF 1059 CASE "USER CAL" 1060 REPEAT 1061 I$=" " 1062 DISP "What sensor would you like to calibrate (8481 or 8485)?"; 1063 I$=VAL$(Cal_sensor) ! Rev C.00.00 1064 Input(I$) 1065 UNTIL I$=" " OR I$="8481" OR I$="8485" 1066 IF I$="8481" AND Present(8) OR I$="8485" AND Present(9) THEN 1067 Cal_sensor=VAL(I$) 1068 GOSUB Cal_power_meter 1069 ELSE 1070 IF I$<>" " THEN CALL Prompt_user("ERROR: The "&I$&"A sensor is not available.") 1071 END IF 1072 CASE "CONTINUOUS TRIGGER" 1073 SELECT Power_mtr_avail 1074 CASE 436 1075 OUTPUT @Pwr_mtr;"V" 1076 CASE 438 1077 OUTPUT @Pwr_mtr;"TR3" 1078 CASE 8902 1079 OUTPUT @Pwr_mtr;"T0" 1080 END SELECT 1081 CASE "READ","SETTLED READ" 1082 IF NPAR=3 THEN Frequency=Val2 1083 IF NPAR<3 THEN Frequency=5.0E+7 1084 Old_power=-999 1085 Time0=TIMEDATE 1086 LOOP 1087 ENTER @Pwr_mtr;Power 1088 WAIT 1 1089 EXIT IF ABS(Old_power-Power)<=.05 AND Power<100 1090 EXIT IF TIMEDATE-Time0>10 ! 10 second maximum wait 1091 Old_power=Power 1092 END LOOP 1093 IF Power>100 THEN Power=-999 ! Under range reading 1094 ALLOCATE A(1:2,1:SIZE(Cal_data,2)) 1095 MAT SORT Cal_data(1,*) 1096 MAT A=Cal_data<=(5.0E+7) ! Number of frequencies <= 50 MHz 1097 Cal_index=SUM(A)-SIZE(A,2) ! All cal factors <= 100 1098 IF Cal_data(1,SIZE(A,2))=5.E+7 THEN 1099 Ref_cal_factor=Cal_data(2,SIZE(A,2)) 1100 ELSE 1101 Ref_cal_factor=(5.0E+7-Cal_data(1,Cal_index))/(Cal_data(1,Cal_index+1)-Cal_data(1,Cal_index))*(Cal_data(2,Cal_index+1)-Cal_data(2,Cal_index)) 1102 Ref_cal_factor=Ref_cal_factor+Cal_data(2,Cal_index) 1103 END IF 1104 MAT A=Cal_data<=(Frequency) ! # cal points < test freq 1105 Test_index=SUM(A)-SIZE(A,2) 1106 IF Frequency=Cal_data(1,SIZE(A,2)) THEN 1107 Test_cal_factor=Cal_data(2,SIZE(A,2)) 1108 ELSE 1109 Test_cal_factor=(Frequency-Cal_data(1,Test_index))/(Cal_data(1,Test_index+1)-Cal_data(1,Test_index))*(Cal_data(2,Test_index+1)-Cal_data(2,Test_index)) 1110 Test_cal_factor=Test_cal_factor+Cal_data(2,Test_index) 1111 END IF 1112 Val1=Power+10*LGT(Ref_cal_factor/Test_cal_factor) 1113 DEALLOCATE A(*) 1114 CASE ELSE 1115 Prompt_user("ERROR: Function "&Function$&" not found in Power_meter driver.") 1116 END SELECT !Function$ 1117 UNTIL Input$="" 1118 ! 1119 SUBEXIT 1120 ! 1121 Cal_power_meter:! 1122 IF Power_mtr_avail=438 THEN 1123 REPEAT 1124 I$=" " 1125 DISP "What channel is the "&VAL$(Cal_sensor)&"A power sensor connected to? (A/B)?"; 1126 Input(I$) 1127 I$=UPC$(I$[1,1]) 1128 UNTIL I$="A" OR I$="B" 1129 IF I$="A" THEN 1130 Current_channel=1 1131 OUTPUT @Pwr_mtr;"AP" 1132 ELSE 1133 Current_channel=2 1134 OUTPUT @Pwr_mtr;"BP" 1135 END IF 1136 END IF 1137 Sensor(Current_channel)=Cal_sensor 1138 IF Sensor(3-Current_channel)=Cal_sensor THEN Sensor(3-Current_channel)=0 1139 Load_cal_data(Cal_sensor) 1140 Channel$="" 1141 IF Power_mtr_avail=438 THEN Channel$="(Channel "&CHR$(NUM("A")+Current_channel-1)&") " 1142 Quit_flag=2 1143 Prompt_user("Connect "&VAL$(Cal_sensor)&"A "&Channel$&"to "&VAL$(Power_mtr_avail)&"A Power Reference",Quit_flag) 1144 IF Quit_flag=3 THEN SUBEXIT 1145 DISP "Calibrating power sensor ..." 1146 SELECT Power_mtr_avail 1147 CASE 438 1148 OUTPUT @Pwr_mtr;"ZECL100EN" 1149 REPEAT 1150 OUTPUT @Pwr_mtr;"SM" 1151 ENTER @Pwr_mtr;Status$ 1152 IF LEN(Status$)<6 THEN Status$=" " 1153 DISP "438A status: ";Status$[5,6] 1154 UNTIL Status$[5,6]="00" OR Status$[5,6]="01" 1155 CASE 436 1156 Prompt_user("Make sure that the 436A power reference is turned off.") 1157 REPEAT !Zeroing loop 1158 OUTPUT @Pwr_mtr;"Z1T" !Send zero trigger program codes 1159 ENTER @Pwr_mtr USING "B,B,B,5D,B,5D";Status,Range,Mode,Power,Letter,Exponent !Read meter 1160 DISP "436A Power reading: ";Power 1161 UNTIL ABS(Power)<2 ! Corresponsds to 0000 +/- 0002 1162 REPEAT !Checking zero loop condition 1163 OUTPUT @Pwr_mtr;"9+AI" !Send normal measurement codes 1164 ENTER @Pwr_mtr USING "B,B,B,5D,B,5D";Status,Range,Mode,Power,Letter,Exponent !Read meter 1165 DISP "436A Status: ";Status 1166 UNTIL Status<84 !Zero loop disabled 1167 OUTPUT @Pwr_mtr;"9D+V" !Set meter to free run, allowing 1168 Prompt_user("Turn on the 436A power reference and calibrate the sensor.") 1169 CASE 8902 1170 Cal_level=1.E-3 !Level to be CALed to 1171 Test_res=3.E-4 !Resolution used for setup check 1172 Resolution=.1 !Resolution of adjustment 1173 REPEAT !Check setup and measure amplitude 1174 Ok=1 1175 OUTPUT @Pwr_mtr;"IP M4 C1" 1176 ENTER @Pwr_mtr;Amplitude 1177 IF ABS(Amplitude-Cal_level)>Test_res THEN ! Signal low or setup bad 1178 Ok=0 1179 Prompt_user("Prepare the 8902A to be calibrated") 1180 END IF 1181 UNTIL Ok 1182 DISP "Initializing calibration data ..." 1183 ! 1184 !Clear CAL factors out of 8902 and set to 100% 1185 !All cal factor correction is done in software 1186 ! 1187 OUTPUT @Pwr_mtr;"IP M4 37.0 SP 37.9 SP 37.3 SP 10 MZ 100 CF" 1188 OUTPUT @Pwr_mtr;"37.3 SP";26500;"MZ";100;"CF" 1189 DISP "Zeroing power sensor ..." 1190 OUTPUT @Pwr_mtr;"IP 37.0 SP 37.3 SP 100 CF M4 ZR" !Zero sensor 1191 ENTER @Pwr_mtr !Holds off the bus until zero is completed 1192 OUTPUT @Pwr_mtr;"C1" 1193 ENTER @Pwr_mtr 1194 OUTPUT @Pwr_mtr;"SC C0" 1195 END SELECT 1196 Cal_time(Current_channel)=TIMEDATE 1197 RETURN 1198 ! 1199 SUBEND ! Power_meter 1200 ! 1201 ! 1202 Driver_8663: SUB Driver_8663(Input$,OPTIONAL Io_value)! 8662/3 driver; 081490.GPB 1203 ! Rev C.00.00 Changed ASSIGN @Syn command 1204 COM /Conditions/Conditions$(0:26,1:2)[160] 1205 DIM Status$[100],Function$[80] 1206 ! 1207 ASSIGN @Syn2 TO VAL(Conditions$(20,2)[1,4]) ! Changed '19' to '20' Rev C.00.00 1208 ! 1209 REPEAT 1210 Parse(Input$,Function$,Parse_value) 1211 IF NPAR>=2 THEN Value=Io_value ! Default value 1212 IF Parse_value<>-999 THEN Value=Parse_value ! Value if passed in func$ 1213 SELECT Function$ 1214 CASE "INITIALIZE" 1215 OUTPUT @Syn2;"SP00" 1216 CASE "FREQUENCY" 1217 OUTPUT @Syn2 USING "K,10D.D,K";"FR";Value;"HZ" 1218 CASE "AMPLITUDE" 1219 OUTPUT @Syn2;"AP";Value;"DM" 1220 WAIT .2 1221 CASE "CHECK FREQ LOCK" 1222 OUTPUT @Syn2;"AP";0;"DM","MS" 1223 ENTER @Syn2;Status$ ! Clear any non-current errors 1224 OUTPUT @Syn2;"MS" 1225 ENTER @Syn2;Status$ 1226 Stat=VAL(Status$[1,2]) 1227 IF Stat=1 THEN CALL Prompt_user("ERROR: No 8662/63 Reference oscillator. Check INT-EXT switches.") 1228 IF Stat=12 THEN CALL Prompt_user("ERROR: 8662/63 Oven not yet warmed up.") 1229 IF Stat=13 THEN CALL Prompt_user("ERROR: 8662/63 Should be on INTernal reference.") 1230 IF Stat=14 THEN CALL Prompt_user("ERROR: 8662/63 Frequency reference out of tolerance.") 1231 IF Stat=32 THEN CALL Prompt_user("ERROR: 8662/63 Amplitude out of range.") 1232 IF Stat=33 THEN CALL Prompt_user("ERROR: 8662/63 Frequency out of range.") 1233 IF Stat=99 THEN CALL Prompt_user("ERROR: 8662/63 Malfunction. Origin unknown.") 1234 IF Stat<>0 AND Stat<>1 AND Stat<>12 AND Stat<>13 AND Stat<>14 AND Stat<>99 THEN CALL Prompt_user("ERROR: 8662/63 Error # "&VAL$(Stat)&".") 1235 IF Stat<>0 THEN Value=1 1236 CASE "UNLEVELLED?" 1237 ! Do nothing 1238 CASE ELSE 1239 Prompt_user("ERROR: Function "&Function$&"> in Driver_8663 not found") 1240 END SELECT 1241 UNTIL Input$="" 1242 ! 1243 SUBEND !Driver_8662 1244 ! 1245 ! 1246 Driver_8340: SUB Driver_8340(Instrument,Input$,OPTIONAL Io_value) 1247 ! 1248 COM /Conditions/Conditions$(*) 1249 DIM Function$[80] 1250 Get_io_path("SYNTH 8340",@Swp) 1251 ! 1252 REPEAT 1253 Parse(Input$,Function$,Parse_value) 1254 IF NPAR=3 THEN Value=Io_value ! Default value 1255 IF Parse_value<>-999 THEN Value=Parse_value ! Value if passed in func$ 1256 SELECT Function$ 1257 CASE "LOCAL" ! Instrument is LOCALized at end of driver 1258 LOCAL @Swp 1259 CASE "INITIALIZE" 1260 OUTPUT @Swp;"IP" 1261 CASE "FREQUENCY" 1262 OUTPUT @Swp;"CW";Value;"HZ" !Send command 1263 CASE "AMPLITUDE" 1264 OUTPUT @Swp;"RF1","PL";Value;"DB" !RF ON 1265 CASE "ATN" 1266 OUTPUT @Swp;"AT";Value 1267 CASE "ALC" 1268 OUTPUT @Swp;"SHPS";Value;"DB" 1269 CASE "RF ON" 1270 OUTPUT @Swp;"RF1" 1271 CASE "RF OFF" 1272 OUTPUT @Swp;"RF0" 1273 CASE "PULSE MODULATION ON" 1274 OUTPUT @Swp;"PM1" 1275 CASE "PULSE MODULATION OFF" 1276 OUTPUT @Swp;"PM0" 1277 CASE "CENTER FREQ" 1278 OUTPUT @Swp;"CF";Value;"HZ" 1279 CASE "DELTA FREQUENCY","SPAN" 1280 OUTPUT @Swp;"DF";Value;"HZ" 1281 CASE "SWEEP TIME" 1282 OUTPUT @Swp;"ST";Value;"SC" 1283 CASE "SINGLE SWEEP","TRIGGER SWEEP" 1284 OUTPUT @Swp;"S2" 1285 CASE "PULSE MODULATION ENHANCEMENT ON" 1286 OUTPUT @Swp;"SHAM";1 1287 CASE "OVEN COLD?" 1288 Bit=2 1289 GOSUB Check_bit 1290 CASE "EXT FREQ REF?" 1291 Bit=3 1292 GOSUB Check_bit 1293 CASE "UNLOCKED?" 1294 Bit=4 1295 GOSUB Check_bit 1296 CASE "UNLEVELED?","UNLEVELLED?" 1297 CLEAR @Swp 1298 Bit=6 1299 GOSUB Check_bit 1300 CASE "AUTO TRACKING CALIBRATION" 1301 OUTPUT @Swp;"SHRP" 1302 CASE ELSE !Illegal Function$ 1303 Prompt_user("ERROR: Function "&Function$&"< in Driver_8340 not found") 1304 END SELECT 1305 UNTIL Input$="" 1306 SUBEXIT 1307 ! 1308 Check_bit: CLEAR @Swp 1309 OUTPUT @Swp;"OS" 1310 ENTER @Swp USING "B,B";First_byte,Second_byte 1311 Io_value=BIT(Second_byte,Bit) 1312 RETURN 1313 ! 1314 SUBEND !Driver_8340 1315 ! 1316 ! 1317 Linker: SUB Linker(Test_link$,Max_value) ! Creates list of tests 1318 COM /Menu/Menu$ 1319 ! 1320 DIM Current$[80] 1321 REPEAT 1322 Current$=Test_link$[MAX(1,LEN(Test_link$)-35)] ! Display string 1323 DISP "Enter test number or 0 to terminate entry. Current list: ";Current$; 1324 Input(I$) 1325 ON ERROR GOSUB End_of_link 1326 Value=VAL(I$) 1327 IF Value<0 OR Value>Max_value THEN 1328 Prompt_user("ERROR: Test number must be between 0 and "&VAL$(Max_value)&".") 1329 ELSE 1330 IF LEN(Test_link$) THEN Test_link$=Test_link$&"," 1331 IF Value=0 THEN Test_link$=Test_link$&"*," ! Last test marker 1332 IF Value AND LEN(Test_link$)<=75 THEN Test_link$=Test_link$&VAL$(INT(Value)) 1333 IF LEN(Test_link$)>=78 THEN CALL Prompt_user("ERROR: No more tests may be linked; enter 0 at next prompt.") 1334 END IF 1335 UNTIL Value=0 1336 DISP ! Clear display line 1337 SUBEXIT 1338 ! 1339 End_of_link: I$="0" ! If non-numeric or null string, terminate entry 1340 RETURN 1341 ! 1342 SUBEND !Linker 1343 ! 1344 ! 1345 Do_test: SUB Do_test 1346 ! 1347 COM /Test_flags/Test_number,Sequence_type,Last_test 1348 COM /Tests/Tests$(*),Short_name$(*),Conn_check(*) 1349 COM /Equipment/Present(1:20),Power_mtr_avail,Counter_avail,Sensor_avail(1:20),Source_avail(1:20),Source2_avail(1:20),Enough_equip(1:20) 1350 COM /Sum_errors/Sum_errors$ 1351 COM /Frendcal/Option$,Test_mode$,Jan_mode$,INTEGER Test_result,Depend 1352 ! 1353 IF Tests$(Test_number,2)="TEST NOT APPLICABLE" THEN 1354 IF Sequence_type=3 OR Sequence_type=5 THEN 1355 Prompt_user("This test does not apply to the current DUT") 1356 END IF 1357 SUBEXIT 1358 END IF 1359 ! 1360 IF NOT Enough_equip(Test_number) THEN 1361 IF Sequence_type=3 OR Sequence_type=5 THEN 1362 Prompt_user("ERROR: Insufficient equip. to do test "&VAL$(Test_number)&": "&TRIM$(Tests$(Test_number,1)[5])) 1363 END IF 1364 SUBEXIT 1365 END IF 1366 ! 1367 GOTO Skip_ptr 1368 PRINT TABXY(1,5); 1369 FOR Test=1 TO VAL(Tests$(0,1)) 1370 IF Test_number=Test THEN 1371 PRINT " =>" 1372 ELSE 1373 PRINT " " 1374 END IF 1375 NEXT Test 1376 Skip_ptr: ! 1377 ! 1378 IF Sequence_type<>5 THEN ON KEY 1 LABEL "Restart" RECOVER Restart 1379 STATUS KBD,9;Kbd_status 1380 IF BIT(Kbd_status,5) THEN ! HIL keyboard 1381 ON KEY 8 LABEL "ABORT TEST" RECOVER Exit_test 1382 ELSE 1383 ON KEY 8 LABEL "ABORT TEST" RECOVER Exit_test 1384 END IF 1385 ! 1386 DISP 1387 ! 1388 Restart: ! 1389 Sum_errors$="" ! Clear DUT error string 1390 Jan_mode$="MENU" ! Set to "MENU" per Design Document 1391 Test_result=0 ! Ignore parameter per Design Document 1392 Depend=0 ! Ignore parameter per Design Document 1393 ! 1394 IF Test_number=1 THEN Result=FNRom_date("SET") 1395 IF Test_number=1 THEN CALL Fr_end_cl_f(Option$,Test_mode$,Jan_mode$,Test_result,Depend) 1396 ! 1397 IF Test_result=0 THEN Result=-2 ! Set complete flag false 1398 IF Test_result=1 THEN Result=2 ! Set complete flag true 1399 CALL Pass_fail(Result) ! Display incomplete/complete message 1400 Last_test=Test_number 1401 Exit_test: ! 1402 OFF KEY 1 1403 OFF KEY 8 1404 ! 1405 SUBEND ! Do_test 1406 ! 1407 ! 1408 Ck_connections: SUB Ck_connections(Connection$,Quit_flag) 1409 ! 1410 IF Quit_flag=3 THEN SUBEXIT 1411 ! 1412 COM /Test_flags/Test_number,Sequence_type,Last_test 1413 COM /Equipment/Present(*),Power_mtr_avail,Counter_avail,Sensor_avail(*),Source_avail(*),Source2_avail(*),Enough_equip(*) 1414 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 1415 ! 1416 Power_meter$=VAL$(Power_mtr_avail)&"A" 1417 Counter$=VAL$(Counter_avail)&"A" 1418 IF Test_number>0 THEN ! Test_number=0 for ref level cal 1419 Sensor$=VAL$(Sensor_avail(Test_number))&"A" 1420 Source$=VAL$(Source_avail(Test_number))&"A" 1421 IF Source_avail(Test_number)=83401 THEN Source$="8340A/B" 1422 IF Source_avail(Test_number)=83402 THEN Source$="83640A/650A" 1423 IF Source2_avail(Test_number)=83401 THEN Source2$="8340A/B" 1424 IF Source2_avail(Test_number)=83402 THEN Source2$="83640A/650A" 1425 END IF 1426 ! 1427 Quit_flag=2 1428 First_pass=1 1429 ! 1430 SELECT Connection$ 1431 ! 1432 CASE "CAL TO DUT" ! Rev B.00.00 Modified for finer REF LVL CAL 1433 ! resolution 1434 ! 1435 Dut("READ F/W REVISION",Rev) 1436 SELECT Rev 1437 CASE <=920528 1438 Max_dac=34 1439 CASE 921111 1440 Max_dac=-529 1441 CASE >921111 1442 Max_dac=529 1443 END SELECT 1444 ! 1445 DISP "Checking that calibrator is connected to DUT RF INPUT..." 1446 Dut("IP,CENTER FREQ=300E6,SPAN=20E6,SINGLE SWEEP") 1447 LOOP 1448 Dut("REF LEVEL CAL="&VAL$(Max_dac)&",TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp1) 1449 Dut("REF LEVEL CAL="&VAL$(-Max_dac)&",TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp2) 1450 Dut("REF LEVEL CAL=0") 1451 EXIT IF Marker_amp1>=-10 AND (Marker_amp1-Marker_amp2)>=5 1452 IF First_pass THEN 1453 First_pass=0 1454 Prompt_user("Connect the DUT CAL OUT to the DUT RF INPUT.",Quit_flag) 1455 ELSE 1456 IF Marker_amp1<-10 THEN 1457 Prompt_user("ERROR: Maximum cal amplitude < -10 dBm.",Quit_flag) 1458 ELSE 1459 Prompt_user("ERROR: Ref Level Cal adjustment range < 5 dB.",Quit_flag) 1460 END IF 1461 END IF 1462 EXIT IF Quit_flag=3 1463 END LOOP 1464 DISP 1465 ! 1466 CASE "REF TO COUNTER" 1467 Prompt_user("Connect DUT REF IN/OUT to "&Counter$&" 10 Hz - 500 MHz INPUT.",Quit_flag) 1468 ! 1469 CASE "CAL OUT TO COUNTER" 1470 Prompt_user("Connect DUT CAL OUTPUT to "&Counter$&" 10 Hz - 500 MHz INPUT.",Quit_flag) 1471 ! 1472 CASE "CAL TO SENSOR" 1473 Prompt_user("Connect the "&Sensor$&" to the DUT CAL OUTPUT.",Quit_flag) 1474 ! 1475 ! 1476 CASE "LO TO SENSOR" 1477 Prompt_user("Connect the "&Sensor$&" to the DUT 1ST LO OUTPUT.",Quit_flag) 1478 ! 1479 CASE "TERMINATE DUT" 1480 Prompt_user("Connect a 50 ohm termination to the DUT RF INPUT.",Quit_flag) 1481 ! 1482 ! 1483 CASE "TERMINATE LO OUT" 1484 Prompt_user("Re-connect 50 ohm termination to the DUT 1ST LO OUTPUT.",Quit_flag) 1485 ! 1486 CASE "SOURCE TO DUT" 1487 Dut("INITIALIZE,SINGLE SWEEP,ATTENUATOR=20,REF LEVEL=10,CENTER FREQ=50E6,SPAN=1E6") 1488 Source("INITIALIZE,FREQUENCY=50E6,AMPLITUDE=5") 1489 ! 1490 LOOP 1491 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1492 EXIT IF ABS(Marker_amp-5)<=5 1493 IF First_pass THEN 1494 First_pass=2 1495 Out$=" RF" 1496 Prompt_user("Connect the "&Source$&Out$&" OUTPUT to the DUT RF INPUT.",Quit_flag) 1497 ELSE 1498 CALL Prompt_user("ERROR: "&Source$&" signal not in +5 +/- 5 dBm range.",Quit_flag) 1499 END IF 1500 EXIT IF Quit_flag=3 1501 END LOOP 1502 ! 1503 CASE "SOURCE NOT LOCKED TO DUT" ! Only checks for 8663 or 8340A/B not locked to the DUT. 1504 IF Source$="8663A" THEN 1505 LOOP 1506 Locked_souce=0 1507 CALL Source("CHECK FREQ LOCK",Locked_source) 1508 EXIT IF NOT Locked_source 1509 Prompt_user("Lock the 8662/63A to its internal frequency reference.",Quit_flag) 1510 EXIT IF Quit_flag=3 1511 END LOOP 1512 END IF 1513 ! 1514 IF (Source_avail(Test_number)=83401) OR (Source_avail(Test_number)=83402) THEN 1515 LOOP 1516 Source("EXT FREQ REF?",Ext_freq_ref) 1517 EXIT IF NOT Ext_freq_ref 1518 IF Source_avail(Test_number)=83401 THEN CALL Prompt_user("Set the "&Source$&" FREQUENCY STANDARD switch to INT.",Quit_flag) 1519 IF Source_avail(Test_number)=83402 THEN CALL Prompt_user("Disconnect the 10 MHz reference from the "&Source$&".",Quit_flag) 1520 EXIT IF Quit_flag=3 1521 END LOOP 1522 END IF 1523 ! 1524 CASE "LOCK SOURCE TO DUT" ! Only applies to 8340s and 83640/650s 1525 Source("FREQUENCY="&VAL$(FNF_max)&",AMPLITUDE=3") 1526 LOOP ! This loops checks that source is locked, but not necessarily 1527 ! to the DUT. 1528 Source("EXT FREQ REF?",Ext_freq_ref) 1529 Source("UNLOCKED?",Unlocked) 1530 Source("OVEN COLD?",Oven_cold) 1531 Source("UNLEVELLED?",Unlevelled) 1532 EXIT IF Ext_freq_ref AND NOT Unlocked AND NOT Oven_cold AND NOT Unlevelled 1533 IF Unlocked THEN 1534 IF Source_avail(Test_number)=83401 THEN CALL Prompt_user("Connect DUT REF IN/OUT to the "&Source$&" EXT FREQ STD.",Quit_flag) 1535 IF Source_avail(Test_number)=83402 THEN CALL Prompt_user("Connect DUT REF IN/OUT to the "&Source$&" REF INPUT",Quit_flag) 1536 ELSE 1537 IF NOT Ext_freq_ref THEN 1538 IF Source_avail(Test_number)=83401 THEN CALL Prompt_user("Set the "&Source$&" FREQUENCY STANDARD switch to EXT.",Quit_flag) 1539 IF Source_avail(Test_number)=83402 THEN CALL Prompt_user("Connect DUT REF IN/OUT to the "&Source$&" REF INPUT",Quit_flag) 1540 ELSE 1541 IF Oven_cold THEN 1542 Prompt_user("ERROR: "&Source$&" has a cold oven.",Quit_flag) 1543 ELSE 1544 Prompt_user("ERROR: "&Source$&" is unlevelled.",Quit_flag) 1545 END IF 1546 END IF 1547 END IF 1548 EXIT IF Quit_flag=3 1549 END LOOP 1550 ! 1551 IF Source_avail(Test_number)=83401 THEN ! 8340A/B is being used 1552 LOOP ! This loop checks that source is indeed locked to DUT ! 1553 OUTPUT @Dut;"FREF EXT;" 1554 WAIT 1 1555 Source("UNLOCKED?",Trial_1) 1556 OUTPUT @Dut;"FREF INT;" 1557 WAIT 5 1558 Source("UNLOCKED?",Trial_2) 1559 EXIT IF Trial_1 AND NOT Trial_2 1560 Prompt_user("Connect DUT REF IN/OUT to the "&Source$&" EXT FREQ STD.",Quit_flag) 1561 EXIT IF Quit_flag 1562 END LOOP 1563 Dut("ADJUST ALL") 1564 END IF 1565 IF Source_avail(Test_number)=83402 THEN ! 83640/650 is being used 1566 LOOP ! This loop checks that source is indeed locked to DUT ! 1567 OUTPUT @Dut;"FREF EXT;" 1568 WAIT 1 1569 Source("EXT FREQ REF?",Trial_1) 1570 OUTPUT @Dut;"FREF INT;" 1571 WAIT 5 1572 Source("EXT FREQ REF?",Trial_2) 1573 EXIT IF NOT Trial_1 AND Trial_2 1574 Prompt_user("Connect DUT REF IN/OUT to the 83640A/650A REF INPUT.",Quit_flag) 1575 EXIT IF Quit_flag 1576 END LOOP 1577 Dut("ADJUST ALL") 1578 END IF 1579 ! 1580 CASE "LOCK SOURCE2 TO DUT" ! Only applies to 8340s and 85640/650s 1581 Source2("FREQUENCY=22E9,AMPLITUDE=3") 1582 LOOP ! This loop checks that source is locked, but not necessarily 1583 ! to the DUT. 1584 Source2("EXT FREQ REF?",Ext_freq_ref) 1585 Source2("UNLOCKED?",Unlocked) 1586 Source2("OVEN COLD?",Oven_cold) 1587 Source2("UNLEVELLED?",Unlevelled) 1588 EXIT IF Ext_freq_ref AND NOT Unlocked AND NOT Oven_cold AND NOT Unlevelled 1589 IF Unlocked THEN 1590 IF Source_avail(Test_number)=83401 THEN CALL Prompt_user("Connect DUT REF IN/OUT to the "&Source2$&" EXT FREQ STD.",Quit_flag) 1591 IF Source_avail(Test_number)=83402 THEN CALL Prompt_user("Connect DUT REF IN/OUT to the "&Source2$&" REF INPUT",Quit_flag) 1592 ELSE 1593 IF NOT Ext_freq_ref THEN 1594 IF Source_avail(Test_number)=83401 THEN CALL Prompt_user("Set the "&Source$&" FREQUENCY STANDARD switch to EXT.",Quit_flag) 1595 IF Source_avail(Test_number)=83402 THEN CALL Prompt_user("Connect DUT REF IN/OUT to the "&Source$&" REF INPUT",Quit_flag) 1596 ELSE 1597 IF Oven_cold THEN 1598 Prompt_user("ERROR: "&Source2$&" has a cold oven.",Quit_flag) 1599 ELSE 1600 Prompt_user("ERROR: "&Source2$&" is unlevelled.",Quit_flag) 1601 END IF 1602 END IF 1603 END IF 1604 EXIT IF Quit_flag=3 1605 END LOOP 1606 ! 1607 IF Source2_avail(Test_number)=83401 THEN ! 8340A/B is being used 1608 LOOP ! This loop checks that source is indeed locked to DUT ! 1609 OUTPUT @Dut;"FREF EXT;" 1610 WAIT 1 1611 Source2("UNLOCKED?",Trial_1) 1612 OUTPUT @Dut;"FREF INT;" 1613 WAIT 5 1614 Source2("UNLOCKED?",Trial_2) 1615 EXIT IF Trial_1 AND NOT Trial_2 1616 Prompt_user("Connect DUT REF IN/OUT to the "&Source2$&" EXT FREQ STD.",Quit_flag) 1617 EXIT IF Quit_flag 1618 END LOOP 1619 Dut("ADJUST ALL") 1620 END IF 1621 IF Source2_avail(Test_number)=83402 THEN ! 83640/650 is being used 1622 LOOP ! This loop checks that source is indeed locked to DUT ! 1623 OUTPUT @Dut;"FREF EXT;" 1624 WAIT 1 1625 Source2("EXT FREQ REF?",Trial_1) 1626 OUTPUT @Dut;"FREF INT;" 1627 WAIT 5 1628 Source2("EXT FREQ REF?",Trial_2) 1629 EXIT IF NOT Trial_1 AND Trial_2 1630 Prompt_user("Connect DUT REF IN/OUT to the "&Source2$&" REF INPUT.",Quit_flag) 1631 EXIT IF Quit_flag 1632 END LOOP 1633 Dut("ADJUST ALL") 1634 END IF 1635 ! 1636 CASE "SOURCE TO SPLITTER TO SENSOR/DUT" 1637 Dut("INITIALIZE,SINGLE SWEEP,ATTENUATOR=20,REF LEVEL=10,CENTER FREQ=1E9,SPAN=1E6") 1638 Source("RF ON,FREQUENCY=1E9") 1639 Source2("RF OFF") 1640 Power_meter("INITIALIZE,CONTINUOUS TRIGGER") 1641 ! 1642 LOOP 1643 Source("AMPLITUDE=5") 1644 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1645 Power_meter("READ",Power,1.E+9) 1646 Setup_ok=0 1647 IF ABS(Marker_amp+1)<=4 AND ABS(Power+1)<=4 THEN 1648 Source("AMPLITUDE=-5") 1649 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1650 Power_meter("READ",Power,1.E+9) 1651 IF ABS(Marker_amp+11)<=4 AND ABS(Power+11)<=4 THEN Setup_ok=1 1652 END IF 1653 EXIT IF Setup_ok 1654 IF First_pass THEN 1655 First_pass=0 1656 Prompt_user("Connect "&Source$&" RF OUTPUT to 11667 Splitter input.",Quit_flag) 1657 Prompt_user("Connect splitter outputs to the "&Sensor$&" and DUT RF INPUT.",Quit_flag) 1658 ELSE 1659 IF ABS(Marker_amp+1)>5 THEN 1660 Prompt_user("ERROR: "&Source$&" signal not in -1 +/- 5 dBm range.",Quit_flag) 1661 ELSE 1662 Prompt_user("ERROR: "&Power_meter$&" doesn't read signal to be in -1 +/- 5 dBm range.",Quit_flag) 1663 END IF 1664 END IF 1665 EXIT IF Quit_flag=3 1666 END LOOP 1667 ! 1668 CASE "SOURCE2 TO SPLITTER TO SENSOR/DUT" 1669 Dut("INITIALIZE,SINGLE SWEEP,ATTENUATOR=20,REF LEVEL=10,CENTER FREQ=1E9,SPAN=1E6") 1670 Source2("RF ON,FREQUENCY=1E9") 1671 Source("RF OFF") 1672 Power_meter("INITIALIZE,CONTINUOUS TRIGGER") 1673 ! 1674 LOOP 1675 Source2("AMPLITUDE=5") 1676 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1677 Power_meter("READ",Power,1.E+9) 1678 Setup_ok=0 1679 IF ABS(Marker_amp+1)<=4 AND ABS(Power+1)<=4 THEN 1680 Source2("AMPLITUDE=-5") 1681 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1682 Power_meter("READ",Power,1.E+9) 1683 IF ABS(Marker_amp+11)<=4 AND ABS(Power+11)<=4 THEN Setup_ok=1 1684 END IF 1685 EXIT IF Setup_ok 1686 IF First_pass THEN 1687 First_pass=0 1688 Prompt_user("Connect "&Source2$&" RF OUTPUT to 11667 Splitter input.",Quit_flag) 1689 Prompt_user("Connect splitter outputs to the "&Sensor$&" and DUT RF INPUT.",Quit_flag) 1690 ELSE 1691 IF ABS(Marker_amp+1)>5 THEN 1692 Prompt_user("ERROR: "&Source2$&" signal not in -1 +/- 5 dBm range.",Quit_flag) 1693 ELSE 1694 Prompt_user("ERROR: "&Power_meter$&" doesn't read signal to be in -1 +/- 5 dBm range.",Quit_flag) 1695 END IF 1696 END IF 1697 EXIT IF Quit_flag=3 1698 END LOOP 1699 ! 1700 CASE "SOURCE TO DUT VIA LPF1","SOURCE TO DUT VIA LPF2" 1701 IF POS(Connection$,"LPF1") THEN Frequency=4.0E+7 1702 IF POS(Connection$,"LPF1") THEN Freq$=" 40 MHz" 1703 IF POS(Connection$,"LPF1") THEN Rejection=50 1704 IF POS(Connection$,"LPF2") THEN Frequency=2.95E+9 1705 IF POS(Connection$,"LPF2") THEN Freq$=" 2.95 GHz" 1706 IF POS(Connection$,"LPF2") THEN Rejection=75 1707 Dut("INITIALIZE,SINGLE SWEEP,ATTENUATOR=30,REF LEVEL=15,SPAN=10E3,RBW=1000") 1708 Source("RF ON,AMPLITUDE=10") 1709 ! 1710 LOOP 1711 Dut("CENTER FREQ",Frequency) 1712 Source("FREQUENCY",Frequency) 1713 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1714 ! 1715 Source("FREQUENCY",2*Frequency) 1716 Dut("CENTER FREQ",2*Frequency) 1717 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp2) 1718 EXIT IF ABS(Marker_amp-10)<=8 AND Marker_amp28 THEN 1730 Prompt_user("ERROR: "&Source$&" +10 dBm signal not in +10+/-8 dBm range.",Quit_flag) 1731 ELSE 1732 Prompt_user("ERROR: Low pass filter(s) don't have at least "&VAL$(Rejection)&" dB rejection.",Quit_flag) 1733 END IF 1734 END IF 1735 IF Quit_flag=3 THEN SUBEXIT 1736 END LOOP 1737 ! 1738 CASE "SOURCES TO SPLITTER TO DUT" 1739 Dut("INITIALIZE,SINGLE SWEEP,ATTENUATOR=20,REF LEVEL=10,CENTER FREQ=50.E6,SPAN=1E6") 1740 Out$="RF" 1741 Out2$=" RF" 1742 ! 1743 LOOP 1744 Source("RF ON,FREQUENCY=50.E6,AMPLITUDE=5") 1745 Source2("RF OFF") 1746 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1747 Source2("RF ON,FREQUENCY=50.E6,AMPLITUDE=5") 1748 Source("RF OFF") 1749 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp2) 1750 EXIT IF ABS(Marker_amp+1)<=5 AND ABS(Marker_amp2+1)<=5 1751 IF First_pass THEN 1752 First_pass=0 1753 Prompt_user("Connect "&Source$&Out$&" OUTPUT to 11667 Splitter output.",Quit_flag) 1754 Prompt_user("Connect "&Source2$&Out2$&" OUTPUT to 11667 Splitter output.",Quit_flag) 1755 Prompt_user("Connect the 11667 Splitter input to the DUT RF INPUT.",Quit_flag) 1756 ELSE 1757 IF ABS(Marker_amp+1)>5 THEN 1758 Prompt_user("ERROR: "&Source$&" +5 dBm signal not in -1 +/- 5 dBm range.",Quit_flag) 1759 ELSE 1760 Prompt_user("ERROR: "&Source2$&" +5 dBm signal not in -1 +/- 5 dBm range.",Quit_flag) 1761 END IF 1762 END IF 1763 EXIT IF Quit_flag=3 1764 END LOOP 1765 ! 1766 CASE "SOURCE AND CAL TO SPLITTER TO DUT" 1767 Dut("INITIALIZE,SINGLE SWEEP,ATTENUATOR=20,REF LEVEL=10,CENTER FREQ=50.E6,SPAN=1E6") 1768 Out$="RF" 1769 ! 1770 LOOP 1771 Source("RF ON,FREQUENCY=50.E6,AMPLITUDE=5") 1772 Dut("CENTER FREQ=50.E6,TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 1773 Dut("CENTER FREQ=300.E6") 1774 Source("RF OFF") 1775 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp2) 1776 EXIT IF ABS(Marker_amp+1)<=5 AND ABS(Marker_amp2+16)<=5 1777 IF First_pass THEN 1778 First_pass=0 1779 Prompt_user("Connect "&Source$&Out$&" OUTPUT to 11667 Splitter output.",Quit_flag) 1780 Prompt_user("Connect CAL OUTPUT to 11667 Splitter output.",Quit_flag) 1781 Prompt_user("Connect the 11667 Splitter input to the DUT RF INPUT.",Quit_flag) 1782 ELSE 1783 IF ABS(Marker_amp+1)>5 THEN 1784 Prompt_user("ERROR: "&Source$&" signal not in -1 +/- 5 dBm range.",Quit_flag) 1785 ELSE 1786 Prompt_user("ERROR: CAL OUT signal not in -16 +/- 5 dBm range.",Quit_flag) 1787 END IF 1788 END IF 1789 EXIT IF Quit_flag=3 1790 END LOOP 1791 ! 1792 CASE ELSE 1793 Prompt_user("ERROR: "&Connection$&" not found in Ck_connections.") 1794 END SELECT 1795 ! 1796 SUBEND 1797 ! 1798 ! 1799 Print_test_list: SUB Print_test_list ! Print test list 1800 ! 1801 COM /Conditions/Conditions$(*) 1802 COM /Tests/Tests$(*),Short_name$(*),Conn_check(*) 1803 ! 1804 FOR I=1 TO SIZE(Tests$,1) 1805 OUTPUT 701 USING "DD,5X,K,5X,K";I,Tests$(I,1) 1806 NEXT I 1807 ! 1808 SUBEND ! Print test list 1809 ! 1810 ! 1811 File: DEF FNFile$(File$,Msi$) 1812 ! 1813 DIM Path$[80] 1814 Path$="" 1815 ! Remote_pos=POS(Msi$,":REMOTE") 1816 ! IF Remote_pos OR POS(Msi$&File$,"/") THEN 1817 ! IF Remote_pos THEN 1818 ! RETURN Msi$[1,Remote_pos-1]&"/"&File$&Msi$[Remote_pos] 1819 ! ELSE 1820 ! RETURN Msi$&"/"&File$ 1821 ! END IF 1822 ! ELSE 1823 ! RETURN File$&Msi$ 1824 ! END IF 1825 Colon_pos=POS(Msi$,":") 1826 SELECT Colon_pos 1827 CASE 0 ! Only path specified, no msus; use default msus 1828 RETURN Msi$&"/"&File$ 1829 CASE 1 ! No path specified; append Msi$ to File$ 1830 RETURN File$&Msi$ 1831 CASE >1 ! Path and msus specified; put File$ in between 1832 Path$=Msi$[1,Colon_pos-1] 1833 IF Path$[Colon_pos-1;1]="/" THEN ! Don't need to add another "/" 1834 RETURN Path$&File$&Msi$[Colon_pos] 1835 ELSE ! Add additional "/" 1836 RETURN Path$&"/"&File$&Msi$[Colon_pos] 1837 END IF 1838 END SELECT 1839 ! 1840 FNEND 1841 ! 1842 ! 1843 Check_addresses: SUB Check_addresses(Message$,OPTIONAL Error_flag) 1844 ! 1845 COM /Conditions/Conditions$(*) 1846 DIM Address(11:18) 1847 ! 1848 Address(11)=0 1849 FOR I=12 TO 18 1850 IF POS(Conditions$(I,2),"NA") THEN 1851 Address(I)=0 1852 ELSE 1853 Address(I)=VAL(Conditions$(I,2)) 1854 END IF 1855 NEXT I 1856 MAT SORT Address 1857 Current_address=0 1858 Current_count=0 1859 FOR I=12 TO 18 1860 IF Address(I)=Address(I-1) THEN 1861 Current_count=Current_count+1 1862 ELSE 1863 IF Current_address<>0 AND Current_count>1 THEN 1864 Prompt_user(Message$&" "&VAL$(Current_count)&" instruments have HPIB addresses of "&VAL$(Current_address)&".") 1865 IF NPAR=2 THEN Error_flag=1 1866 END IF 1867 Current_address=Address(I) 1868 Current_count=1 1869 END IF 1870 NEXT I 1871 IF Current_address<>0 AND Current_count>1 THEN 1872 Prompt_user("ERROR: "&Message$&" "&VAL$(Current_count)&" instruments have HPIB addresses of "&VAL$(Current_address)&".") 1873 END IF 1874 ! 1875 SUBEND 1876 ! 1877 ! 1878 Sensorutilities: SUB Sensorutilities 1879 ! 1880 COM /Conditions/Conditions$(*) 1881 COM /Menu/Menu$ 1882 DIM File$[160],I$[160],Catalog$(1:1000)[80],Cal_data(1:2,1:65) 1883 ! 1884 Menu$="Sensor Utilities Menu" 1885 Draw_alpha_hdr("Sensor Utilities Menu") 1886 ! 1887 STATUS KBD,9;Kbd_status 1888 IF BIT(Kbd_status,5) THEN 1889 Ul$=CHR$(132) 1890 Clr$=CHR$(128) 1891 ELSE 1892 Ul$=CHR$(132) 1893 Clr$=CHR$(128) 1894 END IF 1895 ! 1896 GOSUB List_files 1897 ! 1898 IF BIT(Kbd_status,5) THEN ! HIL keyboard 1899 ON KEY 1 LABEL "View/ Edit" GOSUB View_edit 1900 ON KEY 2 LABEL "Add File" GOSUB Add_file 1901 ON KEY 4 LABEL "Delete File" GOSUB Delete_file 1902 ON KEY 5 LABEL "List Files" GOSUB List_files 1903 ON KEY 6 LABEL "System File" GOSUB Change_sys_file 1904 ON KEY 8 LABEL "Cond Menu" GOTO Exit 1905 ELSE 1906 ON KEY 1 LABEL "View/Edit" GOSUB View_edit 1907 ON KEY 2 LABEL "Add File" GOSUB Add_file 1908 ON KEY 4 LABEL "Delete File" GOSUB Delete_file 1909 ON KEY 5 LABEL "List Files" GOSUB List_files 1910 ON KEY 6 LABEL "System File" GOSUB Change_sys_file 1911 ON KEY 8 LABEL "Cond Menu " GOTO Exit 1912 END IF 1913 ! 1914 SYSTEM PRIORITY 2 1915 PRINT TABXY(61,4); 1916 OUTPUT CRT;Ul$&"Select fnction mode";Clr$ 1917 SYSTEM PRIORITY 0 1918 DISP "Select a special function key." 1919 GOTO 1914 1920 ! 1921 View_edit: ! 1922 PRINT TABXY(61,4); 1923 OUTPUT CRT;Ul$&"View/Edit mode ";Clr$ 1924 File$="" 1925 DISP "Enter the sensor file you wish to view/edit (e.g. ""SEN8501234"")"; 1926 Input(File$) 1927 File$=File$[1,37] 1928 View_add_entry: ! This is where you go to when coming from Add_entry 1929 PRINT TABXY(61,4); 1930 OUTPUT CRT;Ul$&"View/Edit mode ";Clr$ 1931 ON ERROR GOTO No_file 1932 ASSIGN @File TO FNFile$(File$,Conditions$(7,2)) 1933 OFF ERROR 1934 GOSUB Clear_screen 1935 PRINT TABXY(1,5);RPT$("|FREQ CAL",6)&"|" 1936 PRINT TABXY(1,6);RPT$("|(MHz) (%)",6)&"|" 1937 PRINT TABXY(1,7);RPT$("-",73) 1938 FOR I=8 TO 16 1939 PRINT TABXY(1,I);RPT$("| ",6)&"|" 1940 NEXT I 1941 FOR I=17 TO 18 1942 PRINT TABXY(1,I);RPT$("| ",5)&"|" 1943 NEXT I 1944 ENTER @File;Cal_data(*) 1945 GOSUB Sort_cal_data 1946 GOSUB Disp_cal_data 1947 Data_changed=0 1948 LOOP 1949 LOOP 1950 I$="" 1951 DISP 1952 DISP File$;": Enter freq to add/edit/del, 'S' to store data, or to exit"; 1953 Input(I$) 1954 EXIT IF UPC$(I$[1,1])="S" OR LEN(I$)=0 1955 ON ERROR GOTO Bad_data 1956 Frequency=DROUND(PROUND(VAL(I$),-2),3) 1957 IF Frequency>99900 THEN Frequency=99900 1958 OFF ERROR 1959 EXIT IF Frequency>0 1960 Bad_data: OFF ERROR 1961 Prompt_user("ERROR: Non-numeric entry other than 'S' entered, or frequency <=0.") 1962 END LOOP 1963 EXIT IF LEN(I$)=0 1964 IF UPC$(I$[1,1])="S" THEN 1965 ASSIGN @File TO FNFile$(File$,Conditions$(7,2)) 1966 OUTPUT @File;Cal_data(*) 1967 Data_changed=0 1968 ELSE 1969 Cal_factor=-1 1970 DISP 1971 I$="" 1972 DISP "Enter cal factor up to 150% (0 to delete frequency/ Cal Factor pair)"; 1973 Input(I$) 1974 ON ERROR GOSUB Chk_entry 1975 Cal_factor=VAL(I$) 1976 OFF ERROR 1977 IF Cal_factor>=0 AND Cal_factor<=150 THEN 1978 Cal_factor=PROUND(Cal_factor,-1) 1979 Freq_index=0 1980 REPEAT 1981 Freq_index=Freq_index+1 1982 UNTIL DROUND(Cal_data(1,Freq_index)/1.E+6,5)=Frequency OR Freq_index=SIZE(Cal_data,2) 1983 IF Cal_factor=0 THEN 1984 Cal_data(1,Freq_index)=0 1985 Cal_data(2,Freq_index)=0 1986 ELSE 1987 Cal_data(1,Freq_index)=Frequency*1.E+6 1988 Cal_data(2,Freq_index)=Cal_factor/100 1989 END IF 1990 GOSUB Sort_cal_data 1991 GOSUB Disp_cal_data 1992 Data_changed=1 1993 ELSE 1994 IF Cal_factor<>-1 THEN CALL Prompt_user("ERROR: Cal Factor outside of 0 to 150% range entered.") 1995 END IF 1996 END IF 1997 END LOOP 1998 ! 1999 IF Data_changed THEN 2000 I$="N" 2001 DISP "Data changed. Do you wish to store it? (Y/N)"; 2002 Input(I$) 2003 IF UPC$(I$[1,1])="Y" THEN 2004 ASSIGN @File TO FNFile$(File$,Conditions$(7,2)) 2005 OUTPUT @File;Cal_data(*) 2006 END IF 2007 END IF 2008 ! 2009 GOSUB List_files 2010 RETURN 2011 ! 2012 Chk_entry: OFF ERROR 2013 I$="0" 2014 RETURN 2015 ! 2016 No_file: OFF ERROR 2017 Prompt_user("ERROR: File "&FNFile$(File$,Conditions$(7,2))&" not found.") 2018 RETURN 2019 ! 2020 Disp_cal_data: ! 2021 FOR I=1 TO SIZE(Cal_data,2) 2022 Xpos=INT((I-1)/11)*12+2 2023 Ypos=(I-1) MOD 11+8 2024 PRINT TABXY(Xpos,Ypos); 2025 Freq_format$="2D.2D" 2026 IF Cal_data(1,I)>=1.00E+8 THEN Freq_format$="3D.D" 2027 IF Cal_data(1,I)>=1.E+9 THEN Freq_format$="5D" 2028 Cal_format$="3D.D" 2029 IF Cal_data(1,I)<>0 THEN 2030 PRINT USING Freq_format$&",X,"&Cal_format$;Cal_data(1,I)/1.E+6,Cal_data(2,I)*100 2031 ELSE 2032 PRINT " " 2033 END IF 2034 NEXT I 2035 RETURN 2036 ! 2037 Sort_cal_data: ! 2038 FOR I=1 TO SIZE(Cal_data,2) 2039 IF Cal_data(1,I)=0 THEN Cal_data(1,I)=1.E+12 2040 NEXT I 2041 MAT SORT Cal_data(1,*) 2042 FOR I=1 TO SIZE(Cal_data,2) 2043 IF Cal_data(1,I)=1.E+12 THEN Cal_data(1,I)=0 2044 NEXT I 2045 RETURN 2046 ! 2047 Add_file:! 2048 PRINT TABXY(61,4); 2049 OUTPUT CRT;Ul$&"Add file mode ";Clr$ 2050 ON ERROR GOTO Add_no_dir 2051 REDIM Catalog$(1:1000) 2052 CAT Conditions$(7,2) TO Catalog$(*) 2053 OFF ERROR 2054 REPEAT 2055 I$="0" 2056 DISP "Enter the sensor type (8481 or 8485) or to exit."; 2057 Input(I$) 2058 GOSUB Chk_model 2059 ON ERROR GOTO Nonnumericentry 2060 Sensor_type=VAL(I$) 2061 OFF ERROR 2062 UNTIL Sensor_type=0 OR Sensor_type=8481 OR Sensor_type=8485 2063 IF Sensor_type=0 THEN RETURN 2064 REPEAT 2065 I$="0" 2066 DISP 2067 DISP "Enter last 5 digits of the sensor S/N (1 to 99999) or to exit."; 2068 Input(I$) 2069 GOSUB Chk_model 2070 ON ERROR GOTO Nonnumericentry 2071 Sensor_sn=VAL(I$) 2072 OFF ERROR 2073 UNTIL Sensor_sn>=0 AND Sensor_sn<=99999 2074 IF Sensor_sn=0 THEN RETURN 2075 OUTPUT File$ USING "#,K,2D,5Z";"SEN",Sensor_type MOD 100,Sensor_sn 2076 CREATE BDAT FNFile$(File$,Conditions$(7,2)),5,256 2077 ASSIGN @File TO FNFile$(File$,Conditions$(7,2)) 2078 MAT Cal_data=(0) 2079 OUTPUT @File;Cal_data(*) 2080 GOTO View_add_entry 2081 ! 2082 Add_no_dir: OFF ERROR 2083 Prompt_user("ERROR: System mass storage file location catalog cannot be read.") 2084 RETURN 2085 ! 2086 Chk_model: ! 2087 ON ERROR GOTO No_sensor 2088 Temp=VAL(I$) 2089 OFF ERROR 2090 GOTO Leave 2091 No_sensor: OFF ERROR 2092 I$="0" 2093 Leave: RETURN 2094 ! 2095 Nonnumericentry: OFF ERROR 2096 Prompt_user("ERROR: "&I$&" is a non-numeric entry.") 2097 RETURN 2098 ! 2099 Delete_file:! 2100 PRINT TABXY(61,4); 2101 OUTPUT CRT;Ul$&"Delete file mode ";Clr$ 2102 File$="" 2103 DISP "Enter the sensor file you wish to delete (e.g. ""SEN8501234"")"; 2104 Input(File$) 2105 File$=File$[1,37] 2106 ON ERROR GOTO No_file 2107 ASSIGN @File TO FNFile$(File$,Conditions$(7,2)) 2108 ASSIGN @File TO * 2109 OFF ERROR 2110 I$="" 2111 DISP "Do you really want to delete ";FNFile$(File$,Conditions$(7,2));" (Y/N)?"; 2112 Input(I$) 2113 IF UPC$(I$[1,1])="Y" THEN 2114 PURGE FNFile$(File$,Conditions$(7,2)) 2115 GOSUB List_files 2116 END IF 2117 RETURN 2118 ! 2119 List_files: ! 2120 PRINT TABXY(61,4); 2121 OUTPUT CRT;Ul$&"List files mode ";Clr$ 2122 GOSUB Clear_screen 2123 PRINT TABXY(1,5);"Sensor files available on "&TRIM$(Conditions$(7,2))&":" 2124 ON ERROR GOTO No_files_avail 2125 REDIM Catalog$(1:1000) 2126 CAT Conditions$(7,2) TO Catalog$(*);NO HEADER,COUNT Num_entries 2127 REDIM Catalog$(1:Num_entries) 2128 MAT SORT Catalog$(*) 2129 Files_avail=0 2130 FOR Entry=1 TO Num_entries 2131 IF Catalog$(Entry)[1,4]="SEN8" THEN 2132 Files_avail=Files_avail+1 2133 Xpos=INT((Files_avail-1)/12)*11+1 2134 Ypos=(Files_avail-1) MOD 12+6 2135 PRINT TABXY(Xpos,Ypos);Catalog$(Entry)[1,10] 2136 END IF 2137 NEXT Entry 2138 IF Files_avail=0 THEN PRINT TABXY(1,7);"No sensor files found. Check System mass storage file location." 2139 OFF ERROR 2140 RETURN 2141 ! 2142 No_files_avail: OFF ERROR 2143 PRINT TABXY(1,7);"ERROR: System mass storage file location catalog can not be read." 2144 RETURN 2145 ! 2146 Change_sys_file:! 2147 PRINT TABXY(61,4); 2148 OUTPUT CRT;Ul$&"Change sysfile mode";Clr$ 2149 DISP "Enter mass storage file location"; 2150 File$=Conditions$(7,2) 2151 Input(File$) 2152 File$=File$[1,37] 2153 IF File$<>"" THEN 2154 ON ERROR GOTO Bad_file 2155 CAT File$ TO Catalog$(*) 2156 Conditions$(7,2)=File$ 2157 GOSUB List_files 2158 END IF 2159 RETURN 2160 Bad_file: Prompt_user("ERROR: Unable to obtain catalog from """&File$&""".") 2161 RETURN 2162 ! 2163 Clear_screen: ! 2164 FOR I=5 TO 18 2165 PRINT TABXY(1,I);RPT$(" ",80) 2166 NEXT I 2167 RETURN 2168 ! 2169 Exit: ! 2170 ! 2171 SUBEND 2172 ! 2173 ! 2174 Check_equipment: SUB Check_equipment(Option) 2175 ! 2176 ! Option: 1 - Check if sufficient equipment for each test 2177 ! 2 - Print equipment list given test number 2178 ! 2179 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 2180 COM /Test_flags/Test_number,Sequence_type,Last_test 2181 COM /Equipment/Present(*),Power_mtr_avail,Counter_avail,Sensor_avail(*),Source_avail(*),Source2_avail(*),Enough_equip(*) 2182 COM /Tests/Tests$(*),Short_name$(*),Conn_check(*) 2183 COM /Conditions/Conditions$(0:26,1:2)[160] 2184 DIM Equip$[80],Mdl$[20],Choice$[10] 2185 ! Rev C.00.00 Added 8360 Sweeper for 8564/65 support. 2186 ! 83402 actually refers to the 83640A/83650A. 2187 ! 2188 ! Rev B.00.00 Following data reorganized to reflect test reordering 2189 ! Reordering done to improve test flow during All Tests 2190 ! 2191 Source_req: ! 2192 DATA 1,8340,83401,83402,-2 2193 ! 2194 Sensor_req: ! Millimeter sensors for use with 8562 2195 DATA 1,8481,8485,-2 2196 ! 2197 Power_meter_req: ! 2198 DATA 1,436,438,8902,-2 2199 ! 2200 Adtl_equip: ! 2201 DATA 1,"11667A/B Splitter",-2 2202 ! 2203 IF Option=1 THEN ! Check equipment sufficiency 2204 MAT Enough_equip=(1) 2205 ! 2206 ASSIGN @Dut TO VAL(Conditions$(12,2)[1,4]) 2207 IF Present(2) THEN ASSIGN @Printer TO VAL(Conditions$(13,2)[1,4]) 2208 ! 2209 RESTORE Source_req 2210 MAT Source_avail=(0) 2211 REPEAT 2212 READ Test_list 2213 Found_inst=0 2214 LOOP 2215 READ Inst 2216 EXIT IF Inst<0 2217 IF (Inst=83401 OR Inst=8340) AND Present(6) AND NOT Found_inst THEN Source_avail(Test_list)=Inst 2218 IF (Inst=83401 OR Inst=8340) AND Present(6) THEN Found_inst=1 2219 IF Inst=83402 AND Present(7) AND NOT Found_inst THEN Source_avail(Test_list)=Inst 2220 IF Inst=83402 AND Present(7) THEN Found_inst=1 2221 END LOOP 2222 IF NOT Found_inst THEN Enough_equip(Test_list)=0 2223 UNTIL Inst=-2 2224 ! 2225 RESTORE Sensor_req 2226 MAT Sensor_avail=(0) 2227 REPEAT 2228 READ Test_list 2229 Found_inst=0 2230 LOOP 2231 READ Inst 2232 EXIT IF Inst<0 2233 IF Inst=8481 AND Present(8) AND NOT Found_inst THEN Sensor_avail(Test_list)=8481 2234 IF Inst=8481 AND Present(8) THEN Found_inst=1 2235 IF Inst=8485 AND Present(9) AND NOT Found_inst THEN Sensor_avail(Test_list)=8485 2236 IF Inst=8485 AND Present(9) THEN Found_inst=1 2237 END LOOP 2238 IF NOT Found_inst THEN Enough_equip(Test_list)=0 2239 UNTIL Inst=-2 2240 ! 2241 RESTORE Power_meter_req 2242 REPEAT 2243 READ Test_list 2244 Found_inst=0 2245 LOOP 2246 READ Inst 2247 EXIT IF Inst<0 2248 IF Inst=436 AND Present(3) THEN Found_inst=1 2249 IF Inst=436 AND Present(3) THEN ASSIGN @Pwr_mtr TO VAL(Conditions$(14,2)[1,4]) 2250 IF Inst=438 AND Present(4) THEN Found_inst=1 2251 IF Inst=438 AND Present(4) THEN ASSIGN @Pwr_mtr TO VAL(Conditions$(15,2)[1,4]) 2252 IF Inst=8902 AND Present(5) THEN Found_inst=1 2253 IF Inst=8902 AND Present(5) THEN ASSIGN @Pwr_mtr TO VAL(Conditions$(16,2)[1,4]) 2254 END LOOP 2255 IF NOT Found_inst THEN Enough_equip(Test_list)=0 2256 UNTIL Inst=-2 2257 IF (Present(3)+Present(4)+Present(5))>1 THEN GOSUB Pick_pwr_meter 2258 ! 2259 FOR Test=1 TO VAL(Tests$(0,1)) 2260 IF Enough_equip(Test) THEN 2261 Tests$(Test,2)="" 2262 ELSE 2263 Tests$(Test,2)="MISSING ETE" 2264 END IF 2265 NEXT Test 2266 ! 2267 ELSE ! Print equipment list 2268 ! 2269 FOR I=5 TO 18 2270 PRINT TABXY(1,I);RPT$(" ",80) 2271 NEXT I 2272 PRINT TABXY(1,5);"EQUIPMENT REQUIRED FOR TEST # ";VAL$(Test_number);", ";Tests$(Test_number,1)[5] 2273 PRINT 2274 ! 2275 Num_inst=0 2276 RESTORE Source_req 2277 REPEAT 2278 READ Test_list 2279 LOOP 2280 READ Inst 2281 EXIT IF Inst<0 2282 IF Test_list=Test_number THEN 2283 Num_inst=Num_inst+1 2284 IF Num_inst=1 THEN PRINT "Source: "; 2285 IF Num_inst>1 THEN PRINT " or "; 2286 IF Inst=83401 THEN PRINT "8340A/B" 2287 IF Inst=83402 THEN PRINT "83640A/650A" 2288 IF Inst=8340 THEN PRINT "8340" 2289 END IF 2290 END LOOP 2291 UNTIL Inst=-2 2292 IF Num_inst>0 THEN PRINT 2293 ! 2294 Num_inst=0 2295 RESTORE Sensor_req 2296 REPEAT 2297 READ Test_list 2298 LOOP 2299 READ Inst 2300 EXIT IF Inst<0 2301 IF Test_list=Test_number THEN 2302 Num_inst=Num_inst+1 2303 IF Num_inst=1 THEN PRINT "Sensor: "; 2304 IF Num_inst>1 THEN PRINT " or "; 2305 IF Inst=8481 THEN PRINT "8481A" 2306 IF Inst=8485 THEN PRINT "8485A" 2307 END IF 2308 END LOOP 2309 UNTIL Inst=-2 2310 IF Num_inst>0 THEN PRINT 2311 ! 2312 Num_inst=0 2313 RESTORE Power_meter_req 2314 REPEAT 2315 READ Test_list 2316 LOOP 2317 READ Inst 2318 EXIT IF Inst<0 2319 IF Test_list=Test_number THEN 2320 Num_inst=Num_inst+1 2321 IF Num_inst=1 THEN PRINT "Power meter: "; 2322 IF Num_inst>1 THEN PRINT " or "; 2323 IF Inst=436 THEN PRINT " 436A" 2324 IF Inst=438 THEN PRINT " 438A" 2325 IF Inst=8902 THEN PRINT "8902A" 2326 END IF 2327 END LOOP 2328 UNTIL Inst=-2 2329 IF Num_inst>0 THEN PRINT 2330 ! 2331 Num_inst=0 2332 RESTORE Adtl_equip 2333 REPEAT 2334 READ Test_list 2335 LOOP 2336 READ Equip$ 2337 EXIT IF Equip$="-1" OR Equip$="-2" 2338 IF Test_list=Test_number THEN 2339 Num_inst=Num_inst+1 2340 IF Num_inst=1 THEN PRINT "Misc equip: "; 2341 IF Num_inst>1 THEN PRINT " or "; 2342 PRINT Equip$ 2343 END IF 2344 END LOOP 2345 UNTIL Equip$="-2" 2346 ! 2347 END IF 2348 ! 2349 SUBEXIT 2350 ! 2351 Pick_pwr_meter: ! Subroutine to pick the power meter of choice 2352 IF Present(3) AND Present(4) AND NOT Present(5) THEN Mdl$="436 or 438" 2353 IF Present(3) AND Present(5) AND NOT Present(4) THEN Mdl$="436 or 8902" 2354 IF Present(4) AND Present(5) AND NOT Present(3) THEN Mdl$="438 or 8902" 2355 IF Present(3) AND Present(4) AND Present(5) THEN Mdl$="436, 438, or 8902 " 2356 Pick_again: ! 2357 REPEAT 2358 Choice$=" " 2359 DISP "Would you like to use the "&Mdl$&" as the power meter"; 2360 Input(Choice$) 2361 UNTIL Choice$=" " OR Choice$="436" OR Choice$="438" OR Choice$="8902" 2362 ! 2363 SELECT Choice$ 2364 CASE "436" 2365 ASSIGN @Pwr_mtr TO VAL(Conditions$(14,2)[1,4]) ! Rev C.00.00 Changed 15 to 16 2366 Power_mtr_avail=436 2367 CASE "438" 2368 ASSIGN @Pwr_mtr TO VAL(Conditions$(15,2)[1,4]) ! Rev C.00.00 Changed 16 to 17 2369 Power_mtr_avail=438 2370 CASE "8902" 2371 ASSIGN @Pwr_mtr TO VAL(Conditions$(16,2)[1,4]) ! Rev C.00.00 Changed 17 to 18 2372 Power_mtr_avail=8902 2373 CASE ELSE 2374 GOTO Pick_again 2375 END SELECT 2376 ! 2377 RETURN 2378 ! 2379 Pick_counter: ! Subroutine to pick frequency counter of choice 2380 REPEAT 2381 Choice$=" " 2382 DISP " Would you like to use the 5342A or the 5343A frequency counter?"; 2383 Input(Choice$) 2384 UNTIL Choice$=" " OR Choice$="5342" OR Choice$="5343" 2385 ! 2386 SELECT Choice$ 2387 CASE "5342" 2388 ASSIGN @Counter TO VAL(Conditions$(23,2)[1,4]) ! Rev C.00.00 Changed 22 to 23 2389 Counter_avail=5342 2390 CASE "5343" 2391 ASSIGN @Counter TO VAL(Conditions$(24,2)[1,4]) ! Rev C.00.00 Changed 23 to 24 2392 Counter_avail=5343 2393 CASE ELSE 2394 GOTO Pick_counter 2395 END SELECT 2396 RETURN 2397 ! 2398 SUBEND 2399 ! 2400 ! 2401 Driver_3335: SUB Driver_3335(Input$,OPTIONAL Io_value) !3335 driver 2402 ! Rev C.00.00 Changed ASSIGN statement for 64E/65E Compatibility 2403 COM /Conditions/Conditions$(0:26,1:2)[160] 2404 REAL Lo_freq_limit,Upper_freq,Freq_settling,Min_ampltd,Max_ampltd 2405 REAL Min_amp_step,Max_amp_step,Min_freq_step,Max_freq_step 2406 REAL Ampltd_settling 2407 ! 2408 ASSIGN @Syn TO VAL(Conditions$(19,2)[1,4]) ! Changed '18' to '19' Rev C.00.00 2409 ! 2410 Min_freq=200 2411 Max_freq=8.0E+7 2412 Freq_settling=.10 2413 Min_ampltd=-86.98 2414 Max_ampltd=13 2415 Min_amp_step=.01 2416 Max_amp_step=99 2417 Min_freq_step=1 2418 Max_freq_step=1.0E+7 2419 Ampltd_settling=1 2420 ! 2421 ! *** Select the action to be taken by the driver *** 2422 ! 2423 REPEAT 2424 Parse(Input$,Function$,Parse_value) 2425 IF NPAR=2 THEN Value=Io_value ! Default value 2426 IF Parse_value<>-999 THEN Value=Parse_value! Value if passed in func$ 2427 SELECT Function$ 2428 CASE "INITIALIZE" !Prepare for setup 2429 OUTPUT @Syn;"C" 2430 CASE "FREQUENCY","FREQUENCY MASK ERROR" !Set the frequency 2431 Freq=Value !Buffer Value 2432 IF Freq>Max_freq THEN Freq=Max_freq !Check and correct 2433 IF FreqMax_ampltd THEN Ampltd=Max_ampltd !follow the same basic 2440 IF AmpltdMax_freq_step THEN Freq_step=Max_freq_step 2448 OUTPUT @Syn USING "K,8D.10D,K";"FI",Freq_step,"M F" 2449 WAIT Freq_settling 2450 CASE "AMPLITUDE STEP" 2451 Ampltd_step=ABS(Value) 2452 IF Ampltd_stepMax_amp_step THEN Ampltd_step=Max_amp_step 2454 OUTPUT @Syn USING "K,8D.10D,K";"AI",Ampltd_step,"M A" 2455 WAIT Amp_settling 2456 ! 2457 CASE "UP" !Step active function 2458 OUTPUT @Syn;"U" 2459 WAIT Amp_settling !Wait the maximum time 2460 CASE "DOWN" 2461 OUTPUT @Syn;"D" 2462 WAIT Amp_settling 2463 CASE "RF OFF","RF ON" 2464 OUTPUT @Syn USING "K,8D.10D,K";"A",Min_ampltd,"K" 2465 CASE "UNLEVELED?","UNLEVELLED?" 2466 Value=0 2467 CASE ELSE !Function$ not found 2468 Prompt_user("Function "&Function$&" in Driver_3335 not found") 2469 END SELECT 2470 UNTIL Input$="" 2471 SUBEXIT 2472 SUBEND !Driver_3335 2473 ! 2474 ! 2475 Driver_5343: SUB Driver_5343(Function$,OPTIONAL Value) !5343 driver 2476 ! 2477 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 2478 ! 2479 SELECT Function$ 2480 CASE "INITIALIZE" 2481 OUTPUT @Counter;"PSR3T3ST2L" 2482 CASE "FREQUENCY" 2483 TRIGGER @Counter 2484 ENTER @Counter;Value 2485 CASE ELSE 2486 Prompt_user("Function in Driver_5343 not found") 2487 END SELECT 2488 ! 2489 SUBEND !Driver_5343 2490 ! 2491 ! 2492 Driver_5342: SUB Driver_5342(Function$,OPTIONAL Value) !5342 driver 2493 ! 2494 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 2495 ! 2496 SELECT Function$ 2497 CASE "INITIALIZE" 2498 OUTPUT @Counter;"AUOM0SR3T3ST2L" 2499 CASE "FREQUENCY" 2500 TRIGGER @Counter 2501 ENTER @Counter;Value 2502 CASE ELSE 2503 Prompt_user("Function$ in Driver_5342 not found") 2504 END SELECT 2505 ! 2506 SUBEND !Driver_5342 2507 ! 2508 ! 2509 ! FUTURE DRIVER FOR 5352: GB 08-15-91 2510 ! OUTPUT 716;"RESET" 2511 ! OUTPUT 716;"INIT" 2512 ! OUTPUT 716;"LOWZ" 2513 ! OUTPUT 716;"RESOL,0" 2514 ! 2515 ! 5352 DRIVER TO BE INTEGRATED INTO SOFTWARE AT LATER DATE. 2516 ! 2517 Counter: SUB Counter(Input$,OPTIONAL Value) 2518 ! 2519 COM /Equipment/Present(1:20),Power_mtr_avail,Counter_avail,Sensor_avail(1:20),Source_avail(1:20),Source2_avail(1:20),Enough_equip(1:20) 2520 ! 2521 SELECT Counter_avail 2522 CASE 5342 2523 IF NPAR=1 THEN CALL Driver_5342(Input$) 2524 IF NPAR=2 THEN CALL Driver_5342(Input$,Value) 2525 CASE 5343 2526 IF NPAR=1 THEN CALL Driver_5343(Input$) 2527 IF NPAR=2 THEN CALL Driver_5343(Input$,Value) 2528 ! CASE 5352 2529 END SELECT 2530 ! 2531 SUBEND 2532 ! 2533 ! 2534 Source: SUB Source(Input$,OPTIONAL Value) 2535 ! 2536 COM /Equipment/Present(1:20),Power_mtr_avail,Counter_avail,Sensor_avail(1:20),Source_avail(1:20),Source2_avail(1:20),Enough_equip(1:20) 2537 COM /Test_flags/Test_number,Sequence_type,Last_test 2538 ! 2539 SELECT Source_avail(Test_number) 2540 CASE 8340 2541 IF NPAR=1 THEN CALL Driver_8340(2,Input$) 2542 IF NPAR=2 THEN CALL Driver_8340(2,Input$,Value) 2543 CASE 83401 2544 IF NPAR=1 THEN CALL Driver_8340(1,Input$) 2545 IF NPAR=2 THEN CALL Driver_8340(1,Input$,Value) 2546 CASE 83402 2547 IF NPAR=1 THEN CALL Driver_8340(2,Input$) 2548 IF NPAR=2 THEN CALL Driver_8340(2,Input$,Value) 2549 END SELECT 2550 ! 2551 SUBEND 2552 ! 2553 ! 2554 Source2: SUB Source2(Input$,OPTIONAL Value) 2555 ! 2556 COM /Equipment/Present(1:20),Power_mtr_avail,Counter_avail,Sensor_avail(1:20),Source_avail(1:20),Source2_avail(1:20),Enough_equip(1:20) 2557 COM /Test_flags/Test_number,Sequence_type,Last_test 2558 ! 2559 SELECT Source2_avail(Test_number) 2560 CASE 83401 2561 IF NPAR=1 THEN CALL Driver_8340(1,Input$) 2562 IF NPAR=2 THEN CALL Driver_8340(1,Input$,Value) 2563 CASE 83402 2564 IF NPAR=1 THEN CALL Driver_8340(2,Input$) 2565 IF NPAR=2 THEN CALL Driver_8340(2,Input$,Value) 2566 END SELECT 2567 ! 2568 SUBEND 2569 ! 2570 ! 2571 Load_cal_data: SUB Load_cal_data(Cal_sensor) 2572 ! 2573 COM /Sensor/Current_channel,Sensor(*),Cal_time(*),Cal_data(*) 2574 COM /Conditions/Conditions$(0:26,1:2)[160] 2575 DIM File$[80] 2576 ! 2577 SELECT Cal_sensor 2578 CASE 8481 2579 OUTPUT File$ USING "#,K,5Z";"SEN81",VAL(Conditions$(9,2)) 2580 CASE 8485 2581 OUTPUT File$ USING "#,K,5Z";"SEN85",VAL(Conditions$(10,2)) 2582 END SELECT 2583 ! 2584 ASSIGN @File TO FNFile$(File$,Conditions$(7,2)) 2585 ENTER @File;Cal_data(*) 2586 ASSIGN @File TO * 2587 ! 2588 SUBEND 2589 ! 2590 ! 2591 Print_cond: SUB Print_cond ! Print test conditions 2592 ! 2593 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 2594 COM /Conditions/Conditions$(*) 2595 ! 2596 IF Conditions$(12,2)[6,6]="*" THEN 2597 ASSIGN @Printer TO VAL(Conditions$(13,2)[1,4]) 2598 OUTPUT @Printer;CHR$(12);RPT$("*",40)! Print header 2599 IF POS(Conditions$(1,2),"856") THEN 2600 Stop=POS(Conditions$(1,2),",")-1 2601 IF Stop<0 THEN Stop=999 2602 OUTPUT @Printer;"| "&Conditions$(1,2)[1,MIN(POS(Conditions$(1,2)," ")-1,Stop)]&" OPERATION VERIFICATION"&" |" 2603 ELSE 2604 OUTPUT @Printer;"| 8562 OPERATION VERIFICATION |" 2605 END IF 2606 OUTPUT @Printer;RPT$("*",40) 2607 FOR I=1 TO 6 ! Print conditions$ 2608 OUTPUT @Printer USING "K,K,K";Conditions$(I,1);" ";Conditions$(I,2) 2609 NEXT I 2610 END IF 2611 ! 2612 SUBEND !Print_cond 2613 ! 2614 ! 2615 Check_cal_data: SUB Check_cal_data(File$,Error_flag) 2616 ! 2617 COM /Sensor/Current_channel,Sensor(*),Cal_time(*),Cal_data(*) 2618 ! 2619 Min_freq=1.E+99 2620 Max_freq=0 2621 FOR I=1 TO SIZE(Cal_data,2) 2622 IF Cal_data(2,I)<>0 THEN 2623 Min_freq=MIN(Min_freq,Cal_data(1,I)) 2624 Max_freq=MAX(Max_freq,Cal_data(1,I)) 2625 END IF 2626 NEXT I 2627 SELECT File$[1,5] 2628 CASE "SEN81" 2629 IF Min_freq>5.E+7 THEN CALL Prompt_user("ERROR: 8481A Sensor cal data minimum frequency not <= 50 MHz.",Error_flag) 2630 IF Max_freq<3.E+8 THEN CALL Prompt_user("ERROR: 8481A Sensor cal data maximum frequency not >= 300 MHz.",Error_flag) 2631 CASE "SEN85" 2632 IF Min_freq>5.E+7 THEN CALL Prompt_user("ERROR: 8485A Sensor cal data minimum frequency not <= 50 MHz.",Error_flag) 2633 IF Max_freq<2.65E+10 THEN CALL Prompt_user("ERROR: 8485A Sensor cal data maximum frequency not >= 26.5 GHz.",Error_flag) 2634 END SELECT 2635 ! 2636 SUBEND 2637 ! 2638 ! 2639 Pass_fail: SUB Pass_fail(Result,OPTIONAL INTEGER Run_thru) 2640 ! SUBPROGRAM TO PRINT OUT EITHER PASS OR FAIL. IT MAY COME TO PASS 2641 ! THAT WE PRINT SOMETHING ELSE INSTEAD OF "FAIL", SUCH AS "REFER TO 2642 ! MANUAL PERFORMANCE TESTS". 2643 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 2644 COM /Tests/Tests$(*),Short_name$(*),Conn_check(*) 2645 COM /Test_flags/Test_number,Sequence_type,Last_test 2646 INTEGER Looping 2647 DIM Flag$[80],Temp$[80] 2648 ! 2649 Looping=1 2650 IF NPAR>1 THEN Looping=Run_thru 2651 Temp$=Tests$(Test_number,2) 2652 ! 2653 ! OUTPUT @Printer ! Removed per customer direction REV A.00.01 2654 SELECT Result 2655 CASE 0 2656 ! OUTPUT @Printer USING "35X,10A";"** PASS **" 2657 Flag$="PASS" 2658 CASE 1 2659 ! OUTPUT @Printer USING "21X,37A";"** MEASUREMENT IS OUT OF TOLERANCE **" 2660 ! OUTPUT @Printer USING "18X,43A";"REFER TO ASSOCIATED MANUAL PERFORMANCE TEST" 2661 Flag$="MEASUREMENT OUT-OF-TOLERANCE" 2662 CASE -1 2663 ! OUTPUT @Printer USING "32X,K";"** SHORT PASS **" 2664 Flag$="SHORT PASS" 2665 CASE 2 2666 Prompt_user("HP8562E FRONT END CALIBRATION COMPLETE") 2667 CASE -2 2668 Prompt_user("HP8562E FRONT END CALIBRATION INCOMPLETE") 2669 END SELECT 2670 GOSUB Check_flag 2671 ! 2672 ! OUTPUT @Printer ! Removed per customer direction REV A.00.01 2673 FOR I=1 TO 80 2674 ! OUTPUT @Printer;"*"; 2675 NEXT I 2676 ! OUTPUT @Printer 2677 ! OUTPUT @Printer 2678 SUBEXIT 2679 ! 2680 Check_flag: ! 2681 IF Looping=1 THEN 2682 Tests$(Test_number,2)=Flag$ 2683 ELSE 2684 SELECT Temp$ 2685 CASE "PASS" 2686 Tests$(Test_number,2)=Flag$ 2687 CASE "SHORT PASS" 2688 IF Result=1 THEN Tests$(Test_number,2)=Flag$ 2689 END SELECT 2690 END IF 2691 RETURN 2692 ! 2693 SUBEND ! PASS_FAIL 2694 ! 2695 Cnvrt_to_str: SUB Cnvrt_to_str(Freq,Sig_digits,Freq$) 2696 ! SUBPROGRAM TO CONVERT A FREQUENCY TO A STRING, ROUNDED TO A GIVEN 2697 ! NUMBER OF DIGITS. THE STRING LENGTH EQUALS THE NUMBER OF SIGNIFICANT 2698 ! DIGITS + 5 (3 CHARACTERS FOR THE TERMINATOR, ONE BLANK, ONE DECIMAL 2699 ! POINT. MAXIMUM STRING LENGTH IS 20 CHARACTERS, MAXIMUM SIGNIFICANT 2700 ! DIGITS IS 15. 2701 ! 2702 Temp=Freq ! TEMPORARY COPY 2703 L=0 ! POWER OF TEN OF FREQ 2704 ! 2705 REPEAT ! FIND POWER OF TEN OF FREQ 2706 L=L+1 2707 Temp=Temp/10 2708 UNTIL Temp<1 2709 ! 2710 SELECT L ! FIND DIVISOR AND TERMINATOR 2711 CASE 1,2,3 2712 Dvsr=1 2713 T$=" Hz " 2714 CASE 4,5,6 2715 Dvsr=1000 2716 T$=" kHz" 2717 CASE 7,8,9 2718 Dvsr=1.E+6 2719 T$=" MHz" 2720 CASE 10,11,12 2721 Dvsr=1.E+9 2722 T$=" GHz" 2723 CASE ELSE 2724 T$="999 GHz" 2725 END SELECT 2726 ! 2727 Freq$=VAL$(DROUND((Freq/Dvsr),Sig_digits))&T$ 2728 ! 2729 L=LEN(Freq$) ! FILL OUT STRING UNTIL LENGTH=SIG_DIGITS + 5 2730 WHILE L<(Sig_digits+5) 2731 Freq$=" "&Freq$ 2732 L=LEN(Freq$) 2733 END WHILE 2734 SUBEND ! CNVRT_TO_STR 2735 ! 2736 Header_prnt: SUB Header_prnt 2737 ! Rev C.00.00 Modified to list options separately and list f/w revision 2738 COM /Test_flags/Test_number,Sequence_type,Last_test 2739 COM /Conditions/Conditions$(0:26,1:2)[160] 2740 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 2741 ! 2742 ASSIGN @Printer TO VAL(Conditions$(13,2)) 2743 ! 2744 DIM Model$[80] 2745 DIM Serial$[15] 2746 DIM Option$[31] ! Permits up to 8 options to be listed 2747 DIM Operator$[37] 2748 DIM Date$[15] 2749 DIM Time$[15] 2750 DIM Cond$[35] 2751 DIM Comment$[35] 2752 ! 2753 Dut("READ F/W REVISION",Fw_rev) 2754 Dut("READ MODEL NUMBER",Dummy,Model$) 2755 IF LEN(Model$)>7 THEN 2756 Option$=Model$[9;31] 2757 ELSE 2758 Option$="None" 2759 END IF 2760 Space=POS(Conditions$(1,2)," ") 2761 Model$=Conditions$(1,2)[1,7] 2762 Serial$=Conditions$(1,2)[Space+1;10] 2763 Operator$=Conditions$(2,2)[1;25] 2764 Date$=Conditions$(3,2)[1;15] 2765 Time$=Conditions$(4,2)[1;15] 2766 Cond$=Conditions$(5,2)[1;35] 2767 Comment$=Conditions$(6,2)[1;35] 2768 IF Operator$="" THEN Operator$="_________________________" 2769 IF Time$="" THEN Time$="_______________" 2770 IF Date$="" OR VAL(Date$[7])<1987 THEN ! Valid date can't be before 1987 2771 Date$="_______________" ! User will have to write in a 2772 Time$="_______________" ! valid date. 2773 END IF 2774 IF Cond$="" THEN Cond$=RPT$("_",35) 2775 IF Comment$="" THEN Comment$=RPT$("_",35) 2776 OUTPUT @Printer;"________________________________________________________________________________" 2777 OUTPUT @Printer 2778 OUTPUT @Printer USING "18X,3A,5A,X,34A";"HP ",Model$[3;5],"FRONT END CALIBRATION" 2779 OUTPUT @Printer 2780 OUTPUT @Printer;" HEWLETT-PACKARD COMPANY" 2781 OUTPUT @Printer 2782 OUTPUT @Printer USING "5X,6A,23A,5X,11A,25A";"Model ",Model$,"Tested By: ",Operator$ 2783 OUTPUT @Printer USING "5X,8A,31A";"Options ",Option$ 2784 OUTPUT @Printer USING "5X,11A,15A,8X,6A,15A";"Serial No. ",Serial$,"Date: ",Date$ 2785 OUTPUT @Printer USING "5X,18A,6D";"Firmware Revision ";Fw_rev 2786 OUTPUT @Printer 2787 OUTPUT @Printer USING "39X,6A,15A";"Time: ",Time$ 2788 OUTPUT @Printer 2789 OUTPUT @Printer USING "14X,K,K";"Test Conditions:",Cond$ 2790 OUTPUT @Printer USING "14X,K,K";"User's Comments:",Comment$ 2791 OUTPUT @Printer 2792 OUTPUT @Printer;"________________________________________________________________________________" 2793 OUTPUT @Printer 2794 OUTPUT @Printer 2795 PRINTER IS CRT 2796 SUBEND 2797 ! 2798 Rectangle: SUB Rectangle(Width,Height) 2799 ! Subprogram to draw a rectangle, thus eliminating the need 2800 ! for the RECTANGLE function of BASIC 3.0 and 4.0 and allowing 2801 ! program to run in BASIC 2.1 2802 IDRAW Width,0 2803 IDRAW 0,Height 2804 IDRAW -Width,0 2805 IDRAW 0,-Height 2806 SUBEND ! Subprogram Rectangle 2807 ! 2808 Input: SUB Input(Return$) 2809 ! Subprogram to accept keyboard input and, if the text has been 2810 ! scrolled, to "unscroll" it and re-draw the header. 2811 ! 2812 COM /Menu/Menu$ 2813 ! 2814 OUTPUT KBD;"ÿ#";Return$;"ÿH";! Rev C.00.00 Echo back original value, if 2815 ENTER KBD;Return$ ! provided in call to Input. 2816 ! LINPUT "",Return$ 2817 ! 2818 STATUS CRT,3;Lines_above 2819 IF Lines_above>1 THEN ! Only unscroll and redraw if necessary 2820 CONTROL CRT,1;-Lines_above+1 2821 OUTPUT CRT;"" 2822 Draw_alpha_hdr(Menu$) 2823 END IF 2824 ! 2825 SUBEND 2826 ! 2827 Draw_alpha_hdr: SUB Draw_alpha_hdr(Label$) ! Draw Label$ on header 2828 ! 2829 COM /Conditions/Conditions$(*) 2830 DIM Line1_text$[80] 2831 DIM Line2_text$[80] 2832 DIM Line3_text$[80] 2833 DIM In_text$[80] 2834 DIM Out_text$[80] 2835 DIM Ruler1$[80] 2836 DIM Ruler2$[80] 2837 Ruler2$="12345678901234567890123456789012345678901234567890123456789012345678901234567890" 2838 Ruler1$="00000000011111111112222222222333333333344444444445555555555666666666677777777778" 2839 ! 2840 STATUS KBD,9;Kbd_status 2841 IF BIT(Kbd_status,5) THEN 2842 Ul$=CHR$(132) 2843 Clr$=CHR$(128) 2844 ELSE 2845 Ul$=CHR$(132) 2846 Clr$=CHR$(128) 2847 END IF 2848 ! 2849 OUTPUT KBD;"ÿK"; 2850 Line1_text$="HP8562E FREQUENCY RESPONSE ADJUSTMENT" 2851 Line3_text$=Ul$&" Copyright Hewlett-Packard Co. 1996 Rev. A.00.00"&Clr$ 2852 PRINT TABXY(1,1),RPT$("_",80) 2853 PRINT TABXY(1,2),"|",TABXY(80,2),"|" 2854 PRINT TABXY(1,3),"|",TABXY(80,3),"|" 2855 PRINT TABXY(1,4),"|",TABXY(80,4),"|" 2856 !PRINT TABXY(1,5),"|";RPT$("_",78);TABXY(80,5),"|" 2857 PRINT TABXY(60,3);RPT$("_",20) 2858 PRINT TABXY(1,4);Ul$&"|"&RPT$(" ",58)&"|"&RPT$(" ",19)&Ul$&"|"&Clr$ 2859 In_text$=Line1_text$ 2860 GOSUB Expand_print 2861 Menu_len=LEN(Out_text$) 2862 Start_pos=40-Menu_len/2 2863 PRINT TABXY(Start_pos,2),Out_text$ 2864 In_text$=Label$ 2865 GOSUB Expand_print 2866 Menu_len=LEN(Out_text$) 2867 Start_pos=40-Menu_len/2 2868 PRINT TABXY(Start_pos,3),Out_text$ 2869 PRINT TABXY(2,3),Line2_text$ 2870 PRINT TABXY(2,4),Line3_text$ 2871 SUBEXIT 2872 ! 2873 Expand_print: ! 2874 Out_text$="" 2875 Input_length=LEN(In_text$) 2876 IF Input_length>40 THEN RETURN ! Don't expand print if it will exceed 80 characters 2877 FOR I=1 TO Input_length-1 2878 Out_text$=Out_text$&In_text$[I;1]&" " 2879 NEXT I 2880 Out_text$=Out_text$&In_text$[Input_length;1] 2881 RETURN 2882 ! 2883 SUBEND !Draw_alpha_hdr 2884 ! 2885 ! 2886 Check_options: SUB Check_options 2887 ! 2888 COM /Io_paths/@Dut,@Printer,@Pwr_mtr,@Counter 2889 COM /Tests/Tests$(*),Short_name$(*),Conn_check(*) 2890 COM /Conditions/Conditions$(0:26,1:2)[160] 2891 ! 2892 Fadc=2 ! Test number for Fast ADC test 2893 ! 2894 SUBEND 2895 ! 2896 SUB Beeper(OPTIONAL Type$) 2897 ! REV C.01.00 Added Beeper for audible prompts 2898 INTEGER Noise 2899 IF NPAR THEN 2900 SELECT UPC$(TRIM$(Type$)) 2901 CASE "ERROR" 2902 BEEP 500,.05 2903 WAIT .05 2904 CASE "WARNING","WARN" 2905 BEEP 100,.3 2906 CASE "BAD_KEY","BAD KEY" 2907 BEEP 200,.1 2908 CASE "ALERT" 2909 FOR Noise=1 TO 4 2910 BEEP 200,.05 2911 BEEP 400,.05 2912 NEXT Noise 2913 CASE "PASS","PASSED" 2914 BEEP 300,.1 2915 CASE "FAIL","FAILURE","FAILED" 2916 FOR Noise=1 TO 4 2917 BEEP 500,.05 2918 WAIT .1 2919 NEXT Noise 2920 CASE "PROMPT" 2921 BEEP 100,.1 2922 CASE ELSE 2923 BEEP 2924 END SELECT 2925 ELSE 2926 BEEP 2927 END IF 2928 SUBEND 2929 ! 2930 ! 2931! re-save "production/products/856xAL/fr_end_cl_f:HFS" 2932! 2933! END 2934 SUB Fr_end_cl_f(Option$,Test_mode$,Jan_mode$,INTEGER Test_result,Depend) 2935 ! 2936 ! 2937! $Log: fr_end_cl_f,v $ 2938!Revision 2.15 96/01/23 13:10:14 13:10:14 hmgr () 2939!Author: mayk@boar.sr.hp.com 2940!Added 8562E. 2941! 2942!Revision 2.14 95/06/19 14:25:07 14:25:07 hmgr () 2943!Author: mayk@boar.sr.hp.com 2944!Added OUTPUT @Pwr_mtr;"PR LG;BP;TR3;" statement. 2945! 2946!Revision 2.13 94/08/24 16:16:56 16:16:56 hmgr () 2947!Author: lyle@hpsadwc6.sr.hp.com 2948!Changed operator prompt in Chck_dacper_con. 2949! 2950!Revision 2.12 94/08/08 15:27:20 15:27:20 hmgr () 2951!Author: bobw@hpsadwc5.sr.hp.com 2952!Added clr scr to clear old prompt. 2953! 2954!Revision 2.11 94/07/06 15:58:17 15:58:17 hmgr () 2955!Author: bobw@hpsadwc5.sr.hp.com 2956!Slight change to warm up routine. 2957! 2958!Revision 2.9 94/07/05 12:45:24 12:45:24 hmgr () 2959!Author: bobw@hpsadwc5.sr.hp.com 2960!Fixed syntax error with last modification. 2961! 2962!Revision 2.8 94/07/01 15:04:20 15:04:20 hmgr () 2963!Author: bobw@hpsadwc5.sr.hp.com 2964!Added warm up after checking connections. 2965! 2966!Revision 2.7 94/05/20 14:30:52 14:30:52 hmgr () 2967!Author: bobw@hpsadwc5.sad.hp.com 2968!And yet another slight modification. 2969! 2970!Revision 2.5 94/05/18 15:34:05 15:34:05 hmgr () 2971!Author: bobw@hpsadwc5.sad.hp.com 2972!Slight changed from previous modification. 2973! 2974!Revision 2.4 94/05/13 13:51:18 13:51:18 hmgr () 2975!Author: bobw@hpsadwc5.sad.hp.com 2976!The following changes in fr_end_cl_f allows zero to be written into 2977!the eerom for B0 YTF data. This change is 8560E OPT 002 specific. This 2978!will fix a firmware bug in the 940210 rev. firmware. The change will 2979!have no effect on newer rev.codes and once implemented can be left 2980!alone. The firmware bug would use the YTF data after IP had been 2981!pressed. The default values of 128 would cause an offset to be incured 2982!from the real time dac. Substituting zero for 128 eliminates any 2983!offset. 2984! 2985!Revision 2.3 94/04/20 15:52:21 15:52:21 hmgr () 2986!Author: bobw@hpsadwc5.sad.hp.com 2987!Fixed syntax error with previous revision. 2988! 2989!Revision 2.2 94/04/20 14:55:41 14:55:41 hmgr () 2990!Author: bobw@hpsadwc5.sad.hp.com 2991!Changed so that prompt asking to print break table is only given when 2992!not in procedure mode. 2993! 2994!Revision 2.1 94/04/11 15:53:24 15:53:24 hmgr () 2995!Author: bobw@hpsadwc5.sad.hp.com 2996!Many changes related to introduction of ORCA product. 2997! 2998!Revision 1.32 93/09/02 12:42:21 12:42:21 hmgr () 2999!Author: randyh@hpsadpk9.sad.hp.com 3000!changed Set_ytfgain_dac routine to average all of band 3 if dut=ORCA. 3001!Now cools rythm for 90 seconds before taking 2nd meas from 21 to 26.5 GHz 3002! 3003!Revision 1.31 93/09/01 15:44:16 15:44:16 hmgr () 3004!Author: randyh@hpsadpk9.sad.hp.com 3005!corrected bug in new Set_ytfgain_dac routine 3006!now prints out gain dac value of first pass and 0 for ytf on 2nd pass 3007! 3008!Revision 1.30 93/08/30 16:22:30 16:22:30 hmgr () 3009!Author: randyh@hpsadpk9.sad.hp.com 3010!lowered power for multiples check in band 5 from 10dB to 6dB to avoid 3011!8340 unleveling. 3012! 3013!Revision 1.29 93/08/27 11:53:58 11:53:58 hmgr () 3014!Author: randyh@hpsadpk9.sad.hp.com 3015!1) now able to test 8 band ORCAs 3016!2) now able to test 705 point ORCAs 3017!3) new cal routine for rythm bands 3 and 4 id dut is an ORCA 3018! do PP and GAIN cold and then heat up rythm and do GAIN only hot, 3019! average cold and hot GAIN dac settings and store to dut. 3020!4) changed 8340 to SOURCE in setup prompts 3021! 3022!Revision 1.28 93/08/20 16:33:16 16:33:16 hmgr () 3023!Author: randyh@hpsadpk9.sad.hp.com 3024!now bases size of allocated arrays based on what break table returns 3025!instead of what the model is. Also don't have to create arrays that 3026!hold the largest possible number of points, but what is just needed. 3027! 3028!Revision 1.27 93/07/30 17:29:18 17:29:18 hmgr () 3029!Author: randyh@hpsadpk9.sad.hp.com 3030!slight cleanups 3031! 3032!Revision 1.26 93/07/28 09:45:34 09:45:34 hmgr () 3033!Author: randyh@hpsadpk9.sad.hp.com 3034!Band 3 wait increased from 60 to 90 seconds. 3035!if FNRom_date("8 BANDS") then Pp_offset location changes. 3036!Use new Dut() command "UPDATE RF CORE DAC" 3037! 3038!Revision 1.25 93/07/23 11:23:17 11:23:17 hmgr () 3039!Author: randyh@hpsadl19.sr.hp.com 3040!if ORCA the in band 5 find multiple level at 31.2 ghz. if < 80 dbc then 3041!adjust pp rtdac until mult is > 80 dbc. store change in pp rtdac in eerom. 3042! 3043!Revision 1.24 93/07/19 12:47:26 12:47:26 hmgr () 3044!Author: randyh@hpsadpk9.sad.hp.com 3045!Use new FNRom_date CASE "ORCA" 3046! 3047!Revision 1.23 93/07/14 14:13:29 14:13:29 hmgr () 3048!Author: randyh@hpsadpk9.sad.hp.com 3049!changed band 3 wait from 240 sec to 60 sec 3050! 3051!Revision 1.22 93/06/23 13:27:43 13:27:43 hmgr () 3052!Author: bobw@hpsadwc5.sad.hp.com 3053!Changed arbitrary gain dac limit by 50% as recommended by Greg Stone. 3054! 3055!Revision 1.21 93/06/22 15:07:26 15:07:26 hmgr () 3056!Author: randyh@hpsadl19.sr.hp.com 3057!moved setting of Sb_pre_trk from loma_adj to fr_end_cl_f 3058! 3059!Revision 1.20 93/05/28 10:10:16 10:10:16 hmgr () 3060!Author: randyh@hpsadl19.sr.hp.com 3061!no comment 3062! 3063!Revision 1.19 93/05/28 10:05:55 10:05:55 hmgr () 3064!Author: randyh@hpsadl19.sr.hp.com 3065!put in 4 minute wait in band 3 for orca 3066!set start slope for sbtx to 90 3067! 3068!Revision 1.18 93/05/19 11:03:49 11:03:49 hmgr () 3069!Author: randyh@hpsadpk9.sad.hp.com 3070!1) no longer check for OPEN/CLOSE status of DUT. So don't offset dac vals. 3071!2) no longer give option to wait 2 minutes at beginning of band3. Don't 3072! wait at beginning of band3. 3073!3) in Set_slope_off set start slope for first adj to 160. Use returned 3074!Slope value for consecutive adjusts. Check returned Slope value to see 3075!if slope/offset adjust was good. 3076! 3077!Revision 1.17 93/05/12 13:09:23 13:09:23 hmgr () 3078!Author: bobw@hpsadwc5.sad.hp.com 3079!Changed offset values for 60 and 61 boxes to 0. 3080! 3081!Revision 1.16 93/04/20 10:55:00 10:55:00 hmgr () 3082!Author: randyh@hpsadl19.sr.hp.com 3083!syntax error 3084! 3085!Revision 1.15 93/04/16 12:29:58 12:29:58 hmgr () 3086!Author: randyh@hpsadl19.sr.hp.com 3087!if 64/65 and band=3 in adj_slope_off then don't default slope. 3088! 3089!Revision 1.14 93/04/07 14:55:21 14:55:21 hmgr () 3090!Author: randyh@hpsadpk9.sad.hp.com 3091!more changes for new firmware 3092! 3093!Revision 1.13 93/04/06 12:39:19 12:39:19 hmgr () 3094!Author: randyh@hpsadpk9.sad.hp.com 3095!made changes for new ee dac width of 3 on rom versions > "930401" 3096! 3097!Revision 1.12 93/03/09 11:44:14 11:44:14 hmgr () 3098!Author: randyh@hpsadpk9.sad.hp.com 3099!more changes for 8565E 3100! 3101!Revision 1.11 93/03/05 10:13:53 10:13:53 hmgr () 3102!Author: randyh@hpsadpk9.sad.hp.com 3103!added checks for "8565E" where "8564E" is checked for 3104! 3105!Revision 1.10 93/02/11 15:26:27 15:26:27 hmgr () 3106!Author: randyh@hpsadpk9.sad.hp.com 3107!slight cleanups for 8564E 3108! 3109!Revision 1.9 93/02/05 17:18:39 17:18:39 hmgr () 3110!Author: randyh@hpsadpk9.sad.hp.com 3111!no comment 3112! 3113!Revision 1.8 93/02/05 15:13:55 15:13:55 hmgr () 3114!Author: randyh@hpsadpk9.sad.hp.com 3115!no comment 3116! 3117!Revision 1.7 93/02/05 15:06:58 15:06:58 hmgr () 3118!Author: randyh@hpsadpk9.sad.hp.com 3119!no comment 3120! 3121!Revision 1.6 93/02/05 14:40:27 14:40:27 hmgr () 3122!Author: randyh@hpsadpk9.sad.hp.com 3123!cleaned up break table printout. streamlined Adjust_table calculations 3124! 3125!Revision 1.5 93/02/01 13:52:37 13:52:37 hmgr () 3126!Author: randyh@hpsadpk9.sad.hp.com 3127!added printout of breaktable if user desires 3128! 3129!Revision 1.4 92/12/01 13:23:46 13:23:46 hmgr () 3130!Author: randyh@hpsadpk9.sad.hp.com 3131!added 2 selectable 2 minute pause at begining of band 3 3132! 3133!Revision 1.3 92/11/23 15:11:40 15:11:40 hmgr () 3134!Author: randyh@hpsadpk9.sad.hp.com 3135!added checks to make sure it runs correctly with old or new roms 3136! 3137!Revision 1.2 92/11/12 11:50:16 11:50:16 hmgr () 3138!Author: randyh@hpsadpk9.sad.hp.com 3139!no comment 3140! 3141!Revision 1.1 92/10/09 16:29:01 16:29:01 hmgr () 3142!Author: randyh@hpsadpk9.sad.hp.com 3143!Initial revision 3144! 3145!---------------------------------------------------------------------------- 3146 !Fr_end_cl_f:REM $Header: fr_end_cl_f,v 2.15 96/01/23 13:10:14 hmgr Exp $ 3147 COM /Variations/Model$,INTEGER Short_moved 3148 COM /Ee_data/ INTEGER Ee_data(*) 3149 COM /Rp_nums/Rp_8485,Rp_8482 3150 ! 3151 DIM Key_label$[160],Which_one$[25],Message$[500],Array_descrip$(1:1)[80] 3152 DIM Select_opt$[16],Error_message$[160],Key_pressed$[20],Title$[80] 3153 DIM Dir_name$[16],Revision$[1],Control$[300],Sn$[10],Type$[20],Opts$[80] 3154 ! 3155 INTEGER Col_dim(1:1),Row_dim(1:1),Z_dim(1:1) 3156 INTEGER Passed,Failed,In_spec 3157 INTEGER Loop_counter 3158 ! 3159 REAL Old_dacper10db,Fst_dacper10db,Diff_limit,Diff_data_lim 3160 REAL Io_value,Test_date,Marker_amp,Meas_amp,Sb_pre_trk,Trk_hi 3161 REAL Dacper10db,Rd_dacper10db,Power_reading 3162 ! 3163 Passed=1 3164 Aborted=0 3165 Failed=-1 3166 ! 3167 Slope=1 3168 Offset=2 3169 ! 3170 CALL Translate_opt(Select_opt$) 3171 ! 3172 Revision$=FNRev_letter$("$Revision: 2.15 $") 3173 Dir_name$="FR_END_CL_F"&Revision$ 3174 CALL Get_io_path("SYNTH 8340",@Syn_8340) 3175 CALL Get_io_path("PWR MTR 438",@Pwr_mtr) 3176 ASSIGN @Dut TO 718 3177 ON KEY 9 LABEL "ABORT TEST",10 RECOVER Test_aborted 3178 GOSUB Blank_keys 3179 ! 3180 CALL Clr_scr 3181 Title$="*** NEW ""E"" FRONT END CALIBRATION "&FNRcs_rev$("$Revision: 2.15 $")&" ***" 3182 CALL Show_message(Title$,2) 3183 ! 3184 ON SIGNAL 0,9 GOTO Driver_error 3185 ON SIGNAL 2,10 GOTO Dut_error 3186 ! 3187 Adjust_table=0 ! don't do offset anymore !!!!!!!!! 3188 ! 3189 Band3pause=0 3190 IF Model$="8564E" OR Model$="8565E" THEN Band3pause=1 3191 ! 3192 IF NOT (Jan_mode$="PROCEDURE") THEN 3193 CALL Prompt_keys("YES,NO",Key_pressed$,"Do you wish to print out the BREAK TABLE?") 3194 END IF 3195 Printbrktab=(Key_pressed$="YES") 3196 ! 3197 IF Model$="8564E" OR Model$="8565E" THEN 3198 CALL Correct_8487(Rp_8485,Rp_num$) 3199 Ck_sensor_cal("CHB","8487") 3200 OUTPUT @Pwr_mtr;"PR LG;BP;TR3;" 3201 ELSE 3202 ! CALL Correct_8485(Rp_8485,Rp_num$) ! Symm: not required for 8562E (looking for sensor file) *** 3203 CALL Power_meter("CHECK CAL") ! Symm: ** was ** Ck_sensor_cal("CHB","8485") *** 3204 ! OUTPUT @Pwr_mtr;"PR LG;BP;TR3;" ! Symm: not applicable for 436A need to fix for selected pwr_mtr *** 3205 END IF 3206 ! 3207 GOSUB Get_constants 3208 ! 3209 Array_descrip$(1)="SLOPE AND OFFSET DACS" 3210 Row_dim(1)=2 ! Slope and offset data. 6 bands x 2 values 3211 Col_dim(1)=Band_lim_size ! Band 1 to 8 3212 Z_dim(1)=0 3213 ! 3214 ALLOCATE Fr_end_cl_data(1:Row_dim(1),1:Col_dim(1)) 3215 ALLOCATE Fr_end_cl_min(1:Row_dim(1),1:Col_dim(1)) 3216 ALLOCATE Fr_end_cl_max(1:Row_dim(1),1:Col_dim(1)) 3217 ! 3218 CALL Store_key(Dir_name$,Test_mode$,Select_opt$,Row_dim(1),Col_dim(1),Z_dim(1),Array_descrip$(*)) 3219 CALL Store_spec(Dir_name$,Test_mode$,Select_opt$,Row_dim(1),Col_dim(1),Z_dim(1),Array_descrip$(*)) 3220 CALL Fr_end_cl_f_sp(Array_descrip$(1),Test_mode$,Select_opt$,Fr_end_cl_min(*),Fr_end_cl_max(*)) 3221 ! 3222 MAT Fr_end_cl_data=(0) 3223! 3224!--------------------------- TESTS BEGIN HERE ------------------------- 3225! 3226 GOSUB Warm_up 3227 Re_test_loop: ! 3228 Test_result=0 3229 GOSUB Ytf_slope_off 3230 IF Model$="8564E" OR Model$="8565E" THEN 3231 GOSUB Stuff_sb_pretrk 3232 Cal_flatness(@Dut,@Syn_8340,@Pwr_mtr,0,5.0E+10) 3233 Cal_sbpretrack(@Dut,@Syn_8340,Model$,Sb_pre_trk) 3234 Meas_flat(1.3E+10,2.6E+10,5.0E+7) 3235 ELSE 3236 GOSUB Set_ytfgain_dac 3237 Dut("RE-STORE EE BREAK TABLE,ADJUST ALL") 3238 END IF 3239 Test_result=1 3240 ! 3241 GOSUB Output_results 3242 SUBEXIT 3243! 3244!--------------------------------------------------------------------- 3245 Store_pp_ofs: ! 3246!*********** write sb_pp_offset data to eerom and ram ***********! 3247 FOR I=0 TO 2 3248 Write_data(DVAL$(FNRead_value("05FD58",4)+I,16),0) 3249 Write_data(DVAL$(FNRead_value("05FD5C",4)+I,16),0) 3250 NEXT I 3251 Sbtx_bnd_ofs=0 3252 IF FNRom_date("8 BANDS") THEN Sbtx_bnd_ofs=1 3253 Write_data(DVAL$(FNRead_value("05FD58",4)+Sbtx_bnd_ofs,16),Pp_offset) 3254 Write_data(DVAL$(FNRead_value("05FD5C",4)+Sbtx_bnd_ofs,16),Pp_offset) 3255 CALL Calc_chksum 3256 RETURN 3257!****************************************************************! 3258! 3259!--------------------------------------------------------------------- 3260 Stuff_sb_pretrk: ! 3261 !*********** write sb_pre_trk data to eerom and ram ***********! 3262 IF POS(Model$,"65") THEN 3263 Sb_pre_trk=16 3264 ELSE 3265 Sb_pre_trk=16 3266 END IF 3267 Write_data(DVAL$(FNRead_value("05FD4C",4),16),Sb_pre_trk) 3268 Write_data(DVAL$(FNRead_value("05FD50",4),16),Sb_pre_trk) 3269 CALL Calc_chksum 3270 RETURN 3271!****************************************************************! 3272! 3273! 3274 Warm_up:! 3275 CALL Clr_scr 3276 CALL Show_message(Title$,2) 3277 Dut("INITIALIZE") 3278 Warm_up_time=300! 5 minutes 3279 CALL Show_message("Waiting for box to warm up...",8) 3280 CALL Prompt_keys("DEFAULT=CONTINUE",Key_pressed$,"",Warm_up_time) 3281 CALL Show_message("",8) 3282 RETURN 3283 ! 3284! FRONT END CALIBRATION/YTF CONSTANTS 3285 Get_constants: ! 3286 MAT Ee_data=(0) 3287 Ee_data(1)=4 ! Default width of EE ytf/gain cor table 3288 IF FNRom_date("ORCA") THEN Ee_data(1)=3 ! EE ytf/gain cor table 3289 ! 3290 Ytf_mid_dac=128 3291 IF Model$="8560E" AND POS(Option$,"002") THEN !Sets ytf dac to 0 3292 Ytf_mid_dac=0 !for 60E,002 only! 3293 END IF 3294 Gain_mid_dac=2048 !FOR THE 12 bit dac 3295 ! 3296 Dut("WRITE ENABLE,REF LEVEL CAL=0,WRITE EE REF LEVEL CAL=0")!STORES TO EE 3297 GOSUB Chck_dacper_con 3298 GOSUB Meas_dacper10db 3299 Dut("WRITE ENABLE") 3300 Dut("READ EE DAC PER 10DB",First_value) 3301 IF (First_value<=-875 AND First_value>=-1125) THEN Dac_per_10db=First_value 3302 IF (First_value>=-875 OR First_value<=-1125) THEN Dac_per_10db=-1000 3303 IF (First_value>=50 AND First_value<=75) THEN Dac_per_10db=First_value 3304 ! 3305 ! 3306 Data_60: DATA 2,0,-1,-1,-1,-1,-1,-1,-1,-1 3307 DATA 4,2,0,0 3308 Data_61: DATA 2,1,1,1,-1,-1,3E9,6E9,-1,-1 3309 DATA 4,2,0,0 3310 Data_62e: DATA 2,2,1,1,2,2,4E9,6E9,6E9,12.16E9 3311 DATA 4,2,.67,.62 3312 Data_63e: DATA 2,2,1,2,3,3,4E9,12.16E9,13.8E9,25.2E9 3313 DATA 4,2,.67,.62 3314 Data_64e: DATA 5,5,1,1,2,2,3,3,4,4,5,5 3315 DATA 3E9,6E9,6E9,12.16E9,13.8E9,25.2E9,27E9,30.5E9,32E9,39E9 3316 DATA 6,2,.67,.62 3317 Data_64e_8: DATA 6,6,1,1,2,2,3,3,4,4,5,5,6,6 3318 DATA 3E9,6E9,6E9,12.16E9,13.8E9,25.2E9,27E9,28.3E9,28.6E9,30.5E9,32E9,39E9 3319 DATA 7,2,.67,.62 3320 Data_65e: DATA 5,5,1,1,2,2,3,3,4,4,5,5 3321 DATA 3E9,6E9,6E9,12.16E9,13.8E9,25.2E9,27E9,30.5E09,32E9,49E9 3322 DATA 6,2,.67,.62 3323 Data_65e_8: DATA 7,7,1,1,2,2,3,3,4,4,5,5,6,6,7,7 3324 DATA 3E9,6E9,6E9,12.16E9,13.8E9,25.2E9,27E9,28.3E9,28.6E9,30.5E9,32E9,39E9,41E9,49E9 3325 DATA 8,2,.67,.62 3326 ! 3327 Dut("READ OPTIONS",0,Opts$) 3328 Is_8_band=SGN(POS(Opts$,"MBD")) 3329 SELECT Model$ 3330 CASE "8560E" 3331 RESTORE Data_60 3332 CASE "8561E" 3333 RESTORE Data_61 3334 CASE "8562E" 3335 RESTORE Data_62e 3336 CASE "8563E" 3337 RESTORE Data_63e 3338 CASE "8564E" 3339 RESTORE Data_64e 3340 IF Is_8_band THEN RESTORE Data_64e_8 3341 CASE "8565E" 3342 RESTORE Data_65e 3343 IF Is_8_band THEN RESTORE Data_65e_8 3344 END SELECT 3345 ! 3346 READ Slope_adj_size,Slope_adjusts 3347 ALLOCATE Slope_adj_bands(1:Slope_adj_size,1:2) 3348 ALLOCATE Slope_adj_freqs(1:Slope_adj_size,1:2) 3349 READ Slope_adj_bands(*),Slope_adj_freqs(*),Band_lim_size,Num_ofs 3350 ! 3351 ALLOCATE Ofs(1:Num_ofs) 3352 FOR I=1 TO Num_ofs 3353 READ Ofs(I) 3354 NEXT I 3355 MAT Ofs=Ofs*(Dac_per_10db/10) 3356 ! 3357 IF Model$<>"8564E" AND Model$<>"8565E" THEN 3358! 3359! Read in Break_points(*) from firmware. 3360! 3361 CALL Show_message("... READING BREAK TABLE ...",15) 3362 ALLOCATE Break_points(1:20,1:4) ! (Index, Band:Start:Stop:Increment) 3363 Break_addr=FNRead_value("05FB78",4) ! Address of an address 3364 Break_addr=FNRead_value(DVAL$(Break_addr,16),4)!Actual address of table 3365 Index=0 3366 REPEAT 3367 Index=Index+1 3368 FOR Index2=1 TO 4 3369 Break_points(Index,Index2)=FNRead_value(DVAL$(Break_addr+2*Index2-2,16),2) 3370 NEXT Index2 3371 Break_addr=Break_addr+8 3372 UNTIL Break_points(Index,1)>10 ! Should equal 0-4 or 65535 3373 Max_band=Break_points(Index-1,1) 3374! 3375! Generate Num_cal_points(*) from Break_points(*) 3376! 3377 ALLOCATE Num_cal_points(0:Max_band) 3378 Last_band=-1 3379 Cp_index=0 3380 Bp_index=1 3381 WHILE Break_points(Bp_index,1)<10! Should be 0-4 or 65535 (-1 = 65535 for unsigned short) 3382 Band=Break_points(Bp_index,1) 3383 IF Band<>Last_band AND Last_band<>-1 THEN 3384 Num_cal_points(Last_band)=Cp_index 3385 Cp_index=0 3386 END IF 3387 Cp_index=Cp_index+1 3388 Cal_frequency=Break_points(Bp_index,2) ! Frequency in MHz 3389 REPEAT 3390 Cp_index=Cp_index+1 3391 Cal_frequency=Cal_frequency+Break_points(Bp_index,4) 3392 UNTIL Cal_frequency=Break_points(Bp_index,3) 3393 ! 3394 Bp_index=Bp_index+1 3395 Last_band=Band 3396 END WHILE 3397 Num_cal_points(Band)=Cp_index 3398! 3399! Generate Cal_freq(Band,Index) from Break_points(*) 3400! 3401 ALLOCATE Cal_freq(0:Max_band,1:MAX(Num_cal_points(*))) 3402 ALLOCATE Pmcal(0:Max_band,1:MAX(Num_cal_points(*))) 3403 Last_band=-1 3404 Cp_index=0 3405 Bp_index=1 3406 WHILE Break_points(Bp_index,1)<10! Should be 0-4 or 65535 (-1 = 65535 for unsigned short) 3407 Band=Break_points(Bp_index,1) 3408 IF Band<>Last_band AND Last_band<>-1 THEN 3409 Cp_index=0 3410 END IF 3411 Cp_index=Cp_index+1 3412 Cal_frequency=Break_points(Bp_index,2) ! Frequency in MHz 3413 Cal_freq(Band,Cp_index)=Cal_frequency*1.E+6 3414 REPEAT 3415 Cp_index=Cp_index+1 3416 Cal_frequency=Cal_frequency+Break_points(Bp_index,4) 3417 Cal_freq(Band,Cp_index)=Cal_frequency*1.E+6 3418 UNTIL Cal_frequency=Break_points(Bp_index,3) 3419 ! 3420 Max_freq=Cal_freq(Band,Cp_index) 3421 Bp_index=Bp_index+1 3422 Last_band=Band 3423 END WHILE 3424 ! 3425 Eepoint=0 3426 Ee_width=Ee_data(1) 3427 FOR Band=0 TO Max_band 3428 FOR Index=1 TO Num_cal_points(Band) 3429 IF FNRom_date("ORCA") THEN 3430 Ee_data((Eepoint+1)*Ee_width-3+2)=8 ! Mid-range for 12 bit dacs 3431 Ee_data((Eepoint+1)*Ee_width-2+2)=2 3432 Ee_data((Eepoint+1)*Ee_width-1+2)=128 3433 ELSE 3434 Ee_data((Eepoint+1)*Ee_width-4+2)=8 ! Mid-range for 12 bit dacs 3435 Ee_data((Eepoint+1)*Ee_width-3+2)=2 3436 Ee_data((Eepoint+1)*Ee_width-2+2)=0 3437 Ee_data((Eepoint+1)*Ee_width-1+2)=128 3438 END IF 3439 Eepoint=Eepoint+1 3440 NEXT Index 3441 NEXT Band 3442 Ee_data(0)=Eepoint 3443 Dut("RE-STORE EE BREAK TABLE,ADJUST ALL") 3444 END IF 3445 ! 3446 RETURN 3447! 3448!--------------------------------------------------------------------- 3449 Ytf_slope_off: ! 3450 CALL Show_message("... SETTING SLOPE AND OFFSET DACS ...",15) 3451 Dut("INITIALIZE,EXTERNAL REFERENCE,REF LEVEL=10,SPAN=0,SCALE=10,RBW=300E3,VBW=1000,SWEEP TIME=.05,SINGLE SWEEP") 3452 Setup_8340("PRESET,POWER=-4 dBm",@Syn_8340,Error$) 3453 FOR Adj=1 TO Slope_adjusts 3454 Offset=Ytf_mid_dac 3455 IF Adj=1 THEN Slope=160 ! typical start slope for rythm 3456 IF Adj=4 THEN Slope=90 ! typical start slope for sbtx 3457 IF Adj=3 AND Is_8_band THEN Slope=180 ! start slope for last rythm 3458 IF Adj=4 AND Is_8_band THEN Slope=90 ! typical start slope for sbtx 3459 IF Adj=5 AND Is_8_band THEN Slope=50 ! start slope for sbtx band 6/7 3460 Adj_slope_off2(Slope_adj_bands(Adj,1),Slope_adj_freqs(Adj,1),Slope_adj_bands(Adj,2),Slope_adj_freqs(Adj,2),Slope,Offset,Fr_end_cl_data(*),Ytf_mid_dac) 3461 IF Slope<0 OR Slope>255 THEN ! Can't Adjust slope and offset 3462 CALL Prompt_keys("CONT",Key_pressed$,"Can't Adjust slope and offset for BAND "&VAL$(Slope_adj_bands(Adj,1))&", test aborted.") 3463 GOTO Test_aborted 3464 END IF 3465 NEXT Adj 3466 RETURN 3467! 3468!--------------------------------------------------------------------- 3469 Set_orca_dacs: ! 3470 CALL Show_message("... SETTING YTF DACS ...",15) 3471 Startovers=0 !initialize the times tried to zero, exit after 5 attempts 3472 Breakpoint=0 3473 Source_amp=-2 3474 Setup_8340("PRESET,POWER="&VAL$(Source_amp)&"dBm",@Syn_8340,Error$) 3475 ! 3476 Dut("REF LEVEL=0,SCALE=5") 3477 Dut("SINGLE SWEEP,MARKER ON") 3478 FOR Band=0 TO Max_band 3479 Ytf_dac=Ytf_mid_dac 3480 ! 3481 Dut("HARMONIC NUMBER,TRIGGER SWEEP",Band) 3482 ALLOCATE Trc(1:Num_cal_points(Band)) 3483 FOR Cal_point=1 TO Num_cal_points(Band) 3484 IF Band>0 THEN 3485 Frequency=MIN(5.15E+10,Cal_freq(Band,Cal_point)) 3486 Setup_8340("FREQ="&VAL$(Frequency)&"Hz",@Syn_8340,Error$) 3487 Dut("CENTER FREQUENCY,TRIGGER SWEEP",Frequency) 3488 Dut("WRITE RF CORE GAIN DAC",Gain_mid_dac) 3489!////////////////////////////////////////////////////////////////////// 3490 IF FNRom_date("PP OFFSET") THEN 3491 IF Band=5 AND Cal_point=1 THEN !!!! multiples FIX !!!! 3492 Pp_offset=0 3493 GOSUB Store_pp_ofs 3494 END IF 3495 END IF 3496!////////////////////////////////////////////////////////////////////// 3497 Dut("TRIGGER SWEEP,PRESELECTOR PEAK,READ PRESELECTOR DAC",Ytf_dac) 3498 IF Cal_point=1 THEN 3499 Dut("TRIGGER SWEEP,PRESELECTOR PEAK,READ PRESELECTOR DAC",Ytf_dac) 3500 END IF 3501!////////////////////////////////////////////////////////////////////// 3502 IF Band=5 AND Cal_point=1 THEN !!!! multiples FIX !!!! 3503 Pp_inc=32 3504 New_pp_dac=Ytf_dac 3505 Mult_freq=(Frequency+1.E+8+3.9107E+9)/8 3506 Mult_freq=(Mult_freq*15-3.9107E+9)/2 3507 Setup_8340("POWER=6dBm",@Syn_8340,Error$) 3508 Dut("SAVE STATE=1") 3509 Dut("AUTO SWEEP TIME,SCALE=10,RBW=300,VBW=300,SPAN=2000,REF LEVEL=0") 3510 Setup_8340("FREQ="&VAL$(Frequency+1.E+8)&"Hz",@Syn_8340,Error$) 3511 Dut("CENTER FREQUENCY,TRIGGER SWEEP",Frequency+1.E+8) 3512 Dut("TRIGGER SWEEP,READ MARKER AMPLITUDE",Ref_amp) 3513 Setup_8340("FREQ="&VAL$(Mult_freq)&"Hz",@Syn_8340,Error$) 3514 Dut("REF LEVEL=-60") 3515 Dut("TRIGGER SWEEP,TRIGGER SWEEP,TRIGGER SWEEP,READ MARKER AMPLITUDE",Mult_amp) 3516 IF Ref_amp-Mult_amp>70 THEN GOTO Pp_offset_done 3517 LOOP 3518 EXIT IF ABS(Ref_amp-Mult_amp-72)<2 OR New_pp_dac=0 3519 IF Ref_amp-Mult_amp>=74 THEN 3520 Pp_inc=INT(Pp_inc/2) 3521 Pp_offset=Pp_offset-Pp_inc 3522 ELSE 3523 Pp_offset=Pp_offset+Pp_inc 3524 END IF 3525 Pp_offset=MIN(Pp_offset,Ytf_dac) 3526 New_pp_dac=Ytf_dac-Pp_offset 3527 OUTPUT 718;"PSDAC"&VAL$(New_pp_dac)&";" 3528 DISP "PP OFFSET = "&VAL$(Pp_offset) 3529 Dut("TRIGGER SWEEP,TRIGGER SWEEP,TRIGGER SWEEP,READ MARKER AMPLITUDE",Mult_amp) 3530 END LOOP 3531 IF New_pp_dac=0 AND ABS(Ref_amp-Mult_amp-72)>=2 THEN 3532 DISP "YTF DAC = 0 and CAN'T GET MULT BELOW 84dBc !!!" 3533 PAUSE 3534 PAUSE 3535 END IF 3536 Pp_offset_done: ! 3537!!!! ALERT !!!! THIS IS A FUDGE FACTOR !!!! 3538 Pp_offset=Pp_offset+MIN(Ytf_dac-Pp_offset,9)+1 3539 OUTPUT 701;"***************" 3540 OUTPUT 701;"PP OFFSET = "&VAL$(Pp_offset) 3541 OUTPUT 701;"***************" 3542 GOSUB Store_pp_ofs 3543 Setup_8340("POWER="&VAL$(Source_amp)&"dBm",@Syn_8340,Error$) 3544 Setup_8340("FREQ="&VAL$(Frequency)&"Hz",@Syn_8340,Error$) 3545 Dut("RECALL STATE=1") 3546 Dut("TRIGGER SWEEP,PRESELECTOR PEAK,READ PRESELECTOR DAC",Ytf_dac) 3547 END IF 3548!////////////////////////////////////////////////////////////////////// 3549! 3550 Read_438(Frequency/1.E+6,"CH B CORRECTED POWER","dBm",@Pwr_mtr,Pmcal(Band,Cal_point),Error_message$) 3551 END IF ! if band = 0 3552 Trc(Cal_point)=Ytf_dac 3553 NEXT Cal_point 3554 ! 3555 IF Band>0 THEN 3556 IF Band=5 THEN First_point=Trc(1) 3557 Filter_trace(Trc(*)) !!!!!!!!!!!!! APPLY FILTER TO YTF DATA 3558 IF Band=5 THEN Trc(1)=First_point 3559 END IF 3560 ! 3561 FOR I=1 TO Num_cal_points(Band) 3562 Breakpoint=Breakpoint+1 3563 Ee_data(Breakpoint*Ee_width-1+2)=Trc(I) 3564 NEXT I 3565 DEALLOCATE Trc(*) 3566 NEXT Band 3567 Dut("RE-STORE EE BREAK TABLE,ADJUST ALL") 3568 ! 3569 Source_amp=-2 3570 FOR Band=0 TO Max_band 3571 Core_dac=Mid_gain_dac 3572 Breakpoint=0 3573 FOR I=0 TO Band-1 3574 Breakpoint=Breakpoint+Num_cal_points(I) 3575 NEXT I 3576 Setup_8340("PRESET,POWER="&VAL$(Source_amp)&"dBm",@Syn_8340,Error$) 3577 OUTPUT 718;"ip;fref ext;sngls;rl 0;lg 5;sp 10mhz;sp 0;rb 1mhz;st 50ms;" 3578 OUTPUT 718;"hnlock ";Band;";" 3579 OUTPUT 718;"mkt 40ms;" 3580 FOR Cal_point=1 TO Num_cal_points(Band) 3581 Breakpoint=Breakpoint+1 3582 Frequency=MIN(5.15E+10,Cal_freq(Band,Cal_point)) 3583 IF Frequency>=1.0E+7 THEN 3584 Setup_8340("FREQ="&VAL$(Frequency)&"Hz",@Syn_8340,Error$) 3585 Dut("CENTER FREQUENCY",Frequency) ! TRIGGER SWEEP 3586 IF Band=0 THEN 3587 Read_438(Frequency/1.E+6,"CH B CORRECTED POWER","dBm",@Pwr_mtr,Pmcal(Band,Cal_point),Error_message$) 3588 END IF 3589 ! 3590 LOOP 3591 Dut("WRITE RF CORE GAIN DAC="&VAL$(Core_dac)&",UPDATE RF CORE DAC") 3592 OUTPUT 718;"ts;mka?;" 3593 ENTER 718;Ampl 3594 Error=Ampl-Pmcal(Band,Cal_point) 3595 EXIT IF ABS(Error)<.5 3596 Core_dac=Core_dac+INT((Pmcal(Band,Cal_point)-Ampl)*Dac_per_10db/10+.5) 3597 END LOOP 3598 ! 3599 Ee_width=Ee_data(1) 3600 Dac_value=MAX(0,Core_dac) 3601 Ee_data(Breakpoint*Ee_width-Ee_width+2)=INT(Dac_value/256) 3602 Ee_data(Breakpoint*Ee_width-(Ee_width-1)+2)=Dac_value MOD 256 3603 END IF 3604 NEXT Cal_point 3605 ! 3606 IF Band=2 OR Band=3 THEN 3607 Dut("HARMONIC NUMBER",3) 3608 Dut("CENTER FREQUENCY,TRIGGER SWEEP",1.8E+10) 3609 FOR Wait=120 TO 1 STEP -1 3610 DISP "Waiting "&VAL$(Wait)&" seconds ..." 3611 WAIT 1 3612 NEXT Wait 3613 DISP " " 3614 Dut("HARMONIC NUMBER",Band) 3615 END IF 3616 ! 3617 Reflvl=-999 3618 FOR I=1 TO Num_cal_points(Band) 3619 Reflvl=MAX(Pmcal(Band,I),Reflvl) 3620 NEXT I 3621 Reflvl=Reflvl+10 3622 Dbper=2 3623 OUTPUT 718;"rl ";Reflvl;";lg ";Dbper;";rb 300khz;" 3624 ! 3625 Breakpoint=0 3626 FOR I=0 TO Band-1 3627 Breakpoint=Breakpoint+Num_cal_points(I) 3628 NEXT I 3629 FOR Cal_point=1 TO Num_cal_points(Band) 3630 Breakpoint=Breakpoint+1 3631 Frequency=MIN(5.15E+10,Cal_freq(Band,Cal_point)) 3632 IF Frequency>=1.0E+7 THEN 3633 Setup_8340("FREQ="&VAL$(Frequency)&"Hz",@Syn_8340,Error$) 3634 Dut("CENTER FREQUENCY",Frequency) ! TRIGGER SWEEP 3635 Core_dac=Ee_data(Breakpoint*Ee_width-Ee_width+2)*256 3636 Core_dac=Core_dac+Ee_data(Breakpoint*Ee_width-(Ee_width-1)+2) 3637 Dut("WRITE RF CORE GAIN DAC="&VAL$(Core_dac)&",UPDATE RF CORE DAC") 3638 OUTPUT 718;"ts;mka?;" 3639 ENTER 718;Ampl 3640 Delta=INT((Pmcal(Band,Cal_point)-Ampl)*Dac_per_10db/10+.5) 3641 IF ABS(Delta)<500 THEN Core_dac=Core_dac+Delta 3642 ! 3643 Ee_width=Ee_data(1) 3644 Dac_value=MAX(0,Core_dac) 3645 Ee_data(Breakpoint*Ee_width-Ee_width+2)=INT(Dac_value/256) 3646 Ee_data(Breakpoint*Ee_width-(Ee_width-1)+2)=Dac_value MOD 256 3647 END IF 3648 ! 3649 IF Frequency=1.0E+7 THEN 3650 FOR Brkpnt=1 TO Breakpoint-1 3651 Dac_val_ofs=MAX(0,Dac_value-Ofs(Brkpnt)) 3652 Ee_data(Brkpnt*Ee_width-Ee_width+2)=INT(Dac_val_ofs/256) 3653 Ee_data(Brkpnt*Ee_width-(Ee_width-1)+2)=Dac_val_ofs MOD 256 3654 Ee_data(Brkpnt*Ee_width-1+2)=Ytf_mid_dac 3655 NEXT Brkpnt 3656 END IF 3657 NEXT Cal_point 3658 ! 3659 NEXT Band 3660 RETURN 3661! 3662!--------------------------------------------------------------------- 3663 Set_ytfgain_dac: ! ytf gain dac loop - sets the YTF & Core dac values 3664 CALL Show_message("... SETTING YTF AND GAIN DACS ...",15) 3665 Startovers=0 !initialize the times tried to zero, exit after 5 attempts 3666 Breakpoint=0 3667 Source_amp=-3 3668 Power_window=1 3669 Setup_8340("PRESET,POWER="&VAL$(Source_amp)&"dBm",@Syn_8340,Error$) 3670 ! 3671 IF Model$="8564E" OR Model$="8565E" THEN 3672 Nom_amp=-15 3673 Dut("REF LEVEL=-10,SCALE=2") 3674 ELSE 3675 Nom_amp=-10 3676 Dut("REF LEVEL=-5,SCALE=1") 3677 END IF 3678 ! 3679 IF Printbrktab THEN 3680 OUTPUT 701;DATE$(TIMEDATE),TIME$(TIMEDATE) 3681 OUTPUT 701;"EEROM BREAK TABLE DATA" 3682 OUTPUT 701;"This data has not yet been written to EEROM." 3683 OUTPUT 701;" " 3684 OUTPUT 701 USING "16A,16A,16A,16A,15A";"BAND","FREQ(MHz)","GAIN DAC","YTF DAC","INDEX" 3685 OUTPUT 701;"===============================================================================" 3686 END IF 3687 ! 3688 Dut("SINGLE SWEEP,MARKER ON") 3689 Bnd2_1st_time=1 3690 Bnd3_1st_time=1 3691 FOR Band=0 TO Max_band 3692 Core_dac=Gain_mid_dac 3693 Ytf_dac=Ytf_mid_dac 3694 ! 3695 Band_restart: ! 3696 IF FNRom_date("NO TAM") OR Band=3 THEN 3697 IF Band=2 AND Bnd2_1st_time THEN GOTO Done_pausing 3698 IF Band=3 AND Bnd3_1st_time AND FNRom_date("NO TAM") THEN GOTO Done_pausing 3699 Dut("HARMONIC NUMBER,TRIGGER SWEEP",3) 3700 IF Band3pause AND (Band=2 OR Band=3) THEN 3701 Dut("CENTER FREQUENCY,TRIGGER SWEEP",Cal_freq(3,Num_cal_points(3))) 3702 FOR Wait=90 TO 1 STEP -1 3703 DISP "Waiting "&VAL$(Wait)&" seconds ..." 3704 WAIT 1 3705 NEXT Wait 3706 DISP " " 3707 END IF 3708 END IF 3709 ! 3710 Done_pausing: ! 3711 Dut("HARMONIC NUMBER,TRIGGER SWEEP",Band) 3712 FOR Cal_point=1 TO Num_cal_points(Band) 3713 IF FNRom_date("NO TAM") THEN 3714 IF Band=3 AND Bnd2_1st_time THEN 3715 Band=2 3716 Bnd2_1st_time=0 3717 Breakpoint=Num_cal_points(0)+Num_cal_points(1) 3718 GOTO Band_restart 3719 END IF 3720 IF Band=4 AND Bnd3_1st_time THEN 3721 Band=3 3722 Bnd3_1st_time=0 3723 Breakpoint=Num_cal_points(0)+Num_cal_points(1)+Num_cal_points(2) 3724 GOTO Band_restart 3725 END IF 3726 IF Band=3 AND NOT Bnd3_1st_time AND Cal_freq(Band,Cal_point)=2.1E+10 THEN 3727 Dut("HARMONIC NUMBER,TRIGGER SWEEP",0) 3728 Dut("CENTER FREQUENCY,TRIGGER SWEEP",Cal_freq(0,1)) 3729 FOR Wait=90 TO 1 STEP -1 3730 DISP "Waiting "&VAL$(Wait)&" seconds ..." 3731 WAIT 1 3732 NEXT Wait 3733 DISP " " 3734 Dut("HARMONIC NUMBER,TRIGGER SWEEP",Band) 3735 END IF 3736 END IF 3737 Breakpoint=Breakpoint+1 3738 IF Model$="8564E" OR Model$="8565E" THEN 3739 Frequency=MIN(5.15E+10,Cal_freq(Band,Cal_point)) 3740 ELSE 3741 Frequency=MIN(2.65E+10,Cal_freq(Band,Cal_point)) 3742 END IF 3743 ! 3744 IF Frequency>=1.0E+7 THEN !Stores ytf data in eerom for B0 3745 IF Frequency>Max_freq THEN GOTO End_of_test 3746 Setup_8340("FREQ="&VAL$(Frequency)&"Hz",@Syn_8340,Error$) 3747 Dut("CENTER FREQUENCY,TRIGGER SWEEP",Frequency) 3748 Ytf_dac=0 3749 IF FNRom_date("NO TAM") THEN 3750 IF Band=2 AND NOT Bnd2_1st_time THEN GOTO Done_peaking 3751 IF Band=3 AND NOT Bnd3_1st_time THEN GOTO Done_peaking 3752 END IF 3753 Dut("WRITE RF CORE GAIN DAC",Core_dac) 3754 IF Band>0 THEN 3755 Dut("PRESELECTOR PEAK,READ PRESELECTOR DAC",Ytf_dac) 3756 IF Cal_point=1 THEN 3757 Dut("TRIGGER SWEEP,PRESELECTOR PEAK,READ PRESELECTOR DAC",Ytf_dac) 3758 END IF 3759 END IF 3760 Done_peaking: ! 3761 ! 3762 Read_438(Frequency/1.E+6,"CH B CORRECTED POWER","dBm",@Pwr_mtr,Input_power,Error_message$) 3763 WHILE ABS(Nom_amp-Input_power)>Power_window 3764 Source_amp=PROUND(Source_amp+Nom_amp-Input_power,-2) 3765 Setup_8340("POWER="&VAL$(Source_amp)&"dBm",@Syn_8340,Error$) 3766 Read_438(Frequency/1.E+6,"CH B CORRECTED POWER","dBm",@Pwr_mtr,Input_power,Error_message$) 3767 END WHILE 3768 ! 3769 Target=0 3770 DISP "Setting flatness for cal point # ";Cal_point;" in band ";Band;" to ";PROUND(Target,-2);"dB" 3771 IF FNRom_date("NO TAM") AND (Band=2 AND NOT Bnd2_1st_time OR Band=3 AND NOT Bnd3_1st_time) THEN 3772 Dut("READ RF CORE GAIN DAC",Old_dac) 3773 Core_dac=Old_dac 3774 END IF 3775 LOOP 3776 Dut("WRITE RF CORE GAIN DAC="&VAL$(Core_dac)&",UPDATE RF CORE DAC,READ MARKER AMPLITUDE",Marker_amp) 3777 EXIT IF ABS(Input_power-Marker_amp+Target)<.050 3778 Core_dac=Core_dac+INT(.5+(Input_power-Marker_amp+Target)*Dac_per_10db/10) 3779 IF Core_dac<0 OR Core_dac>Gain_mid_dac*2-1 THEN 3780 DISP "Core_dac is out of range!" 3781 PAUSE 3782 END IF 3783 END LOOP 3784 IF FNRom_date("NO TAM") AND (Band=2 AND NOT Bnd2_1st_time OR Band=3 AND NOT Bnd3_1st_time) THEN 3785 Core_dac=INT((Core_dac+Old_dac)/2) 3786 END IF 3787 ! 3788 IF Cal_point=1 AND Band=0 THEN 3789 First_pt=Core_dac 3790 END IF 3791 IF Cal_point=2 AND Band=0 THEN 3792 Startovers=Startovers+1 3793 IF Startovers>10 THEN 3794 PRINT "1st-2nd Core_dac value is too large ... (10MHz vs 27MHz pts)" 3795 PRINT "Get the ENGINEER to find out why. note:program paused" 3796 PAUSE 3797 GOTO Set_gain_dac !ALLOW THE PROG TO RETRY - IF CONTINUE IS PRESSED 3798 END IF 3799 Second_pt=Core_dac 3800 Delta_val=(First_pt-Second_pt) !the difference 3801 IF (Model$="8562E" OR Model$="8563E") AND (Delta_val<20 OR Delta_val>140) THEN GOTO Set_ytfgain_dac 3802 IF (Model$="8561E" OR Model$="8560E") AND (Delta_val<-70 OR Delta_val>90) THEN GOTO Set_ytfgain_dac 3803 END IF 3804 ! 3805 Ee_width=Ee_data(1) 3806 IF Band>=0 THEN !Includes B0 for writing ytf values. 3807 IF FNRom_date("ORCA") THEN 3808 IF FNRom_date("NO TAM") THEN 3809 IF Band<>2 AND Band<>3 OR Band=2 AND Bnd2_1st_time OR Band=3 AND Bnd3_1st_time THEN 3810 Ee_data(Breakpoint*Ee_width-1+2)=Ytf_dac 3811 END IF 3812 ELSE 3813 Ee_data(Breakpoint*Ee_width-1+2)=Ytf_dac 3814 END IF 3815 ELSE 3816 Ee_data(Breakpoint*Ee_width-2+2)=INT(Ytf_dac/256) 3817 Ee_data(Breakpoint*Ee_width-1+2)=Ytf_dac MOD 256 3818 END IF 3819 END IF 3820 Dac_value=MAX(0,Core_dac-(Adjust_table*64)) ! Adjust_table calc 3821 IF NOT FNRom_date("NO TAM") OR Band<>2 AND Band<>3 OR Band=2 AND NOT Bnd2_1st_time OR Band=3 AND NOT Bnd3_1st_time THEN 3822 Ee_data(Breakpoint*Ee_width-Ee_width+2)=INT(Dac_value/256) 3823 Ee_data(Breakpoint*Ee_width-(Ee_width-1)+2)=Dac_value MOD 256 3824 END IF 3825 IF Frequency=1.0E+7 THEN 3826 FOR Brkpnt=1 TO Breakpoint-1 3827 Dac_val_ofs=MAX(0,Dac_value-Ofs(Brkpnt)) 3828 Ee_data(Brkpnt*Ee_width-Ee_width+2)=INT(Dac_val_ofs/256) 3829 Ee_data(Brkpnt*Ee_width-(Ee_width-1)+2)=Dac_val_ofs MOD 256 3830 Ee_data(Brkpnt*Ee_width-1+2)=Ytf_mid_dac 3831 IF Printbrktab THEN 3832 OUTPUT 701 USING "3D,13X,5D.2D,8X,6D,10X,5D,15D";Band,Cal_freq(Band,Brkpnt)/1.E+6,Dac_val_ofs,Ytf_dac,Brkpnt 3833 END IF 3834 NEXT Brkpnt 3835 END IF 3836 IF Printbrktab THEN 3837 OUTPUT 701 USING "3D,13X,5D.2D,8X,6D,10X,5D,15D";Band,Frequency/1.E+6,Dac_value,Ytf_dac,Breakpoint 3838 END IF 3839 END IF 3840 ! 3841 NEXT Cal_point 3842 NEXT Band 3843 ! 3844 End_of_test: ! 3845 RETURN 3846! 3847!--------------------------------------------------------------------- 3848 Chck_dacper_con: ! 3849 CALL Blank_lines(10) 3850 PRINT TABXY(13,15);"Connect the SOURCE to the splitter INPUT." 3851 IF Model$="8564E" OR Model$="8565E" THEN 3852 PRINT TABXY(1,16);"Connect splitter outputs to the channel B power sensor, "&Rp_num$&", and the DUT." 3853 ELSE 3854 PRINT TABXY(1,16);"Connect splitter outputs to the channel B power sensor, "&Rp_num$&", and the DUT." 3855 END IF 3856 CALL Pauseprogram 3857 CALL Blank_lines(15,16) 3858 ! 3859 LOOP !check connections 3860 CALL Show_message("... CHECKING CONNECTIONS ...",15) 3861 Setup_8340("PRESET,FREQUENCY=300MHz,POWER=-5dBm",@Syn_8340,Error_message$) 3862 Dut("IP,CENTER FREQ=300E6,SPAN=20E6,SINGLE SWEEP,RBW=300E3") 3863 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 3864 Read_438(300,"CH B INSTANT READ POWER","dBm",@Pwr_mtr,Meas_amp,Error_message$) 3865 EXIT IF Meas_amp>=-15 AND Marker_amp>=-18 3866 IF Meas_amp<-15 THEN 3867 Message$="438 POWER METER READS LOW POWER -- CONNECT POWER SENSOR, "&Rp_num$&", TO SPLITTER OUTPUT, AND THEN CONNECT SOURCE AND SPECTRUM" 3868 Message$=Message$&" ANALYZER TO THE SPLITTER" 3869 CALL Message(Message$) 3870 CALL Blank_lines(4) 3871 END IF 3872 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 3873 IF Marker_amp<-18 THEN 3874 Message$="ANALYZER MARKER AMPLITUDE READS LESS THEN -18 dBm -- CONNECT THE SPLITTER TO SPECTRUM ANALYZER, AND THEN CONNECT POWER METER AND" 3875 Message$=Message$&" SOURCE TO THE SPLITTER" 3876 CALL Message(Message$) 3877 CALL Blank_lines(4) 3878 END IF 3879 END LOOP 3880 RETURN !CHCK_DACPER_CON 3881! 3882!--------------------------------------------------------------------- 3883 Meas_dacper10db: ! 3884 CALL Show_message("... MEASURING DAC PER 10dB ...",15) 3885 Set_source_8340(-4,-10,.1,300,Power_reading,Loop_counter) 3886 !***///+++ THIS IS AN EVALUATION FOR FTHES. 3887 Old_dacper10db=-100 3888 Diff_limit=1 3889 Diff_data_lim=5 3890 Num_trys=0 3891 LOOP 3892 Dut("3RD IF AMP CAL",Dacper10db) 3893 IF Num_trys=0 THEN Fst_dacper10db=Dacper10db 3894 EXIT IF ABS(Old_dacper10db-Dacper10db)Rd_dacper10db THEN 3903 Test_flag1=Failed 3904 END IF 3905 Scnd_if_data(2)=Dacper10db 3906 RETURN !Meas_dacper10db 3907! 3908!----------------------------------------------------------------------- 3909 Output_results: ! 3910 Test_date=TIMEDATE 3911 DISP "STORING DATA..." 3912 CALL Store_data(Dir_name$,Select_opt$,Fr_end_cl_data(*)) 3913 ! 3914 LOOP 3915 SELECT Jan_mode$ 3916 CASE "SINGLE" 3917 CALL Fr_end_cl_f_dp("SLOPE AND OFFSET DACS",Fr_end_cl_data(*),Fr_end_cl_min(*),Fr_end_cl_max(*),Sn$,Test_date,"DUMP OFF","VIEW TIME ON",Test_result,Model$) 3918 CALL Prompt_keys("CONTINUE,,RE-TEST,DUMP TO SRM,DUMP TO LOCAL",Key_pressed$," press CONTINUE to Return to Menu.") 3919 CASE "SEQUENCED" 3920 CALL Fr_end_cl_f_dp("SLOPE AND OFFSET DACS",Fr_end_cl_data(*),Fr_end_cl_min(*),Fr_end_cl_max(*),Sn$,Test_date,"DUMP OFF","VIEW TIME ON",Test_result,Model$) 3921 IF Test_result=1 THEN 3922 CALL Prompt_keys("DEFAULT=CONTINUE,,RE-TEST,DUMP TO SRM,DUMP TO LOCAL",Key_pressed$," ",2) 3923 ELSE 3924 CALL Prompt_keys("DEFAULT=CONTINUE,,RE-TEST,DUMP TO SRM,DUMP TO LOCAL",Key_pressed$," ",10) 3925 END IF 3926 CASE ELSE 3927 Key_pressed$="CONTINUE" 3928 END SELECT 3929 ! 3930 SELECT Key_pressed$ 3931 CASE "CONTINUE" 3932 GOTO Test_completed 3933 CASE "CONTROL MENU" 3934 ! 3935 CASE "RE-TEST" 3936 CALL Clr_scr 3937 CALL Show_message(Title$,2) 3938 GOTO Re_test_loop 3939 CASE "DUMP TO SRM" 3940 CALL Fr_end_cl_f_dp("SLOPE AND OFFSET DACS",Fr_end_cl_data(*),Fr_end_cl_min(*),Fr_end_cl_max(*),Sn$,Test_date,"DUMP SRM","VIEW TIME ON",Test_result,Model$) 3941 CASE "DUMP TO LOCAL" 3942 CALL Fr_end_cl_f_dp("SLOPE AND OFFSET DACS",Fr_end_cl_data(*),Fr_end_cl_min(*),Fr_end_cl_max(*),Sn$,Test_date,"DUMP ON","VIEW TIME ON",Test_result,Model$) 3943 END SELECT 3944 ! 3945 END LOOP 3946! 3947!------------------------------------------------------------------------ 3948 Test_completed: ! 3949 CALL Clr_scr 3950 GCLEAR 3951 OFF KEY 3952 OFF SIGNAL 3953 RETURN 3954! 3955!------------------------------------------------------------------- 3956 Blank_keys: ! 3957 FOR G=0 TO 8 3958 ON KEY G LABEL " " GOSUB Do_nuthin 3959 NEXT G 3960 RETURN 3961! 3962!------------------------------------------------------------------------! 3963 Do_nuthin: ! 3964 RETURN 3965! 3966!------------------------------------------------------------------------! 3967 Dut_error: ! 3968 CALL Prompt_keys("RE-TEST",Key_pressed$,"Dut error: TIMEOUT caused by the spectum analyzer") 3969 GOTO Re_test_loop 3970! 3971!-----------------------------------------------------------------------! 3972 Driver_error: ! 3973 CALL Tone("ALERT") 3974 IF Error_message$<>"OK" THEN 3975 CALL Prompt_keys("RE-TEST",Key_pressed$,"Driver error: "&Error_message$&", Fix system") 3976 CALL Blank_lines(3) 3977 GOTO Re_test_loop 3978 END IF 3979! 3980!-------------------------------------------------------------------------- 3981 Test_aborted: ! 3982 CALL Clr_scr 3983 OFF SIGNAL 3984 OFF KEY 3985 Test_result=0 3986 SUBEND ! 3987! 3988!************************************************************************** 3989! 3990 SUB Fr_end_cl_f_sp(Which_one$,Test_mode$,Select_opt$,Fr_end_cl_min(*),Fr_end_cl_max(*)) 3991 Fr_end_cl_f_sp: REM $Header: fr_end_cl_f,v 2.15 96/01/23 13:10:14 hmgr Exp $ 3992! 3993 SELECT Which_one$ 3994 CASE "SLOPE AND OFFSET DACS" 3995 FOR I=1 TO 4 3996 Fr_end_cl_min(1,I)=1 !MIN DAC VALUE 3997 Fr_end_cl_min(2,I)=1 3998 Fr_end_cl_max(1,I)=254 !MAX DAC VALUE 3999 Fr_end_cl_max(2,I)=254 4000 NEXT I 4001 END SELECT 4002! 4003 SUBEND 4004! 4005!************************************************************************** 4006! 4007 SUB Fr_end_cl_f_st(Test_mode$,Select_opt$,Which_one$,Spec_min(*),Spec_max(*)) 4008 Fr_end_cl_f_st: REM $Header: fr_end_cl_f,v 2.15 96/01/23 13:10:14 hmgr Exp $ 4009 ! 4010 Fr_end_cl_f_sp(Which_one$,Test_mode$,Select_opt$,Spec_min(*),Spec_max(*)) 4011 ! 4012 SUBEND 4013! 4014!************************************************************************** 4015! 4016 SUB Fr_end_cl_f_pt(Test_mode$,Select_opt$,Which_one$,Type$,Title$,Row_lbl$,Col_lbl$,Plane_lbl$,Row(*),Col(*),Planes(*)) 4017 Fr_end_cl_f_pt: REM $Header: fr_end_cl_f,v 2.15 96/01/23 13:10:14 hmgr Exp $ 4018 Title$="FRONT END CALIBRATION" 4019 ! 4020 SELECT Which_one$ 4021 ! 4022 CASE "SLOPE AND OFFSET DACS" 4023 Col_lbl$="BAND" 4024 Row_lbl$="YTF SLOPE DAC VALUES & YTF OFFSET DAC VALUES" 4025 Plane_lbl$="" 4026 ! 4027 FOR Band=1 TO 4 4028 Col(Band)=Band 4029 NEXT Band 4030 ! 4031 MAT Row=(0) 4032 MAT Planes=(0) 4033 ! 4034 END SELECT 4035 ! 4036 Type$="REAL,OUTPUT=USER DEFINED,END OUTPUT" 4037 ! 4038 SUBEND !fr_end_cl_f_pt 4039! 4040!************************************************************************** 4041! 4042 SUB Fr_end_cl_f_dp(Which_one$,Cl_data(*),Cl_min(*),Cl_max(*),Serial_num$,Test_date,Dump$,View_time$,OPTIONAL INTEGER Test_result,Model$) 4043 Fr_end_cl_f_dp: REM $Header: fr_end_cl_f,v 2.15 96/01/23 13:10:14 hmgr Exp $ 4044 Format1: IMAGE 20X,15A,DDD,15X,DDD 4045 ! 4046 DIM Msg$[160] 4047 INTEGER Failed,Passed,Abort,Num_bands 4048 ! 4049 IF Model$="8560E" THEN SUBEXIT ! No data for no YTF 4050 ! 4051 Failed=-1 4052 Passed=1 4053 Abort=0 4054 ! 4055 CALL Clr_scr 4056 ! 4057 IF UPC$(View_time$)="VIEW TIME ON" THEN 4058 PRINTER IS CRT 4059 GOSUB Display_results 4060 END IF 4061 ! 4062 SELECT UPC$(Dump$) 4063 CASE "DUMP OFF" 4064 ! 4065 CASE "DUMP ON" 4066 CALL Init_thinkjet 4067 DISP "Dumping to local printer..." 4068 PRINTER IS PRT 4069 GOSUB Display_results 4070 PRINTER IS CRT 4071 CASE "DUMP SRM" 4072 DISP "Dumping to SRM printer..." 4073 CALL Printer_is_srm("FR_END_CL_F") 4074 GOSUB Display_results 4075 PRINTER IS CRT 4076 END SELECT 4077 SUBEXIT 4078 ! 4079 Display_results: ! 4080 CALL Show_message("FRONT END CALIBRATION",1) 4081 PRINT TABXY(1,2);"Serial # : ";Serial_num$ 4082 PRINT TABXY(55,2);"Test Date: ";DATE$(Test_date) 4083 ! 4084 FOR I=1 TO 5 4085 PRINT 4086 NEXT I 4087 PRINT " YTF DAC VALUES" 4088 PRINT " SLOPE DAC OFFSET DAC" 4089 PRINT USING Format1;"BAND 1 ";Cl_data(1,1);Cl_data(2,1) 4090 IF Model$="8562E" THEN 4091 PRINT USING Format1;"BAND 2 ";Cl_data(1,2);Cl_data(2,2) 4092 END IF 4093 IF Model$="8563E" OR Model$="8564E" OR Model$="8565E" THEN 4094 PRINT USING Format1;"BAND 2 ";Cl_data(1,2);Cl_data(2,2) 4095 PRINT USING Format1;"BAND 3 ";Cl_data(1,3);Cl_data(2,3) 4096 END IF 4097 IF Model$="8564E" OR Model$="8565E" THEN 4098 PRINT USING Format1;"BAND 4 ";Cl_data(1,4);Cl_data(2,4) 4099 PRINT USING Format1;"BAND 5 ";Cl_data(1,5);Cl_data(2,5) 4100 IF SIZE(Cl_data,2)>=7 THEN 4101 PRINT USING Format1;"BAND 6 ";Cl_data(1,6);Cl_data(2,6) 4102 END IF 4103 IF SIZE(Cl_data,2)=8 THEN 4104 PRINT USING Format1;"BAND 7 ";Cl_data(1,7);Cl_data(2,7) 4105 END IF 4106 END IF 4107 PRINT 4108 ! 4109 Test_result=Passed 4110 FOR J=1 TO 2 4111 IF Cl_data(J,1)Cl_max(J,1) THEN 4112 Test_result=Failed 4113 END IF 4114 NEXT J 4115 ! 4116 IF Test_result=Passed THEN 4117 PRINT " ******* FRONT END CALIBRATION PASSED *******" 4118 ELSE 4119 PRINT " ******* FRONT END CALIBRATION FAILED *******" 4120 END IF 4121 RETURN 4122 ! 4123 SUBEND 4124 ! 4125 ! 4126! END 4127 DEF FNStat_drvr_file$ 4128 Stat_drvr_file: REM This file was built on : Sun Mar 3 00:46:57 PST 1996 4129 RETURN "STAT7_DRVRS" 4130 FNEND 4131 SUB Cal_436_coms 4132 Cal_436_coms: REM $Header: Cal_436_coms.9x,v 1.1 92/07/15 10:24:06 hmgr Exp $ 4133 COM /Power_sensors/ REAL Head_cal_data(1:2,1:6,1:600),REAL Time_checked(1:6) 4134 COM /Power_sensors/ INTEGER Sensor_address(1:6),REAL Sr_num(1:6) 4135 COM /Power_sensors/Sensor_model$(1:4)[10],Low_freq(1:4),Freq_increment(1:4) 4136 COM /Pm_filter/Filter(1:4) 4137 SUBEND 4138 SUB Sensor_index(INTEGER Hpib_address,Active_channel$,INTEGER Sensor_index,OPTIONAL INTEGER New_sensor) 4139 Sensor_index: REM $Header: Sensor_index.9x,v 1.1 92/07/15 10:28:14 hmgr Exp $ 4140 COM /Power_sensors/ REAL Head_cal_data(*),REAL Time_checked(*) 4141 COM /Power_sensors/ INTEGER Sensor_address(*),REAL Sr_num(*) 4142 COM /Power_sensors/Channel$(*),Low_freq(*),Freq_increment(*) 4143 INTEGER Pm_num 4144 REAL Pwr_snsr_cal(1:2,1:600) 4145 DIM Title$[80],Msg$[160] 4146 I=1 4147 Done=0 4148 REPEAT 4149 IF Sensor_address(I)=Hpib_address THEN 4150 Already_assgn=1 4151 Done=1 4152 IF Active_channel$="" THEN 4153 Pm_num=1+(I>2) 4154 Active_channel$=Channel$(Pm_num) 4155 END IF 4156 Sensor_index=I+(Active_channel$="B") 4157 IF NPAR=4 THEN New_sensor=0 4158 END IF 4159 I=I+2 4160 IF I>4 THEN Done=1 4161 UNTIL Done=1 4162 IF Already_assgn THEN GOTO Exit_context 4163 Loop_count=1 4164 Pm_num=0 4165 Sensor_index=0 4166 WHILE Sensor_index=0 4167 Pm_num=Pm_num+1 4168 SUBEXIT ! Symm: added by Symmetrix to bypass channel A/B selection for 436 power meter *** 4169 CALL Get_io_path("PWR MTR 438"&VAL$(Pm_num),@Pm,Status$) 4170 IF Status$="ASSIGNED" THEN 4171 STATUS @Pm,3;Mtr_address 4172 IF Mtr_address=Hpib_address THEN 4173 IF Active_channel$="" THEN 4174 Active_channel$=Channel$(Pm_num) 4175 END IF 4176 SELECT Active_channel$ 4177 CASE "A" 4178 Sensor_index=Loop_count 4179 CASE "B" 4180 Sensor_index=Loop_count+1 4181 END SELECT 4182 Sensor_address(Loop_count)=Mtr_address 4183 Sensor_address(Loop_count+1)=Mtr_address 4184 END IF 4185 END IF 4186 IF Loop_count=5 AND Sensor_index=0 THEN 4187 DISP "438 SENSOR ASSIGNMENT PROBLEM; SUFFIX NUMBER (_1,_2) NOT FOUND" 4188 CALL Tone("STOPPED") 4189 PAUSE 4190 STOP 4191 END IF 4192 Loop_count=Loop_count+2 4193 IF NPAR=4 THEN New_sensor=1 4194 END WHILE 4195 Exit_context:! 4196 SUBEND 4197 SUB Sensor_asgn_438(INTEGER Hpib_address,Active_channel$,OPTIONAL Value_n_unit$) 4198 Sensor_asgn_438: REM $Header: Sensor_asgn_438.9x,v 1.3 95/09/19 11:15:07 hmgr Exp $ 4199 COM /Power_sensors/ REAL Head_cal_data(*),REAL Time_checked(*) 4200 COM /Power_sensors/ INTEGER Sensor_address(*),REAL Sr_num(*) 4201 COM /Power_sensors/Sensor_model$(*),Low_freq(*),Freq_increment(*) 4202 INTEGER Pm_num,Sensor_index,Normalize_off 4203 REAL Pwr_snsr_cal(1:2,1:600) 4204 DIM Title$[80],Msg$[160],Cmd$[15],Division$[3] 4205 Normalize_off=0 4206 Sn_passed$="" 4207 Cmd$="" 4208 Division$="" 4209 ON ERROR GOTO No_div 4210 Division$=FNDivision$ 4211 No_div: OFF ERROR 4212 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index) 4213 IF NPAR>2 THEN 4214 IF POS(Value_n_unit$,"NORMALIZE")>0 THEN 4215 Sn_passed$=Value_n_unit$[1,POS(Value_n_unit$,"NORMALIZE")-1] 4216 Cmd$=Value_n_unit$[POS(Value_n_unit$,"NORMALIZE")] 4217 ELSE 4218 Sn_passed$=Value_n_unit$ 4219 Cmd$="NORMALIZE ON" 4220 END IF 4221 END IF 4222 IF Sn_passed$="" THEN 4223 CALL Clr_scr 4224 Title$="POWER METER SENSOR ASSIGNMENT" 4225 CALL Show_message(Title$,3) 4226 Pm_num=(Sensor_index DIV 2)+(Sensor_index MOD 2) 4227 LOOP 4228 New_sr_num$=FNGet_sr_number$(Hpib_address,Pm_num,Active_channel$) 4229 Sr_num$="RP"&New_sr_num$ 4230 EXIT IF FNSnsr_on_disk$(Sr_num$)="ON DISK" 4231 Msg$="SR NUMBER NOT ON DISK, ENTER ANOTHER SR NUMBER" 4232 DISP Msg$ 4233 WAIT 1 4234 END LOOP 4235 ELSE 4236 New_sr_num$=Sn_passed$ 4237 Sr_num$="RP"&New_sr_num$ 4238 END IF 4239 Normalize_off=(Cmd$="NORMALIZE OFF") 4240 IF Normalize_off THEN 4241 DISP "LOADING SENSOR DATA..... STANDBY" 4242 ELSE 4243 DISP "LOADING AND NORMALIZING SENSOR DATA..... STANDBY" 4244 END IF 4245 IF POS(Division$,"SAD") AND NOT (POS(Sr_num$,"RPBS")) THEN 4246 CALL Load_snsr_data(Sr_num$,Pwr_snsr_cal(*),Cal_due_date$) 4247 Days_til_cal=(DATE(Cal_due_date$)-TIMEDATE) DIV (60*60*24.00) 4248 IF Days_til_cal<0 THEN 4249 Show_message("Power Sensor "&Sr_num$&" cal is due. Program has stopped.",10) 4250 Show_message("Type run and press RETURN.",11) 4251 STOP 4252 ELSE 4253 IF Days_til_cal<30 THEN 4254 Show_message("Power Sensor "&Sr_num$&" cal due within "&VAL$(Days_til_cal)&" days.") 4255 Prompt_keys("CONTINUE",Key_pressed$) 4256 END IF 4257 END IF 4258 ELSE 4259 CALL Load_snsr_data(Sr_num$,Pwr_snsr_cal(*)) 4260 END IF 4261 SELECT Normalize_off 4262 CASE 1 4263 CASE 0 4264 Loop_count=0 4265 REPEAT 4266 Loop_count=Loop_count+1 4267 Upper_freq=Pwr_snsr_cal(1,Loop_count) 4268 UNTIL Upper_freq>50 OR Loop_count=600 4269 IF Loop_count<600 AND Loop_count>1 THEN 4270 Lower_freq=Pwr_snsr_cal(1,Loop_count-1) 4271 Interp_factor=(50-Lower_freq)/(Upper_freq-Lower_freq) 4272 Cal_50_mhz=(Pwr_snsr_cal(2,Loop_count)-Pwr_snsr_cal(2,Loop_count-1))*Interp_factor+Pwr_snsr_cal(2,Loop_count-1) 4273 FOR I=1 TO 600 4274 Pwr_snsr_cal(2,I)=Pwr_snsr_cal(2,I)/(Cal_50_mhz/1000) 4275 NEXT I 4276 END IF 4277 END SELECT 4278 FOR I=1 TO 600 4279 Head_cal_data(1,Sensor_index,I)=Pwr_snsr_cal(1,I) 4280 Head_cal_data(2,Sensor_index,I)=Pwr_snsr_cal(2,I) 4281 NEXT I 4282 Loc=1 4283 WHILE New_sr_num$[Loc;1]<"0" OR New_sr_num$[Loc;1]>"9" 4284 Loc=Loc+1 4285 END WHILE 4286 Sr_num(Sensor_index)=VAL(New_sr_num$[Loc]) 4287 DISP "" 4288 SUBEND 4289 SUB Load_snsr_data(Sr_num$,REAL Pwr_snsr_cal(*),OPTIONAL Cal_due_date$) 4290 Load_snsr_data: REM $Header: Load_snsr_data.9x,v 1.2 95/09/18 12:52:18 hmgr Exp $ 4291 INTEGER Err_num 4292 DIM Msus$[25],Msg$[80],Key_pressed$[20],Cal_directory$[80] 4293 CALL Directory_info("POWER SENSOR CAL",Cal_directory$,Msus$) 4294 Cal_directory$=Cal_directory$&Sr_num$&Msus$ 4295 ASSIGN @Disk TO Cal_directory$ 4296 ENTER @Disk;Pwr_snsr_cal(*),Sensor_model$ 4297 IF NPAR=3 THEN ENTER @Disk;Cal_due_date$ 4298 ASSIGN @Disk TO * 4299 SUBEND 4300 DEF FNGet_sr_number$(OPTIONAL INTEGER Hpib_address,Pwr_mtr_num,Channel$) 4301 Get_sr_number: REM $Header: FNGet_sr_number.gp,v 1.3 92/06/24 10:40:17 hmgr Exp $ 4302 DIM Kbd_entry$[160],Msg$[160] 4303 REAL Interim_sr_num 4304 IF NPAR=2 THEN 4305 CALL Show_message("FOR POWER METER "&VAL$(Pwr_mtr_num)&" WITH HPIB ADDRESS "&VAL$(Hpib_address),8) 4306 END IF 4307 IF NPAR=3 THEN 4308 Msg$="CALIBRATION ID NEEDED FOR POWER METER SENSOR CONNECTED TO " 4309 PRINT TABXY(5,5);Msg$ 4310 Msg$="CHANNEL "&Channel$&" OF METER # "&VAL$(Pwr_mtr_num) 4311 Msg$=Msg$&" AT HPIB ADDRESS "&VAL$(Hpib_address) 4312 PRINT TABXY(5,6);Msg$ 4313 END IF 4314 CALL Show_message("Input the calibration RP# attatched to the",9) 4315 CALL Show_message("side of the Power Sensor. Examples are:",10) 4316 CALL Show_message(" 0001",12,30) 4317 CALL Show_message(" 2215",13,30) 4318 CALL Show_message(" 9999",14,30) 4319 CALL Tone("ENTER") 4320 DISP "Then press ***ENTER***" 4321 CALL Kbd_input("ALL","",Kbd_entry$) 4322 CALL Clr_scr 4323 RETURN Kbd_entry$ 4324 FNEND 4325 DEF FNSnsr_on_disk$(Sr_num$) 4326 Snsr_on_disk: REM $Header: FNSnsr_on_disk.gp,v 1.3 92/06/24 10:40:35 hmgr Exp $ 4327 DIM File_status$[20],Cal_directory$[80],Msus$[50] 4328 CALL Directory_info("POWER SENSOR CAL",Cal_directory$,Msus$) 4329 Cal_directory$=Cal_directory$&Sr_num$&Msus$ 4330 ON ERROR GOTO Not_on_disk 4331 ASSIGN @Sensor TO Cal_directory$ 4332 ASSIGN @Sensor TO * 4333 OFF ERROR 4334 File_status$="ON DISK" 4335 RETURN File_status$ 4336 Not_on_disk:! 4337 OFF ERROR 4338 SELECT ERRN 4339 CASE 56 4340 File_status$="NO FILE ON DISK" 4341 CASE ELSE 4342 DISP ERRM$ 4343 STOP 4344 END SELECT 4345 RETURN File_status$ 4346 FNEND 4347 SUB Store_pm_cal(Cal_id$,Freq(*),Pwr(*),INTEGER Num_points) 4348 Store_pm_cal: REM $Header: Store_pm_cal.9x,v 1.1 92/07/16 13:30:29 hmgr Exp $ 4349 DIM Msus$[25],Cal_directory$[160] 4350 INTEGER I 4351 REAL Pwr_snsr_cal(1:2,1:600) 4352 FOR I=1 TO Num_points 4353 Pwr(I)=10^(Pwr(I)/10) 4354 NEXT I 4355 MAT Pwr=Pwr*(1000) 4356 FOR I=1 TO Num_points 4357 Pwr_snsr_cal(1,I)=Freq(I) 4358 Pwr_snsr_cal(2,I)=Pwr(I) 4359 NEXT I 4360 CALL Pm_disk_stg(Cal_id$,Pwr_snsr_cal(*),Num_points) 4361 SUBEND 4362 SUB Snsr_enter 4363 Snsr_enter: REM $Header: Snsr_enter.9x,v 1.1 92/07/15 10:55:45 hmgr Exp $ 4364 DIM Title$[80],Msg$[80],Directory$[60],Cal_directory$[80] 4365 DIM Cal_disk_file$[50],Header_info$(1:2)[80] 4366 INTEGER Num_recs 4367 REAL Pwr_snsr_cal(1:2,1:600) 4368 Directory$="/MANAGER/CAL_DATA/SENSOR_DATA/" 4369 Msus$=":REMOTE" 4370 Num_recs=5 4371 LOOP 4372 Clr_scr 4373 Title$="* * * * ENTER POWER SENSOR DATA * * * *" 4374 Show_message(Title$,2) 4375 Show_message("This program is ONLY for power sensor data",5) 4376 Show_message("with the 'RP' prefix.",6) 4377 Show_message("Type in the calibration number on the disk.",9) 4378 Show_message("For example : ",10) 4379 Show_message("RP_0001",12,35) 4380 Show_message("RP_1234",13,35) 4381 Show_message("RP_12345",14,35) 4382 LINPUT Cal_code$ 4383 EXIT IF LEN(Cal_code$)>6 AND LEN(Cal_code$)<9 AND POS(Cal_code$,"RP_") 4384 Prompt_keys(" TRY AGAIN, NEVER MIND",What_next$,Cal_code$&" is not a valid entry -- 'TRY AGAIN' or 'NEVER MIND'.") 4385 IF TRIM$(What_next$)="NEVER MIND" THEN GOTO Snsr_exit 4386 END LOOP 4387 Sr_num$="SR"&Cal_code$[4] 4388 Cal_directory$=Directory$&Sr_num$&Msus$ 4389 ON ERROR GOTO Not_on_disk 4390 ASSIGN @Sensor TO Cal_directory$ 4391 OFF ERROR 4392 ASSIGN @Sensor TO * 4393 Prompt_keys(" ENTER AGAIN, EXIT",Key_pressed$,"There is already a file on the SYSTEM DISK for this Cal Number.") 4394 IF TRIM$(Key_pressed$)="EXIT" THEN GOTO Snsr_exit 4395 Cal_disk_stuff:! 4396 Clr_scr 4397 Show_message(Title$,2) 4398 Prompt_keys(":HP9121_700_0,:INTERNAL 4_0, OTHER",Drive$,"Select the Disk Drive MSUS for the sensor data disk.") 4399 SELECT Drive$ 4400 CASE ":INTERNAL 4_0" 4401 Drive_msi$=":INTERNAL,4,0" 4402 CASE ":HP9121_700_0" 4403 Drive_msi$=":HP9121,700,0" 4404 CASE "OTHER" 4405 LINPUT "ENTER MSUS OF SENSOR DATA",Drive_msi$ 4406 END SELECT 4407 Msg$="Place disk in the drive .... and press 'READY'." 4408 Prompt_keys(" READY",Key_pressed$,Msg$) 4409 Cal_disk_file$=Cal_code$&Drive_msi$ 4410 ON ERROR GOTO No_file 4411 ASSIGN @Data TO Cal_disk_file$ 4412 OFF ERROR 4413 DISP "Reading sensor HEADER file from floppy disc." 4414 ENTER @Data,13;Header_info$(1) 4415 ENTER @Data,14;Header_info$(2) 4416 ASSIGN @Data TO * 4417 Num_data_points=VAL(Header_info$(1)[POS(Header_info$(1),":")+1]) 4418 Rows=VAL(Header_info$(2)[POS(Header_info$(2),":")+1]) 4419 ALLOCATE Sensor_data(1:Rows,1:Num_data_points) 4420 Data_file_name$=Cal_code$&"_DT" 4421 Cal_disk_file$=Data_file_name$&Drive_msi$ 4422 ON ERROR GOTO No_file 4423 ASSIGN @Data TO Cal_disk_file$ 4424 OFF ERROR 4425 DISP "Reading SENSOR DATA file from floppy disc." 4426 ENTER @Data;Sensor_data(*) 4427 ASSIGN @Data TO * 4428 FOR Data_point=1 TO Num_data_points 4429 Pwr_snsr_cal(1,Data_point)=INT(Sensor_data(1,Data_point)*1000) 4430 Pwr_snsr_cal(2,Data_point)=INT(Sensor_data(2,Data_point)*10) 4431 NEXT Data_point 4432 ON ERROR GOSUB No_storage_file 4433 ASSIGN @Disk TO Cal_directory$ 4434 OFF ERROR 4435 DISP "STORING the sensor data on the SYSTEM disk." 4436 OUTPUT @Disk;Pwr_snsr_cal(*),Model$ 4437 ASSIGN @Disk TO * 4438 Snsr_exit:! 4439 Clr_scr 4440 SUBEXIT 4441 Not_on_disk:! 4442 OFF ERROR 4443 ASSIGN @Sensor TO * 4444 IF ERRN<>56 THEN GOTO Stop_program 4445 GOTO Cal_disk_stuff 4446 No_file:! 4447 OFF ERROR 4448 ASSIGN @Data TO * 4449 Prompt_keys("TRY DISK AGAIN, EXIT,,DIFF SNSR NUM",Key_pressed$,"Did not find "&Cal_disk_file$) 4450 IF TRIM$(Key_pressed$)="TRY DISK AGAIN" THEN GOTO Cal_disk_stuff 4451 IF TRIM$(Key_pressed$)="DIFF SNSR NUM" THEN GOTO Snsr_enter 4452 IF TRIM$(Key_pressed$)="EXIT" THEN GOTO Snsr_exit 4453 No_storage_file:! 4454 OFF ERROR 4455 ASSIGN @Disk TO * 4456 IF ERRN<>56 THEN GOTO Stop_program 4457 CREATE BDAT Cal_directory$,Num_recs 4458 ASSIGN @Disk TO Cal_directory$ 4459 RETURN 4460 Stop_program:! 4461 Clr_scr 4462 Show_message(Title$,2) 4463 Show_message("The program has STOPPED.",9) 4464 Show_message("Fix the problem then press 'RUN'.",12) 4465 DISP ERRM$ 4466 STOP 4467 SUBEND 4468 SUB Pm_disk_stg(Cal_id$,Pwr_sensor_cal(*),OPTIONAL INTEGER Num_points) 4469 Pm_disk_stg: REM $Header: Pm_disk_stg.9x,v 1.1 92/07/16 13:31:31 hmgr Exp $ 4470 INTEGER File_found 4471 DIM Cal_directory$[160] 4472 CALL Directory_info("POWER SENSOR CAL",Cal_directory$,Msus$) 4473 Cal_directory$=Cal_directory$&"RP"&Cal_id$&Msus$ 4474 CALL File_assign(@Disk,Cal_directory$,File_found) 4475 IF NOT File_found THEN 4476 CALL Bld_dir_n_file(Cal_directory$) 4477 CALL File_assign(@Disk,Cal_directory$,File_found) 4478 END IF 4479 OUTPUT @Disk;Pwr_sensor_cal(*),"CUSTOM" 4480 IF NPAR=3 THEN 4481 OUTPUT @Disk;Num_points 4482 END IF 4483 ASSIGN @Disk TO * 4484 SUBEND 4485 SUB Read_438_org(Frequency,Parameter$,Units$,@Pm,Value,Error_message$) ! not called anymore 4486 Read_438: REM $Header: Read_438.9x,v 1.2 93/02/03 14:24:03 hmgr Exp $ 4487 COM /Power_sensors/ REAL Head_cal_data(*),REAL Time_checked(*) 4488 COM /Power_sensors/ INTEGER Sensor_address(*),REAL Sr_num(*) 4489 COM /Power_sensors/Channel$(*),Low_freq(*),Freq_increment(*) 4490 COM /Pm_filter/Filter(1:4) 4491 DIM Msg$[80],Status$[30],Active_channel$[20] 4492 INTEGER Io_path_exists,Hpib_address,Select_code 4493 INTEGER Lower_point,Upper_point,Cal_point,Sensor_index,Pm_num 4494 REAL Cal_freq,Compensation,Upper_cal,Lower_freq,Upper_freq 4495 REAL Power 4496 Error_message$="OK" 4497 Readinst_again:! 4498 STATUS @Pm,0;Io_path_exists 4499 IF Io_path_exists<>1 THEN 4500 Msg$="The POWER METER has not been ASSIGNed an I/O path" 4501 GOTO Drop_dead_error 4502 END IF 4503 STATUS @Pm,1;Select_code 4504 STATUS @Pm,3;Hpib_address 4505 ON TIMEOUT Select_code,32 GOTO Timeout_438 4506 GOSUB Read_from_438 4507 IF Value=9.E+40 THEN 4508 OUTPUT @Pm;"SM" 4509 ENTER @Pm;Status$ 4510 SELECT Status$[1,2] 4511 CASE "11","12" 4512 Error_message$="INPUT OVERLOAD" 4513 CASE "15","16" 4514 Error_message$="ZERO DRIFTED" 4515 CASE "17","18" 4516 Error_message$="OVER RANGE" 4517 CASE "27" 4518 Error_message$="UNDER RANGE" 4519 Value=-70 4520 END SELECT 4521 END IF 4522 Exit_context:! 4523 OFF TIMEOUT Select_code 4524 IF Error_message$<>"OK" AND Error_message$<>"UNDER RANGE" THEN 4525 Error_message$=Error_message$&" -- Read_438 @ "&VAL$(Hpib_address) 4526 SIGNAL 0 4527 ELSE 4528 IF Error_message$="UNDER RANGE" THEN 4529 SIGNAL 1 4530 END IF 4531 END IF 4532 SUBEXIT 4533 Timeout_438:! 4534 Error_message$="TIMEOUT" 4535 DISP "438 TIMEOUT" 4536 PAUSE 4537 GOTO Exit_context 4538 Drop_dead_error:! 4539 DISP Msg$&"--THIS IS READ_438" 4540 CALL Tone("STOPPED") 4541 PAUSE 4542 STOP 4543 Read_from_438:! 4544 SELECT Parameter$[1,4] 4545 CASE "CH A" 4546 Active_channel$="A" 4547 CASE "CH B" 4548 Active_channel$="B" 4549 CASE ELSE 4550 END SELECT 4551 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index) 4552 Pm_num=1+(Sensor_index>2) 4553 SELECT Parameter$[1,4] 4554 CASE "CH A" 4555 IF Channel$(Pm_num)<>"A" THEN 4556 Channel$(Pm_num)="A" 4557 OUTPUT @Pm;"AP" 4558 END IF 4559 Parameter$=Parameter$[6] 4560 CASE "CH B" 4561 IF Channel$(Pm_num)<>"B" THEN 4562 Channel$(Pm_num)="B" 4563 OUTPUT @Pm;"BP" 4564 END IF 4565 Parameter$=Parameter$[6] 4566 END SELECT 4567 SELECT Parameter$ 4568 CASE "INSTANT READ POWER" 4569 GOSUB Fast_power_read 4570 Value=Power 4571 CASE "VERY FAST CORRECTED POWER" 4572 GOSUB Fast_power_read 4573 GOSUB Correct_power 4574 CASE "FAST CORRECTED POWER" 4575 GOSUB Filter_wait 4576 GOSUB Fast_power_read 4577 GOSUB Correct_power 4578 CASE "FAST UNCORRECTED POWER" 4579 GOSUB Filter_wait 4580 GOSUB Fast_power_read 4581 Value=Power 4582 CASE "UNCORRECTED POWER" 4583 GOSUB Read_power 4584 Value=Power 4585 CASE "CORRECTED POWER" 4586 GOSUB Read_power 4587 GOSUB Correct_power 4588 CASE ELSE 4589 Msg$=Parameter$&" IS NOT A VALID PARAMETER" 4590 GOTO Drop_dead_error 4591 END SELECT 4592 RETURN 4593 Read_power:! 4594 OUTPUT @Pm;"TR2" 4595 ENTER @Pm;Power 4596 RETURN 4597 Fast_power_read:! 4598 OUTPUT @Pm;"TR1" 4599 ENTER @Pm;Power 4600 RETURN 4601 Correct_power:! 4602 Cal_point=40 4603 Upper_point=600 4604 Lower_point=1 4605 LOOP 4606 Cal_freq=Head_cal_data(1,Sensor_index,Cal_point) 4607 IF Cal_freq>=Frequency OR Cal_freq=0 THEN 4608 Upper_point=Cal_point 4609 ELSE 4610 Lower_point=Cal_point 4611 END IF 4612 Cal_point=INT((Upper_point+Lower_point)/2) 4613 EXIT IF Upper_point-Lower_point=1 4614 END LOOP 4615 Lower_freq=Head_cal_data(1,Sensor_index,Lower_point) 4616 Upper_freq=MAX(Head_cal_data(1,Sensor_index,Upper_point),Lower_freq) 4617 IF Frequency>Upper_freq OR Frequency1 THEN 4666 Msg$="The power meter has not been ASSIGNed an I/O path -- Setup_438" 4667 GOTO Drop_dead_error 4668 END IF 4669 STATUS @Pm,1;Select_code 4670 STATUS @Pm,3;Hpib_address 4671 ON TIMEOUT Select_code,5 GOTO Timeout_438 4672 REPEAT 4673 CALL Command_parser(Rest_of_control$,Command$,Value_n_unit$,Last_command) 4674 GOSUB Execute_command 4675 UNTIL Last_command=1 4676 Exit_context:! 4677 OFF TIMEOUT Select_code 4678 IF Error_message$<>"OK" THEN 4679 Error_message$=Error_message$&" -- Setup_438 @ "&VAL$(Hpib_address) 4680 SIGNAL 0 4681 END IF 4682 SUBEXIT 4683 Timeout_438:! 4684 IF POS(Control$,"PRESET") THEN 4685 Msg$="Setup_438 at "&VAL$(Hpib_address)&" -- TIMEOUT. Please fix and press `CONTINUE'." 4686 CALL Tone("ALERT") 4687 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 4688 GOTO Setupinst_again 4689 ELSE 4690 Error_message$="TIMEOUT" 4691 GOTO Exit_context 4692 END IF 4693 Drop_dead_error:! 4694 DISP Msg$ 4695 CALL Tone("STOPPED") 4696 PAUSE 4697 STOP 4698 Execute_command:! 4699 SELECT Command$[1,5] 4700 CASE "CH A " 4701 Command$=Command$[6] 4702 OUTPUT @Pm;"AE" 4703 Active_channel$="A" 4704 GOSUB Suffix_select 4705 CASE "CH B " 4706 OUTPUT @Pm;"BE" 4707 Command$=Command$[6] 4708 Active_channel$="B" 4709 GOSUB Suffix_select 4710 CASE ELSE 4711 GOSUB Standard_select 4712 END SELECT 4713 RETURN 4714 Standard_select:! 4715 SELECT Command$ 4716 CASE "PRESET" 4717 GOSUB Inst_id 4718 OUTPUT @Pm;"PR LG" 4719 MAT Filter=(0) 4720 FOR I=1 TO 4 4721 Filter(I)=0 4722 NEXT I 4723 CALL Sensor_index(Hpib_address,"A",Sensor_index) 4724 Pm_num=1+(Sensor_index>2) 4725 Channel$(Pm_num)="A" 4726 CASE "TRIGGER HOLD" 4727 OUTPUT @Pm;"TR0" 4728 CASE "TRIGGER IMMEDIATE" 4729 OUTPUT @Pm;"TR1" 4730 CASE "TRIGGER FREE RUN" 4731 OUTPUT @Pm;"TR3" 4732 CASE "LOCAL" 4733 LOCAL @Pm 4734 CASE "REMOTE" 4735 REMOTE @Pm 4736 CASE "REF OSC ON" 4737 OUTPUT @Pm;"OC1" 4738 CASE "REF OSC OFF" 4739 OUTPUT @Pm;"OC0" 4740 CASE ELSE 4741 Msg$=Command$&" -- INVALID CONTROL VARIABLE -- This is Setup_438" 4742 GOTO Drop_dead_error 4743 END SELECT 4744 RETURN 4745 Suffix_select:! 4746 SELECT Command$ 4747 CASE "BURIED SENSOR ASGN" 4748 IF Value_n_unit$="" THEN 4749 CALL Sensor_asgn_438(Hpib_address,Active_channel$) 4750 ELSE 4751 IF POS(Value_n_unit$,"NORMALIZE")>0 THEN 4752 Sn_passed$=Value_n_unit$[1,POS(Value_n_unit$,"NORMALIZE")-1] 4753 ELSE 4754 Sn_passed$=Value_n_unit$ 4755 END IF 4756 IF Sn_passed$<>"" THEN 4757 IF FNSnsr_on_disk$("RP"&Sn_passed$)<>"ON DISK" THEN 4758 Error_message$="SENSOR "&Sn_passed$&" IS NOT ON DISC" 4759 GOTO Exit_context 4760 END IF 4761 END IF 4762 CALL Sensor_asgn_438(Hpib_address,Active_channel$,Value_n_unit$) 4763 END IF 4764 CASE "CAL ADJ PWR" 4765 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 4766 SELECT Unit$ 4767 CASE "dBm" 4768 IF Value<-3 OR Value>.78 THEN 4769 Error_message$="CAL ADJUST POWER OUT OF RANGE" 4770 GOTO Exit_context 4771 ELSE 4772 Cal_factor=-(10^(Value/10))*100 4773 OUTPUT @Pm;"CL";Cal_factor;"EN" 4774 GOSUB Errors 4775 END IF 4776 CASE ELSE 4777 Msg$=Unit$&" IS ILLEGAL CAL ADJUST UNIT-- THIS IS SETUP 438" 4778 GOTO Drop_dead_error 4779 END SELECT 4780 CASE "SENSOR VERIFY" 4781 Zero_n_cal=1 4782 GOSUB Sensor_verify 4783 CASE "BURIED SENSOR VERIFY" 4784 Zero_n_cal=0 4785 GOSUB Sensor_verify 4786 CASE "SENSOR ASSIGN" 4787 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index,New_sensor) 4788 Old_sr_num=Sr_num(Sensor_index) 4789 IF Value_n_unit$="" THEN 4790 CALL Sensor_asgn_438(Hpib_address,Active_channel$) 4791 ELSE 4792 IF POS(Value_n_unit$,"NORMALIZE")>0 THEN 4793 Sn_passed$=Value_n_unit$[1,POS(Value_n_unit$,"NORMALIZE")-1] 4794 ELSE 4795 Sn_passed$=Value_n_unit$ 4796 END IF 4797 IF Sn_passed$<>"" THEN 4798 IF FNSnsr_on_disk$("RP"&Sn_passed$)<>"ON DISK" THEN 4799 Error_message$="SENSOR "&Sn_passed$&" IS NOT ON DISC" 4800 GOTO Exit_context 4801 END IF 4802 END IF 4803 CALL Sensor_asgn_438(Hpib_address,Active_channel$,Value_n_unit$) 4804 END IF 4805 IF TIMEDATE-Time_checked(Sensor_index)>3600*3 THEN Service_due=1 4806 IF Old_sr_num<>Sr_num(Sensor_index) OR Service_due THEN 4807 Cal_adj=0 4808 Zeroed=0 4809 GOSUB Autozero 4810 GOSUB Cal_adjust 4811 Time_checked(Sensor_index)=TIMEDATE 4812 END IF 4813 CASE "LOW POWER SENSOR ASSIGN" 4814 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index,New_sensor) 4815 Old_sr_num=Sr_num(Sensor_index) 4816 IF Value_n_unit$="" THEN 4817 CALL Sensor_asgn_438(Hpib_address,Active_channel$) 4818 ELSE 4819 IF POS(Value_n_unit$,"NORMALIZE")>0 THEN 4820 Sn_passed$=Value_n_unit$[1,POS(Value_n_unit$,"NORMALIZE")-1] 4821 ELSE 4822 Sn_passed$=Value_n_unit$ 4823 END IF 4824 IF Sn_passed$<>"" THEN 4825 IF FNSnsr_on_disk$("RP"&Sn_passed$)<>"ON DISK" THEN 4826 Error_message$="SENSOR "&Sn_passed$&" IS NOT ON DISC" 4827 GOTO Exit_context 4828 END IF 4829 END IF 4830 CALL Sensor_asgn_438(Hpib_address,Active_channel$,Value_n_unit$) 4831 END IF 4832 IF TIMEDATE-Time_checked(Sensor_index)>3600*3 THEN Service_due=1 4833 IF Old_sr_num<>Sr_num(Sensor_index) OR Service_due THEN 4834 Cal_adj=0 4835 Zeroed=0 4836 GOSUB Cal_lp_snsr 4837 Time_checked(Sensor_index)=TIMEDATE 4838 END IF 4839 CASE "MEASURE" 4840 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index,New_sensor) 4841 Pm_num=1+(Sensor_index>2) 4842 SELECT Active_channel$ 4843 CASE "A" 4844 OUTPUT @Pm;"AP" 4845 Channel$(Pm_num)="A" 4846 CASE "B" 4847 OUTPUT @Pm;"BP" 4848 Channel$(Pm_num)="B" 4849 END SELECT 4850 CASE "AUTOZERO" 4851 GOSUB Autozero 4852 CASE "CAL ADJUST" 4853 GOSUB Cal_adjust 4854 CASE "LOW POWER CAL AND ZERO" 4855 GOSUB Cal_lp_snsr 4856 CASE "MANUAL FILTER" 4857 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 4858 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index) 4859 SELECT Value 4860 CASE 0 TO 9 4861 Filter(Sensor_index)=Value+1 4862 OUTPUT @Pm;"FM";Value;"EN" 4863 CASE ELSE 4864 Msg$=VAL$(Value)&" IS NOT A VALID FILTER NUMBER" 4865 GOTO Drop_dead_error 4866 END SELECT 4867 CASE "AUTO FILTER" 4868 OUTPUT @Pm;"FA" 4869 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index) 4870 Filter(Sensor_index)=0 4871 CASE "AUTO RANGE" 4872 OUTPUT @Pm;"RA" 4873 CASE "MANUAL RANGE" 4874 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 4875 SELECT Value 4876 CASE 1 TO 5 4877 OUTPUT @Pm;"RM";Value;"EN" 4878 CASE ELSE 4879 Msg$=VAL$(Value)&" IS NOT A VALID RANGE NUMBER" 4880 GOTO Drop_dead_error 4881 END SELECT 4882 CASE "RANGE HOLD" 4883 OUTPUT @Pm;"RH" 4884 CASE ELSE 4885 Msg$="CH x "&Command$&" -- INVALID CONTROL VARIABLE -- This is Setup_438" 4886 GOTO Drop_dead_error 4887 END SELECT 4888 RETURN 4889 Inst_id:! 4890 Loop_counter=0 4891 LOOP 4892 Loop_counter=Loop_counter+1 4893 CLEAR @Pm 4894 ABORT 7 4895 OUTPUT @Pm;"?ID" 4896 ENTER @Pm;Id$ 4897 EXIT IF POS(Id$,"HP438A") 4898 IF Loop_counter>5 THEN 4899 Msg$="The instrument at address "&VAL$(Hpib_address)&"is not a 438 power meter it is "&Id$ 4900 GOTO Drop_dead_error 4901 END IF 4902 END LOOP 4903 RETURN 4904 Autozero:! 4905 OUTPUT @Pm;"LN" 4906 Error_occurred=0 4907 GOSUB Errors 4908 IF Error_occurred=15 OR Error_occurred=16 THEN 4909 Error_occurred=0 4910 Error_message$="OK" 4911 END IF 4912 IF Error_occurred THEN GOTO Exit_context 4913 WHILE Zeroed=0 4914 DISP "" 4915 DISP "ZEROING POWER METER "; 4916 OUTPUT @Pm;"LN ZE" 4917 LOOP 4918 Loop_count=Loop_count+1 4919 IF Loop_count MOD 50=0 THEN 4920 DISP "*"; 4921 END IF 4922 Status_val=SPOLL(@Pm) 4923 EXIT IF BIT(Status_val,3)=1 4924 EXIT IF BIT(Status_val,1)=1 4925 END LOOP 4926 GOSUB Errors 4927 IF NOT Error_occurred THEN Zeroed=1 4928 DISP "" 4929 DISP "" 4930 END WHILE 4931 OUTPUT @Pm;"LG" 4932 RETURN 4933 Cal_adjust:! 4934 OUTPUT @Pm;"LN" 4935 GOSUB Errors 4936 IF Error_occurred THEN GOTO Exit_context 4937 IF Cal_adj=0 THEN 4938 Ref_conn=0 4939 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index) 4940 Pm_num=1+(Sensor_index>2) 4941 IF Channel$(Pm_num)<>Active_channel$ THEN 4942 OUTPUT @Pm;Active_channel$&"P" 4943 Channel_swap=1 4944 END IF 4945 REPEAT 4946 OUTPUT @Pm;"OC0" 4947 WAIT .35 4948 OUTPUT @Pm;"TR1" 4949 ENTER @Pm;Pwr_off 4950 OUTPUT @Pm;"OC1" 4951 WAIT .75 4952 OUTPUT @Pm;"TR1" 4953 ENTER @Pm;Pwr_osc 4954 OUTPUT @Pm;"OC0" 4955 IF Pwr_off>1.E-4 OR Pwr_osc<2.E-4 THEN 4956 Msg$="CONNECT THE CHANNEL "&Active_channel$&" SENSOR OF THE POWER METER AT " 4957 Msg$=Msg$&VAL$(Hpib_address)&" TO THE POWER REFERENCE" 4958 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 4959 Prompt_req=1 4960 ELSE 4961 Ref_conn=1 4962 END IF 4963 UNTIL Ref_conn 4964 DISP "" 4965 DISP "CAL ADJUST IN PROGRESS "; 4966 WHILE Cal_adj=0 4967 OUTPUT @Pm;"CS LN CL100EN" 4968 LOOP 4969 Loop_count=Loop_count+1 4970 IF Loop_count MOD 20=0 THEN DISP "*"; 4971 Status_val=SPOLL(@Pm) 4972 EXIT IF BIT(Status_val,3)=1 4973 EXIT IF BIT(Status_val,1)=1 4974 END LOOP 4975 GOSUB Errors 4976 IF NOT Error_occurred THEN Cal_adj=1 4977 DISP "" 4978 DISP "" 4979 OUTPUT @Pm;"LG" 4980 IF Prompt_req THEN 4981 Msg$="DISCONNECT THE SENSOR FROM THE POWER REFERENCE"&CHR$(10)&"Press CONTINUE when ready" 4982 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 4983 END IF 4984 END WHILE 4985 END IF 4986 OUTPUT @Pm;"LG" 4987 IF Channel_swap THEN 4988 OUTPUT @Pm;Channel$(Pm_num)&"P" 4989 Channel_swap=0 4990 END IF 4991 RETURN 4992 Is_cal_due:! 4993 IF TIMEDATE>Time_checked(Sensor_index)+TIME("3:00") OR New_sensor=1 THEN 4994 Cal_due=1 4995 END IF 4996 RETURN 4997 Sensor_verify:! 4998 CALL Sensor_index(Hpib_address,Active_channel$,Sensor_index,New_sensor) 4999 REPEAT 5000 IF Sr_num(Sensor_index)=0 THEN 5001 CALL Sensor_asgn_438(Hpib_address,Active_channel$) 5002 IF Zero_n_cal=1 THEN 5003 GOSUB Autozero 5004 GOSUB Cal_adjust 5005 Time_checked(Sensor_index)=TIMEDATE 5006 END IF 5007 ELSE 5008 Msg$="VERIFY THAT THE SENSOR ON CHANNEL "&Active_channel$&" OF"&CHR$(10) 5009 Msg$=Msg$&"THE POWER METER AT HPIB ADDRESS "&VAL$(Hpib_address)&"="&VAL$(Sr_num(Sensor_index)) 5010 CALL Prompt_keys("YES,NO",Key_pressed$,Msg$) 5011 SELECT Key_pressed$ 5012 CASE "NO" 5013 CALL Sensor_asgn_438(Hpib_address,Active_channel$) 5014 IF Zero_n_cal=1 THEN 5015 GOSUB Autozero 5016 GOSUB Cal_adjust 5017 Time_checked(Sensor_index)=TIMEDATE 5018 END IF 5019 END SELECT 5020 END IF 5021 UNTIL Key_pressed$="YES" 5022 RETURN 5023 Errors:! 5024 Error_occurred=0 5025 OUTPUT @Pm;"SM" 5026 ENTER @Pm;Status_msg$ 5027 SELECT Status_msg$[1,2] 5028 CASE "00" 5029 CASE "01","02" 5030 Msg$="ERROR!!!.. POWER METER @ "&VAL$(Hpib_address)&" CHANNEL " 5031 Msg$=Msg$&Active_channel$&" CAN'T ZERO"&CHR$(10)&"PROBABLE CAUSE IS POWER" 5032 Msg$=Msg$&" APPLIED... REMOVE POWER" 5033 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 5034 CASE "03","04" 5035 Msg$="ERROR!!!.. CONNECT SENSOR OF POWER METER @"&VAL$(Hpib_address) 5036 Msg$=Msg$&", CHANNEL "&Active_channel$&CHR$(10)&"TO THE 'POWER REF'" 5037 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 5038 CASE "31","32" 5039 Error_message$="MISSING SENSOR FOR CHANNEL "&Active_channel$ 5040 CASE "15","16" 5041 Error_message$=Active_channel$&" NEEDS ZEROING" 5042 CASE ELSE 5043 Msg$="POWER METER ERROR #"&Status_msg$[1,2]&" --CONTACT YOUR MEDIUM FOR SPIRITUAL GUIDANCE" 5044 GOTO Drop_dead_error 5045 END SELECT 5046 IF Status_msg$[1,2]<>"00" THEN Error_occurred=VAL(Status_msg$[1,2]) 5047 OUTPUT @Pm;"CS" 5048 RETURN 5049 Cal_lp_snsr:! 5050 Setup_438("CH "&Active_channel$&" AUTOZERO,REF OSC ON",@Pm,Error_message$) 5051 REPEAT 5052 Read_438(50,"CH "&Active_channel$&" CORRECTED POWER","dBm",@Pm,Power,Error_message$) 5053 IF ABS(Power-(-30))>5 THEN 5054 Clr 5055 Tone("ALERT") 5056 Show_message("CONNECT 8484A CHANNEL "&Active_channel$&" SENSOR AT ADDRESS 712",10) 5057 Show_message("TO THE POWER METER 50MHz REF THROUGH 30dB PAD (p/n 11708A).",11) 5058 Prompt_keys("CONTINUE",Key_pressed$,"PRESS 'CONTINUE' WHEN READY OR PRESS 'FAIL' IF ALREADY CONNECTED TO REFERENCE") 5059 Show_message("") 5060 END IF 5061 UNTIL Power>=-35 5062 Setup_438("REF OSC OFF,CH "&Active_channel$&" AUTOZERO,CH "&Active_channel$&" CAL ADJ PWR=0dBm",@Pm,Error_message$) 5063 Clr 5064 RETURN 5065 SUBEND 5066 SUB Setup_8340_org(Control$,@Syn_8340,Error_message$) ! originally Setup_8340 (not called now) 5067 Setup_8340_org: REM $Header: Setup_8340.gp,v 1.6 93/12/22 14:33:35 hmgr Exp $ 5068 DIM Command$[50],Id$[24],Unit$[6],Value_n_unit$[50],Msg$[160] 5069 DIM Key_pressed$[18] 5070 COM /Synth_8340_mem/Disable_8340err$(1:4,1:2)[80] 5071 INTEGER Io_path_exists,Addr,Select_code,I,Synth_index 5072 INTEGER Last_command,Syn_statusbyte1,Syn_statusbyte2 5073 ALLOCATE Rest_of_control$[LEN(Control$)] 5074 Error_message$="OK" 5075 Setup8340_loop:! 5076 Local=0 5077 Rest_of_control$=Control$ 5078 STATUS @Syn_8340,0;Io_path_exists 5079 IF Io_path_exists<>1 THEN GOTO Not_assigned 5080 STATUS @Syn_8340,1;Select_code 5081 STATUS @Syn_8340,3;Addr 5082 ON TIMEOUT Select_code,5 GOTO Timeout_8340 5083 CALL Synth_index(Addr,Synth_index) 5084 REPEAT 5085 CALL Command_parser(Rest_of_control$,Command$,Value_n_unit$,Last_command) 5086 GOSUB Execute_command 5087 UNTIL Last_command=1 5088 IF NOT Local THEN 5089 GOSUB Chk_8340_status 5090 END IF 5091 Exit_context:! 5092 OFF TIMEOUT Select_code 5093 IF Error_message$<>"OK" THEN 5094 Ok_pos=POS(Error_message$,"OK") 5095 IF Ok_pos THEN 5096 Error_message$=Error_message$[1,Ok_pos-1]&Error_message$[Ok_pos+3] 5097 END IF 5098 Error_message$="Setup_8340 at "&VAL$(Addr)&" "&Error_message$ 5099 END IF 5100 SUBEXIT 5101 Timeout_8340:! 5102 IF POS(Control$,"PRESET")>0 THEN 5103 Msg$="Setup_8340 at "&VAL$(Addr)&"TIMEOUT, FIX AND PRESS CONTINUE" 5104 CALL Tone("ALERT") 5105 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 5106 GOTO Setup8340_loop 5107 ELSE 5108 Error_message$="TIMEOUT" 5109 SIGNAL 0 5110 GOTO Exit_context 5111 END IF 5112 Not_assigned:! 5113 Msg$=" The 8340 has not been assigned to an I/O path" 5114 GOTO Drop_dead_err 5115 Execute_command:! 5116 SELECT Command$ 5117 CASE "PRESET" 5118 LOOP 5119 CLEAR @Syn_8340 5120 OUTPUT @Syn_8340;"OI" 5121 ENTER @Syn_8340;Id$ 5122 EXIT IF POS(Id$,"8340") OR POS(Id$,"8341") 5123 EXIT IF Id$[1,6]="083650" 5124 EXIT IF Id$[1,6]="083640" 5125 EXIT IF Id$[1,6]="083630" 5126 DISP "THE DEVICE AT ADDRESS ";Addr;" IS NOT AN 8340/41 -- FIX AND PRESS CONTINUE" 5127 CALL Tone("ALERT") 5128 PAUSE 5129 DISP 5130 END LOOP 5131 OUTPUT @Syn_8340;"IP CW55.7MZ PL-110DB RP0" 5132 Disable_8340err$(Synth_index,2)="" 5133 CASE "LOCAL" 5134 LOCAL @Syn_8340 5135 Local=1 5136 CASE "REMOTE" 5137 REMOTE @Syn_8340 5138 CASE "STOW" 5139 OUTPUT @Syn_8340;"RF0 CW26.5GZ PL-90DB PM0" 5140 CASE "EXT AC AM","EXT AM ON","EXT AM" 5141 OUTPUT @Syn_8340;"AM1" 5142 CASE "EXT AC FM MODULATION" 5143 Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5144 OUTPUT @Syn_8340;"FM1";Inst_val;"HZ;" 5145 CASE "FM MODULATION ON" 5146 OUTPUT @Syn_8340;"FM1" 5147 CASE "FM MODULATION OFF" 5148 OUTPUT @Syn_8340;"FM0" 5149 CASE "AM" 5150 CASE "MODULATION ON" 5151 OUTPUT @Syn_8340;"SHPM" 5152 CASE "MODULATION OFF","AM MODULATION OFF","AM OFF" 5153 OUTPUT @Syn_8340;"AM0" 5154 CASE "PULSE MOD INTERNAL ON","PULSE MOD EXTERNAL ON","EXT PULSE MOD" 5155 OUTPUT @Syn_8340;"PM1" 5156 CASE "PULSE MOD OFF" 5157 OUTPUT @Syn_8340;"PM0" 5158 CASE "FREQ","CW FREQ","FREQUENCY" 5159 GOSUB Freq_units 5160 OUTPUT @Syn_8340;"CW";Inst_val;"HZ" 5161 CASE "SWEPT CW FREQ" 5162 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 5163 GOSUB Freq_units 5164 OUTPUT @Syn_8340;"CW";Inst_val;"HZ,S1" 5165 CASE "START FREQ" 5166 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 5167 GOSUB Freq_units 5168 OUTPUT @Syn_8340;"FA";Inst_val;"HZ" 5169 CASE "STOP FREQ" 5170 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 5171 GOSUB Freq_units 5172 OUTPUT @Syn_8340;"FB";Inst_val;"HZ" 5173 CASE "CENTER FREQ" 5174 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 5175 GOSUB Freq_units 5176 IF Inst_val<1.000005E+7 THEN 5177 Error_message$="FREQ OUT OF RANGE" 5178 GOTO Drop_dead_err 5179 ELSE 5180 OUTPUT @Syn_8340;"CF";Inst_val;"HZ" 5181 END IF 5182 CASE "DELTA FREQ" 5183 GOSUB Delta_f_units 5184 IF Inst_val<100 THEN 5185 Msg$="FREQ OUT OF RANGE" 5186 GOTO Drop_dead_err 5187 ELSE 5188 OUTPUT @Syn_8340;"DF";Inst_val;"HZ" 5189 END IF 5190 CASE "POWER","POWER LEVEL" 5191 GOSUB Power_units 5192 OUTPUT @Syn_8340;"PL";Inst_val;"DB" 5193 CASE "PEAK POWER","PEAK POWER LEVEL" 5194 GOSUB Power_units 5195 OUTPUT @Syn_8340;"RP1 PL";Inst_val;"DB" 5196 CASE "UNCOUPLED ATTEN POWER" 5197 OUTPUT @Syn_8340;"OPAT" 5198 ENTER @Syn_8340;Atten_setting 5199 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5200 SELECT Unit$ 5201 CASE "dBm" 5202 IF Inst_valAtten_setting+20 THEN 5203 Msg$="UNCOUPLED ATTEN POWER OUT OF RANGE" 5204 GOTO Drop_dead_err 5205 END IF 5206 CASE ELSE 5207 Msg$=Unit$&" IS ILLEGAL POWER UNIT" 5208 GOTO Drop_dead_err 5209 END SELECT 5210 OUTPUT @Syn_8340;"SHPS";-Atten_setting+Inst_val;"DB" 5211 CASE "POWER PEAKING ON" 5212 OUTPUT @Syn_8340;"RP1" 5213 CASE "POWER PEAKING OFF" 5214 OUTPUT @Syn_8340;"RP0" 5215 CASE "POWER OFF","RF OFF" 5216 OUTPUT @Syn_8340;"RF0" 5217 CASE "POWER ON","RF ON" 5218 OUTPUT @Syn_8340;"RF1" 5219 CASE "EXTERNAL LEVELING" 5220 OUTPUT @Syn_8340;"A2" 5221 CASE "INTERNAL LEVELING" 5222 OUTPUT @Syn_8340;"A1" 5223 CASE "METER LEVELING","EXTERNAL POWER METER LEVELING" 5224 OUTPUT @Syn_8340;"A3" 5225 CASE "ALC OFF" 5226 OUTPUT @Syn_8340;"SHA1" 5227 CASE "UNLEVELED POWER" 5228 Msg$=Command$&" IS NOT FUNCTIONAL YET" 5229 GOTO Drop_dead_err 5230 GOSUB Power_units 5231 Disable_8340err$(Synth_index,2)=Disable_8340err$(Synth_index,2)&" UNLEVELED " 5232 OUTPUT @Syn_8340;"SHA3" 5233 CASE "NO LEVELING" 5234 Disable_8340err$(Synth_index,2)=Disable_8340err$(Synth_index,2)&" UNLEVELED " 5235 OUTPUT @Syn_8340;"SHA3" 5236 CASE "DISABLE UNLEVEL ERROR" 5237 Disable_8340err$(Synth_index,2)=Disable_8340err$(Synth_index,2)&" UNLEVELED " 5238 CASE "ENABLE ALL ERRORS" 5239 Disable_8340err$(Synth_index,2)="" 5240 CASE "SWEEP TIME" 5241 GOSUB Time_units 5242 IF Inst_val<.01 OR Inst_val>200 THEN 5243 Msg$="SWEEP TIME OUT OF RANGE" 5244 GOTO Drop_dead_err 5245 ELSE 5246 OUTPUT @Syn_8340;"ST";Inst_val;"SC" 5247 END IF 5248 CASE "SINGLE SWEEP" 5249 OUTPUT @Syn_8340;"S2,RS" 5250 CASE "CONTINUOUS SWEEP","CONTINOUS SWEEP","CONT SWEEP" 5251 OUTPUT @Syn_8340;"S1" 5252 CASE "TAKE SWEEP","ONE SWEEP" 5253 OUTPUT @Syn_8340;"ST;OA" 5254 ENTER @Syn_8340;Sweep_time 5255 IF Sweep_time>20 THEN 5256 OFF TIMEOUT Select_code 5257 ELSE 5258 ON TIMEOUT Select_code,Sweep_time*1.5 GOTO Timeout_8340 5259 END IF 5260 OUTPUT @Syn_8340;"TS" 5261 ON TIMEOUT Select_code,5 GOTO Timeout_8340 5262 CASE "TAKE FREE SWEEP" 5263 OUTPUT @Syn_8340;"ST;OA" 5264 ENTER @Syn_8340;Sweep_time 5265 IF Sweep_time>20 THEN 5266 OFF TIMEOUT Select_code 5267 ELSE 5268 ON TIMEOUT Select_code,Sweep_time*1.5 GOTO Timeout_8340 5269 END IF 5270 OUTPUT @Syn_8340;"S2;CS" 5271 REPEAT 5272 OUTPUT @Syn_8340;"OS" 5273 ENTER @Syn_8340 USING "#,B";Syn_statusbyte1,Syn_statusbyte2 5274 WAIT .1 5275 UNTIL BIT(Syn_statusbyte1,4) 5276 ON TIMEOUT Select_code,5 GOTO Timeout_8340 5277 CASE "ATTEN" 5278 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 5279 IF Unit$<>"dB" THEN 5280 Msg$=Unit$&" IS NOT VALID UNIT FOR ATTENUATION" 5281 GOTO Drop_dead_err 5282 END IF 5283 IF Value<-90 OR Value>0 THEN 5284 Msg$="ATTEN VALUE OF "&VAL$(Value)&"dB IS OUT OF RANGE" 5285 GOTO Drop_dead_err 5286 END IF 5287 IF Value MOD 10 THEN 5288 Msg$="ATTEN VALUE OF "&VAL$(Value)&"dB IS NOT ALLOWED" 5289 GOTO Drop_dead_err 5290 END IF 5291 OUTPUT @Syn_8340;"AT";Value;"DB" 5292 CASE "REFERENCE VOLTAGE" 5293 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5294 SELECT Unit$ 5295 CASE "dBV" 5296 IF Inst_val<-60 OR Inst_val>6 THEN 5297 Msg$="REFERENCE VOLTAGE OUT OF RANGE" 5298 GOTO Drop_dead_err 5299 ELSE 5300 OUTPUT @Syn_8340;"PL";Inst_val;"DB" 5301 END IF 5302 CASE ELSE 5303 Msg$=Unit$&" is an illegal REFERENCE VOLTAGE unit" 5304 END SELECT 5305 CASE "UPPER FREQ LIMIT" 5306 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5307 OUTPUT @Syn_8340;"SHGZ54HZ;SHMZ12HZ;SHKZ22HZ;"&VAL$(Inst_val/1.E+6)&"HZ;EF;" 5308 CASE ELSE 5309 Msg$=Command$&" IS INVALID COMMAND" 5310 GOTO Drop_dead_err 5311 END SELECT 5312 RETURN 5313 Freq_units:! 5314 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5315 IF Unit$<>"Hz" THEN 5316 Msg$=Unit$&" is an ILLEGAL FREQUENCY UNIT" 5317 GOTO Drop_dead_err 5318 END IF 5319 IF Inst_val<9.9999999999E+6 OR Inst_val>5.00000001E+10 THEN 5320 Msg$="FREQUENCY OUT OF RANGE" 5321 GOTO Drop_dead_err 5322 END IF 5323 RETURN 5324 Delta_f_units:! 5325 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5326 IF Unit$<>"Hz" THEN 5327 Msg$=Unit$&" is an ILLEGAL FREQUENCY UNIT" 5328 GOTO Drop_dead_err 5329 END IF 5330 IF Inst_val<99 OR Inst_val>5.00000001E+10 THEN 5331 Msg$="FREQUENCY OUT OF RANGE" 5332 GOTO Drop_dead_err 5333 END IF 5334 RETURN 5335 Power_units:! 5336 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5337 SELECT Unit$ 5338 CASE "dBm" 5339 IF Inst_val<-110 OR Inst_val>20 THEN 5340 Msg$="POWER OUT OF RANGE" 5341 GOTO Drop_dead_err 5342 END IF 5343 CASE ELSE 5344 Msg$=Unit$&" IS ILLEGAL POWER UNIT" 5345 GOTO Drop_dead_err 5346 END SELECT 5347 RETURN 5348 Time_units:! 5349 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 5350 IF Unit$<>"s" AND Unit$<>"sec" THEN 5351 Msg$=Unit$&" IS ILLEGAL TIME UNIT" 5352 GOTO Drop_dead_err 5353 END IF 5354 RETURN 5355 Chk_8340_status:! 5356 Start=TIMEDATE 5357 Loop_count=0 5358 REPEAT 5359 Loop_count=Loop_count+1 5360 No_errors=1 5361 OUTPUT @Syn_8340;"CS OS" 5362 ENTER @Syn_8340 USING "#,B";Syn_statusbyte1,Syn_statusbyte2 5363 IF BIT(Syn_statusbyte2,6) OR BIT(Syn_statusbyte2,4) THEN 5364 No_errors=0 5365 IF BIT(Syn_statusbyte2,6)=1 THEN 5366 OUTPUT @Syn_8340;"SHAK" 5367 END IF 5368 END IF 5369 Et=TIMEDATE-Start 5370 UNTIL (Et>=2 AND Loop_count>1) OR No_errors=1 5371 IF BIT(Syn_statusbyte2,6)=1 THEN 5372 Error_message$="UNLEVELED" 5373 IF POS(Disable_8340err$(Synth_index,2)," UNLEVELED ")>0 THEN 5374 SIGNAL 1 5375 ELSE 5376 SIGNAL 0 5377 END IF 5378 END IF 5379 IF BIT(Syn_statusbyte2,4)=1 THEN 5380 Error_message$="UNLOCKED" 5381 SIGNAL 0 5382 END IF 5383 RETURN 5384 Drop_dead_err:! 5385 DISP "8340 at "&VAL$(Addr)&" "&Msg$&"--This is Setup_8340" 5386 CALL Tone("STOPPED") 5387 PAUSE 5388 STOP 5389 SUBEND 5390 SUB Write_8340(Parameter$,Value,Unit$,@Syn_8340,Error_message$) 5391 Write_8340: REM $Header: Write_8340.gp,v 1.4 95/05/11 12:51:50 hmgr Exp $ 5392 COM /Synth_8340_mem/Disable_8340err$(*) 5393 DIM Msg$[160] 5394 INTEGER Io_path_exists,Addr,Select_code,Syn_statusbyte1,Syn_statusbyte2 5395 INTEGER Synth_index 5396 REAL Inst_value 5397 Error_message$="OK" 5398 STATUS @Syn_8340,0;Io_path_exists 5399 IF Io_path_exists<>1 THEN GOTO Not_assigned 5400 STATUS @Syn_8340,1;Select_code 5401 STATUS @Syn_8340,3;Addr 5402 ON TIMEOUT Select_code,5 GOTO Timeout_8340 5403 CALL Synth_index(Addr,Synth_index) 5404 GOSUB Write_to_8340 5405 Exit_context:! 5406 OFF TIMEOUT Select_code 5407 IF Error_message$<>"OK" THEN 5408 Error_message$="Write_8340 at "&VAL$(Addr)&" "&Error_message$ 5409 END IF 5410 SUBEXIT 5411 Timeout_8340:! 5412 Error_message$="TIMEOUT" 5413 CALL Tone("ALERT") 5414 SIGNAL 0 5415 GOTO Exit_context 5416 Not_assigned:! 5417 Msg$=" The 8340 has not been assigned to an I/O path" 5418 GOTO Drop_dead_err 5419 Write_to_8340:! 5420 Inst_value=Value 5421 Inst_unit$=Unit$ 5422 SELECT Parameter$ 5423 CASE "FREQ","CW FREQ","FREQUENCY" 5424 GOSUB Freq_units 5425 OUTPUT @Syn_8340;"CW";Inst_value;"HZ" 5426 GOSUB Chk_8340_status 5427 CASE "SWEPT CW FREQ" 5428 GOSUB Freq_units 5429 OUTPUT @Syn_8340;"CW";Inst_value;"HZ,S1" 5430 GOSUB Chk_8340_status 5431 CASE "REFERENCE VOLTAGE" 5432 SELECT Unit$ 5433 CASE "dBV" 5434 IF Inst_value<-60 OR Inst_value>6 THEN 5435 Msg$="REFERENCE VOLTAGE OUT OF RANGE" 5436 GOTO Drop_dead_err 5437 ELSE 5438 OUTPUT @Syn_8340;"PL";Inst_value;"DB" 5439 END IF 5440 CASE ELSE 5441 Msg$=Unit$&" is an illegal REFERENCE VOLTAGE unit" 5442 END SELECT 5443 CASE "POWER","POWER LEVEL" 5444 GOSUB Power_units 5445 OUTPUT @Syn_8340;"PL";Inst_value;"DB" 5446 GOSUB Chk_8340_status 5447 CASE "PEAK POWER","PEAK POWER LEVEL" 5448 GOSUB Power_units 5449 OUTPUT @Syn_8340;"RP1 PL";Inst_value;"DB" 5450 GOSUB Chk_8340_status 5451 CASE "UNCOUPLED ATTEN POWER" 5452 OUTPUT @Syn_8340;"OPAT" 5453 ENTER @Syn_8340;Atten_setting 5454 SELECT Unit$ 5455 CASE "dBm" 5456 IF Inst_valueAtten_setting+20 THEN 5457 Msg$="UNCOUPLED ATTEN POWER OUT OF RANGE" 5458 GOTO Drop_dead_err 5459 END IF 5460 CASE ELSE 5461 Msg$=Unit$&" IS ILLEGAL POWER UNIT" 5462 GOTO Drop_dead_err 5463 END SELECT 5464 OUTPUT @Syn_8340;"SHPS";-Atten_setting+Inst_value;"DB" 5465 GOSUB Chk_8340_status 5466 CASE "START FREQ" 5467 GOSUB Freq_units 5468 OUTPUT @Syn_8340;"FA";Inst_value;"HZ" 5469 GOSUB Chk_8340_status 5470 CASE "STOP FREQ" 5471 GOSUB Freq_units 5472 OUTPUT @Syn_8340;"FB";Inst_value;"HZ" 5473 CASE "CENTER FREQ" 5474 GOSUB Freq_units 5475 IF Inst_value<1.000005E+7 THEN 5476 Error_message$="FREQ OUT OF RANGE" 5477 GOTO Drop_dead_err 5478 ELSE 5479 OUTPUT @Syn_8340;"CF";Inst_value;"HZ" 5480 END IF 5481 CASE "DELTA FREQ" 5482 GOSUB Delta_f_units 5483 IF Inst_value<100 THEN 5484 Msg$="FREQ OUT OF RANGE" 5485 GOTO Drop_dead_err 5486 ELSE 5487 OUTPUT @Syn_8340;"DF";Inst_value;"HZ" 5488 END IF 5489 CASE ELSE 5490 Msg$=Parameter$&" is INVALID" 5491 GOTO Drop_dead_err 5492 END SELECT 5493 RETURN 5494 Freq_units:! 5495 CALL Convert_units(Inst_value,Inst_unit$) 5496 SELECT Inst_unit$ 5497 CASE "Hz" 5498 CASE ELSE 5499 Error_message$=Inst_unit$&" IS ILLEGAL FREQUENCY UNIT" 5500 GOTO Drop_dead_err 5501 END SELECT 5502 IF Inst_value<9.999990E+6 OR Inst_value>5.0000001E+10 THEN 5503 Msg$="FREQUENCY OUT OF RANGE" 5504 GOTO Drop_dead_err 5505 END IF 5506 RETURN 5507 Delta_f_units:! 5508 CALL Convert_units(Inst_value,Inst_unit$) 5509 IF Inst_unit$<>"Hz" THEN 5510 Msg$=Inst_unit$&" is an ILLEGAL FREQUENCY UNIT" 5511 GOTO Drop_dead_err 5512 END IF 5513 IF Inst_value<99 OR Inst_value>5.00000001E+10 THEN 5514 Msg$="FREQUENCY OUT OF RANGE" 5515 GOTO Drop_dead_err 5516 END IF 5517 RETURN 5518 Time_units:! 5519 CALL Convert_units(Inst_value,Inst_unit$) 5520 SELECT Inst_unit$ 5521 CASE "s","sec" 5522 CASE ELSE 5523 Msg$=Inst_unit$&" IS ILLEGAL TIME UNIT" 5524 GOTO Drop_dead_err 5525 END SELECT 5526 RETURN 5527 Power_units:! 5528 SELECT Inst_unit$ 5529 CALL Convert_units(Inst_value,Inst_unit$) 5530 CASE "dBm","dB" 5531 IF Inst_value<-110 OR Inst_value>20 THEN 5532 Msg$="POWER OUT OF RANGE" 5533 GOTO Drop_dead_err 5534 END IF 5535 CASE ELSE 5536 Msg$=Inst_unit$&" IS ILLEGAL POWER UNIT" 5537 GOTO Drop_dead_err 5538 END SELECT 5539 RETURN 5540 Chk_8340_status:! 5541 Start=TIMEDATE 5542 REPEAT 5543 No_errors=1 5544 OUTPUT @Syn_8340;"CS OS" 5545 ENTER @Syn_8340 USING "#,B";Syn_statusbyte1,Syn_statusbyte2 5546 IF BIT(Syn_statusbyte2,6) OR BIT(Syn_statusbyte2,4) THEN 5547 No_errors=0 5548 IF BIT(Syn_statusbyte2,6)=1 THEN 5549 OUTPUT @Syn_8340;"SHAK" 5550 END IF 5551 END IF 5552 Et=TIMEDATE-Start 5553 UNTIL No_errors=1 OR Et>2 5554 IF BIT(Syn_statusbyte2,6)=1 THEN 5555 Error_message$="UNLEVELED" 5556 IF POS(Disable_8340err$(Synth_index,2)," UNLEVELED ")<>0 THEN 5557 SIGNAL 1 5558 ELSE 5559 SIGNAL 0 5560 END IF 5561 END IF 5562 IF BIT(Syn_statusbyte2,4)=1 THEN 5563 Error_message$="UNLOCKED" 5564 SIGNAL 0 5565 END IF 5566 RETURN 5567 Drop_dead_err:! 5568 DISP "8340 at addr "&VAL$(Addr)&" "&Msg$&"--This is Write_8340" 5569 CALL Tone("STOPPED") 5570 PAUSE 5571 STOP 5572 SUBEND 5573 SUB Synth_index(INTEGER Hpib_address,Synth_index) 5574 Synth_index: REM $Header: Synth_index.gp,v 1.2 92/06/24 11:34:23 hmgr Exp $ 5575 COM /Synth_8340_mem/Disable_8340err$(*) 5576 Synth_index=1 5577 REPEAT 5578 IF Disable_8340err$(Synth_index,1)=VAL$(Hpib_address) THEN 5579 SUBEXIT 5580 END IF 5581 Synth_index=Synth_index+1 5582 UNTIL Synth_index>4 5583 Synth_index=1 5584 REPEAT 5585 IF Disable_8340err$(Synth_index,1)="" THEN 5586 Disable_8340err$(Synth_index,1)=VAL$(Hpib_address) 5587 SUBEXIT 5588 END IF 5589 Synth_index=Synth_index+1 5590 UNTIL Synth_index>4 5591 Drop_dead_error:! 5592 DISP "ERROR:GREATER THAN 4 8340'S IN ONE SYSTEM--THIS IS SYNTH_INDEX" 5593 CALL Tone("STOPPED") 5594 PAUSE 5595 PAUSE 5596 STOP 5597 SUBEND 5598 SUB Read_8340(Parameter$,Units$,@Syn_8340,Value,Error_message$) 5599 Read_8340: REM $Header: Read_8340,v 1.2 90/08/29 21:14:52 hmgr Exp $ 5600 INTEGER Hpib_address,Select_code 5601 INTEGER Nothing,Status_byte2 5602 DIM Message$[160] 5603 Error_message$="OK" 5604 Read_8340_again:! 5605 STATUS @Syn_8340,1;Select_code 5606 STATUS @Syn_8340,3;Hpib_address 5607 ON TIMEOUT Select_code,5 GOTO Timeout_8340 5608 GOSUB Read_the_8340 5609 OFF TIMEOUT Select_code 5610 SUBEXIT 5611 Timeout_8340:! 5612 Error_message$="READ_8340 FOUND ADDR "&VAL$(Hpib_address)&" TIMEOUT" 5613 SIGNAL 0 5614 SUBEXIT 5615 Drop_dead:! 5616 DISP "READ_8340 HAS AN ERROR OF "&Message$ 5617 CALL Tone("STOPPED") 5618 PAUSE 5619 PAUSE 5620 STOP 5621 Read_the_8340:! 5622 SELECT Parameter$ 5623 CASE "ARE YOU UNLEVELED","ARE YOU UNLEVELED WITH PASSTHROUGH" 5624 OUTPUT @Syn_8340;"OS" 5625 ENTER @Syn_8340 USING "#,B";Nothing,Status_byte2 5626 OUTPUT @Syn_8340;"OS" 5627 ENTER @Syn_8340 USING "#,B";Nothing,Status_byte2 5628 Value=0 5629 IF BIT(Status_byte2,6) THEN Value=1 5630 CASE "POWER?","POWER" 5631 OUTPUT @Syn_8340;"OPPL" 5632 ENTER @Syn_8340;Value 5633 CASE ELSE 5634 Message$=Parameter$&" IS AN INVALID PARAMETER" 5635 GOTO Drop_dead 5636 END SELECT 5637 RETURN 5638 SUBEND 5639 SUB Connector_prmpt 5640 Connector_prmpt: REM $Header: Connector_prmpt,v 2.7 93/04/13 11:00:31 hmgr Exp $ 5641 INTEGER Sel_code,Clean_period,True,False,No_file 5642 INTEGER Warning,Node_num,Record_length,I,Done,They_are_clean 5643 DIM Msi$[100],File_name$[50],Directory$[100],Temp$[100] 5644 DIM Key_pressed$[25],Msus$[100],Node$[10],Station_name$[100] 5645 DIM Do_it_keys$[50],Skip_it_keys$[50],History_keys$[50],Keys$[100] 5646 DIM Month_last_clnd$[100],Todays_date$[100],Todays_month$[100] 5647 DIM Title$[100] 5648 REAL Delay_time 5649 CLEAR SCREEN 5650 Title$="** Connector Cleaning "&FNRcs_rev$("$Revision: 2.7 $")&" **" 5651 True=1 5652 False=0 5653 Clean_period=30 5654 Warning=3 5655 They_are_clean=False 5656 No_file=False 5657 Do_it_keys$="I did it!," 5658 Skip_it_keys$="DEFAULT=Skip it," 5659 History_keys$="History,Print History," 5660 Record_length=12 5661 ALLOCATE REAL Last_clean_date(Record_length),Tech$(Record_length)[100] 5662 ON ERROR GOTO Not_mgr 5663 CALL Directory_info("MANAGER SYSTEM",Directory$,Msus$) 5664 CALL Directory_info("NODE NUMBER",Node$) 5665 OFF ERROR 5666 GOTO Found_system 5667 Not_mgr: OFF ERROR 5668 Directory$="/SYSTEST_DIR/" 5669 Msi$=SYSTEM$("MSI") 5670 Sel_code=VAL(Msi$[POS(Msi$,":")+8]) 5671 STATUS Sel_code,6;Node_num 5672 Node$=VAL$(Node_num) 5673 Found_system:! 5674 File_name$=Directory$&"Connector_check/Node"&Node$ 5675 Todays_date$=DATE$(TIMEDATE) 5676 Todays_month$=Todays_date$[4;3] 5677 ON ERROR GOTO No_file 5678 ASSIGN @File TO File_name$ 5679 ENTER @File;Station_name$,Last_clean_date(*),Tech$(*) 5680 ASSIGN @File TO * 5681 OFF ERROR 5682 Temp$=DATE$(Last_clean_date(1)) 5683 Month_last_clnd$=Temp$[4;3] 5684 IF Month_last_clnd$=Todays_month$ THEN 5685 They_are_clean=True 5686 ELSE 5687 They_are_clean=False 5688 END IF 5689 GOTO Retreival_done 5690 No_file: OFF ERROR 5691 No_file=True 5692 Retreival_done:! 5693 CLEAR SCREEN 5694 CALL Show_message(Title$,2) 5695 SELECT 1 5696 CASE They_are_clean=True 5697 CALL Show_message(RPT$("* ",25),4) 5698 CALL Show_message("* Station cleaning maintenance is up to date. *",6) 5699 CALL Show_message("* Station Name: "&Station_name$&" at Node "&Node$&" *",8) 5700 CALL Show_message("* Last cleaned by: "&Tech$(1)&" on "&DATE$(Last_clean_date(1))&" at "&TIME$(Last_clean_date(1))&" *",10) 5701 CALL Show_message(RPT$("* ",25),12) 5702 Keys$=Skip_it_keys$&History_keys$ 5703 Delay_time=1 5704 CASE No_file=True,They_are_clean=False 5705 CALL Show_message(RPT$("* ",25),4) 5706 CALL Show_message("** A T T E N T I O N **",6) 5707 CALL Show_message(RPT$("* ",25),8) 5708 IF No_file=True THEN 5709 CALL Show_message("* There's no record of the connectors at this station ever being cleaned. *",11) 5710 Keys$=Do_it_keys$ 5711 IF VAL(Todays_date$[1,3])<5 THEN 5712 Keys$=Keys$&Skip_it_keys$ 5713 END IF 5714 ELSE 5715 CALL Show_message("* Station Name: "&Station_name$&" *",10) 5716 CALL Show_message("* Last cleaned on "&DATE$(Last_clean_date(1))&" at "&TIME$(Last_clean_date(1))&" by "&Tech$(1)&" *",12) 5717 Keys$=Do_it_keys$&History_keys$ 5718 IF VAL(Todays_date$[1,3])<5 THEN 5719 Keys$=Keys$&Skip_it_keys$ 5720 END IF 5721 END IF 5722 CALL Show_message("* It's time to clean the connectors, cables and filters at this station! *",14) 5723 CALL Show_message("* They must be cleaned in the first week of each month. *",16) 5724 CALL Show_message(RPT$("* ",25),18) 5725 Delay_time=10 5726 END SELECT 5727 REPEAT 5728 CALL Prompt_keys(Keys$,Key_pressed$,"Select at key",Delay_time) 5729 SELECT Key_pressed$ 5730 CASE "I did it!" 5731 FOR I=Record_length TO 2 STEP -1 5732 Last_clean_date(I)=Last_clean_date(I-1) 5733 Tech$(I)=Tech$(I-1) 5734 NEXT I 5735 IF No_file=True THEN 5736 CREATE BDAT File_name$,1 5737 CALL Kbd_input("ALL","",Station_name$,"Enter station name:") 5738 END IF 5739 CALL Kbd_input("ALPHA","",Tech$(1),"Who are you?") 5740 Last_clean_date(1)=TIMEDATE 5741 ASSIGN @File TO File_name$ 5742 OUTPUT @File;Station_name$,Last_clean_date(*),Tech$(*) 5743 ASSIGN @File TO * 5744 Done=True 5745 CLEAR SCREEN 5746 CASE "History","Print History" 5747 CLEAR SCREEN 5748 IF Key_pressed$="Print History" THEN 5749 DISP "Printing history..." 5750 PRINTER IS 701 5751 END IF 5752 PRINT "** Cleaning Maintenance History **" 5753 PRINT Station_name$;" at Node ";Node$,DATE$(TIMEDATE),TIME$(TIMEDATE) 5754 PRINT 5755 I=1 5756 WHILE Last_clean_date(I)<>0 AND I<=Record_length 5757 PRINT "Cleaned by ";Tech$(I);" on ";DATE$(Last_clean_date(I));" at ";TIME$(Last_clean_date(I)) 5758 I=I+1 5759 END WHILE 5760 IF Key_pressed$="Print History" THEN 5761 PRINTER IS 1 5762 DISP 5763 END IF 5764 CASE "Skip it","" 5765 Done=True 5766 END SELECT 5767 UNTIL Done=True 5768 CLEAR SCREEN 5769 SUBEND 5770 SUB Setup_5342(Control$,@Ctr,Error_message$) 5771 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 5772 Setup_5342:! 5773 DIM Command$[30],Rest_of_command$[24],Message$[80] 5774 INTEGER Hpib_address,Select_code,Last_command 5775 ALLOCATE Rest_of_control$[LEN(Control$)] 5776 Error_message$="OK" 5777 The_beginning:! 5778 Rest_of_control$=Control$ 5779 STATUS @Ctr,0;Io_path_exists 5780 IF Io_path_exists<>1 THEN 5781 Message$="The 5342 has not been ASSIGNed an I/O path" 5782 GOTO Drop_dead_error 5783 END IF 5784 STATUS @Ctr,1;Select_code 5785 STATUS @Ctr,3;Hpib_address 5786 ON TIMEOUT Select_code,1 GOTO Timeout_5342 5787 REPEAT 5788 CALL Command_parser(Rest_of_control$,Command$,Value_n_unit$,Last_command) 5789 GOSUB Execute_command 5790 UNTIL Last_command=1 5791 Exit_context:! 5792 OFF TIMEOUT Select_code 5793 IF Error_message$<>"OK" THEN 5794 Error_message$=Error_message$&" -- Setup_5342 @ "&VAL$(Hpib_address) 5795 SIGNAL 0 5796 END IF 5797 SUBEXIT 5798 Timeout_5342:! 5799 IF POS(Control$,"PRESET") THEN 5800 CALL Tone("ALERT") 5801 Message$="Setup_5342 at "&VAL$(Hpib_address)&" -- TIMEOUT. Please fix and press `TRY AGAIN'." 5802 CALL Prompt_keys(" TRY AGAIN",Key_pressed$,Message$) 5803 GOTO The_beginning 5804 ELSE 5805 Error_message$="TIMEOUT" 5806 GOTO Exit_context 5807 END IF 5808 Drop_dead_error:! 5809 DISP Message$&" -- Setup_5342." 5810 CALL Tone("STOPPED") 5811 PAUSE 5812 STOP 5813 Execute_command:! 5814 SELECT Command$ 5815 CASE "PRESET" 5816 OUTPUT @Ctr;"AU AM0 C SR3 L T0 ST1" 5817 CASE "FREQUENCY" 5818 OUTPUT @Ctr;"AU" 5819 CASE "AMPLITUDE ON" 5820 OUTPUT @Ctr;"AM1" 5821 CASE "AMPLITUDE OFF" 5822 OUTPUT @Ctr;"AM0" 5823 CASE "CW MODE" 5824 OUTPUT @Ctr;"C" 5825 CASE "FM MODE" 5826 OUTPUT @Ctr;"F" 5827 CASE "FRONT PANEL SAMPLE RATE" 5828 OUTPUT @Ctr;"T0" 5829 CASE "HOLD SAMPLE" 5830 OUTPUT @Ctr;"T1" 5831 CASE "FAST SAMPLE" 5832 OUTPUT @Ctr;"T2" 5833 CASE "SAMPLE THEN HOLD" 5834 OUTPUT @Ctr;"T3" 5835 CASE "OUTPUT ONLY WHEN ADDRESSED" 5836 OUTPUT @Ctr;"ST1" 5837 CASE "WAIT UNTIL ADDRESSED" 5838 OUTPUT @Ctr;"ST2" 5839 CASE "RESET" 5840 OUTPUT @Ctr;"RE" 5841 CASE "LOW FREQ RANGE" 5842 OUTPUT @Ctr;"L" 5843 CASE "HIGH FREQ RANGE" 5844 OUTPUT @Ctr;"H" 5845 CASE "RESOLUTION" 5846 SELECT Value_n_unit$ 5847 CASE "1 Hz" 5848 OUTPUT @Ctr;"SR3" 5849 CASE "10 Hz" 5850 OUTPUT @Ctr;"SR4" 5851 CASE "100 Hz" 5852 OUTPUT @Ctr;"SR5" 5853 CASE "1 kHz","1000 Hz" 5854 OUTPUT @Ctr;"SR6" 5855 CASE "10 kHz","10000 Hz",".01 MHz" 5856 OUTPUT @Ctr;"SR7" 5857 CASE "100 kHz",".1 MHz" 5858 OUTPUT @Ctr;"SR8" 5859 CASE "1 MHz" 5860 OUTPUT @Ctr;"SR9" 5861 CASE ELSE 5862 Message$=Value_n_unit$&" -- INVALID RESOLUTION UNIT" 5863 GOTO Drop_dead_error 5864 END SELECT 5865 CASE ELSE 5866 Message$=Command$&" -- INVALID CONTROL VARIABLE" 5867 GOTO Drop_dead_error 5868 END SELECT 5869 RETURN 5870 SUBEND 5871 SUB Setup_3478(Control$,@Dmm,Error_message$) 5872 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 5873 Setup_3478:! 5874 DIM Command$[30],Rest_of_command$[24],Message$[80] 5875 INTEGER Io_path_exists,Hpib_address,Select_code,Last_command 5876 INTEGER Sw_position 5877 ALLOCATE Rest_of_control$[LEN(Control$)] 5878 Error_message$="OK" 5879 Setupinst_again:! 5880 Rest_of_control$=Control$ 5881 STATUS @Dmm,0;Io_path_exists 5882 IF Io_path_exists<>1 THEN 5883 Message$="The 3478 has not been ASSIGNed an I/O path." 5884 GOTO Drop_dead_error 5885 END IF 5886 STATUS @Dmm,1;Select_code 5887 STATUS @Dmm,3;Hpib_address 5888 ON TIMEOUT Select_code,1 GOTO Timeout_3478 5889 REPEAT 5890 CALL Command_parser(Rest_of_control$,Command$,Value_n_unit$,Last_command) 5891 GOSUB Execute_command 5892 UNTIL Last_command=1 5893 Exit_context:! 5894 OFF TIMEOUT Select_code 5895 IF Error_message$<>"OK" THEN 5896 IF Error_message$[1,3]="OK," THEN 5897 Error_message$=Error_message$[4] 5898 END IF 5899 Error_message$=Error_message$&" Setup_3478 @ "&VAL$(Hpib_address) 5900 SIGNAL 0 5901 END IF 5902 SUBEXIT 5903 Timeout_3478:! 5904 IF POS(Control$,"PRESET") THEN 5905 CALL Tone("ALERT") 5906 CALL Prompt_keys("CONTINUE",Key_pressed$,"Setup_3478 at "&VAL$(Hpib_address)&" -- TIMEOUT. Please FIX and press 'CONTINUE'") 5907 GOTO Setupinst_again 5908 ELSE 5909 Error_message$="TIMEOUT" 5910 GOTO Exit_context 5911 END IF 5912 Drop_dead_error:! 5913 DISP Message$&" -- Setup_3478 @ "&VAL$(Hpib_address) 5914 CALL Tone("STOPPED") 5915 PAUSE 5916 STOP 5917 SUBEXIT 5918 Execute_command:! 5919 SELECT Command$ 5920 CASE "PRESET" 5921 CLEAR @Dmm 5922 OUTPUT @Dmm;"M04" 5923 OUTPUT @Dmm;"TRASH" 5924 Dmm_status_byte=SPOLL(@Dmm) 5925 CLEAR @Dmm 5926 IF Dmm_status_byte<>68 THEN 5927 Error_message$="WRONG INSTRUMENT" 5928 GOTO Exit_context 5929 END IF 5930 OUTPUT @Dmm;"H0" 5931 CASE "LOCAL" 5932 OUTPUT @Dmm;"RA T1" 5933 LOCAL @Dmm 5934 CASE "REMOTE" 5935 REMOTE @Dmm 5936 OUTPUT @Dmm;"T1" 5937 CASE "DC VOLTS" 5938 OUTPUT @Dmm;"F1 T1" 5939 CASE "AC VOLTS" 5940 OUTPUT @Dmm;"F2 T1" 5941 CASE "2 WIRE RESISTANCE" 5942 OUTPUT @Dmm;"F3 T1" 5943 CASE "4 WIRE RESISTANCE" 5944 OUTPUT @Dmm;"F4 T1" 5945 CASE "DC AMPS" 5946 OUTPUT @Dmm;"F5 T1" 5947 CASE "AC AMPS" 5948 OUTPUT @Dmm;"F6 T1" 5949 CASE "EXTENDED RESISTANCE" 5950 OUTPUT @Dmm;"F7 T1" 5951 CASE "3 DIGITS" 5952 OUTPUT @Dmm;"N3" 5953 CASE "4 DIGITS" 5954 OUTPUT @Dmm;"N4" 5955 CASE "5 DIGITS" 5956 OUTPUT @Dmm;"N5" 5957 CASE "INT TRIG" 5958 OUTPUT @Dmm;"T1" 5959 CASE "EXT TRIG" 5960 OUTPUT @Dmm;"T2" 5961 CASE "SINGLE TRIG" 5962 OUTPUT @Dmm;"T3" 5963 CASE "HOLD TRIG" 5964 OUTPUT @Dmm;"T4" 5965 CASE "FAST TRIG" 5966 OUTPUT @Dmm;"T5" 5967 CASE "AUTOZERO ON" 5968 OUTPUT @Dmm;"Z1" 5969 CASE "AUTOZERO OFF" 5970 OUTPUT @Dmm;"Z0" 5971 CASE "AUTORANGE" 5972 OUTPUT @Dmm;"RA" 5973 CASE "RANGE" 5974 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 5975 SELECT Unit$ 5976 CASE "V" 5977 SELECT Value 5978 CASE .03 5979 OUTPUT @Dmm;"R-2" 5980 CASE .3 5981 OUTPUT @Dmm;"R-1" 5982 CASE 3 5983 OUTPUT @Dmm;"R0" 5984 CASE 30 5985 OUTPUT @Dmm;"R1" 5986 CASE 300 5987 OUTPUT @Dmm;"R2" 5988 CASE ELSE 5989 Message$=VAL$(Value)&" "&Unit$&" is not a valid RANGE setting." 5990 GOTO Drop_dead_error 5991 END SELECT 5992 CASE "OHMS" 5993 SELECT Value 5994 CASE 30 5995 OUTPUT @Dmm;"R1" 5996 CASE 300 5997 OUTPUT @Dmm;"R2" 5998 CASE 3000 5999 OUTPUT @Dmm;"R3" 6000 CASE 3.E+4 6001 OUTPUT @Dmm;"R4" 6002 CASE 3.E+5 6003 OUTPUT @Dmm;"R5" 6004 CASE 3.E+6 6005 OUTPUT @Dmm;"R6" 6006 CASE 3.E+7 6007 OUTPUT @Dmm;"R7" 6008 CASE ELSE 6009 Message$=VAL$(Value)&" "&Unit$&" is not a valid RANGE setting." 6010 GOTO Drop_dead_error 6011 END SELECT 6012 CASE "A" 6013 SELECT Value 6014 CASE .3 6015 OUTPUT @Dmm;"R-1" 6016 CASE 3 6017 OUTPUT @Dmm;"R0" 6018 CASE ELSE 6019 Message$=VAL$(Value)&" "&Unit$&" is not a valid RANGE setting." 6020 GOTO Drop_dead_error 6021 END SELECT 6022 CASE ELSE 6023 Message$="You have entered an invalid UNIT." 6024 GOTO Drop_dead_error 6025 END SELECT 6026 CASE "FRONT INPUT" 6027 LOOP 6028 OUTPUT @Dmm;"T1,S" 6029 ENTER @Dmm;Sw_position 6030 EXIT IF Sw_position=1 6031 CALL Tone("ALERT") 6032 Message$="Please change the TERMINAL button to the FRONT position on the 3478 at "&VAL$(Hpib_address) 6033 CALL Prompt_keys("CONTINUE",Key_pressed$,Message$) 6034 END LOOP 6035 CASE "REAR INPUT" 6036 LOOP 6037 OUTPUT @Dmm;"T1,S" 6038 ENTER @Dmm;Sw_position 6039 EXIT IF Sw_position=0 6040 CALL Tone("ALERT") 6041 Message$="Please change the TERMINAL button to REAR position on the 3478 at "&VAL$(Hpib_address) 6042 CALL Prompt_keys("CONTINUE",Key_pressed$,Message$) 6043 END LOOP 6044 CASE ELSE 6045 Message$=Command$&" is an INVALID CONTROL VARIABLE." 6046 GOTO Drop_dead_error 6047 END SELECT 6048 RETURN 6049 SUBEND 6050 SUB Read_3478(Parameter$,Units$,@Dmm,Value,Error_message$) 6051 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6052 Read_3478:! 6053 DIM Message$[80] 6054 INTEGER Io_path_exists,Hpib_address,Select_code 6055 REAL Inst_value 6056 Error_message$="OK" 6057 Readinst_again:! 6058 STATUS @Dmm,0;Io_path_exists 6059 IF Io_path_exists<>1 THEN 6060 Message$="The 3478 has not been ASSIGNed an I/O path." 6061 GOTO Drop_dead_error 6062 END IF 6063 STATUS @Dmm,1;Select_code 6064 STATUS @Dmm,3;Hpib_address 6065 ON TIMEOUT Select_code,5 GOTO Timeout_3478 6066 GOSUB Read_from_inst 6067 OFF TIMEOUT Select_code 6068 IF Error_message$<>"OK" THEN 6069 Error_message$=Error_message$&"--Read_3478 @ "&VAL$(Hpib_address) 6070 SIGNAL 0 6071 END IF 6072 SUBEXIT 6073 Timeout_3478:! 6074 Message$="The 3478 at "&VAL$(Hpib_address)&" doesn't answer. Please FIX and press CONTINUE" 6075 CALL Prompt_keys("CONTINUE",Key_pressed$,Message$) 6076 GOTO Readinst_again 6077 Drop_dead_error:! 6078 DISP Message$&" -- Read_3478 @ "&VAL$(Hpib_address) 6079 CALL Tone("STOPPED") 6080 PAUSE 6081 STOP 6082 Read_from_inst:! 6083 SELECT Parameter$ 6084 CASE "DC VOLTS" 6085 OUTPUT @Dmm;"F1 T1" 6086 TRIGGER @Dmm 6087 ENTER @Dmm;Inst_value 6088 GOSUB Volts 6089 CASE "AC VOLTS" 6090 OUTPUT @Dmm;"F2 T1" 6091 TRIGGER @Dmm 6092 ENTER @Dmm;Inst_value 6093 GOSUB Volts 6094 CASE "2 WIRE RESISTANCE" 6095 OUTPUT @Dmm;"F3 T1" 6096 TRIGGER @Dmm 6097 ENTER @Dmm;Inst_value 6098 GOSUB Ohms 6099 CASE "4 WIRE RESISTANCE" 6100 OUTPUT @Dmm;"F4 T1" 6101 TRIGGER @Dmm 6102 ENTER @Dmm;Inst_value 6103 GOSUB Ohms 6104 CASE "DC AMPS" 6105 OUTPUT @Dmm;"F5 T1" 6106 TRIGGER @Dmm 6107 ENTER @Dmm;Inst_value 6108 GOSUB Amps 6109 CASE "AC AMPS" 6110 OUTPUT @Dmm;"F6 T1" 6111 TRIGGER @Dmm 6112 ENTER @Dmm;Inst_value 6113 GOSUB Amps 6114 CASE "EXTENDED RESISTANCE" 6115 OUTPUT @Dmm;"F7 T1" 6116 TRIGGER @Dmm 6117 ENTER @Dmm;Inst_value 6118 GOSUB Ohms 6119 CASE ELSE 6120 Message$=Parameter$&" is an INVALID parameter." 6121 GOTO Drop_dead_error 6122 END SELECT 6123 RETURN 6124 Volts:! 6125 SELECT Units$ 6126 CASE "mV" 6127 Value=Inst_value*1000 6128 CASE "V" 6129 Value=Inst_value 6130 CASE ELSE 6131 Message$=Units$&" is an INVALID unit for Voltage." 6132 GOTO Drop_dead_error 6133 END SELECT 6134 RETURN 6135 Ohms:! 6136 SELECT Units$ 6137 CASE "OHMS" 6138 Value=Inst_value 6139 CASE "kOHMS" 6140 Value=Inst_value/1000 6141 CASE "MOHMS" 6142 Value=Inst_value/1.0E+6 6143 CASE ELSE 6144 Message$=Units$&" is an INVALID unit for Resistance." 6145 GOTO Drop_dead_error 6146 END SELECT 6147 RETURN 6148 Amps:! 6149 SELECT Units$ 6150 CASE "mA" 6151 Value=Inst_value*1000 6152 CASE "A" 6153 Value=Inst_value 6154 CASE ELSE 6155 Message$=Units$&" is an INVALID unit for Current." 6156 GOTO Drop_dead_error 6157 END SELECT 6158 RETURN 6159 SUBEND 6160 SUB Auto_read_3478(Desired_value,Tolerance,Io_value,@Dmm) 6161 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6162 Auto_read_3478:! 6163 DIM Message$[80] 6164 INTEGER Io_path_exists,Hpib_address,Select_code 6165 REAL Inst_value 6166 Error_message$="OK" 6167 Readinst_again:! 6168 STATUS @Dmm,0;Io_path_exists 6169 IF Io_path_exists<>1 THEN 6170 Message$="The 3478 has not been ASSIGNed an I/O path." 6171 GOTO Drop_dead_error 6172 END IF 6173 STATUS @Dmm,1;Select_code 6174 STATUS @Dmm,3;Hpib_address 6175 ON TIMEOUT Select_code,5 GOTO Timeout_3478 6176 GOTO Read_from_inst 6177 Timeout_3478:! 6178 Message$="The 3478 at "&VAL$(Hpib_address)&" doesn't answer. Please FIX and press CONTINUE" 6179 CALL Prompt_keys("CONTINUE",Key_pressed$,Message$) 6180 GOTO Readinst_again 6181 Drop_dead_error:! 6182 DISP Message$&" -- Auto_read_3478 @ "&VAL$(Hpib_address) 6183 CALL Tone("STOPPED") 6184 PAUSE 6185 STOP 6186 Read_from_inst:! 6187 OUTPUT @Dmm;"F1 T1 N3" 6188 ENTER @Dmm;Value1 6189 ENTER @Dmm;Value2 6190 LOOP 6191 ENTER @Dmm;Value3 6192 Average=(Value1+Value2+Value3)/3 6193 Error=MAX(Value1,Value2,Value3)-MIN(Value1,Value2,Value3) 6194 EXIT IF ABS(Average-Desired_value)6 AND LEN(Cal_code$)<9 AND POS(Cal_code$,"RP_") 6224 Prompt_keys(" TRY AGAIN, NEVER MIND",What_next$,Cal_code$&" is not a valid entry -- 'TRY AGAIN' or 'NEVER MIND'.") 6225 IF TRIM$(What_next$)="NEVER MIND" THEN GOTO Snsr_exit 6226 END LOOP 6227 Sr_num$="RP"&Cal_code$[4] 6228 Cal_directory$=Directory$&Sr_num$&Msus$ 6229 ON ERROR GOTO Not_on_disk 6230 ASSIGN @Sensor TO Cal_directory$ 6231 OFF ERROR 6232 ASSIGN @Sensor TO * 6233 Prompt_keys(" ENTER AGAIN, EXIT",Key_pressed$,"There is already a file on the SYSTEM DISK for this Cal Number.") 6234 IF TRIM$(Key_pressed$)="EXIT" THEN GOTO Snsr_exit 6235 Cal_disk_stuff:! 6236 Clr_scr 6237 Show_message(Title$,2) 6238 Prompt_keys(":HP9121_700_0,:INTERNAL 4_0,:HP9122_700_0, OTHER",Drive$,"Select the Disk Drive MSUS for the sensor data disk.") 6239 SELECT Drive$ 6240 CASE ":INTERNAL 4_0" 6241 Drive_msi$=":INTERNAL,4,0" 6242 CASE ":HP9121_700_0" 6243 Drive_msi$=":HP9121,700,0" 6244 CASE ":HP9122_700_0" 6245 Drive_msi$=":HP9122,700,0" 6246 CASE "OTHER" 6247 LINPUT "ENTER MSUS OF SENSOR DATA",Drive_msi$ 6248 END SELECT 6249 Msg$="Place disk in the drive .... and press 'READY'." 6250 Prompt_keys(" READY",Key_pressed$,Msg$) 6251 Cal_disk_file$=Cal_code$&Drive_msi$ 6252 ON ERROR GOTO No_file 6253 ASSIGN @Data TO Cal_disk_file$ 6254 OFF ERROR 6255 DISP "Reading sensor HEADER file from floppy disc." 6256 ENTER @Data,13;Header_info$(1) 6257 ENTER @Data,14;Header_info$(2) 6258 ASSIGN @Data TO * 6259 Num_data_points=VAL(Header_info$(1)[POS(Header_info$(1),":")+1]) 6260 Rows=VAL(Header_info$(2)[POS(Header_info$(2),":")+1]) 6261 ALLOCATE Sensor_data(1:Rows,1:Num_data_points) 6262 Data_file_name$=Cal_code$&"_DT" 6263 Cal_disk_file$=Data_file_name$&Drive_msi$ 6264 ON ERROR GOTO No_file 6265 ASSIGN @Data TO Cal_disk_file$ 6266 OFF ERROR 6267 DISP "Reading SENSOR DATA file from floppy disc." 6268 ENTER @Data;Sensor_data(*) 6269 ASSIGN @Data TO * 6270 FOR Data_point=1 TO Num_data_points 6271 Pwr_snsr_cal(1,Data_point)=INT(Sensor_data(1,Data_point)*1000) 6272 Pwr_snsr_cal(2,Data_point)=INT(Sensor_data(2,Data_point)*10) 6273 NEXT Data_point 6274 ON ERROR GOSUB No_storage_file 6275 ASSIGN @Disk TO Cal_directory$ 6276 OFF ERROR 6277 DISP "STORING the sensor data on the SYSTEM disk." 6278 OUTPUT @Disk;Pwr_snsr_cal(*),Model$ 6279 ASSIGN @Disk TO * 6280 Snsr_exit:! 6281 Clr_scr 6282 SUBEXIT 6283 Not_on_disk:! 6284 OFF ERROR 6285 ASSIGN @Sensor TO * 6286 IF ERRN<>56 THEN GOTO Stop_program 6287 GOTO Cal_disk_stuff 6288 No_file:! 6289 OFF ERROR 6290 ASSIGN @Data TO * 6291 Prompt_keys("TRY DISK AGAIN, EXIT,,DIFF SNSR NUM",Key_pressed$,"Did not find "&Cal_disk_file$) 6292 IF TRIM$(Key_pressed$)="TRY DISK AGAIN" THEN GOTO Cal_disk_stuff 6293 IF TRIM$(Key_pressed$)="DIFF SNSR NUM" THEN GOTO Snsr_enter 6294 IF TRIM$(Key_pressed$)="EXIT" THEN GOTO Snsr_exit 6295 No_storage_file:! 6296 OFF ERROR 6297 ASSIGN @Disk TO * 6298 IF ERRN<>56 THEN GOTO Stop_program 6299 CREATE BDAT Cal_directory$,Num_recs 6300 ASSIGN @Disk TO Cal_directory$ 6301 RETURN 6302 Stop_program:! 6303 Clr_scr 6304 Show_message(Title$,2) 6305 Show_message("The program has STOPPED.",9) 6306 Show_message("Fix the problem then press 'RUN'.",12) 6307 DISP ERRM$ 6308 STOP 6309 SUBEND 6310 SUB Read_5342(Parameter$,Units$,@Ctr,Value,Error_message$) 6311 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6312 Read_5342:! 6313 DIM Message$[80] 6314 INTEGER Io_path_exists,Hpib_address,Select_code 6315 REAL Inst_value 6316 Error_message$="OK" 6317 The_beginning:! 6318 STATUS @Ctr,0;Io_path_exists 6319 IF Io_path_exists<>1 THEN 6320 Message$="The 5342 has not been ASSIGNed an I/O path -- Read_5342" 6321 GOTO Drop_dead_error 6322 END IF 6323 STATUS @Ctr,1;Select_code 6324 STATUS @Ctr,3;Hpib_address 6325 ON TIMEOUT Select_code,11 GOTO Timeout_5342 6326 GOSUB Read_from_5342 6327 Exit_context:! 6328 OFF TIMEOUT Select_code 6329 IF Error_message$<>"OK" THEN 6330 Error_message$=Error_message$&" -- Read_5342 @ "&VAL$(Hpib_address) 6331 SIGNAL 0 6332 END IF 6333 SUBEXIT 6334 Timeout_5342:! 6335 Error_message$="TIMEOUT" 6336 GOTO Exit_context 6337 Drop_dead_error:! 6338 DISP Message$&" -- Read_5342 @ "&VAL$(Hpib_address) 6339 CALL Tone("STOPPED") 6340 PAUSE 6341 STOP 6342 Read_from_5342:! 6343 SELECT Parameter$ 6344 CASE "FREQUENCY","FREQ" 6345 OUTPUT @Ctr;"T3" 6346 ENTER @Ctr;Inst_value 6347 GOSUB Freq_units 6348 CASE "AMPLITUDE","AMPL" 6349 OUTPUT @Ctr;"AM1 T3" 6350 ENTER @Ctr;Nothing,Value 6351 CASE ELSE 6352 Message$=Parameter$&" is INVALID" 6353 GOTO Drop_dead_error 6354 END SELECT 6355 OUTPUT @Ctr;"T0" 6356 RETURN 6357 Freq_units:! 6358 SELECT Units$ 6359 CASE "Hz" 6360 Value=Inst_value 6361 CASE "kHz" 6362 Value=Inst_value/1000 6363 CASE "MHz" 6364 Value=Inst_value/1.E+6 6365 CASE ELSE 6366 Message$=Units$&" is an INVALID unit for Freq_units" 6367 GOTO Drop_dead_error 6368 END SELECT 6369 RETURN 6370 SUBEND 6371 SUB Kbd_input(Chars_enabled$,Key_labels$,Kbd_entry$,OPTIONAL Display_line$,Enter_key_label$,Default$) 6372 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6373 Kbd_input: REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6374 DIM Label$(0:9)[50],Key$[160],Custom$[50],Char_group$[80],Unused$[160] 6375 DIM Char_set$[300],Second_char$[1],Imm_execute_key$[160],K$[160] 6376 INTEGER Last_command,Label_num,Key5_posn,Enable_capslock,Read_pos 6377 ALLOCATE Key_labels_left$[MAX(LEN(Key_labels$),1)] 6378 ALLOCATE Rest_chars_en$[LEN(Chars_enabled$)+1] 6379 Rest_chars_en$=Chars_enabled$ 6380 REPEAT 6381 CALL Command_parser(Rest_chars_en$,Char_group$,Custom$,Last_command) 6382 SELECT Char_group$ 6383 CASE "ALL" 6384 Char_set$[LEN(Char_set$)+1]="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" 6385 Char_set$[LEN(Char_set$)+1]="abcdefghijklmnopqrstuvwxyz)!@#$%^&*(" 6386 Char_set$[LEN(Char_set$)+1]="-_=+[{}]:;'<,>.?/ """ 6387 Enable_capslock=1 6388 CASE "NUMERIC" 6389 Char_set$[LEN(Char_set$)+1]="0123456789" 6390 CASE "ALPHA" 6391 Char_set$[LEN(Char_set$)+1]="ABCDEFGHIJKLMNOPQRSTUVWXYZ " 6392 Char_set$[LEN(Char_set$)+1]="abcdefghijklmnopqrstuvwxyz" 6393 Enable_capslock=1 6394 CASE "PUNCTUATION" 6395 Char_set$[LEN(Char_set$)+1]=",./;:'[]{}()&!@#$%""" 6396 CASE "COMMA" 6397 Char_set$[LEN(Char_set$)+1]="," 6398 CASE "DECIMAL","PERIOD" 6399 Char_set$[LEN(Char_set$)+1]="." 6400 CASE "MATH SYMBOLS" 6401 Char_set$[LEN(Char_set$)+1]="+-*/^)(E%=" 6402 CASE "CUSTOM" 6403 Char_set$[LEN(Char_set$)+1]=Custom$ 6404 IF Custom$=UPC$(Custom$) THEN 6405 CONTROL KBD,0;1 6406 ELSE 6407 Enable_capslock=1 6408 END IF 6409 CASE "CUSTOM KEYPAD" 6410 Char_set$[LEN(Char_set$)+1]="0123456789 +-*/,E." 6411 CASE "ENABLE CAPS LOCK" 6412 Enable_capslock=1 6413 END SELECT 6414 UNTIL Last_command 6415 DISABLE 6416 IF NPAR=5 THEN 6417 ON KEY 5 LABEL FNFix_sftky_lbl$(Enter_key_label$) GOSUB Do_nothing 6418 ELSE 6419 ON KEY 5 LABEL "ENTER" GOSUB Do_nothing 6420 END IF 6421 Eight_keys:! 6422 DATA 6, 7, 8, 0, 1, 2, 3, 4 6423 Six_keys:! 6424 DATA 6, 7, 1, 2, 3, 4 6425 IF FNKbd_type_ut$="46020A" THEN 6426 RESTORE Six_keys 6427 ELSE 6428 RESTORE Eight_keys 6429 END IF 6430 Key_labels_left$=Key_labels$ 6431 Last_command=0 6432 REPEAT 6433 READ Label_num 6434 IF NOT Last_command THEN 6435 CALL Command_parser(Key_labels_left$,Label$(Label_num),Unused$,Last_command) 6436 IF Unused$<>"" THEN Label$(Label_num)=Label$(Label_num)&"="&Unused$ 6437 ELSE 6438 Label$(Label_num)="" 6439 END IF 6440 ON KEY Label_num LABEL FNFix_sftky_lbl$(Label$(Label_num)) GOSUB Do_nothing 6441 UNTIL Label_num=4 6442 IF NPAR>=4 THEN 6443 IF Display_line$<>"" THEN DISP Display_line$ 6444 END IF 6445 Imm_execute_key$="" 6446 IF NPAR>=6 THEN 6447 Read_pos=POS(Default$,"=")+1 6448 OUTPUT KBD;Default$&"ÿH"&RPT$("ÿ>",Read_pos-1); 6449 ELSE 6450 Read_pos=1 6451 END IF 6452 Wait_for_key:! 6453 ON KBD ALL GOTO Kbd_service 6454 ENABLE 6455 LOOP 6456 END LOOP 6457 Do_nothing: RETURN 6458 Exit_kbd_input:! 6459 OUTPUT KBD;"ÿHÿ+K$=""ÿ+ÿG""ÿE"; 6460 Kbd_entry$=TRIM$(K$[Read_pos]&Imm_execute_key$) 6461 IF NPAR>=4 THEN 6462 IF Display_line$<>"" THEN DISP "" 6463 END IF 6464 OUTPUT KBD;"ÿ#"; 6465 SUBEXIT 6466 Kbd_service:! 6467 Key$=KBD$ 6468 SELECT NUM(Key$[1;1]) 6469 CASE 0 TO 254 6470 IF POS(Char_set$,Key$) THEN 6471 OUTPUT KBD;Key$; 6472 END IF 6473 CASE 255 6474 Second_char$=Key$[2;1] 6475 SELECT Second_char$ 6476 CASE "0" TO "4","6" TO "7" 6477 GOSUB Typing_aid_key 6478 CASE "5","C","X","E" 6479 GOTO Exit_kbd_input 6480 CASE "8" 6481 IF FNKbd_type_ut$="46020A" THEN 6482 OUTPUT KBD;Key$; 6483 ELSE 6484 GOSUB Typing_aid_key 6485 END IF 6486 CASE "9","P" 6487 OUTPUT KBD;Key$; 6488 CASE "#","?","@","+","-","%" 6489 OUTPUT KBD;Key$; 6490 CASE "V","^","<",">","B","T","W","H","G" 6491 OUTPUT KBD;Key$; 6492 CASE "U" 6493 IF Enable_capslock=1 THEN 6494 OUTPUT KBD;Key$; 6495 END IF 6496 END SELECT 6497 END SELECT 6498 GOTO Wait_for_key 6499 Typing_aid_key:! 6500 Key5_posn=POS(Label$(VAL(Second_char$)),"ÿ5") 6501 IF Key5_posn>0 THEN 6502 Imm_execute_key$=Label$(VAL(Second_char$))[1,Key5_posn-1] 6503 GOTO Exit_kbd_input 6504 ELSE 6505 OUTPUT KBD;Label$(VAL(Second_char$)); 6506 END IF 6507 RETURN 6508 SUBEND 6509 SUB Meter_coms 6510 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6511 Meter_coms:! 6512 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6513 COM /Max_min_hold/Min_val,Max_val,INTEGER Min_hold_flg,Max_hold_flg 6514 COM /Meter_status/Meter_type$[30],New_meter,Last_val,Polarity 6515 COM /Meter_scale/Ccw_value,Cw_value,Range_mult,Range_value,Center_value 6516 COM /Compensation/Offset,Compen 6517 SUBEND 6518 SUB Zero_ctr_mtr(Function$,Range_mult) 6519 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6520 Zero_ctr_mtr:! 6521 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6522 SELECT Function$ 6523 CASE "DRAW" 6524 PEN 0 6525 AREA INTENSITY .055,.055,.055 6526 MOVE -10/Range_mult,-8 6527 RECTANGLE 20/Range_mult,16 6528 CASE "ERASE" 6529 PEN 1 6530 AREA INTENSITY 0,0,0 6531 PEN -1 6532 MOVE -10/Range_mult,-8 6533 RECTANGLE 20/Range_mult,16 6534 END SELECT 6535 MOVE -49.5,-2.25 6536 RECTANGLE 49-(10/Range_mult),.7,FILL 6537 MOVE -49.5,1.5 6538 RECTANGLE 49-(10/Range_mult),.7,FILL 6539 MOVE 10.5/Range_mult,-2.25 6540 RECTANGLE 49-10/Range_mult,.7,FILL 6541 MOVE 10.5/Range_mult,1.50 6542 RECTANGLE 49-10/Range_mult,.7,FILL 6543 SUBEND 6544 SUB Indicator(Function$,OPTIONAL Value) 6545 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6546 Indicator:! 6547 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6548 COM /Max_min_hold/Min_val,Max_val,INTEGER Min_hold_flg,Max_hold_flg 6549 COM /Meter_status/Meter_type$,New_meter,Last_val,Polarity 6550 COM /Meter_scale/Ccw_value,Cw_value,Range_mult,Range_value,Center_value 6551 SELECT Function$ 6552 CASE "DRAW" 6553 Indicate_pos=50*(Value-Center_value)/(Range_value/2*Range_mult) 6554 Indicate_pos=MIN(49,MAX(Indicate_pos,-49)) 6555 Last_val=Indicate_pos 6556 CASE "ERASE" 6557 Indicate_pos=Last_val 6558 END SELECT 6559 PEN 0 6560 MOVE Indicate_pos,-6 6561 DRAW Indicate_pos,6 6562 IMOVE -2,-6 6563 IDRAW +4,0 6564 SUBEND 6565 SUB Hold_indicator(Function$,Which_one$,Scale_factor,OPTIONAL Value) 6566 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6567 Hold_indicator:! 6568 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6569 COM /Max_min_hold/Min_val,Max_val,INTEGER Min_hold_flg,Max_hold_flg 6570 COM /Meter_status/Meter_type$,New_meter,Last_val,Polarity 6571 COM /Meter_scale/Ccw_value,Cw_value,Range_mult,Range_value,Center_value 6572 SELECT Function$ 6573 CASE "DRAW" 6574 Indicator_val=Value 6575 SELECT Which_one$ 6576 CASE "MIN" 6577 IF Polarity=1 THEN 6578 GOSUB Ccw_indicator 6579 ELSE 6580 GOSUB Cw_indicator 6581 END IF 6582 Min_val=Value 6583 CASE "MAX" 6584 IF Polarity=1 THEN 6585 GOSUB Cw_indicator 6586 ELSE 6587 GOSUB Ccw_indicator 6588 END IF 6589 Max_val=Value 6590 END SELECT 6591 CASE "ERASE" 6592 SELECT Which_one$ 6593 CASE "MIN" 6594 Indicator_val=Min_val 6595 IF Polarity=1 THEN 6596 GOSUB Ccw_indicator 6597 ELSE 6598 GOSUB Cw_indicator 6599 END IF 6600 CASE "MAX" 6601 Indicator_val=Max_val 6602 IF Polarity=1 THEN 6603 GOSUB Cw_indicator 6604 ELSE 6605 GOSUB Ccw_indicator 6606 END IF 6607 END SELECT 6608 END SELECT 6609 SUBEXIT 6610 Cw_indicator:! 6611 PEN 0 6612 Indicator_pos=50*(Indicator_val-Center_value)/(Range_value/2*Scale_factor) 6613 MOVE Indicator_pos,-11 6614 DRAW Indicator_pos,-7 6615 DRAW Indicator_pos+2,-7 6616 RETURN 6617 Ccw_indicator:! 6618 PEN 0 6619 Indicator_pos=50*(Indicator_val-Center_value)/(Range_value/2*Scale_factor) 6620 MOVE Indicator_pos,+11 6621 DRAW Indicator_pos,+7 6622 DRAW Indicator_pos-2,7 6623 RETURN 6624 SUBEND 6625 SUB Read_meter(Indicator$,Value) 6626 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6627 Read_meter:! 6628 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6629 COM /Max_min_hold/Min_val,Max_val,INTEGER Min_hold_flg,Max_hold_flg 6630 COM /Meter_status/Meter_type$,New_meter,Last_val,Polarity 6631 SELECT Indicator$ 6632 CASE "MAX HOLD NEEDLE" 6633 Value=Max_val 6634 CASE "MIN HOLD NEEDLE" 6635 Value=Min_val 6636 CASE "MAIN NEEDLE" 6637 Value=Last_val 6638 END SELECT 6639 SUBEND 6640 SUB Meter_init(Type_meter$,Ccw_val,Cw_val) 6641 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6642 Meter_init:! 6643 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6644 COM /Max_min_hold/Min_val,Max_val,INTEGER Min_hold_flg,Max_hold_flg 6645 COM /Meter_status/Meter_type$,New_meter,Last_val,Polarity 6646 COM /Meter_scale/Ccw_value,Cw_value,Range_mult,Range_value,Center_value 6647 COM /Compensation/Offset,Compen 6648 Range_mult=1 6649 New_meter=1 6650 Min_hold_flg=0 6651 Max_hold_flg=0 6652 Ccw_value=Ccw_val 6653 Cw_value=Cw_val 6654 LINE TYPE 1 6655 Range_value=(Cw_value-Ccw_val) 6656 Center_value=(Ccw_value+Cw_value)/2 6657 IF Ccw_value1 6732 Root_value=DROUND(Nrmlz_value^(1/3),4) 6733 END SELECT 6734 CALL Indicator("DRAW",Root_value) 6735 CASE "FOOLS GOLD" 6736 Nrmlz_value=(Value-Offset)/Compen 6737 IF New_meter THEN 6738 CALL Zero_ctr_mtr("DRAW",1) 6739 ELSE 6740 CALL Indicator("ERASE") 6741 END IF 6742 SELECT Nrmlz_value 6743 CASE -1 TO 1 6744 Root_value=0 6745 CASE <-1 6746 Root_value=DROUND(-(ABS(Nrmlz_value)^(1/3)),4) 6747 CASE >1 6748 Root_value=DROUND(Nrmlz_value^(1/3),4) 6749 END SELECT 6750 CALL Indicator("DRAW",Root_value) 6751 CASE "ANALOG SCALE","ANALOG SCALE MIN HOLD","ANALOG SCALE MAX HOLD","ANALOG SCALE MIN AND MAX HOLD" 6752 IF New_meter THEN 6753 Max_val=Value 6754 Min_val=Value 6755 GOSUB New_range_calc 6756 CALL Indicator("DRAW",Value) 6757 IF Max_hold_flg THEN 6758 CALL Hold_indicator("DRAW","MAX",Range_mult,Value) 6759 Max_val=Value 6760 END IF 6761 IF Min_hold_flg THEN 6762 CALL Hold_indicator("DRAW","MIN",Range_mult,Value) 6763 Min_val=Value 6764 END IF 6765 ELSE 6766 CALL Indicator("ERASE") 6767 Old_range_mult=Range_mult 6768 GOSUB Range_calc 6769 IF Min_hold_flg THEN 6770 IF Old_range_mult<>Range_mult OR ValueRange_mult OR Value>Max_val THEN 6778 CALL Hold_indicator("ERASE","MAX",Old_range_mult) 6779 Hold_value=MAX(Max_val,Value) 6780 CALL Hold_indicator("DRAW","MAX",Range_mult,Hold_value) 6781 END IF 6782 END IF 6783 CALL Indicator("DRAW",Value) 6784 END IF 6785 END SELECT 6786 DISP Value 6787 New_meter=0 6788 SUBEXIT 6789 New_range_calc:! 6790 WHILE ABS(Off_center_val)>ABS(.44*Range_value*Range_mult) 6791 Range_mult=Range_mult*2 6792 END WHILE 6793 RETURN 6794 Range_calc:! 6795 Ok_to_exit=0 6796 REPEAT 6797 IF ABS(Off_center_val)>ABS(Range_mult*ABS(Range_value*.475)) THEN 6798 Range_mult=INT(MIN(Range_mult*3,32)) 6799 Last_val=Value 6800 IF Range_mult>=32 THEN Ok_to_exit=1 6801 ELSE 6802 Ok_to_exit=1 6803 END IF 6804 UNTIL Ok_to_exit 6805 Ok_to_exit=0 6806 IF Range_mult>1 AND Min_hold_flg=0 AND Max_hold_flg=0 THEN 6807 REPEAT 6808 IF ABS(Off_center_val)=3 6833 Filler1$=RPT$(" ",7-INT(Spec_nom_len/3)) 6834 Filler2$=Filler1$ 6835 END SELECT 6836 Left_range_len=(Spec_nom_len/2+LEN(VAL$(Spec_min))+LEN(Filler1$)) 6837 Right_range_len=(Spec_nom_len/2+LEN(VAL$(Spec_max))+LEN(Filler2$)) 6838 Range_diff=(Left_range_len-Right_range_len) 6839 Filler$=RPT$(" ",ABS(Range_diff)) 6840 Title$="===== "&Align_title$&" =====" 6841 Range_header$="MINIMUM NOMINAL MAXIMUM" 6842 Range$=VAL$(Spec_min)&Filler1$&VAL$(Spec_nom)&Filler2$&VAL$(Spec_max) 6843 CALL Show_message(Title$,1) 6844 CALL Show_message(Range_header$,7) 6845 IF Range_diff<0 THEN 6846 CALL Show_message(Filler$&Range$,8) 6847 ELSE 6848 CALL Show_message(Range$&Filler$,8) 6849 END IF 6850 SELECT NPAR 6851 CASE 3 6852 CASE 4 6853 CALL Show_message(Message1$,4) 6854 CASE 5 6855 CALL Show_message(Message1$,3) 6856 CALL Show_message(Message2$,4) 6857 CASE 6 6858 CALL Show_message(Message1$,3) 6859 CALL Show_message(Message2$,4) 6860 CALL Show_message(Message3$,5) 6861 END SELECT 6862 SUBEND 6863 DEF FNRev_letter$(Rcs_revision$) 6864 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6865 Rev_letter: REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6866 INTEGER P1,P2 6867 ALLOCATE Rev_num$[LEN(Rcs_revision$)],Rev_letter$[1] 6868 P1=POS(Rcs_revision$,"Revision:") 6869 IF P1>0 THEN 6870 P1=P1+POS(Rcs_revision$[P1],":")+1 6871 P2=P1+POS(Rcs_revision$[P1],".")-2 6872 IF P1>0 AND P2>=P1 THEN 6873 Rev_num$=TRIM$(Rcs_revision$[P1,P2]) 6874 END IF 6875 Rev_letter$=CHR$(64+VAL(Rev_num$)) 6876 ELSE 6877 Rev_letter$="x" 6878 END IF 6879 RETURN Rev_letter$ 6880 FNEND 6881 DEF FNRcs_rev$(Rcs_revision$) 6882 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6883 Rcs_rev: REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6884 INTEGER P1,P2 6885 ALLOCATE Rev_num$[LEN(Rcs_revision$)] 6886 Rev_num$="0.0" 6887 P1=POS(Rcs_revision$,"Revision:") 6888 IF P1>0 THEN 6889 P1=P1+POS(Rcs_revision$[P1],":")+1 6890 P2=P1+POS(Rcs_revision$[P1],"$")-2 6891 IF P1>0 AND P2>=P1 THEN 6892 Rev_num$=TRIM$(Rcs_revision$[P1,P2]) 6893 END IF 6894 END IF 6895 RETURN " ("&"Rev "&Rev_num$&") " 6896 FNEND 6897 SUB List(Control$,Error_message$) 6898 REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6899 List: REM $Header: stat7_drvrs,v 1.4 95/02/10 10:23:19 hmgr Exp $ 6900 DIM File_name$[200],Key_buffer$[80],Buffer$[80] 6901 DIM Search_string$[80],Title_name$[200] 6902 DIM Cmnd_delimiter$[10] 6903 INTEGER Last_command,Last_match,Help,Max_text_lines 6904 INTEGER Comma_loc,Equals_loc 6905 ALLOCATE Command$[LEN(Control$)],Data$[LEN(Control$)] 6906 STATUS 1,9;Screen_width 6907 STATUS 1,13;Screen_height 6908 Screen_height=Screen_height-8 6909 Top_line=1 6910 Bottom_line=Screen_height+1 6911 Error_message$="OK" 6912 Cmnd_delimiter$="," 6913 Help=1 6914 Max_text_lines=1000 6915 ALLOCATE Text_array$(1:Max_text_lines)[Screen_width] 6916 GOSUB Clear_softkeys 6917 REPEAT 6918 GOSUB Parse_command 6919 GOSUB Execute_command 6920 UNTIL Last_command=1 6921 Text_pointer=1 6922 Page=0 6923 GOSUB Print_page 6924 ON KBD GOSUB Kbd_service 6925 LOOP 6926 REPEAT 6927 UNTIL LEN(Key_buffer$) 6928 GOSUB Key_respond 6929 EXIT IF Done 6930 END LOOP 6931 Exit_context:! 6932 CONTROL 1,12;Softkey_status 6933 IF Error_message$<>"OK" THEN 6934 Error_message$=Error_message$&" in List " 6935 END IF 6936 SUBEXIT 6937 Execute_command:! 6938 SELECT Command$ 6939 CASE "FILE" 6940 File_name$=Data$ 6941 Title_name$=File_name$ 6942 WHILE POS(Title_name$,"/") 6943 Title_name$=Title_name$[POS(Title_name$,"/")+1] 6944 END WHILE 6945 IF POS(Title_name$,":") THEN Title_name$=Title_name$[1;POS(Title_name$,":")-1] 6946 ASSIGN @File TO File_name$;FORMAT ON,RETURN Assign_result 6947 IF Assign_result<>0 THEN 6948 Error_message$="Error "&VAL$(Assign_result)&" occured when trying to assign a path to -"&File_name$&"-" 6949 GOTO Exit_context 6950 END IF 6951 DISP "Reading in text ..." 6952 Num_records=0 6953 ON END @File GOTO Entering_done 6954 LOOP 6955 Num_records=Num_records+1 6956 ENTER @File USING "#,K";Text_array$(Num_records) 6957 END LOOP 6958 Entering_done:! 6959 DISP "" 6960 GOSUB Count_pages 6961 CASE "TEXT" 6962 Num_records=0 6963 Data$=Data$&CHR$(10)&"LAST STRING" 6964 ON ERROR GOTO Next_step 6965 ENTER Data$;Text_array$(*) 6966 Next_step: OFF ERROR 6967 MAT SEARCH Text_array$(*),LOC (="LAST STRING");Num_records 6968 Num_records=Num_records-1 6969 GOSUB Count_pages 6970 CASE "TITLE" 6971 Title_name$=Data$ 6972 CASE "COMMAND DELIMITER" 6973 Cmnd_delimiter$=Data$ 6974 CASE "NO HELP" 6975 Help=0 6976 CASE ELSE 6977 Error_message$=Command$&" is an unknown command" 6978 GOTO Exit_context 6979 END SELECT 6980 RETURN 6981 Key_respond:! 6982 STATUS 1,3;Num_above 6983 Key_pressed$=Key_buffer$[1;1] 6984 Key_buffer$=Key_buffer$[2] 6985 IF Key_pressed$=CHR$(255) THEN 6986 Key_pressed$=Key_pressed$&Key_buffer$[1;1] 6987 Key_buffer$=Key_buffer$[2] 6988 END IF 6989 SELECT UPC$(Key_pressed$) 6990 CASE "N"," ",CHR$(255)&",",CHR$(255)&"T" 6991 IF Text_pointer1 THEN 6998 Text_pointer=MAX(Text_pointer-Screen_height,1) 6999 GOSUB Print_page 7000 END IF 7001 CASE "T",CHR$(255)&"\" 7002 Text_pointer=1 7003 GOSUB Print_page 7004 CASE "B" 7005 Text_pointer=MAX(1,Num_records-Screen_height) 7006 GOSUB Print_page 7007 CASE "Q" 7008 Done=1 7009 CASE "?" 7010 IF Help=1 THEN 7011 GOSUB Help 7012 GOSUB Print_page 7013 END IF 7014 CASE "H" 7015 Printout_done=0 7016 ON TIMEOUT 7,5 RECOVER Printer_timeout 7017 DISP "Printing ";Title_name$ 7018 ASSIGN @Printer TO 701 7019 FOR Counter=1 TO Num_records 7020 OUTPUT @Printer;Text_array$(Counter) 7021 NEXT Counter 7022 Printout_done=1 7023 Printer_timeout:! 7024 IF Printout_done THEN 7025 DISP "Hardcopy printout done" 7026 BEEP 7027 ELSE 7028 DISP "Hardcopy printout failed..." 7029 BEEP 7030 BEEP 7031 END IF 7032 OFF TIMEOUT 7033 CASE "G" 7034 INPUT "ENTER LINE NUMBER TO GO TO",Goto_line 7035 Goto_line=MIN(Goto_line,Num_records-Screen_height) 7036 Goto_line=INT(MAX(Goto_line,1)) 7037 Text_pointer=Goto_line 7038 GOSUB Print_page 7039 CASE "D",CHR$(255)&"V",CHR$(255)&"E",CHR$(255)&"<","J" 7040 Num_down=1 7041 WHILE Key_buffer$[1,2]=Key_pressed$ 7042 Num_down=Num_down+1 7043 Key_buffer$=Key_buffer$[3] 7044 END WHILE 7045 IF Num_down=1 THEN 7046 IF Text_pointer","K" 7055 Num_up=1 7056 WHILE Key_buffer$[1,2]=Key_pressed$ 7057 Num_up=Num_up+1 7058 Key_buffer$=Key_buffer$[3] 7059 END WHILE 7060 IF Num_up=1 THEN 7061 IF Text_pointer>1 THEN 7062 Text_pointer=MAX(1,MIN(Text_pointer-1,Num_records-Screen_height)) 7063 IF Num_above>0 THEN 7064 GOSUB Shuffle_up 7065 ELSE 7066 GOSUB Print_page 7067 END IF 7068 END IF 7069 ELSE 7070 Text_pointer=MAX(1,MIN(Text_pointer-Num_up,Num_records-Screen_height)) 7071 GOSUB Print_page 7072 END IF 7073 CASE "R" 7074 IF Text_pointer>1 THEN 7075 INPUT "INPUT STRING TO SEARCH BACKWARDS FOR",Search_string$ 7076 DISP "SEARCHING FOR ";Search_string$ 7077 Counter=Text_pointer 7078 String_found=0 7079 REPEAT 7080 Counter=Counter-1 7081 IF POS(Text_array$(Counter),Search_string$) THEN String_found=1 7082 UNTIL String_found OR Counter=1 7083 IF String_found THEN 7084 Text_pointer=Counter 7085 GOSUB Print_page 7086 DISP "FOUND "&Search_string$," Line ";Text_pointer 7087 ELSE 7088 DISP "Could not find "&Search_string$," Starting at line ";Text_pointer 7089 BEEP 7090 END IF 7091 ELSE 7092 DISP "Can not Reverse Search from line 1" 7093 BEEP 7094 END IF 7095 CASE "S","/" 7096 INPUT "INPUT STRING TO SEARCH FOR ",Search_string$ 7097 DISP "SEARCHING FOR ";Search_string$ 7098 Counter=Text_pointer 7099 String_found=0 7100 REPEAT 7101 Counter=Counter+1 7102 IF POS(Text_array$(Counter),Search_string$) THEN String_found=1 7103 UNTIL String_found OR Counter=Num_records+1 7104 IF String_found THEN 7105 Text_pointer=Counter 7106 GOSUB Print_page 7107 DISP "FOUND "&Search_string$," Line ";Text_pointer 7108 ELSE 7109 DISP "Could not find "&Search_string$," Starting at line ";Text_pointer 7110 BEEP 7111 END IF 7112 CASE "1" TO "9" 7113 IF Text_pointer for help" 7120 BEEP 7121 END SELECT 7122 RETURN 7123 Count_pages:! 7124 IF Num_records MOD Screen_height THEN 7125 Total_pages=INT(Num_records/Screen_height)+1 7126 ELSE 7127 Total_pages=INT(Num_records/Screen_height) 7128 END IF 7129 RETURN 7130 Print_page:! 7131 Counter=Top_line-1 7132 REPEAT 7133 Counter=Counter+1 7134 PRINT TABXY(1,Counter);Text_array$(Text_pointer+Counter-1)&RPT$(" ",Screen_width-LEN(Text_array$(Text_pointer+Counter-1))) 7135 UNTIL Counter=Bottom_line OR Text_pointer+Counter-1>=Num_records 7136 WHILE Counter for Help"; 7161 DISP 7162 RETURN 7163 Help:! 7164 ALLOCATE Help$[1500] 7165 Help$=" Text Lister Help Screen" 7166 Help$=Help$&CHR$(10)&" " 7167 Help$=Help$&CHR$(10)&" Shift : Next Page or Screen " 7168 Help$=Help$&CHR$(10)&"

" 7169 Help$=Help$&CHR$(10)&" Shift : Previous Page or Screen" 7170 Help$=Help$&CHR$(10)&" : Down one line " 7171 Help$=Help$&CHR$(10)&" : Up one line " 7172 Help$=Help$&CHR$(10)&" : Top or First Line " 7173 Help$=Help$&CHR$(10)&" : Bottom or Last Line" 7174 Help$=Help$&CHR$(10)&" : Search forward " 7175 Help$=Help$&CHR$(10)&" : Search Backwards" 7176 Help$=Help$&CHR$(10)&" : Go to a specific line number" 7177 Help$=Help$&CHR$(10)&" <1> to <9> : Move that many lines down." 7178 Help$=Help$&CHR$(10)&" : Hardcopy (To 701) " 7179 Help$=Help$&CHR$(10)&" : Help Screen (This Screen) " 7180 Help$=Help$&CHR$(10)&" : Quit reading this context." 7181 CALL List("TITLE=Press to quit HELP,NO HELP,TEXT="&Help$,Error_message$) 7182 DEALLOCATE Help$ 7183 RETURN 7184 Clear_softkeys:! 7185 STATUS 1,12;Softkey_status 7186 KEY LABELS OFF 7187 FOR Counter=0 TO 19 7188 ON KEY Counter LABEL "" GOSUB Do_nothing 7189 NEXT Counter 7190 Do_nothing: RETURN 7191 Parse_command:! 7192 Comma_loc=POS(Control$,Cmnd_delimiter$) 7193 IF Comma_loc=0 THEN 7194 Command$=Control$ 7195 Last_command=1 7196 ELSE 7197 Command$=Control$[1,Comma_loc-1] 7198 Control$=Control$[Comma_loc+1] 7199 Last_command=0 7200 END IF 7201 Equals_loc=POS(Command$,"=") 7202 IF Equals_loc<>0 THEN 7203 Data$=Command$[Equals_loc+1] 7204 Command$=Command$[1,(Equals_loc-1)] 7205 ELSE 7206 Data$="" 7207 END IF 7208 RETURN 7209 SUBEND 7210 ! 7211 ! 7212! END 7213 DEF FNBlock_drvr_file$ 7214 Block_drvr_file: REM This file was built on : Fri Mar 15 00:30:56 PST 1996 7215 RETURN "PORT_62A" 7216 FNEND 7217 SUB Adjband(@Dut,@Source,@Pm,Band,Fmin,Fmax,Break_table(*),Ee_data(*)) 7218 Adjband: REM $Header: Adjband,v 1.6 94/10/06 13:33:47 hmgr Exp $ 7219 DIM E$[100],Error$[100] 7220 Graph_enabled= NOT FNField 7221 Power_meter=1 7222 Cal_power=1 7223 Source_amp=-4 7224 Fmin=MAX(Fmin,1.0E+7) 7225 Nstart=FNBand_start(Band,Break_table(*)) 7226 Band_start=Nstart 7227 Nstop=FNBand_stop(Band,Break_table(*)) 7228 IF FNFreq(Nstart,Break_table(*))Fmax/1.E+6 THEN 7232 Nstop=INT(FNCal_point(Band,Fmax/1.E+6,Break_table(*),Ee_data(*))) 7233 END IF 7234 IF Nstop<=Nstart THEN Nstop=Nstart+1 7235 ALLOCATE Pmcal(Nstart:Nstop) 7236 IF Power_meter AND Cal_power THEN 7237 OUTPUT @Source;"IP;CW 1e9HZ;PL ";Source_amp;"DB;" 7238 ELSE 7239 IF Power_meter THEN 7240 OUTPUT @Pm;"PR LG;BP;TR3;" 7241 OUTPUT @Source;"IP;CW 1e9HZ;PL ";Source_amp;"DB;" 7242 ELSE 7243 OUTPUT @Source;"IP;CW 1e9HZ;PL -10DB;" 7244 END IF 7245 END IF 7246 OUTPUT @Dut;"ip;fref ext;sngls;rl 0;lg 10;sp 10mhz;sp 0;rb 1mhz;st 50ms;" 7247 OUTPUT @Dut;"hnlock ";Band;";" 7248 OUTPUT @Dut;"mkt 40ms;" 7249 OUTPUT @Dut;"adjall" 7250 WAIT 30 7251 OUTPUT @Dut;"adjif off;" 7252 Dut("WRITE ENABLE,REF LEVEL CAL=0") 7253 Dut("REF LEVEL CAL=0") 7254 Dut("READ DAC PER 10DB",Dacper10db,E$) 7255 GOSUB Init_ytf_fir 7256 GOSUB Do_band 7257 IF Band=0 AND Fmin<=1.0E+7 THEN 7258 Val4=Ee_data(4*3-2)*256+Ee_data(4*3-1) 7259 Val3=Ee_data(3*3-2)*256+Ee_data(3*3-1) 7260 IF ABS(Val4-Val3)>50 THEN 7261 MAT Ee_data(1:3)=Ee_data(10:12) 7262 MAT Ee_data(4:6)=Ee_data(10:12) 7263 MAT Ee_data(7:9)=Ee_data(10:12) 7264 ELSE 7265 MAT Ee_data(1:3)=Ee_data(7:9) 7266 MAT Ee_data(4:6)=Ee_data(7:9) 7267 END IF 7268 END IF 7269 SUBEXIT 7270 Init_ytf_fir:! 7271 Width=10 7272 Dx=Width 7273 ALLOCATE Fir(-Dx:Dx) 7274 FOR L=-Dx TO Dx 7275 Fir(L)=EXP(-L^2/(Width/2)^2) 7276 Sum=Sum+Fir(L) 7277 NEXT L 7278 FOR L=-Dx TO Dx 7279 Fir(L)=Fir(L)/Sum 7280 NEXT L 7281 RETURN 7282 Do_band:! 7283 Maxampl=-999 7284 Minampl=999 7285 OUTPUT @Source;"pw -2dbm;" 7286 FOR J=Nstart TO Nstop STEP MAX(Nstop-Nstart,1) 7287 F=FNFreq(J,Break_table(*))*1.E+6 7288 OUTPUT @Dut;"cf ";F;";" 7289 OUTPUT @Source;"CW";F;"HZ;" 7290 Setgaindac(@Dut,2048,128) 7291 OUTPUT @Dut;"ts;mka?;" 7292 ENTER @Dut;Ampl 7293 IF Ampl>Maxampl THEN Maxampl=Ampl 7294 IF Ampl0 THEN 7304 IF Graph_enabled THEN 7305 New_window(Id,"ytfsmth","long") 7306 Grid(Nstart,Nstop,40,220,1000,10,0,"ytf dac","cal point","ytf smoothing",0,200,10,100) 7307 MOVE 0,0 7308 PEN 2 7309 END IF 7310 FOR J=Nstart TO Nstop 7311 F=FNFreq(J,Break_table(*))*1.E+6 7312 OUTPUT @Dut;"cf ";F;";" 7313 OUTPUT @Source;"CW";F;"HZ;" 7314 Rfg=Ee_data(J*3-2)*256+Ee_data(J*3-1) 7315 Ytf=Ee_data(J*3) 7316 Setgaindac(@Dut,Rfg,Ytf) 7317 IF Band=5 AND J=Band_start THEN GOSUB Tune_multiple 7318 OUTPUT @Dut;"pp;" 7319 OUTPUT @Dut;"psdac?;" 7320 ENTER @Dut;Ytf 7321 Ee_data(J*3)=Ytf 7322 Pmcal(J)=FNPower(@Pm,F/1.E+6) 7323 PRINT F/1.E+6,Ytf 7324 IF Graph_enabled THEN 7325 PLOT J,Ee_data(J*3) 7326 END IF 7327 NEXT J 7328 IF Graph_enabled THEN 7329 MOVE 0,0 7330 PEN 3 7331 END IF 7332 FOR J=Nstart TO Nstop 7333 F=FNFreq(J,Break_table(*))*1.E+6 7334 Ytf=0 7335 FOR K=-Dx TO Dx 7336 Index=J+K 7337 Index=MAX(MIN(Index,Nstop),Nstart) 7338 Ytf=Ytf+Fir(K)*Ee_data((Index)*3) 7339 NEXT K 7340 Ytf=INT(Ytf+.5) 7341 IF Graph_enabled THEN 7342 PLOT J,Ytf 7343 END IF 7344 Ee_data(J*3)=Ytf 7345 NEXT J 7346 ELSE 7347 FOR J=Nstart TO Nstop 7348 Ee_data(J*3)=128 7349 NEXT J 7350 END IF 7351 IF Graph_enabled THEN 7352 MOVE 0,0 7353 PEN 2 7354 END IF 7355 FOR J=Nstart TO Nstop 7356 F=FNFreq(J,Break_table(*))*1.E+6 7357 OUTPUT @Dut;"cf ";F;";" 7358 OUTPUT @Source;"CW";F;"HZ;" 7359 IF Band=0 THEN Pmcal(J)=FNPower(@Pm,F/1.E+6) 7360 Rfg=Ee_data(J*3-2)*256+Ee_data(J*3-1) 7361 Ytf=Ee_data(J*3) 7362 Adjgaindac(@Dut,Pmcal(J),Rfg,Dacper10db,Ytf,Error) 7363 Ee_data(J*3-2)=INT(Rfg/256) 7364 Ee_data(J*3-1)=Rfg MOD 256 7365 PRINT F/1.E+6,Rfg,Ytf,Error 7366 NEXT J 7367 Reflvl=MAX(Pmcal(*))+10 7368 Dbper=2 7369 OUTPUT @Dut;"rl ";Reflvl;";lg ";Dbper;";rb 300khz;" 7370 IF Band=2 OR Band=3 THEN 7371 Waittime=180 7372 OUTPUT @Dut;"cf 18ghz; sp 0; ts;" 7373 T1=TIMEDATE 7374 LOOP 7375 WAIT .2 7376 DISP "Writing RAM data ... ";PROUND(Waittime-(TIMEDATE-T1),.1);"seconds left." 7377 EXIT IF Waittime-(TIMEDATE-T1)<=0 7378 END LOOP 7379 END IF 7380 F1=FNFreq(Nstart,Break_table(*)) 7381 F2=FNFreq(Nstop,Break_table(*)) 7382 IF Graph_enabled THEN 7383 New_window(Flatdel,"flat del","long") 7384 Grid(F1,F2,-5,5,1.00E+11,1,0,"flatness delta","freq","db",0,200,10,100) 7385 MOVE 0,0 7386 END IF 7387 PRINT "freq, delta rfg, marker ampl, power meter ampl" 7388 FOR J=Nstart TO Nstop 7389 F=FNFreq(J,Break_table(*))*1.E+6 7390 OUTPUT @Dut;"cf ";F;";" 7391 OUTPUT @Source;"CW";F;"HZ;" 7392 Rfg=Ee_data(J*3-2)*256+Ee_data(J*3-1) 7393 Ytf=Ee_data(J*3) 7394 Setgaindac(@Dut,Rfg,Ytf) 7395 Ampl=FNMarker(@Dut) 7396 Delta=INT((Pmcal(J)-Ampl)*Dacper10db/10+.5) 7397 IF ABS(Delta)<500 THEN Rfg=Rfg+Delta 7398 IF Rfg>4096 OR Rfg<0 THEN 7399 PRINT "RF Gain is out of range." 7400 OUTPUT 701;"RF Gain is out of range." 7401 PRINT "rfg=";Rfg 7402 OUTPUT 701;"rfg=";Rfg 7403 PRINT "frequency=";F 7404 OUTPUT 701;"frequency=";F 7405 Rfg=MAX(MIN(Rfg,4096),0) 7406 PRINT "rfg has been limited to ";Rfg 7407 OUTPUT 701;"rfg has been limited to ";Rfg 7408 END IF 7409 Ee_data(J*3-2)=INT(Rfg/256) 7410 Ee_data(J*3-1)=Rfg MOD 256 7411 PRINT F/1.E+6,Delta,Ampl,Pmcal(J) 7412 IF Graph_enabled THEN 7413 PLOT F/1.E+6,Ampl-Pmcal(J) 7414 END IF 7415 NEXT J 7416 RETURN 7417 Tune_multiple:! 7418 Pp_offset=0 7419 GOSUB Store_pp_ofs 7420 OUTPUT @Dut;"pp;" 7421 OUTPUT @Dut;"psdac?;" 7422 ENTER @Dut;Ytf 7423 New_pp_dac=Ytf 7424 Mult_freq=(F+1.E+8+3.9107E+9)/8 7425 Mult_freq=(Mult_freq*15-3.9107E+9)/2 7426 Dut("SAVE STATE=1") 7427 Dut("CENTER FREQUENCY,TRIGGER SWEEP",F+1.E+8) 7428 Setup_8340("FREQ="&VAL$(F+1.E+8)&"Hz",@Source,Error$) 7429 Pm=FNPower(@Pm,F/1.E+6) 7430 Adjgaindac(@Dut,Pm,Rfg,Dacper10db,Ytf,Error) 7431 Dut("AUTO SWEEP TIME,SCALE=10,RBW=300,VBW=300,SPAN=2000,REF LEVEL=-10,ATTENUATOR=0") 7432 Dut("CENTER FREQUENCY",F+1.E+8) 7433 Setgaindac(@Dut,Rfg,Ytf) 7434 Dut("TRIGGER SWEEP,PEAK SEARCH,MARKER TO REF LEVEL,TRIGGER SWEEP,READ MARKER AMPLITUDE",Ref_amp) 7435 Setup_8340("FREQ="&VAL$(Mult_freq)&"Hz",@Source,Error$) 7436 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Mult_amp) 7437 IF Ref_amp-Mult_amp>70 THEN GOTO Pp_offset_done 7438 Pp_inc=32 7439 LOOP 7440 EXIT IF ABS(Ref_amp-Mult_amp-72)<2 OR New_pp_dac=0 7441 IF Ref_amp-Mult_amp>=74 THEN 7442 Pp_inc=INT(Pp_inc/2) 7443 Pp_offset=Pp_offset-Pp_inc 7444 ELSE 7445 Pp_offset=Pp_offset+Pp_inc 7446 END IF 7447 Pp_offset=MIN(Pp_offset,Ytf) 7448 New_pp_dac=Ytf-Pp_offset 7449 Setgaindac(@Dut,Rfg,New_pp_dac) 7450 DISP "PP OFFSET = "&VAL$(Pp_offset) 7451 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Mult_amp) 7452 END LOOP 7453 IF New_pp_dac=0 AND ABS(Ref_amp-Mult_amp-72)>=2 THEN 7454 DISP "YTF DAC = 0 and CAN'T GET MULT BELOW 72dBc !!!" 7455 PAUSE 7456 END IF 7457 Pp_offset_done:! 7458 Pp_offset=Pp_offset+MIN(-Pp_offset,9)+1 7459 OUTPUT 701;"***************" 7460 OUTPUT 701;"PP OFFSET = "&VAL$(Pp_offset) 7461 OUTPUT 701;"***************" 7462 GOSUB Store_pp_ofs 7463 Setup_8340("POWER="&VAL$(Source_amp)&"dBm",@Source,Error$) 7464 Setup_8340("FREQ="&VAL$(F)&"Hz",@Source,Error$) 7465 Dut("RECALL STATE=1") 7466 RETURN 7467 Store_pp_ofs:! 7468 FOR I=0 TO 2 7469 Write_data(DVAL$(FNRead_value("05FD58",4)+I,16),0) 7470 Write_data(DVAL$(FNRead_value("05FD5C",4)+I,16),0) 7471 NEXT I 7472 Sbtx_bnd_ofs=0 7473 IF FNRom_date("8 BANDS") THEN Sbtx_bnd_ofs=1 7474 Write_data(DVAL$(FNRead_value("05FD58",4)+Sbtx_bnd_ofs,16),Pp_offset) 7475 Write_data(DVAL$(FNRead_value("05FD5C",4)+Sbtx_bnd_ofs,16),Pp_offset) 7476 CALL Calc_chksum 7477 RETURN 7478 SUBEND 7479 SUB Adjgaindac(@Dut,Target,Value,Dacper10db,Ytf,Error) 7480 Adjgaindac: REM $Header: Adjgaindac,v 1.1 94/04/11 14:26:33 hmgr Exp $ 7481 I=0 7482 LOOP 7483 I=I+1 7484 Setgaindac(@Dut,Value,Ytf) 7485 OUTPUT @Dut;"ts;mka?;" 7486 ENTER @Dut;Ampl 7487 Error=Ampl-Target 7488 EXIT IF ABS(Error)<.5 OR I>10 7489 Value=Value+INT((Target-Ampl)*Dacper10db/10+.5) 7490 Value=MIN(MAX(0,Value),4096) 7491 END LOOP 7492 SUBEND 7493 SUB Alpha_dump(Prt_spooler$) 7494 Alpha_dump: REM $Header: Alpha_dump,v 1.1 92/02/17 10:55:12 hmgr Exp $ 7495 REM 7496 REM ================================================================== 7497 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 7498 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 7499 REM REVISION: 870414:1330.JA 7500 REM ================================================================== 7501 REM 7502 ON ERROR GOTO Error_exit 7503 STATUS CRT,9;Crt_width 7504 Crt_lines=23 7505 Required_memory=Crt_width*Crt_lines 7506 Avail_mem=VAL(SYSTEM$("AVAILABLE MEMORY")) 7507 IF Avail_mem>Required_memory THEN 7508 ALLOCATE Screen$(1:Crt_lines)[Crt_width] 7509 Sys_type$=SYSTEM$("SYSTEM ID") 7510 Sys_type$=Sys_type$[1;4] 7511 SELECT Sys_type$ 7512 CASE "9920","9836" 7513 Mem_addr=5317025 7514 CASE "9826" 7515 Mem_addr=5318405 7516 CASE ELSE 7517 Mem_addr=5317025 7518 END SELECT 7519 FOR Line=1 TO Crt_lines 7520 FOR Char=1 TO Crt_width 7521 Screen$(Line)[Char;1]=CHR$(READIO(9826,Mem_addr)) 7522 Mem_addr=Mem_addr+2 7523 NEXT Char 7524 NEXT Line 7525 CREATE ASCII Prt_spooler$,1 7526 ASSIGN @Dump TO Prt_spooler$ 7527 OUTPUT @Dump;Screen$(*) 7528 ASSIGN @Dump TO * 7529 DEALLOCATE Screen$(*) 7530 ELSE 7531 DISP "INSUFFECIENT AVAILABLE MEMORY TO RUN ""ALPHA DUMP""" 7532 BEEP 640,.3 7533 WAIT 3 7534 DISP "" 7535 END IF 7536 SUBEXIT 7537 Error_exit:! 7538 DISP ERRM$ 7539 PAUSE 7540 SUBEND 7541 SUB Auto_lo_adj(Message$,Target,Max_error,Polarity,Device$,OPTIONAL Frequency) 7542 Auto_lo_adj: REM $Header: Auto_lo_adj,v 1.1 92/02/17 10:55:24 hmgr Exp $ 7543 DIM Error_message$[180] 7544 IF Device$<>"SA 8562" THEN 7545 CALL Get_io_path(Device$,@Rd_device) 7546 END IF 7547 Dutmessage(Message$) 7548 WAIT 2 7549 REPEAT 7550 Done=0 7551 GOSUB Get_reading 7552 Norm_error=(Reading-Target)/Max_error*Polarity 7553 Error_display(Norm_error) 7554 IF ABS(Norm_error)<.5 THEN 7555 FOR I=1 TO 4 7556 Dut("TITLE",0,"") 7557 WAIT .05 7558 Dut("TITLE",0,"!!!HANDS OFF!!!") 7559 WAIT .3 7560 NEXT I 7561 Dut("TITLE",0,"CHECKING ADJUSTMENT") 7562 FOR I=1 TO 3 7563 GOSUB Get_reading 7564 Check_error(I)=ABS(Reading-Target)/Max_error 7565 NEXT I 7566 IF MAX(Check_error(*))<1 THEN 7567 Done=1 7568 ELSE 7569 Dut("TITLE",0,"Fails check. Retweek same pot") 7570 WAIT 3 7571 END IF 7572 END IF 7573 UNTIL Done 7574 Dutmessage(" SETTING UP NEXT ADJUSTMENT") 7575 SUBEXIT 7576 Get_reading:! 7577 Read_5342("FREQ","Hz",@Rd_device,Reading,Error_message$) 7578 RETURN 7579 SUBEND 7580 SUB Autoadjust(Message$,Target,Max_error,Polarity,Device$,OPTIONAL Frequency) 7581 Autoadjust: REM $Header: Autoadjust,v 1.1 92/02/17 10:55:33 hmgr Exp $ 7582 DIM Error_message$[180] 7583 IF Device$<>"SA 8562" THEN 7584 CALL Get_io_path(Device$,@Rd_device) 7585 END IF 7586 Dutmessage(Message$) 7587 WAIT 2.5 7588 REPEAT 7589 Done=0 7590 GOSUB Get_reading 7591 Norm_error=(Reading-Target)/Max_error*Polarity 7592 Error_display(Norm_error) 7593 IF ABS(Norm_error)<.5 THEN 7594 FOR I=1 TO 4 7595 Dut("TITLE",0,"") 7596 WAIT .05 7597 Dut("TITLE",0,"HANDS OFF!!!") 7598 WAIT .3 7599 NEXT I 7600 Dut("TITLE",0,"CHECKING ADJUSTMENT") 7601 FOR I=1 TO 3 7602 GOSUB Get_reading 7603 Check_error(I)=ABS(Reading-Target)/Max_error 7604 NEXT I 7605 IF MAX(Check_error(*))<1 THEN 7606 Done=1 7607 ELSE 7608 Dut("TITLE",0,"Fails check. Retweek same pot") 7609 WAIT 3 7610 END IF 7611 END IF 7612 UNTIL Done 7613 Dutmessage("ADJUSTMENT COMPLETED!") 7614 SUBEXIT 7615 Get_reading:! 7616 SELECT Device$ 7617 CASE "DVM 3478" 7618 CALL Read_3478("DC VOLTS","V",@Rd_device,Reading,Error_message$) 7619 CASE "CNTR 5342" 7620 Read_5342("FREQ","Hz",@Rd_device,Reading,Error_message$) 7621 CASE "PWR MTR 438" 7622 CALL Read_438(Frequency,"CORRECTED POWER","dBm",@Rd_device,Reading,Error_message$) 7623 CASE "SA 8561","SA 8562" 7624 CALL Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER FREQUENCY",Reading) 7625 CASE ELSE 7626 DISP Device$&" IS NOT A VALID CASE IN SUB ""Autoadjust""" 7627 END SELECT 7628 RETURN 7629 SUBEND 7630 SUB Autodiv(Xmin,Xmax,Xstep) 7631 Autodiv: REM $Header: Autodiv,v 1.1 94/04/11 14:55:08 hmgr Exp $ 7632 Deltax=Xmax-Xmin 7633 IF Xstep*2"ON DISK" THEN 7689 Show_message(Sensor$&"A "&Rp_num$&" NUMBER IS NOT ON DISK. ",16) 7690 Show_message("ABORT TEST AND RERUN ""SERIAL NUM"" TEST (UPDATE "&Sensor$&"A RP# IN MENU) ",17) 7691 LOOP 7692 END LOOP 7693 END IF 7694 IF (POS(Pwr_sensor$,"CHA")) THEN 7695 Message("Connect the CHANNEL A sensor, "&Rp_num$&", to the 438 POWER REF") 7696 ELSE 7697 Message("Connect the CHANNEL B sensor, "&Rp_num$&", to the 438 POWER REF") 7698 END IF 7699 PRINT TABXY(1,15);RPT$(" ",80) 7700 CASE ELSE 7701 Show_message(Pwr_sensor$&" -- IS NOT A VALID CASE. THIS IS Cal_and_zero subprogram",15) 7702 PAUSE 7703 STOP 7704 END SELECT 7705 Setup_again:! 7706 IF (POS(Pwr_sensor$,"CHA")) THEN 7707 IF NPAR=2 THEN 7708 Control$="PRESET,CH A MEASURE,CH A BURIED SENSOR ASGN="&Rp_num$[3] 7709 Control$=Control$&",CH A AUTOZERO,CH A CAL ADJUST" 7710 ELSE 7711 Control$="PRESET,CH A MEASURE,CH A SENSOR ASSIGN="&Rp_num$[3] 7712 END IF 7713 Setup_438(Control$,@Pwr_mtr,Error_message$) 7714 IF NPAR=2 THEN CALL Set_status(VAL$(TIMEDATE),"system","calibration times",Sensor$,"CHA") 7715 ELSE 7716 IF NPAR=2 THEN 7717 Control$="PRESET,CH B MEASURE,CH B BURIED SENSOR ASGN="&Rp_num$[3] 7718 Control$=Control$&",CH B AUTOZERO,CH B CAL ADJUST" 7719 ELSE 7720 Control$="PRESET,CH B MEASURE,CH B SENSOR ASSIGN="&Rp_num$[3] 7721 END IF 7722 Setup_438(Control$,@Pwr_mtr,Error_message$) 7723 IF NPAR=2 THEN CALL Set_status(VAL$(TIMEDATE),"system","calibration times",Sensor$,"CHB") 7724 END IF 7725 CALL Show_message(" ",15) 7726 SUBEXIT 7727 Error_occured:! 7728 CALL Show_message("!! "&Error_message$&" !!",16) 7729 CALL Prompt_keys("CONTINUE",Error_message$," ") 7730 CALL Show_message(" ",16) 7731 GOTO Setup_again 7732 SUBEND 7733 SUB Cal_flatness(@Dut,@Source,@Pm,Fs,Fe) 7734 Cal_flatness: REM $Header: Cal_flatness,v 1.1 94/04/11 14:55:13 hmgr Exp $ 7735 ALLOCATE Break_table(1:100) 7736 ALLOCATE Ee_data(1:705*3) 7737 ALLOCATE Ee_data_test(1:705*3) 7738 Read_ee_break(@Dut,Break_table(*)) 7739 Print_break_tab(Break_table(*)) 7740 Tstart=TIMEDATE 7741 IF Fs>1.0E+7 OR Fe<5.0E+10 THEN 7742 Read_ee_data(@Dut,Break_table(*),Ee_data(*)) 7743 ELSE 7744 Init_ee_data(Break_table(*),Ee_data(*)) 7745 END IF 7746 FOR Band=0 TO 5 7747 Adjband(@Dut,@Source,@Pm,Band,Fs,Fe,Break_table(*),Ee_data(*)) 7748 NEXT Band 7749 N=0 7750 LOOP 7751 N=N+1 7752 Write_ee_data(@Dut,Break_table(*),Ee_data(*),Checksum) 7753 Read_ee_data(@Dut,Break_table(*),Ee_data_test(*)) 7754 Checksumtest=FNRead_checksum 7755 PRINT "CHECKING EE_DATA" 7756 Failed=0 7757 Badcount=0 7758 IF Checksum<>Checksumtest THEN 7759 Failed=1 7760 PRINT "check sums do not match -- try #";N 7761 PRINT Checksum,Checksumtest 7762 OUTPUT 701;"check sums do not match -- try #";N 7763 OUTPUT 701;Checksum,Checksumtest 7764 END IF 7765 FOR I=1 TO 705*3 7766 IF Ee_data(I)<>Ee_data_test(I) THEN 7767 Failed=1 7768 DISP I 7769 PRINT I,Ee_data(I),Ee_data_test(I) 7770 Badcount=Badcount+1 7771 END IF 7772 NEXT I 7773 IF NOT Failed THEN PRINT "EE_DATA IS OK -- try #";N 7774 IF Failed THEN PRINT "EE_DATA Does not match -- try #";N 7775 IF Failed THEN PRINT Badcount;" values" 7776 IF Failed THEN OUTPUT 701;"EE_DATA Does not match -- try #";N 7777 IF Failed THEN OUTPUT 701;Badcount;" values" 7778 EXIT IF NOT Failed 7779 EXIT IF N>=3 7780 END LOOP 7781 IF Failed THEN 7782 PRINT "Did not get matching EE data after ";N;" tries. You lose!" 7783 OUTPUT 701;"Did not get matching EE data after ";N;" tries. You lose!" 7784 PAUSE 7785 END IF 7786 Tstop=TIMEDATE 7787 PRINT "Total time=";(Tstop-Tstart)/60;"minutes" 7788 OUTPUT @Dut;"adjall;" 7789 WAIT 30 7790 SUBEND 7791 SUB Cal_sbpretrack(@Dut,@Source,Model$,Sbpretrack) 7792 Cal_sbpretrack: REM $Header: Cal_sbpretrack,v 1.1 94/04/11 14:55:17 hmgr Exp $ 7793 CLEAR SCREEN 7794 PRINT "Adjusting SBTX pre-track ...." 7795 IF POS(Model$,"65") THEN 7796 F=4.95E+10 7797 Start=3.2E+10 7798 Stop=5.0E+10 7799 ELSE 7800 IF POS(Model$,"64") THEN 7801 F=3.95E+10 7802 Start=3.2E+10 7803 Stop=4.0E+10 7804 ELSE 7805 SUBEXIT 7806 END IF 7807 END IF 7808 St=(Stop-Start)/5.0E+10 7809 OUTPUT @Dut;"IP;SP 0HZ;CF ";F;"HZ;FREF EXT;SNGLS;RL -10;LG 5;ST 50MS;" 7810 OUTPUT @Source;"IP;CW ";F;"HZ;PL -4 DB;" 7811 Offset=5 7812 Dut("READ EE YTF OFFSET",Offset) 7813 Dut("WRITE YTF OFFSET 5",Offset) 7814 OUTPUT @Dut;"CONTS;SNGLS;TS;MKA?;" 7815 ENTER @Dut;Startampl 7816 Ampl=Startampl 7817 WHILE Ampl>Startampl-10 AND Offset>3 7818 Offset=Offset-4 7819 Dut("WRITE YTF OFFSET 5",Offset) 7820 OUTPUT @Dut;"CONTS;SNGLS;TS;MKA?;" 7821 ENTER @Dut;Ampl 7822 END WHILE 7823 Targetampl=Ampl 7824 OUTPUT @Dut;"FA ";Start;";FB ";Stop;";" 7825 OUTPUT @Dut;"ST ";St;" s;" 7826 Sbpretrack=0 7827 Step=16 7828 Ampl=-999 7829 WHILE Ampl255 THEN 7836 PRINT "**************" 7837 PRINT "warning: cant tune sb pre track" 7838 PRINT " contact engineer." 7839 PRINT "program paused" 7840 PRINT "continue will set default value of 16." 7841 PAUSE 7842 Set_sb_track(16) 7843 SUBEXIT 7844 END IF 7845 Sbpretrack=Sbpretrack-Step/2 7846 Set_sb_track(Sbpretrack) 7847 Step=Step/4 7848 WHILE Step>=1 7849 OUTPUT @Dut;"TS;MKPK;MKA?;" 7850 ENTER @Dut;Ampl 7851 IF Ampl>Targetampl THEN 7852 Sbpretrack=Sbpretrack-Step 7853 ELSE 7854 Sbpretrack=Sbpretrack+Step 7855 END IF 7856 Set_sb_track(Sbpretrack) 7857 Step=Step/2 7858 END WHILE 7859 Offset=5 7860 Dut("READ EE YTF OFFSET",Offset) 7861 Dut("WRITE YTF OFFSET 5",Offset) 7862 OUTPUT @Dut;"CONTS;SNGLS;TS;" 7863 PRINT "SBTX pre-track set to ";Sbpretrack 7864 SUBEND 7865 SUB Calc_chksum 7866 Calc_chksum: REM $Header: Calc_chksum,v 1.2 93/07/28 09:44:18 hmgr Exp $ 7867 REAL Ee_dac_addr,Checksum_addr 7868 IF FNRom_date("ORCA") THEN 7869 Z_ta_rdwr$="ZRDWR" 7870 Z_ta_stad$="ZSETADDR" 7871 ELSE 7872 Z_ta_rdwr$="TARDWR" 7873 Z_ta_stad$="TASETADDR" 7874 END IF 7875 Num_pnts=23 7876 IF FNRom_date("PP OFFSET") THEN Num_pnts=25 7877 IF FNRom_date("8 BANDS") THEN Num_pnts=33 7878 ALLOCATE Chksum_data(0:Num_pnts) 7879 ASSIGN @Dut TO 718 7880 Ee_dac_addr=FNRead_value("05FD38",4) 7881 Checksum_addr=Ee_dac_addr-2 7882 OUTPUT @Dut;""&Z_ta_stad$&" "&DVAL$(Ee_dac_addr,10)&";" 7883 FOR I=0 TO Num_pnts 7884 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 7885 ENTER @Dut;Chksum_data(I) 7886 NEXT I 7887 Checksum=SUM(Chksum_data)+1 7888 Write_data(DVAL$(Checksum_addr,16),INT(Checksum/2^8)) 7889 Write_data(DVAL$(Checksum_addr+1,16),Checksum MOD 2^8) 7890 OUTPUT @Dut;"CONTS;TS;SNGLS;TS;" 7891 SUBEND 7892 SUB Chk_status_file(OPTIONAL Jan_mode$) 7893 Chk_status_file: REM $Header: Chk_status_file,v 1.31 96/03/14 16:13:15 hmgr Exp $ 7894 COM /Dut_data/Status$(*),INTEGER Num_pass(*),Num_fail(*) 7895 COM /Dut_data/ REAL Total_test_time(*),Start_test_time 7896 ! COM /Dut_data/ REAL End_test_time,Test_process$,Stop_test_time(*) 7897 ! COM /Dut_data/ INTEGER Rework_flag 7898 COM /Identification/Serial_num$,Option$(*),Tech_num$ 7899 COM /Identification/ INTEGER Station_num,Batch 7900 COM /Variations/Model$,INTEGER Short_moved 7901 DIM Opts$[30],Serial_n$[20],Key_pressed$[20],Msg$[200],Test_menu_rev$[5] 7902 CALL Clr_scr 7903 CALL Show_message("*** Status File Check "&FNRcs_rev$("$Revision: 1.31 $")&" ***",2) 7904 INTEGER No_status_found,Pass_ptr,All_pass 7905 DIM Test_list$[200] 7906 Serial_n$=Serial_num$ 7907 IF LEN(Serial_num$)=4 THEN 7908 Serial_n$="0"&Serial_n$ 7909 END IF 7910 CALL Directory_info("TEST BLOCK",Test_block$) 7911 Test_block$=Test_block$[1;LEN(Test_block$)-1] 7912 CALL Get_status(Test_block$,Serial_num$,Test_menu_rev$,No_status_found) 7913 IF No_status_found THEN 7914 CALL Clr_scr 7915 CALL Prompt_keys("CONTINUE",Key_pressed$,"NO STATUS was found for ALIGNMENT tests for instrument number "&Serial_num$) 7916 ELSE 7917 CALL Dut("READ OPTIONS",0,Opts$) 7918 Opts$=Opts$[1;16] 7919 GOSUB Select_list 7920 All_pass=1 7921 PRINT 7922 FOR Pass_ptr=1 TO FNRead_menu_intgr("MENU SIZE") 7923 DISP "Checking test:";Pass_ptr 7924 IF POS(Test_list$," "&VAL$(Pass_ptr)) THEN 7925 IF Status$(Pass_ptr)[1,4]<>"Pass" THEN 7926 All_pass=0 7927 IF Status$(Pass_ptr)="" THEN 7928 S$="Untested" 7929 ELSE 7930 S$=Status$(Pass_ptr) 7931 END IF 7932 Test_name$=FNRead_menu_str$("TEST NAME") 7933 Status_format: IMAGE 10X,"Test ",DD,X,37A," status: ",10A 7934 PRINT USING Status_format;Pass_ptr,Test_name$,S$ 7935 END IF 7936 END IF 7937 NEXT Pass_ptr 7938 IF All_pass THEN 7939 CALL Load_font_data 7940 CALL Print_rout_slip 7941 ELSE 7942 Msg$="Routing slip not printed because of the above listed condition." 7943 END IF 7944 CALL Prompt_keys("CONTINUE,VIEW STATUS,PRINT STATUS",Key_pressed$,Msg$) 7945 SELECT Key_pressed$ 7946 CASE "CONTINUE" 7947 CASE "VIEW STATUS" 7948 CALL Printout_status("CRT") 7949 CASE "PRINT STATUS" 7950 CALL Printout_status("PRINTER") 7951 END SELECT 7952 END IF 7953 CALL Clr_scr 7954 SUBEXIT 7955 Select_list:! 7956 Test_menu$=FNRead_menu_str$("MENU NAME") 7957 SELECT Test_menu$ 7958 CASE "PORT_AL1" 7959 SELECT TRIM$(Test_menu_rev$) 7960 CASE "A" 7961 SELECT Model$ 7962 CASE "8560A","8560E" 7963 SELECT 1 7964 CASE (POS(Opts$,"02") AND POS(Opts$,"07")) 7965 Test_list$=" 1 2 3 4 5 6 7 8 10 11 12 13 14 15 16" 7966 CASE (POS(Opts$,"07")>0) 7967 Test_list$=" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 16" 7968 CASE (POS(Opts$,"02")>0) 7969 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 14 15 16" 7970 CASE ELSE 7971 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 14 16" 7972 END SELECT 7973 CASE "8561A","8561B","8561E" 7974 IF POS(Opts$,"07") THEN 7975 Test_list$=" 1 2 3 4 5 6 7 8 9 10 11 12 13 14 16" 7976 ELSE 7977 Test_list$=" 1 2 3 4 5 6 7 8 9 10 12 13 14 16" 7978 END IF 7979 CASE "8562A","8563A","A" 7980 Test_list$=" 1 2 3 4 5 6 7 8 9 10 12 13 14 16" 7981 CASE "8562B","B" 7982 Test_list$=" 1 2 3 4 5 6 7 8 9 10 12 13 14 16" 7983 CASE "8563E" 7984 IF POS(Opts$,"07") THEN 7985 Test_list$=" 1 2 3 4 5 6 7 8 10 11 12 13 14 16" 7986 ELSE 7987 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 14 16" 7988 END IF 7989 CASE "8564E","8565E" 7990 IF POS(Opts$,"07") THEN 7991 Test_list$=" 1 2 3 4 5 6 7 8 10 11 12 13 16" 7992 ELSE 7993 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 16" 7994 END IF 7995 CASE ELSE 7996 Msg$="Unknown model:"&Model$ 7997 GOTO Drop_dead_error 7998 END SELECT 7999 CASE "C" 8000 SELECT Model$ 8001 CASE "8560A","8560E" 8002 SELECT 1 8003 CASE (POS(Opts$,"02") AND POS(Opts$,"07")) 8004 Test_list$=" 1 2 3 4 5 6 7 8 10 11 12 13 14 15" 8005 CASE (POS(Opts$,"07")>0) 8006 Test_list$=" 1 2 3 4 5 6 7 8 9 10 12 13 15" 8007 CASE (POS(Opts$,"02")>0) 8008 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 14 15" 8009 CASE ELSE 8010 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 15" 8011 END SELECT 8012 CASE "8561A","8561B","8561E" 8013 IF POS(Opts$,"07") THEN 8014 Test_list$=" 1 2 3 4 5 6 7 8 9 10 11 12 13 15" 8015 ELSE 8016 Test_list$=" 1 2 3 4 5 6 7 8 9 10 12 13 15" 8017 END IF 8018 CASE "8562A","8563A","A" 8019 Test_list$=" 1 2 3 4 5 6 7 8 9 10 12 13 15" 8020 CASE "8562B","B" 8021 Test_list$=" 1 2 3 4 5 6 7 8 9 10 12 13 15" 8022 CASE "8563E" 8023 IF POS(Opts$,"07") THEN 8024 Test_list$=" 1 2 3 4 5 6 7 8 10 11 12 13 15" 8025 ELSE 8026 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 15" 8027 END IF 8028 CASE "8562E" 8029 IF POS(Opts$,"07") THEN 8030 Test_list$=" 1 2 3 4 5 6 7 8 10 11 12 13 15 17" 8031 ELSE 8032 Test_list$=" 1 2 3 4 5 6 7 8 10 12 13 15 17" 8033 END IF 8034 CASE "8564E","8565E" 8035 IF POS(Opts$,"07") THEN 8036 Test_list$=" 1 2 3 4 5 6 7 8 10 11 12 15 17" 8037 ELSE 8038 Test_list$=" 1 2 3 4 5 6 7 8 10 12 15 17" 8039 END IF 8040 CASE ELSE 8041 Msg$="Unknown model:"&Model$ 8042 GOTO Drop_dead_error 8043 END SELECT 8044 CASE ELSE 8045 Msg$="Unknown menu revision: "&Test_menu_rev$ 8046 GOTO Drop_dead_error 8047 END SELECT 8048 CASE "PORT_AL2" 8049 SELECT TRIM$(Test_menu_rev$) 8050 CASE "A" 8051 SELECT Model$ 8052 CASE "8560A","8560E" 8053 SELECT 1 8054 CASE (POS(Opts$,"02") AND POS(Opts$,"07")) 8055 Test_list$=" 1 2 3 " 8056 CASE (POS(Opts$,"07")>0) 8057 Test_list$=" 1 2 3 4" 8058 CASE (POS(Opts$,"02")>0) 8059 Test_list$=" 1 2 3 " 8060 CASE ELSE 8061 Test_list$=" 1 2 3 4" 8062 END SELECT 8063 CASE "8561A","8561B","8561E" 8064 IF POS(Opts$,"07") THEN 8065 Test_list$=" 1 2 3 4" 8066 ELSE 8067 Test_list$=" 1 2 3 4" 8068 END IF 8069 CASE "8562A","8563A","A" 8070 Test_list$=" 1 2 3 4" 8071 CASE "8562B","B" 8072 Test_list$=" 1 2 3 4" 8073 CASE "8562E","8563E","8564E","8565E" 8074 IF POS(Opts$,"07") THEN 8075 Test_list$=" 1 2 3 4" 8076 ELSE 8077 Test_list$=" 1 2 3 4" 8078 END IF 8079 CASE ELSE 8080 Msg$="Unknown model:"&Model$ 8081 GOTO Drop_dead_error 8082 END SELECT 8083 CASE ELSE 8084 Msg$="Unknown menu revision: "&Test_menu_rev$ 8085 GOTO Drop_dead_error 8086 END SELECT 8087 CASE ELSE 8088 Msg$="Unknown test block: "&Test_block$ 8089 GOTO Drop_dead_error 8090 END SELECT 8091 RETURN 8092 Drop_dead_error:! 8093 DISP "Drop_dead_error:";Msg$;" -- This is Chk_status_file." 8094 PAUSE 8095 PAUSE 8096 STOP 8097 SUBEND 8098 SUB Clean_up(Reason$,Jan_mode$) 8099 Clean_up: REM $Header: Clean_up,v 1.13 93/09/13 09:50:18 hmgr Exp $ 8100 CALL Clr_scr 8101 CALL Show_message("*** Clean up "&FNRcs_rev$("$Revision: 1.13 $")&" ***",2) 8102 CALL Mola_bug_fix 8103 IF FNRom_date("<","930606") THEN 8104 CALL Dut("COPY FACTORY PP DATA TO USER PP DATA") 8105 END IF 8106 CALL Chk_status_file(Jan_mode$) 8107 IF FNRom_date("NO TAM") THEN 8108 CALL Show_message("* Put the short on the A2J12 board to position 'WR PROT' *",5) 8109 CALL Prompt_keys("CONTINUE",Key_pressed$) 8110 CALL Show_message(" ",5) 8111 Dut("READ EE DAC PER 10DB",First_value) 8112 LOOP 8113 DISP "... CHECKING POSITION OF EPROM WRITE ENABLE SHORT ..." 8114 Dut("WRITE EE DAC PER 10DB=2,READ EE DAC PER 10DB",Second_value) 8115 EXIT IF (Second_value=First_value) 8116 Dut("WRITE EE DAC PER 10DB="&VAL$(First_value)) 8117 PRINT TABXY(2,4);"The short is in position 'WR ENA' on the A2J12 board! Move it to 'WR PROT'!" 8118 PRINT TABXY(2,6);"You MUST move the short before continuing on. (Press CONTINUE)" 8119 PAUSE 8120 CALL Clr_scr 8121 CALL Show_message("*** Clean up "&FNRcs_rev$("$Revision: 1.13 $")&" ***",2) 8122 END LOOP 8123 Dut("INITIALIZE") 8124 END IF 8125 Dummy=FNRom_date("CLEAR") 8126 SUBEND 8127 SUB Clear_pfail_crt(Control$,OPTIONAL INTEGER Screen_size) 8128 Clear_pfail_crt: REM $Header: Clear_pfail_crt,v 1.1 92/02/17 10:56:21 hmgr Exp $ 8129 GOTO Begin 8130 REM 8131 REM ================================================================== 8132 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 8133 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 8134 REM REVISION: 870326:1330.RV 8135 REM ================================================================== 8136 REM 8137 Begin:! 8138 Col=1 8139 Last=17 8140 Len=80 8141 IF NPAR=2 THEN 8142 Size=Screen_size 8143 ELSE 8144 Size=80 8145 END IF 8146 SELECT Control$ 8147 CASE "Y" 8148 IF Size=80 THEN 8149 First=11 8150 ELSE 8151 First=13 8152 Col=18 8153 Len=32 8154 END IF 8155 GOSUB Clear_it 8156 CASE "N" 8157 IF Size=80 THEN 8158 PRINT TABXY(21,6);RPT$(" ",59) 8159 First=11 8160 ELSE 8161 First=6 8162 Col=18 8163 Len=32 8164 END IF 8165 GOSUB Clear_it 8166 CASE "ALL" 8167 GCLEAR 8168 OUTPUT KBD;CHR$(255)&"K"; 8169 END SELECT 8170 SUBEXIT 8171 Clear_it:! 8172 FOR I=First TO Last 8173 IF Size=50 AND I=12 THEN 8174 ELSE 8175 PRINT TABXY(Col,I);RPT$(CHR$(32),Len) 8176 END IF 8177 NEXT I 8178 SUBEND 8179 SUB Clear_screen(OPTIONAL Control$,INTEGER From,To) 8180 Clear_screen:! 8181 IF NPAR>0 THEN 8182 SELECT Control$ 8183 CASE "LINE" 8184 IF NPAR>1 THEN First=From 8185 IF NPAR>2 THEN 8186 Last=To 8187 ELSE 8188 Last=From 8189 END IF 8190 CASE "ALL" 8191 First=1 8192 Last=18 8193 END SELECT 8194 FOR I=First TO Last 8195 PRINT TABXY(1,I);RPT$(CHR$(32),80) 8196 NEXT I 8197 ELSE 8198 OUTPUT KBD;CHR$(255)&"K"; 8199 END IF 8200 SUBEND 8201 SUB Correct_8482(Rp_8482,Rp_num$) 8202 Correct_8482: REM $Header: Correct_8482,v 1.3 93/02/12 16:12:09 hmgr Exp $ 8203 OUTPUT Rp_num$ USING """RP"",4Z,#";Rp_8482 8204 IF FNSnsr_on_disk$(Rp_num$)<>"ON DISK" THEN 8205 Show_message("8482A "&Rp_num$&" NUMBER IS NOT ON DISK.",16) 8206 Show_message("ABORT TEST AND RERUN ""SERIAL NUM"" TEST (UPDATE 8482 RP# IN MENU)",17) 8207 LOOP 8208 END LOOP 8209 END IF 8210 SUBEND 8211 SUB Correct_8485(Rp_8485,Rp_num$) 8212 Correct_8485: REM $Header: Correct_8485,v 1.3 93/02/12 16:13:23 hmgr Exp $ 8213 OUTPUT Rp_num$ USING """RP"",4Z,#";Rp_8485 8214 IF FNSnsr_on_disk$(Rp_num$)<>"ON DISK" THEN 8215 Show_message("8485A "&Rp_num$&" NUMBER IS NOT ON DISK.",16) 8216 Show_message("ABORT TEST AND RERUN ""SERIAL NUM"" TEST (UPDATE 8485 RP# IN MENU)",17) 8217 LOOP 8218 END LOOP 8219 END IF 8220 SUBEND 8221 SUB Correct_8487(Rp_8487,Rp_num$) 8222 Correct_8487: REM $Header: Correct_8487,v 1.2 93/02/12 16:13:53 hmgr Exp $ 8223 OUTPUT Rp_num$ USING """RP"",4Z,#";Rp_8487 8224 IF FNSnsr_on_disk$(Rp_num$)<>"ON DISK" THEN 8225 Show_message("8487A "&Rp_num$&" NUMBER IS NOT ON DISK.",16) 8226 Show_message("ABORT TEST AND RERUN ""SERIAL NUM"" TEST (UPDATE 8487 RP# IN MENU)",17) 8227 LOOP 8228 END LOOP 8229 END IF 8230 SUBEND 8231 SUB Create_filt(Filt(*),Filt_size) 8232 Create_filt: REM $Header: Create_filt,v 1.1 94/04/11 14:55:22 hmgr Exp $ 8233 GINIT 8234 GCLEAR 8235 T=2 8236 A=1 8237 Taps=2*Filt_size 8238 WINDOW -Taps/2,Taps/2,-1,1 8239 FOR Xx=1 TO 2 8240 Sum=0 8241 X=-Filt_size-1 8242 FOR I=-T TO T STEP T*2/Taps 8243 X=X+1 8244 IF I=0 THEN 8245 Y=A 8246 ELSE 8247 Y=A*(EXP(-I^2)) 8248 END IF 8249 PLOT X,Y 8250 Sum=Sum+Y 8251 Filt(X)=Y 8252 NEXT I 8253 PRINT X 8254 PRINT 1/Sum 8255 A=1/Sum 8256 NEXT Xx 8257 MOVE -10,0 8258 PLOT -10,0 8259 PLOT X,0 8260 SUBEND 8261 SUB Crt_data(Start,S_size) 8262 Crt_data: REM $Header: Crt_data,v 1.1 92/02/17 10:56:58 hmgr Exp $ 8263 INTEGER Mf 8264 Mf=READIO(9826,-302) 8265 IF BIT(Mf,0)=0 THEN 8266 S_size=80 8267 Start=28799 8268 ELSE 8269 S_size=50 8270 Start=29519 8271 END IF 8272 SUBEND 8273 SUB Cursor(INTEGER Col,Row,Cur$) 8274 Cursor: REM $Header: Cursor,v 1.1 92/02/17 10:57:07 hmgr Exp $ 8275 INTEGER Type,Cursor 8276 CALL Crt_data(Start,S_size) 8277 Cursor=Start+Row*S_size+Col 8278 SELECT Cur$ 8279 CASE "NORM" 8280 Type=75 8281 CASE "INSERT" 8282 Type=64 8283 END SELECT 8284 WRITEIO 1,1;10 8285 WRITEIO 1,3;Type 8286 WRITEIO 1,1;15 8287 WRITEIO 1,3;Cursor MOD 256 8288 WRITEIO 1,1;14 8289 WRITEIO 1,3;Cursor DIV 256 8290 PRINT TABXY(Col,Row); 8291 SUBEND 8292 SUB Draw_man 8293 GOTO Draw_man 8294 Draw_man: REM $Header: Draw_man,v 1.1 92/02/17 10:57:17 hmgr Exp $ 8295 COM /Drawings/ INTEGER Man(1:6000),Flag_right(1:3000),Flag_left(1:3000),Flag_r_erase(1:3000),Flag_l_erase(1:3000) 8296 GCLEAR 8297 GINIT 8298 GRAPHICS ON 8299 VIEWPORT 0,130,0,100 8300 WINDOW 0,100,0,100 8301 Draw_it:! 8302 GLOAD Man(*) 8303 LOOP 8304 ON KEY 5 LABEL " CONTINUE" GOSUB Exit 8305 GLOAD Flag_right(*) 8306 WAIT .5 8307 GLOAD Flag_r_erase(*) 8308 WAIT .5 8309 GLOAD Flag_left(*) 8310 GLOAD Flag_l_erase(*) 8311 END LOOP 8312 Exit:! 8313 GCLEAR 8314 ALPHA ON 8315 SUBEND 8316 SUB Dut(Input$,OPTIONAL Io_value,Char$) 8317 Dut: REM $Header: Dut,v 1.33 96/01/23 13:09:26 hmgr Exp $ 8318 COM /Prefix/Prefix$ 8319 COM /Variations/Model$,INTEGER Short_moved 8320 COM /Ee_data/ INTEGER Ee_data(*) 8321 DIM Function$[80],Entry$[80],Instruction$[160],Key_pressed$[10] 8322 DIM Msg$[160],Error_message$[100],Z_ta_rdwr$[15],Z_ta_stad$[15] 8323 DIM Cal_updt_cmd$[40] 8324 REAL Pp_table(0:75),Break_table(0:701),Dummy 8325 INTEGER Select_code 8326 IF FNRom_date("ORCA") THEN 8327 Z_ta_rdwr$="ZRDWR" 8328 Z_ta_stad$="ZSETADDR" 8329 ELSE 8330 Z_ta_rdwr$="TARDWR" 8331 Z_ta_stad$="TASETADDR" 8332 END IF 8333 IF FNRom_date("8 BANDS") THEN 8334 Cal_updt_cmd$="ZRFCAL 0;TS;" 8335 ELSE 8336 Cal_updt_cmd$="CONTS;TS;SNGLS;TS;" 8337 END IF 8338 ASSIGN @Dut TO 718 8339 STATUS @Dut,1;Select_code 8340 ON TIMEOUT Select_code,10 GOTO Dut_timeout 8341 Debug=0 8342 Instruction$=Input$ 8343 Dut_loop:! 8344 Input$=Instruction$ 8345 REPEAT 8346 Parse(Input$,Function$,Parse_value) 8347 IF NPAR>=2 THEN Value=Io_value 8348 IF Parse_value<>-999 THEN Value=Parse_value 8349 SELECT Function$ 8350 CASE "LOCAL" 8351 LOCAL @Dut 8352 CASE "CLEAR" 8353 CLEAR @Dut 8354 CASE "IP" 8355 OUTPUT @Dut;"IP;AUNITS AUTO;PSTATE OFF;" 8356 CASE "INITIALIZE" 8357 OUTPUT @Dut;"IP;AUNITS AUTO;" 8358 CASE "TITLE" 8359 OUTPUT @Dut;"TITLE %"&Char$&"%;" 8360 CASE "POWER ON STATE" 8361 Test_number=-3 8362 OUTPUT @Dut;"IP;AUNITS AUTO;" 8363 Dut("IP,SWEEP TIME=49,EXT MXR UNPRESELECT") 8364 WAIT .5 8365 FOR I=0 TO 8 8366 Dut("SAVE STATE",I) 8367 NEXT I 8368 Dut("SWEEP TIME=49,SAVE STATE=9") 8369 FOR I=0 TO 7 8370 Dut("SAVE TRACE A",I) 8371 NEXT I 8372 Dut("MIXER BIAS OFF,EXT MXR UNPRESELECT,IP,SINGLE SWEEP,CENTER FREQ=300E6,SPAN=200E3,RBW=300,VBW=300,TRIGGER SWEEP,PEAK SEARCH,MARKER TO REF LEVEL") 8373 Dut("TRIGGER SWEEP,PEAK SEARCH,MARKER DELTA=30E3,CONTINUOUS SWEEP,MAX HOLD B,BLANK A,MARKER NOISE ON,SAVE POWER ON") 8374 CASE "ADJUST ALL" 8375 OUTPUT @Dut;"ADJALL;" 8376 WAIT 27 8377 CASE "ADJUST CURRENT STATE" 8378 OUTPUT @Dut;"ADJIF CURR;" 8379 WAIT 8 8380 CASE "AUTOCAL ON" 8381 OUTPUT @Dut;"ADJIF ON;" 8382 CASE "AUTOCAL OFF" 8383 OUTPUT @Dut;"ADJIF OFF;" 8384 CASE "SAVE STATE" 8385 OUTPUT @Dut;"SAVES ";Value;";" 8386 CASE "RECALL STATE" 8387 OUTPUT @Dut;"RCLS ";Value;";" 8388 CASE "SAVE POWER ON" 8389 OUTPUT @Dut;"SAVES PWRON;" 8390 CASE "DONE?" 8391 OUTPUT @Dut;"DONE?;" 8392 Recovery_type=3 8393 ENTER @Dut;Io_value 8394 CASE "REF LEVEL CAL" 8395 OUTPUT @Dut;"RLCAL ";Value;";" 8396 CASE "READ REF LEVEL CAL" 8397 OUTPUT @Dut;"RLCAL?;" 8398 Recovery_type=4 8399 ENTER @Dut;Io_value 8400 CASE "ATTENUATOR" 8401 OUTPUT @Dut;"AT ";Value;";" 8402 CASE "REF LEVEL" 8403 OUTPUT @Dut;"RL ";Value;";" 8404 CASE "READ REF LEVEL" 8405 OUTPUT @Dut;"RL?;" 8406 Recovery_type=5 8407 ENTER @Dut;Io_value 8408 CASE "SCALE" 8409 IF Value=0 THEN OUTPUT @Dut;"LN;" 8410 IF Value>0 THEN OUTPUT @Dut;"LG ";Value;";" 8411 CASE "READ SCALE" 8412 OUTPUT @Dut;"LG?;" 8413 Recovery_type=6 8414 ENTER @Dut;Io_value 8415 CASE "UNITS VOLTS" 8416 OUTPUT @Dut;"AUNITS V;" 8417 CASE "UNITS DBM" 8418 OUTPUT @Dut;"AUNITS DBM;" 8419 CASE "RBW" 8420 OUTPUT @Dut;"RB ";Value;";" 8421 CASE "READ RBW" 8422 OUTPUT @Dut;"RB?;" 8423 Recovery_type=7 8424 ENTER @Dut;Io_value 8425 CASE "AUTO RBW" 8426 OUTPUT @Dut;"RB AUTO;" 8427 CASE "VBW" 8428 OUTPUT @Dut;"VB ";Value;";" 8429 CASE "READ VBW" 8430 OUTPUT @Dut;"VB?;" 8431 Recovery_type=8 8432 ENTER @Dut;Io_value 8433 Recovery_type=7 8434 CASE "AUTO VBW" 8435 OUTPUT @Dut;"VB AUTO;" 8436 CASE "VBW AVERAGE" 8437 OUTPUT @Dut;"VAVG ";Value;";" 8438 CASE "VBW AVERAGE OFF" 8439 OUTPUT @Dut;"VAVG OFF;" 8440 CASE "AM DEMOD ON" 8441 OUTPUT @Dut;"DEMOD AM;" 8442 CASE "FM DEMOD ON" 8443 OUTPUT @Dut;"DEMOD FM;" 8444 CASE "DEMOD OFF" 8445 OUTPUT @Dut;"DEMOD OFF;" 8446 CASE "VOLUME" 8447 OUTPUT @Dut;"VOL ";Value;";" 8448 CASE "CENTER FREQ","CENTER FREQUENCY" 8449 OUTPUT @Dut;"CF ";Value;";" 8450 CASE "SPAN" 8451 OUTPUT @Dut;"SP ";Value;";" 8452 CASE "STEP SPAN DOWN" 8453 OUTPUT @Dut;"SP DN;" 8454 CASE "START FREQ","START FREQUENCY" 8455 OUTPUT @Dut;"FA ";Value;";" 8456 CASE "STOP FREQ","STOP FREQUENCY" 8457 OUTPUT @Dut;"FB ";Value;";" 8458 CASE "READ SPAN" 8459 OUTPUT @Dut;"SP?;" 8460 Recovery_type=9 8461 ENTER @Dut;Io_value 8462 CASE "READ MROLL" 8463 OUTPUT @Dut;"FDIAG MROLL ?;" 8464 Recovery_type=10 8465 ENTER @Dut;Io_value 8466 CASE "READ OROLL" 8467 OUTPUT @Dut;"FDIAG OROLL ?;" 8468 Recovery_type=11 8469 ENTER @Dut;Io_value 8470 CASE "READ XROLL" 8471 OUTPUT @Dut;"FDIAG XROLL ?;" 8472 Recovery_type=12 8473 ENTER @Dut;Io_value 8474 CASE "INTERNAL REF","INTERNAL REFERENCE" 8475 OUTPUT @Dut;"FREF INT;" 8476 CASE "EXTERNAL REF","EXTERNAL REFERENCE" 8477 LOOP 8478 OUTPUT @Dut;"FREF EXT;" 8479 WAIT 1 8480 OUTPUT @Dut;"ERR?;" 8481 ENTER @Dut;Temp_err$ 8482 IF POS(Temp_err$,"905") THEN 8483 Msg$="856X External Reference Error!" 8484 CALL Show_message(Msg$,8) 8485 Msg$="Check that the 10 MHz Reference is connected to the Rear Panel." 8486 CALL Show_message(Msg$,9) 8487 CALL Prompt_keys("CONTINUE",Key_pressed$) 8488 CALL Clear_screen("LINE",4,18) 8489 END IF 8490 EXIT IF NOT POS(Temp_err$,"905") 8491 END LOOP 8492 CASE "MARKER FREQ COUNT RES" 8493 OUTPUT @Dut;"MKFCR ";Value;";" 8494 CASE "COUNT MARKER FREQUENCY" 8495 Loop_counter=0 8496 REPEAT 8497 Loop_counter=Loop_counter+1 8498 OUTPUT @Dut;"MKFC ON;TS;" 8499 OUTPUT @Dut;"MKF?;" 8500 Recovery_type=13 8501 ENTER @Dut;Io_value 8502 Recovery_type=0 8503 OUTPUT @Dut;"MKFC OFF;" 8504 UNTIL ABS(Io_value)<1.E+11 OR Loop_counter=10 8505 CASE "INTERNAL MIXER" 8506 OUTPUT @Dut;"MXRMODE INT;" 8507 CASE "EXTERNAL MIXER" 8508 OUTPUT @Dut;"MXRMODE EXT;" 8509 CASE "PRESET CONVERSION LOSS" 8510 OUTPUT @Dut;"MXRMODE EXT;TS;" 8511 RESTORE Mixer_harmonics 8512 Mixer_harmonics: DATA 5,6,8,10,14,16,18,24,30,36,44,54,END 8513 LOOP 8514 READ Harmonic$ 8515 EXIT IF Harmonic$="END" 8516 OUTPUT @Dut;"HNLOCK "&Harmonic$&";TS;CNVLOSS 30;" 8517 END LOOP 8518 CASE "MIXER BIAS OFF" 8519 OUTPUT @Dut;"MBIAS OFF;" 8520 CASE "MIXER BIAS" 8521 OUTPUT @Dut;"MBIAS ";Value;";" 8522 CASE "HARMONIC NUMBER" 8523 OUTPUT @Dut;"HNLOCK ";Value;";TS;" 8524 CASE "PRESELECTOR PEAK","PEAK PRESELECTOR" 8525 OUTPUT @Dut;"PP;" 8526 CASE "CENTER PRESELECTOR","CENTER PRESELECTOR W/O HANGUP" 8527 No_hangup=POS(Function$,"W/O HANGUP") 8528 Rf_core_addr=FNRead_value("05FC44",4) 8529 Offset=FNRead_value(DVAL$(Rf_core_addr+4,16),2) 8530 Ytf_offset=1 8531 Address$=DVAL$(Rf_core_addr+Offset*4+Ytf_offset,10) 8532 Address$=Address$[4;10] 8533 Old_dac=Io_value 8534 LOOP 8535 IF No_hangup THEN OUTPUT @Dut;"PP;TS;" 8536 OUTPUT @Dut;"PP;TS;MKA?" 8537 ENTER @Dut;Peak_amp 8538 OUTPUT @Dut;""&Z_ta_stad$&" "&Address$&";"&Z_ta_rdwr$&"?;" 8539 ENTER @Dut;Data$ 8540 Peak_ytf_dac=VAL(Data$) 8541 EXIT IF Peak_amp>-35 AND ABS(Peak_ytf_dac-128)<=96 AND ABS(Peak_ytf_dac-Old_dac)<=5 8542 EXIT IF No_hangup 8543 Old_dac=Peak_ytf_dac 8544 END LOOP 8545 IF No_hangup THEN 8546 Center_ytf_dac=Peak_ytf_dac 8547 ELSE 8548 Center_ytf_dac=0 8549 Start_power=5 8550 Stop_power=3 8551 Below_amp=-999 8552 Below_dac=0 8553 Above_amp=999 8554 Above_dac=0 8555 FOR Sign=-1 TO 1 STEP 2 8556 Ytf_dac=Peak_ytf_dac 8557 Toggle=1 8558 FOR Power=Start_power TO Stop_power STEP -1 8559 IF Power=Start_power-1 AND Toggle=1 THEN Power=Start_power 8560 Last_amp=Marker_amp 8561 Last_dac=Ytf_dac 8562 Ytf_dac=Ytf_dac+Sign*Toggle*2^Power 8563 IF Ytf_dac>255 OR Ytf_dac<0 THEN 8564 DISP "YTF DAC out of range in CENTER PRESELECTOR routine. (Wants to be "&VAL$(Ytf_dac)&".)" 8565 PAUSE 8566 END IF 8567 Data$=DVAL$(Ytf_dac,10) 8568 WAIT .01 8569 OUTPUT @Dut;""&Z_ta_stad$&" "&Address$&";"&Z_ta_rdwr$&" "&Data$&";TS;MKA?" 8570 WAIT .01 8571 ENTER 718;Marker_amp 8572 Toggle=(Marker_amp>Peak_amp-4)*2-1 8573 IF Toggle=1 THEN 8574 Above_amp=Marker_amp 8575 Above_dac=Ytf_dac 8576 ELSE 8577 Below_amp=Marker_amp 8578 Below_dac=Ytf_dac 8579 END IF 8580 NEXT Power 8581 Dac_point=Below_dac+(Above_dac-Below_dac)*(Peak_amp-4-Below_amp)/(Above_amp-Below_amp) 8582 Center_ytf_dac=Center_ytf_dac+Dac_point/2 8583 NEXT Sign 8584 END IF 8585 Io_value=PROUND(Center_ytf_dac,0) 8586 OUTPUT @Dut;""&Z_ta_stad$&" "&Address$&";"&Z_ta_rdwr$&" "&VAL$(Io_value)&";" 8587 WAIT .01 8588 CASE "READ PRESELECTOR DAC" 8589 OUTPUT @Dut;"PSDAC?;" 8590 ENTER @Dut;Io_value 8591 CASE "READ EXT MXR PRESELECT" 8592 OUTPUT @Dut;"EXTMXR?;" 8593 ENTER @Dut;Char$ 8594 CASE "EXT MXR UNPRESELECT" 8595 OUTPUT @Dut;"EXTMXR UNPR;" 8596 OUTPUT @Dut;"ERR?;" 8597 ENTER @Dut;Temp_err$ 8598 IF Temp_err$<>"0" THEN 8599 LOCAL @Dut 8600 REMOTE @Dut 8601 END IF 8602 CASE "EXT MXR PRESELECT" 8603 OUTPUT @Dut;"EXTMXR PRE;" 8604 OUTPUT @Dut;"ERR?;" 8605 ENTER @Dut;Temp_err$ 8606 IF Temp_err$<>"0" THEN 8607 LOCAL @Dut 8608 REMOTE @Dut 8609 END IF 8610 CASE "SWEEP TIME" 8611 OUTPUT @Dut;"ST ";Value;";" 8612 CASE "READ SWEEP TIME" 8613 OUTPUT @Dut;"ST?;" 8614 Recovery_type=14 8615 ENTER @Dut;Io_value 8616 CASE "AUTO SWEEP TIME" 8617 OUTPUT @Dut;"ST AUTO;" 8618 CASE "TRIGGER SWEEP" 8619 OUTPUT @Dut;"TS;" 8620 CASE "SINGLE SWEEP" 8621 OUTPUT @Dut;"SNGLS;" 8622 CASE "CONTINUOUS SWEEP" 8623 OUTPUT @Dut;"CONTS;" 8624 CASE "EXTERNAL TRIGGER" 8625 OUTPUT @Dut;"TM EXT;" 8626 CASE "VIDEO TRIGGER" 8627 OUTPUT @Dut;"TM VID;" 8628 CASE "VIDEO TRIGGER LEVEL" 8629 OUTPUT @Dut;"VTL ";Value;";" 8630 CASE "LINE TRIGGER" 8631 OUTPUT @Dut;"TM LINE;" 8632 CASE "RAMP SWEEP OUTPUT" 8633 OUTPUT @Dut;"SWPOUT RAMP;" 8634 CASE "FAV SWEEP OUTPUT" 8635 OUTPUT @Dut;"SWPOUT FAV;" 8636 CASE "MARKER ON" 8637 OUTPUT @Dut;"MKN;" 8638 CASE "MARKER OFF" 8639 OUTPUT @Dut;"MKOFF;" 8640 CASE "MARKER NOISE ON" 8641 OUTPUT @Dut;"MKNOISE ON;" 8642 CASE "MARKER DELTA" 8643 OUTPUT @Dut;"MKD "&VAL$(Value);";" 8644 CASE "PEAK SEARCH" 8645 OUTPUT @Dut;"MKPK;" 8646 CASE "PEAK EXCURSION" 8647 OUTPUT @Dut;"MKPX ";Value;";" 8648 CASE "PEAK THRESHOLD" 8649 OUTPUT @Dut;"MKPT ";Value;";" 8650 CASE "NEXT PEAK" 8651 OUTPUT @Dut;"MKPK NH;" 8652 CASE "RIGHT PEAK" 8653 OUTPUT @Dut;"MKPK NR;" 8654 CASE "MIN SEARCH" 8655 OUTPUT @Dut;"MKMIN;" 8656 CASE "READ MARKER AMPLITUDE" 8657 OUTPUT @Dut;"MKA?;" 8658 Recovery_type=2 8659 ENTER @Dut;Io_value 8660 CASE "READ EXTRAPOLATED PEAK AMPLITUDE" 8661 Dut("DUMP TRACE A,READ REF LEVEL",Ref_level) 8662 Dut("READ SPAN",Span) 8663 Dut("READ RBW",Rbw) 8664 Io_value=MAX(Trace_data(*)) 8665 IF Io_value>Ref_level THEN 8666 MAT Trace_data=Trace_data>=(Ref_level) 8667 Delta_freq=(SUM(Trace_data)-1)*Span/600 8668 Io_value=Ref_level+40*LGT((Delta_freq/Rbw/2)^2/1.151627^2+1) 8669 END IF 8670 CASE "MARKER FREQ" 8671 OUTPUT @Dut;"MKF ";Value;";" 8672 CASE "READ MARKER FREQ","READ MARKER FREQUENCY" 8673 OUTPUT @Dut;"MKF?;" 8674 Recovery_type=13 8675 ENTER @Dut;Io_value 8676 CASE "MARKER TIME" 8677 OUTPUT @Dut;"MKT ";Value;";" 8678 CASE "READ MARKER TIME" 8679 OUTPUT @Dut;"MKT?;" 8680 Recovery_type=15 8681 ENTER @Dut;Io_value 8682 CASE "MARKER TO REF LEVEL" 8683 OUTPUT @Dut;"MKRL;" 8684 CASE "MARKER TO CENTER FREQUENCY" 8685 OUTPUT @Dut;"MKCF;" 8686 CASE "MARKER TRACK ON" 8687 OUTPUT @Dut;"MKTRACK ON;" 8688 CASE "MARKER TRACK OFF" 8689 OUTPUT @Dut;"MKTRACK OFF;" 8690 CASE "READ MODEL NUMBER" 8691 Loop_counter=0 8692 REPEAT 8693 Loop_counter=Loop_counter+1 8694 OUTPUT @Dut;"ID?;" 8695 Recovery_type=16 8696 ENTER @Dut;Char$ 8697 Recovery_type=0 8698 IF Loop_counter=10 THEN CALL Loop_error("DUT ID reading REPEAT loop.") 8699 UNTIL LEN(Char$)=7 OR POS(Char$,",")=8 OR Loop_counter=10 8700 IF LEN(Char$)>7 THEN Char$=Char$[1,7] 8701 CASE "READ OPTIONS" 8702 Loop_counter=0 8703 REPEAT 8704 Loop_counter=Loop_counter+1 8705 OUTPUT @Dut;"ID?;" 8706 Recovery_type=16 8707 ENTER @Dut;Char$ 8708 Recovery_type=0 8709 IF Loop_counter=10 THEN CALL Loop_error("DUT OPT reading REPEAT loop.") 8710 UNTIL LEN(Char$)=7 OR POS(Char$,",")=8 OR Loop_counter=10 8711 IF LEN(Char$)>7 THEN 8712 Char$=Char$[8] 8713 ELSE 8714 Char$="" 8715 END IF 8716 CASE "READ SERIAL NUMBER","READ FULL SERIAL NUMBER" 8717 Loop_counter=0 8718 REPEAT 8719 Loop_counter=Loop_counter+1 8720 OUTPUT @Dut;"SER?;" 8721 Recovery_type=17 8722 ENTER @Dut;Entry$ 8723 Recovery_type=0 8724 OUTPUT @Dut;"ID?;" 8725 Recovery_type=16 8726 ENTER @Dut;Id$ 8727 Recovery_type=0 8728 IF Loop_counter=10 THEN CALL Loop_error("DUT serial number reading REPEAT loop.") 8729 UNTIL Loop_counter=10 OR (LEN(Entry$)=10 AND (LEN(Id$)=7 OR POS(Id$,",")=8)) 8730 Char$=Id$[7,7]&Entry$[6] 8731 IF Function$="READ FULL SERIAL NUMBER" THEN Char$=Entry$ 8732 CASE "READ ROM DATE" 8733 OUTPUT @Dut;"REV?;" 8734 Recovery_type=18 8735 ENTER @Dut;Char$ 8736 Recovery_type=0 8737 CASE "CHECK UNLOCKED" 8738 OUTPUT @Dut;"FREF EXT;TS;" 8739 OUTPUT @Dut;"ERR?;" 8740 Recovery_type=1 8741 ENTER @Dut;Entry$ 8742 Recovery_type=0 8743 IF POS(Entry$,"301") OR POS(Entry$,"302") OR POS(Entry$,"303") OR POS(Entry$,"304") OR POS(Entry$,"327") THEN Io_value=1 8744 OUTPUT @Dut;"FREF INT;" 8745 CASE "READ ERRORS" 8746 OUTPUT @Dut;"ERR?;" 8747 ENTER @Dut;Char$ 8748 CASE "CLEAR WRITE A" 8749 OUTPUT @Dut;"CLRW TRA;" 8750 CASE "BLANK A" 8751 OUTPUT @Dut;"BLANK TRA;" 8752 CASE "MAX HOLD B" 8753 OUTPUT @Dut;"MXMH TRB;" 8754 CASE "VIEW A" 8755 OUTPUT @Dut;"VIEW TRA;" 8756 CASE "DUMP TRACE A" 8757 OUTPUT @Dut;"TDF P;" 8758 OUTPUT @Dut;"TRA?;" 8759 Recovery_type=19 8760 ENTER @Dut;Trace_data(*) 8761 Recovery_type=0 8762 CASE "SAVE TRACE A" 8763 OUTPUT @Dut;"SAVET TRA, ";Value;";" 8764 CASE "DIGITAL AVERAGE" 8765 Dut("READ SCALE",Scale) 8766 OUTPUT @Dut;"CLRW TRA;" 8767 OUTPUT @Dut;"DONE?;" 8768 Recovery_type=3 8769 ENTER @Dut;Dummy 8770 Recovery_type=0 8771 DISP Dummy 8772 OUTPUT @Dut;"TS;TDF P;" 8773 OUTPUT @Dut;"TRA?;" 8774 Recovery_type=19 8775 ENTER @Dut;Trace_data(*) 8776 Recovery_type=0 8777 Io_value=SUM(Trace_data)/SIZE(Trace_data,1) 8778 IF Scale=0 THEN Io_value=10*LGT(MAX(1.E-10,Io_value)^2/50)+30 8779 CASE "DIGITAL AVERAGE DIV 0-2" 8780 Dut("DUMP TRACE A") 8781 Io_value=0 8782 FOR I=0 TO 120 8783 Io_value=Io_value+Trace_data(I)/121 8784 NEXT I 8785 CASE "DIGITAL AVERAGE BKT 0-12" 8786 Dut("DUMP TRACE A") 8787 Io_value=0 8788 FOR I=0 TO 12 8789 Io_value=Io_value+Trace_data(I)/13 8790 NEXT I 8791 CASE "DIGITAL PEAK DIV 2-8" 8792 Dut("DUMP TRACE A") 8793 Io_value=-999 8794 FOR I=120 TO 480 8795 Io_value=MAX(Io_value,Trace_data(I)) 8796 NEXT I 8797 CASE "SAMPLE DETECTOR" 8798 OUTPUT @Dut;"DET SMP;" 8799 CASE "POSITIVE DETECTOR" 8800 OUTPUT @Dut;"DET POS;" 8801 CASE "NEGATIVE DETECTOR" 8802 OUTPUT @Dut;"DET NEG;" 8803 CASE "GRATICULE OFF" 8804 OUTPUT @Dut;"GRAT OFF;" 8805 CASE "CRT ADJUSTMENT PATTERN" 8806 OUTPUT @Dut;"ADJCRT;" 8807 CASE "ADJUST RF GAIN TABLE" 8808 Break_address=DVAL(FNHex_value$("05FB70"),16) 8809 FOR Address=Break_address TO Break_address+690 STEP 10 8810 OUTPUT @Dut;""&Z_ta_stad$&" "&VAL$(Address+6);";" 8811 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 8812 ENTER @Dut;Data$ 8813 OUTPUT @Dut;""&Z_ta_stad$&" "&VAL$(Address+6);";" 8814 WAIT .01 8815 OUTPUT @Dut;""&Z_ta_rdwr$&" "&VAL$(VAL(Data$)-4);";" 8816 WAIT .01 8817 NEXT Address 8818 OUTPUT @Dut;"IP;AUNITS AUTO;" 8819 Dut_tam:! 8820 CASE "WRITE ENABLE" 8821 WAIT .01 8822 OUTPUT @Dut;""&Z_ta_stad$&" ";DVAL("FEF000",16);";"&Z_ta_rdwr$&" 1;" 8823 WAIT .01 8824 CASE "WRITE DISABLE" 8825 WAIT .01 8826 OUTPUT @Dut;""&Z_ta_stad$&" ";DVAL("FEF000",16);";"&Z_ta_rdwr$&" 0;" 8827 WAIT .01 8828 CASE "UPDATE RF CORE DAC" 8829 OUTPUT 718;Cal_updt_cmd$ 8830 CASE "READ RF CORE GAIN DAC","READ RF CORE YTF DAC","WRITE RF CORE GAIN DAC","WRITE RF CORE YTF DAC" 8831 IF Model$="8560E" OR Model$="8561E" OR Model$="8562E" OR Model$="8563E" OR Model$="8564E" OR Model$="8565E" THEN 8832 OUTPUT @Dut;"CONTS;SNGLS;" 8833 Addr_addr=FNRead_value("05FD10",4) 8834 Addr=FNRead_value(DVAL$(Addr_addr,16),4) 8835 Dac_length=2 8836 Delta=Dac_length*(POS(Function$,"YTF DAC")<>0) 8837 IF Function$[1,4]="READ" THEN 8838 Io_value=FNRead_value(DVAL$(Addr+Delta,16),Dac_length) 8839 ELSE 8840 WAIT .01 8841 Write_data(DVAL$(Addr+Delta,16),INT(Value/256)) 8842 Write_data(DVAL$(Addr+Delta+1,16),Value MOD 256) 8843 END IF 8844 ELSE 8845 Addr=FNRead_value("05FC44",4) 8846 Offset=FNRead_value(DVAL$(Addr+4,16),2) 8847 Dac_length=1 8848 Delta=Dac_length*(POS(Function$,"YTF DAC")<>0) 8849 IF Function$[1,4]="READ" THEN 8850 Io_value=FNRead_value(DVAL$(Addr+Offset*4+Delta,16),Dac_length) 8851 ELSE 8852 WAIT .01 8853 Write_data(DVAL$(Addr+Offset*4+Delta,16),Value) 8854 END IF 8855 END IF 8856 CASE "PRINT EE BREAK TABLE" 8857 Ee_break_addr=FNRead_value("05FBB8",4) 8858 St_address(DVAL$(Ee_break_addr,16)) 8859 FOR I=0 TO 69 8860 Frequency=0 8861 FOR J=0 TO 5 8862 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 8863 ENTER @Dut;Data$ 8864 Frequency=Frequency*256+VAL(Data$) 8865 NEXT J 8866 PRINT USING "#,5D,5X";Frequency/1.E+6 8867 IF Model$="8560E" OR Model$="8561E" OR Model$="8562E" OR Model$="8563E" OR Model$="8564E" OR Model$="8565E" THEN 8868 FOR J=1 TO 2 8869 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 8870 ENTER @Dut;Data1$ 8871 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 8872 ENTER @Dut;Data2$ 8873 PRINT USING "#,8D";256*VAL(Data1$)+VAL(Data2$) 8874 NEXT J 8875 ELSE 8876 FOR J=6 TO 9 8877 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 8878 ENTER @Dut;Data$ 8879 PRINT USING "#,8A";Data$ 8880 NEXT J 8881 END IF 8882 PRINT 8883 NEXT I 8884 CASE "RE-STORE EE BREAK TABLE" 8885 DISP "Copying break table to EEROM" 8886 Ee_break_addr=FNRead_value("05FBB8",4) 8887 Checksum_addr=FNRead_value("05FB74",4) 8888 Checksum=1 8889 IF Model$="8560E" OR Model$="8561E" OR Model$="8562E" OR Model$="8563E" OR Model$="8564E" OR Model$="8565E" THEN 8890 Checksum_len=FNRead_value("05FB2A",2) 8891 St_address(DVAL$(Ee_break_addr,16)) 8892 Ee_length=Checksum_len*Ee_data(1) 8893 WAIT .01 8894 FOR I=2 TO Ee_length+1 8895 OUTPUT @Dut;""&Z_ta_rdwr$&" ";DVAL$(Ee_data(I),10);";" 8896 WAIT .01 8897 Checksum=Checksum+Ee_data(I) 8898 IF Checksum>=2^16 THEN Checksum=(Checksum-2^16)+1 8899 NEXT I 8900 Write_data(DVAL$(Checksum_addr,16),INT(Checksum/2^8)) 8901 Write_data(DVAL$(Checksum_addr+1,16),Checksum MOD 2^8) 8902 ELSE 8903 St_address(DVAL$(Ee_break_addr,16)) 8904 WAIT .01 8905 FOR I=0 TO 699 8906 OUTPUT @Dut;""&Z_ta_rdwr$&" ";DVAL$(Ee_data(I),10);";" 8907 WAIT .01 8908 Checksum=Checksum+Ee_data(I) 8909 NEXT I 8910 Write_data(DVAL$(Checksum_addr,16),INT(Checksum/2^8)) 8911 Write_data(DVAL$(Checksum_addr+1,16),Checksum MOD 2^8) 8912 END IF 8913 DISP 8914 CASE "CHECK TAM" 8915 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 8916 ENTER @Dut;Anything$ 8917 CASE "3RD IF AMP CAL" 8918 IF Model$="8560E" OR Model$="8561E" OR Model$="8562E" OR Model$="8563E" OR Model$="8564E" OR Model$="8565E" THEN 8919 CALL Dut("IP,CENTER FREQ=300E6,SPAN=0,SINGLE SWEEP,MARKER ON,TRIGGER SWEEP") 8920 Dut("READ RF CORE GAIN DAC",Prev_value) 8921 First_value=8*256 8922 Scnd_value=(8*256+1000) 8923 Dut("WRITE RF CORE GAIN DAC",First_value) 8924 OUTPUT 718;Cal_updt_cmd$ 8925 WAIT 1 8926 Dut("TRIGGER SWEEP,READ MARKER AMPLITUDE",Marker1) 8927 Dut("WRITE RF CORE GAIN DAC",Scnd_value) 8928 OUTPUT 718;Cal_updt_cmd$ 8929 WAIT 1 8930 Dut("TRIGGER SWEEP,READ MARKER AMPLITUDE",Marker2) 8931 Dut("WRITE RF CORE GAIN DAC",Prev_value) 8932 WAIT .2 8933 Io_value=PROUND(10*(Scnd_value-First_value)/(Marker2-Marker1),0) 8934 ELSE 8935 CALL Dut("IP,CENTER FREQ=300E6,SPAN=0,SINGLE SWEEP,MARKER ON,TRIGGER SWEEP") 8936 Addr=FNRead_value("05FC44",4)+25*4 8937 Prev_value=FNRead_value(DVAL$(Addr,16),1) 8938 First_value=128 8939 Scnd_value=196 8940 Multiplier=64*10 8941 WAIT .01 8942 Write_data(DVAL$(Addr,16),First_value) 8943 Dut("TRIGGER SWEEP,READ MARKER AMPLITUDE",Marker1) 8944 Write_data(DVAL$(Addr,16),Scnd_value) 8945 Dut("TRIGGER SWEEP,READ MARKER AMPLITUDE",Marker2) 8946 Write_data(DVAL$(Addr,16),Prev_value) 8947 Io_value=PROUND(Multiplier/(Marker2-Marker1),0) 8948 END IF 8949 CASE "WRITE EE REF LEVEL CAL" 8950 Addr=FNRead_value("05FBC4",4) 8951 IF Value<0 THEN Value=Value+2^16 8952 WAIT .01 8953 Write_data(DVAL$(Addr,16),INT(Value/2^8)) 8954 Write_data(DVAL$(Addr+1,16),Value MOD 2^8) 8955 CASE "COPY BREAK TABLE TO EEROM" 8956 Ram_break_addr=FNRead_value("05FB70",4) 8957 Ee_break_addr=FNRead_value("05FBB8",4) 8958 Checksum_addr=FNRead_value("05FB74",4) 8959 St_address(DVAL$(Ram_break_addr,16)) 8960 DISP "Reading break table from RAM" 8961 FOR I=0 TO 699 8962 OUTPUT @Dut;""&Z_ta_rdwr$&"?;" 8963 ENTER @Dut;Data$ 8964 Break_table(I)=DVAL(TRIM$(Data$),10) 8965 NEXT I 8966 St_address(DVAL$(Ee_break_addr,16)) 8967 DISP "Copying break table to EEROM" 8968 WAIT .01 8969 FOR I=0 TO 699 8970 OUTPUT @Dut;""&Z_ta_rdwr$&" "&DVAL$(Break_table(I),10);";" 8971 WAIT .01 8972 NEXT I 8973 Checksum=SUM(Break_table)+1 8974 Write_data(DVAL$(Checksum_addr,16),INT(Checksum/2^8)) 8975 Write_data(DVAL$(Checksum_addr+1,16),Checksum MOD 2^8) 8976 DISP 8977 CASE "READ EE FIRST MIXER" 8978 Addr=FNRead_value("05FC94",4) 8979 Io_value=FNRead_value(DVAL$(Addr+Io_value,16),1) 8980 CASE "READ EE FIRST MIXER CHECKSUM" 8981 Addr=FNRead_value("05FC94",4)+5 8982 Io_value=FNRead_value(DVAL$(Addr,16),2) 8983 CASE "COPY FIRST MIXER TO EE" 8984 Checksum=1 8985 WAIT .01 8986 FOR Band=0 TO 4 8987 Mixer_dac=Band 8988 Dut("READ MIXER DAC",Mixer_dac) 8989 Addr=FNRead_value("05FC94",4)+Band 8990 Write_data(DVAL$(Addr,16),Mixer_dac) 8991 Checksum=Checksum+Mixer_dac 8992 NEXT Band 8993 Write_data(DVAL$(Addr+1,16),INT(Checksum/2^8)) 8994 Write_data(DVAL$(Addr+2,16),Checksum MOD 2^8) 8995 CASE "VALID FIRST MIXER DAC ADDRESS" 8996 CALL Dut("READ ROM DATE",Null,Date_rev$) 8997 Io_value=-1 8998 IF Date_rev$>"881030" THEN Io_value=1 8999 IF Prefix$="2809A" THEN Io_value=1 9000 CASE "READ FIRST MIXER DAC","READ MIXER DAC" 9001 IF NPAR=3 THEN Addr_valid$=Char$ 9002 Band=Io_value 9003 IF Addr_valid$<>"VALID" THEN 9004 CALL Dut("VALID FIRST MIXER DAC ADDRESS",Valid) 9005 END IF 9006 IF Valid=1 OR Addr_valid$="VALID" THEN 9007 IF Prefix$<>"2809A" THEN 9008 Start_addr=FNRead_value("05FD08",4) 9009 Intmxr_addr=Start_addr+Band 9010 Io_value=FNRead_value(DVAL$(Intmxr_addr,16),1) 9011 ELSE 9012 Start_addr=DVAL("FFC334",16) 9013 Intmxr_addr=Start_addr+Band 9014 Io_value=FNRead_value(DVAL$(Intmxr_addr,16),1) 9015 END IF 9016 ELSE 9017 GOSUB Print_oper_warn 9018 END IF 9019 CASE "OLD READ MIXER DAC" 9020 Band=Io_value 9021 IF Prefix$<>"2809A" THEN 9022 IF Model$="8561B" THEN 9023 Start_addr=DVAL("FFC34E",16) 9024 ELSE 9025 Start_addr=DVAL("FFC344",16) 9026 END IF 9027 ELSE 9028 Start_addr=DVAL("FFC334",16) 9029 END IF 9030 Intmxr_addr=Start_addr+Band 9031 Io_value=FNRead_value(DVAL$(Intmxr_addr,16),1) 9032 CASE "WRITE FIRST MIXER DAC 0" TO "WRITE FIRST MIXER DAC 4" 9033 IF NPAR=3 THEN Addr_valid$=Char$ 9034 IF Addr_valid$<>"VALID" THEN 9035 CALL Dut("VALID FIRST MIXER DAC ADDRESS",Valid) 9036 END IF 9037 IF Valid=1 OR Addr_valid$="VALID" THEN 9038 WAIT .01 9039 IF Prefix$<>"2809A" THEN 9040 Addr=FNRead_value("05FD08",4)+VAL(Function$[23]) 9041 Write_data(DVAL$(Addr,16),Io_value) 9042 ELSE 9043 Addr=DVAL("FFC334",16)+VAL(Function$[23]) 9044 Write_data(DVAL$(Addr,16),Io_value) 9045 END IF 9046 ELSE 9047 GOSUB Print_oper_warn 9048 END IF 9049 CASE "READ YTF SLOPE","READ EE YTF SLOPE" 9050 Addr=FNRead_value("05FC9C",4) 9051 IF POS(Function$,"EE") THEN Addr=FNRead_value("05FCA4",4) 9052 Io_value=FNRead_value(DVAL$(Addr+Io_value,16),1) 9053 CASE "WRITE YTF SLOPE 0" TO "WRITE YTF SLOPE 7" 9054 Addr=FNRead_value("05FC9C",4)+VAL(Function$[17]) 9055 WAIT .01 9056 Write_data(DVAL$(Addr,16),Io_value) 9057 CASE "WRITE EE YTF SLOPE 0" TO "WRITE EE YTF SLOPE 7" 9058 Addr=FNRead_value("05FCA4",4)+VAL(Function$[20]) 9059 WAIT .01 9060 Write_data(DVAL$(Addr,16),Io_value) 9061 CASE "READ YTF OFFSET","READ EE YTF OFFSET" 9062 Addr=FNRead_value("05FC98",4) 9063 IF POS(Function$,"EE") THEN Addr=FNRead_value("05FCA0",4) 9064 Io_value=FNRead_value(DVAL$(Addr+Io_value,16),1) 9065 CASE "WRITE YTF OFFSET 0" TO "WRITE YTF OFFSET 7" 9066 Addr=FNRead_value("05FC98",4)+VAL(Function$[17]) 9067 WAIT .01 9068 Write_data(DVAL$(Addr,16),Io_value) 9069 CASE "WRITE EE YTF OFFSET 0" TO "WRITE EE YTF OFFSET 7" 9070 Addr=FNRead_value("05FCA0",4)+VAL(Function$[20]) 9071 WAIT .01 9072 Write_data(DVAL$(Addr,16),Io_value) 9073 CASE "READ EXT MXR REF CAL","READ EE EXT MXR REF CAL","READ EXT MXR REF CAL DAC" 9074 Addr=FNRead_value("05FCB4",4) 9075 IF POS(Function$,"EE") THEN Addr=FNRead_value("05FCB0",4) 9076 Io_value=FNRead_value(DVAL$(Addr,16),2) 9077 IF Io_value>2^15-1 THEN Io_value=Io_value-2^16 9078 Io_value=Io_value/100 9079 CASE "WRITE EXT MXR REF CAL","WRITE EE EXT MXR REF CAL" 9080 Addr=FNRead_value("05FCB4",4) 9081 IF POS(Function$,"EE") THEN Addr=FNRead_value("05FCB0",4) 9082 Value=Value*100 9083 IF Value<0 THEN Value=Value+2^16 9084 WAIT .01 9085 Write_data(DVAL$(Addr,16),INT(Value/2^8)) 9086 Write_data(DVAL$(Addr+1,16),Value MOD 2^8) 9087 CASE "READ DAC PER 10DB","READ EE DAC PER 10DB" 9088 Addr=FNRead_value("05FCBC",4) 9089 IF POS(Function$,"EE") THEN Addr=FNRead_value("05FCA8",4) 9090 Io_value=FNRead_value(DVAL$(Addr,16),2) 9091 IF Model$="8560E" OR Model$="8561E" OR Model$="8562E" OR Model$="8563E" OR Model$="8564E" OR Model$="8565E" THEN 9092 IF Io_value>32768 THEN Io_value=Io_value-2^16 9093 END IF 9094 CASE "WRITE DAC PER 10DB","WRITE EE DAC PER 10DB" 9095 Addr=FNRead_value("05FCBC",4) 9096 IF POS(Function$,"EE") THEN Addr=FNRead_value("05FCA8",4) 9097 IF Model$="8560E" OR Model$="8561E" OR Model$="8562E" OR Model$="8563E" OR Model$="8564E" OR Model$="8565E" THEN 9098 IF Value<0 THEN Value=Value+2^16 9099 END IF 9100 WAIT .01 9101 Write_data(DVAL$(Addr,16),INT(Value/2^8)) 9102 Write_data(DVAL$(Addr+1,16),Value MOD 2^8) 9103 CASE "COPY FACTORY PP DATA TO USER PP DATA" 9104 Factory_addr=FNRead_value("05FBB8",4) 9105 User_addr=DVAL("FF0C04",16) 9106 WAIT .01 9107 FOR I=0 TO 69 9108 Pp_table(I)=FNRead_value(DVAL$(Factory_addr+I*10+7,16),1) 9109 Write_data(DVAL$(User_addr+I,16),Pp_table(I)) 9110 NEXT I 9111 Checksum=2^16-SUM(Pp_table)+1 9112 Write_data(DVAL$(User_addr+70,16),INT(Checksum/256)) 9113 Write_data(DVAL$(User_addr+71,16),Checksum MOD 256) 9114 CASE "EXT MXR REF CAL DAC" 9115 Addr=FNRead_value("05FCB4",4) 9116 Value=Value*10+2^16 9117 WAIT .01 9118 Write_data(DVAL$(Addr,16),INT(Value/2^16)) 9119 Write_data(DVAL$(Addr+1,16),Value MOD 2^16) 9120 CASE "READ YTF SLOPE" 9121 Addr=FNRead_value("05FC9C",4) 9122 Io_value=FNRead_value(DVAL$(Addr+Io_value,16),1) 9123 CASE "READ YTF OFFSET" 9124 Addr=FNRead_value("05FCA0",4) 9125 Io_value=FNRead_value(DVAL$(Addr+Io_value,16),1) 9126 CASE "FOCUS DAC" 9127 Ccfreq_addr=FNRead_value("05FB80",4) 9128 Focus_addr=Ccfreq_addr+239 9129 WAIT .01 9130 Write_data(DVAL$(Focus_addr,16),Value) 9131 Write_data("FF2041",Value) 9132 CASE "STORE FOCUS" 9133 Ccfreq_addr=FNRead_value("05FB80",4) 9134 Focus_addr=Ccfreq_addr+239 9135 Focus=FNRead_value(DVAL$(Focus_addr,16),1) 9136 Eefocus_addr=FNRead_value("05FC8C",4) 9137 WAIT .01 9138 Write_data(DVAL$(Eefocus_addr,16),Focus) 9139 CASE "INTENSITY DAC" 9140 Ccfreq_addr=FNRead_value("05FB80",4) 9141 Inten_addr=Ccfreq_addr+241 9142 WAIT .01 9143 Write_data(DVAL$(Inten_addr,16),Value) 9144 Write_data("FF2040",Value) 9145 CASE "STORE INTENSITY" 9146 Ccfreq_addr=FNRead_value("05FB80",4) 9147 Inten_addr=Ccfreq_addr+241 9148 Inten=FNRead_value(DVAL$(Inten_addr,16),1) 9149 Eeinten_addr=FNRead_value("05FC88",4) 9150 WAIT .01 9151 Write_data(DVAL$(Eeinten_addr,16),Inten) 9152 CASE "AMPLITUDE PREADJUST CHECK" 9153 Dut("READ REF LEVEL CAL",Rl_cal) 9154 IF Rl_cal<-33 THEN 9155 Dut("REF LEVEL CAL=0") 9156 Dut("WRITE EE REF LEVEL CAL=0") 9157 Ram_break_addr=FNRead_value("05FB70",4) 9158 Ee_break_addr=FNRead_value("05FBB8",4) 9159 St_address(DVAL$(Ram_break_addr+86,16)) 9160 WAIT .01 9161 OUTPUT @Dut;""&Z_ta_rdwr$&" "&DVAL$(175,10);";" 9162 WAIT .01 9163 St_address(DVAL$(Ee_break_addr+86,16)) 9164 OUTPUT @Dut;""&Z_ta_rdwr$&" "&DVAL$(175,10);";" 9165 WAIT .01 9166 Dut("COPY BREAK TABLE TO EEROM") 9167 END IF 9168 CASE "TKGEN COARSE DAC" 9169 OUTPUT @Dut;"SRCCRSTK ";Value;";" 9170 CASE "TKGEN FINE DAC" 9171 OUTPUT @Dut;"SRCFINTK ";Value;";" 9172 CASE "TRACKING GENERATOR POWER" 9173 OUTPUT @Dut;"SRCPWR ";Value;";" 9174 CASE "TRACKING GENERATOR ON" 9175 OUTPUT @Dut;"SRCPWR 3;SRCPWR ON;" 9176 CASE "TRACKING GENERATOR OFF" 9177 OUTPUT @Dut;"SRCPWR -10;SRCPWR OFF;" 9178 CASE "PEAK TRACKING GENERATOR" 9179 OUTPUT @Dut;"SRCTKPK;" 9180 CASE "READ F/W REVISION" ! Symm: Case Read F/W Revision added by Symmetrix, *** 9181 OUTPUT @Dut;"REV?;" ! Symm: missing from provided subprograms. *** 9182 ENTER @Dut;Io_value ! Symm: *** 9183 CASE ELSE 9184 Show_message(Function$&" not found in DUT driver") 9185 STOP 9186 END SELECT 9187 Recovery_type=0 9188 UNTIL Input$="" 9189 SUBEXIT 9190 Print_oper_warn:! 9191 CLEAR SCREEN 9192 PRINT "ATTENTION ALIGNMENT TECH:" 9193 PRINT "THE FIRST MIXER DAC ADDRESS IS NOT AVAILABLE FOR THIS ROM REV DATE OF ";Date_rev$&"!" 9194 PRINT "You were trying to '"&Function$&"="&VAL$(Io_value)&"'." 9195 PRINT "Please contact FRANCIS SMALL or RONETTE VERRALL, and report the serial number," 9196 PRINT "prefix number, rom rev date, and problem. If they are not around, then leave a" 9197 PRINT "note on their desk, and if at all possible," 9198 PRINT "TEST THE FIRST MIXER DAC MANUALLY!" 9199 CALL Prompt_keys("CONTINUE",Key_pressed$,"Press 'CONTINUE' when ready.") 9200 Char$="No known address for mixer bias dac." 9201 SIGNAL 2 9202 Dut_timeout:! 9203 IF (POS(Instruction$,"IP")>0) OR (POS(Instruction$,"INITIALIZE")>0) THEN 9204 Msg$="8562 at address 718 TIMEOUT, FIX AND PRESS CONTINUE" 9205 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 9206 GOTO Dut_loop 9207 ELSE 9208 SIGNAL 2 9209 END IF 9210 Dut_end: SUBEND 9211 SUB Dutmessage(Message$) 9212 Dutmessage: REM $Header: Dutmessage,v 1.1 92/02/17 10:57:37 hmgr Exp $ 9213 Message(Message$,Dontpause) 9214 Dut("TITLE",0,Message$) 9215 SUBEND 9216 SUB Ee_band(Whichband,Break_table(*),Start_index,Stop_index) 9217 Ee_band: REM $Header: Ee_band,v 1.1 94/04/11 14:55:26 hmgr Exp $ 9218 Start_index=700 9219 Stop_index=0 9220 I=1 9221 Ntotal=0 9222 WHILE Break_table(I)<>65535 9223 IF I DIV 4=I/4 THEN 9224 N=(Break_table(I-1)-Break_table(I-2))/Break_table(I)+1 9225 Ntotal=Ntotal+N 9226 Band=Break_table(I-3) 9227 Nstart=Ntotal-N+1 9228 Nstop=Ntotal 9229 IF Band=Whichband THEN 9230 IF NstartStop_index THEN Stop_index=Nstop 9232 END IF 9233 END IF 9234 I=I+1 9235 END WHILE 9236 IF Stop_index<=Start_index OR Start_index<1 OR Stop_index>699 THEN 9237 PRINT "Error in 'ee_band' .... paused" 9238 PRINT Whichband,Start_index,Stop_index 9239 PAUSE 9240 END IF 9241 SUBEND 9242 SUB Ee_info(Band,Freq,Break_table(*),Ee_data(*),Cal_point,Rfgain,Ytf) 9243 Ee_info: REM $Header: Ee_info,v 1.1 94/04/11 14:55:29 hmgr Exp $ 9244 N=0 9245 I=1 9246 WHILE Break_table(I)=Freq 9257 N=N+(Break_table(I+2)-Break_table(I+1))/Break_table(I+3)+1 9258 I=I+4 9259 EXIT IF Break_table(I)<>Band 9260 END LOOP 9261 IF Break_table(I)<>Band THEN 9262 Rfgain=Ee_data(3*N-2)*256+Ee_data(3*N-1) 9263 Ytf=Ee_data(3*N) 9264 Cal_point=N 9265 ELSE 9266 IF Freq>Break_table(I+1) THEN 9267 M=N+1+((Freq-Break_table(I+1))/Break_table(I+3)) 9268 N=INT(M) 9269 Rfgain1=Ee_data(3*N-2)*256+Ee_data(3*N-1) 9270 Ytf1=Ee_data(3*N) 9271 N=INT(M+1) 9272 Rfgain2=Ee_data(3*N-2)*256+Ee_data(3*N-1) 9273 Ytf2=Ee_data(3*N) 9274 Rfgain=Rfgain1+(Rfgain2-Rfgain1)*(M-INT(M)) 9275 Ytf=Ytf1+(Ytf2-Ytf1)*(M-INT(M)) 9276 Cal_point=M 9277 ELSE 9278 IF Break_table(I-4)<>Band THEN 9279 N=N+1 9280 Rfgain=Ee_data(3*N-2)*256+Ee_data(3*N-1) 9281 Ytf=Ee_data(3*N) 9282 Cal_point=N 9283 ELSE 9284 F1=Break_table(I-4+2) 9285 Rfgain1=Ee_data(3*N-2)*256+Ee_data(3*N-1) 9286 Ytf1=Ee_data(3*N) 9287 F2=Break_table(I+1) 9288 N=N+1 9289 Rfgain2=Ee_data(3*N-2)*256+Ee_data(3*N-1) 9290 Ytf2=Ee_data(3*N) 9291 Rfgain=Rfgain1+(Rfgain2-Rfgain1)*(Freq-F1)/(F2-F1) 9292 Ytf=Ytf1+(Ytf2-Ytf1)*(Freq-F1)/(F2-F1) 9293 Cal_point=N-1+(Freq-F1)/(F2-F1) 9294 END IF 9295 END IF 9296 END IF 9297 SUBEND 9298 SUB Enter_data(Field$(*),Sfk$,Key_labels$(*),OPTIONAL INTEGER First_field) 9299 Enter_data: REM $Header: Enter_data,v 1.2 92/03/17 13:45:00 hmgr Exp $ 9300 INTEGER Fld,Base_col,Col,Row,Len,Key,Valid 9301 DIM Key$[80],Cursor$[6] 9302 CALL Crt_data(Start,S_size) 9303 Cursor$="NORM" 9304 IF NPAR=4 THEN 9305 Fld=First_field-1 9306 ELSE 9307 Fld=0 9308 END IF 9309 Done=0 9310 ON KBD ALL GOSUB Kerr 9311 ON KNOB .01 GOSUB Kerr 9312 GOSUB Define_keycodes 9313 CONTROL 1,12;0 9314 FOR I=0 TO 9 9315 ON KEY I LABEL Key_labels$(I) GOTO Key_service 9316 NEXT I 9317 OFF KBD 9318 OFF KNOB 9319 ON KBD ALL GOSUB Keyservice 9320 GOSUB Tab_mode 9321 CALL Cursor(Col,Row,Cursor$) 9322 Loop: IF Done THEN GOTO Done 9323 GOTO Loop 9324 Knobservice:! 9325 Key$=KBD$ 9326 DISP Key$ 9327 WAIT 1 9328 CALL Tone("ERROR") 9329 GOTO Flush 9330 Keyservice:! 9331 Key$=KBD$ 9332 Flush:! 9333 IF NOT LEN(Key$) THEN RETURN 9334 Key=NUM(Key$) 9335 IF (Key=255) THEN 9336 Key=NUM(Key$[2]) 9337 Key$=Key$[3] 9338 IF Key=255 THEN 9339 CALL Tone("ERROR") 9340 Key$=Key$[4] 9341 END IF 9342 ELSE 9343 Key$=Key$[2] 9344 GOTO Write_char 9345 END IF 9346 SELECT Key 9347 CASE Top,Bottom,Home,Recl 9348 GOTO Ignor_it 9349 CASE Stop,Pa,Cont,Run,Exe,Del_lin,Ins_lin 9350 GOTO Ignor_it 9351 CASE C_tab,S_tb,Result,Any_char 9352 GOTO Ignor_it 9353 CASE L_arr,B_sp,R_arr,0 9354 GOSUB Cursor_mode 9355 CASE Caps 9356 GOSUB Type 9357 CASE Sfk0 TO Sfk9 9358 GOSUB Exit_control 9359 CASE Del_chr 9360 GOSUB Delete_char 9361 CASE C_end 9362 GOSUB Clr_end 9363 CASE Ins_chr 9364 IF Cursor$="INSERT" THEN 9365 Cursor$="NORM" 9366 ELSE 9367 Cursor$="INSERT" 9368 END IF 9369 CASE Tab,S_tab,Up,Down,S_left,S_right,S_up,S_down,Ent 9370 Cursor$="NORM" 9371 GOSUB Tab_mode 9372 CASE D_alpha 9373 Dump_screen 9374 CASE C_lin 9375 GOSUB Clr_line 9376 END SELECT 9377 CALL Cursor(Col,Row,Cursor$) 9378 GOTO Flush 9379 Write_char:! 9380 IF Cursor$="INSERT" THEN 9381 GOSUB Insert_char 9382 ELSE 9383 OUTPUT CRT;CHR$(Key); 9384 Key=0 9385 GOSUB Cursor_mode 9386 END IF 9387 CALL Cursor(Col,Row,Cursor$) 9388 GOTO Flush 9389 Ignor_it:! 9390 CALL Tone("ERROR") 9391 CALL Cursor(Col,Row,Cursor$) 9392 GOTO Flush 9393 Type:! 9394 STATUS 2,0;Cap_stat 9395 IF Cap_stat<>0 THEN 9396 Cap_stat=0 9397 Cap$="Caps lock off" 9398 ELSE 9399 Cap_stat=1 9400 Cap$="Caps lock on" 9401 END IF 9402 CONTROL 2,0;Cap_stat 9403 DISP Cap$ 9404 RETURN 9405 Exit_control:! 9406 Done=1 9407 Sfk$=Key_labels$(Key-48) 9408 RETURN 9409 Define_keycodes:! 9410 INTEGER Down,Up,S_down,S_up,Ins_lin,Del_lin 9411 INTEGER Recl,S_recl,Ins_chr,Del_chr,C_end,Edit 9412 INTEGER S_edit,Alpha,D_alpha,Graph,D_graph 9413 INTEGER Step,Any,C_lin,C_scn,Result,S_tb,Prt_all 9414 INTEGER C_tb,C_io,Stp,Pa,Run,Cont,Exe,Ent 9415 INTEGER B_sp,L_arr,R_arr,S_left,S_right 9416 INTEGER Tab,S_tab,Caps,Sfk0,Sfk1,Sfk2,Sfk3,Sfk4,Sfk5 9417 INTEGER Sfk6,Sfk7,Sfk8,Sfk9,Sfk10,Sfk11,Sfk12,Sfk13 9418 INTEGER Sfk14,Sfk15,Sfk16,Sfk17,Sfk18,Sfk19 9419 Keycodes:! 9420 DATA 86,94,84,87,42,47,63,64,43,45,37,68,70,77,79,76,78 9421 DATA 83,36,35,75,61,93,65,91,73,33,80,82,67,88,69,66,60,62 9422 DATA 72,71,41,40,85,48,49,50,51,52,53,54,55,56,57 9423 DATA 97,98,99,100,101,102,103,104,105,106 9424 DATA 9,17,25,33,41,49,57,65,73,80,1 9425 RESTORE Keycodes 9426 READ Down,Up,S_down,S_up,Ins_lin,Del_lin 9427 READ Recl,S_recl,Ins_chr,Del_chr,C_end,Edit 9428 READ S_edit,Alpha,D_alpha,Graph,D_graph 9429 READ Step,Any,C_lin,C_scn,Result,S_tb,Prt_all 9430 READ C_tb,C_io,Stp,Pa,Run,Cont,Exe,Ent 9431 READ B_sp,L_arr,R_arr,S_left,S_right 9432 READ Tab,S_tab,Caps,Sfk0,Sfk1,Sfk2,Sfk3,Sfk4,Sfk5 9433 READ Sfk6,Sfk7,Sfk8,Sfk9,Sfk10,Sfk11,Sfk12,Sfk13 9434 READ Sfk14,Sfk15,Sfk16,Sfk17,Sfk18,Sfk19 9435 RETURN 9436 Kerr: Twist=KNOBX 9437 Key$=KBD$ 9438 DISP "don't touch me there!" 9439 WAIT .4 9440 DISP "" 9441 RETURN 9442 Cursor_mode:! 9443 IF Key=B_sp OR Key=L_arr THEN 9444 IF Col-1Last_col THEN 9451 GOTO Tab_mode 9452 ELSE 9453 Col=Col+1 9454 END IF 9455 END IF 9456 RETURN 9457 Tab_mode:! 9458 CALL Field_tab(Field$(*),Fld,Key,Base_col,Col,Row,Len) 9459 Last_col=Base_col+Len-1 9460 RETURN 9461 Clr_end:! 9462 CONTROL 1;Col,Row 9463 OUTPUT 1;RPT$(" ",Last_col-Col+1) 9464 RETURN 9465 Clr_line:! 9466 CONTROL 1;Base_col,Row 9467 OUTPUT 1;RPT$(" ",Last_col-Base_col+1) 9468 Col=Base_col 9469 Cursor$="NORM" 9470 RETURN 9471 Insert_char:! 9472 CONTROL 1;Col,Row 9473 ALLOCATE Insert$[Last_col+1-Col] 9474 ENTER 1;Insert$ 9475 Ins_len=LEN(Insert$) 9476 IF Ins_len>0 THEN 9477 IF Col+Ins_len>Last_col THEN 9478 Insert$=Insert$[1;Ins_len-1] 9479 END IF 9480 ELSE 9481 Insert$="" 9482 END IF 9483 CONTROL 1,0;Col,Row 9484 OUTPUT 1;CHR$(Key)&Insert$&" " 9485 Col=MIN(Col+1,Last_col) 9486 DEALLOCATE Insert$ 9487 RETURN 9488 Delete_char:! 9489 CONTROL 1,0;Col,Row 9490 IF Col0 THEN 9513 Errornum=MIN(21,MAX(0,PROUND((5*LGT(ABS(Error))),0)+5)) 9514 IF Sign=1 THEN 9515 IF Errornum>=5 THEN 9516 Display$[9;5]="+++++" 9517 IF Errornum>=7 THEN 9518 Display$[14,15]="<<" 9519 IF Errornum>7 THEN 9520 Numindicators=Errornum-7 9521 Display$[32-Numindicators;Numindicators]=RPT$(">",Numindicators) 9522 END IF 9523 ELSE 9524 IF Errornum=6 THEN Display$[14;1]="<" 9525 END IF 9526 ELSE 9527 Display$[9;Errornum]=RPT$("+",Errornum) 9528 END IF 9529 ELSE 9530 IF Errornum>=5 THEN 9531 Display$[3;5]="-----" 9532 IF Errornum>=7 THEN 9533 Display$[1,2]=">>" 9534 IF Errornum>7 THEN 9535 Numindicators=MIN(15,Errornum-7) 9536 Display$[17;Numindicators]=RPT$("<",Numindicators) 9537 END IF 9538 ELSE 9539 IF Errornum=6 THEN Display$[2;1]=">" 9540 END IF 9541 ELSE 9542 Display$[8-Errornum;Errornum]=RPT$("-",Errornum) 9543 END IF 9544 END IF 9545 END IF 9546 Dut("TITLE",0,Display$) 9547 SUBEND 9548 SUB F200_subs 9549 F200_subs: REM $Header: F200_subs,v 1.1 92/02/17 10:58:05 hmgr Exp $ 9550 REM 9551 REM ================================================================== 9552 REM FORMS_200 ARCHITECTURE LIBRARY 9553 REM REVISION: 870409:1415.JA 9554 REM FORMS_200 BOILER_PLATE 9555 REM ================================================================== 9556 REM 9557 SUBEND 9558 DEF FNBand_start(Whichband,Break_table(*)) 9559 Band_start: REM $Header: FNBand_start,v 1.1 94/04/11 14:54:12 hmgr Exp $ 9560 Ee_band(Whichband,Break_table(*),Start_index,Stop_index) 9561 RETURN Start_index 9562 FNEND 9563 DEF FNBand_stop(Whichband,Break_table(*)) 9564 Band_stop: REM $Header: FNBand_stop,v 1.1 94/04/11 14:54:16 hmgr Exp $ 9565 Ee_band(Whichband,Break_table(*),Start_index,Stop_index) 9566 RETURN Stop_index 9567 FNEND 9568 DEF FNCal_point(Band,Freq,Break_table(*),Ee_data(*)) 9569 Cal_point: REM $Header: FNCal_point,v 1.1 94/04/11 14:54:19 hmgr Exp $ 9570 Ee_info(Band,Freq,Break_table(*),Ee_data(*),Cal_point,Rfgain,Ytf) 9571 RETURN Cal_point 9572 FNEND 9573 DEF FNCol(Fld$,INTEGER Valid) 9574 Col:! 9575 DIM X$[2] 9576 INTEGER Column 9577 X$=FNFind_sub$(Fld$,"COL=",59) 9578 Column=FNVal(X$,Valid) 9579 RETURN Column 9580 FNEND 9581 DEF FNDate$ 9582 Date:! 9583 REM 9584 REM ================================================================== 9585 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 9586 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 9587 REM REVISION: 870414:1330.JA 9588 REM ================================================================== 9589 REM 9590 X=TIMEDATE DIV 86400-1721119 9591 Year=(4*X-1) DIV 146097 9592 X=(4*X-1) MOD 146097 9593 Day=X DIV 4 9594 X=(4*Day+3) DIV 1461 9595 Day=(4*Day+3) MOD 1461 9596 Day=(Day+4) DIV 4 9597 Month=(5*Day-3) DIV 153 9598 Day=(5*Day-3) MOD 153 9599 Day=(Day+5) DIV 5 9600 Year=100*Year+X-1900 9601 IF Month<10 THEN 9602 Month=Month+3 9603 ELSE 9604 Month=Month-9 9605 Year=Year+1 9606 END IF 9607 IF Month<10 THEN 9608 Date$=Date$&"0"&VAL$(Month) 9609 ELSE 9610 Date$=Date$&VAL$(Month) 9611 END IF 9612 IF Day<10 THEN 9613 Date$=Date$&"0"&VAL$(Day) 9614 ELSE 9615 Date$=Date$&VAL$(Day) 9616 END IF 9617 Date$=Date$&VAL$(Year) 9618 RETURN Date$ 9619 FNEND 9620 DEF FNDelim$(N) 9621 Fndelims: REM $Header: FNDelim,v 1.1 92/02/17 10:58:33 hmgr Exp $ 9622 RETURN CHR$(255)&CHR$(N) 9623 FNEND 9624 DEF FNEnhancement$(Enh$) 9625 Enhancements:! 9626 SELECT Enh$ 9627 CASE "INV" 9628 Return$="INVERSE" 9629 CASE "NOR" 9630 Return$="NORMAL" 9631 CASE "FRA" 9632 Return$="FRAME" 9633 CASE "UND" 9634 Return$="UNDERLINE" 9635 CASE ELSE 9636 Return$="INVERSE" 9637 END SELECT 9638 RETURN Return$ 9639 FNEND 9640 DEF FNFind_sub$(Field$,Find$,OPTIONAL INTEGER Alt_delim) 9641 Find_sub:! 9642 DIM Alpha$[144],Delim$[1] 9643 INTEGER Pos,Endpos 9644 IF NPAR=3 THEN 9645 Delim$=CHR$(Alt_delim) 9646 ELSE 9647 Delim$="," 9648 END IF 9649 Pos=POS(Field$,Find$) 9650 IF Pos<>0 THEN 9651 Pos=Pos+LEN(Find$) 9652 Alpha$=Field$[Pos] 9653 Endpos=POS(Alpha$,Delim$) 9654 IF Endpos<>0 THEN 9655 Alpha$=Alpha$[1,Endpos-1] 9656 END IF 9657 ELSE 9658 Alpha$="" 9659 END IF 9660 RETURN Alpha$ 9661 FNEND 9662 DEF FNFreq(Cal_point,Break_table(*)) 9663 Freq: REM $Header: FNFreq,v 1.1 94/04/11 14:54:22 hmgr Exp $ 9664 N=0 9665 I=1 9666 LOOP 9667 P=(Break_table(I+2)-Break_table(I+1))/Break_table(I+3)+1 9668 N=N+P 9669 EXIT IF N>=Cal_point 9670 I=I+4 9671 EXIT IF Break_table(I)=65535 9672 END LOOP 9673 IF Break_table(I)=65535 THEN 9674 PRINT "End of break table found in FNfreq" 9675 PRINT "cal point #";Cal_point 9676 PAUSE 9677 RETURN -1 9678 ELSE 9679 N=N-P 9680 Freq=Break_table(I+1)+Break_table(I+3)*(Cal_point-N-1) 9681 END IF 9682 RETURN Freq 9683 FNEND 9684 DEF FNHex_value$(Address$) 9685 Hex_value: REM $Header: FNHex_value,v 1.1 92/02/17 10:59:04 hmgr Exp $ 9686 Value=0 9687 FOR I=DVAL(Address$,16) TO DVAL(Address$,16)+3 9688 St_address(DVAL$(I,16)) 9689 Read_data(Data$) 9690 Value=Value+VAL(Data$)*256.^(DVAL(Address$,16)-I+3) 9691 NEXT I 9692 RETURN DVAL$(Value,16) 9693 FNEND 9694 DEF FNLen(Fld$,INTEGER Valid) 9695 Len:! 9696 DIM L$[2] 9697 INTEGER Length 9698 L$=FNFind_sub$(Fld$,"LEN=",59) 9699 Length=FNVal(L$,Valid) 9700 RETURN Length 9701 FNEND 9702 DEF FNMarker(@Dut) 9703 Marker: REM $Header: FNMarker,v 1.1 94/04/11 14:54:25 hmgr Exp $ 9704 Lastrdg=-999 9705 LOOP 9706 OUTPUT @Dut;"ts;mka?;" 9707 ENTER @Dut;Rdg 9708 I=I+1 9709 EXIT IF ABS(Rdg-Lastrdg)<=.02 9710 Lastrdg=Rdg 9711 IF N>30 THEN 9712 PRINT "marker not settling ... paused" 9713 PAUSE 9714 END IF 9715 END LOOP 9716 RETURN Rdg 9717 FNEND 9718 DEF FNNum_fields(F$(*)) 9719 Num_fields:! 9720 INTEGER Num 9721 Num=1 9722 LOOP 9723 EXIT IF F$(Num)="END_LIST" OR F$(Num)="" 9724 Num=Num+1 9725 END LOOP 9726 RETURN Num 9727 FNEND 9728 DEF FNNumcalpnts(Break_table(*)) 9729 Numcalpnts: REM $Header: FNNumcalpnts,v 1.1 94/04/11 14:52:59 hmgr Exp $ 9730 N=0 9731 I=1 9732 WHILE Break_table(I)<>65535 9733 N=N+(Break_table(I+2)-Break_table(I+1))/Break_table(I+3)+1 9734 I=I+4 9735 END WHILE 9736 RETURN N 9737 FNEND 9738 DEF FNPower(@Pm,F) 9739 Power: REM $Header: FNPower,v 1.1 94/04/11 14:54:29 hmgr Exp $ 9740 Power_meter=1 9741 Cal_power=1 9742 DIM E$[100] 9743 Lastrdg=-999 9744 LOOP 9745 IF Power_meter AND Cal_power THEN 9746 Read_438(F,"CH B VERY FAST CORRECTED POWER","dBm",@Pm,Rdg,E$) 9747 ELSE 9748 IF Power_meter THEN 9749 ENTER @Pm;Rdg 9750 ELSE 9751 Rdg=-10 9752 END IF 9753 END IF 9754 I=I+1 9755 EXIT IF ABS(Rdg-Lastrdg)<=.02 9756 Lastrdg=Rdg 9757 IF N>30 THEN 9758 PRINT "power meter not settling ... paused" 9759 PAUSE 9760 END IF 9761 WAIT .1 9762 END LOOP 9763 RETURN Rdg 9764 FNEND 9765 DEF FNRead_checksum 9766 Read_checksum: REM $Header: FNRead_checksum,v 1.1 94/04/11 14:54:32 hmgr Exp $ 9767 ASSIGN @Dut TO 718 9768 OUTPUT @Dut;"zsetaddr ";DVAL("05fb74",16);";" 9769 Chksumaddr=FNRead_int(@Dut,4) 9770 OUTPUT @Dut;"zsetaddr ";Chksumaddr;";" 9771 OUTPUT @Dut;"zrdwr?" 9772 ENTER @Dut;V1 9773 OUTPUT @Dut;"zrdwr?" 9774 ENTER @Dut;V2 9775 Checksum=V1*256+V2 9776 RETURN Checksum 9777 FNEND 9778 DEF FNRead_int(@Dut,Bytes) 9779 Read_int: REM $Header: FNRead_int,v 1.1 94/04/11 14:54:35 hmgr Exp $ 9780 D=0 9781 FOR I=1 TO Bytes 9782 OUTPUT @Dut;"zrdwr?;" 9783 ENTER @Dut;Dtmp 9784 D=D*256+Dtmp 9785 NEXT I 9786 RETURN D 9787 FNEND 9788 DEF FNRead_value(Address$,Length) 9789 Read_value: REM $Header: FNRead_value,v 1.1 92/02/17 10:59:34 hmgr Exp $ 9790 Value=0 9791 FOR I=DVAL(Address$,16) TO DVAL(Address$,16)+Length-1 9792 St_address(DVAL$(I,16)) 9793 Read_data(Data$) 9794 Value=Value+VAL(Data$)*256.^(DVAL(Address$,16)-I+Length-1) 9795 DISP Value 9796 NEXT I 9797 RETURN Value 9798 FNEND 9799 DEF FNResident_util$ 9800 REM 9801 REM ================================================================== 9802 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 9803 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 9804 REM REVISION: 870414:1330.JA 9805 REM ================================================================== 9806 REM 9807 REM ================================================================== 9808 REM 9809 REM Changes made to the program in FN Valid_ref_design 9810 REM date: 29 feb 88 - ernest hawes 9811 REM 9812 REM ================================================================== 9813 REM 9814 Resident_util: REM $Header: FNResident_util,v 1.1 92/02/17 10:59:43 hmgr Exp $ 9815 RETURN "PFAIL_200" 9816 FNEND 9817 DEF FNRom_date(Cmd$,OPTIONAL Date$) 9818 Rom_date: REM $Header: FNRom_date,v 1.12 96/01/23 13:12:57 hmgr Exp $ 9819 COM /Rom_date/Rom_date$[6],No_tam,Set 9820 IF NPAR=1 THEN 9821 SELECT Cmd$ 9822 CASE "SET" 9823 OUTPUT 718;"REV?;" 9824 ENTER 718;Rom_date$ 9825 Set=1 9826 RETURN Set 9827 CASE "QUERY NO TAM?" 9828 No_tam=0 9829 IF FNField THEN 9830 No_tam=1 9831 ELSE 9832 Show_message("ALIGNMENT 1",6,5) 9833 Show_message("-----------",7,5) 9834 Show_message("8562E, 8564E & 8565E INSTRUMENTS DON'T NEED THE TAM.",9,7) 9835 Show_message("ALIGNMENT 2",12,5) 9836 Show_message("-----------",13,5) 9837 Show_message("8564E & 8565E INSTRUMENTS DON'T NEED THE TAM.",15,7) 9838 Prompt_keys("YES,NO",Key$,"Are you using the TAM?") 9839 Show_message("",12) 9840 Show_message("",13) 9841 Show_message("",15) 9842 IF Key$="NO" THEN No_tam=1 9843 END IF 9844 RETURN No_tam 9845 CASE "CLEAR" 9846 Set=0 9847 RETURN Set 9848 CASE "STATUS" 9849 RETURN Set 9850 CASE ELSE 9851 IF Set THEN 9852 SELECT Cmd$ 9853 CASE "NO TAM" 9854 RETURN No_tam 9855 CASE "ORCA" 9856 RETURN Rom_date$>"930606" AND Rom_date$<>"930715" AND Rom_date$<>"930809" 9857 CASE "FASTADC" 9858 RETURN Rom_date$>"920528" 9859 CASE "PP OFFSET" 9860 RETURN Rom_date$>="930720" AND Rom_date$<>"930809" 9861 CASE "8 BANDS" 9862 RETURN Rom_date$>="930726" AND Rom_date$<>"930809" 9863 CASE ELSE 9864 DISP Cmd$,"is not valid. This is FNRom_date" 9865 GOTO Error 9866 END SELECT 9867 ELSE 9868 DISP "Rom date has not been set yet!!! This is FNRom_date" 9869 GOTO Error 9870 END IF 9871 END SELECT 9872 ELSE 9873 IF Set THEN 9874 SELECT Cmd$ 9875 CASE ">" 9876 RETURN Rom_date$>Date$ 9877 CASE ">=" 9878 RETURN Rom_date$>=Date$ 9879 CASE "=" 9880 RETURN Rom_date$=Date$ 9881 CASE "<=" 9882 RETURN Rom_date$<=Date$ 9883 CASE "<" 9884 RETURN Rom_date$=2 THEN CALL Set_status_ptrs(Field2$,Field_start,Data_start,Data_end) 9912 IF NPAR>=3 THEN CALL Set_status_ptrs(Field3$,Field_start,Data_start,Data_end) 9913 IF NPAR>=4 THEN CALL Set_status_ptrs(Field4$,Field_start,Data_start,Data_end) 9914 IF NPAR>=5 THEN CALL Set_status_ptrs(Field5$,Field_start,Data_start,Data_end) 9915 RETURN Status_com$[Data_start,Data_end] 9916 FNEND 9917 DEF FNType$(Fld$) 9918 Type: REM $Header: FNType,v 1.1 92/02/17 11:00:33 hmgr Exp $ 9919 DIM Type$[1] 9920 Type$=FNFind_sub$(Fld$,"TYPE=",59) 9921 IF Type$="" THEN 9922 DISP "No TYPE designation in FNType" 9923 PAUSE 9924 Type$="" 9925 END IF 9926 RETURN Type$ 9927 FNEND 9928 DEF FNType_ok(Type$) 9929 Type_ok: REM $Header: FNType_ok,v 1.1 92/02/17 11:00:42 hmgr Exp $ 9930 SELECT Type$ 9931 CASE "A","N","C","G" 9932 RETURN 1 9933 CASE ELSE 9934 RETURN 0 9935 END SELECT 9936 FNEND 9937 DEF FNVal(Value$,INTEGER Valid,OPTIONAL Lo,Hi) 9938 Val:! 9939 ON ERROR GOTO Non_numeric 9940 FOR I=1 TO LEN(Value$) 9941 Value=VAL(Value$[I;1]) 9942 NEXT I 9943 Value=VAL(Value$) 9944 OFF ERROR 9945 SELECT NPAR 9946 CASE 2 9947 Valid=1 9948 CASE 3 9949 IF Value>=Lo THEN Valid=1 9950 CASE 4 9951 IF (Value>=Lo) AND (Value<=Hi) THEN Valid=1 9952 CASE ELSE 9953 Valid=0 9954 END SELECT 9955 RETURN Value 9956 Non_numeric:! 9957 OFF ERROR 9958 Valid=0 9959 RETURN -1 9960 FNEND 9961 DEF FNValid_ref_desig(Suspect_data$) 9962 Valid_ref_desig: REM $Header: FNValid_ref_desig,v 1.1 92/02/17 11:01:03 hmgr Exp $ 9963 REM 9964 REM ================================================================== 9965 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 9966 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 9967 REM REVISION: 870414:1330.FB 9968 REM ================================================================== 9969 REM 9970 ALLOCATE Found_char$[1] 9971 INTEGER Found_char_pos 9972 INTEGER Numeric_char 9973 INTEGER Character 9974 INTEGER Found_an_a 9975 INTEGER How_many_char 9976 INTEGER Result 9977 Result=1 9978 IF Suspect_data$<>UPC$(Suspect_data$) THEN 9979 Result=0 9980 ELSE 9981 How_many_char=LEN(Suspect_data$) 9982 Character=1 9983 Found_char$="" 9984 Found_char_pos=0 9985 LOOP 9986 IF LEN(Found_char$)=0 THEN 9987 SELECT Suspect_data$[Character;1] 9988 CASE "A" 9989 Found_an_a=1 9990 CASE "B" TO "Z" 9991 Found_char$=Suspect_data$[Character;1] 9992 Found_char_pos=Character 9993 CASE "0" TO "9" 9994 CASE ELSE 9995 Result=0 9996 END SELECT 9997 ELSE 9998 Numeric_char=0 9999 SELECT Suspect_data$[Character;1] 10000 CASE "B" 10001 IF Found_char$<>"T" THEN Result=0 10002 CASE "P" 10003 IF Found_char$<>"T" AND Found_char$<>"X" THEN Result=0 10004 CASE "R" 10005 IF Found_char$<>"C" AND Found_char$<>"V" THEN Result=0 10006 CASE "S" 10007 IF Found_char$<>"D" THEN Result=0 10008 CASE "T" 10009 IF Found_char$<>"B" AND Found_char$<>"R" THEN Result=0 10010 CASE "U" 10011 IF Suspect_data$[Found_char_pos]<>"TB1U1" THEN Result=0 10012 CASE "W" 10013 IF Found_char$<>"S" THEN Result=0 10014 CASE "0" TO "9" 10015 Numeric_char=1 10016 CASE ELSE 10017 Result=0 10018 END SELECT 10019 IF Character<>Found_char_pos+1 AND NOT Numeric_char AND Suspect_data$[Found_char_pos]<>"TB1U1" THEN Result=0 10020 END IF 10021 EXIT IF Character>=How_many_char OR Result=0 10022 Character=Character+1 10023 END LOOP 10024 END IF 10025 RETURN Result 10026 FNEND 10027 SUB Field_tab(Field$(*),INTEGER Fld,Key,Base_col,Col,Row,Len) 10028 Field_tab: REM $Header: Field_tab,v 1.1 92/02/17 11:01:12 hmgr Exp $ 10029 DIM Type$[1] 10030 INTEGER Tab,S_tab,Num_flds,Up,Down,S_up,S_down,S_left,S_right,Ent 10031 INTEGER Valid,Offset 10032 DATA 41,40,94,86,72,71,87,84,69,66,62,60 10033 READ Tab,S_tab,Up,Down,S_left,S_right,S_up,S_down,Ent,B_sp,R_arr,L_arr 10034 Fld=MAX(Fld,1) 10035 Num_flds=FNNum_fields(Field$(*))-1 10036 Len=FNLen(Field$(Fld),Valid) 10037 LOOP 10038 Offset=0 10039 SELECT Key 10040 CASE Tab,0,Down,Ent,R_arr,0 10041 IF Fld+1>Num_flds THEN 10042 Fld=1 10043 ELSE 10044 Fld=Fld+1 10045 END IF 10046 CASE S_tab,Up,L_arr,B_sp 10047 IF Fld-1<1 THEN 10048 Fld=Num_flds 10049 ELSE 10050 Fld=Fld-1 10051 END IF 10052 CASE S_left 10053 CASE S_right 10054 Offset=FNLen(Field$(Fld),Valid)-1 10055 CASE S_up 10056 Fld=1 10057 CASE S_down 10058 Fld=Num_flds 10059 CASE ELSE 10060 DISP " (SUB""Field_tab"" error:";Key 10061 PAUSE 10062 END SELECT 10063 Type$=FNType$(Field$(Fld)) 10064 EXIT IF FNType_ok(Type$) 10065 END LOOP 10066 Set_cursor:! 10067 Base_col=FNCol(Field$(Fld),Valid) 10068 Col=Base_col+Offset 10069 Row=FNRow(Field$(Fld),Valid) 10070 Len=FNLen(Field$(Fld),Valid) 10071 SUBEND 10072 SUB Filter(Trc(*),Filt(*),Filt_size) 10073 Filter: REM $Header: Filter,v 1.1 94/04/11 14:54:39 hmgr Exp $ 10074 Stp=SIZE(Filt,1)+BASE(Filt,1)-1 10075 Strt=BASE(Filt,1) 10076 Numpts=SIZE(Trc,1) 10077 ALLOCATE Newtrc(-Filt_size+1:Numpts+Filt_size) 10078 MAT Newtrc(1:Numpts)=Trc 10079 FOR I=-Filt_size+1 TO 0 10080 Newtrc(I)=Trc(1) 10081 NEXT I 10082 FOR I=Numpts+1 TO Numpts+Filt_size 10083 Newtrc(I)=Trc(Numpts) 10084 NEXT I 10085 FOR Pts=1 TO Numpts 10086 Sum=0 10087 FOR I=Strt TO Stp 10088 Sum=Sum+Newtrc(Pts-I)*Filt(I) 10089 NEXT I 10090 Trc(Pts)=Sum 10091 IF Pts=1 THEN MOVE Pts,Sum 10092 PLOT Pts,Sum 10093 NEXT Pts 10094 SUBEND 10095 SUB Filter_trace(Trc(*)) 10096 Filter_trace: REM $Header: Filter_trace,v 1.1 94/04/11 14:54:43 hmgr Exp $ 10097 Filt_size=10 10098 ALLOCATE Filt(-Filt_size:Filt_size) 10099 CLEAR SCREEN 10100 Create_filt(Filt(*),Filt_size) 10101 GINIT 10102 GRAPHICS ON 10103 GCLEAR 10104 WINDOW 1,SIZE(Trc,1),0,255 10105 FOR I=1 TO SIZE(Trc,1) 10106 PLOT I,Trc(I) 10107 NEXT I 10108 CALL Filter(Trc(*),Filt(*),Filt_size) 10109 SUBEND 10110 SUB Grid(Xmin,Xmax,Ymin,Ymax,Xstep,Ystep,Rotate,Title$,Xlabel$,Ylabel$,OPTIONAL Wxl,Wxu,Wyl,Wyu) 10111 Grid: REM $Header: Grid,v 1.1 94/04/11 14:53:03 hmgr Exp $ 10112 Autodiv(Xmin,Xmax,Xstep) 10113 Autodiv(Ymin,Ymax,Ystep) 10114 DEG 10115 Gridline=4 10116 Lsize=2.5 10117 Aspect=.6 10118 Windxl=0 10119 Windxu=133 10120 Windyl=10 10121 Windyu=100 10122 IF NPAR>10 THEN 10123 Windxl=Wxl 10124 Windxu=Wxu 10125 Windyl=Wyl 10126 Windyu=Wyu 10127 END IF 10128 IF NOT Rotate THEN 10129 Xstart=Xmin 10130 Xstop=Xmax 10131 Xs=Xstep 10132 Xblp=(LEN(VAL$(Ymax))+4)*Lsize*Aspect+Lsize 10133 Xbup=Lsize*4 10134 Ystart=Ymin 10135 Ystop=Ymax 10136 Ys=Ystep 10137 Yblp=(LEN(VAL$(Xmax))+4)*Lsize*Aspect+Lsize 10138 Ybup=Lsize*4 10139 ELSE 10140 Xstart=Ymin 10141 Xstop=Ymax 10142 Xs=Ystep 10143 Xblp=(LEN(VAL$(Xmax))+2)*Lsize*Aspect+Lsize 10144 Xbup=Lsize*4 10145 Ystart=Xmax 10146 Ystop=Xmin 10147 Ys=-Xstep 10148 Ybup=(LEN(VAL$(Ymax))+2)*Lsize*Aspect+Lsize 10149 Yblp=Lsize*4 10150 END IF 10151 Xborderl=(Xstop-Xstart)/(Windxu-Windxl-Xblp-Xbup)*Xblp 10152 Xborderu=(Xstop-Xstart)/(Windxu-Windxl-Xblp-Xbup)*Xbup 10153 Yborderl=(Ystop-Ystart)/(Windyu-Windyl-Yblp-Ybup)*Yblp 10154 Yborderu=(Ystop-Ystart)/(Windyu-Windyl-Yblp-Ybup)*Ybup 10155 VIEWPORT Windxl,Windxu,Windyl,Windyu 10156 WINDOW Xstart-Xborderl,Xstop+Xborderu,Ystart-Yborderl,Ystop+Yborderu 10157 PEN 1 10158 CSIZE Lsize 10159 IF NOT Rotate THEN 10160 LDIR 0 10161 LORG 5 10162 MOVE (Xstart+Xstop)/2,Ystop+Yborderu/2 10163 LABEL Title$ 10164 LORG 4 10165 MOVE (Xstart+Xstop)/2,Ystart-Yborderl 10166 LABEL Xlabel$ 10167 LDIR 90 10168 LORG 6 10169 MOVE Xstart-Xborderl,(Ystart+Ystop)/2 10170 LABEL Ylabel$ 10171 ELSE 10172 LDIR -90 10173 LORG 5 10174 MOVE Xstop+Xborderu/2,(Ystart-Ystop)/2 10175 LABEL Title$ 10176 LORG 4 10177 MOVE Xstart-Xborderl,(Ystart-Ystop)/2 10178 LABEL Xlabel$ 10179 LDIR 0 10180 LORG 6 10181 MOVE (Xstart+Xstop)/2,Ystop+Yborderu 10182 LABEL Ylabel$ 10183 END IF 10184 Plot_grid:! 10185 FOR Y=Ystart TO Ystop STEP Ys 10186 IF ABS(Y)=50) OR (First_value<=-875 AND First_value>=-1125) THEN 10392 Dut("WRITE EE DAC PER 10DB",First_value) 10393 ELSE 10394 Dut("WRITE EE DAC PER 10DB",100) 10395 END IF 10396 Dut("READ EE DAC PER 10DB",Next_value) 10397 CALL Show_message(" ",15) 10398 Skip_the_short:! 10399 Ok_options$=",001,002,003,005,006,007,008,026,103,104,1BH,C03,H01,H02,H03,H05,H06,H09,H13,H14,H15" 10400 Ok_options$=Ok_options$&",H16,H18,H20,H22,H24,H25,H26,H32,H36,H50,H51,H76,K01,MBD,T01,H39,UK6,1BP,1BN,8ZE" 10401 FOR I=1 TO 3 10402 FOR J=8 TO 11 10403 BEEP J*100,.05 10404 NEXT J 10405 WAIT .1 10406 NEXT I 10407 ON ERROR GOTO Input_data 10408 ON TIMEOUT 7,1 GOTO Input_data 10409 OUTPUT 718;"SER?" 10410 ENTER 718;Serial$ 10411 Temp=VAL(Serial$) 10412 OUTPUT 718;"ID?" 10413 ENTER 718;Id$ 10414 Entered=Yes 10415 Input_data:! 10416 OFF ERROR 10417 OFF TIMEOUT 10418 CLEAR 7 10419 IF NOT FNField THEN 10420 CALL Setup_438("PRESET,CH B MEASURE",@Pwr_mtr,Error_message$) 10421 END IF 10422 GOSUB Program_id 10423 CALL Dut("EXT MXR UNPRESELECT") 10424 OUTPUT 718;"ID?" 10425 ENTER 718;Id$ 10426 OUTPUT 718;"SER?" 10427 ENTER 718;Serial$ 10428 PRINT TABXY(1,4),"Model,Option is ";Id$ 10429 PRINT TABXY(1,5),"Serial number is ";Serial$ 10430 IF NOT FNField THEN 10431 PRINT TABXY(1,8),"Check that the PREFIX number,SERIAL number and OPTION number " 10432 PRINT TABXY(1,9),"written on the PTD are the same as the REAR PANEL SERIAL TAG. " 10433 Entered=No 10434 BEEP 10435 Message$="Is this the correct Model#, Serial# and Option? -Y/N " 10436 CALL Kbd_input("CUSTOM=YNyn"," ",Answer$,Message$) 10437 ELSE 10438 Answer$="Y" 10439 WAIT 3 10440 END IF 10441 UNTIL ((Answer$="Y") OR (Answer$="y")) 10442 IF NOT FNField AND FNRom_date("NO TAM") THEN CALL Stor_station(Serial$) 10443 SUBEXIT 10444 Program_id:! 10445 OUTPUT KBD;"ÿK"; 10446 BEEP 10447 IF NOT (Entered) THEN 10448 Message$="Using SOFTKEYS enter Model #. Then enter Options (ex: HP8560A,002 or HP8562A) " 10449 Id$="PREV KEYS" 10450 REPEAT 10451 IF Id$="PREV KEYS" THEN 10452 CALL Kbd_input("ALL","MORE KEYS,HP8560A,HP8560E,HP8561B,HP8561E,HP8562A,HP8562B,HP8562E",Id$,Message$) 10453 ELSE 10454 CALL Kbd_input("ALL","PREV KEYS,HP8563A,HP8563E,HP8564E,HP8565E",Id$,Message$) 10455 END IF 10456 UNTIL NOT POS(Id$,"KEYS") 10457 END IF 10458 IF (POS(Id$,"8560A")) THEN Model$="8560A" 10459 IF (POS(Id$,"8560E")) THEN Model$="8560E" 10460 IF (POS(Id$,"8561A")) THEN Model$="8561A" 10461 IF (POS(Id$,"8561B")) THEN Model$="8561B" 10462 IF (POS(Id$,"8561E")) THEN Model$="8561E" 10463 IF (POS(Id$,"8562A")) THEN Model$="A" 10464 IF (POS(Id$,"8562B")) THEN Model$="B" 10465 IF (POS(Id$,"8562E")) THEN Model$="8562E" 10466 IF (POS(Id$,"8563A")) THEN Model$="8563A" 10467 IF (POS(Id$,"8563E")) THEN Model$="8563E" 10468 IF (POS(Id$,"8564E")) THEN Model$="8564E" 10469 IF (POS(Id$,"8565E")) THEN Model$="8565E" 10470 BEEP 10471 Dut("WRITE ENABLE") 10472 Dut("READ EE DAC PER 10DB",First_value) 10473 IF LEN(Model$)>4 THEN 10474 IF ((Model$[5]="E") AND (First_value<=-875 AND First_value>=-1125)) THEN 10475 Dut("WRITE EE DAC PER 10DB",First_value) 10476 END IF 10477 IF ((Model$[5]="E") AND (First_value>=-875 OR First_value<=-1125)) THEN 10478 Dut("WRITE EE DAC PER 10DB",-1000) 10479 END IF 10480 IF ((Model$[5]<>"E") AND (First_value>=50 AND First_value<=75)) THEN 10481 Dut("WRITE EE DAC PER 10DB",First_value) 10482 END IF 10483 IF ((Model$[5]<>"E") AND (First_value<=50 OR First_value>=75)) THEN 10484 Dut("WRITE EE DAC PER 10DB",60) 10485 END IF 10486 END IF 10487 Dut("READ EE DAC PER 10DB",First_value) 10488 Enter_ser_num:! 10489 IF NOT (Entered) THEN 10490 Message$="Enter 10 character PREFIX and SERIAL NUMBER from REAR PANEL (ex: 2807A01842)" 10491 CALL Kbd_input("NUMERIC,CUSTOM=A","",Full_ser$,Message$) 10492 IF LEN(Full_ser$)<>10 THEN 10493 Show_message("Wrong number of characters...",16) 10494 Show_message("You entered SERIAL NUMBER "&Full_ser$,18) 10495 GOTO Enter_ser_num 10496 END IF 10497 IF Full_ser$[5;1]<>"A" THEN 10498 Show_message(" The 'A' is in the wrong position...",16) 10499 Show_message("You entered SERIAL NUMBER "&Full_ser$,18) 10500 GOTO Enter_ser_num 10501 END IF 10502 Ser$(1,1)=Full_ser$[1,5] 10503 ELSE 10504 Ser$(1,1)=Serial$[1;5] 10505 END IF 10506 IF NOT (Entered) THEN 10507 Ser$(1,2)[1,5]=Full_ser$[6,10] 10508 ON ERROR GOTO Error_1 10509 FOR I=1 TO 4 10510 Check=VAL(Ser$(1,1)[I]) 10511 NEXT I 10512 OFF ERROR 10513 ON ERROR GOTO Error_3 10514 FOR I=1 TO 5 10515 Check=VAL(Ser$(1,2)[I]) 10516 NEXT I 10517 OFF ERROR 10518 Serial$=Ser$(1,1)&Ser$(1,2) 10519 ELSE 10520 Ser$(1,1)=Serial$[1;5] 10521 Ser$(1,2)=Serial$[6;5] 10522 END IF 10523 IF (VAL(Ser$(1,1)[1,4])>3123) AND POS(Id$,"8563A") AND NOT (POS(Id$,"026")) THEN 10524 IF NOT (POS(Id$,"H01")) AND NOT (POS(Id$,"H05")) AND NOT (POS(Id$,"H09")) AND NOT (POS(Id$,"1BH")) AND NOT (POS(Id$,"K01")) THEN 10525 CALL Show_message("Added an option 26 because it is a NEW 8563A and has a prefix > 3123.",18) 10526 WAIT .6 10527 Id$=Id$&",026" 10528 END IF 10529 END IF 10530 Serial_num$=Ser$(1,2) 10531 Id$=TRIM$(Id$) 10532 Serial$=TRIM$(Serial$) 10533 IF (LEN(Serial$)=10 AND LEN(Id$)=7) OR (LEN(Serial$)=10 AND POS(Id$,",")=8) THEN 10534 Options_ok=1 10535 IF LEN(Id$)>7 THEN 10536 Options$=Id$[8] 10537 IF LEN(Options$) MOD 4<>0 THEN 10538 Options_ok=0 10539 Entered=0 10540 CALL Prompt_keys("CONTINUE",Key_pressed$,"Options listed are of incorrect length. Expect 4xN characters.") 10541 END IF 10542 IF POS(Id$[7,7],"A") OR POS(Id$[7,7],"B") THEN 10543 IF LEN(Options$)>16 THEN 10544 CALL Prompt_keys("CONTINUE,*",Key_pressed$,"Options listed take greater than 16 characters. Max of 4 allowed.") 10545 IF Key_pressed$="CONTINUE" THEN 10546 Options_ok=0 10547 Entered=0 10548 END IF 10549 END IF 10550 END IF 10551 IF LEN(Options$)>40 THEN 10552 Options_ok=0 10553 Entered=No 10554 CALL Prompt_keys("CONTINUE",Key_pressed$,"There are more than 10 options listed."&CHR$(10)&"Max of 10 options (40 characters) allowed.") 10555 END IF 10556 FOR I=1 TO LEN(Options$)/4 10557 IF Options_ok THEN 10558 REDIM O$(1:10) 10559 IF Options$[I*4-3;1]<>"," THEN 10560 Options_ok=0 10561 Entered=No 10562 CALL Prompt_keys("CONTINUE",Key_pressed$,"Options must be of the form ',XXX' where XXX=option #.") 10563 ELSE 10564 IF NOT POS(Ok_options$,Options$[I*4-3;4]) THEN 10565 Options_ok=0 10566 Entered=No 10567 OUTPUT 1;CHR$(12);"Acceptable options:",Ok_options$ 10568 CALL Prompt_keys("CONTINUE",Key_pressed$,Options$[I*4-3;4]&" not found on the list of acceptable options.") 10569 OUTPUT 1;CHR$(12) 10570 ELSE 10571 O$(I)=Options$[I*4-3;4] 10572 END IF 10573 END IF 10574 END IF 10575 NEXT I 10576 IF Options_ok THEN 10577 Num_options=LEN(Options$)/4 10578 REDIM O$(1:Num_options) 10579 MAT SORT O$(*) 10580 Options$="" 10581 FOR I=1 TO Num_options 10582 Options$=Options$&O$(I) 10583 NEXT I 10584 END IF 10585 ELSE 10586 Options$="" 10587 END IF 10588 IF Options_ok THEN 10589 IF POS(Options$,",") THEN 10590 Temp_opt$=Options$[2]&" " 10591 I=1 10592 LOOP 10593 Option$(I)=Temp_opt$[1;3] 10594 EXIT IF Temp_opt$[4;1]=" " 10595 Temp_opt$=Temp_opt$[5] 10596 I=I+1 10597 END LOOP 10598 END IF 10599 IF VAL(Ser$(1,2))=0 THEN SUBEXIT 10600 OUTPUT 718;"ZENTID '"&Id$[1,7]&Options$&"'" 10601 OUTPUT 718;"ZENTSER '"&Serial$&"'" 10602 END IF 10603 ELSE 10604 Error_2:! 10605 PRINT TABXY(1,10),"LENGTH OF THE IDENTITY IS INCORRECT." 10606 PRINT TABXY(1,11),"PLEASE REENTER AND DO NOT USE ANY SPACES." 10607 PRINT TABXY(1,12),"SERIAL NUMBER THAT YOU ENTERED IS ";Serial$ 10608 PRINT TABXY(1,13),"IDENTITY THAT YOU ENTERED IS ";Id$ 10609 PRINT TABXY(1,14),"HIT ""CONTINUE""" 10610 CALL Prompt_keys("CONTINUE",Key_pressed$," ") 10611 GOSUB Program_id 10612 END IF 10613 IF NOT (Options_ok) THEN GOTO Program_id 10614 OUTPUT KBD;"ÿK"; 10615 OUTPUT 718;"ID?" 10616 ENTER 718;Id$ 10617 OUTPUT 718;"SER?" 10618 ENTER 718;Serial$ 10619 Entered=Yes 10620 PRINT TABXY(1,4),"Model,Option is : ";Id$ 10621 PRINT TABXY(1,5),"Serial number is : ";Serial$ 10622 IF NOT FNField THEN 10623 PRINT TABXY(1,7),"Check that the PREFIX number, SERIAL number and OPTION number " 10624 PRINT TABXY(1,8),"written on the PTD is the same as the REAR PANEL SERIAL TAG. " 10625 BEEP 10626 Message$="Is this the correct Model#, Serial# and Option? -Y/N " 10627 CALL Kbd_input("CUSTOM=YNyn","",Answer$,Message$) 10628 ELSE 10629 Answer$="Y" 10630 WAIT 2 10631 END IF 10632 IF ((Answer$="N") OR (Answer$="n")) THEN 10633 Entered=No 10634 GOTO Program_id 10635 END IF 10636 IF NOT FNField AND FNRom_date("NO TAM") THEN CALL Stor_station(Serial$) 10637 SUBEXIT 10638 RETURN 10639 Not_there:! 10640 CALL Clr_scr 10641 CALL Show_message(Title$,1) 10642 OFF TIMEOUT 10643 PRINT TABXY(1,8);"A TIMEOUT OCCURED AT ADDRESS 718" 10644 PRINT TABXY(1,10);"THE FOLLOWING CAN CAUSE A TIMEOUT:" 10645 PRINT TABXY(1,11);" (1) THE HPIB CABLE MAY NOT BE CONNECTED" 10646 PRINT TABXY(1,12);" (2) THE 856X MAY BE SET TO THE WRONG ADDRESS" 10647 PRINT TABXY(1,13);" (3) TAM MAY NOT BE CONNECTED" 10648 PRINT TABXY(1,14);" (4) THE 856X MAY NOT BE TURNED ON. IF THE INSTRUMENT IS OFF, WAIT FOR IT TO REALIGN BEFORE PRESSING CONTINUE." 10649 CALL Prompt_keys("CONTINUE",Key_pressed$," ") 10650 CALL Clr_scr 10651 CALL Show_message(Title$,1) 10652 OFF TIMEOUT 10653 GOTO Start_again 10654 Do_nuthin:! 10655 RETURN 10656 Show_changes:! 10657 CALL List("FILE=/MANAGER/CHANGES/ALIGNMENT:REMOTE",Error_message$) 10658 IF Error_message$<>"OK" THEN 10659 PRINT Error_message$ 10660 DISP "Error with CHANGES file -- Please call your friendly software tech" 10661 PAUSE 10662 END IF 10663 RETURN 10664 Error_1:! 10665 PRINT TABXY(1,10),"THE AMOUNT OF CHARACTERS OR CHARACTER TYPE FOR THE PREFIX IS INCORRECT." 10666 PRINT TABXY(1,11),"PLEASE ENTER THE PREFIX IN THIS FORMAT: DDDDA" 10667 PRINT TABXY(1,12),"THE CHARACTERS YOU ACTUALLY ENTERED ARE """;Full_ser$;"""" 10668 PRINT TABXY(1,13),"PLEASE ENTER THE FULL 10 CHARACTER SERIAL NUMBER AGAIN." 10669 GOSUB Enter_ser_num 10670 Error_3:! 10671 PRINT TABXY(1,10),"THE AMOUNT OF CHARACTERS OR CHARACTER TYPE FOR THE SUFFIX IS INCORRECT." 10672 PRINT TABXY(1,11),"PLEASE ENTER THE SUFFIX IN THIS FORMAT: DDDDD" 10673 PRINT TABXY(1,12),"THE CHARACTERS YOU ACTUALLY ENTERED ARE """;Full_ser$;"""" 10674 PRINT TABXY(1,13),"PLEASE ENTER THE FULL 10 CHARACTER SERIAL NUMBER AGAIN." 10675 GOSUB Enter_ser_num 10676 REPEAT 10677 Message$="PLEASE ENTER PREFIX IN THIS SYNTAX. (D=DIGIT A=CHARACTER) DDDDA" 10678 CALL Kbd_input("NUMERIC,CUSTOM=A","",Ser$(1,1),Message$) 10679 UNTIL LEN(Ser$(1,1))=5 10680 Prefix$=Ser$(1,1)[1,5] 10681 GOSUB Enter_ser_num 10682 SUBEND 10683 SUB Init_ee_data(Break_table(*),Ee_data(*)) 10684 Init_ee_data: REM $Header: Init_ee_data,v 1.1 94/04/11 14:53:06 hmgr Exp $ 10685 DISP "initializing ee_data(*)" 10686 FOR I=1 TO FNNumcalpnts(Break_table(*)) 10687 Ee_data(I*3-2)=8 10688 Ee_data(I*3-1)=0 10689 Ee_data(I*3)=128 10690 NEXT I 10691 DISP 10692 SUBEND 10693 SUB Input_data(Dir_name$,Selected_opts$,D1(*),OPTIONAL D2(*),D3(*),D4(*),D5(*),D6(*),D7(*),D8(*),D9(*),D10(*),D11(*),D12(*),D13(*),D14(*),D15(*),D16(*)) 10694 Input_data: REM $Header: Input_data,v 1.3 93/05/21 16:11:20 hmgr Exp $ 10695 DIM Serial_num$[15],Dir_path$[150],Options$[50],Ser_suffix$[10] 10696 DIM First_path$[150],Last_path$[150],Block_dir$[40] 10697 DIM Block_num$[20] 10698 INTEGER Char_num,Pre_existing,Length,Done,First_found,Last_found 10699 Records=1 10700 CALL Id_info("SERIAL NUMBER",Serial_num$) 10701 Serial_num$=TRIM$(Serial_num$) 10702 Length=LEN(Serial$) 10703 Char_num=0 10704 Done=0 10705 Serial_num$=REV$(Serial_num$) 10706 REPEAT 10707 Char_num=Char_num+1 10708 SELECT Serial_num$[Char_num,Char_num] 10709 CASE "0" TO "9" 10710 Ser_suffix$[Char_num]=Serial_num$[Char_num,Char_num] 10711 CASE ELSE 10712 IF Char_num=1 THEN 10713 DISP "SORRY, BUT YOUR SERIAL NUMBER MUST END IN A NUMERIC -- THIS IS Input_data" 10714 CALL Tone("STOPPED") 10715 STOP 10716 ELSE 10717 Ser_suffix$=REV$(Ser_suffix$) 10718 Done=1 10719 END IF 10720 END SELECT 10721 UNTIL Done=1 10722 CALL Directory_info("TEST BLOCK",Block_dir$,Msus$) 10723 Options$=FNOption_dir$(Selected_opts$) 10724 Block_num$="" 10725 Block_num$="/"&FNGet_block_num$(Ser_suffix$) 10726 Last_path$=Block_dir$&Dir_name$&Options$&Block_num$&"/SN"&Ser_suffix$&Msus$ 10727 First_path$=Block_dir$&Dir_name$&Options$&Block_num$&"/SN"&Ser_suffix$&"F"&Msus$ 10728 CALL File_assign(@Input_data,First_path$,First_found) 10729 IF First_found THEN 10730 CALL File_assign(@Input_data,Last_path$,Last_found) 10731 IF Last_found=0 THEN CALL File_assign(@Input_data,First_path$,First_found) 10732 ELSE 10733 SUBEXIT 10734 END IF 10735 ENTER @Input_data;Who_cares;D1(*) 10736 IF NPAR>3 THEN ENTER @Input_data;D2(*) 10737 IF NPAR>4 THEN ENTER @Input_data;D3(*) 10738 IF NPAR>5 THEN ENTER @Input_data;D4(*) 10739 IF NPAR>6 THEN ENTER @Input_data;D5(*) 10740 IF NPAR>7 THEN ENTER @Input_data;D6(*) 10741 IF NPAR>8 THEN ENTER @Input_data;D7(*) 10742 IF NPAR>9 THEN ENTER @Input_data;D8(*) 10743 IF NPAR>10 THEN ENTER @Input_data;D9(*) 10744 IF NPAR>11 THEN ENTER @Input_data;D10(*) 10745 IF NPAR>12 THEN ENTER @Input_data;D11(*) 10746 IF NPAR>13 THEN ENTER @Input_data;D12(*) 10747 IF NPAR>14 THEN ENTER @Input_data;D13(*) 10748 IF NPAR>15 THEN ENTER @Input_data;D14(*) 10749 IF NPAR>16 THEN ENTER @Input_data;D15(*) 10750 IF NPAR>17 THEN ENTER @Input_data;D16(*) 10751 ASSIGN @Input_data TO * 10752 SUBEND 10753 SUB Load_font_data 10754 Load_font_data: REM $Header: Load_font_data,v 1.1 92/02/17 11:01:41 hmgr Exp $ 10755 COM /Font_data/Font_data(*),Char_index(*) 10756 DIM Catalog$(1:1)[80] 10757 DISP "Loading font data" 10758 ASSIGN @File TO "/SYSTEST_DIR/FONT_DATA:REMOTE 21,0" 10759 ENTER @File;Data_size 10760 REDIM Font_data(1:Data_size,1:3) 10761 ENTER @File;Font_data(*),Char_index(*) 10762 ASSIGN @File TO * 10763 DISP 10764 SUBEND 10765 SUB Log_status(Serial_n$,Model$,First_record$,Second_record$) 10766 Log_status: REM $Header: Log_status,v 1.4 96/01/11 15:47:09 hmgr Exp $ 10767 DIM Model_type$[4],File_name$[40] 10768 SELECT Model$ 10769 CASE "8561B" 10770 Model_type$="61B" 10771 CASE "B" 10772 Model_type$="62B" 10773 CASE "8561A" 10774 Model_type$="61A" 10775 CASE "8560A" 10776 Model_type$="60A" 10777 CASE "A" 10778 Model_type$="62A" 10779 CASE "8563A" 10780 Model_type$="63A" 10781 CASE "8560E" 10782 Model_type$="60E" 10783 CASE "8561E" 10784 Model_type$="61E" 10785 CASE "8562E" 10786 Model_type$="62E" 10787 CASE "8563E" 10788 Model_type$="63E" 10789 CASE ELSE 10790 PRINT Model$&"--- IS NOT IN THE CASE SELECTION FOR THE LOG_STATUS SUBPROGRAM" 10791 END SELECT 10792 File_name$="/MANAGER/PORT_62A/STATUS_DATA/"&Model_type$&Serial_n$ 10793 ON ERROR GOTO File_exists 10794 CREATE BDAT File_name$,1 10795 ASSIGN @File TO File_name$ 10796 OUTPUT @File,1;First_record$ 10797 OUTPUT @File,2;Second_record$ 10798 ASSIGN @File TO * 10799 File_exists:! 10800 SUBEND 10801 SUB Loop_error(Message$) 10802 Loop_error: REM $Header: Loop_error,v 1.1 92/02/17 11:02:00 hmgr Exp $ 10803 CALL Blank_lines(15,17) 10804 PRINT TABXY(1,17);"****ERROR**** Loop aborted in: ";Message$ 10805 CALL Pauseprogram 10806 SUBEND 10807 SUB Meas_flat(Fs,Fe,Step) 10808 Meas_flat: REM $Header: Meas_flat,v 1.4 95/04/05 08:25:07 hmgr Exp $ 10809 COM /Rp_nums/Rp_8485,Rp_8482 10810 Power_meter=1 10811 Cal_power=1 10812 ASSIGN @Dut TO 718 10813 Get_io_path("SYNTH 8340",@Source) 10814 Get_io_path("PWR MTR 438",@Pm) 10815 IF Power_meter AND Cal_power THEN 10816 OUTPUT @Source;"IP;CW 1e9HZ;PL -4DB;" 10817 ELSE 10818 IF Power_meter THEN 10819 OUTPUT @Pm;"PR LG;BP;TR3;" 10820 OUTPUT @Source;"IP;CW 1e9HZ;PL -4DB;" 10821 ELSE 10822 OUTPUT @Source;"IP;CW 1e9HZ;PL -10DB;" 10823 END IF 10824 END IF 10825 Whichband=3 10826 N=(Fe-Fs)/Step 10827 Park=18 10828 Waittime=180 10829 CLEAR SCREEN 10830 GOSUB Meas 10831 DUMP GRAPHICS 10832 SUBEXIT 10833 Parkstart=1 10834 Parkstop=26 10835 Waittime=3600 10836 FOR Park2=Parkstart^2 TO Parkstop^2 STEP (Parkstop^2-Parkstart^2)/5 10837 Park=SQR(Park2) 10838 GOSUB Meas 10839 OUTPUT 701;CHR$(12) 10840 DUMP GRAPHICS 10841 NEXT Park2 10842 Park=30 10843 GOSUB Meas 10844 OUTPUT 701;CHR$(12) 10845 DUMP GRAPHICS 10846 PAUSE 10847 SUBEXIT 10848 Meas:! 10849 DIM Testfreq(2000),Zsampl(2000),Sweptfreq(2000),Sweptampl(2000),Pmampl(2000) 10850 MAT Zsampl=(0) 10851 OUTPUT @Dut;"IP;CF ";Park;"GHZ;SP 100MHZ;" 10852 OUTPUT @Source;"CW ";Park*1.E+9;";PL -10DB" 10853 PRINT "Parked at ";PROUND(Park,-4);"GHz" 10854 Wait(Waittime) 10855 OUTPUT @Dut;"ip;sngls;rl -10;lg 5;sp 10mhz;sp 0;rb 1mhz;ts;mkt 45ms;" 10856 OUTPUT @Dut;"hnlock ";Whichband;";" 10857 New_window(Flatwin1,"raw flat","long") 10858 Grid(Fs,Fe,-5,5,1.E+9,1,0,"zero span flatness: parked @"&VAL$(PROUND(Park,-4))&"GHz","freq","db",0,200,10,100) 10859 PEN 3 10860 MOVE 0,0 10861 FOR I=1 TO N 10862 F=Fs+(I-1)*Step 10863 OUTPUT @Dut;"cf ";F;";ts;" 10864 OUTPUT @Source;"CW";F;"HZ;" 10865 PEN 3 10866 FOR K=0 TO 0 10867 WAIT .1 10868 OUTPUT @Dut;"ts;mka?;" 10869 ENTER @Dut;Zsampl(I) 10870 Pmampl(I)=FNPower(@Pm,F/1.E+6) 10871 Zsampl(I)=Zsampl(I)-Pmampl(I) 10872 IF K>=2 THEN PEN 4 10873 PLOT F+K/20*Step,Zsampl(I) 10874 NEXT K 10875 Skip_zero:! 10876 Testfreq(I)=F 10877 DISP Testfreq(I),Zsampl(I) 10878 PLOT Testfreq(I),Zsampl(I) 10879 NEXT I 10880 RETURN 10881 Meas_swept:! 10882 Span=Testfreq(N)-Testfreq(1) 10883 Start=Testfreq(1)-Span/100 10884 Stop=Testfreq(N)+Span/100 10885 OUTPUT @Dut;"fa ";Start;";fb ";Stop;";" 10886 PEN 4 10887 MOVE 0,0 10888 FOR I=1 TO N 10889 F=Fs+(I-1)*Step 10890 OUTPUT @Source;"CW";F;"HZ;" 10891 OUTPUT @Dut;"ts;mkpk;mka?;" 10892 ENTER @Dut;Sweptampl(I) 10893 OUTPUT @Dut;"mkf?;" 10894 ENTER @Dut;Sweptfreq(I) 10895 Sweptampl(I)=Sweptampl(I)-Pmampl(I) 10896 PRINT Testfreq(I),Zsampl(I),Sweptfreq(I),Sweptampl(I),Pmampl(I) 10897 PLOT Testfreq(I),Sweptampl(I) 10898 NEXT I 10899 RETURN 10900 SUBEND 10901 SUB Message(Message$,OPTIONAL Dontpause) 10902 Message: REM $Header: Message,v 1.2 92/02/26 13:21:09 hmgr Exp $ 10903 Show_message(RPT$(" ",160),12) 10904 Show_message(RPT$(" ",160),14) 10905 Show_message(RPT$(" ",160),16) 10906 Show_message(RPT$(" ",80),18) 10907 Show_message(Message$,12) 10908 IF NPAR=1 THEN CALL Pauseprogram 10909 SUBEND 10910 SUB Mola_bug_fix 10911 Mola_bug_fix: REM $Header: Mola_bug_fix,v 1.1 92/07/02 14:50:14 hmgr Exp $ 10912 DISP "Writing MOLA debug data..." 10913 FOR Addr=16741124 TO 16741142 10914 CALL Write_data(DVAL$(Addr,16),0) 10915 NEXT Addr 10916 Addr=16741143 10917 CALL Write_data(DVAL$(Addr,16),74) 10918 DISP 10919 SUBEND 10920 SUB Move_file(Data$(*),Control$,Filename$,OPTIONAL INTEGER Auto) 10921 Move_file: REM $Header: Move_file,v 1.1 92/02/17 11:02:19 hmgr Exp $ 10922 INTEGER Records,Err,I,Forever,First,Last,Lines 10923 First=BASE(Data$,1) 10924 Last=SIZE(Data$,1)-1 10925 SELECT Control$ 10926 CASE "LOAD" 10927 Get_file:! 10928 IF NPAR=3 THEN 10929 LINPUT "ENTER FILE TO RETREIVE",Filename$ 10930 END IF 10931 I=First 10932 ON ERROR GOSUB Disc_errors 10933 ASSIGN @File TO Filename$ 10934 ON END @File GOTO Got_it 10935 REPEAT 10936 ENTER @File;Data$(I) 10937 IF I=Last THEN Forever=1 10938 I=I+1 10939 UNTIL Forever 10940 Got_it:! 10941 ASSIGN @File TO * 10942 OFF ERROR 10943 CASE "STORE","STORE ALL" 10944 Save_file:! 10945 IF NPAR=3 THEN 10946 LINPUT "ENTER FILE TO STORE",Filename$ 10947 END IF 10948 IF Control$="STORE ALL" THEN 10949 Lines=Last 10950 ELSE 10951 Lines=FNNum_fields(Data$(*)) 10952 END IF 10953 Records=INT((1+Lines)*128./256) 10954 ON ERROR GOSUB Disc_errors 10955 ASSIGN @File TO Filename$ 10956 FOR I=First TO Lines 10957 OUTPUT @File;Data$(I) 10958 NEXT I 10959 OUTPUT @File;END 10960 OFF ERROR 10961 ASSIGN @File TO * 10962 END SELECT 10963 SUBEXIT 10964 Disc_errors:! 10965 OFF ERROR 10966 Err=ERRN 10967 SELECT Err 10968 CASE 56 10969 GOTO Create_file 10970 CASE ELSE 10971 BEEP 85,.3 10972 PRINT TABXY(1,15); 10973 PRINT ERRM$ 10974 PRINT "CORRECT CONDITION AND PRESS CONTINUE" 10975 PAUSE 10976 PRINT TABXY(1,15);RPT$(" ",80) 10977 PRINT TABXY(1,15);RPT$(" ",80) 10978 END SELECT 10979 RETURN 10980 Create_file:! 10981 DISP "CREATING: ";Filename$ 10982 ON ERROR GOSUB Disc_errors 10983 Records=MAX(Records,1) 10984 CREATE ASCII Filename$,Records 10985 OFF ERROR 10986 WAIT .2 10987 RETURN 10988 SUBEND 10989 SUB New_window(Id,Name$,OPTIONAL Size$) 10990 New_window: REM $Header: New_window,v 1.2 94/04/20 15:56:03 hmgr Exp $ 10991 Windows=0 10992 Grpause=0 10993 Grprint=0 10994 IF Windows THEN 10995 GOSUB Make_or_set 10996 GINIT 10997 PLOTTER IS Id,"WINDOW" 10998 GRAPHICS ON 10999 ELSE 11000 IF Grpause THEN 11001 DISP "press CONTINUE for next graph" 11002 PAUSE 11003 DISP 11004 END IF 11005 IF Grprint THEN 11006 DUMP GRAPHICS 11007 OUTPUT 701;CHR$(12) 11008 END IF 11009 GINIT 11010 GRAPHICS ON 11011 END IF 11012 SUBEXIT 11013 Make_or_set:! 11014 Width=900 11015 IF NPAR>=3 THEN 11016 SELECT Size$ 11017 CASE "long","LONG","Long" 11018 Width=1000 11019 END SELECT 11020 END IF 11021 DIM L$[80],C$[1],Winname$[20],Winid(1:20) 11022 CREATE BDAT "win_list:HFS",1 11023 PRINTER IS "win_list:HFS" 11024 !LIST WINDOW 11025 PRINTER IS 1 11026 ASSIGN @Path TO "win_list:HFS" 11027 N=0 11028 LOOP 11029 N=N+1 11030 ON ERROR GOTO Assume_eof 11031 ENTER @Path USING "K";L$ 11032 OFF ERROR 11033 IF N>=6 THEN 11034 Winid(N)=VAL(L$) 11035 Winname$=L$[63,POS(L$,":")-1] 11036 IF Winname$=Name$ THEN 11037 Id=Winid(N) 11038 ASSIGN @Path TO * 11039 PURGE "win_list:HFS" 11040 RETURN 11041 END IF 11042 END IF 11043 END LOOP 11044 Assume_eof:! 11045 OFF ERROR 11046 ASSIGN @Path TO * 11047 PURGE "win_list:HFS" 11048 Id=Winid(N-1)+1 11049 !CREATE WINDOW Id,450,400,Width,500;LABEL Name$,RETAIN 11050 RETURN 11051 SUBEND 11052 SUB Parse(Input$,Return$,OPTIONAL Value) 11053 Parse: REM $Header: Parse,v 1.1 92/02/17 11:02:32 hmgr Exp $ 11054 IF NPAR=3 THEN Value=-999 11055 IF POS(Input$,",") THEN 11056 Return$=Input$[1,POS(Input$,",")-1] 11057 Input$=Input$[POS(Input$,",")+1] 11058 ELSE 11059 Return$=Input$ 11060 Input$="" 11061 END IF 11062 IF POS(Return$,"=") THEN 11063 Value=VAL(Return$[POS(Return$,"=")+1]) 11064 Return$=Return$[1,POS(Return$,"=")-1] 11065 END IF 11066 SUBEND 11067 SUB Parse_ln(F$,T$,X$,Y$,L$,P1$,P2$,Defn$,Enh$) 11068 Parse_ln: REM $Header: Parse_ln,v 1.1 92/02/17 11:02:45 hmgr Exp $ 11069 T$=FNFind_sub$(F$,"TYPE=",59) 11070 X$=FNFind_sub$(F$,"COL=",59) 11071 Y$=FNFind_sub$(F$,"ROW=",59) 11072 L$=FNFind_sub$(F$,"LEN=",59) 11073 P1$=FNFind_sub$(F$,"P1=",59) 11074 P2$=FNFind_sub$(F$,"P2=",59) 11075 Defn$=FNFind_sub$(F$,"DEF=",59) 11076 Enh$=FNFind_sub$(F$,"ENH=",59) 11077 SUBEND 11078 SUB Pauseprogram 11079 Pauseprogram: REM $Header: Pauseprogram,v 1.1 92/02/17 11:02:56 hmgr Exp $ 11080 ON KBD GOTO Continueprog 11081 Endlessloop: DISP "Hit any key" 11082 GOTO Endlessloop 11083 Continueprog: DISP 11084 SUBEND 11085 SUB Pfail_200 11086 Pfail_200: REM $Header: Pfail_200,v 1.2 92/07/13 22:36:43 hmgr Exp $ 11087 SUBEXIT 11088 REM 11089 REM ================================================================== 11090 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 11091 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 11092 REM REVISION: 870817:0930.JA 11093 REM ================================================================== 11094 REM 11095 DIM Id$[12],Dir_path$[80],File_name$[16],Msus$[24],To_file$[30] 11096 DIM Spool$[40],Return_msus$[120],More$[3] 11097 DIM Sfk$[14],Key_labels$(0:9)[14],Scn_file$[14],Mess$[160] 11098 DIM Field$(1:60)[140],Data$(1:16)[71] 11099 INTEGER First_field,Size,Complete 11100 Initialize:! 11101 GCLEAR 11102 Clear_pfail_crt("ALL") 11103 DISP "Please wait . . . system initialization in progress." 11104 PRINTER IS CRT 11105 Return_msus$=SYSTEM$("MASS STORAGE IS") 11106 User_config(Id$,Dir_path$,File_name$,Msus$,To_file$,Spool$) 11107 IF Id$="EXIT" THEN 11108 Mess$="PROD FAIL ENTRY EXITED ABNORMALLY, NO DATA SAVED" 11109 GOTO Quit_pfail 11110 ELSE 11111 MASS STORAGE IS Dir_path$&Msus$ 11112 END IF 11113 ON ERROR GOSUB Load_subs 11114 CALL F200_subs 11115 OFF ERROR 11116 STATUS CRT,9;Size 11117 IF Size=50 THEN 11118 Scn_file$="C50_PF_SCN" 11119 ELSE 11120 Scn_file$="C80_PF_SCN" 11121 END IF 11122 Move_file(Field$(*),"LOAD",Scn_file$,1) 11123 DISP 11124 Start_pfail:! 11125 ON SIGNAL 0 RECOVER Error_trap 11126 ON ERROR GOTO Error_trap 11127 RESTORE Prodfail_keys 11128 READ Key_labels$(*) 11129 First_field=0 11130 CALL Clear_pfail_crt("ALL") 11131 CALL Print_form(Field$(*)) 11132 REPEAT 11133 CALL Print_required(Field$(*)) 11134 CALL Enter_data(Field$(*),Sfk$,Key_labels$(*),First_field) 11135 SELECT Sfk$ 11136 CASE "ENTER FAILURE" 11137 CALL Rd_pfail_data(Field$(*),Data$(*),Key_labels$(*),More$) 11138 CALL Sv_pfail_data(Data$(*),Dir_path$,File_name$,Msus$,Mess$) 11139 Clear_pfail_crt(More$,Size) 11140 IF More$="Y" THEN 11141 First_field=17 11142 ELSE 11143 First_field=0 11144 END IF 11145 CASE "PRINT" 11146 CALL Alpha_dump(Spool$) 11147 CASE "DONE" 11148 Mess$="PRODUCTION FAIL ENTRY COMPLETE, THANK YOU AND GOOD BYE" 11149 Complete=1 11150 END SELECT 11151 UNTIL Complete 11152 Quit_pfail:! 11153 GCLEAR 11154 PRINT TABXY(1,18) 11155 PRINT Mess$ 11156 FOR I=1 TO 17 11157 PRINT USING "#,/" 11158 WAIT .04 11159 NEXT I 11160 BEEP 11161 WAIT 2 11162 MASS STORAGE IS Return_msus$ 11163 SUBEXIT 11164 Load_subs: OFF ERROR 11165 LOADSUB ALL FROM "/UTILITIES/P_FAIL/F200_SUBS" 11166 RETURN 11167 Prodfail_keys:! 11168 DATA "","","","","" 11169 DATA "ENTER FAILURE","","PRINT","DONE","" 11170 Error_keys:! 11171 DATA "","","","","","CONTINUE","","","","ABORT" 11172 Error_trap: OFF ERROR 11173 OFF SIGNAL 11174 Mess$=ERRM$ 11175 OUTPUT KBD;Mess$; 11176 Tone("ERROR") 11177 RESTORE Error_keys 11178 READ Key_labels$(*) 11179 Read_keys(Sfk$,Key_labels$(*),"MAKE SOFTKEY SELECTION") 11180 OUTPUT KBD;CHR$(255)&"#"; 11181 IF Sfk$="ABORT" THEN 11182 Mess$="PRODUCTION FAIL ENTRY ABORTED" 11183 GOTO Quit_pfail 11184 ELSE 11185 GOTO Start_pfail 11186 END IF 11187 SUBEND 11188 SUB Pfail_edits(Field_data$,Co_data$,Defn$,INTEGER Valid,Mess$) 11189 Pfail_edits: REM $Header: Pfail_edits,v 1.2 96/01/11 15:45:30 hmgr Exp $ 11190 REM 11191 REM ================================================================== 11192 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 11193 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 11194 REM REVISION: 870414:1330.JA 11195 REM ================================================================== 11196 REM 11197 DIM Check_item$[80],Compare_data$[16],Holding$[16] 11198 Mess$="OK" 11199 Valid=0 11200 SELECT Defn$ 11201 CASE "LOC" 11202 IF Field_data$="" THEN GOTO Required 11203 Valid=1 11204 CASE "OPER" 11205 IF Field_data$="" THEN GOTO Required 11206 SELECT Co_data$ 11207 CASE "2423" 11208 Valid_loc=1 11209 RESTORE Valid_ops_2423 11210 CASE ELSE 11211 Valid_loc=0 11212 Mess$="INVALID LOCATION CODE, ENTER CORRECT LOCATION" 11213 Valid=-5 11214 END SELECT 11215 IF Valid_loc THEN 11216 GOSUB Check_valid 11217 IF Valid<=0 THEN 11218 Mess$="NOT ACCEPTING THIS LOCATION/OP CODE COMBINATION" 11219 END IF 11220 END IF 11221 CASE "DATE" 11222 IF Field_data$="" THEN GOTO Required 11223 IF Field_data$[1;2]>="01" AND Field_data$[1;2]<="12" THEN 11224 IF Field_data$[3;2]>="01" AND Field_data$[3;2]<="31" THEN 11225 IF Field_data$[5;2]>="86" AND Field_data$[3;2]<="99" THEN 11226 IF Field_data$<=FNDate$ THEN Valid=1 11227 END IF 11228 END IF 11229 END IF 11230 IF NOT Valid THEN 11231 Mess$="INVALID DATE" 11232 ELSE 11233 Field_data$=Field_data$[5;2]&Field_data$[1;4] 11234 END IF 11235 CASE "ASSY" 11236 IF Field_data$="" THEN GOTO Required 11237 Holding$=Field_data$ 11238 GOSUB Pack_field 11239 RESTORE Valid_assembly 11240 GOSUB Check_valid 11241 Field_data$=Holding$ 11242 IF Valid<=0 THEN 11243 Mess$="NOT ACCEPTING THIS ASSEMBLY NUMBER: "&Field_data$ 11244 END IF 11245 CASE "TESTED" 11246 IF Field_data$="" THEN GOTO Required 11247 Num_tested=FNVal(Field_data$,Valid,1,9999) 11248 IF NOT Valid THEN Mess$="RANGE OR DATA TYPE ERROR IN ""Qty Tested""" 11249 CASE "FAILED" 11250 IF Field_data$="" THEN Field_data$="0" 11251 Num_failed=FNVal(Field_data$,Valid,0,9999) 11252 IF NOT Valid THEN 11253 Mess$="RANGE OR DATA TYPE ERROR IN ""Qty Failed""" 11254 ELSE 11255 IF Num_failed>VAL(Co_data$) THEN 11256 Mess$="NUMBER OF FAILURES CANNOT EXCEED NUMBER TESTED" 11257 Valid=0 11258 END IF 11259 END IF 11260 CASE "RUN" 11261 IF Field_data$<>"" THEN 11262 Run=FNVal(Field_data$,Valid) 11263 IF NOT Valid THEN Mess$="INVALID RUN OR WORKORDER NUMBER" 11264 ELSE 11265 Valid=1 11266 END IF 11267 CASE "SER NUM" 11268 IF Field_data$<>"" THEN 11269 Field_data$=RPT$("0",5-LEN(Field_data$))&Field_data$ 11270 Ser=FNVal(Field_data$,Valid) 11271 IF NOT Valid THEN Mess$="INVALID SERIAL NUMBER" 11272 ELSE 11273 Valid=1 11274 END IF 11275 CASE "REP TIME" 11276 Rep_time=FNVal(Field_data$,Valid) 11277 IF NOT Valid THEN Mess$="REPAIR TIME MUST BE A NUMERIC VALUE" 11278 CASE "CODE" 11279 SELECT Co_data$ 11280 CASE "2423" 11281 RESTORE Fail_codes_2423 11282 CASE ELSE 11283 Mess$="INVALID LOCATION CODE" 11284 END SELECT 11285 GOSUB Check_valid 11286 IF Valid<=0 THEN Mess$="INVALID OPCODE FOR THIS LOCATION" 11287 CASE "QYFL" 11288 Qty_failed=FNVal(Field_data$,Valid,0,9999) 11289 IF NOT Valid THEN Mess$="INVALID QUANTITY ENTERED" 11290 CASE "REFD" 11291 IF LEN(TRIM$(Field_data$))=0 THEN 11292 Valid=1 11293 ELSE 11294 Valid=FNValid_ref_desig(TRIM$(Field_data$)) 11295 END IF 11296 IF NOT Valid THEN Mess$="INVALID REFERENCE DESIGNATOR" 11297 CASE "COMP" 11298 Valid=1 11299 CASE "COMM" 11300 Valid=1 11301 CASE "MORE" 11302 IF UPC$(Field_data$)="Y" OR UPC$(Field_data$)="N" THEN 11303 Valid=1 11304 ELSE 11305 Valid=-52 11306 Mess$="ENTER ""Y"" OR ""N"" ONLY" 11307 END IF 11308 CASE ELSE 11309 DISP "BOMBS AWAY IN PFAIL_EDITS, Defn$= "&Defn$ 11310 PAUSE 11311 END SELECT 11312 SUBEXIT 11313 Check_valid:! 11314 Ok=0 11315 Compare_data$=Field_data$&"," 11316 LOOP 11317 READ Check_item$ 11318 EXIT IF Check_item$<="0" 11319 IF POS(Check_item$,Compare_data$) THEN Ok=1 11320 EXIT IF Ok 11321 END LOOP 11322 IF NOT Ok THEN 11323 Valid=VAL(Check_item$) 11324 ELSE 11325 Valid=1 11326 END IF 11327 RETURN 11328 Pack_field: Delimiter_found=0 11329 REPEAT 11330 Sep_pos=POS(Field_data$,".") 11331 IF Sep_pos=0 THEN Sep_pos=POS(Field_data$,"-") 11332 IF Sep_pos THEN 11333 Field_data$=Field_data$[1,Sep_pos-1]&Field_data$[Sep_pos+1] 11334 Done=0 11335 ELSE 11336 Done=1 11337 END IF 11338 UNTIL Done 11339 RETURN 11340 Required:! 11341 Mess$="ENTRY REQUIRED IN THIS DATA FIELD" 11342 Valid=0 11343 SUBEXIT 11344 Data_tables:! 11345 Valid_ops_2423:! 11346 PAUSE 11347 DATA "TEST," 11348 DATA -7 11349 Valid_assembly:! 11350 DATA "8562,8562A,8562B,8562A001,8562A026,8562AT01,8562AH51,8562AH01,8562E," 11351 DATA "8561B,8561A,8561E," 11352 DATA "8560A,8560A002,8560A012,8560A003,8560A013,8560A023,8560A123,8560E," 11353 DATA "8563A,8563H01,85640A,8563E," 11354 DATA -8 11355 Fail_codes_2423:! 11356 DATA "72PM,72PA,72PP,72PT,72PV,72ZZ,72YY,72PZ,72CM," 11357 DATA "74PM,74PA,74PP,74PT,74PV,74ZZ,74YY,74PZ,74CM," 11358 DATA "77PM,77PA,77PP,77PT,77PV,77ZZ,77YY,77PZ,77CM," 11359 DATA 0 11360 Fail_codes_2533:! 11361 DATA "31,18,69,00,16,2H,2M,29,13,99,1M,2J,04,15,2W,26,11,1J,24,1X," 11362 DATA "1H,2X,2P,38,56,2E,41,1,77,1E,19,32,2A,1F,1S,23,2L,2N,12,45," 11363 DATA "1A,1L,2C,09,1V,22,2R,1C,2T,54," 11364 DATA 0 11365 SUBEND 11366 SUB Pfail_hilite(INTEGER Line_number,Beg_col,End_col,Type$) 11367 Pfail_hilite: REM $Header: Pfail_hilite,v 1.1 92/02/17 11:03:28 hmgr Exp $ 11368 REAL Midx,Midy,Ratio 11369 CALL Crt_data(Start,S_size) 11370 AREA PEN 6 11371 Ratio=RATIO 11372 IF PROUND(Ratio,-11)=1.33444816054 THEN 11373 VIEWPORT 0,134,26,125 11374 WINDOW 1.2,S_size+1,19.5,1 11375 ELSE 11376 VIEWPORT 4,127.5,27,96.5 11377 WINDOW 1,S_size+1,19,1 11378 END IF 11379 GRAPHICS ON 11380 PLOT Beg_col,Line_number,-2 11381 Length=End_col+1-Beg_col 11382 Width=Line_number+.8-Line_number+.032 11383 SELECT Type$ 11384 CASE "INVERSE" 11385 PEN 6 11386 AREA PEN 6 11387 RECTANGLE Length,Width,FILL 11388 CASE "NORMAL" 11389 PEN -1 11390 AREA PEN 0 11391 CASE "FRAME" 11392 PEN 6 11393 RECTANGLE Length,Width,EDGE 11394 CASE "UNDERLINE" 11395 PEN 6 11396 CLIP Beg_col,End_col+1,Line_number+.80,Line_number+.795 11397 FRAME 11398 END SELECT 11399 SUBEND 11400 SUB Plot_char(Input$,OPTIONAL Inverse) 11401 Plot_char: REM $Header: Plot_char,v 1.1 92/02/17 11:03:39 hmgr Exp $ 11402 COM /Font_data/Font_data(*),Char_index(*) 11403 DIM Symbol(1:100,1:3),Plot$[80] 11404 Plot$=CHR$(0)&Input$ 11405 FOR J=1 TO LEN(Plot$) 11406 Index=NUM(Plot$[J;1]) 11407 I=0 11408 REPEAT 11409 I=I+1 11410 Symbol(I,1)=Font_data(Char_index(Index)+I,1) 11411 Symbol(I,2)=Font_data(Char_index(Index)+I,2) 11412 Symbol(I,3)=Font_data(Char_index(Index)+I,3) 11413 IF Symbol(I,3)=13 AND NPAR=2 THEN Symbol(I,1)= NOT Symbol(I,1) 11414 UNTIL Symbol(I,3)=8 11415 SYMBOL Symbol(*) 11416 NEXT J 11417 SUBEND 11418 SUB Position_cursor(INTEGER X,Y,Direction,Num_of_row,Num_of_col) 11419 Position_cursor: REM $Header: Position_cursor,v 1.1 92/02/17 11:03:49 hmgr Exp $ 11420 INTEGER Up,Down 11421 Up=1 11422 Down=-1 11423 SELECT Y 11424 CASE 0 11425 IF Direction=Down THEN 11426 Y=Y+1 11427 X=1 11428 ELSE 11429 Y=Num_of_row-1 11430 X=1 11431 END IF 11432 CASE Num_of_row-1 11433 IF Direction=Up THEN 11434 X=1 11435 Y=Y-1 11436 ELSE 11437 X=1 11438 Y=0 11439 END IF 11440 CASE ELSE 11441 IF Direction=Up THEN 11442 X=1 11443 Y=Y-1 11444 ELSE 11445 Y=Y+1 11446 X=1 11447 END IF 11448 END SELECT 11449 SUBEND 11450 SUB Print_break_tab(Break_table(*)) 11451 Print_break_tab: REM $Header: Print_break_tab,v 1.1 94/04/11 14:53:13 hmgr Exp $ 11452 I=1 11453 Ntotal=0 11454 PRINT "band, f1, f2, step, #points, total # points" 11455 WHILE Break_table(I)<>65535 11456 PRINT Break_table(I), 11457 IF I DIV 4=I/4 THEN 11458 N=(Break_table(I-1)-Break_table(I-2))/Break_table(I)+1 11459 Ntotal=Ntotal+N 11460 PRINT N,Ntotal 11461 END IF 11462 I=I+1 11463 END WHILE 11464 SUBEND 11465 SUB Print_form(Field$(*),OPTIONAL Control$) 11466 Print_form: REM $Header: Print_form,v 1.1 92/02/17 11:04:02 hmgr Exp $ 11467 DIM Type$[1],X$[2],Y$[2],L$[2],P1$[40],P2$[40],Defn$[24],Enh$[3] 11468 INTEGER X,Y,Len,Size_of_prompt,Last_col,I,Valid,Done 11469 DIM Start$[12],Stop$[12],Mode$[12] 11470 IF NPAR>1 THEN 11471 GOSUB Set_limits 11472 ELSE 11473 Mode$="PRINT ON" 11474 END IF 11475 LOOP 11476 I=I+1 11477 EXIT IF Field$(I)="END_LIST" OR Field$(I)="" 11478 Parse_ln(Field$(I),Type$,X$,Y$,L$,P1$,P2$,Defn$,Enh$) 11479 IF Mode$="PRINT OFF" THEN 11480 IF Type$="G" THEN 11481 IF Defn$=Start$ THEN Mode$="PRINT ON" 11482 END IF 11483 ELSE 11484 IF Type$<>"G" THEN 11485 X=FNVal(X$,Valid) 11486 Y=FNVal(Y$,Valid) 11487 Len=FNVal(L$,Valid) 11488 Last_col=X+Len-1 11489 Enh_type$=FNEnhancement$(Enh$) 11490 IF Len>0 THEN CALL Pfail_hilite(Y,X,Last_col,Enh_type$) 11491 Size_of_prompt=LEN(P1$) 11492 IF Type$<>"L" THEN 11493 X=X-Size_of_prompt-1 11494 X=MAX(X,1) 11495 PRINT TABXY(X,Y);P1$; 11496 PRINT TABXY(Last_col+2,Y);P2$ 11497 ELSE 11498 P1$=P1$&RPT$(" ",40-LEN(P1$)) 11499 PRINT TABXY(X,Y);P1$&P2$ 11500 END IF 11501 END IF 11502 END IF 11503 END LOOP 11504 SUBEXIT 11505 Set_limits:! 11506 REPEAT 11507 CALL String_parser(Control$,Case$,Data$,Done) 11508 SELECT Case$ 11509 CASE "START" 11510 Start$=Data$ 11511 CASE "STOP" 11512 Stop$=Data$ 11513 END SELECT 11514 UNTIL Done 11515 Mode$="PRINT OFF" 11516 RETURN 11517 SUBEND 11518 SUB Print_required(Field$(*)) 11519 Print_required:! 11520 REM 11521 REM ================================================================== 11522 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 11523 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 11524 REM REVISION: 870414:1330.JA 11525 REM ================================================================== 11526 REM 11527 DIM Req_field$[10] 11528 INTEGER I,Col,File_end,Found,Row 11529 Req_fields: DATA "LOC","DATE","OPER","MORE",ETX 11530 LOOP 11531 READ Req_field$ 11532 EXIT IF Req_field$="ETX" 11533 GOSUB Find_line 11534 GOSUB Do_field 11535 END LOOP 11536 SUBEXIT 11537 Do_field:! 11538 SELECT Req_field$ 11539 CASE "LOC" 11540 PRINT "2423" 11541 CASE "OPER" 11542 PRINT "TEST" 11543 CASE "DATE" 11544 PRINT FNDate$ 11545 CASE "MORE" 11546 PRINT "N" 11547 CASE ELSE 11548 END SELECT 11549 RETURN 11550 Find_line:! 11551 Found=0 11552 File_end=0 11553 LOOP 11554 I=I+1 11555 IF Field$(I)="" OR Field$(I)="END_LIST" THEN 11556 File_end=1 11557 ELSE 11558 IF POS(Field$(I),Req_field$) THEN 11559 Row=VAL(FNFind_sub$(Field$(I),"ROW=",59)) 11560 Col=VAL(FNFind_sub$(Field$(I),"COL=",59)) 11561 CONTROL 1,0;Col,Row 11562 Found=1 11563 END IF 11564 END IF 11565 EXIT IF Found OR File_end 11566 END LOOP 11567 RETURN 11568 SUBEND 11569 SUB Print_rout_slip 11570 Print_rout_slip: REM $Header: Print_rout_slip,v 1.16 94/08/24 11:45:27 hmgr Exp $ 11571 COM /Tech_num/Tech_number 11572 DIM Options$[128],Inst_status$[22],Send_to$[16],Prev_loc$[16],Instruction$[5000],Model$[12],Key_pressed$[10],Test_block$[100] 11573 CALL Prompt_keys("DEFAULT=CONTINUE,SKIP IT",Key_pressed$,"Routing slip about to be printed...",10) 11574 IF Key_pressed$="SKIP IT" THEN SUBEXIT 11575 Re_test_loop:! 11576 ON SIGNAL 2,10 GOTO Dut_error 11577 Crlf$=CHR$(10)&CHR$(13) 11578 Instruction$=Crlf$ 11579 ASSIGN @Printer TO 701 11580 ON TIMEOUT 7,2 GOTO Printer_timeout 11581 ON KEY 9 LABEL "ABORT",10 RECOVER Exit_sub 11582 OUTPUT @Printer;CHR$(27)&"E"; 11583 CALL Clr_scr 11584 SEPARATE ALPHA FROM GRAPHICS 11585 GINIT 11586 ALPHA OFF 11587 GRAPHICS ON 11588 LORG 1 11589 Dut("READ MODEL NUMBER",0,Model$) 11590 Dut("READ OPTIONS",0,Options$) 11591 Options$=Options$&RPT$(" ",16) 11592 IF Options$[1,1]=" " THEN Options$=" STANDARD " 11593 AREA INTENSITY 1,1,1 11594 MOVE 0,80 11595 RECTANGLE 70,20,FILL 11596 MOVE 2,82 11597 AREA INTENSITY 0,0,0 11598 RECTANGLE 65,16,FILL 11599 CSIZE 8 11600 MOVE 0,90 11601 Plot_char(" RUGGED ") 11602 MOVE 0,82 11603 Plot_char(" ROUTING SLIP ") 11604 CSIZE 4 11605 MOVE 0,72 11606 Plot_char("MODEL:") 11607 MOVE 0,63 11608 Plot_char("S/N:") 11609 MOVE 0,55 11610 Plot_char("OPTIONS:") 11611 CSIZE 8 11612 MOVE 38,70 11613 Plot_char(Model$[3,7]) 11614 Dut("READ FULL SERIAL NUMBER",0,Ser_num$) 11615 MOVE 38,62 11616 Plot_char(Ser_num$) 11617 CSIZE 6 11618 MOVE 38,55 11619 Plot_char(Options$[2,17]) 11620 MOVE 38,50 11621 Plot_char(Options$[18,32]) 11622 CSIZE 4 11623 MOVE 0,45 11624 Plot_char(" "&UPC$(DATE$(TIMEDATE))&" "&TIME$(TIMEDATE)) 11625 MOVE 0,38 11626 Plot_char("CURRENT") 11627 MOVE 0,34 11628 Plot_char("INSTRUMENT") 11629 MOVE 0,30 11630 Plot_char("STATUS:") 11631 Test_menu$=FNRead_menu_str$("MENU NAME") 11632 SELECT Test_menu$ 11633 CASE "PORT_AL1" 11634 MOVE 0,25 11635 Plot_char("SEND TO: BUTTON UP/ALIGNMENT II") 11636 MOVE 0,15 11637 Plot_char("ALIGNMENT I OPERATOR: "&VAL$(Tech_number)) 11638 MOVE 0,20 11639 GOSUB Stn_num 11640 Plot_char("ALIGNMENT I STATION: "&VAL$(Al_num)) 11641 CSIZE 6 11642 MOVE 45,37 11643 Plot_char("PASSED") 11644 MOVE 45,31 11645 Plot_char("ALIGNMENT I") 11646 CASE "PORT_AL2" 11647 MOVE 0,25 11648 Plot_char("SEND TO: EI") 11649 MOVE 0,15 11650 Plot_char("ALIGNMENT II OPERATOR: "&VAL$(Tech_number)) 11651 MOVE 0,20 11652 GOSUB Stn_num 11653 Plot_char("ALIGNMENT II STATION: "&VAL$(Al_num)) 11654 CSIZE 6 11655 MOVE 45,37 11656 Plot_char("PASSED") 11657 MOVE 45,31 11658 Plot_char("ALIGNMENT II") 11659 CASE ELSE 11660 CALL Prompt_keys("CONTINUE",Key_pressed$,"Error: Unknown test menu - This is Print_rout_slip") 11661 SUBEXIT 11662 END SELECT 11663 DUMP GRAPHICS 11664 GCLEAR 11665 CSIZE 4 11666 MOVE 0,88 11667 OUTPUT @Printer;CHR$(27)&"E"; 11668 Exit_sub:! 11669 KEY LABELS ON 11670 SUBEXIT 11671 Dut_error:! 11672 CALL Clr_scr 11673 CALL Prompt_keys("CONTINUE",Key_pressed$,"Dut error: TIMEOUT caused by the spectum analyzer") 11674 CALL Blank_lines(4) 11675 GOTO Re_test_loop 11676 Printer_timeout:! 11677 CALL Clr_scr 11678 CALL Prompt_keys("CONTINUE",Key_pressed$,"TIMEOUT: caused by printer -- pleas fix") 11679 CALL Blank_lines(4) 11680 GOTO Re_test_loop 11681 Stn_num:! 11682 STATUS 21,6;Node 11683 SELECT Node 11684 CASE 20 11685 Al_num=7 11686 CASE 24 11687 Al_num=10 11688 CASE 56 11689 Al_num=9 11690 CASE 57 11691 Al_num=6 11692 CASE ELSE 11693 Al_num=Node-50 11694 END SELECT 11695 RETURN 11696 SUBEND 11697 SUB Print_status(OPTIONAL Field1$,Field2$,Field3$,Field4$,Field5$) 11698 Print_status: REM $Header: Print_status,v 1.1 92/02/17 11:04:36 hmgr Exp $ 11699 COM /Status_com/Status_com$ 11700 Data_start=1 11701 Data_end=LEN(Status_com$) 11702 IF NPAR>=1 THEN CALL Set_status_ptrs(Field1$,Field_start,Data_start,Data_end,First_field) 11703 IF NPAR>=2 THEN CALL Set_status_ptrs(Field2$,Field_start,Data_start,Data_end) 11704 IF NPAR>=3 THEN CALL Set_status_ptrs(Field3$,Field_start,Data_start,Data_end) 11705 IF NPAR>=4 THEN CALL Set_status_ptrs(Field4$,Field_start,Data_start,Data_end) 11706 IF NPAR>=5 THEN CALL Set_status_ptrs(Field5$,Field_start,Data_start,Data_end) 11707 Pointer=Data_start 11708 Suppress_lf1=1 11709 PRINT CHR$(12); 11710 WHILE Pointer<=Data_end-2 11711 IF NUM(Status_com$[Pointer+2;1])=255 THEN 11712 Pointer=Pointer+2 11713 ELSE 11714 Indent=NUM(Status_com$[Pointer+1;1]) 11715 Field_start=Pointer+2 11716 Pointer=POS(Status_com$[Pointer+2],CHR$(255))+Pointer+1 11717 IF Indent=0 THEN 11718 PRINT USING "#,K";CHR$(129)&"="&CHR$(128)&Status_com$[Field_start,Pointer-1] 11719 ELSE 11720 IF NOT Suppress_lf1 THEN PRINT 11721 PRINT USING "#,K";RPT$(" ",(Indent-1-NPAR)*2)&Status_com$[Field_start,Pointer-1] 11722 Suppress_lf1=0 11723 END IF 11724 END IF 11725 END WHILE 11726 PRINT 11727 SUBEND 11728 SUB Prt_data_fields(Field$(*),Info$(*)) 11729 Prt_data_fields: REM $Header: Prt_data_fields,v 1.1 92/02/17 11:04:46 hmgr Exp $ 11730 DIM Item$[20] 11731 INTEGER X,Y,L,Row,Base_col,Col,Len,Fld,Key,Offset 11732 Fld=1 11733 Offset=0 11734 Key=41 11735 CALL Print_form(Field$(*)) 11736 LOOP 11737 CALL Field_tab(Field$(*),Fld,Key,Base_col,Col,Row,Len) 11738 IF FNType$(Field$(Fld-1))="L" THEN Offset=Offset+1 11739 Item$=FNFind_sub$(Info$(Fld-Offset),"=") 11740 PRINT TABXY(Col,Row); 11741 PRINT Item$ 11742 EXIT IF Field$(Fld+1)="END_LIST" 11743 END LOOP 11744 SUBEND 11745 SUB Prude 11746 Prude: REM $Header: Prude,v 1.1 92/02/17 11:04:57 hmgr Exp $ 11747 DISP "PLEASE ... DON'T TOUCH ME THERE!" 11748 CALL Tone("ERROR") 11749 WAIT .75 11750 DISP "" 11751 SUBEND 11752 SUB Rd_pfail_data(Field$(*),Pfail_data$(*),Key_labels$(*),More$) 11753 Rd_pfail_data: REM $Header: Rd_pfail_data,v 1.1 92/02/17 11:05:13 hmgr Exp $ 11754 REM 11755 REM ================================================================== 11756 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 11757 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 11758 REM REVISION: 870817:0930.JA 11759 REM ================================================================== 11760 REM 11761 DIM Type$[1],X$[2],Y$[2],L$[2],P1$[40],P2$[40],Defn$[24],Enh$[3] 11762 DIM Field_data$[32],Mess$[80],Key$[14],Mode$[9] 11763 DIM Template$(1:2)[71],Null_line$[80] 11764 INTEGER I,X,Y,Len,Num_flds,Valid,Complete,Index,Null,Fld,Detail_index 11765 ON ERROR GOTO Quit 11766 MAT Pfail_data$=(RPT$(" ",71)) 11767 MAT Template$=(RPT$(" ",71)) 11768 Template$(1)[1;1]="1" 11769 Template$(2)[1;1]="2" 11770 Index=-1 11771 First_record=1 11772 Max_num_flds=FNNum_fields(Field$(*)) 11773 REPEAT 11774 Fld=MAX(1,Fld) 11775 IF FNType$(Field$(Fld))<>"L" THEN 11776 REPEAT 11777 Parse_ln(Field$(Fld),Type$,X$,Y$,L$,P1$,P2$,Defn$,Enh$) 11778 X=FNVal(X$,Valid) 11779 Y=FNVal(Y$,Valid) 11780 Len=FNVal(L$,Valid) 11781 Read_fld(X,Y,Len,Field_data$) 11782 GOSUB Set_parameters 11783 IF Valid<=0 THEN GOSUB Bozo 11784 UNTIL Valid=1 OR Null_line 11785 END IF 11786 Fld=Fld+1 11787 UNTIL Field$(Fld)="" OR Field$(Fld)="END_LIST" 11788 SUBEXIT 11789 Bozo:! 11790 IF Valid<0 THEN Fld=(-Valid) 11791 DISP Mess$ 11792 CALL Tone("ALERT") 11793 CALL Enter_data(Field$(*),Key$,Key_labels$(*),Fld) 11794 DISP "" 11795 Fld=5 11796 RETURN 11797 Set_parameters:! 11798 Co_data$="" 11799 Record_type$="1" 11800 Null_line=0 11801 SELECT Defn$ 11802 CASE "LOC" 11803 Location$=Field_data$ 11804 Fld_len=4 11805 Fld_loc=19 11806 CASE "DATE" 11807 Fld_len=6 11808 Fld_loc=23 11809 CASE "ASSY" 11810 Fld_len=12 11811 Fld_loc=2 11812 Record_type$="BOTH" 11813 CASE "OPER" 11814 Fld_len=4 11815 Fld_loc=29 11816 Co_data$=Location$ 11817 CASE "TESTED" 11818 Fld_len=4 11819 Fld_loc=33 11820 Qty_tested$=Field_data$ 11821 CASE "FAILED" 11822 Fld_len=4 11823 Fld_loc=37 11824 Co_data$=Qty_tested$ 11825 CASE "RUN" 11826 Fld_len=10 11827 Fld_loc=41 11828 CASE "SER NUM" 11829 Fld_len=5 11830 Fld_loc=14 11831 Record_type$="BOTH" 11832 CASE "REP TIME" 11833 IF Field_data$="" THEN Field_data$="0" 11834 Fld_len=3 11835 Fld_loc=51 11836 CASE "CODE" 11837 Detail_index=Fld 11838 IF TRIM$(Field_data$)="" THEN 11839 GOSUB Check_null_line 11840 IF NOT Null_line THEN 11841 Mess$="FAIL CODE CANNOT BE LEFT BLANK" 11842 Valid=0 11843 Fld=Detail_index 11844 GOTO Set_param_exit 11845 ELSE 11846 Fld=MIN(Fld+4,Max_num_flds) 11847 Fail_code$="" 11848 IF First_record THEN 11849 End_of_line=1 11850 First_record=0 11851 END IF 11852 END IF 11853 ELSE 11854 IF NOT First_record THEN 11855 Template$(1)[52,69]=RPT$(" ",20) 11856 Template$(2)[19,69]=RPT$(" ",53) 11857 END IF 11858 Fld_len=4 11859 Fld_loc=54 11860 Fail_code$=Field_data$ 11861 Co_data$=Location$ 11862 First_record=0 11863 END IF 11864 CASE "QYFL" 11865 Fld_len=4 11866 Fld_loc=19 11867 Record_type$="2" 11868 Co_data$=Fail_code$ 11869 CASE "REFD" 11870 Fld_len=14 11871 Fld_loc=58 11872 CASE "COMP" 11873 Fld_len=12 11874 Fld_loc=23 11875 Record_type$="2" 11876 CASE "COMM" 11877 Fld_len=32 11878 Fld_loc=35 11879 Record_type$="2" 11880 End_of_line=1 11881 CASE "MORE" 11882 More$=Field_data$ 11883 CASE ELSE 11884 DISP "BOMBS AWAY, WE SHOULDN'T BE HERE !!!!" 11885 PAUSE 11886 END SELECT 11887 IF NOT Null_line THEN 11888 Pfail_edits(Field_data$,Co_data$,Defn$,Valid,Mess$) 11889 IF Valid AND Defn$<>"MORE" THEN GOSUB Pack_strings 11890 ELSE 11891 IF First_record THEN GOSUB Pack_strings 11892 END IF 11893 IF End_of_line THEN GOSUB Append_data 11894 Set_param_exit:! 11895 RETURN 11896 Pack_strings:! 11897 String_len=LEN(Field_data$) 11898 IF String_len"L" THEN 11952 REPEAT 11953 Read_fld(X,Y,Len,Tag$) 11954 CALL Type_match(Tag$,Type$,Valid) 11955 IF NOT Valid THEN GOSUB Bozo 11956 UNTIL Valid 11957 IF Defn$="" THEN 11958 Data$(Index)=Tag$ 11959 ELSE 11960 Data$(Index)=Defn$&"="&Tag$ 11961 END IF 11962 Index=Index+1 11963 ELSE 11964 END IF 11965 NEXT I 11966 Entries=Index-1 11967 SUBEXIT 11968 Bozo:! 11969 DISP "INVALID DATA TYPE, TRY AGAIN" 11970 CALL Tone("ALERT") 11971 CALL Enter_data(Field$(*),Key$,Key_labels$(*),I) 11972 DISP "" 11973 RETURN 11974 SUBEND 11975 SUB Read_ee_break(@Dut,Break_table(*)) 11976 Read_ee_break: REM $Header: Read_ee_break,v 1.1 94/04/11 14:53:17 hmgr Exp $ 11977 Break_addr_ptr$="05FB78" 11978 OUTPUT @Dut;"zsetaddr ";DVAL(Break_addr_ptr$,16);";" 11979 Addr=FNRead_int(@Dut,4) 11980 OUTPUT @Dut;"zsetaddr ";Addr;";" 11981 Addr=FNRead_int(@Dut,4) 11982 OUTPUT @Dut;"zsetaddr ";Addr;";" 11983 Index=0 11984 REPEAT 11985 Index=Index+1 11986 Break_table(Index)=FNRead_int(@Dut,2) 11987 UNTIL Break_table(Index)=65535 11988 SUBEND 11989 SUB Read_ee_data(@Dut,Break_table(*),Ee_data(*)) 11990 Read_ee_data: REM $Header: Read_ee_data,v 1.1 94/04/11 14:53:20 hmgr Exp $ 11991 Ee_addr_ptr$="05FBB8" 11992 Read_ee_break(@Dut,Break_table(*)) 11993 N=FNNumcalpnts(Break_table(*)) 11994 PRINT "Reading ";N;" cal points ..." 11995 OUTPUT @Dut;"zsetaddr ";DVAL(Ee_addr_ptr$,16);";" 11996 Addr=FNRead_int(@Dut,4) 11997 OUTPUT @Dut;"zsetaddr ";Addr;";" 11998 Index=0 11999 FOR I=1 TO N*3 12000 Ee_data(I)=FNRead_int(@Dut,1) 12001 IF I DIV 30=I/30 THEN DISP I/3 12002 NEXT I 12003 DISP 12004 SUBEND 12005 SUB Read_fld(INTEGER X,Y,Len,Data$,OPTIONAL Trim$) 12006 Read_fld: REM $Header: Read_fld,v 1.1 92/02/17 11:05:47 hmgr Exp $ 12007 ALLOCATE Target$[Len] 12008 Data$="" 12009 CONTROL 1;X,Y 12010 ENTER 1;Target$ 12011 IF NPAR=4 THEN 12012 Data$=TRIM$(Target$) 12013 ELSE 12014 Data$=Target$ 12015 END IF 12016 DEALLOCATE Target$ 12017 SUBEND 12018 SUB Read_keys(Key_pressed$,Key_labels$(*),OPTIONAL Msg$) 12019 Read_keys: REM $Header: Read_keys,v 1.2 92/02/27 14:15:35 hmgr Exp $ 12020 INTEGER Key_selected,I 12021 DIM Key$[160] 12022 ON KBD ALL GOSUB Check_key 12023 FOR I=0 TO 9 12024 ON KEY (I) LABEL Key_labels$(I) GOTO Check_key 12025 NEXT I 12026 IF NPAR>2 THEN DISP Msg$ 12027 REPEAT 12028 UNTIL Key_selected 12029 IF Key_pressed$="ABORT" THEN SIGNAL 1 12030 DISP "" 12031 SUBEXIT 12032 Check_key:! 12033 Key$=KBD$ 12034 SELECT Key$[2,2] 12035 CASE "0" TO "9" 12036 Key_pressed$=Key_labels$(NUM(Key$[2])-48) 12037 Key_selected=1 12038 CASE "P" 12039 DISP "PRESS CONTINUE TO RESUME OPERATIONS" 12040 PAUSE 12041 CASE "^","<" 12042 Key_pressed$="UP" 12043 Key_selected=1 12044 CASE "V",">" 12045 Key_pressed$="DOWN" 12046 Key_selected=1 12047 CASE ELSE 12048 CALL Tone("ERROR") 12049 END SELECT 12050 Key$="" 12051 RETURN 12052 Check_knob:! 12053 Key$=KBD$ 12054 CALL Tone("ERROR") 12055 RETURN 12056 SUBEND 12057 SUB Screen_input(Data_array(*),INTEGER Num_of_col,X_offst,Y_offst,OPTIONAL INTEGER Abort_it) 12058 Screen_input: REM $Header: Screen_input,v 1.2 94/08/23 14:46:38 hmgr Exp $ 12059 INTEGER X,Y,I,Up,Down,Pos_y,Pos_x,Posy,Yes,Num_of_row 12060 Num_of_row=SIZE(Data_array,1) 12061 ALLOCATE Data_str$(0:Num_of_row-1)[Num_of_col],Block$[Num_of_col+2] 12062 DIM Temp$[13] 12063 Block$=CHR$(129)&RPT$(CHR$(127),Num_of_col)&CHR$(128) 12064 FOR I=0 TO 8 12065 ON KEY I LABEL " " GOSUB Do_nuthin 12066 NEXT I 12067 ON KEY 2 LABEL "CLEAR ROW" GOTO Clear_row 12068 ON KEY 5 LABEL "DONE" GOTO Stop_it 12069 ON KEY 9 LABEL "ABORT" GOTO Get_out 12070 ON KBD GOSUB Process_keys 12071 FOR I=0 TO Num_of_row-1 12072 Data_str$(I)=RPT$(" ",Num_of_col) 12073 NEXT I 12074 Data_input=0 12075 Yes=1 12076 Down=-1 12077 Up=1 12078 Pos_y=0 12079 Count=1 12080 Pos_x=1 12081 Offsty=Y_offst 12082 Offstx=X_offst-1 12083 FOR I=Offsty TO Offsty+Num_of_row-1 STEP 1 12084 PRINT TABXY(X_offst,I);Block$ 12085 NEXT I 12086 FOR I=1 TO Num_of_row 12087 IF Data_array(I)<>0 THEN Data_input=Yes 12088 NEXT I 12089 IF Data_input THEN 12090 FOR I=1 TO Num_of_row 12091 IF LEN(VAL$(Data_array(I)))>Num_of_col THEN 12092 OUTPUT Temp$ USING "K";Data_array(I) 12093 Data_str$(I-1)=Temp$[1,Num_of_col] 12094 ELSE 12095 Data_str$(I-1)=VAL$(Data_array(I))&RPT$(" ",Num_of_col-LEN(VAL$(Data_array(I)))) 12096 END IF 12097 NEXT I 12098 FOR Pos_y=0 TO Num_of_row-1 12099 IF LEN(VAL$(Data_array(Pos_y+1)))>Num_of_col THEN 12100 Max_pos_x=Num_of_col 12101 ELSE 12102 Max_pos_x=LEN(VAL$(Data_array(Pos_y+1))) 12103 END IF 12104 FOR Pos_x=1 TO Max_pos_x 12105 Key$[1]=Data_str$(Pos_y)[Pos_x;1] 12106 PRINT TABXY(Pos_x+Offstx,Pos_y+Offsty);CHR$(129)&Key$[1]&CHR$(128) 12107 NEXT Pos_x 12108 NEXT Pos_y 12109 Pos_x=1 12110 Pos_y=0 12111 END IF 12112 Start_loop:! 12113 LOOP 12114 PRINT TABXY(Offstx+Pos_x,Offsty+Pos_y);Data_str$(Pos_y)[Pos_x;1] 12115 WAIT .05 12116 PRINT TABXY(Offstx+Pos_x,Offsty+Pos_y);CHR$(129)&CHR$(127)&CHR$(128) 12117 WAIT .05 12118 END LOOP 12119 Process_keys: Key$=KBD$ 12120 IF Pos_x<=Num_of_col THEN 12121 IF LEN(Key$[1])=0 THEN Key$[1]="A" 12122 IF NUM(Key$[1])=255 THEN 12123 SELECT NUM(Key$[2]) 12124 CASE 41,86,69,88 12125 GOSUB Update_char 12126 Pos_x=1 12127 Position_cursor(Pos_x,Pos_y,Down,Num_of_row,Num_of_col) 12128 CASE 40,94 12129 GOSUB Update_char 12130 Pos_x=1 12131 Position_cursor(Pos_x,Pos_y,Up,Num_of_row,Num_of_col) 12132 CASE 66,60 12133 GOSUB Update_char 12134 Pos_x=Pos_x-1 12135 IF Pos_x=0 THEN 12136 Position_cursor(Pos_x,Pos_y,Up,Num_of_row,Num_of_col) 12137 ELSE 12138 GOSUB Update_char 12139 END IF 12140 END SELECT 12141 END IF 12142 IF NUM(Key$[1])>=48 AND NUM(Key$[1])<=57 OR Key$[1]="-" OR Key$[1]="." THEN 12143 PRINT TABXY(Pos_x+Offstx,Pos_y+Offsty);CHR$(129)&Key$[1]&CHR$(128) 12144 Data_str$(Pos_y)[Pos_x;1]=Key$[1] 12145 Pos_x=Pos_x+1 12146 END IF 12147 END IF 12148 IF Pos_x=Num_of_col+1 THEN 12149 Pos_x=1 12150 Pos_y=Pos_y+1 12151 END IF 12152 IF Pos_y=Num_of_row THEN 12153 Pos_y=0 12154 Count=1 12155 Pos_x=1 12156 Offsty=Y_offst 12157 Offstx=X_offst-1 12158 END IF 12159 RETURN 12160 Update_char:! 12161 IF Data_str$(Pos_y)[Pos_x;1]="" OR Data_str$(Pos_y)[Pos_x;1]=" " THEN 12162 PRINT TABXY(Offstx+Pos_x,Offsty+Pos_y);CHR$(129)&CHR$(127)&CHR$(128) 12163 ELSE 12164 PRINT TABXY(Offstx+Pos_x,Offsty+Pos_y);CHR$(129)&Data_str$(Pos_y)[Pos_x;1];CHR$(128) 12165 END IF 12166 RETURN 12167 Do_nuthin:! 12168 RETURN 12169 Stop_it:! 12170 ON ERROR GOTO Need_more_data 12171 FOR I=1 TO Num_of_row STEP 1 12172 Data_array(I)=VAL(Data_str$(I-1)) 12173 NEXT I 12174 CALL Clr_scr 12175 SUBEXIT 12176 Clear_row:! 12177 PRINT TABXY(X_offst,Pos_y+Y_offst);Block$ 12178 Data_str$(Pos_y)=RPT$(" ",Num_of_col) 12179 Pos_x=1 12180 GOTO Start_loop 12181 Need_more_data:! 12182 DISP "INPUT DATA TABLE NOT COMPLETE OR AN INPUT ERROR OCCURED" 12183 OFF ERROR 12184 GOTO Start_loop 12185 Get_out:! 12186 IF NPAR=5 THEN 12187 Abort_it=1 12188 END IF 12189 SUBEND 12190 SUB Set_ext_mxr_dac(Model$,Min_dac_num,Max_dac_num,Box_open_delta,OPTIONAL Dac_setting,INTEGER Fail_flag) 12191 Set_ext_mxr_dac: REM $Header: Set_ext_mxr_dac,v 1.14 93/01/21 10:44:05 hmgr Exp $ 12192 DIM Init_dac_setng(1:4),Error_message$[80] 12193 REAL Marker_amp,Io_value,Dac_step,Error 12194 INTEGER Harmonic_number,Sign,Old_sign,Loop_count 12195 ALLOCATE Command$[180] 12196 Fail_flag=1 12197 Ref_level=0 12198 Num_tries=1 12199 Upper_limit=MIN(Max_dac_num-Box_open_delta,Max_dac_num) 12200 Lower_limit=MAX(Min_dac_num-Box_open_delta,Min_dac_num) 12201 Command$="EXTERNAL MIXER,PRESET CONVERSION LOSS,HARMONIC NUMBER=8,RBW=300E3" 12202 Command$=Command$&",SPAN=0,SWEEP TIME=.05,TRIGGER SWEEP" 12203 Dut(Command$) 12204 WAIT 5 12205 Dut("ADJUST CURRENT STATE") 12206 WAIT 5 12207 Dut("WRITE EXT MXR REF CAL",0) 12208 GOSUB Toggle_harm_num 12209 Dut("CENTER FREQ=20E09,RBW=300E03,VBW=300,SPAN=1E06,AUTO SWEEP TIME") 12210 LOOP 12211 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 12212 Delta=Marker_amp-Ref_level 12213 New_setting=PROUND(Dac_setting-Delta,-2) 12214 EXIT IF ABS(Delta)<=.17 OR New_settingUpper_limit OR Num_tries>10 12215 Dac_setting=New_setting 12216 Dut("WRITE EXT MXR REF CAL",Dac_setting) 12217 GOSUB Toggle_harm_num 12218 Num_tries=Num_tries+1 12219 END LOOP 12220 IF Num_tries>10 THEN 12221 CALL Message("Unable to adjust DAC in 10 tries. Test will be aborted.") 12222 CALL Blank_lines(4) 12223 Fail_flag=0 12224 SUBEXIT 12225 END IF 12226 IF ABS(Delta)>.17 OR New_setting>Upper_limit OR New_setting.000001 THEN 12237 CALL Message("Error in EEPROM: DAC number read not equal to DAC number stored. Test will be aborted.") 12238 CALL Blank_lines(4) 12239 Fail_flag=0 12240 SUBEXIT 12241 END IF 12242 SUBEXIT 12243 Toggle_harm_num:! 12244 Dut("HARMONIC NUMBER=6") 12245 WAIT 1 12246 Dut("HARMONIC NUMBER=8") 12247 WAIT 1 12248 RETURN 12249 SUBEND 12250 SUB Set_mixer_dac(INTEGER Band,REAL Desired_voltage,REAL Freq) 12251 Set_mixer_dac: REM $Header: Set_mixer_dac,v 1.1 92/02/17 11:06:32 hmgr Exp $ 12252 DIM Error_message$[80] 12253 CALL Get_io_path("DVM 3478",@Dvm) 12254 Dut("VALID FIRST MIXER DAC ADDRESS",Value) 12255 IF Value=1 THEN 12256 Restart: Dut("WRITE FIRST MIXER DAC "&VAL$(Band),0,"VALID") 12257 Dut("EXTERNAL MIXER,INTERNAL MIXER,SPAN=0,CENTER FREQUENCY,TRIGGER SWEEP",Freq) 12258 Voltage1=999 12259 REPEAT 12260 Old_value=Voltage1 12261 Read_3478("DC VOLTS","V",@Dvm,Voltage1,Error_messagae$) 12262 UNTIL ABS(Voltage1-Old_value)<.0002 12263 Dut("WRITE FIRST MIXER DAC "&VAL$(Band),100,"VALID") 12264 Dut("EXTERNAL MIXER,INTERNAL MIXER,SPAN=0,CENTER FREQUENCY,TRIGGER SWEEP",Freq) 12265 Voltage2=999 12266 REPEAT 12267 Old_value=Voltage2 12268 Read_3478("DC VOLTS","V",@Dvm,Voltage2,Error_messagae$) 12269 UNTIL ABS(Voltage2-Old_value)<.0002 12270 Sensitivity=(Voltage2-Voltage1)/100 12271 IF Sensitivity=0 THEN 12272 PRINT TABXY(1,8);"No change in the DVM reading. Are you sure the connector is set to volts" 12273 PRINT TABXY(1,9);"and not still on current? (Press CONTINUE)" 12274 PAUSE 12275 Blank_lines(8,9) 12276 GOTO Restart 12277 END IF 12278 Dac_value=0 12279 Voltage=Voltage1 12280 WHILE ABS(Voltage-Desired_voltage)>Sensitivity 12281 Dac_value=Dac_value+PROUND((Desired_voltage-Voltage)/Sensitivity,0) 12282 IF Dac_value<0 OR Dac_value>255 THEN 12283 PRINT "DAC VALUE OUT OF RANGE IN MIXER DAC ADJUSTMENT TEST!" 12284 PAUSE 12285 END IF 12286 Dut("WRITE FIRST MIXER DAC "&VAL$(Band),Dac_value,"VALID") 12287 Dut("EXTERNAL MIXER,INTERNAL MIXER,SPAN=0,CENTER FREQUENCY,TRIGGER SWEEP",Freq) 12288 Voltage=999 12289 REPEAT 12290 Old_value=Voltage 12291 Read_3478("DC VOLTS","V",@Dvm,Voltage,Error_messagae$) 12292 UNTIL ABS(Voltage-Old_value)<.0002 12293 END WHILE 12294 ELSE 12295 Dut("EXTERNAL MIXER,INTERNAL MIXER,SPAN=0,CENTER FREQUENCY,TRIGGER SWEEP,LOCAL",Freq) 12296 CLEAR SCREEN 12297 PRINT TABXY(25,5);"MIXER BIAS ADJUST FOR BAND "&VAL$(Band)&"." 12298 PRINT TABXY(25,6);"------------------------------------------" 12299 PRINT TABXY(1,8);"DESCRIPTION: There are bias voltages on the 1st mixer for each band, and " 12300 PRINT TABXY(1,9);" the 'MIXER BIAS DAC' has to be set to this voltage." 12301 PRINT TABXY(1,11);"PROCEDURE: Press 'MIXER INT' and 'MIXER BIAS' on the dut." 12302 PRINT TABXY(1,12);" Adjust the 'MIXER BIAS DAC' to "&VAL$(Desired_voltage)&"v (by using the" 12303 PRINT TABXY(1,13);" RPG knob on the DUT). Note that the measurement isn't sensitive," 12304 PRINT TABXY(1,14);" and the closest value to the bias volts will have to do." 12305 PRINT TABXY(1,17);" Input the 1st MIXER BIAS DAC number and press 'ENTER'." 12306 INPUT "What is the Mixer Bias Dac number that gives the above voltage?",Io_value 12307 CLEAR SCREEN 12308 END IF 12309 SUBEND 12310 SUB Set_sb_track(Sb_pre_trk) 12311 Set_sb_track: REM $Header: Set_sb_track,v 1.1 94/04/11 14:53:23 hmgr Exp $ 12312 Write_data(DVAL$(FNRead_value("05FD4C",4),16),Sb_pre_trk) 12313 Write_data(DVAL$(FNRead_value("05FD50",4),16),Sb_pre_trk) 12314 CALL Calc_chksum 12315 SUBEND 12316 SUB Set_sig_level(Source,Source_amp,Des_level,Des_max_err,OPTIONAL Min_acc_level) 12317 Set_sig_level: REM $Header: Set_sig_level,v 1.1 92/02/17 11:06:43 hmgr Exp $ 12318 Set_sign_level:! 12319 DIM Error_message$[180] 12320 SELECT Source 12321 CASE 3336 12322 Max_src_power=8.76 12323 CALL Get_io_path("SYNTH 3336",@Source) 12324 CASE 8340 12325 Max_src_power=20 12326 CALL Get_io_path("SYNTH 8340",@Source) 12327 END SELECT 12328 Min_level=Des_level-Des_max_err 12329 IF NPAR=5 THEN Min_level=Min_acc_level 12330 Dut("MARKER OFF,MARKER ON,READ REF LEVEL",Ref_level) 12331 Dut("READ SPAN",Span) 12332 Loop_counter=0 12333 LOOP 12334 Loop_counter=Loop_counter+1 12335 IF Loop_counter=50 THEN 12336 CALL Prompt_keys("CONTINUE",Key_pressed$,"""SET_SIGNAL_LEVEL"" --- THE LOOP_COUNTER REACHED 50. PRESS CONTINUE AND THEN REPEAT THIS TEST") 12337 END IF 12338 EXIT IF Loop_counter=50 12339 IF Source=3336 THEN 12340 Write_3336("POWER",Source_amp,"dBm",@Source,Error_message$) 12341 END IF 12342 IF Source=8340 THEN 12343 Write_8340("POWER",Source_amp,"dBm",@Source,Error_message$) 12344 END IF 12345 Dut("TRIGGER SWEEP,PEAK SEARCH,READ MARKER AMPLITUDE",Marker_amp) 12346 IF Marker_amp>Ref_level AND Span>0 THEN CALL Dut("READ EXTRAPOLATED PEAK AMPLITUDE",Marker_amp) 12347 EXIT IF ABS(Marker_amp-Des_level)<=Des_max_err OR Source_amp>Max_src_power AND Marker_amp=3 THEN CALL Set_status_ptrs(Field2$,Field_start,Data_start,Data_end) 12381 IF NPAR>=4 THEN CALL Set_status_ptrs(Field3$,Field_start,Data_start,Data_end) 12382 IF NPAR>=5 THEN CALL Set_status_ptrs(Field4$,Field_start,Data_start,Data_end) 12383 IF NPAR>=6 THEN CALL Set_status_ptrs(Field5$,Field_start,Data_start,Data_end) 12384 IF Data_start=6 AND Start_field<=5 THEN Add$=FNDelim$(5)&Field5$&FNDelim$(0)&Add$&FNDelim$(5) 12390 IF NPAR>=5 AND Start_field<=4 THEN Add$=FNDelim$(4)&Field4$&FNDelim$(0)&Add$&FNDelim$(4) 12391 IF NPAR>=4 AND Start_field<=3 THEN Add$=FNDelim$(3)&Field3$&FNDelim$(0)&Add$&FNDelim$(3) 12392 IF NPAR>=3 AND Start_field<=2 THEN Add$=FNDelim$(2)&Field2$&FNDelim$(0)&Add$&FNDelim$(2) 12393 IF NPAR>=2 AND Start_field<=1 THEN Add$=FNDelim$(1)&Field1$&FNDelim$(0)&Add$&FNDelim$(1) 12394 Add$=Add$[3] 12395 IF Field_start"ON DISK" THEN 12551 Msg$="8482A ""RP"" NUMBER "&Rp_num$ 12552 Rp_ok=0 12553 END IF 12554 END IF 12555 OUTPUT Rp_num$ USING Rp_image;Rp_num(2) 12556 IF FNSnsr_on_disk$(Rp_num$)<>"ON DISK" THEN 12557 IF Rp_ok=0 THEN 12558 IF FNRead_menu_str$("MENU NAME")="PORT_AL1" THEN 12559 IF FNField THEN 12560 Msg$=Msg$&" and 8487A ""RP"" NUMBER "&Rp_num$ 12561 ELSE 12562 Msg$=Msg$&" and 8485A ""RP"" NUMBER "&Rp_num$ 12563 END IF 12564 ELSE 12565 Msg$=Msg$&" and 8487A ""RP"" NUMBER "&Rp_num$ 12566 END IF 12567 ELSE 12568 IF FNRead_menu_str$("MENU NAME")="PORT_AL1" THEN 12569 IF FNField THEN 12570 Msg$="8487A ""RP"" NUMBER "&Rp_num$ 12571 ELSE 12572 Msg$="8485A ""RP"" NUMBER "&Rp_num$ 12573 END IF 12574 ELSE 12575 Msg$="8487A ""RP"" NUMBER "&Rp_num$ 12576 END IF 12577 Rp_ok=0 12578 END IF 12579 END IF 12580 IF NOT Rp_ok THEN 12581 Show_message(Msg$&" is not on disk.",10) 12582 CALL Prompt_keys("CONTINUE",Key_pressed$,"") 12583 END IF 12584 RETURN 12585 SUBEND 12586 SUB Stor_station(Ser_num$) 12587 Stor_station: REM $Header: Stor_station,v 1.3 94/02/02 15:24:55 hmgr Exp $ 12588 DIM Path$[80] 12589 CALL Translate_opt(Option_path$) 12590 Path$="/MANAGER/STAT_NODE"&Option_path$&"/" 12591 ON ERROR GOSUB Create_file 12592 PURGE Path$&Ser_num$ 12593 GOSUB Create_file 12594 ASSIGN @File TO Path$&Ser_num$ 12595 STATUS 21,6;Node 12596 OUTPUT @File;Node 12597 ASSIGN @File TO * 12598 SUBEXIT 12599 Create_file:! 12600 OFF ERROR 12601 CREATE BDAT Path$&Ser_num$,1 12602 RETURN 12603 SUBEND 12604 SUB Sv_pfail_data(Data$(*),Dir$,File_name$,Msus$,Error_message$) 12605 Sv_pfail_data: REM $Header: Sv_pfail_data,v 1.1 92/02/17 11:07:50 hmgr Exp $ 12606 REM 12607 REM ================================================================== 12608 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 12609 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 12610 REM REVISION: 870326:1330.RV 12611 REM ================================================================== 12612 REM 12613 INTEGER Num_add_recs,Last_record,Total_recs,Eof_record,Num_of_records 12614 INTEGER Max_allow_recs,Added_recs,Error_number,I 12615 Assign_file:! 12616 Error_message$="OK" 12617 ON ERROR GOTO File_assign_err 12618 ASSIGN @Data_file TO Dir$&File_name$&Msus$ 12619 DISP "Please wait . . . data operations in progress" 12620 WAIT .4 12621 REPEAT 12622 Lock_file: LOCK @Data_file;CONDITIONAL Error_number 12623 IF Error_number<>0 THEN 12624 Err_count=Err_count+1 12625 WAIT .1 12626 END IF 12627 UNTIL Error_number=0 OR Err_count=100 12628 IF Err_count=100 THEN 12629 Error_message$="UNABLE TO LOCK FILE, DATA NOT SAVED" 12630 GOTO Quit 12631 END IF 12632 STATUS @Data_file,3;Last_used 12633 First_rec=Last_used+1 12634 GOSUB Count_new_recs 12635 Last_rec=Last_used+Num_new_recs 12636 Counter=0 12637 Add_rec_to_file:! 12638 DISP "Merging . . ." 12639 WAIT .3 12640 Fmt: IMAGE 71A 12641 FOR Rec_num=First_rec TO Last_rec 12642 Counter=Counter+1 12643 OUTPUT @Data_file,Rec_num USING Fmt;Data$(Counter) 12644 NEXT Rec_num 12645 Close_file:! 12646 OFF ERROR 12647 ON ERROR GOTO Exit_sub 12648 ASSIGN @Data_file TO * 12649 Exit_sub: OFF ERROR 12650 DISP "Data operations complete" 12651 WAIT .3 12652 DISP 12653 SUBEXIT 12654 Quit:! 12655 ASSIGN @Data_file TO * 12656 OFF ERROR 12657 SIGNAL 0 12658 SUBEXIT 12659 File_assign_err:! 12660 OFF ERROR 12661 IF ERRN=56 THEN 12662 DISP "Creating file """&Dir$&File_name$&Msus$&""". Hold on." 12663 ON ERROR GOTO Is_dirpath_ther 12664 CREATE BDAT Dir$&File_name$&Msus$,1,74 12665 OFF ERROR 12666 Last_record=1 12667 GOTO Assign_file 12668 Is_dirpath_ther:! 12669 OFF ERROR 12670 ON ERROR GOTO Deadly_errors 12671 DISP "Creating directory path """&Dir$&""". " 12672 CREATE DIR Dir$[1,LEN(Dir$)-1]&Msus$ 12673 GOTO File_assign_err 12674 END IF 12675 Deadly_errors:! 12676 OFF ERROR 12677 SELECT ERRN 12678 CASE 53,56,67,72,73,76,78,353,459 12679 Error_message$="ERROR NUM="&VAL$(ERRN)&". Check DIR$ & MSUS$ validity. DATA NOT STORED." 12680 SUBEXIT 12681 CASE ELSE 12682 Error_message$="Error '"&ERRM$&"' has occured." 12683 GOSUB Alert_operator 12684 END SELECT 12685 SUBEXIT 12686 RETURN 12687 Alert_operator:! 12688 Error_message$="'"&ERRM$&"' has occured." 12689 PRINT TABXY(1,17);RPT$(" ",80) 12690 PRINT TABXY(1,18);RPT$(" ",80) 12691 PRINT TABXY(1,17);Error_message$ 12692 PRINT TABXY(1,18);"Please fix the problem, and press the appropiate softkey." 12693 DISP "Press 'CONTINUE' to try again, or 'ABORT' to abort the storage." 12694 GOSUB Blank_keys 12695 ON KEY 5 LABEL "CONTINUE" GOTO Assign_file 12696 ON KEY 7 LABEL "ABORTED" GOTO Close_file 12697 Spin: GOTO Spin 12698 RETURN 12699 Count_new_recs:! 12700 Num_new_recs=0 12701 WHILE Data$(Num_new_recs+1)[1;1]<>" " 12702 Num_new_recs=Num_new_recs+1 12703 END WHILE 12704 RETURN 12705 Blank_keys:! 12706 FOR I=1 TO 9 12707 ON KEY I LABEL "" GOSUB Do_nuthin 12708 NEXT I 12709 RETURN 12710 Do_nuthin:! 12711 RETURN 12712 SUBEND 12713 SUB Test_caller(Test_name$,Option$,Test_mode$,Jan_mode$,INTEGER Result,Depend,Call_completed) 12714 Test_caller: REM $Header: Test_caller,v 1.23 96/01/11 15:42:52 hmgr Exp $ 12715 COM /Variations/Model$,INTEGER Short_moved 12716 Call_completed=1 12717 IF NOT FNField THEN CALL Dut("CLEAR") 12718 SELECT UPC$(Test_name$) 12719 CASE "AL2_PRECHKS" 12720 CALL Al2_prechks(Option$,Test_mode$,Jan_mode$,Result,Depend) 12721 CASE "FIN_ALIGN" 12722 CALL Fin_align(Option$,Test_mode$,Jan_mode$,Result,Depend) 12723 CASE "IMAGE_R" 12724 CALL Image_r(Option$,Test_mode$,Jan_mode$,Result,Depend) 12725 CASE "PWR_SUP" 12726 CALL Pwr_sup(Option$,Test_mode$,Jan_mode$,Result,Depend) 12727 CASE "SER_NUM" 12728 CALL Ser_num(Option$,Test_mode$,Jan_mode$,Result,Depend) 12729 CASE "ERROR_CHK" 12730 CALL Error_chk(Option$,Test_mode$,Jan_mode$,Result,Depend) 12731 CASE "PROBE_VLT" 12732 CALL Probe_vlt(Option$,Test_mode$,Jan_mode$,Result,Depend) 12733 CASE "LO_FREQ" 12734 CALL Lo_freq(Option$,Test_mode$,Jan_mode$,Result,Depend) 12735 CASE "LODA_ADJ" 12736 SELECT Model$ 12737 CASE "8564E","8565E" 12738 CALL Loma_adj(Option$,Test_mode$,Jan_mode$,Result,Depend) 12739 CASE "8560E","8561E","8562E","8563E" 12740 CALL Sloda_adj(Option$,Test_mode$,Jan_mode$,Result,Depend) 12741 CASE ELSE 12742 CALL Loda_adj(Option$,Test_mode$,Jan_mode$,Result,Depend) 12743 END SELECT 12744 CASE "REF_OSC" 12745 CALL Ref_osc(Option$,Test_mode$,Jan_mode$,Result,Depend) 12746 CASE "EXT_MXR_C" 12747 CALL Ext_mxr_c(Option$,Test_mode$,Jan_mode$,Result,Depend) 12748 CASE "EYO_FM_CL" 12749 CALL Eyo_fm_cl(Option$,Test_mode$,Jan_mode$,Result,Depend) 12750 CASE "INT_MXR_V" 12751 CALL Int_mxr_v(Option$,Test_mode$,Jan_mode$,Result,Depend) 12752 CASE "CAL_OSC_P" 12753 CALL Cal_osc_p(Option$,Test_mode$,Jan_mode$,Result,Depend) 12754 CASE "FR_END_CL" 12755 SELECT Model$ 12756 CASE "8560E","8561E","8562E","8563E","8564E","8565E" 12757 IF FNRom_date("FASTADC") THEN 12758 CALL Fr_end_cl_f(Option$,Test_mode$,Jan_mode$,Result,Depend) 12759 ELSE 12760 CALL Fr_end_cl_e(Option$,Test_mode$,Jan_mode$,Result,Depend) 12761 END IF 12762 CASE ELSE 12763 CALL Fr_end_cl(Option$,Test_mode$,Jan_mode$,Result,Depend) 12764 END SELECT 12765 CASE "PRT_BRK_TAB" 12766 CALL Prt_brk_tab(Option$,Test_mode$,Jan_mode$,Result,Depend) 12767 CASE "UNCAL_FLAT" 12768 CALL Uncal_flat(Option$,Test_mode$,Jan_mode$,Result,Depend) 12769 CASE "FLAT_CHK" 12770 CALL Flat_chk(Option$,Test_mode$,Jan_mode$,Result,Depend) 12771 CASE "REF_LVL_CL" 12772 CALL Ref_lvl_cl(Option$,Test_mode$,Jan_mode$,Result,Depend) 12773 CASE "FADC_VID_TRG" 12774 CALL Fadc_vid_trg(Option$,Test_mode$,Jan_mode$,Result,Depend) 12775 CASE "FST_ZRO_SPAN" 12776 CALL Fst_zro_span(Option$,Test_mode$,Jan_mode$,Result,Depend) 12777 CASE "EARPHONE_CK" 12778 CALL Earphone_ck(Option$,Test_mode$,Jan_mode$,Result,Depend) 12779 CASE "SCND_IF" 12780 CALL Scnd_if(Option$,Test_mode$,Jan_mode$,Result,Depend) 12781 CASE "R_OSC_R" 12782 CALL R_osc_r(Option$,Test_mode$,Jan_mode$,Result,Depend) 12783 CASE "TAM_CHK" 12784 CALL Tam_chk(Option$,Test_mode$,Jan_mode$,Result,Depend) 12785 CASE "TRK_GEN_CK" 12786 CALL Trk_gen_chk(Option$,Test_mode$,Jan_mode$,Result,Depend) 12787 CASE "TRAK_GEN_ADJ" 12788 CALL Trak_gen_adj(Option$,Test_mode$,Jan_mode$,Result,Depend) 12789 CASE ELSE 12790 Call_completed=0 12791 END SELECT 12792 CALL Clr_scr 12793 SUBEND 12794 SUB Translate_opt(Select_opts$,OPTIONAL Option_sent$) 12795 Translate_opt: REM $Header: Translate_opt,v 1.9 96/01/11 15:50:29 hmgr Exp $ 12796 COM /Variations/Model$,INTEGER Short_moved 12797 Dut("READ OPTIONS",0,Opts$) 12798 Opts$=Opts$[1;16] 12799 SELECT Model$ 12800 CASE "8560A" 12801 Select_opts$="/8560A" 12802 IF POS(Opts$,"002") THEN 12803 Select_opts$=Select_opts$&"02" 12804 END IF 12805 CASE "8560E" 12806 Select_opts$="/8560E" 12807 IF POS(Opts$,"002") THEN 12808 Select_opts$=Select_opts$&"02" 12809 END IF 12810 CASE "8561A" 12811 Select_opts$="/8561A" 12812 CASE "8561B" 12813 Select_opts$="/8561B" 12814 CASE "8561E" 12815 Select_opts$="/8561E" 12816 CASE "A" 12817 Select_opts$="" 12818 CASE "B" 12819 Select_opts$="/B" 12820 CASE "8562E" 12821 Select_opts$="/8562E" 12822 CASE "8563A" 12823 Select_opts$="/8563A" 12824 CASE "8563E" 12825 Select_opts$="/8563E" 12826 CASE "8564E" 12827 Select_opts$="/8564E" 12828 CASE "8565E" 12829 Select_opts$="/8565E" 12830 CASE ELSE 12831 Show_message(Model$&" IS NOT VALID -- THIS IS Translate_opt ",15) 12832 END SELECT 12833 SUBEND 12834 SUB Type_match(Data$,Type$,INTEGER Valid) 12835 Type_match: REM $Header: Type_match,v 1.1 92/02/17 11:08:22 hmgr Exp $ 12836 INTEGER Len,I,J 12837 REAL Test 12838 Valid=1 12839 Len=LEN(Data$) 12840 SELECT Type$ 12841 CASE "N" 12842 Test=FNVal(Data$,Valid) 12843 CASE "A" 12844 FOR I=1 TO Len 12845 Test=NUM(Data$[I;1]) 12846 SELECT Test 12847 CASE 32,65 TO 90,97 TO 122 12848 CASE ELSE 12849 Valid=0 12850 END SELECT 12851 NEXT I 12852 CASE "L","C","G" 12853 CASE ELSE 12854 END SELECT 12855 SUBEND 12856 SUB User_config(Id$,Dir_path$,File_name$,Msus$,To_file$,Spool$) 12857 User_config: REM $Header: User_config,v 1.1 92/02/17 11:08:33 hmgr Exp $ 12858 REM 12859 REM ================================================================== 12860 REM SOFTWARE ARCHITECTURE LIBRARY // XXXX-XXXX 12861 REM COPYRIGHT @ 1987 BY THE HEWLETT PACKARD COMPANY 12862 REM REVISION: 870414:1330.JA 12863 REM ================================================================== 12864 REM 12865 READ LABEL Id$ 12866 REPEAT 12867 Entry_ok=1 12868 SELECT Id$ 12869 CASE "GP_ENG" 12870 Dir_path$="/UTILITIES/P_FAIL" 12871 File_name$="/PF_PORT" 12872 Msus$=":REMOTE" 12873 Spool$="/SPOOLER/pfail:REMOTE" 12874 To_file$="ZPFPORTD.PRODFAIL.MFGSA" 12875 CASE "PORTAPROD" 12876 Dir_path$="/UTILITIES/P_FAIL" 12877 File_name$="/PF_PORT" 12878 Msus$=":REMOTE" 12879 Spool$="/SPOOL/pfail:REMOTE" 12880 To_file$="ZPFPORTD.PRODFAIL.MFGSA" 12881 CASE "EXIT","E" 12882 Id$="EXIT" 12883 CASE ELSE 12884 CALL Tone("ERROR") 12885 GOSUB Input_user_id 12886 Entry_ok=0 12887 END SELECT 12888 UNTIL Entry_ok 12889 SUBEXIT 12890 Input_user_id:! 12891 INPUT "PLEASE ENTER YOUR GROUP ID, OR ""EXIT""",Id$ 12892 Id$=UPC$(Id$) 12893 RETURN 12894 SUBEND 12895 SUB Wait(Waittime) 12896 Wait: REM $Header: Wait,v 1.1 94/04/11 14:53:26 hmgr Exp $ 12897 T1=TIMEDATE 12898 LOOP 12899 WAIT .2 12900 DISP "Waiting ...";PROUND(Waittime-(TIMEDATE-T1),.1);"seconds left." 12901 EXIT IF Waittime-(TIMEDATE-T1)<=0 12902 END LOOP 12903 SUBEND 12904 SUB Write_data(Address$,Tam_data) 12905 Write_data: REM $Header: Write_data,v 1.4 93/07/19 12:53:05 hmgr Exp $ 12906 INTEGER Select_code 12907 St_address(Address$) 12908 ASSIGN @Sa TO 718 12909 Data$=DVAL$(Tam_data,10) 12910 IF FNRom_date("ORCA") THEN 12911 Command$="ZRDWR "&Data$ 12912 ELSE 12913 Command$="TARDWR "&Data$ 12914 END IF 12915 WAIT .01 12916 OUTPUT @Sa;Command$ 12917 SUBEND 12918 SUB Write_ee_data(@Dut,Break_table(*),Ee_data(*),OPTIONAL Checksumout) 12919 Write_ee_data: REM $Header: Write_ee_data,v 1.1 94/04/11 14:53:30 hmgr Exp $ 12920 DISP "writing ee_data(*) to analyzer" 12921 Break_addr_ptr$="05FB78" 12922 Ee_addr_ptr$="05FBB8" 12923 OUTPUT @Dut;"zsetaddr ";DVAL(Break_addr_ptr$,16);";" 12924 Addr=FNRead_int(@Dut,4) 12925 OUTPUT @Dut;"zsetaddr ";Addr;";" 12926 Addr=FNRead_int(@Dut,4) 12927 OUTPUT @Dut;"zsetaddr ";Addr;";" 12928 Index=0 12929 REPEAT 12930 Index=Index+1 12931 Break_table(Index)=FNRead_int(@Dut,2) 12932 UNTIL Break_table(Index)=65535 12933 N=FNNumcalpnts(Break_table(*)) 12934 PRINT "Writing ";N;" cal points ..." 12935 OUTPUT @Dut;"zsetaddr ";DVAL("05fb74",16);";" 12936 Chksumaddr=FNRead_int(@Dut,4) 12937 OUTPUT @Dut;"zsetaddr ";DVAL("05fb2a",16);";" 12938 Chksumlen=FNRead_int(@Dut,2) 12939 PRINT "chksumlen=";Chksumlen 12940 OUTPUT @Dut;"zsetaddr ";DVAL(Ee_addr_ptr$,16);";" 12941 Addr=FNRead_int(@Dut,4) 12942 OUTPUT @Dut;"zsetaddr ";Addr;";" 12943 Checksum=1 12944 FOR I=1 TO Chksumlen*3 12945 OUTPUT @Dut;"zrdwr ";Ee_data(I);";" 12946 IF I DIV 30=I/30 THEN DISP I/3 12947 Checksum=Checksum+Ee_data(I) 12948 IF Checksum>=2^16 THEN Checksum=(Checksum-2^16)+1 12949 NEXT I 12950 DISP 12951 OUTPUT @Dut;"zsetaddr ";Chksumaddr;";" 12952 OUTPUT @Dut;"zrdwr ";Checksum DIV 256;";" 12953 OUTPUT @Dut;"zrdwr ";Checksum MOD 256;";" 12954 PRINT DVAL$(Chksumaddr,16),Checksum 12955 IF NPAR=4 THEN Checksumout=Checksum 12956 SUBEND 12957 SUB Ref_osc(Option$,Test_mode$,Jan_mode$,INTEGER Test_result,Depend) 12958 GOTO Ref_osc 12959 Ref_osc: REM $Header: ref_osc,v 4.7 94/09/16 10:11:12 hmgr Exp $ 12960 COM /Variations/Model$,INTEGER Short_moved 12961 COM /Rp_nums/Rp_8485,Rp_8482 12962 DIM Dir_name$[16],Revision$[1],Title$[80],Sn$[10],Adj_msg$[80] 12963 DIM Select_opt$[16],Error_message$[160],Key_pressed$[20] 12964 DIM Key_labels$[100],Prompt$[100],Rp_num$[18] 12965 INTEGER Col_dim(1:1),Row_dim(1:1),Z_dim(1:1) 12966 INTEGER Passed,Failed,Aborted,G 12967 REAL Cal_pwr,Cal_freq,Test_date,Adj_frq_err,View_time 12968 Passed=1 12969 Aborted=0 12970 Failed=-1 12971 Revision$=FNRev_letter$("$Revision: 4.7 $") 12972 CALL Translate_opt(Select_opt$) 12973 IF POS(Option$,"003") THEN Select_opt$=Select_opt$&"_OPT_3" 12974 IF POS(Option$,"103") THEN Select_opt$=Select_opt$&"_OPT_103" 12975 Dir_name$="REF_OSC"&Revision$ 12976 CALL Id_info("SERIAL NUMBER",Sn$) 12977 Row_dim(1)=0 12978 Col_dim(1)=2 12979 Z_dim(1)=0 12980 ALLOCATE Ref_osc_data(1:Col_dim(1)) 12981 ALLOCATE Ref_osc_min(1:Col_dim(1)) 12982 ALLOCATE Ref_osc_max(1:Col_dim(1)) 12983 GOSUB Blank_keys 12984 ON KEY 9 LABEL "ABORT TEST",10 RECOVER Test_aborted 12985 CALL Clr_scr 12986 Title$="*** REFERENCE OSCILLATOR ADJUSTMENTS "&FNRcs_rev$("$Revision: 4.7 $")&" ***" 12987 CALL Show_message(Title$,2) 12988 ON SIGNAL 0,9 GOTO Driver_error 12989 ON SIGNAL 2,10 GOTO Dut_error 12990 Key_pressed$=" " 12991 CALL Store_key(Dir_name$,Test_mode$,Select_opt$,Row_dim(*),Col_dim(*),Z_dim(*)) 12992 CALL Store_spec(Dir_name$,Test_mode$,Select_opt$,Row_dim(*),Col_dim(*),Z_dim(*)) 12993 CALL Ref_osc_sp(Test_mode$,Select_opt$,Ref_osc_min(*),Ref_osc_max(*)) 12994 CALL Ref_osc_pm(Adj_frq_err,Select_opt$,Model$) 12995 CALL Get_io_path("PWR MTR 438",@Pwr_mtr) 12996 CALL Get_io_path("CNTR 5342",@Cntr) 12997 CALL Ck_sensor_cal("CHA","8482") 12998 CALL Correct_8482(Rp_8482,Rp_num$) 12999 Setup_438("PRESET,CH A BURIED SENSOR ASGN="&Rp_num$[3],@Pwr_mtr,Error_message$) 13000 Re_test_loop:! 13001 Adjust_freq:! 13002 IF POS(Select_opt$,"_3") OR ((POS(Model$,"E") OR POS(Model$,"8563")) AND POS(Select_opt$,"103")<1) THEN 13003 Ref_osc_data(1)=-99999 13004 ELSE 13005 Dutmessage("") 13006 Message("Connect LOW FREQ input of the counter to the CAL OUTPUT.") 13007 Setup_5342("PRESET,LOW FREQ RANGE,RESOLUTION=1 Hz",@Cntr,Error_message$) 13008 Dut("SINGLE SWEEP") 13009 Adj_msg$="Adj TCXO on RF BOARD for 300MHz =/- "&VAL$((Ref_osc_max(1)-Ref_osc_min(1))/2)&"Hz" 13010 CALL Read_5342("FREQ","Hz",@Cntr,Cal_freq,Error_message$) 13011 IF NOT FNField THEN PRINT TABXY(14,8);" NOTE: REFERENCE FIG. 5 (ALIGNMENT WORK INSTRUCTIONS). " 13012 WHILE ((Cal_freqRef_osc_max(1))) 13013 Autoadjust(Adj_msg$,3.00E+8,Adj_frq_err+1,1,"CNTR 5342") 13014 CALL Read_5342("FREQ","Hz",@Cntr,Cal_freq,Error_message$) 13015 END WHILE 13016 Ref_osc_data(1)=Cal_freq 13017 Blank_lines(6,10) 13018 Dutmessage(" ") 13019 IF ABS(Ref_osc_data(1)-3.00E+8)>300 THEN 13020 CALL Show_message("FREQUENCY REFERENCE = "&VAL$(Ref_osc_data(1))&" Hz.",9) 13021 CALL Message("FREQUENCY REFERENCE seems ABBY-NORMAL. Please check for RF MOD SHORT.") 13022 CALL Blank_lines(9,15) 13023 END IF 13024 END IF 13025 Adjust_power:! 13026 Blank_lines(6,10) 13027 Message("Connect the 8482A (channel A) to the CAL OUTPUT") 13028 CALL Read_438(300,"CORRECTED POWER","dBm",@Pwr_mtr,Cal_pwr,Error_message$) 13029 WHILE ((Cal_pwrRef_osc_max(2))) 13030 IF NOT FNField THEN PRINT TABXY(14,8);" NOTE: REFERENCE FIG. 5 (ALIGNMENT WORK INSTRUCTIONS). " 13031 CALL Show_message("Adjust A15R561 (CAL AMPTD) for -10dbm.",11) 13032 Autoadjust("",-10,.02,1,"PWR MTR 438",300) 13033 Dutmessage(" ---HANDS OFF--- CHECKING SPECS ") 13034 WAIT .5 13035 CALL Read_438(300,"CORRECTED POWER","dBm",@Pwr_mtr,Cal_pwr,Error_message$) 13036 END WHILE 13037 Ref_osc_data(2)=PROUND(Cal_pwr,-2) 13038 Dutmessage(" ") 13039 Blank_lines(6,11) 13040 Message("Disconnect the 8482A from the CAL OUTPUT.") 13041 Output_results:! 13042 Test_date=TIMEDATE 13043 DISP "STORING DATA..." 13044 CALL Store_data(Dir_name$,Select_opt$,Ref_osc_data(*)) 13045 LOOP 13046 SELECT Jan_mode$ 13047 CASE "SINGLE" 13048 CALL Ref_osc_dp(Ref_osc_data(*),Ref_osc_min(*),Ref_osc_max(*),Sn$,Test_date,"DUMP OFF","VIEW TIME ON",Test_result,Model$) 13049 IF FNField THEN 13050 Key_labels$="CONTINUE,,RE-TEST,,DUMP TO LOCAL" 13051 ELSE 13052 Key_labels$="CONTINUE,,RE-TEST,DUMP TO SRM,DUMP TO LOCAL" 13053 END IF 13054 Prompt$="press CONTINUE to Return to Menu." 13055 CALL Prompt_keys(Key_labels$,Key_pressed$,Prompt$) 13056 CASE "SEQUENCED" 13057 CALL Ref_osc_dp(Ref_osc_data(*),Ref_osc_min(*),Ref_osc_max(*),Sn$,Test_date,"DUMP OFF","VIEW TIME ON",Test_result,Model$) 13058 IF FNField THEN 13059 Key_labels$="DEFAULT=CONTINUE,,RE-TEST,,DUMP TO LOCAL" 13060 ELSE 13061 Key_labels$="DEFAULT=CONTINUE,,RE-TEST,DUMP TO SRM,DUMP TO LOCAL" 13062 END IF 13063 IF Test_result=1 THEN 13064 View_time=2 13065 ELSE 13066 View_time=10 13067 END IF 13068 Prompt$=" " 13069 CALL Prompt_keys(Key_labels$,Key_pressed$,Prompt$,View_time) 13070 CASE ELSE 13071 Key_pressed$="CONTINUE" 13072 END SELECT 13073 SELECT Key_pressed$ 13074 CASE "CONTINUE" 13075 GOTO Test_completed 13076 CASE "CONTROL MENU" 13077 CASE "RE-TEST" 13078 CALL Clr_scr 13079 CALL Show_message(Title$,2) 13080 GOTO Re_test_loop 13081 CASE "DUMP TO SRM" 13082 CALL Ref_osc_dp(Ref_osc_data(*),Ref_osc_min(*),Ref_osc_max(*),Sn$,Test_date,"DUMP SRM","VIEW TIME ON",Test_result,Model$) 13083 CASE "DUMP TO LOCAL" 13084 CALL Ref_osc_dp(Ref_osc_data(*),Ref_osc_min(*),Ref_osc_max(*),Sn$,Test_date,"DUMP ON","VIEW TIME ON",Test_result,Model$) 13085 END SELECT 13086 END LOOP 13087 Test_completed:! 13088 CALL Clr_scr 13089 GCLEAR 13090 OFF KEY 13091 OFF SIGNAL 13092 SUBEXIT 13093 Blank_keys:! 13094 FOR G=0 TO 9 13095 ON KEY G LABEL " " GOSUB Do_nuthin 13096 NEXT G 13097 RETURN 13098 Do_nuthin:! 13099 RETURN 13100 Dut_error:! 13101 CALL Tone("ALERT") 13102 CALL Prompt_keys("RE-TEST",Key_pressed$,"Dut error: TIMEOUT caused by the spectum analyzer") 13103 CALL Blank_lines(3) 13104 GOTO Re_test_loop 13105 Driver_error:! 13106 CALL Tone("ALERT") 13107 IF Error_message$<>"OK" THEN 13108 CALL Prompt_keys("RE-TEST",Key_pressed$,"Driver error: "&Error_message$&", Fix system") 13109 CALL Blank_lines(3) 13110 GOTO Re_test_loop 13111 END IF 13112 Test_aborted:! 13113 CALL Clr_scr 13114 OFF SIGNAL 13115 OFF KEY 13116 Test_result=Aborted 13117 SUBEND 13118 SUB Ref_osc_pm(Adj_frq_err,Select_opt$,Model$) 13119 Ref_osc_pm: REM $Header: ref_osc,v 4.7 94/09/16 10:11:12 hmgr Exp $ 13120 Adj_frq_err=10+1 13121 SUBEND 13122 SUB Ref_osc_pt(Test_mode$,Select_opt$,Type$,Title$,Row_lbl$,Col_lbl$,Plane_lbl$,Row(*),Col(*),Planes(*)) 13123 Ref_osc_pt: REM $Header: ref_osc,v 4.7 94/09/16 10:11:12 hmgr Exp $ 13124 MAT Col=(0) 13125 MAT Row=(0) 13126 MAT Planes=(0) 13127 Title$="REFERENCE OSCILLATOR READINGS" 13128 Col_lbl$="FREQUENCY (Hz) & AMPLITUDE (dBm)" 13129 Type$="REAL,OUTPUT=USER DEFINED,END OUTPUT" 13130 SUBEND 13131 SUB Ref_osc_sp(Test_mode$,Select_opt$,Ref_osc_min(*),Ref_osc_max(*)) 13132 Ref_osc_sp: REM $Header: ref_osc,v 4.7 94/09/16 10:11:12 hmgr Exp $ 13133 COM /Variations/Model$,INTEGER Short_moved 13134 Ref_osc_min(1)=3.E+8-11 13135 Ref_osc_max(1)=3.E+8+11 13136 Ref_osc_min(2)=-10-.02 13137 Ref_osc_max(2)=-10+.02 13138 SUBEND 13139 SUB Ref_osc_st(Test_mode$,Select_opt$,Spec_min(*),Spec_max(*)) 13140 Ref_osc_st: REM $Header: ref_osc,v 4.7 94/09/16 10:11:12 hmgr Exp $ 13141 Ref_osc_sp(Test_mode$,Select_opt$,Spec_min(*),Spec_max(*)) 13142 SUBEND 13143 SUB Ref_osc_dp(Ref_osc_data(*),Ref_osc_min(*),Ref_osc_max(*),Serial_num$,Test_date,Dump$,View_time$,OPTIONAL INTEGER Test_result,Model$) 13144 Ref_osc_dp: REM $Header: ref_osc,v 4.7 94/09/16 10:11:12 hmgr Exp $ 13145 DIM Msg$[160] 13146 INTEGER Failed,Passed,Abort,I 13147 Failed=-1 13148 Passed=1 13149 Abort=0 13150 CALL Clr_scr 13151 IF UPC$(View_time$)="VIEW TIME ON" THEN 13152 PRINTER IS CRT 13153 GOSUB Compare_to_spec 13154 END IF 13155 SELECT UPC$(Dump$) 13156 CASE "DUMP OFF" 13157 CASE "DUMP ON" 13158 CALL Init_thinkjet 13159 DISP "Dumping to local printer..." 13160 PRINTER IS PRT 13161 GOSUB Compare_to_spec 13162 PRINTER IS CRT 13163 CASE "DUMP SRM" 13164 DISP "Dumping to SRM printer..." 13165 CALL Printer_is_srm("REF_OSC") 13166 GOSUB Compare_to_spec 13167 PRINTER IS CRT 13168 END SELECT 13169 SUBEXIT 13170 Compare_to_spec:! 13171 ALLOCATE Result$(1:SIZE(Ref_osc_data,1))[7] 13172 MAT Result$=(" PASS") 13173 FOR I=1 TO SIZE(Ref_osc_data,1) 13174 IF Ref_osc_data(I)Ref_osc_max(I) THEN 13175 IF I=2 OR (I=1 AND Ref_osc_data(1)<>-99999) THEN 13176 Result$(I)="*FAIL" 13177 Test_result=Failed 13178 END IF 13179 END IF 13180 NEXT I 13181 Display_results:! 13182 Fmt_title: IMAGE 3X,10A,13X,10A,10X,10A,10X,10A 13183 Fmt: IMAGE 20A,3X,DD.DD,X,AAA,9X,"+/-",DD.DD,X,AAA,13X,7A 13184 CALL Show_message("REFERENCE OSCILLATOR ADJUSTMENTS",1) 13185 PRINT TABXY(1,2);"Serial # : ";Serial_num$ 13186 PRINT TABXY(55,2);"Test Date: ";DATE$(Test_date) 13187 PRINT 13188 PRINT 13189 PRINT USING Fmt_title;" 300 MHz "," "," "," " 13190 PRINT USING Fmt_title;"CAL OUTPUT","ERROR","SPEC","RESULT" 13191 PRINT USING Fmt_title;"----------","-----","----","------" 13192 IF Ref_osc_data(1)<>-99999 THEN 13193 PRINT USING Fmt;"REF FREQ ERROR",Ref_osc_data(1)-300000000,"Hz",Ref_osc_max(1)-300000000,"Hz",Result$(1) 13194 END IF 13195 PRINT 13196 PRINT USING Fmt;"CAL OUT PWR ERROR",Ref_osc_data(2)+10,"dBm",Ref_osc_max(2)+10,"dBm",Result$(2) 13197 PRINT 13198 IF Test_result=Failed THEN 13199 CALL Show_message(" **************** TEST FAILED **************** ",17) 13200 ELSE 13201 CALL Show_message(" **************** TEST PASSED **************** ",17) 13202 Test_result=Passed 13203 END IF 13204 DEALLOCATE Result$(*) 13205 RETURN 13206 SUBEND 13207 DEF FNField 13208 Field: REM $Header: FNField.fac,v 1.1 93/07/29 14:30:55 hmgr Exp $ 13209 RETURN 0 13210 FNEND 13211 ! 13212 ! 13213 SUB Adj_slope_off2(Band1,Frequency1,Band2,Frequency2,Slope,Offset,Fr_end_cl_data(*),Mid_dac) 13214! $Log: Adj_slope_off2,v $ 13215!Revision 1.6 93/05/28 10:03:46 10:03:46 hmgr () 13216!Author: randyh@hpsadl19.sr.hp.com 13217!changed min amplitude from -25 to -30 13218! 13219!Revision 1.5 93/05/19 10:57:48 10:57:48 hmgr () 13220!Author: randyh@hpsadpk9.sad.hp.com 13221!noe kicks start slope value +- steps of 25 if slope and offset are peaked 13222!but signal is less than -25dBm. I out of range then slope = <0 or >255. 13223!This value signals fr_end_cl_f that adjustment is bad. 13224! 13225!Revision 1.4 93/04/16 12:28:20 12:28:20 hmgr () 13226!Author: randyh@hpsadl19.sr.hp.com 13227!don't bail out if first adjustment 13228! 13229!Revision 1.3 93/03/09 14:07:19 14:07:19 hmgr () 13230!Author: bobw@hpsadwc5.sad.hp.com 13231!Added setting of default slope in band 1 and 2 at beginning of 13232!routine. Required for Fast ADC. 13233! 13234!Revision 1.2 92/11/12 11:59:00 11:59:00 hmgr () 13235!Author: randyh@hpsadpk9.sad.hp.com 13236!no comment 13237! 13238!Revision 1.1 92/10/09 16:29:18 16:29:18 hmgr () 13239!Author: randyh@hpsadpk9.sad.hp.com 13240!Initial revision 13241! 13242!---------------------------------------------------------------------------- 13243 Adj_slope_off2: REM $Header: Adj_slope_off2,v 1.6 93/05/28 10:03:46 hmgr Exp $ 13244! 13245 Slope_addr=FNRead_value("05FC9C",4) 13246 Oset_addr=FNRead_value("05FC98",4) 13247 ! 13248 Dir=1 13249 Loop_cnt=0 13250 ! 13251 LOOP 13252 Dut("WRITE YTF OFFSET "&VAL$(Band1),Offset) 13253 Dut("WRITE YTF OFFSET "&VAL$(Band2),Offset) 13254 Dut("WRITE YTF SLOPE "&VAL$(Band1),Slope) 13255 Dut("WRITE YTF SLOPE "&VAL$(Band2),Slope) 13256 ! 13257 First_slope=Slope 13258 Prev_slp=0 13259 Prev_off=0 13260 ! 13261 FOR Adj=0 TO 5 13262 Autoset2(5-Adj,Offset,Oset_addr+Band1,Band1,Frequency1,Mid_dac,Amp1) 13263 Dut("WRITE YTF OFFSET "&VAL$(Band2),Offset) 13264 Autoset2(5-Adj,Slope,Slope_addr+Band2,Band2,Frequency2,Mid_dac,Amp2) 13265 Dut("WRITE YTF SLOPE "&VAL$(Band1),(Slope)) 13266 IF Slope=Prev_slp AND Offset=Prev_off AND Adj>0 THEN Adj=5 13267 Prev_slp=Slope 13268 Prev_off=Offset 13269 NEXT Adj 13270 EXIT IF Amp1>-30 AND Amp2>-30 13271 Dir=-Dir 13272 Loop_cnt=Loop_cnt+1 13273 Slope=First_slope+Dir*Loop_cnt*25 13274 IF Slope>255 OR Slope<0 THEN 13275 SUBEXIT 13276 END IF 13277 END LOOP 13278 ! 13279 Adjust_done: ! 13280 FOR Band=Band1 TO Band2 13281 Dut("WRITE YTF OFFSET "&VAL$(Band),(Offset)) 13282 Dut("WRITE YTF SLOPE "&VAL$(Band),(Slope)) 13283 Dut("WRITE EE YTF OFFSET "&VAL$(Band),(Offset)) 13284 Dut("WRITE EE YTF SLOPE "&VAL$(Band),(Slope)) 13285 Fr_end_cl_data(1,Band)=Slope 13286 Fr_end_cl_data(2,Band)=Offset 13287 NEXT Band 13288 ! 13289 SUBEND ! Adj_slope 13290 ! 13291! 13292 SUB Autoset2(Start_power,Init_guess,Address,Band,Frequency,Mid_dac,Amp_o) 13293! $Log: Autoset2,v $ 13294!Revision 1.5 95/04/03 16:07:15 16:07:15 hmgr () 13295!Author: mayk@boar.sr.hp.com 13296!Changed ASSIGN @XXX to Get_io_path. 13297!Changed OUTPUT 719 to OUTPUT @XXX. 13298! 13299!Revision 1.4 93/07/19 12:47:40 12:47:40 hmgr () 13300!Author: randyh@hpsadpk9.sad.hp.com 13301!Use new FNRom_date CASE "ORCA" 13302! 13303!Revision 1.3 93/06/16 12:18:57 12:18:57 hmgr () 13304!Author: randyh@hpsadpk9.sad.hp.com 13305!now checks that rom_date > 930606 and if so than uses ZRDWR and ZSETADDR 13306!instead of TARDWR and TASETADDR. 13307! 13308!Revision 1.2 93/05/19 10:59:06 10:59:06 hmgr () 13309!Author: randyh@hpsadpk9.sad.hp.com 13310!now returns parm Amp_o, the marker value to Adj_slope_off2 so that 13311!Adj_slope_off2 can determine a good adjustment. 13312! 13313!Revision 1.1 92/10/09 16:29:33 16:29:33 hmgr () 13314!Author: randyh@hpsadpk9.sad.hp.com 13315!Initial revision 13316! 13317!---------------------------------------------------------------------------- 13318 Autoset2: REM $Header: Autoset2,v 1.5 95/04/03 16:07:15 hmgr Exp $ 13319! 13320 INTEGER Setting,Max_setting 13321 DIM Z_ta_rdwr$[15],Z_ta_stad$[15] 13322 DIM Ytf_data(0:256) 13323 MAT Ytf_data=(0) 13324 ! 13325 ASSIGN @Dut TO 718 13326 Get_io_path("SYNTH 8340",@Swp1) 13327 ! 13328 IF FNRom_date("ORCA") THEN 13329 Z_ta_rdwr$="ZRDWR" 13330 Z_ta_stad$="ZSETADDR" 13331 ELSE 13332 Z_ta_rdwr$="TARDWR" 13333 Z_ta_stad$="TASETADDR" 13334 END IF 13335 ! 13336 IF Init_guess>255 THEN 13337 Init_guess=128 13338 END IF 13339 Max_setting=Init_guess 13340 ! 13341 OUTPUT @Swp1;"CW";Frequency;"HZ" 13342 OUTPUT @Dut;"HNLOCK ";Band;";CF ";Frequency;";TS;" 13343 Dut("WRITE RF CORE YTF DAC",Mid_dac) 13344 OUTPUT @Dut;""&Z_ta_stad$&" ";Address;";"&Z_ta_rdwr$&" ";Max_setting;";" 13345 OUTPUT @Dut;"CONTS;SNGLS;TS;MKA?;" 13346 ENTER @Dut;Ytf_data(Max_setting) 13347 Max_amp=Ytf_data(Max_setting) 13348 ! 13349 FOR Delta_power=Start_power TO 0 STEP -1! Power of 2 13350 Setting_step=2^Delta_power 13351 FOR Nsetting=Max_setting-Setting_step TO Max_setting+Setting_step STEP Setting_step 13352 Setting=MAX(0,MIN(Nsetting,Mid_dac*2-1)) 13353 OUTPUT @Dut;""&Z_ta_stad$&" ";Address;";"&Z_ta_rdwr$&" ";Setting;";" 13354 OUTPUT @Dut;"CONTS;SNGLS;TS;MKA?;" 13355 ENTER @Dut;Ytf_data(Setting) 13356 IF Ytf_data(Setting)>Max_amp THEN 13357 Max_amp=Ytf_data(Setting) 13358 Max_setting=Setting 13359 END IF 13360 NEXT Nsetting 13361 NEXT Delta_power 13362 ! 13363 Amp_o=Max_amp 13364 Init_guess=PROUND(Max_setting,0) 13365 ! 13366 SUBEND ! Autoset2 13367! 13368!************************************************************************************ 13369 ! 13370 ! 13371 SUB Show_message(Message$,OPTIONAL INTEGER Line,Column) 13372!================================================================! 13373! PART OF : MANAGER FIXED 13374!----------------------------------------------------------------! 13375! PURPOSE : Print a message on the hp series 200 computer CRT 13376!----------------------------------------------------------------! 13377! PROGRAMMER : Claude Ashen REVISION DATE: 2/07/84 13378!================================================================! 13379! PASS PARAMETERS: (Message$, OPTIONAL INTEGER Line,Column) 13380! 13381! This subprogram will print 'Message$' centered on the CRT of 13382! a hp series 200 computer if no optional parameters passed. 13383! (CRT line 11) 13384! 13385! If the optional parameter 'Line' is passed this subprogram will 13386! print the message centered on the CRT line specifed by 'Line'. 13387! 13388! If the optional parameter 'Column' is NOT passed this 13389! subprogram will first print a full screen line of blanks to 13390! erase the specifed line. 13391! 13392! If the optional parameter 'Column' is passed the first 13393! character of 'Message$' will be placed in the colum specifed by 13394! 'Column'. 13395! 13396! If the lenght of 'Message$' is greater than the CRT with the 13397! message will be placed starting at colum 1 and the message will 13398! wrap around to the next line. 13399! 13400! If the optional parameter 'Column' is passed the length of 13401! 'Message$' may cause the message to wrap arround to the next 13402! line. 13403! 13404! NOTES: 1) If wrap araound does occur the portion that is 13405! printed on the following line may be overwritten and 13406! lost by subsequent calls to this subprogram. 13407! 13408! 2) This subprogram does NOT trim the leading or trailing 13409! spaces when making possitioning or centering 13410! caculations. 13411!================================================================! 13412 Show_message: REM $Header: Show_message,v 1.1 91/09/05 13:00:19 hmgr Exp $ 13413!----------------------------------------------------------------! 13414 INTEGER Column_tab,Line_tab,Screen_width 13415!----------------------------------------------------------------! 13416 SELECT NPAR 13417 CASE 1 13418 Line_tab=11 13419 GOSUB Centering 13420 CASE 2 13421 Line_tab=Line 13422 GOSUB Centering 13423 CASE 3 13424 Line_tab=Line 13425 Column_tab=Column 13426 END SELECT 13427 PRINT TABXY(Column_tab,Line_tab);Message$ 13428 SUBEXIT 13429! 13430 Centering: ! 13431! This subroutine reads the screen status register to 13432! determine the screen width. Once the screen width is known 13433! the line starting location is computed so that the line 13434! will be centered on the screen. This routine will also clear 13435! the line that the message is to be displayed on. 13436!-------------------------------------------------------------! 13437 DIM All_spaces$[80] 13438!-------------------------------------------------------------! 13439 STATUS 1,9;Screen_width 13440 Screen_width=MIN(Screen_width,80) 13441 OUTPUT All_spaces$ USING "#,"&VAL$(Screen_width)&"X" 13442 PRINT TABXY(1,Line_tab);All_spaces$ 13443 ! 13444 Column_tab=((Screen_width-LEN(Message$)) DIV 2)+1 13445 IF Column_tab<1 THEN Column_tab=1 13446 RETURN 13447 ! 13448 SUBEND ! Show_msg 13449 ! 13450 ! 13451 SUB Command_parser(Control$,Command$,Value_n_unit$,INTEGER Last_command) 13452 Command_parser: REM $Header: Command_parser,v 1.1 91/09/05 12:52:31 hmgr Exp $ 13453! 13454 INTEGER Comma_loc,Equals_loc 13455 Comma_loc=POS(Control$,",") 13456 IF Comma_loc=0 THEN ! No more commas in the string 13457 Command$=Control$ ! Last or only command in the string 13458 Last_command=1 13459 ELSE 13460 Command$=Control$[1,Comma_loc-1] 13461 Control$=Control$[Comma_loc+1] 13462 Last_command=0 13463 END IF ! End of Parser 13464! 13465 Equals_loc=POS(Command$,"=") ! If a Value is included in 13466 IF Equals_loc<>0 THEN ! Command$ then separate 13467 Value_n_unit$=Command$[Equals_loc+1]! the value and units from 13468 Command$=Command$[1,(Equals_loc-1)]! the command 13469 ELSE 13470 Value_n_unit$="" 13471 END IF 13472 SUBEND 13473 ! 13474 ! 13475 SUB Id_info(Id_descript$,Requested_id$) 13476 Id_info: REM $Header: Id_info,v 1.4 95/11/13 11:22:56 hmgr Exp $ 13477 !COM /Identification/ Serial_num$,Option$(*),Tech_num$ 13478 !COM /Identification/ Station_num,Batch 13479 SELECT Id_descript$ 13480 CASE "SERIAL NUMBER" 13481 Requested_id$=Serial_num$ 13482 CASE "STATION NUMBER" 13483 Requested_id$=VAL$(Station_num) 13484 CASE "STATION ID" 13485 Requested_id$="STN"&VAL$(Station_num)&"_NODE"&FNWs_id$ 13486 CASE "TEST NAME" 13487 Requested_id$=FNRead_menu_str$("TEST NAME") 13488 CASE "TEST MODE" 13489 Requested_id$=FNRead_menu_str$("CUSTOM") 13490 CASE "EMPLOYEE NUMBER" 13491 Requested_id$=Tech_num$ 13492 CASE ELSE 13493 DISP Id_descript$&" IS NOT A VALID ID REQUEST -- THIS IS Id_info" 13494 PAUSE 13495 STOP 13496 END SELECT 13497 SUBEND 13498 ! 13499 ! 13500 SUB Ck_sensor_cal(Channel$,Sensor$) 13501 Ck_sensor_cal: REM $Header: Ck_sensor_cal,v 1.1 92/02/18 11:12:52 hmgr Exp $ 13502! 13503! $Log: Ck_sensor_cal,v $ 13504!Revision 1.1 92/02/18 11:12:52 11:12:52 hmgr () 13505!Author: bobw@hpsadwc5.sad.hp.com 13506!Initial revision 13507! 13508! 13509 DIM Last_cal_time$[20] 13510 ! 13511 Last_cal_time$=FNStatus$("system","calibration times",Sensor$,Channel$) 13512 ! 13513 IF Last_cal_time$="" THEN 13514 GOSUB Cal_sensor 13515 ELSE 13516 IF TIMEDATE-VAL(Last_cal_time$)>2*60*60 THEN GOSUB Cal_sensor ! Cal if more than 2 hours old 13517 END IF 13518 SUBEXIT 13519 ! 13520 Cal_sensor: ! 13521 CALL Cal_and_zero(Channel$&" "&Sensor$,"FORCE CAL") !ZERO AND CAL POWER SENSOR 13522 Set_status(VAL$(TIMEDATE),"system","calibration times",Sensor$,Channel$) 13523 RETURN 13524 SUBEND 13525 ! 13526 ! 13527 SUB Sep_val_units(In$,Value,Unit$) 13528 Sep_val_units: REM $Header: Sep_val_units,v 1.1 96/01/30 12:20:13 hmgr Exp $ 13529 !-------------------------------------------------------------- 13530 ! Last modified by: 13531 ! $Log: Sep_val_units,v $ 13532 ! Revision 1.1 96/01/30 12:20:13 12:20:13 hmgr () 13533 ! Author: mayk@boar.sr.hp.com 13534 ! Initial revision 13535 ! 13536 ! 13537 !-------------------------------------------------------------- 13538 INTEGER I,Value_found 13539 I=LEN(In$) 13540 Value_found=0 13541 LOOP 13542 SELECT In$[I,I] 13543 CASE "0" TO "9" 13544 Value_found=1 13545 CASE ELSE 13546 END SELECT 13547 EXIT IF Value_found=1 OR I=1 13548 I=I-1 13549 END LOOP 13550 IF Value_found=1 THEN 13551 Unit$=TRIM$(In$[I+1]) 13552 Value=VAL(In$[1,I]) 13553 CALL Convert_units(Value,Unit$) 13554 ELSE 13555 Unit$="" 13556 Value=0 13557 END IF 13558 SUBEND 13559 !*********************************************************************** 13560 ! 13561 SUB Convert_units(Value,Unit$) 13562 Std_unit_conv: REM $Header: Convert_units,v 1.1 96/01/30 12:15:33 hmgr Exp $ 13563 !-------------------------------------------------------------- 13564 ! Last modified by: 13565 ! $Log: Convert_units,v $ 13566 ! Revision 1.1 96/01/30 12:15:33 12:15:33 hmgr () 13567 ! Author: mayk@boar.sr.hp.com 13568 ! Initial revision 13569 ! 13570 ! 13571 !-------------------------------------------------------------- 13572 SELECT Unit$[1,1] 13573 CASE "a" 13574 IF Unit$[1,3]<>"amp" THEN 13575 Value=Value*1.E-18 13576 Unit$=Unit$[2] 13577 END IF 13578 CASE "f" 13579 Value=Value*1.E-15 13580 Unit$=Unit$[2] 13581 CASE "p" 13582 Value=Value*1.E-12 13583 Unit$=Unit$[2] 13584 CASE "n" 13585 Value=Value*1.E-9 13586 Unit$=Unit$[2] 13587 CASE "u" 13588 Value=Value*1.E-6 13589 Unit$=Unit$[2] 13590 CASE "m" 13591 IF Unit$<>"mho" THEN 13592 Value=Value*1.E-3 13593 Unit$=Unit$[2] 13594 END IF 13595 CASE "k" 13596 Value=Value*1.E+3 13597 Unit$=Unit$[2] 13598 CASE "M" 13599 Value=Value*1.E+6 13600 Unit$=Unit$[2] 13601 CASE "G" 13602 Value=Value*1.E+9 13603 Unit$=Unit$[2] 13604 CASE "T" 13605 Value=Value*1.E+12 13606 Unit$=Unit$[2] 13607 CASE "P" 13608 Value=Value*1.E+15 13609 Unit$=Unit$[2] 13610 CASE "E" 13611 Value=Value*1.E+18 13612 Unit$=Unit$[2] 13613 CASE ELSE 13614 END SELECT 13615 SUBEND 13616 ! 13617 ! 13618 SUB Prompt_keys(Key_labels$,Key_pressed$,OPTIONAL Message$,Seconds) 13619 Prompt_keys: REM $Header: Prompt_keys,v 1.1 91/09/05 12:59:13 hmgr Exp $ 13620! REV 2 APR 87 BOB WALTENSPIEL 13621! ENABLED THE CONTINUE BUTTON IF A SOFTKEY IS LABELED "CONTINUE" 13622! AND SERVICED THE KEYBOARD WITH A GOTO INSTEAD OF GOSUB TO LOWER 13623! SYSTEM PRIORITY FOR SUCH THINGS A KEYBOARD CALLS FROM THIS CONTEXT. 13624! 13625! REV 26 MAY 87 BILL SIMMONS 13626! ELIMINATE PROBLEMS.... TWO KEY PRESSES TO GET ACTION ON K9 13627 DIM Keys$(1:4,0:8)[25] 13628 DIM Kbd_key$[5],Kbd_msg$[160],Top_line$[80],Key_label$[25] 13629 DIM Bot_line$[80],Msg$[80],Sequence(1:8),Default_key$[25],Default$[25] 13630 INTEGER Key_num,Default_key_num,Timer_set,Last_key 13631 INTEGER Key_count,Key_layer,Lf_pos,Cont_enabled 13632 ALLOCATE Rest_key_labels$[LEN(Key_labels$)] 13633 Junk$=KBD$ ! READ KBD$ TO CLEAR KBD BUFFER 13634 Rest_key_labels$=Key_labels$ 13635 Key_pressed$=" " 13636 Debug$=" " 13637 Cont_enabled=0 13638 ON KBD ALL,10 GOSUB Do_nuthin 13639 Kbd_msg$=RPT$(" ",160) 13640 IF NPAR>2 THEN 13641 IF LEN(Message$)>160 THEN 13642 Msg$="ERROR: PROMPT KEY MESSAGE EXCEEDS 160 CHARS; IS "&VAL$(LEN(Message$))&"CHARS LONG" 13643 GOTO Drop_dead 13644 END IF 13645 Lf_pos=POS(Message$,CHR$(10)) 13646 IF Lf_pos>0 THEN 13647 IF Lf_pos>81 THEN 13648 Msg$="ERROR: PROMPT KEY MESSAGE LINE FEED HAS MORE THAN 80 CHARACTERS BEFORE IT" 13649 GOTO Drop_dead 13650 END IF 13651 IF LEN(Message$)-Lf_pos>80 THEN 13652 Msg$="ERROR: PROMPT KEY MESSAGE LINE FEED HAS MORE THAN 80 CHARACTERS AFTER IT" 13653 GOTO Drop_dead 13654 END IF 13655 Top_line$=TRIM$(Message$[1,Lf_pos-1]) 13656 Bot_line$=TRIM$(Message$[Lf_pos+1]) 13657 Kbd_msg$[INT(41-(LEN(Top_line$)/2))]=Top_line$ 13658 Kbd_msg$=Kbd_msg$&RPT$(" ",160-LEN(Kbd_msg$)) 13659 Kbd_msg$[81+(40-(LEN(Bot_line$)/2))]=Bot_line$ 13660 ELSE 13661 IF LEN(Message$)<80 THEN 13662 Kbd_msg$[41-(LEN(Message$)/2)]=Message$ 13663 ELSE 13664 Kbd_msg$=Message$ 13665 END IF 13666 END IF 13667 OUTPUT KBD;Kbd_msg$; 13668 END IF 13669 RESTORE Key_sequence 13670 Key_layer=0 13671 REPEAT 13672 Key_count=0 13673 Key_layer=Key_layer+1 13674 IF Key_layer=1 OR Key_layer=2 THEN 13675 READ Sequence(*) 13676 END IF 13677 REPEAT 13678 CALL Command_parser(Rest_key_labels$,Key_label$,Default_key$,Last_key) 13679 Key_count=Key_count+1 13680 SELECT Key_label$ 13681 CASE "DEFAULT" 13682 Keys$(Key_layer,Sequence(Key_count))=Default_key$ 13683 Default_key_num=Sequence(Key_count) 13684 Default_layer=Key_layer 13685 Default$=Default_key$ 13686 IF Default_key$="CONTINUE" THEN Cont_enabled=1 13687 CASE ELSE 13688 IF Default_key$<>"" THEN 13689 Key_label$=Key_label$&"="&Default_key$ 13690 END IF 13691 Keys$(Key_layer,Sequence(Key_count))=Key_label$ 13692 IF Key_label$="CONTINUE" THEN Cont_enabled=1 13693 END SELECT 13694 UNTIL Key_count=8 OR Last_key=1 13695 IF Key_layer=1 AND Last_key=0 THEN 13696 Rest_key_labels$=Keys$(1,4)&","&Rest_key_labels$ 13697 Keys$(1,4)="MORE KEYS X" 13698 END IF 13699 IF Key_layer>1 THEN 13700 Keys$(Key_layer,4)="MORE KEYS X" 13701 END IF 13702 UNTIL Last_key=1 13703 FOR I=0 TO 8 13704 FOR J=1 TO Key_layer 13705 IF Keys$(J,I)="" THEN Keys$(J,I)=" " 13706 NEXT J 13707 NEXT I 13708 Key_sequence: ! 13709 DATA 5,7,8,0,1,2,3,4 13710 DATA 5,6,7,8,0,1,2,3 13711 Current_layer=1 13712 GOSUB Light_keys 13713 IF NPAR=4 AND Default$<>"" THEN 13714 GOSUB Setup_default 13715 ELSE 13716 DISP "Press a softkey" 13717 END IF 13718 ON KBD ALL,11 GOTO Key_service 13719 LOOP 13720 Wait_for_key: ! 13721 EXIT IF Key_pressed$<>" " 13722 END LOOP 13723 DISP "" 13724 IF NPAR>2 THEN 13725 OUTPUT KBD;"ÿ#"; 13726 END IF 13727 SUBEXIT 13728 Light_keys: ! 13729 FOR I=0 TO 8 13730 ON KEY I LABEL Keys$(Current_layer,I) GOSUB Do_nuthin 13731 NEXT I 13732 RETURN 13733 Setup_default: ! 13734 ON KEY 6 LABEL "HALT" GOSUB Do_nuthin 13735 Timer_set=1 13736 GOSUB Disp_default 13737 ON CYCLE 1,6 GOSUB Disp_default 13738 RETURN 13739 Disp_default: ! 13740 ON DELAY .75,7 GOSUB Clr_disp 13741 DISP "Press a softkey, Program will -- "&Default$&" -- in "&VAL$(Seconds)&" seconds" 13742 Seconds=Seconds-1 13743 IF Current_layer=1 AND Default_layer=1 THEN 13744 ON KEY Default_key_num LABEL Default$ GOSUB Do_nuthin 13745 ELSE 13746 DISP "Press a softkey" 13747 END IF 13748 RETURN 13749 Clr_disp: ! 13750 OFF DELAY 13751 DISP " Program will -- "&Default$&" -- in "&VAL$(Seconds)&" seconds" 13752 IF Current_layer=1 AND Default_layer=1 THEN 13753 ON KEY Default_key_num LABEL "" GOSUB Do_nuthin 13754 END IF 13755 IF Timer_set AND Seconds<1 THEN Key_pressed$=Default$ 13756 RETURN 13757 Key_service: ! 13758 Kbd_key$[1,2]=KBD$ 13759 Kbd_key$=TRIM$(Kbd_key$) 13760 SELECT Kbd_key$[1,1] 13761 CASE "D","E","B","U","G","d","e","b","u","g" 13762 Debug$=Debug$&Kbd_key$[1,1] 13763 Debug$=UPC$(Debug$[2,6]) 13764 IF Debug$="DEBUG" THEN 13765 OFF KBD 13766 OUTPUT KBD;"ÿP ÿS"; 13767 SUBEXIT 13768 END IF 13769 CASE CHR$(255) 13770 SELECT Kbd_key$[2,2] 13771 CASE "0" TO "9","a" TO "j" 13772 IF Timer_set=1 THEN 13773 OFF CYCLE 13774 OFF DELAY 13775 DISP "Press a softkey" 13776 Timer_set=0 13777 IF Current_layer=1 THEN 13778 ON KEY 6 LABEL "" GOSUB Do_nuthin 13779 IF Default_layer=1 THEN 13780 ON KEY Default_key_num LABEL Default$ GOSUB Do_nuthin 13781 END IF 13782 END IF 13783 END IF 13784 END SELECT 13785 SELECT Kbd_key$[2,2] 13786 CASE "0" TO "8" 13787 Key_num=VAL(Kbd_key$[2,2]) 13788 Key_pressed$=Keys$(Current_layer,Key_num) 13789 IF Key_pressed$="MORE KEYS X" THEN 13790 Current_layer=Current_layer+1 13791 IF Current_layer>Key_layer THEN Current_layer=1 13792 GOSUB Light_keys 13793 Key_pressed$=" " 13794 END IF 13795 CASE "9" 13796 OUTPUT KBD;Kbd_key$; 13797 CASE "P" 13798 PAUSE 13799 CASE "C" 13800 IF Cont_enabled THEN 13801 Key_pressed$="CONTINUE" 13802 ELSE 13803 Key_pressed$=" " 13804 END IF 13805 CASE ELSE 13806 END SELECT 13807 END SELECT 13808 GOTO Wait_for_key 13809 Drop_dead: ! 13810 CALL Tone("ALERT") 13811 DISP Msg$ 13812 PAUSE 13813 STOP 13814 Do_nuthin: ! 13815 RETURN 13816 SUBEND 13817 ! 13818 ! ------------------------------- REPLACED SUBPROGRAMS ---------------------------- 13819 ! 13820 ! Subprograms added that do nothing per the Design Document are: 13821 ! Store_key, Store_spec, Store_data 13822 ! 13823 ! Subprograms added by Symmetrix that replace subprograms that call MAN/JAN subprograms are: 13824 ! Get_io_path, Directory_info, Tone, Clr_scr, Clr 13825 ! 13826 ! Subprograms added by Symmetrix that form substitution layers for MAN/JAN subprograms are" 13827 ! Setup_8340, Read_438 13828 ! 13829 ! 13830 SUB Store_key(Dir_name$,Test_mode$,Select_opt$,INTEGER Row_dim,INTEGER Col_dim,INTEGER Z_dim,Array_descrip$(*)) 13831 ! a do nothing subprogram per the Design Document 13832 SUBEND 13833 ! 13834 ! 13835 SUB Store_spec(Dir_name$,Test_mode$,Select_opt$,INTEGER Row_dim,INTEGER Col_dim,INTEGER Z_dim,Array_descrip$(*)) 13836 ! a do nothing subprogram per the Design Document 13837 SUBEND 13838 ! 13839 ! 13840 SUB Store_data(Dir_name$,Select_opt$,Array(*)) 13841 ! a do nothing subprogram per the Design Document 13842 SUBEND 13843 ! 13844 ! 13845 SUB Get_io_path(Inst_name$,@Io_path,OPTIONAL Status$) ! substitution layer 13846 Get_io_path: REM $Header: Get_io_path.rh,v 0.0 96/06/26 12:00:00 symm Exp $ 13847 COM /Conditions/Conditions$(*) 13848 IF NPAR=2 THEN 13849 END IF 13850 IF Inst_name$<>"" THEN 13851 IF Inst_name$="SA 8562" THEN ASSIGN @Io_path TO VAL(Conditions$(12,2)[1,4]) 13852 IF Inst_name$="PRINTER" THEN ASSIGN @Io_path TO VAL(Itions$(13,2)[1,4]) 13853 IF Inst_name$="PWR MTR 436" THEN ASSIGN @Io_path TO VAL(Conditions$(14,2)[1,4]) 13854 IF Inst_name$="PWR MTR 438" THEN ASSIGN @Io_path TO VAL(Conditions$(15,2)[1,4]) 13855 IF Inst_name$="8902A" THEN ASSIGN @Io_path TO VAL(Conditions$(16,2)[1,4]) 13856 IF Inst_name$="SYNTH 8340" THEN 13857 IF Conditions$(17,2)[6]="*" THEN ASSIGN @Io_path TO VAL(Conditions$(17,2)[1,4]) 13858 IF Conditions$(18,2)[6]="*" THEN ASSIGN @Io_path TO VAL(Conditions$(18,2)[1,4]) 13859 END IF 13860 ELSE 13861 Prompt_user("ERROR: unable to assign an IO path to "&Inst_name$,2) 13862 END IF 13863 IF NPAR=3 AND Inst_name$<>"" THEN 13864 Status$="ASSIGNED" 13865 END IF 13866 SUBEND ! Get_io_paths 13867 ! 13868 ! 13869 SUB Directory_info(A$,Cal_directory$,C$) 13870 Directory_info: REM $Header: Directory_info.rh,v 0.0 96/06/26 12:00:00 symm Exp $ 13871 Cal_directory$="" 13872 SUBEND 13873 ! 13874 ! 13875 SUB Tone(Signal$) ! subprogram called by Fr_end_cal_f, blk_drvrs, stat_drvrs to beep 13876 Tone: REM $Header: Tone.rh,v 0.0 96/06/26 12:00:00 symm Exp $ 13877 SELECT Signal$ 13878 CASE "STOPPED" 13879 BEEP 100,.3 13880 CASE "ALERT" 13881 FOR Noise=1 TO 4 13882 BEEP 200,.05 13883 BEEP 400,.05 13884 NEXT Noise 13885 CASE "ENTER" 13886 BEEP 100,.1 13887 CASE "ERROR" 13888 BEEP 500,.05 13889 END SELECT 13890 SUBEND ! Tone 13891 ! 13892 ! 13893 SUB Clr_scr ! subprogram called by stat_drvrs to clear screen 13894 Clr_scr: REM $Header: Clr_scr.rh,v 0.0 96/06/26 12:00:00 symm Exp $ 13895 PRINT USING "@" 13896 SUBEND ! Clr_scr 13897 ! 13898 ! 13899 SUB Clr ! subprogram called by Fr_end_cal_f, blk_drvrs to clear screen 13900 Clr: REM $Header: Clr.rh,v 0.0 96/06/26 12:00:00 symm Exp $ 13901 PRINT USING "@" 13902 SUBEND ! Clr 13903 ! 13904 ! 13905 SUB Setup_8340(Control$,@Syn_8340,Error_message$) ! substitution layer 13906 Setup_8340: REM $Header: Setup_8340.rh,v 0.0 96/06/26 12:00:00 symm Exp $ 13907 DIM Command$[50],Id$[24],Unit$[6],Value_n_unit$[50],Msg$[160] 13908 DIM Key_pressed$[18] 13909 COM /Synth_8340_mem/Disable_8340err$(1:4,1:2)[80] 13910 INTEGER Io_path_exists,Addr,Select_code,I,Synth_index 13911 INTEGER Last_command,Syn_statusbyte1,Syn_statusbyte2 13912 ALLOCATE Rest_of_control$[LEN(Control$)] 13913 Error_message$="OK" 13914 Setup8340_loop:! 13915 Local=0 13916 Rest_of_control$=Control$ 13917 STATUS @Syn_8340,0;Io_path_exists 13918 IF Io_path_exists<>1 THEN GOTO Not_assigned 13919 STATUS @Syn_8340,1;Select_code 13920 STATUS @Syn_8340,3;Addr 13921 ON TIMEOUT Select_code,5 GOTO Timeout_8340 13922 CALL Synth_index(Addr,Synth_index) 13923 REPEAT 13924 CALL Command_parser(Rest_of_control$,Command$,Value_n_unit$,Last_command) 13925 GOSUB Execute_command 13926 UNTIL Last_command=1 13927 IF NOT Local THEN 13928 GOSUB Chk_8340_status 13929 END IF 13930 Exit_context:! 13931 OFF TIMEOUT Select_code 13932 IF Error_message$<>"OK" THEN 13933 Ok_pos=POS(Error_message$,"OK") 13934 IF Ok_pos THEN 13935 Error_message$=Error_message$[1,Ok_pos-1]&Error_message$[Ok_pos+3] 13936 END IF 13937 Error_message$="Setup_8340 at "&VAL$(Addr)&" "&Error_message$ 13938 END IF 13939 SUBEXIT 13940 Timeout_8340:! 13941 IF POS(Control$,"PRESET")>0 THEN 13942 Msg$="Setup_8340 at "&VAL$(Addr)&" TIMEOUT, FIX AND PRESS CONTINUE" 13943 CALL Tone("ALERT") 13944 CALL Prompt_keys("CONTINUE",Key_pressed$,Msg$) 13945 GOTO Setup8340_loop 13946 ELSE 13947 Error_message$="TIMEOUT" 13948 SIGNAL 0 13949 GOTO Exit_context 13950 END IF 13951 Not_assigned:! 13952 Msg$=" The 8340 has not been assigned to an I/O path. " 13953 GOTO Drop_dead_err 13954 Execute_command:! 13955 SELECT Command$ 13956 CASE "PRESET" 13957 CLEAR @Syn_8340 13958 OUTPUT @Syn_8340;"IP CW55.7MZ PL-110DB RP0" 13959 Disable_8340err$(Synth_index,2)="" 13960 CASE "LOCAL" 13961 LOCAL @Syn_8340 13962 Local=1 13963 CASE "REMOTE" 13964 REMOTE @Syn_8340 13965 CASE "STOW" 13966 OUTPUT @Syn_8340;"RF0 CW26.5GZ PL-90DB PM0" 13967 CASE "EXT AC AM","EXT AM ON","EXT AM" 13968 OUTPUT @Syn_8340;"AM1" 13969 CASE "EXT AC FM MODULATION" 13970 Sep_val_units(Value_n_unit$,Inst_val,Unit$) 13971 OUTPUT @Syn_8340;"FM1";Inst_val;"HZ;" 13972 CASE "FM MODULATION ON" 13973 OUTPUT @Syn_8340;"FM1" 13974 CASE "FM MODULATION OFF" 13975 OUTPUT @Syn_8340;"FM0" 13976 CASE "AM" 13977 CASE "MODULATION ON" 13978 OUTPUT @Syn_8340;"SHPM" 13979 CASE "MODULATION OFF","AM MODULATION OFF","AM OFF" 13980 OUTPUT @Syn_8340;"AM0" 13981 CASE "PULSE MOD INTERNAL ON","PULSE MOD EXTERNAL ON","EXT PULSE MOD" 13982 OUTPUT @Syn_8340;"PM1" 13983 CASE "PULSE MOD OFF" 13984 OUTPUT @Syn_8340;"PM0" 13985 CASE "FREQ","CW FREQ","FREQUENCY" 13986 GOSUB Freq_units 13987 !OUTPUT @Syn_8340;"CW";Inst_val;"HZ" 13988 CALL Source("FREQUENCY",Inst_val) 13989 CASE "SWEPT CW FREQ" 13990 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 13991 GOSUB Freq_units 13992 OUTPUT @Syn_8340;"CW";Inst_val;"HZ,S1" 13993 CASE "START FREQ" 13994 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 13995 GOSUB Freq_units 13996 OUTPUT @Syn_8340;"FA";Inst_val;"HZ" 13997 CASE "STOP FREQ" 13998 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 13999 GOSUB Freq_units 14000 OUTPUT @Syn_8340;"FB";Inst_val;"HZ" 14001 CASE "CENTER FREQ" 14002 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 14003 GOSUB Freq_units 14004 IF Inst_val<1.000005E+7 THEN 14005 Error_message$="FREQ OUT OF RANGE" 14006 GOTO Drop_dead_err 14007 ELSE 14008 OUTPUT @Syn_8340;"CF";Inst_val;"HZ" 14009 END IF 14010 CASE "DELTA FREQ" 14011 GOSUB Delta_f_units 14012 IF Inst_val<100 THEN 14013 Msg$="FREQ OUT OF RANGE" 14014 GOTO Drop_dead_err 14015 ELSE 14016 OUTPUT @Syn_8340;"DF";Inst_val;"HZ" 14017 END IF 14018 CASE "POWER","POWER LEVEL" 14019 GOSUB Power_units 14020 ! OUTPUT @Syn_8340;"PL";Inst_val;"DB" 14021 CALL Source("AMPLITUDE",Inst_val) 14022 CASE "PEAK POWER","PEAK POWER LEVEL" 14023 GOSUB Power_units 14024 OUTPUT @Syn_8340;"RP1 PL";Inst_val;"DB" 14025 CASE "UNCOUPLED ATTEN POWER" 14026 OUTPUT @Syn_8340;"OPAT" 14027 ENTER @Syn_8340;Atten_setting 14028 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 14029 SELECT Unit$ 14030 CASE "dBm" 14031 IF Inst_valAtten_setting+20 THEN 14032 Msg$="UNCOUPLED ATTEN POWER OUT OF RANGE" 14033 GOTO Drop_dead_err 14034 END IF 14035 CASE ELSE 14036 Msg$=Unit$&" IS ILLEGAL POWER UNIT" 14037 GOTO Drop_dead_err 14038 END SELECT 14039 OUTPUT @Syn_8340;"SHPS";-Atten_setting+Inst_val;"DB" 14040 CASE "POWER PEAKING ON" 14041 OUTPUT @Syn_8340;"RP1" 14042 CASE "POWER PEAKING OFF" 14043 OUTPUT @Syn_8340;"RP0" 14044 CASE "POWER OFF","RF OFF" 14045 OUTPUT @Syn_8340;"RF0" 14046 CASE "POWER ON","RF ON" 14047 OUTPUT @Syn_8340;"RF1" 14048 CASE "EXTERNAL LEVELING" 14049 OUTPUT @Syn_8340;"A2" 14050 CASE "INTERNAL LEVELING" 14051 OUTPUT @Syn_8340;"A1" 14052 CASE "METER LEVELING","EXTERNAL POWER METER LEVELING" 14053 OUTPUT @Syn_8340;"A3" 14054 CASE "ALC OFF" 14055 OUTPUT @Syn_8340;"SHA1" 14056 CASE "UNLEVELED POWER" 14057 Msg$=Command$&" IS NOT FUNCTIONAL YET" 14058 GOTO Drop_dead_err 14059 GOSUB Power_units 14060 Disable_8340err$(Synth_index,2)=Disable_8340err$(Synth_index,2)&" UNLEVELED " 14061 OUTPUT @Syn_8340;"SHA3" 14062 CASE "NO LEVELING" 14063 Disable_8340err$(Synth_index,2)=Disable_8340err$(Synth_index,2)&" UNLEVELED " 14064 OUTPUT @Syn_8340;"SHA3" 14065 CASE "DISABLE UNLEVEL ERROR" 14066 Disable_8340err$(Synth_index,2)=Disable_8340err$(Synth_index,2)&" UNLEVELED " 14067 CASE "ENABLE ALL ERRORS" 14068 Disable_8340err$(Synth_index,2)="" 14069 CASE "SWEEP TIME" 14070 GOSUB Time_units 14071 IF Inst_val<.01 OR Inst_val>200 THEN 14072 Msg$="SWEEP TIME OUT OF RANGE" 14073 GOTO Drop_dead_err 14074 ELSE 14075 OUTPUT @Syn_8340;"ST";Inst_val;"SC" 14076 END IF 14077 CASE "SINGLE SWEEP" 14078 OUTPUT @Syn_8340;"S2,RS" 14079 CASE "CONTINUOUS SWEEP","CONTINOUS SWEEP","CONT SWEEP" 14080 OUTPUT @Syn_8340;"S1" 14081 CASE "TAKE SWEEP","ONE SWEEP" 14082 OUTPUT @Syn_8340;"ST;OA" 14083 ENTER @Syn_8340;Sweep_time 14084 IF Sweep_time>20 THEN 14085 OFF TIMEOUT Select_code 14086 ELSE 14087 ON TIMEOUT Select_code,Sweep_time*1.5 GOTO Timeout_8340 14088 END IF 14089 OUTPUT @Syn_8340;"TS" 14090 ON TIMEOUT Select_code,5 GOTO Timeout_8340 14091 CASE "TAKE FREE SWEEP" 14092 OUTPUT @Syn_8340;"ST;OA" 14093 ENTER @Syn_8340;Sweep_time 14094 IF Sweep_time>20 THEN 14095 OFF TIMEOUT Select_code 14096 ELSE 14097 ON TIMEOUT Select_code,Sweep_time*1.5 GOTO Timeout_8340 14098 END IF 14099 OUTPUT @Syn_8340;"S2;CS" 14100 REPEAT 14101 OUTPUT @Syn_8340;"OS" 14102 ENTER @Syn_8340 USING "#,B";Syn_statusbyte1,Syn_statusbyte2 14103 WAIT .1 14104 UNTIL BIT(Syn_statusbyte1,4) 14105 ON TIMEOUT Select_code,5 GOTO Timeout_8340 14106 CASE "ATTEN" 14107 CALL Sep_val_units(Value_n_unit$,Value,Unit$) 14108 IF Unit$<>"dB" THEN 14109 Msg$=Unit$&" IS NOT VALID UNIT FOR ATTENUATION" 14110 GOTO Drop_dead_err 14111 END IF 14112 IF Value<-90 OR Value>0 THEN 14113 Msg$="ATTEN VALUE OF "&VAL$(Value)&" dB IS OUT OF RANGE" 14114 GOTO Drop_dead_err 14115 END IF 14116 IF Value MOD 10 THEN 14117 Msg$="ATTEN VALUE OF "&VAL$(Value)&" dB IS NOT ALLOWED" 14118 GOTO Drop_dead_err 14119 END IF 14120 OUTPUT @Syn_8340;"AT";Value;"DB" 14121 CASE "REFERENCE VOLTAGE" 14122 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 14123 SELECT Unit$ 14124 CASE "dBV" 14125 IF Inst_val<-60 OR Inst_val>6 THEN 14126 Msg$=" REFERENCE VOLTAGE OUT OF RANGE" 14127 GOTO Drop_dead_err 14128 ELSE 14129 OUTPUT @Syn_8340;"PL";Inst_val;"DB" 14130 END IF 14131 CASE ELSE 14132 Msg$=Unit$&" is an illegal REFERENCE VOLTAGE unit" 14133 END SELECT 14134 CASE "UPPER FREQ LIMIT" 14135 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 14136 OUTPUT @Syn_8340;"SHGZ54HZ;SHMZ12HZ;SHKZ22HZ;"&VAL$(Inst_val/1.E+6)&"HZ;EF;" 14137 CASE ELSE 14138 Msg$=Command$&" IS INVALID COMMAND" 14139 GOTO Drop_dead_err 14140 END SELECT 14141 RETURN 14142 Freq_units:! 14143 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 14144 IF Unit$<>"Hz" THEN 14145 Msg$=Unit$&" is an ILLEGAL FREQUENCY UNIT" 14146 GOTO Drop_dead_err 14147 END IF 14148 IF Inst_val<9.9999999999E+6 OR Inst_val>5.00000001E+10 THEN 14149 Msg$="FREQUENCY OUT OF RANGE" 14150 GOTO Drop_dead_err 14151 END IF 14152 RETURN 14153 Delta_f_units:! 14154 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 14155 IF Unit$<>"Hz" THEN 14156 Msg$=Unit$&" is an ILLEGAL FREQUENCY UNIT" 14157 GOTO Drop_dead_err 14158 END IF 14159 IF Inst_val<99 OR Inst_val>5.00000001E+10 THEN 14160 Msg$="FREQUENCY OUT OF RANGE" 14161 GOTO Drop_dead_err 14162 END IF 14163 RETURN 14164 Power_units:! 14165 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 14166 SELECT Unit$ 14167 CASE "dBm" 14168 IF Inst_val<-110 OR Inst_val>20 THEN 14169 Msg$="POWER OUT OF RANGE" 14170 GOTO Drop_dead_err 14171 END IF 14172 CASE ELSE 14173 Msg$=Unit$&" IS ILLEGAL POWER UNIT" 14174 GOTO Drop_dead_err 14175 END SELECT 14176 RETURN 14177 Time_units:! 14178 CALL Sep_val_units(Value_n_unit$,Inst_val,Unit$) 14179 IF Unit$<>"s" AND Unit$<>"sec" THEN 14180 Msg$=Unit$&" IS ILLEGAL TIME UNIT" 14181 GOTO Drop_dead_err 14182 END IF 14183 RETURN 14184 Chk_8340_status:! 14185 Start=TIMEDATE 14186 Loop_count=0 14187 REPEAT 14188 Loop_count=Loop_count+1 14189 No_errors=1 14190 OUTPUT @Syn_8340;"CS OS" 14191 ENTER @Syn_8340 USING "#,B";Syn_statusbyte1,Syn_statusbyte2 14192 IF BIT(Syn_statusbyte2,6) OR BIT(Syn_statusbyte2,4) THEN 14193 No_errors=0 14194 IF BIT(Syn_statusbyte2,6)=1 THEN 14195 OUTPUT @Syn_8340;"SHAK" 14196 END IF 14197 END IF 14198 Et=TIMEDATE-Start 14199 UNTIL (Et>=2 AND Loop_count>1) OR No_errors=1 14200 IF BIT(Syn_statusbyte2,6)=1 THEN 14201 Error_message$="UNLEVELED" 14202 IF POS(Disable_8340err$(Synth_index,2)," UNLEVELED ")>0 THEN 14203 SIGNAL 1 14204 ELSE 14205 SIGNAL 0 14206 END IF 14207 END IF 14208 IF BIT(Syn_statusbyte2,4)=1 THEN 14209 Error_message$="UNLOCKED" 14210 SIGNAL 0 14211 END IF 14212 RETURN 14213 Drop_dead_err:! 14214 DISP "8340 at "&VAL$(Addr)&" "&Msg$&"--This is Setup_8340" 14215 CALL Tone("STOPPED") 14216 PAUSE 14217 STOP 14218 SUBEND 14219 ! 14220 ! 14221 SUB Read_438(Frequency,Parameter$,Units$,@Pm,Value,Error_message$) ! substitution layer 14222 Read_438: REM $Header: Read_438.rh,v 0.0 96/06/26 12:00:00 symm Exp $ 14223 CALL Power_meter("READ",Value) 14224 SUBEND 14225 ! 14226 !