1 : C DEVTRA SOURCE CHAT 09/10/09 21:17:11 6519 2 : SUBROUTINE DEVTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,KTRES,KPREF, 3 : & KTPHI,KTLIAB,RIGIDE,ITCARA,LMODYN) 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 : * Transpose l'information des objets de Castem2000 dans des * 12 : * tableaux de travail. * 13 : * * 14 : * Param�tres: * 15 : * * 16 : * e ITBAS Table repr�sentant une base modale * 17 : * e ITKM Table contenant les matrices XK et XM * 18 : * e ITA Table contenant la matrice XASM * 19 : * es KTKAM Segment contenant les matrices XK, XASM et XM * 20 : * e IPMAIL Maillage de r�f�rence pour les CHPOINTs r�sultats * 21 : * es KTRES Segment de sauvegarde des r�sultats * 22 : * e KPREF Segment des points de r�f�rence * 23 : * es KTPHI Segment des d�form�es modales * 24 : * e KTLIAB Segment des liaisons sur base B * 25 : * e RIGIDE Vrai si corps rigide, faux sinon * 26 : * * 27 : * Auteur, date de cr�ation: * 28 : * * 29 : * Denis ROBERT-MOUGIN, le 26 mai 1989. * 30 : * * 31 : *--------------------------------------------------------------------* 32 : -INC SMRIGID 33 : -INC CCOPTIO 34 : -INC CCREEL 35 : * 36 : SEGMENT,MTKAM 37 : REAL*8 XK(NA1),XASM(NA1),XM(NA1) 38 : ENDSEGMENT 39 : SEGMENT,MTPHI 40 : INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 41 : INTEGER IAROTA(NSB) 42 : REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 43 : ENDSEGMENT 44 : SEGMENT MTLIAB 45 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 46 : REAL*8 XPALB(NLIAB,NXPALB) 47 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 48 : ENDSEGMENT 49 : * 50 : * 51 : segment mtbas 52 : integer itbmod,lsstru(np1),nsstru 53 : endsegment 54 : 55 : LOGICAL L0,L1,RIGIDE,LMODYN 56 : CHARACTER*4 CMOT 57 : CHARACTER*8 TYPRET,CHARRE 58 : CHARACTER*40 MONMOT 59 : * 60 : MTKAM = KTKAM 61 : MTPHI = KTPHI 62 : MTLIAB = KTLIAB 63 : * 64 : NPLB = IBASB(/1) 65 : NSB = INMSB(/1) 66 : NA2 = XPHILB(/3) 67 : IDIMB = XPHILB(/4) 68 : NLIAB = IPALB(/1) 69 : * 70 : IA1 = 0 71 : DEUXPI = 2.D0 * XPI 72 : RIGIDE =.FALSE. 73 : * 74 : * Traitement des matrices de variables g�n�ralis�es: 75 : * 76 : IF (ITBAS.NE.0 .AND.ITKM.EQ.0.AND.(.NOT.LMODYN)) THEN 76 : CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'SOUSTYPE',L0,IP0, 77 : & 'MOT',I1,X1,MONMOT,L1,IP1) 78 : IF (IERR.NE.0) RETURN 79 : * 80 : * Cas o: la base est unique 81 : * 82 : IF (MONMOT(1:11).EQ.'BASE_MODALE') THEN 83 : * 84 : * On r�cup�re la base de modes 85 : * 85 : CALL ACCTAB(ITBAS,'MOT',IMODE,X0,'MODES',L0,IP0, 86 : & 'TABLE',I1,X1,' ',L1,IBAS) 87 : IF (IERR.NE.0) RETURN 87 : CALL DYNE26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,1,ICOMP, 88 : & RIGIDE,ITCARA,LMODYN) 89 : c IF (RIGIDE) THEN 90 : c RIGIDE =.FALSE. 91 : c DO 80 ILIA =1,NLIAB 92 : c ITYP = IPALB(ILIA,1) 93 : c IF (ITYP.EQ.35.OR.ITYP.EQ.36) THEN 94 : c RIGIDE =.TRUE. 95 : c ENDIF 96 : c 80 CONTINUE 97 : c ENDIF 98 : IF (IERR.NE.0) RETURN 99 : * 100 : * Cas o: on a un ensemble de bases 101 : * 102 : ELSE IF (MONMOT(1:17).EQ.'ENSEMBLE_DE_BASES') THEN 103 : * 104 : * On boucle sur le nombre de bases 105 : * 106 : IT = 0 107 : NPLSB = 0 108 : 10 CONTINUE 109 : TYPRET = ' ' 110 : IT = IT + 1 110 : CALL ACCTAB(ITBAS,'ENTIER',IT,X0,' ',L0,IP0, 111 : & TYPRET,I1,X1,CHARRE,L1,ITTBAS) 112 : IF (IERR.NE.0) RETURN 113 : IF (ITTBAS.NE.0) THEN 114 : IF (TYPRET.EQ.'TABLE ') THEN 114 : CALL ACCTAB(ITTBAS,'MOT',IMODE,X0,'MODES',L0,IP0, 115 : & 'TABLE',I1,X1,' ',L1,IBAS) 116 : IF (IERR.NE.0) RETURN 116 : CALL DYNE26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,IT,ICOMP, 117 : & RIGIDE,ITCARA,LMODYN) 118 : IF (IERR.NE.0) RETURN 119 : NPLSB = MAX(NPLSB,ICOMP) 120 : GOTO 10 121 : ELSE 121 : CALL ERREUR(491) 122 : RETURN 123 : ENDIF 124 : ENDIF 125 : 126 : * le segadj n'est plus necessaire 127 : * on le fait dans dyne26 128 : * MP 129 : * SEGADJ,MTPHI 130 : ENDIF 131 : * 132 : * ELSE IF (ITBAS.NE.0.AND.ITKM.NE.0) THEN 133 : * WRITE(IOIMP,*) 134 : * & 'DYNE : TBAS et TKM coexistent ---> @ impl�menter.' 135 : * IERR = 2 136 : * RETURN 137 : * 138 : ELSE IF (LMODYN) THEN 139 : mtbas = itbas 140 : NPLSB = 0 141 : do isstru = 1,nsstru 141 : CALL DYNE26(itbas,KTKAM,KTLIAB,KTPHI,IA1,isstru,ICOMP, 142 : & RIGIDE,ITCARA,LMODYN) 143 : IF (IERR.NE.0) RETURN 144 : NPLSB = MAX(NPLSB,ICOMP) 145 : enddo 146 : * 147 : * 148 : ELSE IF (ITKM.NE.0) THEN 149 : TYPRET = ' ' 149 : CALL ACCTAB(ITKM,'MOT',I0,X0,'RAIDEUR',L0,IP0, 150 : & TYPRET,I1,X1,CHARRE,L1,IRIGI) 151 : IF (IERR.NE.0) RETURN 152 : IF (IRIGI.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN 153 : IA = 0 154 : MRIGID = IRIGI 155 : SEGACT,MRIGID 156 : NRIGI = IRIGEL(/2) 157 : DO 20 I=1,NRIGI 158 : COEF = COERIG(I) 159 : xMATRI = IRIGEL(4,I) 160 : SEGACT,xMATRI 161 : NRIG = re(/3) 162 : DO 30 IRIG=1,NRIG 163 : * XMATRI = IMATTT(IRIG) 164 : * SEGACT,XMATRI 165 : LVAL = RE(/1) 166 : IN = 0 167 : 35 CONTINUE 168 : * 169 : * Partie diagonale seulement ... 170 : * 171 : IN = IN + 1 172 : * NN = (IN * (IN + 1)) / 2 173 : * IF (NN.LE.LVAL) THEN 174 : IF (IN.LE.LVAL) THEN 175 : IA = IA + 1 176 : XK(IA) = RE(IN,IN,irig) * COEF 177 : GOTO 35 178 : ENDIF 179 : * SEGDES,XMATRI 180 : 30 CONTINUE 181 : * end do 182 : SEGDES,xMATRI 183 : 20 CONTINUE 184 : * end do 185 : SEGDES,MRIGID 186 : ELSE 186 : CALL ERREUR(483) 187 : RETURN 188 : ENDIF 189 : * 190 : TYPRET = ' ' 190 : CALL ACCTAB(ITKM,'MOT',I0,X0,'MASSE',L0,IP0, 191 : & TYPRET,I1,X1,CHARRE,L1,IMASS) 192 : IF (IERR.NE.0) RETURN 193 : IF (IMASS.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN 194 : IA = 0 195 : MRIGID = IMASS 196 : SEGACT,MRIGID 197 : NMASS = IRIGEL(/2) 198 : DO 40 I=1,NMASS 199 : COEF = COERIG(I) 200 : xMATRI = IRIGEL(4,I) 201 : SEGACT,xMATRI 202 : NRIG = re(/3) 203 : DO 50 IRIG=1,NRIG 204 : * XMATRI = IMATTT(IRIG) 205 : * SEGACT,XMATRI 206 : LVAL = RE(/1) 207 : IN = 0 208 : 55 CONTINUE 209 : IN = IN + 1 210 : * NN = (IN * (IN + 1)) / 2 211 : * IF (NN.LE.LVAL) THEN 212 : IF (IN.LE.LVAL) THEN 213 : IA = IA + 1 214 : XM(IA) = RE(IN,IN,irig) * COEF 215 : GOTO 55 216 : ENDIF 217 : * SEGDES,XMATRI 218 : 50 CONTINUE 219 : * end do 220 : SEGDES,xMATRI 221 : 40 CONTINUE 222 : * end do 223 : SEGDES,MRIGID 224 : ELSE 224 : CALL ERREUR(484) 225 : RETURN 226 : ENDIF 227 : ENDIF 228 : * 229 : * Traitement de la matrice d'amortissement 230 : * 231 : IF (ITA.NE.0) THEN 232 : if (lmodyn) then 233 : iamor = ita 234 : typret='RIGIDITE' 235 : else 236 : TYPRET = ' ' 236 : CALL ACCTAB(ITA,'MOT',I0,X0,'AMORTISSEMENT',L0,IP0, 237 : & TYPRET,I1,X1,CHARRE,L1,IAMOR) 238 : IF (IERR.NE.0) RETURN 239 : endif 240 : IF (IAMOR.NE.0 .AND. TYPRET.EQ.'RIGIDITE') THEN 241 : IA = 0 242 : MRIGID = IAMOR 243 : SEGACT,MRIGID 244 : NAMOR = IRIGEL(/2) 245 : DO 60 I=1,NAMOR 246 : COEF = COERIG(I) 247 : xMATRI = IRIGEL(4,I) 248 : SEGACT,xMATRI 249 : NRIG = re(/3) 250 : DO 70 IRIG=1,NRIG 251 : * XMATRI = IMATTT(IRIG) 252 : * SEGACT,XMATRI 253 : LVAL = RE(/1) 254 : IN = 0 255 : 75 CONTINUE 256 : IN = IN + 1 257 : * NN = (IN * (IN + 1)) / 2 258 : * IF (NN.LE.LVAL) THEN 259 : IF (IN.LE.LVAL) THEN 260 : IA = IA + 1 261 : XASM(IA) = RE(IN,IN,irig) * COEF 262 : GOTO 75 263 : ENDIF 264 : * SEGDES,XMATRI 265 : 70 CONTINUE 266 : * end do 267 : SEGDES,xMATRI 268 : 60 CONTINUE 269 : * end do 270 : SEGDES,MRIGID 271 : ELSE 271 : CALL ERREUR(485) 272 : RETURN 273 : ENDIF 274 : ENDIF 275 : * 276 : IF (IIMPI.EQ.333) THEN 277 : WRITE(IOIMP,*)' segment MTPHI' 278 : WRITE(IOIMP,*)'DEVTRA : valeur de NPLB :',IBASB(/1) 279 : WRITE(IOIMP,*)'DEVTRA : valeur de NSB :',XPHILB(/1) 280 : WRITE(IOIMP,*)'DEVTRA : valeur de NPLSB :',XPHILB(/2) 281 : WRITE(IOIMP,*)'DEVTRA : valeur de NA2 :',XPHILB(/3) 282 : WRITE(IOIMP,*)'DEVTRA : valeur de IDIMB :',XPHILB(/4) 283 : ENDIF 284 : * 285 : END 286 : 287 : 288 : 289 : 290 : 291 : 292 : 293 : 294 : 295 : 296 : 297 : 298 :
© Cast3M 2003 - All rights reserved.
Disclaimer