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

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