The TELEMAC-MASCARET system  trunk
fasp_sp.f
Go to the documentation of this file.
1 ! ******************
2  SUBROUTINE fasp_sp
3 ! ******************
4 !
5  &(xrelv,yrelv,zrelv,np,x,y,z,i)
6 !
7 !***********************************************************************
8 ! BIEF V7P3 15/09/2017
9 !***********************************************************************
10 !
11 !brief INTERPOLATES VALUES FROM A SET OF POINTS ON AN ARTEMIS BOUNDARY NODE.
12 !
13 !history N.DURAND (HRW)
14 !+ 15/09/2017
15 !+ V7P3
16 !+ Adapted from FASP
17 !
18 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
19 !| NP |-->| NUMBER OF TOMAWAC SPECTRA
20 !| XRELV |-->| ABCISSAE OF TOMAWAC SPECTRA
21 !| YRELV |-->| ORDINATES OF TOMAWAC SPECTRA
22 !| ZRELV |-->| VALUES IN TOMAWAC SPECTRA
23 !| I |-->| ARTEMIS BOUNDARY NODE NUMBER
24 !| X,Y |-->| MESH COORDINATES
25 !| Z |<--| INTERPOLATED VALUES
26 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27 !
28  USE declarations_artemis, ONLY : ndir, debug
30  IMPLICIT NONE
31 !
32 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
33 !
34  INTEGER, INTENT(IN) :: NP
35  DOUBLE PRECISION, INTENT(IN) :: X,Y
36  DOUBLE PRECISION, INTENT(IN) :: XRELV(np),YRELV(np)
37  DOUBLE PRECISION, INTENT(IN) :: ZRELV(np,ndir+1)
38  DOUBLE PRECISION, INTENT(OUT) :: Z(ndir+1)
39 !
40 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
41 !
42  INTEGER N,INUM,I,IDIR
43  INTEGER N1,N2,N3,N4
44 !
45  DOUBLE PRECISION DIST1,DIST2,DIST3,DIST4
46  DOUBLE PRECISION ZCADR1,ZCADR2,ZCADR3,ZCADR4
47  DOUBLE PRECISION DIFX,DIFY,DIST,X1,Y1,X2,Y2,X3,Y3,X4,Y4
48  DOUBLE PRECISION ZNUM,ZDEN
49 !
50  LOGICAL OK1,OK2,OK3,OK4
51 !
52 !-----------------------------------------------------------------------
53 !
54 ! INITIALISES:
55 !
56  dist1=1.d12
57  dist2=1.d12
58  dist3=1.d12
59  dist4=1.d12
60 !
61  ok1 = .false.
62  ok2 = .false.
63  ok3 = .false.
64  ok4 = .false.
65 !
66  zcadr1=0.d0
67  zcadr2=0.d0
68  zcadr3=0.d0
69  zcadr4=0.d0
70 !
71  inum = 0
72 !
73 ! LOOP ON THE SET OF TOMAWAC SPECTRA POINTS (THERE ARE NP)
74 ! TO IDENTIFY THOSE CLOSEST TO ARTEMIS LIQUID BOUNDARY NODE :
75 !
76  DO n=1,np
77  difx = xrelv(n)-x
78  dify = yrelv(n)-y
79  dist = difx*difx + dify*dify
80 !
81  IF ( dist.LT.1.d-6 ) dist=1.d-6
82 ! ->QUADRANT 1 :
83  IF( difx.LE.0.d0 .AND. dify.LE.0.d0) THEN
84  IF(dist.LE.dist1)THEN
85  IF(debug.GT.0) x1=xrelv(n)
86  IF(debug.GT.0) y1=yrelv(n)
87  dist1=dist
88  n1=n
89  ok1 = .true.
90  inum = inum + 1
91  ENDIF
92 ! ->QUADRANT 2 :
93  ELSEIF( difx.GE.0.d0 .AND. dify.LE.0.d0) THEN
94  IF(dist.LE.dist2)THEN
95  IF(debug.GT.0) x2=xrelv(n)
96  IF(debug.GT.0) y2=yrelv(n)
97  dist2=dist
98  n2=n
99  ok2 = .true.
100  inum = inum + 1
101  ENDIF
102 ! ->QUADRANT 3 :
103  ELSEIF( difx.GE.0.d0 .AND. dify.GE.0.d0) THEN
104  IF(dist.LE.dist3)THEN
105  IF(debug.GT.0) x3=xrelv(n)
106  IF(debug.GT.0) y3=yrelv(n)
107  dist3=dist
108  n3=n
109  ok3 = .true.
110  inum = inum + 1
111  ENDIF
112 ! ->QUADRANT 4 :
113  ELSEIF( difx.LE.0.d0 .AND. dify.GE.0.d0) THEN
114  IF(dist.LE.dist4)THEN
115  IF(debug.GT.0) x4=xrelv(n)
116  IF(debug.GT.0) y4=yrelv(n)
117  dist4=dist
118  n4=n
119  ok4 = .true.
120  inum = inum + 1
121  ENDIF
122  ENDIF
123  ENDDO ! N=1,NP
124 !
125 ! END OF LOOP ON THE SET OF TOMAWAC SPECTRA POINTS
126 !
127  IF(inum.EQ.0) THEN
128  WRITE(lu,401) i
129  CALL plante(1)
130  stop
131 !
132  ELSE
133 !
134 ! IF(DEBUG.GT.0) WRITE(LU,*) I,INUM,OK1,N1,OK2,N2,OK3,N3,OK4,N4
135 !
136  DO idir = 1,ndir+1
137 !
138  znum = 0.d0
139  zden = 0.d0
140  IF(ok1) THEN
141 ! IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK1'
142  znum = znum + zrelv(n1,idir)/dist1
143  zden = zden + 1.d0/dist1
144  ENDIF
145  IF(ok2) THEN
146 ! IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK2'
147  znum = znum + zrelv(n2,idir)/dist2
148  zden = zden + 1.d0/dist2
149  ENDIF
150  IF(ok3) THEN
151 ! IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK3'
152  znum = znum + zrelv(n3,idir)/dist3
153  zden = zden + 1.d0/dist3
154  ENDIF
155  IF(ok4) THEN
156 ! IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK4'
157  znum = znum + zrelv(n4,idir)/dist4
158  zden = zden + 1.d0/dist4
159  ENDIF
160 !
161  z(idir)=znum/zden
162 ! IF(DEBUG.GT.0) WRITE(LU,*) I,IDIR,Z(IDIR)
163 !
164  ENDDO ! IDIR = 1,500*NDALE
165 !
166  ENDIF
167 !
168 !-----------------------------------------------------------------------
169 !
170 ! PRINTOUT FORMATS:
171 !
172 401 FORMAT(/,1x,'FASDPA_SP : NOT ENOUGH DATA TO INTERPOLATE ',
173  & 'AT ARTEMIS BOUNDARY NODE : ',i7)
174 !
175 !-----------------------------------------------------------------------
176 !
177  RETURN
178  END
subroutine fasp_sp(XRELV, YRELV, ZRELV, NP, X, Y, Z, I)
Definition: fasp_sp.f:7