source: codes/icosagcm/trunk/src/sphere/vector.f90 @ 810

MODULE vector
  USE genmod

CONTAINS

  FUNCTION Norm(V)
  IMPLICIT NONE
    REAL(rstd)            :: Norm
    REAL(rstd),INTENT(IN) :: V(3)
    
    Norm=sqrt(V(1)*V(1)+V(2)*V(2)+V(3)*V(3))
  
  END FUNCTION Norm
  
  FUNCTION dot_product(V1,V2)
  IMPLICIT NONE
    REAL(rstd)       :: dot_product
    REAL(rstd),INTENT(IN) :: V1(3)
    REAL(rstd),INTENT(IN) :: V2(3)
    
    dot_product=V1(1)*V2(1)+V1(2)*V2(2)+V1(3)*V2(3)
    
   END FUNCTION dot_product
   
   FUNCTION cross_product(V1,V2)
   IMPLICIT NONE
     REAL(rstd)     ::cross_product(3)
     REAL(rstd),INTENT(IN) :: V1(3)
     REAL(rstd),INTENT(IN) :: V2(3)
     cross_product(1)=V1(2)*V2(3)-V1(3)*V2(2)
     cross_product(2)=V1(3)*V2(1)-V1(1)*V2(3)
     cross_product(3)=V1(1)*V2(2)-V1(2)*V2(1)     
   END FUNCTION cross_product

   SUBROUTINE cross_product2(Va,Vb,cross_product)
   IMPLICIT NONE
     REAL(rstd),INTENT(OUT):: cross_product(3)
     REAL(rstd),INTENT(IN) :: Va(3), Vb(3)
     REAL(rstd) :: V1(3),V2(3)
     V1=.5*(Va+Vb)
     V2=Va-Vb
     cross_product(1)=V1(2)*V2(3)-V1(3)*V2(2)
     cross_product(2)=V1(3)*V2(1)-V1(1)*V2(3)
     cross_product(3)=V1(1)*V2(2)-V1(2)*V2(1)
   END SUBROUTINE cross_product2

    FUNCTION arc(lon,lat, lonc,latc)
      REAL(rstd) :: lon,lat, lonc,latc, arc
      arc=ACOS(sin(latc)*sin(lat)+cos(latc)*cos(lat)*cos(lon-lonc))
    END FUNCTION arc

END MODULE vector