FTN77
$files 0,1
      Program MOON (1,10)
C     ============
C
C     Make a map of the moon using the pc control system.
C
      Implicit None
      Character*166 reply
      Character*1 junk
      Integer Lbuf(500), HPIBLU, AntennaLU,
     *        FeedSys, Nscan, i
      Real ScanRate, Width, A0moon, Parallax,
     *     B0moon, FracDay, MJD, Size, Tmax,
     *     a0, a1, a2, a3, a4, a5, b0, b1, b2, b3, b4, b5,
     *     p0, p1, p2, p3, p4
      Data AntennaLU /39/
C
      Call LGBUF (Lbuf,250)
      Call FSYSU (1,1)
      Print *, '                        Moon Mapping Program'
      Print *, '                        ####################'
      Print *, ' '
      Print *, 'Enter RA coefficients (deg): _'
      Read *, a0, a1, a2, a3, a4, a5
      Print *, 'Enter DEC coefficients : _'
      Read *, b0, b1, b2, b3, b4, b5
      Print *, 'Enter Parallax coefficients: _'
      Read *, p0, p1, p2, p3, p4
      Print *, 'Enter Feed System (1-8): _'
      Read *, FeedSys
      Print *, 'Enter size of area (deg): _'
      Read *, Size
      Print *, 'Enter Scan Spacing (deg): _'
      Read *, Width
      Print *, 'Enter Scan Rate (deg/sec): _'
      Read *, ScanRate
      Nscan = (Nint(Size / Width) / 2) * 2 + 1
      Size = Width * (Nscan - 1)
      Read (AntennaLU,'(27x,f13.6)') MJD
      Call UNLT
      FracDay = Amod (MJD,1.0)
      A0moon = ((((a5*FracDay+a4)*FracDay+a3)*FracDay+a2)*FracDay+
     *             a1)*FracDay+a0
      B0moon = ((((b5*FracDay+b4)*FracDay+b3)*FracDay+b2)*FracDay+
     *             b1)*FracDay+b0
      Parallax = (((p4*FracDay+p3)*FracDay+p2)*FracDay+p1)*FracDay+p0
      Write (AntennaLU,'(a)') 'Begin FindMoon'
      Write (AntennaLU,'(a)') 'Clear_Fifo'
      Write (AntennaLU,'(a)') 'Duration 900'
      Write (AntennaLU,'(a)') 'Coordinate_System APPARENT'
      Write (AntennaLU,'(a,f7.3)') 'Parallax ', Parallax
      Write (AntennaLU,'(a)') 'Pointing On'
      Write (AntennaLU,'(a,i2)') 'Feed_System ', FeedSys
      Write (AntennaLU,'(a)') 'A0 0.0'
      Write (AntennaLU,'(a)') 'A1 0.0'
      Write (AntennaLU,'(a)') 'B0 0.0'
      Write (AntennaLU,'(a)') 'B1 0.0'
      Write (AntennaLU,'(a,f7.3)') 'Psi ', A0moon
      Write (AntennaLU,'(a,f7.3)') 'Phi ', -B0moon
      Write (AntennaLU,'(a)') 'Theta 0.0'
      Write (AntennaLU,'(a)') 'End'
      Call UNLT
      Print*, 'Driving to Moon .....'
