dnwalc.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	dnwalc (x, rwl, msr)

Function/Subroutine Documentation

dnwalc()

subroutine dnwalc	(		x,
			rwl,
		integer	msr )

Definition at line 29 of file dnwalc.F.

C-----------------------------------------------                        
C   I m p l i c i t   T y p e s                                         
C-----------------------------------------------                        
#include      "implicit_f.inc"                                          
C-----------------------------------------------                        
C   D u m m y   A r g u m e n t s                                       
C-----------------------------------------------                        
      INTEGER MSR                                                       
      my_real                                                           
     .   x(3,*), rwl(*)                                                 
C-----------------------------------------------                        
C   L o c a l   V a r i a b l e s                                       
C-----------------------------------------------                        
      INTEGER I,J                                                       
      my_real                                                           
     .   xwl, ywl, zwl,xn,yn,zn,d,dx,dy,dz,xl, v1, v2, v3, vv1,         
     .   vv2, vv3, vv,s,c,xx,yy,zz,alpha,x0,y0,z0                       
      REAL R4                                                           
C-----------------------------------------------                        
C                                                                       
       xn =rwl(1)                                                       
       yn =rwl(2)                                                       
       zn =rwl(3)                                                       
      IF(msr==0)THEN                                                  
       xwl=rwl(4)                                                       
       ywl=rwl(5)                                                       
       zwl=rwl(6)                                                       
      ELSE                                                              
       xwl=x(1,msr)                                                     
       ywl=x(2,msr)                                                     
       zwl=x(3,msr)                                                     
      ENDIF                                                             
C                                                                       
      v1 = zero                                                         
      v2 = zep707                                                       
      v3 = zep707                                                       
                                                                        
      vv1 = v2 * zn - v3 * yn                                           
      vv2 = v3 * xn - v1 * zn                                           
      vv3 = v1 * yn - v2 * xn                                           
      vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)                            
      IF(vv<=half)THEN                                              
        v1 = zero                                                       
        v2 = -zep707                                                    
        v3 = zep707                                                     
        vv1 = v2 * zn - v3 * yn                                         
        vv2 = v3 * xn - v1 * zn                                         
        vv3 = v1 * yn - v2 * xn                                         
        vv = sqrt(vv1*vv1 + vv2*vv2 + vv3*vv3)                          
      ENDIF                                                             
      vv1 = vv1/vv                                                      
      vv2 = vv2/vv                                                      
      vv3 = vv3/vv                                                      
      v1 = vv2 * zn - vv3 * yn                                          
      v2 = vv3 * xn - vv1 * zn                                          
      v3 = vv1 * yn - vv2 * xn                                          
C                                                                       
      alpha = zero                                                      
      DO i=1,24                                                         
        s = sin(alpha)                                                  
        c = cos(alpha)                                                  
        xx = vv1 * s + v1 * c                                           
        yy = vv2 * s + v2 * c                                           
        zz = vv3 * s + v3 * c                                           
        d = three1000                                                   
        DO j=1,2                                                        
          CALL write_s_c(nint(xx*d),1)                                  
          CALL write_s_c(nint(yy*d),1)                                  
          CALL write_s_c(nint(zz*d),1)                                  
        ENDDO                                                           
        alpha = alpha + pi*one_over_12                                      
      ENDDO                                                             
C                                                                       
      RETURN