Télécharger la plaquette Cast3M


fr en

Télécharger devrig.eso

Retour à la liste

Numérotation des lignes : 

devrig

  1. C DEVRIG    SOURCE    CB215821  20/11/25    13:25:06     10792          
  2.         SUBROUTINE DEVRIG(ITCHAR,KTNUM,KTPHI,KTFEX,KTLIAB,REPRIS)
  3.       IMPLICIT INTEGER(I-N)
  4.         IMPLICIT REAL*8(A-H,O-Z)
  5. *---------------------------------------------------------------*
  6. *                                                               *
  7. *     Opérateur DYNE : algorithme de Fu - de Vogelaere          *
  8. *     ________________________________________________          *
  9. *                                                               *
  10. *     Remplissage du tableau FTEXB représentant les chargements,*
  11. *     sur base B, on ne lit que les efforts car ces forces      *
  12. *     servent au calcul des moments pour les corps rigides      *
  13. *     On effectue aussi les interpolations nécessaires.         *
  14. *                                                               *
  15. *     Paramètres:                                               *
  16. *                                                               *
  17. * e   ITCHAR  Table représentant les chargements                *
  18. * e   ITINIT  Table représentant les conditions initiales       *
  19. * e   KTNUM   Segment contenant les paramètres numériques       *
  20. * e   KPREF   Segment des points de référence                   *
  21. * es  KTFEX   Segment contenant les chargements libres          *
  22. * e   REPRISE Vrai si reprise, faux sinon                       *
  23. *                                                               *
  24. *     Auteur, date de création:                                 *
  25. *                                                               *
  26. *     Samuel DURAND, le 07 octobre 1996  .                      *
  27. *                                                               *
  28. *                                                               *
  29. *---------------------------------------------------------------*
  30. *
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMTABLE
  35. -INC SMCHARG
  36. -INC SMCHPOI
  37. -INC SMELEME
  38. -INC SMLREEL
  39. *
  40. *       FTEXB(.,.,1,..)  valeur au pas m
  41. *       FTEXB(.,.,2,..)  valeur au pas m-1/2
  42. *
  43.       SEGMENT,MTNUM
  44.          REAL*8 XDT(NPC1),XTEMPS(NPC1)
  45.       ENDSEGMENT
  46.       SEGMENT,MTPHI
  47.          INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB)
  48.          INTEGER IAROTA(NSB)
  49.          REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB)
  50.       ENDSEGMENT
  51.       SEGMENT,MTFEX
  52.          REAL*8  FEXA(NPFEXA,NPC1,2)
  53.          REAL*8  FEXPSM(NPLB,NPC1,2,IDIMB)
  54.          REAL*8  FTEXB(NPLB,NPC1,2,IDIM)
  55. *         INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  56.       ENDSEGMENT
  57.       SEGMENT,MTRAV
  58.          REAL*8 FTCHG(NPC2)
  59.       ENDSEGMENT
  60.       SEGMENT,MTLIAB
  61.          INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
  62.          REAL*8 XPALB(NLIAB,NXPALB)
  63.          REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
  64.       ENDSEGMENT
  65. *
  66. *
  67.         LOGICAL L0,L1,REPRIS
  68.         CHARACTER*(LOCOMP) CMOT,NOMTRI(3)
  69.         CHARACTER*8 TYPRET,CHARRE
  70. *
  71.         DATA NOMTRI/'FX  ','FY  ','FZ  '/
  72. *
  73.         MTNUM = KTNUM
  74.         MTFEX = KTFEX
  75.         MTPHI = KTPHI
  76.         MTLIAB = KTLIAB
  77. *
  78.         NPC1 = XDT(/1)
  79.         NPLB = JPLIB(/1)
  80.         NSB = IAROTA(/1)
  81.         IDIMB = XPHILB(/4)
  82. *
  83. * Lecture des chargements en base B
  84. *
  85.         DO 5 IP=1,NPLB
  86.           DO 6 IC=1,NPC1
  87.             DO 7 I2=1,2
  88.                DO 8 I3=1,IDIM
  89.                   FTEXB(IP,IC,I2,I3)=0.D0
  90.  8             CONTINUE
  91.  7           CONTINUE
  92.  6         CONTINUE
  93.  5      CONTINUE
  94.       IF (ITCHAR.NE.0) THEN
  95.         TYPRET = ' '
  96.         CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0,
  97.      &                  TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  98.         IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  99.            MCHARG = ICHAR1
  100.            SEGACT,MCHARG
  101.            NCHAR = KCHARG(/1)
  102. *
  103. *        Boucle sur les chargements élémentaires
  104. *
  105.          DO 10 ICHAR=1,NCHAR
  106.             ICHARG = KCHARG(ICHAR)
  107.             SEGACT,ICHARG
  108.             IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  109.      & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  110.                SEGDES ICHARG
  111.                SEGDES MCHARG
  112.                CALL ERREUR(696)
  113.                RETURN
  114.             ENDIF
  115.             MLR1 = ICHPO2
  116.             MLR2 = ICHPO3
  117.             CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  118.             MTRAV = KTRAV
  119.             MCHPOI = ICHPO1
  120.             SEGACT,MCHPOI
  121.             NSOUPO=IPCHP(/1)
  122.             DO 20 I=1,NSOUPO
  123.                MSOUPO = IPCHP(I)
  124.                SEGACT,MSOUPO
  125.                MELEME = IGEOC
  126.                SEGACT,MELEME
  127.                NC = NOCOMP(/2)
  128.                MPOVAL = IPOVAL
  129.                SEGACT,MPOVAL
  130.                N = VPOCHA(/1)
  131.                DO 30 J=1,N
  132.                   KNOE = NUM(1,J)
  133.                   DO 35 K=1,NC
  134.                      CMOT = NOCOMP(K)
  135.                      CALL PLACE5(NOMTRI,3,ID,CMOT)
  136.                      IF (ID.NE.0) THEN
  137. * On vérifie que le point est un point de liaison
  138.                        CALL PLACE2(JPLIB,NPLB,IPOS,KNOE)
  139.                         IF (IPOS.NE.0) THEN
  140.                            ISB = IBASB(IPOS)
  141.                            IF (IAROTA(ISB).NE.0) THEN
  142.                               XFORCB = VPOCHA(J,K)
  143. *
  144. *                       Boucle sur les pas de temps
  145. *
  146.                               DO 36 IT=1,NPC1
  147.                                 NP = 2 * IT
  148.                                 FTEXB(IPOS,IT,1,ID) =
  149.      &                    FTEXB(IPOS,IT,1,ID) +( XFORCB * FTCHG(NP) )
  150.                                 NI = NP - 1
  151.                                 FTEXB(IPOS,IT,2,ID) =
  152.      &                    FTEXB(IPOS,IT,2,ID) +( XFORCB * FTCHG(NI) )
  153.  36                           CONTINUE
  154.                             ENDIF
  155. *                       end do
  156.                          ENDIF
  157.                        ENDIF
  158.  35                 CONTINUE
  159. *                 end do
  160.  30               CONTINUE
  161. *              end do
  162.                SEGDES,MPOVAL,MELEME,MSOUPO
  163.  20            CONTINUE
  164. *           end do
  165.             SEGDES,MCHPOI,ICHARG
  166.             SEGSUP,MTRAV
  167.  10         CONTINUE
  168. *        end do
  169.          SEGDES,MCHARG
  170.        ENDIF
  171.       ENDIF
  172. *
  173.        END
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  

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