      PROGRAM FMASK                                                                                                                 
C     PROGRAM FMASK (GG,      MASK,      CMASK,      INPUT,      OUTPUT,)       D2                                                  
C    1         TAPE1=GG,TAPE2=MASK,TAPE3=CMASK,TAPE5=INPUT,TAPE6=OUTPUT)                                                            
C     ---------------------------------------------------------                 D2                                                  
C                                                                               D2                                                  
C     MAR 02/09 - S.KHARIN (ALLOW USER DEFINED MASK VALUE.                      D2                                                  
C                           KEEP ORIGINAL VARIABLE NAMES AND SUPERLABLES,       D2                                                  
C                           IF REQUESTED.)                                      D2                                                  
C     DEC 12/06 - F.MAJAESS (BASE PACKING DENSITY SETTING ON CURRENT INSTEAD                                                        
C                            OF THAT OF THE FIRST RECORD)                                                                           
C     JAN 26/05 - S.KHARIN (OPTIONALLY SAVE COMPLEMENTARY CMASK=1-MASK)                                                             
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     NOV 06/95 - F.MAJAESS (REVISE DEFAULT PACKING DENSITY VALUE)                                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     NOV 15/85 - B.DUGAS, J.D.HENDERSON (VECTORISER...)                                                                            
C                                                                               D2                                                  
CFMASK   - MAKES 1. OR 0. MASK FROM A GRID OR A SET OF GRIDS.           1  2 C  D1                                                  
C                                                                               D3                                                  
CAUTHOR  - J.D.HENDERSON                                                        D3                                                  
C                                                                               D3                                                  
CPURPOSE - PRODUCES A FLOATING POINT MASK (0. OR 1.) FROM A FIELD READ          D3                                                  
C          FROM FILE GG AND A LOGICAL OPERATOR (LOP) AND COMPARISON             D3                                                  
C          NUMBER (VALUE) WHICH ARE BOTH READ FROM A CARD.                      D3                                                  
C          FOR EACH NUMBER IN THE FIELD, WHENEVER (FIELD.LOP.VALUE) IS TRUE,    D3                                                  
C                                                 THE MASK IS SET TO 1.         D3                                                  
C                                        OTHERWISE      IT IS SET TO 0.         D3                                                  
C          NOTE - THE FIELD FROM GG MAY BE REAL OR COMPLEX.                     D3                                                  
C                 COMPLEX FIELDS ARE TREATED AS A STRING OF REAL NUMBERS.       D3                                                  
C                                                                               D3                                                  
CINPUT FILE...                                                                  D3                                                  
C                                                                               D3                                                  
C      GG = FILE OF REAL OR COMPLEX FIELDS                                      D3                                                  
C                                                                               D3                                                  
COUTPUT FILE(S)...                                                              D3                                                  
C                                                                               D3                                                  
C      MASK = MASK FIELDS COMPUTED FROM THE FIELDS IN GG.                       D3                                                  
C     CMASK = (OPTIONAL) COMPLEMENTARY 1-MASK.                                  D3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               D5                                                  
C      NT,NAME = STEP AND NAME OF FIELD TO BE SELECTED FROM GG.                 D5                                                  
C      LOP     = 2 CHARACTER LOGICAL OPERATOR (EQ,NE,LT,LE,GT,GE).              D5                                                  
C      VALUE   = COMPARISON VALUE FOR LOP.                                      D5                                                  
C      LMSK    = 1, USE MASK VALUE FROM INPUT CARD.                             D5                                                  
C                   OTHERWISE, USE FMSK=1 (DEFAULT).                            D5                                                  
C      FMSK    = MASK VALUE (IGNORED WHEN LMSK != 1)                            D5                                                  
C      LNAME   = 1, KEEP THE VARIABLE NAMES.                                    D5                                                  
C                   OTHERWISE USE 4HFMSK (DEFAULT).                             D5                                                  
C      LSLAB   = 1, KEEP SUPERLABELS.                                           D5                                                  
C                   OTHERWISE, SKIP SUPERLABELS (DEFAULT).                      D5                                                  
C                                                                               D5                                                  
CEXAMPLE OF INPUT CARD...                                                       D5                                                  
C                                                                               D5                                                  
C*FMASK           36   TS   GT      273.                                        D5                                                  
C                                                                               D5                                                  
C FOR THE ABOVE EXAMPLE THE MASK WILL BE SET TO 1. WHENEVER THE                 D5                                                  
C VALUE IN THE FIELD TS IS GREATER THAN 273, AND 0. ELSEWHERE.                  D5                                                  
C                                                                               D5                                                  
C*FMASK           -1 NEXT   GT       2.2    1     1.E38    1                    D5                                                  
C (USE 1.E+38 INSTEAD OF 1. AND KEEP THE ORIGINAL NAMES)                        D5                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/GG(65341),GMSK(65341),GMSKP(65341)                                                                              
                                                                                                                                    
      LOGICAL OK, SPEC, LCMASK                                                                                                      
      CHARACTER*2 LOP                                                                                                               
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
      DATA MAXX/65341/                                                                                                              
