      PROGRAM GRSET                                                                                                                 
C     PROGRAM GRSET (GG,       INPUT,       OUTPUT,                     )       C2                                                  
C    1        TAPE11=GG, TAPE5=INPUT, TAPE6=OUTPUT)                                                                                 
C     ---------------------------------------------                             C2                                                  
C                                                                               C2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       C2                                                  
C     JUN 26/95 - F.MAJAESS(LIMIT READING 16 LEVELS PER LINE INSTEAD OF 20)     C2                                                  
C     JAN 12/93 - E. CHAN  (DECODE LEVELS IN 8-WORD LABEL)                                                                          
C     JUL 13/92 - E. CHAN  (DIMENSION SELECTED VARIABLES AS REAL*8)                                                                 
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 11/83 - R.LAPRISE.                                                                                                        
C                                                                               C2                                                  
CGRSET   - CREATES A GRID DATA FIELD FOR TESTING PURPOSES               0  1 C GC1                                                  
C                                                                               C3                                                  
CAUTHOR  - R.LAPRISE                                                            C3                                                  
C                                                                               C3                                                  
CPURPOSE - CREATES A FILE, GG, CONTAINING NSETS OF ILEV LEVELS OF GRID          C3                                                  
C          OF SIZE (ILG,ILAT). FIELDS ARE SET BY THIS EQUATION...               C3                                                  
C          GG(T,LON,LAT,P) =                                                    C3                                                  
C              A + B*P + (C+D*P)*(SIN(2PI*T/NSETS)+2.*SIN(LON))*COS(LAT)        C3                                                  
C          WHERE T   = 1,NSTEPS                                                 C3                                                  
C                LON = 1,ILG                                                    C3                                                  
C                LAT = 1,ILAT                                                   C3                                                  
C                P   = LVL(1), ... , LVL(ILEV)                                  C3                                                  
C                                                                               C3                                                  
COUTPUT FILE...                                                                 C3                                                  
C                                                                               C3                                                  
C      GG = OUTPUT SETS OF MULTI OR SINGLE LEVEL GRIDS                          C3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               C5                                                  
C      NSETS   = NUMBER OF INDIVIDUAL TIMESTEPS                                 C5                                                  
C      NAME    = NAME ASSIGNED TO THE SET IN STANDARD CCRN LABEL                C5                                                  
C      ILEV    = NUMBER OF PRESSURE LEVELS IN INDIVIDUAL SETS (MAX $PL$)        C5                                                  
C      ILG     = NUMBER OF DISTINCT LONITUDE POINTS                             C5                                                  
C      ILAT    = DEGREE OF THE LEGENDRE POLYNOMIAL THE ZERO'S OF WHICH          C5                                                  
C                ARE THE LATITUDES OF THE GRID (MAX $J$)                        C5                                                  
C                *** MAX ILG*ILAT = $IJ$ ***                                    C5                                                  
C      NPACK   = PACKING DENSITY DESIRED                                        C5                                                  
C      A,B,C,D = PARAMETERS USED TO CALCULATE VALUES ON THE GRID                C5                                                  
C      LVL     = ARRAY OF VERTICAL LEVELS TO BE USED IN IBUF(4)                 C5                                                  
C                                                                               C5                                                  
CEXAMPLE OF INPUT CARDS...                                                      C5                                                  
C                                                                               C5                                                  
C*GRSET      10 TEMP   16  128   64    4      273.      -10.       10.        0.C5                                                  
C*  5   10   30   70  100  150  200  250  300  400  500  700  850  900  950 1000C5                                                  
C*(THIS WILL PRODUCE 10 SETS OF 16 LEVEL 128X64 GRIDS WITH NAME 4HTEMP)         C5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      INTEGER LVL(100)                                                                                                              
      REAL*8 SL(96),WL(96),CL(96),RADL(96),WOSSL(96)                                                                                
C                                                                                                                                   
      COMMON/BLANCK/G(18528)                                                                                                        
C                                                                                                                                   
      COMMON /ICOM/IBUF(8),IDAT(18528)                                                                                              
