Error executing df.exe

COMMON/PAWC/H(320000)
      COMMON/GCBANK/Q(2560000)
c      parameter(kWbank=69000)
c      COMMON/GCBANK/NZEBRA,GVERSN,ZVERSN,IXSTOR,IXDIV,IXCONS,FENDQ(16)
c     +             ,LMAIN,LR1,WS(KWBANK)
c
c      common/sctn/ekfiss(1000),csgn(1000),csgf(1000),khuia
 
 
*
*     ------------------------------------------------------------------
*
      CALL GZEBRA(2560000)
      CALL HLIMIT(-320000)
*
*             Geant initialization.
*
      CALL UGINIT
*
      CALL GRUN
 
c   call igmeta(20,-111)
c   call igrng(20.,20.)*
      CALL UGLAST
*
      STOP
*
      END
 
 
      SUBROUTINE UFILES
*
*            To open FFREAD and HBOOK files
*
      CHARACTER*(*) FILNAM, FSTAT
      PARAMETER (FILNAM='oldnew.dat')
*
      PARAMETER (FSTAT='old')
*
      OPEN(UNIT=4,FILE=FILNAM,STATUS=FSTAT,FORM='FORMATTED')
      OPEN(UNIT=74,FILE='gespe.ntp')
c   open(unit=20,file='pic2.ps',form='formatted',status='unknown')
C      OPEN(73,FILE='FORT.73',FORM='UNFORMATTED',ACCESS='SEQUENTIAL')
*
*             Open a HBOOK4 direct access file
*
      CALL HROPEN(34,'HBOOK','gexam2.hist','N',1024,ISTAT)
      END
 
 
 
      SUBROUTINE UGINIT
*
************************************************************************
*                                                                      *
*              To initialise GEANT3 program and read data cards        *
*                                                                      *
************************************************************************
*
      COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5)
      INTEGER LIN,LOUT,NUNITS,LUNITS
      COMMON/GCMAIL/CHMAIL
      CHARACTER*132 CHMAIL
 
      COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
     +      ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
 
*
      COMMON/CDHSC/TRESHO,TRIGGE,VLET(3),ESINT(5),ENLO,IMENA,NMATER,
     &             IFUCK,JMATER(20),nn,idraw,iqwa,imld
      CHARACTER*4 IMENA(20)
*
*             Open user files
*
      OPEN(11,FILE='oldnew.par')
      READ(11,'(2I3)') NN, IDRAW
      rewind 11
      CLOSE(11)
 
      CALL UFILES
*
 
*             Initialize GEANT
*
      CALL GINIT
*
*             Prints version number
*
      WRITE(LOUT,1000)
*
*             Read data cards with FFREAD
*
      CALL FFKEY('VLET', VLET, 3, 'REAL')
      CALL FFKEY('TRHS', TRESHO, 2, 'REAL')
      CALL GFFGO
*
*             Initialize GEANT/ZEBRA data structures
*
       CALL GZINIT
*
      IF(IDRAW.EQ.1) call iginit(0)
*
*           Request workstation type
*
       IF(IDRAW.EQ.1) CALL IGWKTY(IWK)
*
*           Initialize HPLOT
*
      CALL HPLINT(IWK)
 
      IF(IDRAW.EQ.1) CALL IGSA(0)
*
*             Initialize graphics package
*
      IF(IDRAW.EQ.1) CALL GDINIT
*
*             Geometry and materials description.
*
      CALL GECDHS
*
*             Particle table definition and energy loss initialization.
*
      CALL GPART
      CALL GPHYSI
*
*             Create a view bank
*
      IF(IDRAW.EQ.1) CALL VIEWYZ(0)
*
      call gdxyz(0)
 
 1000 FORMAT(/,'  GEXAM2 VERSION 1.00 : ',/)
      END
*
      SUBROUTINE GECDHS