C---------------------------------------------------------------------                                                              
      NFF=5                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,5,6)                                                                                                    
      NFF=NFF-2                                                                                                                     
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      LCMASK=.FALSE.                                                                                                                
      IF(NFF.EQ.3)THEN                                                                                                              
        WRITE(6,'(A)')' SAVE MASK AND 1-MASK.'                                                                                      
        LCMASK=.TRUE.                                                                                                               
        REWIND 3                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
C     * GET MASK INFORMATION FROM CARD.                                                                                             
C     * NT AND NAME IDENTIFYING THE FIELD TO BE READ.                                                                               
C     * LOP IS A TWO CHARACTER LOGICAL OPERATOR (EQ,NE,LT,GT,LE,GE).                                                                
C     * VALUE IS THE FIELD COMPARISON NUMBER.                                                                                       
                                                                                                                                    
      LMSK=0                                                                                                                        
      LNAME=0                                                                                                                       
      LSLAB=0                                                                                                                       
      READ(5,5010,END=900) NT,NAME,LOP,VALUE,LMSK,FMSK,LNAME,LSLAB             D4                                                   
      IF (LMSK.NE.1)FMSK=1.E0                                                                                                       
      WRITE(6,6008) NT,NAME,FMSK,LNAME,LSLAB                                                                                        
      WRITE(6,6010) LOP,VALUE                                                                                                       
                                                                                                                                    
C     * GET THE REQUESTED FIELD FROM FILE 1.                                                                                        
                                                                                                                                    
      NF=0                                                                                                                          
  100 CALL GETFLD2(1,GG,-1,NT,NAME,-1,IBUF,MAXX,OK)                                                                                 
      IF (.NOT.OK)  THEN                                                                                                            
          IF (NF.EQ.0)  CALL                       XIT(' FMASK',-1)                                                                 
          WRITE(6,6030) NF                                                                                                          
          CALL                                     XIT(' FMASK',0)                                                                  
      ENDIF                                                                                                                         
      IF(NF.EQ.0) THEN                                                                                                              
        CALL PRTLAB(IBUF)                                                                                                           
      ENDIF                                                                                                                         
      NPACK=MIN(2,IBUF(8))                                                                                                          
                                                                                                                                    
      SPEC=(IBUF(1).EQ.NC4TO8("SPEC").OR.IBUF(1).EQ.NC4TO8("FOUR"))                                                                 
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
      IF(SPEC) NWDS=NWDS*2                                                                                                          
                                                                                                                                    
C     * PROCESS SUPERLABELS                                                                                                         
                                                                                                                                    
      IF(IBUF(1).EQ.NC4TO8("LABL").AND.LSLAB.EQ.1)THEN                                                                              
        CALL PUTFLD2(2,GG,IBUF,MAXX)                                                                                                
        IF(LCMASK)CALL PUTFLD2(3,GG,IBUF,MAXX)                                                                                      
        GOTO 100                                                                                                                    
      ENDIF                                                                                                                         
                                                                                                                                    
