Télécharger la plaquette Cast3M


fr en

Télécharger cv2mca.eso

Retour à la liste

Numérotation des lignes : 

  1. C CV2MCA    SOURCE    CB215821  20/11/25    13:23:36     10792          
  2.       SUBROUTINE CV2MCA(CGEOME,TABVDC,TABMAT,
  3.      $     MYFALS,
  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 CGEOME.MELEME
  53. *
  54. * Includes persos
  55. *
  56. CBEGININCLUDE SMCHAEL
  57.       SEGMENT MCHAEL
  58.       POINTEUR IMACHE(N1).MELEME
  59.       POINTEUR ICHEVA(N1).MCHEVA
  60.       ENDSEGMENT
  61.       SEGMENT MCHEVA
  62.       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  63.       ENDSEGMENT
  64.       SEGMENT LCHEVA
  65.       POINTEUR LISCHE(NBCHE).MCHEVA
  66.       ENDSEGMENT
  67. CENDINCLUDE SMCHAEL
  68.       POINTEUR MYMCHA.MCHAEL
  69. CBEGININCLUDE SFALRF
  70.       SEGMENT FALRF
  71.       CHARACTER*(LNNFA) NOMFA
  72.       INTEGER NUQUAF(NBLRF)
  73.       POINTEUR ELEMF(NBLRF).ELREF
  74.       ENDSEGMENT
  75.       SEGMENT FALRFS
  76.       POINTEUR LISFA(0).FALRF
  77.       ENDSEGMENT
  78. CENDINCLUDE SFALRF
  79.       POINTEUR MYFALS.FALRFS
  80. CBEGININCLUDE SMPOUET
  81.       SEGMENT TABGEO
  82.       CHARACTER*4 DISGEO
  83.       POINTEUR IGEO.MCHAEL
  84.       ENDSEGMENT
  85.       SEGMENT TABVDC
  86.       INTEGER VVARPR(NUMVPR)
  87.       INTEGER VVARDU(NUMVDU)
  88.       INTEGER VDATPR(NUMDPR)
  89.       INTEGER VDATDU(NUMDDU)
  90.       INTEGER VCOFPR(NUMCPR)
  91.       INTEGER VCOFDU(NUMCDU)
  92.       INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  93.       INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  94.       POINTEUR VLCOF(JLCOF).MLENTI
  95.       POINTEUR VCOMP(JGCOF).COMP
  96.       POINTEUR VLDAT(JGCOF).MLENTI
  97.       INTEGER  DJSVD(JGVD)
  98.       POINTEUR NOMVD(JGVD).MLMOTS
  99.       POINTEUR MVD(JGVD).MCHPOI
  100.       REAL*8 XVD(JGVD)
  101.       CHARACTER*4 DISVD(KGVD)
  102.       ENDSEGMENT
  103.       SEGMENT TATRAV
  104.       POINTEUR VVCOF(JLCOF).MCHEVA
  105.       POINTEUR VCOF(JGCOF).MCHEVA
  106.       POINTEUR IVD(JGVD).MCHAEL
  107.       POINTEUR VD(JGVD).MCHEVA
  108.       POINTEUR DVD(JGVD).MCHEVA
  109.       POINTEUR FFVD(KGVD).MCHEVA
  110.       POINTEUR DFFVD(KGVD).MCHEVA
  111.       LOGICAL LVCOF(JGCOF)
  112.       LOGICAL LVD(JGVD)
  113.       LOGICAL LDVD(JGVD)
  114.       LOGICAL LFFVD(KGVD)
  115.       LOGICAL LDFFVD(KGVD)
  116.       ENDSEGMENT
  117.       SEGMENT TABMAT
  118.       POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  119.       ENDSEGMENT
  120. CENDINCLUDE SMPOUET
  121.       INTEGER NUMVPR,NUMVDU
  122. *
  123.       CHARACTER*4 MDISCP,MDISCD,MYDISC
  124.       INTEGER IMPR,IRET
  125. *
  126.       LOGICAL MVVPR,MVVDU
  127. *
  128. * Executable statements
  129. *
  130.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mca'
  131. *
  132.       CALL CV2MAA(CGEOME,TABVDC,TABMAT,
  133.      $     MYFALS,
  134.      $     MATLSA,
  135.      $     IMPR,IRET)
  136.       IF (IRET.NE.0) GOTO 9999
  137.       CHPLSA=0
  138.       CHPTMP=0
  139.       SEGACT TABVDC
  140.       SEGACT TABMAT
  141.       NUMVPR=TABMAT.VMAT(/2)
  142.       NUMVDU=TABMAT.VMAT(/1)
  143.       DO IVARPR=1,NUMVPR
  144.          DO IVARDU=1,NUMVDU
  145.             IJVARP=TABVDC.VVARPR(IVARPR)
  146.             IJVARD=TABVDC.VVARDU(IVARDU)
  147.             MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  148.             MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  149.             IKVARP=TABVDC.DJSVD(IJVARP)
  150.             MDISCP=TABVDC.DISVD(IKVARP)
  151.             NCVARP=TABVDC.NOMVD(IJVARP)
  152.             IKVARD=TABVDC.DJSVD(IJVARD)
  153.             MDISCD=TABVDC.DISVD(IKVARD)
  154.             NCVARD=TABVDC.NOMVD(IJVARD)
  155.             MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  156.             IF (MYMCHA.NE.0) THEN
  157.                IF (MVVPR.OR.MVVDU) THEN
  158.                   IF ((.NOT.MVVPR).AND.MVVDU) THEN
  159.                      MYDISC=MDISCP
  160.                      MYLMOT=NCVARP
  161.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  162.      $                    MYFALS,
  163.      $                    CHPTMP,
  164.      $                    IMPR,IRET)
  165.                      IF (IRET.NE.0) GOTO 9999
  166.                   ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
  167.                      MYDISC=MDISCD
  168.                      MYLMOT=NCVARD
  169.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  170.      $                    MYFALS,
  171.      $                    CHPTMP,
  172.      $                    IMPR,IRET)
  173.                      IF (IRET.NE.0) GOTO 9999
  174.                   ELSEIF (MVVPR.AND.MVVDU) THEN
  175.                      MYDISC='CSTE'
  176.                      JGN=4
  177.                      JGM=1
  178.                      SEGINI,MYLMOT
  179. *               MYLMOT.MOTS(1)='RES2'
  180.                      MYLMOT.MOTS(1)='SCAL'
  181. * In CV2CP9 : SEGINI CHPTMP
  182.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  183.      $                    MYFALS,
  184.      $                    CHPTMP,
  185.      $                    IMPR,IRET)
  186.                      IF (IRET.NE.0) GOTO 9999
  187.                      SEGSUP,MYLMOT
  188.                   ENDIF
  189.                ENDIF
  190.                IF (CHPTMP.NE.0) THEN
  191.                   IF (CHPLSA.EQ.0) THEN
  192.                      CHPLSA=CHPTMP
  193.                      CHPTMP=0
  194.                   ELSE
  195. * In ADCHPO : SEGINI CHPTM2
  196.                      CALL ADCHPO(CHPLSA,CHPTMP,CHPTM2,1.D0,1.D0)
  197.                      IF (CHPTM2.EQ.0) THEN
  198.                         WRITE(IOIMP,*)
  199.      $                       'Pas pu faire le ET des chpoints...'
  200.                         GOTO 9999
  201.                      ENDIF
  202. * In DTCHPO : SEGSUP CHPLSA
  203.                      CALL DTCHPO(CHPLSA)
  204. * In DTCHPO : SEGSUP CHPTMP
  205.                      CALL DTCHPO(CHPTMP)
  206.                      CHPLSA=CHPTM2
  207.                      CHPTMP=0
  208.                   ENDIF
  209.                ENDIF
  210.             ENDIF
  211.          ENDDO
  212.       ENDDO
  213.       SEGDES TABMAT
  214.       SEGDES TABVDC
  215. *      WRITE(IOIMP,*) '>'
  216.       IF (IMPR.GT.3) THEN
  217.          IF (MATLSA.NE.0) THEN
  218.             CALL ECROBJ('RIGIDITE',MATLSA)
  219.             CALL PRLIST
  220.          ENDIF
  221.          IF (CHPLSA.NE.0) THEN
  222.             CALL ECROBJ('CHPOINT ',CHPLSA)
  223.             CALL PRLIST
  224.          ENDIF
  225.       ENDIF
  226. *
  227. * Normal termination
  228. *
  229.       IRET=0
  230.       RETURN
  231. *
  232. * Format handling
  233. *
  234. *
  235. * Error handling
  236. *
  237.  9999 CONTINUE
  238.       IRET=1
  239.       WRITE(IOIMP,*) 'An error was detected in subroutine cv2mca'
  240.       RETURN
  241. *
  242. * End of subroutine CV2MCA
  243. *
  244.       END
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  

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