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    FANDEUR   22/03/01    21:15:07     11301          
  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. * In CP2TR2 : SEGDES LINCD
  167.          CALL CP2TR2(LINCD,MELEME,MCHPOI,MTRAV,IRET)
  168.          IF (IRET.NE.0) GOTO 9999
  169.          SEGSUP MELEME
  170.          SEGACT MTRAV
  171.          SEGACT LINCD
  172.          NNIN=LINCD.MOTS(/2)
  173.          NNNOE=NDDLDU
  174.          SEGINI MTRA2
  175.          DO ININ=1,NNIN
  176.             MTRA2.INCO(ININ)=LINCD.MOTS(ININ)
  177.             MTRA2.NHAR(ININ)=MTRAV.NHAR(ININ)
  178.          ENDDO
  179.       ENDIF
  180. *        Ensemble des numéros de points primaux
  181.       DO IDDLDU=1,NDDLDU
  182.          MCON.COERIG(IDDLDU)=1.D0
  183.          INZ=PROFM.IA(IDDLDU)
  184.          LNZ=PROFM.IA(IDDLDU+1)-INZ
  185. *
  186. * Création de la géométrie pour la iddldueme matrice
  187. *
  188. *     Quels points de KJSPGP sont concernés par les
  189. *     ddls INZ à INZ+LNZ-1.
  190. *   degré et fin de la liste chaînée
  191.          LDG=0
  192.          LAST=-1
  193.          DO JNZ=1,LNZ
  194.             NUMPP=IMINCP.LNUPO(PROFM.JA(INZ+JNZ-1))
  195.             IF (KLSPGP.LECT(NUMPP).EQ.0) THEN
  196.                LDG=LDG+1
  197.                KLSPGP.LECT(NUMPP)=LAST
  198.                LAST=NUMPP
  199.             ENDIF
  200.          ENDDO
  201. *   remplissage de KKSPGP
  202. *   KLSPGP sert maintenant de repérage dans KKSPGP
  203. *   (ouh la la quelle prise de risque !)
  204.          JG=LDG
  205.          SEGINI KKSPGP
  206.          DO ILDG=1,LDG
  207.             IPREC=KLSPGP.LECT(LAST)
  208.             KKSPGP.LECT(ILDG)=LAST
  209.             KLSPGP.LECT(LAST)=ILDG
  210. *            KLSPGP.LECT(LAST)=0
  211.             LAST=IPREC
  212.          ENDDO
  213. *   géométrie
  214.          NBNN=LDG+1
  215.          NBELEM=1
  216.          NBSOUS=0
  217.          NBREF=0
  218.          SEGINI MEL
  219.          MEL.ITYPEL=22
  220. *   le premier point correspond à celui de IDDLDU
  221.          NUPODU=KJSPGD.LECT(IMINCD.LNUPO(IDDLDU))
  222. *!         MEL.NUM(1,1)=NUPODU
  223. *! on crée deux ! nouveaux points
  224. *   on crée un nouveau point de mêmes coordonnées
  225. *   support du multiplicateur de Lagrange
  226. *         NBPTOT=nbpts
  227. *         NBPTS=NBPTOT+1
  228. *         SEGADJ MCOORD
  229. *         DO IIDIM=1,IDIM
  230. *            XCOOR((NBPTS-1)*(IDIM+1) + IIDIM)=
  231. *     $           XCOOR((NUPODU-1)*(IDIM+1) + IIDIM)
  232. *         ENDDO
  233. *         MEL.NUM(2,1)=NBPTS
  234.          NBPTOT=nbpts
  235.          NBPTS=NBPTOT+1
  236.          SEGADJ MCOORD
  237.          DO IIDIM=1,IDIM
  238.             XCOOR((NBPTS-1)*(IDIM+1) + IIDIM)=
  239.      $           XCOOR((NUPODU-1)*(IDIM+1) + IIDIM)
  240.          ENDDO
  241.          MEL.NUM(1,1)=NBPTS
  242. *   les points suivants correspondent à ceux de KKSPGP
  243.          DO ILDG=1,LDG
  244.             MEL.NUM(1+ILDG,1)=KJSPGP.LECT(KKSPGP.LECT(ILDG))
  245.          ENDDO
  246.          SEGDES MEL
  247.          MCON.IRIGEL(1,IDDLDU)=MEL
  248. *
  249. * Création du segment descripteur pour la iddldueme matrice
  250. *
  251.          NLIGRP=1+LNZ
  252.          NLIGRD=1+LNZ
  253.          SEGINI DESCON
  254. * Les deux premiers indices
  255.          DESCON.NOELEP(1)=1
  256.          DESCON.NOELED(1)=1
  257.          MYMOD=LINCD.MOTS(IMINCD.LNUINC(IDDLDU))
  258.          CALL FICH4(MYMOD,NOMDU,LNOMDU,
  259.      $        INOMDU,
  260.      $        IMPR,IRET)
  261.          IF (IRET.NE.0) GOTO 9999
  262.          DESCON.LISINC(1)=NOMDD(INOMDU)
  263.          DESCON.LISDUA(1)=MYMOD
  264. * Les indices suivants
  265.          DO JNZ=1,LNZ
  266.             NUIPP=IMINCP.LNUINC(PROFM.JA(INZ+JNZ-1))
  267.             MYMOP=LINCP.MOTS(NUIPP)
  268.             CALL FICH4(MYMOP,NOMDD,LNOMDD,
  269.      $           INOMDD,
  270.      $           IMPR,IRET)
  271.             IF (IRET.NE.0) GOTO 9999
  272.             DESCON.LISINC(1+JNZ)=MYMOP
  273.             DESCON.LISDUA(1+JNZ)=NOMDU(INOMDD)
  274.             NUMPP=IMINCP.LNUPO(PROFM.JA(INZ+JNZ-1))
  275.             NUMP2=KLSPGP.LECT(NUMPP)
  276.             IF (NUMP2.EQ.0) THEN
  277.                WRITE(IOIMP,*) 'Erreur grave no1'
  278.                GOTO 9999
  279.             ENDIF
  280.             DESCON.NOELEP(1+JNZ)=1+NUMP2
  281.             DESCON.NOELED(1+JNZ)=1+NUMP2
  282.          ENDDO
  283.          SEGDES DESCON
  284.          MCON.IRIGEL(3,IDDLDU)=DESCON
  285. * remise à zéro de KLSPGP et suppression de KKSPGP
  286.          DO ILDG=1,LDG
  287.             KLSPGP.LECT(KKSPGP.LECT(ILDG))=0
  288.          ENDDO
  289.          SEGSUP KKSPGP
  290. *
  291. * Création de la matrice élémentaire
  292. *
  293.          NELRIG=1
  294. *         SEGINI ICON
  295.          NLIGRP=1+LNZ
  296.          NLIGRD=1+LNZ
  297.          SEGINI XCON
  298. * Les deux premiers indices
  299.          XCON.RE(1,1)=0.D0
  300. * Les indices suivants
  301.          DO JNZ=1,LNZ
  302.             VAL=VALM.A(INZ+JNZ-1)
  303.             XCON.RE(1,1+JNZ,1)=VAL
  304.             XCON.RE(1+JNZ,1,1)=VAL
  305.          ENDDO
  306.          SEGDES XCON
  307. *         ICON.IMATTT(1)=XCON
  308. *         SEGDES ICON
  309. *         MCON.IRIGEL(4,IDDLDU)=ICON
  310.          MCON.IRIGEL(4,IDDLDU)=XCON
  311.          MCON.IRIGEL(5,IDDLDU)=0
  312.          MCON.IRIGEL(6,IDDLDU)=0
  313.          MCON.IRIGEL(7,IDDLDU)=0
  314.          IF (MCHPOI.NE.0) THEN
  315.             ININ=IMINCD.LNUINC(IDDLDU)
  316.             INNOE=IMINCD.LNUPO(IDDLDU)
  317.             MTRA2.IGEO(IDDLDU)=NBPTS
  318.             MTRA2.IBIN(ININ,IDDLDU)=1
  319.             MTRA2.BB(ININ,IDDLDU)=MTRAV.BB(ININ,INNOE)
  320.          ENDIF
  321.       ENDDO
  322.       SEGSUP KLSPGP
  323.       SEGDES MCON
  324. * Suppression de tous les objets de MATASS
  325.       SEGSUP VALM
  326.       SEGSUP PROFM
  327.       SEGSUP IMINCD
  328.       SEGSUP LINCD
  329.       SEGSUP KJSPGD
  330.       SEGSUP IMINCP
  331.       SEGSUP LINCP
  332.       SEGSUP KJSPGP
  333. *     SEGDES MCOORD
  334.       SEGACT MCOORD
  335.       SEGSUP MATASS
  336.       IF (MCHPOI.NE.0) THEN
  337.          SEGSUP MTRAV
  338.          CALL CRECHP(MTRA2,MCHPO2)
  339.          SEGSUP MTRA2
  340.       ELSE
  341.          MCHPO2=0
  342.       ENDIF
  343. *
  344. * Normal termination
  345. *
  346.       IRET=0
  347.       RETURN
  348. *
  349. * Format handling
  350. *
  351. *
  352. * Error handling
  353. *
  354.  9999 CONTINUE
  355.       IRET=1
  356.       WRITE(IOIMP,*) 'An error was detected in subroutine relr30'
  357.       RETURN
  358. *
  359. * End of subroutine RELR30
  360. *
  361.       END
  362.  
  363.  
  364.  

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