      PROGRAM SPAFR                                                                                                                 
C     PROGRAM SPAFR (SC,      FC,      DFDY,       INPUT,      OUTPUT,  )       E2                                                  
C    1         TAPE1=SC,TAPE2=FC,TAPE3=DFDY, TAPE5=INPUT,TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     OCT 23/00 - F.MAJAESS (ENSURE "DFDY" NOT CREATED UNLESS IT IS ASKED FOR)                                                      
C     FEB 15/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     JUL 13/92 - E. CHAN  (DIMENSION SELECTED VARIABLES AS REAL*8)                                                                 
C     NOV 15/91 - E.CHAN.   (REMOVE RELEASE OF FT03)                                                                                
C     OCT 25/87 - M.LAZARE. (ADD RELEASE OF FT03 IN CASE IDY.NE.1.)                                                                 
C     MAY 13/83 - R.LAPRISE.                                                                                                        
C     JUL 16/81 - J.D.HENDERSON,S.LAMBERT                                                                                           
C                                                                               E2                                                  
CSPAFR   - CONVERTS SP COEFF TO FOURIER COEFF ON GAUSSIAN LATITUDES     1  2 C GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - J.D.HENDERSON, S.LAMBERT                                             E3                                                  
C                                                                               E3                                                  
CPURPOSE - CONVERTS A FILE OF GLOBAL SPHERICAL HARMONIC COEFFICIENTS TO         E3                                                  
C          FOURIER COEFFICIENTS AND OPTIONALLY THEIR MERIDIONAL DERIVATIVES.    E3                                                  
C          NOTE: "DFDY" ONLY NEED TO BE SPECIFIED IF "IDY" INPUT PARAMETER      E3                                                  
C                IS SET EQUAL TO 1.                                             E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      SC = GLOBAL SPHERICAL HARMONICS                                          E3                                                  
C                                                                               E3                                                  
COUTPUT FILES...                                                                E3                                                  
C                                                                               E3                                                  
C      FC   = LATITUDINAL FOURIER ANALYSES ON GAUSSIAN LATITUDES                E3                                                  
C             TO THE SAME RESOLUTION AS THE DATA IN SC.                         E3                                                  
C      DFDY = (OPTIONAL) CORRESPONDING MERIDIONAL DERIVATIVES                   E3                                                  
C                        (FOURIER COEFF TO THE SAME RESOLUTION)                 E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      NLAT = NUMBER OF GAUSSIAN LATITUDES                                      E5                                                  
C      IDY  = 1, MERIDIONAL DERIVATIVES CALCULATED AND WRITTEN INTO "DFDY",     E5                                                  
C             OTHERWISE, NO CALCULATION OF MERIDIONAL DERIVATIVES.              E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARD...                                                       E5                                                  
C                                                                               E5                                                  
C*   SPAFR   32    1                                                            E5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMPLEX F(6336),G(6336)                                                                                                       
      COMPLEX SC,FCO,DFCO                                                                                                           
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      DIMENSION LSR(2,66)                                                                                                           
      REAL*8 SL(96),CL(96),WL(96),WOSSL(96),RAD(96)                                                                                 
      REAL*8 ALP(2275),DALP(2275),EPSI(2275)                                                                                        
      COMMON/LCM/SC(2210),FCO(66),DFCO(66)                                                                                          
      COMMON/LCM/ALP,DALP,EPSI                                                                                                      
      COMMON/ICOM/IBUF(8),IDAT(12672)                                                                                               
      DATA MAXX/12672/                                                                                                              
C-----------------------------------------------------------------------                                                            
      NFF=5                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,5,6)                                                                                                    
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      IF (NFF.GT.4) REWIND 3                                                                                                        
C                                                                                                                                   
C     * READ THE NUMBER OF GAUSSIAN LATITUDES ON WHICH THE FOURIER                                                                  
C     * COEFFICIENTS ARE TO BE COMPUTED.  IF IDY IS NOT SET TO 1, NO                                                                
C     * DERIVATIVES WILL BE CALCULATED.                                                                                             
C                                                                                                                                   
      READ(5,5000,END=902) NLAT,IDY                                             E4                                                  
      IF(IDY.EQ.1.AND.NFF.NE.5) CALL               XIT('SPAFR',-1)                                                                  
      ILATH=NLAT/2                                                                                                                  
      CALL GAUSSG(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
      CALL TRIGL (ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
C                                                                                                                                   
      CALL GETFLD2(1,SC,NC4TO8("SPEC"),-1,-1,-1,IBUF,MAXX,OK)                                                                       
      IF(.NOT.OK) CALL                             XIT('SPAFR',-2)                                                                  
      REWIND 1                                                                                                                      
      CALL DIMGT(LSR,LA,LR,LM,KTR,IBUF(7))                                                                                          
      CALL EPSCAL(EPSI,LSR,LM)                                                                                                      
C                                                                                                                                   
      NRECS=0                                                                                                                       
  100 CALL GETFLD2(1,SC,NC4TO8("SPEC"),-1,-1,-1,IBUF,MAXX,OK)                                                                       
      IF(.NOT.OK)THEN                                                                                                               
        IF(NRECS.EQ.0) CALL                        XIT('SPAFR',-3)                                                                  
        WRITE(6,6020) NRECS                                                                                                         
        CALL                                       XIT('SPAFR',0)                                                                   
      ENDIF                                                                                                                         
      IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                             
                                                                                                                                    
      DO 400 I=1,NLAT                                                                                                               
       CALL ALPST2(ALP,LSR,LM,SL(I),EPSI)                                                                                           
C                                                                                                                                   
C      * COMPUTE THE FOURIER COEFFICIENTS                                                                                           
C                                                                                                                                   
       CALL STAF2(FCO,SC,LSR,LM,ALP)                                                                                                
       DO 200 K=1,LM                                                                                                                
200    F(LM*(I-1)+K)=FCO(K)                                                                                                         
       IF(IDY.EQ.1) THEN                                                                                                            
         CALL ALPDY2(DALP,ALP,LSR,LM,EPSI)                                                                                          
C                                                                                                                                   
C        * COMPUTE DERIVATIVES IF REQUESTED                                                                                         
C                                                                                                                                   
         CALL STAF2(DFCO,SC,LSR,LM,DALP)                                                                                            
         DO 300 K=1,LM                                                                                                              
300      G(LM*(I-1)+K)=DFCO(K)/CL(I)                                                                                                
       ENDIF                                                                                                                        
400   CONTINUE                                                                                                                      
C                                                                                                                                   
C     * WRITE OUT THE COMPUTED FOURIER COEFFICIENTS                                                                                 
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("FOUR"),IBUF(2),IBUF(3),                                                                              
     +                            IBUF(4),LM,NLAT,0,1)                                                                              
      CALL PUTFLD2(2,F,IBUF,MAXX)                                                                                                   
      IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                             
C                                                                                                                                   
C     * WRITE OUT THE COMPUTED DERIVATIVES IF REQUESTED                                                                             
C                                                                                                                                   
      IF(IDY.EQ.1) THEN                                                                                                             
        IBUF(3)=NC4TO8("DFDY")                                                                                                      
        CALL PUTFLD2(3,G,IBUF,MAXX)                                                                                                 
        IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                           
      ENDIF                                                                                                                         
      NRECS=NRECS+1                                                                                                                 
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  902 CALL                                         XIT('SPAFR',-4)                                                                  
C-----------------------------------------------------------------------                                                            
 5000 FORMAT(10X,2I5)                                                           E4                                                  
 6020 FORMAT(' ',I6,' RECORDS READ')                                                                                                
      END                                                                                                                           
