C     ****************************************************************    A  10
C     *                                                              *    A  20
C     *     SOLUTE TRANSPORT AND DISPERSION IN A POROUS MEDIUM       *    A  30
C     *      NUMERICAL SOLUTION --- METHOD OF CHARACTERISTICS        *    A  40
C     *      PROGRAMMED BY J. D. BREDEHOEFT AND L. F. KONIKOW        *    A  50
C     *               REVISED APRIL 1979, MARCH 1980                 *    A  55
C     *               REVISED DECEMBER 1980                          *    A  56
C     *               REVISED AUGUST 1981, JUNE 1982                 *    A  57
C     *               REVISED OCTOBER 1983                           *    A  58
C     * REV. JUNE-AUG. 1984 BY W. SANFORD TO ALLOW 16 PTS. PER NODE  *    A  59
C     *  REV. MAY-AUG. 1985 BY L. KONIKOW AND M. PERSON TO INCLUDE:  *    A  59R
C     *       DECAY AND EQUILIBRIUM SORPTION-DESORPTION REACTIONS    *    A  60R
C     *                                                              *   SA  61
C     * REV. JULY-DEC.1985 TO ALLOW SECONDARY SUBGRID FOR TRANSPORT  *   SA  62
C     *               REVISED JULY 1986                              *    A  63
C     *               REVISED MARCH 1987 BY D.J. GOODE               *    A  64
C     *               REVISED MAY 1987 BY D.J. GOODE                 *    A  67
C     *               REVISED JANUARY 1988                           *    A  68A
C     *                                                              *    A  69R
C     ****************************************************************    A  70
CHRI  ****************************************************************
CHRI  *                                                              *
CHRI  *    PROGRAM NAME: MOCADI                                      *
CHRI  *   IGWMC VERSION: 2.5                                         *
CHRI  *                                                              *
CHRI  *         INTERNATIONAL GROUND WATER MODELING CENTER           *
CHRI  *                HOLCOMB RESEARCH INSTITUTE                    *
CHRI  *                     BUTLER UNIVERSITY                        *
CHRI  *               INDIANAPOLIS, INDIANA  46208                   *
CHRI  *                      (317) 283-9458                          *
CHRI  *                                                              *
CHRI  ****************************************************************
CHRI
CHRI  ---FILENAME VARIABLES FOR IBM PC VERSION
CHRI
      CHARACTER*40 INFILE,OUTFILE
CHRI
      DOUBLE PRECISION DMIN1,DEXP,DLOG,DABS                               A  80
      DOUBLE PRECISION TMRX,VPRM,HI,HR,HC,HK,WT,REC,RECH,TIM,AOPT,TITLE   A  90
      DOUBLE PRECISION XDEL,YDEL,S,AREA,SUMT,RHO,PARAM,TEST,TOL,PINT,     A 100
     1                 HMIN,PYR                                           A 101
      DOUBLE PRECISION TINT,ALPHA1,ANITP                                  A 110
      DOUBLE PRECISION TMSUM,ANTIM,TDEL                                   A 116
      COMMON /PRMJ/ NTIM,NPMP,NPNT,NITP,N,NX,NY,NP,NREC,INT,NNX,NNY,NUMO  A 120
     1BS,NMOV,IMOV,NPMAX,ITMAX,NZCRIT,IPRNT,NPTPND,NPNTMV,NPNTVL,NPNTD,N  A 130
     2PNCHV,NPDELC,ICHK                                                   A 141
      COMMON /PRMC/ NODEID(40,40),NPCELL(20,20),NPOLD(20,20),LIMBO(500), SA 145
     1IXOBS(5),IYOBS(5)                                                   A 146
      COMMON /HEDA/ THCK(40,40),PERM(40,40),TMWL(5,50),TMOBS(50),ANFCTR  SA 170
      COMMON /HEDB/ TMRX(40,40,2),VPRM(40,40),HI(40,40),HR(40,40),HC(40, SA 180
     140),HK(40,40),WT(40,40),REC(40,40),RECH(40,40),TIM(100),AOPT(20),  SA 190
     2TITLE(10),XDEL,YDEL,S,AREA,SUMT,RHO,PARAM,TEST,TOL,PINT,HMIN,PYR    A 200
      COMMON /HEDC/ MX,MY,MMX,MMY,NMX,NMY,MCHK                           SA 205
      COMMON /CHMA/ PART(3,6400),CONC(20,20),TMCN(5,50),VX(40,40),VY(40, SA 211
     140),CONINT(20,20),CNRECH(20,20),POROS,SUMTCH,BETA,TIMV,STORM,STORM SA 220
     2I,CMSIN,CMSOUT,FLMIN,FLMOT,SUMIO,CELDIS,DLTRAT,CSTORM               A 230
CHRI     
C     ***************************************************************
C       introductory screen and prompts for input, output files
C
      WRITE (*,51)
  51  FORMAT (1H1,19X,42HINTERNATIONAL GROUND WATER MODELING CENTER,/,1H
     1 ,27X,26HINDIANAPOLIS, INDIANA, USA,/,32X,18HMOCADI VERSION 2.5)
