1 : C D2VRIG SOURCE CHAT 05/01/12 22:35:53 5004 2 : C DEVRIG SOURCE KK2000 97/09/08 21:18:59 2809 3 : SUBROUTINE D2VRIG(ITCHAR,KTNUM,KTPHI,KTFEX,KTLIAB, 4 : & REPRIS) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : *---------------------------------------------------------------* 8 : * * 9 : * Opérateur DYNE : algorithme de Fu - de Vogelaere * 10 : * ________________________________________________ * 11 : * * 12 : * Remplissage du tableau FTEXB représentant les chargements,* 13 : * sur base B, on ne lit que les efforts car ces forces * 14 : * servent au calcul des moments pour les corps rigides * 15 : * On effectue aussi les interpolations nécessaires. * 16 : * * 17 : * Paramètres: * 18 : * * 19 : * e ITCHAR Table représentant les chargements * 20 : * e ITINIT Table représentant les conditions initiales * 21 : * e KTNUM Segment contenant les paramètres numériques * 22 : * e KPREF Segment des points de référence * 23 : * es KTFEX Segment contenant les chargements libres * 24 : * e REPRISE Vrai si reprise, faux sinon * 25 : * * 26 : * Auteur, date de création: * 27 : * * 28 : * Samuel DURAND, le 07 octobre 1996 . * 29 : * * 30 : * * 31 : *---------------------------------------------------------------* 32 : * 33 : -INC CCOPTIO 34 : -INC SMTABLE 35 : -INC SMCHARG 36 : -INC SMCHPOI 37 : -INC SMELEME 38 : -INC SMLREEL 39 : * 40 : * FTEXB(.,.,1,..) valeur au pas m 41 : * FTEXB(.,.,2,..) valeur au pas m-1 42 : * 43 : SEGMENT,MTNUM 44 : REAL*8 XDT(NPC1),XTEMPS(NPC1) 45 : ENDSEGMENT 46 : SEGMENT,MTPHI 47 : INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 48 : INTEGER IAROTA(NSB) 49 : REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 50 : ENDSEGMENT 51 : SEGMENT,MTFEX 52 : REAL*8 FEXA(NPFEXA,NPC1,2) 53 : REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB) 54 : REAL*8 FTEXB(NPLB,NPC1,2,IDIM) 55 : INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB) 56 : ENDSEGMENT 57 : SEGMENT,MTRAV 58 : REAL*8 FTCHG(NPC2) 59 : ENDSEGMENT 60 : SEGMENT,MTLIAB 61 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 62 : REAL*8 XPALB(NLIAB,NXPALB) 63 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 64 : ENDSEGMENT 65 : * 66 : * 67 : LOGICAL L0,L1,REPRIS 68 : CHARACTER*4 CMOT,NOMTRI(3) 69 : CHARACTER*8 TYPRET,CHARRE 70 : CHARACTER*40 MONMOT 71 : * 72 : DATA NOMTRI/'FX ','FY ','FZ '/ 73 : * 74 : MTNUM = KTNUM 75 : MTFEX = KTFEX 76 : MTPHI = KTPHI 77 : MTLIAB = KTLIAB 78 : * 79 : NPC1 = XDT(/1) 80 : NPLB = JPLIB(/1) 81 : NSB = IAROTA(/1) 82 : IDIMB = XPHILB(/4) 83 : * 84 : * Lecture des chargements en base B 85 : * 86 : DO 5 IP=1,NPLB 87 : DO 6 IC=1,NPC1 88 : DO 7 I2=1,2 89 : DO 8 I3=1,IDIM 90 : FTEXB(IP,IC,I2,I3)=0.D0 91 : 8 CONTINUE 92 : 7 CONTINUE 93 : 6 CONTINUE 94 : 5 CONTINUE 95 : IF (ITCHAR.NE.0) THEN 96 : TYPRET = ' ' 96 : CALL ACCTAB(ITCHAR,'MOT',I0,X0,'BASE_B',L0,IP0, 97 : & TYPRET,I1,X1,CHARRE,L1,ICHAR1) 98 : IF (ICHAR1.NE.0 .AND. TYPRET.EQ.'CHARGEME') THEN 99 : MCHARG = ICHAR1 100 : SEGACT,MCHARG 101 : NCHAR = KCHARG(/1) 102 : * 103 : * Boucle sur les chargements élémentaires 104 : * 105 : DO 10 ICHAR=1,NCHAR 106 : ICHARG = KCHARG(ICHAR) 107 : SEGACT,ICHARG 108 : IF(CHATYP.NE.'CHPOINT '.OR.CHAMOB(ICHAR).NE.'STAT' 109 : & .OR.CHALIE(ICHAR).NE.'LIE ') THEN 110 : SEGDES ICHARG 111 : SEGDES MCHARG 111 : CALL ERREUR(696) 112 : RETURN 113 : ENDIF 114 : MLR1 = ICHPO2 115 : MLR2 = ICHPO3 115 : CALL DEVINT(MLR1,MLR2,KTNUM,KTRAV,REPRIS) 116 : MTRAV = KTRAV 117 : MCHPOI = ICHPO1 118 : SEGACT,MCHPOI 119 : NSOUPO=IPCHP(/1) 120 : DO 20 I=1,NSOUPO 121 : MSOUPO = IPCHP(I) 122 : SEGACT,MSOUPO 123 : MELEME = IGEOC 124 : SEGACT,MELEME 125 : NC = NOCOMP(/2) 126 : MPOVAL = IPOVAL 127 : SEGACT,MPOVAL 128 : N = VPOCHA(/1) 129 : DO 30 J=1,N 130 : KNOE = NUM(1,J) 131 : DO 35 K=1,NC 132 : CMOT = NOCOMP(K) 132 : CALL PLACE5(NOMTRI,3,ID,CMOT) 133 : IF (ID.NE.0) THEN 134 : * On vérifie que le point est un point de liaison 134 : CALL PLACE2(JPLIB,NPLB,IPOS,KNOE) 135 : IF (IPOS.NE.0) THEN 136 : ISB = IBASB(IPOS) 137 : IF (IAROTA(ISB).NE.0) THEN 138 : XFORCB = VPOCHA(J,K) 139 : * 140 : * Boucle sur les pas de temps 141 : * 142 : DO 36 IT=1,(NPC1 - 1) 143 : FTEXB(IPOS,IT,2,ID) = 144 : & FTEXB(IPOS,IT,2,ID) +( XFORCB * FTCHG(IT) ) 145 : IT2 = IT + 1 146 : FTEXB(IPOS,IT,1,ID) = 147 : & FTEXB(IPOS,IT,1,ID) +( XFORCB * FTCHG(IT2) ) 148 : 36 CONTINUE 149 : ENDIF 150 : * end do 151 : ENDIF 152 : ENDIF 153 : 35 CONTINUE 154 : * end do 155 : 30 CONTINUE 156 : * end do 157 : SEGDES,MPOVAL,MELEME,MSOUPO 158 : 20 CONTINUE 159 : * end do 160 : SEGDES,MCHPOI,ICHARG 161 : SEGSUP,MTRAV 162 : 10 CONTINUE 163 : * end do 164 : SEGDES,MCHARG 165 : ENDIF 166 : ENDIF 167 : * 168 : END 169 :
© Cast3M 2003 - All rights reserved.
Disclaimer