      PROGRAM TRFD                                                      
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
      REAL CPU,WALL,CPU1,WALL1,TIM1,TIM2                                
      LOGICAL OUT                                                       
      COMMON/IOFILE/IR,IW                                               
      COMMON/IJPAIR/IA(255)                                             
      COMMON/MEMORY/X(1000000)                                          
      COMMON/TRFPAR/NUM,NORB                                            
      DATA MAX /1000000/                                                
CX00001 CALL MAINIX (1)                                                 
CY00001 CALL MAINIY (1)                                                 
CX60000 CALL CNTINX ()                                                  
CY60000 CALL CNTINY ()                                                  
C                                                                       
      CALL CPUTIM(CPU)                                                  
      CALL ELAPSE(WALL)                                                 
      OPEN(1,FILE='TIV')                                                
      OPEN(6,FILE='TIO6')                                               
      WRITE(1,1)                                                        
1     FORMAT(1X,
     * 'OUTPUT FOR PERFECT CLUB BENCHMARK: TRFD INSTRUMENTED VERSION'/
     *       1X,'$Revision: 1.A.1 $ $Author: psharma $'/)                    
                                                                        
      IR=5                                                              
      IW=6                                                              
      OUT=.FALSE.                                                       
CX10501 CALL DOINX( 501 )                                               
CY10501 CALL DOINY( 501 )                                               
C     CALL XUFLOW(0)                                                    
C                                                                       
C     ----- SET MO'S AND AO INTEGRALS -----                             
C                                                                       
      DO 30 NUM=10,40,5                                                 
C                                                                       
      DO 10 I=1,NUM                                                     
   10 IA(I)=(I*(I-1))/2                                                 
      NORB=NUM                                                          
C                                                                       
      NP=NUM                                                            
      NPQ=(NUM*(NUM+1))/2                                               
      NRS=(NUM*(NUM+1))/2                                               
      I00=1                                                             
      I10=I00+NUM*NUM                                                   
      I20=I10+NUM                                                       
      I30=I20+NORB*NUM                                                  
      I40=I30+NPQ*NRS                                                   
      LAST=I40                                                          
      NEED=LAST-1                                                       
      IF(NEED.GT.MAX) WRITE(IW,9998) NUM,NEED,MAX                       
 9998 FORMAT(' NOT ENOUGH CORE. NUM,NEED,MAX = ',I4,2I10)               
      IF(NEED.GT.MAX) THEN                                              
CX70000 CALL CNTOTX ()                                                  
CY70000 CALL CNTOTY ()                                                  
CX50000 CALL MAINOX ()                                                  
CY50000 CALL MAINOY ()                                                  
      STOP                                                              
      ENDIF                                                             
