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

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