      PROGRAM CWINDS                                                                                                                
C     PROGRAM CWINDS (SSVORT,   SSDIV,      SSU,      SSV,      OUTPUT, )       E2                                                  
C    1       TAPE1=SSVORT,TAPE2=SSDIV,TAPE3=SSU,TAPE4=SSV,TAPE6=OUTPUT)                                                             
C     -----------------------------------------------------------------         E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     MAY 13/96 - F.MAJAESS (CORRECT LRWLMT COMPUTATION FOR TRUNCATIONS > 99)                                                       
C     FEB 15/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     JUL 13/92 - E. CHAN  (DIMENSION ARRAY EPSI AS REAL*8)                                                                         
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 06/83 - R.LAPRISE.                                                                                                        
C     APR 22/80 - J.D.HENDERSON.                                                                                                    
C                                                                               E2                                                  
CCWINDS  - CONVERTS SPECTRAL Q,D FILES TO SPECTRAL U,V                  2  2   GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - J.D.HENDERSON                                                        E3                                                  
C                                                                               E3                                                  
CPURPOSE - CONVERTS SPECTRAL VORTICITY, (Q), AND DIVERGENCE, (D), TO            E3                                                  
C          MODEL WIND COMPONENTS (U,V)COS(LAT)/A.                               E3                                                  
C          THESE ARE SAVED ON FILES SSU AND SSV.                                E3                                                  
C          ALL FIELDS ARE GLOBAL.                                               E3                                                  
C                                                                               E3                                                  
CINPUT FILES...                                                                 E3                                                  
C                                                                               E3                                                  
C      SSVORT = INPUT FILE OF SPECTRAL VORTICITY                                E3                                                  
C      SSDIV  = INPUT FILE OF SPECTRAL DIVERGENCE                               E3                                                  
C                                                                               E3                                                  
COUTPUT FILES...                                                                E3                                                  
C                                                                               E3                                                  
C      SSU = OUTPUT FILE OF SPECTRAL WIND COMPONENT U                           E3                                                  
C      SSV = OUTPUT FILE OF SPECTRAL WIND COMPONENT V                           E3                                                  
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMPLEX Q,D,U,V                                                                                                               
      COMMON/BLANCK/ Q(2145),D(2145),U(2210),V(2210)                                                                                
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      INTEGER LSR(2,66)                                                                                                             
      REAL*8 EPSI(2210)                                                                                                             
                                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(4420)                                                                                                
      COMMON/JCOM/JBUF(8),JDAT(4420)                                                                                                
      DATA MAXX/4420/                                                                                                               
C---------------------------------------------------------------------                                                              
      NFF=5                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,4,6)                                                                                                    
      DO 110 N=1,4                                                                                                                  
  110 REWIND N                                                                                                                      
C                                                                                                                                   
C     * READ THE NEXT VORTICITY FIELD FROM FILE SSVORT.                                                                             
C     * READ THE NEXT DIVERGENCE FIELD FROM FILE SSDIV.                                                                             
C                                                                                                                                   
      NR=0                                                                                                                          
  160 CALL GETFLD2(1,Q,NC4TO8("SPEC"),-1,NC4TO8("VORT"),-1,IBUF,MAXX,OK)                                                            
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6010) NR                                                                                                            
        IF(NR.EQ.0)THEN                                                                                                             
          CALL                                     XIT('CWINDS',-1)                                                                 
        ELSE                                                                                                                        
          CALL                                     XIT('CWINDS',0)                                                                  
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
      NST=IBUF(2)                                                                                                                   
      LEVEL=IBUF(4)                                                                                                                 
C                                                                                                                                   
      CALL GETFLD2(2,D,NC4TO8("SPEC"),NST,NC4TO8(" DIV"),LEVEL,                                                                     
     +                                            JBUF,MAXX,OK)                                                                     
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6010) NR                                                                                                            
        CALL                                       XIT('CWINDS',-2)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
      CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                                 
      IF(.NOT.OK)THEN                                                                                                               
        CALL PRTLAB (IBUF)                                                                                                          
        CALL PRTLAB (JBUF)                                                                                                          
        CALL                                       XIT('CWINDS',-3)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * FIRST TIME ONLY, CALCULATE CONSTANTS.                                                                                       
C                                                                                                                                   
      IF(NR.GT.0) GO TO 210                                                                                                         
      CALL PRTLAB (IBUF)                                                                                                            
      CALL PRTLAB (JBUF)                                                                                                            
      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)                                                                                                      
      LAW=LSR(2,LM+1)-1                                                                                                             
      LRW=LR+1                                                                                                                      
C     LRWLMT=1000*LRW+10*LM+KTR                                                                                                     
      CALL FXLRLMT (LRWLMT,LRW,LM,KTR)                                                                                              
C                                                                                                                                   
C     * COMPUTE THE WIND COMPONENTS U,V FROM Q,D.                                                                                   
C                                                                                                                                   
  210 CALL QDAWG2(U,V,Q,D,EPSI,LSR,LM)                                                                                              
C                                                                                                                                   
C     * NOW PACK U,V ONTO FILES SSU,SSV.                                                                                            
C                                                                                                                                   
      IBUF(5)=LAW                                                                                                                   
      IBUF(6)=1                                                                                                                     
      IBUF(7)=LRWLMT                                                                                                                
C                                                                                                                                   
      IBUF(3)=NC4TO8("   U")                                                                                                        
      CALL PUTFLD2(3,U,IBUF,MAXX)                                                                                                   
      IF(NR.EQ.0) CALL PRTLAB (IBUF)                                                                                                
C                                                                                                                                   
      IBUF(3)=NC4TO8("   V")                                                                                                        
      CALL PUTFLD2(4,V,IBUF,MAXX)                                                                                                   
      IF(NR.EQ.0) CALL PRTLAB (IBUF)                                                                                                
C                                                                                                                                   
      NR=NR+1                                                                                                                       
      GO TO 160                                                                                                                     
C---------------------------------------------------------------------                                                              
 6010 FORMAT('0CWINDS TRANSFORMED',I6,'  PAIRS OF Q,D TO U,V')                                                                      
      END                                                                                                                           