C                                                                                                                                   
      DATA MAXX/18528/, MAXL/100/                                                                                                   
C-----------------------------------------------------------------------                                                            
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,11,5,6)                                                                                                       
      REWIND 11                                                                                                                     
C                                                                                                                                   
C     * READ IN DIMENSIONS AND CONSTANTS.                                                                                           
C                                                                                                                                   
      READ(5,5010,END=901) NSETS,NAME,ILEV,ILG,ILAT,NPACK,A,B,C,D               C4                                                  
      WRITE(6,6010)NSETS,NAME,ILEV,ILG,ILAT,NPACK,A,B,C,D                                                                           
      IF((ILEV.LT.1).OR.(ILEV.GT.MAXL)) CALL       XIT('GRSET',-1)                                                                  
      READ(5,5020,END=902) (LVL(L),L=1,ILEV)                                    C4                                                  
      WRITE(6,6020)(LVL(L),L=1,ILEV)                                                                                                
C                                                                                                                                   
      ILG1=ILG+1                                                                                                                    
      ILATH=ILAT/2                                                                                                                  
      RK  =2.E0*3.1416E0/FLOAT(ILG)                                                                                                 
      OMEG=2.E0*3.1416E0/FLOAT(NSETS)                                                                                               
      CALL GAUSSG(ILATH,SL,WL,CL,RADL,WOSSL)                                                                                        
      CALL TRIGL (ILATH,SL,WL,CL,RADL,WOSSL)                                                                                        
C                                                                                                                                   
C     * SET FIELD AS PER EQUATION.                                                                                                  
C                                                                                                                                   
      DO 310 NT=1,NSETS                                                                                                             
      TIM=FLOAT(NT-1)                                                                                                               
C                                                                                                                                   
      DO 310 L=1,ILEV                                                                                                               
      CALL LVDCODE(P,LVL(L),1)                                                                                                      
C                                                                                                                                   
      DO 210 J=1,ILAT                                                                                                               
      DO 200 I=1,ILG                                                                                                                
      RLON=FLOAT(I-1)                                                                                                               
  200 G((J-1)*ILG1+I) =                                                                                                             
     &  A+B*P + (C+D*P)*(SIN(OMEG*TIM)+2.E0*SIN(RK*RLON)) *CL(J)                                                                    
  210 G((J-1)*ILG1+ILG1) = G((J-1)*ILG1+1)                                                                                          
C                                                                                                                                   
C     * SAVE FIELD.                                                                                                                 
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),NT,NAME,LVL(L),ILG1,ILAT,0,NPACK)                                                             
      CALL PUTFLD2(11,G,IBUF,MAXX)                                                                                                  
      IF(NT.EQ.NSETS) WRITE(6,6030)IBUF                                                                                             
  310 CONTINUE                                                                                                                      
C                                                                                                                                   
      CALL                                         XIT('GRSET',0)                                                                   
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  901 CALL                                         XIT('GRSET',-2)                                                                  
  902 CALL                                         XIT('GRSET',-3)                                                                  
C-----------------------------------------------------------------------                                                            
 5010 FORMAT(10X,I5,1X,A4,4I5,4E10.0)                                           C4                                                  
 5020 FORMAT(16I5)                                                              C4                                                  
 6010 FORMAT(/,' NSETS=',I5,  ',NAME=',A4,  ',ILEV=',I5,                                                                            
     1       ',ILG=',I5,  ',ILAT=',I5,  ',NPACK=',I5,//,                                                                            
     2       ' EQUATION=',E10.3,  ' + ',E10.3,                                                                                      
     3       ' *P + (',E10.3,  ' + ',E10.3,                                                                                         
     4       ' *P) * (SIN(2PI*T/NSTEPS)+2.*SIN(LON)) *COS(LAT)',/)                                                                  
 6020 FORMAT(' LEVELS=',16I5,/(8X,16I5/))                                                                                           
 6030 FORMAT(2X,A4,I10,2X,A4,I10,4I6)                                                                                               
      END                                                                                                                           
