[updated 15.Dec.2000]

Qui appelle glap3c ?

      SUBROUTINE  GLAP3C (NOYO,CORM,CORP,R,E,D1EM,D1EP,D2EMP)

  Auteur : D.Martin (Octobre 1989)  
  Derniere modification : D.Martin (15 Decembre 2000)
  Version 1.0.0
 
  Solution elementaire au point 'M' du Laplacien dans R3 :
 
                    E = [-1/4Pi] 1/R, avec R = || MP ||
 
  Attention : On travaille des arguments complexes !!!!!
 
  Attention : La multiplication par -1./4*PI n'est pas effectuee dans ce s-p.
 
 -- Arguments d'entree --
  NOYO  = 'D' (Dirichlet), 'N' ou 'F' (Neumann ou Fourier)
        'D' implique le calcul du noyau et des derivees 1eres
        'N' ou 'F'      calcul du noyau, des derivees 1eres et 2ndes croisees
  CORM  coordonnees du point source
  CORP  coordonnees du point image
 -- Arguments de sortie --
  R     distance des 2 points M et P
  E     = 1/R
  D1EM  dE/dxm, dE/dym, dE/dzm
  D1EP  dE/dxp, dE/dyp, dE/dzp
  D2EMP derivees secondes croisees dans l'ordre suivant  
          d2E/dxmdxp, d2E/dxmdyp, d2E/dxmdzp
          d2E/dymdxp, d2E/dymdyp, d2E/dymdzp
          d2E/dzmdxp, d2E/dzmdyp, d2E/dzmdzp

      CHARACTER*(*) NOYO
      REAL          R,CORP(*),CORM(*)
      COMPLEX       E,D1EP(*),D1EM(*),D2EMP(*)
 
      INTEGER       NDIM,IDIM,JDIM,IRANG
      PARAMETER    ( NDIM = 3)
      REAL          TRSUR5,UNSUR,UNSUR2,UNSUR3,X,XM(NDIM),XMSRN

      R=0. 
      DO 1 IDIM=1,NDIM
         X=CORP(IDIM)-CORM(IDIM)
         R=R+X*X
         XM(IDIM)=X
1     CONTINUE
      IF (R.LT.1.E-06)  GOTO 99999
 
      R     = SQRT(R)  
      UNSUR = 1./R
      E     = E + UNSUR
      UNSUR2=UNSUR*UNSUR
      UNSUR3=UNSUR2*UNSUR
 
      Derivees premieres
 
      DO 2 IDIM=1,NDIM
         X         =XM(IDIM)
         XMSRN     =X*UNSUR3
         D1EP(IDIM)=D1EP(IDIM)-XMSRN
         D1EM(IDIM)=D1EM(IDIM)+XMSRN
2     CONTINUE
 
      IF (NOYO(1:1).NE.'D') THEN
 
         Derivees secondes croisees
 
         TRSUR5=-3.*UNSUR3*UNSUR2  
         IRANG=1
         DO 4 IDIM=1,NDIM
            X=XM(IDIM) 
            XMSRN=X*TRSUR5
            DO 3 JDIM=1,NDIM
              D2EMP(IRANG)=D2EMP(IRANG)+XMSRN*XM(JDIM)
              IRANG=IRANG+1
3           CONTINUE
4        CONTINUE
         IRANG=1
         DO 5 IDIM=1,NDIM
            D2EMP(IRANG)=D2EMP(IRANG)+UNSUR3
            IRANG=IRANG+NDIM+1
5        CONTINUE
      ENDIF
 
      RETURN

99999 WRITE(*,10) (CORP(IDIM),IDIM=1,NDIM),(CORM(IDIM),IDIM=1,NDIM)
      CALL BAISE  ('Erreur dans le maillage ?')
10    FORMAT('   Rigolo on essaie de calculer la fonction de Green pour'
     &,' une distance < 10**-6'
     &/T11,'Xp=',E12.4,' Yp=',E12.4,' Zp=',E12.4
     &/T11,'Xm=',E12.4,' Ym=',E12.4,' Zm=',E12.4/)
                                                                    END !Glap3c

glap3c est appelé dans (4 procédures)