Télécharger la plaquette Cast3M


fr en

Télécharger kdom8.eso

Retour à la liste

Numérotation des lignes : 

kdom8

  1. C KDOM8     SOURCE    KK2000    14/04/10    21:15:14     8032
  2.       SUBROUTINE KDOM8(NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
  3.      &              NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20,
  4.      &              NN21)
  5. C
  6. C************************************************************************
  7. C
  8. C PROJET            :  CASTEM 2000
  9. C
  10. C NOM               :  KDOM8
  11. C
  12. C DESCRIPTION       :  This subroutine check whether NN21 is inside of
  13. C                      the PR21
  14. C
  15. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  18. C
  19. C************************************************************************
  20. C
  21. C
  22.  
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26.       INTEGER NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
  27.      &     NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20,
  28.      &     NN21, I1, IPCEN, IPL, IPR
  29.       REAL*8 DX0,DY0,DZ0,DX1,DY1,DZ1,NORX1,NORY1,NORZ1,PSCA0,PSCA1
  30. C
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMCOORD
  35. C
  36. C**** First triangle
  37. C
  38.       IPCEN=NN1
  39.       IPR=NN3
  40.       IPL=NN5
  41.       DX0=XCOOR((IPR-1)*(IDIM+1)+1)-
  42.      &     XCOOR((IPCEN-1)*(IDIM+1)+1)
  43.       DY0=XCOOR((IPR-1)*(IDIM+1)+2)-
  44.      &     XCOOR((IPCEN-1)*(IDIM+1)+2)
  45.       DZ0=XCOOR((IPR-1)*(IDIM+1)+3)-
  46.      &     XCOOR((IPCEN-1)*(IDIM+1)+3)
  47.       DX1=XCOOR((IPL-1)*(IDIM+1)+1)-
  48.      &     XCOOR((IPCEN-1)*(IDIM+1)+1)
  49.       DY1=XCOOR((IPL-1)*(IDIM+1)+2)-
  50.      &     XCOOR((IPCEN-1)*(IDIM+1)+2)
  51.       DZ1=XCOOR((IPL-1)*(IDIM+1)+3)-
  52.      &        XCOOR((IPCEN-1)*(IDIM+1)+3)
  53.       NORX1=(DY0*DZ1-DY1*DZ0)
  54.       NORY1=(DZ0*DX1-DZ1*DX0)
  55.       NORZ1=(DX0*DY1-DX1*DY0)
  56. C
  57. C     The scalar product between this normal and
  58. C     CENTRE-IPCEN
  59. C
  60.       DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)-
  61.      &     XCOOR((NN21-1)*(IDIM+1)+1)
  62.       DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)-
  63.      &     XCOOR((NN21-1)*(IDIM+1)+2)
  64.       DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)-
  65.      &     XCOOR((NN21-1)*(IDIM+1)+3)
  66.       PSCA0=DX1*NORX1+DY1*NORY1+DZ1*NORZ1
  67. C
  68. C     The other triangles
  69. C
  70.       DO I1=1,13
  71.          IF(I1.EQ.1)THEN
  72.             IPCEN=NN10
  73.             IPR=NN14
  74.             IPL=NN12
  75.          ELSEIF(I1.EQ.2)THEN
  76.             IPCEN=NN1
  77.             IPR=NN18
  78.             IPL=NN10
  79.          ELSEIF(I1.EQ.3)THEN
  80.             IPCEN=NN5
  81.             IPR=NN18
  82.             IPL=NN1
  83.          ELSEIF(I1.EQ.4)THEN
  84.             IPCEN=NN14
  85.             IPR=NN18
  86.             IPL=NN5
  87.          ELSEIF(I1.EQ.5)THEN
  88.             IPCEN=NN10
  89.             IPR=NN18
  90.             IPL=NN14
  91.          ELSEIF(I1.EQ.6)THEN
  92.             IPCEN=NN5
  93.             IPR=NN17
  94.             IPL=NN14
  95.          ELSEIF(I1.EQ.7)THEN
  96.             IPCEN=NN3
  97.             IPR=NN17
  98.             IPL=NN5
  99.          ELSEIF(I1.EQ.8)THEN
  100.             IPCEN=NN12
  101.             IPR=NN17
  102.             IPL=NN3
  103.          ELSEIF(I1.EQ.9)THEN
  104.             IPCEN=NN14
  105.             IPR=NN17
  106.             IPL=NN12
  107.          ELSEIF(I1.EQ.10)THEN
  108.             IPCEN=NN3
  109.             IPR=NN16
  110.             IPL=NN12
  111.          ELSEIF(I1.EQ.11)THEN
  112.             IPCEN=NN1
  113.             IPR=NN16
  114.             IPL=NN3
  115.          ELSEIF(I1.EQ.12)THEN
  116.             IPCEN=NN10
  117.             IPR=NN16
  118.             IPL=NN1
  119.          ELSEIF(I1.EQ.13)THEN
  120.             IPCEN=NN12
  121.             IPR=NN16
  122.             IPL=NN10
  123.          ENDIF
  124.          DX0=XCOOR((IPR-1)*(IDIM+1)+1)-
  125.      &        XCOOR((IPCEN-1)*(IDIM+1)+1)
  126.          DY0=XCOOR((IPR-1)*(IDIM+1)+2)-
  127.      &        XCOOR((IPCEN-1)*(IDIM+1)+2)
  128.          DZ0=XCOOR((IPR-1)*(IDIM+1)+3)-
  129.      &        XCOOR((IPCEN-1)*(IDIM+1)+3)
  130.          DX1=XCOOR((IPL-1)*(IDIM+1)+1)-
  131.      &        XCOOR((IPCEN-1)*(IDIM+1)+1)
  132.          DY1=XCOOR((IPL-1)*(IDIM+1)+2)-
  133.      &        XCOOR((IPCEN-1)*(IDIM+1)+2)
  134.          DZ1=XCOOR((IPL-1)*(IDIM+1)+3)-
  135.      &        XCOOR((IPCEN-1)*(IDIM+1)+3)
  136.          NORX1=(DY0*DZ1-DY1*DZ0)
  137.          NORY1=(DZ0*DX1-DZ1*DX0)
  138.          NORZ1=(DX0*DY1-DX1*DY0)
  139. C
  140. C     The scalar product between this normal and
  141. C     CENTRE-IPCEN
  142. C
  143.          DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)-
  144.      &        XCOOR((NN21-1)*(IDIM+1)+1)
  145.          DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)-
  146.      &        XCOOR((NN21-1)*(IDIM+1)+2)
  147.          DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)-
  148.      &        XCOOR((NN21-1)*(IDIM+1)+3)
  149.          PSCA1=DX1*NORX1+DY1*NORY1+DZ1*NORZ1
  150.          IF((PSCA1*PSCA0) .LT.0)THEN
  151. C
  152.             WRITE(IOIMP,*) 'Subroutine kdom8.eso'
  153.             WRITE(IOIMP,*) 'PR21'
  154. C
  155. C           Erreur -107 0
  156. C           Liste des noeuds de l'élément :
  157. C
  158.             CALL ERREUR(-107)
  159.             WRITE(IOIMP,*) NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10
  160.             WRITE(IOIMP,*) NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19
  161.      $           ,NN20
  162.             WRITE(IOIMP,*) NN21
  163. C
  164. C           Erreur 845 2
  165. C           Maillage donné incorrect ?!!!
  166. C
  167.             CALL ERREUR(845)
  168. C
  169.             GOTO 9999
  170.          ENDIF
  171.       ENDDO
  172. C
  173.  9999 RETURN
  174.       END
  175.  
  176.  
  177.  
  178.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales