      PROGRAM SPCSUM                                                                                                                
C     PROGRAM SPCSUM (SP2DIN,   SP1DOUT,   SP2DOUT,   INPUT,    OUTPUT,   )     E2                                                  
C    1                TAPE1=SP2DIN, TAPE2=SP1DOUT, TAPE3=SP2DOUT,                                                                   
C    2                TAPE5=INPUT, TAPE6=OUTPUT)                                                                                    
C     ---------------------------------------------------------                 E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     MAY 14/96 - F.MAJAESS (TREAT "LABEL" AS A CHARACTER STRING, IMPROVE                                                           
C                            EXIT PROCESSING)                                                                                       
C     FEB 15/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     JAN 12/94 - F.MAJAESS (CORRECT "SKIP" OPTION )                                                                                
C     JUN 29/93 - J. KOSHYK (INCLUDE OPTION TO OUTPUT RESULT IN 2D ARRAY)                                                           
C     JAN 29/92 - E. CHAN   (CONVERT HOLLERITH LITERALS TO ASCII)                                                                   
C     AUG 13/90 - F.MAJAESS (MODIFY THE CALL TO "SPECTRA")                                                                          
C     NOV 24/83 - B.DUGAS.                                                                                                          
C     MAY 13/83 - R.LAPRISE, S.LAMBERT.                                                                                             
C                                                                               E2                                                  
CSPCSUM  - PRINTS SPECTRAL SUMS OVER M OR N                             1  0 C GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - S.LAMBERT,T.SHEPHERD                                                 E3                                                  
C                                                                               E3                                                  
CPURPOSE - SUMS A COMPLEX-VALUED SPECTRAL FILE SC(N,M) EITHER OVER THE          E3                                                  
C          PARAMETER M, PRINTING OUT THE RESULT SUM(N), OR OVER N, WITH         E3                                                  
C          THE RESULT SUM(M). IT PRODUCES A CROSS-SECTION FILE OF               E3                                                  
C          SPECTRAL DENSITY AS A FUNCTION OF WAVENUMBER AND PRESSURE            E3                                                  
C          (WHICH CAN BE USED AS A DISPLAY PROGRAM FOR SPCDNS).                 E3                                                  
C          THE RESULT CAN ALSO BE OUTPUT IN 2D FORM, SUM(N,M), WHERE SUM(N,M)   E3                                                  
C          IS CONSTANT IN EITHER M OR N.  SPECIFICATION OF THE OUTPUT FILES     E3                                                  
C          SP1DOUT AND SP2DOUT IS OPTIONAL.                                     E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      SP2DIN  = GLOBAL SPECTRAL COEFF FILE                                     E3                                                  
C                                                                               E3                                                  
COUTPUT FILES...                                                                E3                                                  
C                                                                               E3                                                  
C      SP1DOUT = CROSS-SECTION OF HEIGHT VS. WAVENUMBER (N OR M).               E3                                                  
C      SP2DOUT = SPECTRAL COEFF FILE WITH VALUES S(N,M) = SUM(N) FOR            E3                                                  
C                EACH M, OR S(N,M) = SUM(M) FOR EACH N.                         E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      SUMTYP = 'M' CAUSES SUM OVER N PRODUCING A FUNCTION OF M.                E5                                                  
C             = 'N' CAUSES SUM OVER M PRODUCING A FUNCTION OF N.(DEFAULT)       E5                                                  
C                                                                               E5                                                  
C      LABEL  = 80 CHARACTER LABEL PRINTED UNDER DISPLAY.                       E5                                                  
C                                                                               E5                                                  
C      NSTEP,                                                                   E5                                                  
C      NAM                                                                      E5                                                  
C    & LEVEL  = RECORD LABEL WORDS 2,3,4 IDENTIFYING THE FIELD TO SUM.          E5                                                  
C      IX     = 1 CAUSES THE CROSS-SECTION TO CONTAIN LOG10 OF THE SPECTRAL     E5                                                  
C                 DENSITIES INSTEAD OF THE SPECTRAL DENSITIES THEMSELVES.       E5                                                  
C                 (WAVE NUMBER ZERO IS OMITTED)                                 E5                                                  
C      NWAV   = 1 CAUSES THE NUMBER OF WAVES ON FILE OUT TO BE TRUNCATED TO     E5                                                  
C                 AN EVEN NUMBER.(DEFAULT IS 0; NO TRUNCATION).                 E5                                                  
C      IPNT   = 1 PRINTS THE VALUES OF THE SPECTRUM,                            E5                                                  
C             = 0 NO PRINTING.                                                  E5                                                  
C      I2D    = 1 OUTPUT THE TWO-DIMENSIONAL ARRAY S(N,M) IN SP2DOUT,           E5                                                  
C             = 0 SP2DOUT NON-EXISTENT.                                         E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARDS...                                                      E5                                                  
C                                                                               E5                                                  
C*  SPCSUM    M                                                                 E5                                                  
C*DISPLAY LABEL GOES HERE                                                       E5                                                  
C*                36 VORT  500    1    0    1    1                              E5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
C                                                                                                                                   
      COMPLEX A,SUM                                                                                                                 
      COMMON/BLANCK/A(2210),B(130)                                                                                                  
      CHARACTER*80 LABEL                                                                                                            
      CHARACTER*1  SUMTYP                                                                                                           
      INTEGER LSR(2,66)                                                                                                             
      DIMENSION SUM(130)                                                                                                            
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(4420)                                                                                                
      COMMON/JCOM/JBUF(8),G(130)                                                                                                    
