Télécharger la plaquette Cast3M


fr en

Télécharger cv2mcb.eso

Retour à la liste

Numérotation des lignes : 

cv2mcb

  1. C CV2MCB    SOURCE    GOUNAND   24/11/06    21:15:08     12073          
  2.       SUBROUTINE CV2MCB(CGEOMQ,TABVDC,TABMAT,
  3.      $     MYFALS,LCHAM,
  4.      $     MATLSB,CHPLSB,
  5.      $     IMPR,IRET)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM         : CV2MCB
  10. C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments)
  11. C               représentant un ensemble de matrices élémentaires en
  12. C               MATRIK...
  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       : PRLSB2
  22. C***********************************************************************
  23. C ENTREES            :
  24. C ENTREES/SORTIES    : -
  25. C SORTIES            :
  26. C TRAVAIL            : * MYMEL (type MELEME) : maillage élémentaire.
  27. C                      * JMTLSB (type MCHEVA) : valeurs du champ IMTLSB
  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, 22/07/09, version initiale
  36. C HISTORIQUE : v1, 22/07/09, création
  37. C HISTORIQUE :
  38. C***********************************************************************
  39. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40. C en cas de modification de ce sous-programme afin de faciliter
  41. C la maintenance !
  42. C***********************************************************************
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC SMLMOTS
  46.       POINTEUR MYLMOT.MLMOTS
  47.       POINTEUR NCVARP.MLMOTS
  48.       POINTEUR NCVARD.MLMOTS
  49. -INC SMELEME
  50.       POINTEUR CGEOMQ.MELEME
  52.       POINTEUR MATLSB.MATRIK
  53.       POINTEUR MATTMP.MATRIK
  54.       POINTEUR MATTM2.MATRIK
  55. -INC SMCHPOI
  56. *      POINTEUR CHPLSB.MCHPOI
  57. *      POINTEUR CHPTMP.MCHPOI
  58. *      POINTEUR CHPTM2.MCHPOI
  59.       INTEGER CHPLSB,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 cv2mcb'
  79. *      WRITE(IOIMP,*) '<'
  80.       MATLSB=0
  81.       CHPLSB=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 CV2MAB(CGEOMQ,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(CGEOMQ,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(CGEOMQ,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(CGEOMQ,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 (CHPLSB.EQ.0) THEN
  168.                      CHPLSB=CHPTMP
  169.                      CHPTMP=0
  170.                   ELSE
  171.                      IF (LCHAM.EQ.1) THEN
  172.                         CALL ADCHEL(CHPLSB,CHPTMP,CHPTM2,1)
  173.                      ELSE
  174. * In ADCHPO : SEGINI CHPTM2
  175.                         CALL ADCHPO(CHPLSB,CHPTMP,CHPTM2,1.D0,1.D0)
  176.                      ENDIF
  177.                      IF (CHPTM2.EQ.0) THEN
  178.                         WRITE(IOIMP,*)
  179.      $                       'Pas pu faire le ET des chpoints...'
  180.                         GOTO 9999
  181.                      ENDIF
  182.                      IF (LCHAM.EQ.1) THEN
  183.                         CALL DTCHAM(CHPLSB)
  184.                         CALL DTCHAM(CHPTMP)
  185.                      ELSE
  186. * In DTCHPO : SEGSUP CHPLSB
  187.                         CALL DTCHPO(CHPLSB)
  188. * In DTCHPO : SEGSUP CHPTMP
  189.                         CALL DTCHPO(CHPTMP)
  190.                      ENDIF
  191.                      CHPLSB=CHPTM2
  192.                      CHPTMP=0
  193.                   ENDIF
  194.                ENDIF
  195.                IF (MATTMP.NE.0) THEN
  196.                   IF (MATLSB.EQ.0) THEN
  197.                      MATLSB=MATTMP
  198.                      MATTMP=0
  199.                   ELSE
  200. * In FUSMTK : SEGINI MATTM2
  201.                      CALL FUSMTK(MATLSB,MATTMP,MATTM2)
  202.                      IF (MATTM2.EQ.0) THEN
  203.                         WRITE(IOIMP,*)
  204.      $                       'Pas pu faire le ET des matriks...'
  205.                         GOTO 9999
  206.                      ENDIF
  207.                      SEGSUP MATLSB
  208.                      SEGSUP MATTMP
  209.                      MATLSB=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 (MATLSB.NE.0) THEN
  221.             CALL ECROBJ('MATRIK',MATLSB)
  222.             CALL PRLIST
  223.          ENDIF
  224.          IF (CHPLSB.NE.0) THEN
  225.             IF (LCHAM.EQ.1) THEN
  226.                CALL ECROBJ('MCHAML  ',CHPLSB)
  227.             ELSE
  228.                CALL ECROBJ('CHPOINT ',CHPLSB)
  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 cv2mcb'
  247.       RETURN
  248. *
  249. * End of subroutine CV2MCB
  250. *
  251.       END
  252.  
  253.  

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