/[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.9 by pam-fi, Fri Apr 27 10:39:58 2007 UTC revision 1.14 by pam-fi, Tue Aug 7 13:56:29 2007 UTC
# Line 1  Line 1 
1    
2    
3          subroutine idtoc(ipfa,cpfa)
4          
5          integer ipfa
6          character*4 cpfa
7    
8          CPFA='COG4'
9          if(ipfa.eq.0)CPFA='ETA'
10          if(ipfa.eq.2)CPFA='ETA2'
11          if(ipfa.eq.3)CPFA='ETA3'
12          if(ipfa.eq.4)CPFA='ETA4'
13          if(ipfa.eq.10)CPFA='COG'
14          if(ipfa.eq.11)CPFA='COG1'
15          if(ipfa.eq.12)CPFA='COG2'
16          if(ipfa.eq.13)CPFA='COG3'
17          if(ipfa.eq.14)CPFA='COG4'
18          
19          end
20    
21  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
22  *     this file contains all subroutines and functions  *     this file contains all subroutines and functions
23  *     that are needed for position finding algorithms  *     that are needed for position finding algorithms
# Line 145  c      print*,pfastrips Line 164  c      print*,pfastrips
164        end        end
165    
166  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
167        real function ris_eta(ic,angle)  c      real function riseta(ic,angle)
168          real function riseta(iview,angle)
169  *--------------------------------------------------------------  *--------------------------------------------------------------
170  *     this function returns the average spatial resolution  *     this function returns the average spatial resolution
171  *     (in cm) for the ETA algorithm (function pfaeta(ic,angle))  *     (in cm) for the ETA algorithm (function pfaeta(ic,angle))
172  *     it calls:  *     it calls:
173  *     - risx_eta2(angle)  *     - risxeta2(angle)
174  *     - risy_eta2(angle)  *     - risyeta2(angle)
175  *     - risx_eta3(angle)  *     - risxeta3(angle)
176  *     - risx_eta4(angle)  *     - risxeta4(angle)
177  *     according to the angle  *     according to the angle
178  *--------------------------------------------------------------  *--------------------------------------------------------------
179        include 'commontracker.f'        include 'commontracker.f'
180        include 'level1.f'        include 'level1.f'
181        include 'calib.f'        include 'calib.f'
182    
183        ris_eta = 0        riseta = 0
184    
185        if(mod(int(VIEW(ic)),2).eq.1)then !Y-view  c      if(mod(int(VIEW(ic)),2).eq.1)then !Y-view
186          if(mod(iview,2).eq.1)then !Y-view
187                
188    
189           if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then           if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then
190              ris_eta = risy_eta2(angle)              riseta = risyeta2(angle)
191           elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then           elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then
192              ris_eta = risy_cog(angle) !ATTENZIONE!!              riseta = risy_cog(angle) !ATTENZIONE!!
193           elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then           elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then
194              ris_eta = risy_cog(angle) !ATTENZIONE!!              riseta = risy_cog(angle) !ATTENZIONE!!
195           else           else
196              ris_eta = risy_cog(angle)              riseta = risy_cog(angle)
197           endif                       endif            
198    
199        else                      !X-view        else                      !X-view
200    
201           if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then           if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then
202              ris_eta = risx_eta2(angle)              riseta = risxeta2(angle)
203           elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then           elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then
204              ris_eta = risx_eta3(angle)              riseta = risxeta3(angle)
205           elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then           elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then
206              ris_eta = risx_eta4(angle)              riseta = risxeta4(angle)
207           else           else
208              ris_eta = risx_cog(angle)              riseta = risx_cog(angle)
209           endif                       endif            
210                            
211        endif        endif
212    
213    cc      print*,'---- ',riseta,iview,angle
214    
215   100  return   100  return
216        end        end
217    
# Line 589  c$$$      endif Line 612  c$$$      endif
612    
613    
614  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
615        real function cog0(ncog,ic)  c$$$      real function cog0(ncog,ic)
616  *-------------------------------------------------  c$$$*-------------------------------------------------
617  *     this function returns  c$$$*     this function returns
618  *  c$$$*
619  *     - the Center-Of-Gravity of the cluster IC  c$$$*     - the Center-Of-Gravity of the cluster IC
620  *     evaluated using NCOG strips,  c$$$*     evaluated using NCOG strips,
621  *     calculated relative to MAXS(IC)  c$$$*     calculated relative to MAXS(IC)
622  *      c$$$*    
623  *     - zero in case that not  enough strips  c$$$*     - zero in case that not  enough strips
624  *     have a positive signal  c$$$*     have a positive signal
625  *      c$$$*    
626  *     NOTE:  c$$$*     NOTE:
627  *     This is the old definition, used by Straulino.  c$$$*     This is the old definition, used by Straulino.
628  *     The new routine, according to Landi,  c$$$*     The new routine, according to Landi,
629  *     is COG(NCOG,IC)  c$$$*     is COG(NCOG,IC)
630  *-------------------------------------------------  c$$$*-------------------------------------------------
631    c$$$
632    c$$$
633        include 'commontracker.f'  c$$$      include 'commontracker.f'
634        include 'level1.f'  c$$$      include 'level1.f'
635          c$$$      
636  *     --> signal of the central strip  c$$$*     --> signal of the central strip
637        sc = CLSIGNAL(INDMAX(ic)) !center  c$$$      sc = CLSIGNAL(INDMAX(ic)) !center
638    c$$$
639  *     signal of adjacent strips  c$$$*     signal of adjacent strips
640  *     --> left  c$$$*     --> left
641        sl1 = 0                  !left 1  c$$$      sl1 = 0                  !left 1
642        if(  c$$$      if(
643       $     (INDMAX(ic)-1).ge.INDSTART(ic)  c$$$     $     (INDMAX(ic)-1).ge.INDSTART(ic)
644       $     )  c$$$     $     )
645       $     sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1))  c$$$     $     sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1))
646    c$$$
647        sl2 = 0                  !left 2  c$$$      sl2 = 0                  !left 2
648        if(  c$$$      if(
649       $     (INDMAX(ic)-2).ge.INDSTART(ic)  c$$$     $     (INDMAX(ic)-2).ge.INDSTART(ic)
650       $     )  c$$$     $     )
651       $     sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2))  c$$$     $     sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2))
652    c$$$
653  *     --> right  c$$$*     --> right
654        sr1 = 0                  !right 1  c$$$      sr1 = 0                  !right 1
655        if(  c$$$      if(
656       $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))  c$$$     $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))
657       $     .or.  c$$$     $     .or.
658       $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)  c$$$     $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH)
659       $     )  c$$$     $     )
660       $     sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1))  c$$$     $     sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1))
661    c$$$
662        sr2 = 0                  !right 2  c$$$      sr2 = 0                  !right 2
663        if(  c$$$      if(
664       $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))  c$$$     $     (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))
665       $     .or.  c$$$     $     .or.
666       $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)  c$$$     $     (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH)
667       $     )  c$$$     $     )
668       $     sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2))  c$$$     $     sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2))
669          c$$$      
670  ************************************************************  c$$$************************************************************
671  *     COG computation  c$$$*     COG computation
672  ************************************************************  c$$$************************************************************
673    c$$$
674  c      print*,sl2,sl1,sc,sr1,sr2  c$$$c      print*,sl2,sl1,sc,sr1,sr2
675    c$$$
676        COG = 0.  c$$$      COG = 0.
677            c$$$        
678        if(sl1.gt.sr1.and.sl1.gt.0.)then  c$$$      if(sl1.gt.sr1.and.sl1.gt.0.)then
679            c$$$        
680           if(ncog.eq.2.and.sl1.ne.0)then  c$$$         if(ncog.eq.2.and.sl1.ne.0)then
681              COG = -sl1/(sl1+sc)          c$$$            COG = -sl1/(sl1+sc)        
682           elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then  c$$$         elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then
683              COG = (sr1-sl1)/(sl1+sc+sr1)  c$$$            COG = (sr1-sl1)/(sl1+sc+sr1)
684           elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then  c$$$         elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then
685              COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1)  c$$$            COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1)
686           else  c$$$         else
687              COG = 0.  c$$$            COG = 0.
688           endif  c$$$         endif
689            c$$$        
690        elseif(sl1.le.sr1.and.sr1.gt.0.)then  c$$$      elseif(sl1.le.sr1.and.sr1.gt.0.)then
691    c$$$
692           if(ncog.eq.2.and.sr1.ne.0)then  c$$$         if(ncog.eq.2.and.sr1.ne.0)then
693              COG = sr1/(sc+sr1)              c$$$            COG = sr1/(sc+sr1)            
694           elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then  c$$$         elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then
695              COG = (sr1-sl1)/(sl1+sc+sr1)  c$$$            COG = (sr1-sl1)/(sl1+sc+sr1)
696           elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then  c$$$         elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then
697              COG = (2*sr2+sr1-sl1)/(sl2+sl1+sc+sr1)  c$$$            COG = (2*sr2+sr1-sl1)/(sl2+sl1+sc+sr1)
698           else  c$$$         else
699              COG = 0.  c$$$            COG = 0.
700           endif  c$$$         endif
701    c$$$
702        endif  c$$$      endif
703    c$$$
704        COG0 = COG  c$$$      COG0 = COG
705    c$$$
706  c      print *,ncog,ic,cog,'/////////////'  c$$$c      print *,ncog,ic,cog,'/////////////'
707    c$$$
708        return  c$$$      return
709        end  c$$$      end
710    
711  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
712        real function cog(ncog,ic)        real function cog(ncog,ic)
# Line 715  c      print *,ncog,ic,cog,'//////////// Line 738  c      print *,ncog,ic,cog,'////////////
738  *     --> signal of the central strip  *     --> signal of the central strip
739           sc = CLSIGNAL(INDMAX(ic)) !center           sc = CLSIGNAL(INDMAX(ic)) !center
740  *     signal of adjacent strips  *     signal of adjacent strips
741           sl1 = 0                !left 1           sl1 = -9999.           !left 1
742           if(           if(
743       $        (INDMAX(ic)-1).ge.INDSTART(ic)       $        (INDMAX(ic)-1).ge.INDSTART(ic)
744       $        )       $        )
745       $        sl1 = CLSIGNAL(INDMAX(ic)-1)       $        sl1 = CLSIGNAL(INDMAX(ic)-1)
746                    
747           sl2 = 0                !left 2           sl2 = -9999.           !left 2
748           if(           if(
749       $        (INDMAX(ic)-2).ge.INDSTART(ic)       $        (INDMAX(ic)-2).ge.INDSTART(ic)
750       $        )       $        )
751       $        sl2 = CLSIGNAL(INDMAX(ic)-2)       $        sl2 = CLSIGNAL(INDMAX(ic)-2)
752                    
753           sr1 = 0                !right 1           sr1 = -9999.           !right 1
754           if(           if(
755       $        (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))       $        (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1))
756       $        .or.       $        .or.
# Line 735  c      print *,ncog,ic,cog,'//////////// Line 758  c      print *,ncog,ic,cog,'////////////
758       $        )       $        )
759       $        sr1 = CLSIGNAL(INDMAX(ic)+1)       $        sr1 = CLSIGNAL(INDMAX(ic)+1)
760                    
761           sr2 = 0                !right 2           sr2 = -9999.           !right 2
762           if(           if(
763       $        (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))       $        (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1))
764       $        .or.       $        .or.
# Line 747  c      print *,ncog,ic,cog,'//////////// Line 770  c      print *,ncog,ic,cog,'////////////
770                    
771  c         print*,'## ',sl2,sl1,sc,sr1,sr2  c         print*,'## ',sl2,sl1,sc,sr1,sr2
772    
773    c     ==============================================================
774           if(ncog.eq.1)then           if(ncog.eq.1)then
775              COG = 0.              COG = 0.
776                if(sr1.gt.sc)cog=1. !NEW
777                if(sl1.gt.sc.and.sl1.gt.sr1)cog=-1. !NEW
778    c     ==============================================================
779           elseif(ncog.eq.2)then           elseif(ncog.eq.2)then
780              if(sl1.gt.sr1)then              if(sl1.gt.sr1)then
781                 if((sl1+sc).ne.0)COG = -sl1/(sl1+sc)                         if((sl1+sc).ne.0)COG = -sl1/(sl1+sc)        
782              elseif(sl1.le.sr1)then              elseif(sl1.lt.sr1)then
783                 if((sc+sr1).ne.0)COG = sr1/(sc+sr1)                             if((sc+sr1).ne.0)COG = sr1/(sc+sr1)                        
784              endif              elseif( sl1.eq.sr1.and.sl1.ne.-9999.)then !NEW
785                   if( clsigma(indmax(ic)-1).lt.clsigma(indmax(ic)+1)
786         $              .and.(sl1+sc).ne.0 )cog = -sl1/(sl1+sc) !NEW
787                   if( clsigma(indmax(ic)-1).gt.clsigma(indmax(ic)+1)
788         $              .and.(sc+sr1).ne.0 )cog = sr1/(sc+sr1) !NEW
789                endif
790    c$$$            if(cog==0)print*,'Strange cluster (2) - @maxs ',MAXS(ic)
791    c$$$     $           ,VIEW(ic),LADDER(ic)
792    c$$$     $           ,' : ',sl2,sl1,sc,sr1,sr2
793    c     ==============================================================
794           elseif(ncog.eq.3)then           elseif(ncog.eq.3)then
795               if((sl1+sc+sr1).ne.0)COG = (sr1-sl1)/(sl1+sc+sr1)               if( (sl1+sc+sr1).ne.0 )COG = (sr1-sl1)/(sl1+sc+sr1)
796    c$$$             if(cog==0)print*,'Strange cluster (3) - @maxs ',MAXS(ic)
797    c$$$     $           ,VIEW(ic),LADDER(ic)
798    c$$$     $            ,' : ',sl2,sl1,sc,sr1,sr2
799    c     ==============================================================
800           elseif(ncog.eq.4)then           elseif(ncog.eq.4)then
801              if(sl2.gt.sr2)then              if(sl2.gt.sr2)then
802                 if((sl2+sl1+sc+sr1).ne.0)                 if((sl2+sl1+sc+sr1).ne.0)
803       $              COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1)       $              COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1)
804              elseif(sl2.le.sr2)then              elseif(sl2.lt.sr2)then
805                  if((sl2+sl1+sc+sr1).ne.0)                 if((sr2+sl1+sc+sr1).ne.0)
806       $              COG = (2*sr2+sr1-sl1)/(sl2+sl1+sc+sr1)       $              COG = (2*sr2+sr1-sl1)/(sr2+sl1+sc+sr1)
807                elseif(sl2.eq.sr2.and.sl2.ne.-9999.)then !NEW
808                   if( clsigma(indmax(ic)-2).lt.clsigma(indmax(ic)+2)
809         $              .and.(sl2+sl1+sc+sr1).ne.0 )
810         $              cog = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1) !NEW
811                   if( clsigma(indmax(ic)-2).gt.clsigma(indmax(ic)+2)
812         $              .and.(sr2+sl1+sc+sr1).ne.0 )
813         $              cog = (2*sr2+sr1-sl1)/(sr2+sl1+sc+sr1)  !NEW              
814              endif              endif
815    c$$$            if(cog==0)print*,'Strange cluster (4) - @maxs ',MAXS(ic)
816    c$$$     $           ,VIEW(ic),LADDER(ic)
817    c$$$     $           ,' : ',sl2,sl1,sc,sr1,sr2
818    c     ==============================================================
819           else           else
820              print*,'function COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG              print*,'function COG(NCOG,IC) ==> WARNING!! NCOG=',NCOG
821       $           ,' not implemented'       $           ,' not implemented'
# Line 795  c         print*,'-------' Line 846  c         print*,'-------'
846                 COG = COG + ipos*CLSIGNAL(i)                 COG = COG + ipos*CLSIGNAL(i)
847                 SGN = SGN + CLSIGNAL(i)                 SGN = SGN + CLSIGNAL(i)
848                 mu = mu + 1                 mu = mu + 1
849                 print*,ipos,CLSIGNAL(i)  c               print*,ipos,CLSIGNAL(i)
850              else              else
851                 goto 10                 goto 10
852              endif              endif
# Line 808  c         print*,'-------' Line 859  c         print*,'-------'
859                 COG = COG + ipos*CLSIGNAL(i)                 COG = COG + ipos*CLSIGNAL(i)
860                 SGN = SGN + CLSIGNAL(i)                 SGN = SGN + CLSIGNAL(i)
861                 mu = mu + 1                 mu = mu + 1
862                 print*,ipos,CLSIGNAL(i)  c               print*,ipos,CLSIGNAL(i)
863              else              else
864                 goto 20                 goto 20
865              endif              endif
866           enddo           enddo
867   20      continue   20      continue
868           if(SGN.le.0)then           if(SGN.le.0)then
869  c            print*,'cog(0,ic) --> ic, dedx ',ic,SGN              print*,'cog(0,ic) --> ic, dedx ',ic,SGN
870              print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)              print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop)
871              print*,(CLSIGNAL(i),i=istart,istop)              print*,(CLSIGNAL(i),i=istart,istop)
872  c            print*,'cog(0,ic) --> NOT EVALUATED '  c            print*,'cog(0,ic) --> NOT EVALUATED '
# Line 1170  c         if(BAD(VIEW(ic),nvk(MAXS(ic)), Line 1221  c         if(BAD(VIEW(ic),nvk(MAXS(ic)),
1221    
1222  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1223    
1224        FUNCTION risx_eta2(x)        FUNCTION risxeta2(x)
1225    
1226        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
1227        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
# Line 1257  c         if(BAD(VIEW(ic),nvk(MAXS(ic)), Line 1308  c         if(BAD(VIEW(ic),nvk(MAXS(ic)),
1308     20 CONTINUE     20 CONTINUE
1309        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1310                
1311        risx_eta2=HQUADF* 1e-4        risxeta2=HQUADF* 1e-4
1312    
1313        END        END
1314    
1315  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1316        FUNCTION risx_eta3(x)        FUNCTION risxeta3(x)
1317        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
1318        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
1319        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 1348  c         if(BAD(VIEW(ic),nvk(MAXS(ic)), Line 1399  c         if(BAD(VIEW(ic),nvk(MAXS(ic)),
1399     20 CONTINUE     20 CONTINUE
1400        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1401                
1402        risx_eta3 = HQUADF* 1e-4        risxeta3 = HQUADF* 1e-4
1403    
1404        END        END
1405  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1406        FUNCTION risx_eta4(x)        FUNCTION risxeta4(x)
1407        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
1408        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
1409        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 1438  c         if(BAD(VIEW(ic),nvk(MAXS(ic)), Line 1489  c         if(BAD(VIEW(ic),nvk(MAXS(ic)),
1489     20 CONTINUE     20 CONTINUE
1490        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1491                
1492        risx_eta4=HQUADF* 1e-4        risxeta4=HQUADF* 1e-4
1493    
1494        END        END
1495  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
1496        FUNCTION risy_eta2(x)        FUNCTION risyeta2(x)
1497        DOUBLE PRECISION V( 1)        DOUBLE PRECISION V( 1)
1498        INTEGER NPAR, NDIM, IMQFUN, I, J        INTEGER NPAR, NDIM, IMQFUN, I, J
1499        DOUBLE PRECISION HQDJ, VV, VCONST        DOUBLE PRECISION HQDJ, VV, VCONST
# Line 1510  c         if(BAD(VIEW(ic),nvk(MAXS(ic)), Line 1561  c         if(BAD(VIEW(ic),nvk(MAXS(ic)),
1561     20 CONTINUE     20 CONTINUE
1562        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)        IF (IMQFUN .EQ. 2) HQUADF = VCONST * EXP (HQUADF)
1563    
1564        risy_eta2=HQUADF* 1e-4        risyeta2=HQUADF* 1e-4
1565    
1566        END        END
1567  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***  *** * * * *** * * * *** * * * *** * * * *** * * * *** * * * ***
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.23