      PROGRAM MKGLOB                                                                                                                
C     PROGRAM MKGLOB (TAPE1=X, TAPE2=Y,  INPUT,       OUTPUT,           )       D2                                                  
C    1                             TAPE5=INPUT, TAPE6=OUTPUT)                                                                       
C     -------------------------------------------------------                   D2                                                  
C                                                                               D2                                                  
C     NOV 21/13 - ADD OPTION FOR PROPAGATING SUPERLABELS.                       D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     MAR 09/99 - SLAVA KHARIN.                                                                                                     
C                                                                               D2                                                  
CMKGLOB  - EXTEND A WINDOW TO A GLOBAL GRID.                            1  1 C  D1                                                  
C                                                                               D3                                                  
CAUTHOR  - SLAVA KHARIN                                                         D3                                                  
C                                                                               D3                                                  
CPURPOSE - EXTEND A WINDOW TO A GLOBAL GRID.                                    D3                                                  
C                                                                               D3                                                  
CINPUT FILE...                                                                  D3                                                  
C                                                                               D3                                                  
C     X    = INPUT FILE WITH A SUB-AREA OF THE GLOBAL GRID.                     D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C     Y    = GLOBAL GRID FILE IN CCRN FORMAT.                                   D3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               D5                                                  
C11-15  NLON   = X-DIMENSION OF THE GLOBAL FIELD.                               D5                                                  
C                IF NLON=-1, USE IBUF(5) OF THE INPUT FILE.                     D5                                                  
C16-20  NLAT   = Y-DIMENSIONS OF THE GLOBAL GRID.                               D5                                                  
C                IF NLAT=-1, USE IBUF(6) OF THE INPUT FILE.                     D5                                                  
C                NLON MUST NOT INCLUDE THE CYCLIC LONGITUDE BECAUSE             D5                                                  
C                IT WILL BE ADDED BY DEFAULT (NOCYCL=0).                        D5                                                  
C                IF THE GLOBAL GRID DOES NOT HAVE THE CYCLIC LONGITUDE,         D5                                                  
C                USE NOCYCL=1.                                                  D5                                                  
C21-25      I1 = LEFT  GRID COORDINATE OF THE SUBAREA. IF I1=-1, SET I1=1.      D5                                                  
C26-30      I2 = RIGHT GRID COORDINATE OF THE SUBAREA. IF I2=-1, SET I2=NLON.   D5                                                  
C31-35      J1 = LOWER GRID COORDINATE OF THE SUBAREA. IF J1=-1, SET J1=1.      D5                                                  
C36-40      J2 = UPPER GRID COORDINATE OF THE SUBAREA. IF J2=-1, SET J2=NLAT.   D5                                                  
C41-50   SPVAL = SPECIAL VALUE FOR FILLING OUTSIDE OF THE SUBAREA.              D5                                                  
C51-55  NOCYCL = 0 ADD AN EXTRA LONGITUDE FOR CYCLICITY,                        D5                                                  
C                OTHERWISE DO NOT ADD IT.                                       D5                                                  
C56-60  ISPVL  = 1 PROPAGATE SUPERLABELS FROM INPUT FILE INTO OUTPUT FILE.      D5                                                  
C                OTHERWISE DO NOT OUTPUT THEM.                                  D5                                                  
C                                                                               D5                                                  
CEXAMPLE OF INPUT CARD...                                                       D5                                                  
C                                                                               D5                                                  
C*MKGLOB.    96   48    1   96   25   48    1.E+38    0                         D5                                                  
C                                                                               D5                                                  
C (EXTEND NORTHERN HEMISPHERE TO GLOBAL 96X48 GRID BY FILLING 1.E+38 AND        D5                                                  
C  ADD CYCLIC LONGITUDE)                                                        D5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      REAL X(65341),Y(65341)                                                                                                        
      LOGICAL OK                                                                                                                    
      COMMON /ICOM/ IBUF(8),IDAT(65341)                                                                                             
C                                                                                                                                   
      DATA MAXX/65341/                                                                                                              
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
C     * ASSIGN FILES TO FORTRAN UNITS                                                                                               
C                                                                                                                                   
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,1,2,5,6)                                                                                                      
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ INPUT PARAMETERS FROM CARD                                                                                             
C                                                                                                                                   
      READ(5,5010,END=900)NLON0,NLAT0,I01,I02,J01,J02,SPVAL,NOCYCL,ISPVL        D4                                                  
C                                                                                                                                   
C     * PRINT INPUT PARAMETERS TO STANDARD OUTPUT                                                                                   
C                                                                                                                                   
      WRITE(6,6010) NLON0,NLAT0,I01,I02,J01,J02,SPVAL,NOCYCL,ISPVL                                                                  
                                                                                                                                    
