C     ******************************************************************        
C     MAIN CODE FOR MODULAR MODEL --    9/1/87                                  
C          BY MICHAEL G. MCDONALD AND ARLEN W. HARBAUGH                         
C-----VERSION 1638 24JUL1987 MAIN1                                            
C                                                                            
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------        
      COMMON X(85000)
      COMMON/FLW/LAYCON(80)
      CHARACTER*4 HEADNG,VBNM                                                 
      DIMENSION HEADNG(32),VBNM(4,20),VBVL(4,20),IUNIT(24)                      
      DOUBLE PRECISION DUMMY                                                    
      EQUIVALENCE (DUMMY,X(1))                                                  
C     ------------------------------------------------------------------        
C                                                                               
C1------SET SIZE OF X ARRAY. REMEMBER TO REDIMENSION X.                         
      LENX=85000
C                                                                               
C2------ASSIGN BASIC INPUT UNIT AND PRINTER UNIT.                               
      INBAS=1                                                                   
cluke
cluke      write(6,*) 'Please enter OUTPUT filename:'
      IOUT=33
CLUKE
CLUKE ASSIGN THE INPUT/OUTPUT FILENAMES
CLUKE
      OPEN(UNIT=INBAS,FILE='FOR001.DAT',STATUS='OLD')
      OPEN(UNIT=IOUT,FILE='FOR033.DAT',STATUS='UNKNOWN')
CLUKE
C
C3------DEFINE PROBLEM__ROWS,COLUMNS,LAYERS,STRESS PERIODS,PACKAGES             
      CALL BAS1DF(ISUM,HEADNG,NPER,ITMUNI,TOTIM,NCOL,NROW,NLAY,                 
     1             NODES,INBAS,IOUT,IUNIT)  
CLUKE
CLUKE ASSIGN THE INPUT/OUTPUT FILENAMES
CLUKE
      OPEN(UNIT=IUNIT(1),FILE='FOR011.DAT',STATUS='OLD')
      OPEN(UNIT=IUNIT(2),FILE='FOR012.DAT',STATUS='UNKNOWN')
      OPEN(UNIT=IUNIT(8),FILE='FOR018.DAT',STATUS='UNKNOWN')
      OPEN(UNIT=IUNIT(9),FILE='FOR019.DAT',STATUS='OLD')
      OPEN(UNIT=IUNIT(12),FILE='FOR022.DAT',STATUS='OLD')
      OPEN(UNIT=76,FILE='FOR076.DAT',STATUS='UNKNOWN')
      OPEN(UNIT=77,FILE='FOR077.DAT',STATUS='UNKNOWN')
CLUKE                               
C                                                                               
C4------ALLOCATE SPACE IN "X" ARRAY.                                            
      CALL BAS1AL(ISUM,LENX,LCHNEW,LCHOLD,LCIBOU,LCCR,LCCC,LCCV,                
     1              LCHCOF,LCRHS,LCDELR,LCDELC,LCSTRT,LCBUFF,LCIOFL,            
     2              INBAS,ISTRT,NCOL,NROW,NLAY,IOUT)                            
      IF(IUNIT(1).GT.0) CALL BCF1AL(ISUM,LENX,LCSC1,LCHY,                       
     1     LCBOT,LCTOP,LCSC2,LCTRPY,IUNIT(1),ISS,                               
     2     NCOL,NROW,NLAY,IOUT,IBCFCB)                                          
      IF(IUNIT(2).GT.0) CALL WEL1AL(ISUM,LENX,LCWELL,MXWELL,NWEL,               
     1                 IUNIT(2),IOUT,IWELCB)                                    
      IF(IUNIT(3).GT.0) CALL DRN1AL(ISUM,LENX,LCDRAI,NDRAIN,MXDRN,              
     1                 IUNIT(3),IOUT,IDRNCB)                                    
      IF(IUNIT(8).GT.0) CALL RCH1AL(ISUM,LENX,LCIRCH,LCRECH,NRCHOP,             
     1            NCOL,NROW,IUNIT(8),IOUT,IRCHCB)                               
      IF(IUNIT(5).GT.0) CALL EVT1AL(ISUM,LENX,LCIEVT,LCEVTR,LCEXDP,             
     1            LCSURF,NCOL,NROW,NEVTOP,IUNIT(5),IOUT,IEVTCB)    
      IF(IUNIT(4).GT.0) CALL RIV1AL(ISUM,LENX,LCRIVR,MXRIVR,NRIVER,             
     1            IUNIT(4),IOUT,IRIVCB)    
      IF(IUNIT(7).GT.0) CALL GHB1AL(ISUM,LENX,LCBNDS,NBOUND,MXBND,              
     1            IUNIT(7),IOUT,IGHBCB)                                         
      IF(IUNIT(9).GT.0) CALL SIP1AL(ISUM,LENX,LCEL,LCFL,LCGL,LCV,               
     1          LCHDCG,LCLRCH,LCW,MXITER,NPARM,NCOL,NROW,NLAY,                  
     2          IUNIT(9),IOUT)  
      IF(IUNIT(11).GT.0) CALL SOR1AL(ISUM,LENX,LCA,LCRES,LCHDCG,LCLRCH,         
     1           LCIEQP,MXITER,NCOL,NROW,NLAY,NSLICE,MBW,IUNIT(11),IOUT)    
C                                                                               
C5------IF THE "X" ARRAY IS NOT BIG ENOUGH THEN STOP.                           
      IF(ISUM-1.GT.LENX) STOP                                                   
C                                                                               
C6------READ AND PREPARE INFORMATION FOR ENTIRE SIMULATION.                     
      CALL BAS1RP(X(LCIBOU),X(LCHNEW),X(LCSTRT),X(LCHOLD),                      
     1       ISTRT,INBAS,HEADNG,NCOL,NROW,NLAY,NODES,VBVL,X(LCIOFL),            
     2       IUNIT(12),IHEDFM,IDDNFM,IHEDUN,IDDNUN,IOUT)                        
      IF(IUNIT(1).GT.0) CALL BCF1RP(X(LCIBOU),X(LCHNEW),X(LCSC1),               
     1          X(LCHY),X(LCCR),X(LCCC),X(LCCV),X(LCDELR),                      
     2           X(LCDELC),X(LCBOT),X(LCTOP),X(LCSC2),X(LCTRPY),                
     3           IUNIT(1),ISS,NCOL,NROW,NLAY,NODES,IOUT)                        
      IF(IUNIT(9).GT.0) CALL SIP1RP(NPARM,MXITER,ACCL,HCLOSE,X(LCW),            
     1          IUNIT(9),IPCALC,IPRSIP,IOUT)  
      IF(IUNIT(11).GT.0) CALL SOR1RP(MXITER,ACCL,HCLOSE,IUNIT(11),              
     1         IPRSOR,IOUT)                                                     