C    
      WRITE (*,52)
      READ  (*,53)INFILE
      WRITE (*,54)
      READ  (*,53)OUTFILE
  52  FORMAT (' ',////,12X,' ENTER NAME OF INPUT FILE: ')
  53  FORMAT (A40)
  54  FORMAT (' ',//,12X,' ENTER NAME OF OUTPUT FILE: ')
C
      OPEN(UNIT=5,FILE=INFILE,ACCESS='SEQUENTIAL',STATUS='OLD')
      OPEN(UNIT=6,FILE=OUTFILE,ACCESS='SEQUENTIAL')
      REWIND 5
      REWIND 6
C
C      ---PRINT IGWMC VERSION NUMBER IDENTIFICATION
C
      WRITE (6,55)
  55  FORMAT (1H1,19X,42HINTERNATIONAL GROUND WATER MODELING CENTER,/,1H
     1 ,27X,26HINDIANAPOLIS, INDIANA, USA,/,32X,18HMOCADI VERSION 2.5)
CHRI
C     ***************************************************************
C      ---LOAD DATA---                                                    A 250
      INT=0                                                               A 260
      TMSUM=0.0                                                           A 265
      CALL PARLOD                                                         A 270
      CALL GENPT                                                          A 280
C     ***************************************************************     A 290
C     ---START COMPUTATIONS---                                            A 300
C        ---COMPUTE ONE PUMPING PERIOD---                                 A 310
      DO 150 INT=1,NPMP                                                   A 320
      IF (INT.GT.1) TMSUM=TMSUM+PYR                                       A 325
      IF (INT.GT.1) CALL PARLOD                                           A 330
      IPCK=0                                                              A 336
      REMN=1.0                                                            A 338
C        ---COMPUTE ONE TIME STEP---                                      A 340
      DO 130 N=1,NTIM                                                     A 350
      IPRNT=0                                                             A 360
C        ---LOAD NEW DELTA T---                                           A 370
      TINT=SUMT-TMSUM                                                     A 381
      TDEL=DMIN1(TIM(N),PYR-TINT)                                         A 390
      SUMT=SUMT+TDEL                                                      A 400
      IF (TDEL.EQ.(PYR-TINT)) IPCK=1                                      A 406
      TIM(N)=TDEL                                                         A 410
      IF (NPNT.GT.0) REMN=MOD(N,NPNT)                                     A 421
C     ***************************************************************     A 430
      IF (S.EQ.0.0.AND.ICHK.EQ.0.AND.(N.GT.1.OR.INT.GT.1)) GO TO 101      A 435
      CALL ITERAT                                                         A 440
      IF (REMN.EQ.0.0.OR.N.EQ.NTIM.OR.IPCK.EQ.1) CALL OUTPT               A 451
      CALL VELO                                                           A 460
  101 CALL MOVE                                                           A 471
C     ***************************************************************     A 480
C     ---STORE OBS. WELL DATA FOR TRANSIENT FLOW PROBLEMS---              A 490
      IF (S.EQ.0.0) GO TO 120                                             A 500
      IF (NUMOBS.LE.0) GO TO 120                                          A 510
      J=MOD(N,50)                                                         A 520
      IF (J.EQ.0) J=50                                                    A 530
      TMOBS(J)=SUMT                                                       A 540
      DO 110 I=1,NUMOBS                                                   A 550
      TMWL(I,J)=HK(IXOBS(I),IYOBS(I))                                     A 560
      IX=IXOBS(I)-MX+1                                                   SA 562
      IF (IXOBS(I).LT.MX.OR.IXOBS(I).GT.MMX) GO TO 110                   SA 563
      IY=IYOBS(I)-MY+1                                                   SA 564
      IF (IYOBS(I).LT.MY.OR.IYOBS(I).GT.MMY) GO TO 110                   SA 565
      TMCN(I,J)=CONC(IX,IY)                                              SA 571
  110 CONTINUE                                                            A 580
C     ***************************************************************     A 590
C     ---OUTPUT ROUTINES---                                               A 600
  120 IF (REMN.EQ.0.0.OR.N.EQ.NTIM.OR.MOD(N,50).EQ.0.OR.IPCK.EQ.1)        A 611
     1 CALL CHMOT                                                         A 612
      IF (SUMT.GE.(PYR+TMSUM)) GO TO 140                                  A 621
  130 CONTINUE                                                            A 630
C     ***************************************************************     A 640
C     ---SUMMARY OUTPUT---                                                A 650
  140 CONTINUE                                                            A 660
      IPRNT=1                                                             A 670
      CALL CHMOT                                                          A 680
  150 CONTINUE                                                            A 690
C     ***************************************************************     A 700
      ENDFILE(6)                                                          A 702
      IF (NPNCHV.EQ.0) GO TO 155                                          A 703
      ENDFILE(7)                                                          A 704
  155 CONTINUE                                                            A 705
      STOP                                                                A 710
C     ***************************************************************     A 720
      END                                                                 A 730-