*
************************************************************************
*                                                                      *
*             Routine to define the geometry of the set-up.            *
*                                                                      *
************************************************************************
*
*
      COMMON/CDHSC/TRESHO,TRIGGE,VLET(3),ESINT(5),ENLO,IMENA,NMATER,
     &             IFUCK,JMATER(20),nn,idraw,iqwa,imld
*
C      COMMON/ATARG/ATARG1,ATRAG2
 
      DIMENSION PAR(20), ISNOT(20), ANGLES(20,6),
     *          nmtx(20),PARS(20,10),poz(20,3),icol(20),nummix(20),
     *          a(20,20),z(20,20),w(20,20),aa(20),zz(20),
     *          ww(20),ro(20),ama(20),zma(20),roma(20),radlma(20),
     *          abslma(20)
*
      character*4 shapes(20), imena(20), mama(20)
      character*20 matnam(20)
      parameter(ibigg=10000)
*
      OPEN(12,FILE='angles.par')
      OPEN(91,FILE='oldnew.par')
      READ(91,'(4I3)') NN, idraw, NTAR1, NTAR2
      write (*,'(4I3)') NN, idraw,NTAR1, NTAR2
 
      open(94,file='interes.dat')
      read(94,'(4i3)') NMATER, IFUCK ,iqwa, imld
      close (94)
 
c       write(*,*) 'calculating TETA begins'
 
c      if(jf.eq.1) then
c       tet = 4.0*atan(1.0)*srrun(ibigg)/180.0
c       cost = cos(tet)
c      end if
c      write(*,*) 'calculating TETA finished'
 
      DO I=1,NN
c... j=1,3 instead of j=1,isnot(i)
C        READ(91,'(3(a4,1x),i1,1x,i2,6(1x,f7.2),1x,i2)')
C     &   imena(i),mama(i),shapes(i),ISNOT(I),nmtx(i),
C     &   PARS(I,1),pars(i,2),pars(i,3),
C     &   POZ(I,1),poz(i,2),poz(i,3),
C     &   icol(i)
*
C   EFIMKIN SOSTELIL XUJNIU
*
         READ(91,'(3(a4,1x),i1,1x,i2,1x,i2)')
     &    imena(i),mama(i),shapes(i),ISNOT(I),nmtx(i),icol(i)
         READ(91,'(20(1x,f11.4))')
     &    (PARS(I,J),J=1,ISNOT(I)),(POZ(I,J),J=1,3)
*
c        write (*,*) imena(1),mama(1),shapes(1),ISNOT(1),nmtx(1),
c     &             (PARS(1,J),J=1,ISNOT(1)), (POZ(1,J),J=1,3),icol(1)
*
c          if(jf.eq.1.and.i.eq.ntar) then
c           pars(i,3) = pars(i,3)/cost
c         end if
 
        IF(NMTX(I).GT.0) THEN
            K=NMTX(I)
            READ(12,*) (ANGLES(K,J),J=1,6)
        END IF
      END DO
      CLOSE(91)
      CLOSE(12)
*
      open(92,file='mix.it')
      open(12,file='mix.yes')
      open(13,file='mix.no')
      K=0
      do i=1,nn
        read(92,'(i2,2x,a20)') nummix(i),matnam(i)
        WRITE(*,'(i2,2x,a20)') nummix(i),matnam(i)
        if(nummix(i).ne.0) then
           K=K+1
           read(12,'(f8.3)') ro(K)
           read(12,'(7f8.3)') (a(K,j),j=1,abs(nummix(i)))
           read(12,'(7f8.3)') (z(K,j),j=1,abs(nummix(i)))
           read(12,'(7f8.3)') (w(K,j),j=1,abs(nummix(i)))
           write(*,'(f8.3)') ro(K)
           write(*,'(7f8.3)') (a(K,j),j=1,abs(nummix(i)))
           write(*,'(7f8.3)') (z(K,j),j=1,abs(nummix(i)))
           write(*,'(7f8.3)') (w(K,j),j=1,abs(nummix(i)))
           
           do j=1,abs(nummix(i))
              aa(j)=a(K,j)
              zz(j)=z(K,j)
              ww(j)=w(K,j)
           end do
           call gsmixt(i, matnam(i), aa, zz, ro, nummix(i), ww)
        else
           read(13,'(5(1x,e8.3,1x))') ama(i),zma(i),roma(i),
     &                                radlma(i),abslma(i)
 
