The TELEMAC-MASCARET system  trunk
disimp_gaia.f
Go to the documentation of this file.
1 ! **********************
2  SUBROUTINE disimp_gaia
3 ! **********************
4 !
5  &(q,q2bor,numliq,ifrliq,nsoldis,work1,qbor,nptfr,mask,mesh)
6 !
7 !***********************************************************************
8 ! GAIA
9 !***********************************************************************
10 !
14 !
15 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
28 !
29  USE bief
30 !
32  USE interface_parallel, ONLY : p_sum
33  IMPLICIT NONE
34 !
35 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
36 !
37  INTEGER, INTENT(IN) :: NPTFR,IFRLIQ,NSOLDIS
38  INTEGER, INTENT(IN) :: NUMLIQ(nptfr)
39  DOUBLE PRECISION, INTENT(IN) :: MASK(nptfr),Q
40  TYPE(bief_mesh), INTENT(INOUT) :: MESH
41  TYPE(bief_obj), INTENT(INOUT) :: WORK1,QBOR
42  TYPE(bief_obj), INTENT(IN) :: Q2BOR
43 !
44 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
45 !
46  INTEGER K,IELM,IELEB
47 !
48  DOUBLE PRECISION Q1
49 !
50  INTRINSIC abs
51 !
52 !=======================================================================
53 ! COMPUTES FLUX
54 !=======================================================================
55 !
56 ! IN THE FOLLOWING LOOP ONE RESTRICTS THE MASK OF DIRICHLETS SEGMENTS
57 ! TO THOSE OF THE LIQUID BOUNDARY NUMBER IFRLIQ. AS NUMLIQ IS
58 ! DEFINED AT NODES, ONE RISKS AN ERROR FOR THE SEGMENT FOLLOWING
59 ! THE LAST NODE ON THE BOUNDARY. IN FACT THIS SEGMENT WILL BE SOLID
60 ! AND WILL HAVE A MASK ALREADY SET TO ZERO.
61 !
62  CALL os( 'X=0 ' , x=work1 )
63 !
64  DO ieleb=1,mesh%NELEB
65  k=mesh%IKLBOR%I(ieleb)
66  IF(numliq(k).EQ.ifrliq) work1%R(ieleb)=mask(ieleb)
67  ENDDO
68 !
69 ! Q2BOR IS INTEGRATED ALONG THE BOUNDARY
70 !
71  ielm=11
72  CALL vector(qbor,'=','MASVEC ',ielbor(ielm,1),
73 ! USED VOID VOID VOID VOID VOID
74  & 1.d0,q2bor,q2bor,q2bor,q2bor,q2bor,q2bor,
75  & mesh,.true.,work1)
76 !
77 !=======================================================================
78 ! FINAL QBOR IF Q2BOR ONLY A PROFILE
79 !=======================================================================
80 !
81  IF(nsoldis.GE.ifrliq) THEN
82 !
83 ! A VALUE OF DISCHARGE HAS BEEN GIVEN IN THE PARAMETER FILE
84 ! FOR THIS BOUNDARY. Q2BOR IS CONSIDERED AS ONLY A PROFILE
85 !
86 ! FOR THE USER: POSITIVE DISCHARGE = ENTERING
87  q1 = bief_sum(qbor)
88  IF(ncsize.GT.1) q1 = p_sum(q1)
89 !
90  IF(abs(q1).LT.1.d-10) THEN
91 ! ZERO FLUX: WARNING MESSAGE
92  IF(abs(q).GT.1.d-10) THEN
93  WRITE(lu,31) ifrliq
94 31 FORMAT(1x,'DISIMP_GAIA : PROBLEM ON BOUNDARY NUMBER ',1i6,/,
95  & 1x,
96  & ' GIVE A SOLID DISCHARGE PROFILE ',/,1x,
97  & ' IN THE BOUNDARY CONDITIONS FILE')
98  CALL plante(1)
99  stop
100  ELSE
101  q1 = 1.d0
102  ENDIF
103  ENDIF
104 !
105  DO k=1,nptfr
106  IF(numliq(k).EQ.ifrliq) THEN
107  qbor%R(k) = qbor%R(k) * q / q1
108  ENDIF
109  ENDDO
110 !
111  ENDIF
112 !
113 !-----------------------------------------------------------------------
114 !
115  RETURN
116  END
integer function ielbor(IELM, I)
Definition: ielbor.f:7
subroutine vector(VEC, OP, FORMUL, IELM1, XMUL, F, G, H, U, V, W, MESH, MSK, MASKEL, LEGO, ASSPAR)
Definition: vector.f:7
double precision function bief_sum(X)
Definition: bief_sum.f:7
subroutine disimp_gaia(Q, Q2BOR, NUMLIQ, IFRLIQ, NSOLDIS, WORK1, QBOR, NPTFR, MASK, MESH)
Definition: disimp_gaia.f:7
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
double precision function q(I)
Definition: q.f:7
Definition: bief.f:3