      PROGRAM COFALL                                                                                                                
C     PROGRAM COFALL (SPFILE,       LLFILE,       INPUT,       OUTPUT,  )       E2                                                  
C    1          TAPE1=SPFILE, TAPE2=LLFILE, 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     FEV 07/86 - J.HASLIP (LIGNES 16,17,20 ET 79: ILG CHANGE A NLG)                                                                
C     FEV 07/85 - B.DUGAS  (REDUCE DIM TO 45 T20 TRANSFORM).                                                                        
C                                                                               E2                                                  
CCOFALL  - CONVERTS SPECTRAL FILE TO LAT-LONG GRIDS                     1  1 C GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - B. DUGAS.                                                            E3                                                  
C                                                                               E3                                                  
CPURPOSE - CONVERTS A FILE OF GLOBAL SPECTRAL COEFFICIENTS, (SPFILE),           E3                                                  
C          TO GLOBAL LAT-LONG GRIDS AND WRITES THEM ON FILE (LLFILE)            E3                                                  
C          WITH PACKING DENSITY NPKLL.                                          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      LLFILE = OUTPUT FILE OF LAT-LONG GRIDS                                   E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      NLG   = NUMBER OF GRID POINTS IN LATITUDE CIRCLE                         E5                                                  
C              (MUST BE A POWER OF TWO OR THREE TIMES A POWER OF TWO)           E5                                                  
C      NLAT  = NUMBER OF EQUALLY SPACED LATITUDES FROM THE                      E5                                                  
C              SOUTH TO THE NORTH (POLES INCLUDED).                             E5                                                  
C      KUV   = 0 FOR NORMAL ANALYSIS                                            E5                                                  
C            = 1 TO CONVERT MODEL WINDS TO REAL WINDS                           E5                                                  
C      NPKLL = GRID PACKING DENSITY (0 DEFAULTS TO 2)                           E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARD...                                                       E5                                                  
C                                                                               E5                                                  
C*COFALL    129   73    0    4                                                  E5                                                  
C                                                                               E5                                                  
CNOTE THAT THE EQUATOR IS INCLUDED HERE.                                        E5                                                  
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/W(2304400)                                                                                                      
C                                                                                                                                   
      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),PI,THETA,DELTA                                                                                           
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
C                                                                                                                                   
      DATA MAXX,MAXW,MAXLG,MAXL/18528,2304400,194,100/                                                                              
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      PI=3.141592654E0                                                                                                              
C                                                                                                                                   
C     * READ GLOBAL LAT-LONG GRID SIZE (NLG,NLAT).                                                                                  
C     * NLG MUST BE 2**N OR 3*2**N.                                                                                                 
C     * THE ACTUAL GRID PRODUCED HAS SIZE (NLG+1,NLAT).                                                                             
C     * KUV=1 CONVERTS MODEL WINDS TO REAL WINDS.                                                                                   
C     * NPKLL = OUTPUT GRID PACKING DENSITY (LE.0 DEFAULTS TO 2).                                                                   
C                                                                                                                                   
      READ(5,5010,END=900) NLG,NLAT,KUV,NPKLL                                   E4                                                  
      IF (NLG+2.GT.MAXLG)   THEN                                                                                                    
          WRITE(6,6005) NLG,MAXLG-2                                                                                                 
          CALL                                     XIT('COFALL',-1)                                                                 
      ENDIF                                                                                                                         
      MAXLG=NLG+2                                                                                                                   
      IF(KUV.EQ.1) WRITE(6,6008)                                                                                                    
      NLG1=NLG+1                                                                                                                    
      LLL=NLG1*NLAT                                                                                                                 
      IF(NPKLL.EQ.0) NPKLL=2                                                                                                        
C                                                                                                                                   
C     * READ THE FIRST SPECTRAL FIELD TO GET THE SIZE (LR,LM).                                                                      
C                                                                                                                                   
      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('COFALL',-2)                                                                 
      ENDIF                                                                                                                         
      BACKSPACE  1                                                                                                                  
      BACKSPACE  1                                                                                                                  
      CALL PRTLAB (IBUF)                                                                                                            
C                                                                                                                                   
C     * FIRST TIME ONLY, SET CONSTANTS FOR SPECTRAL-GRID TRANSFORMATION.                                                            
C     * DETERMINE SIN(LAT)=SL, COS(LAT)=CL OF LATITUDES.                                                                            
C                                                                                                                                   
      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)                                                                                             
