derive.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE derive
!                   *****************
!
     &(u,v,w,dt,at,x,y,z,ikle,ifabor,lt,ielm,ielmu,ndp,ndp2,
     & npoin,npoin2,
     & nelem,nelmax,surdet,xflot,yflot,zflot,
     & shpflo,shzflo,tagflo,clsflo,eltflo,etaflo,
     & nflot,nflot_max,mesh,
     & isub,dx,dy,dz,eltbuf,shpbuf,shzbuf,sizebuf,stocha,visc,
     & nplan,zstar,transf,
     & aalgae,dalgae,ralgae,ealgae,talgae,yalgae,
     & rel_algae,tw1_algae,tw2_algae,a_algae,
     & orbvel,ak,ep,h)
!
!***********************************************************************
! BIEF   V6P3                                   21/08/2010
!***********************************************************************
!
!brief    - COMPUTES THE BARYCENTRIC COORDINATES OF A FLOAT
!+                  IN THE MESH AT THE TIME OF RELEASE.
!+
!+            - COMPUTES THE SUCCESSIVE POSITIONS OF THIS FLOAT
!+                  WHICH IS CARRIED WITHOUT FRICTION BY THE CURRENT
!+                 (SUBSEQUENT TIMESTEPS).
!
!history  J-M JANIN (LNH)
!+        18/08/94
!+        V5P1
!+   Original version.
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  J-M HERVOUET (LNHE)
!+        19/06/2012
!+        V6P2
!+   Adapted for calling SCARACT instead of CHAR11. However parallelism
!+   will require further modifications.
!
!history  J-M HERVOUET (LNHE)
!+        12/03/2013
!+        V6P3
!+   New file format for Tecplot. Works in parallel. Works in 3D.
!
!history  J-M HERVOUET (LNHE)
!+        12/03/2013
!+        V6P3
!+   Arguments STOCHA and VISC added
!
!history  A Joly
!+        20/06/2013
!+        V6P3
!+   New conditions added to treat algae transport
!+     - Only tested in 2D
!+     - Does not work for quadratic elements
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        14/08/2015
!+        V7P1
!+   Hardcoded argument NRK added for SCARACT.
!
!history  R. ATA (EDF LAB, LNHE)
!+        14/01/2017
!+        V7P2
!+  bug fix and  better preparation of the call of SCARACT for 3D.
!+    see lines between !RA
!
!history  J,RIEHME (ADJOINTWARE)
!+        November 2016
!+        V7P2
!+   Replaced EXTERNAL statements to parallel functions / subroutines
!+   by the INTERFACE_PARALLEL
!
!history  M.S.TURNBULL (HRW)
!+        26/11/2019
!+        V8P2
!+   Algae Dislodgement
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| A_ALGAE        |-->| RATE OF DEGRADATION FOR ALGAE
!| CLSFLO         |-->| CLASS OF FLOATS
!| DT             |-->| TIME STEP (I.E. TIME INTERVAL).
!| DX             |<->| WORK ARRAY (DISPLACEMENTS ALONG X)
!| DY             |<->| WORK ARRAY (DISPLACEMENTS ALONG Y)
!| DZ             |<->| WORK ARRAY (DISPLACEMENTS ALONG Z)
!| ELTBUF         |<->| WORK ARRAY
!| ELTFLO         |<->| NUMBERS OF ELEMENTS WHERE ARE THE FLOATS
!| ETAFLO         |<->| LEVELS WHERE ARE THE FLOATS
!|                |   | FOR FLOATS POSITIONS.
!| IELM           |-->| TYPE OF ELEMENT.
!| IELMU          |-->| TYPE OF ELEMENT FOR VELOCITIES.
!| IFABOR         |-->| ELEMENTS BEHIND THE EDGES OF ANOTHER ELEMENT
!|                |   | IF IFABOR NEGATIVE OR 0, THE EDGE IS A
!|                |   | LIQUID OR PERIODIC BOUNDARY
!| IKLE           |-->| CONNECTIVITY TABLE.
!| ISUB           |<->| ARRIVAL SUB-DOMAIN OF PARTICLES.
!| LT             |-->| TIME STEP NUMBER.
!| MESH           |<->| MESH STRUCTURE.
!| NDP            |-->| NUMBER OF POINTS PER ELEMENT FOR IELM
!| NDP2           |-->| NUMBER OF POINTS PER ELEMENT FOR IELMU
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS IN 2D
!| NFLOT          |<->| NUMBER OF FLOATS.
!| NFLOT_MAX      |<->| MAXIMUM NUMBER OF FLOATS.
!| NPLAN          |-->| NUMBER OF PLANES FOR 3D (1 FOR 2D)
!| NPOIN          |-->| NUMBER OF POINTS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| NSTAR          |-->| VERTICAL DISTRIBUTION OF PLANES
!| ORBVEL         |-->| WAVE ORBITAL VELOCITY
!| REL_ALGAE      |-->| ALGAE RELEASE TYPE
!| SHPBUF         |<->| WORK ARRAY
!| SHPFLO         |<->| BARYCENTRIC COORDINATES OF FLOATS IN THEIR
!|                |   | ELEMENTS.
!| SHZBUF         |<->| WORK ARRAY
!| SHZFLO         |<->| BARYCENTRIC COORDINATE ON VERTICAL
!| SIZEBUF        |-->| DILMENSION OF SOME WORK ARRAYS
!| SURDET         |-->| 1/DETERMINANT, USED IN ISOPARAMETRIC
!|                |   | TRANSFORMATION.
!| TAGFLO         |-->| TAGS OF FLOATS
!| TALGAE         |-->| DURATION BEFORE ALGAE RELEASE
!| TRANSF         |-->| 3D MESH TRANSFORMATION
!| TW1_ALGAE      |-->| WAVE ORBITAL VELOCITY THRESHOLD FOR ALGAE 1
!| TW2_ALGAE      |-->| WAVE ORBITAL VELOCITY THRESHOLD FOR ALGAE 2
!| U              |-->| X-COMPONENT OF VELOCITY
!| V              |-->| Y-COMPONENT OF VELOCITY
!| W              |-->| Z-COMPONENT OF VELOCITY
!| X              |-->| ABSCISSAE OF POINTS IN THE MESH
!| XFLOT          |<->| ABSCISSAE OF FLOATS
!| Y              |-->| ORDINATES OF POINTS IN THE MESH
!| YALGAE         |-->| ALGAE TYPE
!| YFLOT          |<->| ORDINATES OF FLOATS
!| Z              |-->| ELEVATIONS OF POINTS IN THE MESH
!| ZFLOT          |<->| ELEVATIONS OF FLOATS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_derive => derive
      USE declarations_telemac, ONLY : deja_derive, svoid_derive,
     &                                 init_alg, sizebuf2_d,buff_1d_d,
     &                                 buff_2d_d, alg_dislodge,
     &                                 buff_elt_i
      USE streamline
      USE algae_transp