C                                                                                                                                   
C     * DO FOR EACH INPUT RECORD                                                                                                    
C                                                                                                                                   
      NR=0                                                                                                                          
 100  CONTINUE                                                                                                                      
      CALL GETFLD2(1,X,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                    
      IF(.NOT.OK)THEN                                                                                                               
         IF (NR.EQ.0) CALL                         XIT('MKGLOB',-1)                                                                 
         CALL PRTLAB(IBUF)                                                                                                          
         WRITE (6,6020) NR                                                                                                          
         CALL                                      XIT('MKGLOB',0)                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * WRITE OUT SUPERLABELS                                                                                                       
C                                                                                                                                   
      IF(IBUF(1).EQ.NC4TO8("LABL") .OR.                                                                                             
     1   IBUF(1).EQ.NC4TO8("CHAR")) THEN                                                                                            
        IF(ISPVL.EQ.1)THEN                                                                                                          
          CALL PUTFLD2(2,X,IBUF,MAXX)                                                                                               
        ENDIF                                                                                                                       
        GOTO 100                                                                                                                    
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DIMENSIONS OF THE GLOBAL FIELD                                                                                              
C                                                                                                                                   
      IF(NLON0.EQ.-1)THEN                                                                                                           
        NLON=IBUF(5)                                                                                                                
      ELSE                                                                                                                          
        NLON=NLON0                                                                                                                  
      ENDIF                                                                                                                         
      IF(NLAT0.EQ.-1)THEN                                                                                                           
        NLAT=IBUF(6)                                                                                                                
      ELSE                                                                                                                          
        NLAT=NLAT0                                                                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * DIMENSIONS OF THE WINDOW                                                                                                    
C                                                                                                                                   
      IF(I01.EQ.-1)THEN                                                                                                             
        I1=1                                                                                                                        
      ELSE                                                                                                                          
        I1=I01                                                                                                                      
      ENDIF                                                                                                                         
      IF(I02.EQ.-1)THEN                                                                                                             
        I2=NLON                                                                                                                     
      ELSE                                                                                                                          
        I2=I02                                                                                                                      
      ENDIF                                                                                                                         
      IF(J01.EQ.-1)THEN                                                                                                             
        J1=1                                                                                                                        
      ELSE                                                                                                                          
        J1=J01                                                                                                                      
      ENDIF                                                                                                                         
      IF(J02.EQ.-1)THEN                                                                                                             
        J2=NLAT                                                                                                                     
      ELSE                                                                                                                          
        J2=J02                                                                                                                      
      ENDIF                                                                                                                         
                                                                                                                                    
      NLATW=J2-J1+1                                                                                                                 
      IF (I2.GE.I1)THEN                                                                                                             
        NLONW=I2-I1+1                                                                                                               
      ELSE                                                                                                                          
        NLONW=I2-I1+1+NLON                                                                                                          
      ENDIF                                                                                                                         
                                                                                                                                    
      NLONP=NLON                                                                                                                    
      IF (NOCYCL.EQ.0) NLONP=NLON+1                                                                                                 
      NWDS=NLONP*NLAT                                                                                                               
      NR = NR+1                                                                                                                     
      IF (NR.EQ.1) CALL PRTLAB(IBUF)                                                                                                
                                                                                                                                    
      IF (IBUF(5).NE.NLONW.OR.IBUF(6).NE.NLATW) THEN                                                                                
         WRITE(6,'(2A)')                                                                                                            
     1        ' *** ERROR: GRID DIMENSIONS ARE NOT CONSISTED',                                                                      
     2        ' WITH I1,I2,J1,J2'                                                                                                   
         CALL                                      XIT('MKGLOB',-2)                                                                 
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * INITIALIZE GLOBAL GRID WITH SPECIAL VALUE                                                                                   
C                                                                                                                                   
      DO IJ=1,NWDS                                                                                                                  
         Y(IJ)=SPVAL                                                                                                                
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * PUT VALUES IN SUB-WINDOW                                                                                                    
C                                                                                                                                   
      IJW=0                                                                                                                         
      DO J=J1,J2                                                                                                                    
         IF (I2.GE.I1) THEN                                                                                                         
            DO I=I1,I2                                                                                                              
               IJW=IJW+1                                                                                                            
               IJG=(J-1)*NLONP+I                                                                                                    
               Y(IJG)=X(IJW)                                                                                                        
            ENDDO                                                                                                                   
         ELSE                                                                                                                       
            DO I=I1,NLON                                                                                                            
               IJW=IJW+1                                                                                                            
               IJG=(J-1)*NLONP+I                                                                                                    
               Y(IJG)=X(IJW)                                                                                                        
            ENDDO                                                                                                                   
            DO I=1,I2                                                                                                               
               IJW=IJW+1                                                                                                            
               IJG=(J-1)*NLONP+I                                                                                                    
               Y(IJG)=X(IJW)                                                                                                        
            ENDDO                                                                                                                   
         ENDIF                                                                                                                      
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * MAKE LAST LONGITUDE IDENTICAL TO THE FIRST LONGITUDE IF NEEDED                                                              
C                                                                                                                                   
      IF (NOCYCL.EQ.0) THEN                                                                                                         
         DO J=1,NLAT                                                                                                                
            Y((J-1)*NLONP+NLON+1)=Y((J-1)*NLONP+1)                                                                                  
         ENDDO                                                                                                                      
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * SAVE GLOBAL FIELDS                                                                                                          
C                                                                                                                                   
      IBUF(5)=NLONP                                                                                                                 
      IBUF(6)=NLAT                                                                                                                  
C                                                                                                                                   
C     * CHANGE PACKING DENSITY TO 1 TO AVOID PROBLEMS WITH SPVAL=1.E+38                                                             
C                                                                                                                                   
      IF(SPVAL.EQ.1.E+38)THEN                                                                                                       
        IBUF(8)=1                                                                                                                   
      ENDIF                                                                                                                         
      CALL PUTFLD2(2,Y,IBUF,MAXX)                                                                                                   
                                                                                                                                    
      GOTO 100                                                                                                                      
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
 900  CALL                                         XIT('MKGLOB',-3)                                                                 
C-----------------------------------------------------------------------                                                            
 5010 FORMAT (10X,6I5,E10.0,2I5)                                                D4                                                  
 6010 FORMAT (' INPUT PARAMETERS:'/' NLON=',I5,' NLAT=',I5,                                                                         
     1     ' I1,I2,J1,J2=',4I5,' SPVAL=',1P1E12.5,' NOCYCL=',I5,                                                                    
     2     ' ISPVL=',I5)                                                                                                            
 6020 FORMAT (1X,I10,' RECORDS READ IN.')                                                                                           
      END                                                                                                                           
