Télécharger prolrf.eso

Retour à la liste

Numérotation des lignes :

  1. C PROLRF SOURCE GOUNAND 05/12/21 21:35:54 5281
  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. -INC CCOPTIO
  36. CBEGININCLUDE SELREF
  37. SEGMENT ELREF
  38. CHARACTER*(LNNOM) NOMLRF
  39. CHARACTER*(LNFORM) FORME
  40. CHARACTER*(LNTYPL) TYPEL
  41. CHARACTER*(LNESP) ESPACE
  42. INTEGER DEGRE
  43. REAL*8 XCONOD(NDIMEL,NBNOD)
  44. INTEGER NPQUAF(NBDDL)
  45. INTEGER NUMCMP(NBDDL)
  46. INTEGER QUENOD(NBDDL)
  47. INTEGER ORDDER(NDIMEL,NBDDL)
  48. POINTEUR MBPOLY.POLYNS
  49. ENDSEGMENT
  50. SEGMENT ELREFS
  51. POINTEUR LISEL(0).ELREF
  52. ENDSEGMENT
  53. CENDINCLUDE SELREF
  54. POINTEUR ELCOUR.ELREF
  55. POINTEUR ELPRO1.ELREF
  56. POINTEUR ELPRO2.ELREF
  57. *
  58. INTEGER IMPR,IRET
  59. *
  60. INTEGER NBNOD1,NBNOD2,NBNODC
  61. INTEGER IBNOD1,IBNOD2,IBNODC
  62. INTEGER NDIML1,NDIML2,NDIMLC
  63. INTEGER IDIML1,IDIML2,IDIMLC
  64. *
  65. * Executable statements
  66. *
  67. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prolrf.eso'
  68. SEGACT ELPRO1
  69. SEGACT ELPRO2
  70. NDIML1=ELPRO1.XCONOD(/1)
  71. NBNOD1=ELPRO1.XCONOD(/2)
  72. NDIML2=ELPRO2.XCONOD(/1)
  73. NBNOD2=ELPRO2.XCONOD(/2)
  74. NDIMLC=ELCOUR.XCONOD(/1)
  75. NBNODC=ELCOUR.XCONOD(/2)
  76. IF ((NDIML1+NDIML2).NE.NDIMLC) THEN
  77. WRITE(IOIMP,*) 'Err. dim. esp.'
  78. GOTO 9999
  79. ENDIF
  80. IF ((NBNOD1*NBNOD2).NE.NBNODC) THEN
  81. WRITE(IOIMP,*) 'Err. nb. noeud.'
  82. GOTO 9999
  83. ENDIF
  84. IBNODC=0
  85. DO 1 IBNOD2=1,NBNOD2
  86. DO 12 IBNOD1=1,NBNOD1
  87. IBNODC=IBNODC+1
  88. IDIMLC=0
  89. DO 122 IDIML1=1,NDIML1
  90. IDIMLC=IDIMLC+1
  91. ELCOUR.XCONOD(IDIMLC,IBNODC)=
  92. $ ELPRO1.XCONOD(IDIML1,IBNOD1)
  93. 122 CONTINUE
  94. DO 124 IDIML2=1,NDIML2
  95. IDIMLC=IDIMLC+1
  96. ELCOUR.XCONOD(IDIMLC,IBNODC)=
  97. $ ELPRO2.XCONOD(IDIML2,IBNOD2)
  98. 124 CONTINUE
  99. 12 CONTINUE
  100. 1 CONTINUE
  101. SEGDES ELPRO2
  102. SEGDES ELPRO1
  103. *
  104. * Normal termination
  105. *
  106. IRET=0
  107. RETURN
  108. *
  109. * Format handling
  110. *
  111. *
  112. * Error handling
  113. *
  114. 9999 CONTINUE
  115. IRET=1
  116. WRITE(IOIMP,*) 'An error was detected in subroutine prolrf'
  117. RETURN
  118. *
  119. * End of subroutine PROLRF
  120. *
  121. END
  122.  
  123.  
  124.  
  125.  

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