/[PAMELA software]/DarthVader/TrackerLevel2/src/F77/grkuta.f
ViewVC logotype

Diff of /DarthVader/TrackerLevel2/src/F77/grkuta.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by pam-fi, Wed Nov 8 16:42:28 2006 UTC revision 1.6 by pam-fi, Tue Nov 27 11:43:51 2007 UTC
# Line 28  C.    *                                 Line 28  C.    *                                
28  C.    ******************************************************************  C.    ******************************************************************
29  C.  C.
30        IMPLICIT DOUBLE PRECISION(A-H,O-Z)        IMPLICIT DOUBLE PRECISION(A-H,O-Z)
31          COMMON/DELTAB/DELTA0,DELTA1
32  *  *
33        REAL VVV(3),FFF(3)        REAL VVV(3),FFF(3)
34        REAL*8 CHARGE, STEP, VECT(*), VOUT(*), F(4)        REAL*8 CHARGE, STEP, VECT(*), VOUT(*), F(4)
# Line 43  C. Line 44  C.
44        PARAMETER (PISQUA=.986960440109D+01)        PARAMETER (PISQUA=.986960440109D+01)
45        PARAMETER (IX=1,IY=2,IZ=3,IPX=4,IPY=5,IPZ=6)        PARAMETER (IX=1,IY=2,IZ=3,IPX=4,IPY=5,IPZ=6)
46    
47          REAL*8 DELTAB(3)
48    
49  *.  *.
50  *.    ------------------------------------------------------------------  *.    ------------------------------------------------------------------
51  *.  *.
52  *             This constant is for units CM,GEV/C and KGAUSS  *             This constant is for units CM,GEV/C and KGAUSS
53  *  *
54    
55        ITER = 0        ITER = 0
56        NCUT = 0        NCUT = 0
57        DO 10 J=1,7        DO 10 J=1,7
# Line 69  C. Line 73  C.
73        DO I=1,3        DO I=1,3
74         F(I)=DBLE(FFF(I))         F(I)=DBLE(FFF(I))
75        ENDDO        ENDDO
76          DELTAB(2) = -F(2)*VECT(7)*CHARGE*(DELTA0+DELTA1*VVV(2))
77          F(2) = F(2)+DELTAB(2)
78    cPP   -----------------
79  *  *
80  *             Start of integration  *             Start of integration
81  *  *
# Line 106  C. Line 113  C.
113        CALL GUFLD(VVV,FFF)        CALL GUFLD(VVV,FFF)
114        DO I=1,3        DO I=1,3
115         F(I)=DBLE(FFF(I))         F(I)=DBLE(FFF(I))
116        ENDDO            ENDDO  
117          DELTAB(2) = -F(2)*VECT(7)*CHARGE*(DELTA0+DELTA1*VVV(2))
118          F(2) = F(2)+DELTAB(2)
119    cPP   -----------------
120  C      CALL GUFLD(XYZT,F)  C      CALL GUFLD(XYZT,F)
121        AT     = A + SECXS(1)        AT     = A + SECXS(1)
122        BT     = B + SECYS(1)        BT     = B + SECYS(1)
# Line 141  C      CALL GUFLD(XYZT,F) Line 151  C      CALL GUFLD(XYZT,F)
151        DO I=1,3        DO I=1,3
152         F(I)=DBLE(FFF(I))         F(I)=DBLE(FFF(I))
153        ENDDO        ENDDO
154          DELTAB(2) = -F(2)*VECT(7)*CHARGE*(DELTA0+DELTA1*VVV(2))
155          F(2) = F(2)+DELTAB(2)
156    cPP   -----------------
157  C      CALL GUFLD(XYZT,F)  C      CALL GUFLD(XYZT,F)
158  *  *
159        Z      = Z + (C + (SECZS(1) + SECZS(2) + SECZS(3)) * THIRD) * H        Z      = Z + (C + (SECZS(1) + SECZS(2) + SECZS(3)) * THIRD) * H
# Line 500  c      print*,'- ',VOUT(3),z,VOUT(1),x,V Line 513  c      print*,'- ',VOUT(3),z,VOUT(1),x,V
513       $     +(VOUT(IY)-VECT(IY))**2       $     +(VOUT(IY)-VECT(IY))**2
514       $     +(VOUT(IZ)-VECT(IZ))**2       $     +(VOUT(IZ)-VECT(IZ))**2
515       $     )       $     )
516        print*,'WARNING: GRKUTA2 --> '  c      print*,'WARNING: GRKUTA2 --> '
517       $     ,'helix :-( ... length evaluated with straight line'  c     $     ,'helix :-( ... length evaluated with straight line'
518    
519  *  *
520    999 END    999 END
# Line 521  c      print*,'- ',VOUT(3),z,VOUT(1),x,V Line 534  c      print*,'- ',VOUT(3),z,VOUT(1),x,V
534        real*8 vv(3),ff(3)        !inter_B.f works in double precision        real*8 vv(3),ff(3)        !inter_B.f works in double precision
535    
536    
537          do i=1,3        do i=1,3
538            vv(i)=v(i)/100.       !inter_B.f works in meters           vv(i)=v(i)/100.        !inter_B.f works in meters
539          enddo        enddo
540  c       inter_B: coordinates in m, B field in Tesla  c     inter_B: coordinates in m, B field in Tesla
541  c        print*,'GUFLD: v ',v  c$$$      print*,'GUFLD: v ',v
542          call inter_B(vv(1),vv(2),vv(3),ff)        call inter_B(vv(1),vv(2),vv(3),ff)
543          do i=1,3                !change back the field in kGauss        do i=1,3                  !change back the field in kGauss
544            f(i)=ff(i)*10.           f(i)=ff(i)*10.
545          enddo        enddo
546  c        print*,'GUFLD: b ',f  c$$$      print*,'GUFLD: b ',f
547  c        print*,vv,ff        
   
548        return        return
549        end        end
550    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.23