1 : C D2POL1 SOURCE CHAT 05/01/12 22:35:02 5004 2 : C DYPOL1 SOURCE IANIS 96/08/08 21:16:04 2249 3 : SUBROUTINE D2POL1(Q1,Q2,NA1,IPLIA,XPALA,XVALA,NLIAA,IND,XDT, 4 : & NPAS,NUMLIA,NMOD,FTOTA,IVINIT,IANNUL) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : *--------------------------------------------------------------------* 8 : * * 9 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 10 : * ________________________________________________ * 11 : * * 12 : * Calcul de la force elementaire pour la liaison POLYNOMIALE * 13 : * * 14 : * Parametres: * 15 : * * 16 : * e Q1 Vecteur des deplacements generalises * 17 : * e Q2 Vecteur des vitesses generalisees * 18 : * e NA1 Nombre total d'inconnues en base A * 19 : * e IPLIA Tableau des points de types support et origine * 20 : * es XPALA Tableau des parametres de la liaison * 21 : * es XVALA Tableau des variables internes de la liaison * 22 : * e NLIAA Nombre de liaisons sur la base A * 23 : * e IND Indice du demi-pas * 24 : * e XDT Valeurs des pas de temps * 25 : * e NPAS Numero du pas de temps * 26 : * e NUMLIA Numero de la liaison consideree * 27 : * e NMOD Nombre de modes "origine" de la liaison * 28 : * es FTOTA Forces exterieures totalisees sur la base A * 29 : * e IVINIT =1 si vitesses initiales, =0 sinon * 30 : * * 31 : * Auteur, date de creation: * 32 : * * 33 : * Denis ROBERT, le 30 avril 1992. * 34 : * * 35 : *--------------------------------------------------------------------* 36 : * 37 : -INC CCOPTIO 38 : * 39 : INTEGER IPLIA(NLIAA,*) 40 : REAL*8 XPALA(NLIAA,*),XVALA(NLIAA,4,*),Q1(NA1,*),FTOTA(NA1,*) 41 : REAL*8 XDT(*),Q2(NA1,*) 42 : PARAMETER (XZERO = 0.D0) 43 : PARAMETER (XUN = 1.D0 ) 44 : * 45 : XPDT = XDT(NPAS) 46 : 47 : c XPDTS2 = 0.5 * XPDT 48 : XPDTS2 = XPDT 49 : * 50 : * Boucle sur les modes "origine" 51 : * Organisation de XPALA et indices : 52 : * COEF [ ED / RD / XJD / EV / RV / XJV / ... NMAX val de depl ... ] 53 : * i= 1 IDEB IDEB+6 54 : * 55 : IF (IIMPI.EQ.666) THEN 56 : WRITE(IOIMP,*)' ' 57 : WRITE(IOIMP,*)'NPAS = ',NPAS 58 : WRITE(IOIMP,*)'IVINIT = ',IVINIT 59 : WRITE(IOIMP,*)'IND = ',IND 60 : ENDIF 61 : XCOEF = XPALA(NUMLIA,1) 62 : IF (IANNUL.EQ.1) XCOEF = 0.D0 63 : FX = 1.D0 64 : IDEB = 2 65 : DO 10 I = 1,NMOD 66 : INA2 = IPLIA(NUMLIA,I+1) 67 : RD = XPALA(NUMLIA,IDEB+1) 68 : * NRD : decalage pour trouver le deplacement lie au retard RD 69 : NRD = INT(RD/XPDTS2) + 1 70 : RV = XPALA(NUMLIA,IDEB+4) 71 : * NRV : decalage pour trouver la vitesse liee au retard RV 72 : NRV = INT(RV/XPDTS2) + 1 73 : * NRV2 : un deplacement de plus pour calculer la vitesse 74 : NRV2 = NRV + 1 75 : NMAX = MAX(NRD,NRV2) 76 : ED = XPALA(NUMLIA,IDEB) 77 : EV = XPALA(NUMLIA,IDEB+3) 78 : XJD = XPALA(NUMLIA,IDEB+2) 79 : XJV = XPALA(NUMLIA,IDEB+5) 80 : * 81 : * Les deplacements sont reactualises en First In Last Out 82 : * 83 : XDNEW = Q1(INA2,IND) 84 : J1 = IDEB + 6 85 : J2 = IDEB + NMAX + 5 86 : DO 15 J = J1,J2 87 : XAUX = XPALA(NUMLIA,J) 88 : XPALA(NUMLIA,J) = XDNEW 89 : XDNEW = XAUX 90 : 15 CONTINUE 91 : * 92 : * Boucle d'impression de XPALA 93 : * 94 : IF (IIMPI.EQ.666) THEN 95 : WRITE(IOIMP,*)'DYPOL1 : IMOD = ',I 96 : DO 200 II = IDEB,J2 97 : WRITE(IOIMP,*)'XPALA(',NUMLIA,',',II,')=' ) 98 : & ,XPALA(NUMLIA,II ) ) 99 : 200 CONTINUE 100 : WRITE(IOIMP,*)'NRD = ',NRD 101 : WRITE(IOIMP,*)'NRV = ',NRV 102 : ENDIF 103 : * 104 : * faut-il calculer ( cad t > tau) 105 : * 106 : jmax = ideb + 5+Nmax 107 : Xtest = XPALA(NUMLIA,jmax) 108 : itest = int (xtest) 109 : IF ( itest .eq. 123456) then 110 : * on n'a pas ce qu'il faut pour calculer : on met zero 111 : fx = 0d0 112 : ELSE 113 : 114 : XDEPL = XPALA(NUMLIA,IDEB+5+NRD) 115 : * 116 : * Calcul de la vitesse 117 : * 118 : IF ((IND.EQ.3).AND.(IVINIT.EQ.1).and. (nrd.eq.1)) THEN 119 : XVIT = Q2(INA2,IND) 120 : ELSE 121 : XD1 = XPALA(NUMLIA,IDEB+5+NRV) 122 : XD2 = XPALA(NUMLIA,IDEB+5+NRV2) 123 : XVIT = (XD1 - XD2) / XPDTS2 124 : ENDIF 125 : IF (IIMPI.EQ.666) THEN 126 : WRITE(IOIMP,*)'---> XVIT = ',XVIT 127 : ENDIF 128 : * 129 : IF ((XJD.NE.XZERO).AND.(ED.EQ.XZERO)) THEN 130 : ISEUIL = 1 131 : ELSE 132 : ISEUIL = 0 133 : ENDIF 134 : IF (XJD.GE.XZERO) THEN 135 : * 136 : * partie positive de (XDEPL - XJD) 137 : * 138 : IF (XDEPL.GE.XJD) THEN 139 : XD = ABS(XDEPL-XJD) 140 : ELSE 141 : XD = XZERO 142 : ENDIF 143 : ELSE 144 : IF (XDEPL.LT.XJD) THEN 145 : XD = ABS(XJD-XDEPL) 146 : ELSE 147 : XD = XZERO 148 : ENDIF 149 : ENDIF 150 : IF (IIMPI.EQ.666) THEN 151 : WRITE(IOIMP,*)'XD = ',XD 152 : ENDIF 153 : IF (XJV.GE.XZERO) THEN 154 : IF (XVIT.GE.XJV) THEN 155 : XV = ABS(XVIT-XJV) 156 : ELSE 157 : XV = XZERO 158 : ENDIF 159 : ELSE 160 : IF (XVIT.LT.XJV) THEN 161 : XV = ABS(XJV-XVIT) 162 : ELSE 163 : XV = XZERO 164 : ENDIF 165 : ENDIF 166 : IF (IIMPI.EQ.666) THEN 167 : WRITE(IOIMP,*)'XV = ',XV 168 : ENDIF 169 : IF (XD.GT.XZERO) THEN 170 : FXD = EXP(ED*LOG(XD)) 171 : ELSE 172 : IF (ED.EQ.XZERO) THEN 173 : FXD = XUN 174 : ELSE 175 : FXD = XZERO 176 : ENDIF 177 : ENDIF 178 : IF (XV.GT.XZERO) THEN 179 : IF (ISEUIL.EQ.0) THEN 180 : FXV = EXP(EV*LOG(XV)) 181 : ELSE 182 : IF (XD.GT.XZERO) THEN 183 : FXV = EXP(EV*LOG(XV)) 184 : ELSE 185 : FXV = XZERO 186 : ENDIF 187 : ENDIF 188 : ELSE 189 : IF (EV.EQ.XZERO) THEN 190 : FXV = XUN 191 : ELSE 192 : FXV = XZERO 193 : ENDIF 194 : ENDIF 195 : FX = FX * FXV * FXD 196 : IF (IIMPI.EQ.666) THEN 197 : WRITE(IOIMP,*)'FXD = ',FXD 198 : WRITE(IOIMP,*)'FXV = ',FXV 199 : WRITE(IOIMP,*)'FX = ',FX 200 : ENDIF 201 : IDEB = IDEB + 6 + NMAX 202 : endif 203 : 10 CONTINUE 204 : INA1 = IPLIA(NUMLIA,1) 205 : FXTOT = XCOEF * FX 206 : XVALA(NUMLIA,IND,1) = FXTOT 207 : FTOTA(INA1,IND) = FTOTA(INA1,IND) + FXTOT 208 : * 209 : END 210 : 211 : 212 :
© Cast3M 2003 - All rights reserved.
Disclaimer