C                                                                               
C7------SIMULATE EACH STRESS PERIOD.                                            
      DO 300 KPER=1,NPER
      KKPER=KPER                                                        
C                                                                               
C7A-----READ STRESS PERIOD TIMING INFORMATION.                                  
      CALL BAS1ST(NSTP,DELT,TSMULT,PERTIM,KKPER,INBAS,IOUT)      
C                                                                               
C7B-----READ AND PREPARE INFORMATION FOR STRESS PERIOD.    
      IF(IUNIT(2).GT.0) CALL WEL1RP(X(LCWELL),NWEL,MXWELL,IUNIT(2),             
     1             IOUT)                                                        
      IF(IUNIT(3).GT.0) CALL DRN1RP(X(LCDRAI),NDRAIN,MXDRN,IUNIT(3),            
     1                 IOUT)                                                    
      IF(IUNIT(8).GT.0) CALL RCH1RP(NRCHOP,X(LCIRCH),X(LCRECH),                 
     1            X(LCDELR),X(LCDELC),NROW,NCOL,NLAY,IUNIT(8),IOUT)             
      IF(IUNIT(5).GT.0) CALL EVT1RP(NEVTOP,X(LCIEVT),X(LCEVTR),                 
     1            X(LCEXDP),X(LCSURF),X(LCDELR),X(LCDELC),NCOL,NROW,            
     1            NLAY,IUNIT(5),IOUT)    
      IF(IUNIT(4).GT.0) CALL RIV1RP(X(LCRIVR),NRIVER,MXRIVR,IUNIT(4),           
     1            IOUT)    
      IF(IUNIT(7).GT.0) CALL GHB1RP(X(LCBNDS),NBOUND,MXBND,IUNIT(7),            
     1              IOUT)                                                       
C                                                                               
C7C-----SIMULATE EACH TIME STEP.                                                
      DO 200 KSTP=1,NSTP
      KKSTP=KSTP                                                        
C                                                                               
C7C1----CALCULATE TIME STEP LENGTH. SET HOLD=HNEW..                             
      CALL BAS1AD(DELT,TSMULT,TOTIM,PERTIM,X(LCHNEW),X(LCHOLD),KKSTP,   
     1             NCOL,NROW,NLAY)                                              
C                                                                               
C7C2----ITERATIVELY FORMULATE AND SOLVE THE EQUATIONS.                          
      DO 100 KITER=1,MXITER
      KKITER=KITER                                                     
C                                                                               
C7C2A---FORMULATE THE FINITE DIFFERENCE EQUATIONS.                              
      CALL BAS1FM(X(LCHCOF),X(LCRHS),NODES)                      
      IF(IUNIT(1).GT.0) CALL BCF1FM(X(LCHCOF),X(LCRHS),X(LCHOLD),               
     1          X(LCSC1),X(LCHNEW),X(LCIBOU),X(LCCR),X(LCCC),X(LCCV),           
     2          X(LCHY),X(LCTRPY),X(LCBOT),X(LCTOP),X(LCSC2),                   
     3          X(LCDELR),X(LCDELC),DELT,ISS,KKITER,KKSTP,KKPER,NCOL,     
     4          NROW,NLAY,IOUT)                                                 
      IF(IUNIT(2).GT.0) CALL WEL1FM(NWEL,MXWELL,X(LCRHS),X(LCWELL),             
     1           X(LCIBOU),NCOL,NROW,NLAY)                                      
      IF(IUNIT(3).GT.0) CALL DRN1FM(NDRAIN,MXDRN,X(LCDRAI),X(LCHNEW),           
     1         X(LCHCOF),X(LCRHS),X(LCIBOU),NCOL,NROW,NLAY)                     
      IF(IUNIT(8).GT.0) CALL RCH1FM(NRCHOP,X(LCIRCH),X(LCRECH),                 
     1            X(LCRHS),X(LCIBOU),NCOL,NROW,NLAY)                            
      IF(IUNIT(5).GT.0) CALL EVT1FM(NEVTOP,X(LCIEVT),X(LCEVTR),                 
     1            X(LCEXDP),X(LCSURF),X(LCRHS),X(LCHCOF),X(LCIBOU),             
     1            X(LCHNEW),NCOL,NROW,NLAY)    
      IF(IUNIT(4).GT.0) CALL RIV1FM(NRIVER,MXRIVR,X(LCRIVR),X(LCHNEW),          
     1            X(LCHCOF),X(LCRHS),X(LCIBOU),NCOL,NROW,NLAY)    
      IF(IUNIT(7).GT.0) CALL GHB1FM(NBOUND,MXBND,X(LCBNDS),X(LCHCOF),           
     1            X(LCRHS),X(LCIBOU),NCOL,NROW,NLAY)    
C                                                                               
C7C2B---MAKE ONE CUT AT AN APPROXIMATE SOLUTION.                                
      IF(IUNIT(9).GT.0) CALL SIP1AP(X(LCHNEW),X(LCIBOU),X(LCCR),X(LCCC),        
     1     X(LCCV),X(LCHCOF),X(LCRHS),X(LCEL),X(LCFL),X(LCGL),X(LCV),           
     2     X(LCW),X(LCHDCG),X(LCLRCH),NPARM,KITER,HCLOSE,ACCL,ICNVG,            
     3     KKSTP,KKPER,IPCALC,IPRSIP,MXITER,NSTP,NCOL,NROW,NLAY,NODES,   
     4     IOUT)  
