Télécharger sh2fnr.eso

Retour à la liste

Numérotation des lignes :

  1. C SH2FNR SOURCE BP208322 16/11/18 21:21:07 9177
  2. SUBROUTINE SH2FNR(MYLRF,MYPG,
  3. $ FNPG,DFNPG,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : SH2FNR
  9. C DESCRIPTION : Conversion shape.eso -> kfnref.eso
  10. C
  11. C
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES :
  18. C APPELES (E/S) :
  19. C APPELES (BLAS) :
  20. C APPELES (CALCUL) :
  21. C APPELE PAR :
  22. C***********************************************************************
  23. C SYNTAXE GIBIANE :
  24. C ENTREES :
  25. C ENTREES/SORTIES :
  26. C SORTIES :
  27. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28. C***********************************************************************
  29. C VERSION : v1, 25/10/2005, version initiale
  30. C HISTORIQUE : v1, 25/10/2005, création
  31. C HISTORIQUE :
  32. C HISTORIQUE :
  33. C***********************************************************************
  34. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  35. C en cas de modification de ce sous-programme afin de faciliter
  36. C la maintenance !
  37. C***********************************************************************
  38. -INC CCGEOME
  39. -INC CCOPTIO
  40. CBEGININCLUDE SELREF
  41. SEGMENT ELREF
  42. CHARACTER*(LNNOM) NOMLRF
  43. CHARACTER*(LNFORM) FORME
  44. CHARACTER*(LNTYPL) TYPEL
  45. CHARACTER*(LNESP) ESPACE
  46. INTEGER DEGRE
  47. REAL*8 XCONOD(NDIMEL,NBNOD)
  48. INTEGER NPQUAF(NBDDL)
  49. INTEGER NUMCMP(NBDDL)
  50. INTEGER QUENOD(NBDDL)
  51. INTEGER ORDDER(NDIMEL,NBDDL)
  52. POINTEUR MBPOLY.POLYNS
  53. ENDSEGMENT
  54. SEGMENT ELREFS
  55. POINTEUR LISEL(0).ELREF
  56. ENDSEGMENT
  57. CENDINCLUDE SELREF
  58. POINTEUR MYLRF.ELREF
  59. CBEGININCLUDE SPOGAU
  60. SEGMENT POGAU
  61. CHARACTER*(LNNPG) NOMPG
  62. CHARACTER*(LNTPG) TYPMPG
  63. CHARACTER*(LNFPG) FORLPG
  64. INTEGER NORDPG
  65. REAL*8 XCOPG(NDLPG,NBPG)
  66. REAL*8 XPOPG(NBPG)
  67. ENDSEGMENT
  68. SEGMENT POGAUS
  69. POINTEUR LISPG(0).POGAU
  70. ENDSEGMENT
  71. CENDINCLUDE SPOGAU
  72. POINTEUR MYPG.POGAU
  73. CBEGININCLUDE SMCHAEL
  74. SEGMENT MCHAEL
  75. POINTEUR IMACHE(N1).MELEME
  76. POINTEUR ICHEVA(N1).MCHEVA
  77. ENDSEGMENT
  78. SEGMENT MCHEVA
  79. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  80. ENDSEGMENT
  81. SEGMENT LCHEVA
  82. POINTEUR LISCHE(NBCHE).MCHEVA
  83. ENDSEGMENT
  84. CENDINCLUDE SMCHAEL
  85. POINTEUR FNPG.MCHEVA
  86. POINTEUR DFNPG.MCHEVA
  87. *
  88. SEGMENT/SHXX/(SHPXXX(6,NBB)*D)
  89. *
  90. INTEGER IMPR,IRET
  91. EXTERNAL SHAPE
  92. *
  93. * Executable statements
  94. *
  95. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans sh2fnr.eso'
  96. *
  97. SEGACT MYLRF
  98. *
  99. * Conversion élément nlin -> élément castem
  100. *
  101. IF (MYLRF.NOMLRF.EQ.'H1D1PY5') THEN
  102. IELE=25
  103. ELSEIF (MYLRF.NOMLRF.EQ.'H1D2PY13') THEN
  104. IELE=26
  105. ELSEIF (MYLRF.NOMLRF.EQ.'H1D2PR15') THEN
  106. IELE=17
  107. ELSEIF (MYLRF.NOMLRF.EQ.'H1D2CU20') THEN
  108. IELE=15
  109. ELSE
  110. WRITE(IOIMP,*) 'Element ',MYLRF.NOMLRF,' inconnu'
  111. GOTO 9999
  112. ENDIF
  113. *
  114. NDIML=MYLRF.ORDDER(/1)
  115. NDDL=MYLRF.ORDDER(/2)
  116. NBB=NDDL
  117. SEGINI,SHXX
  118. SEGACT MYPG
  119. IDIMPG=MYPG.XCOPG(/1)
  120. IF (IDIMPG.NE.NDIML) THEN
  121. WRITE(IOIMP,*) 'Erreur grave ?'
  122. GOTO 9999
  123. ENDIF
  124. NPG=MYPG.XCOPG(/2)
  125. NBLIG=1
  126. NBCOL=NDDL
  127. N2LIG=1
  128. N2COL=1
  129. NBPOI=NPG
  130. NBELM=1
  131. SEGINI,FNPG
  132. N2COL=NDIML
  133. SEGINI,DFNPG
  134. QSI=0.D0
  135. ETA=0.D0
  136. DZE=0.D0
  137. DO IPG=1,NPG
  138. IF (NDIML.GE.1) THEN
  139. QSI=MYPG.XCOPG(1,IPG)
  140. IF (NDIML.GE.2) THEN
  141. ETA=MYPG.XCOPG(2,IPG)
  142. IF (NDIML.GE.3) THEN
  143. DZE=MYPG.XCOPG(3,IPG)
  144. ENDIF
  145. ENDIF
  146. ENDIF
  147. *
  148. CALL SHAPE(QSI,ETA,DZE,IELE,SHPXXX,IRET)
  149. IF (IRET.EQ.0) THEN
  150. C ERREUR LES FONCTIONS DE FORME PAS ENCORE IMPLEMENTEES
  151. MOTERR(1:4)=NOMS(IELE)
  152. CALL ERREUR(68)
  153. GOTO 9999
  154. ENDIF
  155. DO IDDL=1,NDDL
  156. FNPG.VELCHE(1,IDDL,1,1,IPG,1)=SHPXXX(1,IDDL)
  157. DO IDIML=1,NDIML
  158. DFNPG.VELCHE(1,IDDL,1,IDIML,IPG,1)=SHPXXX(IDIML+1,IDDL)
  159. ENDDO
  160. ENDDO
  161. ENDDO
  162. SEGSUP SHXX
  163. SEGDES DFNPG
  164. SEGDES FNPG
  165. SEGDES MYPG
  166. SEGDES MYLRF
  167. *
  168. * Normal termination
  169. *
  170. IRET=0
  171. RETURN
  172. *
  173. * Format handling
  174. *
  175. *
  176. * Error handling
  177. *
  178. 9999 CONTINUE
  179. IRET=1
  180. WRITE(IOIMP,*) 'An error was detected in subroutine sh2fnr'
  181. RETURN
  182. *
  183. * End of subroutine SH2FNR
  184. *
  185. END
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  

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