Télécharger la plaquette Cast3M


fr en

Télécharger xpxtra.eso

Retour à la liste

Numérotation des lignes : 

xpxtra

  1. C XPXTRA    SOURCE    CB215821  25/04/23    21:15:48     12247          
  2.       SUBROUTINE XPXTRA
  3. C
  4. C     CREATION DE LA RIGIDITE OBTENU PAR MULTIPLICATION TENSORIELLE
  5. C              (PONDEREE) DE DEUX CHPOINT ELEMENTAIRES
  6. C
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMRIGID
  13. -INC SMCOORD
  14. -INC SMCHPOI
  15. -INC SMELEME
  16. -INC CCHAMP
  17. C
  18.       SEGMENT,ITRAV1
  19.         CHARACTER*4 NDCOMP(NC)
  20.       ENDSEGMENT
  21. C
  22. C     LECTURE D'UN CHPOINT
  23. C
  24.       CALL LIROBJ('CHPOINT',MCHPOI,1,IRETOU)
  25.       IF(IERR.NE.0)RETURN
  26. C
  27. C     LECTURE EVENTUELLE D'UN REEL
  28. C
  29.       CALL LIRREE(FLO,0,IRETOU)
  30.       IF(IRETOU.EQ.0)FLO=1.D0
  31. C
  32. C     VERIFICATION DU CARACTERE ELEMENTAIRE DU CHPOINT,
  33. C     SANS SERIE DE FOURIER
  34. C
  35.       SEGACT,MCHPOI
  36.       IF(IPCHP(/1).NE.1)THEN
  37.         WRITE(IOIMP,*)'XXT: the CHPO should be elementar'
  38.         GOTO 9999
  39.       ENDIF
  40.       IF(IFOPOI.EQ.1)THEN
  41.         WRITE(IOIMP,*)'XXT: the CHPO should not be FOURIER'
  42.         GOTO 9999
  43.       ENDIF
  44. C
  45. C     ACTIVATIONS DIVERSES
  46. C
  47.       MSOUPO=IPCHP(1)
  48.       SEGACT,MSOUPO
  49.       IPT1=IGEOC
  50.       MPOVAL=IPOVAL
  51.       SEGACT,IPT1,MPOVAL
  52. C
  53. C     NOM DES COMPOSANTES DE DEPLACEMENTS
  54. C
  55.       NC=NOHARM(/1)
  56.       SEGINI,ITRAV1
  57.       DO IE1=1,NC
  58.         CALL PLACE(NOMDU,LNOMDD,IMOT,NOCOMP(IE1))
  59.         IF(IMOT.EQ.0)THEN
  60.           WRITE(IOIMP,*)'XXT: one component of the CHPOIN is not'
  61.           WRITE(IOIMP,*)'        a force'
  62.           GOTO 9998
  63.         ENDIF
  64.         NDCOMP(IE1)=NOMDD(IMOT)
  65.       ENDDO
  66. C
  67. C     CREATION DU SUPERELEMENT ET DESACTIVATION DU MAILLAGE
  68. C
  69.       NBSOUS=0
  70.       NBELEM=1
  71.       NBNN=IPT1.ICOLOR(/1)
  72.       NBREF=0
  73.       SEGINI,MELEME
  74.       ITYPEL=28
  75.       DO IE1=1,NBNN
  76.         NUM(IE1,1)=IPT1.NUM(1,IE1)
  77.       ENDDO
  78.       ICOLOR(1)=IPT1.ICOLOR(1)
  79.       SEGDES,IPT1,MELEME
  80. C
  81. C     DECRIPTEUR POUR LA RIGIDITE
  82. C
  83.       NLIGRP=NC*NBNN
  84.       NLIGRD=NLIGRP
  85.       SEGINI,DESCR
  86.       DO IE1=1,NBNN
  87.         IDUM=(IE1-1)*NC
  88.         DO IE2=1,NC
  89.           LISINC(IDUM+IE2)=NDCOMP(IE2)
  90.           LISDUA(IDUM+IE2)=NOCOMP(IE2)
  91.           NOELEP(IDUM+IE2)=IE1
  92.           NOELED(IDUM+IE2)=IE1
  93.         ENDDO
  94.       ENDDO
  95.       SEGDES,DESCR,MSOUPO
  96.       SEGSUP,ITRAV1
  97. C
  98. C     CONTENU DE LA RIGIDITE
  99. C
  100.       nelrig=1
  101.       SEGINI,XMATRI
  102.       DO IE1=1,NLIGRP
  103.         DO IE2=1,NLIGRP
  104.           RE(IE1,IE2,1)=VPOCHA((IE1+NC-1)/NC,MOD(IE1+NC-1,NC)+1)
  105.      >               *VPOCHA((IE2+NC-1)/NC,MOD(IE2+NC-1,NC)+1)
  106.         ENDDO
  107.       ENDDO
  108.       SEGDES,XMATRI,MPOVAL
  109. *      NELRIG=1
  110. *      SEGINI,IMATRI
  111. *      IMATTT(1)=XMATRI
  112. *      SEGDES,IMATRI
  113. C
  114. C     CHAPEAU MRIGID DE LA RIGIDITE
  115. C
  116.       NRIGEL=1
  117.       NRIGE=7
  118.       SEGINI,MRIGID
  119.       MTYMAT='RIGIDITE'
  120.       COERIG(1)=FLO
  121.       IRIGEL(1,1)=MELEME
  122.       IRIGEL(2,1)=0
  123.       IRIGEL(3,1)=DESCR
  124.       IRIGEL(4,1)=xMATRI
  125.       IRIGEL(5,1)=0
  126.       IRIGEL(6,1)=0
  127.       IRIGEL(7,1)=0
  128.       ICHOLE=0
  129.       IMGEO1=0
  130.       IMGEO2=0
  131.       IFORIG=IFOPOI
  132.       ISUPEG=0
  133.       SEGDES,MRIGID,MCHPOI
  134. C
  135. C     RETOUR A GIBIANE
  136. C
  137.       CALL ECROBJ('RIGIDITE',MRIGID)
  138.       RETURN
  139. C
  140. C     ERREURS
  141. C
  142.  9998 SEGSUP,ITRAV1
  143.       SEGDES,IPT1,MPOVAL,MSOUPO
  144.  9999 SEGDES,MCHPOI
  145.       RETURN
  146.       END
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  

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