C     IF((ITYP.EQ.0).AND.(IUNIT(10).GT.0)) GO TO 110                            
      IF(IUNIT(11).GT.0) CALL SOR1AP(X(LCHNEW),X(LCIBOU),X(LCCR),               
     1 X(LCCC),X(LCCV),X(LCHCOF),X(LCRHS),X(LCA),X(LCRES),X(LCIEQP),
     2 X(LCHDCG),X(LCLRCH),KITER,HCLOSE,ACCL,ICNVG,KKSTP,KKPER,IPRSOR,
     3 MXITER,NSTP,NCOL,NROW,NLAY,NSLICE,MBW,IOUT)
C                                                                               
C7C2C---IF CONVERGENCE CRITERION HAS BEEN MET STOP ITERATING.                   
      IF(ICNVG.EQ.1) GO TO 110                                                  
  100 CONTINUE                                                                  
      KITER=MXITER                                                              
  110 CONTINUE                                                                  
C                                                                               
C7C3----DETERMINE WHICH OUTPUT IS NEEDED.                                       
      CALL BAS1OC(NSTP,KKSTP,ICNVG,X(LCIOFL),NLAY,    
     1  IBUDFL,ICBCFL,IHDDFL,IUNIT(12),IOUT)                                    
C                                                                               
C7C4----CALCULATE BUDGET TERMS. SAVE CELL-BY-CELL FLOW TERMS.                   
      MSUM=1                                                                    
      IF(IUNIT(1).GT.0) CALL BCF1BD(VBNM,VBVL,MSUM,X(LCHNEW),                   
     1     X(LCIBOU),X(LCHOLD),X(LCSC1),X(LCCR),X(LCCC),X(LCCV),                
     2     X(LCTOP),X(LCSC2),DELT,ISS,NCOL,NROW,NLAY,KKSTP,KKPER,    
     3     IBCFCB,ICBCFL,X(LCBUFF),IOUT)                                        
      IF(IUNIT(2).GT.0)CALL WEL1BD(NWEL,MXWELL,VBNM,VBVL,MSUM,
     1     X(LCWELL),X(LCIBOU),DELT,NCOL,NROW,NLAY,KKSTP,KKPER,IWELCB,
     1     ICBCFL,X(LCBUFF),IOUT)    
      IF(IUNIT(3).GT.0) CALL DRN1BD(NDRAIN,MXDRN,VBNM,VBVL,MSUM,                
     1     X(LCDRAI),DELT,X(LCHNEW),NCOL,NROW,NLAY,X(LCIBOU),KKSTP,
     2     KKPER,IDRNCB,ICBCFL,X(LCBUFF),IOUT)           
      IF(IUNIT(8).GT.0) CALL RCH1BD(NRCHOP,X(LCIRCH),X(LCRECH),                 
     1     X(LCIBOU),NROW,NCOL,NLAY,DELT,VBVL,VBNM,MSUM,KKSTP,KKPER,    
     2     IRCHCB,ICBCFL,X(LCBUFF),IOUT)                                        
      IF(IUNIT(5).GT.0) CALL EVT1BD(NEVTOP,X(LCIEVT),X(LCEVTR),                 
     1     X(LCEXDP),X(LCSURF),X(LCIBOU),X(LCHNEW),NCOL,NROW,NLAY,              
     2     DELT,VBVL,VBNM,MSUM,KKSTP,KKPER,IEVTCB,ICBCFL,X(LCBUFF),IOUT)    
      IF(IUNIT(4).GT.0) CALL RIV1BD(NRIVER,MXRIVR,X(LCRIVR),X(LCIBOU),          
     1     X(LCHNEW),NCOL,NROW,NLAY,DELT,VBVL,VBNM,MSUM,                        
     2     KKSTP,KKPER,IRIVCB,ICBCFL,X(LCBUFF),IOUT)    
      IF(IUNIT(7).GT.0) CALL GHB1BD(NBOUND,MXBND,VBNM,VBVL,MSUM,                
     1     X(LCBNDS),DELT,X(LCHNEW),NCOL,NROW,NLAY,X(LCIBOU),KKSTP,
     2     KKPER,IGHBCB,ICBCFL,X(LCBUFF),IOUT)       
C                                                                               
C7C5---PRINT AND OR SAVE HEADS AND DRAWDOWNS. PRINT OVERALL BUDGET.             
      CALL BAS1OT(X(LCHNEW),X(LCSTRT),ISTRT,X(LCBUFF),X(LCIOFL),                
     1        MSUM,X(LCIBOU),VBNM,VBVL,KKSTP,KKPER,DELT,  
     2        PERTIM,TOTIM,ITMUNI,NCOL,NROW,NLAY,ICNVG,                         
     3     IHDDFL,IBUDFL,IHEDFM,IHEDUN,IDDNFM,IDDNUN,IOUT)                      
C                                                                               
C7C6----IF ITERATION FAILED TO CONVERGE THEN STOP.                              
      IF(ICNVG.EQ.0) STOP                                                       
  200 CONTINUE                                                                  
  300 CONTINUE                                                                  
C                                                                               
C8------END PROGRAM                                                             
      STOP                                                                      
C                                                                               
      END                                                                       
C FILE UTL1.F77                                                                 
      SUBROUTINE UBUDSV(KSTP,KPER,TEXT,IBDCHN,BUFF,NCOL,NROW,NLAY,IOUT)         
C                                                                               
C                                                                               
C-----VERSION 1305 28DEC1983 UBUDSV                                             
C     ******************************************************************        
C     RECORD CELL-BY-CELL FLOW TERMS FOR ONE COMPONENT OF FLOW.                 
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 TEXT        
      DIMENSION TEXT(4),BUFF(NCOL,NROW,NLAY)                                    
C     ------------------------------------------------------------------        
C                                                                               
C1------WRITE AN UNFORMATTED RECORD CONTAINING IDENTIFYING                      
C1------INFORMATION.                                                            
      WRITE(IOUT,1) TEXT,IBDCHN,KSTP,KPER                                       
    1 FORMAT(1X,'"',4A4,'" BUDGET VALUES WILL BE SAVED ON UNIT',I3,             
     1     ' AT END OF TIME STEP',I3,', STRESS PERIOD',I3)                      
C                                                                               
      WRITE(IBDCHN) KSTP,KPER,TEXT,NCOL,NROW,NLAY                               
