Télécharger la plaquette Cast3M


fr en

Télécharger elccno.eso

Retour à la liste

Numérotation des lignes : 

elccno

  1. C ELCCNO    SOURCE    PV        22/04/26    21:15:01     11344          
  2. C
  3. C
  4.       SUBROUTINE ELCCNO(ICODE,IDE,ITRNO2,NBNMX2,NBE,
  5.      >                  ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  6.      >                  ITVL,NITMAX,
  7.      >                  COORD,IDIMC,NBCOOR,NBCOMX,iarr)
  8. C     *****************************************************************
  9. C     OBJET ELCCNO : CALCUL LES NOEUDS MILIEU (MANQUANT) D'UN MAILLAGE
  10. C
  11. C     EN ENTREE    :
  12. C       ---------- LE MAILLAGE A REMPLIR -----------------------
  13. C       ICODE  : CODE DES ELEMENTS DE ITRNOE
  14. C       ITRNOE : NOEUDS DES ELEMENTS (AVEC NOEUDS MILIEU)
  15. C       IFARSN : FONCTION QUI RENVOI LES SOMMETS D'UNE ARETE (ELARSN)
  16. C       IFCCPO : FONCTION QUI CALCUL LES POINTS MILIEU
  17. C       ---------- LE MAILLAGE SANS NOEUDS ---------------------
  18. C       ITRNOE : IDEM ITRNO2 (SANS NOEUDS MILIEU)
  19. C       ITRTRI : TABLEAU DES ELEMENTS VOISINS
  20. C       NBNMAX : NOMBRE DE NOEUDS D'UN ELEMENT
  21. C       NBE    : NOMBRE D'ELEMENTS = NBE2
  22. C       ----------TABLEAU DE TRAVAIL ---------------------------
  23. C       ITVL   : TABLEAU D'ENTIERS
  24. C       NITMAX : TAILLE DE ITVL
  25. C       ----------TABLEAU DE TRAVAIL ---------------------------
  26. C       COORD  : TABLEAU DES COORDONNEES
  27. C       IDIMC  : DIMENSION DE L'ESPACE
  28. C       NBCOOR : NOMBRE DE POINTS DANS COORD
  29. C
  30. C     EN SORTIE    :
  31. C       ITRNOE : NOEUDS DES ELEMENTS AVEC NOEUDS MILIEU
  32. C       iarr   : CODE D'ERREUR
  33. C     *****************************************************************
  34.       IMPLICIT INTEGER(I-N)
  35.       INTEGER ICODE,IDE,ITRNO2(*),NBNMX2,NBE
  36.       INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  37.       INTEGER ITVL(*),NITMAX
  38.       REAL*8    COORD(*)
  39.       INTEGER IDIMC,NBCOOR,NBCOMX,iarr
  40. C
  41. C
  42.       INTEGER IEL,NBAR,INDAR,INDSO(2),INDNO(1),NBNO,NUMSO(2),NUMNO(1),
  43.      >      INO
  44.       INTEGER NOETRI(1),NOEMAX
  45.       REAL*8    XYZ(3)
  46.       INTEGER INTSO(24),INTNO(100),I,NBSOM,NBNOE
  47.       INTEGER NBS
  48. C
  49.       CALL ELSOVO(ICODE,INTNO,NBSOM,NBNOE,iarr)
  50. C      WRITE(6,*) 'ICODE, NBSOM =',ICODE,NBSOM
  51.       IF( iarr.NE.0 )THEN
  52.         CALL DSERRE(1,iarr,'ELCCNO ',' APPEL ELSOVO')
  53.         GOTO 9999
  54.       ENDIF
  55.       CALL STNBAR(IDE,NBSOM,NBAR)
  56. C
  57.       CALL ELARSN(ICODE,INTSO,INTNO,NBNO,iarr)
  58.         IF( iarr.NE.0 )THEN
  59.           CALL DSERRE(1,iarr,'ELCCNO ',' APPEL ELARSN')
  60.           GOTO 9999
  61.         ENDIF
  62. C
  63. C      WRITE(6,*) 'IDE,NBNMAX,NBARETE = ',IDE,NBNMAX,NBAR
  64. C
  65.       DO 200 IEL=1,NBE
  66. C      WRITE(6,*) '==========================================='
  67. C      WRITE(6,*) '            ELEMENT ',IEL
  68. C      WRITE(6,*) '==========================================='
  69.       DO 100 INDAR=1,NBAR
  70. C
  71. C         =================================
  72. C     ---- EXTRACTION DES ARETES ----
  73. C         =================================
  74. C
  75. C       ---- INDICES RELATIFS ----
  76. C
  77.         INDSO(1) = INTSO((INDAR-1)*2+1)
  78.         INDSO(2) = INTSO((INDAR-1)*2+2)
  79.         NBNO = INTNO(INDAR+1)-INTNO(INDAR)
  80.         DO 5 I=1,NBNO
  81.           INDNO(I) = INTNO(INTNO(INDAR-1+I))
  82.     5   CONTINUE
  83. C
  84. C        WRITE(6,*) INDAR,' ARETE DE (S1,S2,N)',
  85. C     >             INDSO(1),INDSO(2),INDNO(1)
  86. C
  87. C       ---- NUMERO ABSOLUS DANS ITRNO1 ------
  88.         NUMSO(1) = ITRNO2((IEL-1)*NBNMX2+INDSO(1))
  89.         NUMSO(2) = ITRNO2((IEL-1)*NBNMX2+INDSO(2))
  90.         DO 10 INO=1,NBNO
  91.           NUMNO(1) = ITRNO2((IEL-1)*NBNMX2+INDNO(INO))
  92.           IF( NUMNO(1).EQ. 0 )THEN
  93. C         ==================================
  94. C     ---- CALCUL DES NOEUDS MILIEU        ----
  95. C         ==================================
  96.           CALL ELCCPO(COORD((NUMSO(1)-1)*IDIMC+1),
  97.      >                COORD((NUMSO(2)-1)*IDIMC+1),IDIMC,
  98.      >                ICODE,INDAR,INO,NBNO,XYZ,iarr)
  99.           NOEMAX = 0
  100.           CALL S0AJNO(XYZ,COORD,IDIMC,NBCOOR,NBCOMX,
  101.      >                     NOETRI,NOEMAX,NUMNO(1),iarr)
  102. C          WRITE(6,*) 'NOEUD CREE = ',NUMNO(1)
  103.           NBS = 2
  104.           CALL NOAJAR(NUMSO,IEL,NBS,NUMNO,NBNO,
  105.      >                  ICODE,IDE,ITRNO2,NBNMX2,NBE,
  106.      >                  ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  107.      >                  ITVL,NITMAX,iarr)
  108. C          ELSE
  109. C          WRITE(6,*) 'ENTRE ',NUMSO(1),NUMSO(2),
  110. C     >    'LE NOEUD EXISTE DEJA  ',NUMNO(1)
  111.           ENDIF
  112.    10   CONTINUE
  113.  
  114.   100 CONTINUE
  115.   200 CONTINUE
  116. C
  117.  9999 END
  118.  
  119.  
  120.  
  121.  
  122.  

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