| 1 |
************************************************************************* |
| 2 |
* |
| 3 |
* Subroutine read_B.f |
| 4 |
* |
| 5 |
* it calls the subroutines which read the magnetic field maps for |
| 6 |
* the PAMELA spectrometer |
| 7 |
* |
| 8 |
* needs: |
| 9 |
* - ./read_B_inner.f inner map reading subroutine |
| 10 |
* - ./read_B_outer.f outer map reading subroutine |
| 11 |
* |
| 12 |
* to be called before ./inter_B.f (interpolation subroutine) |
| 13 |
* |
| 14 |
************************************************************************* |
| 15 |
|
| 16 |
function readb2maps(idata_dir) |
| 17 |
c subroutine read_B(idata_dir) |
| 18 |
include './common_B_inner.for' |
| 19 |
include './common_B_outer.for' |
| 20 |
CHARACTER*250 idata_dir |
| 21 |
integer lastnb2 |
| 22 |
c integer lung |
| 23 |
REAL PFX(3),FX,DFX !Bx field component coordinates in m, value and error in T |
| 24 |
REAL PFY(3),FY,DFY |
| 25 |
REAL PFZ(3),FZ,DFZ |
| 26 |
INTEGER INDEX(3) !point index |
| 27 |
COMMON /ntplvars/ INDEX,PFX,FX,DFX,PFY,FY,DFY,PFZ,FZ,DFZ |
| 28 |
c save/ntplvars/ |
| 29 |
c |
| 30 |
c parameter(NWPAWC=8500000) |
| 31 |
integer nwpawc |
| 32 |
parameter(NWPAWC=200000) |
| 33 |
common/pawc/hmem(NWPAWC) |
| 34 |
c save/pawc/ |
| 35 |
common/quest/iquest(100) |
| 36 |
c save/quest/ |
| 37 |
c |
| 38 |
c IQUEST(10) = 65000 |
| 39 |
call hlimit(nwpawc) |
| 40 |
c |
| 41 |
readb2maps=0 |
| 42 |
lastnb2 = length(idata_dir)+1 |
| 43 |
c call the subroutine which reads the maps of the measurements taken |
| 44 |
c inside the magnetic cavity |
| 45 |
call read_B_inner(idata_dir(1:lastnb2)) |
| 46 |
|
| 47 |
c call the subroutine which reads the maps of the measurements taken |
| 48 |
c outside the magnetic cavity |
| 49 |
call read_B_outer(idata_dir(1:lastnb2)) |
| 50 |
|
| 51 |
c call resizepawc |
| 52 |
c |
| 53 |
return |
| 54 |
end |
| 55 |
|
| 56 |
include './read_B_inner.for' |
| 57 |
include './read_B_outer.for' |
| 58 |
|
| 59 |
|
| 60 |
integer function length(str) |
| 61 |
c return the string length without the blanks characters |
| 62 |
|
| 63 |
implicit integer (k-l) |
| 64 |
character *(*) str |
| 65 |
|
| 66 |
lmax=len(str) |
| 67 |
|
| 68 |
c search the last non blank character |
| 69 |
do i = 1, lmax |
| 70 |
if( str(i:i).eq.'.' )then |
| 71 |
length=i |
| 72 |
return |
| 73 |
endif |
| 74 |
enddo |
| 75 |
|
| 76 |
length=lmax |
| 77 |
|
| 78 |
return |
| 79 |
end |
| 80 |
|
| 81 |
|
| 82 |
c function resizepawc |
| 83 |
c parameter(NWPAWC=80) |
| 84 |
c common/pawc/hmem(NWPAWC) |
| 85 |
c common/quest/iquest(1) |
| 86 |
|
| 87 |
c |
| 88 |
c call hlimit(nwpawc) |
| 89 |
c return |
| 90 |
c end |
Parent Directory
| 
Revision Log