C           IF(I.EQ.nTAR1) ATARG1=AMA(I)
C           IF(I.EQ.ntaR2) ATARG2=ama(I)
           
           call gsmate(i, matnam(i), ama(i), zma(i), roma(i),
     &                 radlma(i), abslma(i), 0, 0)
        end if
      end do
      close(92)
      close(12)
      close(13)
*
*             Defines tracking media parameters.
*
      open(93,file='oldnew.tra')
      read(93,'(f8.3,i3,5f8.3)')
     & fieldm, ifield, tmaxfd, dmaxms, deemax, epsil, stmin
      close(93)
*
      if(imld.ne.0) then
           CALL GSTMED ( 1, matnam(1)    ,  1 , 0 , IFIELD ,
     *                FIELDM,TMAXFD,0.,0., EPSIL, STMIN,0 , 0 )
        do i=2,nn
         if(i.eq.ntar1.or.i.eq.ntar2) then                        
           CALL GSTMED( i, matnam(i)    ,  i , 0 , 0,
     *                FIELDM,TMAXFD,0.,0., EPSIL, STMIN,0 , 0 )
         else                                     
           CALL GSTMED( i, matnam(i)    ,   i , 0 , 0 ,
     *                FIELDM,TMAXFD,0.,0., EPSIL, STMIN,0 , 0 )
         end if
        end do
 
       else
 
        do i=1,nn
           CALL GSTMED( i, matnam(i)    ,  i , 0 , ifield,
     *                FIELDM,TMAXFD,0.,0., EPSIL, STMIN,0 , 0 )
        end do
      end if
*                          z
*             Defines geometry of the set-up
*             Define the overall calorimeter
*
      do j=1,isnot(1)
         PAR(j)=PARS(1,j)
      end do
 
      CALL GSVOLU(imena(1), shapes(1), 1,PAR, isnot(1), IVOLU)
      call gsord(imena(1),3)
*
*               The rest set-up
*
       do i=2,nn
c !
       if (isnot(i).gt.0) then
 
         do j=1,isnot(i)
             par(j) = pars(i,j)
         end do
         if(nmtx(i).gt.0) then
            IMTX=NMTX(I)
            call gsvolu(imena(i),shapes(i),i,par,isnot(i), ivolu)
            CALL GSROTM(IMTX,    ANGLES(IMTX,1),
     &                           ANGLES(IMTX,2),
     &                           ANGLES(IMTX,3),
     &                           ANGLES(IMTX,4),
     &                           ANGLES(IMTX,5),
     &                           ANGLES(IMTX,6) )
 
            CALL GSPOS(imena(i), 1, mama(i), POz(i,1), POz(i,2),
     &                 POz(i,3), IMTX, 'ONLY')
         else
 
            call gsvolu(imena(i),shapes(i),i,par,isnot(i), ivolu)
            call gspos(imena(i), 1, mama(i), POz(i,1), POz(i,2),
     &                 POz(i,3), 0, 'ONLY')
         end if
         IF(IDRAW.GT.0) THEN
          NCOL=ICOL(I)
          call gsatt(imena(i),'COLO',Ncol)
         END IF
 
       end if
 
      end do
*
*             Close geometry banks. Mandatory system routine.
*
      CALL GGCLOS
 
*
      END
*
      SUBROUTINE GUKINE
