[updated 14.Dec.1995]
Librairie-d'application appl_rw3d > Fichier green.f |
subroutine green (tabcsg,cop1,com1,g,nr,tabass,mctabg,eta)
com : coordonees de M
cop : coordonees de P
g : valeur,derivee x,derivee y,derivee z
nr : numro de region pour interpollation
TABASS doit etre initialise a zero
a partir de nta0+1
structure de tabass :
nta0 +1 valeur minimale rencontree de x
2 valeur minimale rencontree de y
3 valeur minimale rencontree de z
4 valeur maximale rencontree de x
5 valeur maximale rencontree de y
6 valeur maximale rencontree de z
7 nombre de depassements en x
8 nombre de depassements en y
9 nombre de depassements en z
10 vague lointaine :
| ---------------
| nombre de pts calcules par methode i-10
| 0 : pas de calcul
| 1 : serie convergente
| 2 : serie asymptotique
| 3 : romberg
14 4 : majoration
21 vague proche :
| ------------
24 nombre de pts de chaque region i-20
parameter (nta0=3)
real cox(3),wg(6),ng(4),g(*),glap(4),coa(3)
real com1(3),cop1(3)
real coxmax(3)
complex tabass
real tabcsg
dimension tabcsg (*)
dimension tabass (*)
complex zero
dimension temps(2)
common/time/tentot(2)
common/numa/nbapg
test fonction de green rapide
if(.false.) then
gsu2 =tabcsg(1)
x=(cop1(1)-com1(1)) *gsu2
y=(cop1(2)-com1(2)) *gsu2
z=(cop1(3)-com1(3)) *gsu2
r=sqrt(x*x+y*y+z*z)
g(1)=r
g(2)=r
g(3)=r
g(4)=r
return
endif
C
C
c INCLUDE 'OVERFLOW'
C
c ROYAL1(1) = COM1(1)
c ROYAL1(2) = COM1(2)
c ROYAL1(3) = COM1(3)
c ROYAL2(1) = COP1(1)
c ROYAL2(2) = COP1(2)
c ROYAL2(3) = COP1(3)
C
! call dtime(temps)
nbapg=nbapg+1
usqpi=.0795774715459
coxmax(1)=100
coxmax(2)=15
coxmax(3)=0.2
zero=cmplx(0,0)
un=cmplx(1,0)
gsu2 =tabcsg(1)
x= (cop1(1)-com1(1)) *gsu2
y= (cop1(2)-com1(2)) *gsu2
z=-abs((cop1(3)+com1(3)))*gsu2
cox(1) = x
cox(2) = y
cox(3) = z
do 1 i=1,2
if(abs(cox(i)).gt.coxmax(i)) then
tabass(nta0+6+i)= tabass(nta0+6+i)+un
if (tabass(nta0+6+i).eq.un) then
write(6,*) '*Fonction de Green* '//
* ': Valeur de M-P hors limites :'
write(6,*) ' ',cox(1),cox(2),cox(3)
endif
endif
1 continue
i=3
if(abs(cox(i)).lt.coxmax(i)) then
tabass(nta0+6+i)= tabass(nta0+6+i)+un
if (tabass(nta0+6+i).eq.un) then
write(6,*) '*Fonction de Green* '//
* ': Valeur de M-P hors limites :'
write(6,*) ' ',cox(1),cox(2),cox(3)
call baise('Augmentez la profondeur ou '
* //'diminuez la vitesse')
endif
endif
statistiques sur min et max des arguments
-----------------------------------------
tabass(nta0+1)=cmplx(min(real(tabass(nta0+1)),x))
tabass(nta0+2)=cmplx(min(real(tabass(nta0+2)),y))
tabass(nta0+3)=cmplx(min(real(tabass(nta0+3)),z))
tabass(nta0+4)=cmplx(max(real(tabass(nta0+4)),x))
tabass(nta0+5)=cmplx(max(real(tabass(nta0+5)),y))
tabass(nta0+6)=cmplx(max(real(tabass(nta0+6)),z))
solution elementaire du laplacien
---------------------------------
c ITYPE = 1
call glaplg(com1,cop1,glap)
vague proche
------------
coa(1)=abs(cox(1))
coa(2)=abs(cox(2))
coa(3)=-abs(cox(3))
c ITYPE = 2
call eltq2d (coa,ng,nr,mctabg)
if (cox(1).le.0) ng(2)=-ng(2)
if (cox(2).gt.0) ng(3)=-ng(3)
m=20+nr
tabass(nta0+m)=tabass(nta0+m)+un
vague lointaine
---------------
c ITYPE = 3
call gwd (cox,wg,met,eta)
m=10+met/10
tabass(nta0+m)=tabass(nta0+m)+un
if (cox(2).gt.0) wg(3)=-wg(3)
g2su4=gsu2*gsu2
g(1)=(glap(1)+(+2*gsu2 *ng(1)+gsu2 *wg(1)))*usqpi
g(2)=(glap(2)+(+2*g2su4*ng(2)+g2su4*wg(2)))*usqpi
g(3)=(glap(3)+(-2*g2su4*ng(3)-g2su4*wg(3)))*usqpi
g(4)=(glap(4)+(+2*g2su4*ng(4)+g2su4*wg(4)))*usqpi
111 format (3f12.5)
print111,cox(1),cox(2),cox(3)
! call dtime(temps)
tentot(1)=tentot(1)+temps(1)
tentot(2)=tentot(2)+temps(2)
end
green est appelé dans (56 procédures)