C                                                                               
C2------WRITE AN UNFORMATTED RECORD CONTAINING VALUES FOR                       
C2------EACH CELL IN THE GRID. THE ARRAY IS DIMENSIONED                         
C2------(NCOL,NROW,NLAY)                                                        
      WRITE(IBDCHN) BUFF                                                        
C                                                                               
C3------RETURN                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE UCOLNO(NLBL1,NLBL2,NSPACE,NCPL,NDIG,IOUT)                      
C                                                                               
C                                                                               
C-----VERSION 1446 20APR1983 UCOLNO                                             
C     ******************************************************************        
C     OUTPUT COLUMN NUMBERS ABOVE A MATRIX PRINTOUT                             
C        NLBL1 IS THE START COLUMN LABEL (NUMBER)                               
C        NLBL2 IS THE STOP COLUMN LABEL (NUMBER)                                
C        NSPACE IS NUMBER OF BLANK SPACES TO LEAVE AT START OF LINE             
C        NCPL IS NUMBER OF COLUMN NUMBERS PER LINE                              
C        NDIG IS NUMBER OF CHARACTERS IN EACH COLUMN FIELD                      
C        IOUT IS OUTPUT CHANNEL                                                 
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 DOT,SPACE,DG,BF        
      DIMENSION BF(130),DG(10)                                                  
C                                                                               
      DATA DG(1),DG(2),DG(3),DG(4),DG(5),DG(6),DG(7),DG(8),DG(9),DG(10)/        
     1         '0   ','1   ','2   ','3   ','4   ','5   ','6   ',                
     2         '7   ','8   ','9   '/                                            
      DATA DOT,SPACE/'.   ','    '/                                             
C     ------------------------------------------------------------------        
C                                                                               
C1------CALCULATE # OF COLUMNS TO BE PRINTED (NLBL), WIDTH                      
C1------OF A LINE (NTOT), NUMBER OF LINES (NWRAP).                              
      WRITE(IOUT,1)                                                             
    1 FORMAT(1X)                                                                
      NLBL=NLBL2-NLBL1+1                                                        
      N=NLBL                                                                    
      IF(NLBL.GT.NCPL) N=NCPL                                                   
      NTOT=NSPACE+N*NDIG                                                        
      IF(NTOT.GT.130) GO TO 50                                                  
      NWRAP=(NLBL-1)/NCPL + 1                                                   
      J1=NLBL1-NCPL                                                             
      J2=NLBL1-1                                                                
C                                                                               
C2------BUILD AND PRINT EACH LINE                                               
      DO 40 N=1,NWRAP                                                           
C                                                                               
C3------CLEAR THE BUFFER (BF).                                                  
      DO 20 I=1,130                                                             
      BF(I)=SPACE                                                               
   20 CONTINUE                                                                  
      NBF=NSPACE                                                                
C                                                                               
C4------DETERMINE FIRST (J1) AND LAST (J2) COLUMN # FOR THIS LINE.              
      J1=J1+NCPL                                                                
      J2=J2+NCPL                                                                
      IF(J2.GT.NLBL2) J2=NLBL2                                                  
C5------LOAD THE COLUMN #'S INTO THE BUFFER.                                    
      DO 30 J=J1,J2                                                             
      NBF=NBF+NDIG                                                              
      I2=J/10                                                                   
      I1=J-I2*10+1                                                              
      BF(NBF)=DG(I1)                                                            
      IF(I2.EQ.0) GO TO 30                                                      
      I3=I2/10                                                                  
      I2=I2-I3*10+1                                                             
      BF(NBF-1)=DG(I2)                                                          
      IF(I3.EQ.0) GO TO 30                                                      
      BF(NBF-2)=DG(I3+1)                                                        
   30 CONTINUE                                                                  
C                                                                               
C6------PRINT THE CONTENTS OF THE BUFFER (I.E. PRINT THE LINE).                 
      WRITE(IOUT,31) (BF(I),I=1,NBF)                                            
   31 FORMAT(1X,130A1)                                                          
C                                                                               
   40 CONTINUE                                                                  
C                                                                               
C7------PRINT A LINE OF DOTS (FOR ESTHETIC PURPOSES ONLY).                      
   50 NTOT=NTOT+5                                                               
      IF(NTOT.GT.130) NTOT=130                                                  
      WRITE(IOUT,51) (DOT,I=1,NTOT)                                             
   51 FORMAT(1X,130A1)                                                          
C                                                                               
C8------RETURN                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE ULAPRS(BUF,TEXT,KSTP,KPER,NCOL,NROW,ILAY,IPRN,IOUT)            
C                                                                               
C                                                                               
C-----VERSION 1640 12MAY1987 ULAPRS                                             
C     ******************************************************************        
C     PRINT A 1 LAYER ARRAY IN STRIPS                                           
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 TEXT        
      DIMENSION BUF(NCOL,NROW),TEXT(4)                                          
C     ------------------------------------------------------------------        
C                                                                               
C1------MAKE SURE THE FORMAT CODE (IP OR IPRN) IS BETWEEN 1                     
C1------AND 12.                                                                 
      IP=IPRN                                                                   
      IF(IP.LT.1 .OR. IP.GT.12) IP=12                                           
C                                                                               
C2------DETERMINE THE NUMBER OF VALUES (NCAP) PRINTED ON ONE LINE.              
      IF(IP.EQ.1) NCAP=11                                                       
      IF(IP.EQ.2) NCAP=9                                                        
      IF(IP.GT.2 .AND. IP.LT.7) NCAP=15                                         
      IF(IP.GT.6 .AND. IP.LT.12) NCAP=20                                        
      IF(IP.EQ.12) NCAP=10                                                      
C                                                                               
C3------CALCULATE THE NUMBER OF STRIPS (NSTRIP).                                
      NCPF=129/NCAP                                                             
      ISP=0                                                                     
      IF(NCAP.GT.12) ISP=3                                                      
      NSTRIP=(NCOL-1)/NCAP + 1                                                  
      J1=1-NCAP                                                                 
      J2=0                                                                      
C                                                                               
C4------LOOP THROUGH THE STRIPS.                                                
      DO 2000 N=1,NSTRIP                                                        
