!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998-2005 Guido Dhondt
!
!     This program is free software; you can redistribute it and/or
!     modify it under the terms of the GNU General Public License as
!     published by the Free Software Foundation(version 2);
!     
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of 
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine tempload(xforcold,xforc,xforcact,iamforc,nforc,
     &  xloadold,xload,xloadact,iamload,nload,ibody,xbody,nbody,
     &  xbodyold,xbodyact,t1old,t1,t1act,iamt1,nk,
     &  amta,namta,nam,ampli,time,reltime,ttime,dtime,ithermal,nmethod,
     &  xbounold,xboun,xbounact,iamboun,nboun,
     &  nodeboun,ndirboun,nodeforc,ndirforc,istep,iinc,
     &  co,vold)
!
!     calculates the loading at a given time
!
      implicit none
!
      integer iamforc(*),iamload(2,*),iamt1(*),
     &  nam,i,istart,iend,id,nforc,nload,nk,namta(3,*),ithermal,
     &  nmethod,iamt1i,iamboun(*),nboun,iamforci,iambouni,
     &  iamloadi1,iamloadi2,ibody(2,*),
     &  nbody,iambodyi,nodeboun(*),ndirboun(*),nodeforc(2,*),
     &  ndirforc(*),istep,iinc,msecpt,node,j
!
      real*8 xforc(*),xforcact(*),xload(2,*),xloadact(2,*),
     &  t1(*),t1act(*),amta(2,*),ampli(*),time,
     &  xforcold(*),xloadold(2,*),t1old(*),reltime,
     &  xbounold(*),xboun(*),xbounact(*),ttime,dtime,reftime,
     &  xbody(7,*),xbodyold(7,*),
     &  xbodyact(7,*),co(3,*),vold(0:3,*),abqtime(2),coords(3)
!
      data msecpt /1/
!
!     if an amplitude is active, the loading is scaled according to
!     the actual time. If no amplitude is active, then the load is
!     - scaled according to the relative time for a static step
!     - applied as a step loading for a dynamic step
!
!     calculating all amplitude values for the current time
!
      do i=1,nam
         if(namta(3,i).lt.0) then
            reftime=ttime+dtime
         else
            reftime=time
         endif
         if(abs(namta(3,i)).ne.i) then
            reftime=reftime-amta(1,namta(1,i))
            istart=namta(1,abs(namta(3,i)))
            iend=namta(2,abs(namta(3,i)))
         else
            istart=namta(1,i)
            iend=namta(2,i)
         endif
         call identamta(amta,reftime,istart,iend,id)
         if(id.lt.istart) then
            ampli(i)=amta(2,istart)
         elseif(id.eq.iend) then
            ampli(i)=amta(2,iend)
         else
            ampli(i)=amta(2,id)+(amta(2,id+1)-amta(2,id))
     &           *(reftime-amta(1,id))/(amta(1,id+1)-amta(1,id))
         endif
      enddo
!
!     scaling the loading
!
      do i=1,nforc
         if(ndirforc(i).eq.0) then
            if((xforc(i).lt.1.2357111318d0).and.
     &         (xforc(i).gt.1.2357111316d0)) then
!
!              user subroutine for the concentrated heat flux
!
               node=nodeforc(1,i)
               abqtime(1)=time
               abqtime(2)=ttime
               do j=1,3
                  coords(j)=co(j,node)+vold(j,node)
               enddo
               call cflux(xforcact(i),msecpt,istep,iinc,abqtime,node,
     &              coords,vold)
               cycle
            endif
         endif
         if(nam.gt.0) then
            iamforci=iamforc(i)
         else
            iamforci=0
         endif
         if(iamforci.gt.0) then
            xforcact(i)=xforc(i)*ampli(iamforci)
         elseif(nmethod.eq.1) then
            xforcact(i)=xforcold(i)+
     &         (xforc(i)-xforcold(i))*reltime
         else
            xforcact(i)=xforc(i)
         endif
      enddo
!
      do i=1,nload
         if(nam.gt.0) then
            iamloadi1=iamload(1,i)
            iamloadi2=iamload(2,i)
         else
            iamloadi1=0
            iamloadi2=0
         endif
         if(iamloadi1.gt.0) then
            xloadact(1,i)=xload(1,i)*ampli(iamloadi1)
         elseif(nmethod.eq.1) then
            xloadact(1,i)=xloadold(1,i)+
     &         (xload(1,i)-xloadold(1,i))*reltime
         else
            xloadact(1,i)=xload(1,i)
         endif
         if(iamloadi2.gt.0) then
            xloadact(2,i)=xload(2,i)*ampli(iamloadi2)
         elseif(nmethod.eq.1) then
            xloadact(2,i)=xload(2,i)
         else
            xloadact(2,i)=xload(2,i)
         endif
      enddo
