C DEVFX0 SOURCE CB215821 20/11/25 13:25:01 10792 SUBROUTINE DEVFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE, &LMODYN,ITBAS) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Op�rateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Remplissage des tableaux repr�sentant les chargements, en * * faisant les interpolations n�cessaires. * * * * Param�tres: * * * * e ITCHAR Table repr�sentant les chargements * * e ITINIT Table repr�sentant les conditions initiales * * e KTNUM Segment contenant les param�tres num�riques * * e KPREF Segment des points de r�f�rence * * es KTFEX Segment contenant les chargements libres * * * * Auteur, date de cr�ation: * * * * Denis ROBERT-MOUGIN, le 25 mai 1989. * * * *--------------------------------------------------------------------* * -INC PPARAM -INC CCOPTIO -INC SMCHARG -INC SMCHPOI -INC SMELEME -INC SMLREEL * * FEXA(.,.,1) valeur au pas m * FEXA(.,.,2) valeur au pas m - 1/2 * SEGMENT,MTNUM REAL*8 XDT(NPC1),XTEMPS(NPC1) ENDSEGMENT SEGMENT,MTFEX REAL*8 FEXA(NPFEXA,NPC1,2) REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB) REAL*8 FTEXB(NPLB,NPC1,2,IDIM) * INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB) ENDSEGMENT SEGMENT,MTRAV REAL*8 FTCHG(NPC2) ENDSEGMENT SEGMENT,MPREF INTEGER IPOREF(NPREF) ENDSEGMENT LOGICAL L0,L1,REPRIS,RIGIDE,LMODYN CHARACTER*8 TYPRET,CHARRE * MTNUM = KTNUM MTFEX = KTFEX MPREF = KPREF NPREF = IPOREF(/1) NPC1 = XDT(/1) * * On extrait les chargements de la table * TYPRET = ' ' if (lmodyn) then TYPRET= 'CHARGEME' ICHAR1 = ITCHAR else CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ICHAR1) endif IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN MCHARG = ICHAR1 SEGACT,MCHARG NCHAR = KCHARG(/1) IXA = 0 * * Boucle sur les chargements �l�mentaires * DO 10 ICHAR=1,NCHAR ICHARG = KCHARG(ICHAR) SEGACT,ICHARG IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT' & .OR.CHALIE(ICHAR).NE.'LIE ') THEN SEGDES ICHARG SEGDES MCHARG CALL ERREUR(696) RETURN ENDIF MLR1 = ICHPO2 MLR2 = ICHPO3 CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS) MTRAV = KTRAV MCHPOI = ICHPO1 SEGACT,MCHPOI NSOUPO=IPCHP(/1) DO 20 I=1,NSOUPO MSOUPO = IPCHP(I) SEGACT,MSOUPO MELEME = IGEOC SEGACT,MELEME NC = NOCOMP(/2) MPOVAL = IPOVAL SEGACT,MPOVAL N = VPOCHA(/1) DO 30 J=1,N DO 35 K=1,NC KNOE = NUM(1,J) CALL PLACE2(IPOREF,NPREF,IPOS,KNOE) IF (IPOS.NE.0) THEN IXA = IXA + 1 XFORCA = VPOCHA(J,K) * bp, 2018-12-14 IFEXA(IPOS) = IXA * * Boucle sur les pas de temps * DO 36 IT=1,NPC1 NP = 2 * IT FEXA(IPOS,IT,1) = FEXA(IPOS,IT,1) + & ( XFORCA * FTCHG(NP) ) NI = NP - 1 FEXA(IPOS,IT,2) = FEXA(IPOS,IT,2) + & ( XFORCA * FTCHG(NI) ) 36 CONTINUE * end do ENDIF 35 CONTINUE * end do 30 CONTINUE * end do SEGDES,MPOVAL,MELEME,MSOUPO 20 CONTINUE * end do SEGDES,MCHPOI,ICHARG SEGSUP,MTRAV 10 CONTINUE * end do SEGDES,MCHARG ELSE TYPRET = ' ' CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ICHAR2) IF ((ICHAR2.EQ.0).OR.(.NOT.RIGIDE)) THEN CALL ERREUR(486) RETURN ENDIF ENDIF * END