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