C-----------------------------------------------------------------------------
      SUBROUTINE RVERT    
C-----------------------------------------------------------------------------
C     VERTICAL(CONICAL) RECEIVER SURFACE AT A FIXED RADIUS FROM
C     A SPECIFIED ORIGIN.                                      
C                                                              
C     COMMON DECK "RKAM" INSERTED HERE                         
      implicit double precision (a-h,o-z)
      DOUBLE PRECISION KR,KTH,KPH
      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20)
C     COMMON DECK "RR" INSERTED HERE                            
      DOUBLE PRECISION MODREC
      COMMON/RR/ MODREC(4)                                      
      COMMON/RR/F,PFR,PFRR,PFRTH,PFRPH                          
      COMMON/RR/PFTH,PFPH,PFTHTH,PFPHPH,PFTHPH,FSELECT,FTIME    
C     COMMON DECK "B8" INSERTED HERE                            
      INTEGER RMX,RNTBL,RITBL,RFRMTBL,IDSR(10)                  
      COMMON/B8/RMX,RNTBL(10),RITBL(10),RFRMTBL(10),RGP(10)     
      EQUIVALENCE (RGP,IDSR)                                    
C     COMMON DECK "GAMANG" INSERTED HERE                        
      COMMON/SPHGAM/SINLM0,COSLM0,GPH0,COSPHD,SINTH,COSTH       
      COMMON/SPHGAM/GAMFUN,PGMTH,PGMPH,PGMTHTH,PGMPHPH,PGMTHPH  
      COMMON/WW/ dum(10), MAXW,W(1000)
C     RECEIVER HEIGHT   275-299                                 
      EQUIVALENCE (RVALPH0,W(278)) ,(RVLAMZ,W(279)), (RVPH0,W(280))
      INTEGER RPX    ,RQTBL(10),RLTBL(10),RIRMTBL(10)              
      DATA RPX/1/                
      DATA RQTBL/1,11,8*0/       
      DATA RLTBL/1,9*0/          
      DATA RIRMTBL/1,9*0/        
      ENTRY SETRCV               
      RMX=RPX                    
      CALL IMOVE(RNTBL,RQTBL,10) 
      CALL IMOVE(RITBL,RLTBL,10) 
      CALL IMOVE(RFRMTBL,RIRMTBL,10)   
      RETURN          
C                     
      ENTRY IRECVR    
      IF(W(275) .NE. 3.) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(275) should be 1 if you are using model RVERT.'
      endif

      MODREC(1)=7HRVERT  
      MODREC(2)= w(277)
      SINLMZ=dSIN(RVLAMZ)
      COSLMZ=dCOS(RVLAMZ)
      COSALP=dCOS(RVALPH0)
      RETURN              
C
      ENTRY RECEVER
      SINLM0=SINLMZ
      COSLM0=COSLMZ
      GPH0=RVPH0   
      CALL GAMANG(TH,PH)
      F=GAMFUN-COSALP   
      PFR=0.d0          
      CALL RMOVE(PFTH,PGMTH,5)
C                             
      RETURN                  
      END                     
                                                                                
                                                                                
                                                                                

