      PROGRAM SPDVDT                                                                                                                
C     PROGRAM SPDVDT (SPU,          SPV,           SPOMEG,       SPVORT,        E2                                                  
C    1                SPDIV,        SPDVDT,        INPUT,        OUTPUT,)       E2                                                  
C    2         TAPE11=SPU,   TAPE12=SPV,    TAPE13=SPOMEG,TAPE14=SPVORT,                                                            
C    3         TAPE15=SPDIV, TAPE16=SPDVDT, 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     JUL 13/92 - E. CHAN  (DIMENSION SELECTED VARIABLES AS REAL*8)                                                                 
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     JAN 25/85 - B.DUGAS  (VECTORIZE)                                                                                              
C     APR   /80 - S. LAMBERT                                                                                                        
C                                                                               E2                                                  
CSPDVDT  - COMPUTES SPECTRAL TENDENCY OF VORTICITY                      5  1 C GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - S.LAMBERT                                                            E3                                                  
C                                                                               E3                                                  
CPURPOSE - COMPUTES THE SPHERICAL HARMONIC COEFFICIENTS OF THE VORTICITY        E3                                                  
C          TENDENCY FROM THE SPHERICAL HARMONIC COEFFICENTS OF BIG U, BIG V,    E3                                                  
C          OMEGA, VORTICITY AND DIVERGENCE USING THE MODEL VORTICITY EQUATION.  E3                                                  
C                                                                               E3                                                  
CINPUT FILES...                                                                 E3                                                  
C                                                                               E3                                                  
C      SPU    = GLOBAL SPECTRAL MODEL U                                         E3                                                  
C      SPV    = GLOBAL SPECTRAL MODEL V                                         E3                                                  
C      SPOMEG = GLOBAL SPECTRAL VERTICAL MOTION (OMEGA)                         E3                                                  
C      SPVORT = GLOBAL SPECTRAL VORTICITY                                       E3                                                  
C      SPDIV  = GLOBAL SPECTRAL DIVERGENCE                                      E3                                                  
C                                                                               E3                                                  
COUTPUT FILE...                                                                 E3                                                  
C                                                                               E3                                                  
C      SPDVDT = GLOBAL SPECTRAL VORTICITY TENDENCY.                             E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      NLAT  = NUMBER OF LATITUDES IN THE TRANSFORM GAUSSIAN GRID.              E5                                                  
C      ILONG = LENGTH OF A GAUSSIAN GRID ROW.                                   E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARD...                                                       E5                                                  
C                                                                               E5                                                  
C*  SPDVDT   52   64                                                            E5                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
C     * THE WORKING FIELD ARRAYS SC AND SL ARE DIMENSIONED AS:                                                                      
C     *       SC = SPECTRAL ACCUMULATION ARRAY CMPLX (T30*15LEV*6VAR),                                                              
C     *       SL = REAL SLICE ARRAY (98GRID*15LEV*13VAR).                                                                           
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/LCM/SC,SL,ALP,DALP,EPSI                                                                                                
      COMPLEX SC(1326000),SL(126100)                                                                                                
      REAL*8    ALP(2275),DALP(2275),EPSI(2275)                                                                                     
      REAL*8    S(96),WEIGHT(96),SIA(96),RAD(96),WOCS(96)                                                                           
      DIMENSION TRIGS(194),IFAX(10)                                                                                                 
      DIMENSION LEV(100),LSR(2,66),LRW(2,66),                                                                                       
     1          PR(100),WRKS(12416)                                                                                                 
                                                                                                                                    
      COMMON/BUFCOM/IBUF(8),IDAT(4420)                                                                                              
      LOGICAL OK                                                                                                                    
      DATA MAXX,MAXLG,MAXSP / 4420,194,1326000 /                                                                                    
      DATA MAXL,MAXLT,MAXAM/ 100,96,2210 /                                                                                          
C-----------------------------------------------------------------------                                                            
      NFF=8                                                                                                                         
      CALL JCLPNT(NFF,11,12,13,14,15,16,5,6)                                                                                        
      NRECS=0                                                                                                                       
      DO 10 N=11,16                                                                                                                 
         REWIND N                                                                                                                   
   10 CONTINUE                                                                                                                      
                                                                                                                                    
