Télécharger la plaquette Cast3M


fr en

Télécharger melrig.eso

Retour à la liste

Numérotation des lignes : 

melrig

  1. C MELRIG    SOURCE    CB215821  25/06/20    21:15:05     12290          
  2.       SUBROUTINE MELRIG(IBOGID,IPP1)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : MELRIG
  7. C DESCRIPTION : Extrait le maillage d'une rigidite
  8. C
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  13. C               mel : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES          : FUSEBO
  16. C APPELE PAR       : EXTRAI,
  17. C***********************************************************************
  18. C SYNTAXE GIBIANE    : EXTR RIG1 'MAIL' ;
  19. C ENTREES            : IBOGID
  20. C ENTREES/SORTIES    :
  21. C SORTIES            : IPP1
  22. C***********************************************************************
  23. C VERSION    : v1, 12/03/2025, version initiale
  24. C HISTORIQUE : v1, 12/03/2025, creation
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC SMELEME
  32. -INC SMRIGID
  33. *
  34. * Executable statements
  35. *
  36.       MRIGID=IBOGID
  37.       SEGACT MRIGID
  38.       NBSOUS=IRIGEL(/2)
  39.       IF (NBSOUS.EQ.0) THEN
  40.          CALL MELVID(0,IPP1)
  41.       ELSE
  42.          IPP1 = IRIGEL(1,1)
  43.          IF(NBSOUS.GT.1) THEN
  44.             NBREF=0
  45.             NBNN=0
  46.             NBELEM=0
  47.             SEGINI IPT4
  48.             KT4 = 1
  49.             IPT4.LISOUS(KT4) = IPP1
  50.             DO 1130 I=1,NBSOUS
  51.                DO 1129 JJ = 1,KT4
  52.                   IF (IRIGEL(1,I).EQ.IPT4.LISOUS(JJ)) GOTO 1130
  53.  1129          CONTINUE
  54.                KT4 = KT4 + 1
  55.                IPT4.LISOUS(KT4)=IRIGEL(1,I)
  56.  1130       CONTINUE
  57.             NBSOUS = KT4
  58.             SEGADJ IPT4
  59.             CALL FUSEBO (IPT4,IPP1)
  60. * Osons
  61. C            IF (IPT4.NE.IPP1) segsup IPT4
  62.          ENDIF
  63.          IPT2=IPP1
  64.          CALL UNIQMA(IPP1,nbdif,1)
  65. C         IF (IPT2.NE.IPP1) segsup IPT2
  66.       ENDIF
  67. *
  68. * Normal termination
  69. *
  70.       RETURN
  71. *
  72. * Format handling
  73. *
  74. *
  75. * Error handling
  76. *
  77.  9999 CONTINUE
  78.       WRITE(IOIMP,*) 'An error was detected in subroutine melrig'
  79.       RETURN
  80. *
  81. * End of subroutine MELRIG
  82. *
  83.       END
  84.  
  85.  
  86.  

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