*
************************************************************************
*                                                                      *
*             Read or Generates Kinematics for primary tracks          *
*                                                                      *
************************************************************************
*
      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
      COMMON/GCFLAX/BATCH, NOLOG
      LOGICAL BATCH, NOLOG
*
      COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP
     +      ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD
*
      COMMON/CDHSC/TRESHO,TRIGGE,VLET(3),ESINT(5),ENLO,IMENA,NMATER,
     &             IFUCK,JMATER(20),nn,idraw,iqwa,imld
      CHARACTER*4 IMENA(20)
*
      DIMENSION VERTEX(3),PLAB(3)
      parameter(ibigg=10000)
 
      OPEN(94,FILE='interes.dat')
      READ(94,'(4I3,2f11.4)') NMATER, IFUCK ,iqwa,IMLD,thein,phin
c      
c      READ(94,'(2f11.4)') 
        
 
      DO I=1,NMATER
         READ(94,*) JMATER(I)
      END DO
      CLOSE(94)
*
        
    IDURNDM=0
       if(iqwa.eq.0) then
       IDURNDM= IDRNDM+1
       UTHETA = thein/180.*3.14159265358
c      UPHI   = RNDM(IDURNDM)*2*3.14159265358     45./180.* 3.14159265358
       UPHI   =phin/180.*3.14159265358
 
       VERTEX(1) = VLET(1)
       VERTEX(2) = VLET(2)
       VERTEX(3) = VLET(3)
 
       PLAB(1) = PKINE(1) * SIN(UTHETA) * COS(UPHI)
       PLAB(2) = PKINE(1) * SIN(UTHETA) * SIN(UPHI)
       PLAB(3) = PKINE(1) * COS(UTHETA)
 
 
 
      else
 
c       UTHETA = 4.0*atan(1.0)*srrun(ibigg)/180.0
       UTHETA = thein/180.*3.14159265358
c       write(*,*) 'atan(1.0)',atan(1.0),'srrun',srrun(ibigg)
c       write(*,*) ' UTHETA= ',  UTHETA
       UPHI   = 3.14159265358/2.
 
       VERTEX(1) = VLET(1)
       VERTEX(2) = VLET(2)-abs(VLET(3))*tan(utheta)
       VERTEX(3) = VLET(3)
 
c      end if
 
 
c       IF(IFUCK.EQ.1) THEN
 
c         IE_BATb=ibigg
         pkine(1)= srrun(ibigg) * 0.001
c         write(*,*) '!!!pkine(1) = ', pkine(1)
         PLAB(1) = PKINE(1) * SIN(UTHETA) * COS(UPHI)
c         write(*,*) 'PLAB(1) =',PLAB(1)
         PLAB(2) = PKINE(1) * SIN(UTHETA) * SIN(UPHI)
c         write(*,*) 'PLAB(2) =',PLAB(2)
         PLAB(3) = PKINE(1) * COS(UTHETA)
c         write(*,*) 'PLAB(3) =',PLAB(3)
c         end if
c      ELSE
c         PLAB(1) = PKINE(1) * SIN(UTHETA) * COS(UPHI)
c         PLAB(2) = PKINE(1) * SIN(UTHETA) * SIN(UPHI)
c         PLAB(3) = PKINE(1) * COS(UTHETA)
      END IF
 
C      write(*,*) 'utheta = ',utheta,'N event=',ievent
C      write(*,*) 'pkine(1) =  ',PKINE(1)
*
    
      call gdpart(0,1 ,0.4)
      CALL GSVERT(VERTEX,0,0,0,0,NVERT)
      CALL GSKINE(PLAB,IKINE,NVERT,0,0,NT)
 
*
*             Reset energy deposited
*
      CALL VZERO(ESINT,5)
      CALL VZERO(ENLO,1)
*
*              Kinematic debug (controled by ISWIT(1))
*
      IF(IDEBUG.EQ.1.AND.ISWIT(1).EQ.1) THEN
        CALL GPRINT('VERT',0)
        CALL GPRINT('KINE',0)
      ENDIF
