Télécharger la plaquette Cast3M


fr en

Télécharger prlin.eso

Retour à la liste

Numérotation des lignes : 

prlin

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

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