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

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