*
      END
 
      SUBROUTINE GUTREV
*
************************************************************************
*                                                                      *
*             User routine to control tracking of one event            *
*                                                                      *
*             Called by GRUN                                           *
*                                                                      *
************************************************************************
*
      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
      COMMON/GCFLAX/BATCH, NOLOG
      LOGICA   L BATCH, NOLOG
*
      CALL GTREVE
*
*             Debug and plot tracks.
*
 
 
      IF(IDEBUG.EQ.1) THEN
        IF(ISWIT(2).EQ.1) CALL GPRINT('JXYZ', 0)
        IF(ISWIT(3).EQ.1) THEN
          call gdxyz(0)
          
          ENDIF
      ENDIF
 
*
      END
 
      SUBROUTINE GUOUT
*
C.    ******************************************************************
C.    *                                                                *
C.    *       User routine called at the end of each event.            *
C.    *                                                                *
C.    ******************************************************************
C.
C.
      COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5)
      INTEGER LIN,LOUT,NUNITS,LUNITS
      COMMON/GCMAIL/CHMAIL
      CHARACTER*132 CHMAIL
 
      CHARACTER*20 CHIEVE
 
*
      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
      COMMON/GCFLAX/BATCH, NOLOG
      LOGICAL BATCH, NOLOG
*
      PARAMETER (MAXMEC=30)
      COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(MAXMEC)
     + ,NAMEC(MAXMEC),NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG
     + ,STEP  ,SNEXT ,SFIELD,TOFG  ,GEKRAT,UPWGHT,IGNEXT,INWVOL
     + ,ISTOP ,IGAUTO,IEKBIN, ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN
     + ,NLVSAV,ISTORY
*
      COMMON/CDHSC/TRESHO,TRIGGE,VLET(3),ESINT(5),ENLO,IMENA,NMATER,
     +             IFUCK,JMATER(20),nn,idraw,iqwa,imld
      CHARACTER*4 IMENA(20)
c      real x3d(3), U,V
      
      
c      do i=1,3
c       x3d(i)=vout(i)
c      end do
c      call gdfr3d(x3d,-1,U,V)
c      write(*,'(5f6.2)') x3d(1), x3d(2), x3d(3), u, v
c       u=u-0.5*0.4
c       v=v+1.5*0.4
c       write(chieve,'(i4,''$'')') ipart
c       call gdrawt(u,v,chieve,0.4,0.,4,1) 
 
c       CALL gdpart(0,11,0.3)
            
            
c           if(ESINT(3).GT.0.0) THEN
c           WRITE(73,'(5F11.4)') ESINT(3)*1000., TETAUG, FIUG,
c     &                          ESINT(4),ESINT(5)
c           WRITE(75,*) IEVENT, esint(1)
c          esint(1)=esint(1)+1.
c          END IF
 
 
 
      
      IF(IDRAW.EQ.1) THEN
c          call gdgirl(3.,3.)
c   call igmeta(20,-111)
c   call igrng(20.,20.)
       
 
       IF (IEVENT.EQ.INT(IEVENT*1./20.)*20) THEN
         CALL ICLRWK(0,0)
         CALL VIEWYZ(0)
         WRITE (CHIEVE,'(A10,I9,A1)') '  IEVENT =',IEVENT,'$'
         CALL GDRAWT(15.,19.,CHIEVE,0.5,0.0,5,1)
        END IF
       END IF
        close(94)
*
      END
 
      SUBROUTINE UGLAST
*
************************************************************************
*                                                                      *
*            Termination routine to print histograms and statistics    *
*                                                                      *
************************************************************************
*
      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
      COMMON/GCFLAX/BATCH, NOLOG
      LOGICAL BATCH, NOLOG
