      PROGRAM GGVECPS                                                                                                               
C     PROGRAM GGVECPS (UIN,         VIN,           NUOUT,       NVOUT,          D2                                                  
C    1                 SUOUT,        SVOUT,        INPUT,       OUTPUT, )       D2                                                  
C    2           TAPE1=UIN,    TAPE2=VIN,   TAPE11=NUOUT,TAPE12=NVOUT,                                                              
C    3          TAPE13=SUOUT, TAPE14=SVOUT, TAPE5 =INPUT, TAPE6=OUTPUT)                                                             
C     -----------------------------------------------------------------         D2                                                  
C                                                                               D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       D2                                                  
C     JAN 25/02 - F.MAJAESS(CORRECT THE LABEL FOR WRITING TO "SVOUT")           D2                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 18/84 - B.DUGAS, R.LAPRISE, N.SARGENT, L.LEFAIVRE.                                                                        
C                                                                               D2                                                  
CGGVECPS - TRANSFORMS GAUSSIAN GRID VECTORS TO POLAR STEREO. REPRES.    2  4   GD1                                                  
C                                                                               D3                                                  
CAUTHORS - R.LAPRISE, L.LEFAIVRE                                                D3                                                  
C                                                                               D3                                                  
CPURPOSE - THIS PROGRAM IS MEANT TO TRANSFORM WIND VECTORS FROM                 D3                                                  
C          GAUSSIAN GRIDS TO POLAR STEREOGRAPHIC REPRESENTATION.                D3                                                  
C          NOTE - THE  TRANSFORMATION MATRIX  INVOLVES A LINEAR                 D3                                                  
C                 COMBINATION OF SINES AND COSINES OF LONGITUDE.                D3                                                  
C                                                                               D3                                                  
CINPUT FILES...                                                                 D3                                                  
C                                                                               D3                                                  
C      UIN   = FILE OF GAUSSIAN GRID U WIND COMPONENTS.                         D3                                                  
C      VIN   = FILE OF GAUSSIAN GRID V WIND COMPONENTS.                         D3                                                  
C                                                                               D3                                                  
COUTPUT FILES...                                                                D3                                                  
C                                                                               D3                                                  
C      NUOUT = FILE OF U WINDS TO BE USED FOR N.H. P.S. MAPS                    D3                                                  
C      NVOUT = FILE OF V WINDS TO BE USED FOR N.H. P.S. MAPS                    D3                                                  
C      SUOUT = FILE OF U WINDS TO BE USED FOR S.H. P.S. MAPS                    D3                                                  
C      SVOUT = FILE OF V WINDS TO BE USED FOR S.H. P.S. MAPS                    D3                                                  
C--------------------------------------------------------------------------                                                         
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/U(18528),V(18528),UPS(18528),VPS(18528)                                                                         
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      DIMENSION CLON(364),SLON(364),LEV(100)                                                                                        
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      COMMON/JCOM/JBUF(8),JDAT(18528)                                                                                               
      DATA MAXX/18528/, MAXL/100/                                                                                                   
      DATA PI/3.141592654E0/                                                                                                        
C---------------------------------------------------------------                                                                    
      NFF=7                                                                                                                         
      CALL JCLPNT(NFF,1,2,11,12,13,14,6)                                                                                            
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 11                                                                                                                     
      REWIND 12                                                                                                                     
      REWIND 13                                                                                                                     
      REWIND 14                                                                                                                     
C                                                                                                                                   
      CALL FILEV(LEV,NLEV,IBUF,1)                                                                                                   
      IF((NLEV.LT.1).OR.(NLEV.GT.MAXL)) CALL       XIT(' VECPS',-1)                                                                 
      NR=0                                                                                                                          
100   CONTINUE                                                                                                                      
      DO 200 K=1,NLEV                                                                                                               
C                                                                                                                                   
C    * BRING IN U FIELD                                                                                                             
C                                                                                                                                   
      CALL GETFLD2(1,U,NC4TO8("GRID"),-1,NC4TO8("   U"),LEV(K),                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK)THEN                                                                                                               
        IF(NR.EQ.0)THEN                                                                                                             
          WRITE(6,6025) IBUF                                                                                                        
          CALL                                     XIT(' VECPS',-2)                                                                 
        ELSE                                                                                                                        
          WRITE(6,6025) IBUF,JBUF                                                                                                   
          WRITE(6,6010) NR                                                                                                          
          CALL                                     XIT(' VECPS',0)                                                                  
        ENDIF                                                                                                                       
      ENDIF                                                                                                                         
