Télécharger la plaquette Cast3M


fr en

Télécharger d2vfx0.eso

Retour à la liste

Numérotation des lignes : 

  1. C D2VFX0    SOURCE    CHAT      05/01/12    22:35:18     5004
  2. C DEVFX0    SOURCE    KK2000    97/09/08    21:16:59     2809
  3.       SUBROUTINE D2VFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Opérateur DYNE : algorithme de Fu - de Vogelaere               *
  9. *     ________________________________________________               *
  10. *                                                                    *
  11. *     Remplissage des tableaux représentant les chargements, en      *
  12. *     faisant les interpolations nécessaires.                        *
  13. *                                                                    *
  14. *     Paramètres:                                                    *
  15. *                                                                    *
  16. * e   ITCHAR  Table représentant les chargements                     *
  17. * e   ITINIT  Table représentant les conditions initiales            *
  18. * e   KTNUM   Segment contenant les paramètres numériques            *
  19. * e   KPREF   Segment des points de référence                        *
  20. * es  KTFEX   Segment contenant les chargements libres               *
  21. *                                                                    *
  22. *     Auteur, date de création:                                      *
  23. *                                                                    *
  24. *     Denis ROBERT-MOUGIN, le 25 mai 1989.                           *
  25. *                                                                    *
  26. *--------------------------------------------------------------------*
  27. *
  28. -INC CCOPTIO
  29. -INC SMCHARG
  30. -INC SMCHPOI
  31. -INC SMELEME
  32. -INC SMLREEL
  33. *
  34. *     FEXA(.,.,1)  valeur au pas  m
  35. *     FEXA(.,.,2)  valeur au pas  m - 1
  36. *
  37.       SEGMENT,MTNUM
  38.          REAL*8 XDT(NPC1),XTEMPS(NPC1)
  39.       ENDSEGMENT
  40.       SEGMENT,MTFEX
  41.          REAL*8  FEXA(NPFEXA,NPC1,2)
  42.          REAL*8  FEXPSM(NPLB,NPC1,2,IDIMB)
  43.          REAL*8  FTEXB(NPLB,NPC1,2,IDIM)
  44.          INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB)
  45.       ENDSEGMENT
  46.       SEGMENT,MTRAV
  47.          REAL*8 FTCHG(NPC1)
  48.       ENDSEGMENT
  49.       SEGMENT,MPREF
  50.          INTEGER IPOREF(NPREF)
  51.       ENDSEGMENT
  52.       LOGICAL L0,L1,REPRIS,RIGIDE
  53.       CHARACTER*8 TYPRET,CHARRE
  54. *
  55.       MTNUM = KTNUM
  56.       MTFEX = KTFEX
  57.       MPREF = KPREF
  58.       NPREF = IPOREF(/1)
  59.       NPC1 = XDT(/1)
  60. *
  61. *     On extrait les chargements de la table
  62. *
  63.       TYPRET = ' '
  64.       CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,
  65.      &                  TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  66.       IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  67.          MCHARG = ICHAR1
  68.          SEGACT,MCHARG
  69.          NCHAR = KCHARG(/1)
  70.          IXA = 0
  71. *
  72. *        Boucle sur les chargements élémentaires
  73. *
  74.          DO 10 ICHAR=1,NCHAR
  75.             ICHARG = KCHARG(ICHAR)
  76.             SEGACT,ICHARG
  77.             IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  78.      & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  79.                SEGDES ICHARG
  80.                SEGDES MCHARG
  81.                CALL ERREUR(696)
  82.                RETURN
  83.             ENDIF
  84.             MLR1 = ICHPO2
  85.             MLR2 = ICHPO3
  86.             CALL D2VINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  87.             MTRAV = KTRAV
  88.             MCHPOI = ICHPO1
  89.             SEGACT,MCHPOI
  90.             NSOUPO=IPCHP(/1)
  91.             DO 20 I=1,NSOUPO
  92.                MSOUPO = IPCHP(I)
  93.                SEGACT,MSOUPO
  94.                MELEME = IGEOC
  95.                SEGACT,MELEME
  96.                NC = NOCOMP(/2)
  97.                MPOVAL = IPOVAL
  98.                SEGACT,MPOVAL
  99.                N = VPOCHA(/1)
  100.                DO 30 J=1,N
  101.                   DO 35 K=1,NC
  102.                      KNOE = NUM(1,J)
  103.                      CALL PLACE2(IPOREF,NPREF,IPOS,KNOE)
  104.                      IF (IPOS.NE.0) THEN
  105.                         IXA = IXA + 1
  106.                         XFORCA = VPOCHA(J,K)
  107.                         IFEXA(IPOS) = IXA
  108. *
  109. *                       Boucle sur les pas de temps
  110. *
  111.                         DO 36 IT=1, (NPC1 - 1)
  112.                            FEXA(IPOS,IT,2) = FEXA(IPOS,IT,2) +
  113.      &                                       ( XFORCA * FTCHG(IT) )
  114.                            IT2 = IT + 1
  115.                            FEXA(IPOS,IT,1) = FEXA(IPOS,IT,1) +
  116.      &                                       ( XFORCA * FTCHG(IT2) )
  117.  36                        CONTINUE
  118. *                       end do
  119.                      ENDIF
  120.  35                  CONTINUE
  121. *                 end do
  122.  30               CONTINUE
  123. *              end do
  124.                SEGDES,MPOVAL,MELEME,MSOUPO
  125.  20            CONTINUE
  126. *           end do
  127.             SEGDES,MCHPOI,ICHARG
  128.             SEGSUP,MTRAV
  129.  10         CONTINUE
  130. *        end do
  131.          SEGDES,MCHARG
  132.       ELSE
  133.          TYPRET = ' '
  134.          CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0,
  135.      &                  TYPRET,I1,X1,CHARRE,L1,ICHAR2)
  136.          IF ((ICHAR2.EQ.0).OR.(.NOT.RIGIDE)) THEN
  137.             CALL ERREUR(486)
  138.             RETURN
  139.          ENDIF
  140.       ENDIF
  141. *
  142.       END
  143.  
  144.  
  145.  
  146.  

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