Télécharger prlin.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLIN SOURCE CB215821 19/07/31 21:16:43 10277
  2. SUBROUTINE PRLIN()
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : PRLIN
  7. C DESCRIPTION : Lecture des données et écriture des résultats
  8. C pour nlin
  9. C
  10. C LANGAGE : ESOPE
  11. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  12. C mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C APPELES : PRLIN2
  15. C APPELES (E/S) : LIROBJ, ECROBJ
  16. C APPELE PAR : PILOT ou KOPS
  17. C***********************************************************************
  18. C SYNTAXE GIBIANE :
  19. C ENTREES :
  20. C SORTIES : * MATLIN (type MATRIK) : matrice de rigidité.
  21. C***********************************************************************
  22. C VERSION : v3.1, 30/07/04, possiblité de travailler
  23. C dans l'espace de référence
  24. C VERSION : v3, 10/05/04, refonte complète (modif SMPOUET)
  25. C lois de comportement
  26. C VERSION : v2, 22/09/03, refonte complète (modif SMPOUET)
  27. C VERSION : v1, 22/08/03, version initiale
  28. C HISTORIQUE : v1, 22/08/03, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33. C en cas de modification de ce sous-programme afin de faciliter
  34. C la maintenance !
  35. C***********************************************************************
  36. -INC CCGEOME
  37.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC SMELEME
  41. POINTEUR CGEOM2.MELEME
  42. POINTEUR CSGEO2.MELEME
  43. -INC SMTABLE
  44. POINTEUR TABCPR.MTABLE
  45. POINTEUR TABCDU.MTABLE
  46. C-INC SMLMOTS
  47. C POINTEUR MOTSCL.MLMOTS
  48. -INC SMRIGID
  49. POINTEUR MATLIN.MRIGID
  50. -INC SMCHPOI
  51. POINTEUR CHPLIN.MCHPOI
  52. *
  53. *dbg INTEGER OOOVAL
  54. *
  55. CHARACTER*4 LGDISC
  56. CHARACTER*4 METING
  57. INTEGER LAXI
  58. INTEGER LERF
  59. LOGICAL LERJ
  60. INTEGER IMPR,IRET
  61. *
  62. PARAMETER (NMOT0=2,NMOT1=2,NMOT2=1,NMOT3=2,NMOT4=1)
  63. CHARACTER*4 MOTCL0(NMOT0),MOTCL1(NMOT1)
  64. CHARACTER*4 MOTCL2(NMOT2),MOTCL3(NMOT3)
  65. CHARACTER*4 MOTCL4(NMOT4)
  66. DATA MOTCL0/'TJAC','TPG '/
  67. DATA MOTCL1/'EREF','ERF1'/
  68. DATA MOTCL2/'ERRJ'/
  69. DATA MOTCL3/'CRES','MATK'/
  70. * DATA MOTCL4/'MREG','NMRE'/
  71. DATA MOTCL4/'MREG'/
  72. *
  73. * Executable statements
  74. *
  75. IMPR=0
  76. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin'
  77. *dbg NSEGAV=OOOVAL(2,1)
  78. *
  79. * Lecture du mot-cle pour les subroutines de test
  80. * Pas à destination des utilisateurs
  81. *
  82. CALL LIRMOT(MOTCL0,NMOT0,IRAN,0)
  83. IF (IRAN.EQ.1) THEN
  84. CALL TESTJA
  85. RETURN
  86. ELSEIF (IRAN.EQ.2) THEN
  87. CALL TESTPG
  88. RETURN
  89. ENDIF
  90. *
  91. * Lecture de la famille d'espaces de discrétisations
  92. * pour la géométrie
  93. *
  94. CALL LIRCHA(LGDISC,1,IRET)
  95. IF (IRET.NE.4) GOTO 9999
  96. *
  97. * Lecture du maillage de QUAF
  98. *
  99. CALL LIROBJ('MAILLAGE',CGEOM2,1,IRET)
  100. IF (IRET.EQ.0) GOTO 9999
  101. *
  102. * Lecture du maillage surfacique de QUAF (optionnel)
  103. *
  104. CALL LIROBJ('MAILLAGE',CSGEO2,0,IRET)
  105. IF (IRET.EQ.0) THEN
  106. CSGEO2=0
  107. ENDIF
  108. *
  109. * Lecture de la table des coefficients du système d'équations
  110. * pour la variable primale
  111. CALL LIROBJ('TABLE ',TABCPR,1,IRET)
  112. IF (IRET.EQ.0) GOTO 9999
  113. * Lecture de la table des coefficients du système d'équations
  114. * pour la variable duale
  115. CALL LIROBJ('TABLE ',TABCDU,1,IRET)
  116. IF (IRET.EQ.0) GOTO 9999
  117. C*
  118. C* Lecture du mot-cle pour l'axisymétrique
  119. C* Inutile, on peut l'introduire explicitement avec
  120. C* les coefficients. Ca paraît plus propre
  121. C*
  122. C JGM=3
  123. C JGN=4
  124. C SEGINI MOTSCL
  125. C MOTSCL.MOTS(1)='AXIS'
  126. C MOTSCL.MOTS(2)='AXI1'
  127. C MOTSCL.MOTS(3)='AXI2'
  128. C CALL LIRMOT(MOTSCL.MOTS,MOTSCL.MOTS(/2),IRAN,0)
  129. C IF (IFOMOD.EQ.0.AND.IRAN.EQ.0) THEN
  130. C WRITE(IOIMP,*) 'En axi, on attend un des mots-cles :'
  131. C SEGPRT,MOTSCL
  132. C GOTO 9999
  133. C ELSEIF (IFOMOD.NE.0.AND.IRAN.NE.0) THEN
  134. C WRITE(IOIMP,*) 'Le mot-cle ',MOTSCL.MOTS(IRAN),
  135. C $ ' necessite OPTI MODE AXIS.'
  136. C GOTO 9999
  137. C ENDIF
  138. C LAXI=IRAN
  139. C SEGSUP MOTSCL
  140. *
  141. LAXI=IFOMOD
  142. *
  143. * Lecture du mot-cle pour si on discrétise dans l'espace de référence
  144. * ou dans l'espace de référence avec le volume des éléments normalisé
  145. * à 1
  146. * DATA MOTCL1/'EREF','ERF1'/
  147. *
  148. CALL LIRMOT(MOTCL1,NMOT1,LERF,0)
  149. *
  150. * Lecture du mot-cle pour si on capture les erreurs de changement de
  151. * signe du Jacobien
  152. * DATA MOTCL2/'ERRJ'/
  153. *
  154. CALL LIRMOT(MOTCL2,NMOT2,IRAN,0)
  155. IF (IRAN.EQ.0) THEN
  156. LERJ=.FALSE.
  157. ELSEIF (IRAN.EQ.1) THEN
  158. LERJ=.TRUE.
  159. ELSE
  160. GOTO 9999
  161. ENDIF
  162. *
  163. * Lecture du mot-cle pour l'assemblage compatible avec RESO
  164. * DATA MOTCL3/'CRES','MATK'/
  165. *
  166. CALL LIRMOT(MOTCL3,NMOT3,IRESO,0)
  167. * IRESO=2
  168. *
  169. * Lecture du mot-cle pour accélération de NLIN si maillage régulier
  170. * DATA MOTCL4/'MREG'/
  171. *
  172. CALL LIRMOT(MOTCL4,NMOT4,IMREG,0)
  173. * IMREG=1
  174. * IF (IMREG.EQ.1) WRITE(IOIMP,*) 'MAILLAGE REGULIER'
  175. *
  176. * Lecture de la famille de méthodes d'intégration
  177. *
  178. CALL LIRCHA(METING,0,IRET)
  179. IF (IERR.NE.0) GOTO 9999
  180. IF (IRET.EQ.0) THEN
  181. METING=' '
  182. ENDIF
  183. C WRITE(IOIMP,*) 'LAXI=',LAXI
  184. C WRITE(IOIMP,*) 'LERF=',LERF
  185. C WRITE(IOIMP,*) 'LERJ=',LERJ
  186. C WRITE(IOIMP,*) 'METING=',METING
  187. *
  188. * Fin des lectures
  189. *
  190. CALL PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,LERF,
  191. $ LERJ,IRESO,IMREG,
  192. $ MATLIN,CHPLIN,
  193. $ IMPR,IRET)
  194. IF (IRET.NE.0) THEN
  195. IF (LERJ) GOTO 9666
  196. GOTO 9999
  197. ENDIF
  198. IF ((CHPLIN.EQ.0).AND.(MATLIN.EQ.0)) THEN
  199. WRITE(IOIMP,*) 'Nothing was computed, check your tables'
  200. GOTO 9999
  201. ENDIF
  202. * l'ordre des retours sera normalement, mat chpo = NLIN ...
  203. IF (CHPLIN.NE.0) THEN
  204. CALL ACTOBJ('CHPOINT ',CHPLIN,1)
  205. CALL ECROBJ('CHPOINT ',CHPLIN)
  206. ENDIF
  207. IF (MATLIN.NE.0) THEN
  208. IF (IRESO.EQ.2) THEN
  209. CALL ECROBJ('MATRIK ',MATLIN)
  210. ELSE
  211. CALL ECROBJ('RIGIDITE',MATLIN)
  212. ENDIF
  213. ENDIF
  214. *dbg NSEGAP=OOOVAL(2,1)
  215. *dbg NSEGD=NSEGAP-NSEGAV
  216. *dbg WRITE(IOIMP,*) 'NLIN : ',NSEGD,' segments crees ',
  217. *dbg $ ' MAT=',MATLIN,' CHP=',CHPLIN
  218. *
  219. * Normal termination
  220. *
  221. IRET=0
  222. RETURN
  223. *
  224. * Format handling
  225. *
  226. *
  227. * Error handling
  228. *
  229. 9666 CONTINUE
  230. IRET=666
  231. RETURN
  232. 9999 CONTINUE
  233. IRET=1
  234. WRITE(IOIMP,*) 'An error was detected in subroutine prlin'
  235. CALL ERREUR(26)
  236. RETURN
  237. *
  238. * End of subroutine PRLIN
  239. *
  240. END
  241.  
  242.  
  243.  

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