*
      COMMON/CDHSC/TRESHO,TRIGGE,VLET(3),ESINT(5),ENLO,IMENA,NMATER,
     &             IFUCK,JMATER(20),nn,idraw,iqwa,imld
      CHARACTER*4 IMENA(20)
*
      CALL GLAST
c   call igmeta(0,0)
c   call iclrwk(0,0)
*
*             Close GKS display file
*
      CALL IGEND
*
      END
 
      SUBROUTINE VIEWYZ (IVIEW)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *     Draw full set up in 'view bank' mode.                      *
C.    *                                                                *
C.    ******************************************************************
C.
      COMMON/CDHSC/TRESHO,TRIGGE,VLET(3),ESINT(5),ENLO,IMENA,NMATER,
     &             IFUCK,JMATER(20),nn,idraw,iqwa,imld
      CHARACTER*4 IMENA(20)
 
      OPEN(14, FILE='view.dat')
      READ(14,*) THETA, PHI, PSI, U0, V0, SU, SV, DRAX
      CLOSE(14)
 
      CALL GSATT('*','SEEN', 1)
 
      CALL GDOPEN(IVIEW)
C
C      CALL GDHEAD(110110, 'VIEW XYU$' ,0.5)
      CALL GDHEAD(000110, 'VIEW XYU$' ,0.5)
C
      CALL  GDRAW (IMENA(1), THETA, PHI, PSI, U0, V0, SU, SV)
      IF (DRAX.NE.0.) CALL GDAXIS(0.,0.,0.,DRAX) 
           
c           call gdxyz(0)
c           call gdcol(0)
*
      END
 
 
 
            SUBROUTINE GUFLD(X,F)
C.
C.    ******************************************************************
C.    *                                                                *
C.    *       User routine to compute the magnetic field F             *
C.    *       at space point X                                         *
C.    *                                                                *
C.    *    ==>Called by : GHELIX,GRKUTA                                *
C.    *                                                                *
C.    ******************************************************************
C.
      DIMENSION X(7),F(4)
       real  Alfa,Y0,Pi,B0,Aa,Rr,Delta,Rb,Scon,Xp,Alfa1,X0
c       razmer
C.
C.    ------------------------------------------------------------------
C.
      open(52,file='magnet1.fld')   
        read(52,'(3f11.4)') F(1),Alfa,Y0
        read(52,'(3f11.4)') F(2),Aa,X0
        read(52,'(2f11.4)') F(3),xp
        read(52,'(f11.4)')  F(4)
 
        B0=F(2)
 
        Pi=4.*ATAN(1.)
         Alfa=Pi*Alfa/180.
         
         Rr=SQRT(X(1)**2+X(3)**2)        
         
         Alfa1=ATAN(Rr*TAN(Alfa)/(Aa+Rr))
 
         Scon=(Y0*B0/Alfa1)
 
         Delta=Y0/TAN(Alfa1)
 
         Rb=SQRT(X(2)**2+(Rr+Delta)**2)
        
        F(1)=(-1.)*Scon*(X(1)*X(2))/((Rb**2)*Rr)
 
        F(2)=(Scon/xp)*SQRT(1.-(X(2)**2/Rb**2))/Rb
 
        F(3)=(-1.)*Scon*(X(2)*X(3))/((Rb**2)*Rr)
       
        close(52)
      return
C
      END
 
=====================

$debug
       program LiCl
       implicit double precision(a-h,o-z)
       character*6 out1
       
c        INTEGER*4 n
c      DIMENSION P [ALLOCATABLE](:,:)
c       
        DIMENSION PPa [ALLOCATABLE](:)
 
c 
         DIMENSION CLiCl [ALLOCATABLE](:,:)
 
      
       open (4,file='datas',status='UNKNOWN')
       read(4,1) out1
       write(*,1) out1
   1    format(1(1x,a6/))
       open (3,file=out1,status='UNKNOWN')
       write(3,1) out1
     