C                                                                                                                                   
      CALL EPSCAL(EPSI,LSR,LM)                                                                                                      
      CALL FTSETUP(TRIGS,IFAX,NLG)                                                                                                  
C                                                                                                                                   
      IF(KUV.EQ.1) PI=0.999E0*PI                                                                                                    
      DELTA=PI/FLOAT(NLAT-1)                                                                                                        
      THETA=-PI/2.E0                                                                                                                
      DO 100 J=1,NLAT                                                                                                               
      SL(J)=SIN(THETA)                                                                                                              
      CL(J)=SQRT(1.E0-SL(J)**2)                                                                                                     
      THETA=THETA+DELTA                                                                                                             
  100 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * FIND HOW MANY SP,LL PAIRS WE CAN FIT (MAX 64).                                                                              
C                                                                                                                                   
      NWDS=2*LA+LLL                                                                                                                 
      MAXLEV=MAXW/NWDS                                                                                                              
      IF(MAXLEV.GT.MAXL) MAXLEV=MAXL                                                                                                
      NLL1=2*LA*MAXLEV+1                                                                                                            
      WRITE(6,6015) LR,LM,NLG1,NLAT,MAXLEV                                                                                          
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -                                                               
C     * READ AS MANY SPECTRAL FIELDS AS POSSIBLE (2*LA REAL WORDS EACH).                                                            
C                                                                                                                                   
  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                                                                                                         
      DO 150 I=1,8                                                                                                                  
  150 IB(I,L)=IBUF(I)                                                                                                               
      ILEV=ILEV+1                                                                                                                   
      NSP=NSP+2*LA                                                                                                                  
  160 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * CONVERT ILEV SPECTRAL FIELDS TO LAT-LONG GRIDS.                                                                             
C     * NORMAL SPEC FIELDS ARE (LR,LM) BUT WINDS ARE (LRW,LM).                                                                      
C                                                                                                                                   
  180 CALL STAGG (W(NLL1),NLG1,NLAT,ILEV,SL, W(1),LSR,LM,LA,                                                                        
     1                  ALP,EPSI,WRKS,WRKL,TRIGS,IFAX,MAXLG)                                                                        
C                                                                                                                                   
C     * WRITE ALL THE GRIDS ONTO FILE 2.                                                                                            
C     * KUV=1 CONVERTS MODEL WINDS TO REAL WINDS.                                                                                   
C                                                                                                                                   
      NLL=NLL1                                                                                                                      
      DO 490 L=1,ILEV                                                                                                               
      CALL SETLAB(IBUF,NC4TO8("GRID"),IB(2,L),IB(3,L),IB(4,L),                                                                      
     +                                      NLG1,NLAT,0,NPKLL)                                                                      
      IF(KUV.EQ.1) CALL LWBW2(W(NLL),NLG1,NLAT,CL,-1)                                                                               
      CALL PUTFLD2(2,W(NLL),IBUF,MAXX)                                                                                              
      IF(NR.EQ.0) CALL PRTLAB (IBUF)                                                                                                
      NLL=NLL+LLL                                                                                                                   
      NR=NR+1                                                                                                                       
  490 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * STOP IF ALL SPECTRAL FIELDS HAVE BEEN CONVERTED TO GRIDS.                                                                   
C     * OTHERWISE GO BACK FOR THE NEXT SET.                                                                                         
C                                                                                                                                   
  510 IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6010) NR                                                                                                            
        CALL                                       XIT('COFALL',0)                                                                  
      ENDIF                                                                                                                         
      GO TO 110                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  900 CALL                                         XIT('COFALL',-3)                                                                 
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,4I5)                                                           E4                                                  
 6005 FORMAT(' NLG = ',I4,' IS TOO BIG, MAX PERMISSIBLE IS ',I4)                                                                    
 6008 FORMAT('0 INCLUDE WIND CONVERSION'/)                                                                                          
 6010 FORMAT('0',I6,'  RECORDS CONVERTED')                                                                                          
 6015 FORMAT('0SPEC=',2I5,'  GRID=',2I5,'  MAXLEV=',I5)                                                                             
      END                                                                                                                           
