fasp_sp.f

Go to the documentation of this file.

!                   ******************
                    SUBROUTINE fasp_sp
!                   ******************
!
     &(xrelv,yrelv,zrelv,np,x,y,z,i)
!
!***********************************************************************
! BIEF   V7P3                                   15/09/2017
!***********************************************************************
!
!brief    INTERPOLATES VALUES FROM A SET OF POINTS ON AN ARTEMIS BOUNDARY NODE.
!
!history  N.DURAND (HRW)
!+        15/09/2017
!+        V7P3
!+   Adapted from FASP
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| NP             |-->| NUMBER OF TOMAWAC SPECTRA
!| XRELV          |-->| ABCISSAE OF TOMAWAC SPECTRA
!| YRELV          |-->| ORDINATES OF TOMAWAC SPECTRA
!| ZRELV          |-->| VALUES IN TOMAWAC SPECTRA
!| I              |-->| ARTEMIS BOUNDARY NODE NUMBER
!| X,Y            |-->| MESH COORDINATES
!| Z              |<--| INTERPOLATED VALUES
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_artemis, ONLY : ndir, debug
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NP
      DOUBLE PRECISION, INTENT(IN)  :: X,Y
      DOUBLE PRECISION, INTENT(IN)  :: XRELV(np),YRELV(np)
      DOUBLE PRECISION, INTENT(IN)  :: ZRELV(np,ndir+1)
      DOUBLE PRECISION, INTENT(OUT) :: Z(ndir+1)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER N,INUM,I,IDIR
      INTEGER N1,N2,N3,N4
!
      DOUBLE PRECISION DIST1,DIST2,DIST3,DIST4
      DOUBLE PRECISION ZCADR1,ZCADR2,ZCADR3,ZCADR4
      DOUBLE PRECISION DIFX,DIFY,DIST,X1,Y1,X2,Y2,X3,Y3,X4,Y4
      DOUBLE PRECISION ZNUM,ZDEN
!
      LOGICAL OK1,OK2,OK3,OK4
!
!-----------------------------------------------------------------------
!
!     INITIALISES:
!
      dist1=1.d12
      dist2=1.d12
      dist3=1.d12
      dist4=1.d12
!
      ok1 = .false.
      ok2 = .false.
      ok3 = .false.
      ok4 = .false.
!
      zcadr1=0.d0
      zcadr2=0.d0
      zcadr3=0.d0
      zcadr4=0.d0
!
      inum = 0
!
!     LOOP ON THE SET OF TOMAWAC SPECTRA POINTS (THERE ARE NP)
!     TO IDENTIFY THOSE CLOSEST TO ARTEMIS LIQUID BOUNDARY NODE :
!
      DO n=1,np
        difx = xrelv(n)-x
        dify = yrelv(n)-y
        dist = difx*difx + dify*dify
!
        IF ( dist.LT.1.d-6 ) dist=1.d-6
! ->QUADRANT 1 :
        IF( difx.LE.0.d0 .AND. dify.LE.0.d0) THEN
          IF(dist.LE.dist1)THEN
            IF(debug.GT.0) x1=xrelv(n)
            IF(debug.GT.0) y1=yrelv(n)
            dist1=dist
            n1=n
            ok1 = .true.
            inum = inum + 1
          ENDIF
! ->QUADRANT 2 :
        ELSEIF( difx.GE.0.d0 .AND. dify.LE.0.d0) THEN
          IF(dist.LE.dist2)THEN
            IF(debug.GT.0) x2=xrelv(n)
            IF(debug.GT.0) y2=yrelv(n)
            dist2=dist
            n2=n
            ok2 = .true.
            inum = inum + 1
          ENDIF
! ->QUADRANT 3 :
        ELSEIF( difx.GE.0.d0 .AND. dify.GE.0.d0) THEN
          IF(dist.LE.dist3)THEN
            IF(debug.GT.0) x3=xrelv(n)
            IF(debug.GT.0) y3=yrelv(n)
            dist3=dist
            n3=n
            ok3 = .true.
            inum = inum + 1
          ENDIF
! ->QUADRANT 4 :
        ELSEIF( difx.LE.0.d0 .AND. dify.GE.0.d0) THEN
          IF(dist.LE.dist4)THEN
            IF(debug.GT.0) x4=xrelv(n)
            IF(debug.GT.0) y4=yrelv(n)
            dist4=dist
            n4=n
            ok4 = .true.
            inum = inum + 1
          ENDIF
        ENDIF
      ENDDO ! N=1,NP
!
!     END OF LOOP ON THE SET OF TOMAWAC SPECTRA POINTS
!
      IF(inum.EQ.0) THEN
        WRITE(lu,401) i
        CALL plante(1)
        stop
!
      ELSE
!
!       IF(DEBUG.GT.0) WRITE(LU,*) I,INUM,OK1,N1,OK2,N2,OK3,N3,OK4,N4
!
        DO idir = 1,ndir+1
!
          znum = 0.d0
          zden = 0.d0
          IF(ok1) THEN
!        IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK1'
            znum = znum + zrelv(n1,idir)/dist1
            zden = zden + 1.d0/dist1
          ENDIF
          IF(ok2) THEN
!        IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK2'
            znum = znum + zrelv(n2,idir)/dist2
            zden = zden + 1.d0/dist2
          ENDIF
          IF(ok3) THEN
!        IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK3'
            znum = znum + zrelv(n3,idir)/dist3
            zden = zden + 1.d0/dist3
          ENDIF
          IF(ok4) THEN
!        IF(DEBUG.GT.0) WRITE(LU,*) IDIR,'OK4'
            znum = znum + zrelv(n4,idir)/dist4
            zden = zden + 1.d0/dist4
          ENDIF
!
          z(idir)=znum/zden
!        IF(DEBUG.GT.0) WRITE(LU,*) I,IDIR,Z(IDIR)
!
        ENDDO ! IDIR = 1,500*NDALE
!
      ENDIF
!
!-----------------------------------------------------------------------
!
!     PRINTOUT FORMATS:
!
401   FORMAT(/,1x,'FASDPA_SP : NOT ENOUGH DATA TO INTERPOLATE ',
     &       'AT ARTEMIS BOUNDARY NODE : ',i7)
!
!-----------------------------------------------------------------------
!
      RETURN
      END