1 | subroutine fieldlal(filebz) |
---|
2 | c----------------------------------------------------------------------- |
---|
3 | c reading B field on a file (LAL) |
---|
4 | c----------------------------------------------------------------------- |
---|
5 | c |
---|
6 | include 'param_sz.h' |
---|
7 | include 'bfieldcom.h' |
---|
8 | include 'flagcom.h' |
---|
9 | include 'misccom.h' |
---|
10 | include 'syscom.h' |
---|
11 | include 'ucom.h' |
---|
12 | c |
---|
13 | character filebz*12 |
---|
14 | common/spline/c(nsplc),zchp(nspl),chp(nspl),ivrai |
---|
15 | dimension d(2),w(nsplc) |
---|
16 | cbm28/09/09 dimension z(1000),bz(1000) |
---|
17 | dimension z(nptcb),bz(nptcb) |
---|
18 | c-------------------------------------------------------------------------- |
---|
19 | c* |
---|
20 | namelist/champ/chp |
---|
21 | c open (unit=nbz,file=filebz//'.inbz',status='old') |
---|
22 | nlast = index(filebz,' ') |
---|
23 | if(nlast.eq.0) nlast=len(filebz)+1 |
---|
24 | open (unit=nbz,file=filebz(1:nlast-1)//'.inbz',status='old') |
---|
25 | ifld=1 |
---|
26 | zmin=vv(1) |
---|
27 | zmax=vv(2) |
---|
28 | dzz=vv(3) |
---|
29 | nchp=vv(4) |
---|
30 | facbz=vv(5) |
---|
31 | iopt=vv(6) |
---|
32 | write(nnout,*) 'Number of used values for B ',nchp |
---|
33 | if(nchp.gt.nptcb) then |
---|
34 | write(nnout,*) |
---|
35 | * ' Number of points for magnetic field gt ',nptcb |
---|
36 | stop |
---|
37 | endif |
---|
38 | c--- |
---|
39 | if(iopt.eq.1) then |
---|
40 | c read field in namelist format, step constant |
---|
41 | write(nnout,*) 'Namelist format for Foclal ' |
---|
42 | write(nnout,9017) zmin,zmax,facbz |
---|
43 | zchp(1)=vv(1) |
---|
44 | do 10 i=2,nchp |
---|
45 | zchp(i)=zchp(i-1)+dzz |
---|
46 | 10 continue |
---|
47 | cibm read(nbz,CHAMP) |
---|
48 | read(nbz,champ,iostat=ios) |
---|
49 | do 11 i=1,nchp |
---|
50 | chp(i)=chp(i)*facbz |
---|
51 | write(nnout,100) zchp(i),chp(i) |
---|
52 | 11 continue |
---|
53 | if(nchp.lt.nspl) then |
---|
54 | do 12 i=nchp+1,nspl |
---|
55 | chp(i)=0. |
---|
56 | 12 continue |
---|
57 | endif |
---|
58 | ivrai=nchp |
---|
59 | endif |
---|
60 | c--- |
---|
61 | if(iopt.eq.2) then |
---|
62 | c read field in free format z(cm), chp(Gauss), step constant in part |
---|
63 | c with field but we don't give z and bz for bz = 0. |
---|
64 | write(nnout,*) 'Free format for foclal' |
---|
65 | il=1 |
---|
66 | 13 continue |
---|
67 | read(nbz,*,end=14) z(il),bz(il) |
---|
68 | bz(il)=bz(il)*facbz |
---|
69 | il=il+1 |
---|
70 | go to 13 |
---|
71 | c--- |
---|
72 | 14 continue |
---|
73 | nchp=il-1 |
---|
74 | zmin=z(1) |
---|
75 | zmax=z(nchp) |
---|
76 | cbm10/2009 dzz=z(2)-z(1) |
---|
77 | dzz=(zmax-zmin)/(nchp-1) |
---|
78 | write(nnout,9017) zmin,zmax,facbz |
---|
79 | do 17 iw=1,nchp |
---|
80 | write(nnout,100) z(iw),bz(iw) |
---|
81 | 17 continue |
---|
82 | i=1 |
---|
83 | zchp(i)=zmin |
---|
84 | jp=1 |
---|
85 | 15 continue |
---|
86 | if(abs(zchp(i)-z(jp)).le.1.e-04) then |
---|
87 | chp(i)=bz(jp) |
---|
88 | jp=jp+1 |
---|
89 | if(jp.gt.nchp) go to 18 |
---|
90 | else |
---|
91 | chp(i)=0. |
---|
92 | endif |
---|
93 | i=i+1 |
---|
94 | zchp(i)=zchp(i-1)+dzz |
---|
95 | if(zchp(i).le.zmax) go to 15 |
---|
96 | cbm if(abs(zmax-zchp(i)).gt.1.e-04) go to 15 |
---|
97 | 18 continue |
---|
98 | ivrai=i |
---|
99 | endif |
---|
100 | c--- |
---|
101 | 9017 format ( |
---|
102 | . ' zmin = ',t40,g12.4,' cm'/ |
---|
103 | . ' zmax = ',t40,g12.4,' cm'/ |
---|
104 | . ' scaling factor = ',t40,g12.3) |
---|
105 | 100 format(1x,'z=',E13.5,5X,'chp. mag.=',E13.5) |
---|
106 | c---------------ecriture dans un fichier |
---|
107 | open(unit=nfield,file='parmfoc',access='sequential', |
---|
108 | * status='unknown',form='formatted') |
---|
109 | do 16 i=1,ivrai |
---|
110 | write(nfield,*) zchp(i),chp(i) |
---|
111 | 16 continue |
---|
112 | close(nfield) |
---|
113 | c------------------------------- |
---|
114 | J=1 |
---|
115 | D(1)=0. |
---|
116 | D(2)=0. |
---|
117 | C |
---|
118 | C---CALCUL DES COEFFS DU POLYNOME-INTERPOLATION SPLINE(DEG.3) |
---|
119 | C |
---|
120 | call spln1(ivrai,zchp,chp,j,d,c,w) |
---|
121 | return |
---|
122 | end |
---|
123 | c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++* |
---|