c       
       
     write(3,*) ''
     
     read(4,*) NShema
       
 
 
     read(4,*) Nx
       write(3,*) 'Nx - ÷èñëî èíòåðâàëîâ ïî îñè Õ=',Nx
 
        ALLOCATE (P(3,Nx+1))
        ALLOCATE (PPa(Nx+1))
        ALLOCATE (CLiCl(3,Nx+1))
 
 
 
       read(4,*) dTime
       write(3,*) 'dTime - ',dTime 
       read(4,*) Nprt
       write(3,*) 'Nprt - ',Nprt
       read(4,*) Tstop
       write(3,*) 'Tstop - è',Tstop
 
     
     read(4,*) P0
       write(3,*) 'P0 
     read(4,*) Ro
       write(3,*) 'Ro 
     read(4,*) C0
       write(3,*) 'C0 
 
       read(4,*) V
     write(3,*) 'V 
       read(4,*) VLq
     write(3,*) 'VLq 
       read(4,*) Dlina
       write(3,*) 'Dlina 
 
       read(4,*) Permea
       write(3,*) 'Permea 
 
       read(4,*) R
       write(3,*) 'R 
       read(4,*) Temper
     write(3,*) 'Temper 
       
c  
       write(3,*) 
       AA=771.3d0
     write(3,*) 'A = (Ïà)',AA
       BB=16.13d0
     write(3,*) 'B = (Ïà)',BB
       DD=0.058d0
     write(3,*) 'd = (Ïà))',DD
 
 
 
 
         write(3,*) 
 
        Dxx=1.d0/Nx
        write(3,*) 
 
 
       TemprKelv=Temper+273.15d0
        write(3,*) 
 
       Tau0=1.d0/(Permea*R*TemprKelv)
        write(3,*) 
 
       Tau01=Dlina/V
        write(3,*) 
 
         Tau02=Dlina/VLq
        write(3,*)
 
 
 
       EVL=Tau0/Tau01
        write(3,*) 'EVL   =',EVL
 
       VEL=Tau0/Tau02
    
        write(3,*) 'VEL    =',VEL
 
       ELV=Tau0*Permea/Ro
    
        write(3,*) 'ELV   =',ELV
 
 
        Dts=Tau0*dTime
        write(3,*)
 
     IF(NShema.EQ.1) then
     write(3,*) 
        write(3,*) '+++++++++++++++++++++++++++'
         ENDIF
     IF(NShema.EQ.2) then
     write(3,*) 
        write(3,*) '+++++++++++++++++++++++++++'
         ENDIF
 
 
c          
 
          Time=0.d0
           do 2 i=1,Nx+1
           CLiCl(1,i)=C0
         P(1,i)=1.d0
  2        continue
 
c           
            Time=Time+dTime
           do 3 i=1,Nx+1
           CLiCl(2,i)=C0
         P(2,i)=1.d0
  3        continue
 
c            
                 kk=1
  101       Time=Time+dTime
 
 
                kk=kk+1
 
c             
                     IF(NShema.EQ.1) then
 
 
 
c            
             do 4 i=2,Nx
 
         P(3,i)=P(2,i)-dTime/Dxx*EVL*(P(2,i)-P(2,i-1))
     *   -dTime*(P(2,i)-(AA-BB*CliCl(2,i))*dexp(DD*Temper)/P0)
  4       continue
 
c           
           P(3,1)=1.d0
 
c            
c            P(3,Nx+1)=(4.d0*P(3,Nx)-P(3,Nx-1))/3.d0
       P(3,Nx+1)=(18.d0*P(3,Nx)-9.d0*P(3,Nx-1)+2.d0*P(3,Nx-2))/11.d0
 
 
    
 
c          
             do 11 i=2,Nx
         CLiCl(3,i)=CLiCl(2,i)-dTime/Dxx*VEL*(CLiCl(2,i)-CLiCl(2,i-1))
     *   +dTime*ELV*((AA-BB*CLiCl(2,i))
     *    *dexp(dd*Temper)-P(2,i)*P0).d0
  11      continue
 