!
      USE declarations_special
      USE interface_parallel, ONLY : p_isum
      USE initial_drogues, ONLY : parclss
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER         , INTENT(IN)    :: NPOIN,LT,IELM,IELMU,NDP,NELEM
      INTEGER         , INTENT(IN)    :: NELMAX,SIZEBUF,NPOIN2
      INTEGER         , INTENT(IN)    :: NFLOT_MAX,STOCHA,NPLAN,TRANSF
      INTEGER         , INTENT(INOUT) :: NFLOT
      INTEGER         , INTENT(IN)    :: NDP2
      DOUBLE PRECISION, INTENT(IN)    :: DT,AT
      DOUBLE PRECISION, INTENT(IN)    :: U(*),V(*),W(*)
      DOUBLE PRECISION, INTENT(IN)    :: X(npoin),Y(npoin),Z(npoin)
      INTEGER         , INTENT(IN)    :: IKLE(nelmax,ndp2)
      INTEGER         , INTENT(IN)    :: IFABOR(*)
      DOUBLE PRECISION, INTENT(IN)    :: SURDET(nelem),ZSTAR(nplan)
      DOUBLE PRECISION, INTENT(INOUT) :: XFLOT(nflot_max),DX(nflot_max)
      DOUBLE PRECISION, INTENT(INOUT) :: YFLOT(nflot_max),DY(nflot_max)
      DOUBLE PRECISION, INTENT(INOUT) :: ZFLOT(nflot_max),DZ(nflot_max)
      INTEGER         , INTENT(INOUT) :: TAGFLO(nflot_max)
      INTEGER         , INTENT(INOUT) :: CLSFLO(nflot_max)
      INTEGER         , INTENT(INOUT) :: ELTFLO(nflot_max)
      INTEGER         , INTENT(INOUT) :: ETAFLO(nflot_max)
      INTEGER         , INTENT(INOUT) :: ELTBUF(sizebuf)
      INTEGER         , INTENT(INOUT) :: ISUB(nflot_max)
      DOUBLE PRECISION, INTENT(INOUT) :: SHPFLO(ndp,nflot_max)
      DOUBLE PRECISION, INTENT(INOUT) :: SHZFLO(nflot_max)
      DOUBLE PRECISION, INTENT(INOUT) :: SHPBUF(ndp,sizebuf)
      DOUBLE PRECISION, INTENT(INOUT) :: SHZBUF(sizebuf)
      TYPE(bief_obj)  , INTENT(IN)    :: VISC
      TYPE(bief_mesh) , INTENT(INOUT) :: MESH
      LOGICAL         , OPTIONAL, INTENT(IN) :: AALGAE
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: AK(*),EP(*)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: ORBVEL(*)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: H(npoin)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: DALGAE(*),RALGAE(*)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: EALGAE(*)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: TALGAE(*)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: TW1_ALGAE(*)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: TW2_ALGAE(*)
      DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: A_ALGAE(*)
      INTEGER         , OPTIONAL, INTENT(IN) :: YALGAE(*)
      INTEGER         , OPTIONAL, INTENT(IN) :: REL_ALGAE(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IFLOT,FRE(1),FREBUF(1),ELT,ETF
      INTEGER N1,N2,N3,N4,N5,N6,NOMB,SENS,NRK
!
      INTEGER REL_ALG
      DOUBLE PRECISION TW0, TW1, TW2, A_ALG
      DOUBLE PRECISION, ALLOCATABLE :: TW(:)
!
      LOGICAL SSIGMA
!
      CHARACTER(LEN=11) EXTENS
      EXTERNAL          extens
!
      LOGICAL ALGAE
!
      SAVE tw
!
!-----------------------------------------------------------------------
!
!     HARDCODED NUMBER OF SUB-STEPS FOR COMPUTING THE PATH-LINES
!
      nrk=3
!
!-----------------------------------------------------------------------
!
!     CHECKING ARGUMENTS FOR ALGAE
!
      IF(PRESENT(aalgae)) THEN
        algae=aalgae
      ELSE
        algae=.false.
      ENDIF
      IF(algae) THEN
        IF(.NOT.PRESENT(ak).OR.
     &     .NOT.PRESENT(ep).OR.
     &     .NOT.PRESENT(h).OR.
     &     .NOT.PRESENT(dalgae).OR.
     &     .NOT.PRESENT(ralgae).OR.
     &     .NOT.PRESENT(ealgae).OR.
     &     .NOT.PRESENT(talgae).OR.
     &     .NOT.PRESENT(yalgae)) THEN
          WRITE(lu,*) 'DERIVE: MISSING ARGUMENTS FOR ALGAE'
          CALL plante(1)
          stop
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!
!     PARAMETERISING THE CALL TO SCARACT
!
!     NUMBER OF PLANES, NOW GOT BY ARGUMENT
!      NPLAN=NPOIN/NPOIN2
!     NO VARIABLE TO INTERPOLATE AT THE FOOT OF CHARACTERISTICS
      nomb=0
!     FORWARD TRACKING
      sens=1
!     CASE OF 3D CALLS, DETECT IF SIGMA TRANSFORM
      ssigma=ielm.EQ.41.AND.transf.NE.0.AND.transf.NE.5
!
      IF(ielm.NE.11.AND.ielm.NE.41) THEN
        WRITE(lu,124) ielm
124     FORMAT(1x,'DERIVE : UNEXPECTED TYPE OF ELEMENT: ',1i6)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
!     INITIALISING SVOID_DERIVE AND HEADER OF A TECPLOT FILE
!
      IF(.NOT.deja_derive) THEN
!
!       THOUGH NOMB = 0, THESE COMPONENTS WILL BE USED IN SCARACT
!
        svoid_derive%TYPE=2
        svoid_derive%NAT = 1
        svoid_derive%DIM1=1
        ALLOCATE(svoid_derive%R(1))
!
        IF(algae.AND.alg_dislodge)THEN
          ALLOCATE(tw(nflot_max))
        END IF
!
        deja_derive=.true.
!
      ENDIF
!
      svoid_derive%ELM=ielm
!
!-----------------------------------------------------------------------
!
!     TRAJECTORIES COMPUTED FOR ALL POINTS
!
!     ALLOCATE THE ALGAE VARIABLES IF NEEDED
!
      IF(algae.AND.init_alg) THEN
        init_alg=.false.
!       VERIFY THAT THE BUFFER SIZE IS BIG ENOUGH FOR PARTICLE TRANSPORT
        IF(nflot_max.GT.sizebuf)THEN
          sizebuf2_d=nflot_max
          ALLOCATE(buff_1d_d(sizebuf2_d))
          ALLOCATE(buff_2d_d(ndp,sizebuf2_d))
          ALLOCATE(buff_elt_i(sizebuf2_d))
        ELSE
!         SET IT TO TRUE SO DEALL_BIEF DOES NOT TRY TO DEALLOCATE IT
          init_alg=.true.
        ENDIF
      ENDIF
!
      IF(algae) THEN
        IF(lt.EQ.1) THEN
          IF(ielmu.EQ.11) THEN
            CALL interp_algae(nflot,nflot_max,shpflo,shzflo,eltflo,
     &          u_x_av_0%R,u_y_av_0%R,u_z_av_0%R,k_av_0%R,eps_av_0%R,
     &          h_flu%R,npoin,ielm,ndp,ndp2,nplan,nelmax,ikle,shzbuf,
     &          ielmu,npoin,u,v,w,ak,ep,h)
            CALL interp_algae(nflot,nflot_max,shpflo,shzflo,eltflo,
     &          u_x_av%R,u_y_av%R,u_z_av%R,k_av%R,eps_av%R,
     &          h_flu%R,npoin,ielm,ndp,ndp2,nplan,nelmax,ikle,shzbuf,
     &          ielmu,npoin,u,v,w,ak,ep,h)
          ELSEIF(ielmu.EQ.12) THEN
            CALL interp_algae(nflot,nflot_max,shpflo,shzflo,eltflo,
     &          u_x_av_0%R,u_y_av_0%R,u_z_av_0%R,k_av_0%R,eps_av_0%R,
     &          h_flu%R,npoin,ielm,ndp,ndp2,nplan,nelmax,ikle,shzbuf,
     &          ielmu,npoin+nelmax,u,v,w,ak,ep,h)
            CALL interp_algae(nflot,nflot_max,shpflo,shzflo,eltflo,
     &          u_x_av%R,u_y_av%R,u_z_av%R,k_av%R,eps_av%R,
     &          h_flu%R,npoin,ielm,ndp,ndp2,nplan,nelmax,ikle,shzbuf,
     &          ielmu,npoin+nelmax,u,v,w,ak,ep,h)
          ENDIF
        ENDIF
      ENDIF
!     BACK CONVERSION WHEN SIGMA TRANSFORM
      IF(ssigma)THEN
        DO iflot=1,nflot
          etf = etaflo(iflot)
          zflot(iflot)=zstar(etf)+ shzflo(iflot)*
     &                (zstar(etf+1)-zstar(etf))
        ENDDO
      ENDIF
!
! -----------------
! IF ALGAE IS .TRUE., THEN USE ALGAE TRANSPORT
! OTHERWISE THIS IS A NORMAL DROGUE TRANSPORT
! -----------------
!
      IF(algae)THEN
!
! FILL I_A_GL, WHICH WILL BE USED TO VERIFY THAT THE ALGAE INFO IS SENT IN
! THE SAME FASHION AS THE PARTICLE POSITIONS
!
        DO iflot=1,nflot
          i_a_gl%I(iflot)=tagflo(iflot)
        END DO
!
        IF(ielmu.EQ.11)THEN
          CALL interp_algae(nflot,nflot_max,shpflo,shzflo,eltflo,
     &          u_x_av%R,u_y_av%R,u_z_av%R,k_av%R,eps_av%R,
     &          h_flu%R,npoin,ielm,ndp,ndp2,nplan,nelmax,ikle,shzbuf,
     &          ielmu,npoin,u,v,w,ak,ep,h)
          IF(alg_dislodge)THEN
            CALL bief_interp(orbvel,tw,shpflo,ndp,shzflo,
     &           eltflo,shzbuf,fre,
     &           eltflo,nflot,npoin,nplan,ielmu,ikle,nelmax,
     &           .false.,.false.)
          END IF
        ELSEIF(ielmu.EQ.12)THEN
          CALL interp_algae(nflot,nflot_max,shpflo,shzflo,eltflo,
     &          u_x_av%R,u_y_av%R,u_z_av%R,k_av%R,eps_av%R,
     &          h_flu%R,npoin,ielm,ndp,ndp2,nplan,nelmax,ikle,shzbuf,
     &          ielmu,npoin+nelmax,u,v,w,ak,ep,h)
          IF(alg_dislodge)THEN
            CALL bief_interp(orbvel,tw,shpflo,ndp,shzflo,
     &           eltflo,shzbuf,fre,
     &           eltflo,nflot,npoin+nelmax,nplan,ielmu,ikle,nelmax,
     &           .false.,.false.)
          END IF
        END IF
!
        DO iflot=1,nflot_max
          parclss%I(iflot) = clsflo(iflot)
        END DO
!
        IF(alg_dislodge)THEN
          DO iflot=1,nflot
            rel_alg = rel_algae(clsflo(iflot))
            IF (rel_alg.EQ.2) THEN
              tw1 = tw1_algae(clsflo(iflot))
              tw2 = tw2_algae(clsflo(iflot))
              a_alg = a_algae(clsflo(iflot))
              teff%R(iflot) = teff%R(iflot) + dt * tw(iflot)
              tw0 = tw2 + (tw1 - tw2) * exp(-a_alg * teff%R(iflot))
              IF (tw(iflot).GT.tw0) THEN
                dislodge%I(iflot) = 1
              ENDIF
            ENDIF
          END DO
        END IF
!
        CALL disp_algae(nflot_max,nflot,mesh%DIM1,dt,at,
     &                 u_x_av_0%R,u_y_av_0%R,u_z_av_0%R,k_av_0%R,
     &                 eps_av_0%R,h_flu%R,u_x_av%R,u_y_av%R,u_z_av%R,
     &                 u_x_0%R,u_y_0%R,u_z_0%R,v_x_0%R,v_y_0%R,v_z_0%R,
     &                 dx,dy,dz,eltflo,u_x%R,u_y%R,u_z%R,v_x%R,v_y%R,
     &                 v_z%R,xflot,yflot,zflot,lt,dalgae,ralgae,ealgae,
     &                 talgae,yalgae,rel_algae)
!
! FIND THE ELEMENT AND SUBDOMAIN AFTER THE TRANSPORT (WITH A VERIFICATION
! IF SIZEBUF.LT.NFLOT_MAX)
!
        IF(nflot_max.GT.sizebuf)THEN
          CALL scaract(svoid_derive,svoid_derive,u,v,w,w,x,y,zstar,
     &                 zstar,
     &                 xflot,yflot,zflot,zflot,dx,dy,dz,dz,z,
     &                 shpflo,shzflo,shzflo,
     &                 surdet,dt,ikle,ifabor,eltflo,etaflo,
     &                 fre,buff_elt_i,isub,ielm,ielmu,
     &                 nelem,nelmax,nomb,npoin2,ndp,nrk,
     &                 nplan,1,mesh,nflot,npoin2,sens,
     &                 buff_2d_d,buff_1d_d,buff_1d_d,frebuf,sizebuf2_d,
     &                 apost=.true.,asigma=ssigma,aalg=algae)
        ELSE
          CALL scaract(svoid_derive,svoid_derive,u,v,w,w,x,y,zstar,
     &                 zstar,
     &                 xflot,yflot,zflot,zflot,dx,dy,dz,dz,z,
     &                 shpflo,shzflo,shzflo,
     &                 surdet,dt,ikle,ifabor,eltflo,etaflo,
     &                 fre,eltbuf,isub,ielm,ielmu,
     &                 nelem,nelmax,nomb,npoin2,ndp,nrk,
     &                 nplan,1,mesh,nflot,npoin2,sens,
     &                 shpbuf,shzbuf,shzbuf,frebuf,sizebuf,
     &                 apost=.true.,asigma=ssigma,aalg=algae)
        ENDIF
      ELSE
        CALL scaract(svoid_derive,svoid_derive,u,v,w,w,x,y,zstar,zstar,
     &               xflot,yflot,zflot,zflot,
     &               dx,dy,dz,dz,z,shpflo,shzflo,shzflo,surdet,dt,
     &               ikle,ifabor,eltflo,etaflo,
     &               fre,eltbuf,isub,ielm,ielmu,nelem,nelmax,
     &               nomb,npoin2,ndp,nrk,
     &               nplan,1,mesh,nflot,npoin2,sens,
     &               shpbuf,shzbuf,shzbuf,frebuf,sizebuf,
     &               apost=.true.,asigma=ssigma,astocha=stocha,
!                    APOST=.TRUE. OTHERWISE ISUB IS NOT FILLED
     &               avisc=visc)
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF(ncsize.GT.1.AND.nflot.GT.0) THEN
!
!       IN // XFLOT AND YFLOT MAY HAVE BEEN DESTROYED BY SCARACT
!       BECAUSE RE-USED FOR GENERATIONS OF LOST PARTICLES
!       THEY ARE REDONE HERE FOR PARTICLES WHICH ARE STILL IN THE
!       SUB-DOMAIN
!
        IF(ielm.EQ.11) THEN
          DO iflot=1,nflot
            IF(isub(iflot).EQ.ipid) THEN
              elt=eltflo(iflot)
              IF(elt.GT.0) THEN
                n1=ikle(elt,1)
                n2=ikle(elt,2)
                n3=ikle(elt,3)
                xflot(iflot)=shpflo(1,iflot)*x(n1)
     &                      +shpflo(2,iflot)*x(n2)
     &                      +shpflo(3,iflot)*x(n3)
                yflot(iflot)=shpflo(1,iflot)*y(n1)
     &                      +shpflo(2,iflot)*y(n2)
     &                      +shpflo(3,iflot)*y(n3)
              ENDIF
            ENDIF
          ENDDO
        ELSEIF(ielm.EQ.41) THEN
          DO iflot=1,nflot
            IF(isub(iflot).EQ.ipid) THEN
              elt=eltflo(iflot)
              IF(elt.GT.0) THEN
                n1=ikle(elt,1)+npoin2*(etaflo(iflot)-1)
                n2=ikle(elt,2)+npoin2*(etaflo(iflot)-1)
                n3=ikle(elt,3)+npoin2*(etaflo(iflot)-1)
                n4=ikle(elt,1)+npoin2* etaflo(iflot)
                n5=ikle(elt,2)+npoin2* etaflo(iflot)
                n6=ikle(elt,3)+npoin2* etaflo(iflot)
                xflot(iflot)=shpflo(1,iflot)*x(n1)
     &                      +shpflo(2,iflot)*x(n2)
     &                      +shpflo(3,iflot)*x(n3)
                yflot(iflot)=shpflo(1,iflot)*y(n1)
     &                      +shpflo(2,iflot)*y(n2)
     &                      +shpflo(3,iflot)*y(n3)
                zflot(iflot)=(z(n1)*shpflo(1,iflot)
     &                      +z(n2)*shpflo(2,iflot)
     &                      +z(n3)*shpflo(3,iflot))*(1.d0-shzflo(iflot))
     &                      +(z(n4)*shpflo(1,iflot)
     &                      +z(n5)*shpflo(2,iflot)
     &                      +z(n6)*shpflo(3,iflot))*shzflo(iflot)
              ENDIF
            ENDIF
          ENDDO
        ENDIF
!
      ENDIF
!
!     SEND THE ALGAE INFORMATION IF IT IS NECESSARY
!
      IF(ncsize.GT.1.AND.algae) THEN
        IF(nflot_max.GT.sizebuf)THEN
          CALL send_info_alg(isub,i_a_gl%I,clsflo,teff%R,dislodge%I,
     &                       buff_elt_i,nflot,nflot_max,
     &                       u_x_av%R,u_y_av%R,u_z_av%R,k_av%R,eps_av%R,
     &                       h_flu%R,u_x%R,u_y%R,u_z%R,v_x%R,v_y%R,
     &                       v_z%R,nwin,mesh%DIM1,psi)
        ELSE
          CALL send_info_alg(isub,i_a_gl%I,clsflo,teff%R,dislodge%I,
     &                       eltbuf,nflot,nflot_max,
     &                       u_x_av%R,u_y_av%R,u_z_av%R,k_av%R,eps_av%R,
     &                       h_flu%R,u_x%R,u_y%R,u_z%R,v_x%R,v_y%R,
     &                       v_z%R,nwin,mesh%DIM1,psi)
        ENDIF
      ENDIF
!
!     SENDING THE PARTICLES THAT MIGRATED TO ANOTHER SUB-DOMAIN
!
      IF(ncsize.GT.1) THEN
        IF(algae) THEN
          CALL send_particles(xflot,yflot,zflot,shpflo,shzflo,eltflo,
     &                 etaflo,isub,tagflo,clsflo,ndp,nflot,nflot_max,
     &                        mesh,nplan,dx=dx,dy=dy,dz=dz)
        ELSE
          CALL send_particles(xflot,yflot,zflot,shpflo,shzflo,eltflo,
     &                 etaflo,isub,tagflo,clsflo,ndp,nflot,nflot_max,
     &                        mesh,nplan)
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!
!     CASE OF LOST FLOATS (EXITED OR NOW REMOVED AFTER BEING SENT TO
!                          ANOTHER SUB-DOMAIN)
!
      iflot=1
      IF(ncsize.GT.1) THEN
!
!       IN // MODE
!
11      CONTINUE
!       LOST OR MIGRATED FLOATS
        IF(nflot.GT.0.AND.ncsize.GT.1) THEN
          IF(eltflo(iflot).LE.0.OR.isub(iflot).NE.ipid) THEN
!
!           REMOVE ALGAE INFORMATION FROM A SUB DOMAIN IF IT IS NECESSARY
!
            IF(algae) THEN
              CALL del_info_alg(tagflo(iflot),nflot,nflot_max,
     &            mesh%TYPELM,i_a_gl%I,clsflo,eltbuf,v_x%R,v_y%R,v_z%R,
     &                   u_x%R,u_y%R,u_z%R,u_x_av%R,u_y_av%R,u_z_av%R,
     &                   k_av%R,eps_av%R,h_flu%R,nwin,mesh%DIM1,psi)
            ENDIF
!
            IF(algae) THEN
              CALL del_particle(tagflo(iflot),nflot,nflot_max,xflot,
     &                   yflot,zflot,tagflo,clsflo,shpflo,shzflo,eltflo,
     &                          etaflo,mesh%TYPELM,
     &                          dx=dx,dy=dy,dz=dz,isub=isub,
     &                          teff=teff%R,dislodge=dislodge%I)
            ELSE
              CALL del_particle(tagflo(iflot),nflot,nflot_max,xflot,
     &                   yflot,zflot,tagflo,clsflo,shpflo,shzflo,eltflo,
     &                          etaflo,mesh%TYPELM,
     &                          isub=isub)
            ENDIF
!
!           THE SAME IFLOT IS NOW A NEW PARTICLE AND MUST BE CHECKED AGAIN!
            IF(iflot.LE.nflot) GO TO 11
          ENDIF
!
          IF(algae)THEN
!           UPDATE DX_A,DY_A,DZ_A
            dx_a%R(iflot)=dx(iflot)
            dy_a%R(iflot)=dy(iflot)
            dz_a%R(iflot)=dz(iflot)
          ENDIF
!
          iflot=iflot+1
          IF(iflot.LE.nflot) GO TO 11
        ENDIF
!
      ELSE
!
!       IN SCALAR MODE
!
10      CONTINUE
!       LOST FLOATS ONLY
        IF(nflot.GT.0) THEN
          IF(eltflo(iflot).LE.0) THEN
!
!           REMOVE INFORMATION FROM A SUB DOMAIN IF NECESSARY
!
            IF(algae) THEN
              CALL del_info_alg(tagflo(iflot),nflot,nflot_max,
     &            mesh%TYPELM,i_a_gl%I,clsflo,eltbuf,v_x%R,v_y%R,v_z%R,
     &                   u_x%R,u_y%R,u_z%R,u_x_av%R,u_y_av%R,u_z_av%R,
     &                   k_av%R,eps_av%R,h_flu%R,nwin,mesh%DIM1,psi)
              CALL del_particle(tagflo(iflot),nflot,nflot_max,xflot,
     &                 yflot,zflot,tagflo,clsflo,shpflo,shzflo,eltflo,
     &                    etaflo,mesh%TYPELM,dx=dx,dy=dy,dz=dz,
     &                    teff=teff%R,dislodge=dislodge%I)
            ELSE
              CALL del_particle(tagflo(iflot),nflot,nflot_max,xflot,
     &                 yflot,zflot,tagflo,clsflo,shpflo,shzflo,eltflo,
     &                    etaflo,mesh%TYPELM)
            ENDIF
!
!           THE SAME IFLOT IS NOW A NEW PARTICLE AND MUST BE CHECKED AGAIN!
            IF(iflot.LE.nflot) GO TO 10
          ENDIF
!
          IF(algae)THEN
!           UPDATE DX_A,DY_A,DZ_A
            dx_a%R(iflot)=dx(iflot)
            dy_a%R(iflot)=dy(iflot)
            dz_a%R(iflot)=dz(iflot)
          ENDIF
!
          iflot=iflot+1
          IF(iflot.LE.nflot) GO TO 10
        ENDIF
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE derive