!
c      if(ithermal.ge.2) then
c         do i=1,nflow
c            if((xflow(i).lt.1.2357111318d0).and.
c     &         (xflow(i).gt.1.2357111316d0)) then
c!
c!              user subroutine for the concentrated heat flux
c!
c               nodeup=nodeflow(1,i)
c               nodedo=nodeflow(2,i)
c               abqtime(1)=time
c               abqtime(2)=ttime
c               do j=1,3
c                  coordsup(j)=co(j,nodeup)+vold(j,nodeup)
c                  coordsdo(j)=co(j,nodedo)+vold(j,nodedo)
c               enddo
c               call massflowrate(xflowact(i),istep,iinc,abqtime,
c     &              nodeup,nodedo,coordsup,coordsdo,vold)
c               cycle
c            endif
c            if(nam.gt.0) then
c               iamflowi=iamflow(i)
c            else
c               iamflowi=0
c            endif
c            if(iamflowi.gt.0) then
c               xflowact(i)=xflow(i)*ampli(iamflowi)
c            elseif(nmethod.eq.1) then
c               xflowact(i)=xflowold(i)+
c     &              (xflow(i)-xflowold(i))*reltime
c            else
c               xflowact(i)=xflow(i)
c            endif
c         enddo
c      endif
!
      do i=1,nbody
         if(nam.gt.0) then
            iambodyi=ibody(2,i)
         else
            iambodyi=0
         endif
         if(iambodyi.gt.0) then
            xbodyact(1,i)=xbody(1,i)*ampli(iambodyi)
         elseif(nmethod.eq.1) then
            xbodyact(1,i)=xbodyold(1,i)+
     &           (xbody(1,i)-xbodyold(1,i))*reltime
         else
            xbodyact(1,i)=xbody(1,i)
         endif
      enddo
!
!     scaling the boundary conditions
!
      do i=1,nboun
         if((xboun(i).lt.1.2357111318d0).and.
     &        (xboun(i).gt.1.2357111316d0)) then
!     
!           user subroutine for boundary conditions
!     
            node=nodeboun(i)
            abqtime(1)=time
            abqtime(2)=ttime
            do j=1,3
               coords(j)=co(j,node)+vold(j,node)
            enddo
            if(ndirboun(i).eq.0) then
               call utemp(xbounact(i),msecpt,istep,iinc,abqtime,node,
     &              coords,vold)
            else
               call uboun(xbounact(i),istep,iinc,abqtime,node,
     &              ndirboun(i),coords,vold)
            endif
            cycle
         endif
!
         if(nam.gt.0) then
            iambouni=iamboun(i)
         else
            iambouni=0
         endif
         if(iambouni.gt.0) then
            xbounact(i)=xboun(i)*ampli(iambouni)
         elseif(nmethod.eq.1) then
            xbounact(i)=xbounold(i)+
     &         (xboun(i)-xbounold(i))*reltime
         else
            xbounact(i)=xboun(i)
         endif
      enddo
!
!     scaling the temperatures
!
      if(ithermal.eq.1) then
         do i=1,nk
            if(nam.gt.0) then
               iamt1i=iamt1(i)
            else
               iamt1i=0
            endif
            if(iamt1i.gt.0) then
               t1act(i)=t1(i)*ampli(iamt1i)
            elseif(nmethod.eq.1) then
               t1act(i)=t1old(i)+(t1(i)-t1old(i))*reltime
            else
               t1act(i)=t1(i)
            endif
         enddo
      endif
!
c      write(*,*) 'nboun'
c      do i=1,nboun
c         write(*,'(i7,1x,e11.4,1x,e11.4)') i,xbounact(i),xboun(i)
c      enddo
c      write(*,*) 'nforc'
c      do i=1,nforc
c         write(*,'(i7,1x,e11.4,1x,e11.4)') i,xforcact(i),xforc(i)
c      enddo
c      write(*,*) 'nload'
c      do i=1,nload
c         write(*,'(i7,1x,e11.4,1x,e11.4)') i,xloadact(1,i),xload(1,i)
c      enddo
!
      return
      end
