1 : C MANUR3 SOURCE CHAT 09/10/09 21:20:32 6519 2 : SUBROUTINE MANUR3 (IPELEM,IINCO,IDUAL,IPDESC) 3 : ************************************************************************ 4 : * 5 : * M A N U R 3 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * CONSTRUCTION DU DESCRIPTEUR D'UN OBJET 'RIGIDITE' CREE 12 : * MANUELLEMENT. 13 : * L'UTILISATION DE CE SOUS-PROGRAMME N'EST PAS UNIVERSELLE. 14 : * 15 : * MODE D'APPEL: 16 : * ------------- 17 : * 17 : * CALL MANUR3 (IPELEM,IINCO,IDUAL,IPDESC) 18 : * 19 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 20 : * ----------- 21 : * 22 : * IPELEM ENTIER (E) POINTEUR DE L'OBJET 'MAILLAGE' SUR LEQUEL 23 : * VA S'APPUYER LA 'RIGIDITE'. 24 : * IINCO SEGMENT (E) REGROUPEMENT DE POINTEURS SUR DES 25 : * 'LISTMOTS'. 26 : * SOIT IL N'Y A QU'1 'LISTMOTS', QUI CONTIENT 27 : * LES NOMS DES COMPOSANTES POUR UN NOEUD D'UN 28 : * ELEMENT DE L'OBJET DE POINTEUR "IPELEM", 29 : * SOIT IL Y A AUTANT DE 'LISTMOTS' QUE DE 30 : * NOEUDS PAR ELEMENT ET LE N-IEME 'LISTMOTS' 31 : * CONTIENT LES NOMS DES COMPOSANTES POUR LE 32 : * N-IEME NOEUD D'UN ELEMENT. 33 : * IDUAL SEGMENT (E) IDEM POUR LES DUALES 34 : * IPDESC ENTIER (S) POINTEUR SUR LE SEGMENT DESCRIPTEUR DE 35 : * L'OBJET 'RIGIDITE'. 36 : * 37 : * LEXIQUE: (ORDRE ALPHABETIQUE) 38 : * -------- 39 : * 40 : * MTEM3 SEGMENT REGROUPEMENT DE POINTEURS SUR DES 'LISTMOTS'. 41 : * MEME ORGANISATION QUE "MTEMP3", MAIS LES 42 : * 'LISTMOTS' CONTIENNENT LES NOMS DES INCONNUES 43 : * DUALES. 44 : * NBCOMP ENTIER NOMBRE DE COMPOSANTES POUR UN NOEUD D'ELEMENT. 45 : * NBLMOT ENTIER NOMBRE DE 'LISTMOTS' REFERENCES PAR "MTEMP3". 46 : * NBMOTT ENTIER NOMBRE TOTAL DE NOMS DE COMPOSANTES DONNES. 47 : * 48 : * LES AUTRES VARIABLES IMPORTANTES SONT EXPLIQUEES DANS LES MODULES 49 : * INCLUS. 50 : * 51 : * SOUS-PROGRAMMES APPELES: 52 : * ------------------------ 53 : * 54 : * ERREUR. 55 : * 56 : * AUTEUR, DATE DE CREATION: 57 : * ------------------------- 58 : * 59 : * PASCAL MANIGOT 19 FEVRIER 1985 60 : * 61 : * LANGAGE: 62 : * -------- 63 : * 64 : * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. 65 : * 66 : ************************************************************************ 67 : * 68 : IMPLICIT INTEGER(I-N) 69 : -INC CCOPTIO 70 : -INC CCHAMP 71 : -INC SMELEME 72 : -INC SMLMOTS 73 : -INC SMRIGID 74 : * 75 : SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3 76 : * 77 : LOGICAL BADNAM 78 : * 79 : * 80 : * 81 : * -- VERIFICATION DES NOMS DE COMPOSANTES DONNES ET ENREGISTREMENT 82 : * DES COMPOSANTES DUALES -- 83 : * 84 : MTEMP3=IINCO 85 : SEGACT,MTEMP3 86 : NBLMOT = ILMOTS(/1) 87 : * 88 : * ON N'A PAS DONNE LES NOMS DES DUALES 89 : * ON CHERCHE DANS NOMDD 90 : * 91 : IF (IDUAL.EQ.0) THEN 92 : SEGINI,MTEM3=MTEMP3 93 : * 94 : NBMOTT = 0 95 : DO 100 IB100=1,NBLMOT 96 : * 97 : MLMOTS = ILMOTS(IB100) 98 : SEGACT,MLMOTS 99 : NBMOTS = MOTS(/2) 100 : NBMOTT = NBMOTT + NBMOTS 101 : SEGINI,MLMOT1=MLMOTS 102 : MTEM3.ILMOTS(IB100) = MLMOT1 103 : * 104 : DO 110 IB110=1,NBMOTS 105 : * 106 : BADNAM = .TRUE. 107 : DO 120 IB120=1,LNOMDD 108 : IF (MOTS(IB110) .EQ. NOMDD(IB120) ) THEN 109 : MLMOT1.MOTS(IB110) = NOMDU(IB120) 110 : BADNAM = .FALSE. 111 : * --> SORTIE DE BOUCLE N.120 112 : GOTO 122 113 : END IF 114 : 120 CONTINUE 115 : * END DO 116 : 122 CONTINUE 117 : * 118 : IF (BADNAM) THEN 119 : MOTERR(1:4) = MOTS(IB110) 120 : NUMERR = 197 120 : CALL ERREUR (NUMERR) 121 : RETURN 122 : END IF 123 : * 124 : 110 CONTINUE 125 : * END DO 126 : * 127 : SEGDES,MLMOTS 128 : SEGDES,MLMOT1 129 : * 130 : 100 CONTINUE 131 : * END DO 132 : * 133 : * ON A DONNE LES NOMS DES DUALES 134 : * ON NE FAIT AUCUNE VERIF SUR LES NOMS 135 : * 136 : ELSE 137 : 138 : MTEM3=IDUAL 139 : SEGACT MTEM3 140 : * 141 : NBMOTT=0 142 : DO 200 IB200=1,NBLMOT 143 : MLMOTS = ILMOTS(IB200) 144 : SEGACT,MLMOTS 145 : MLMOT1 = MTEM3.ILMOTS(IB200) 146 : SEGACT MLMOT1 147 : NBMOTS = MOTS(/2) 148 : IF (NBMOTS.NE.MLMOT1.MOTS(/2)) THEN 148 : CALL ERREUR(217) 149 : RETURN 150 : ENDIF 151 : NBMOTT = NBMOTT + NBMOTS 152 : SEGDES MLMOTS 153 : SEGDES MLMOT1 154 : 200 CONTINUE 155 : 156 : ENDIF 157 : * 158 : * -- REMPLISSAGE DU DESCRIPTEUR DE L'OBJET "RIGIDITE" -- 159 : * 160 : MELEME = IPELEM 161 : SEGACT,MELEME 162 : NBNN = NUM(/1) 163 : SEGDES,MELEME 164 : * 165 : IF (NBLMOT .EQ. 1) THEN 166 : * 167 : NLIGRP= NBMOTT * NBNN 168 : NLIGRD=NBMOTT * NBNN 169 : SEGINI,DESCR 170 : MLMOTS = ILMOTS(1) 171 : SEGACT,MLMOTS 172 : MLMOT1 = MTEM3.ILMOTS(1) 173 : SEGACT,MLMOT1 174 : NBCOMP = NBMOTT 175 : * 176 : DO 500 IB500=1,NBNN 177 : ICONST = (IB500 - 1) * NBCOMP 178 : DO 510 IB510=1,NBCOMP 179 : III = IB510 + ICONST 180 : NOELEP(III) = IB500 181 : NOELED(III) = IB500 182 : LISINC(III) = MOTS(IB510) 183 : LISDUA(III) = MLMOT1.MOTS(IB510) 184 : 510 CONTINUE 185 : * END DO 186 : 500 CONTINUE 187 : * END DO 188 : * 189 : SEGDES,MLMOTS 190 : * 191 : ELSE IF (NBLMOT .GT. 1) THEN 192 : * 193 : IF (NBLMOT .NE. NBNN) THEN 194 : NUMERR = 198 194 : CALL ERREUR (NUMERR) 195 : RETURN 196 : END IF 197 : * 198 : NLIGRP = NBMOTT 199 : NLIGRD=NBMOTT 200 : SEGINI,DESCR 201 : * 202 : ICONST = 0 203 : DO 550 IB550=1,NBNN 204 : * 205 : MLMOTS = ILMOTS(IB550) 206 : SEGACT,MLMOTS 207 : MLMOT1 = MTEM3.ILMOTS(IB550) 208 : SEGACT,MLMOT1 209 : NBCOMP = MOTS(/2) 210 : * 211 : DO 570 IB570=1,NBCOMP 212 : III = IB570 + ICONST 213 : NOELEP(III) = IB550 214 : NOELED(III) = IB550 215 : LISINC(III) = MOTS(IB570) 216 : LISDUA(III) = MLMOT1.MOTS(IB570) 217 : 570 CONTINUE 218 : * END DO 219 : * 220 : ICONST = ICONST + NBCOMP 221 : * 222 : SEGDES,MLMOTS 223 : * 224 : 550 CONTINUE 225 : * END DO 226 : * 227 : ELSE 228 : * 229 : * IL N'A PAS ETE FOURNI DE 'LISTMOTS': 230 : MOTERR(1:8) = 'LISTMOTS' 231 : NUMERR = 37 231 : CALL ERREUR (NUMERR) 232 : RETURN 233 : * 234 : END IF 235 : * 236 : IPDESC = DESCR 237 : SEGDES,DESCR 238 : SEGDES,MTEMP3 239 : IF (IDUAL.EQ.0) THEN 240 : SEGSUP MTEM3 241 : ELSE 242 : SEGDES MTEM3 243 : ENDIF 244 : * 245 : END 246 : 247 : 248 : 249 : 250 : 251 : 252 : 253 : 254 :
© Cast3M 2003 - All rights reserved.
Disclaimer