      PROGRAM POLOUT                                                                                                                
C     PROGRAM POLOUT (GGFULL,       GGZERO,       OUTPUT,               )       D2                                                  
C    1          TAPE1=GGFULL, TAPE2=GGZERO, TAPE6=OUTPUT)                                                                           
C     ---------------------------------------------------                       D2                                                  
C                                                                               D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       D2                                                  
C     JAN 29/92 - E. CHAN    (CONVERT HOLLERITH LITERALS TO ASCII)                                                                  
C     MAR 12/85 - S.J.LAMBERT                                                                                                       
C                                                                               D2                                                  
CPOLOUT  - SETS THE TOP AND BOTTOM ROWS OF A GAUSSIAN GRID TO ZERO      1  1    D1                                                  
C                                                                               D3                                                  
CAUTHOR  - S.J.LAMBERT                                                          D3                                                  
C                                                                               D3                                                  
CPURPOSE - SETS THE TOP AND BOTTOM ROWS OF A GAUSSIAN GRID TO ZERO.             D3                                                  
C                                                                               D3                                                  
CINPUT FILE...                                                                  D3                                                  
C                                                                               D3                                                  
C      GGFULL = GAUSSIAN GRID FILE                                              D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C      GGZERO = GAUSSIAN GRID FILE WITH THE TOP AND BOTTOM ROWS SET TO ZERO     D3                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANK/GG(18528)                                                                                                        
      LOGICAL OK                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      DATA MAXX/18528/                                                                                                              
C----------------------------------------------------------------------                                                             
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,1,2,6)                                                                                                        
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
                                                                                                                                    
      NRECS=0                                                                                                                       
100   CALL GETFLD2(1,GG,NC4TO8("GRID"),-1,-1,-1,IBUF,MAXX,OK)                                                                       
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6010) NRECS                                                                                                         
        CALL                                       XIT('POLOUT',0)                                                                  
      ENDIF                                                                                                                         
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      IS=IBUF(5)                                                                                                                    
      IN=NWDS-IBUF(5)+1                                                                                                             
                                                                                                                                    
      DO 150 I=1,IS                                                                                                                 
  150 GG(I)=0.0E0                                                                                                                   
      DO 200 I=IN,NWDS                                                                                                              
  200 GG(I)=0.0E0                                                                                                                   
                                                                                                                                    
      CALL PUTFLD2(2,GG,IBUF,MAXX)                                                                                                  
      IF(NRECS.EQ.0) WRITE(6,6025) IBUF                                                                                             
      NRECS=NRECS+1                                                                                                                 
      GO TO 100                                                                                                                     
C-----------------------------------------------------------------------                                                            
 6010 FORMAT('0',I6,' RECORDS PROCESSED')                                                                                           
 6025 FORMAT(1X,A4,I10,2X,A4,I10,4I6)                                                                                               
      END                                                                                                                           
