      PROGRAM SPFLUX                                                                                                                
C     PROGRAM SPFLUX (IN,       OUT,       INPUT,       OUTPUT,         )       E2                                                  
C    1          TAPE1=IN, TAPE2=OUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                     
C     ---------------------------------------------------------                 E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     FEB 15/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     JAN 12/94 - F.MAJAESS (CORRECT "SKIP" OPTION )                                                                                
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     AUG 13/90 - F.MAJAESS (MODIFY THE CALL TO "SPECTRA")                                                                          
C     NOV   /86 - G.J.B.  (REDEFINE FLUX SO CONSISTENT FOR M CASE)                                                                  
C     NOV 24/83 - B.DUGAS.                                                                                                          
C     JUL 18/79 - TED SHEPHERD.                                                                                                     
C                                                                               E2                                                  
CSPFLUX  - COMPUTE AND PRINT SPECTRAL M OR N FLUX                       1  1 C GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - T.SHEPHERD                                                           E3                                                  
C                                                                               E3                                                  
CPURPOSE - COMPUTES THE LEITH FLUX FUNCTION OF A COMPLEX-VALUED SPECTRAL        E3                                                  
C          FILE SC(N,M) AND PRODUCES A CROSS-SECTION OF THE M OR N FLUX         E3                                                  
C          AS A FUNCTION OF HEIGHT AND WAVENUMBER. SO, IT CAN BE EITHER         E3                                                  
C          THE M-FLUX, PRINTING OUT THE RESULT FLUX(M), OR THE N-FLUX           E3                                                  
C          WITH THE RESULT FLUX(N).                                             E3                                                  
C                                                                               E3                                                  
C          FLUX(M+1)=FLUX(M)-INTR(M) WHERE INTR(M) IS THE APPROPRIATE           E3                                                  
C          INTERACTION TERM AND FLUX(0)=0 (IN MATH NOTATION). THIS IS A         E3                                                  
C          CHANGE FROM THE PREVIOUS VERSION WHERE FLUX(0)=-INTR(0) AND          E3                                                  
C          FLUX(M=+1)=FLUX(M)-INTR(M+1) WHICH CLEARLY DOESNT WORK FOR           E3                                                  
C          THE M CASE (IE FLUX(0) NOT =0).                                      E3                                                  
C                                                                               E3                                                  
C          FLUX(N+1)=FLUX(N)-INTR(N+1) IS USED FOR THE N CASE SINCE THERE       E3                                                  
C          ISN'T A PROBLEM IN THIS CASE AND FOR CONSISTENCY WITH PAST USAGE     E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      IN   = GLOBAL SPECTRAL FILE.                                             E3                                                  
C                                                                               E3                                                  
COUTPUT FILE...                                                                 E3                                                  
C                                                                               E3                                                  
C      OUT  = CONTAINS THE REQUESTED FLUX CROSS-SECTIONS                        E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      FLUXTYP          = M FOR M-FLUX, OR N FOR N-FLUX.                        E5                                                  
C      LABEL            = 80 CHARACTER LABEL.                                   E5                                                  
C      NSTEP,NAM ,LEVEL = RECORD LABEL ID FOR FIELD TO BE PROCESSED.            E5                                                  
C                         NAM =4H ALL PROCESSES THE COMPLETE FILE.              E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARDS...                                                      E5                                                  
C                                                                               E5                                                  
C*  SPFLUX    M                                                                 E5                                                  
C* LABEL CARD GOES HERE                                                         E5                                                  
C*                36 VORT  500                                                  E5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMPLEX A,SUM1,SUM2                                                                                                           
      LOGICAL OK                                                                                                                    
      CHARACTER*1 FLUXTYP                                                                                                           
      COMMON/ICOM/IBUF(8),IDAT(4420)                                                                                                
      COMMON/JCOM/JBUF(8),JDAT(130)                                                                                                 
C                                                                                                                                   
      COMMON/BLANCK/A(2210),B(130)                                                                                                  
      INTEGER LABEL(10)                                                                                                             
      INTEGER LSR(2,66)                                                                                                             
      DIMENSION SUM1(130),SUM2(130)                                                                                                 
      DATA MAXX,NAX/4420,130/                                                                                                       
C-----------------------------------------------------------------------                                                            
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * READ FLUX TYPE ('M' OR 'N') AND LABEL.                                                                                      
C                                                                                                                                   
      READ(5,5005,END=902) FLUXTYP                                              E4                                                  
      IF(FLUXTYP.EQ.'M')THEN                                                                                                        
        KD=2                                                                                                                        
      ELSE                                                                                                                          
        KD=1                                                                                                                        
      ENDIF                                                                                                                         
      READ(5,5060,END=903) LABEL                                                E4                                                  
