User-written subroutine example

      subroutine user1(gg,t,c,q,qd,r,time,dt,it,
     + kode,nocon,maxno,iconv,dum1,dum2,dtp,tf)
      
      implicit none
C======================================================================
C   USER1: Applies heat load varying linearly with Z and proportional
C   to element area for elements in group 'MID SECTION ELEMENTS'
C======================================================================
C     Arguments
C
      double precision t(*), time, dt
      real gg(*), c(*), q(*), qd(*), r(*)
      real dum1, dum2, dtp, tf
      integer it, kode, nocon, maxno, iconv(*)
      character*7 name
C
C     Common block variables
C
      real tdmax, prtflg, params(8000), grav, gv(3), tabs, rgas
      real pstd, tstd, sigma
      integer irun, ir(1), maxn1, maxn2
C
C     Common block definitions
C
      common/tdmax/tdmax
      common/prtflg/prtflg
      common/irun/irun,ir
      common/maxnoq/maxn1,maxn2
      common/params/params
      common/grav/grav,gv,tabs,rgas,pstd,tstd,sigma
C
      save
C     Parameters
C     maxlistlen=maximum number of elements in group
C     maxelem=maximum number of elements in model
C
      integer maxlistlen
      parameter (maxlistlen=2000)
      integer maxelem
      parameter (maxelem=10000)
C
      logical firsttime, active
      data firsttime/.true./
      integer errcount, i, j, n
C
C     Variables for element properties. We must declare
C     all array argument but only need dimension the ones we use.
C
      real geom(3,4,maxelem), prop(10,maxelem), gridloc
      integer gridlist
      real flux
C
C     Variables required for group
C
      integer gid, glength, gnumelem
      character*7 sname
      integer glist(maxlistlen)
C
      logical checkunits
C
CC======================================================================
C   INITIALIZATION 
C======================================================================
      if ( firsttime ) then
CC
C     Check units
C
         errcount=0
         if (checkunits()) then
            errcount=errcount+1
         endif
C
         call longname(sname,'MID SECTION ELEMENTS',gid,glength,2)
         call namar(sname,glist,gnumelem)
         call userarraycheck(maxlistlen,gnumelem,'glist',errcount)
C
C     Get element CG data. Check that array is big enough first.
C
         call userarraycheck(maxelem,maxno,'geom',errcount)
         call readprop2(prop,geom,gridlist,gridloc,'Y','Y','N','N')
C
C     Get flux value
C
         call varval('%TMGVAR0',flux)
         print *,'Applied flux will be ',flux,' times'
         print *,'element Z coordinate'
         print *,' '
C
C     Housing keeping and error checking
C
         firsttime = .false.
         if (errcount .gt. 0) then
            stop
         endif
      end if
C======================================================================
C   MAIN EXECUTION
C======================================================================
      if (kode .eq. 1) then
C
C     Apply heat load to all elements in group that
C     is proportional to Z coordinate
C
         do i=1,gnumelem
            n=glist(i)
            q(n)=flux*prop(1,n)*geom(3,1,n)
         end do
      endif
      return
      end subroutine user1
C
C
      subroutine userarraycheck(arrsize, needsize,arrname, err)
C
C     Checks array size (arrsize) against needed size (needsize) 
C     and increment error counter if array is not large enough. 
C     The arrayname
C     (arrname) is only used for printing diagnostics.
C     Using an error counter means that all arrays can be checked 
C     in a run even if one fails.
C
      integer arrsize, needsize,err
      character*40 arrname
         if (needsize .gt. arrsize) then
            err=err+1
            print *,'*** Fatal error ***'
            print *,'Array : ',arrname
            print *,'Required size is ',needsize
            print *,'Actual size is ',arrsize
         endif
      return
      end subroutine userarraycheck
C
C
      logical function checkunits
C
C     This routine checks model units against an internal set
C     of values. The tolerance for units checking is defined
C     by parameter unitstol. It returns false if there are no
C     problems
C
      implicit none
      real unitscheck(5), unitstol
      parameter (unitstol=0.01)
C     Define SI units
      data unitscheck/1.0,1.0,1.0,-273.15,1.0/
C
      real uvals(5), xunits
      integer idum
      logical unitserror
      integer i
C
C
      call tunits(idum,uvals(1), uvals(2), uvals(3), uvals(4),
     + uvals(5))
C
C     Check each unit for error, allow a tolerance of 1%
C
      unitserror=.false.
      do i=1,5
         xunits=abs((uvals(i)/unitscheck(i))-1)
         if(xunits .gt. unitstol) then
            unitserror=.true.
            print *,' '
            print *,'*** Fatal error ***'
            print *,'Wrong runtime units selected'
            print *,' '
            exit
         end if
      enddo
      checkunits=unitserror
      return
      end function checkunits

Here F=10⁹ W. This value is set inside the %TMGVAR0 TMG variable, which will be read by the provided USER1 subroutine when the solution will run.