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

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