Télécharger la plaquette Cast3M


fr en

Télécharger cv2mc9.eso

Retour à la liste

Numérotation des lignes : 

cv2mc9

  1. C CV2MC9    SOURCE    GOUNAND   24/11/06    21:15:06     12073          
  2.       SUBROUTINE CV2MC9(CGEOMQ,TABVDC,TABMAT,
  3.      $     MYFALS,LCHAM,
  4.      $     MATLS9,CHPLS9,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : CV2MC9
  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          : KEEF   (recherche de l'élément fini)
  19. C APPELES (E/S)    : ECROBJ, PRLIST (écriture entier, objet,
  20. C                    impression)
  21. C APPELE PAR       : PRLS92
  22. C***********************************************************************
  23. C ENTREES            :
  24. C ENTREES/SORTIES    : -
  25. C SORTIES            :
  26. C TRAVAIL            : * MYMEL (type MELEME) : maillage élémentaire.
  27. C                      * JMTLS9 (type MCHEVA) : valeurs du champ IMTLS9
  28. C                        sur le maillage élémentaire.
  29. C                        Structure (cf.include SMCHAEL) :
  30. C                        (nb. ddl dual, nb. ddl primal,
  31. C                         nb. comp. duales, nb. comp. primales,
  32. C                         1, nb. éléments)
  33. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  34. C***********************************************************************
  35. C VERSION    : v1, 26/09/03, version initiale
  36. C HISTORIQUE : v1, 26/09/03, création
  37. C HISTORIQUE : 21/05/2021 : ajout sortie de MCHAMLs
  38. C HISTORIQUE :
  39. C***********************************************************************
  40. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  41. C en cas de modification de ce sous-programme afin de faciliter
  42. C la maintenance !
  43. C***********************************************************************
  44.  
  45. -INC PPARAM
  46. -INC CCOPTIO
  47. -INC SMLMOTS
  48.       POINTEUR MYLMOT.MLMOTS
  49.       POINTEUR NCVARP.MLMOTS
  50.       POINTEUR NCVARD.MLMOTS
  51. -INC SMRIGID
  52.       POINTEUR MATLS9.MRIGID
  53.       POINTEUR MATTMP.MRIGID
  54.       POINTEUR MATTM2.MRIGID
  55. -INC SMELEME
  56.       POINTEUR CGEOMQ.MELEME
  57. -INC SMCHPOI
  58.       POINTEUR CHPLS9.MCHPOI
  59.       POINTEUR CHPTMP.MCHPOI
  60.       POINTEUR CHPTM2.MCHPOI
  61. *
  62. * Includes persos
  63. *
  64. -INC TNLIN
  65. *-INC SMCHAEL
  66.       POINTEUR MYMCHA.MCHAEL
  67. *-INC SFALRF
  68.       POINTEUR MYFALS.FALRFS
  69. *-INC SMTNLIN
  70.       INTEGER NUMVPR,NUMVDU
  71. *
  72.       CHARACTER*4 MDISCP,MDISCD,MYDISC
  73.       INTEGER IMPR,IRET
  74. *
  75.       LOGICAL MVVPR,MVVDU
  76. *
  77. * Executable statements
  78. *
  79.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mc9'
  80. *      WRITE(IOIMP,*) '<'
  81.       MATLS9=0
  82.       CHPLS9=0
  83.       MATTMP=0
  84.       CHPTMP=0
  85.       SEGACT TABVDC
  86.       SEGACT TABMAT
  87. *      SEGPRT,TABMAT
  88.       NUMVPR=TABMAT.VMAT(/2)
  89.       NUMVDU=TABMAT.VMAT(/1)
  90.       DO IVARPR=1,NUMVPR
  91.          DO IVARDU=1,NUMVDU
  92.             IJVARP=TABVDC.VVARPR(IVARPR)
  93.             IJVARD=TABVDC.VVARDU(IVARDU)
  94.             MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  95.             MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  96.             IKVARP=TABVDC.DJSVD(IJVARP)
  97.             MDISCP=TABVDC.DISVD(IKVARP)
  98.             NCVARP=TABVDC.NOMVD(IJVARP)
  99.             IKVARD=TABVDC.DJSVD(IJVARD)
  100.             MDISCD=TABVDC.DISVD(IKVARD)
  101.             NCVARD=TABVDC.NOMVD(IJVARD)
  102.             MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  103.             IF (MYMCHA.NE.0) THEN
  104.                IF ((.NOT.MVVPR).AND.(.NOT.MVVDU)) THEN
  105. * In cv2ma9 : SEGINI MATTMP
  106.                   CALL CV2MA9(CGEOMQ,MDISCP,NCVARP,MDISCD,NCVARD,
  107.      $                 MYMCHA,
  108.      $                 MYFALS,
  109.      $                 MATTMP,
  110.      $                 IMPR,IRET)
  111.                   IF (IRET.NE.0) GOTO 9999
  112.                ELSEIF ((.NOT.MVVPR).AND.MVVDU) THEN
  113.                   MYDISC=MDISCP
  114.                   MYLMOT=NCVARP
  115.                   IF (LCHAM.EQ.1) THEN
  116.                      CALL CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
  117.      $                    MYFALS,
  118.      $                    CHPTMP,
  119.      $                    IMPR,IRET)
  120.                      IF (IRET.NE.0) GOTO 9999
  121.                   ELSE
  122.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  123.      $                    MYFALS,
  124.      $                    CHPTMP,
  125.      $                    IMPR,IRET)
  126.                      IF (IRET.NE.0) GOTO 9999
  127.                   ENDIF
  128.                ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
  129.                   MYDISC=MDISCD
  130.                   MYLMOT=NCVARD
  131.                   IF (LCHAM.EQ.1) THEN
  132.                      CALL CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
  133.      $                    MYFALS,
  134.      $                    CHPTMP,
  135.      $                    IMPR,IRET)
  136.                      IF (IRET.NE.0) GOTO 9999
  137.                   ELSE
  138.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  139.      $                    MYFALS,
  140.      $                    CHPTMP,
  141.      $                    IMPR,IRET)
  142.                      IF (IRET.NE.0) GOTO 9999
  143.                   ENDIF
  144.                ELSEIF (MVVPR.AND.MVVDU) THEN
  145.                   MYDISC='CSTE'
  146.                   JGN=4
  147.                   JGM=1
  148.                   SEGINI,MYLMOT
  149. *               MYLMOT.MOTS(1)='RES2'
  150.                   MYLMOT.MOTS(1)='SCAL'
  151. * In CV2CP9 : SEGINI CHPTMP
  152.                   IF (LCHAM.EQ.1) THEN
  153.                      CALL CV2CML(CGEOMQ,MYDISC,MYLMOT,MYMCHA,
  154.      $                    MYFALS,
  155.      $                    CHPTMP,
  156.      $                    IMPR,IRET)
  157.                      IF (IRET.NE.0) GOTO 9999
  158.                   ELSE
  159.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  160.      $                    MYFALS,
  161.      $                    CHPTMP,
  162.      $                    IMPR,IRET)
  163.                      IF (IRET.NE.0) GOTO 9999
  164.                   ENDIF
  165.                   SEGSUP,MYLMOT
  166.                ENDIF
  167.                IF (CHPTMP.NE.0) THEN
  168.                   IF (CHPLS9.EQ.0) THEN
  169.                      CHPLS9=CHPTMP
  170.                      CHPTMP=0
  171.                   ELSE
  172.                      IF (LCHAM.EQ.1) THEN
  173.                         CALL ADCHEL(CHPLS9,CHPTMP,CHPTM2,1)
  174.                      ELSE
  175. * In ADCHPO : SEGINI CHPTM2
  176.                         CALL ADCHPO(CHPLS9,CHPTMP,CHPTM2,1.D0,1.D0)
  177.                      ENDIF
  178.                      IF (CHPTM2.EQ.0) THEN
  179.                         WRITE(IOIMP,*)
  180.      $                       'Pas pu faire le ET des champs...'
  181.                         GOTO 9999
  182.                      ENDIF
  183.                      IF (LCHAM.EQ.1) THEN
  184.                         CALL DTCHAM(CHPLS9)
  185.                         CALL DTCHAM(CHPTMP)
  186.                      ELSE
  187. * In DTCHPO : SEGSUP CHPLS9
  188.                         CALL DTCHPO(CHPLS9)
  189. * In DTCHPO : SEGSUP CHPTMP
  190.                         CALL DTCHPO(CHPTMP)
  191.                      ENDIF
  192.                      CHPLS9=CHPTM2
  193.                      CHPTMP=0
  194.                   ENDIF
  195.                ENDIF
  196.                IF (MATTMP.NE.0) THEN
  197.                   IF (MATLS9.EQ.0) THEN
  198.                      MATLS9=MATTMP
  199.                      MATTMP=0
  200.                   ELSE
  201. * In FUSRIG : SEGINI MATTM2
  202.                      CALL FUSRIG(MATLS9,MATTMP,MATTM2)
  203.                      IF (MATTM2.EQ.0) THEN
  204.                         WRITE(IOIMP,*)
  205.      $                       'Pas pu faire le ET des rigidites...'
  206.                         GOTO 9999
  207.                      ENDIF
  208.                      SEGSUP MATLS9
  209.                      SEGSUP MATTMP
  210.                      MATLS9=MATTM2
  211.                      MATTMP=0
  212.                   ENDIF
  213.                ENDIF
  214.             ENDIF
  215.          ENDDO
  216.       ENDDO
  217.       SEGDES TABMAT
  218.       SEGDES TABVDC
  219. *      WRITE(IOIMP,*) '>'
  220.       IF (IMPR.GT.3) THEN
  221.          IF (MATLS9.NE.0) THEN
  222.             CALL ECROBJ('RIGIDITE',MATLS9)
  223.             CALL PRLIST
  224.          ENDIF
  225.          IF (CHPLS9.NE.0) THEN
  226.             IF (LCHAM.EQ.1) THEN
  227.                CALL ECROBJ('MCHAML  ',CHPLS9)
  228.             ELSE
  229.                CALL ECROBJ('CHPOINT ',CHPLS9)
  230.             ENDIF
  231.             CALL PRLIST
  232.          ENDIF
  233.       ENDIF
  234. *
  235. * Normal termination
  236. *
  237.       IRET=0
  238.       RETURN
  239. *
  240. * Format handling
  241. *
  242. *
  243. * Error handling
  244. *
  245.  9999 CONTINUE
  246.       IRET=1
  247.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2mc9'
  248.       RETURN
  249. *
  250. * End of subroutine CV2MC9
  251. *
  252.       END
  253.  
  254.  

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