Télécharger la plaquette Cast3M


fr en

Télécharger prlin2.eso

Retour à la liste

Numérotation des lignes : 

prlin2

  1. C PRLIN2    SOURCE    GOUNAND   24/11/12    21:15:07     12076          
  2.       SUBROUTINE PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,
  3.      $     LERF,LERJ,IRESO,IMREG,LCHAM,
  4.      $     MATLIN,ICHLIN,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : PRLIN2
  10. C DESCRIPTION : Initialisations, tests et formatage des données et des
  11. C               résultats pour nlin.
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          :
  18. C APPELE PAR       : PRLIN
  19. C***********************************************************************
  20. C ENTREES            :
  21. C SORTIES            :
  22. C TRAVAIL            :
  23. C
  24. C***********************************************************************
  25. C VERSION    : v3.1, 30/07/04, possiblité de travailler
  26. C                              dans l'espace de référence
  27. C VERSION    : v3, 10/05/04, refonte complète (modif SMTNLIN)
  28. C                            lois de comportement
  29. C VERSION    : v2, 22/09/03, refonte complète (modif SMTNLIN)
  30. C VERSION    : v1, 22/08/2003, version initiale
  31. C HISTORIQUE : v1, 22/08/2003, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC SMELEME
  43.       POINTEUR CGEOME.MELEME
  44.       POINTEUR CGEOMQ.MELEME
  45.       POINTEUR CGEOM2.MELEME
  46.       POINTEUR CSGEO2.MELEME
  47.       POINTEUR CGEOM3.MELEME
  48.       POINTEUR CSGEO3.MELEME
  49.       POINTEUR CGEOQ3.MELEME
  50.       POINTEUR CSGEQ3.MELEME
  51. -INC SMTABLE
  52.       POINTEUR TABCPR.MTABLE
  53.       POINTEUR TABCDU.MTABLE
  54. -INC SMRIGID
  55.       POINTEUR MATLIN.MRIGID
  56. -INC SMCHPOI
  57.       POINTEUR ICHLIN.MCHPOI
  58. * Segments à moi
  59. -INC TNLIN
  60. *-INC SELREF
  61.       POINTEUR MYLRFS.ELREFS
  62. *-INC SFALRF
  63.       POINTEUR MYFALS.FALRFS
  64. *-INC SPOGAU
  65.       POINTEUR MYPGS.POGAUS
  66. *-INC SFAPG
  67.       POINTEUR MYFPGS.FAPGS
  68. *-INC SLCOMP
  69.       POINTEUR MYCOMS.COMPS
  70.       POINTEUR MYCOM.COMP
  71. *-INC SIQUAF
  72.       POINTEUR MYQRFS.IQUAFS
  73. *-INC SFACTIV
  74. *-INC SMTNLIN
  75. *
  76.       SEGMENT ISQUAF(0)
  77.       CHARACTER*4 LGDISC
  78.       CHARACTER*4 METING
  79.       CHARACTER*4 ITMP
  80.       INTEGER LAXI
  81.       INTEGER LERF
  82.       LOGICAL LERJ
  83.       INTEGER IMPR,IRET
  84. *
  85.       INTEGER OOOVAL
  86. *
  87. * Executable statements
  88. *
  89.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin2'
  90. *
  91. * Initialisation du segment contenant les informations sur les
  92. * éléments de référence.
  93. *
  94. *      SEGINI MYLRFS.LISEL(*)
  95.       CALL INLRFS(MYLRFS,IMPR,IRET)
  96.       IF (IRET.NE.0) GOTO 9999
  97. *
  98. * Initialisation du segment contenant les informations sur les
  99. * familles d'éléments de référence.
  100. *
  101. *      SEGINI MYFALS.LISFA(*)
  102.       CALL INFALS(MYFALS,MYLRFS,IMPR,IRET)
  103.       IF (IRET.NE.0) GOTO 9999
  104. *
  105. * Initialisation du segment contenant les informations sur les
  106. * méthodes d'intégration (type Gauss).
  107. *
  108. *      SEGINI MYPGS.LISPG(*)
  109.       CALL INPGS(MYPGS,IMPR,IRET)
  110.       IF (IRET.NE.0) GOTO 9999
  111. *
  112. * Initialisation du segment contenant les informations sur les
  113. * familles de méthodes d'intégration (type Gauss).
  114. *
  115. *      SEGINI MYFPGS.LISFPG(*)
  116.       CALL INFPGS(MYFPGS,MYPGS,IMPR,IRET)
  117.       IF (IRET.NE.0) GOTO 9999
  118. *
  119. * Initialisation du segment contenant les informations sur les
  120. * lois de comportements
  121. *
  122. *      SEGINI MYCOMS.LISCOM(*)
  123. * 19/01/2006
  124. *      CALL INCOMS(MYCOMS,IMPR,IRET)
  125.       CALL INCOMS(MYCOMS,CGEOM2,LERF,IMPR,IRET)
  126.       IF (IRET.NE.0) GOTO 9999
  127. *
  128. * Initialisation du segment contenant les informations sur les
  129. * éléments QUAFs de référence.
  130. *
  131.       IF (CSGEO2.NE.0) THEN
  132. *      SEGINI MYQRFS
  133.          CALL INQRFS(MYQRFS,IMPR,IRET)
  134.          IF (IRET.NE.0) GOTO 9999
  135. * On régularise le maillage pour plus se faire chier si LISOUS(/1).EQ.0
  136. * In REGMAI : SEGINI CGEOM3
  137.          CALL REGMAI(CGEOM2,CGEOM3)
  138. * In REGMAI : SEGINI CSGEO3
  139.          CALL REGMAI(CSGEO2,CSGEO3)
  140. *
  141. * Transformation de CGEOM3 et CSGEO3 en QUAF si ça n'est pas le cas
  142. * S'il y a eu transformation, les MELEME originaux sont stockés dans LISREF
  143. *
  144.          CALL TRQUAF(CGEOM3,CGEOQ3,MYFALS)
  145.          IF (IERR.NE.0) RETURN
  146.          CALL TRQUAF(CSGEO3,CSGEQ3,MYFALS)
  147.          IF (IERR.NE.0) RETURN
  148. *
  149. *     Si les maillages d'origine n'étaient pas QUAF, le NLIN avec
  150. *     maillage de surface ne marchera pas compte tenu de la logique
  151. *     actuelle de extfac (compare les numéros de noeuds milieux de face)
  152. *
  153.          SEGINI ISQUAF
  154.          ISQUAF(**)=CGEOQ3
  155.          ISQUAF(**)=CSGEQ3
  156.          DO ii=1,ISQUAF(/1)
  157.             MELEME=ISQUAF(ii)
  158.             SEGACT MELEME
  159.             NSOUS=LISOUS(/1)
  160.             DO ISOUS=1,NSOUS
  161.                IPT2=LISREF(ISOUS)
  162.                IF (IPT2.NE.0) THEN
  163.                   MOTERR(1:8)='MAILLAGE'
  164.                   MOTERR(9:16)='QUAF'
  165.                   CALL ERREUR(66)
  166.                   RETURN
  167.                ENDIF
  168.             ENDDO
  169.             SEGDES MELEME
  170.          ENDDO
  171.          SEGSUP ISQUAF
  172.  
  173. *
  174. * On extrait de CGEOM3 les éléments qui ont au moins une face
  175. * appartenant à CSGEO3 et un objet contenant les faces actives.
  176. *
  177. * In EXTFAC : SEGINI CGEOME
  178. * In EXTFAC : SEGINI FACTIV
  179.          CALL EXTFAC(CGEOQ3,CSGEQ3,MYQRFS,
  180.      $        CGEOMQ,FACTIV,
  181.      $        IMPR,IRET)
  182.          IF (IRET.NE.0) GOTO 9999
  183. *
  184. *  Après EXTFAC :
  185. *
  186. C         Write(ioimp,*) 'Après extfac'
  187. C         Write(ioimp,*) '  cgeom3'
  188. C         ITMP='RESU'
  189. C         CALL ECROBJ('MAILLAGE',CGEOM3)
  190. C         CALL ECRCHA(ITMP)
  191. C         CALL PRLIST
  192. C         ITMP='RESU'
  193. C         CALL ECROBJ('MAILLAGE',CSGEO3)
  194. C         CALL ECRCHA(ITMP)
  195. C         CALL PRLIST
  196. C         CALL ECROBJ('MAILLAGE',CGEOME)
  197. C         CALL PRLIST
  198. C         SEGPRT,FACTIV
  199.          IF (METING.NE.'    ') THEN
  200.             CALL VERFPG(CGEOMQ,METING,MYFPGS,IMPR,IRET)
  201.             IF (IRET.NE.0) GOTO 9999
  202.             CALL VERFPG(CSGEQ3,METING,MYFPGS,IMPR,IRET)
  203.             IF (IRET.NE.0) GOTO 9999
  204.          ENDIF
  205.       ELSE
  206. *
  207. * On régularise le maillage pour ne plus se faire chier si LISOUS(/1).EQ.0
  208. * In REGMAI : SEGINI CGEOME
  209.          CALL REGMAI(CGEOM2,CGEOME)
  210. *
  211. * Transformation de CGEOME en QUAF si ça n'est pas le cas
  212. * S'il y a eu transformation, les MELEME originaux sont stockés dans LISREF
  213. *
  214.          CALL TRQUAF(CGEOME,CGEOMQ,MYFALS)
  215.          IF (IERR.NE.0) RETURN
  216. *
  217. *   On vérifie pour la famille de méthode d'intégration :
  218. *   - qu'elle est valide ;
  219. *   - qu'il y a bien un élément fini qui correspond à chaque élément géométrique
  220.          IF (METING.NE.'    ') THEN
  221.             CALL VERFPG(CGEOMQ,METING,MYFPGS,IMPR,IRET)
  222.             IF (IRET.NE.0) GOTO 9999
  223.          ENDIF
  224.       ENDIF
  225. *
  226. * In PRLIN3 : SEGINI TABGEO
  227. * In PRLIN3 : SEGINI TABVDC
  228. * In PRLIN3 : SEGINI TATRAV
  229.       CALL PRLIN3(CGEOMQ,LGDISC,TABCPR,TABCDU,LERF,LCHAM,
  230.      $     MYFALS,MYCOMS,
  231.      $     TABGEO,TABVDC,TATRAV,
  232.      $     IMPR,IRET)
  233.       IF (IRET.NE.0) GOTO 9999
  234. *
  235. * Dans PRLIN4, on explicite ce que l'on va vraiment devoir
  236. * calculer dans TATRAV
  237. *
  238.       CALL PRLIN4(TABVDC,TATRAV,
  239.      $     IMPR,IRET)
  240.       IF (IRET.NE.0) GOTO 9999
  241. *
  242. * Calculons la matrice des opérateurs
  243. * In NLIN : SEGINI TABMAT
  244.       IF (CSGEO2.EQ.0) THEN
  245.          CALL NLIN(CGEOMQ,TABGEO,TABVDC,TATRAV,
  246.      $        METING,LAXI,LERF,LERJ,IMREG,
  247.      $        MYFALS,MYPGS,MYFPGS,
  248.      $        TABMAT,
  249.      $        IMPR,IRET)
  250.          IF (IRET.NE.0) THEN
  251.             IF (LERJ) GOTO 9666
  252.             GOTO 9999
  253.          ENDIF
  254.       ELSE
  255.          CALL NLIA(CGEOMQ,FACTIV,TABGEO,TABVDC,TATRAV,
  256.      $        METING,LAXI,LERF,LERJ,
  257.      $        MYFALS,MYPGS,MYFPGS,MYQRFS,
  258.      $        TABMAT,
  259.      $        IMPR,IRET)
  260.          IF (IRET.NE.0) GOTO 9999
  261.       ENDIF
  262. * Ménage de TATRAV
  263. * In SUTRAV : SEGSUP TATRAV
  264.       CALL SUTRAV(TATRAV,IMPR,IRET)
  265.       IF (IRET.NE.0) GOTO 9999
  266. *dbg      NSEGAV=OOOVAL(2,1)
  267. * Transformer la matrice de moindres carrés en RIGIDITE ou en MATRIK
  268.       IF (IRESO.EQ.0) THEN
  269.          CALL CV2MC9(CGEOMQ,TABVDC,TABMAT,
  270.      $        MYFALS,LCHAM,
  271.      $        MATLIN,ICHLIN,
  272.      $        IMPR,IRET)
  273.          IF (IRET.NE.0) GOTO 9999
  274.       ELSEIF (IRESO.EQ.1) THEN
  275.          CALL CV2MCA(CGEOMQ,TABVDC,TABMAT,
  276.      $        MYFALS,LCHAM,
  277.      $        MATLIN,ICHLIN,
  278.      $        IMPR,IRET)
  279.          IF (IRET.NE.0) GOTO 9999
  280.       ELSEIF (IRESO.EQ.2) THEN
  281.          CALL CV2MCB(CGEOMQ,TABVDC,TABMAT,
  282.      $        MYFALS,LCHAM,
  283.      $        MATLIN,ICHLIN,
  284.      $        IMPR,IRET)
  285.          IF (IRET.NE.0) GOTO 9999
  286.       ELSE
  287.          WRITE(IOIMP,*) 'Erreur grave'
  288.          GOTO 9999
  289.       ENDIF
  290. *dbg      NSEGAP=OOOVAL(2,1)
  291. *dbg      NSEGD=NSEGAP-NSEGAV
  292. *dbg      WRITE(IOIMP,*) 'CV2MC9 : ',NSEGD,' segments crees ',
  293. *dbg     $     ' MAT=',MATLIN,' CHP=',ICHLIN
  294. *
  295. * Destructions finales...
  296. *
  297. * In SUPOUE : SEGSUP TABMAT
  298. * In SUPOUE : SEGSUP TABVDC
  299. * In SUPOUE : SEGSUP TABGEO
  300.       CALL SUPOUE(TABGEO,TABVDC,TABMAT,IMPR,IRET)
  301.       IF (IRET.NE.0) GOTO 9999
  302. *
  303.       SEGINI ISQUAF
  304.       IF (CSGEO2.NE.0) THEN
  305. * In SUFACT : SEGSUP FACTIV
  306.          CALL SUFACT(FACTIV,IMPR,IRET)
  307.          IF (IRET.NE.0) GOTO 9999
  308.          SEGSUP CSGEO3
  309.          SEGSUP CGEOM3
  310. *      SEGSUP MYQRFS
  311.          CALL SUQRFS(MYQRFS,IMPR,IRET)
  312.          IF (IRET.NE.0) GOTO 9999
  313. * Suppression éventuelle des QUAFs créés dans TRQUAF
  314.          ISQUAF(**)=CGEOQ3
  315.          ISQUAF(**)=CSGEQ3
  316.          ISQUAF(**)=CGEOMQ
  317.       ELSE
  318. * REGMAI crée un nouveau chapeau
  319.          SEGSUP CGEOME
  320.          ISQUAF(**)=CGEOMQ
  321.       ENDIF
  322.       DO ii=1,ISQUAF(/1)
  323. * Suppression éventuelle des QUAFs créés dans TRQUAF
  324.          MELEME=ISQUAF(ii)
  325.          SEGACT MELEME
  326.          NSOUS=LISOUS(/1)
  327.          DO ISOUS=1,NSOUS
  328.             IPT2=LISREF(ISOUS)
  329.             IF (IPT2.NE.0) THEN
  330.                IPT1=LISOUS(ISOUS)
  331.                SEGSUP IPT1
  332.             ENDIF
  333.          ENDDO
  334.          SEGSUP MELEME
  335.       ENDDO
  336.       SEGSUP ISQUAF
  337. *
  338. *      SEGSUP MYLRFS.LISEL(*)
  339.       CALL SULRFS(MYLRFS,IMPR,IRET)
  340.       IF (IRET.NE.0) GOTO 9999
  341. *      SEGSUP MYFALS.LISFA(*)
  342.       CALL SUFALS(MYFALS,IMPR,IRET)
  343.       IF (IRET.NE.0) GOTO 9999
  344. *      SEGSUP MYPGS.LISPG(*)
  345.       CALL SUPGS(MYPGS,IMPR,IRET)
  346.       IF (IRET.NE.0) GOTO 9999
  347. *      SEGSUP MYFPGS.LISFPG(*)
  348.       CALL SUFPGS(MYFPGS,IMPR,IRET)
  349.       IF (IRET.NE.0) GOTO 9999
  350.       SEGACT MYCOMS
  351.       NBCOMP=MYCOMS.LISCOM(/1)
  352.       DO IBCOMP=1,NBCOMP
  353.          MYCOM=MYCOMS.LISCOM(IBCOMP)
  354.          SEGSUP,MYCOM
  355.       ENDDO
  356.       SEGSUP MYCOMS
  357. *
  358. * Normal termination
  359. *
  360.       IRET=0
  361.       RETURN
  362. *
  363. * Format handling
  364. *
  365. *
  366. * Error handling
  367. *
  368.  9666 CONTINUE
  369.       IRET=666
  370.       RETURN
  371.  9999 CONTINUE
  372.       IRET=1
  373.       WRITE(IOIMP,*) 'An error was detected in subroutine prlin2'
  374.       RETURN
  375. *
  376. * End of subroutine PRLIN2
  377. *
  378.       END
  379.  
  380.  

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