Télécharger prlin.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLIN SOURCE BP208322 16/11/18 21:20:11 9177
  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. -INC CCOPTIO
  38. -INC SMELEME
  39. POINTEUR CGEOM2.MELEME
  40. POINTEUR CSGEO2.MELEME
  41. -INC SMTABLE
  42. POINTEUR TABCPR.MTABLE
  43. POINTEUR TABCDU.MTABLE
  44. C-INC SMLMOTS
  45. C POINTEUR MOTSCL.MLMOTS
  46. -INC SMRIGID
  47. POINTEUR MATLIN.MRIGID
  48. -INC SMCHPOI
  49. POINTEUR CHPLIN.MCHPOI
  50. *
  51. *dbg INTEGER OOOVAL
  52. *
  53. CHARACTER*4 LGDISC
  54. CHARACTER*4 METING
  55. INTEGER LAXI
  56. INTEGER LERF
  57. LOGICAL LERJ
  58. INTEGER IMPR,IRET
  59. *
  60. PARAMETER (NMOT0=2,NMOT1=2,NMOT2=1,NMOT3=2,NMOT4=1)
  61. CHARACTER*4 MOTCL0(NMOT0),MOTCL1(NMOT1)
  62. CHARACTER*4 MOTCL2(NMOT2),MOTCL3(NMOT3)
  63. CHARACTER*4 MOTCL4(NMOT4)
  64. DATA MOTCL0/'TJAC','TPG '/
  65. DATA MOTCL1/'EREF','ERF1'/
  66. DATA MOTCL2/'ERRJ'/
  67. DATA MOTCL3/'CRES','MATK'/
  68. * DATA MOTCL4/'MREG','NMRE'/
  69. DATA MOTCL4/'MREG'/
  70. *
  71. * Executable statements
  72. *
  73. IMPR=0
  74. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin'
  75. *dbg NSEGAV=OOOVAL(2,1)
  76. *
  77. * Lecture du mot-cle pour les subroutines de test
  78. * Pas à destination des utilisateurs
  79. *
  80. CALL LIRMOT(MOTCL0,NMOT0,IRAN,0)
  81. IF (IRAN.EQ.1) THEN
  82. CALL TESTJA
  83. RETURN
  84. ELSEIF (IRAN.EQ.2) THEN
  85. CALL TESTPG
  86. RETURN
  87. ENDIF
  88. *
  89. * Lecture de la famille d'espaces de discrétisations
  90. * pour la géométrie
  91. *
  92. CALL LIRCHA(LGDISC,1,IRET)
  93. IF (IRET.NE.4) GOTO 9999
  94. *
  95. * Lecture du maillage de QUAF
  96. *
  97. CALL LIROBJ('MAILLAGE',CGEOM2,1,IRET)
  98. IF (IRET.EQ.0) GOTO 9999
  99. *
  100. * Lecture du maillage surfacique de QUAF (optionnel)
  101. *
  102. CALL LIROBJ('MAILLAGE',CSGEO2,0,IRET)
  103. IF (IRET.EQ.0) THEN
  104. CSGEO2=0
  105. ENDIF
  106. *
  107. * Lecture de la table des coefficients du système d'équations
  108. * pour la variable primale
  109. CALL LIROBJ('TABLE ',TABCPR,1,IRET)
  110. IF (IRET.EQ.0) GOTO 9999
  111. * Lecture de la table des coefficients du système d'équations
  112. * pour la variable duale
  113. CALL LIROBJ('TABLE ',TABCDU,1,IRET)
  114. IF (IRET.EQ.0) GOTO 9999
  115. C*
  116. C* Lecture du mot-cle pour l'axisymétrique
  117. C* Inutile, on peut l'introduire explicitement avec
  118. C* les coefficients. Ca paraît plus propre
  119. C*
  120. C JGM=3
  121. C JGN=4
  122. C SEGINI MOTSCL
  123. C MOTSCL.MOTS(1)='AXIS'
  124. C MOTSCL.MOTS(2)='AXI1'
  125. C MOTSCL.MOTS(3)='AXI2'
  126. C CALL LIRMOT(MOTSCL.MOTS,MOTSCL.MOTS(/2),IRAN,0)
  127. C IF (IFOMOD.EQ.0.AND.IRAN.EQ.0) THEN
  128. C WRITE(IOIMP,*) 'En axi, on attend un des mots-cles :'
  129. C SEGPRT,MOTSCL
  130. C GOTO 9999
  131. C ELSEIF (IFOMOD.NE.0.AND.IRAN.NE.0) THEN
  132. C WRITE(IOIMP,*) 'Le mot-cle ',MOTSCL.MOTS(IRAN),
  133. C $ ' necessite OPTI MODE AXIS.'
  134. C GOTO 9999
  135. C ENDIF
  136. C LAXI=IRAN
  137. C SEGSUP MOTSCL
  138. *
  139. LAXI=IFOMOD
  140. *
  141. * Lecture du mot-cle pour si on discrétise dans l'espace de référence
  142. * ou dans l'espace de référence avec le volume des éléments normalisé
  143. * à 1
  144. * DATA MOTCL1/'EREF','ERF1'/
  145. *
  146. CALL LIRMOT(MOTCL1,NMOT1,LERF,0)
  147. *
  148. * Lecture du mot-cle pour si on capture les erreurs de changement de
  149. * signe du Jacobien
  150. * DATA MOTCL2/'ERRJ'/
  151. *
  152. CALL LIRMOT(MOTCL2,NMOT2,IRAN,0)
  153. IF (IRAN.EQ.0) THEN
  154. LERJ=.FALSE.
  155. ELSEIF (IRAN.EQ.1) THEN
  156. LERJ=.TRUE.
  157. ELSE
  158. GOTO 9999
  159. ENDIF
  160. *
  161. * Lecture du mot-cle pour l'assemblage compatible avec RESO
  162. * DATA MOTCL3/'CRES','MATK'/
  163. *
  164. CALL LIRMOT(MOTCL3,NMOT3,IRESO,0)
  165. * IRESO=2
  166. *
  167. * Lecture du mot-cle pour accélération de NLIN si maillage régulier
  168. * DATA MOTCL4/'MREG'/
  169. *
  170. CALL LIRMOT(MOTCL4,NMOT4,IMREG,0)
  171. * IMREG=1
  172. * IF (IMREG.EQ.1) WRITE(IOIMP,*) 'MAILLAGE REGULIER'
  173. *
  174. * Lecture de la famille de méthodes d'intégration
  175. *
  176. CALL LIRCHA(METING,0,IRET)
  177. IF (IERR.NE.0) GOTO 9999
  178. IF (IRET.EQ.0) THEN
  179. METING=' '
  180. ENDIF
  181. C WRITE(IOIMP,*) 'LAXI=',LAXI
  182. C WRITE(IOIMP,*) 'LERF=',LERF
  183. C WRITE(IOIMP,*) 'LERJ=',LERJ
  184. C WRITE(IOIMP,*) 'METING=',METING
  185. *
  186. * Fin des lectures
  187. *
  188. CALL PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,LERF,
  189. $ LERJ,IRESO,IMREG,
  190. $ MATLIN,CHPLIN,
  191. $ IMPR,IRET)
  192. IF (IRET.NE.0) THEN
  193. IF (LERJ) GOTO 9666
  194. GOTO 9999
  195. ENDIF
  196. IF ((CHPLIN.EQ.0).AND.(MATLIN.EQ.0)) THEN
  197. WRITE(IOIMP,*) 'Nothing was computed, check your tables'
  198. GOTO 9999
  199. ENDIF
  200. * l'ordre des retours sera normalement, mat chpo = NLIN ...
  201. IF (CHPLIN.NE.0) THEN
  202. CALL ECROBJ('CHPOINT ',CHPLIN)
  203. ENDIF
  204. IF (MATLIN.NE.0) THEN
  205. IF (IRESO.EQ.2) THEN
  206. CALL ECROBJ('MATRIK ',MATLIN)
  207. ELSE
  208. CALL ECROBJ('RIGIDITE',MATLIN)
  209. ENDIF
  210. ENDIF
  211. *dbg NSEGAP=OOOVAL(2,1)
  212. *dbg NSEGD=NSEGAP-NSEGAV
  213. *dbg WRITE(IOIMP,*) 'NLIN : ',NSEGD,' segments crees ',
  214. *dbg $ ' MAT=',MATLIN,' CHP=',CHPLIN
  215. *
  216. * Normal termination
  217. *
  218. IRET=0
  219. RETURN
  220. *
  221. * Format handling
  222. *
  223. *
  224. * Error handling
  225. *
  226. 9666 CONTINUE
  227. IRET=666
  228. RETURN
  229. 9999 CONTINUE
  230. IRET=1
  231. WRITE(IOIMP,*) 'An error was detected in subroutine prlin'
  232. CALL ERREUR(26)
  233. RETURN
  234. *
  235. * End of subroutine PRLIN
  236. *
  237. END
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  

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