additional modifications to make mood work

Src2D2/Fortran/quickhull.f90

@@ -35,22 +35,28 @@ MODULE quickhull
   PUBLIC:: test_quick
   REAL(DP), PARAMETER:: tol=-SQRT(EPSILON(0.0_dp))
   REAL(dp), PARAMETER:: tol_hull=1.e-4_dp!0._dp!-epsilon(0.0_dp)
+  real(dp), parameter:: infty=huge(1._dp)
 CONTAINS
   SUBROUTINE tri(x,y)
     IMPLICIT NONE
     REAL(DP), DIMENSION(:,:), INTENT(in)  :: x
     REAL(DP), DIMENSION(:,:), INTENT(out) :: y
-    REAL(DP), DIMENSION(2, SIZE(x, dim=2)):: buff
+    REAL(DP), DIMENSION(2, SIZE(x, dim=2)):: buff, buf
     LOGICAL, DIMENSION(SIZE(x,dim=2))     :: ind
     INTEGER                               :: m, j, k, i
 
     m=SIZE(x,dim=2)
+    buf=x
+    do i=1, m
+       if (abs(x(1,i))>infty) buf(1,i)=Huge(1._dp)
+       if (abs(x(2,i))>infty) buf(2,i)=Huge(1._dp)
+enddo
     ind=.TRUE.
     k=0
     DO i=1, m
-       j=MINLOC(x(1,:),1, ind)
+       j=MINLOC(buf(1,:),1, ind)
        k=k+1
-       buff(:, k)=x(:,j)
+       buff(:, k)=buf(:,j)
        ind(j)=.FALSE.
     ENDDO
     y=buff
@@ -104,11 +110,12 @@ CONTAINS
     ELSE
 
        CALL tri(Points_o,Points)
+
        iLower = 0
        Lower  = -HUGE(1._dp)
        DO i=0,nPoints-1
           DO WHILE(iLower.GE.2.AND.Cross(Lower(:,iLower-2),Lower(:,iLower-1),Points(:,i)).LE.0._dp)
-             Lower(:,iLower) = -HUGE(1.)
+             Lower(:,iLower) = -HUGE(1._dp)
              iLower          = iLower - 1
           END DO
           Lower(:,iLower) = Points(:,i) 
@@ -130,7 +137,12 @@ CONTAINS
        iUpper = iUpper-1
        nHull  = iLower+iUpper+1
 
-
+       if (ilower+iUpper.gt.size(hull,2)) then
+          print*, mod_name, ilower+iUpper,size(hull,2),Npoints
+          do i=0, Npoints-1
+             print*, points(:,i)
+          enddo
+       endif
        ! NOTE: Initialize Hull with zeros
        Hull   = 0._dp
 
@@ -139,6 +151,8 @@ CONTAINS
        Hull(:,iLower:iLower+iUpper-1) = Upper(:,0:iUpper-1)
 
        ! NOTE: save first value twice
+
+       
        Hull(:,       iLower+iUpper  ) = Hull (:,0         )
 
     END IF

Src2D2/Simplex/Makefile

@@ -4,13 +4,16 @@ LIBS = -llapack -lblas
 
 all: test
 
-hull.o: hull.f90 dualsimplex.o
+hull.o: hull.f90 dualsimplex.o precision.o
 	$(FORT) $(CFLAGS) -o hull.o hull.f90
-dualsimplex.o: dualsimplex.f90
+dualsimplex.o: dualsimplex.f90 precision.o
 	$(FORT) $(CFLAGS) dualsimplex.f90 -o dualsimplex.o
 
-test: test.f90 dualsimplex.o hull.o
+test: test.f90 dualsimplex.o hull.o precision.o
 	$(FORT) test.f90 dualsimplex.o hull.o $(LIBS) -o test
 
+precision.o: precision.f90
+	     $(FORT) $(CFLAGS) -o precision.o precision.f90
+
 clean:
 	rm -f *.o *.mod delaunayLP generate

Src2D2/Simplex/dualsimplex.f90

@@ -217,7 +217,7 @@ IF (PRESENT(EPS)) THEN
       IERR = 20; RETURN; END IF
    EPSL = EPS
 ELSE ! Set the default value.
