Télécharger la plaquette Cast3M


fr en

Télécharger prolrf.eso

Retour à la liste

Numérotation des lignes : 

prolrf

  1. C PROLRF    SOURCE    GOUNAND   21/06/02    21:17:32     11022          
  2.       SUBROUTINE PROLRF(ELPRO1,ELPRO2,
  3.      $     ELCOUR,
  4.      $     IMPR,IRET)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM         : PROLRF
  9. C PROJET      : Noyau linéaire NLIN
  10. C DESCRIPTION : Construit les coordonnées des noeuds d'éléments produits
  11. C               (ex : prisme = triangle * segment)
  12. C
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES          : -
  19. C APPELE PAR       : INELPR, INELCU
  20. C***********************************************************************
  21. C ENTREES            : ELPRO1, ELPRO2
  22. C ENTREES/SORTIES    : ELCOUR (supposé actif en *MOD)
  23. C SORTIES            : -
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION    : v1, 28/04/2000, version initiale
  27. C HISTORIQUE : v1, 28/04/2000, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC TNLIN      
  39. *-INC SELREF
  40.       POINTEUR ELCOUR.ELREF
  41.       POINTEUR ELPRO1.ELREF
  42.       POINTEUR ELPRO2.ELREF
  43. *
  44.       INTEGER IMPR,IRET
  45. *
  46.       INTEGER NBNOD1,NBNOD2,NBNODC
  47.       INTEGER IBNOD1,IBNOD2,IBNODC
  48.       INTEGER NDIML1,NDIML2,NDIMLC
  49.       INTEGER IDIML1,IDIML2,IDIMLC
  50. *
  51. * Executable statements
  52. *
  53.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prolrf.eso'
  54.       SEGACT ELPRO1
  55.       SEGACT ELPRO2
  56.       NDIML1=ELPRO1.XCONOD(/1)
  57.       NBNOD1=ELPRO1.XCONOD(/2)
  58.       NDIML2=ELPRO2.XCONOD(/1)
  59.       NBNOD2=ELPRO2.XCONOD(/2)
  60.       NDIMLC=ELCOUR.XCONOD(/1)
  61.       NBNODC=ELCOUR.XCONOD(/2)
  62.       IF ((NDIML1+NDIML2).NE.NDIMLC) THEN
  63.          WRITE(IOIMP,*) 'Err. dim. esp.'
  64.          GOTO 9999
  65.       ENDIF
  66.       IF ((NBNOD1*NBNOD2).NE.NBNODC) THEN
  67.          WRITE(IOIMP,*) 'Err. nb. noeud.'
  68.          GOTO 9999
  69.       ENDIF
  70.       IBNODC=0
  71.       DO 1 IBNOD2=1,NBNOD2
  72.          DO 12 IBNOD1=1,NBNOD1
  73.             IBNODC=IBNODC+1
  74.             IDIMLC=0
  75.             DO 122 IDIML1=1,NDIML1
  76.                IDIMLC=IDIMLC+1
  77.                ELCOUR.XCONOD(IDIMLC,IBNODC)=
  78.      $              ELPRO1.XCONOD(IDIML1,IBNOD1)
  79.  122        CONTINUE
  80.             DO 124 IDIML2=1,NDIML2
  81.                IDIMLC=IDIMLC+1
  82.                ELCOUR.XCONOD(IDIMLC,IBNODC)=
  83.      $              ELPRO2.XCONOD(IDIML2,IBNOD2)
  84.  124        CONTINUE
  85.  12      CONTINUE
  86.  1    CONTINUE
  87.       SEGDES ELPRO2
  88.       SEGDES ELPRO1
  89. *
  90. * Normal termination
  91. *
  92.       IRET=0
  93.       RETURN
  94. *
  95. * Format handling
  96. *
  97. *
  98. * Error handling
  99. *
  100.  9999 CONTINUE
  101.       IRET=1
  102.       WRITE(IOIMP,*) 'An error was detected in subroutine prolrf'
  103.       RETURN
  104. *
  105. * End of subroutine PROLRF
  106. *
  107.       END
  108.  
  109.  
  110.  
  111.  
  112.  

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