C                                                                                                                                   
C     * READ NEXT RECORD FROM WHICH TO CALCULATE THE FLUX.                                                                          
C                                                                                                                                   
  100 READ(5,5010,END=900) NSTEP,NAM ,LEVEL                                     E4                                                  
      NAME=NAM                                                                                                                      
      IF(NAM.EQ.NC4TO8(" ALL")) NAME=NC4TO8("NEXT")                                                                                 
      IF(NAME.EQ.NC4TO8("SKIP"))THEN                                                                                                
C       READ(1,END=901)                                                                                                             
        CALL FBUFFIN(1,IBUF,MAXX,KK,LEN)                                                                                            
        IF (KK.GE.0) GO TO 901                                                                                                      
        GO TO 100                                                                                                                   
      ENDIF                                                                                                                         
200   CALL GETFLD2(1,A,NC4TO8("SPEC"),NSTEP,NAME,LEVEL,IBUF,MAXX,OK)                                                                
      IF(.NOT.OK) THEN                                                                                                              
        IF(NAM.EQ.NC4TO8(" ALL")) THEN                                                                                              
          CALL                                     XIT('SPFLUX',1)                                                                  
        ENDIF                                                                                                                       
        WRITE(6,6020) NSTEP,NAME,LEVEL                                                                                              
        CALL                                       XIT('SPFLUX',-1)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
      LRLMT=IBUF(7)                                                                                                                 
      IF(LRLMT.LT.100) CALL FXLRLMT (LRLMT,IBUF(5),IBUF(6),0)                                                                       
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                            
C                                                                                                                                   
C     * SUM OVER THE APPROPRIATE INDEX, CALCULATE THE FLUX, AND PRINT.                                                              
C                                                                                                                                   
      CALL SPECTRA(A,LM,LR,KTR,LA,LSR,SUM1,KD)                                                                                      
C                                                                                                                                   
      SUM2(1)=(0.0E0,0.0E0)                                                                                                         
      IF(KD.EQ.2) GO TO 400                                                                                                         
      IF(KTR.EQ.0) NMAX=LR+LM-1                                                                                                     
      IF(KTR.EQ.2) NMAX=LR                                                                                                          
      DO 250 N=2,NMAX                                                                                                               
  250 SUM2(N)=SUM2(N-1)-SUM1(N)                                                                                                     
      WRITE(6,6040) (I-1,REAL(SUM2(I)),I=1,NMAX)                                                                                    
      GO TO 500                                                                                                                     
C                                                                                                                                   
  400 DO 450 M=2,LM                                                                                                                 
  450 SUM2(M)=SUM2(M-1)-SUM1(M-1)                                                                                                   
      WRITE(6,6050) (I-1,REAL(SUM2(I)),I=1,LM)                                                                                      
  500 CALL PRTLAB (IBUF)                                                                                                            
C                                                                                                                                   
C     * WRITE OUT THE REAL PART OF THE ARRAY SUM2 TO THE FILE OUT.                                                                  
C     * THE ORDER OF THE ELEMENTS IS REVERSED FOR USE BY ZXLOOK.                                                                    
C                                                                                                                                   
      IF(KD.EQ.2)THEN                                                                                                               
        LP=LM                                                                                                                       
      ELSE                                                                                                                          
        LP=NMAX                                                                                                                     
      ENDIF                                                                                                                         
      CALL SETLAB(JBUF,NC4TO8("ZONL"),IBUF(2),IBUF(3),IBUF(4),LP,1,0,1)                                                             
      DO 800 I=1,LP                                                                                                                 
800   B(I)=REAL(SUM2(LP+1-I))                                                                                                       
      CALL PUTFLD2(2,B,JBUF,NAX)                                                                                                    
      IF(NAM.EQ.NC4TO8(" ALL")) GO TO 200                                                                                           
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  900 WRITE(6,6060)LABEL                                                                                                            
      CALL                                         XIT('SPFLUX',0)                                                                  
  901 CALL                                         XIT('SPFLUX',-101)                                                               
  902 CALL                                         XIT('SPFLUX',-2)                                                                 
  903 CALL                                         XIT('SPFLUX',-3)                                                                 
C-----------------------------------------------------------------------                                                            
 5005 FORMAT(10X,4X,A1)                                                         E4                                                  
 5010 FORMAT(10X,I10,1X,A4,I5)                                                  E4                                                  
 5060 FORMAT(10A8)                                                              E4                                                  
 6020 FORMAT('0..EOF LOOKING FOR',I10,2X,A4,I5)                                                                                     
 6040 FORMAT('0FLUX AS A FUNCTION OF N',/,                                                                                          
     1       (',',4(11X,I3,5X,1PE13.6)))                                                                                            
 6050 FORMAT('0FLUX AS A FUNCTION OF M',/,                                                                                          
     1       (',',4(11X,I3,5X,1PE13.6)))                                                                                            
 6060 FORMAT('+',48X,10A8)                                                                                                          
      END                                                                                                                           
