Télécharger la plaquette Cast3M


fr en

Télécharger cv2ma9.eso

Retour à la liste

Numérotation des lignes : 

cv2ma9

  1. C CV2MA9    SOURCE    FANDEUR   22/01/19    21:15:04     11256          
  2.       SUBROUTINE CV2MA9(MDISCP,NCVARP,MDISCD,NCVARD,
  3.      $     IMTLS9,
  4.      $     MYFALS,
  5.      $     MATLS9,
  6.      $     IMPR,IRET)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8.       IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM         : CV2MA9
  11. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  12. C               représentant un ensemble de matrices élémentaires en
  13. C               RIGIDITE...
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          : KEEF   (recherche de l'élément fini)
  20. C APPELES (E/S)    : ECROBJ, PRLIST (écriture entier, objet,
  21. C                    impression)
  22. C APPELE PAR       : PRLS92
  23. C***********************************************************************
  24. C ENTREES            :
  25. C ENTREES/SORTIES    : -
  26. C SORTIES            :
  27. C TRAVAIL            : * MYMEL (type MELEME) : maillage élémentaire.
  28. C                      * JMTLS9 (type MCHEVA) : valeurs du champ IMTLS9
  29. C                        sur le maillage élémentaire.
  30. C                        Structure (cf.include SMCHAEL) :
  31. C                        (nb. ddl dual, nb. ddl primal,
  32. C                         nb. comp. duales, nb. comp. primales,
  33. C                         1, nb. éléments)
  34. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  35. C***********************************************************************
  36. C VERSION    : v1, 26/09/03, version initiale
  37. C HISTORIQUE : v1, 26/09/03, création
  38. C HISTORIQUE :
  39. C HISTORIQUE :
  40. C***********************************************************************
  41. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  42. C en cas de modification de ce sous-programme afin de faciliter
  43. C la maintenance !
  44. C***********************************************************************
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC SMLMOTS
  49.       POINTEUR NCVARP.MLMOTS
  50.       POINTEUR NCVARD.MLMOTS
  51. -INC SMELEME
  52.       POINTEUR MYMEL.MELEME
  53.       POINTEUR RIGMEL.MELEME
  54.       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  55. -INC SMLENTI
  56.       POINTEUR LPOQUF.MLENTI
  57.       POINTEUR KPOQUF.MLENTI
  58.       INTEGER JG
  59. -INC SMRIGID
  60.       POINTEUR MATLS9.MRIGID
  61.       POINTEUR MYDSCR.DESCR
  62.       POINTEUR MYIMAT.IMATRI
  63.       POINTEUR MYXMAT.XMATRI
  64.       INTEGER NRIGE,NRIGEL,NELRIG,NLIGRP,NLIGRD
  65. *
  66. * Includes persos
  67. *
  68. -INC TNLIN      
  69. *-INC SMCHAEL
  70.       POINTEUR IMTLS9.MCHAEL
  71.       POINTEUR JMTLS9.MCHEVA
  72.       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  73. *-INC SFALRF
  74.       POINTEUR MYFALS.FALRFS
  75. *-INC SELREF
  76.       POINTEUR LRFPRI.ELREF
  77.       POINTEUR LRFDUA.ELREF
  78. *
  79.       CHARACTER*4 MDISCP,MDISCD
  80.       INTEGER IMPR,IRET
  81. *
  82.       INTEGER IBNN,IBELEM
  83.       INTEGER ITQUAF,NDDLPR,NDDLDU
  84.       INTEGER        IDDLPR,IDDLDU
  85.       INTEGER               NSOUS,NPOQUF
  86.       INTEGER ISOUS
  87.       INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD
  88.  
  89. *
  90. * Executable statements
  91. *
  92.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2ma9'
  93.       NRIGEL=0
  94. c*      NRIGE=8
  95.       SEGINI,MATLS9
  96.       MATLS9.MTYMAT='LEASTSQU'
  97.       MATLS9.IFORIG=IFOUR
  98. * On prend le mode de calcul courant (on pourrait s'appuyer sur celui du champ ?)
  99.       NRIGE=MATLS9.IRIGEL(/1)
  100. *
  101. *     Remplissage de MRIGID
  102. *
  103.       SEGACT NCVARP
  104.       SEGACT NCVARD
  105.       SEGACT IMTLS9
  106.       NSOUS=IMTLS9.JMACHE(/1)
  107. C      SEGPRT,NCVARP
  108. C      SEGPRT,NCVARD
  109. C      SEGPRT,IMTLS9
  110.       DO ISOUS=1,NSOUS
  111.          JMTLS9=IMTLS9.ICHEVA(ISOUS)
  112.          IF (JMTLS9.NE.0) THEN
  113. C            SEGPRT,NCVARP
  114. C            SEGPRT,NCVARD
  115. C            SEGPRT,JMTLS9
  116.             MYMEL =IMTLS9.JMACHE(ISOUS)
  117.             SEGACT MYMEL
  118.             ITQUAF=MYMEL.ITYPEL
  119.             CALL KEEF(ITQUAF,MDISCP,MYFALS,
  120.      $           LRFPRI,IMPR,IRET)
  121.             IF (IRET.NE.0) GOTO 9999
  122.             SEGACT LRFPRI
  123.             NDDLPR=LRFPRI.NPQUAF(/1)
  124.             CALL KEEF(ITQUAF,MDISCD,MYFALS,
  125.      $           LRFDUA,IMPR,IRET)
  126.             IF (IRET.NE.0) GOTO 9999
  127.             SEGACT LRFDUA
  128.             NDDLDU=LRFDUA.NPQUAF(/1)
  129. *
  130. * remplissage du segment DISCR
  131. *
  132. *  Construction de la liste des points du QUAF sur lesquels il y a des
  133. *  ddl
  134.             JG=0
  135.             SEGINI LPOQUF
  136.             DO IDDLPR=1,NDDLPR
  137.                LPOQUF.LECT(**)=LRFPRI.NPQUAF(IDDLPR)
  138.             ENDDO
  139.             DO IDDLDU=1,NDDLDU
  140.                LPOQUF.LECT(**)=LRFDUA.NPQUAF(IDDLDU)
  141.             ENDDO
  142. * Suppression des doublons
  143.             CALL IUNIQ(LPOQUF.LECT,LPOQUF.LECT(/1),
  144.      $           LPOQUF.LECT,NPOQUF,
  145.      $           IMPR,IRET)
  146.             IF (IRET.NE.0) GOTO 9999
  147.             JG=NPOQUF
  148.             SEGADJ,LPOQUF
  149. * Segment de repérage dans cette liste
  150.             JG=MYMEL.NUM(/1)
  151.             SEGINI,KPOQUF
  152.             CALL RSETXI(KPOQUF.LECT,LPOQUF.LECT,LPOQUF.LECT(/1))
  153.             NLIGRP=NDDLPR
  154.             NLIGRD=NDDLDU
  155.             SEGINI MYDSCR
  156.             DO ILIGRP=1,NLIGRP
  157.                ICMPP=LRFPRI.NUMCMP(ILIGRP)
  158.                MYDSCR.LISINC(ILIGRP)=NCVARP.MOTS(ICMPP)
  159.                MYDSCR.NOELEP(ILIGRP)=
  160.      $              KPOQUF.LECT(LRFPRI.NPQUAF(ILIGRP))
  161.             ENDDO
  162.             DO ILIGRD=1,NLIGRD
  163.                ICMPD=LRFDUA.NUMCMP(ILIGRD)
  164.                MYDSCR.LISDUA(ILIGRD)=NCVARD.MOTS(ICMPD)
  165.                MYDSCR.NOELED(ILIGRD)=
  166.      $              KPOQUF.LECT(LRFDUA.NPQUAF(ILIGRD))
  167.             ENDDO
  168.             SEGDES MYDSCR
  169.             SEGDES LRFDUA
  170.             SEGDES LRFPRI
  171.             SEGSUP KPOQUF
  172. *
  173. * remplissage du maillage pour la rigidité
  174. *
  175.             NBNN=NPOQUF
  176.             NBELEM=MYMEL.NUM(/2)
  177.             NBSOUS=0
  178.             NBREF=0
  179.             SEGINI,RIGMEL
  180. * Type 32 POLY
  181.             RIGMEL.ITYPEL=32
  182.             DO IBELEM=1,NBELEM
  183.                DO IBNN=1,NBNN
  184.                   RIGMEL.NUM(IBNN,IBELEM)=
  185.      $                 MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM)
  186.                ENDDO
  187.             ENDDO
  188.             SEGDES RIGMEL
  189.             SEGSUP LPOQUF
  190.             SEGDES MYMEL
  191. *
  192. * remplissage des matrices élémentaires
  193. *
  194.             SEGACT JMTLS9
  195.             NBLIG=JMTLS9.WELCHE(/1)
  196.             NBCOL=JMTLS9.WELCHE(/2)
  197.             N2LIG=JMTLS9.WELCHE(/3)
  198.             N2COL=JMTLS9.WELCHE(/4)
  199.             NBPOI=JMTLS9.WELCHE(/5)
  200.             NBELM=JMTLS9.WELCHE(/6)
  201.             IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG.NE.1
  202.      $           .OR.N2COL.NE.1.OR.NBPOI.NE.1) THEN
  203.                WRITE(IOIMP,*) 'Erreur dims JMTLS9'
  204.                GOTO 9999
  205.             ENDIF
  206.             NELRIG=NBELM
  207.             nligrp=nddlpr
  208.             nligrd=nddldu
  209.             SEGINI MYxMAT
  210.  
  211.             DO IELRIG=1,NELRIG
  212. *               NLIGRP=NDDLPR
  213. *               NLIGRD=NDDLDU
  214. *               SEGINI MYXMAT
  215.                DO ILIGRP=1,NLIGRP
  216.                   DO ILIGRD=1,NLIGRD
  217.                      MYXMAT.RE(ILIGRD,ILIGRP,ielrig)=
  218.      $                    JMTLS9.WELCHE(ILIGRD,ILIGRP,1,1,1,IELRIG)
  219.                   ENDDO
  220.                ENDDO
  221. *               SEGDES MYXMAT
  222. *               MYIMAT.IMATTT(IELRIG)=MYXMAT
  223.             ENDDO
  224.             SEGDES JMTLS9
  225. *
  226. * remplissage du chapeau
  227. *
  228.             NRIGE=MATLS9.IRIGEL(/1)
  229.             NRIGEL=MATLS9.IRIGEL(/2)+1
  230.             SEGADJ,MATLS9
  231.             MATLS9.COERIG(NRIGEL)=1.D0
  232.             MATLS9.IRIGEL(1,NRIGEL)=RIGMEL
  233.             MATLS9.IRIGEL(2,NRIGEL)=0
  234.             MATLS9.IRIGEL(3,NRIGEL)=MYDSCR
  235.             MATLS9.IRIGEL(4,NRIGEL)=MYxMAT
  236.             MATLS9.IRIGEL(5,NRIGEL)=0
  237.             MATLS9.IRIGEL(6,NRIGEL)=0
  238. *
  239. * la matrice ne possède pas de symétries (a priori...)
  240. *
  241.             MATLS9.IRIGEL(7,NRIGEL)=2
  242.             MATLS9.IRIGEL(8,NRIGEL)=0
  243.             myxmat.symre = 2
  244.             SEGDES MYxMAT
  245.          ENDIF
  246.       ENDDO
  247.       SEGDES IMTLS9
  248.       SEGDES NCVARD
  249.       SEGDES NCVARP
  250.       SEGDES MATLS9
  251.       IF (IMPR.GT.3) THEN
  252.          WRITE(IOIMP,*) 'On a créé MATLS9=',MATLS9
  253.          CALL ECROBJ('RIGIDITE',MATLS9)
  254.          CALL PRLIST
  255.       ENDIF
  256. *
  257. * Normal termination
  258. *
  259.       IRET=0
  260.       RETURN
  261. *
  262. * Format handling
  263. *
  264. *
  265. * Error handling
  266. *
  267.  9999 CONTINUE
  268.       IRET=1
  269.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2ma9'
  270.       RETURN
  271. *
  272. * End of subroutine CV2MA9
  273. *
  274.       END
  275.  
  276.  
  277.  

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