1 : C ONDE SOURCE CHAT 07/10/29 21:25:11 5940 2 : C 3 : SUBROUTINE ONDE 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-V) 6 : IMPLICIT COMPLEX*16 (W-Z) 7 : CHARACTER *72 TI 8 : CHARACTER *24 MOTY 9 : CHARACTER *4 NSORT(4),MCLE(5) 10 : LOGICAL INV,IABS,ICRO 11 : C 12 : C======================================================================= 13 : C = CALCUL DE LA TRANSFORMEE EN ONDELETTE CONTINUE D'UN SIGNAL = 14 : C = = 15 : C = SYNTAXE : = 16 : C = = 17 : C = TRANSFORMEE DE FOURIER DIRECTE = 18 : C = = 19 : C = EVO = 'ONDE' EVO1 EXP2 SORT 'FMIN' V1 'FMAX' V2 ( 'NFRQ' V3 ) = 20 : C = ( 'PULS' V4 ) ( 'EPSI' V5 ) = 21 : C = OU = 22 : C = CHP1 MAIL1 = 'ONDE' EVO1 EXP2 SORT 'FMIN' V1 'FMAX' V2 = 23 : C = ( 'NFRQ' V3 ) ( 'PULS' V4 ) = 24 : C = = 25 : C = EXP2 : EXPOSANT DANS NPOINT=2^EXP2, NPOINT ETANT = 26 : C = LE NOMBRE DE REELS DANS LISTREEL = 27 : C = EVO1 : OBJET DE TYPE EVOLUTIO CONTENANT LE SIGNAL A TRAITER= 28 : C = SORT : TYPE DE SORTIE ; = 29 : C = = 'CRMO' EXTRACTION CRETE SUR CRITERE MODULE = 30 : C = ( PAR DEFAUT ) = 31 : C = = 'CRPH' EXTRACTION CRETE SUR CRITERE PHASE = 32 : C = = 'REIM' PART REEL & PART IMAG = 33 : C = = 'MOPH' MODULE & PHASE = 34 : C = V1 : FREQUENCE MINI A VISUALISER = 35 : C = V2 : FREQUENCE MAXI A VISUALISER = 36 : C = V3 : NOMBRE DE PAS EN FREQUENCE = 37 : C = V4 : PULSATION ONDELETTE MERE = 38 : C = V5 : CRITERE DE NULLITE = 39 : C = COU1 : COULEUR ATTRIBUEE A LA PREMIERE COURBE (FACULTATIF) = 40 : C = COU2 : COULEUR ATTRIBUEE A LA DEUXIEME COURBE (FACULTATIF) = 41 : C = = 42 : C = = 43 : C======================================================================= 44 : C 45 : -INC CCREEL 46 : -INC CCGEOME 47 : -INC CCOPTIO 48 : -INC SMEVOLL 49 : -INC SMLREEL 50 : -INC SMCHPOI 51 : -INC SMELEME 52 : -INC SMCOORD 53 : C 54 : SEGMENT MTRAV1 55 : IMPLIED XX(NCOU),YY(NCOU),WOND(NCOU),WONC(NCOU) 56 : IMPLIED YY1(NCOU),YY2(NCOU),VM(NCOU),VP(NCOU) 57 : IMPLIED VDP(NCOU),VPL(NCOU) 58 : ENDSEGMENT 59 : C 60 : SEGMENT MTRAV2 61 : IMPLIED W(NEXP) 62 : ENDSEGMENT 63 : 64 : SEGMENT MTRAV3 65 : IMPLIED VML((NA+1)*NCOU),VML2((NA+1)*NCOU) 66 : IMPLIED ICP1((NA+1)*NCOU) 67 : ENDSEGMENT 68 : C 69 : DATA NSORT(1),NSORT(2),NSORT(3)/'CRMO','CRPH','REIM'/ 70 : DATA NSORT(4)/'MOPH'/ 71 : DATA MCLE(1),MCLE(2),MCLE(3),MCLE(4)/'FMIN','FMAX','NFRQ','EPSI'/ 72 : DATA MCLE(5)/'PULS'/ 73 : C 74 : C LECTURE DE EXP2 75 : C 76 : 76 : CALL LIRENT(N2,1,IRET1) 77 : IF(IRET1.EQ.0)GOTO 666 78 : C 79 : C LECTURE DE L'OBJET EVOLUTIO CONTENANT LE SIGNAL 80 : C 80 : CALL LIROBJ('EVOLUTIO',IPSIG,1,IRET2) 81 : IF(IRET2.EQ.0)GOTO 666 82 : C 83 : C LECTURE DU TYPE DE SORTIE 84 : C 84 : CALL LIRMOT(NSORT,4,ISORT,0) 85 : IF(ISORT.EQ.0) ISORT=1 86 : C 87 : C LECTURE DE LA FREQUENCE MINIE 88 : C 88 : CALL LIRMOT(MCLE(1),1,IRET,0) 89 : IF(IRET.EQ.1) THEN 89 : CALL LIRREE(FRMI,0,IRET1) 90 : IF(IRET1.EQ.0) THEN 91 : MOTERR(1:4)=MCLE(1)(1:4) 91 : CALL ERREUR(166) 92 : GOTO 666 93 : ENDIF 94 : IF(FRMI.LT.(-1.D-20)) FRMI=-FRMI 95 : IF(ABS(FRMI).LT.1.D-20) FRMA=-1.D0 96 : ELSE 97 : FRMI=-1.D0 98 : ENDIF 99 : C 100 : C LECTURE DE LA FREQUENCE MAXIE 101 : C 101 : CALL LIRMOT(MCLE(2),1,IRET,0) 102 : IF(IRET.EQ.1) THEN 102 : CALL LIRREE(FRMA,0,IRET1) 103 : IF(IRET1.EQ.0) THEN 104 : MOTERR(1:4)=MCLE(2)(1:4) 104 : CALL ERREUR(166) 105 : GOTO 666 106 : ENDIF 107 : IF(FRMA.LT.(-1.D-20)) FRMA=-FRMA 108 : IF(ABS(FRMA).LT.1.D-20) FRMA=-1.D0 109 : ELSE 110 : FRMA=-1.D0 111 : ENDIF 112 : C 113 : C LECTURE DU NOMBRE DE DIVISION EN FREQUENCE 114 : C 114 : CALL LIRMOT(MCLE(3),1,IRET,0) 115 : IF(IRET.EQ.1) THEN 115 : CALL LIRENT(NA,0,IRET1) 116 : IF(IRET1.EQ.0) THEN 117 : MOTERR(1:4)=MCLE(3)(1:4) 117 : CALL ERREUR(166) 118 : GOTO 666 119 : ENDIF 120 : ELSE 121 : NA=100 122 : ENDIF 123 : C 124 : C LECTURE DU CRITERE 125 : C 125 : CALL LIRMOT(MCLE(4),1,IRET,0) 126 : IF(IRET.EQ.1) THEN 126 : CALL LIRREE(EPSI,0,IRET1) 127 : IF(IRET1.EQ.0) THEN 128 : MOTERR(1:4)=MCLE(4)(1:4) 128 : CALL ERREUR(166) 129 : GOTO 666 130 : ENDIF 131 : ELSE 132 : EPSI=1.D-4 133 : ENDIF 134 : C 135 : C LECTURE DE LA FREQUENCE ONDELETTE 136 : C 136 : CALL LIRMOT(MCLE(5),1,IRET,0) 137 : IF(IRET.EQ.1) THEN 137 : CALL LIRREE(V0,0,IRET1) 138 : IF(IRET1.EQ.0) THEN 139 : MOTERR(1:4)=MCLE(5)(1:4) 139 : CALL ERREUR(166) 140 : GOTO 666 141 : ENDIF 142 : ELSE 143 : V0=5.D0 144 : ENDIF 145 : C 146 : C LECTURE DE LA COULEUR 147 : C 147 : CALL LIRMOT(NCOUL,NBCOUL,ICOU1,0) 148 : IF(ICOU1.EQ.0) ICOU1=IDCOUL+1 149 : ICOU1=ICOU1-1 149 : CALL LIRMOT(NCOUL,NBCOUL,ICOU2,0) 150 : IF(ICOU2.EQ.0) ICOU2=IDCOUL+1 151 : ICOU2=ICOU2-1 152 : C 153 : IF(IERR.NE.0) GOTO 666 154 : C 155 : MEVOL1=IPSIG 156 : SEGACT MEVOL1 157 : KEVOL1=MEVOL1.IEVOLL(1) 158 : SEGACT KEVOL1 159 : MLREE1=KEVOL1.IPROGX 160 : MLREE2=KEVOL1.IPROGY 161 : C 162 : SEGACT MLREE1,MLREE2 163 : L1=MLREE1.PROG(/1) 164 : DT=MLREE1.PROG(2)-MLREE1.PROG(1) 165 : TDEB=MLREE1.PROG(1) 166 : SEGDES MLREE1 167 : C 168 : NPOINT=2**N2 169 : IF(NPOINT.GT.L1) THEN 170 : IF(IIMPI.EQ.1) WRITE(IOIMP,1000) L1,N2,NPOINT 171 : 1000 FORMAT(1H ,'LE NOMBRE DE POINTS DANS LISTEMPS ',I6, ' EST ', 172 : & 'INFERIEURE @ 2**',I5, 173 : & /' ON PRENDRA UNE LONGUEUR DE LISTEMPS DE ',I6 174 : $ ,' MOTS ',/' ET ON COMPLETERA PAR DES ZEROS') 175 : ELSE 176 : IF(NPOINT.LT.L1) THEN 177 : IF(IIMPI.EQ.1) WRITE(IOIMP,1010) N2 178 : 1010 FORMAT(1H ,'ON TRONQUE LE SIGNAL A 2**',I5,' MOTS',/) 179 : ELSE 180 : IF(IIMPI.EQ.1) WRITE(IOIMP,1030)N2,NPOINT 181 : 1030 FORMAT(1H ,'LA LONGUEUR DU LISTEMP EST EGALE A 2**',I5, 182 : & ' = ',I6,/) 183 : ENDIF 184 : ENDIF 185 : TFIN=TDEB+(NPOINT*DT) 186 : C 187 : NCOU=NPOINT 188 : SEGINI MTRAV1 189 : C 190 : NEXP=NPOINT/2 191 : SEGINI MTRAV2 192 : 193 : SEGINI MTRAV3 194 : C 195 : C CHARGEMENT DES TABLEAUX DE TRAVAIL 196 : C 197 : IND1=L1 198 : IF(NPOINT.LT.L1)IND1 = NPOINT 199 : DO 1100 I=1,IND1 200 : XX(I)=MLREE2.PROG(I) 201 : C IF(IIMPI.EQ.1)WRITE(IOIMP,*) ' XX(',I,') = ',XX(I) 202 : 1100 CONTINUE 203 : IF(NPOINT.GT.L1) THEN 204 : L2=L1+1 205 : DO 1110 I=L2,NPOINT 206 : XX(I)=0.D0 207 : 1110 CONTINUE 208 : ENDIF 209 : 210 : DUREE=DT*DBLE(NPOINT) 211 : DFREQ=1.D0/DUREE 212 : KHALF=INT(NPOINT/2)+1 213 : KDEBU=1 214 : NNN=KHALF-KDEBU+1 215 : JG=NNN 216 : C 217 : C CALCUL DE LA FFT 218 : C 219 : IF(IIMPI.EQ.1) WRITE(IOIMP,*)' CALCUL DE LA FFT DU SIGNAL ' 220 : C 221 : C================= CALCUL TFR FONCTION F(T) ============= 222 : C 223 : C 224 : INV=.FALSE. 224 : CALL WEXP(INV,NPOINT,W(1)) 224 : CALL FFTL(XX(1),YY(1),W(1),NPOINT) 225 : SEGDES MLREE2 226 : 227 : C 228 : C======================================================== 229 : C 230 : 231 : AMIN=V0/2.D0/XPI/FRMA 232 : AMAX=V0/2.D0/XPI/FRMI 233 : NPO=NPOINT*(NA+1) 234 : 235 : GOTO(1999,2999,4199,4199),ISORT 236 : RETURN 237 : 238 : C 239 : C CRITERE SUR LE MODULE 240 : C 241 : 1999 SEGINI MLREE1 242 : SEGINI MLREE2 243 : SEGINI MLREE3 244 : JG=0 245 : SEGADJ MLREE1 246 : K=1 247 : 248 : 249 : C================ BOUCLE SUR LES FREQUENCES ================= 250 : C 251 : DO 2000 I=0,NA 252 : A=AMIN+((AMAX-AMIN)*I/NA) 253 : V=V0/A 254 : 255 : C PRODUIT ONDELETTE TFR SIGNAL 256 : 257 : DO 1200 J=1,KHALF 258 : VJ=DBLE(J-1)*DFREQ*2.D0*XPI*A 259 : V2=(VJ-V0)**2.D0 260 : PM=EXP(-0.5D0*V2)*((2.D0*XPI)**0.5D0) 261 : WOND(J)=PM*XX(J) 262 : 1200 CONTINUE 263 : 264 : J=NPOINT+1 265 : KK=1 266 : L11=KHALF-1 267 : DO 1205 II=2,L11 268 : KK=KK+1 269 : J=J-1 270 : VJ=DBLE(J-1-NPOINT)*DFREQ*2.D0*XPI*A 271 : V2=(VJ-V0)**2.D0 272 : PM=EXP(-0.5D0*V2)*((2.D0*XPI)**0.5D0) 273 : WOND(J)=CONJG(XX(KK))*PM 274 : 275 : 1205 CONTINUE 276 : 277 : 278 : C 279 : C================= CALCUL TFR INVERSE ============= 280 : C 281 : C 282 : INV=.TRUE. 282 : CALL WEXP(INV,NPOINT,W(1)) 282 : CALL FFTL(WOND(1),YY1(1),W(1),NPOINT) 283 : C 284 : C======================================================== 285 : DO 1210 J=1,NPOINT 286 : R1=WOND(J) 287 : R2=CXTOIM(WOND(J))*(-1.D0) 288 : RT=SQRT(R1*R1+R2*R2) 289 : VML((I*NPOINT)+J)=RT/(DBLE(NPOINT)) 290 : 1210 CONTINUE 291 : 292 : 2000 CONTINUE 293 : 294 : 295 : C RECHERCHE CRETE 296 : 297 : JN=INT(((2.D0*AMAX)-TDEB)/DT-1.D0) 298 : JX=INT((TFIN-(2.D0*AMAX)-TDEB)/DT-1.D0) 299 : DO 2500 J=JN,JX 300 : VP=-1.D0 301 : DO 2100 I=0,NA 302 : A=AMIN+((AMAX-AMIN)*I/NA) 303 : V=V0/A 304 : TCOU=TDEB+(DT*DBLE(J-1)) 305 : VMIJ=VML((I*NPOINT)+J)/((XPI/2.D0)**0.5D0) 306 : IF(VMIJ.GT.VP) THEN 307 : VP=VMIJ 308 : VF=V/2.D0/XPI 309 : ENDIF 310 : 2100 CONTINUE 311 : IF(VP.GT.0) THEN 312 : JG=K 313 : SEGADJ MLREE1 314 : SEGADJ MLREE2 315 : SEGADJ MLREE3 316 : MLREE3.PROG(K)=VP 317 : MLREE2.PROG(K)=VF 318 : MLREE1.PROG(K)=TCOU 319 : K=K+1 320 : ENDIF 321 : 2500 CONTINUE 322 : 2501 GOTO 4001 323 : 324 : C 325 : C CRITERE SUR LA PHASE 326 : C 327 : 328 : 2999 SEGINI MLREE1 329 : SEGINI MLREE2 330 : SEGINI MLREE3 331 : JG=0 332 : SEGADJ MLREE1 333 : K=1 334 : 335 : C 336 : C================ BOUCLE SUR LES FREQUENCES ================= 337 : C 338 : DO 4000 I=0,NA 339 : A=AMIN+((AMAX-AMIN)*I/NA) 340 : V=V0/A 341 : 342 : C PRODUIT ONDELETTE TFR SIGNAL 343 : 344 : DO 3200 J=1,KHALF 345 : VJ=DBLE(J-1)*DFREQ*2.D0*XPI*A 346 : V2=(VJ-V0)**2.D0 347 : PM=EXP(-0.5D0*V2)*((2.D0*XPI)**0.5D0) 348 : WOND(J)=PM*XX(J) 349 : 3200 CONTINUE 350 : 351 : J=NPOINT+1 352 : KK=1 353 : L11=KHALF-1 354 : DO 3205 II=2,L11 355 : KK=KK+1 356 : J=J-1 357 : VJ=DBLE(J-1-NPOINT)*DFREQ*2.D0*XPI*A 358 : V2=(VJ-V0)**2.D0 359 : PM=EXP(-0.5D0*V2)*((2.D0*XPI)**0.5D0) 360 : WOND(J)=CONJG(XX(KK))*PM 361 : 362 : 3205 CONTINUE 363 : 364 : 365 : C 366 : C================= CALCUL TFR INVERSE ============= 367 : C 368 : C 369 : INV=.TRUE. 369 : CALL WEXP(INV,NPOINT,W(1)) 369 : CALL FFTL(WOND(1),YY1(1),W(1),NPOINT) 370 : C 371 : C======================================================== 372 : DO 3210 J=1,NPOINT 373 : R1=WOND(J) 374 : R2=CXTOIM(WOND(J))*(-1.D0) 375 : RT=SQRT(R1*R1+R2*R2) 376 : VM(J)=RT/(DBLE(NPOINT)) 376 : CALL FACOMP(R1,R2,RT) 377 : VP(J)=ATAN2(R2,R1) 378 : VPL(J)=VP(J)+0.D0 379 : 3210 CONTINUE 380 : 381 : 382 : 383 : C================= CALCUL DERIVEE PHASE ============= 384 : 385 : VDP(1)=(VPL(2)-VPL(1))/DT 386 : DO 3220 J=2,(NPOINT-1) 387 : VDP(J)=(VPL(J+1)-VPL(J-1))/2.D0/DT 388 : 3220 CONTINUE 389 : VDP(NPOINT)=(VPL(NPOINT)-VPL(NPOINT-1))/DT 390 : 391 : C CORRECTION 392 : 393 : DO 3230 J=1,NPOINT 394 : DPI=XPI*0.5D0/DT 395 : SPI=DPI*(-1.D0) 396 : IF(VDP(J).GT.DPI) VDP(J)=VDP(J)-(XPI/DT) 397 : IF(VDP(J).LT.SPI) VDP(J)=VDP(J)+(XPI/DT) 398 : VDP(J)=VDP(J)+(V0/A) 399 : 400 : C RECHERCHE CRETE 401 : 402 : AVDP=ABS(VDP(J))-(EPSI*V0/A) 403 : IF(AVDP.LT.0) THEN 404 : FCOU=0.5D0/A 405 : TCOU=TDEB+(DT*DBLE(J-1)) 406 : TFCO=TFIN-(1.D0/FCOU) 407 : TDCO=TDEB+(1.D0/FCOU) 408 : IF(TCOU.GT.TDCO) THEN 409 : IF(TCOU.LT.TFCO) THEN 410 : VMJ=VM(J)/((XPI/2.D0)**0.5D0) 411 : JG=K 412 : SEGADJ MLREE1 413 : SEGADJ MLREE2 414 : SEGADJ MLREE3 415 : MLREE3.PROG(K)=VMJ 416 : MLREE2.PROG(K)=V/2.D0/XPI 417 : MLREE1.PROG(K)=TCOU 418 : K=K+1 419 : ENDIF 420 : ENDIF 421 : ENDIF 422 : 3230 CONTINUE 423 : 424 : 425 : 4000 CONTINUE 426 : 427 : C----------- SORTIES ------------ 428 : 429 : 4001 SEGDES MLREE1,MLREE2,MLREE3 430 : 431 : C 432 : C CREATION DE L'OBJET EVOLUTIO CRETE 433 : C 434 : N=2 435 : SEGINI MEVOLL 436 : IPVO=MEVOLL 437 : TI(1:72)=TITREE 438 : IEVTEX=TI 439 : C 440 : C PREMIERE COURBE 441 : C 442 : SEGINI KEVOLL 443 : TYPX='LISTREEL' 444 : TYPY='LISTREEL' 445 : KEVTEX=TI 446 : IEVOLL(1)=KEVOLL 447 : C 448 : IPROGX=MLREE1 449 : NOMEVX='TEMPS S' 450 : C 451 : IPROGY=MLREE2 452 : NOMEVY='FREQ HZ' 453 : C 454 : NUMEVX=ICOU1 455 : NUMEVY=' ' 456 : 457 : SEGDES KEVOLL 458 : C 459 : C DEUXIEME COURBE 460 : C 461 : SEGINI KEVOLL 462 : TYPX='LISTREEL' 463 : TYPY='LISTREEL' 464 : KEVTEX=TI 465 : IEVOLL(2)=KEVOLL 466 : C 467 : IPROGX=MLREE1 468 : NOMEVX='TEMPS S' 469 : C 470 : IPROGY=MLREE3 471 : NOMEVY='MODULE ' 472 : C 473 : NUMEVX=ICOU2 474 : NUMEVY=' ' 475 : 476 : C 477 : SEGDES KEVOLL 478 : C 479 : SEGSUP MTRAV1,MTRAV2,MTRAV3 480 : SEGDES KEVOL1,MEVOL1 481 : C 482 : SEGDES MEVOLL 482 : CALL ECROBJ('EVOLUTIO',IPVO) 483 : 484 : RETURN 485 : 486 : C=============== CHAMPOINT =========================== 487 : 488 : 489 : 490 : 4199 IF (IDIM.EQ.0) RETURN 491 : NBSOUS=0 492 : NBREF=0 493 : NBELEM=NA*(NPOINT-1) 494 : NBNN=4 495 : SEGINI MELEME 496 : ITYPEL=8 497 : NBPTS=XCOOR(/1)/(IDIM+1) 498 : IDEB=NBPTS 499 : SEGACT MCOORD 500 : 501 : 502 : C 503 : C================ BOUCLE SUR LES FREQUENCES ================= 504 : C 505 : DO 5000 I=0,NA 506 : A=AMIN+((AMAX-AMIN)*I/NA) 507 : V=V0/A 508 : 509 : C PRODUIT ONDELETTE TFR SIGNAL 510 : 511 : DO 4200 J=1,KHALF 512 : VJ=DBLE(J-1)*DFREQ*2.D0*XPI*A 513 : V2=(VJ-V0)**2.D0 514 : PM=EXP(-0.5D0*V2)*((2.D0*XPI)**0.5D0) 515 : WOND(J)=PM*XX(J) 516 : 4200 CONTINUE 517 : 518 : J=NPOINT+1 519 : KK=1 520 : L11=KHALF-1 521 : DO 4205 II=2,L11 522 : KK=KK+1 523 : J=J-1 524 : VJ=DBLE(J-1-NPOINT)*DFREQ*2.D0*XPI*A 525 : V2=(VJ-V0)**2.D0 526 : PM=EXP(-0.5D0*V2)*((2.D0*XPI)**0.5D0) 527 : WOND(J)=CONJG(XX(KK))*PM 528 : 529 : 4205 CONTINUE 530 : 531 : 532 : C 533 : C================= CALCUL TFR INVERSE ============= 534 : C 535 : C 536 : INV=.TRUE. 536 : CALL WEXP(INV,NPOINT,W(1)) 536 : CALL FFTL(WOND(1),YY1(1),W(1),NPOINT) 537 : C 538 : C======================================================== 539 : 540 : DO 4210 J=1,NPOINT 541 : II=(I*NPOINT)+J 542 : IF(ISORT.EQ.3) THEN 543 : VML(II)=WOND(J)/(DBLE(NPOINT))/((XPI/2.D0)**0.5D0) 544 : VML2(II)=CXTOIM(WOND(J))/(DBLE(NPOINT))/((XPI/2.D0)**0 545 : $ .5D0) 546 : ENDIF 547 : IF(ISORT.EQ.4) THEN 548 : R1=WOND(J) 549 : R2=CXTOIM(WOND(J)) 550 : VML(II)=SQRT(R1*R1+R2*R2)/(DBLE(NPOINT))/((XPI/2.D0)**0 551 : $ .5D0) 552 : VML2(II)=ATAN2(R2,R1)*360.D0/XPI 553 : ENDIF 554 : FCOU=0.5D0/A 555 : TCOU=TDEB+(DT*DBLE(J-1)) 556 : TFCO=TFIN-(1.D0/FCOU) 557 : TDCO=TDEB+(1.D0/FCOU) 558 : IF ((TCOU.LT.TDCO).OR.(TCOU.GT.TFCO)) THEN 559 : VML(II)=0.D0 560 : VML2(II)=0.D0 561 : ENDIF 562 : NBPTS=NBPTS+1 563 : SEGADJ MCOORD 564 : XCOOR((NBPTS-1)*(IDIM+1)+1)=DBLE(J-1)/(NPOINT-1) 565 : XCOOR((NBPTS-1)*(IDIM+1)+2)=1.D0-(DBLE(I)/NA) 566 : IF(IDIM.NE.2) THEN 567 : XCOOR((NBPTS-1)*(IDIM+1)+3)=0.D0 568 : ENDIF 569 : XCOOR(NBPTS*(IDIM+1))=0.D0 570 : 571 : 572 : 4210 CONTINUE 573 : 574 : 575 : 5000 CONTINUE 576 : 577 : 578 : DO 5150 I=0,(NA-1) 579 : DO 5100 J=1,(NPOINT-1) 580 : INE=I*(NPOINT-1)+J 581 : ICOLOR(INE)=IDCOUL 582 : NUM(1,INE)=IDEB+J+(I*NPOINT) 583 : NUM(2,INE)=IDEB+(J+1)+(I*NPOINT) 584 : NUM(3,INE)=IDEB+(J+1)+((I+1)*NPOINT) 585 : NUM(4,INE)=IDEB+J+((I+1)*NPOINT) 586 : 5100 CONTINUE 587 : 5150 CONTINUE 588 : 589 : C--- TABLEAU CONVERSION QUA4->POI1 ---- 590 : 591 : DO 5151 I=1,NPO 592 : ICP1(I)=0 593 : 5151 CONTINUE 594 : ICON=0 595 : DO 5155 I=1,4 596 : DO 51551 J=1,NBELEM 597 : IKI=NUM(I,J)-IDEB 598 : IF (ICP1(IKI).NE.0) GOTO 51551 599 : ICON=ICON+1 600 : ICP1(IKI)=ICON 601 : 51551 CONTINUE 602 : 5155 CONTINUE 603 : 604 : 605 : C GOTO 4310 606 : SEGDES MELEME 606 : CALL ECROBJ('MAILLAGE',MELEME) 607 : SEGACT MELEME 607 : CALL CHANGE (MELEME,1) 608 : NBPOIN=NUM(/2) 609 : NSOUPO=1 610 : NC=2 611 : N=NBPOIN 612 : NAT=1 613 : SEGINI MCHPOI 614 : MOCHDE=' chpoint de coordonnees ' 615 : MTYPOI=' ' 616 : JATTRI(1) = 1 617 : IPPOI=MCHPOI 618 : SEGINI MSOUPO 619 : SEGINI MPOVAL 620 : IPCHP(1)=MSOUPO 621 : IFOPOI = IFOMOD 622 : SEGDES MCHPOI 623 : IF(ISORT.EQ.3) THEN 624 : NOCOMP(1)='PREE' 625 : NOCOMP(2)='PIMA' 626 : ENDIF 627 : IF(ISORT.EQ.4) THEN 628 : NOCOMP(1)='MODU' 629 : NOCOMP(2)='PHAS' 630 : ENDIF 631 : NOHARM(1)=NIFOUR 632 : NOHARM(2)=NIFOUR 633 : IGEOC=MELEME 634 : IPOVAL=MPOVAL 635 : SEGDES MSOUPO 636 : DO 5160 I= 1 ,NPO 637 : II=ICP1(I) 638 : VPOCHA(II,1)=VML(I) 639 : VPOCHA(II,2)=VML2(I) 640 : 5160 CONTINUE 641 : SEGDES MPOVAL 642 : SEGDES MELEME 642 : CALL ECROBJ('CHPOINT ',IPPOI) 643 : SEGSUP MTRAV1,MTRAV2,MTRAV3 644 : 645 : 646 : 666 CONTINUE 647 : RETURN 648 : END 649 : 650 : 651 : 652 : 653 : 654 : 655 : 656 : 657 : 658 : 659 : 660 : 661 :
© Cast3M 2003 - All rights reserved.
Disclaimer