Sources Esope | Cast3M

kdom9
C KDOM9     SOURCE    KK2000    14/04/10    21:15:15     8032
      SUBROUTINE KDOM9(NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
     &              NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20,
     &              NN21,NN22,NN23,NN24,NN25,NN26,NN27)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KDOM9
C
C DESCRIPTION       :  This subroutine check whether NN27 is inside of
C                      the CU27
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
C
C************************************************************************
C
C
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      INTEGER NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
     &     NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20,
     &     NN21,NN22,NN23,NN24,NN25,NN26,NN27, I1, IPCEN, IPL, IPR
      REAL*8 DX0,DY0,DZ0,DX1,DY1,DZ1,NORX1,NORY1,NORZ1,PSCA0,PSCA1
C
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
C
C**** First triangle
C
      IPCEN=NN1
      IPR=NN25
      IPL=NN7
      DX0=XCOOR((IPR-1)*(IDIM+1)+1)-
     &     XCOOR((IPCEN-1)*(IDIM+1)+1)
      DY0=XCOOR((IPR-1)*(IDIM+1)+2)-
     &     XCOOR((IPCEN-1)*(IDIM+1)+2)
      DZ0=XCOOR((IPR-1)*(IDIM+1)+3)-
     &     XCOOR((IPCEN-1)*(IDIM+1)+3)
      DX1=XCOOR((IPL-1)*(IDIM+1)+1)-
     &     XCOOR((IPCEN-1)*(IDIM+1)+1)
      DY1=XCOOR((IPL-1)*(IDIM+1)+2)-
     &     XCOOR((IPCEN-1)*(IDIM+1)+2)
      DZ1=XCOOR((IPL-1)*(IDIM+1)+3)-
     &        XCOOR((IPCEN-1)*(IDIM+1)+3)
      NORX1=(DY0*DZ1-DY1*DZ0)
      NORY1=(DZ0*DX1-DZ1*DX0)
      NORZ1=(DX0*DY1-DX1*DY0)
C
C     The scalar product between this normal and
C     CENTRE-IPCEN
C
      DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)-
     &     XCOOR((NN27-1)*(IDIM+1)+1)
      DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)-
     &     XCOOR((NN27-1)*(IDIM+1)+2)
      DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)-
     &     XCOOR((NN27-1)*(IDIM+1)+3)
      PSCA0=DX1*NORX1+DY1*NORY1+DZ1*NORZ1
C
C     The other triangles
C
      DO I1=1,23
         IF(I1.EQ.1)THEN
            IPCEN=NN3
            IPR=NN25
            IPL=NN1
         ELSEIF(I1.EQ.2)THEN
            IPCEN=NN5
            IPR=NN25
            IPL=NN3
         ELSEIF(I1.EQ.3)THEN
            IPCEN=NN7
            IPR=NN25
            IPL=NN5
         ELSEIF(I1.EQ.4)THEN
            IPCEN=NN13
            IPR=NN26
            IPL=NN15
         ELSEIF(I1.EQ.5)THEN
            IPCEN=NN19
            IPR=NN26
            IPL=NN13
         ELSEIF(I1.EQ.6)THEN
            IPCEN=NN17
            IPR=NN26
            IPL=NN19
         ELSEIF(I1.EQ.7)THEN
            IPCEN=NN15
            IPR=NN26
            IPL=NN17
         ELSEIF(I1.EQ.8)THEN
            IPCEN=NN1
            IPR=NN21
            IPL=NN3
         ELSEIF(I1.EQ.9)THEN
            IPCEN=NN13
            IPR=NN21
            IPL=NN1
         ELSEIF(I1.EQ.10)THEN
            IPCEN=NN15
            IPR=NN21
            IPL=NN13
         ELSEIF(I1.EQ.11)THEN
            IPCEN=NN3
            IPR=NN21
            IPL=NN15
         ELSEIF(I1.EQ.12)THEN
            IPCEN=NN3
            IPR=NN22
            IPL=NN5
         ELSEIF(I1.EQ.13)THEN
            IPCEN=NN15
            IPR=NN22
            IPL=NN3
         ELSEIF(I1.EQ.14)THEN
            IPCEN=NN17
            IPR=NN22
            IPL=NN15
         ELSEIF(I1.EQ.15)THEN
            IPCEN=NN5
            IPR=NN22
            IPL=NN17
         ELSEIF(I1.EQ.16)THEN
            IPCEN=NN7
            IPR=NN23
            IPL=NN19
         ELSEIF(I1.EQ.17)THEN
            IPCEN=NN5
            IPR=NN23
            IPL=NN7
         ELSEIF(I1.EQ.18)THEN
            IPCEN=NN17
            IPR=NN23
            IPL=NN5
         ELSEIF(I1.EQ.19)THEN
            IPCEN=NN19
            IPR=NN23
            IPL=NN17
         ELSEIF(I1.EQ.20)THEN
            IPCEN=NN1
            IPR=NN24
            IPL=NN13
         ELSEIF(I1.EQ.21)THEN
            IPCEN=NN7
            IPR=NN24
            IPL=NN1
         ELSEIF(I1.EQ.22)THEN
            IPCEN=NN19
            IPR=NN24
            IPL=NN7
         ELSEIF(I1.EQ.23)THEN
            IPCEN=NN13
            IPR=NN24
            IPL=NN19
         ENDIF
         DX0=XCOOR((IPR-1)*(IDIM+1)+1)-
     &        XCOOR((IPCEN-1)*(IDIM+1)+1)
         DY0=XCOOR((IPR-1)*(IDIM+1)+2)-
     &        XCOOR((IPCEN-1)*(IDIM+1)+2)
         DZ0=XCOOR((IPR-1)*(IDIM+1)+3)-
     &        XCOOR((IPCEN-1)*(IDIM+1)+3)
         DX1=XCOOR((IPL-1)*(IDIM+1)+1)-
     &        XCOOR((IPCEN-1)*(IDIM+1)+1)
         DY1=XCOOR((IPL-1)*(IDIM+1)+2)-
     &        XCOOR((IPCEN-1)*(IDIM+1)+2)
         DZ1=XCOOR((IPL-1)*(IDIM+1)+3)-
     &        XCOOR((IPCEN-1)*(IDIM+1)+3)
         NORX1=(DY0*DZ1-DY1*DZ0)
         NORY1=(DZ0*DX1-DZ1*DX0)
         NORZ1=(DX0*DY1-DX1*DY0)
C
C     The scalar product between this normal and
C     CENTRE-IPCEN
C
         DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)-
     &        XCOOR((NN27-1)*(IDIM+1)+1)
         DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)-
     &        XCOOR((NN27-1)*(IDIM+1)+2)
         DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)-
     &        XCOOR((NN27-1)*(IDIM+1)+3)
         PSCA1=DX1*NORX1+DY1*NORY1+DZ1*NORZ1
         IF((PSCA1*PSCA0) .LT.0)THEN
C
            WRITE(IOIMP,*) 'CU27'
C
C           Erreur -107 0
C           Liste des noeuds de l'élément :
C
            WRITE(IOIMP,*) 'Subroutine kdom9.eso'
            CALL ERREUR(-107)
            WRITE(IOIMP,*) NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10
            WRITE(IOIMP,*) NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19
     $           ,NN20
            WRITE(IOIMP,*) NN21,NN22,NN23,NN24,NN25,NN26,NN27
C
C           Erreur 845 2
C           Maillage donné incorrect ?!!!
C
            CALL ERREUR(845)
C
            GOTO 9999
         ENDIF
      ENDDO
C
 9999 RETURN
      END