anchor.diff:        end
   c
   c version
  -c $Id: viscos.f,v 1.1 2004/04/14 21:18:30 willic3 Exp $
  +c $Id: viscos.f,v 1.2 2004/07/13 17:39:36 willic3 Exp $
   c
   c Generated automatically by Fortran77Mill on Wed May 21 14:15:03 2003
   c
  
positive.code:         end do
        end do
        write(kto,800) ntimdat(7),ntimdat(8),ntimdat(9)
        if(idout.gt.1) write(kw,800) ntimdat(7),ntimdat(8),ntimdat(9)
        if(idout.gt.1) close(kw)
        close(kp)
  c
   700  format('STEP ',i7)
  
negative.code: cdebug      write(6,*) "From viscos_f, ngauss,nsd,gauss:",ngauss,nsd,
  cdebug     & (gauss(idb),idb=1,(nsd+1)*ngauss)
  c
        if(idout.gt.ione) open(kw,file=ofile,status="old",access="append")
        if(idsk.eq.izero) open(kp,file=pfile,status="old",access="append")
        if(idsk.eq.ione) open(kp,file=pfile,status="old",
       & form="unformatted",access="append")
  c
  c...  signal user that viscous computation is begun
  c
        write(kto,2000)
  c
  c...  loop over complete cycles
  c
        reform=.false.
        if(ireform.eq.ione) reform=.true.
        indexx=1
        ntot=0
        do jcyc=1,ncycle
          if(ncycle.gt.ione) write(kto,2001) jcyc
          nfirst=izero
          naxstp=izero
          nstep=izero
          time=zero
  c
  c...  loop over time step groups
  c
          do i=2,nintg
  c
  c...  define constants to control stepping in current group
  c
            call const(maxstp,delt,alfa,maxit,ntdinit,lgdef,ibbar,utol,
       &     ftol,etol,itmax,nintg,i,naxstp,nfirst,rtimdat,deltp,alfap,
       &     ntimdat,nstep,maxitp,ntdinitp,lgdefp,ibbarp,itmaxp,gtol)
  cdebug          write(6,*) nintg,i,naxstp,nfirst,deltp,alfap,maxitp,maxitcp,
  cdebug     &     lgdefp,ibbarp,itmaxp,(gtol(idb),idb=1,3)
            ltim=.true.
  c
  c...  loop over time steps in current group
  c
            do j=nfirst,naxstp
              ntot=ntot+ione
              nstep=nstep+ione
              ntimdat(1)=nstep
              time=time+deltp
              skc=(numslp.ne.0.and.(iskopt.eq.2.or.(iskopt.le.0.and.
       &       abs(iskopt).eq.nstep)))
  c
  c...  clear arrays at beginning of time step
  c
              call fill(deld,zero,ndof*numnp)
              call fill(deldx,zero,ndof*numnp)
              if(skc) then
                call skclear(idslp,skew,numsn,numnp)
                call skcomp(x,d,skew,idslp,ipslp,ipstrs,numsn,numnp,nstep,
       &         lgdefp,ierr,errstrng)
                if(ierr.ne.izero) return
              end if
  c
  c...  see whether winkler forces are locked or unlocked in this step.
  c
              if(nwink.ne.izero) call cklock(iwink,histry,ltim,nwink,
       &       nstep,nhist,lastep,unlck)
              if(nwinkx.ne.izero) call cklock(iwinkx,histry,ltim,nwinkx,
       &       nstep,nhist,lastep,unlckf)
  c
  c...  test for reform and refactor interval, whether full output
  c     occurs in this step
  c
              ireform=izero
              if(ntdinitp.eq.izero) then
                reform=.false.
              else
                reform=(mod(j,ntdinitp).eq.izero)
              end if
              reform=reform.or.ltim
              if(reform) ireform=ione
              ntimdat(10)=ireform
              fulout=.false.
              if(ntot.eq.iprint(indexx)) fulout=.true.
  c
              if(idout.gt.ione) write(kw,1000) time,ntot,jcyc
  C***********************************
              if(fulout.and.idsk.eq.izero) write(kp,700) ntot
  C***********************************
              if(fulout.and.idsk.eq.izero) write(kp,4000) time
              if(fulout.and.idsk.eq.ione) write(kp) ntot
              if(fulout.and.idsk.eq.ione) write(kp) time
              write(kto,5000) time,ntot,lastep*ncycle
  c*            call flush(kto)
  c*            call flush(kw)
  c*            call flush(kp)
  c
  c...  apply boundary conditions
  c
              call load(id,ibond,bond,d,deld,btot,histry,deltp,numnp,neq,
       &       nhist,nstep,lastep,ierr,errstrng)
              if(ierr.ne.izero) return
  c
  c...  compute current split node displacements
  c
              if(numfn.ne.izero) then
                call loadf(fault,dfault,histry,deltp,nfault,nstep,numfn,
       &         nhist,lastep,ierr,errstrng)
                if(ierr.ne.izero) return
              end if
  c
  c...  add loads from changes in differential forces across internal
  c        interfaces
  c
              if(numdif.ne.izero) then
                call loadx(btot,diforc,histry,idx,idhist,neq,numnp,nhist,
       &         nstep,lastep,ierr,errstrng)
                if(ierr.ne.izero) return
              end if
  c
  c...  compute change in load vector if winkler forces are removed
  c
              call fill(zcg,zero,neq)
              if(nwink.ne.izero.and.unlck) call unlock(zcg,btot,id,iwink,
       &       idhist,ibond,bond,histry,nstep,numnp,nwink,nhist,neq,
       &       numdif,lastep,ione)
              if(nwinkx.ne.izero.and.unlckf) call unlock(zcg,btot,idx,
       &       iwinkx,idhist,ibond,diforc,histry,nstep,numnp,nwinkx,nhist,
       &       neq,numdif,lastep,itwo)
  	    call daxpy(neq,one,zcg,ione,btot,ione)
  c
  c...  reform time-dependent material and stiffness matrices if
  c     requested, compute forces due to applied displacements and split
  c     nodes, and perform iterative solution.
  c
              if(lgdefp.eq.izero.and.ibbarp.eq.izero) then
                if(reform) call matinit_drv(
       &         alnz,ja,nnz,neq,                                         ! sparse
       &         x,d,iwink,wink,numnp,nwink,                              ! global
       &         dx,iwinkx,winkx,numslp,numsn,nwinkx,                     ! slip
       &         tfault,numfn,                                            ! fault
       &         s,stemp,                                                 ! stiff
       &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,nstatesz, ! elemnt
       &         ndmatsz,numelt,nconsz,                                   ! elemnt
       &         prop,mhist,infmat,infmatmod,numat,npropsz,tminmax,       ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         histry,rtimdat,ntimdat,nhist,lastep,td_matinit_cmp_ss,   ! timdat
       &         skew,numrot,                                             ! skew
       &         getshapn,bmatrixn,                                       ! bbar
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
                call formdf_ss(
       &         b,neq,                                                   ! force
       &         x,d,dcur,numnp,                                          ! global
       &         s,stemp,                                                 ! stiff
       &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
       &         infmat,infmatmod,numat,                                  ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         skew,numrot,                                             ! skew
       &         getshapn,bmatrixn,                                       ! bbar
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
                if(numfn.ne.izero) call formf_ss(
       &         b,neq,                                                   ! force
       &         x,numnp,                                                 ! global
       &         s,stemp,                                                 ! stiff
       &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
       &         infmat,infmatmod,numat,                                  ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         skew,numrot,                                             ! skew
       &         nfault,dfault,tfault,numfn,                              ! split
       &         getshapn,bmatrixn,                                       ! bbar
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
                call iterate(
       &         alnz,pcg,zcg,ja,                                         ! sparse
       &         b,btot,bres,pvec,gvec1,gvec2,grav,                       ! force
       &         x,d,deld,dprev,dcur,id,iwink,wink,nsysdat,               ! global
       &         dx,deldx,dxcur,idx,iwinkx,winkx,idslp,ipslp,             ! slip
       &         nfault,dfault,tfault,                                    ! fault
       &         s,stemp,                                                 ! stiff
       &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,npar,     ! elemnt
       &         ielno,iside,ihistry,pres,pdir,                           ! tractn
       &         prop,mhist,infmat,infmatmod,                             ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         histry,rtimdat,ntimdat,nvisdat,                          ! timdat
       &         rgiter,gcurr,gi,gprev,gtol,rmin,rmult,nsiter,            ! iterate
       &         skew,                                                    ! skew
       &         ncodat,nunits,nprint,                                    ! ioinfo
       &         getshapn,bmatrixn,gload_cmp_ss,td_strs_cmp_ss,           ! external
       &         td_strs_mat_cmp_ss,                                      ! external
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
              else if(lgdefp.eq.izero.and.ibbarp.eq.ione) then
                if(reform) call matinit_drv(
       &         alnz,ja,nnz,neq,                                         ! sparse
       &         x,d,iwink,wink,numnp,nwink,                              ! global
       &         dx,iwinkx,winkx,numslp,numsn,nwinkx,                     ! slip
       &         tfault,numfn,                                            ! fault
       &         s,stemp,                                                 ! stiff
       &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,nstatesz, ! elemnt
       &         ndmatsz,numelt,nconsz,                                   ! elemnt
       &         prop,mhist,infmat,infmatmod,numat,npropsz,tminmax,       ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         histry,rtimdat,ntimdat,nhist,lastep,td_matinit_cmp_ss,   ! timdat
       &         skew,numrot,                                             ! skew
       &         getshapb,bmatrixb,                                       ! bbar
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
                call formdf_ss(
       &         b,neq,                                                   ! force
       &         x,d,dcur,numnp,                                          ! global
       &         s,stemp,                                                 ! stiff
       &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
       &         infmat,infmatmod,numat,                                  ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         skew,numrot,                                             ! skew
       &         getshapb,bmatrixb,                                       ! bbar
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
                if(numfn.ne.izero) call formf_ss(
       &         b,neq,                                                   ! force
       &         x,numnp,                                                 ! global
       &         s,stemp,                                                 ! stiff
       &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
       &         infmat,infmatmod,numat,                                  ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         skew,numrot,                                             ! skew
       &         nfault,dfault,tfault,numfn,                              ! split
       &         getshapb,bmatrixb,                                       ! bbar
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
                call iterate(
       &         alnz,pcg,zcg,ja,                                         ! sparse
       &         b,btot,bres,pvec,gvec1,gvec2,grav,                       ! force
       &         x,d,deld,dprev,dcur,id,iwink,wink,nsysdat,               ! global
       &         dx,deldx,dxcur,idx,iwinkx,winkx,idslp,ipslp,             ! slip
       &         nfault,dfault,tfault,                                    ! fault
       &         s,stemp,                                                 ! stiff
       &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,npar,     ! elemnt
       &         ielno,iside,ihistry,pres,pdir,                           ! tractn
       &         prop,mhist,infmat,infmatmod,                             ! materl
       &         gauss,sh,shj,infetype,                                   ! eltype
       &         histry,rtimdat,ntimdat,nvisdat,                          ! timdat
       &         rgiter,gcurr,gi,gprev,gtol,rmin,rmult,nsiter,            ! iterate
       &         skew,                                                    ! skew
       &         ncodat,nunits,nprint,                                    ! ioinfo
       &         getshapb,bmatrixb,gload_cmp_ss,td_strs_cmp_ss,           ! external
       &         td_strs_mat_cmp_ss,                                      ! external
       &         ierr,errstrng)                                           ! errcode
  c
                if(ierr.ne.izero) return
  c
  clater            else if(lgdefp.eq.ione.and.ibbarp.eq.izero) then
  clater              if(reform) call matinit_drv(
  clater     &         alnz,ja,nnz,neq,                                         ! sparse
  clater     &         x,d,iwink,wink,numnp,nwink,                              ! global
  clater     &         dx,iwinkx,winkx,numslp,numsn,nwinkx,                     ! slip
  clater     &         tfault,numfn,                                            ! fault
  clater     &         s,stemp,                                                 ! stiff
  clater     &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,nstatesz, ! elemnt
  clater     &         ndmatsz,numelt,nconsz,                                   ! elemnt
  clater     &         prop,mhist,infmat,infmatmod,numat,npropsz,tminmax,       ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         histry,rtimdat,ntimdat,nhist,lastep,td_matinit_cmp_ld,   ! timdat
  clater     &         skew,numrot,                                             ! skew
  clater     &         getshapn,bmatrixn,                                       ! bbar
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
  clater              call formdf_ld(
  clater     &         b,neq,                                                   ! force
  clater     &         x,d,dcur,numnp,                                          ! global
  clater     &         s,stemp,                                                 ! stiff
  clater     &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
  clater     &         infmat,infmatmod,numat,                                  ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         skew,numrot,                                             ! skew
  clater     &         getshapn,bmatrixn,                                       ! bbar
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
  clater              if(numfn.ne.izero) call formf_ld(
  clater     &         b,neq,                                                   ! force
  clater     &         x,numnp,                                                 ! global
  clater     &         s,stemp,                                                 ! stiff
  clater     &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
  clater     &         infmat,infmatmod,numat,                                  ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         skew,numrot,                                             ! skew
  clater     &         nfault,dfault,tfault,numfn,                              ! split
  clater     &         getshapn,bmatrixn,                                       ! bbar
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
  clater              call iterate(
  clater     &         alnz,pcg,zcg,ja,                                         ! sparse
  clater     &         b,btot,bres,pvec,gvec1,gvec2,grav,                       ! force
  clater     &         x,d,deld,dprev,dcur,id,iwink,wink,nsysdat,               ! global
  clater     &         dx,deldx,dxcur,idx,iwinkx,winkx,idslp,ipslp,             ! slip
  clater     &         nfault,dfault,tfault,                                    ! fault
  clater     &         s,stemp,                                                 ! stiff
  clater     &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,npar,     ! elemnt
  clater     &         ielno,iside,ihistry,pres,pdir,                           ! tractn
  clater     &         prop,mhist,infmat,infmatmod,                             ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         histry,rtimdat,ntimdat,nvisdat,                          ! timdat
  clater     &         rgiter,gcurr,gi,gprev,gtol,rmin,rmult,nsiter,            ! iterate
  clater     &         skew,                                                    ! skew
  clater     &         ncodat,nunits,nprint,                                    ! ioinfo
  clater     &         getshapn,bmatrixn,gload_cmp_ld,td_strs_cmp_ld,           ! external
  clater     &         td_strs_mat_cmp_ld,                                      ! external
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
  clater            else if(lgdefp.eq.ione.and.ibbarp.eq.ione) then
  clater              if(reform) call matinit_drv(
  clater     &         alnz,ja,nnz,neq,                                         ! sparse
  clater     &         x,d,iwink,wink,numnp,nwink,                              ! global
  clater     &         dx,iwinkx,winkx,numslp,numsn,nwinkx,                     ! slip
  clater     &         tfault,numfn,                                            ! fault
  clater     &         s,stemp,                                                 ! stiff
  clater     &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,nstatesz, ! elemnt
  clater     &         ndmatsz,numelt,nconsz,                                   ! elemnt
  clater     &         prop,mhist,infmat,infmatmod,numat,npropsz,tminmax,       ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         histry,rtimdat,ntimdat,nhist,lastep,td_matinit_cmp_ld,   ! timdat
  clater     &         skew,numrot,                                             ! skew
  clater     &         getshapb,bmatrixb,                                       ! bbar
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
  clater              call formdf_ld(
  clater     &         b,neq,                                                   ! force
  clater     &         x,d,dcur,numnp,                                          ! global
  clater     &         s,stemp,                                                 ! stiff
  clater     &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
  clater     &         infmat,infmatmod,numat,                                  ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         skew,numrot,                                             ! skew
  clater     &         getshapb,bmatrixb,                                       ! bbar
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
  clater              if(numfn.ne.izero) call formf_ld(
  clater     &         b,neq,                                                   ! force
  clater     &         x,numnp,                                                 ! global
  clater     &         s,stemp,                                                 ! stiff
  clater     &         dmat,ien,lm,lmx,infiel,iddmat,ndmatsz,numelt,nconsz,     ! elemnt
  clater     &         infmat,infmatmod,numat,                                  ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         skew,numrot,                                             ! skew
  clater     &         nfault,dfault,tfault,numfn,                              ! split
  clater     &         getshapb,bmatrixb,                                       ! bbar
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
  clater              call iterate(
  clater     &         alnz,pcg,zcg,ja,                                         ! sparse
  clater     &         b,btot,bres,pvec,gvec1,gvec2,grav,                       ! force
  clater     &         x,d,deld,dprev,dcur,id,iwink,wink,nsysdat,               ! global
  clater     &         dx,deldx,dxcur,idx,iwinkx,winkx,idslp,ipslp,             ! slip
  clater     &         nfault,dfault,tfault,                                    ! fault
  clater     &         s,stemp,                                                 ! stiff
  clater     &         state,dstate,dmat,ien,lm,lmx,lmf,infiel,iddmat,npar,     ! elemnt
  clater     &         ielno,iside,ihistry,pres,pdir,                           ! tractn
  clater     &         prop,mhist,infmat,infmatmod,                             ! materl
  clater     &         gauss,sh,shj,infetype,                                   ! eltype
  clater     &         histry,rtimdat,ntimdat,nvisdat,                          ! timdat
  clater     &         rgiter,gcurr,gi,gprev,gtol,rmin,rmult,nsiter,            ! iterate
  clater     &         skew,                                                    ! skew
  clater     &         ncodat,nunits,nprint,                                    ! ioinfo
  clater     &         getshapb,bmatrixb,gload_cmp_ld,td_strs_cmp_ld,           ! external
  clater     &         td_strs_mat_cmp_ld,                                      ! external
  clater     &         ierr,errstrng)                                           ! errcode
  c
  clater              if(ierr.ne.izero) return
  c
              end if
  c
  c...  print displacements at all nodes when requested.
  c
              if(fulout) then
                call printd(d,deld,deltp,idslp,numnp,numnp,ione,
       &         idout,idsk,kto,kw,kp)
                call printf(tfault,dfault,deltp,nfault,numfn,idout,
       &         idsk,kw,kp)
                call printd(dx,deldx,deltp,idslp,numnp,numsn,itwo,
       &         idout,idsk,kto,kw,kp)
                call printl(idx,iwinkx,idslp,histry,numsn,numnp,
       &         nstep,nhist,nwinkx,lastep,idsk,kp)
              end if
  c
  c...  print stresses and strains in all elements when requested
  c
              if(fulout) call write_state(
       &       state,dstate,infiel,nstatesz,numelt,                       ! elemnt
       &       infmat,infmatmod,ismatmod,numat,                           ! materl
       &       infetype,                                                  ! eltype
       &       delt,nstep,                                                ! timdat
       &       istatout,                                                  ! ioopts
       &       idout,idsk,kw,kp)                                          ! ioinfo
              ltim=.false.
              if(fulout) indexx=indexx+1
              if(indexx.gt.icontr) indexx=icontr
  