'                       I.F. Rejection
'                       --------------

' version 2.1
'4 may 95

COMMON sgcode$, atten$, sgen$, ch$, ctr$

sgen = VAL(sgcode$)
'sgen = 1
'atten$ = "27"
CLOSE


DIM fr$(15)
DIM fr(15)
DIM imag(15)
DIM im$(15)

SCREEN 9
CLS
COLOR 14, 1

start:
' initial set up of gp-ib

 OPEN "ieeectrl" FOR RANDOM AS #1
 OPEN "ieeedata" FOR RANDOM AS #2
 IOCTL #1, "init" + CHR$(13)
 IOCTL #1, "clear" + CHR$(13)
 IOCTL #1, "to 10 end=13 eos=13" + CHR$(13)

 OPEN "com2:9600,n,8,2" FOR RANDOM AS #3
 OPEN "c:\qb\gpr\res\file" FOR APPEND AS #4

 PRINT #4, "IF. Channel"
 SLEEP 5
 GOTO test

mar:
 IF sgen = 2 THEN RETURN

 COLOR 11
 IOCTL #1, "3" + CHR$(13)
 IOCTL #2, mar$ + CHR$(13)
' PRINT mar$
 RETURN

adret:
  IF sgen = 1 THEN RETURN
  IOCTL #1, "3" + CHR$(13)
  IOCTL #2, adret$ + CHR$(13)
RETURN

at:
COLOR 13
  IOCTL #1, atten$ + CHR$(13)
  IOCTL #2, at$ + CHR$(13)
'  PRINT at$
  SLEEP 1
  RETURN

ip:
COLOR 14
   ip$ = IOCTL$(#2)
'   PRINT ip$
   ip# = VAL((MID$(ip$, s, e)))
   RETURN

freqip:
mar$ = "cfrq?": GOSUB mar
s = 12
e = 14
GOSUB ip
ip# = ip# / 1000000
'PRINT ip#; " MHz"
RETURN

levip:
mar$ = "rflv?": GOSUB mar
s = 22
e = 6
GOSUB ip
u$ = MID$(ip$, 12, 4)
'PRINT ip#; u$
RETURN

freq:
adfr = VAL(fr$)
adfr = adfr * 1000000
adfr$ = STR$(adfr)
adret$ = "F " + adfr$
GOSUB adret

mar$ = "cfrq " + fr$ + " mhz"
GOSUB mar
RETURN

lev:
adret$ = "A " + l$
GOSUB adret
mar$ = "rflv " + l$ + "dbm"
GOSUB mar
RETURN

gpr:
  PRINT #3, gpr$
  INPUT #3, r$
  SLEEP 1

er$ = LEFT$(r$, 1)
IF er$ <> "E" THEN RETURN
IF gpr$ = "REM" THEN RETURN

eror:
BEEP
COLOR 15
PRINT
PRINT "                 Error in GPR code   :    "; gpr$
BEEP
SLEEP
RETURN


test:
at$ = "A 100,": GOSUB at
gpr$ = "REM": GOSUB gpr
mar$ = "*RST": GOSUB mar
mar$ = "imode normal": GOSUB mar
SLEEP 2
mar$ = "rflv:ON": GOSUB mar
mar$ = "mod:off": GOSUB mar
gpr$ = "RD L": GOSUB gpr
gpr$ = "BW 1": GOSUB gpr

gpr$ = "TS 6": GOSUB gpr
gpr$ = "VN": GOSUB gpr

rec$ = LEFT$(r$, 4)

'************************************************************
IF VAL(LEFT$(r$, 5)) = 4305 THEN rec$ = MID$(STR$(4301), 2, 4)
'************************************************************

sn$ = RIGHT$(r$, 4)
fv$ = MID$(r$, 5, 5)
COLOR 15
PRINT "Receiver type         GPR"; rec$
PRINT "Serial no.               "; sn$
COLOR 14
LOCATE 5, 20
PRINT "I. F. Rejection"
PRINT
COLOR 11
PRINT TAB(10); "Frequency"; TAB(24); "I.F."; TAB(36); "Measured"

FOR flp = 1 TO 7
READ fr(flp), ifr(flp)

ifr$(flp) = STR$(ifr(flp))
fr$(flp) = STR$(fr(flp))

NEXT flp


DATA 229.9,301.1,350,130,400,302
DATA 230,301,400,302
DATA 240,300,400,302

  
  IF LEFT$(rec$, 2) = "43" THEN
    slp = 4
    elp = 6
  END IF

  IF rec$ = "4306" THEN
    slp = 6
    elp = 8
  END IF

  IF LEFT$(rec$, 2) = "44" THEN
    slp = 1
    elp = 4
  END IF
  rescol = 13
  res$(3) = "----"

lp = slp
y = 1

DO
  ofs = 0
  sgofs = 0
 
  at$ = "A 100,": GOSUB at
  gpr$ = "BW 1": GOSUB gpr
  mar$ = "rflv:OFF": GOSUB mar

  
  f = VAL(fr$(lp))
  f = f * 1000000
  f& = f
  f$ = STR$(f&)

  gpr$ = "FR " + f$: GOSUB gpr
  SLEEP 10
  gpr$ = "CL": GOSUB gpr
  SLEEP 5

level:
  freq = VAL(fr$(lp))
  fr$ = STR$(freq)
  GOSUB freq
 
  l$ = "-6": GOSUB lev
  mar$ = "rflv:ON": GOSUB mar
  SLEEP 2
  lev = -6

adjust:
  DO
    SLEEP 1
    gpr$ = "SG": GOSUB gpr
 
    adlev! = VAL(r$)
    inlev! = lev - adlev!
   
    IF inlev! <> 0 THEN
      l$ = STR$(inlev!)
      lev = inlev!
      GOSUB lev
    END IF

  LOOP UNTIL adlev! = 0

  fr$ = ifr$(lp)
  GOSUB freq

  at$ = "A 35,": GOSUB at
  SLEEP 2
  gpr$ = "SG": GOSUB gpr
  statt% = VAL(r$)
  at = (35 + statt%) + 4

atts:
  DO
    at = at - 1
    att$ = STR$(at)
    IF at = 0 THEN
      res$ = "> 100"
      rescol = 10
      GOTO result
    END IF
    at$ = "A " + att$ + ",": GOSUB at
   SLEEP 1
    gpr$ = "SG": GOSUB gpr
    r = VAL(r$)
  LOOP UNTIL r > -.5
    dp = r
    res = (100 - at) - r
    res$ = STR$(res)
    rescol = 10
result:
  LOCATE 7 + y, 10
  COLOR 11
  PRINT fr$(lp); " MHz";

  PRINT TAB(24); ifr$(lp); " MHz"
  LOCATE 7 + y, 36
  COLOR rescol
  PRINT res$; " dB"
 
  opf$(y) = fr$(lp)
  opif$(y) = ifr$(lp)
  res$(y) = res$
 
  y = y + 1
  lp = lp + 1
LOOP UNTIL lp = elp

FOR y = 1 TO 3
  PRINT #4, opf$(y)
  PRINT #4, opif$(y)
  PRINT #4, res$(y)
NEXT y
PRINT #4, "IF end"

mar$ = "*RST": GOSUB mar
gpr$ = "BW 1": GOSUB gpr
gpr$ = "LOC": GOSUB gpr
SLEEP 4

CLOSE
IF ctr$ = "1" THEN CHAIN "c:\qb\gpr\conn1"
CHAIN "c:\qb\gpr\menu"

END