C                                                                                                                                   
C    * BRING IN V FIELD                                                                                                             
C                                                                                                                                   
      CALL GETFLD2(2,V,NC4TO8("GRID"),-1,NC4TO8("   V"),LEV(K),                                                                     
     +                                            JBUF,MAXX,OK)                                                                     
      IF (.NOT.OK)THEN                                                                                                              
        WRITE(6,6025) IBUF,JBUF                                                                                                     
        CALL                                       XIT(' VECPS',-3)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C    * COMPARE THE TWO FIELDS                                                                                                       
C                                                                                                                                   
      IF(IBUF(5).NE.JBUF(5).OR.IBUF(6).NE.JBUF(6))THEN                                                                              
        WRITE(6,6025)IBUF,JBUF                                                                                                      
        CALL                                       XIT(' VECPS',-4)                                                                 
      ENDIF                                                                                                                         
      IF(NR.EQ.0) WRITE(6,6120) IBUF(5),IBUF(6)                                                                                     
C                                                                                                                                   
C    * EVALUATE COS(LON) AND SIN(LON).WE HAVE TO KEEP IN MIND THAT...                                                               
C    * 1. THE INCREMENT IN LONGITUDE IS 2*PI DIVIDED BY (NLON-1).                                                                   
C    * 2. THE GRIDS START AT 0 LON AND 90 LAT S.                                                                                    
C    * 3. THE POLAR STEREOGRAPHIC GRID IS TILTED 10 DEG FROM THE X AXIS                                                             
C    *    TOWARDS THE EAST (WEST) IN THE SOUTHERN (NORTHERN) HEMISPHERE.                                                            
C                                                                                                                                   
      NLON=IBUF(5)                                                                                                                  
      NLONM=NLON-1                                                                                                                  
      DEG=2*PI/FLOAT(NLONM)                                                                                                         
C                                                                                                                                   
C    * EVALUATE THE POLAR STEREOGRAPHIC U AND V.                                                                                    
C                                                                                                                                   
C    * FIRST THE SOUTHERN HEMISPHERE                                                                                                
C                                                                                                                                   
      DO 120 I=1,NLON                                                                                                               
      ADEG=(I-1)*DEG+(PI/18.E0)                                                                                                     
      CLON(I)=COS(ADEG)                                                                                                             
120   SLON(I)=SIN(ADEG)                                                                                                             
C                                                                                                                                   
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      DO 140 IJ=1,NWDS                                                                                                              
      I=IJ-(IJ/NLON)*NLON                                                                                                           
      IF(I.EQ.0) I=NLON                                                                                                             
      UPS(IJ)=(-1)*U(IJ)*SLON(I)+V(IJ)*CLON(I)                                                                                      
140   VPS(IJ)=(-1)*U(IJ)*CLON(I)-V(IJ)*SLON(I)                                                                                      
C                                                                                                                                   
C     * OUTPUT U,V FIELDS TO BE USED FOR S.H. POLARSTEREO MAPS.                                                                     
C                                                                                                                                   
      CALL PUTFLD2(13,UPS,IBUF,MAXX)                                                                                                
      CALL PUTFLD2(14,VPS,JBUF,MAXX)                                                                                                
C                                                                                                                                   
C    * THEN THE NORTHERN HEMISPHERE                                                                                                 
C                                                                                                                                   
      DO 150 I=1,NLON                                                                                                               
      ADEG=(I-1)*DEG-(PI/18.E0)                                                                                                     
      CLON(I)=COS(ADEG)                                                                                                             
150   SLON(I)=SIN(ADEG)                                                                                                             
C                                                                                                                                   
      DO 160 IJ=1,NWDS                                                                                                              
      I=IJ-(IJ/NLON)*NLON                                                                                                           
      IF(I.EQ.0) I=NLON                                                                                                             
      UPS(IJ)=(-1)*U(IJ)*SLON(I)-V(IJ)*CLON(I)                                                                                      
160   VPS(IJ)=     U(IJ)*CLON(I)-V(IJ)*SLON(I)                                                                                      
C                                                                                                                                   
C     * OUTPUT U,V FIELDS TO BE USED FOR N.H. POLARSTEREO MAPS.                                                                     
C                                                                                                                                   
      CALL PUTFLD2(11,UPS,IBUF,MAXX)                                                                                                
      CALL PUTFLD2(12,VPS,JBUF,MAXX)                                                                                                
      NR=NR+1                                                                                                                       
200   CONTINUE                                                                                                                      
      GO TO 100                                                                                                                     
C                                                                                                                                   
C---------------------------------------------------------------                                                                    
6010  FORMAT(' ',I6,' RECORDS READ')                                                                                                
6025  FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
6120  FORMAT(' ','NUMBER OF LONGITUDES',I6,                                                                                         
     1 10X,'NUMBER OF LATITUDES',I6)                                                                                                
      END                                                                                                                           
