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