Télécharger la plaquette Cast3M


fr en

Télécharger relr30.eso

Retour à la liste

Numérotation des lignes : 

relr30

  1. C RELR30    SOURCE    GOUNAND   25/04/30    21:15:37     12258          
  2.       SUBROUTINE RELR30(MATASS,MCHPOI,
  3.      $     MCON,MCHPO2,
  4.      $     IMPR,IRET)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6.       IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM         : RELR30
  9. C DESCRIPTION :
  10. *
  11. * Création d'une matrice de contraintes (simple mulag)
  12. *
  13. C
  14. C
  15. C
  16. C LANGAGE     : ESOPE
  17. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  18. C               mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C APPELES          :
  21. C APPELES (E/S)    :
  22. C APPELES (BLAS)   :
  23. C APPELES (CALCUL) :
  24. C APPELE PAR       :
  25. C***********************************************************************
  26. C SYNTAXE GIBIANE    :
  27. C ENTREES            :
  28. C ENTREES/SORTIES    :
  29. C SORTIES            :
  30. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  31. C***********************************************************************
  32. C VERSION    : v1, 01/03/2006, version initiale
  33. C HISTORIQUE : v1, 01/03/2006, création
  34. C HISTORIQUE :
  35. C HISTORIQUE :
  36. C***********************************************************************
  37. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  38. C en cas de modification de ce sous-programme afin de faciliter
  39. C la maintenance !
  40. C***********************************************************************
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. -INC CCHAMP
  46. -INC SMCHPOI
  47. -INC TMTRAV
  48.       POINTEUR MTRA2.MTRAV
  49. -INC SMRIGID
  50.       POINTEUR MCON.MRIGID
  51.       POINTEUR DESCON.DESCR
  52. *      POINTEUR ICON.IMATRI
  53.       POINTEUR XCON.XMATRI
  54. -INC SMELEME
  55.       POINTEUR MEL.MELEME
  56. * Includes persos
  57. CBEGININCLUDE SMMINC
  58.       SEGMENT MINC
  59.       INTEGER     NPOS(NPT+1)
  60.       INTEGER     MPOS(NPT,NBI+1)
  61.       ENDSEGMENT
  62.       SEGMENT IMINC
  63.       INTEGER LNUPO (NDDL)
  64.       INTEGER LNUINC(NDDL)
  65.       ENDSEGMENT
  66. CENDINCLUDE SMMINC
  67.       POINTEUR MINCP.MINC
  68.       POINTEUR MINCD.MINC
  69.       POINTEUR IMINCP.IMINC
  70.       POINTEUR IMINCD.IMINC
  71. CBEGININCLUDE SMPMORS
  72.       SEGMENT PMORS
  73.       INTEGER IA (NTT+1)
  74.       INTEGER JA (NJA)
  75.       ENDSEGMENT
  76. CENDINCLUDE SMPMORS
  77.       POINTEUR PROFM.PMORS
  78. CBEGININCLUDE SMIZA
  79.       SEGMENT IZA
  80.       REAL*8  A(NBVA)
  81.       ENDSEGMENT
  82. CENDINCLUDE SMIZA
  83.       POINTEUR VALM.IZA
  84. CBEGININCLUDE SMMATASS
  85.       SEGMENT MATASS
  86.       POINTEUR KJPOPA.MLENTI
  87.       POINTEUR LINCPA.MLMOTS
  88.       POINTEUR MINCPA.MINC
  89.       POINTEUR KJPODA.MLENTI
  90.       POINTEUR LINCDA.MLMOTS
  91.       POINTEUR MINCDA.MINC
  92.       POINTEUR PROFMA.PMORS
  93.       POINTEUR VALMA.IZA
  94.       ENDSEGMENT
  95. CENDINCLUDE SMMATASS
  96. *
  97. -INC SMLENTI
  98.       POINTEUR KJSPGP.MLENTI
  99.       POINTEUR KJSPGD.MLENTI
  100.       POINTEUR KLSPGP.MLENTI
  101.       POINTEUR KKSPGP.MLENTI
  102. -INC SMLMOTS
  103.       POINTEUR LINCP.MLMOTS
  104.       POINTEUR LINCD.MLMOTS
  105. *
  106.       INTEGER IMPR,IRET
  107.       CHARACTER*4 MYMOP,MYMOD
  108. *
  109. * Executable statements
  110. *
  111.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr30.eso'
  112. *
  113. * Lecture de MATASS
  114. *
  115.       SEGACT MATASS
  116.       KJSPGP=MATASS.KJPOPA
  117.       LINCP =MATASS.LINCPA
  118.       MINCP =MATASS.MINCPA
  119.       KJSPGD=MATASS.KJPODA
  120.       LINCD =MATASS.LINCDA
  121.       MINCD =MATASS.MINCDA
  122.       PROFM =MATASS.PROFMA
  123.       VALM  =MATASS.VALMA
  124. *
  125. * Création de l'inverse des segments MINC
  126. * et suppression de ces derniers
  127. *
  128. * In relr21 : SEGINI IMINCP
  129.       CALL RELR21(MINCP,IMINCP,IMPR,IRET)
  130.       IF (IRET.NE.0) GOTO 9999
  131. * In relr21 : SEGINI IMINCD
  132.       CALL RELR21(MINCD,IMINCD,IMPR,IRET)
  133.       IF (IRET.NE.0) GOTO 9999
  134. *      SEGPRT,IMINCP
  135. *      SEGPRT,IMINCD
  136.       SEGSUP MINCP
  137.       SEGSUP MINCD
  138.       SEGACT MCOORD*MOD
  139.       SEGACT KJSPGP
  140.       SEGACT LINCP
  141.       SEGACT IMINCP
  142.       SEGACT KJSPGD
  143.       SEGACT LINCD
  144.       SEGACT IMINCD
  145.       SEGACT PROFM
  146.       SEGACT VALM
  147.       NDDLDU=IMINCD.LNUPO(/1)
  148.       NPOPRI=KJSPGP.LECT(/1)
  149. * Il y a autant de rigidités à créer que de degrés de liberté duaux
  150.       NRIGEL=NDDLDU
  151.       SEGINI MCON
  152.       MCON.MTYMAT='CON.DIV.'
  153.       MCON.IFORIG=IFOUR
  154.       JG=NPOPRI
  155.       SEGINI KLSPGP
  156.       IF (MCHPOI.NE.0) THEN
  157. * Transformer le KJSPGD en MELEME
  158.          NBNN=1
  159.          NBELEM=KJSPGD.LECT(/1)
  160.          NBSOUS=0
  161.          NBREF=0
  162.          SEGINI MELEME
  163.          DO IBELEM=1,NBELEM
  164.             NUM(1,IBELEM)=KJSPGD.LECT(IBELEM)
  165.          ENDDO
  166.          CALL CP2TR2(LINCD,MELEME,MCHPOI,MTRAV)
  167.          IF (IERR.NE.0) GOTO 9999
  168.          SEGSUP MELEME
  169.          SEGACT MTRAV
  170.          SEGACT LINCD
  171.          NNIN=LINCD.MOTS(/2)
  172.          NNNOE=NDDLDU
  173.          SEGINI MTRA2
  174.          DO ININ=1,NNIN
  175.             MTRA2.INCO(ININ)=LINCD.MOTS(ININ)
  176.             MTRA2.NHAR(ININ)=MTRAV.NHAR(ININ)
  177.          ENDDO
  178.       ENDIF
  179. *        Ensemble des numéros de points primaux
  180.       DO IDDLDU=1,NDDLDU
  181.          MCON.COERIG(IDDLDU)=1.D0
  182.          INZ=PROFM.IA(IDDLDU)
  183.          LNZ=PROFM.IA(IDDLDU+1)-INZ
  184. *
  185. * Création de la géométrie pour la iddldueme matrice
  186. *
  187. *     Quels points de KJSPGP sont concernés par les
  188. *     ddls INZ à INZ+LNZ-1.
  189. *   degré et fin de la liste chaînée
  190.          LDG=0
  191.          LAST=-1
  192.          DO JNZ=1,LNZ
  193.             NUMPP=IMINCP.LNUPO(PROFM.JA(INZ+JNZ-1))
  194.             IF (KLSPGP.LECT(NUMPP).EQ.0) THEN
  195.                LDG=LDG+1
  196.                KLSPGP.LECT(NUMPP)=LAST
  197.                LAST=NUMPP
  198.             ENDIF
  199.          ENDDO
  200. *   remplissage de KKSPGP
  201. *   KLSPGP sert maintenant de repérage dans KKSPGP
  202. *   (ouh la la quelle prise de risque !)
  203.          JG=LDG
  204.          SEGINI KKSPGP
  205.          DO ILDG=1,LDG
  206.             IPREC=KLSPGP.LECT(LAST)
  207.             KKSPGP.LECT(ILDG)=LAST
  208.             KLSPGP.LECT(LAST)=ILDG
  209. *            KLSPGP.LECT(LAST)=0
  210.             LAST=IPREC
  211.          ENDDO
  212. *   géométrie
  213.          NBNN=LDG+1
  214.          NBELEM=1
  215.          NBSOUS=0
  216.          NBREF=0
  217.          SEGINI MEL
  218.          MEL.ITYPEL=22
  219. *   le premier point correspond à celui de IDDLDU
  220.          NUPODU=KJSPGD.LECT(IMINCD.LNUPO(IDDLDU))
  221. *!         MEL.NUM(1,1)=NUPODU
  222. *! on crée deux ! nouveaux points
  223. *   on crée un nouveau point de mêmes coordonnées
  224. *   support du multiplicateur de Lagrange
  225. *         NBPTOT=nbpts
  226. *         NBPTS=NBPTOT+1
  227. *         SEGADJ MCOORD
  228. *         DO IIDIM=1,IDIM
  229. *            XCOOR((NBPTS-1)*(IDIM+1) + IIDIM)=
  230. *     $           XCOOR((NUPODU-1)*(IDIM+1) + IIDIM)
  231. *         ENDDO
  232. *         MEL.NUM(2,1)=NBPTS
  233.          NBPTOT=nbpts
  234.          NBPTS=NBPTOT+1
  235.          SEGADJ MCOORD
  236.          DO IIDIM=1,IDIM
  237.             XCOOR((NBPTS-1)*(IDIM+1) + IIDIM)=
  238.      $           XCOOR((NUPODU-1)*(IDIM+1) + IIDIM)
  239.          ENDDO
  240.          MEL.NUM(1,1)=NBPTS
  241. *   les points suivants correspondent à ceux de KKSPGP
  242.          DO ILDG=1,LDG
  243.             MEL.NUM(1+ILDG,1)=KJSPGP.LECT(KKSPGP.LECT(ILDG))
  244.          ENDDO
  245.          SEGDES MEL
  246.          MCON.IRIGEL(1,IDDLDU)=MEL
  247. *
  248. * Création du segment descripteur pour la iddldueme matrice
  249. *
  250.          NLIGRP=1+LNZ
  251.          NLIGRD=1+LNZ
  252.          SEGINI DESCON
  253. * Les deux premiers indices
  254.          DESCON.NOELEP(1)=1
  255.          DESCON.NOELED(1)=1
  256.          MYMOD=LINCD.MOTS(IMINCD.LNUINC(IDDLDU))
  257.          CALL FICH4(MYMOD,NOMDU,LNOMDU,
  258.      $        INOMDU,
  259.      $        IMPR,IRET)
  260.          IF (IRET.NE.0) GOTO 9999
  261. *?? SG 2025/04/25         DESCON.LISINC(1)=NOMDD(INOMDU)
  262. *?? SG 2025/04/25         DESCON.LISDUA(1)=MYMOD
  263.          DESCON.LISINC(1)='LX'
  264.          DESCON.LISDUA(1)='FLX'
  265. * Les indices suivants
  266.          DO JNZ=1,LNZ
  267.             NUIPP=IMINCP.LNUINC(PROFM.JA(INZ+JNZ-1))
  268.             MYMOP=LINCP.MOTS(NUIPP)
  269.             CALL FICH4(MYMOP,NOMDD,LNOMDD,
  270.      $           INOMDD,
  271.      $           IMPR,IRET)
  272.             IF (IRET.NE.0) GOTO 9999
  273.             DESCON.LISINC(1+JNZ)=MYMOP
  274.             DESCON.LISDUA(1+JNZ)=NOMDU(INOMDD)
  275.             NUMPP=IMINCP.LNUPO(PROFM.JA(INZ+JNZ-1))
  276.             NUMP2=KLSPGP.LECT(NUMPP)
  277.             IF (NUMP2.EQ.0) THEN
  278.                WRITE(IOIMP,*) 'Erreur grave no1'
  279.                GOTO 9999
  280.             ENDIF
  281.             DESCON.NOELEP(1+JNZ)=1+NUMP2
  282.             DESCON.NOELED(1+JNZ)=1+NUMP2
  283.          ENDDO
  284.          SEGDES DESCON
  285.          MCON.IRIGEL(3,IDDLDU)=DESCON
  286. * remise à zéro de KLSPGP et suppression de KKSPGP
  287.          DO ILDG=1,LDG
  288.             KLSPGP.LECT(KKSPGP.LECT(ILDG))=0
  289.          ENDDO
  290.          SEGSUP KKSPGP
  291. *
  292. * Création de la matrice élémentaire
  293. *
  294.          NELRIG=1
  295. *         SEGINI ICON
  296.          NLIGRP=1+LNZ
  297.          NLIGRD=1+LNZ
  298.          SEGINI XCON
  299. * Les deux premiers indices
  300.          XCON.RE(1,1)=0.D0
  301. * Les indices suivants
  302.          DO JNZ=1,LNZ
  303.             VAL=VALM.A(INZ+JNZ-1)
  304.             XCON.RE(1,1+JNZ,1)=VAL
  305.             XCON.RE(1+JNZ,1,1)=VAL
  306.          ENDDO
  307.          SEGDES XCON
  308. *         ICON.IMATTT(1)=XCON
  309. *         SEGDES ICON
  310. *         MCON.IRIGEL(4,IDDLDU)=ICON
  311.          MCON.IRIGEL(4,IDDLDU)=XCON
  312.          MCON.IRIGEL(5,IDDLDU)=0
  313.          MCON.IRIGEL(6,IDDLDU)=0
  314.          MCON.IRIGEL(7,IDDLDU)=0
  315.          IF (MCHPOI.NE.0) THEN
  316.             ININ=IMINCD.LNUINC(IDDLDU)
  317.             INNOE=IMINCD.LNUPO(IDDLDU)
  318.             MTRA2.IGEO(IDDLDU)=NBPTS
  319.             MTRA2.IBIN(ININ,IDDLDU)=1
  320.             MTRA2.BB(ININ,IDDLDU)=MTRAV.BB(ININ,INNOE)
  321.          ENDIF
  322.       ENDDO
  323.       SEGSUP KLSPGP
  324.       SEGDES MCON
  325. * Suppression de tous les objets de MATASS
  326.       SEGSUP VALM
  327.       SEGSUP PROFM
  328.       SEGSUP IMINCD
  329.       SEGSUP LINCD
  330.       SEGSUP KJSPGD
  331.       SEGSUP IMINCP
  332.       SEGSUP LINCP
  333.       SEGSUP KJSPGP
  334. *     SEGDES MCOORD
  335.       SEGACT MCOORD
  336.       SEGSUP MATASS
  337.       IF (MCHPOI.NE.0) THEN
  338.          SEGSUP MTRAV
  339.          CALL CRECHP(MTRA2,MCHPO2)
  340.          SEGSUP MTRA2
  341.       ELSE
  342.          MCHPO2=0
  343.       ENDIF
  344. *
  345. * Normal termination
  346. *
  347.       IRET=0
  348.       RETURN
  349. *
  350. * Format handling
  351. *
  352. *
  353. * Error handling
  354. *
  355.  9999 CONTINUE
  356.       IRET=1
  357.       WRITE(IOIMP,*) 'An error was detected in subroutine relr30'
  358.       RETURN
  359. *
  360. * End of subroutine RELR30
  361. *
  362.       END
  363.  
  364.  

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