1 : C QUESUQ SOURCE CHAT 11/03/16 21:30:01 6902 2 : SUBROUTINE QUESUQ(IPMODE,IPCHE1,ISUP,ICOND,MOMOT,lesupp,IRET, 3 : $ IRET2) 4 : *______________________________________________________________________ 5 : * 6 : * VERIFICATION DU LIEU SUPPORT DES MCHAML 7 : * 8 : * IPMODE POINTEUR SUR UNE ZONE ELEMENTAIRE DU MODELE 9 : * ACTIF EN ENTREE ACTIF EN SORTIE 10 : * IPCHE1 POINTEUR SUR LE MCHAML DONT ON SOUHAITE VERIFIER LE SUPPORT 11 : * DE CERTAINES COMPOSANTES 12 : * (LIEU DU MINTE) 13 : * ISUP > 0 : 14 : * 15 : * ISUP = 1 ON SOUHAITE QUE IPCHE1 SOIT AUX NOEUDS 16 : * = 2 ON SOUHAITE QUE IPCHE1 SOIT AUX CENTRE DE GRAVITE 17 : * = 3 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR 18 : * LA RIGIDITE 19 : * = 4 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR 20 : * LA MASSE 21 : * = 5 ON SOUHAITE QUE IPCHE1 SOIT AUX POINTS DE GAUSS POUR 22 : * LES CONTRAINTES 23 : * ISUP = 0 ON VEUDRAIT CONNAITRE LE SUPPORT 24 : * 25 : * ICOND = 0 SI LE MCHAML PEUT ETRE SUR LE SUPPORT DEMANDE OU AUX 26 : * NOEUDS(UTILISE UNIQUEMENT QUAND ISUP >0) 27 : * 1 SI LE MCHAML DOIT ETRE IMPERATIVEMENT SUR LE SUPPORT 28 : * VOULU (CAS NOTAMENT DES MATRICE DE HOOKES ET DES 29 : * DES MATRICES DE HOOKES TANGENTES) 30 : * 31 : * MOMOT : POINTEUR SUR SEGMENT DES NOMS DES COMPOSANTES A EXAMINER 32 : * ACTIF EN ENTREE ACTIF EN SORTIE 33 : * 34 : * IPINF : POINTEUR SUR SEGMENT INFO 35 : * 36 : * 37 : * DANS LE CAS ISUP > 0 38 : * 39 : * IRET = 1 IPCHE1 SE TROUVE AUX NOEUDS 40 : * = 0 IPCHE1 EST BIEN SUR LE SUPPORT DEMANDE 41 : * = 9999 LE SUPPORT DE UNE OU PLUSIEURS SOUS ZONE N'EST 42 : * PAS LE BON 43 : * DANS LE CAS ISUP = 0 44 : * 45 : * IRET > 0 IL DONNE LE NUMERO DU SUPPORT 46 : * = 0 LE CHAMP EST CONSTANT 47 : * = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT 48 : * 49 : * 50 : * IRET2 > 0 IL DONNE LE NUMERO DU SUPPORT 51 : * = 9999 LE CHAMELEM N'EST PAS HOMOGENE AU NIVEAU SUPPORT 52 : * 53 : * REMARQUE : SI IPCHE1 EST AUX NOEUDS LE PASSAGE DES VALEURS SUR LE 54 : * SUPPORT VOULU SE FAIT DANS VALCHE ET/OU VALMEL SAUF DANS 55 : * LE CAS DES MATRICE DE HOOKES 56 : * 57 : * 58 : * INSPIRE DE QUESUP 59 : *_______________________________________________________________________ 60 : * 61 : IMPLICIT INTEGER(I-N) 62 : IMPLICIT REAL*8(A-H,O-Z) 63 : -INC CCOPTIO 64 : -INC SMCHAML 65 : -INC SMINTE 66 : -INC SMMODEL 67 : * 68 : CHARACTER*16 CONCH 69 : * 70 : IRET=0 71 : IRET2=0 72 : ICONST=1 73 : * 74 : NOMID = MOMOT 75 : NBROBL = LESOBL(/2) 76 : NBRFAC = LESFAC(/2) 77 : * 78 : MCHELM=IPCHE1 79 : SEGACT MCHELM 80 : NSOUS=ICHAML(/1) 81 : * 82 : * si le chamelem est constant sur l'element quelque soit le 83 : * support demande on est bon 84 : * 85 : DO 10 ISOUS=1,NSOUS 86 : MCHAML=ICHAML(ISOUS) 87 : SEGACT MCHAML 88 : NCOMP=IELVAL(/1) 89 : DO 20 ICOMP=1,NCOMP 90 : * 91 : * TEST SUR LES NOMS DE COMPOSANTES 92 : * 93 : JELAI=0 94 : DO 21 ICOCO=1,NBROBL 95 : IF(NOMCHE(ICOMP).EQ.LESOBL(ICOCO)) JELAI=1 96 : 21 CONTINUE 97 : IF(JELAI.EQ.0) THEN 98 : DO 22 ICOCO=1,NBRFAC 99 : IF(NOMCHE(ICOMP).EQ.LESFAC(ICOCO)) JELAI=1 100 : 22 CONTINUE 101 : ENDIF 102 : IF(JELAI.EQ.0) GO TO 20 103 : * 104 : MELVAL=IELVAL(ICOMP) 105 : IF(MELVAL.NE.0)THEN 106 : SEGACT MELVAL 107 : IF(TYPCHE(ICOMP)(1:8).NE.'POINTEUR')THEN 108 : IPOIN=VELCHE(/1) 109 : ELSE 110 : IPOIN=IELCHE(/1) 111 : ENDIF 112 : IF(IPOIN.NE.1)THEN 113 : SEGDES MELVAL,MCHAML 114 : ICONST=0 115 : GOTO 500 116 : ENDIF 117 : SEGDES MELVAL 118 : ENDIF 119 : 20 CONTINUE 120 : SEGDES MCHAML 121 : 10 CONTINUE 122 : * 123 : 500 CONTINUE 124 : N3=INFCHE(/2) 125 : IF (N3.LT.4) GOTO 1000 126 : IF(N3.GE.6) THEN 127 : ISUP1=INFCHE(1,6) 128 : IRET2=ISUP1 129 : IF (ICONST.EQ.1) GOTO 666 130 : ELSE 131 : GOTO 3000 132 : ENDIF 133 : * 134 : IFLAG=0 135 : * 136 : * CAS ISUP = 0 137 : * ------------ 138 : * 139 : IF(ISUP.EQ.0)THEN 140 : IF(N3.GE.6)ISUP1=INFCHE(1,6) 141 : DO 1 ISOUS=1,NSOUS 142 : IF (INFCHE(ISOUS,4).EQ.0) GOTO 1 143 : IF (N3.GE.6) THEN 144 : INFCH=INFCHE(ISOUS,6) 145 : IF (INFCH.EQ.1) GOTO 1 146 : IF (INFCH.NE.ISUP1) THEN 147 : MINTE=INFCHE(1,4) 148 : MINTE1=INFCHE(ISOUS,4) 149 : SEGACT MINTE 150 : SEGACT MINTE1 151 : NBPGAU=POIGAU(/1) 152 : NBPGA1=MINTE1.POIGAU(/1) 153 : * NO DESACT SEGDES,MINTE,MINTE1 154 : IF(NBPGAU.EQ.NBPGA1)THEN 155 : IFLAG=IFLAG+1 156 : ELSE 157 : GOTO 2000 158 : ENDIF 159 : ELSE 160 : IFLAG=IFLAG+1 161 : ENDIF 162 : ELSE 163 : GOTO 3000 164 : ENDIF 165 : 1 CONTINUE 166 : * 167 : * TOUTES LES SOUS ZONES DOIVENT ETRE SUR LE BON SUPPORT 168 : * 169 : IF (IFLAG.EQ.0) GOTO 1000 170 : IF (IFLAG.EQ.NSOUS) THEN 171 : IF(ISUP.EQ.0) THEN 172 : IRET=ISUP1 173 : IRET2=ISUP1 174 : ENDIF 175 : GOTO 666 176 : ELSE 177 : GOTO 2000 178 : ENDIF 179 : * 180 : * CAS ISUP > 0 181 : * ------------ 182 : * DANS CE CAS CE SONT LES ZONES DU MODELE QUI PILOTENT 183 : * 184 : ELSE 185 : ISUP1=ISUP 186 : * 187 : * ETUDE DE LA SOUS ZONE DU MODELE 188 : * 189 : IMODEL=IPMODE 190 : MELE=NEFMOD 191 : * 192 : * BOUCLE SUR LES ZONES DU CHAMELEM 193 : * 194 : DO 2 ISOUS=1,NSOUS 195 : CONCH=CONCHE(ISOUS) 196 : IPMAIL=IMACHE(ISOUS) 197 : IF(IMAMOD.NE.IPMAIL.OR.CONCH.NE.CONMOD)GOTO 2 198 : IF (INFCHE(ISOUS,4).EQ.0) GOTO 2 199 : * 200 : IF (N3.GE.6) THEN 201 : INFCH=INFCHE(ISOUS,6) 202 : IF (INFCH.EQ.1) GOTO 2 203 : IF (INFCH.NE.ISUP1) THEN 204 : IF(ISUP1.EQ.6)THEN 204 : CALL TSHAPE(MELE,'GAUSS',IPMIN1) 205 : ELSE 206 : * INFO=IPINF 207 : IPMIN1=INFMOD(lesupp+2) 208 : ENDIF 209 : MINTE=INFCHE(ISOUS,4) 210 : MINTE1=IPMIN1 211 : SEGACT MINTE 212 : SEGACT MINTE1 213 : NBPGAU=POIGAU(/1) 214 : NBPGA1=MINTE1.POIGAU(/1) 215 : IF(NBPGAU.EQ.NBPGA1)THEN 216 : IRT=1 217 : ELSE 218 : IRT=0 219 : ENDIF 220 : * NO DESACT SEGDES MINTE,MINTE1 221 : IF(IRT.EQ.1)THEN 222 : IFLAG=IFLAG+1 223 : ELSE 224 : GOTO 2000 225 : ENDIF 226 : ELSE 227 : IFLAG=IFLAG+1 228 : ENDIF 229 : ELSE 230 : GOTO 3000 231 : ENDIF 232 : 2 CONTINUE 233 : * 234 : * LA SOUS-ZONE DOIT ETRE SUR LE BON SUPPORT 235 : * 236 : IF (IFLAG.EQ.0) GOTO 1000 237 : IF (IFLAG.EQ.1) THEN 238 : IF(ISUP.EQ.0) THEN 239 : IRET=ISUP1 240 : IRET2=ISUP1 241 : ENDIF 242 : GOTO 666 243 : ELSE 244 : GOTO 2000 245 : ENDIF 246 : ENDIF 247 : * 248 : 1000 CONTINUE 249 : * 250 : * IPCHE1 EST AUX NOEUDS 251 : * 252 : IRET=1 253 : IF (ISUP.EQ.1) IRET=0 254 : IF (ICOND.EQ.1.AND.IRET.EQ.1.AND.ISUP.NE.0) GOTO 2000 255 : GOTO 666 256 : * 257 : 2000 CONTINUE 258 : * 259 : IF(ISUP.NE.0)THEN 260 : * 261 : * IPCHE1 EST SUR UN AUTRE SUPPORT QUE CELUI VOULU ET PAS AUX NOEUDS 262 : * 263 : * ==> MESSAGE D'ERREUR POUR QUE L'ON DONNE LE CHAMELEM SUR UN 264 : * SUPPORT CORRECT 265 : * 266 : MOTERR(1:8)=TITCHE 266 : CALL ERREUR(124) 267 : ELSE 268 : * 269 : * LES DIFFERENTS SOUS-ZONES DU CHAMELEM ONT DES POINTS SUPPORTS DIFFERENTS 270 : * 270 : CALL ERREUR(560) 271 : ENDIF 272 : SEGDES MCHELM 273 : IRET=9999 274 : IRET2=9999 275 : RETURN 276 : * 277 : 3000 CONTINUE 278 : * 279 : * IPCHE1 A UN POINTEUR SUR UN MINTE <> 0 MAIS L'INFCHE(..,6) 280 : * N'EST PAS RENSEIGNE (NE DOIT PAS ARRIVE NORMALEMENT) 281 : * 282 : IRET=9999 283 : IRET2=9999 283 : CALL ERREUR(53) 284 : * 285 : 666 CONTINUE 286 : SEGDES MCHELM 287 : RETURN 288 : END 289 : 290 : 291 : 292 : 293 : 294 : 295 : 296 :
© Cast3M 2003 - All rights reserved.
Disclaimer