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

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