C                                                                                                                                   
      DATA MAXX,NAX/4420,130/                                                                                                       
C-----------------------------------------------------------------------                                                            
      NF=5                                                                                                                          
      CALL JCLPNT(NF,1,2,3,5,6)                                                                                                     
      NO=NF-3                                                                                                                       
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * READ SUM TYPE ('M' OR 'N') AND LABEL.                                                                                       
C                                                                                                                                   
      READ(5,5005,END=902) SUMTYP                                               E4                                                  
      IF(SUMTYP.EQ.'M')THEN                                                                                                         
        KD=2                                                                                                                        
      ELSE                                                                                                                          
        KD=1                                                                                                                        
      ENDIF                                                                                                                         
      READ(5,5060,END=903) LABEL                                                E4                                                  
      NREC=0                                                                                                                        
C                                                                                                                                   
C     * READ NEXT RECORD TO BE SUMMED.                                                                                              
C                                                                                                                                   
  100 READ(5,5010,END=900) NSTEP,NAM,LEVEL,IX,NWAV,IPNT,I2D                     E4                                                  
      IF(I2D.EQ.1) THEN                                                                                                             
        KD=-KD                                                                                                                      
C     *                                                                                                                             
C     * IF ONLY A 2D OUTPUT FILE WAS NAMED IN THE CALLING JCL STATEMENT (I.E.                                                       
C     * SP1DOUT OMITTED) SET THE VALUE OF NO SO THAT NOTHING IS WRITTEN TO                                                          
C     * UNIT 2 LATER.                                                                                                               
C     *                                                                                                                             
        IF (NO.EQ.1) NO=0                                                                                                           
      END IF                                                                                                                        
      NAME=NAM                                                                                                                      
      IF(NAM.EQ.NC4TO8(" ALL")) NAME=NC4TO8("NEXT")                                                                                 
      IF(NAME.EQ.NC4TO8("SKIP"))THEN                                                                                                
C       READ(1,END=906)                                                                                                             
        CALL FBUFFIN(1,IBUF,MAXX,KK,LEN)                                                                                            
        IF (KK.GE.0) GO TO 906                                                                                                      
        GO TO 100                                                                                                                   
      ENDIF                                                                                                                         
200   CALL GETFLD2(1,A,NC4TO8("SPEC"),NSTEP,NAME,LEVEL,IBUF,MAXX,OK)                                                                
      IF(.NOT.OK)THEN                                                                                                               
        IF(IPNT.NE.1) CALL PRTLAB (IBUF)                                                                                            
        IF(NAM.EQ.NC4TO8(" ALL").AND.NREC.GT.0) THEN                                                                                
          WRITE(6,6060) LABEL                                                                                                       
          CALL                                     XIT('SPCSUM',0)                                                                  
        ENDIF                                                                                                                       
        WRITE(6,6020) NSTEP,NAME,LEVEL                                                                                              
        CALL                                       XIT('SPCSUM',-1)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
      NREC=NREC+1                                                                                                                   
      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 REQUESTED INDEX AND PRINT.                                                                                     