c       
         CLiCl(3,1)=C0
 
c           
c          CLiCl(3,Nx+1)=(4.d0*CLiCl(3,Nx)-CLiCl(3,Nx-1))/3.d0
       CLiCl(3,Nx+1)=(18.d0*CLiCl(3,Nx)-9.d0*CLiCl(3,Nx-1)+2.d0*
     * CLiCl(3,Nx-2))/11.d0
                                ENDIF
 
 
c             
                     IF(NShema.EQ.2) then
 
 
 
c           
             do 24 i=2,Nx
 
         P(3,i)=P(2,i)-dTime/Dxx*EVL*(P(2,i)-P(2,i-1))
     *   -dTime*(P(2,i)-(AA-BB*CliCl(2,i))*dexp(DD*Temper)/P0)
  24       continue
 
c           
           P(3,1)=1.d0
 
c           
c            P(3,Nx+1)=(4.d0*P(3,Nx)-P(3,Nx-1))/3.d0
       P(3,Nx+1)=(18.d0*P(3,Nx)-9.d0*P(3,Nx-1)+2.d0*P(3,Nx-2))/11.d0
 
    
 
c           
             do 211 ii=2,Nx
             i=Nx-ii+2
         CLiCl(3,i)=CLiCl(2,i)-dTime/Dxx*VEL*(CLiCl(2,i)-CLiCl(2,i+1))
     *   +dTime*ELV*((AA-BB*CLiCl(2,i))
     *    *dexp(dd*Temper)-P(2,i)*P0).d0
  211      continue
 
c      
         CLiCl(3,Nx+1)=C0
 
c         
c          CLiCl(3,1)=(4.d0*CLiCl(3,2)-CLiCl(3,3))/3.d0
       CLiCl(3,1)=(18.d0*CLiCl(3,2)-9.d0*CLiCl(3,3)+2.d0*
     * CLiCl(3,4))/11.d0
                                ENDIF
 
 
 
 
 
 
 
 
 
c            
             do 5 i=1,Nx+1
             P(1,i)=P(2,i)
             P(2,i)=P(3,i)
 
             CLiCl(1,i)=CLiCl(2,i)
             CLiCl(2,i)=CLiCl(3,i)
 
  5          continue
 
c           
              IF(kk.EQ.Nprt) then
          kk=0
            write(3,*) 'T++++++++++++++++++++++'
           write(3,*) 'Time (sec)=',Time*Tau0
 
 
             IF(NShema.EQ.1) then
 
       write(3,*) '*****Time*******t,sec*****P/P0*****P(Ïà)******C,%**'
       write(3,3007)Time,Time*Tau0,P(3,Nx+1),P(3,Nx+1)*P0,CLiCl(3,Nx+1)
              ENDIF
 
             IF(NShema.EQ.2) then
 
       write(3,*) '*****Time*******t,sec*****P/P0*****P(Ïà)******C,%**'
       write(3,3007)Time,Time*Tau0,P(3,Nx+1),P(3,Nx+1)*P0,CLiCl(3,1)
              ENDIF
 
 
 
 
             ENDIF
 
c          
            IF(Time.LT.Tstop) goto 101
          
             do 6 i=1,Nx+1
c            write(3,3009) P(3,i)
             write(3,3009) CLiCl(3,i)
 
  6          continue   
             
 
                                             
        
 3009  format(5x(1x,d9.4))        
 
 
 
 
 
 3007  format(1x,5(1x,d9.3))
 
   
        DEALLOCATE (P,PPa,CLiCl,STAT=ierr)
 
         end
 
 
l(3,1)
              ENDIF
 
 
 
 
             ENDIF
 
c         
            IF(Time.LT.Tstop) goto 101
          
             do 6 i=1,Nx+1
c            write(3,3009) P(3,i)
             write(3,3009