-   EPSL = EPSILON(0.0_dp)
+   EPSL = tiny(1.0_dp)!EPSILON(0.0_dp)
 END IF
 IF (PRESENT(IBUDGET)) THEN
    IF(IBUDGET < 0) THEN ! Must be nonnegative.

Src2D2/Simplex/hull.f90

@@ -38,10 +38,10 @@ CONTAINS
     REAL(dp), DIMENSION(:,:), INTENT(in):: points
     REAL(dp), DIMENSION(:)  , INTENT(in):: x
     INTEGER :: D, N, M,jj
-    integer, save:: compte=0
+    INTEGER, SAVE:: compte=0
 
 
-     REAL(DP), ALLOCATABLE :: A(:,:),  C(:,:)
+    REAL(DP), ALLOCATABLE :: A(:,:),  C(:,:)
     REAL(DP) :: START, FINISH
 
     INTEGER, ALLOCATABLE :: BASIS(:), IERR(:)
@@ -68,19 +68,19 @@ CONTAINS
     DO I = 1, N
        A(1:D,i)=Points(1:D,I)
        A(D+1,I) = -1.0_dp
- !     A(D+1,I) = 1.0_dp
-     END DO
-  !  A = -A
+       !     A(D+1,I) = 1.0_dp
+    END DO
+    !  A = -A
     ! Read the interpolation points into the matrix C(:,:).
     DO I = 1, M
        C(1:D,I)=X(I)
-!      C(D+1,I) = 1.0_dp
+       !      C(D+1,I) = 1.0_dp
        C(D+1,I) = -1.0_dp
     END DO
 
-!    C = -C
+    !    C = -C
+
 
- 
     ! Compute the interpolation results and time.
 
     DO I = 1, M

Src2D2/Simplex/test.f90

 PROGRAM test
+  use precision
   USE hull
   IMPLICIT NONE
   !  INTEGER, PARAMETER:: R8=SELECTED_REAL_KIND(13)
-  REAL(kind=r8), DIMENSION(:,:), ALLOCATABLE:: points
-  REAL(kind=r8), DIMENSION(:), ALLOCATABLE:: x
+  REAL(dp), DIMENSION(:,:), ALLOCATABLE:: points
+  REAL(dp), DIMENSION(:), ALLOCATABLE:: x
   INTEGER:: D, N
   LOGICAL:: is
   INTEGER :: i
@@ -15,12 +16,12 @@ PROGRAM test
   ALLOCATE(Points(D,N),X(D) )
   DO i=1, N
      WRITE(*,*) "Point #", i
-     READ(*,*) Points(:,i)
+     READ(1,*) Points(:,i)
   ENDDO
   WRITE(*,*) " Point a tester"
-  READ(*,*) X
+  READ(2,*) X
 
-  is=is_in_hull(Points, X)
+  is=is_in_hull_simplex(Points, X)
   IF (is) THEN
      WRITE(*,*) "nous sommes dans le domaine"
   ELSE

Src2D2/elements.f90

@@ -89,7 +89,7 @@ MODULE element_class
 
      REAL(dp), DIMENSION(:,:,:), POINTER      :: coeff =>Null() ! \int_K phi_i*nabla phi_j for Galerkin
      REAL(DP), DIMENSION(:,:), POINTER        :: masse=>Null() !  the local mass matrix
-
+     real(dp)                                 :: l=1._dp  ! B limiter. modified in scheme/scheme8 (bidouille/lim)
 #ifdef parallel
      INTEGER :: id
      INTEGER :: subMeshId

Src2D2/geom.f90

@@ -16,7 +16,7 @@ MODULE geom
   USE param2d
   USE Boundary
   IMPLICIT NONE
-  private
+  PRIVATE
 
   ! GMSH_ELE(i, j): i = #Ndofs, j = # Verts
   INTEGER, DIMENSION(31, 2), PARAMETER :: GMSH_ELE = &
@@ -32,12 +32,16 @@ MODULE geom
      MODULE PROCEDURE coord_kinetic_new
   END INTERFACE coord_kinetic
 
-   INTERFACE calculateMassMatrLumped
+  INTERFACE calculateMassMatrLumped
      MODULE PROCEDURE calculateMassMatrLumped_new
   END INTERFACE calculateMassMatrLumped
 
