rpi_intr.f

Go to the documentation of this file.

!                       *******************
                        SUBROUTINE rpi_intr
!                       *******************
!
     &(neigb  , nb_close, rx  , ry      , rxx     , ryy ,
     & npoin2 , i       , maxnsp  , ffd , firdiv1 , firdiv2 ,
     & secdiv1, secdiv2 , secdiv3, frstdiv , scnddiv)
!
!***********************************************************************
! TOMAWAC   V6P3                                   25/06/2012
!***********************************************************************
!
!brief    FREE-MESH METHOD FOR DIFFRACTION COMPUTATION
!+
!+            CALCULATES FIRST AND SECOND DERIVATIVE OF
!+            VARIABLE FFD
!
!history  E. KRIEZI (LNH)
!+        04/12/2006
!+        V5P5
!+
!
!history  G.MATTAROLO (EDF - LNHE)
!+        23/10/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!history  G.MATTAROLO (EDF - LNHE)
!+        23/06/2012
!+        V6P2
!+   Modification for V6P2
!
!history  J-M HERVOUET (EDF R&D, LNHE)
!+        19/03/2013
!+        V6P3
!+   Arguments slightly changed to avoid copy before calling.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FFD            |-->| INPUT FIELD FUNCTION
!| FIRDIV         |<--| FIRST DERIVATIVE OF FFD
!| FRSTDIV        |-->| IF TRUE COMPUTES 1ST DERIVATIVE
!| I              |-->| POINT INDEX
!| MAXNSP         |-->| CONSTANT FOR MESHFREE TECHNIQUE
!| NB_CLOSE       |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| NEIGB          |-->| NEIGHBOUR POINTS FOR MESHFREE METHOD
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| RX             |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| RXX            |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| RY             |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| RYY            |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| SECDIV         |<--| SECOND DERIVATIVE OF FFD
!| SCNDDIV        |-->| IF TRUE COMPUTES 2ND DERIVATIVE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : deja_rpi_intr, wu_om_rpi
      USE interface_tomawac, ex_rpi_intr => rpi_intr
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NPOIN2, MAXNSP,I
      INTEGER, INTENT(IN) :: NEIGB(npoin2,maxnsp),NB_CLOSE(npoin2)
!
      DOUBLE PRECISION, INTENT(IN)    :: RX(maxnsp),RY(maxnsp)
      DOUBLE PRECISION, INTENT(IN)    :: RXX(maxnsp),RYY(maxnsp)
      DOUBLE PRECISION, INTENT(INOUT) :: SECDIV1,SECDIV2,SECDIV3
      DOUBLE PRECISION, INTENT(INOUT) :: FIRDIV1,FIRDIV2
      DOUBLE PRECISION, INTENT(IN)    :: FFD(npoin2)
!
      LOGICAL, INTENT(IN)             :: FRSTDIV,SCNDDIV
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IPOIN,IP1

      DOUBLE PRECISION WZX1,WZY1,WZX2,WZY2
!
!-----------------------------------------------------------------------
!
      IF(.NOT.deja_rpi_intr) THEN
        ALLOCATE(wu_om_rpi(maxnsp))
        deja_rpi_intr=.true.
      ENDIF
!
!     FFD the field function where data are coming from.
!
      DO ip1 =1,nb_close(i)
        ipoin=neigb(i,ip1)
        wu_om_rpi(ip1)=ffd(ipoin)
      ENDDO
!
!     Calculate derivatives in IPOIN
!     TODO: never used still usefull ?
!
      IF(frstdiv) THEN
        wzx1=0.d0
        wzy1=0.d0
        DO ip1 =1,nb_close(i)
          wzx1=wzx1+rx(ip1)*wu_om_rpi(ip1)
          wzy1=wzy1+ry(ip1)*wu_om_rpi(ip1)
        ENDDO
        firdiv1=wzx1
        firdiv2=wzy1
      ENDIF
!
!     SECOND DERIVATIVES
!
      IF(scnddiv) THEN
        wzx2=0.d0
        wzy2=0.d0
        DO ip1 =1,nb_close(i)
          wzx2=wzx2+rxx(ip1)*wu_om_rpi(ip1)
          wzy2=wzy2+ryy(ip1)*wu_om_rpi(ip1)
        ENDDO
        secdiv1=wzx2
        secdiv2=wzy2
!       NOTE JMH : The only value really used
        secdiv3= wzx2+wzy2
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END