1 : C MANUCH SOURCE GOUNAND 05/10/10 21:15:17 5200 2 : C 3 : SUBROUTINE MANUCH 4 : C 5 : CCCCCCCCCCC CE SUBROUTINE FABRIQUE UN OBJET DE TYPE CHPOINT 6 : C 7 : C 8 : CCCCCCCCCCC SYNTAXE : 9 : C C = MANU CHPO ELEM1 NC DDLi LISTREELi 10 : C TITRE CHA1 ; 11 : C 12 : C ELEM1 : POINTEUR SUR UN POINT OU UN MAILLAGE 13 : C NC : POUR CE MAILLAGE NOMBRE DE COMPOSANTES 14 : C ON ECRIT NC FOIS LES COUPLES DDL LISTREEL 15 : C DDLi : NOM DE LA Ieme COMPOSANTE (MOT) 16 : C LISTREELi: VALEURS DE CETTE COMPOSANTE DU CHAMP (LISTREEL) 17 : C TITRE : MOT-CLE, POUR DONNER UN TITRE AU CHPOINT 18 : C CHA1 : TITRE, MAXIMUN DE 72 CARACTERES. 19 : C 20 : C EXEMPLE : C=MANU CHPO ELEM1 2 UX (PROG 1. 1.) UY (PROG 2. -1.) ; 21 : C où ELEM est un maillage contenant deux points 22 : C 23 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 24 : C 25 : C SI ELEM N'EST PAS DE TYPE POI1 ON LE CHANGE EN POI1 26 : C LA DIMENSION DE LISTREEL DOIT ETRE CELLE DE ELM SAUF 27 : C SI C'EST 1 ==> CHPO CONSTANT 28 : C POUR FAIRE UN CHPO CONSTANT ON PEUT AUSSI DONNER UN FLOTTANT 29 : C A LA PLACE DU LISTREEL 30 : C 31 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 32 : C 33 : C Variables internes 34 : C 35 : C ILU : indique si le nombre de composantes est donné 36 : C NCC : compteur limite pour la boucle sur les composantes 37 : C NC : nombre de composantes, donné ou à déterminer 38 : C 39 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 40 : C 41 : IMPLICIT INTEGER(I-N) 42 : -INC CCOPTIO 43 : -INC SMCHPOI 44 : -INC SMLMOTS 45 : -INC SMLREEL 46 : -INC SMELEME 47 : -INC SMCOORD 48 : C 49 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 50 : C 51 : PARAMETER (LMOOPT=2) 52 : REAL*8 VFLOT 53 : CHARACTER*(4) MOXX 54 : CHARACTER*(6) MOYY 55 : CHARACTER*72 TITRE 56 : CHARACTER*4 MOOPT(LMOOPT) 57 : CHARACTER*4 ADDI(3) 58 : C ADDI STOCKE LES MOTCLE DE LA 1ERE NATURE 59 : INTEGER ATTRI(10) 60 : C ATTRI STOCKE LES ATTRIBUT DE NATURE (LIMITE A 10) 61 : C MOTCLE DE LA SYNTAXE 62 : DATA MOOPT /'TITR','NATU'/ 63 : DATA ADDI /'INDE','DIFF','DISC'/ 64 : C 65 : C LECTURE FACULTATIVE DU TITRE OU DE LA NATURE 66 : C 67 : TITRE = ' ' 68 : NAT = 1 69 : DO 10 I=1,10 70 : 10 ATTRI(I)=0 71 : C 71 : 100 CALL LIRMOT(MOOPT,LMOOPT,IMOT,0) 72 : IF(IERR.NE.0) RETURN 73 : IF (IMOT.EQ.1) THEN 74 : C lecture du titre 74 : CALL LIRCHA(TITRE,1,IRETOU) 75 : IF (IERR.NE.0) RETURN 76 : GOTO 100 77 : ELSEIF (IMOT.EQ.2) THEN 78 : C lecture de l'attribut de nature 78 : CALL LIRMOT(ADDI,3,ATTRI(1),1) 79 : IF (IERR .NE. 0) RETURN 80 : NAT = MAX(1,NAT) 81 : ATTRI(1) = ATTRI(1) - 1 82 : GOTO 100 83 : ENDIF 84 : C 85 : C LECTURE DE LA GEOMETRIE 86 : C 86 : 400 CALL LIROBJ('POINT ',KPOINT,0,IRETOU) 87 : IF (IRETOU.NE.0) THEN 87 : CALL CRELEM(KPOINT) 88 : MELEME=KPOINT 89 : ELSE 89 : CALL LIROBJ('MAILLAGE',MELEME,1,IRETOU) 90 : IF (IERR.NE.0) RETURN 91 : SEGACT MELEME 91 : * IF (ITYPEL.NE.1.OR.LISOUS(/1).NE.0) CALL CHANGE(MELEME,1) 91 : CALL CHANGE(MELEME,1) 92 : ENDIF 93 : 94 : * VERIFICATION QUE CHAQUE POINT N'APPARAIT QU'UNE SEULE FOIS 95 : NBP1 = NUM(/2) 96 : SEGINI ICPR 97 : ICON = 0 98 : DO 12 I=1,NBP1 99 : IKI = NUM(1,I) 100 : IF(ICPR(IKI).NE.0) GOTO 12 101 : ICON = ICON+1 102 : ICPR(IKI) = ICON 103 : 12 CONTINUE 104 : SEGSUP ICPR 105 : SEGDES MELEME 106 : C UN POINT EST DONNE PLUSIEURS DANS LA GEOMETRIE 106 : IF (ICON.NE.NBP1) CALL ERREUR(75) 107 : IF (IERR.NE.0) RETURN 108 : C 109 : C Nouvelle syntaxe gounand 110 : C 110 : CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU) 111 : * Ancienne syntaxe 112 : IF (IRETOU.EQ.0) GOTO 300 113 : SEGACT MLMOTS 114 : NC=MOTS(/2) 114 : CALL LIROBJ('LISTREEL',MLREEL,1,IRETOU) 115 : IF (IERR.NE.0) RETURN 116 : SEGACT MLREEL 117 : NR=PROG(/1) 118 : * 119 : SEGINI MSOUPO 120 : IGEOC = MELEME 121 : N = NBP1 122 : SEGINI MPOVAL 123 : IPOVAL = MPOVAL 124 : * 125 : DO IC=1,NC 126 : NOCOMP(IC) = MOTS(IC)(1:4) 127 : NOHARM(IC) = NIFOUR 128 : IF (IC.GT.NR) THEN 129 : VFLOT=0.D0 130 : ELSE 131 : VFLOT=PROG(IC) 132 : ENDIF 133 : DO K=1,NBP1 134 : VPOCHA(K,IC) = VFLOT 135 : ENDDO 136 : ENDDO 137 : SEGDES MLREEL 138 : SEGDES MLMOTS 139 : * La création du chapeau : c'est comme avant 140 : GOTO 500 141 : C 142 : C LECTURE DU NOMBRE DE COMPOSANTES 143 : C 144 : 300 CONTINUE 145 : NC = 0 145 : CALL LIRENT(NC,0,IRETOU) 146 : IF (IRETOU.NE.0) THEN 147 : ILU = 1 148 : INTERR(1)= NC 149 : NCC = NC 149 : IF (NC.LE.0) CALL ERREUR(36) 150 : IF (IERR.NE.0) RETURN 151 : ELSE 152 : NC = 0 153 : NCC = 1 154 : ILU = 0 155 : ENDIF 156 : 157 : SEGINI MSOUPO 158 : IGEOC = MELEME 159 : N = NBP1 160 : SEGINI MPOVAL 161 : IPOVAL = MPOVAL 162 : C 163 : IC = 0 164 : DO 20 ICC=1,NCC 165 : c Boucle sur les mots lus 166 : C 167 : C LECTURE DU NOM DE COMPOSANTE 168 : C 169 : 32 continue 170 : IC = IC + 1 171 : 171 : CALL LIRCHA(MOYY,0,IRETOU) 172 : IF (IRETOU.EQ.0) THEN 173 : IF(ILU.EQ.1) THEN 173 : CALL ERREUR (80) 174 : RETURN 175 : ELSE 176 : GO TO 21 177 : ENDIF 178 : ENDIF 179 : IF(IERR.NE.0) RETURN 180 : IF(IRETOU.GT.4) THEN 180 : CALL ERREUR(536) 181 : RETURN 182 : ENDIF 183 : IF (ILU.EQ.0) THEN 184 : NC = NC + 1 185 : SEGADJ MSOUPO 186 : SEGADJ MPOVAL 187 : ENDIF 188 : NOCOMP(IC) = MOYY(1:4) 189 : NOHARM(IC) = NIFOUR 190 : C 191 : C LECTURE DES VALEURS 192 : C 193 : C est-ce un flottant ? 193 : CALL LIRREE(VFLOT,0,IRETOU) 194 : MLREEL=0 195 : C ou alors une liste de réels ? 195 : IF (IRETOU.EQ.0) CALL LIROBJ('LISTREEL',MLREEL,1,IRETOU) 196 : IF(IERR.NE.0) RETURN 197 : 198 : IF (MLREEL.NE.0) THEN 199 : SEGACT MLREEL 200 : N = PROG(/1) 200 : IF (N.NE.NBP1.AND.N.NE.1) CALL ERREUR(21) 201 : IF (IERR.NE.0) RETURN 202 : IF (N.EQ.1) THEN 203 : c c'est une liste de réels, mais avec une seule valeur 204 : VFLOT = PROG(1) 205 : SEGDES MLREEL 206 : MLREEL = 0 207 : ENDIF 208 : ENDIF 209 : IF (MLREEL.NE.0) THEN 210 : c on crée un chpo variable 211 : DO 42 K=1,NBP1 212 : VPOCHA(K,IC) = PROG(K) 213 : 42 CONTINUE 214 : SEGDES MLREEL 215 : ELSE 216 : c on crée un chpo constant 217 : DO 43 K=1,NBP1 218 : VPOCHA(K,IC) = VFLOT 219 : 43 CONTINUE 220 : ENDIF 221 : c si le nb de composantes n'est pas précisé, on continue de les lire 222 : IF (ILU.EQ.0) GOTO 32 223 : 20 CONTINUE 224 : 21 CONTINUE 225 : C 226 : C LECTURE FACULTATIVE DU TITRE OU DE LA NATURE 227 : C 227 : 500 CALL LIRMOT(MOOPT,LMOOPT,IMOT,0) 228 : IF (IERR.NE.0) RETURN 229 : IF (IMOT.EQ.1) THEN 230 : C lecture du titre 230 : CALL LIRCHA(TITRE,1,IRETOU) 231 : IF (IERR.NE.0) RETURN 232 : GOTO 500 233 : ELSEIF (IMOT.EQ.2) THEN 234 : C lecture de l'attribut de nature 234 : CALL LIRMOT(ADDI,3,ATTRI(1),1) 235 : IF (IERR .NE. 0) RETURN 236 : NAT = MAX(1,NAT) 237 : ATTRI(1) = ATTRI(1) - 1 238 : GOTO 500 239 : ENDIF 240 : C 241 : C CREATION DU CHPO 242 : C 243 : SEGDES MPOVAL,MSOUPO 244 : NSOUPO = 1 245 : SEGINI MCHPOI 246 : MOCHDE = TITRE 247 : MTYPOI = ' ' 248 : DO 1000 I=1,NAT 249 : JATTRI(I) = ATTRI(I) 250 : 1000 CONTINUE 251 : IFOPOI = IFOMOD 252 : IPCHP(1)= MSOUPO 253 : SEGDES MCHPOI 254 : 254 : CALL ECROBJ('CHPOINT',MCHPOI) 255 : RETURN 256 : C 257 : END 258 : 259 : 260 : 261 : 262 :
© Cast3M 2003 - All rights reserved.
Disclaimer