C                                                                               
C5------CALCULATE THE FIRST(J1) & THE LAST(J2) COLUMNS FOR THIS STRIP           
      J1=J1+NCAP                                                                
      J2=J2+NCAP                                                                
      IF(J2.GT.NCOL) J2=NCOL                                                    
C                                                                               
C6-------PRINT TITLE ON EACH STRIP                                              
      WRITE(IOUT,1) TEXT,ILAY,KSTP,KPER                                         
    1 FORMAT(1H1,10X,4A4,' IN LAYER',I3,' AT END OF TIME STEP',I3,              
     1     ' IN STRESS PERIOD',I3/11X,71('-'))                                  
C                                                                               
C7------PRINT COLUMN NUMBERS ABOVE THE STRIP                                    
      CALL UCOLNO(J1,J2,ISP,NCAP,NCPF,IOUT)                                     
C                                                                               
C8------LOOP THROUGH THE ROWS PRINTING COLS J1 THRU J2 WITH FORMAT IP           
      DO 1000 I=1,NROW                                                          
      GO TO(10,20,30,40,50,60,70,80,90,100,110,120), IP                         
C                                                                               
C------------FORMAT 10G10.3                                                     
   10 WRITE(IOUT,11) I,(BUF(J,I),J=J1,J2)                                       
   11 FORMAT(1H0,I3,2X,1PG10.3,10(1X,G10.3))                                    
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 8G13.6                                                      
   20 WRITE(IOUT,21) I,(BUF(J,I),J=J1,J2)                                       
   21 FORMAT(1H0,I3,2X,1PG13.6,8(1X,G13.6))                                     
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 15F7.1                                                      
   30 WRITE(IOUT,31) I,(BUF(J,I),J=J1,J2)                                       
   31 FORMAT(1H0,I3,1X,15(1X,F7.1))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 15F7.2                                                      
   40 WRITE(IOUT,41) I,(BUF(J,I),J=J1,J2)                                       
   41 FORMAT(1H0,I3,1X,15(1X,F7.2))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 15F7.3                                                      
   50 WRITE(IOUT,51) I,(BUF(J,I),J=J1,J2)                                       
   51 FORMAT(1H0,I3,1X,15(1X,F7.3))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 15F7.4                                                      
   60 WRITE(IOUT,61) I,(BUF(J,I),J=J1,J2)                                       
   61 FORMAT(1H0,I3,1X,15(1X,F7.4))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 20F5.0                                                      
   70 WRITE(IOUT,71) I,(BUF(J,I),J=J1,J2)                                       
   71 FORMAT(1H0,I3,1X,20(1X,F5.0))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 20F5.1                                                      
   80 WRITE(IOUT,81) I,(BUF(J,I),J=J1,J2)                                       
   81 FORMAT(1H0,I3,1X,20(1X,F5.1))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 20F5.2                                                      
   90 WRITE(IOUT,91) I,(BUF(J,I),J=J1,J2)                                       
   91 FORMAT(1H0,I3,1X,20(1X,F5.2))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 20F5.3                                                      
  100 WRITE(IOUT,101) I,(BUF(J,I),J=J1,J2)                                      
  101 FORMAT(1H0,I3,1X,20(1X,F5.3))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 20F5.4                                                      
  110 WRITE(IOUT,111) I,(BUF(J,I),J=J1,J2)                                      
  111 FORMAT(1H0,I3,1X,20(1X,F5.4))                                             
      GO TO 1000                                                                
C                                                                               
C------------FORMAT 9G11.4                                                      
  120 WRITE(IOUT,121) I,(BUF(J,I),J=J1,J2)                                      
  121 FORMAT(1H0,I3,2X,1PG11.4,9(1X,G11.4))                                     
C                                                                               
 1000 CONTINUE                                                                  
 2000 CONTINUE                                                                  
C                                                                               
C9------RETURN                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE ULAPRW(BUF,TEXT,KSTP,KPER,NCOL,NROW,ILAY,IPRN,IOUT)            
C                                                                               
C                                                                               
C-----VERSION 1642 12MAY1987 ULAPRW                                             
C     ******************************************************************        
C     PRINT 1 LAYER ARRAY                                                       
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 TEXT        
      DIMENSION BUF(NCOL,NROW),TEXT(4)                                          
C     ------------------------------------------------------------------        
C                                                                               
C1------PRINT A HEADER                                                          
      IF(ILAY.LE.0) GO TO 5                                                     
      WRITE(IOUT,1) TEXT,ILAY,KSTP,KPER                                         
    1 FORMAT(1H1,10X,4A4,' IN LAYER',I3,' AT END OF TIME STEP',I3,              
     1     ' IN STRESS PERIOD',I3/11X,71('-'))                                  
C                                                                               
C2------MAKE SURE THE FORMAT CODE (IP OR IPRN) IS                               
C2------BETWEEN 1 AND 12.                                                       
    5 IP=IPRN                                                                   
      IF(IP.LT.1 .OR. IP.GT.12) IP=12                                           
C                                                                               
C3------CALL THE UTILITY MODULE UCOLNO TO PRINT COLUMN NUMBERS.                 
      IF(IP.EQ.1) CALL UCOLNO(1,NCOL,0,11,11,IOUT)                              
      IF(IP.EQ.2) CALL UCOLNO(1,NCOL,0,9,14,IOUT)                               
      IF(IP.GT.2 .AND. IP.LT.7) CALL UCOLNO(1,NCOL,3,15,8,IOUT)                 
      IF(IP.GT.6 .AND. IP.LT.12) CALL UCOLNO(1,NCOL,3,20,6,IOUT)                
      IF(IP.EQ.12) CALL UCOLNO(1,NCOL,0,10,12,IOUT)                             
C                                                                               
C4------LOOP THROUGH THE ROWS PRINTING EACH ONE IN ITS ENTIRETY.                
      DO 1000 I=1,NROW                                                          
      GO TO(10,20,30,40,50,60,70,80,90,100,110,120), IP                         
