1 : C COUPNO SOURCE PV 11/10/07 21:15:12 7164 2 : subroutine coupno (xmi,xma,ymi,yma,zmi,zma,coupra,coupol) 3 : implicit integer(i-n) 4 : -INC SMCOORD 5 : -INC CCOPTIO 6 : dimension xtr(5),ytr(5),ztr(5) 7 : 8 : ISORT = 0 9 : IRESU = 0 9 : call ini(IRESU,ISORT,0,0,0,0.,0.,0.,0.) 10 : xz=0d0 11 : xd=10d0 12 : xv=20d0 12 : call dfenet(xz,xd,xz,xv,xz,xd,xz,xd,xz,xv,.false.) 13 : xtr(1)=2. 14 : xtr(2)=8. 15 : xtr(3)=8. 16 : xtr(4)=2. 17 : xtr(5)=xtr(1) 18 : ytr(1)=7. 19 : ytr(2)=7. 20 : ytr(3)=7.3 21 : ytr(4)=7.3 22 : ytr(5)=ytr(1) 23 : ztr(1)=0.1 24 : ztr(2)=0.1 25 : ztr(3)=0.1 26 : ztr(4)=0.1 27 : ztr(5)=0.1 28 : 28 : call majseg(1,0,0,0,0) 28 : call insegt(1,ires) 28 : call trmess(' <-- proche : lointain --> ') 28 : call chcoul(0) 28 : call polrl(5,xtr,ytr,ztr) 29 : * indiquer la position courante 30 : if( coupol.ge.0.) then 31 : xtr(1)=xtr(1)+ ( xtr(3)-xtr(1))*coupol- 6. / 100. 32 : ytr(1)= 7.05 33 : xtr(2)=xtr(1)+ 6. / 100. 34 : ytr(2)=ytr(1) 35 : xtr(3)=xtr(2) 36 : ytr(3)=7.25 37 : xtr(4)=xtr(1) 38 : ytr(4)=ytr(3) 39 : xtr(5)=xtr(1) 40 : ytr(5)=ytr(1) 40 : call polrl(5,xtr,ytr,ztr) 41 : endif 42 : rxpos=0. 43 : rypos=0. 44 : if( iogra.ne.6) then 44 : call trdig (rxpos,rypos,inouse) 45 : else 45 : call otrdig (rxpos,rypos,inouse) 46 : endif 47 : coupra=(rxpos-2.) / 6. 48 : if( coupra.le.0.) coupra=0.01 49 : if(coupra.ge.1.) coupra=0.99 50 : * write(6,*) ' coupra ',coupra 51 : if( coupra . lt. 0.)coupra=0.01 52 : if( coupra . ge . 1.) coupra = 0.99 53 : coupol=coupra 54 : return 55 : 56 : * 57 : end 58 : 59 : 60 : 61 :
© Cast3M 2003 - All rights reserved.
Disclaimer