C     * DETERMINE NUMBER OF LEVELS                                                                                                  
                                                                                                                                    
      CALL FILEV(LEV,NLEV,IBUF,11)                                                                                                  
      IF((NLEV.LT.1).OR.(NLEV.GT.MAXL)) CALL       XIT('SPDVDT',-1)                                                                 
      NLEV1=NLEV-1                                                                                                                  
      REWIND 11                                                                                                                     
      LRLMT=IBUF(7)                                                                                                                 
                                                                                                                                    
C     * READ SIZE OF TRANSFORM GRID                                                                                                 
                                                                                                                                    
      READ(5,5000,END=900) NLAT,ILONG                                           E4                                                  
      IF ((ILONG.GT.(MAXLG-2)).OR.(NLAT.GT.MAXLT))   THEN                                                                           
          WRITE(6,6040) NLAT,ILONG                                                                                                  
          CALL                                     XIT('SPDVDT',-2)                                                                 
      ELSE                                                                                                                          
          MAXLG=ILONG+2                                                                                                             
          ILH=MAXLG/2                                                                                                               
      ENDIF                                                                                                                         
      ILATH=NLAT/2                                                                                                                  
      CALL LVDCODE(PR,LEV,NLEV)                                                                                                     
      DO 20 L=1,NLEV                                                                                                                
         PR(L)=100.E0*PR(L)                                                                                                         
   20 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL DIMGT(LRW,LAW,LW,LM,KTR,LRLMT)                                                                                           
      DO 25 I=LAW+1,MAXAM                                                                                                           
         ALP(I)=0.E0                                                                                                                
         DALP(I)=0.E0                                                                                                               
   25 CONTINUE                                                                                                                      
      CALL GAUSSG(ILATH,S,WEIGHT,SIA,RAD,WOCS)                                                                                      
      CALL TRIGL (ILATH,S,WEIGHT,SIA,RAD,WOCS)                                                                                      
      CALL EPSCAL(EPSI,LRW,LM)                                                                                                      
      CALL FTSETUP(TRIGS,IFAX,ILONG)                                                                                                
                                                                                                                                    
      LMP1=LM+1                                                                                                                     
      DO 30 M=2,LMP1                                                                                                                
         LSR(1,M)=LRW(1,M)-M+1                                                                                                      
         LSR(2,M)=LRW(2,M)                                                                                                          
   30 CONTINUE                                                                                                                      
      LSR(1,1)=1                                                                                                                    
      LSR(2,1)=1                                                                                                                    
      LA=LAW-LM                                                                                                                     
                                                                                                                                    
C     * GET STARTING POSITIONS OF FIELDS.                                                                                           
                                                                                                                                    
      ISU=1                                                                                                                         
      ISV=NLEV*LAW+ISU                                                                                                              
      ISW=NLEV*LAW+ISV                                                                                                              
      ISP=NLEV*LA +ISW                                                                                                              
      ISD=NLEV*LA +ISP                                                                                                              
      ISA=NLEV*LA +ISD                                                                                                              
      IF (ISA+LA*NLEV.GT.MAXSP)   CALL             XIT('SPDVDT',-3)                                                                 
                                                                                                                                    
      IU =1                                                                                                                         
      IV =NLEV*ILH+IU                                                                                                               
      IW =NLEV*ILH+IV                                                                                                               
      IP =NLEV*ILH+IW                                                                                                               
      ID =NLEV*ILH+IP                                                                                                               
      IWN=NLEV*ILH+ID                                                                                                               
      IPN=NLEV*ILH+IWN                                                                                                              
      IWL=NLEV*ILH+IPN                                                                                                              
      IPL=NLEV*ILH+IWL                                                                                                              
      IUP=NLEV*ILH+IPL                                                                                                              
      IVP=NLEV*ILH+IUP                                                                                                              
      IPP=NLEV*ILH+IVP                                                                                                              
      IA =NLEV*ILH+IPP                                                                                                              
                                                                                                                                    
C     * GET ANOTHER SLAB OF SPECTRAL DATA.                                                                                          
                                                                                                                                    
   40 DO 50 I=ISA,ISA+NLEV*LA-1                                                                                                     
         SC(I)=CMPLX(0.E0,0.E0)                                                                                                     
   50 CONTINUE                                                                                                                      
                                                                                                                                    
