Télécharger la plaquette Cast3M


fr en

Télécharger noeinc.eso

Retour à la liste

Numérotation des lignes : 

noeinc

  1. C NOEINC    SOURCE    OF166741  23/03/03    21:15:03     11416          
  2.  
  3. C***********************************************************************
  4. C NOM         : noeinc.eso
  5. C DESCRIPTION : Tableau des MELEME / POINTS nommes dont les numeros de
  6. C               noeuds sont strictement inclus dans ICPR1
  7. C***********************************************************************
  8. C HISTORIQUE :  10/10/2018 : BERTHINC : Creation
  9. C               01/08/2022 : OF       : Modifications diverses
  10. C***********************************************************************
  11. C Priere de PRENDRE LE TEMPS DE COMPLETER LES COMMENTAIRES
  12. C en cas de modification de ce sous-programme afin de faciliter
  13. C la maintenance !
  14. C***********************************************************************
  15. C APPELE PAR : SORMED.ESO
  16. C***********************************************************************
  17. C ENTREES    : CTYP, ICPR1
  18. C SORTIES    : IREP1
  19. C***********************************************************************
  20.  
  21.       SUBROUTINE NOEINC(ICPR1,CTYP,IREP1)
  22.  
  23.       IMPLICIT INTEGER(i-n)
  24.       IMPLICIT REAL*8(a-h,o-z)
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCMED
  29.  
  30. -INC SMELEME
  31. -INC SMMED
  32.  
  33.       CHARACTER*(*) CTYP
  34.  
  35. C     Segment de travail
  36.       SEGMENT icpr(ic)
  37.  
  38.       icpr = ICPR1
  39. c*      segact,icpr  <- suppose actif en entree
  40.       IREP1 = 0
  41.  
  42. C***********************************************************************
  43. C     On recupere les entites nommes et leurs noms
  44.       CALL REPER1(CTYP, SREPER)
  45.       IF (IERR.NE.0) RETURN
  46.  
  47.       NBENT  = SREPER.IREPER(/1)
  48.       NBENT1 = 0
  49.  
  50. C  ****************************************************************
  51. C  * CAS des objets de type 'MAILLAGES'
  52. C  ****************************************************************
  53. C  Note : Les maillages nommes ne sont pas necessairement actives !
  54. C         Ils sont actives puis desactives si non retenus.
  55.       IF    (CTYP .EQ. 'MAILLAGE') THEN
  56. C       On repere quel MELEME nomme est inclus dans IMEL1
  57.         DO ii = 1, NBENT
  58.           IPT1 = SREPER.IREPER(ii)
  59.           SEGACT,IPT1
  60.           NBSOUS = IPT1.LISOUS(/1)
  61.           ides = 1
  62. C  Cas MELEME SIMPLE
  63.           IF (NBSOUS .EQ. 0) THEN
  64.             DO iel = 1, IPT1.NUM(/2)
  65.               DO inoe = 1, IPT1.NUM(/1)
  66.                 IF(icpr(IPT1.NUM(inoe,iel)) .EQ. 0) GOTO 10
  67.               ENDDO
  68.             ENDDO
  69. C  Cas MELEME COMPLEXE
  70.           ELSE
  71.             DO isous=1,NBSOUS
  72.               IPT2 = IPT1.LISOUS(isous)
  73.               SEGACT,IPT2
  74.               DO iel=1,IPT2.NUM(/2)
  75.                 DO inoe=1,IPT2.NUM(/1)
  76.                   IF(icpr(IPT2.NUM(inoe,iel)) .EQ. 0) GOTO 10
  77.                 ENDDO
  78.               ENDDO
  79.             ENDDO
  80.           ENDIF
  81.           ides = 0
  82.  
  83.           NBENT1=NBENT1+1
  84.           SREPER.IREPER(NBENT1)=IPT1
  85.           SREPER.CREPER(NBENT1)=SREPER.CREPER(ii)
  86.  
  87.  10       CONTINUE
  88.           IF (ides.EQ.1) SEGDES,IPT1
  89.         ENDDO
  90.  
  91. C  ****************************************************************
  92. C  * CAS des objets de type 'POINT'
  93. C  ****************************************************************
  94.       ELSE IF (CTYP .EQ. 'POINT   ')THEN
  95. C       On repere quel POINT nomme est inclus dans IMEL1
  96.         DO ii = 1, NBENT
  97.           inoe = SREPER.IREPER(ii)
  98.           IF (icpr(inoe) .NE. 0) THEN
  99.             NBENT1=NBENT1+1
  100.             SREPER.IREPER(NBENT1)=inoe
  101.             SREPER.CREPER(NBENT1)=SREPER.CREPER(ii)
  102.           END IF
  103.         ENDDO
  104.  
  105.       ELSE
  106.         CALL ERREUR(5)
  107.       ENDIF
  108.  
  109. C  Ajustement final
  110.       IF (NBENT1 .NE. NBENT) THEN
  111.         NBENT=NBENT1
  112.         SEGADJ,SREPER
  113.       ENDIF
  114.       IREP1 = SREPER
  115.  
  116. c      segdes,icpr
  117.  
  118. c      return
  119.       END
  120.  
  121.  
  122.  

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