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   24/09/06    21:15:04     12004          
  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.          DESCON.LISINC(1)=NOMDD(INOMDU)
  262.          DESCON.LISDUA(1)=MYMOD
  263. * Les indices suivants
  264.          DO JNZ=1,LNZ
  265.             NUIPP=IMINCP.LNUINC(PROFM.JA(INZ+JNZ-1))
  266.             MYMOP=LINCP.MOTS(NUIPP)
  267.             CALL FICH4(MYMOP,NOMDD,LNOMDD,
  268.      $           INOMDD,
  269.      $           IMPR,IRET)
  270.             IF (IRET.NE.0) GOTO 9999
  271.             DESCON.LISINC(1+JNZ)=MYMOP
  272.             DESCON.LISDUA(1+JNZ)=NOMDU(INOMDD)
  273.             NUMPP=IMINCP.LNUPO(PROFM.JA(INZ+JNZ-1))
  274.             NUMP2=KLSPGP.LECT(NUMPP)
  275.             IF (NUMP2.EQ.0) THEN
  276.                WRITE(IOIMP,*) 'Erreur grave no1'
  277.                GOTO 9999
  278.             ENDIF
  279.             DESCON.NOELEP(1+JNZ)=1+NUMP2
  280.             DESCON.NOELED(1+JNZ)=1+NUMP2
  281.          ENDDO
  282.          SEGDES DESCON
  283.          MCON.IRIGEL(3,IDDLDU)=DESCON
  284. * remise à zéro de KLSPGP et suppression de KKSPGP
  285.          DO ILDG=1,LDG
  286.             KLSPGP.LECT(KKSPGP.LECT(ILDG))=0
  287.          ENDDO
  288.          SEGSUP KKSPGP
  289. *
  290. * Création de la matrice élémentaire
  291. *
  292.          NELRIG=1
  293. *         SEGINI ICON
  294.          NLIGRP=1+LNZ
  295.          NLIGRD=1+LNZ
  296.          SEGINI XCON
  297. * Les deux premiers indices
  298.          XCON.RE(1,1)=0.D0
  299. * Les indices suivants
  300.          DO JNZ=1,LNZ
  301.             VAL=VALM.A(INZ+JNZ-1)
  302.             XCON.RE(1,1+JNZ,1)=VAL
  303.             XCON.RE(1+JNZ,1,1)=VAL
  304.          ENDDO
  305.          SEGDES XCON
  306. *         ICON.IMATTT(1)=XCON
  307. *         SEGDES ICON
  308. *         MCON.IRIGEL(4,IDDLDU)=ICON
  309.          MCON.IRIGEL(4,IDDLDU)=XCON
  310.          MCON.IRIGEL(5,IDDLDU)=0
  311.          MCON.IRIGEL(6,IDDLDU)=0
  312.          MCON.IRIGEL(7,IDDLDU)=0
  313.          IF (MCHPOI.NE.0) THEN
  314.             ININ=IMINCD.LNUINC(IDDLDU)
  315.             INNOE=IMINCD.LNUPO(IDDLDU)
  316.             MTRA2.IGEO(IDDLDU)=NBPTS
  317.             MTRA2.IBIN(ININ,IDDLDU)=1
  318.             MTRA2.BB(ININ,IDDLDU)=MTRAV.BB(ININ,INNOE)
  319.          ENDIF
  320.       ENDDO
  321.       SEGSUP KLSPGP
  322.       SEGDES MCON
  323. * Suppression de tous les objets de MATASS
  324.       SEGSUP VALM
  325.       SEGSUP PROFM
  326.       SEGSUP IMINCD
  327.       SEGSUP LINCD
  328.       SEGSUP KJSPGD
  329.       SEGSUP IMINCP
  330.       SEGSUP LINCP
  331.       SEGSUP KJSPGP
  332. *     SEGDES MCOORD
  333.       SEGACT MCOORD
  334.       SEGSUP MATASS
  335.       IF (MCHPOI.NE.0) THEN
  336.          SEGSUP MTRAV
  337.          CALL CRECHP(MTRA2,MCHPO2)
  338.          SEGSUP MTRA2
  339.       ELSE
  340.          MCHPO2=0
  341.       ENDIF
  342. *
  343. * Normal termination
  344. *
  345.       IRET=0
  346.       RETURN
  347. *
  348. * Format handling
  349. *
  350. *
  351. * Error handling
  352. *
  353.  9999 CONTINUE
  354.       IRET=1
  355.       WRITE(IOIMP,*) 'An error was detected in subroutine relr30'
  356.       RETURN
  357. *
  358. * End of subroutine RELR30
  359. *
  360.       END
  361.  
  362.  

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