      PROGRAM SLICE                                                                                                                 
C     PROGRAM SLICE (IN,       SLOUT,       INPUT,       OUTPUT,        )       C2                                                  
C    1         TAPE1=IN, TAPE2=SLOUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                    
C     ----------------------------------------------------------                C2                                                  
C                                                                               C2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       C2                                                  
C     MAR 05/02 - F.MAJAESS (REVISED TO HANDLE "CHAR" KIND RECORDS)                                                                 
C     JAN 29/92 - E. CHAN   (CONVERT HOLLERITH LITERALS TO ASCII)                                                                   
C     JUL 24/85 - F.ZWIERS, B.DUGAS.                                                                                                
C     MAR 30/82 - J.D.HENDERSON                                                                                                     
C                                                                               C2                                                  
CSLICE   - SELECTS A COLUMN OR ROW FROM EACH FIELD IN A FILE.           1  1 C  C1                                                  
C                                                                               C3                                                  
CAUTHOR  - J.D.HENDERSON                                                        C3                                                  
C                                                                               C3                                                  
CPURPOSE - SELECTS ONE COLUMN OR ROW FROM EACH FIELD IN FILE IN AND             C3                                                  
C          PUTS THE RESULTS ON FILE SLOUT.                                      C3                                                  
C          NOTE - IF FILE IN CONTAINS MULTI-LEVEL GRID SETS THEN SLOUT          C3                                                  
C                 FILE WILL CONTAIN ZONAL OR MERIDIONAL CROSS-SECTIONS.         C3                                                  
C                 ALSO, "LABL" AND/OR "CHAR" KIND RECORDS ARE RETAINED          C3                                                  
C                 IF PRESENT IN FILE IN.                                        C3                                                  
C                                                                               C3                                                  
CINPUT FILE...                                                                  C3                                                  
C                                                                               C3                                                  
C      IN = SERIES OF MULTI-LEVEL SETS (REAL OR COMPLEX)                        C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      SLOUT = CROSS-SECTIONS                                                   C3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               C5                                                  
C      ICR = COLUMN OR ROW TO BE SELECTED                                       C5                                                  
C      KCR = (0,1) TO SELECT (COLUMN,ROW)                                       C5                                                  
C                                                                               C5                                                  
CEXAMPLE OF INPUT CARD...                                                       C5                                                  
C                                                                               C5                                                  
C*   SLICE   25    1                                                            C5                                                  
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/ZM(361),F(65341)                                                                                                
                                                                                                                                    
      LOGICAL OK                                                                                                                    
      COMMON/ICOM/ IBUF(8),IDAT(65341)                                                                                              
      DATA MAXX/65341/                                                                                                              
C---------------------------------------------------------------------                                                              
      NF=4                                                                                                                          
      CALL JCLPNT(NF,1,2,5,6)                                                                                                       
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
                                                                                                                                    
C     * READ CONTROL CARD.                                                                                                          
C     * ICR = COLUMN OR ROW TO BE SELECTED.                                                                                         
C     * KCR = (0,1) TO SELECT (COL,ROW).                                                                                            
                                                                                                                                    
      READ(5,5010,END=902) ICR,KCR                                              C4                                                  
      WRITE(6,6005)ICR,KCR                                                                                                          
                                                                                                                                    
C     * READ THE NEXT RECORD FROM  THE FILE. STOP AT EOF.                                                                           
                                                                                                                                    
      NR=0                                                                                                                          
  110 CALL RECGET(1,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                       
                                                                                                                                    
          IF (IBUF(1).EQ.NC4TO8("SPEC")) OK=.FALSE.                                                                                 
          IF (.NOT.OK) THEN                                                                                                         
              WRITE(6,6030) NR                                                                                                      
              IF (NR.EQ.0) CALL                    XIT('SLICE',-1)                                                                  
              CALL                                 XIT('SLICE',0)                                                                   
          ENDIF                                                                                                                     
                                                                                                                                    
C         * COPY "LABL" AND/OR "CHAR" KIND RECORDS TO THE OUTPUT FILE.                                                              
                                                                                                                                    
          IF (IBUF(1).EQ.NC4TO8("LABL").OR.                                                                                         
     +        IBUF(1).EQ.NC4TO8("CHAR")    ) THEN                                                                                   
              CALL RECPUT(2,IBUF)                                                                                                   
              GOTO 110                                                                                                              
          ENDIF                                                                                                                     
                                                                                                                                    
C         * UNPACK THE RECORD JUST READ.                                                                                            
                                                                                                                                    
          IF (NR.EQ.0) WRITE(6,6025) IBUF                                                                                           
          CALL RECUP2(F,IBUF)                                                                                                       
          LR=IBUF(5)                                                                                                                
          IF (IBUF(1).EQ.NC4TO8("FOUR")) LR=LR*2                                                                                    
          NROWS=IBUF(6)                                                                                                             
                                                                                                                                    
C         * GET ONE COLUMN OF THE FIELD (KCR=0).                                                                                    
                                                                                                                                    
          IF (KCR.EQ.0) THEN                                                                                                        
              DO 150 J=1,NROWS                                                                                                      
                  N=LR*(J-1)+ICR                                                                                                    
                  ZM(J)=F(N)                                                                                                        
  150         CONTINUE                                                                                                              
                                                                                                                                    
C         * GET ONE ROW OF THE FIELD (KCR=1).                                                                                       
                                                                                                                                    
          ELSE IF (KCR.EQ.1) THEN                                                                                                   
              N=LR*(ICR-1)                                                                                                          
              DO 180 I=1,LR                                                                                                         
                  ZM(I)=F(N+I)                                                                                                      
  180         CONTINUE                                                                                                              
                                                                                                                                    
          ELSE                                                                                                                      
              CALL                                 XIT('SLICE',-2)                                                                  
          ENDIF                                                                                                                     
                                                                                                                                    
C         * SAVE THE MERIDIONAL VECTOR ON FILE 2.                                                                                   
                                                                                                                                    
          IBUF(1)=NC4TO8("ZONL")                                                                                                    
          IF (KCR.EQ.0) IBUF(5)=IBUF(6)                                                                                             
          IBUF(6)=1                                                                                                                 
          CALL PUTFLD2(2,ZM,IBUF,MAXX)                                                                                              
          IF (NR.EQ.0) WRITE(6,6025) IBUF                                                                                           
          NR=NR+1                                                                                                                   
                                                                                                                                    
      GOTO 110                                                                                                                      
                                                                                                                                    
C     * E.O.F. ON INPUT.                                                                                                            
                                                                                                                                    
  902 CALL                                         XIT('SLICE',-3)                                                                  
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,2I5)                                                           C4                                                  
 6005 FORMAT('0ICR,KCR =',2I5)                                                                                                      
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
 6030 FORMAT('0',I5,'  RECORDS READ')                                                                                               
      END                                                                                                                           