C                                                                       
C     ----- CALCULATE -V- AND (IJ//KL) -----                            
C                                                                       
      CALL INTGRL(NP,NPQ,X(I00),X(I30))                                 
      IF(OUT) CALL TRFPRT(NP,NPQ,IA,X(I30),0)                           
C                                                                       
C     ----- TRANSFORM INTEGRALS -----                                   
C                                                                       
      TIME=0.0D+00                                                      
      NTRF=1                                                            
      DO 20 ITRF=1,NTRF                                                 
      CALL CPUTIM(TIM1)                                                 
      CALL OLDA(X(I00),X(I30),X(I30),X(I30),X(I30),                     
     1                 X(I20),X(I20),X(I10),X(I10),                     
     2                 NORB,NORB,NUM,NUM)                               
      CALL CPUTIM(TIM2)                                                 
      WRITE(IW,*) '  AFTER OLDA  ',X(I30)                               
      TIME=TIME+(TIM2-TIM1)                                             
   20 CONTINUE                                                          
      NIJ=(NORB*(NORB+1))/2                                             
      IF(OUT) CALL TRFPRT(NORB,NIJ,IA,X(I30),1)                         
C                                                                       
C---- MFLOP=NFLOP(NUM)                                                  
C---- FLOPS=MFLOP/TIME                                                  
      FN=FLOAT(NUM)                                                     
      FLOPS=(25.0*FN**5 + 58.0*FN**4 + 47.0*FN**3 + 14.0*FN**2 )/24.0   
      FLOPS=FLOPS*2.0                                                   
      FLOPS=FLOPS/TIME                                                  
      FLOPS=FLOPS/1.0D+06                                               
      WRITE(IW,9999) NUM,TIME,FLOPS,MFLOP                               
 9999 FORMAT(' NUM = ',I3,' TIME = ',F12.3,                             
     1       ' (SEC.) . (MFLOPS=',F5.2,' NFLOP=',I15,')')               
C                                                                       
   30 CONTINUE                                                          
CX20502 CALL DOOUTX( 502 )                                              
CY20502 CALL DOOUTY( 502 )                                              
      WRITE(1,2)                                                        
      WRITE(1,5) X(I30)                                                 
      IF (X(I30) .GT. 106352.   .AND.   X(I30) .LT. 106353) THEN        
        WRITE(1,3)                                                      
      ELSE                                                              
        WRITE(1,4)                                                      
      ENDIF                                                             
C                                                                       
      CALL CPUTIM (CPU1)                                                
      CALL ELAPSE (WALL1)                                               
      WRITE (IW,9997) CPU1-CPU,MOD(WALL1-WALL+1000000.0,1000000.0)      
 9997 FORMAT (                                                          
     1 ' TOTAL ELAPSED CPU TIME = ',F15.5,' SECONDS. '/                 
     2 ' TOTAL ELAPSED WALL CLOCK TIME = ',F15.5,' SECONDS. ')          
      WRITE(1,*)                                                        
      WRITE(1,*) 'ELAPSED CPU TIME IN SECONDS: ',CPU1-CPU               
C MFLOPS = MFLOP 1 CPU CRAY X-MP/CPU TIME                               
      WRITE(1,*) 'MFLOPS RATE: ', 430.877/(CPU1-CPU)                    
      WRITE(1,*) 'ELAPSED WALLCLOCK TIME IN SECONDS: ',                 
     *            MOD(WALL1-WALL+1000000.0,1000000.0)                   
2     FORMAT(1X,'VALIDATION PARAMETERS:'/)                              
3     FORMAT(//1X,'RESULTS FOR THIS RUN ARE:   VALID')                  
4     FORMAT(//1X,'RESULTS FOR THIS RUN ARE: INVALID')                  
5     FORMAT(1X,E12.5)                                                  
CX70000 CALL CNTOTX ()                                                  
CY70000 CALL CNTOTY ()                                                  
CX50000 CALL MAINOX ()                                                  
CY50000 CALL MAINOY ()                                                  
      STOP                                                              
      END                                                               
      SUBROUTINE INTGRL(NP,NPQ,V,X)                                     
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
C     COMMON/IJPAIR/IA(1)  ***COMMON BLOCK SIZE MUST BE THE SAME        
C                          ***IN ALL SUBPROGRAMS (ANSI) 3/7/89          
      COMMON/IJPAIR/IA(255)                                             
      DIMENSION V(NP,1),X(NPQ,1)                                        
CX30003 CALL SBINX (3)                                                  
CY30003 CALL SBINY (3)                                                  
CX10503 CALL DOINX( 503 )                                               
CY10503 CALL DOINY( 503 )                                               
C                                                                       
      DO 20 J=1,NP                                                      
      DUM1=DBLE(J)                                                      
      DO 10 I=1,NP                                                      
      DUM2=DBLE(I)                                                      
      V(I,J)=1.0D+00-1.0D+00/(DUM1+DUM2)                                
   10 CONTINUE                                                          
   20 CONTINUE                                                          
CX20504 CALL DOOUTX( 504 )                                              
CY20504 CALL DOOUTY( 504 )                                              
CX10505 CALL DOINX( 505 )                                               
CY10505 CALL DOINY( 505 )                                               
C                                                                       
      DO 140 I=1,NP                                                     
      DO 130 J=1,I                                                      
      IJ=IA(I)+J                                                        
      A=1.0D+00/(I+J)                                                   
      DO 120 K=1,I                                                      
      MAXL=K                                                            
      IF(K.EQ.I) MAXL=J                                                 
      DO 110 L=1,MAXL                                                   
      KL=IA(K)+L                                                        
      B=1.0D+00/(K+L)                                                   
      VAL=A+B                                                           
      IF(I.EQ.J) VAL=VAL*0.5D+00                                        
      IF(K.EQ.L) VAL=VAL*0.5D+00                                        
      X(IJ,KL)=VAL                                                      
      X(KL,IJ)=VAL                                                      
  110 CONTINUE                                                          
  120 CONTINUE                                                          
  130 CONTINUE                                                          
  140 CONTINUE                                                          
CX20506 CALL DOOUTX( 506 )                                              
CY20506 CALL DOOUTY( 506 )                                              
CX40004 CALL SBOUTX (4)                                                 
CY40004 CALL SBOUTY (4)                                                 
C                                                                       
      RETURN                                                            
      END                                                               
      SUBROUTINE TRFA(V,XRSPQ,XRSIJ,XIJRS,XIJKL,                        
     1 XRSIQ,XIJKS,XIJ,XKL,NORB,MORB,NUM,NDIM)                          
C                                                                       
C     ----- THIS IS THE ORIGINAL -TRFCOR- FROM -HONDO- -----            
C                                                                       
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
      DIMENSION V(NDIM,1)                                               
      DIMENSION XRSPQ(1),XRSIJ(1),XIJRS(1),XIJKL(1)                     
      DIMENSION XRSIQ(MORB,1),XIJKS(MORB,1),XIJ(1),XKL(1)               
      DATA ZERO /0.0D+00/                                               
CX30005 CALL SBINX (5)                                                  
CY30005 CALL SBINY (5)                                                  
C                                                                       
C     ----- TRANSFORM -P- AND -Q- -----                                 
C                                                                       
      NRS=(NUM*(NUM+1))/2                                               
      NP=NUM                                                            
      NQ=NUM                                                            
      MRSIJ0=0                                                          
      MRSPQ=0                                                           
CX10507 CALL DOINX( 507 )                                               
CY10507 CALL DOINY( 507 )                                               
C                                                                       
      DO 100 MRS=1,NRS                                                  
C                                                                       
      DO 10 MQ=1,NQ                                                     
      DO 10 MI=1,MORB                                                   
   10 XRSIQ(MI,MQ)=ZERO                                                 
      DO 40 MP=1,NP                                                     
      DO 30 MQ=1,MP                                                     
      MRSPQ=MRSPQ+1                                                     
      VAL=XRSPQ(MRSPQ)                                                  
C---- IF(VAL.EQ.ZERO) GO TO 30                                          
      DO 20 MI=1,MORB                                                   
      XRSIQ(MI,MQ)=XRSIQ(MI,MQ)+VAL*V(MP,MI)                            
      XRSIQ(MI,MP)=XRSIQ(MI,MP)+VAL*V(MQ,MI)                            
   20 CONTINUE                                                          
   30 CONTINUE                                                          
   40 CONTINUE                                                          
C                                                                       
      MRSIJ=MRSIJ0                                                      
      DO 90 MI=1,MORB                                                   
      DO 50 MJ=1,MI                                                     
   50 XIJ(MJ)=ZERO                                                      
      DO 70 MQ=1,NQ                                                     
      VAL=XRSIQ(MI,MQ)                                                  
C---- IF(VAL.EQ.ZERO) GO TO 70                                          
      DO 60 MJ=1,MI                                                     
   60 XIJ(MJ)=XIJ(MJ)+VAL*V(MQ,MJ)                                      
   70 CONTINUE                                                          
      DO 80 MJ=1,MI                                                     
      MRSIJ=MRSIJ+1                                                     
   80 XRSIJ(MRSIJ)=XIJ(MJ)                                              
   90 CONTINUE                                                          
C                                                                       
      MRSIJ0=MRSIJ0+NRS                                                 
  100 CONTINUE                                                          
CX20508 CALL DOOUTX( 508 )                                              
CY20508 CALL DOOUTY( 508 )                                              
C                                                                       
C     ----- TRANSPOSE (R,S//I,J) -----                                  
C                                                                       
      NIJ=(MORB*(MORB+1))/2                                             
      MRSIJ=0                                                           
CX10509 CALL DOINX( 509 )                                               
CY10509 CALL DOINY( 509 )                                               
      DO 120 MRS=1,NRS                                                  
      MIJRS=0                                                           
      MAX=MRS                                                           
      IF(MAX.GT.NIJ) MAX=NIJ                                            
      DO 110 MIJ=1,MAX                                                  
      DUM=XRSIJ(MRSIJ+MIJ)                                              
      XIJRS(MRSIJ+MIJ)=XRSIJ(MIJRS+MRS)                                 
      XIJRS(MIJRS+MRS)=DUM                                              
  110 MIJRS=MIJRS+NRS                                                   
  120 MRSIJ=MRSIJ+NRS                                                   
CX20510 CALL DOOUTX( 510 )                                              
CY20510 CALL DOOUTY( 510 )                                              
C                                                                       
C     ----- TRANSFORM -R- AND -S- -----                                 
C                                                                       
      NR=NUM                                                            
      NS=NUM                                                            
      MIJKL=0                                                           
      MIJRS=0                                                           
      MIJ=0                                                             
      MLEFT=NRS-NIJ                                                     
CX10511 CALL DOINX( 511 )                                               
CY10511 CALL DOINY( 511 )                                               
C                                                                       
      DO 300 MI=1,MORB                                                  
      DO 300 MJ=1,MI                                                    
      MIJ=MIJ+1                                                         
C                                                                       
      DO 210 MS=1,NS                                                    
      DO 210 MK=MI,MORB                                                 
  210 XIJKS(MK,MS)=ZERO                                                 
      DO 240 MR=1,NR                                                    
      DO 230 MS=1,MR                                                    
      MIJRS=MIJRS+1                                                     
      VAL=XIJRS(MIJRS)                                                  
C---- IF(VAL.EQ.ZERO) GO TO 230                                         
      DO 220 MK=MI,MORB                                                 
      XIJKS(MK,MS)=XIJKS(MK,MS)+VAL*V(MR,MK)                            
      XIJKS(MK,MR)=XIJKS(MK,MR)+VAL*V(MS,MK)                            
  220 CONTINUE                                                          
  230 CONTINUE                                                          
  240 CONTINUE                                                          
C                                                                       
      LMIN=MJ                                                           
      LMAX=MI                                                           
      DO 290 MK=MI,MORB                                                 
      DO 250 ML=LMIN,LMAX                                               
  250 XKL(ML)=ZERO                                                      
      DO 270 MS=1,NS                                                    
      VAL=XIJKS(MK,MS)                                                  
C---- IF(VAL.EQ.ZERO) GO TO 270                                         
      DO 260 ML=LMIN,LMAX                                               
  260 XKL(ML)=XKL(ML)+VAL*V(MS,ML)                                      
  270 CONTINUE                                                          
      DO 280 ML=LMIN,LMAX                                               
      MIJKL=MIJKL+1                                                     
  280 XIJKL(MIJKL)=XKL(ML)                                              
      LMIN=1                                                            
      LMAX=MK+1                                                         
  290 CONTINUE                                                          
      MIJKL=MIJKL+MIJ+MLEFT                                             
C                                                                       
  300 CONTINUE                                                          
CX20512 CALL DOOUTX( 512 )                                              
CY20512 CALL DOOUTY( 512 )                                              
CX40006 CALL SBOUTX (6)                                                 
CY40006 CALL SBOUTY (6)                                                 
      RETURN                                                            
      END                                                               
      SUBROUTINE OLDA(V,XRSPQ,XRSIJ,XIJRS,XIJKL,                        
     1 XRSIQ,XIJKS,XIJ,XKL,NORB,MORB,NUM,NDIM)                          
C                                                                       
C     ----- THIS IS THE ORIGINAL -TRFCOR- FROM -HONDO- -----            
C                                                                       
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
      DIMENSION V(NDIM,1)                                               
      DIMENSION XRSPQ(1),XRSIJ(1),XIJRS(1),XIJKL(1)                     
      DIMENSION XRSIQ(MORB,1),XIJKS(MORB,1),XIJ(1),XKL(1)               
      DATA ZERO /0.0D+00/                                               
CX30007 CALL SBINX (7)                                                  
CY30007 CALL SBINY (7)                                                  
C                                                                       
C     ----- TRANSFORM -P- AND -Q- -----                                 
C                                                                       
      NRS=(NUM*(NUM+1))/2                                               
      NP=NUM                                                            
      NQ=NUM                                                            
      MRSIJ0=0                                                          
      MRSPQ=0                                                           
CX10513 CALL DOINX( 513 )                                               
CY10513 CALL DOINY( 513 )                                               
C                                                                       
      DO 100 MRS=1,NRS                                                  
C                                                                       
      DO 10 MQ=1,NQ                                                     
      DO 10 MI=1,MORB                                                   
   10 XRSIQ(MI,MQ)=ZERO                                                 
      DO 40 MP=1,NP                                                     
      DO 30 MQ=1,MP                                                     
      MRSPQ=MRSPQ+1                                                     
      VAL=XRSPQ(MRSPQ)                                                  
      IF(VAL.EQ.ZERO) GO TO 30                                          
      DO 20 MI=1,MORB                                                   
      XRSIQ(MI,MQ)=XRSIQ(MI,MQ)+VAL*V(MP,MI)                            
      XRSIQ(MI,MP)=XRSIQ(MI,MP)+VAL*V(MQ,MI)                            
   20 CONTINUE                                                          
   30 CONTINUE                                                          
   40 CONTINUE                                                          
C                                                                       
      MRSIJ=MRSIJ0                                                      
      DO 90 MI=1,MORB                                                   
      DO 50 MJ=1,MI                                                     
   50 XIJ(MJ)=ZERO                                                      
      DO 70 MQ=1,NQ                                                     
      VAL=XRSIQ(MI,MQ)                                                  
      IF(VAL.EQ.ZERO) GO TO 70                                          
      DO 60 MJ=1,MI                                                     
   60 XIJ(MJ)=XIJ(MJ)+VAL*V(MQ,MJ)                                      
   70 CONTINUE                                                          
      DO 80 MJ=1,MI                                                     
      MRSIJ=MRSIJ+1                                                     
   80 XRSIJ(MRSIJ)=XIJ(MJ)                                              
   90 CONTINUE                                                          
C                                                                       
      MRSIJ0=MRSIJ0+NRS                                                 
  100 CONTINUE                                                          
CX20514 CALL DOOUTX( 514 )                                              
CY20514 CALL DOOUTY( 514 )                                              
C                                                                       
C     ----- TRANSPOSE (R,S//I,J) -----                                  
C                                                                       
      NIJ=(MORB*(MORB+1))/2                                             
      MRSIJ=0                                                           
CX10515 CALL DOINX( 515 )                                               
CY10515 CALL DOINY( 515 )                                               
      DO 120 MRS=1,NRS                                                  
      MIJRS=0                                                           
      MAX=MRS                                                           
      IF(MAX.GT.NIJ) MAX=NIJ                                            
      DO 110 MIJ=1,MAX                                                  
      DUM=XRSIJ(MRSIJ+MIJ)                                              
      XIJRS(MRSIJ+MIJ)=XRSIJ(MIJRS+MRS)                                 
      XIJRS(MIJRS+MRS)=DUM                                              
  110 MIJRS=MIJRS+NRS                                                   
  120 MRSIJ=MRSIJ+NRS                                                   
CX20516 CALL DOOUTX( 516 )                                              
CY20516 CALL DOOUTY( 516 )                                              
C                                                                       
C     ----- TRANSFORM -R- AND -S- -----                                 
C                                                                       
      NR=NUM                                                            
      NS=NUM                                                            
      MIJKL=0                                                           
      MIJRS=0                                                           
      MIJ=0                                                             
      MLEFT=NRS-NIJ                                                     
CX10517 CALL DOINX( 517 )                                               
CY10517 CALL DOINY( 517 )                                               
C                                                                       
      DO 300 MI=1,MORB                                                  
      DO 300 MJ=1,MI                                                    
      MIJ=MIJ+1                                                         
C                                                                       
      DO 210 MS=1,NS                                                    
      DO 210 MK=MI,MORB                                                 
  210 XIJKS(MK,MS)=ZERO                                                 
      DO 240 MR=1,NR                                                    
      DO 230 MS=1,MR                                                    
      MIJRS=MIJRS+1                                                     
      VAL=XIJRS(MIJRS)                                                  
      IF(VAL.EQ.ZERO) GO TO 230                                         
      DO 220 MK=MI,MORB                                                 
      XIJKS(MK,MS)=XIJKS(MK,MS)+VAL*V(MR,MK)                            
      XIJKS(MK,MR)=XIJKS(MK,MR)+VAL*V(MS,MK)                            
  220 CONTINUE                                                          
  230 CONTINUE                                                          
  240 CONTINUE                                                          
C                                                                       
      LMIN=MJ                                                           
      LMAX=MI                                                           
      DO 290 MK=MI,MORB                                                 
      DO 250 ML=LMIN,LMAX                                               
  250 XKL(ML)=ZERO                                                      
      DO 270 MS=1,NS                                                    
      VAL=XIJKS(MK,MS)                                                  
      IF(VAL.EQ.ZERO) GO TO 270                                         
      DO 260 ML=LMIN,LMAX                                               
  260 XKL(ML)=XKL(ML)+VAL*V(MS,ML)                                      
  270 CONTINUE                                                          
      DO 280 ML=LMIN,LMAX                                               
      MIJKL=MIJKL+1                                                     
  280 XIJKL(MIJKL)=XKL(ML)                                              
      LMIN=1                                                            
      LMAX=MK+1                                                         
  290 CONTINUE                                                          
      MIJKL=MIJKL+MIJ+MLEFT                                             
C                                                                       
  300 CONTINUE                                                          
CX20518 CALL DOOUTX( 518 )                                              
CY20518 CALL DOOUTY( 518 )                                              
CX40008 CALL SBOUTX (8)                                                 
CY40008 CALL SBOUTY (8)                                                 
      RETURN                                                            
      END                                                               
      SUBROUTINE TRFPRT(NORB,NIJ,IA,TX,JFLAG)                           
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
      COMMON/IOFILE/IR,IW                                               
      COMMON/TR2PRT/VALINT(3),JC,JCINT(15)                              
      DIMENSION TX(NIJ,1),IA(1)                                         
C                                                                       
 1000 FORMAT(' AO 2E-INTEGRALS : ')                                     
 1010 FORMAT(' TRANSFORMED 2E-INTEGRALS : ')                            
 1020 FORMAT(' TOTAL NUMBER OF AO 2E-INTEGRALS  = ',I10)                
 1030 FORMAT(' TOTAL NUMBER OF TRANSFORMED 2E-INTEGRALS  = ',I10)       
CX30009 CALL SBINX (9)                                                  
CY30009 CALL SBINY (9)                                                  
C                                                                       
      IF(JFLAG.EQ.0) WRITE(IW,1000)                                     
      IF(JFLAG.EQ.1) WRITE(IW,1010)                                     
C                                                                       
      JC=0                                                              
      NX=0                                                              
CX10519 CALL DOINX( 519 )                                               
CY10519 CALL DOINY( 519 )                                               
      DO 140 I=1,NORB                                                   
      DO 130 J=1,I                                                      
      DO 120 K=1,I                                                      
      LMAX=K                                                            
      IF(K.EQ.I) LMAX=J                                                 
      DO 110 L=1,LMAX                                                   
      NX=NX+1                                                           
      IJ=IA(I)+J                                                        
      KL=IA(K)+L                                                        
      VAL=TX(IJ,KL)                                                     
      CALL TRFOUT(I,J,K,L,NX,VAL,0)                                     
  110 CONTINUE                                                          
  120 CONTINUE                                                          
  130 CONTINUE                                                          
  140 CONTINUE                                                          
CX20520 CALL DOOUTX( 520 )                                              
CY20520 CALL DOOUTY( 520 )                                              
      IF(JFLAG.EQ.0) WRITE(IW,1020) NX                                  
      IF(JFLAG.EQ.1) WRITE(IW,1030) NX                                  
CX40010 CALL SBOUTX (10)                                                
CY40010 CALL SBOUTY (10)                                                
      RETURN                                                            
      END                                                               
      SUBROUTINE TRFOUT(I,J,K,L,N,VAL,NCALL)                            
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)                               
      COMMON/IOFILE/IR,IW                                               
      COMMON/TR2PRT/V(3),JC,J1(3),J2(3),J3(3),J4(3),N1(3)               
CX30011 CALL SBINX (11)                                                 
CY30011 CALL SBINY (11)                                                 
      IF(NCALL.NE.0) GO TO 10                                           
      JC=JC+1                                                           
      J1(JC)=I                                                          
      J2(JC)=J                                                          
      J3(JC)=K                                                          
      J4(JC)=L                                                          
      N1(JC)=N                                                          
      V(JC)=VAL                                                         
      IF(JC.LT.3) THEN                                                  
CX40012 CALL SBOUTX (12)                                                
CY40012 CALL SBOUTY (12)                                                
      RETURN                                                            
      ENDIF                                                             
   10 CONTINUE                                                          
      IF(JC.EQ.0) THEN                                                  
CX40012 CALL SBOUTX (12)                                                
CY40012 CALL SBOUTY (12)                                                
      RETURN                                                            
      ENDIF                                                             
      WRITE(IW,9999) (J1(M),J2(M),J3(M),J4(M),N1(M),V(M),M=1,JC)        
      JC=0                                                              
 9999 FORMAT(3(4I3,I5,E20.12))                                          
CX40012 CALL SBOUTX (12)                                                
CY40012 CALL SBOUTY (12)                                                
      RETURN                                                            
      END                                                               
      FUNCTION NFLOP(N)                                                 
CX30013 CALL SBINX (13)                                                 
CY30013 CALL SBINY (13)                                                 
      NFLP=0                                                            
      MORB=N                                                            
      NRS=(N*(N+1))/2                                                   
      NP=N                                                              
      NQ=N                                                              
CX10521 CALL DOINX( 521 )                                               
CY10521 CALL DOINY( 521 )                                               
      DO 100 MRS=1,NRS                                                  
      DO 40 MP=1,NP                                                     
      DO 30 MQ=1,MP                                                     
      DO 20 MI=1,MORB                                                   
      NFLP=NFLP+(2+2)                                                   
   20 CONTINUE                                                          
   30 CONTINUE                                                          
   40 CONTINUE                                                          
      DO 90 MI=1,MORB                                                   
      DO 70 MQ=1,NQ                                                     
      DO 60 MJ=1,MI                                                     
      NFLP=NFLP+(1+1)                                                   
   60 CONTINUE                                                          
   70 CONTINUE                                                          
   90 CONTINUE                                                          
  100 CONTINUE                                                          
CX20522 CALL DOOUTX( 522 )                                              
CY20522 CALL DOOUTY( 522 )                                              
C                                                                       
      NR=N                                                              
      NS=N                                                              
CX10523 CALL DOINX( 523 )                                               
CY10523 CALL DOINY( 523 )                                               
      DO 300 MI=1,MORB                                                  
      DO 300 MJ=1,MI                                                    
      DO 240 MR=1,NR                                                    
      DO 230 MS=1,MR                                                    
      DO 220 MK=MI,MORB                                                 
      NFLP=NFLP+(2+2)                                                   
  220 CONTINUE                                                          
  230 CONTINUE                                                          
  240 CONTINUE                                                          
      LMIN=MJ                                                           
      LMAX=MI                                                           
      DO 290 MK=MI,MORB                                                 
      DO 270 MS=1,NS                                                    
      DO 260 L=LMIN,LMAX                                                
      NFLP=NFLP+(1+1)                                                   
  260 CONTINUE                                                          
  270 CONTINUE                                                          
      LMIN=1                                                            
      LMAX=MK+1                                                         
  290 CONTINUE                                                          
  300 CONTINUE                                                          
CX20524 CALL DOOUTX( 524 )                                              
CY20524 CALL DOOUTY( 524 )                                              
C                                                                       
      NFLOP=NFLP                                                        
CX40014 CALL SBOUTX (14)                                                
CY40014 CALL SBOUTY (14)                                                
      RETURN                                                            
      END                                                               
                                                                        
