Télécharger la plaquette Cast3M


fr en

Télécharger ectopi.eso

Retour à la liste

Numérotation des lignes : 

ectopi

  1. C ECTOPI    SOURCE    GOUNAND   21/04/06    21:15:07     10940          
  2.       SUBROUTINE ECTOPI(TOPINV,INIV)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : ECTOPI
  7. C DESCRIPTION : Ecrit une topologie inverse.
  8. C               INIV=1 : Ecrit la topologie telle quelle
  9. C               INIV=2 : Pour chaque noeud, les éléments qui le touche
  10. C      
  11. C      
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C***********************************************************************
  18. C SYNTAXE GIBIANE    : 
  19. C ENTREES            : TOPINV (Activé)
  20. C ENTREES/SORTIES    :
  21. C SORTIES            :
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION    : v1, 03/10/2017, version initiale
  25. C HISTORIQUE : v1, 03/10/2017, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC TMATOP1      
  32. *-INC STOPINV
  33. -INC SMLENTI
  34.       CHARACTER*24 FORMA
  35. *     
  36. * Executable statements
  37. *
  38.       IDIMP=IDIM+1
  39.       WRITE(IOIMP,185) 'SEGMENT TOPINV',TOPINV
  40.       NBELEM=TLC(/1)/IDIMP
  41.       NBPTS=TIC(/1)
  42.       write(ioimp,186) 'NBELEM',NBELEM,'NBPTS',NBPTS,'LDGT',LDGT
  43.      $     ,'LDGT/D',LDGT/IDIMP
  44.       if (iniv.eq.1) then
  45.          WRITE(FORMA,FMT='("(1(",I1,"I6,2X))")') IDIMP
  46. *     write(ioimp,*) 'forma=',forma
  47.          write(ioimp,*) 'TIC'
  48.          write(ioimp,187)  (TIC(I),I=1,TIC(/1))
  49.          write(ioimp,*) 'TLC'
  50.          write(ioimp,forma)  (TLC(I),I=1,TLC(/1))
  51.          write(ioimp,*) 'TDC'
  52.          write(ioimp,187)  (TDC(I),I=1,TDC(/1))
  53.       elseif (iniv.EQ.2) then
  54.          jg=0
  55.          do ip=1,nbpts
  56.             jg=max(jg,tdc(ip))
  57.          enddo
  58.          segini mlenti
  59.          do ip=1,nbpts
  60.             ig=0
  61.             LAST=TIC(IP)
  62.             LDG=TDC(IP)
  63.             DO IDG=1,LDG
  64.                IL=((LAST-1)/IDIMP)+1
  65.                ig=ig+1
  66.                lect(ig)=il
  67.                LAST=TLC(LAST)
  68.             ENDDO
  69. *            write(ioimp,*) 'noeud ip=',ip,' relie aux elements'
  70.             write(ioimp,184) ip
  71.             write(ioimp,187) (lect(I),I=1,ig)
  72.          enddo
  73.          segsup mlenti
  74.       else
  75.          write(ioimp,*) 'iniv=',iniv,' incorrect'
  76.          goto 9999
  77.       endif
  78.  
  79.  184  FORMAT (2X,'noeud ip=',i4,' relie aux elements')
  80.  185  FORMAT (/2X,10(A16,'=',I8,2X)/)
  81.  186  FORMAT (2X,10(A6,'=',I6,2X))
  82.  187  FORMAT (5X,10I8)
  83. *
  84. * Normal termination
  85. *
  86.       RETURN
  87. *     
  88. * Error handling     
  89. *     
  90.  9999 CONTINUE
  91.       MOTERR(1:8)='ECTOPI  '
  92. * 349 2
  93. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  94.       CALL ERREUR(349)
  95.       RETURN
  96. *
  97. * End of subroutine ECTOPI
  98. *
  99.       END
  100.  
  101.  
  102.  

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