1 | subroutine fieldlal(filebz) |
---|
2 | c----------------------------------------------------------------------- |
---|
3 | c reading B field on a file (LAL) |
---|
4 | c----------------------------------------------------------------------- |
---|
5 | parameter (imaa=10000,imb=10,maxbuf=50,lmx=1000) |
---|
6 | parameter (nspl=10001) |
---|
7 | parameter (nsplc=nspl*3+2) |
---|
8 | character filebz*12 |
---|
9 | logical poiflag |
---|
10 | common/flags/poiflag |
---|
11 | common/flag1/ifld,ifoclal |
---|
12 | common/misc/irun,ip,nn,vv(100) |
---|
13 | common/bfield/bf(1002,0:6),zmin,zmax,dzz |
---|
14 | common/systeme/nel,ntype(0:lmx),zloc(0:lmx),el(11,0:lmx) |
---|
15 | common/spline/c(nsplc),zchp(nspl),chp(nspl),ivrai |
---|
16 | common/unit/nbz,nfld,nin,nsav,nschef,nav,ndes1,ndiag,ndpout, |
---|
17 | 1 nemit,nfield,nhist,nnout,nout1,nout2,nsemit,nstat, |
---|
18 | 2 ntrw,nuch,nsnap,nback,nback1,ndes2,nimp,ninput,npois |
---|
19 | dimension d(2),w(nsplc) |
---|
20 | dimension z(1000),bz(1000) |
---|
21 | c-------------------------------------------------------------------------- |
---|
22 | c* |
---|
23 | namelist/champ/chp |
---|
24 | c open (unit=nbz,file=filebz//'.inbz',status='old') |
---|
25 | nlast = index(filebz,' ') |
---|
26 | if(nlast.eq.0) nlast=len(filebz)+1 |
---|
27 | open (unit=nbz,file=filebz(1:nlast-1)//'.inbz',status='old') |
---|
28 | ifld=1 |
---|
29 | zmin=vv(1) |
---|
30 | zmax=vv(2) |
---|
31 | dzz=vv(3) |
---|
32 | nchp=vv(4) |
---|
33 | facbz=vv(5) |
---|
34 | iopt=vv(6) |
---|
35 | c--- |
---|
36 | if(iopt.eq.1) then |
---|
37 | c read field in namelist format, step constant |
---|
38 | write(nnout,*) 'Namelist format for Foclal ' |
---|
39 | write(nnout,9017) zmin,zmax,facbz |
---|
40 | zchp(1)=vv(1) |
---|
41 | do 10 i=2,nchp |
---|
42 | zchp(i)=zchp(i-1)+dzz |
---|
43 | 10 continue |
---|
44 | read(nbz,CHAMP) |
---|
45 | do 11 i=1,nchp |
---|
46 | chp(i)=chp(i)*facbz |
---|
47 | write(nnout,100) zchp(i),chp(i) |
---|
48 | 11 continue |
---|
49 | if(nchp.lt.nspl) then |
---|
50 | do 12 i=nchp+1,nspl |
---|
51 | chp(i)=0. |
---|
52 | 12 continue |
---|
53 | endif |
---|
54 | ivrai=nchp |
---|
55 | endif |
---|
56 | c--- |
---|
57 | if(iopt.eq.2) then |
---|
58 | c read field in free format z(cm), chp(Gauss), step constant in part |
---|
59 | c with field but we don't give z and bz for bz = 0. |
---|
60 | write(nnout,*) 'Free format for foclal' |
---|
61 | il=1 |
---|
62 | 13 continue |
---|
63 | read(nbz,*,end=14) z(il),bz(il) |
---|
64 | bz(il)=bz(il)*facbz |
---|
65 | il=il+1 |
---|
66 | go to 13 |
---|
67 | c--- |
---|
68 | 14 continue |
---|
69 | nchp=il-1 |
---|
70 | zmin=z(1) |
---|
71 | zmax=z(nchp) |
---|
72 | dzz=z(2)-z(1) |
---|
73 | write(nnout,9017) zmin,zmax,facbz |
---|
74 | do 17 iw=1,nchp |
---|
75 | write(nnout,100) z(iw),bz(iw) |
---|
76 | 17 continue |
---|
77 | i=1 |
---|
78 | zchp(i)=zmin |
---|
79 | jp=1 |
---|
80 | 15 continue |
---|
81 | if(abs(zchp(i)-z(jp)).le.1.e-04) then |
---|
82 | chp(i)=bz(jp) |
---|
83 | jp=jp+1 |
---|
84 | if(jp.gt.nchp) go to 18 |
---|
85 | else |
---|
86 | chp(i)=0. |
---|
87 | endif |
---|
88 | i=i+1 |
---|
89 | zchp(i)=zchp(i-1)+dzz |
---|
90 | if(zchp(i).le.zmax) go to 15 |
---|
91 | cbm if(abs(zmax-zchp(i)).gt.1.e-04) go to 15 |
---|
92 | 18 continue |
---|
93 | ivrai=i |
---|
94 | endif |
---|
95 | c--- |
---|
96 | 9017 format ( |
---|
97 | . ' zmin = ',t40,g12.4,' cm'/ |
---|
98 | . ' zmax = ',t40,g12.4,' cm'/ |
---|
99 | . ' scaling factor = ',t40,g12.3) |
---|
100 | 100 format(1x,'z=',E13.5,5X,'chp. mag.=',E13.5) |
---|
101 | c---------------ecriture dans un fichier |
---|
102 | open(unit=nfield,file='parmfoc',access='sequential', |
---|
103 | * status='unknown',form='formatted') |
---|
104 | do 16 i=1,ivrai |
---|
105 | write(nfield,*) zchp(i),chp(i) |
---|
106 | 16 continue |
---|
107 | close(nfield) |
---|
108 | c------------------------------- |
---|
109 | J=1 |
---|
110 | D(1)=0. |
---|
111 | D(2)=0. |
---|
112 | C |
---|
113 | C---CALCUL DES COEFFS DU POLYNOME-INTERPOLATION SPLINE(DEG.3) |
---|
114 | C |
---|
115 | call spln1(ivrai,zchp,chp,j,d,c,w) |
---|
116 | return |
---|
117 | end |
---|
118 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
---|