Esope source files

   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 = ' '
  63 :       CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0,
  64 :      &                  TYPRET,I1,X1,CHARRE,L1,ICHAR1)
  65 :       IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN
  66 :          MCHARG = ICHAR1
  67 :          SEGACT,MCHARG
  68 :          NCHAR = KCHARG(/1)
  69 :          IXA = 0
  70 : *
  71 : *        Boucle sur les chargements élémentaires
  72 : *
  73 :          DO 10 ICHAR=1,NCHAR
  74 :             ICHARG = KCHARG(ICHAR)
  75 :             SEGACT,ICHARG
  76 :             IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT'
  77 :      & .OR.CHALIE(ICHAR).NE.'LIE ') THEN
  78 :                SEGDES ICHARG
  79 :                SEGDES MCHARG
  79 :                CALL ERREUR(696)
  80 :                RETURN
  81 :             ENDIF
  82 :             MLR1 = ICHPO2
  83 :             MLR2 = ICHPO3
  83 :             CALL D2VINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS)
  84 :             MTRAV = KTRAV
  85 :             MCHPOI = ICHPO1
  86 :             SEGACT,MCHPOI
  87 :             NSOUPO=IPCHP(/1)
  88 :             DO 20 I=1,NSOUPO
  89 :                MSOUPO = IPCHP(I)
  90 :                SEGACT,MSOUPO
  91 :                MELEME = IGEOC
  92 :                SEGACT,MELEME
  93 :                NC = NOCOMP(/2)
  94 :                MPOVAL = IPOVAL
  95 :                SEGACT,MPOVAL
  96 :                N = VPOCHA(/1)
  97 :                DO 30 J=1,N
  98 :                   DO 35 K=1,NC
  99 :                      KNOE = NUM(1,J)
  99 :                      CALL PLACE2(IPOREF,NPREF,IPOS,KNOE)
 100 :                      IF (IPOS.NE.0) THEN
 101 :                         IXA = IXA + 1
 102 :                         XFORCA = VPOCHA(J,K)
 103 :                         IFEXA(IPOS) = IXA
 104 : *
 105 : *                       Boucle sur les pas de temps
 106 : *
 107 :                         DO 36 IT=1, (NPC1 - 1)
 108 :                            FEXA(IPOS,IT,2) = FEXA(IPOS,IT,2) +
 109 :      &                                       ( XFORCA * FTCHG(IT) )
 110 :                            IT2 = IT + 1
 111 :                            FEXA(IPOS,IT,1) = FEXA(IPOS,IT,1) +
 112 :      &                                       ( XFORCA * FTCHG(IT2) )
 113 :  36                        CONTINUE
 114 : *                       end do
 115 :                      ENDIF
 116 :  35                  CONTINUE
 117 : *                 end do
 118 :  30               CONTINUE
 119 : *              end do
 120 :                SEGDES,MPOVAL,MELEME,MSOUPO
 121 :  20            CONTINUE
 122 : *           end do
 123 :             SEGDES,MCHPOI,ICHARG
 124 :             SEGSUP,MTRAV
 125 :  10         CONTINUE
 126 : *        end do
 127 :          SEGDES,MCHARG
 128 :       ELSE
 129 :          TYPRET = ' '
 129 :          CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0,
 130 :      &                  TYPRET,I1,X1,CHARRE,L1,ICHAR2)
 131 :          IF ((ICHAR2.EQ.0).OR.(.NOT.RIGIDE)) THEN
 131 :             CALL ERREUR(486)
 132 :             RETURN
 133 :          ENDIF
 134 :       ENDIF
 135 : *
 136 :       END
 137 : 
 138 :  
 139 :