1 : C SENSI1 SOURCE PV 09/03/12 21:34:13 6325 2 : * 3 : * 4 : * BOUCLE SUR LES SOUS ZONES (1 SEUL ELEMENT PAR SOUS ZONE ) 5 : * LELEU DIDIER HAZE FREDERIC 6 : * 03/03/93 7 : * EXTRAIT DE ADCHEL.ESO 8 : * 9 : * 10 : SUBROUTINE SENSI1(IPCHE1,IPCHE2,MTAB1) 11 : * 12 : * 13 : * 14 : * 15 : * 16 : * 17 : * ENTREE : 18 : * -------- 19 : * 20 : * 21 : * IPCHE1 POINTEUR SUR LE PREMIER CHAMP (TYPE MCHAML) 22 : * IPCHE2 POINTEUR SUR LE DEUXIEME CHAMP (TYPE MCHALM) 23 : * 24 : * 25 : * SORTIE : 26 : * ________ 27 : * 28 : * MTAB1 POINTEUR SUR LA TABLE DERIVEES (TYPE TABLE) 29 : * = 0 SI L OPERATION EST IMPOSSIBLE 30 : * 31 : * 32 : * 33 : * 34 : * 35 : IMPLICIT INTEGER(I-N) 36 : IMPLICIT REAL*8(A-H,O-Z) 37 : REAL*8 MOYS,A 38 : CHARACTER*2 B 39 : LOGICAL C 40 : * 41 : -INC SMCHAML 42 : -INC SMTABLE 43 : -INC CCOPTIO 44 : * 45 : SEGMENT MZONG 46 : INTEGER NZONG(0) 47 : ENDSEGMENT 48 : * 49 : SEGMENT MZON1 50 : INTEGER NZON1(0) 51 : ENDSEGMENT 52 : * 53 : SEGMENT MZON2 54 : INTEGER NZON2(0) 55 : ENDSEGMENT 56 : * 57 : SEGMENT ITAFF 58 : INTEGER JTAFF(0) 59 : ENDSEGMENT 60 : * 61 : SEGMENT MPTVAL 62 : INTEGER IPOS(NS) ,NSOF(NS) 63 : INTEGER IVAL(NCOSOU) 64 : CHARACTER*16 TYVAL(NCOSOU) 65 : ENDSEGMENT 66 : * 67 : PARAMETER ( NINF=3 ) 68 : INTEGER INFOS(NINF) 69 : CHARACTER*72 MOT 70 : CHARACTER*16 CONCH1,CONCH2 71 : * 72 : MCHEL1=IPCHE1 73 : MCHEL2=IPCHE2 74 : SEGACT MCHEL1 75 : SEGACT MCHEL2 76 : * 77 : L1=MCHEL1.TITCHE(/1) 78 : MOT=MCHEL1.TITCHE 79 : IF (MOT.EQ.'NOEUD'.OR.MOT.EQ.'GRAVITE'.OR.MOT.EQ.'RIGIDITE'. 80 : & OR.MOT.EQ.'MASSE'.OR.MOT.EQ.'STRESSES'. 81 : & OR.MOT.EQ.'SCALAIRE') THEN 82 : MOT=MCHEL2.TITCHE 83 : L1=MCHEL2.TITCHE(/1) 84 : ENDIF 85 : N3=MCHEL1.INFCHE(/2) 86 : NSOUS1=MCHEL1.ICHAML(/1) 87 : NSOUS2=MCHEL2.ICHAML(/1) 88 : * 89 : 90 : * 91 : * QUELLES BIJECTIONS ENTRE LES SOUS PAQUETS SI OUI TRAITEMENT AMELIORE 92 : * 93 : * 94 : SEGINI ITAFF 95 : DO 17 ISOUS1=1,NSOUS1 96 : IPMAI1 = MCHEL1.IMACHE(ISOUS1) 97 : CONCH1 = MCHEL1.CONCHE(ISOUS1) 98 : DO 18 ISOUS2=1,NSOUS2 99 : ISOUS=ISOUS2 100 : IPMAI2= MCHEL2.IMACHE(ISOUS) 101 : CONCH2= MCHEL2.CONCHE(ISOUS) 102 : IF(IPMAI1.EQ.IPMAI2.AND.CONCH1.EQ.CONCH2) THEN 103 : * 104 : * VERIFICATION POUR LES INFCHE 105 : * 105 : CALL IDENT (IPMAI1,CONCH1,IPCHE1,IPCHE2,INFOS,IRTD) 106 : IF (IRTD.EQ.0) GOTO 18 107 : IMINT1=0 108 : IMINT2=0 109 : IF (MCHEL1.INFCHE(/2).GE.4) IMINT1=MCHEL1.INFCHE(ISOUS1,4) 110 : IF (MCHEL2.INFCHE(/2).GE.4) IMINT2=MCHEL2.INFCHE(ISOUS2,4) 111 : IF (IMINT1.EQ.IMINT2) GOTO 171 112 : IMINT1=1 113 : IMINT2=1 114 : IF (MCHEL1.INFCHE(/2).GE.6) IMINT1=MCHEL1.INFCHE(ISOUS1,6) 115 : IF (MCHEL2.INFCHE(/2).GE.6) IMINT2=MCHEL2.INFCHE(ISOUS2,6) 116 : IF (IMINT1.EQ.0) IMINT1=1 117 : IF (IMINT2.EQ.0) IMINT2=1 118 : IF (IMINT1.EQ.IMINT2) GOTO 171 119 : * 120 : * ERREUR IMPOSSIBLE D ADDITIONNER DES CHPS/ELMTS 121 : * DE SS TYPE DIFFERENTS 122 : * 123 : MOTERR(1:8)=MCHEL1.TITCHE 124 : MOTERR(9:16)=MCHEL2.TITCHE 124 : CALL ERREUR(329) 125 : SEGDES MCHEL1,MCHEL2 126 : SEGSUP ITAFF 127 : IPCHAD=0 128 : RETURN 129 : ENDIF 130 : 18 CONTINUE 131 : SEGSUP ITAFF 132 : GOTO 4000 133 : * 134 : 171 CONTINUE 135 : JTAFF(**)=MCHEL2.ICHAML(ISOUS) 136 : 17 CONTINUE 137 : * 138 : * ON A TROUVE UNE BIJECTION ET ON VECTORISE 139 : * 140 : N1=NSOUS1 141 : SEGINI MCHELM 142 : TITCHE=MOT 143 : IFOCHE=IFOUR 144 : M=NSOUS1+1 145 : SEGINI MTABLE 146 : MLOTAB=0 147 : DO 400 ISOUS=1,NSOUS1 148 : IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS) 149 : CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS) 150 : DO 401 N33=1,N3 151 : INFCHE(ISOUS,N33)=MCHEL1.INFCHE(ISOUS,N33) 152 : 401 CONTINUE 153 : * 154 : MCHAM1=MCHEL1.ICHAML(ISOUS) 155 : * 156 : SEGINI,MCHAML=MCHAM1 157 : ICHAML(ISOUS)=MCHAML 158 : IPCHA=MCHAML 159 : * 160 : MCHAM2=JTAFF(ISOUS) 161 : SEGACT MCHAM2 162 : IPCHA2=MCHAM2 163 : * 163 : CALL SENSI2 (IPCHA2,IPCHA,MOYS) 163 : CALL ECCTAB(MTABLE,'ENTIER',ISOUS,A,B,C 164 : & ,IOBIN,'FLOTTANT',IB,MOYS,B, 165 : & C,IOBIN) 166 : * 167 : MOYS=0.D0 168 : IF (IPCHA.EQ.0) THEN 169 : SEGSUP ITAFF 170 : GOTO 9990 171 : ENDIF 172 : * 173 : SEGDES MCHAML,MCHAM2 174 : 400 CONTINUE 175 : MTAB1=MTABLE 176 : SEGDES MCHEL1,MCHEL2 177 : SEGSUP ITAFF 178 : SEGDES MCHELM 179 : GOTO 666 180 : *_______________________________________________________________________ 181 : * 182 : * ON A PAS TROUVE DE BIJECTION 183 : *_______________________________________________________________________ 184 : * 185 : 4000 CONTINUE 186 : SEGINI MZONG,MZON1,MZON2 187 : DO 500 ISOUS1=1,NSOUS1 188 : NZONG(**)=MCHEL1.IMACHE(ISOUS1) 189 : NZON1(**)=ISOUS1 190 : NZON2(**)=0 191 : 500 CONTINUE 192 : IWRN=0 193 : DO 510 ISOUS2=1,NSOUS2 194 : IPMAI2 = MCHEL2.IMACHE(ISOUS2) 195 : CONCH2 = MCHEL2.CONCHE(ISOUS2) 196 : DO 520 ISOUS1=1,NSOUS1 197 : IPMAI1= MCHEL1.IMACHE(ISOUS1) 198 : CONCH1= MCHEL1.CONCHE(ISOUS1) 199 : IF(IPMAI1.EQ.IPMAI2 .AND.CONCH1.EQ.CONCH2) THEN 199 : CALL IDENT (IPMAI1,CONCH1,IPCHE1,IPCHE2,INFOS,IRTD) 200 : IF (IRTD.EQ.0) GOTO 520 201 : * 202 : * VERIFICATION POUR LES MINTES 203 : * 204 : IF ( MCHEL1.INFCHE(ISOUS1,4).EQ. 205 : & MCHEL2.INFCHE(ISOUS2,4) ) GOTO 530 206 : * 207 : * ERREUR SUR LES SUPPORTS DES MCHAML 208 : * 209 : MOTERR(1:8)=MCHEL1.TITCHE 210 : MOTERR(9:16)=MCHEL2.TITCHE 210 : CALL ERREUR(329) 211 : IPCHAD=0 212 : SEGDES MCHEL1,MCHEL2 213 : SEGSUP MZONG,MZON1,MZON2 214 : RETURN 215 : * 216 : ENDIF 217 : 520 CONTINUE 218 : IWRN=1 219 : NZONG(**)=IPMAI2 220 : NZON1(**)=0 221 : NZON2(**)=ISOUS2 222 : GOTO 510 223 : * 224 : 530 CONTINUE 225 : NZON2(ISOUS1)=ISOUS2 226 : 510 CONTINUE 227 : * 228 : * WARNING LES SOUS ZONES GEOMETRIQUES NE SE CORRESPONDENT PAS 2 A 2 229 : * 229 : IF(IWRN.EQ.1) CALL ERREUR(103) 230 : NSOUS=NZONG(/1) 231 : N1=NSOUS 232 : SEGINI MCHELM 233 : TITCHE=MOT 234 : IFOCHE=IFOUR 235 : IPCHAD=MCHELM 236 : * 237 : DO 540 ISOUS=1,NSOUS 238 : IF(NZON1(ISOUS).NE.0.AND.NZON2(ISOUS).NE.0) GOTO 550 239 : * 240 : IF(NZON1(ISOUS).NE.0) THEN 241 : MCHAM1=MCHEL1.ICHAML( NZON1(ISOUS) ) 242 : SEGINI,MCHAML=MCHAM1 243 : IMACHE(ISOUS)=NZONG(ISOUS) 244 : CONCHE(ISOUS)=MCHEL1.CONCHE( NZON1(ISOUS) ) 245 : 246 : DO 402 N33=1,N3 247 : INFCHE(ISOUS,N33)=MCHEL1.INFCHE(NZON1(ISOUS),N33) 248 : 402 CONTINUE 249 : * 250 : ENDIF 251 : IF(NZON2(ISOUS).NE.0) THEN 252 : MCHAM2=MCHEL2.ICHAML( NZON2(ISOUS) ) 253 : SEGINI,MCHAML=MCHAM2 254 : IMACHE(ISOUS)=NZONG(ISOUS) 255 : CONCHE(ISOUS)=MCHEL2.CONCHE( NZON2(ISOUS) ) 256 : 257 : DO 403 N33=1,N3 258 : INFCHE(ISOUS,N33)=MCHEL2.INFCHE(NZON2(ISOUS),N33) 259 : 403 CONTINUE 260 : * 261 : ENDIF 262 : ICHAML(ISOUS)=MCHAML 263 : * 264 : DO 175 ICOMP=1,IELVAL(/1) 265 : MELVA1=IELVAL(ICOMP) 266 : SEGINI,MELVAL=MELVA1 267 : IELVAL(ICOMP)=MELVAL 268 : SEGDES MELVAL 269 : 175 CONTINUE 270 : SEGDES MCHAML 271 : * 272 : GOTO 540 273 : * 274 : 550 CONTINUE 275 : MCHAM1=MCHEL1.ICHAML( NZON1(ISOUS) ) 276 : SEGINI,MCHAML=MCHAM1 277 : IMACHE(ISOUS)=NZONG(ISOUS) 278 : CONCHE(ISOUS)=MCHEL1.CONCHE( NZON1(ISOUS) ) 279 : 280 : DO 404 N33=1,N3 281 : INFCHE(ISOUS,N33)=MCHEL1.INFCHE(NZON1(ISOUS),N33) 282 : 404 CONTINUE 283 : ICHAML(ISOUS)=MCHAML 284 : IPCHA=MCHAML 285 : MCHAM2=MCHEL2.ICHAML( NZON2(ISOUS) ) 286 : SEGACT MCHAM2 287 : IPCHA2=MCHAM2 288 : * 288 : CALL SENSI2 (IPCHA2,IPCHA,MOYS) 289 : IF (IPCHA.EQ.0) THEN 290 : SEGSUP MZONG,MZON1,MZON2 291 : GOTO 9990 292 : ENDIF 293 : * 294 : SEGDES MCHAML,MCHAM2 295 : 540 CONTINUE 296 : SEGDES MCHELM 297 : * 298 : SEGSUP MZONG,MZON1,MZON2 299 : GOTO 666 300 : * 301 : 9990 CONTINUE 302 : * 303 : * ERREUR DANS UNE SOUS ZONE : DESACTIVATION ET RETOUR 304 : * 305 : SEGDES MCHEL1,MCHEL2,MCHAM2 306 : SEGSUP MCHAML,MCHELM,ITAFF 307 : IPCHAD=0 308 : RETURN 309 : * 310 : 666 CONTINUE 311 : SEGDES MCHEL1,MCHEL2 312 : 777 CONTINUE 313 : RETURN 314 : END 315 : 316 : 317 : 318 : 319 :
© Cast3M 2003 - All rights reserved.
Disclaimer