      PROGRAM SPFILL                                                                                                                
C     PROGRAM SPFILL (SPIN,       SPOUT,       INPUT,       OUTPUT,     )       E2                                                  
C    1          TAPE1=SPIN, TAPE2=SPOUT, 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 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     OCT 23/85 - B.DUGAS  (CHANGER POUR IBUF(8)=1)                                                                                 
C                                                                               E2                                                  
CSPFILL  - FILLS SPECTRAL ARRAY WHITH A CERTAIN COEFFICIENT'S VALUE     1  1 C  E1                                                  
C                                                                               E3                                                  
CAUTHORS - S.J.LAMBERT,B.DUGAS.                                                 E3                                                  
C                                                                               E3                                                  
CPURPOSE - FILLS AN OUTPUT SPECTRAL COEFFICIENTS ARRAY WITH A SINGLE            E3                                                  
C          SELECTED COEFFICIENT FROM THE INPUT ARRAY.                           E3                                                  
C          NOTE - SPOUT FILE IS UNPACKED AND SHOULD REMAIN SO. THE PACKER       E3                                                  
C                 ZEROES OUT THE IMAGINARY PART OF THE M=0 COEFFICIENTS...      E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      SPIN  = FILE OF SPECTRAL ARRAYS.                                         E3                                                  
C                                                                               E3                                                  
COUTPUT FILE...                                                                 E3                                                  
C                                                                               E3                                                  
C      SPOUT = SPECTRAL FILE WITH EVERY ELEMENT IN A GIVEN ARRAY IS FILLED      E3                                                  
C              BY A SELECTED COEFFICIENT FROM THE CORRESPONDING ARRAY IN        E3                                                  
C              SPIN.                                                            E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      M = M VALUE OF SELECTED SPECTRAL COEFFICIENT.                            E5                                                  
C      N = N VALUE OF SELECTED SPECTRAL COEFFICIENT.                            E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARD...                                                       E5                                                  
C                                                                               E5                                                  
C*  SPFILL    0    0                                                            E5                                                  
C                                                                               E5                                                  
C  THIS WILL SELECT THE SURFACE MEAN COEFFICIENT AND WRITE IT EVERYWHERE.       E5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMPLEX F,VAL                                                                                                                 
      COMMON/F/F(2210)                                                                                                              
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      INTEGER LSR(2,66)                                                                                                             
      COMMON/ICOM/IBUF(8),IDAT(4420)                                                                                                
      DATA MAXX/4420/                                                                                                               
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      NRECS =0                                                                                                                      
C                                                                                                                                   
C     * READ A CARD SPECIFYING THE COEFFICIENT TO BE COPIED                                                                         
C     * TO EVERY WORD IN THE OUTPUT FIELD.                                                                                          
C                                                                                                                                   
      READ(5,5010,END=900) M,N                                                  E4                                                  
      IF (M.GT.N) GO TO 300                                                                                                         
      WRITE(6,6000) M,N                                                                                                             
C                                                                                                                                   
C     * READ IN THE INPUT FIELDS ONE AT A TIME.                                                                                     
C                                                                                                                                   
  100 CALL GETFLD2(1,F,NC4TO8("SPEC"),-1,-1,-1,IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK)THEN                                                                                                               
        IF (NRECS.EQ.0) CALL                       XIT('SPFILL',-1)                                                                 
        WRITE(6,6010) NRECS                                                                                                         
        CALL                                       XIT('SPFILL',0)                                                                  
      ENDIF                                                                                                                         
      IF (NRECS.EQ.0)               CALL PRTLAB (IBUF)                                                                              
      LRLMT=IBUF(7)                                                                                                                 
C                                                                                                                                   
C     * CALCULATE SPECTRAL DIMENSIONS.                                                                                              
C                                                                                                                                   
      IF(LRLMT.LT.100) CALL FXLRLMT (LRLMT,IBUF(5),IBUF(6),0)                                                                       
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                            
C                                                                                                                                   
C     * DETERMINE THE COEFFICIENT CORRESPONDING TO M, N.                                                                            
C                                                                                                                                   
      IF (M.GT.LM-1)           GO TO 300                                                                                            
      INDEX=LSR(1,M+1)+N-M                                                                                                          
      IF (INDEX.GE.LSR(1,M+2)) GO TO 300                                                                                            
      VAL=F(INDEX)                                                                                                                  
C                                                                                                                                   
C     * REPLACE VALUES OF INPUT ARRAY BY VAL.                                                                                       
C                                                                                                                                   
      DO 200 I=1,LA                                                                                                                 
  200 F(I)=VAL                                                                                                                      
C                                                                                                                                   
C     * WRITE THE RESULT ON UNIT 2.                                                                                                 
C                                                                                                                                   
      IBUF(8)=1                                                                                                                     
      CALL PUTFLD2 (2,F,IBUF,MAXX)                                                                                                  
      NRECS=NRECS+1                                                                                                                 
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * IF M,N ARE NOT ALLOWED VALUES FOR THE INDICES OF F,                                                                         
C     * EXIT THE PROGRAM AND WRITE INFORMATION MESSAGE.                                                                             
C                                                                                                                                   
  300 WRITE(6,6050) M,N                                                                                                             
      CALL                                         XIT('SPFILL',-100)                                                               
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  900 CALL                                         XIT('SPFILL',-2)                                                                 
C-----------------------------------------------------------------                                                                  
 5010 FORMAT(10X,2I5)                                                           E4                                                  
 6000 FORMAT('0 FOR SPFILL, M=',I5,' AND N=',I5)                                                                                    
 6010 FORMAT('0',I6,' RECORDS READ')                                                                                                
 6050 FORMAT('0',' THE COEFFICIENT M=',I5,' N=',I5,                                                                                 
     1       ' DOES NOT EXIST IN THE INPUT FILE')                                                                                   
      END                                                                                                                           
