Télécharger la plaquette Cast3M


fr en

Télécharger cv2mca.eso

Retour à la liste

Numérotation des lignes : 

  1. C CV2MCA    SOURCE    CHAT      09/10/09    21:16:53     6519
  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. -INC CCOPTIO
  37. -INC SMLMOTS
  38.       POINTEUR MYLMOT.MLMOTS
  39.       POINTEUR NCVARP.MLMOTS
  40.       POINTEUR NCVARD.MLMOTS
  41. -INC SMRIGID
  42.       POINTEUR MATLSA.MRIGID
  43.       POINTEUR MATTMP.MRIGID
  44.       POINTEUR MATTM2.MRIGID
  45. -INC SMCHPOI
  46.       POINTEUR CHPLSA.MCHPOI
  47.       POINTEUR CHPTMP.MCHPOI
  48.       POINTEUR CHPTM2.MCHPOI
  49. -INC SMELEME
  50.       POINTEUR CGEOME.MELEME
  51. *
  52. * Includes persos
  53. *
  54. CBEGININCLUDE SMCHAEL
  55.       SEGMENT MCHAEL
  56.       POINTEUR IMACHE(N1).MELEME
  57.       POINTEUR ICHEVA(N1).MCHEVA
  58.       ENDSEGMENT
  59.       SEGMENT MCHEVA
  60.       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  61.       ENDSEGMENT
  62.       SEGMENT LCHEVA
  63.       POINTEUR LISCHE(NBCHE).MCHEVA
  64.       ENDSEGMENT
  65. CENDINCLUDE SMCHAEL
  66.       POINTEUR MYMCHA.MCHAEL
  67. CBEGININCLUDE SFALRF
  68.       SEGMENT FALRF
  69.       CHARACTER*(LNNFA) NOMFA
  70.       INTEGER NUQUAF(NBLRF)
  71.       POINTEUR ELEMF(NBLRF).ELREF
  72.       ENDSEGMENT
  73.       SEGMENT FALRFS
  74.       POINTEUR LISFA(0).FALRF
  75.       ENDSEGMENT
  76. CENDINCLUDE SFALRF
  77.       POINTEUR MYFALS.FALRFS
  78. CBEGININCLUDE SMPOUET
  79.       SEGMENT TABGEO
  80.       CHARACTER*4 DISGEO
  81.       POINTEUR IGEO.MCHAEL
  82.       ENDSEGMENT
  83.       SEGMENT TABVDC
  84.       INTEGER VVARPR(NUMVPR)
  85.       INTEGER VVARDU(NUMVDU)
  86.       INTEGER VDATPR(NUMDPR)
  87.       INTEGER VDATDU(NUMDDU)
  88.       INTEGER VCOFPR(NUMCPR)
  89.       INTEGER VCOFDU(NUMCDU)
  90.       INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  91.       INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  92.       POINTEUR VLCOF(JLCOF).MLENTI
  93.       POINTEUR VCOMP(JGCOF).COMP
  94.       POINTEUR VLDAT(JGCOF).MLENTI
  95.       INTEGER  DJSVD(JGVD)
  96.       POINTEUR NOMVD(JGVD).MLMOTS
  97.       POINTEUR MVD(JGVD).MCHPOI
  98.       REAL*8 XVD(JGVD)
  99.       CHARACTER*4 DISVD(KGVD)
  100.       ENDSEGMENT
  101.       SEGMENT TATRAV
  102.       POINTEUR VVCOF(JLCOF).MCHEVA
  103.       POINTEUR VCOF(JGCOF).MCHEVA
  104.       POINTEUR IVD(JGVD).MCHAEL
  105.       POINTEUR VD(JGVD).MCHEVA
  106.       POINTEUR DVD(JGVD).MCHEVA
  107.       POINTEUR FFVD(KGVD).MCHEVA
  108.       POINTEUR DFFVD(KGVD).MCHEVA
  109.       LOGICAL LVCOF(JGCOF)
  110.       LOGICAL LVD(JGVD)
  111.       LOGICAL LDVD(JGVD)
  112.       LOGICAL LFFVD(KGVD)
  113.       LOGICAL LDFFVD(KGVD)
  114.       ENDSEGMENT
  115.       SEGMENT TABMAT
  116.       POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  117.       ENDSEGMENT
  118. CENDINCLUDE SMPOUET
  119.       INTEGER NUMVPR,NUMVDU
  120. *
  121.       CHARACTER*4 MDISCP,MDISCD,MYDISC
  122.       INTEGER IMPR,IRET
  123. *
  124.       LOGICAL MVVPR,MVVDU
  125. *
  126. * Executable statements
  127. *
  128.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2mca'
  129. *
  130.       CALL CV2MAA(CGEOME,TABVDC,TABMAT,
  131.      $     MYFALS,
  132.      $     MATLSA,
  133.      $     IMPR,IRET)
  134.       IF (IRET.NE.0) GOTO 9999
  135.       CHPLSA=0
  136.       CHPTMP=0
  137.       SEGACT TABVDC
  138.       SEGACT TABMAT
  139.       NUMVPR=TABMAT.VMAT(/2)
  140.       NUMVDU=TABMAT.VMAT(/1)
  141.       DO IVARPR=1,NUMVPR
  142.          DO IVARDU=1,NUMVDU
  143.             IJVARP=TABVDC.VVARPR(IVARPR)
  144.             IJVARD=TABVDC.VVARDU(IVARDU)
  145.             MVVPR=(TABVDC.MVD(IJVARP).NE.0)
  146.             MVVDU=(TABVDC.MVD(IJVARD).NE.0)
  147.             IKVARP=TABVDC.DJSVD(IJVARP)
  148.             MDISCP=TABVDC.DISVD(IKVARP)
  149.             NCVARP=TABVDC.NOMVD(IJVARP)
  150.             IKVARD=TABVDC.DJSVD(IJVARD)
  151.             MDISCD=TABVDC.DISVD(IKVARD)
  152.             NCVARD=TABVDC.NOMVD(IJVARD)
  153.             MYMCHA=TABMAT.VMAT(IVARDU,IVARPR)
  154.             IF (MYMCHA.NE.0) THEN
  155.                IF (MVVPR.OR.MVVDU) THEN
  156.                   IF ((.NOT.MVVPR).AND.MVVDU) THEN
  157.                      MYDISC=MDISCP
  158.                      MYLMOT=NCVARP
  159.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  160.      $                    MYFALS,
  161.      $                    CHPTMP,
  162.      $                    IMPR,IRET)
  163.                      IF (IRET.NE.0) GOTO 9999
  164.                   ELSEIF (MVVPR.AND.(.NOT.MVVDU)) THEN
  165.                      MYDISC=MDISCD
  166.                      MYLMOT=NCVARD
  167.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  168.      $                    MYFALS,
  169.      $                    CHPTMP,
  170.      $                    IMPR,IRET)
  171.                      IF (IRET.NE.0) GOTO 9999
  172.                   ELSEIF (MVVPR.AND.MVVDU) THEN
  173.                      MYDISC='CSTE'
  174.                      JGN=4
  175.                      JGM=1
  176.                      SEGINI,MYLMOT
  177. *               MYLMOT.MOTS(1)='RES2'
  178.                      MYLMOT.MOTS(1)='SCAL'
  179. * In CV2CP9 : SEGINI CHPTMP
  180.                      CALL CV2CP9(MYDISC,MYLMOT,MYMCHA,
  181.      $                    MYFALS,
  182.      $                    CHPTMP,
  183.      $                    IMPR,IRET)
  184.                      IF (IRET.NE.0) GOTO 9999
  185.                      SEGSUP,MYLMOT
  186.                   ENDIF
  187.                ENDIF
  188.                IF (CHPTMP.NE.0) THEN
  189.                   IF (CHPLSA.EQ.0) THEN
  190.                      CHPLSA=CHPTMP
  191.                      CHPTMP=0
  192.                   ELSE
  193. * In ADCHPO : SEGINI CHPTM2
  194.                      CALL ADCHPO(CHPLSA,CHPTMP,CHPTM2,1.D0,1.D0)
  195.                      IF (CHPTM2.EQ.0) THEN
  196.                         WRITE(IOIMP,*)
  197.      $                       'Pas pu faire le ET des chpoints...'
  198.                         GOTO 9999
  199.                      ENDIF
  200. * In DTCHPO : SEGSUP CHPLSA
  201.                      CALL DTCHPO(CHPLSA)
  202. * In DTCHPO : SEGSUP CHPTMP
  203.                      CALL DTCHPO(CHPTMP)
  204.                      CHPLSA=CHPTM2
  205.                      CHPTMP=0
  206.                   ENDIF
  207.                ENDIF
  208.             ENDIF
  209.          ENDDO
  210.       ENDDO
  211.       SEGDES TABMAT
  212.       SEGDES TABVDC
  213. *      WRITE(IOIMP,*) '>'
  214.       IF (IMPR.GT.3) THEN
  215.          WRITE(IOIMP,*) 'On a créé MATLSA=',MATLSA
  216.          IF (MATLSA.NE.0) THEN
  217.             CALL ECROBJ('RIGIDITE',MATLSA)
  218.             CALL PRLIST
  219.          ENDIF
  220.          WRITE(IOIMP,*) 'On a créé CHPLSA=',CHPLSA
  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.  

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