      PROGRAM MASKO                                                                                                                 
C     PROGRAM MASKO  (DDSCIN.       BETAOUT,      INPUT,       OUTPUT,  )       D2                                                  
C    1          TAPE1=GRIDIN,TAPE11=BETAOUT,TAPE5=INPUT, TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          D2                                                  
C                                                                               D2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       D2                                                  
C     MAY 02/02 - W.G. LEE  MODIFIED TO USE DATA DESCRIPTION FILES              D2                                                  
C                           INSTEAD OF GRIDINFO FILES.                          D2                                                  
C     JUL 19/01 - W.G. LEE  ORIGINAL VERSION                                                                                        
C                                                                               D2                                                  
CMASKO   - DETERMINE REGION BETA MASK BASED ON INPUT CARD(S)            1  1 C GD1                                                  
C                                                                               D3                                                  
CAUTHOR  - W.G. LEE                                                             D3                                                  
C                                                                               D3                                                  
CPURPOSE - FROM DATADESC FILE, DETERMINE ONE REGION BETA MASK                   D3                                                  
C          DEFINED BY UNION OF ALL REGIONS SPECIFIED IN THE INPUT CARD(S)       D3                                                  
C                                                                               D3                                                  
CINPUT FILE...                                                                  D3                                                  
C                                                                               D3                                                  
C   DDSCIN = DATA DESCRIPTION FILE CONTAINING:                                  D3                                                  
C            DSRC - DATA SOURCE (EG. OGCM1, OGCM2, OGCM3, OCEANOBS)             D3                                                  
C            BASN - ASSIGNED OCEAN BASIN FOR EACH GRID                          D3                                                  
C                                                                               D3                                                  
COUTPUT FILE...                                                                 D3                                                  
C                                                                               D3                                                  
C  BETAOUT = 2-D BETA FIELD (0 OR 1) DEFINED BY THE UNION OF ALL REIONS         D3                                                  
C            DEFINED IN THE INPUT CARD(S)                                       D3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               D5                                                  
C     REG1  = NAME OF THE FIRST  REGION                                         D5                                                  
C     REG2  = NAME OF THE SECOND REGION                                         D5                                                  
C     REG3  = NAME OF THE THIRD  REGION                                         D5                                                  
C                    .                                                          D5                                                  
C                    .                                                          D5                                                  
C                    .                                                          D5                                                  
C     REGN  = NAME OF THE LAST   REGION                                         D5                                                  
C                                                                               D5                                                  
CDEFINITION OF INPUT PARAMETER NAMES                                            D5                                                  
C                                                                               D5                                                  
C     NATL  = NORTH ATLANTIC                                                    D5                                                  
C     SATL  = SOUTH ATLANTIC                                                    D5                                                  
C     NPAC  = NORTH PACIFIC                                                     D5                                                  
C     SPAC  = SOUTH PACIFIC                                                     D5                                                  
C     NIND  = NORTH INDIAN                                                      D5                                                  
C     SIND  = SOUTH INDIAN                                                      D5                                                  
C     ARCT  = ARCTIC                                                            D5                                                  
C     MEDT  = MEDITERRANEAN                                                     D5                                                  
C     HBAY  = HUDSON BAY                                                        D5                                                  
C     BLKS  = BLACK SEA                                                         D5                                                  
C     CASP  = CASPIAN SEA                                                       D5                                                  
C     BLTC  = BALTIC SEA                                                        D5                                                  
C                                                                               D5                                                  
C     LAKE  = LAKES                                                             D5                                                  
C     LAND  = LAND (DOES NOT INCLUDE LAKES GRID POINTS!)                        D5                                                  
C                                                                               D5                                                  
C      ATL  = ATLANTIC (NATL+SATL+ARCT)                                         D5                                                  
C      PAC  = PACIFIC  (NPAC+SPAC)                                              D5                                                  
C      IND  = INDIAN   (NIND+SIND)                                              D5                                                  
C                                                                               D5                                                  
C     GLOB  = GLOBAL   (ATL+PAC+IND+MEDT+HBAY)                                  D5                                                  
C     NHEM  = NORTHERN HEMISPHERE  (NATL+NPAC+NIND+ARCT+MEDT+HBAY)              D5                                                  
C     SHEM  = SOUTHERN HEMISPHERE  (SATL+SPAC+SIND)                             D5                                                  
C     PA_I  = PACIFIC AND INDIAN OCEAN                                          D5                                                  
C                                                                               D5                                                  
C     MARS  = UNCONNECTED MARGINAL SEAS (BALTIC, BLACK SEA, CASPIAN SEA)        D5                                                  
C                                                                               D5                                                  
C     NOTO  = NOT OCEAN (LAND+LAKE+MARS)                                        D5                                                  
C                                                                               D5                                                  
CEXAMPLES OF OPTIONAL INPUT CARDS...                                            D5                                                  
C                                                                               D5                                                  
C     THE PROGRAM MASKO WILL KEEP READING CARDS UNTIL AN EOF IS ENCOUNTERED.    D5                                                  
C     ALL POSSIBLE FIELDS IN EACH CARD WILL BE CHECKED FOR REGION SPECIFIERS.   D5                                                  
C     THE FORMAT FOR THE REGIONS NAME IS RIGHT JUSTIFY AND THERE IS A SPACE     D5                                                  
C     BETWEEN EACH REGIONS NAME FORMAT(10X,14(1X,A4)).                          D5                                                  
C     EACH OF THE FOLLOWING EXAMPLES WILL GIVE THE SAME RESULTS:                D5                                                  
C                                                                               D5                                                  
C     EXAMPLE 1 (1 CARD) :                                                      D5                                                  
C                                                                               D5                                                  
C* MASKO   ARCT NATL  ATL                                                       D5                                                  
C                                                                               D5                                                  
C     EXAMPLE 2 (2 CARDS) :                                                     D5                                                  
C                                                                               D5                                                  
C* MASKO   ARCT       ATL                                                       D5                                                  
C*         NATL                                                                 D5                                                  
C                                                                               D5                                                  
C     EXAMPLE 3 (3 CARDS) :                                                     D5                                                  
C                                                                               D5                                                  
C* MASKO   ARCT                                                                 D5                                                  
C*         NATL                                                                 D5                                                  
C*          ATL                                                                 D5                                                  
C                                                                               D5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
C     MAXIMUM 2-D GRID SIZE IMC X JMC -> IJMAX                                                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (IMC=769,JMC=384,IJMAX=IMC*JMC,IJMAX2=IJMAX*1)                                                                      
      PARAMETER (NMAX=10,NREGMX=100)                                                                                                
