1 : C LEKCOF SOURCE PV 13/04/16 21:15:18 7765 2 : SUBROUTINE LEKCOF(TITRE,MTABX,KINC,NU,IXV, 3 : & MCHPOI,MPOVAL,NPT,NC,IK1,IRET) 4 : C---------------------------------------------------------------------- 5 : C Ce sous programme lit le NUième coefficient d'un operateur, stocké 6 : C à l'indice ARGnu de la table KIZX de pointeur MTABX associée à 7 : C l'opérateur en cours de traitement. 8 : C Le coefficient est de type ENTIER, FLOTTANT, POINT, CHPOINT ou MOT. 9 : C---------------------------------------------------------------------- 10 : C Quel que soit le type de l'objet récupéré, l'objet retourné est un 11 : C CHPOINT. Ce CHPO s'appuie sur un point bidon dans le cas ou la donnée 12 : C est un ENTIER, un FLOTTANT ou un POINT. 13 : C---------------------------------------------------------------------- 14 : C HISTORIQUE : 20/09/00 : Les segments MPOVAL sont retournes actif en 15 : C lecture seule. 16 : C HISTORIQUE : 17 : C 18 : C 19 : C--------------------------- 20 : C Paramètres Entrée/Sortie : 21 : C--------------------------- 22 : C 23 : C E/ TITRE : Commentaires pour les messages d'erreur (à supprimer) 24 : C E/ MTABX : Pointeur de la table contenant le coefficient 25 : C E/ KINC : Pointeur de la table INCO dans laquelle on va chercher 26 : C les valeurs des indices lorsque ceux-ci sont des MOTS. 27 : C E/ NU : Rang du coefficient a aller chercher (ENTIER) 28 : C E/ IXV(*) : Vecteur d'entier indiquant le type de l'objet cherché 29 : C IXV(1) = 0 : Objet CHPO non autorisé 30 : C IXV(1) > 0 : spg du CHPO si une composante (SCAL) 31 : C IXV(1) < 0 : spg du CHPO si IDIM composante (VECT) 32 : C IXV(2) = 0 : Objet FLOTTANT ou ENTIER non autorisé in 33 : C IXV(2) = 1 : Objet FLOTTANT ou ENTIER autorisé 34 : C IXV(3) = 0 : Objet POINT non autorisé 35 : C IXV(3) = 1 : Objet POINT autorisé 36 : C IXV(i),i>3 : Autres spg pour CHPO (similaire à IXV(1)) 37 : C cf IRET 38 : C /S MCHPOI : Pointeur du CHPO contenant le coef 39 : C /S MPOVAL : Pointeur sur le segment du CHPO contenant les coef 40 : C /S NPT : Nombre de point du spg du CHPO 41 : C /S NC : Nombre de composante du CHPO 42 : C (on autorise 1 ou IDIM) 43 : C /S IK1 : Indicateur retournant le type de l'objet trouvé 44 : C 0=CHPO 1=FLOTTANT 2=POINT >3=CHPO de spg IXV(ik1) 45 : C Dans le cas ou IK1=1 ou 2 la donnée est transformée 46 : C en CHPO et stocké à l'indice ARGSnu de la table MTABX 47 : C E/S IRET : En entrée, =0 tentative de lecture seule 48 : C : En entrée, =1 Si l'objet n existe pas on le cree 49 : C si CHPOIN autorise et on le met dans la table inco 50 : C Dans ce cas en sortie IRET=2 (ceci ne marche 51 : C que si dime de IXV<=3 52 : C : En entrée, si supérieur à 3 dimension de IXV, 53 : C En sortie, indicateur de succès (0=problèmes, 1=OK , 54 : C 2 si creation aveugle) 55 : C---------------------------------------------------------------------- 56 : C Dans le cas ENTIER, FLOTTANT ou POINT, on construit un CHPOINT 57 : C que l'on stocke à l'indice ARGSnu de la table MTABX. 58 : C Dans le cas MOT, on récupère la donnée se trouvant à l'indice MOT 59 : C de la table INCO que l'on transforme éventuellement en CHPOINT comme 60 : C precedemment. 61 : C---------------------------------------------------------------------- 62 : IMPLICIT INTEGER(I-N) 63 : IMPLICIT REAL*8 (A-H,O-Z) 64 : -INC CCOPTIO 65 : -INC SMCOORD 66 : -INC SMCHPOI 67 : -INC SMELEME 68 : -INC SMTABLE 69 : POINTEUR igeom.meleme 70 : POINTEUR MTABX.MTABLE,KINC.MTABLE 71 : CHARACTER*(*) TITRE 72 : CHARACTER*8 TYPE,TYPC,NOM,MARG,NARG,TYPI 73 : LOGICAL LOGI 74 : REAL*8 XVAL(3) 75 : DIMENSION IXV(*) 76 : C 77 : C- Récupération du TYPE du NUième argument de l'opérateur 78 : C 79 : C write(6,*)' DEBUT LEKCOF' 80 : IXV1 = IRET 81 : ISG1 = 1 82 : IRET = 1 83 : IF (NU.LE.0 .OR. NU.GE.100) THEN 84 : INTERR(1) = NU 85 : INTERR(2) = 1 86 : INTERR(3) = 99 86 : CALL ERREUR(789) 87 : IRET = 0 88 : RETURN 89 : ENDIF 90 : IF (NU.LE.9) THEN 91 : WRITE(NARG,FMT='(A3,I1)')'ARG',Nu 92 : WRITE(MARG,FMT='(A4,I1)')'ARGS',Nu 93 : ELSE 94 : WRITE(NARG,FMT='(A3,I2)')'ARG',Nu 95 : WRITE(MARG,FMT='(A4,I2)')'ARGS',Nu 96 : ENDIF 97 : TYPE = ' ' 97 : CALL LENCHA(NARG,LC) 97 : CALL ACCTAB(MTABX,'MOT', 0,0.D0,NARG(1:LC),LOGI, 0, 98 : & TYPE ,IENT,XVAL, NOM,LOGI,MCHPOI) 99 : C 100 : C- Argument de TYPE ENTIER ou FLOTTANT 101 : C 102 : IF (TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER') THEN 103 : IF (IXV(2).EQ.0) THEN 104 : MOTERR(1: 8) = NARG 105 : MOTERR(9:16) = TYPE 105 : CALL ERREUR(787) 106 : IRET = 0 107 : RETURN 108 : ENDIF 109 : IF (TYPE.EQ.'ENTIER') XVAL(1)=FLOAT(IENT) 110 : C creation d'un champoin 111 : NBNN=1 112 : NBELEM=1 113 : NBSOUS=0 114 : NBREF=0 115 : SEGINI MELEME 116 : ITYPEL=1 117 : NUM(1,1)=1 118 : SEGDES MELEME 119 : 120 : NSOUPO=1 121 : NAT=1 122 : N=1 123 : NC=1 124 : SEGINI MCHPOI,MSOUPO,MPOVAL 125 : JATTRI(1)=2 126 : IFOPOI=IFOMOD 127 : MTYPOI=' ' 128 : MOCHDE=' ' 129 : IPCHP(1)=MSOUPO 130 : IPOVAL=MPOVAL 131 : NOCOMP(1)='SCAL' 132 : SEGDES MCHPOI,MSOUPO 133 : C creation d'un champoin fin 134 : 135 : VPOCHA(1,1)=XVAL(1) 136 : IK1 = 1 137 : NPT = 1 138 : NC = 1 139 : C 140 : C- Argument de type CHPOINT 141 : C 142 : ELSEIF (TYPE.EQ.'CHPOINT') THEN 143 : IF (IXV(1).EQ.0) THEN 144 : MOTERR(1: 8) = NARG 145 : MOTERR(9:16) = TYPE 145 : CALL ERREUR(787) 146 : IRET = 0 147 : RETURN 148 : ENDIF 148 : CALL LRCHT(MCHPOI,MPOVAL,TYPC,IGEOM) 149 : 150 : NC=VPOCHA(/2) 151 : MELEME = IXV(1) 152 : IF (MELEME.LT.0) THEN 153 : MELEME= -IXV(1) 154 : ISG1 = -1 155 : ENDIF 156 : IF (IGEOM.NE.MELEME) THEN 157 : * write (6,*) ' lekcof 1-1 ',igeom,meleme 158 : segact igeom,meleme 159 : igeom0=abs(igeom) 159 : call crech1(igeom,0) 159 : call crech1(meleme,0) 160 : endif 161 : * write (6,*) ' lekcof 1-2 ',igeom,meleme 162 : IF (IGEOM.NE.MELEME) THEN 163 : IF (IXV1.GT.3) THEN 164 : IXV2 = IXV1 - 3 165 : I = 0 166 : 10 CONTINUE 167 : I = I + 1 168 : IF(NC.GT.1)THEN 169 : IGEOM=-ABS(IGEOM) 170 : ISG1=-1 171 : ENDIF 172 : IF (IGEOM0.EQ.IXV(I+3)) THEN 173 : IK1=I+3 174 : GOTO 20 175 : ENDIF 176 : IF (I.LT.IXV2) GOTO 10 177 : ENDIF 178 : MOTERR(1: 8) = NARG 179 : MOTERR(9:16) = TYPE 179 : CALL ERREUR(788) 180 : IRET = 0 181 : RETURN 182 : ELSE 183 : IK1 = 0 184 : ENDIF 185 : 20 CONTINUE 186 : NPT = VPOCHA(/1) 187 : NC = VPOCHA(/2) 188 : IF ( (ISG1.EQ.-1.AND.NC.NE.IDIM) .OR. 189 : & (ISG1.EQ.1.AND.NC.NE.1) ) THEN 190 : MOTERR(1: 8) = NARG 191 : MOTERR(9:16) = TYPE 191 : CALL ERREUR(784) 192 : IRET = 0 193 : RETURN 194 : ENDIF 195 : C 196 : C- Argument de type POINT 197 : C 198 : ELSEIF (TYPE.EQ.'POINT') THEN 199 : IF (IXV(3).EQ.0)THEN 200 : MOTERR(1: 8) = NARG 201 : MOTERR(9:16) = TYPE 201 : CALL ERREUR(787) 202 : IRET = 0 203 : RETURN 204 : ENDIF 205 : IP = MCHPOI 206 : XVAL(1) = XCOOR((IP-1)*(IDIM+1) +1) 207 : XVAL(2) = XCOOR((IP-1)*(IDIM+1) +2) 208 : IF (IDIM.EQ.3) XVAL(3)=XCOOR((IP-1)*(IDIM+1) +3) 209 : IK1 = 2 210 : NPT = 1 211 : 212 : C creation d'un champoin 213 : NBNN=1 214 : NBELEM=1 215 : NBSOUS=0 216 : NBREF=0 217 : SEGINI MELEME 218 : ITYPEL=1 219 : NUM(1,1)=1 220 : SEGDES MELEME 221 : 222 : NSOUPO=1 223 : NAT=1 224 : N=1 225 : NC=IDIM 226 : SEGINI MCHPOI,MSOUPO,MPOVAL 227 : JATTRI(1)=2 228 : IFOPOI=IFOMOD 229 : MTYPOI=' ' 230 : MOCHDE=' ' 231 : IPCHP(1)=MSOUPO 232 : IPOVAL=MPOVAL 233 : NOCOMP(1)='SCAL' 234 : SEGDES MCHPOI,MSOUPO 235 : C creation d'un champoin fin 236 : 237 : VPOCHA(1,1) = XVAL(1) 238 : VPOCHA(1,2) = XVAL(2) 239 : IF (IDIM.EQ.3) VPOCHA(1,3)=XVAL(3) 240 : C 241 : C- Argument de type MOT 242 : C- 243 : C- TYPC : TYPE de l'objet rangé à l'indice MOT de la table KINC. 244 : C- On considère à nouveau les cas ENTIER, FLOTTANT, POINT ou CHPO 245 : C- que l'on traite de la meme facon que ci-dessus. 246 : C 247 : ELSEIF(TYPE.EQ.'MOT')THEN 248 : IF (KINC.EQ.0) THEN 249 : MOTERR(1: 8) = NARG 250 : MOTERR(9:16) = 'INCO ' 250 : CALL ERREUR(785) 251 : IRET = 0 252 : RETURN 253 : ENDIF 254 : TYPC = ' ' 254 : CALL ACMO(KINC,NOM,TYPC,MCHPOI) 255 : IF (TYPC.EQ.'CHPOINT ') THEN 256 : IF (IXV(1).EQ.0) THEN 257 : MOTERR(1: 8) = NARG 258 : MOTERR(9:16) = TYPC 258 : CALL ERREUR(787) 259 : IRET = 0 260 : RETURN 261 : ENDIF 262 : MELEME = IXV(1) 263 : IF (MELEME.LT.0) THEN 264 : MELEME= -IXV(1) 265 : ISG1 = -1 266 : ENDIF 266 : CALL LRCHT(MCHPOI,MPOVAL,TYPE,IGEOM) 267 : NC=VPOCHA(/2) 268 : IF (IGEOM.NE.MELEME) THEN 269 : * write (6,*) ' lekcof 2-1 ',igeom,meleme 270 : segact igeom,meleme 271 : igeomo=abs(igeom) 271 : * call ecmail(igeom,1) 271 : * call ecmail(meleme,1) 272 : * segact igeom,meleme 272 : call crech1(igeom,0) 272 : call crech1(meleme,0) 273 : endif 274 : IF (IGEOM.NE.MELEME) THEN 275 : * write (6,*) ' lekcof 2-2 ',igeom,meleme,ixv1 276 : IF (IXV1.GT.3) THEN 277 : IXV2 = IXV1 - 3 278 : I = 0 279 : 100 CONTINUE 280 : I = I + 1 281 : IF(NC.GT.1)THEN 282 : IGEOM=-ABS(IGEOM) 283 : ISG1=-1 284 : ENDIF 285 : IF (IGEOMO.EQ.IXV(I+3)) THEN 286 : IK1=I+3 287 : GOTO 110 288 : ENDIF 289 : IF (I.LT.IXV2) GOTO 100 290 : ENDIF 291 : MOTERR(1: 8) = NARG 292 : MOTERR(9:16) = TYPC 292 : CALL ERREUR(788) 293 : IRET = 0 294 : RETURN 295 : ELSE 296 : IK1 = 0 297 : ENDIF 298 : 110 CONTINUE 299 : NPT = VPOCHA(/1) 300 : NC = VPOCHA(/2) 301 : IF ( (ISG1.EQ.-1.AND.NC.NE.IDIM) .OR. 302 : & (ISG1.EQ.1.AND.NC.NE.1) ) THEN 303 : MOTERR(1: 8) = NARG 304 : MOTERR(9:16) = TYPC 304 : CALL ERREUR(784) 305 : IRET = 0 306 : RETURN 307 : ENDIF 308 : ELSEIF (TYPC.EQ.'FLOTTANT') THEN 309 : IF (IXV(2).EQ.0) THEN 310 : MOTERR(1: 8) = NARG 311 : MOTERR(9:16) = TYPC 311 : CALL ERREUR(787) 312 : IRET = 0 313 : RETURN 314 : ENDIF 314 : CALL ACMF(KINC,NOM,XVAL) 315 : IK1 = 1 316 : 317 : C creation d'un champoin 318 : NBNN=1 319 : NBELEM=1 320 : NBSOUS=0 321 : NBREF=0 322 : SEGINI MELEME 323 : ITYPEL=1 324 : NUM(1,1)=1 325 : SEGDES MELEME 326 : 327 : NSOUPO=1 328 : NAT=1 329 : N=1 330 : NC=1 331 : SEGINI MCHPOI,MSOUPO,MPOVAL 332 : JATTRI(1)=2 333 : IFOPOI=IFOMOD 334 : MTYPOI=' ' 335 : MOCHDE=' ' 336 : IPCHP(1)=MSOUPO 337 : IPOVAL=MPOVAL 338 : NOCOMP(1)='SCAL' 339 : SEGDES MCHPOI,MSOUPO 340 : C creation d'un champoin fin 341 : 342 : VPOCHA(1,1) = XVAL(1) 343 : NPT = 1 344 : NC = 1 345 : ELSEIF (TYPC.EQ.'ENTIER') THEN 346 : IF (IXV(2).EQ.0) THEN 347 : MOTERR(1: 8) = NARG 348 : MOTERR(9:16) = TYPC 348 : CALL ERREUR(787) 349 : IRET = 0 350 : RETURN 351 : ENDIF 351 : CALL ACME(KINC,NOM,IENT) 352 : XVAL(1) = FLOAT(IENT) 353 : 354 : C creation d'un champoin 355 : NBNN=1 356 : NBELEM=1 357 : NBSOUS=0 358 : NBREF=0 359 : SEGINI MELEME 360 : ITYPEL=1 361 : NUM(1,1)=1 362 : SEGDES MELEME 363 : 364 : NSOUPO=1 365 : NAT=1 366 : N=1 367 : NC=1 368 : SEGINI MCHPOI,MSOUPO,MPOVAL 369 : JATTRI(1)=2 370 : IFOPOI=IFOMOD 371 : MTYPOI=' ' 372 : MOCHDE=' ' 373 : IPCHP(1)=MSOUPO 374 : IPOVAL=MPOVAL 375 : NOCOMP(1)='SCAL' 376 : SEGDES MCHPOI,MSOUPO 377 : C creation d'un champoin fin 378 : 379 : VPOCHA(1,1) = XVAL(1) 380 : IK1 = 1 381 : NPT = 1 382 : NC = 1 383 : ELSEIF (TYPC.EQ.'POINT') THEN 384 : IF (IXV(3).EQ.0) THEN 385 : MOTERR(1: 8) = NARG 386 : MOTERR(9:16) = TYPC 386 : CALL ERREUR(787) 387 : IRET = 0 388 : RETURN 389 : ENDIF 390 : IP = MCHPOI 391 : XVAL(1) = XCOOR((IP-1)*(IDIM+1) +1) 392 : XVAL(2) = XCOOR((IP-1)*(IDIM+1) +2) 393 : IF (IDIM.EQ.3) XVAL(3)=XCOOR((IP-1)*(IDIM+1) +3) 394 : 395 : C creation d'un champoin 396 : NBNN=1 397 : NBELEM=1 398 : NBSOUS=0 399 : NBREF=0 400 : SEGINI MELEME 401 : ITYPEL=1 402 : NUM(1,1)=1 403 : SEGDES MELEME 404 : 405 : NSOUPO=1 406 : NAT=1 407 : N=1 408 : NC=IDIM 409 : SEGINI MCHPOI,MSOUPO,MPOVAL 410 : JATTRI(1)=2 411 : IFOPOI=IFOMOD 412 : MTYPOI=' ' 413 : MOCHDE=' ' 414 : IPCHP(1)=MSOUPO 415 : IPOVAL=MPOVAL 416 : NOCOMP(1)='SCAL' 417 : SEGDES MCHPOI,MSOUPO 418 : C creation d'un champoin fin 419 : 420 : VPOCHA(1,1) = XVAL(1) 421 : VPOCHA(1,2) = XVAL(2) 422 : IF (IDIM.EQ.3) VPOCHA(1,3)=XVAL(3) 423 : IK1 = 2 424 : NPT = 1 425 : ELSE 426 : IF(IXV1.EQ.1)THEN 427 : IF(IXV(1).GT.0)THEN 428 : NC=1 429 : IGEOM=IXV(1) 430 : TYPI='LEKCOF' 431 : TYPC='CHPOINT' 431 : CALL CRCHPT(TYPI,IGEOM,NC,MCHPOI) 431 : CALL ECMO(KINC,NOM,TYPC,MCHPOI) 431 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM0) 432 : IRET=2 433 : RETURN 434 : ELSEIF(IXV(1).LT.0)THEN 435 : NC=IDIM 436 : IGEOM=-IXV(1) 437 : TYPI='LEKCOF' 438 : TYPC='CHPOINT' 438 : CALL CRCHPT(TYPI,IGEOM,NC,MCHPOI) 438 : CALL ECMO(KINC,NOM,TYPC,MCHPOI) 438 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM0) 439 : IRET=2 440 : RETURN 441 : ENDIF 442 : ENDIF 443 : 444 : IF (MCHPOI.EQ.0) THEN 445 : MOTERR( 1: 8) = NARG 446 : MOTERR( 9:16) = NOM 447 : MOTERR(17:24) = 'INCO ' 447 : CALL ERREUR(786) 448 : ELSE 449 : MOTERR(1: 8) = NARG 450 : MOTERR(9:16) = TYPC 450 : CALL ERREUR(787) 451 : ENDIF 452 : IRET = 0 453 : RETURN 454 : ENDIF 455 : C 456 : C- Argument de type autre que ENTIER, FLOTTANT, POINT, CHPO ou MOT 457 : C 458 : ELSE 459 : MOTERR(1: 8) = NARG 460 : MOTERR(9:16) = TYPE 460 : CALL ERREUR(787) 461 : IRET = 0 462 : RETURN 463 : ENDIF 464 : C 465 : RETURN 466 : END 467 : 468 : 469 : 470 : 471 : 472 : 473 :
© Cast3M 2003 - All rights reserved.
Disclaimer