1 : C DEVFX0 SOURCE KICH 08/06/26 21:15:23 6133 2 : SUBROUTINE DEVFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE, 3 : &LMODYN,ITBAS) 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/2 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(NPC2) 48 : ENDSEGMENT 49 : SEGMENT,MPREF 50 : INTEGER IPOREF(NPREF) 51 : ENDSEGMENT 52 : LOGICAL L0,L1,REPRIS,RIGIDE,LMODYN 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 : 65 : if (lmodyn) then 66 : TYPRET= 'CHARGEME' 67 : ICHAR1 = ITCHAR 68 : else 68 : CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_A',L0,IP0, 69 : & TYPRET,I1,X1,CHARRE,L1,ICHAR1) 70 : endif 71 : 72 : IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN 73 : MCHARG = ICHAR1 74 : SEGACT,MCHARG 75 : NCHAR = KCHARG(/1) 76 : IXA = 0 77 : * 78 : * Boucle sur les chargements �l�mentaires 79 : * 80 : DO 10 ICHAR=1,NCHAR 81 : ICHARG = KCHARG(ICHAR) 82 : SEGACT,ICHARG 83 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT' 84 : & .OR.CHALIE(ICHAR).NE.'LIE ') THEN 85 : 86 : SEGDES ICHARG 87 : SEGDES MCHARG 87 : CALL ERREUR(696) 88 : RETURN 89 : ENDIF 90 : MLR1 = ICHPO2 91 : MLR2 = ICHPO3 91 : CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS) 92 : MTRAV = KTRAV 93 : MCHPOI = ICHPO1 94 : SEGACT,MCHPOI 95 : NSOUPO=IPCHP(/1) 96 : DO 20 I=1,NSOUPO 97 : MSOUPO = IPCHP(I) 98 : SEGACT,MSOUPO 99 : MELEME = IGEOC 100 : SEGACT,MELEME 101 : NC = NOCOMP(/2) 102 : MPOVAL = IPOVAL 103 : SEGACT,MPOVAL 104 : N = VPOCHA(/1) 105 : DO 30 J=1,N 106 : DO 35 K=1,NC 107 : KNOE = NUM(1,J) 107 : CALL PLACE2(IPOREF,NPREF,IPOS,KNOE) 108 : IF (IPOS.NE.0) THEN 109 : IXA = IXA + 1 110 : XFORCA = VPOCHA(J,K) 111 : IFEXA(IPOS) = IXA 112 : * 113 : * Boucle sur les pas de temps 114 : * 115 : DO 36 IT=1,NPC1 116 : NP = 2 * IT 117 : FEXA(IPOS,IT,1) = FEXA(IPOS,IT,1) + 118 : & ( XFORCA * FTCHG(NP) ) 119 : NI = NP - 1 120 : FEXA(IPOS,IT,2) = FEXA(IPOS,IT,2) + 121 : & ( XFORCA * FTCHG(NI) ) 122 : 36 CONTINUE 123 : * end do 124 : ENDIF 125 : 35 CONTINUE 126 : * end do 127 : 30 CONTINUE 128 : * end do 129 : SEGDES,MPOVAL,MELEME,MSOUPO 130 : 20 CONTINUE 131 : * end do 132 : SEGDES,MCHPOI,ICHARG 133 : SEGSUP,MTRAV 134 : 10 CONTINUE 135 : * end do 136 : SEGDES,MCHARG 137 : ELSE 138 : TYPRET = ' ' 138 : CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0, 139 : & TYPRET,I1,X1,CHARRE,L1,ICHAR2) 140 : IF ((ICHAR2.EQ.0).OR.(.NOT.RIGIDE)) THEN 140 : CALL ERREUR(486) 141 : RETURN 142 : ENDIF 143 : ENDIF 144 : * 145 : END 146 : 147 : 148 : 149 : 150 : 151 :
© Cast3M 2003 - All rights reserved.
Disclaimer