Télécharger la plaquette Cast3M


fr en

Télécharger cv2maa.eso

Retour à la liste

Numérotation des lignes : 

cv2maa

  1. C CV2MAA    SOURCE    CB215821  25/04/23    21:15:12     12247          
  2.       SUBROUTINE CV2MAA(CGEOMQ,TABVDC,TABMAT,
  3.      $     MYFALS,
  4.      $     MATLSA,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : CV2MAA
  10. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  11. C               représentant un ensemble de matrices élémentaires en
  12. C               RIGIDITE...
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES          :
  19. C APPELES (E/S)    :
  20. C APPELE PAR       : CV2MCA
  21. C***********************************************************************
  22. C ENTREES            :
  23. C ENTREES/SORTIES    : -
  24. C SORTIES            :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION    : v1, 06/03/06, version initiale
  28. C HISTORIQUE : v1, 06/03/06, création
  29. C HISTORIQUE :
  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.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC CCHAMP
  40. -INC SMLMOTS
  41.       POINTEUR NCVAPR.MLMOTS
  42.       POINTEUR NCVADU.MLMOTS
  43. -INC SMELEME
  44.       POINTEUR CGEOMQ.MELEME
  45.       POINTEUR MYMEL.MELEME
  46.       POINTEUR RIGMEL.MELEME
  47. -INC SMLENTI
  48.       POINTEUR LINCPR.MLENTI,LINCDU.MLENTI
  49.       POINTEUR KINCPR.MLENTI,KINCDU.MLENTI
  50.       POINTEUR LPOQUF.MLENTI,KPOQUF.MLENTI
  51.       POINTEUR NOFSPR.MLENTI,NOFSDU.MLENTI
  52.       POINTEUR COPRDU.MLENTI,LINCD2.MLENTI
  53. -INC SMRIGID
  54. -INC SMCOORD
  55.       POINTEUR MATLSA.MRIGID
  56.       POINTEUR MYDSCR.DESCR
  57.       POINTEUR MYIMAT.IMATRI
  58.       POINTEUR MYXMAT.XMATRI
  59. *
  60. * Includes persos
  61. *
  62. -INC TNLIN
  63. *-INC SMTNLIN
  64. *-INC SMCHAEL
  65.       POINTEUR IMTLSA.MCHAEL
  66.       POINTEUR JMTLSA.MCHEVA
  67.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  68. *-INC SFALRF
  69.       POINTEUR MYFALS.FALRFS
  70. *-INC SELREF
  71.       POINTEUR LRFPR.ELREF
  72.       POINTEUR LRFDU.ELREF
  73. *
  74.       CHARACTER*4 MDISPR,MDISDU,MOPR,MODU
  75.       INTEGER IMPR,IRET
  76. *
  77.       INTEGER IBNN,IBELEM
  78.       INTEGER ITQUAF,NDDLPR,NDDLDU
  79.       INTEGER        IDDLPR,IDDLDU
  80.       INTEGER               NSOUS,NPOQUF
  81.       INTEGER ISOUS
  82.       LOGICAL LOK,LFOUND,LCORES,LEQ1,LEQ2,LFIRST
  83.  
  84. *
  85. * Executable statements
  86. *
  87.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2maa'
  88. *
  89. *      Vérification sur les inconnues
  90. *
  91.       SEGACT TABVDC
  92.       SEGACT TABMAT
  93. *      SEGPRT,TABVDC
  94. *      SEGPRT,TABMAT
  95.  
  96.       NUMVPR=TABMAT.VMAT(/2)
  97.       NUMVDU=TABMAT.VMAT(/1)
  98. *
  99. * Construction des listes d'inconnues primales et duales
  100. * qui interviennent dans la matrice et dont la valeur n'est pas
  101. * donnée
  102.       JG=0
  103.       SEGINI LINCPR
  104.       SEGINI LINCDU
  105.       DO IVARPR=1,NUMVPR
  106.          IPR=TABVDC.VVARPR(IVARPR)
  107.          IF (TABVDC.MVD(IPR).EQ.0) THEN
  108.             DO IVARDU=1,NUMVDU
  109.                IDU=TABVDC.VVARDU(IVARDU)
  110.                IF (TABVDC.MVD(IDU).EQ.0) THEN
  111.                   IF (TABMAT.VMAT(IVARDU,IVARPR).NE.0) THEN
  112.                      LINCDU.LECT(**)=IDU
  113.                      LINCPR.LECT(**)=IPR
  114.                   ENDIF
  115.                ENDIF
  116.             ENDDO
  117.          ENDIF
  118.       ENDDO
  119.       NINCPR=LINCPR.LECT(/1)
  120.       NINCDU=LINCDU.LECT(/1)
  121. * Sortie anticipée s'il n'y a pas de matrices à construire
  122.       IF (NINCPR.EQ.0.AND.NINCDU.EQ.0) THEN
  123. *         SEGACT LINCPR
  124. *         SEGACT LINCDU
  125.          SEGSUP LINCPR
  126.          SEGSUP LINCDU
  127.          MATLSA=0
  128.          RETURN
  129.       ENDIF
  130. *
  131. *      WRITE(IOIMP,*) 'LINCPR et LINCDU'
  132. *      SEGPRT,LINCPR
  133. *      SEGPRT,LINCDU
  134. * Suppression des doublons
  135.       CALL IUNIQ(LINCPR.LECT,LINCPR.LECT(/1),
  136.      $     LINCPR.LECT,NINCPR,
  137.      $     IMPR,IRET)
  138.       IF (IRET.NE.0) GOTO 9999
  139.       JG=NINCPR
  140.       SEGADJ,LINCPR
  141.       CALL IUNIQ(LINCDU.LECT,LINCDU.LECT(/1),
  142.      $     LINCDU.LECT,NINCDU,
  143.      $     IMPR,IRET)
  144.       IF (IRET.NE.0) GOTO 9999
  145.       JG=NINCDU
  146.       SEGADJ,LINCDU
  147. *      WRITE(IOIMP,*) 'LINCPR et LINCDU sans doublons'
  148. *      SEGPRT,LINCPR
  149. *      SEGPRT,LINCDU
  150. *
  151. * Si les listes d'inconnues ont même taille, on se fatigue
  152. * à chercher une permutation des inconnues duales qui les
  153. * recollent sur les primales
  154. * Ca ne marche pas pour l'instant : COPRDU n'est pas forcément
  155. * une permutation ex : primale = 'TN' ; duale = 'SCAL'
  156. *
  157.       IF (.FALSE.) THEN
  158.          IF (NINCPR.EQ.NINCDU) THEN
  159.             JG=NINCPR
  160.             SEGINI COPRDU
  161.             LOK=.TRUE.
  162.             IINCPR=0
  163.  3          CONTINUE
  164.             IF (LOK.AND.IINCPR.LT.NINCPR) THEN
  165.                IINCPR=IINCPR+1
  166.                JGVDPR=LINCPR.LECT(IINCPR)
  167.                NCVAPR=TABVDC.NOMVD(JGVDPR)
  168.                SEGACT NCVAPR
  169. *            SEGPRT,NCVAPR
  170.                NMOVPR=NCVAPR.MOTS(/2)
  171.                IINCDU=0
  172.                LFOUND=.FALSE.
  173.  1             CONTINUE
  174. *            WRITE(IOIMP,*) '1'
  175.                IF (.NOT.LFOUND.AND.IINCDU.LT.NINCDU) THEN
  176.                   IINCDU=IINCDU+1
  177.                   JGVDDU=LINCDU.LECT(IINCDU)
  178.                   NCVADU=TABVDC.NOMVD(JGVDDU)
  179.                   SEGACT NCVADU
  180. *               SEGPRT,NCVADU
  181.                   NMOVDU=NCVADU.MOTS(/2)
  182.                   LCORES=.FALSE.
  183.                   IF (NMOVDU.EQ.NMOVPR) THEN
  184.                      LCORES=.TRUE.
  185.                      IMOV=0
  186.  2                   CONTINUE
  187. *                  WRITE(IOIMP,*) '2'
  188.                      IF (LCORES.AND.IMOV.LT.NMOVDU) THEN
  189.  
  190.                         IMOV=IMOV+1
  191.                         MOPR=NCVAPR.MOTS(IMOV)
  192.                         MODU=NCVADU.MOTS(IMOV)
  193. *                     WRITE(IOIMP,*) 'avant fimot2'
  194.                         CALL FIMOT2(MOPR,NOMDD,LNOMDD,
  195.      $                       IPR,IMPR,IRET)
  196.                         IF (IRET.NE.0) GOTO 9999
  197. *                     WRITE(IOIMP,*) 'apres fimot2'
  198.                         LEQ1=MOPR.EQ.MODU
  199. *                     WRITE(IOIMP,*) 'LEQ1=',LEQ1
  200. *                     WRITE(IOIMP,*) 'IPR=',IPR
  201.                         IF (IPR.NE.0) THEN
  202.                            LEQ2=MODU.EQ.NOMDU(IPR)
  203.                         ELSE
  204.                            LEQ2=.FALSE.
  205.                         ENDIF
  206. *                     WRITE(IOIMP,*) 'LEQ2=',LEQ2
  207.                         LCORES=LCORES.AND.(LEQ1.OR.LEQ2)
  208.                         GOTO 2
  209.                      ENDIF
  210.                   ENDIF
  211.                   SEGDES NCVADU
  212.                   LFOUND=LCORES
  213.                   GOTO 1
  214.                ENDIF
  215.                IF (LFOUND) THEN
  216.                   COPRDU.LECT(IINCPR)=IINCDU
  217.                ENDIF
  218.                SEGDES NCVAPR
  219.                LOK=LOK.AND.LFOUND
  220.                GOTO 3
  221.             ENDIF
  222. *         SEGPRT,COPRDU
  223. *
  224. * On permute LINCDU
  225. *
  226.             LINCD2=LINCDU
  227.             JG=NINCDU
  228.             SEGINI LINCDU
  229.             DO IINCDU=1,NINCDU
  230.                LINCDU.LECT(IINCDU)=LINCD2.LECT(COPRDU.LECT(IINCDU))
  231.             ENDDO
  232.             SEGSUP LINCD2
  233.             SEGSUP COPRDU
  234.          ENDIF
  235. *      WRITE(IOIMP,*) 'LINCDU permuté'
  236. *      SEGPRT,LINCPR
  237. *      SEGPRT,LINCDU
  238.       ENDIF
  239. *
  240. * Maintenant on construit la table de repérage dans LINCPR et LINCDU
  241. *
  242.       JG=TABVDC.DJSVD(/1)
  243.       SEGINI KINCPR
  244.       CALL RSETXI(KINCPR.LECT,LINCPR.LECT,LINCPR.LECT(/1))
  245.       SEGINI KINCDU
  246.       CALL RSETXI(KINCDU.LECT,LINCDU.LECT,LINCDU.LECT(/1))
  247. *      WRITE(IOIMP,*) 'KINCPR et KINCDU'
  248. *      SEGPRT,KINCPR
  249. *      SEGPRT,KINCDU
  250. *
  251.       SEGACT CGEOMQ
  252.       NSOUS=CGEOMQ.LISOUS(/1)
  253. *
  254. * Initialisation de la matrice
  255. *
  256.       NRIGEL=NSOUS
  257.       SEGINI,MATLSA
  258.       MATLSA.MTYMAT='LEASTSQU'
  259. * Parcours
  260.       DO ISOUS=1,NSOUS
  261. *         WRITE(IOIMP,*) 'ISOUS=',ISOUS
  262.          MYMEL=CGEOMQ.LISOUS(ISOUS)
  263.          SEGACT MYMEL
  264. *         SEGPRT,MYMEL
  265.          ITQUAF=MYMEL.ITYPEL
  266. *
  267. * Maintenant on construit :
  268. * - L'objet géométrie
  269. * - La table d'offset pour les variables primales et duales
  270. * - Le segment descripteur
  271. *
  272. *   Liste des points du QUAF sur lequels il y a des ddl
  273.          JG=0
  274.          SEGINI LPOQUF
  275. *   Tables d'offset
  276.          JG=NINCPR+1
  277.          SEGINI NOFSPR
  278.          NOFSPR.LECT(1)=0
  279.          JG=NINCDU+1
  280.          SEGINI NOFSDU
  281.          NOFSDU.LECT(1)=0
  282.          NLIGRP=0
  283.          NLIGRD=0
  284. *       Primale
  285.          DO IINCPR=1,NINCPR
  286.             IJGVD=LINCPR.LECT(IINCPR)
  287.             IKGVD=TABVDC.DJSVD(IJGVD)
  288.             MDISPR=TABVDC.DISVD(IKGVD)
  289.             CALL KEEF(ITQUAF,MDISPR,MYFALS,
  290.      $           LRFPR,IMPR,IRET)
  291.             IF (IRET.NE.0) GOTO 9999
  292.             SEGACT LRFPR
  293.             NDDLPR=LRFPR.NPQUAF(/1)
  294.             DO IDDLPR=1,NDDLPR
  295.                LPOQUF.LECT(**)=LRFPR.NPQUAF(IDDLPR)
  296.             ENDDO
  297. * Si le maillage donné à NLIN n'était pas QUAF au départ, il faut
  298. * vérifier que tous les ddls peuvent s'appuyer sur les points du
  299. * maillage donné
  300. * Le test uniquement sur le 1er element doit etre suffisant
  301.             IF (CGEOMQ.LISREF(ISOUS).NE.0) THEN
  302.                DO IDDLPR=1,NDDLPR
  303.                   NNQUA=LRFPR.NPQUAF(IDDLPR)
  304.                   NNGLO=MYMEL.NUM(NNQUA,1)
  305.                   IF (NNGLO.EQ.0) THEN
  306.                      WRITE(IOIMP,*) 'A discretization space ',MDISPR,
  307.      $                    ' is incompatible with the given mesh'
  308.                      WRITE(IOIMP,*) 'Check its element type please'
  309.                      GOTO 9999
  310.                   ENDIF
  311.                ENDDO
  312.             ENDIF
  313.             SEGDES LRFPR
  314.             NLIGRP=NLIGRP+NDDLPR
  315.             NOFSPR.LECT(IINCPR+1)=NLIGRP
  316.          ENDDO
  317. *       Duale
  318.          DO IINCDU=1,NINCDU
  319.             IJGVD=LINCDU.LECT(IINCDU)
  320.             IKGVD=TABVDC.DJSVD(IJGVD)
  321.             MDISDU=TABVDC.DISVD(IKGVD)
  322.             CALL KEEF(ITQUAA,MDISDU,MYFALS,
  323.      $           LRFDU,IMPR,IRET)
  324.             IF (IRET.NE.0) GOTO 9999
  325.             SEGACT LRFDU
  326.             NDDLDU=LRFDU.NPQUAF(/1)
  327.             DO IDDLDU=1,NDDLDU
  328.                LPOQUF.LECT(**)=LRFDU.NPQUAF(IDDLDU)
  329.             ENDDO
  330. * Si le maillage donné à NLIN n'était pas QUAF au départ, il faut
  331. * vérifier que tous les ddls peuvent s'appuyer sur les points du
  332. * maillage donné
  333. * Le test uniquement sur le 1er element doit etre suffisant
  334.             IF (CGEOMQ.LISREF(ISOUS).NE.0) THEN
  335.                DO IDDLDU=1,NDDLDU
  336.                   NNQUA=LRFDU.NPQUAF(IDDLDU)
  337.                   NNGLO=MYMEL.NUM(NNQUA,1)
  338.                   IF (NNGLO.EQ.0) THEN
  339.                      WRITE(IOIMP,*) 'A discretization space ',MDISDU,
  340.      $                    ' is incompatible with the given mesh'
  341.                      WRITE(IOIMP,*) 'Check its element type please'
  342.                      GOTO 9999
  343.                   ENDIF
  344.                ENDDO
  345.             ENDIF
  346.             SEGDES LRFDU
  347.             NLIGRD=NLIGRD+NDDLDU
  348.             NOFSDU.LECT(IINCDU+1)=NLIGRD
  349.          ENDDO
  350. * Suppression des doublons de LPOQUF
  351.          CALL IUNIQ(LPOQUF.LECT,LPOQUF.LECT(/1),
  352.      $        LPOQUF.LECT,NPOQUF,
  353.      $        IMPR,IRET)
  354.          IF (IRET.NE.0) GOTO 9999
  355.          JG=NPOQUF
  356.          SEGADJ,LPOQUF
  357. * Segment de repérage dans LPOQUF
  358.          JG=MYMEL.NUM(/1)
  359.          SEGINI,KPOQUF
  360.          CALL RSETXI(KPOQUF.LECT,LPOQUF.LECT,LPOQUF.LECT(/1))
  361. *         SEGPRT,LPOQUF
  362. *         SEGPRT,KPOQUF
  363. *
  364. * Remplissage de l'objet géométrie
  365. *
  366.          NBNN=NPOQUF
  367.          NBELEM=MYMEL.NUM(/2)
  368.          NBSOUS=0
  369.          NBREF=0
  370.          SEGINI,RIGMEL
  371. * Type 32 POLY
  372.          RIGMEL.ITYPEL=32
  373.          DO IBELEM=1,NBELEM
  374.             DO IBNN=1,NBNN
  375.                RIGMEL.NUM(IBNN,IBELEM)=
  376.      $              MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM)
  377.             ENDDO
  378.          ENDDO
  379.          SEGDES RIGMEL
  380.          SEGSUP LPOQUF
  381. *        SEGPRT,RIGMEL
  382. *
  383. * Remplissage du segment DESCR
  384. *
  385.          SEGINI MYDSCR
  386. *       Primale
  387.          DO IINCPR=1,NINCPR
  388.             IJGVD=LINCPR.LECT(IINCPR)
  389.             IKGVD=TABVDC.DJSVD(IJGVD)
  390.             MDISPR=TABVDC.DISVD(IKGVD)
  391.             CALL KEEF(ITQUAA,MDISPR,MYFALS,
  392.      $           LRFPR,IMPR,IRET)
  393.             IF (IRET.NE.0) GOTO 9999
  394.             SEGACT LRFPR
  395.             NCVAPR=TABVDC.NOMVD(IJGVD)
  396.             SEGACT NCVAPR
  397.             NDDLPR=LRFPR.NPQUAF(/1)
  398.             DO IDDLPR=1,NDDLPR
  399.                ILIGPR=IDDLPR+NOFSPR.LECT(IINCPR)
  400.                ICMPR=LRFPR.NUMCMP(IDDLPR)
  401.                MYDSCR.LISINC(ILIGPR)=NCVAPR.MOTS(ICMPR)
  402.                MYDSCR.NOELEP(ILIGPR)=
  403.      $              KPOQUF.LECT(LRFPR.NPQUAF(IDDLPR))
  404.             ENDDO
  405.             SEGDES NCVAPR
  406.             SEGDES LRFPR
  407.          ENDDO
  408. *       Duale
  409.          DO IINCDU=1,NINCDU
  410.             IJGVD=LINCDU.LECT(IINCDU)
  411.             IKGVD=TABVDC.DJSVD(IJGVD)
  412.             MDISDU=TABVDC.DISVD(IKGVD)
  413.             CALL KEEF(ITQUAA,MDISDU,MYFALS,
  414.      $           LRFDU,IMPR,IRET)
  415.             IF (IRET.NE.0) GOTO 9999
  416.             SEGACT LRFDU
  417.             NCVADU=TABVDC.NOMVD(IJGVD)
  418.             SEGACT NCVADU
  419.             NDDLDU=LRFDU.NPQUAF(/1)
  420.             DO IDDLDU=1,NDDLDU
  421.                ILIGDU=IDDLDU+NOFSDU.LECT(IINCDU)
  422.                ICMDU=LRFDU.NUMCMP(IDDLDU)
  423.                MYDSCR.LISDUA(ILIGDU)=NCVADU.MOTS(ICMDU)
  424.                MYDSCR.NOELED(ILIGDU)=
  425.      $              KPOQUF.LECT(LRFDU.NPQUAF(IDDLDU))
  426.             ENDDO
  427.             SEGDES NCVADU
  428.             SEGDES LRFDU
  429.          ENDDO
  430.          SEGDES MYDSCR
  431. *         SEGPRT,MYDSCR
  432.          SEGSUP KPOQUF
  433. *
  434. * Remplissage du IMATRI
  435. *
  436.          NELRIG=MYMEL.NUM(/2)
  437.          SEGDES MYMEL
  438.          SEGINI MYxMAT
  439. *      NLIGRP et NLIGRD déjà calculés
  440.          DO IVARPR=1,NUMVPR
  441. *            write(ioimp,*) 'ivarpr=',ivarpr
  442.             JGVDPR=TABVDC.VVARPR(IVARPR)
  443.             IF (TABVDC.MVD(JGVDPR).EQ.0) THEN
  444.                IINCPR=KINCPR.LECT(JGVDPR)
  445. *               write(ioimp,*) 'iincpr=',iincpr
  446.                DO IVARDU=1,NUMVDU
  447. *                  write(ioimp,*) 'ivardu=',ivardu
  448.                   JGVDDU=TABVDC.VVARDU(IVARDU)
  449.                   IF (TABVDC.MVD(JGVDDU).EQ.0) THEN
  450.                      IINCDU=KINCDU.LECT(JGVDDU)
  451. *                     write(ioimp,*) 'iincdu=',iincdu
  452.                      IMTLSA=TABMAT.VMAT(IVARDU,IVARPR)
  453.                      IF (IMTLSA.NE.0) THEN
  454.                         SEGACT IMTLSA
  455.                         JMTLSA=IMTLSA.ICHEVA(ISOUS)
  456.                         SEGACT JMTLSA
  457.                         NBLIG=JMTLSA.WELCHE(/1)
  458.                         NBCOL=JMTLSA.WELCHE(/2)
  459.                         N2LIG=JMTLSA.WELCHE(/3)
  460.                         N2COL=JMTLSA.WELCHE(/4)
  461.                         NBPOI=JMTLSA.WELCHE(/5)
  462.                         NBELM=JMTLSA.WELCHE(/6)
  463.                         IOFSPR=NOFSPR.LECT(IINCPR)
  464.                         IOFSDU=NOFSDU.LECT(IINCDU)
  465. *                        write(ioimp,*) 'iofspr=',iofspr
  466. *                        write(ioimp,*) 'iofsdu=',iofsdu
  467.                         NDDLPR=NOFSPR.LECT(IINCPR+1)-IOFSPR
  468.                         NDDLDU=NOFSDU.LECT(IINCDU+1)-IOFSDU
  469.                         IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG
  470.      $                       .NE.1.OR.N2COL.NE.1.OR.NBPOI.NE.1.OR.NBELM
  471.      $                       .NE.NELRIG) THEN
  472.                            WRITE(IOIMP,*) 'NBLIG=',NBLIG
  473.                            WRITE(IOIMP,*) 'NBCOL=',NBCOL
  474.                            WRITE(IOIMP,*) 'NBELM=',NBELM
  475.                            WRITE(IOIMP,*) 'NDDLDU=',NDDLDU
  476.                            WRITE(IOIMP,*) 'NDDLPR=',NDDLPR
  477.                            WRITE(IOIMP,*) 'NELRIG=',NELRIG
  478.  
  479.  
  480.                            WRITE(IOIMP,*) 'Erreur dims JMTLSA'
  481.                            GOTO 9999
  482.                         ENDIF
  483. *                        WRITE(IOIMP,*) 'IINCPR=',IINCPR
  484. *                        WRITE(IOIMP,*) 'IINCDU=',IINCDU
  485.                         DO IELRIG=1,NELRIG
  486. *                           WRITE(IOIMP,*) 'IELRIG=',IELRIG
  487. *                           MYXMAT=MYIMAT.IMATTT(IELRIG)
  488. *                           IF (MYXMAT.EQ.0) THEN
  489. *                              LFIRST=.TRUE.
  490. *                              SEGINI MYXMAT
  491. *                           ELSE
  492. *                              LFIRST=.FALSE.
  493. *                              SEGACT MYXMAT*MOD
  494. *                           ENDIF
  495.                            DO IDDLPR=1,NDDLPR
  496. *                              write(ioimp,*) 'iddlpr=',iddlpr
  497.                               DO IDDLDU=1,NDDLDU
  498. *                                 write(ioimp,*) 'iddldu=',iddldu
  499.                                  MYXMAT.RE(IOFSDU+IDDLDU,IOFSPR+IDDLPR
  500.      $                                ,ielrig)=JMTLSA.WELCHE(IDDLDU
  501.      $                                ,IDDLPR,1,1,1,IELRIG)
  502.                               ENDDO
  503.                            ENDDO
  504. *                           IF (LFIRST) THEN
  505. *                              SEGDES MYXMAT
  506. *                              MYIMAT.IMATTT(IELRIG)=MYXMAT
  507. *                           ELSE
  508. *                              SEGDES MYXMAT
  509. *                           ENDIF
  510. *                           SEGPRT,MYXMAT
  511.                         ENDDO
  512.                         SEGDES JMTLSA
  513.                         SEGDES IMTLSA
  514.                      ENDIF
  515.                   ENDIF
  516.                ENDDO
  517.             ENDIF
  518.          ENDDO
  519.          SEGSUP NOFSDU
  520.          SEGSUP NOFSPR
  521.          SEGDES MYxMAT
  522. *         SEGPRT,MYIMAT
  523. *
  524. * Remplissage du chapeau
  525. *
  526.          MATLSA.COERIG(ISOUS)=1.D0
  527.          MATLSA.IRIGEL(1,ISOUS)=RIGMEL
  528.          MATLSA.IRIGEL(2,ISOUS)=0
  529.          MATLSA.IRIGEL(3,ISOUS)=MYDSCR
  530.          MATLSA.IRIGEL(4,ISOUS)=MYxMAT
  531.          MATLSA.IRIGEL(5,ISOUS)=0
  532.          MATLSA.IRIGEL(6,ISOUS)=0
  533. *
  534. * la matrice ne possède pas de symétries (a priori...)
  535. *
  536.          MATLSA.IRIGEL(7,ISOUS)=2
  537.       ENDDO
  538.       SEGDES MATLSA
  539.       IF (IMPR.GT.3) THEN
  540.          WRITE(IOIMP,*) 'On a créé MATLSA=',MATLSA
  541.          CALL ECROBJ('RIGIDITE',MATLSA)
  542.          CALL PRLIST
  543.       ENDIF
  544.  
  545.       SEGDES CGEOMQ
  546.       SEGSUP KINCPR
  547.       SEGSUP KINCDU
  548.       SEGSUP LINCPR
  549.       SEGSUP LINCDU
  550.       SEGDES TABMAT
  551.       SEGDES TABVDC
  552. *
  553. * Normal termination
  554. *
  555.       IRET=0
  556.       RETURN
  557. *
  558. * Format handling
  559. *
  560. *
  561. * Error handling
  562. *
  563.  9999 CONTINUE
  564.       IRET=1
  565.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2maa'
  566.       RETURN
  567. *
  568. * End of subroutine CV2MAA
  569. *
  570.       END
  571.  
  572.  
  573.  

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