

C-----------------------------------------------------------------------------

      SUBROUTINE SLLOSS   

C-----------------------------------------------------------------------------

C     SLLOSS BACKGROUND ABSORPTION FORMULA

C     Compile with options /c (compile only) and /4Yb (error tracing)



      implicit double precision (a-h,o-z)



      EQUIVALENCE (W(503),ACOEF),(W(504),BCOEF),(W(505),OMEG1) 

      EQUIVALENCE (W(506),OMEG2),(w(6),ow)                     

C     COMMON DECK "LL" INSERTED HERE                           

      DOUBLE PRECISION MODL

      common/ww/ dum(10), maxw,w(1000)

      COMMON/LL/MODL(4),APH,APHPT,APHPR,APHPTH,APHPPH 

C     COMMON DECK "CB17" INSERTED HERE                

      INTEGER VMX,VNTBL,VITBL,VFRMTBL,IDSV(10)        

      COMMON/B17/VMX,VNTBL(10),VITBL(10),VFRMTBL(10),VGP(53)

      EQUIVALENCE (VGP,IDSV),(ANV,VGP(11))                  

      INTEGER VPX    ,VQTBL(10),VLTBL(10),VIRMTBL(10)       

      DATA VPX/1/         

      DATA VQTBL/1,11,8*0/

      DATA VLTBL/1,9*0/   

      DATA VIRMTBL/1,9*0/ 

C                         

      ENTRY SETABS        

      VMX=VPX                       

      CALL IMOVE(VNTBL,VQTBL,10)    

      CALL IMOVE(VITBL,VLTBL,10)    

      CALL IMOVE(VFRMTBL,VIRMTBL,10)

      CALL SETPAB                   

      RETURN                        

C                                   

      ENTRY IABSRP                  

      IF(W(500) .NE. 1.) THEN

           PRINT*,' Model check number mismatch: '

           STOP ' W(500) should be 1 if you are using model SLLOSS.'

      endif



      MODL(1)=8HSLLOSS                             

      MODL(2)= w(502)

      CALL IPABSRP                                 

      RETURN                                       

C                                                  

      ENTRY ABSRP                                  

      OWS=OW*OW                                    

C  NOTE, 18 December 2002.  I suspect that OW below should be the 

C  intrinsic frequency OWI instead of frequency OW.  RMJ

      APH=ACOEF*(OW/OMEG1)*(ow/omeg1)+ BCOEF*OWS/(OMEG2*omeg2+OWS) 

      CALL PABSRP       

      END               

                        

 