C     * READ INPUT FILES                                                                                                            
                                                                                                                                    
      DO 100 L=0,NLEV1                                                                                                              
                                                                                                                                    
         CALL GETFLD2(11,SC(ISU+L*LAW),NC4TO8("SPEC"),-1,                                                                           
     +                    NC4TO8("   U"),-1,IBUF,MAXX,OK)                                                                           
         IF(.NOT.OK)THEN                                                                                                            
           IF(NRECS.EQ.0) CALL                     XIT('SPDVDT',-4)                                                                 
           WRITE(6,6020) NRECS                                                                                                      
           CALL                                    XIT('SPDVDT',0)                                                                  
         ENDIF                                                                                                                      
         IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                          
                                                                                                                                    
         CALL GETFLD2(12,SC(ISV+L*LAW),NC4TO8("SPEC"),-1,                                                                           
     +                    NC4TO8("   V"),-1,IBUF,MAXX,OK)                                                                           
         IF(.NOT.OK) CALL                          XIT('SPDVDT',-5)                                                                 
         IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                          
                                                                                                                                    
         CALL GETFLD2(13,SC(ISW+ L*LA),NC4TO8("SPEC"),-1,                                                                           
     +                    NC4TO8("OMEG"),-1,IBUF,MAXX,OK)                                                                           
         IF(.NOT.OK) CALL                          XIT('SPDVDT',-6)                                                                 
         IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                          
                                                                                                                                    
         CALL GETFLD2(14,SC(ISP+ L*LA),NC4TO8("SPEC"),-1,                                                                           
     +                    NC4TO8("VORT"),-1,IBUF,MAXX,OK)                                                                           
         IF(.NOT.OK) CALL                          XIT('SPDVDT',-7)                                                                 
         IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                          
                                                                                                                                    
         CALL GETFLD2(15,SC(ISD+ L*LA),NC4TO8("SPEC"),-1,                                                                           
     +                    NC4TO8(" DIV"),-1,IBUF,MAXX,OK)                                                                           
         IF(.NOT.OK) CALL                          XIT('SPDVDT',-8)                                                                 
         IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                          
                                                                                                                                    
  100 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL DVDT(  SC(ISU),  SC(ISV),  SC(ISW),  SC(ISP),  SC(ISD),                                                                  
     1            SC(ISA),                                                                                                          
     2          SL(   IU),SL(   IV),SL(   IW),SL(   IP),SL(   ID),                                                                  
     3          SL(  IWN),SL(  IPN),SL(  IWL),SL(  IPL),                                                                            
     4          SL(  IUP),SL(  IVP),SL(  IPP),SL(   IA),                                                                            
     6          SL(   IU),SL(   IV),SL(   IW),SL(   IP),                                                                            
     7          SL(  IWN),SL(  IPN),SL(  IWL),SL(  IPL),                                                                            
     8          SL(  IUP),SL(  IVP),SL(  IPP),    PR,                                                                               
     9          ALP, DALP, EPSI, LSR, LRW, S, WEIGHT, TRIGS, IFAX,                                                                  
     A          ILONG, NLAT, NLEV, ILH, MAXLG, LA, LAW, LM, WRKS)                                                                   
                                                                                                                                    
      IBUF(3)=NC4TO8("DVDT")                                                                                                        
                                                                                                                                    
      DO 750 L=0,NLEV1                                                                                                              
         IBUF(4)=LEV(L+1)                                                                                                           
         CALL PUTFLD2(16,SC(ISA+ L*LA),IBUF,MAXX)                                                                                   
         IF(NRECS.EQ.0) CALL PRTLAB (IBUF)                                                                                          
750   CONTINUE                                                                                                                      
      NRECS=NRECS+1                                                                                                                 
      GOTO 40                                                                                                                       
                                                                                                                                    
C     * END OF INPUT ON UNIT 5.                                                                                                     
                                                                                                                                    
900   CALL                                         XIT('SPDVDT',-9)                                                                 
C-----------------------------------------------------------------------                                                            
 5000 FORMAT(10X,2I5)                                                           E4                                                  
 6020 FORMAT('0SPDVDT PRODUCED',I6,' SETS OF COEFS')                                                                                
 6040 FORMAT(' NLAT,ILONG = ',2I5,' , ( TOO LARGE ) ')                                                                              
      END                                                                                                                           