C     * PREPARE THE MASK ACCORDING TO KIND AND VALUE.                                                                               
                                                                                                                                    
      IF(LOP.NE.'LT') GO TO 211                                                                                                     
      DO 210 I=1,NWDS                                                                                                               
          GMSK(I) = MERGE( FMSK, 0.0E0, GG(I).LT.VALUE)                                                                             
  210 CONTINUE                                                                                                                      
      GO TO 240                                                                                                                     
  211 IF(LOP.NE.'GT') GO TO 213                                                                                                     
      DO 212 I=1,NWDS                                                                                                               
          GMSK(I) = MERGE( FMSK, 0.0E0, GG(I).GT.VALUE)                                                                             
  212 CONTINUE                                                                                                                      
      GO TO 240                                                                                                                     
  213 IF(LOP.NE.'GE') GO TO 215                                                                                                     
      DO 214 I=1,NWDS                                                                                                               
          GMSK(I) = MERGE( FMSK, 0.0E0, GG(I).GE.VALUE)                                                                             
  214 CONTINUE                                                                                                                      
      GO TO 240                                                                                                                     
  215 IF(LOP.NE.'LE') GO TO 217                                                                                                     
      DO 216 I=1,NWDS                                                                                                               
          GMSK(I) = MERGE( FMSK, 0.0E0, GG(I).LE.VALUE)                                                                             
  216 CONTINUE                                                                                                                      
      GO TO 240                                                                                                                     
  217 IF(LOP.NE.'EQ') GO TO 219                                                                                                     
      DO 218 I=1,NWDS                                                                                                               
          GMSK(I) = MERGE( FMSK, 0.0E0, GG(I).EQ.VALUE)                                                                             
  218 CONTINUE                                                                                                                      
      GO TO 240                                                                                                                     
  219 IF(LOP.NE.'NE') GO TO 230                                                                                                     
      DO 220 I=1,NWDS                                                                                                               
          GMSK(I) = MERGE( FMSK, 0.0E0, GG(I).NE.VALUE)                                                                             
  220 CONTINUE                                                                                                                      
      GO TO 240                                                                                                                     
  230 CALL                                         XIT(' FMASK',-2)                                                                 
                                                                                                                                    
C     * SAVE THE MASK ON FILE 2.                                                                                                    
                                                                                                                                    
  240 IF(LNAME.NE.1)IBUF(3)=NC4TO8("FMSK")                                                                                          
      IBUF(8)=NPACK                                                                                                                 
      IF(LCMASK)THEN                                                                                                                
        DO I=1,NWDS                                                                                                                 
          GMSKP(I)=FMSK-GMSK(I)                                                                                                     
        ENDDO                                                                                                                       
        CALL PUTFLD2(3,GMSKP,IBUF,MAXX)                                                                                             
      ENDIF                                                                                                                         
      CALL PUTFLD2(2,GMSK,IBUF,MAXX)                                                                                                
      IF(NF.EQ.0) CALL PRTLAB(IBUF)                                                                                                 
      NF=NF+1                                                                                                                       
      GO TO 100                                                                                                                     
                                                                                                                                    
C     * E.O.F. ON INPUT.                                                                                                            
                                                                                                                                    
  900 CALL                                         XIT(' FMASK',-3)                                                                 
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,I10,1X,A4,3X,A2,E10.0,I5,E10.0,2I5)                            D4                                                  
 6008 FORMAT('0FIELD',I10,2X,A4,' FMSK=',E12.3,                                                                                     
     1     ' LNAME=',I2,' LSLAB=',I2)                                                                                               
 6010 FORMAT('0MASK FOR ALL VALUES',2X,A2,E12.3/)                                                                                   
 6030 FORMAT('0FMASK READ ',I5,' FIELDS')                                                                                           
      END                                                                                                                           
