calculatearea.F [SRC] [CPP] [JOB] [SCAN] TOOLS / PREDATAS / GENERIC

```   1 | include(dom.inc)
2 |       SUBROUTINE calculatearea(nb_nodes, nodelist, area)
3 |
4 | !       ================================================================!
5 | !                                                                       !
6 | !       calculatearea.F : Calculates the surface of any kind of face    !
7 | !                                                                       !
8 | !       in              : The number of nodes of the face 'nb_nodes'    !
9 | !                         The id list of the nodes                      !
10 | !       out             : The face's surface value 'area'               !
11 | !                                                                       !
12 | !       author          : J. AMAYA (avril 2007)                         !
13 | !                                                                       !
14 | !       ================================================================!
15 |
16 |         USE datas
17 |         IMPLICIT NONE
18 |
19 | !       IN
20 |         DOM_INT           :: nb_nodes
21 |         DOM_INT, DIMENSION(nb_nodes) :: nodelist
22 |
23 | !       OUT
24 |         DOM_REAL  :: area
25 |
26 | !       LOCAL
27 |         DOM_REAL  :: s, a, b, c, a1, a2
28 |         DOM_REAL  :: x1, y1, z1, x2, y2, z2, x3, y3, z3
29 |         DOM_INT           :: ierr
30 |
31 | !       -------------------!
32 | !       For the edge in 2D !
33 | !       -------------------!
34 |         IF (nb_nodes.eq.2) THEN
35 |           x1 = node_list(1, nodelist(1))
36 |           y1 = node_list(2, nodelist(1))
37 |
38 |           x2 = node_list(1, nodelist(2))
39 |           y2 = node_list(2, nodelist(2))
40 |
41 |           a = x2 - x1
42 |           b = y2 - y1
43 |
44 |           area = SQRT( a*a + b*b )
45 | !       -------------------!
46 | !       For the triangle : !
47 | !       -------------------!
48 |         ELSE IF (nb_nodes.eq.3) THEN
49 |
50 |           x1 = node_list(1, nodelist(1))
51 |           y1 = node_list(2, nodelist(1))
52 |           z1 = node_list(3, nodelist(1))
53 |
54 |           x2 = node_list(1, nodelist(2))
55 |           y2 = node_list(2, nodelist(2))
56 |           z2 = node_list(3, nodelist(2))
57 |
58 |           x3 = node_list(1, nodelist(3))
59 |           y3 = node_list(2, nodelist(3))
60 |           z3 = node_list(3, nodelist(3))
61 |
62 |           a=SQRT((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
63 |           b=SQRT((x3-x2)*(x3-x2)+(y3-y2)*(y3-y2)+(z3-z2)*(z3-z2))
64 |           c=SQRT((x1-x3)*(x1-x3)+(y1-y3)*(y1-y3)+(z1-z3)*(z1-z3))
65 |
66 |           s = (a + b + c) / 2
67 |           area = SQRT(s*(s-a)*(s-b)*(s-c))
68 |
69 | !       ----------------!
70 | !       For the square: !
71 | !       ----------------!
72 |         ELSE
73 |
74 |           x1 = node_list(1, nodelist(1))
75 |           y1 = node_list(2, nodelist(1))
76 |           z1 = node_list(3, nodelist(1))
77 |
78 |           x2 = node_list(1, nodelist(2))
79 |           y2 = node_list(2, nodelist(2))
80 |           z2 = node_list(3, nodelist(2))
81 |
82 |           x3 = node_list(1, nodelist(3))
83 |           y3 = node_list(2, nodelist(3))
84 |           z3 = node_list(3, nodelist(3))
85 |
86 |           a=SQRT((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
87 |           b=SQRT((x3-x2)*(x3-x2)+(y3-y2)*(y3-y2)+(z3-z2)*(z3-z2))
88 |           c=SQRT((x1-x3)*(x1-x3)+(y1-y3)*(y1-y3)+(z1-z3)*(z1-z3))
89 |
90 |           s = (a + b + c) / 2
91 |           a1 = SQRT(s*(s-a)*(s-b)*(s-c))
92 |
93 |           x2 = node_list(1, nodelist(4))
94 |           y2 = node_list(2, nodelist(4))
95 |           z2 = node_list(3, nodelist(4))
96 |
97 |           a=SQRT((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)+(z2-z1)*(z2-z1))
98 |           b=SQRT((x3-x2)*(x3-x2)+(y3-y2)*(y3-y2)+(z3-z2)*(z3-z2))
99 |
100 |           s = (a + b + c) / 2
101 |           a2 = SQRT(s*(s-a)*(s-b)*(s-c))
102 |
103 |           area = a1 + a2
104 |
105 |         ENDIF
106 |
107 |       END SUBROUTINE calculatearea
```

calculatearea.F could be called by:
 addface.F [TOOLS/PREDATAS/DATAS] - 126 Makefile [TOOLS/PREDATAS] - 80