-  public:: ReadMeshGMSH2, coord_kinetic, calculateMassMatrLumped
-  
+  INTERFACE voisinage
+     MODULE PROCEDURE voisinage_new
+  END INTERFACE voisinage
+
+  PUBLIC:: ReadMeshGMSH2, coord_kinetic, calculateMassMatrLumped
+
 CONTAINS
 
 
@@ -107,7 +111,7 @@ CONTAINS
     ALLOCATE (Physname(Nphys))
     DO i=1,Nphys
        READ(UNIT,*) dummy,idummy,PhysName(idummy)
-       PRINT*, trim(adjustl(physName(idummy)))
+       PRINT*, TRIM(ADJUSTL(physName(idummy)))
     ENDDO
 
     READ(UNIT,*) !!$EndPhysicalNames
@@ -247,7 +251,7 @@ CONTAINS
 
        ALLOCATE(Mesh%e(ii)%base_at_dofs( SIZE(ele(i)%nu), SIZE(ele(i)%nu)))
        ALLOCATE(Mesh%e(ii)%inv_base_at_dofs( SIZE(ele(i)%nu), SIZE(ele(i)%nu)))
-       allocate(Mesh%e(ii)%grad_at_dofs(n_dim,SIZE(ele(i)%nu), SIZE(ele(i)%nu)))
+       ALLOCATE(Mesh%e(ii)%grad_at_dofs(n_dim,SIZE(ele(i)%nu), SIZE(ele(i)%nu)))
 
        CALL Mesh%e(ii)%base_ref()
        CALL Mesh%e(ii)%grad_ref()
@@ -374,8 +378,8 @@ CONTAINS
   ! MatLumped         is the global lumped mass matrix (Fortran)
   ! MatLumpedInv      is its inverse (using Inverse function from algebra.f90)
   SUBROUTINE calculateMassMatrLumped_old(DATA, Mesh)
-    implicit none
-          CHARACTER(LEN = *), PARAMETER :: mod_name = "calculateMassMatrLumped_old"
+    IMPLICIT NONE
+    CHARACTER(LEN = *), PARAMETER :: mod_name = "calculateMassMatrLumped_old"
     TYPE(donnees),            INTENT(in) :: DATA
     TYPE(maillage),           INTENT(inout) :: Mesh
     TYPE(element)              :: e
@@ -420,7 +424,7 @@ CONTAINS
 
 
   SUBROUTINE calculateMassMatrLumped_new(DATA, Mesh)
-    implicit none
+    IMPLICIT NONE
     CHARACTER(LEN = *), PARAMETER :: mod_name ="calculateMassMatrLumped_new"
     TYPE(donnees),            INTENT(in) :: DATA
     TYPE(maillage),           INTENT(inout) :: Mesh
@@ -495,7 +499,7 @@ CONTAINS
     END SUBROUTINE volume
   END SUBROUTINE calculateMassMatrLumped_new
 
- SUBROUTINE coord_kinetic_old(Mesh)
+  SUBROUTINE coord_kinetic_old(Mesh)
     IMPLICIT NONE
     CHARACTER(LEN = *), PARAMETER :: mod_name ="coord_kinetic_old"
     TYPE(maillage), INTENT(inout):: Mesh
@@ -590,29 +594,29 @@ CONTAINS
     INTEGER                              :: ndim=2
     vals=0._dp
 
