      PROGRAM COFAGG                                                                                                                
C     PROGRAM COFAGG (SPFILE,       GGFILE,       INPUT,       OUTPUT,  )       E2                                                  
C    1          TAPE1=SPFILE, TAPE2=GGFILE, TAPE5=INPUT, TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     NOV 06/95 - F.MAJAESS (REVISE DEFAULT PACKING DENSITY VALUE)                                                                  
C     FEB 15/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     JUL 13/92 - E. CHAN  (DIMENSION SELECTED VARIABLES AS REAL*8)                                                                 
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     AUG 13/85 - B.DUGAS. (AUGMENTER DIM SPECTRALE POUR T42).                                                                      
C     NOV 06/81 - J.D.HENDERSON                                                                                                     
C                                                                               E2                                                  
CCOFAGG  - CONVERTS SPECTRAL FILE TO GAUSSIAN GRIDS                     1  1 C GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - J.D.HENDERSON                                                        E3                                                  
C                                                                               E3                                                  
CPURPOSE - READS A FILE OF GLOBAL SPECTRAL COEFFICIENTS (SPFILE),               E3                                                  
C          CONVERTS THEM TO GLOBAL GAUSSIAN GRIDS, AND WRITES THEM ON           E3                                                  
C          FILE GGFILE WITH PACKING DENSITY NPKGG.                              E3                                                  
C          NOTE - ALL SPECTRAL FIELDS ON THE FILE MUST BE THE SAME SIZE.        E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      SPFILE = INPUT FILE OF SPECTRAL COEFF                                    E3                                                  
C                                                                               E3                                                  
COUTPUT FILE...                                                                 E3                                                  
C                                                                               E3                                                  
C      GGFILE = OUTPUT FILE OF GAUSSIAN GRIDS                                   E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      ILG   = NUMBER OF GRID POINTS IN GAUSSIAN LATITUDE CIRCLE                E5                                                  
C              (MUST BE A POWER OF TWO OR THREE TIMES A POWER OF TWO)           E5                                                  
C      ILAT  = NUMBER OF GAUSSIAN LATITUDES                                     E5                                                  
C      KUV   = 0 FOR NORMAL ANALYSIS                                            E5                                                  
C            = 1 TO CONVERT MODEL WINDS TO REAL WINDS                           E5                                                  
C      NPKGG = GRID PACKING DENSITY (0 DEFAULTS TO 2)                           E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARD...                                                       E5                                                  
C                                                                               E5                                                  
C*COFAGG     64   32    0    4                                                  E5                                                  
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
      INTEGER IB(8,100)                                                                                                             
      INTEGER LSR(2,66),IFAX(10)                                                                                                    
      REAL WRKS(12416),WRKL(19400),TRIGS(194)                                                                                       
      REAL*8 ALP(2275),EPSI(2275)                                                                                                   
      REAL*8 SL(96),CL(96),WL(96),WOSSL(96),RAD(96)                                                                                 
                                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      COMMON/W/W(2304400)                                                                                                           
                                                                                                                                    
      DATA MAXX,MAXW,MAXLG,MAXL/18528,2304400,194,100/                                                                              
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
                                                                                                                                    
C     * READ GLOBAL GAUSSIAN GRID SIZE (ILG,ILAT).                                                                                  
C     * ILG MUST BE 2**N OR 3*2**N.                                                                                                 
C     * THE ACTUAL GRID PRODUCED HAS SIZE (ILG+1,ILAT).                                                                             
C     * KUV=1 CONVERTS MODEL WINDS TO REAL WINDS.                                                                                   
C     * NPKGG = OUTPUT GRID PACKING DENSITY (LE.0 DEFAULTS TO 2).                                                                   
                                                                                                                                    
      READ(5,5010,END=901) ILG,ILAT,KUV,NPKGG                                   E4                                                  
      IF (ILG+2.GT.MAXLG)   THEN                                                                                                    
          WRITE(6,6005) ILG,MAXLG-2                                                                                                 
          CALL                                     XIT('COFAGG',-1)                                                                 
      ENDIF                                                                                                                         
      MAXLG=ILG+2                                                                                                                   
      IF(KUV.EQ.1) WRITE(6,6008)                                                                                                    
      ILATH=ILAT/2                                                                                                                  
      ILG1=ILG+1                                                                                                                    
      LGG=ILG1*ILAT                                                                                                                 
      IF(NPKGG.EQ.0) NPKGG=2                                                                                                        
                                                                                                                                    
C     * READ THE FIRST SPECTRAL FIELD TO GET THE SIZE (LR,LM).                                                                      
                                                                                                                                    
      NR=0                                                                                                                          
      CALL GETFLD2(1,W( 1 ),NC4TO8("SPEC"),-1,-1,-1,IBUF,MAXX,OK)                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6010) NR                                                                                                            
        CALL                                       XIT('COFAGG',-2)                                                                 
      ENDIF                                                                                                                         
      BACKSPACE  1                                                                                                                  
      BACKSPACE  1                                                                                                                  
      CALL PRTLAB (IBUF)                                                                                                            
                                                                                                                                    