C                                                                               
C------------ FORMAT 11G10.3                                                    
   10 WRITE(IOUT,11) I,(BUF(J,I),J=1,NCOL)                                      
   11 FORMAT(1H0,I3,2X,1PG10.3,10(1X,G10.3)/(5X,11(1X,G10.3)))                  
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 9G13.6                                                     
   20 WRITE(IOUT,21) I,(BUF(J,I),J=1,NCOL)                                      
   21 FORMAT(1H0,I3,2X,1PG13.6,8(1X,G13.6)/(5X,9(1X,G13.6)))                    
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 15F7.1                                                     
   30 WRITE(IOUT,31) I,(BUF(J,I),J=1,NCOL)                                      
   31 FORMAT(1H0,I3,1X,15(1X,F7.1)/(5X,15(1X,F7.1)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 15F7.2                                                     
   40 WRITE(IOUT,41) I,(BUF(J,I),J=1,NCOL)                                      
   41 FORMAT(1H0,I3,1X,15(1X,F7.2)/(5X,15(1X,F7.2)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 15F7.3                                                     
   50 WRITE(IOUT,51) I,(BUF(J,I),J=1,NCOL)                                      
   51 FORMAT(1H0,I3,1X,15(1X,F7.3)/(5X,15(1X,F7.3)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 15F7.6                                                     
   60 WRITE(IOUT,61) I,(BUF(J,I),J=1,NCOL)                                      
   61 FORMAT(1H0,I3,1X,15(1X,F7.6)/(5X,15(1X,F7.6)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 20F5.0                                                     
   70 WRITE(IOUT,71) I,(BUF(J,I),J=1,NCOL)                                      
   71 FORMAT(1H0,I3,1X,20(1X,F5.0)/(5X,20(1X,F5.0)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 20F5.1                                                     
   80 WRITE(IOUT,81) I,(BUF(J,I),J=1,NCOL)                                      
   81 FORMAT(1H0,I3,1X,20(1X,F5.1)/(5X,20(1X,F5.1)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 20F5.2                                                     
   90 WRITE(IOUT,91) I,(BUF(J,I),J=1,NCOL)                                      
   91 FORMAT(1H0,I3,1X,20(1X,F5.2)/(5X,20(1X,F5.2)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 20F5.3                                                     
  100 WRITE(IOUT,101) I,(BUF(J,I),J=1,NCOL)                                     
  101 FORMAT(1H0,I3,1X,20(1X,F5.3)/(5X,20(1X,F5.3)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 20F5.4                                                     
  110 WRITE(IOUT,111) I,(BUF(J,I),J=1,NCOL)                                     
  111 FORMAT(1H0,I3,1X,20(1X,F5.4)/(5X,20(1X,F5.4)))                            
      GO TO 1000                                                                
C                                                                               
C------------ FORMAT 10G11.4                                                    
  120 WRITE(IOUT,121) I,(BUF(J,I),J=1,NCOL)                                     
  121 FORMAT(1H0,I3,2X,1PG11.4,9(1X,G11.4)/(5X,10(1X,G11.4)))                   
C                                                                               
 1000 CONTINUE                                                                  
C                                                                               
C5------RETURN                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE ULASAV(BUF,TEXT,KSTP,KPER,PERTIM,TOTIM,NCOL,                   
     1                   NROW,ILAY,ICHN)                                        
C                                                                               
C-----VERSION 1642 12MAY1987 ULASAV                                             
C     ******************************************************************        
C     SAVE 1 LAYER ARRAY ON DISK                                                
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 TEXT        
      DIMENSION BUF(NCOL,NROW),TEXT(4)                                          
C     ------------------------------------------------------------------        
C                                                                               
C1------WRITE AN UNFORMATTED RECORD CONTAINING IDENTIFYING                      
C1------INFORMATION.    
      WRITE(ICHN,*) KSTP,KPER,PERTIM,TOTIM,'''',TEXT,'''',NCOL,NROW,
     1     ILAY      
C                                                                               
C2------WRITE AN UNFORMATTED RECORD CONTAINING ARRAY VALUES                     
C2------THE ARRAY IS DIMENSIONED (NCOL,NROW)                                    
      WRITE(ICHN,*) ((BUF(IC,IR),IC=1,NCOL),IR=1,NROW)   
C                                                                               
C3------RETURN                                                                  
      RETURN                                                                    
      END                                                                       
      SUBROUTINE U1DREL(A,ANAME,JJ,IN,IOUT)                                     
C                                                                               
C                                                                               
C-----VERSION 1436 20MAY1983 U1DREL                                             
C     ******************************************************************        
C     ROUTINE TO INPUT 1-D REAL DATA MATRICES                                   
C       A IS ARRAY TO INPUT                                                     
C       ANAME IS 24 CHARACTER DESCRIPTION OF A                                  
C       JJ IS NO. OF ELEMENTS                                                   
C       IN IS INPUT UNIT                                                        
C       IOUT IS OUTPUT UNIT                                                     
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 ANAME
      CHARACTER*20 FMTIN        
      DIMENSION A(JJ),ANAME(6)                                         
C     ------------------------------------------------------------------        
C                                                                               
C1------READ ARRAY CONTROL RECORD.                                              
      READ (IN,1) LOCAT,CNSTNT,FMTIN,IPRN                                       
    1 FORMAT(I10,F10.0,A20,I10)                                                 
C                                                                               
C2------USE LOCAT TO SEE WHERE ARRAY VALUES COME FROM.                          
      IF(LOCAT.GT.0) GO TO 90                                                   
C                                                                               
C3------IF LOCAT=0 THEN SET ALL ARRAY VALUES EQUAL TO CNSTNT. RETURN            
      DO 80 J=1,JJ                                                              
   80 A(J)=CNSTNT                                                               
      WRITE(IOUT,3) ANAME,CNSTNT                                                
    3 FORMAT(1H0,52X,6A4,' =',G15.7)                                            
      RETURN                                                                    
C                                                                               
C4------IF LOCAT>0 THEN READ FORMATTED RECORDS USING FORMAT FMTIN.              
   90 WRITE(IOUT,5) ANAME,LOCAT,FMTIN                                           
    5 FORMAT(1H0,///30X,6A4,' WILL BE READ ON UNIT',I3,                         
     1         ' USING FORMAT: ',A20/30X,79('-')/)                              
      READ (LOCAT,FMTIN) (A(J),J=1,JJ)                                          
C                                                                               
C5------IF CNSTNT NOT ZERO THEN MULTIPLY ARRAY VALUES BY CNSTNT.                
      IF(CNSTNT.EQ.0.) GO TO 120                                                
      DO 100 J=1,JJ                                                             
  100 A(J)=A(J)*CNSTNT                                                          
C                                                                               
C6------IF PRINT CODE (IPRN) =>0 THEN PRINT ARRAY VALUES.                       
 120  IF(IPRN.LT.0) RETURN                                                      
      WRITE(IOUT,1001) (A(J),J=1,JJ)                                            
 1001 FORMAT((1X,1PG12.5,9(1X,G12.5)))                                          
      RETURN                                                                    
C                                                                               
C7------CONTINUE                                                                
      END                                                                       
      SUBROUTINE U2DINT(IA,ANAME,II,JJ,K,IN,IOUT)                               
C                                                                               
C                                                                               
C-----VERSION 1442 20APR1983 U2DINT                                             
C     ******************************************************************        
C     ROUTINE TO INPUT 2-D INTEGER DATA MATRICES                                
C       IA IS ARRAY TO INPUT                                                    
C       ANAME IS 24 CHARACTER DESCRIPTION OF IA                                 
C       II IS NO. OF ROWS                                                       
C       JJ IS NO. OF COLS                                                       
C       K IS LAYER NO. (USED WITH NAME TO TITLE PRINTOUT UNLESS K IS 0)         
C       IN IS INPUT UNIT                                                        
C       IOUT IS OUTPUT UNIT                                                     
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 ANAME
      CHARACTER*20 FMTIN        
      DIMENSION IA(JJ,II),ANAME(6)                                     
C     ------------------------------------------------------------------        
C                                                                               
C1------READ ARRAY CONTROL RECORD.
      READ (IN,1) LOCAT,ICONST,FMTIN,IPRN                                       
    1 FORMAT(I10,I10,A20,I10)                                                   
C                                                                               
C2------USE LOCAT TO SEE WHERE ARRAY VALUES COME FROM.                          
      IF(LOCAT) 200,50,90                                                       
C                                                                               
C3------IF LOCAT=0 THEN SET ALL ARRAY VALUES EQUAL TO ICONST. RETURN            
   50 DO 80 I=1,II                                                              
      DO 80 J=1,JJ                                                              
   80 IA(J,I)=ICONST                                                            
      IF(K.GT.0) WRITE(IOUT,2) ANAME,ICONST,K                                   
    2 FORMAT(1H0,52X,6A4,' =',I15,' FOR LAYER',I3)                              
      IF(K.LE.0) WRITE(IOUT,3) ANAME,ICONST                                     
    3 FORMAT(1H0,52X,6A4,' =',I15)                                              
      RETURN                                                                    
C                                                                               
C4------IF LOCAT>0 THEN READ FORMATTED RECORDS USING FORMAT FMTIN.              
   90 IF(K.GT.0) WRITE(IOUT,4) ANAME,K,LOCAT,FMTIN                              
    4 FORMAT(1H0,///30X,6A4,' FOR LAYER',I3,' WILL BE READ ON UNIT',            
     1       I3,' USING FORMAT: ',A20/30X,96('-'))                              
      IF(K.LE.0) WRITE(IOUT,5) ANAME,LOCAT,FMTIN                                
    5 FORMAT(1H0,///30X,6A4,' WILL BE READ ON UNIT',                            
     1        I3,' USING FORMAT: ',A20/30X,83('-'))                             
      DO 100 I=1,II                                                             
      READ (LOCAT,FMTIN) (IA(J,I),J=1,JJ)                                       
  100 CONTINUE                                                                  
      GO TO 300                                                                 
C                                                                               
C5------LOCAT<0 THEN READ UNFORMATTED RECORD CONTAINING ARRAY VALUES            
  200 LOCAT=-LOCAT                                                              
      IF(K.GT.0) WRITE(IOUT,201) ANAME,K,LOCAT                                  
  201 FORMAT(1H0,///30X,6A4,', LAYER',I3,                                       
     1    ' WILL BE READ UNFORMATTED ON UNIT',I3/30X,73('-'))                   
      IF(K.LE.0) WRITE(IOUT,202) ANAME,LOCAT                                    
  202 FORMAT(1H0,///30X,6A4,                                                    
     1    ' WILL BE READ UNFORMATTED ON UNIT',I3/30X,60('-'))                   
C                                                                               
C5A------READ AN UNFORMATTED DUMMY RECORD FIRST.                                
      READ(LOCAT)                                                               
      READ(LOCAT) IA                                                            
C                                                                               
C6------IF ICONST NOT ZERO THEN MULTIPLY ARRAY VALUES BY ICONST.                
  300 IF(ICONST.EQ.0) GO TO 320                                                 
      DO 310 I=1,II                                                             
      DO 310 J=1,JJ                                                             
      IA(J,I)=IA(J,I)*ICONST                                                    
  310 CONTINUE                                                                  
C                                                                               
C7------IF PRINT CODE (IPRN) =>0 THEN PRINT ARRAY VALUES.                       
  320 IF(IPRN.LT.0) RETURN                                                      
      IF(IPRN.GT.5) IPRN=0                                                      
      IPRN=IPRN+1                                                               
C                                                                               
C8------PRINT COLUMN NUMBERS AT TOP OF PAGE.                                    
      IF(IPRN.EQ.1) CALL UCOLNO(1,JJ,0,10,12,IOUT)                              
      NL=125/IPRN/5*5                                                           
      IF(IPRN.GT.1) CALL UCOLNO(1,JJ,4,NL,IPRN,IOUT)                            
C                                                                               
C9------PRINT EACH ROW IN THE ARRAY.                                            
      DO 110 I=1,II                                                             
C                                                                               
C10-----SELECT THE FORMAT                                                       
      GO TO(101,102,103,104,105,106), IPRN                                      
C                                                                               
C----------------FORMAT 10I11                                                   
  101 WRITE(IOUT,1001) I,(IA(J,I),J=1,JJ)                                       
 1001 FORMAT(1H0,I3,2X,I11,9(1X,I11)/(5X,10(1X,I11)))                           
      GO TO 110                                                                 
C                                                                               
C----------------FORMAT 60I1                                                    
  102 WRITE(IOUT,1002) I,(IA(J,I),J=1,JJ)                                       
 1002 FORMAT(1H0,I3,1X,60(1X,I1)/(5X,60(1X,I1)))                                
      GO TO 110                                                                 
C                                                                               
C----------------FORMAT 40I2                                                    
  103 WRITE(IOUT,1003) I,(IA(J,I),J=1,JJ)                                       
 1003 FORMAT(1H0,I3,1X,40(1X,I2)/(5X,40(1X,I2)))                                
      GO TO 110                                                                 
C                                                                               
C----------------FORMAT 30I3                                                    
  104 WRITE(IOUT,1004) I,(IA(J,I),J=1,JJ)                                       
 1004 FORMAT(1H0,I3,1X,30(1X,I3)/(5X,30(1X,I3)))                                
      GO TO 110                                                                 
C                                                                               
C----------------FORMAT 25I4                                                    
  105 WRITE(IOUT,1005) I,(IA(J,I),J=1,JJ)                                       
 1005 FORMAT(1H0,I3,1X,25(1X,I4)/(5X,25(1X,I4)))                                
      GO TO 110                                                                 
C                                                                               
C----------------FORMAT 20I5                                                    
  106 WRITE(IOUT,1006) I,(IA(J,I),J=1,JJ)                                       
 1006 FORMAT(1H0,I3,1X,20(1X,I5)/(5X,20(1X,I5)))                                
  110 CONTINUE                                                                  
      RETURN                                                                    
C                                                                               
C11-----RETURN                                                                  
      END                                                                       
      SUBROUTINE U2DREL(A,ANAME,II,JJ,K,IN,IOUT)                                
C                                                                               
C                                                                               
C-----VERSION 1439 20APR1983 U2DREL                                             
C     ******************************************************************        
C     ROUTINE TO INPUT 2-D REAL DATA MATRICES                                   
C       A IS ARRAY TO INPUT                                                     
C       ANAME IS 24 CHARACTER DESCRIPTION OF A                                  
C       II IS NO. OF ROWS                                                       
C       JJ IS NO. OF COLS                                                       
C       K IS LAYER NO. (USED WITH NAME TO TITLE PRINTOUT UNLESS K IS 0)         
C       IN IS INPUT UNIT                                                        
C       IOUT IS OUTPUT UNIT                                                     
C     ******************************************************************        
C                                                                               
C        SPECIFICATIONS:                                                        
C     ------------------------------------------------------------------
      CHARACTER*4 ANAME
      CHARACTER*20 FMTIN        
      DIMENSION A(JJ,II),ANAME(6)                                      
C     ------------------------------------------------------------------        
C                                                                               
C1------READ ARRAY CONTROL RECORD.                                              
      READ (IN,1) LOCAT,CNSTNT,FMTIN,IPRN                                       
    1 FORMAT(I10,F10.0,A20,I10)                                                 
C                                                                               
C2------USE LOCAT TO SEE WHERE ARRAY VALUES COME FROM.                          
      IF(LOCAT) 200,50,90                                                       
C                                                                               
C3------IF LOCAT=0 THEN SET ALL ARRAY VALUES EQUAL TO CNSTNT. RETURN            
   50 DO 80 I=1,II                                                              
      DO 80 J=1,JJ                                                              
   80 A(J,I)=CNSTNT                                                             
      IF(K.GT.0) WRITE(IOUT,2) ANAME,CNSTNT,K                                   
    2 FORMAT(1H0,52X,6A4,' =',G15.7,' FOR LAYER',I3)                            
      IF(K.LE.0) WRITE(IOUT,3) ANAME,CNSTNT                                     
    3 FORMAT(1H0,52X,6A4,' =',G15.7)                                            
      RETURN                                                                    
C                                                                               
C4------IF LOCAT>0 THEN READ FORMATTED RECORDS USING FORMAT FMTIN.              
   90 IF(K.GT.0) WRITE(IOUT,4) ANAME,K,LOCAT,FMTIN                              
    4 FORMAT(1H0,///30X,6A4,' FOR LAYER',I3,' WILL BE READ ON UNIT',            
     1       I3,' USING FORMAT: ',A20/30X,96('-'))                              
      IF(K.LE.0) WRITE(IOUT,5) ANAME,LOCAT,FMTIN                                
    5 FORMAT(1H0,///30X,6A4,' WILL BE READ ON UNIT',                            
     1       I3,' USING FORMAT: ',A20/30X,83('-'))                              
      DO 100 I=1,II                                                             
      READ (LOCAT,FMTIN) (A(J,I),J=1,JJ)                                        
  100 CONTINUE                                                                  
      GO TO 300                                                                 
C                                                                               
C5------LOCAT<0 THEN READ UNFORMATTED RECORD CONTAINING ARRAY VALUES            
  200 LOCAT=-LOCAT                                                              
      IF(K.GT.0) WRITE(IOUT,201) ANAME,K,LOCAT                                  
  201 FORMAT(1H0,///30X,6A4,', LAYER',I3,                                       
     1    ' WILL BE READ UNFORMATTED ON UNIT',I3/30X,73('-'))                   
      IF(K.LE.0) WRITE(IOUT,202) ANAME,LOCAT                                    
  202 FORMAT(1H0,///30X,                                                        
     1    ' WILL BE READ UNFORMATTED ON UNIT',I3/30X,60('-'))                   
C                                                                               
C5A------READ AN UNFORMATTED DUMMY RECORD FIRST.                                
      READ(LOCAT)                                                               
      READ(LOCAT) A                                                             
C                                                                               
C6------IF CNSTNT NOT ZERO THEN MULTIPLY ARRAY VALUES BY CNSTNT.                
  300 IF(CNSTNT.EQ.0.) GO TO 320                                                
      DO 310 I=1,II                                                             
      DO 310 J=1,JJ                                                             
      A(J,I)=A(J,I)*CNSTNT                                                      
  310 CONTINUE                                                                  
C                                                                               
C7------IF PRINT CODE (IPRN) =>0 THEN PRINT ARRAY VALUES.                       
  320 IF(IPRN.LT.0) RETURN                                                      
      CALL ULAPRW(A,ANAME,0,0,JJ,II,0,IPRN,IOUT)                                
      RETURN                                                                    
C                                                                               
C8------RETURN                                                                  
      END                                                                       
