C COUPNO SOURCE PV 11/10/07 21:15:12 7164 subroutine coupno (xmi,xma,ymi,yma,zmi,zma,coupra,coupol) implicit integer(i-n) -INC SMCOORD -INC PPARAM -INC CCOPTIO dimension xtr(5),ytr(5),ztr(5) ISORT = 0 IRESU = 0 call ini(IRESU,ISORT,0,0,0,0.,0.,0.,0.) xz=0d0 xd=10d0 xv=20d0 call dfenet(xz,xd,xz,xv,xz,xd,xz,xd,xz,xv,.false.) xtr(1)=2. xtr(2)=8. xtr(3)=8. xtr(4)=2. xtr(5)=xtr(1) ytr(1)=7. ytr(2)=7. ytr(3)=7.3 ytr(4)=7.3 ytr(5)=ytr(1) ztr(1)=0.1 ztr(2)=0.1 ztr(3)=0.1 ztr(4)=0.1 ztr(5)=0.1 call majseg(1,0,0,0,0) call insegt(1,ires) call trmess(' <-- proche : lointain --> ') call chcoul(0) call polrl(5,xtr,ytr,ztr) * indiquer la position courante if( coupol.ge.0.) then xtr(1)=xtr(1)+ ( xtr(3)-xtr(1))*coupol- 6. / 100. ytr(1)= 7.05 xtr(2)=xtr(1)+ 6. / 100. ytr(2)=ytr(1) xtr(3)=xtr(2) ytr(3)=7.25 xtr(4)=xtr(1) ytr(4)=ytr(3) xtr(5)=xtr(1) ytr(5)=ytr(1) call polrl(5,xtr,ytr,ztr) endif rxpos=0. rypos=0. if( iogra.ne.6) then call trdig (rxpos,rypos,inouse) else call otrdig (rxpos,rypos,inouse) endif coupra=(rxpos-2.) / 6. if( coupra.le.0.) coupra=0.01 if(coupra.ge.1.) coupra=0.99 * write(6,*) ' coupra ',coupra if( coupra . lt. 0.)coupra=0.01 if( coupra . ge . 1.) coupra = 0.99 coupol=coupra return * end