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

Last change on this file was 899, checked in by adurocher, 5 years ago

trunk : Fixed GCC warnings

Fixed iso c bindings
fixed warnings with -Wall -Wno-aliasing -Wno-unused -Wno-unused-dummy-argument -Wno-maybe-uninitialized -Wno-tabs warnings
Removed all unused variables (-Wunused-variable)
vector%dot_product is now dot_product_3d to avoid compilation warning "dot_product shadows intrinsic" with GCC

File size: 1.3 KB
Line 
1MODULE vector
2  USE genmod
3
4CONTAINS
5
6  FUNCTION Norm(V)
7  IMPLICIT NONE
8    REAL(rstd)            :: Norm
9    REAL(rstd),INTENT(IN) :: V(3)
10   
11    Norm=sqrt(V(1)*V(1)+V(2)*V(2)+V(3)*V(3))
12 
13  END FUNCTION Norm
14 
15  FUNCTION dot_product_3d(V1,V2) result(dot_product)
16  IMPLICIT NONE
17    REAL(rstd)       :: dot_product
18    REAL(rstd),INTENT(IN) :: V1(3)
19    REAL(rstd),INTENT(IN) :: V2(3)
20   
21    dot_product=V1(1)*V2(1)+V1(2)*V2(2)+V1(3)*V2(3)
22   
23   END FUNCTION dot_product_3d
24   
25   FUNCTION cross_product(Va,Vb)
26   IMPLICIT NONE
27     REAL(rstd)     ::cross_product(3)
28     REAL(rstd),INTENT(IN) :: Va(3)
29     REAL(rstd),INTENT(IN) :: Vb(3)
30     REAL(rstd) :: V1(3),V2(3)
31     V1=.5*(Va+Vb)
32     V2=Vb-Va
33     cross_product(1)=V1(2)*V2(3)-V1(3)*V2(2)
34     cross_product(2)=V1(3)*V2(1)-V1(1)*V2(3)
35     cross_product(3)=V1(1)*V2(2)-V1(2)*V2(1)     
36   END FUNCTION cross_product
37
38   SUBROUTINE cross_product2(V1,V2,cross_product_res)
39   IMPLICIT NONE
40     REAL(rstd),INTENT(OUT):: cross_product_res(3)
41     REAL(rstd),INTENT(IN) :: V1(3), V2(3)
42     cross_product_res=cross_product(V1,V2)
43   END SUBROUTINE cross_product2
44
45    FUNCTION arc(lon,lat, lonc,latc)
46      REAL(rstd) :: lon,lat, lonc,latc, arc
47      arc=ACOS(sin(latc)*sin(lat)+cos(latc)*cos(lat)*cos(lon-lonc))
48    END FUNCTION arc
49
50END MODULE vector
Note: See TracBrowser for help on using the repository browser.