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

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

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

revision 1.27 by pam-fi, Tue Mar 12 11:02:02 2013 UTC revision 1.29 by mocchiut, Fri Jan 17 10:14:39 2014 UTC
# Line 57  Line 57 
57        subroutine idtoc(ipfa,cpfa)        subroutine idtoc(ipfa,cpfa)
58                
59        integer ipfa        integer ipfa
60        character*10 cpfa  c      character*10 cpfa
61          character*4 cpfa ! EM GCC4.7
62    
63        CPFA='COG4'        CPFA='COG4'
64        if(ipfa.eq.0)CPFA='ETA'        if(ipfa.eq.0)CPFA='ETA'
# Line 74  Line 75 
75        end        end
76  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
77        real function effectiveangle(ang,iview,bbb)        real function effectiveangle(ang,iview,bbb)
78          
79        include 'commontracker.f'        include 'commontracker.f'
80          real tgtemp
81    
82        effectiveangle = 0.        effectiveangle = 0.
83    
# Line 89  c     here bbb is the y component of the Line 91  c     here bbb is the y component of the
91           if(iview.eq.12) angx = -1. * ang           if(iview.eq.12) angx = -1. * ang
92           if(iview.eq.12) by   = -1. * bbb           if(iview.eq.12) by   = -1. * bbb
93  cc         tgtemp  = tan(ang*acos(-1.)/180.) + pmuH_h*by*0.00001 !ORRORE!!  cc         tgtemp  = tan(ang*acos(-1.)/180.) + pmuH_h*by*0.00001 !ORRORE!!
94           tgtemp  = tan(angx*acos(-1.)/180.) + pmuH_h*by*0.00001           tgtemp  = tan(angx*acos(-1.)/180.) + REAL(pmuH_h*by*0.00001)  ! EM GCC4.7 pmuH_h is double precision but all the others are real...
95    
96        elseif(mod(iview,2).eq.1)then        elseif(mod(iview,2).eq.1)then
97  c     =================================================  c     =================================================
# Line 98  c     ================================== Line 100  c     ==================================
100  c     here bbb is the x component of the m.filed  c     here bbb is the x component of the m.filed
101           angy = ang           angy = ang
102           bx   = bbb           bx   = bbb
103           tgtemp  = tan(angy*acos(-1.)/180.)+pmuH_e*bx*0.00001                   tgtemp  = tan(angy*acos(-1.)/180.)+real(pmuH_e*bx*0.00001) ! EM GCC4.7 pmuH_h is double precision but all the others are real...
104    
105        endif              endif      
106        effectiveangle = 180.*atan(tgtemp)/acos(-1.)        effectiveangle = 180.*atan(tgtemp)/acos(-1.)
# Line 120  c     ================================== Line 122  c     ==================================
122  c     here bbb is the y component of the m.field  c     here bbb is the y component of the m.field
123           by   = bbb           by   = bbb
124           if(iview.eq.12) by = -1. * bbb           if(iview.eq.12) by = -1. * bbb
125           fieldcorr     = -1. * 0.5*pmuH_h*by*0.00001*SiDimZ/pitchX           fieldcorr = -1. * 0.5*REAL(pmuH_h*by*0.00001*SiDimZ/pitchX)! EM GCC4.7 pmuH_h is double precision but all the others are real...
126    
127        elseif(mod(iview,2).eq.1)then        elseif(mod(iview,2).eq.1)then
128  c     =================================================  c     =================================================
# Line 128  c     Y view Line 130  c     Y view
130  c     =================================================          c     =================================================        
131  c     here bbb is the x component of the m.filed  c     here bbb is the x component of the m.filed
132           bx   = bbb           bx   = bbb
133           fieldcorr     = 0.5*pmuH_e*bx*0.00001*SiDimZ/pitchY           fieldcorr     = 0.5*real(pmuH_e*bx*0.00001*SiDimZ/pitchY) ! EM GCC4.7 pmuH_h is double precision but all the others are real...
134    
135        endif              endif      
136                
# Line 147  c     here bbb is the x component of the Line 149  c     here bbb is the x component of the
149        character*4 PFAtt        character*4 PFAtt
150        include 'commontracker.f'        include 'commontracker.f'
151        include 'level1.f'        include 'level1.f'
152          real corr, res ! EM GCC4.7
153        corr = 0        corr = 0.
154        res  = 0        res  = 0.
155    
156        if(ic.le.0)return        if(ic.le.0)return
157    
# Line 164  c     ================================== Line 166  c     ==================================
166    
167           if(PFAtt.eq.'COG1')then           if(PFAtt.eq.'COG1')then
168    
169              corr   = 0              corr   = 0.
170              res = 1e-4*pitchX/sqrt(12.)!!res              res = REAL(1e-4*pitchX/sqrt(12.))!!res  EM GCC4.7
171    
172           elseif(PFAtt.eq.'COG2')then           elseif(PFAtt.eq.'COG2')then
173    
# Line 233  c            res = riseta(ic,ang)       Line 235  c            res = riseta(ic,ang)      
235           if( nsatstrips(ic).gt.0 )then           if( nsatstrips(ic).gt.0 )then
236  c            corr  = cog(4,ic)              c            corr  = cog(4,ic)            
237              corr = digsat(ic)              corr = digsat(ic)
238              res = pitchX*1e-4/sqrt(12.)              res = REAL(pitchX*1e-4/sqrt(12.)) !EM GCC4.7
239  cc            cc=cog(4,ic)  cc            cc=cog(4,ic)
240  c$$$            print*,ic,' *** ',cc  c$$$            print*,ic,' *** ',cc
241  c$$$            print*,ic,' *** ',res  c$$$            print*,ic,' *** ',res
# Line 250  c     ================================== Line 252  c     ==================================
252           if(PFAtt.eq.'COG1')then           if(PFAtt.eq.'COG1')then
253    
254              corr  = 0                corr  = 0  
255              res = 1e-4*pitchY/sqrt(12.)!res                res = REAL(1e-4*pitchY/sqrt(12.))!res  EM GCC4.7
256    
257           elseif(PFAtt.eq.'COG2')then           elseif(PFAtt.eq.'COG2')then
258    
# Line 316  c            res = riseta(ic,ang)   Line 318  c            res = riseta(ic,ang)  
318           if( nsatstrips(ic).gt.0 )then           if( nsatstrips(ic).gt.0 )then
319  c            corr    = cog(4,ic)              c            corr    = cog(4,ic)            
320              corr = digsat(ic)              corr = digsat(ic)
321              res = pitchY*1e-4/sqrt(12.)              res = REAL(pitchY*1e-4/sqrt(12.)) ! EM GCC4.7
322  cc            cc=cog(4,ic)  cc            cc=cog(4,ic)
323  c$$$            print*,ic,' *** ',cc  c$$$            print*,ic,' *** ',cc
324  c$$$            print*,ic,' *** ',res  c$$$            print*,ic,' *** ',res
# Line 530  c      real function riseta(ic,angle) Line 532  c      real function riseta(ic,angle)
532        include 'level1.f'        include 'level1.f'
533        include 'calib.f'        include 'calib.f'
534    
535        riseta = 0        riseta = 0.
536    
537  c      if(mod(int(VIEW(ic)),2).eq.1)then !Y-view  c      if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
538        if(mod(iview,2).eq.1)then !Y-view        if(mod(iview,2).eq.1)then !Y-view
# Line 1135  ' Line 1137  '
1137  *     =========================  *     =========================
1138    
1139           iv=VIEW(ic)           iv=VIEW(ic)
1140           if(mod(iv,2).eq.1)incut=incuty           if(mod(iv,2).eq.1)incut=NINT(incuty) ! incut is implicitly INTEGER, incuty is REAL
1141           if(mod(iv,2).eq.0)incut=incutx           if(mod(iv,2).eq.0)incut=NINT(incutx) ! incut is implicitly INTEGER, incutx is REAL
1142           istart = INDSTART(IC)           istart = INDSTART(IC)
1143           istop  = TOTCLLENGTH           istop  = TOTCLLENGTH
1144           if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1           if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1
# Line 1221  c      print *,'## cog ',ncog,ic,cog,'// Line 1223  c      print *,'## cog ',ncog,ic,cog,'//
1223        if(mod(int(VIEW(ic)),2).eq.1)then !Y-view        if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
1224           si = 8.4  !average good-strip noise           si = 8.4  !average good-strip noise
1225           f  = 4.   !average bad-strip noise: f*si           f  = 4.   !average bad-strip noise: f*si
1226           incut=incuty           incut=NINT(incuty)
1227        else                      !X-view        else                      !X-view
1228           si = 3.9  !average good-strip noise           si = 3.9  !average good-strip noise
1229           f  = 6.   !average bad-strip noise: f*si           f  = 6.   !average bad-strip noise: f*si
1230           incut=incutx           incut=NINT(incutx)
1231        endif        endif
1232                
1233        fbad_cog = 1.        fbad_cog = 1.
# Line 1410  c            COG = 0. Line 1412  c            COG = 0.
1412        include 'calib.f'        include 'calib.f'
1413    
1414        if(mod(int(VIEW(ic)),2).eq.1)then !Y-view        if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
1415           incut = incuty           incut = NINT(incuty) ! EM GCC4.7
1416           pitch = pitchY / 1.e4           pitch = REAL(pitchY / 1.e4)
1417        else                      !X-view        else                      !X-view
1418           incut = incutx           incut = NINT(incutx) ! EM GCC4.7
1419           pitch = pitchX / 1.e4           pitch = REAL(pitchX / 1.e4)
1420        endif        endif
1421                
1422        func = 100000.        func = 100000.
# Line 1605  ccc         SDE = 0. Line 1607  ccc         SDE = 0.
1607    
1608        if(mod(int(iview),2).eq.1)then !Y-view        if(mod(int(iview),2).eq.1)then !Y-view
1609    
1610           pitch = pitchY / 1.e4           pitch = REAL(pitchY / 1.e4) !EM GCC 4.7
1611    
1612           if(ncog.eq.0)then           if(ncog.eq.0)then
1613              if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then              if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
# Line 1622  ccc         SDE = 0. Line 1624  ccc         SDE = 0.
1624    
1625        else                      !X-view        else                      !X-view
1626    
1627           pitch = pitchX / 1.e4           pitch = REAL(pitchX / 1.e4) ! EM GCC4.7
1628    
1629           if(ncog.eq.0)then           if(ncog.eq.0)then
1630              if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then              if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
# Line 1741  ccc         SDE = 0. Line 1743  ccc         SDE = 0.
1743    
1744        FUNCTION risxeta2(x)        FUNCTION risxeta2(x)
1745    
1746          DOUBLE PRECISION HQUADF ! EM GCC4.7
1747        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
1748        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
1749        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 1826  ccc         SDE = 0. Line 1829  ccc         SDE = 0.
1829     20 CONTINUE     20 CONTINUE
1830        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1831                
1832        risxeta2=HQUADF* 1e-4        risxeta2=REAL(HQUADF* 1e-4) ! EM GCC4.7 all computation here are done in double precision but the function returns REAL since it is undefined and it is used in the code in single precision variables
1833    
1834        END        END
1835    
1836  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1837        FUNCTION risxeta3(x)        FUNCTION risxeta3(x)
1838          DOUBLE PRECISION HQUADF ! EM GCC4.7
1839        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
1840        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
1841        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 1917  ccc         SDE = 0. Line 1921  ccc         SDE = 0.
1921     20 CONTINUE     20 CONTINUE
1922        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1923                
1924        risxeta3 = HQUADF* 1e-4        risxeta3 = REAL(HQUADF* 1e-4) ! EM GCC4.7 all computation here are done in double precision but the function returns REAL since it is undefined and it is used in the code in single precision variables
1925    
1926        END        END
1927  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1928        FUNCTION risxeta4(x)        FUNCTION risxeta4(x)
1929          DOUBLE PRECISION HQUADF ! EM GCC4.7
1930        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
1931        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
1932        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 2007  ccc         SDE = 0. Line 2012  ccc         SDE = 0.
2012     20 CONTINUE     20 CONTINUE
2013        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
2014                
2015        risxeta4=HQUADF* 1e-4        risxeta4=REAL(HQUADF* 1e-4) ! EM GCC4.7 all computation here are done in double precision but the function returns REAL since it is undefined and it is used in the code in single precision variables
2016    
2017        END        END
2018  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
2019        FUNCTION risyeta2(x)        FUNCTION risyeta2(x)
2020          DOUBLE PRECISION HQUADF ! EM GCC4.7
2021        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
2022        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
2023        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 2079  ccc         SDE = 0. Line 2085  ccc         SDE = 0.
2085     20 CONTINUE     20 CONTINUE
2086        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
2087    
2088        risyeta2=HQUADF* 1e-4        risyeta2=REAL(HQUADF* 1e-4) ! EM GCC4.7 all computation here are done in double precision but the function returns REAL since it is undefined and it is used in the code in single precision variables
2089    
2090        END        END
2091  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
2092    
2093        FUNCTION risy_cog(x)        FUNCTION risy_cog(x)
2094          DOUBLE PRECISION HQUADF ! EM GCC4.7
2095        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
2096        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
2097        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 2146  ccc         SDE = 0. Line 2153  ccc         SDE = 0.
2153     20 CONTINUE     20 CONTINUE
2154        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
2155    
2156        risy_cog=HQUADF* 1e-4        risy_cog=REAL(HQUADF* 1e-4) ! EM GCC4.7 all computation here are done in double precision but the function returns REAL since it is undefined and it is used in the code in single precision variables
2157                
2158        END        END
2159  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
2160        FUNCTION risx_cog(x)        FUNCTION risx_cog(x)
2161          DOUBLE PRECISION HQUADF ! EM GCC4.7
2162        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
2163        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
2164        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 2227  ccc         SDE = 0. Line 2235  ccc         SDE = 0.
2235     20 CONTINUE     20 CONTINUE
2236        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
2237    
2238        risx_cog = HQUADF * 1e-4        risx_cog = REAL(HQUADF * 1e-4) ! EM GCC4.7 all computation here are done in double precision but the function returns REAL since it is undefined and it is used in the code in single precision variables
2239    
2240        END        END
2241    
Legend:
Removed from v.1.27  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.23