C     * FIRST TIME ONLY, SET CONSTANTS FOR SPECTRAL-GRID TRANSFORMATION.                                                            
C     * GAUSSG COMPUTES THE VALUE OF THE GAUSSIAN LATITUDES AND THEIR                                                               
C     * SINES AND COSINES. TRIGL MAKES THEM GLOBAL (S TO N).                                                                        
                                                                                                                                    
      LRLMT=IBUF(7)                                                                                                                 
C     IF(LRLMT.LT.100) LRLMT=1000*IBUF(5)+10*IBUF(6)                                                                                
      IF(LRLMT.LT.100) CALL FXLRLMT (LRLMT,IBUF(5),IBUF(6),0)                                                                       
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                            
      CALL PRLRLMT (LA,LR,LM,KTR,LRLMT)                                                                                             
                                                                                                                                    
      CALL EPSCAL(EPSI,LSR,LM)                                                                                                      
      CALL GAUSSG(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
      CALL  TRIGL(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
      CALL FTSETUP(TRIGS,IFAX,ILG)                                                                                                  
                                                                                                                                    
C     * FIND HOW MANY SP,GG PAIRS WE CAN FIT (MAX 45).                                                                              
                                                                                                                                    
      NWDS=2*LA+LGG                                                                                                                 
      MAXLEV=MAXW/NWDS                                                                                                              
      IF(MAXLEV.GT.MAXL) MAXLEV=MAXL                                                                                                
      NGG1=2*LA*MAXLEV+1                                                                                                            
      WRITE(6,6015) LR,LM,ILG1,ILAT,MAXLEV                                                                                          
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -                                                               
C     * READ AS MANY SPECTRAL FIELDS AS POSSIBLE (2*LA REAL WORDS EACH).                                                            
                                                                                                                                    
  110 ILEV=0                                                                                                                        
      NSP=1                                                                                                                         
      DO 160 L=1,MAXLEV                                                                                                             
      CALL GETFLD2(1,W(NSP),NC4TO8("SPEC"),-1,-1,-1,IBUF,MAXX,OK)                                                                   
      IF(.NOT.OK.AND.ILEV.EQ.0) GO TO 510                                                                                           
      IF(.NOT.OK) GO TO 180                                                                                                         
      IF (IBUF(5).NE.LA.OR.IBUF(7).NE.LRLMT)                                                                                        
     1  CALL                                       XIT('COFAGG',-10-L)                                                              
      DO 150 I=1,8                                                                                                                  
  150 IB(I,L)=IBUF(I)                                                                                                               
      ILEV=ILEV+1                                                                                                                   
      NSP=NSP+2*LA                                                                                                                  
  160 CONTINUE                                                                                                                      
                                                                                                                                    
C     * CONVERT ILEV SPECTRAL FIELDS TO GAUSSIAN GRIDS.                                                                             
C     * NORMAL SPEC FIELDS ARE (LR,LM) BUT WINDS ARE (LRW,LM).                                                                      
                                                                                                                                    
  180 CALL STAGG (W(NGG1),ILG1,ILAT,ILEV,SL, W(1),LSR,LM,LA,                                                                        
     1            ALP,EPSI,WRKS,WRKL,TRIGS,IFAX,MAXLG)                                                                              
                                                                                                                                    
C     * WRITE ALL THE GRIDS ONTO FILE 2.                                                                                            
C     * KUV=1 CONVERTS MODEL WINDS TO REAL WINDS.                                                                                   
                                                                                                                                    
      NGG=NGG1                                                                                                                      
      DO 490 L=1,ILEV                                                                                                               
      CALL SETLAB(IBUF,NC4TO8("GRID"),IB(2,L),IB(3,L),IB(4,L),                                                                      
     +                                      ILG1,ILAT,0,NPKGG)                                                                      
      IF(KUV.EQ.1) CALL LWBW2(W(NGG),ILG1,ILAT,CL,-1)                                                                               
      CALL PUTFLD2(2,W(NGG),IBUF,MAXX)                                                                                              
      IF(NR.EQ.0) CALL PRTLAB (IBUF)                                                                                                
      NGG=NGG+LGG                                                                                                                   
      NR=NR+1                                                                                                                       
  490 CONTINUE                                                                                                                      
                                                                                                                                    
C     * STOP IF ALL SPECTRAL FIELDS HAVE BEEN CONVERTED TO GRIDS.                                                                   
C     * OTHERWISE GO BACK FOR THE NEXT SET.                                                                                         
                                                                                                                                    
  510 IF(.NOT.OK) THEN                                                                                                              
        WRITE(6,6010) NR                                                                                                            
        CALL                                       XIT('COFAGG',0)                                                                  
      ENDIF                                                                                                                         
      GO TO 110                                                                                                                     
                                                                                                                                    
C     * E.O.F. ON INPUT.                                                                                                            
  901 CALL                                         XIT('COFAGG',-3)                                                                 
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,4I5)                                                           E4                                                  
 6005 FORMAT('ILG = ',I4,' IS TO BIG, MAXIMUM PERMISSIBLE IS ',I4)                                                                  
 6008 FORMAT('0 INCLUDE WIND CONVERSION'/)                                                                                          
 6010 FORMAT('0',I6,'  RECORDS CONVERTED')                                                                                          
 6015 FORMAT('0SPEC=',2I5,'  GRID=',2I5,'  MAXLEV=',I5)                                                                             
      END                                                                                                                           
