The TELEMAC-MASCARET system  trunk
p_dots.f
Go to the documentation of this file.
1 ! ********************************
2  DOUBLE PRECISION FUNCTION p_dots
3 ! ********************************
4 !
5  &( x , y , mesh )
6 !
7 !***********************************************************************
8 ! BIEF V7P1
9 !***********************************************************************
10 !
11 !brief SAME AS DOTS BUT TAKING PARALLELISM INTO ACCOUNT.
12 !+
13 !+ SCALAR PRODUCT OF TWO OBJECTS, WHICH CAN BE:
14 !+
15 !+ TWO VECTORS STRUCTURES, OR
16 !+
17 !+ TWO VECTOR BLOCKS STRUCTURES OF IDENTICAL NUMBER AND
18 !+ CHARACTERISTICS.
19 !
20 !warning IF THE VECTORS HAVE A SECOND DIMENSION, IT IS IGNORED
21 !+ FOR THE TIME BEING
22 !
23 !history J-M HERVOUET (LNH)
24 !+ 24/04/97
25 !+ V5P1
26 !+ AFTER REINHARD HINKELMANN (HANNOVER UNI.)
27 !
28 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
29 !+ 13/07/2010
30 !+ V6P0
31 !+ Translation of French comments within the FORTRAN sources into
32 !+ English comments
33 !
34 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
35 !+ 21/08/2010
36 !+ V6P0
37 !+ Creation of DOXYGEN tags for automated documentation and
38 !+ cross-referencing of the FORTRAN sources
39 !
40 !history J-M HERVOUET (EDF LAB, LNHE)
41 !+ 10/06/2015
42 !+ V7P1
43 !+ Moving from double precisiion FAC to integer IFAC.
44 !
45 
46 !history R.NHEILI (Univerte de Perpignan, DALI)
47 !+ 24/02/2016
48 !+ V7P3
49 !+ ADD MODASS=3
50 !
51 !history J,RIEHME (ADJOINTWARE)
52 !+ November 2016
53 !+ V7P2
54 !+ Replaced EXTERNAL statements to parallel functions / subroutines
55 !+ by the INTERFACE_PARALLEL
56 !
57 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58 !| MESH |-->| MESH STRUCTURE
59 !| X |-->| BIEF_OBJ STRUCTURE (MAY BE A BLOCK)
60 !| Y |-->| BIEF_OBJ STRUCTURE (MAY BE A BLOCK)
61 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
62 !
63  USE bief, ex_p_dots => p_dots
64  USE declarations_telemac, ONLY : modass
65 !
68  IMPLICIT NONE
69 !
70 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
71 !
72  TYPE(bief_mesh), INTENT(IN) :: MESH
73  TYPE(bief_obj), INTENT(IN) :: X,Y
74 !
75 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
76 !
77  INTEGER NPX,IBL,TYPX
78  DOUBLE PRECISION PAIR(2),P_ERR
79 !
80 !-----------------------------------------------------------------------
81 !
82  typx = x%TYPE
83 !
84 !-----------------------------------------------------------------------
85 !
86 ! CASE WHERE THE STRUCTURES ARE BLOCKS
87 !
88  pair=0.d0
89  IF(typx.EQ.4) THEN
90 !
91  p_dots = 0.d0
92  p_err = 0.d0
93 !
94  IF(ncsize.LE.1.OR.nptir.EQ.0) THEN
95  IF (modass .EQ. 1) THEN
96  DO ibl = 1 , x%N
97  p_dots=p_dots+dot(x%ADR(ibl)%P%DIM1,x%ADR(ibl)%P%R,
98  & y%ADR(ibl)%P%R)
99  ENDDO
100  ELSEIF (modass .EQ. 3) THEN
101  DO ibl = 1 , x%N
102  p_dots=p_dots+dot_comp(x%ADR(ibl)%P%DIM1,x%ADR(ibl)%P%R,
103  & y%ADR(ibl)%P%R)
104  ENDDO
105  ENDIF
106 
107  ELSE
108  IF (modass .EQ. 1) THEN
109  DO ibl = 1 , x%N
110  p_dots=p_dots+p_dot(x%ADR(ibl)%P%DIM1,x%ADR(ibl)%P%R,
111  & y%ADR(ibl)%P%R,
112  & mesh%IFAC%I)
113  ENDDO
114  ELSEIF (modass .EQ. 3) THEN
115  DO ibl = 1 , x%N
116  CALL p_dotpair(x%ADR(ibl)%P%DIM1,x%ADR(ibl)%P%R,
117  & y%ADR(ibl)%P%R,
118  & mesh%IFAC%I,pair)
119  p_dots=p_dots+pair(1)
120  p_err=pair(2)
121  ENDDO
122  ENDIF
123  ENDIF
124 !
125 !-----------------------------------------------------------------------
126 !
127 ! CASE WHERE THE STRUCTURES ARE NOT BLOCKS
128 ! (ASSUMES THAT Y HAS THE SAME TYPE AS X)
129 !
130  ELSEIF(typx.EQ.2) THEN
131 !
132  npx = x%DIM1
133 !
134  IF(y%DIM1.NE.npx) THEN
135  WRITE(lu,60) x%NAME,x%TYPE
136  WRITE(lu,61) y%NAME,y%TYPE
137  WRITE(lu,62) x%DIM1,y%DIM1
138 62 FORMAT(1x,'DIFFERENT SIZES: ',1i6,' AND ',1i6)
139  CALL plante(1)
140  stop
141  ENDIF
142 !
143  IF (modass .EQ. 1) THEN
144  IF(ncsize.LE.1.OR.nptir.EQ.0) THEN
145  p_dots=dot(npx,x%R,y%R)
146  ELSE
147  p_dots=p_dot(npx,x%R,y%R,mesh%IFAC%I)
148  ENDIF
149  ELSEIF (modass .EQ. 3) THEN
150  IF(ncsize.LE.1.OR.nptir.EQ.0) THEN
151  p_dots=dot_comp(npx,x%R,y%R)
152  ELSE
153  CALL p_dotpair(npx,x%R,y%R,mesh%IFAC%I,pair)
154  p_dots=pair(1)
155  p_err=pair(2)
156  ENDIF
157  ENDIF
158 
159 !
160 !-----------------------------------------------------------------------
161 !
162 ! ERROR
163 !
164  ELSE
165 !
166  WRITE(lu,60) x%NAME,x%TYPE
167  WRITE(lu,61) y%NAME,y%TYPE
168  WRITE(lu,63)
169 60 FORMAT(1x,'P_DOTS (BIEF) : NAME OF X : ',a6,' TYPE : ',1i6)
170 61 FORMAT(1x,' NAME OF Y : ',a6,' TYPE : ',1i6)
171 63 FORMAT(1x,' NOT IMPLEMENTED')
172  CALL plante(1)
173  stop
174 !
175  ENDIF
176 !
177 !-----------------------------------------------------------------------
178 !
179 ! FINAL SUM ON ALL THE SUB-DOMAINS
180 !
181  IF (modass .EQ. 1) THEN
182  IF(ncsize.GT.1) p_dots = p_sum(p_dots)
183  ELSEIF (modass .EQ. 3) THEN
184  IF(ncsize.GT.1) p_dots = p_dsumerr(pair)
185  ENDIF
186 !
187 !-----------------------------------------------------------------------
188 !
189  RETURN
190  END
191 
double precision function dot(NPOIN, X, Y)
Definition: dot.f:7
double precision function p_dot(NPOIN, X, Y, IFAC)
Definition: p_dot.f:7
double precision function p_dsumerr(PARTIAL)
Definition: p_dsumerr.F:7
double precision function p_dots(X, Y, MESH)
Definition: p_dots.f:7
subroutine p_dotpair(NPOIN, X, Y, IFAC, PAIR)
Definition: p_dotpair.f:7
Definition: bief.f:3
double precision function dot_comp(NPOIN, X, Y)
Definition: dot_comp.f:7