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

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