C                                                                                                                                   
      CALL SPECTRA(A,LM,LR,KTR,LA,LSR,SUM,KD)                                                                                       
                                                                                                                                    
      IF (I2D.EQ.1) CALL PUTFLD2(3,A,IBUF,MAXX)                                                                                     
                                                                                                                                    
      IF(KTR.EQ.0) NMAX=LR+LM-1                                                                                                     
      IF(KTR.EQ.2) NMAX=LR                                                                                                          
      IF(IPNT.NE.1) GO TO 230                                                                                                       
      IF(ABS(KD).EQ.1) WRITE(6,6040)  (I-1,REAL(SUM(I)),I=1,NMAX)                                                                   
      IF(ABS(KD).EQ.2) WRITE(6,6050)  (I-1,REAL(SUM(I)),I=1,LM)                                                                     
      CALL PRTLAB (IBUF)                                                                                                            
  230 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * THIS SECTION WRITES THE REAL PART OF THE ARRAY SUM TO THE FILE                                                              
C     * OUT.  THE ORDER OF THE ELEMENTS IS REVERSED FOR USE BY ZXLOOK.                                                              
C     * NOTE THAT YOU DO THIS ONLY IF A FILE WAS NAMED IN THE CALLING                                                               
C     * JCL STATEMENT.                                                                                                              
C                                                                                                                                   
      IF (NO.EQ.0.AND.NAM.EQ.NC4TO8(" ALL")) THEN                                                                                   
          GO TO 200                                                                                                                 
      ELSE IF (NO.EQ.0) THEN                                                                                                        
          GO TO 100                                                                                                                 
      ELSE                                                                                                                          
      LP=NMAX                                                                                                                       
      IF(ABS(KD).EQ.2) LP=LM                                                                                                        
C                                                                                                                                   
C     * IX=1 CAUSES THE BASE TEN LOG OF THE SPECTRAL DENSITY TO WRITTEN                                                             
C     * TO THE OUTPUT FILE.                                                                                                         
C                                                                                                                                   
      IF(IX.EQ.1) GO TO 300                                                                                                         
      IF(NWAV.EQ.1 .AND. MOD(LP,2).NE.0) LP=LP-1                                                                                    
      CALL SETLAB(JBUF,NC4TO8("ZONL"),IBUF(2),IBUF(3),IBUF(4),LP,1,0,1)                                                             
      DO 250 I=1,LP                                                                                                                 
250   B(I)=REAL(SUM(LP+1-I))                                                                                                        
      CALL PUTFLD2(2,B,JBUF,NAX)                                                                                                    
      IF(NAM.EQ.NC4TO8(" ALL")) GO TO 200                                                                                           
      GO TO 100                                                                                                                     
  300 IF(NWAV.EQ.1 .AND. MOD(LP,2).NE.1) LP=LP-1                                                                                    
      DO 350 I=2,LP                                                                                                                 
350   B(I-1)=LOG10(REAL(SUM(LP+2-I)))                                                                                               
      CALL SETLAB(JBUF,NC4TO8("ZONL"),IBUF(2),IBUF(3),IBUF(4),                                                                      
     +                                             LP-1,1,0,1)                                                                      
      CALL PUTFLD2(2,B,JBUF,NAX)                                                                                                    
      IF(NAM.EQ.NC4TO8(" ALL")) GO TO 200                                                                                           
      GO TO 100                                                                                                                     
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  900 WRITE(6,6060)LABEL                                                                                                            
      IF(NREC.GT.0) THEN                                                                                                            
        CALL                                       XIT('SPCSUM',0)                                                                  
      ELSE                                                                                                                          
        CALL                                       XIT('SPCSUM',-2)                                                                 
      ENDIF                                                                                                                         
  902 CALL                                         XIT('SPCSUM',-3)                                                                 
  903 CALL                                         XIT('SPCSUM',-4)                                                                 
C                                                                                                                                   
C     * E.O.F. ON FILE IN.                                                                                                          
C                                                                                                                                   
  906 CALL                                         XIT('SPCSUM',-5)                                                                 
C-----------------------------------------------------------------------                                                            
 5005 FORMAT(10X,4X,A1)                                                         E4                                                  
 5010 FORMAT(10X,I10,1X,A4,5I5)                                                 E4                                                  
 5060 FORMAT(A80)                                                               E4                                                  
 6020 FORMAT('0..EOF LOOKING FOR',I10,2X,A4,I5)                                                                                     
 6040 FORMAT('0SUM OVER M TO GIVE G(N)',/,                                                                                          
     1       (',',4(11X,I3,5X,1PE13.6)))                                                                                            
 6050 FORMAT('0SUM OVER N TO GIVE G(M)',/,                                                                                          
     1       (',',4(11X,I3,5X,1PE13.6)))                                                                                            
 6060 FORMAT('0',48X,A80)                                                                                                           
      END                                                                                                                           