-! e%nsommet=3,triangle
-       VALS(1  ,1,3)=1._qp/6._qp
-       VALS(2:3,1,3)=1._qp/12._qp
-       VALS(2  ,2,3)=VALS(1,1,3)
-       VALS(1  ,2,3)=VALS(2,1,3)
-       VALS(3  ,2,3)=VALS(2,1,3)
-       VALS(1:2,3,3)=VALS(2,1,3)
-       VALS(3  ,3,3)=VALS(1,1,3)
-! e%nsommet=6,triangle
-       VALS(1,1,6)=1._qp/10._qp
-       VALS(2:3,1,6)=1._qp/30._qp
-       VALS(2,2,6)=VALS(1,1,6)
-       VALS(1,2,6)=VALS(2,1,6)
-       VALS(3,2,6)=VALS(2,1,6)
-       VALS(1:2,3,6)=VALS(2,1,6)
-       VALS(3,3,6)=VALS(1,1,6)
-       VALS(3,4,6)=1._qp/30._qp
-       VALS(2,5,6)=VALS(3,4,6)
-       VALS(1,6,6)=VALS(3,4,6)
-       VALS(1:2,4,6)=1._qp/15._qp
-       VALS(2:3,6,6)=1._qp/15._qp
-       VALS(1,5,6)=1._qp/15._qp
-       VALS(3,5,6)=1._qp/15._qp
+    ! e%nsommet=3,triangle
+    VALS(1  ,1,3)=1._qp/6._qp
+    VALS(2:3,1,3)=1._qp/12._qp
+    VALS(2  ,2,3)=VALS(1,1,3)
+    VALS(1  ,2,3)=VALS(2,1,3)
+    VALS(3  ,2,3)=VALS(2,1,3)
+    VALS(1:2,3,3)=VALS(2,1,3)
+    VALS(3  ,3,3)=VALS(1,1,3)
+    ! e%nsommet=6,triangle
+    VALS(1,1,6)=1._qp/10._qp
+    VALS(2:3,1,6)=1._qp/30._qp
+    VALS(2,2,6)=VALS(1,1,6)
+    VALS(1,2,6)=VALS(2,1,6)
+    VALS(3,2,6)=VALS(2,1,6)
+    VALS(1:2,3,6)=VALS(2,1,6)
+    VALS(3,3,6)=VALS(1,1,6)
+    VALS(3,4,6)=1._qp/30._qp
+    VALS(2,5,6)=VALS(3,4,6)
+    VALS(1,6,6)=VALS(3,4,6)
+    VALS(1:2,4,6)=1._qp/15._qp
+    VALS(2:3,6,6)=1._qp/15._qp
+    VALS(1,5,6)=1._qp/15._qp
+    VALS(3,5,6)=1._qp/15._qp
 !!!
     ALLOCATE(coords(ndim, Mesh%ndofs))
 
@@ -631,7 +635,7 @@ CONTAINS
              coords(:,e%nu(l))=coords(:,e%nu(l))+ e%yy(:,l) *e%volume
           ENDDO
        CASE(4) ! quadrangle
-           DO l=1, e%nsommets
+          DO l=1, e%nsommets
              CALL machin(l,e,z)
              e%yy(:,l)=z/e%volume
              coords(:,e%nu(l))=coords(:,e%nu(l))+ z
@@ -673,22 +677,22 @@ CONTAINS
       REAL(dp), DIMENSION(2)   :: z
       REAL(dp), DIMENSION(2,2) :: jac
       REAL(dp), DIMENSION(2)   :: a,b,c
-      
+
       y(:)=0._dp; vol=0._dp
       DO iq=1, e%nquad
-         
+
          x=e%quad(1:2,iq)
-z=e%iso(x)
-!         a=e%coor(:,2)-e%coor(:,1)
-!         b=e%coor(:,4)-e%coor(:,1)
-!         c=e%coor(:,3)-e%coor(:,2)+e%coor(:,1)-e%coor(:,4)
-!         z=e%coor(:,1)+ ( a+c*x(2) )*x(1) + b*x(2) ! location of the point thanks to iso parametric transformation
-
-!         jac(1,1)=a(1)+x(2)*c(1)
-!         Jac(1,2)=b(1)+x(1)*c(1)
-!         Jac(2,1)=a(2)+x(2)*c(2)
-!         Jac(2,2)=b(2)+x(1)*c(2)
-Jac=e%d_iso(x)
+         z=e%iso(x)
+         !         a=e%coor(:,2)-e%coor(:,1)
+         !         b=e%coor(:,4)-e%coor(:,1)
+         !         c=e%coor(:,3)-e%coor(:,2)+e%coor(:,1)-e%coor(:,4)
+         !         z=e%coor(:,1)+ ( a+c*x(2) )*x(1) + b*x(2) ! location of the point thanks to iso parametric transformation
+
+         !         jac(1,1)=a(1)+x(2)*c(1)
+         !         Jac(1,2)=b(1)+x(1)*c(1)
+         !         Jac(2,1)=a(2)+x(2)*c(2)
+         !         Jac(2,2)=b(2)+x(1)*c(2)
+         Jac=e%d_iso(x)
 
          det=ABS( Jac(1,1)*Jac(2,2) - Jac(1,2)*Jac(2,1) )
          phi=e%base(l,x(1:2))