1     Read (AntennaLU,'(a)') Reply
      Call UNLT
      call exec (12,0,2,0,-1)
      if (reply(1:1) .gt. '0') goto 1
      Print *, 'Tracking Moon, adjust radiometer attenuation'
      Print *, 'Press RETURN when ready: _'
      Read (1,'(a)') junk
      Read (35,*) Tmax
      Write (31,'("sp 1;pu;pa 4000,10000")')
      Write (31,'("si 1.5,1.5;lb The MOON",a)') Char(3)
      Write (31,'("sp 0;")')
      Open (file='MONDAT::15', UNIT=20,STATUS='UNKNOWN')
      Do i = -(Nscan/2) , +(Nscan/2)
        Read (AntennaLU,'(27x,f13.6)') MJD
        Call UNLT
        FracDay = Amod(MJD,1.0)
        A0moon = ((((a5*FracDay+a4)*FracDay+a3)*FracDay+a2)*FracDay+
     *             a1)*FracDay+a0
        B0moon = ((((b5*FracDay+b4)*FracDay+b3)*FracDay+b2)*FracDay+
     *             b1)*FracDay+b0
        Parallax = (((p4*FracDay+p3)*FracDay+p2)*FracDay+p1)*FracDay+p0
        Write (AntennaLU,'(a,i2.2)') 'Begin Start', i + Nscan/2 + 1
        Write (AntennaLU,'(a)') 'Duration 200'
        Write (AntennaLU,'(a,f7.3)') 'Parallax ', Parallax
        Write (AntennaLU,'(a,f7.3)') 'Psi ', A0moon
        Write (AntennaLU,'(a,f7.3)') 'Phi ', -B0moon
        Write (AntennaLU,'(a,f7.3)') 'A0 ', Width*i
        Write (AntennaLU,'(a,f7.3)') 'B0 ', (-1)**(i+Nscan) * Size / 2.0
        Write (antennaLU,'(a)') 'B1 0.0'
        Write (AntennaLU,'(a)') 'End'
        Call UNLT
        Print *,'Driving to start of scan',i+Nscan/2+1
2       Read (AntennaLU,'(a)') Reply
        Call UNLT
        call exec (12,0,2,0,-1)
        If (Reply(1:1) .gt. '0') goto 2
        Write (AntennaLU,'(a,i2.2)') 'Begin Moon', i + Nscan/2 + 1
        Write (AntennaLU,'(a,f8.3)') 'Duration ', Size / ScanRate
        Write (AntennaLU,'(a,f7.3)') 'B1 ', ScanRate*(-1)**(i+Nscan+1)
        Write (AntennaLU,'(a)') 'End'
        Call UNLT
        Print *,'Doing scan', i+Nscan/2+1
        Call PlotScan (AntennaLU, i, Nscan, Size, Tmax)
      End Do
      Print *, '#########################'
      Print *, '#  MOON scans finished  #'
      Print *, '#########################'
      End
      Subroutine PlotScan (LU, Iscan, Nscan, Size, Tmax)
C     ===================
C
      Integer Count(51)
      Real Y(200), Z(200), Out(51)
      DATA Plu /31/
      Read (LU,'(i1,1x,148x,2f8.3)') Istat, X, YY
      Call UNLT
      Read (35,*) DVM
      Base = DVM
      Write (Plu,'("pu;")')
      If (Iscan .lt. 0) Write (Plu,'("sp 1;")')
      If (Iscan .eq. 0) Write (Plu,'("sp 2;")')
      If (Iscan .gt. 0) Write (Plu,'("sp 3;")')
      Isam = 0
1       Isam = Isam + 1
        Y(Isam) = YY
        Z(Isam) = (DVM - Base)/(Tmax - Base)
        Write (Plu,'("pa ",i6,",",i6,";")')
     *        Nint((YY+Size/2)/Size*10000+3000),
     *        Nint(Z(Isam)*6000) + (Iscan+Nscan/2)*150 +
     *        500
        Write (Plu,'("pd;")')
        Read (LU,'(i1,1x,148x,2f8.3)') Istat, X, YY
        Call UNLT
        Read (35,*) DVM
        If (Istat .lt. 2) goto 1
      Write (Plu,'("pu;")')
      Write (Plu,'("sp 0;")')
      Do i = 1 , Nscan
        Count(i) = 0
        Out(i) = 0.0
      End Do
      Do i = 1 , Isam
        ii = Nint ((Size/2.0 + Y(i)) / Size * Nscan)
        ii = Min ( Max ( ii , 1 ) , Nscan )
        Count(ii) = Count(ii) + 1
        Out(ii) = Out(ii) + Z(i)
      End Do
      Do i = 1 , Nscan
        Count(i) = Max ( Count(i) , 1 )
        Out(i) = Out(i) / Count(i)
      End Do
      Write (20,'(8F10.5)') (Out(i) , i = 1 , Nscan)
      End
      Subroutine UNLT
C     ===============
C
      Integer Cmd(2)
      DATA Cmd /2, 2H_?/
      Call CMDR (30,Cmd,0)
      End