C                                                                                                                                   
      REAL    BASN(IJMAX),  BETA(IJMAX)                                                                                             
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
C                                                                                                                                   
      INTEGER IBUF,IDAT,MAXX                                                                                                        
      INTEGER NIDREG(NMAX)                                                                                                          
C                                                                                                                                   
      CHARACTER*4  INCHAR(14), REGIN(NREGMX)                                                                                        
C                                                                                                                                   
      CHARACTER*8  CDSRC                                                                                                            
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(IJMAX2)                                                                                              
      DATA MAXX/IJMAX2/                                                                                                             
C                                                                                                                                   
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
      NF = 4                                                                                                                        
C                                                                                                                                   
      CALL JCLPNT(NF,1,11,5,6)                                                                                                      
C                                                                                                                                   
      REWIND  1                                                                                                                     
      REWIND 11                                                                                                                     
C                                                                                                                                   
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
C     INPUT MODEL IDENTIFICATION NUMBER AND CHECK IF IT IS VALID FOR                                                                
C     THIS PROGRAM                                                                                                                  
C                                                                                                                                   
      CALL GETFLD2(1,CDSRC,NC4TO8("CHAR"),-1,NC4TO8("DSRC"),-1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF (.NOT.OK) THEN                                                                                                             
         WRITE(6,6010)                                                                                                              
         CALL  PRTLAB(IBUF)                                                                                                         
         CALL                                      XIT('MASKO',-1)                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
C---------------------------------------------------------------------                                                              
C    IF DSRC DOES NOT SPECIFY OGCM1, OGCM2 OR OGCM3                                                                                 
C    OR OCEANOBS THEN THE PROGRAM WILL ABORT.                                                                                       
C                                                                                                                                   
      IF ((CDSRC.NE.'OGCM1   ').AND.(CDSRC.NE.'OGCM2   ').AND.                                                                      
     1    (CDSRC.NE.'OGCM3   ').AND.(CDSRC.NE.'OCEANOBS')) THEN                                                                     
         WRITE(6,6020)                                                                                                              
         CALL  PRTLAB(IBUF)                                                                                                         
         CALL                                      XIT('MASKO',-2)                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
C                                                                                                                                   
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
C     INPUT OCEAN BASIN ASSIGNMENT FILE                                                                                             
C                                                                                                                                   
      CALL GETFLD2(1,BASN,NC4TO8("GRID"),-1,NC4TO8("BASN"),-1,                                                                      
     +                                           IBUF,MAXX,OK)                                                                      
      IF (.NOT.OK) THEN                                                                                                             
         WRITE(6,6030)                                                                                                              
         CALL  PRTLAB(IBUF)                                                                                                         
         CALL                                      XIT('MASKO',-3)                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
C     GET THE NUMBER OF LATITUDE, LONGITUDE FROM BASN FIELD                                                                         
C                                                                                                                                   
      NLAT = IBUF(6)                                                                                                                
      NLON = IBUF(5)                                                                                                                
C                                                                                                                                   
      IMCJMC = NLAT * NLON                                                                                                          
C                                                                                                                                   
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
C     INITIALIZE BETA MASK TO ZERO                                                                                                  
C                                                                                                                                   
      DO 100 IJ = 1, IMCJMC                                                                                                         
         BETA(IJ) = 0.0E0                                                                                                           
  100 CONTINUE                                                                                                                      
C                                                                                                                                   
C----------------------------------------------------------------------                                                             
C                                                                                                                                   
C     READ IN THE SUB-REGIONS FROM INPUT CARD(S)                                                                                    
C                                                                                                                                   
      NSUBR = 0                                                                                                                     
      NC = 14                                                                                                                       
C                                                                                                                                   
  300 READ(5,5020,END=500) (INCHAR(N),N=1,NC)                                   D4                                                  
C                                                                                                                                   
      DO 400 N = 1,NC                                                                                                               
         IF (INCHAR(N).NE.'    ') THEN                                                                                              
            NSUBR = NSUBR + 1                                                                                                       
            IF (NSUBR.GT.NREGMX) THEN                                                                                               
               WRITE(6,6040) NREGMX                                                                                                 
               CALL                                XIT('MASKO',-4)                                                                  
            ENDIF                                                                                                                   
            REGIN(NSUBR) = INCHAR(N)                                                                                                
         ENDIF                                                                                                                      
  400 CONTINUE                                                                                                                      
C                                                                                                                                   
      GOTO 300                                                                                                                      
C                                                                                                                                   
C---------------------------------------------------------------------                                                              
C     CALL REGNUM TO DETERMINE SUBREGIONS ASSOCIATED WITH A                                                                         
C     PARTICULAR REGION NAME                                                                                                        
C                                                                                                                                   
                                                                                                                                    
  500 IF (NSUBR.LE.0) THEN                                                                                                          
         WRITE(6,6050)                                                                                                              
         CALL                                      XIT('MASKO',-5)                                                                  
      ENDIF                                                                                                                         
C                                                                                                                                   
      WRITE(6,6060)                                                                                                                 
      WRITE(6,6070) (REGIN(N),N=1,NSUBR)                                                                                            
C                                                                                                                                   
      DO 900 NN = 1,NSUBR                                                                                                           
         CALL REGNUM(REGIN(NN),NR,NIDREG,NMAX)                                                                                      
         WRITE(6,6080) REGIN(NN),NR,(NIDREG(N),N=1,NR)                                                                              
         DO 800 N = 1, NR                                                                                                           
            DO 700 IJ = 1, IMCJMC                                                                                                   
               IF (INT(BASN(IJ)+0.5E0).EQ.NIDREG(N))  BETA(IJ) = 1.0E0                                                              
  700       CONTINUE                                                                                                                
  800    CONTINUE                                                                                                                   
  900 CONTINUE                                                                                                                      
C                                                                                                                                   
      IBUF(3) = NC4TO8("BETA")                                                                                                      
      CALL PUTFLD2(11,BETA,IBUF,MAXX)                                                                                               
C                                                                                                                                   
      CALL                                         XIT('MASKO',0)                                                                   
C                                                                                                                                   
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
 5020 FORMAT(10X,14(1X,A4))                                                     D4                                                  
C                                                                                                                                   
 6010 FORMAT(' ERROR IN MASKO: DSRC MODEL SPECIFIER NOT FOUND')                                                                     
 6020 FORMAT(' ERROR IN MASKO: THIS PROGRAM CURRENTLY SUPPORTS',                                                                    
     1       ' OGCM1, OGCM2, OGCM3 AND OCEANOBS')                                                                                   
 6030 FORMAT(' ERROR IN MASKO: BASN RECORD NOT FOUND')                                                                              
 6040 FORMAT(' ERROR IN MASKO: TOO MANY SUBREGIONS SPECIFICED: >',I5)                                                               
 6050 FORMAT(' ERROR: NO SUB-REGIONS SPECIFIED IN THE INPUT CARD(S)')                                                               
 6060 FORMAT(' THE FOLLOWING SUBREGIONS WILL BE USED TO DEFINE',                                                                    
     1       ' THE BETA MASK :')                                                                                                    
 6070 FORMAT(10X,14(1X,A4))                                                                                                         
 6080 FORMAT(A4,I3,10I3)                                                                                                            
C                                                                                                                                   
      END                                                                                                                           