@@ -697,13 +701,13 @@ Jac=e%d_iso(x)
       ENDDO
 
     END SUBROUTINE machin
-    
+
 
   END SUBROUTINE coord_kinetic_new
 
 
-  
- 
+
+
   SUBROUTINE coord_kinetic_ent(Mesh)
     IMPLICIT NONE
     CHARACTER(LEN = *), PARAMETER :: mod_name ="coord_kinetic entropy"
@@ -712,24 +716,65 @@ Jac=e%d_iso(x)
   END SUBROUTINE coord_kinetic_ent
 
 
-  SUBROUTINE voisinage(Mesh)
+  SUBROUTINE voisinage_old(Mesh)
+    IMPLICIT NONE
+    CHARACTER(LEN = *), PARAMETER :: mod_name = "voisinage_old"
+
+    TYPE(Maillage), INTENT(inout):: mesh
+    TYPE(element):: e
+    INTEGER:: jt, k, is
+    INTEGER, DIMENSION(:), ALLOCATABLE:: is2jt, compte
+    ALLOCATE(is2jt(Mesh%ns), compte(Mesh%ns) )
+    is2jt=0
+    compte=0
+    DO jt=1, Mesh%nt
+       e=Mesh%e(jt)
+       DO k=1, e%nvertex!sommets
+          is2jt(e%nu(k))=is2jt(e%nu(k))+1 ! number of element that contain the vertex is
+       ENDDO
+    ENDDO
+    ALLOCATE (Mesh%vois(Mesh%ns))!dofs) )
+    DO is=1, Mesh%ns!dofs
+       ALLOCATE(Mesh%vois(is)%nvois(is2jt(is)), Mesh%vois(is)%loc(is2jt(is)) )
+       Mesh%vois(is)%nvois=0
+    ENDDO
+
+
+    DO jt=1, Mesh%nt
+       e=Mesh%e(jt)
+
+       DO k=1, e%nvertex!sommets
+          compte(e%nu(k))=compte(e%nu(k))+1
+          mesh%vois( e%nu(k) )%nvois( compte(e%nu(k)) )=jt ! index of the element that contains e%nu(k)<->is
+          mesh%vois( e%nu(k) )%loc( compte(e%nu(k)) )=k    ! in that element is=e%nu(k) is number k
+       ENDDO
+    ENDDO
+    DO is=1, Mesh%ns!dofs
+       mesh%vois(is)%nbre=SIZE(Mesh%vois(is)%nvois) ! how many element contain is
+    ENDDO
+
+
+    DEALLOCATE(compte, is2jt)
+  END SUBROUTINE voisinage_old
+
+  SUBROUTINE voisinage_new(Mesh)
     IMPLICIT NONE
-          CHARACTER(LEN = *), PARAMETER :: mod_name = "voisinage"
+    CHARACTER(LEN = *), PARAMETER :: mod_name = "voisinage_new"
 
     TYPE(Maillage), INTENT(inout):: mesh
-    type(element):: e
+    TYPE(element):: e
     INTEGER:: jt, k, is
-    integer, dimension(:), allocatable:: is2jt, compte
+    INTEGER, DIMENSION(:), ALLOCATABLE:: is2jt, compte
     ALLOCATE(is2jt(Mesh%ns), compte(Mesh%ns) )
     is2jt=0
     compte=0
     DO jt=1, Mesh%nt
        e=Mesh%e(jt)
        DO k=1, e%nvertex!sommets
-          is2jt(e%nu(k))=is2jt(e%nu(k))+1
+          is2jt(e%nu(k))=is2jt(e%nu(k))+1 ! number of element that contain the vertex is
        ENDDO
     ENDDO
-    allocate (Mesh%vois(Mesh%ns))!dofs) )
+    ALLOCATE (Mesh%vois(Mesh%ns))!dofs) )
     DO is=1, Mesh%ns!dofs
        ALLOCATE(Mesh%vois(is)%nvois(is2jt(is)), Mesh%vois(is)%loc(is2jt(is)) )
        Mesh%vois(is)%nvois=0
@@ -741,16 +786,16 @@ Jac=e%d_iso(x)
 
        DO k=1, e%nvertex!sommets
           compte(e%nu(k))=compte(e%nu(k))+1