c
c User subroutine VDISP to prescribe boundary conditions
c     
      subroutine vdisp(
c Read only -
     *   nblock, nDof, nCoord, kstep, kinc, 
     *   stepTime, totalTime, dtNext, dt, 
     *   cbname, jBCType, jDof, jNodeUid, amp,
     *   coordNp, u, v, a, rf, rmass, rotaryI, 
c Write only -
     *   rval )
c
      include 'vaba_param.inc'
      parameter( zero = 0.d0, half = 0.5d0 )
      dimension jDof(nDof), jNodeUid(nblock), 
     *   amp(nblock), coordNp(nCoord, nblock), 
     *   u(nDof,nblock), v(nDof,nblock), a(nDof,nblock), 
     *   rf(nDof,nblock), rmass(nblock), rotaryI(3,3,nblock), 
     *   rval(nDof,nblock)
c      
      character*80 cbname
c
      A1 = 0.5
      B1 = 1.5
      omega = .3141593
*
*     INITIAL VELOCITY CONDITION AT THE START OF ANALYSIS.
*     At step boundaries, the velocity at the end of the 
*     previous step is continued as the initial velocity
*     for the current step.  To do so, simply skip defining
*     the rVal when stepTime .lt. zero .and. kStep .gt. 1.
      if( stepTime .lt. zero .and. kStep .eq. 1) then
*
         if( jBCType .eq. 0 ) then
c     
c        Impose displacement
c     
            v0 = B1*omega
            do  k=1, nblock
                do  j=1, nDof
                   if ( jDof(j) .gt. 0 ) then
                     rval(j,k) = u(j,k) - v0*dt
                   end if
                end do 
            end do 
c     
c         
         else if( jBCType .eq. 1 ) then
c     
c        Impose velocity
c     
            time = zero
c     
            do k=1, nblock
               do j=1, nDof
                  if ( jDof(j) .gt. 0 ) then
                     rval(j,k) = A1*cos(omega*time) + B1*sin(omega*time)
                  end if
               end do     
            end do     
c     
         else if( jBCType .eq. 2 ) then
c     
c        Impose acceleration
c     
            vInit = 0.7
            do  k=1, nblock
               do  j=1, nDof
                  if ( jDof(j) .gt. 0 ) then
                     rval(j,k) = vInit/dt
                  end if
               end do
            end do
c     
         end if
        
      end if
*
*     BOUNDARY CONDITION STARTING WITH THE INITIAL CONFIGURATION.
      if( stepTime .ge. zero ) then
*      
         if( jBCType .eq. 0 ) then
c  
c        Impose displacement
c  
            time = totalTime + dtNext
            do  k=1, nblock
               do j=1, nDof
                  if ( jDof(j) .gt. 0 ) then
                    rval(j,k) = B1*sin( omega*time )
                  end if
               end do
            end do
c  
         else if( jBCType .eq. 1 ) then
c  
c        Impose velocity
c  
            time = totalTime + dtNext*half
c  
            do k=1, nblock
               do j=1, nDof
                  if ( jDof(j) .gt. 0 ) then
                     rval(j,k) = A1*cos(omega*time) + B1*sin(omega*time)
                  end if
               end do     
            end do     
c  
         else if( jBCType .eq. 2 ) then
c  
c        Impose acceleration
c  
            time = totalTime
c  
            do  k=1, nblock
               do  j=1, nDof
                  if ( jDof(j) .gt. 0 ) then
                     rval(j,k) = A1*cos(omega*time) + B1*sin(omega*time)
                  end if
               end do
            end do
c  
         end if
         
      end if
c
      return
      end
c      
C
C   A SIMPLE VERSION of VEXTERNALDB is used below to 
C   control time incrementation directly.
C
c     user routine to dynamically exchange data
      Subroutine vexternaldb(lOp, i_Array, niArray, r_Array, nrArray)
*
      include 'vaba_param.inc'
#include <SMAAspUserSubroutines.hdr>

      dimension i_Array(niArray), 
     *   r_Array(nrArray)

C     possible values for argument lOp
      parameter (j_int_startAnalysis   = 0,
     *           j_int_startStep       = 1,
     *           j_int_setupIncrement  = 2,
     *           j_int_startIncrement  = 3,
     *           j_int_endIncrement    = 4,
     *           j_int_endStep         = 5,
     *           j_int_endAnalysis     = 6)
     
C     contents of i_Array
      parameter (
     *           i_int_nTotalNodes        = 1,
     *           i_int_nTotalElements     = 2,
     *           i_int_kStep              = 3,
     *           i_int_kInc               = 4,
     *           i_int_iStatus            = 5,
     *           i_int_lWriteRestart      = 6)
     
C     possible values for i_Array(i_int_iStatus) 
      parameter (j_int_continue          = 0,
     *           j_int_terminateStep     = 1,
     *           j_int_terminateAnalysis = 2)
     
C     contents of r_Array
      parameter (
     *           i_flt_totalTime  = 1,
     *           i_flt_stepTime   = 2,
     *           i_flt_dTime      = 3 )
      
      parameter (direct = 0.1d0 )
      
      r_Array(i_flt_dTime) = direct
      
      return
      end