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   21/06/02    21:15:41     11022          
  2.       SUBROUTINE CV2MC9(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 SMCHPOI
  56. *      POINTEUR CHPLS9.MCHPOI
  57. *      POINTEUR CHPTMP.MCHPOI
  58. *      POINTEUR CHPTM2.MCHPOI
  59.       INTEGER CHPLS9,CHPTMP,CHPTM2
  60. *
  61. * Includes persos
  62. *
  63. -INC TNLIN      
  64. *-INC SMCHAEL
  65.       POINTEUR MYMCHA.MCHAEL
  66. *-INC SFALRF
  67.       POINTEUR MYFALS.FALRFS
  68. *-INC SMTNLIN
  69.       INTEGER NUMVPR,NUMVDU
  70. *
  71.       CHARACTER*4 MDISCP,MDISCD,MYDISC
  72.       INTEGER IMPR,IRET
  73. *
  74.       LOGICAL MVVPR,MVVDU
  75. *
  76. * Executable statements
  77. *
  78.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mc9'
  79. *      WRITE(IOIMP,*) '<'
  80.       MATLS9=0
  81.       CHPLS9=0
  82.       MATTMP=0
  83.       CHPTMP=0
  84.       SEGACT TABVDC
  85.       SEGACT TABMAT
  86. *      SEGPRT,TABMAT
  87.       NUMVPR=TABMAT.VMAT(/2)
  88.       NUMVDU=TABMAT.VMAT(/1)
  89.       DO IVARPR=1,NUMVPR
  90.          DO IVARDU=1,NUMVDU
  91.             IJVARP=TABVDC.VVARPR(IVARPR)
  92.             IJVARD=TABVDC.VVARDU(IVARDU)
  93.             MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  94.             MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  95.             IKVARP=TABVDC.DJSVD(IJVARP)
  96.             MDISCP=TABVDC.DISVD(IKVARP)
  97.             NCVARP=TABVDC.NOMVD(IJVARP)
  98.             IKVARD=TABVDC.DJSVD(IJVARD)
  99.             MDISCD=TABVDC.DISVD(IKVARD)
  100.             NCVARD=TABVDC.NOMVD(IJVARD)
  101.             MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  102.             IF (MYMCHA.NE.0) THEN
  103.                IF ((.NOT.MVVPR).AND.(.NOT.MVVDU)) THEN
  104. * In cv2ma9 : SEGINI MATTMP
  105.                   CALL CV2MA9(MDISCP,NCVARP,MDISCD,NCVARD,
  106.      $                 MYMCHA,
  107.      $                 MYFALS,
  108.      $                 MATTMP,
  109.      $                 IMPR,IRET)
  110.                   IF (IRET.NE.0) GOTO 9999
  111.                ELSEIF ((.NOT.MVVPR).AND.MVVDU) THEN
  112.                   MYDISC=MDISCP
  113.                   MYLMOT=NCVARP
  114.                   IF (LCHAM.EQ.1) THEN 
  115.                      CALL CV2CML(MYDISC,MYLMOT,MYMCHA,
  116.      $                    MYFALS,
  117.      $                    CHPTMP,
  118.      $                    IMPR,IRET)
  119.                      IF (IRET.NE.0) GOTO 9999
  120.                   ELSE
  121.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  122.      $                    MYFALS,
  123.      $                    CHPTMP,
  124.      $                    IMPR,IRET)
  125.                      IF (IRET.NE.0) GOTO 9999
  126.                   ENDIF
  127.                ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
  128.                   MYDISC=MDISCD
  129.                   MYLMOT=NCVARD
  130.                   IF (LCHAM.EQ.1) THEN 
  131.                      CALL CV2CML(MYDISC,MYLMOT,MYMCHA,
  132.      $                    MYFALS,
  133.      $                    CHPTMP,
  134.      $                    IMPR,IRET)
  135.                      IF (IRET.NE.0) GOTO 9999
  136.                   ELSE
  137.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  138.      $                    MYFALS,
  139.      $                    CHPTMP,
  140.      $                    IMPR,IRET)
  141.                      IF (IRET.NE.0) GOTO 9999
  142.                   ENDIF
  143.                ELSEIF (MVVPR.AND.MVVDU) THEN
  144.                   MYDISC='CSTE'
  145.                   JGN=4
  146.                   JGM=1
  147.                   SEGINI,MYLMOT
  148. *               MYLMOT.MOTS(1)='RES2'
  149.                   MYLMOT.MOTS(1)='SCAL'
  150. * In CV2CP9 : SEGINI CHPTMP
  151.                   IF (LCHAM.EQ.1) THEN 
  152.                      CALL CV2CML(MYDISC,MYLMOT,MYMCHA,
  153.      $                    MYFALS,
  154.      $                    CHPTMP,
  155.      $                    IMPR,IRET)
  156.                      IF (IRET.NE.0) GOTO 9999
  157.                   ELSE
  158.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  159.      $                    MYFALS,
  160.      $                    CHPTMP,
  161.      $                    IMPR,IRET)
  162.                      IF (IRET.NE.0) GOTO 9999
  163.                   ENDIF
  164.                   SEGSUP,MYLMOT
  165.                ENDIF
  166.                IF (CHPTMP.NE.0) THEN
  167.                   IF (CHPLS9.EQ.0) THEN
  168.                      CHPLS9=CHPTMP
  169.                      CHPTMP=0
  170.                   ELSE
  171.                      IF (LCHAM.EQ.1) THEN
  172.                         CALL ADCHEL(CHPLS9,CHPTMP,CHPTM2,1)
  173.                      ELSE
  174. * In ADCHPO : SEGINI CHPTM2
  175.                         CALL ADCHPO(CHPLS9,CHPTMP,CHPTM2,1.D0,1.D0)
  176.                      ENDIF
  177.                      IF (CHPTM2.EQ.0) THEN
  178.                         WRITE(IOIMP,*)
  179.      $                       'Pas pu faire le ET des champs...'
  180.                         GOTO 9999
  181.                      ENDIF
  182.                      IF (LCHAM.EQ.1) THEN
  183.                         CALL DTCHAM(CHPLS9)
  184.                         CALL DTCHAM(CHPTMP)
  185.                      ELSE
  186. * In DTCHPO : SEGSUP CHPLS9
  187.                         CALL DTCHPO(CHPLS9)
  188. * In DTCHPO : SEGSUP CHPTMP
  189.                         CALL DTCHPO(CHPTMP)
  190.                      ENDIF
  191.                      CHPLS9=CHPTM2
  192.                      CHPTMP=0
  193.                   ENDIF
  194.                ENDIF
  195.                IF (MATTMP.NE.0) THEN
  196.                   IF (MATLS9.EQ.0) THEN
  197.                      MATLS9=MATTMP
  198.                      MATTMP=0
  199.                   ELSE
  200. * In FUSRIG : SEGINI MATTM2
  201.                      CALL FUSRIG(MATLS9,MATTMP,MATTM2)
  202.                      IF (MATTM2.EQ.0) THEN
  203.                         WRITE(IOIMP,*)
  204.      $                       'Pas pu faire le ET des rigidites...'
  205.                         GOTO 9999
  206.                      ENDIF
  207.                      SEGSUP MATLS9
  208.                      SEGSUP MATTMP
  209.                      MATLS9=MATTM2
  210.                      MATTMP=0
  211.                   ENDIF
  212.                ENDIF
  213.             ENDIF
  214.          ENDDO
  215.       ENDDO
  216.       SEGDES TABMAT
  217.       SEGDES TABVDC
  218. *      WRITE(IOIMP,*) '>'
  219.       IF (IMPR.GT.3) THEN
  220.          IF (MATLS9.NE.0) THEN
  221.             CALL ECROBJ('RIGIDITE',MATLS9)
  222.             CALL PRLIST
  223.          ENDIF
  224.          IF (CHPLS9.NE.0) THEN
  225.             IF (LCHAM.EQ.1) THEN
  226.                CALL ECROBJ('MCHAML  ',CHPLS9)
  227.             ELSE
  228.                CALL ECROBJ('CHPOINT ',CHPLS9)
  229.             ENDIF
  230.             CALL PRLIST
  231.          ENDIF
  232.       ENDIF
  233. *
  234. * Normal termination
  235. *
  236.       IRET=0
  237.       RETURN
  238. *
  239. * Format handling
  240. *
  241. *
  242. * Error handling
  243. *
  244.  9999 CONTINUE
  245.       IRET=1
  246.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2mc9'
  247.       RETURN
  248. *
  249. * End of subroutine CV2MC9
  250. *
  251.       END
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  

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