angl.f

Go to the documentation of this file.

      subroutine angl                                                   
c
c     subroutine angl computes sine and cosine and other trig. quantitie
c     rt calculations                                                   
c***********************************************************************
c.....include common block and declaration statements                   
      implicit real*8 (a-h,o-z)
      include 'common_all.cmn'                                         
c***********************************************************************
c                                                                       
c     write(6,*)'entering subroutine angl'
      do 15 i=1,nx                                                      
      j=nmu-i+1                                                         
      rmu(i)=rx(i)                                                      
      rmu(j)=180.0-rx(i)                                                
 15   continue                                                          
      rmuo=the0in(ksza)
      the0(isza)=rmuo                                                   
c                                                                       
c     write(6,900)isza,rmuo
900   format('isza,rmuo',i5,1pe11.3)                              
       do 9836 i=1,nmu                                                  
 9836  cmu(i) =dcos(rmu(i)*conv)                                        
c                                                                       
       do 9837 i=1,nmum1                                                
       xmu = (rmu(i) + rmu(i+1) )/2.0d0                                 
      the(i)=xmu                                                        
      if(i .gt. jjjj)then
        the(i)=the(nmum1-i+1)                             
      endif
      dddd=dabs(xmu-rmuo)
      if(dddd.le.1.0d-3)then
        amuo = dcos(xmu*conv)
        kkx=i
      endif
       bmu(i) =dcos(xmu*conv)                                           
       bnu(i) =dsin(xmu*conv)                                           
 9837  continue                                                         
c                                                                       
c     write(*,*)'kkx,amuo',kkx,amuo
c     write(*,*),'the',the
       nophip=nophi+1
      do 52 l=1,nophip                                                   
      yy=l                                                              
      phi(l)=(yy-1.0d0)*dphi                                            
      jphi(l)=phi(l)+0.001                                              
c     write(6,*)'l,jphi(l),phi(l)',l,jphi(l),phi(l)
 52   continue                                                          
c     write(6,*)'jpart',jpart
      do 2300 i=1,jpart                                                 
      th=(i-1)*dphi*conv                                                
      cosn(i)=dcos(th)                                                  
      sn(i)=dsin(th)                                                    
 2300 continue                                                          
      do 1100 i = 1,nmum1                                               
      dmus2(i)=(cmu(i)**2-cmu(i+1)**2)/2.d0                             
 1100 dmu(i) = cmu(i) - cmu(i+1)                                        
c                                                                       
      do i=1,nmum1                                                      
c     write(6,151)i,rmu(i),cmu(i),bnu(i),dmu(i),dmus2(i)                
151   format(i3,1x,1p5e11.3)                                            
      enddo                                                             
c     write(6,152)amuo                                                  
152   format('amuo',1pe11.3)                                            
c     write(6,*)'leaving subroutine angl'
      return                                                            
      end                                                               
c**********************************************************************