/[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.24 by pam-fi, Sat Mar 22 08:32:50 2008 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 231  c            res = riseta(ic,ang)       Line 233  c            res = riseta(ic,ang)      
233  *     temporary patch for saturated clusters  *     temporary patch for saturated clusters
234  *     ======================================  *     ======================================
235           if( nsatstrips(ic).gt.0 )then           if( nsatstrips(ic).gt.0 )then
236              corr  = cog(4,ic)              c            corr  = cog(4,ic)            
237              res = pitchX*1e-4/sqrt(12.)              corr = digsat(ic)
238                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 249  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 313  c            res = riseta(ic,ang)   Line 316  c            res = riseta(ic,ang)  
316  *     temporary patch for saturated clusters  *     temporary patch for saturated clusters
317  *     ======================================  *     ======================================
318           if( nsatstrips(ic).gt.0 )then           if( nsatstrips(ic).gt.0 )then
319              corr    = cog(4,ic)              c            corr    = cog(4,ic)            
320              res = pitchY*1e-4/sqrt(12.)              corr = digsat(ic)
321                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 460  cc            print*,pfaeta2(ic,angle) Line 464  cc            print*,pfaeta2(ic,angle)
464                            
465        endif        endif
466                
467   100  return  c 100  return
468          return
469        end        end
470    
471  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 507  cc            print*,VIEW(ic),angle,pfae Line 512  cc            print*,VIEW(ic),angle,pfae
512                            
513        endif        endif
514                
515   100  return  c 100  return
516          return
517        end        end
518  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
519  c      real function riseta(ic,angle)  c      real function riseta(ic,angle)
# Line 526  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 557  c      if(mod(int(VIEW(ic)),2).eq.1)then Line 563  c      if(mod(int(VIEW(ic)),2).eq.1)then
563        endif        endif
564    
565    
566   100  return  c 100  return
567          return
568        end        end
569    
570  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 718  c$$$      endif Line 725  c$$$      endif
725       $     ,cog2-iadd,' -->',pfaeta2       $     ,cog2-iadd,' -->',pfaeta2
726    
727    
728   100  return  c 100  return
729          return
730        end        end
731    
732  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 821  c            print*,'-----',x1,x2,y1,y2 Line 829  c            print*,'-----',x1,x2,y1,y2
829        if(DEBUG.EQ.1)print*,'ETA3  (ic ',ic,' ang',angle,')'        if(DEBUG.EQ.1)print*,'ETA3  (ic ',ic,' ang',angle,')'
830       $     ,cog3-iadd,' -->',pfaeta3       $     ,cog3-iadd,' -->',pfaeta3
831    
832   100  return  c 100  return
833          return
834        end        end
835    
836  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
# Line 930  c$$$      endif Line 939  c$$$      endif
939        if(DEBUG.EQ.1)print*,'ETA4  (ic ',ic,' ang',angle,')'        if(DEBUG.EQ.1)print*,'ETA4  (ic ',ic,' ang',angle,')'
940       $     ,cog4-iadd,' -->',pfaeta4       $     ,cog4-iadd,' -->',pfaeta4
941    
942   100  return  c 100  return
943          return
944        end        end
945    
946    *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
947          real function digsat(ic)
948    *-------------------------------------------------
949    *
950    *          
951    *-------------------------------------------------
952          include 'commontracker.f'
953          include 'calib.f'
954          include 'level1.f'
955          
956          integer nsat
957          real pitchsat
958          
959          nsat = 0
960          pitchsat = 0.
961          iv=VIEW(ic)              
962          istart = INDSTART(IC)
963          istop  = TOTCLLENGTH
964          if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1
965          do i = INDMAX(IC),istart,-1
966             if(  (mod(iv,2).eq.1.and.CLADC(i).lt.ADCsatx)
967         $        .or.
968         $        (mod(iv,2).eq.0.and.CLADC(i).gt.ADCsaty) )then
969                nsat = nsat + 1
970                pitchsat = pitchsat + i - INDMAX(IC)
971             else
972                goto 10
973             endif
974          enddo
975     10   continue
976          do i = INDMAX(IC)+1,istop
977             if(  (mod(iv,2).eq.1.and.CLADC(i).lt.ADCsatx)
978         $        .or.
979         $        (mod(iv,2).eq.0.and.CLADC(i).gt.ADCsaty) )then
980                nsat = nsat + 1
981                pitchsat = pitchsat + i - INDMAX(IC)
982             else
983                goto 20
984             endif
985          enddo
986     20   continue
987          
988          digsat = 0
989          if (nsat.gt.0) digsat = pitchsat / nsat
990          
991          return
992          end
993    
994    
995  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
996        real function cog(ncog,ic)        real function cog(ncog,ic)
# Line 1000  c      print *,'## ',sl2,sl1,sc,sr1,sr2 Line 1057  c      print *,'## ',sl2,sl1,sc,sr1,sr2
1057  c     ==============================================================  c     ==============================================================
1058           if(ncog.eq.1)then           if(ncog.eq.1)then
1059              COG = 0.              COG = 0.
1060              if(sr1.gt.sc)cog=1.           if(sr1.gt.sc)cog=1.
1061              if(sl1.gt.sc.and.sl1.gt.sr1)cog=-1.           if(sl1.gt.sc.and.sl1.gt.sr1)cog=-1.
1062  c     ==============================================================  c     ==============================================================
1063           elseif(ncog.eq.2)then           elseif(ncog.eq.2)then
1064              COG = 0.              COG = 0.
1065              if(sl1.gt.sr1)then              if(sl1.gt.sr1)then
1066                 if((sl1+sc).ne.0)COG = -sl1/(sl1+sc)                         if((sl1+sc).ne.0)COG = -sl1/(sl1+sc)        
1067              elseif(sl1.lt.sr1)then              elseif(sl1.lt.sr1)then
1068                 if((sc+sr1).ne.0)COG = sr1/(sc+sr1)                                         if((sc+sr1).ne.0)COG = sr1/(sc+sr1)
1069              elseif( sl1.eq.sr1.and.sl1.ne.-9999.)then           elseif( sl1.eq.sr1.and.sl1.ne.-9999.)then
1070                 if( clsigma(indmax(ic)-1).lt.clsigma(indmax(ic)+1)                 if( clsigma(indmax(ic)-1).lt.clsigma(indmax(ic)+1)
1071       $              .and.(sl1+sc).ne.0 )cog = -sl1/(sl1+sc)       $              .and.(sl1+sc).ne.0 )cog = -sl1/(sl1+sc)
1072                 if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)                 if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)
1073       $              .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1)       $              .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1)
1074              endif           endif
1075  c            if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)  c            if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)
1076  c     $           ,' : ',sl2,sl1,sc,sr1,sr2  c     $           ,' : ',sl2,sl1,sc,sr1,sr2
1077  c     ==============================================================  c     ==============================================================
# Line 1080  ' 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 1166  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 1355  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 1550  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 1567  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 1686  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 1771  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 1862  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 1952  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 2024  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 2091  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 2172  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    
# Line 2211  ccc         SDE = 0. Line 2274  ccc         SDE = 0.
2274        if(DEBUG.eq.1)print*,'LANDI (ic ',ic,' ang',angle,') -->',pfacorr        if(DEBUG.eq.1)print*,'LANDI (ic ',ic,' ang',angle,') -->',pfacorr
2275    
2276                
2277   100  return  c 100  return
2278          return
2279        end        end
Legend:
Removed from v.1.24  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.23