Initial commit from Polytechnique Montreal

1 files changed, 1603 insertions, 0 deletions

diff --git a/Trivac/src/NEIGH1.f b/Trivac/src/NEIGH1.f
new file mode 100755
index 0000000..1293bab
--- /dev/null
+++ b/Trivac/src/NEIGH1.f
@@ -0,0 +1,1603 @@
+*DECK NEIGH1
+      SUBROUTINE NEIGH1 (NC,N,K,M,POIDS)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Compute the index of a neighbour hexagon for a given symmetry.
+* The following SUBROUTINE points are available:
+* NEIGH1: S30 symmetry;              NEIGH2: SA60 symmetry;
+* NEIGH3: SB60 symmetry;             NEIGH4: S90 symmetry;
+* NEIGH5: R120 symmetry;             NEIGH6: R180 symmetry;
+* NEIGH7: SA180 symmetry;            NEIGH8: SB180 symmetry;
+* NEIGH9: complete assembly;         NEIG10: S30 symmetry with HBC SYME;
+* NEIG11: SA60 symmetry with HBC SYME.
+*
+*Copyright:
+* Copyright (C) 2002 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): A. Benaboud
+*
+*Parameters: input
+* NC      total number of hexagonal crowns.
+* N       index of the considered hexagon.
+* K       index of the side.
+* POIDS   weight of the hexagon.
+*
+*Parameters: output
+* M       index of the neighbour hexagon (=n: reflection on side k;
+*         .LT.0: axial symmetry or rotation).
+*
+*-----------------------------------------------------------------------
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      FSTA(1) = 1
+      IL=0
+      DO 1 L = 1,NC+1,2
+         NBA(L)   = 1+IL
+         NBA(L+1) = 1+IL
+         IL = IL+1
+ 1    CONTINUE
+      DO 2 L = 2,NC+1
+         FSTA(L) = FSTA(L-1)+NBA(L-1)
+ 2    CONTINUE
+      IL=0
+      DO 3 L = 1,NC+1,2
+         LSTA(L)   = FSTA(L)+IL
+         LSTA(L+1) = FSTA(L+1)+IL
+         IL = IL+1
+ 3    CONTINUE
+*
+      I=1
+      IF (N.GT.1) THEN
+         I=0
+         DO 4 I0 = 1,NC
+            IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+               I=I0
+               GO TO 5
+            ENDIF
+ 4       CONTINUE
+ 5       IF (I.EQ.0) CALL XABORT('NEIGH1: ALGORITHM FAILURE.')
+      ENDIF
+*
+      N1 = FSTA(I)
+      N2 = LSTA(I)
+      EVEN = MOD(I,2).EQ.0
+*
+      IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M = 2
+         ELSE IF (EVEN) THEN
+            M = N+NBA(I)+1
+         ELSE IF (.NOT.EVEN) THEN
+            M = N+NBA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.N2) THEN
+            M = -(LSTA(I+1)-1)
+         ELSE
+            M =  N+1
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF ((N.EQ.1).OR.(N.EQ.2)) THEN
+            M = -2
+         ELSE IF (N.EQ.N2) THEN
+            M = -(N-1)
+         ELSE IF (EVEN) THEN
+            M =  N-NBA(I-1)+1
+         ELSE IF (.NOT.EVEN) THEN
+            M =  N-NBA(I-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I-1)
+         ELSE IF (EVEN) THEN
+            M =  N-NBA(I-1)
+         ELSE IF (.NOT.EVEN) THEN
+            M =  N-NBA(I-1)-1
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  N
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -(N+1)
+         ELSE
+            M =  N-1
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I+1)
+         ELSE IF (EVEN) THEN
+            M =  N+NBA(I)
+         ELSE IF (.NOT.EVEN) THEN
+            M =  N+NBA(I)-1
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 1./12.
+      ELSE IF (N.EQ.N2) THEN
+         POIDS = 0.5
+      ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH2 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      NBA(1)  = 1
+      LSTA(1) = 1
+      FSTA(1) = 1
+      FSTA(2) = 2
+      DO 7 L = 2,NC+1
+         NBA(L)  = L
+         LSTA(L) = L+LSTA(L-1)
+         FSTA(L+1) = L+FSTA(L)
+ 7    CONTINUE
+*
+      I=0
+      DO 8 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 9
+         ENDIF
+ 8    CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIGH2: ALGORITHM FAILURE.')
+*
+ 9    N1 = FSTA(I)
+      N2 = LSTA(I)
+*
+      IF (K.EQ.1) THEN
+*
+         M =  N+NBA(I)+1
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.N2) THEN
+            M = -(N+NBA(I))
+         ELSE
+            M =  N+1
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF (N.EQ.N2) THEN
+            M = -(N-1)
+         ELSE
+            M =  N-NBA(I-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.N1) THEN
+            M = -(N+1)
+         ELSE
+            M =  N-NBA(I-1)-1
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.N1) THEN
+            M = -(N+NBA(I)+1)
+         ELSE
+            M =  N-1
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         M =  N+NBA(I)
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 1./6.
+      ELSE IF ((N.EQ.N1).OR.(N.EQ.N2)) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH3 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      LSTA(1) = 1
+      FSTA(1) = 1
+      IL=0
+      DO 10 L = 1,NC+1,2
+         NBA(L)   = 1+IL
+         NBA(L+1) = 1+IL
+         IL = IL+2
+ 10   CONTINUE
+      DO 11 L = 2,NC+1
+         FSTA(L) = FSTA(L-1)+NBA(L-1)
+        LSTA(L) = NBA(L)+LSTA(L-1)
+ 11   CONTINUE
+*
+      I=0
+      N1=0
+      N2=0
+      N3=0
+      IF (N.EQ.1) GOTO 14
+      DO 12 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 13
+         ENDIF
+ 12   CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIGH3: ALGORITHM FAILURE.')
+*
+ 13   N1 = FSTA(I)
+      N2 = (FSTA(I)+LSTA(I))/2
+      N3 = LSTA(I)
+      EVEN = MOD(I,2).EQ.0
+*
+ 14   IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  2
+         ELSE IF ((N.GE.N1).AND.(N.LE.N3)) THEN
+            M =  N+I
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.2) THEN
+            M =  5
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+I+1
+         ELSE IF ((N.EQ.N3).AND.EVEN) THEN
+            M =  LSTA(I+1)
+         ELSE IF ((N.EQ.N3).AND.(.NOT.EVEN)) THEN
+            M = -LSTA(I+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.2) THEN
+            M =  2
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N+2-I
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+1
+         ELSE IF ((N.EQ.N3).AND.EVEN) THEN
+            M =  N
+         ELSE IF ((N.EQ.N3).AND.(.NOT.EVEN)) THEN
+            M = -(N-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  N+1-I
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -(N+2-I)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3)) THEN
+            M =  N+1-I
+         ELSE IF ((N.EQ.N3).AND.EVEN) THEN
+            M =  N+1-I
+         ELSE IF ((N.EQ.N3).AND.(.NOT.EVEN)) THEN
+            M = -(N-I)
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  N
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -(N+1)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-I
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  N+I-1
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -(N+I)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N+I-1
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-1
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 1./6.
+      ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.5
+      ELSE IF ((N.EQ.N3).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH4 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA,INTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2),INTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      INTA(:NC+2)=0
+      LSTA(1) = 1
+      FSTA(1) = 1
+      IL=0
+      DO 15 L = 1,NC+1,2
+         NBA(L)   = L+IL
+         NBA(L+1) = L+1+IL
+         IL = IL+1
+ 15   CONTINUE
+      DO 16 L = 2,NC+1
+         FSTA(L) = FSTA(L-1)+NBA(L-1)
+         LSTA(L) = NBA(L)+LSTA(L-1)
+ 16   CONTINUE
+      IL=0
+      DO 17 L = 1,NC+1,2
+         INTA(L)   = FSTA(L)+IL
+         INTA(L+1) = FSTA(L+1)+IL
+         IL = IL+1
+ 17   CONTINUE
+*
+      I=0
+      N1=0
+      N2=0
+      N3=0
+      IF (N.EQ.1) GOTO 20
+      DO 18 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 19
+         ENDIF
+ 18   CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIGH4: ALGORITHM FAILURE.')
+*
+ 19   N1 = FSTA(I)
+      N2 = INTA(I)
+      N3 = LSTA(I)
+      EVEN = MOD(I,2).EQ.0
+*
+ 20   IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  2
+         ELSE IF ((N.GE.N1).AND.(N.LE.N3).AND.EVEN) THEN
+            M =  N+NBA(I)+1
+         ELSE IF ((N.GE.N1).AND.(N.LE.N3).AND.(.NOT.EVEN)) THEN
+            M =  N+NBA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  3
+         ELSE IF (N.EQ.2) THEN
+            M =  6
+         ELSE IF (N.EQ.N1) THEN
+            M =  N+1
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N2).AND.(N.LE.N3)) THEN
+            M =  N+NBA(I+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.2) THEN
+            M =  3
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  FSTA(I-1)+1
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M =  FSTA(I-1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2).AND.EVEN) THEN
+            M =  N-(I-1)-(INTA(I-1)-FSTA(I-1))+1
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2).AND.(.NOT.EVEN)) THEN
+            M =  N-(I-1)-(INTA(I-1)-FSTA(I-1))
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+1
+         ELSE IF (N.EQ.N3) THEN
+            M = -(LSTA(I+1)-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  FSTA(I-1)
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I-1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3).AND.EVEN) THEN
+            M =  N-NBA(I-1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3).AND.(.NOT.EVEN)) THEN
+            M =  N-NBA(I-1)-1
+         ELSE IF (N.EQ.N3) THEN
+            M = -(N-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  N
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -(N+1)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-NBA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  FSTA(I+1)
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I+1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2).AND.EVEN) THEN
+            M =  N+I+INTA(I)-FSTA(I)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2).AND.(.NOT.EVEN)) THEN
+            M =  N+I+INTA(I)-FSTA(I)-1
+         ELSE IF (N.EQ.N2) THEN
+            M =  INTA(I+1)-1
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-1
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 0.25
+      ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.5
+      ELSE IF (N.EQ.N3) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA,INTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH5 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      NBA (1) = 1
+      LSTA(1) = 1
+      FSTA(1) = 1
+      DO 21 L = 2,NC+1
+         NBA(L)  = 2*(L-1)
+         LSTA(L) = NBA(L)+LSTA(L-1)
+         FSTA(L) = NBA(L-1)+FSTA(L-1)
+ 21   CONTINUE
+*
+      I=0
+      DO 22 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 23
+         ENDIF
+ 22   CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIGH5: ALGORITHM FAILURE.')
+*
+ 23   N1 = FSTA(I)
+      N2 = FSTA(I) + (I-2)
+      N3 = LSTA(I)
+*
+      IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  2
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2).AND.(N.NE.1)) THEN
+            M =  N+NBA(I+1)-1
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+NBA(I)+1
+         ELSE IF (N.EQ.N3) THEN
+            M =  N+NBA(I+1)-1
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  3
+         ELSE IF (N.EQ.2) THEN
+            M =  6
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+NBA(I)+2
+         ELSE IF (N.EQ.N3) THEN
+            M =  N+NBA(I+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.2) THEN
+            M =  3
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2).AND.(N.NE.1)) THEN
+            M =  N-NBA(I-1)
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+1
+         ELSE IF (N.EQ.N3) THEN
+            M = -(N+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF (N.EQ.2) THEN
+            M =  1
+         ELSE IF (N.EQ.3) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.(N.NE.1)) THEN
+            M = -LSTA(I-1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3)) THEN
+            M =  N-NBA(I-1)-1
+         ELSE IF ((N.EQ.N3).AND.(N.NE.3)) THEN
+            M = -(N-NBA(I-1)-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.2) THEN
+            M = -3
+         ELSE IF ((N.EQ.N1).AND.(N.NE.1)) THEN
+            M = -LSTA(I)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2).AND.(N.NE.3)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N2).AND.(N.LT.N3)) THEN
+            M =  N-NBA(I-1)-2
+         ELSE IF (N.EQ.N3) THEN
+            M =  N-NBA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF (N.EQ.3) THEN
+            M =  2
+         ELSE IF ((N.EQ.N1).AND.(N.NE.1)) THEN
+            M =  FSTA(I+1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2)) THEN
+            M =  N+NBA(I+1)-2
+         ELSE IF (N.EQ.N2) THEN
+            M =  N+NBA(I)
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-1
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 1./3.
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH6 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      NBA (1) = 1
+      LSTA(1) = 1
+      FSTA(1) = 1
+      DO 24 L = 2,NC+1
+         NBA(L)  = 3*(L-1)
+         LSTA(L) = NBA(L)+LSTA(L-1)
+         FSTA(L) = NBA(L-1)+FSTA(L-1)
+ 24   CONTINUE
+*
+      I=0
+      N1=0
+      N2=0
+      N3=0
+      N4=0
+      IF (N.EQ.1) GOTO 27
+      DO 25 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 26
+         ENDIF
+ 25   CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIGH6: ALGORITHM FAILURE.')
+*
+ 26   N1 = FSTA(I)
+      N2 = LSTA(I-1) +   (I-1)
+      N3 = LSTA(I-1) + 2*(I-1)
+      N4 = LSTA(I)
+*
+ 27   IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  3
+         ELSE IF (N.EQ.2) THEN
+            M =  7
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N2).AND.(N.LE.N4)) THEN
+            M =  N+NBA(I)+2
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  4
+         ELSE IF (N.EQ.2) THEN
+            M =  3
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N-NBA(I-1)
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N3).AND.(N.LE.N4)) THEN
+            M =  N+NBA(I+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.2) THEN
+            M =  1
+         ELSE IF (N.EQ.N1) THEN
+            M = -(N-1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3)) THEN
+            M =  N-NBA(I-1)-1
+         ELSE IF ((N.GE.N3).AND.(N.LT.N4)) THEN
+            M =  N+1
+         ELSE IF (N.EQ.N4) THEN
+            M = -(N+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF (N.EQ.2) THEN
+            M = -4
+         ELSE IF (N.EQ.3) THEN
+            M =  1
+         ELSE IF (N.EQ.N1) THEN
+            M = -LSTA(I)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N2).AND.(N.LT.N4)) THEN
+            M =  N-NBA(I)+1
+         ELSE IF (N.EQ.N4) THEN
+            M = -(N-NBA(I)+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -4
+         ELSE IF (N.EQ.3) THEN
+            M =  2
+         ELSE IF ((N.GE.N1).AND.(N.LE.N2)) THEN
+            M =  N+NBA(I)
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N3).AND.(N.LE.N4)) THEN
+            M =  N-NBA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  2
+         ELSE IF ((N.GE.N1).AND.(N.LE.N3)) THEN
+            M =  N+NBA(I)+1
+         ELSE IF ((N.GT.N3).AND.(N.LE.N4)) THEN
+            M =  N-1
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 1./2.
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH7 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      NBA (1) = 1
+      LSTA(1) = 1
+      FSTA(1) = 1
+      DO 28 L = 2,NC+1
+         NBA(L)  = 3+NBA(L-1)
+         LSTA(L) = NBA(L)+LSTA(L-1)
+         FSTA(L) = 1+LSTA(L-1)
+ 28   CONTINUE
+*
+      I=0
+      DO 29 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 30
+         ENDIF
+ 29   CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIGH7: ALGORITHM FAILURE.')
+*
+ 30   N1 = FSTA(I)
+      N2 = FSTA(I) + (I-1)
+      N3 = FSTA(I) + 2*(I-1)
+      N4 = LSTA(I)
+*
+      IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  4
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2).AND.(N.NE.1)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  NBA(I)+N+2
+         ELSE IF ((N.GE.N3).AND.(N.LE.N4)) THEN
+            M =  NBA(I+1)+N-1
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  5
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2).AND.(N.NE.1)) THEN
+            M =  N-NBA(I-1)
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N3).AND.(N.LE.N4)) THEN
+            M =  N+NBA(I+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -4
+         ELSE IF ((N.EQ.N1).AND.(N.NE.1)) THEN
+            M = -(N+1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3)) THEN
+            M =  N-NBA(I-1)-1
+         ELSE IF ((N.GE.N3).AND.(N.LT.N4)) THEN
+            M =  N+1
+         ELSE IF (N.EQ.N4) THEN
+            M = -(N+NBA(I+1)-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF ((N.EQ.N1).AND.(N.NE.1)) THEN
+            M = -(FSTA(I+1)+1)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N2).AND.(N.LT.N3)) THEN
+            M =  N-NBA(I-1)-2
+         ELSE IF ((N.GE.N3).AND.(N.LT.N4)) THEN
+            M =  N-NBA(I)+1
+         ELSE IF (N.EQ.N4) THEN
+            M = -(N-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.N1) THEN
+            M =  FSTA(I+1)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N+NBA(I)
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N3).AND.(N.LE.N4)) THEN
+            M =  N-NBA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.N1) THEN
+            M =  FSTA(I+1)+1
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3)) THEN
+            M =  N+NBA(I)+1
+         ELSE IF (N.EQ.N3) THEN
+            M =  N+NBA(I+1)-2
+         ELSE IF ((N.GT.N3).AND.(N.LE.N4)) THEN
+            M =  N-1
+         ENDIF
+*
+      ENDIF
+*
+      IF ((N.EQ.N1).OR.(N.EQ.N4)) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH8 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      NBA (1) = 1
+      LSTA(1) = 1
+      FSTA(1) = 1
+      DO 31 L = 2,NC+1,2
+         NBA(L)  = 3*(L-1)
+         NBA(L+1)  = 3*L+1
+ 31   CONTINUE
+      DO 32 L = 2,NC+1
+         LSTA(L) = NBA(L)+LSTA(L-1)
+         FSTA(L) = NBA(L-1)+FSTA(L-1)
+ 32   CONTINUE
+*
+      I=0
+      N1=0
+      N2=0
+      N3=0
+      N4=0
+      N5=0
+      IF (N.EQ.1) GOTO 35
+      DO 33 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 34
+         ENDIF
+ 33   CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIGH8: ALGORITHM FAILURE.')
+*
+ 34   N1 = FSTA(I)
+      N2 = (FSTA(I) + LSTA(I))/2 - (I-1)
+      N3 = (FSTA(I) + LSTA(I))/2
+      N4 = (FSTA(I) + LSTA(I))/2 + (I-1)
+      N5 = LSTA(I)
+      EVEN = MOD(I,2).EQ.0
+*
+ 35   IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  2
+         ELSE IF ((N.GE.N1).AND.(N.LE.N3)) THEN
+            M =  N+3*I-2
+         ELSE IF ((N.GT.N3).AND.(N.LE.N4)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N4).AND.(N.LE.N5)) THEN
+            M =  N-(3*I-2)
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  3
+         ELSE IF (N.EQ.2) THEN
+            M =  7
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N2).AND.(N.LE.N4)) THEN
+            M =  N+3*I-1
+         ELSE IF ((N.GT.N4).AND.(N.LE.N5)) THEN
+            M =  N-1
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  4
+         ELSE IF (N.EQ.2) THEN
+            M =  3
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N-3*(I-2)
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N3).AND.(N.LE.N5)) THEN
+            M =  N+3*I
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -4
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  FSTA(I-1)
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I-1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3)) THEN
+            M =  N-3*I+5
+         ELSE IF ((N.GE.N3).AND.(N.LT.N4)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N4).AND.(N.LT.N5)) THEN
+            M =  N+3*I+1
+         ELSE IF ((N.EQ.N5).AND.EVEN) THEN
+            M =  LSTA(I+1)
+         ELSE IF ((N.EQ.N5).AND.(.NOT.EVEN)) THEN
+            M = -LSTA(I+1)
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  N
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -(N+1)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N2).AND.(N.LT.N4)) THEN
+            M =  N-3*I+4
+         ELSE IF ((N.GE.N4).AND.(N.LT.N5)) THEN
+            M =  N+1
+         ELSE IF ((N.EQ.N5).AND.EVEN) THEN
+            M =  N
+         ELSE IF ((N.EQ.N5).AND.(.NOT.EVEN)) THEN
+            M = -(N-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  FSTA(I+1)
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I+1)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N+3*(I-1)
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N3).AND.(N.LT.N5)) THEN
+            M =  N-3*(I-1)
+         ELSE IF ((N.EQ.N5).AND.EVEN) THEN
+            M =  LSTA(I-1)
+         ELSE IF ((N.EQ.N5).AND.(.NOT.EVEN)) THEN
+            M = -LSTA(I-1)
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 0.5
+      ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.5
+      ELSE IF ((N.EQ.N5).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIGH9 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      POIDS = 1.
+      NBA(1)  = 1
+      LSTA(1) = 1
+      FSTA(1) = 1
+      DO 36 L = 2,NC+1
+         NBA(L)  = (L-1)*6
+         LSTA(L) = 1+3*L*(L-1)
+         FSTA(L) = 1+LSTA(L-1)
+ 36   CONTINUE
+*
+      I=0
+      IF (N.EQ.1) THEN
+         M =  K+1
+         RETURN
+      ELSE IF(N.GT.1) THEN
+         DO 37 I0 = 2,NC
+            IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+               I=I0
+               GO TO 38
+            ENDIF
+ 37      CONTINUE
+         IF (I.EQ.0) CALL XABORT('NEIGH9: ALGORITHM FAILURE.')
+      ENDIF
+*
+ 38   N1 = FSTA(I)
+      N2 = FSTA(I) + (I-1)
+      N3 = FSTA(I) + 2*(I-1)
+      N4 = FSTA(I) + 3*(I-1)
+      N5 = FSTA(I) + 4*(I-1)
+      N6 = FSTA(I) + 5*(I-1)
+      N7 = LSTA(I)
+*
+      IF (K.EQ.1) THEN
+*
+         IF (N.EQ.N1) THEN
+            M =  FSTA(I+1)
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2)) THEN
+            M =  N+NBA(I)
+         ELSE IF (N.EQ.N2) THEN
+            M =  FSTA(I+1)+I-1
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N3).AND.(N.LT.N4)) THEN
+            M =  N-NBA(I-1)-3
+         ELSE IF (N.EQ.5) THEN
+            M =  1
+         ELSE IF (N.EQ.N4) THEN
+            M =  FSTA(I-1)+3*(I-2)
+         ELSE IF ((N.GT.N4).AND.(N.LT.N5)) THEN
+            M =  N-NBA(I-1)-3
+         ELSE IF ((N.GE.N5).AND.(N.LT.N6)) THEN
+            M =  N+1
+         ELSE IF (N.EQ.7) THEN
+            M =  19
+         ELSE IF ((N.GE.N6).AND.(N.LE.N7)) THEN
+            M =  N+NBA(I)+6
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.N1) THEN
+            M =  FSTA(I+1)+1
+         ELSE IF ((N.GT.N1).AND.(N.LT.N2)) THEN
+            M =  N+NBA(I)+1
+         ELSE IF (N.EQ.N2) THEN
+            M =  FSTA(I+1)+I
+         ELSE IF ((N.GT.N2).AND.(N.LE.N3)) THEN
+            M =  N+NBA(I)+1
+         ELSE IF ((N.GT.N3).AND.(N.LE.N4)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N4).AND.(N.LT.N5)) THEN
+            M =  N-NBA(I-1)-4
+         ELSE IF (N.EQ.6) THEN
+            M =  1
+         ELSE IF (N.EQ.N5) THEN
+            M =  FSTA(I-1)+4*(I-2)
+         ELSE IF ((N.GT.N5).AND.(N.LT.N6)) THEN
+            M =  N-NBA(I-1)-4
+         ELSE IF ((N.GE.N6).AND.(N.LT.N7)) THEN
+            M =  N+1
+         ELSE IF (N.EQ.N7) THEN
+            M =  FSTA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N+1
+         ELSE IF (N.EQ.N2) THEN
+            M =  FSTA(I+1)+I+1
+         ELSE IF ((N.GT.N2).AND.(N.LE.N4)) THEN
+            M =  N+NBA(I)+2
+         ELSE IF ((N.GT.N4).AND.(N.LE.N5)) THEN
+            M =  N-1
+         ELSE IF (N.EQ.7) THEN
+            M =  1
+         ELSE IF ((N.GT.N5).AND.(N.LT.N7)) THEN
+            M =  N-NBA(I-1)-5
+         ELSE IF (N.EQ.N7) THEN
+            M =  FSTA(I-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.2) THEN
+            M =  1
+         ELSE IF ((N.GE.N1).AND.(N.LT.N2)) THEN
+            M =  N-NBA(I-1)
+         ELSE IF ((N.GE.N2).AND.(N.LT.N3)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N3).AND.(N.LE.N5)) THEN
+            M =  N+NBA(I)+3
+         ELSE IF ((N.GT.N5).AND.(N.LE.N6)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N6).AND.(N.LT.N7)) THEN
+            M =  N-NBA(I-1)-6
+         ELSE IF (N.EQ.N7) THEN
+            M =  LSTA(I-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.N1) THEN
+            M =  LSTA(I)
+         ELSE IF (N.EQ.3) THEN
+            M =  1
+         ELSE IF (N.EQ.7) THEN
+            M =  17
+         ELSE IF ((N.GT.N1).AND.(N.LT.N3)) THEN
+            M =  N-NBA(I-1)-1
+         ELSE IF ((N.GE.N3).AND.(N.LT.N4)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N4).AND.(N.LE.N6)) THEN
+            M =  N+NBA(I)+4
+         ELSE IF ((N.GT.N6).AND.(N.LE.N7)) THEN
+            M =  N-1
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.N1) THEN
+            M =  LSTA(I+1)
+         ELSE IF ((N.GT.N1).AND.(N.LE.N2)) THEN
+            M =  N-1
+         ELSE IF ((N.GT.N2).AND.(N.LT.N4)) THEN
+            M =  N-NBA(I-1)-2
+         ELSE IF ((N.GE.N4).AND.(N.LT.N5)) THEN
+            M =  N+1
+         ELSE IF ((N.GE.N5).AND.(N.LE.N7)) THEN
+            M =  N+NBA(I)+5
+         ENDIF
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIG10 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN,OUTER
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      FSTA(1) = 1
+      IL=0
+      DO 39 L = 1,NC+1,2
+         NBA(L)   = 1+IL
+         NBA(L+1) = 1+IL
+         IL = IL+1
+ 39   CONTINUE
+      DO 40 L = 2,NC+1
+         FSTA(L) = FSTA(L-1)+NBA(L-1)
+ 40   CONTINUE
+      IL=0
+      DO 41 L = 1,NC+1,2
+         LSTA(L)   = FSTA(L)+IL
+         LSTA(L+1) = FSTA(L+1)+IL
+         IL = IL+1
+ 41   CONTINUE
+*
+      I=1
+      IF (N.GT.1) THEN
+         I=0
+         DO 42 I0 = 1,NC
+            IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+               I=I0
+               GO TO 43
+            ENDIF
+ 42      CONTINUE
+ 43      IF (I.EQ.0) CALL XABORT('NEIG10: ALGORITHM FAILURE.')
+      ENDIF
+*
+      N1 = FSTA(I)
+      N2 = LSTA(I)
+      EVEN = MOD(I,2).EQ.0
+      OUTER = I.EQ.NC
+*
+      IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  2
+         ELSE IF (OUTER.AND.(N.EQ.2)) THEN
+            M = -2
+         ELSE IF (OUTER.AND.(N.EQ.N2)) THEN
+            M = -(N-1)
+         ELSE IF (OUTER.AND.EVEN) THEN
+            M = -(N-NBA(I-1)+1)
+         ELSE IF (OUTER.AND.(.NOT.EVEN)) THEN
+            M = -(N-NBA(I-1))
+         ELSE IF (EVEN) THEN
+            M =  N+NBA(I)+1
+         ELSE IF (.NOT.EVEN) THEN
+            M =  N+NBA(I)
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (OUTER.AND.(N.EQ.N2)) THEN
+            M = -LSTA(I-1)
+         ELSE IF (N.EQ.N2) THEN
+            M = -(LSTA(I+1)-1)
+         ELSE
+            M =  N+1
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF ((N.EQ.1).OR.(N.EQ.2)) THEN
+            M = -2
+         ELSE IF (N.EQ.N2) THEN
+            M = -(N-1)
+         ELSE IF (EVEN) THEN
+            M =  N-NBA(I-1)+1
+         ELSE IF (.NOT.EVEN) THEN
+            M =  N-NBA(I-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I-1)
+         ELSE IF (EVEN) THEN
+            M =  N-NBA(I-1)
+         ELSE IF (.NOT.EVEN) THEN
+            M =  N-NBA(I-1)-1
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF ((N.EQ.N1).AND.EVEN) THEN
+            M =  N
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -(N+1)
+         ELSE
+            M =  N-1
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (OUTER.AND.(N.EQ.N1)) THEN
+            M = -FSTA(I-1)
+         ELSE IF (OUTER.AND.EVEN) THEN
+            M = -(N-NBA(I-1))
+         ELSE IF (OUTER.AND.(.NOT.EVEN)) THEN
+            M = -(N-NBA(I-1)-1)
+         ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+            M = -FSTA(I+1)
+         ELSE IF (EVEN) THEN
+            M =  N+NBA(I)
+         ELSE IF (.NOT.EVEN) THEN
+            M =  N+NBA(I)-1
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 1./12.
+      ELSE IF (OUTER.AND.(N.EQ.N2)) THEN
+         POIDS = 1./6.
+      ELSE IF (OUTER.AND.(N.EQ.N1).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.25
+      ELSE IF (OUTER.OR.(N.EQ.N2)) THEN
+         POIDS = 0.5
+      ELSE IF ((N.EQ.N1).AND.(.NOT.EVEN)) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END
+*
+      SUBROUTINE NEIG11 (NC,N,K,M,POIDS)
+*
+*----
+*  SUBROUTINE ARGUMENTS
+*----
+      INTEGER   NC,N,K,M
+      REAL      POIDS
+*----
+*  LOCAL VARIABLES
+*----
+      LOGICAL   EVEN,OUTER
+      INTEGER, DIMENSION(:), ALLOCATABLE :: NBA,FSTA,LSTA
+*
+      ALLOCATE(NBA(NC+2),FSTA(NC+2),LSTA(NC+2))
+      EVEN=.TRUE.
+      NBA(:NC+2)=0
+      FSTA(:NC+2)=0
+      LSTA(:NC+2)=0
+      NBA(1)  = 1
+      LSTA(1) = 1
+      FSTA(1) = 1
+      FSTA(2) = 2
+      DO 45 L = 2,NC+1
+         NBA(L)  = L
+         LSTA(L) = L+LSTA(L-1)
+         FSTA(L+1) = L+FSTA(L)
+ 45   CONTINUE
+*
+      I=0
+      DO 46 I0 = 1,NC
+         IF ((N.GE.FSTA(I0)).AND.(N.LE.LSTA(I0))) THEN
+            I=I0
+            GO TO 47
+         ENDIF
+ 46   CONTINUE
+      IF (I.EQ.0) CALL XABORT('NEIG11: ALGORITHM FAILURE.')
+*
+ 47   N1 = FSTA(I)
+      N2 = LSTA(I)
+      OUTER = I.EQ.NC
+*
+      IF (K.EQ.1) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  3
+         ELSE IF (OUTER.AND.(N.EQ.N2)) THEN
+            M = -(N-1)
+         ELSE IF (OUTER) THEN
+            M = -(N-NBA(I-1))
+         ELSE
+            M =  N+NBA(I)+1
+         ENDIF
+*
+      ELSE IF (K.EQ.2) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (OUTER.AND.(N.EQ.N2)) THEN
+            M = -(N-NBA(I-1)-1)
+         ELSE IF (N.EQ.N2) THEN
+            M = -(N+NBA(I))
+         ELSE
+            M =  N+1
+         ENDIF
+*
+      ELSE IF (K.EQ.3) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF (N.EQ.N2) THEN
+            M = -(N-1)
+         ELSE
+            M =  N-NBA(I-1)
+         ENDIF
+*
+      ELSE IF (K.EQ.4) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -2
+         ELSE IF (N.EQ.N1) THEN
+            M = -(N+1)
+         ELSE
+            M =  N-NBA(I-1)-1
+         ENDIF
+*
+      ELSE IF (K.EQ.5) THEN
+*
+         IF (N.EQ.1) THEN
+            M = -3
+         ELSE IF (OUTER.AND.(N.EQ.N1)) THEN
+            M = -(N-NBA(I-1))
+         ELSE IF (N.EQ.N1) THEN
+            M = -(N+NBA(I)+1)
+         ELSE
+            M =  N-1
+         ENDIF
+*
+      ELSE IF (K.EQ.6) THEN
+*
+         IF (N.EQ.1) THEN
+            M =  2
+         ELSE IF (OUTER.AND.(N.EQ.N1)) THEN
+            M = -(N+1)
+         ELSE IF (OUTER) THEN
+            M = -(N-NBA(I-1)-1)
+         ELSE
+            M =  N+NBA(I)
+         ENDIF
+*
+      ENDIF
+*
+      IF (N.EQ.1) THEN
+         POIDS = 1./6.
+      ELSE IF (OUTER.AND.((N.EQ.N1).OR.(N.EQ.N2))) THEN
+         POIDS = 1./6.
+      ELSE IF (OUTER.OR.(N.EQ.N1).OR.(N.EQ.N2)) THEN
+         POIDS = 0.5
+      ELSE
+         POIDS = 1.
+      ENDIF
+      DEALLOCATE(NBA,FSTA,LSTA)
+      RETURN
+      END