Télécharger la plaquette Cast3M


fr en

Télécharger cv2mca.eso

Retour à la liste

Numérotation des lignes : 

cv2mca

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

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