1 : C DEPGE1 SOURCE CHAT 05/01/12 22:42:17 5004 2 : C 3 : SUBROUTINE DEPGE1(IPB,IPX,QI,MOT,IBBX2,IPLMOX,IPLMOY) 4 : C 5 : C******************************************************************** 6 : C 7 : C SBR APPELE PAR DEPGEN 8 : C 9 : C CALCUL DES DEPLACEMENTS GENERALISES 10 : C """"""""""""""""""""""""""""""""""" 11 : C ECRIT PAR D. BROCHARD 15/5/86 12 : C 13 : C 14 : C IPB POINTEUR MASSE 15 : C IPX POINTEUR MODE 16 : C PROPRE VECTEUR DES CARACTERISTIQUES MODALES) 17 : C MOT NOM DE LA COMPOSANTE 18 : C IBBX2 POINTEUR SUR CHPO M*X 19 : C IPLIMO POINTEUR SUR LIST MOTS TABLEAU UX FX ... POUR APPEL A 20 : C XTY1 21 : C 22 : C CE SBR CALCULE DTMU 23 : C TOUT D ABORD GENERATION DU VECTEUR U AYANT DES COMPOSANTES 24 : C DE VALEUR 1. SUR LES VARIABLES UX UY UZ OU SUR UR UT DANS 25 : C LEC CAS AXI OU FOURIER (1 OU -1 SELON L HARMONIQUE) 26 : C 27 : C SBR APPELANT : DEPGEN 28 : C 29 : C SBR APPELE : YTMX,DTCHPO,PLACE 30 : C 31 : C LE 15/05/86 : OPTION FOURIER N DIFF. 0 NON TESTEE 32 : C NUMERO D HARMONIQUE NON ECRITE DANS CHAMP POINT 33 : C 34 : C 35 : C 36 : C LE 08/07/86 : IFOPOI ET NOHARM CORRECTS SPR. TESTE DANS LE 37 : C CAS FOURIER AVEC UNE SEULE HARMONIQUE. RESTE 38 : C A TESTER LE CAS AXISYMETRIQUE. 39 : C 40 : C******************************************************************** 41 : C 42 : C 43 : IMPLICIT INTEGER(I-N) 44 : IMPLICIT REAL*8(A-H,O-Z) 45 : -INC SMCHPOI 46 : -INC SMELEME 47 : -INC CCOPTIO 48 : SEGMENT MTRA(NSOUP1) 49 : C 50 : REAL*8 QI 51 : CHARACTER*4 MOREF(3),MOT,MOT1,MOT2(3),MOT3 52 : DATA MOT2/'UR ','UT ','UZ '/,MOREF/'UX ','UY ','UZ '/ 53 : C 54 : C 55 : C EXTRAIRE LA COMPOSANTE DE NOM MOT 56 : C 57 : C 58 : C 59 : IHARM1=0 60 : MCHPO1=IPX 61 : SEGACT MCHPO1 62 : IF(MCHPO1.IFOPOI.NE.1) GOTO 1001 63 : LMOREF=3 63 : CALL PLACE(MOREF,LMOREF,IMOT,MOT) 64 : GOTO (1,2,3),IMOT 65 : 1 CONTINUE 66 : C 67 : C UX 68 : C 69 : IHARM1=1 70 : IDEB=1 71 : IFIN=2 72 : GOTO 1001 73 : 2 CONTINUE 74 : C 75 : C UY 76 : C 77 : IHARM1=-1 78 : IDEB=1 79 : IFIN=2 80 : GOTO 1001 81 : 3 CONTINUE 82 : C 83 : C UZ 84 : C 85 : IDEB=3 86 : IFIN=3 87 : C 88 : 1001 CONTINUE 89 : NSOUP1=MCHPO1.IPCHP(/1) 90 : SEGINI MTRA 91 : NSOUPO=0 92 : C 93 : C BOUCLE SUR LES SOUS PAQUETS DE MCHPO1 94 : C 95 : IF(MCHPO1.IFOPOI.EQ.1) GOTO 400 96 : DO 100 IA=1,NSOUP1 97 : MSOUP1=MCHPO1.IPCHP(IA) 98 : SEGACT MSOUP1 99 : NC1=MSOUP1.NOCOMP(/2) 100 : DO 110 IB=1,NC1 101 : MOT1=MSOUP1.NOCOMP(IB) 102 : IF(MOT1.NE.MOT) GOTO 110 103 : NSOUPO=NSOUPO+1 104 : MTRA(NSOUPO)=MSOUP1 105 : GOTO 401 106 : 110 CONTINUE 107 : 401 CONTINUE 108 : SEGDES MSOUP1 109 : 100 CONTINUE 110 : GOTO 500 111 : 400 CONTINUE 112 : DO 410 IA=1,NSOUP1 113 : MSOUP1=MCHPO1.IPCHP(IA) 114 : SEGACT MSOUP1 115 : NC1=MSOUP1.NOCOMP(/2) 116 : DO 112 I=IDEB,IFIN 117 : MOT3=MOT2(I) 118 : DO 111 IB=1,NC1 119 : MOT1=MSOUP1.NOCOMP(IB) 120 : IHARM=MSOUP1.NOHARM(IB) 121 : IF(MOT1.EQ.MOT3.AND.IHARM.EQ.IHARM1) GOTO 112 122 : 111 CONTINUE 123 : GOTO 405 124 : 112 CONTINUE 125 : NSOUPO=NSOUPO+1 126 : MTRA(NSOUPO)=MSOUP1 127 : 405 CONTINUE 128 : SEGDES MSOUP1 129 : 410 CONTINUE 130 : C 131 : 500 CONTINUE 132 : C 133 : IF(NSOUPO.EQ.0) GOTO 1000 134 : C 135 : IF(IHARM1.EQ.0) GOTO 300 136 : C 137 : C CREATION DU CHAMP POINT AYANT SELON LES CAS 1 OU -1 SU UR ET UT 138 : C 139 : NAT=1 140 : SEGINI MCHPOI 141 : IFOPOI=MCHPO1.IFOPOI 142 : NC=2 143 : DO 130 ISOUP=1,NSOUPO 144 : SEGINI MSOUPO 145 : IPCHP(ISOUP)=MSOUPO 146 : MSOUP1=MTRA(ISOUP) 147 : SEGACT MSOUP1 148 : IGEOC=MSOUP1.IGEOC 149 : NOCOMP(1)=MOT2(1) 150 : NOCOMP(2)=MOT2(2) 151 : NOHARM(1)=IHARM1 152 : NOHARM(2)=IHARM1 153 : MPOVA1=MSOUP1.IPOVAL 154 : SEGACT MPOVA1 155 : N=MPOVA1.VPOCHA(/1) 156 : SEGINI MPOVAL 157 : IPOVAL=MPOVAL 158 : DO 131 I=1,N 159 : VPOCHA(I,1)=1.0D0 160 : VPOCHA(I,2)=1.0D0 161 : IF(IHARM1.EQ.1) VPOCHA(I,2)=-1.0D0 162 : 131 CONTINUE 163 : SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO 164 : 130 CONTINUE 165 : GOTO 310 166 : 300 NAT=1 167 : SEGINI MCHPOI 168 : IFOPOI=MCHPO1.IFOPOI 169 : C 170 : C CREATION D UN CHAMP POINT DE VALEUR 1.0 SUR UX OU UY OU UZ 171 : C 172 : NC=1 173 : DO 120 ISOUP=1,NSOUPO 174 : SEGINI MSOUPO 175 : IPCHP(ISOUP)=MSOUPO 176 : MSOUP1=MTRA(ISOUP) 177 : SEGACT MSOUP1 178 : IGEOC=MSOUP1.IGEOC 179 : NOCOMP(1)=MOT 180 : NOHARM(1)=0 181 : MPOVA1=MSOUP1.IPOVAL 182 : SEGACT MPOVA1 183 : N =MPOVA1.VPOCHA(/1) 184 : SEGINI MPOVAL 185 : IPOVAL=MPOVAL 186 : DO 121 I=1,N 187 : VPOCHA(I,1)= 1.D0 188 : 121 CONTINUE 189 : SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO 190 : 120 CONTINUE 191 : 310 CONTINUE 192 : IP2=MCHPOI 193 : SEGDES MCHPOI 194 : * 195 : IF(IBBX2.EQ.0) GOTO 2000 195 : CALL XTY1(IP2,IBBX2,IPLMOX,IPLMOY,QI) 196 : GOTO 2001 197 : C 197 : 2000 CALL YTMX(IPX,IP2,IPB,QI) 197 : 2001 CALL DTCHPO(IP2) 198 : GOTO 1100 199 : 1000 CONTINUE 200 : QI=0.D0 201 : 1100 CONTINUE 202 : SEGSUP MTRA 203 : SEGDES MCHPO1 204 : RETURN 205 : END 206 :
© Cast3M 2003 - All rights reserved.
Disclaimer