subroutine forcem(press,th1,th2,nn,n)
c
c CONTACT: ap@marc.de
c      
c
      implicit real*8 (a-h,o-z)                                               dp
c
      dimension n(7)
c
c* * * * * *
c
c PURPOSE
c   Apply a pressure to the element edge as long as it is not
c   in full contact with another body.
c
c NOTE
c   Always use the FOLLOW FOR parameter option. With this
c   parameter option, the total (not incremental) pressure
c   is defined in this subroutine.
c   This routine works only for 2D continuum elements (plane
c   stress, plane strain, axisymmetric).
c   This routine works only in MARC version k7 and higher.
c
c INPUT
c     th1          1st integration point coordinate
c     th2          2nd integration point coordinate
c     nn           integration point number
c     n            element number,etc
c
c OUTPUT
c     press        distributed load magnitude
c
c* * * * * *
c
      include '../common/form'
      include '../common/array4'
      include '../common/blnk'
      include '../common/space'
c
c... determine the element edge number: idf
      if (n(2).eq. 3) idf = 1
      if (n(2).eq. 7) idf = 2
      if (n(2).eq. 9) idf = 3
      if (n(2).eq.11) idf = 4
c
c... determine the nodes (internal number) of this edge
c... n1: internal node number of 1st node
c... n2: internal node number of 2nd node
      goto (10,20,30,40) idf
 10   continue
      n1 = lm(1)
      n2 = lm(2)
      goto 99
 20   continue
      n1 = lm(2)
      n2 = lm(3)
      goto 99
 30   continue
      n1 = lm(3)
      n2 = lm(4)
      goto 99
 40   continue
      n1 = lm(4)
      n2 = lm(1)
      goto 99
 99   continue
c
c... determine user node numbers from the internal ones
c... m1: user node number of 1st node
c... m2: user node number of 2nd node
      call nodnum(m1,idum,n1,3)
      call nodnum(m2,idum,n2,3)
c
c... the call to "coinfo" determines the contact status of a node
c
c... iflag1=0: node m1 (internal nr: n1) is not contacting another body
c... iflag1>0: node m1 (internal nr: n1) is     contacting another body
      ijk=0
      md =0
      call coinfo(ijk,n1,m1,md,idie,ints(inf),ints(itouch),
     $            nbcn,ints(inbct),ints(inseg),iflag1,
     $            idum1,idum2,idum3,irigid1,irigid2,irigid3)
c
c... iflag2=0: node m2 (internal nr: n2) is not contacting another body
c... iflag2>0: node m2 (internal nr: n2) is     contacting another body
      ijk=0
      md =0
      call coinfo(ijk,n2,m2,md,idie,ints(inf),ints(itouch),
     $            nbcn,ints(inbct),ints(inseg),iflag2,
     $            idum1,idum2,idum3,irigid1,irigid2,irigid3)
c
      if (iflag1.ne.0.and.iflag2.ne.0) then
c... if both edge nodes are contacting then don't apply a pressure
       press = 0d0
      else
c... apply a pressure if at least one edge node is not contacting
       press = 0.1d0
      endif
c
      return
      end