c     INCLUDE 'MarcTools.f'
c
      MODULE CommonData
      IMPLICIT NONE
      CHARACTER*32, PARAMETER : : SETNAME = 'ElementList'
      REAL*8, PARAMETER : : yStress = 210.D0
      INTEGER, ALLOCATABLE : : edgeList( : , : )
      INTEGER : : edgeCount
      REAL*8, ALLOCATABLE : : edgeStress( : )
      LOGICAL , ALLOCATABLE : : yMask( : )
      END MODULE CommonData
c      
      SUBROUTINE ubginc(ubInc,ubIncsub)
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
      USE CommonData
c      USE MarcTools
      IMPLICIT NONE
c     Start of generated type statements:
      INTEGER ubInc , ubIncsub
c     End of generated type statements.
      INTEGER , PARAMETER : : MAXEDGE = 8
      INTEGER , ALLOCATABLE , DIMENSION ( : ) : : elLst
      INTEGER : : elNum
      INTEGER , ALLOCATABLE , DIMENSION ( : , : ) : : curEdLst
      INTEGER : : curEl , curEdNum
      INTEGER , ALLOCATABLE , DIMENSION ( : , : ) : : orgEdLst
      INTEGER : : orgEdNum
      INTEGER , ALLOCATABLE , DIMENSION ( : , : ) : : refEdLst
      INTEGER : : nRefEdLst
      INTEGER : : i , j , k
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='ubInc.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'ubInc = ',ubInc
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=ubInc.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      IF ( ubInc .EQ. 0) THEN
      CALL ExtractSetItemLst(SETNAME, elLst , elNum)
      IF ( elNum .GT . 0) THEN
      ALLOCATE (orgEdlst(2 , elNum*MAXEDGE) )
      orgEdNum = 0
      DO i = 1 , elNum
      curEl = elLst ( i )
      CALL ExtractElmEdgeLst ( curEl , curEdLst , curEdNum)
      DO j = 1 , curEdNum
      DO k = 1 , 2
      orgEdLst ( k , orgEdNum + j ) = curEdLst ( k , j )
      END DO
      END DO
      orgEdNum = orgEdNum + curEdNum
      END DO
      CALL PutSmallFirst(orgEdLst,orgEdNum)
      CALL DelRepeated2D(orgEdlst, orgEdNum, refEdlst, nRefEdLst)
      CALL DelElmFreeEdge(refEdlst, nRefEdLst, edgeList)
      edgeCount = size(edgeList,2)
      Allocate( edgeStress ( edgeCount ) )
      Allocate( yMask ( edgeCount ) )
      yMask = . FALSE .
      edgeStress = 0.D0
      ELSE
      CALL QUIT(1234)
      END IF
      END IF
      RETURN
      END      
c
      SUBROUTINE usplit_mesh(icall,nodelist,nlist,iedgelist,nedgelist,
     $ ifacelist,nfacelist,inc,time,timeinc)
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
      USE CommonData
      IMPLICIT NONE
c     Start of generated type statements:
      INTEGER nodelist,nlist,iedgelist,nedgelist,ifacelist,nfacelist
      INTEGER icall,inc
      REAL*8 time,timeinc
      DIMENSION nodelist(*),iedgelist(2,*),ifacelist(4,*)
c     End of generated type statements.
      INTEGER : : i , yEdNum
      INTEGER , ALLOCATABLE , DIMENSION ( : ) : : yIndex
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='icall.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'ICALL = ',icall
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=icall.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      IF (icall.EQ.3) THEN
      yMask = [ ( edgeStress ( i ) .GT. yStress , i =1 , edgeCount ) ]
      yEdNum = COUNT( yMask )
      ALLOCATE(yIndex,SOURCE=PACK([(i,i=1,edgeCount)],yMask))
      nEdgeList = yEdNum
      iEdgeLi s t ( : , 1 : yEdNum) = edgeList( : , yIndex )
      END IF
      RETURN
      END      
c
      SUBROUTINE uedinc ( inc , incsub )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).      
      USE CommonData
c      USE MarcTools, ONLY: GetElmEdgeVal
      IMPLICIT NONE
c     Start of generated type statements:
      INTEGER inc , incsub
c     End of generated type statements.
      INTEGER : : i
      REAL*8 : : GetElmEdgeVal 
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='inc.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'inc = ',inc
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=inc.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      IF (inc.GT.0) THEN
      DO i = 1 , edgeCount
      edgeStress ( i ) =
     & GetElmEdgeVal ( edgeList ( 1 , i ) , edgeList ( 2 , i ) , 17 , 2)
      WRITE( 6 , * ) edgeList ( 1 , i ) , ' - ' , edgeList ( 2 , i )
      WRITE ( 6 , * ) ' stress ' , edgeStress ( i )
      END DO
      END IF
      RETURN
      END      
c      
      SUBROUTINE ExtractSetItemLst( setName , itemLst , nItemLst )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      CHARACTER( LEN=* ) , INTENT ( IN ) : : setName
      INTEGER , INTENT (OUT) , ALLOCATABLE, DIMENSION ( : ) : : itemLst
      INTEGER , INTENT (OUT) : : nItemLst
      INTEGER , PARAMETER : : MAX_SET_ITEM = 1000
      INTEGER : : tItemLst(MAX_SET_ITEM) , isFound , setType , i
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='setName.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'setName = ',setName
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=setName.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      CALL Marc_SetInf( setName , isFound , tItemLst , setType , 
     & nItemLst )
      IF ( isFound .EQ. 1) THEN
      ALLOCATE ( itemLst ( nItemLst ) )
      itemLst = [ ( tItemLst( i ) , i = 1 , nItemLst ) ]
      ELSE
      nItemLst = 0
      END IF
      RETURN
      END SUBROUTINE ExtractSetItemLst 
c
      INTEGER FUNCTION GetElmIntID ( elmID )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID
      INTEGER : : ielint , tElmIntID
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      tElmIntID = ielint ( elmID )
      IF ( tElmIntID . LE. 0) THEN
      CALL QUIT (1234)
      ELSE
      GetElmIntID = tElmInt ID
      END IF
      END FUNCTION GetElmIntID
c      
      INTEGER FUNCTION GetNodExtID ( intNodID )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : intNodID
      INTEGER : : tIntNodID , nodext
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='intNodID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'intNodID = ',intNodID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=intNodID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      tIntNodID = nodext ( intNodID )
      IF ( tIntNodID . LE. 0) THEN
      CALL QUIT(1234)
      ELSE
      GetNodExtID = t IntNodID
      END IF
      END FUNCTION GetNodExtID      
c      
      SUBROUTINE ExtractElmNodLst ( elmID , nodLst , nNod )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID
      INTEGER , ALLOCATABLE, DIMENSION ( : ) , INTENT (OUT) : : nodLst
      INTEGER , INTENT (OUT) : : nNod
      INTEGER : : i , intElID
      INTEGER , ALLOCATABLE : : tNodLst ( : )
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      ALLOCATE( tNodLst ( nnodmx ) )
      intElID = GetElmIntID ( elmID )
      IF ( intElID.NE.0) THEN
      CALL ElNodes ( intElID , nNod , tNodLst )
      ALLOCATE ( nodLst ( nNod ) )
      DO i = 1 , nNod
      nodLst ( i ) = GetNodExtID ( tNodLst ( i ) )
      END DO
      ELSE
      nNod = 0
      END IF
      END SUBROUTINE ExtractElmNodLst      
c      
      SUBROUTINE ExtractElmEdgeLst ( elmID , edgeLst , nEdgeLst )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID
      INTEGER , ALLOCATABLE, DIMENSION ( : , : ) , 
     & INTENT (OUT) : : edgeLst
      INTEGER , INTENT (OUT ) : : nEdgeLst
      INTEGER , ALLOCATABLE, DIMENSION ( : ) : : nodLst
      INTEGER : : nNodLst , i
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      CALL ExtractElmNodLst ( elmID , nodLst , nNodLst )
      nEdgeLst = nNodLst
      ALLOCATE ( edgeLst (2 , nNodLst ) )
      DO i = 1 , ( nNodLst - 1)
      edgeLst (1 , i ) = nodLst ( i )
      edgeLst (2 , i ) = nodLst ( i +1)
      END DO
      edgeLst (1 , nNodLst ) = nodLst ( nNodLst )
      edgeLst (2 , nNodLst ) = nodLst (1)
      RETURN
      END SUBROUTINE ExtractElmEdgeLst      
c
      SUBROUTINE SwapInt (num1 , num2)
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( INOUT) : : num1 , num2
      INTEGER : : tNum
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='num1.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'num1 = ',num1
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=num1.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).      
      tNum = num1
      num1 = num2
      num2 = tNum
      END SUBROUTINE SwapInt      
c     
      SUBROUTINE PutSmallFirst ( itemLst , nItemLst )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , DIMENSION ( 2 , * ) , INTENT ( INOUT) : : itemLst
      INTEGER , INTENT ( IN ) : : nItemLst
      INTEGER : : i
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nItemLst.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nItemLst = ',nItemLst
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nItemLst.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      DO i = 1 , nItemLst
      IF ( itemLst (1 , i ) .GT. itemLst (2 , i ) ) THEN
      CALL SwapInt ( itemLst (1 , i ) , i temLst (2 , i ) )
      END IF
      END DO
      END SUBROUTINE PutSmallFirst      
c
      SUBROUTINE DelRepeated2D ( itemLst , nItemLst ,
     & outItemLst , nOutItemLst )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , DIMENSION ( 2 , * ) , INTENT ( IN ) : : itemLst
      INTEGER , INTENT ( IN ) : : nI temLst
      INTEGER , DIMENSION ( : , : ) , ALLOCATABLE, 
     & INTENT (OUT) : : outItemLst
      INTEGER , INTENT (OUT) : : nOutItemLst
      LOGICAL , ALLOCATABLE, DIMENSION ( : ) : : lstMask
      INTEGER , ALLOCATABLE, DIMENSION ( : ) : : lstIndex
      INTEGER : : i
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nItemLst.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nItemLst = ',nItemLst
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nItemLst.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      ALLOCATE ( lstMask ( nItemLst ) )
      lstMask = .TRUE.
      DO i = nItemLst , 2 , -1
      lstMask ( i ) = 
     & .NOT. ( Any ( itemLst ( 1 , : i -1) .EQ. itemLst (1 , i )
     & .AND. itemLst ( 2 , : i -1) .EQ. itemLst (2 , i ) ) )
      END DO
      ALLOCATE( lstIndex , source=PACK( [ ( i , i =1 , nItemLst ) ] , 
     & lstMask ) )
      ALLOCATE( outItemLst , source=i temLst ( : , lstIndex ) )
      nOutItemLst = Size ( outItemLst , 2)
      END SUBROUTINE DelRepeated2D 
c
      SUBROUTINE DelRepeated(itemLst, nItemLst, outItemLst, 
     & nOutItemLst)
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER, DIMENSION ( * ) , INTENT ( IN ) : : itemLst
      INTEGER, INTENT ( IN ) : : nItemLst
      INTEGER, DIMENSION ( : ), ALLOCATABLE, INTENT (OUT) : : outItemLst
      INTEGER, INTENT (OUT) : : nOutItemLst
      LOGICAL, ALLOCATABLE, DIMENSION ( : ) : : lstMask
      INTEGER, ALLOCATABLE, DIMENSION ( : ) : : lstIndex
      INTEGER : : i
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nItemLst.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nItemLst = ',nItemLst
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nItemLst.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end). 
      ALLOCATE ( lstMask ( nItemLst ) )
      lstMask = .TRUE.
      DO i = nItemLst , 2 , -1
      lstMask(i) = .NOT. (Any ( itemLst ( : i -1) .EQ.itemLst(i)))
      END DO
      ALLOCATE(lstIndex, source = PACK([(i, i =1, nItemLst)], lstMask))
      ALLOCATE( outItemLst , source = i temLst ( lstIndex ) )
      nOutItemLst = Size ( outItemLst )
      END SUBROUTINE DelRepeated      
c      
      SUBROUTINE ExtractIntersectLst ( itemLst1 , nItemLst1 ,
     & itemLst2 , nItemLst2 , interlst , nInterLst )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , DIMENSION ( * ) , INTENT ( IN ) : : itemLst1 , itemLst2
      INTEGER , INTENT ( IN ) : : nItemLst1 , nItemLst2
      INTEGER , ALLOCATABLE, INTENT (OUT) : : interLst ( : )
      INTEGER , INTENT (OUT) : : nInterLst
      INTEGER : : i , nLst
      LOGICAL , ALLOCATABLE, DIMENSION ( : ) : : lstMask
      INTEGER , ALLOCATABLE, DIMENSION ( : ) : : tLst
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nItemLst1.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nItemLst1 = ',nItemLst1
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nItemLst1.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      ALLOCATE ( lstMask ( nItemLst1 ) )
      DO i = 1 , nItemLst1
      lstMask(i) = Any ( itemLst1 ( i ) .EQ. itemLst2 ( : nItemLst2 ) )
      END DO
      nLst = Count ( lstMask )
      IF (nLst .NE. 0) THEN
      ALLOCATE ( tLst , SOURCE = Pack ( itemLst1 ( 1 : nItemLst1 ) ,
     & MASK=lstMask ) )
      CALL DelRepeated ( tLst , nLst , interLst , nInterLst )
      ELSE
      nInterLst = nLst
      END IF
      END SUBROUTINE ExtractIntersectLst      
c      
      SUBROUTINE DelElmFreeEdge ( edgeLst , nEdge , ref inedEdgeLst )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , DIMENSION ( 2 , * ) , INTENT ( INOUT) : : edgeLst
      INTEGER , INTENT ( IN ) : : nEdge
      INTEGER , ALLOCATABLE, INTENT (OUT) : : refinedEdgeLst ( : , : )
      INTEGER : : edgeNod1 , nElmLstNod1 , edgeNod2 , nElmLstNod2
      INTEGER : : i , nInterLst
      LOGICAL , ALLOCATABLE, DIMENSION ( : ) : : aMask
      INTEGER , ALLOCATABLE, DIMENSION ( : ) : : anIndex , interLst ,
     & elmLstNod1 , elmLstNod2
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nEdge.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nEdge = ',nEdge
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nEdge.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      ALLOCATE ( aMask ( nEdge ) )
      ALLOCATE ( elmLstNod1 (maxnp ) )
      ALLOCATE ( elmLstNod2 (maxnp ) )
      elmLstNod1 = 0
      elmLstNod2 = 0
      nElmLstNod1 = 0
      nElmLstNod2 = 0
      DO i = 1 , nEdge
      edgeNod1 = edgeLst (1 , i )
      edgeNod2 = edgeLst (2 , i )
      CALL UT_ELEMENTS_AT_NODE ( edgeNod1 , elmLstNod1 , nElmLstNod1 )
      CALL UT_ELEMENTS_AT_NODE ( edgeNod2 , elmLstNod2 , nElmLstNod2 )
      CALL ExtractIntersectLst ( elmLstNod1 , nElmLstNod1 ,
     & elmLstNod2 , nElmLstNod2 , interLst, nInterLst )
      aMask ( i ) = nInterLst.GT.1
      END DO
      ALLOCATE( anIndex , source = PACK( [ ( i , i = 1 , nEdge ) ] , 
     & aMask ) )
      ALLOCATE( ref inedEdgeLst , source = edgeLst ( : , anIndex ) )
      RETURN
      END SUBROUTINE DelElmFreeEdge      
c      
      FUNCTION GetNodCoord ( nodID , nodState )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : nodID
      INTEGER , OPTIONAL , INTENT ( IN ) : : nodState
      REAL*8 , DIMENSION( 3 ) : : GetNodCoord
      INTEGER : : nComp , dataType , i
      REAL*8 , DIMENSION( 3 ) : : nodCoord , nodDisp
      INTEGER : : coordState
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nodID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nodID = ',nodID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nodID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      nodCoord = [ 0.0D0 , 0.0D0 , 0.0D0 ]
      IF (PRESENT( nodState ) ) THEN
      coordState = nodState
      ELSE
      coordState = 1
      END IF
      CALL NodVar (0 , nodID , nodCoord , nComp, dataType )
      IF ( coordState .EQ. 1) THEN
      GetNodCoord = nodCoord
      ELSE
      CALL NodVar (1 , nodID , nodDisp , nComp, dataType )
      GetNodCoord = nodCoord + nodDisp
      END IF
      IF (nComp .EQ. 2) GetNodCoord ( 3 ) = 0.D0
      END FUNCTION GetNodCoord      
c      
      SUBROUTINE ExtractNodCloseIPLst(nodID, nItemLst, elmLst, IPLst)
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : nodID
      INTEGER , INTENT (OUT ) : : nItemLst
      INTEGER, ALLOCATABLE, INTENT(OUT) : : elmLst ( : ) , IPLs t ( : )
      INTEGER , ALLOCATABLE : : tElmLst ( : )
      INTEGER : : nTElmLst, i , curIP , curElm
      REAL*8 , DIMENSION( 3 ) : : nodCoord , IPCoord
      REAL*8 , ALLOCATABLE : : distanceLst(:)
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nodID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nodID = ',nodID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nodID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      ALLOCATE (tElmLst(maxNP))
      CALL ut_elements_at_node ( nodID , tElmLst , nTElmLst )
      IF ( nTElmLst .EQ. 0) THEN
      nItemLst = 0
      CALL QUIT(1234)
      RETURN
      ELSE
      nItemLst = nTElmLst
      ALLOCATE ( elmLst ( nItemLst ) )
      ALLOCATE ( IPLst ( nItemLst ) )
      nodCoord = GetNodCoord ( nodID , 1)
      ALLOCATE(distanceLst(nintbmx))
      DO i = 1 , nItemLst
      curElm = tElmLst ( i )
      elmLst ( i ) = curElm
      DO cur IP = 1 , nintbmx
      IPCoord = GetIPCoord ( curElm , curIP )
      distanceLst ( curIP ) = GetDistance ( nodCoord , IPCoord )
      END DO
      IPLst ( i ) = Minloc ( distanceLst , 1)
      END DO
      END IF
      END SUBROUTINE ExtractNodCloseIPLst     
c
      SUBROUTINE MakeElmIDLst ( elmIDLst )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , ALLOCATABLE, DIMENSION ( : ) , INTENT (OUT) : : elmIDLst
      INTEGER : : i
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmIDLst.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmIDLst = ',elmIDLst
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmIDLst.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      ALLOCATE ( elmIDLst ( numel ) )
      elmIDLst = [ ( GetElmExtID ( i ) , i = 1 , numel ) ]
      RETURN
      END SUBROUTINE MakeElmIDLst     
c
      FUNCTION GetIndex ( itemLst , nItemLst , searchItem )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) , DIMENSION( * ) : : itemLst
      INTEGER , INTENT ( IN ) : : nItemLst , searchItem
      INTEGER : : GetIndex
      INTEGER : : i
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nItemLst.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nItemLst = ',nItemLst
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nItemLst.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      GetIndex = 0
      DO i = 1 , nItemLst
      IF ( itemLst ( i ) .EQ. searchItem ) THEN
      GetIndex = i
      EXIT
      END IF
      END DO
      END FUNCTION GetIndex      
c      
      FUNCTION IsElmIDValid ( elmID )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID
      LOGICAL : : IsElmIDValid
      INTEGER , ALLOCATABLE, DIMENSION ( : ) : : elmIDLst
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      CALL MakeElmIDLst ( elmIDLst )
      IF ( GetIndex ( elmIDLst , numel , elmID ) .EQ. 0) THEN
      IsElmIDValid = . FALSE .
      ELSE
      IsElmIDValid = .TRUE.
      END IF
      RETURN
      END FUNCTION IsElmIDValid      
c      
      FUNCTION GetElmIPCount ( elmID )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID
      INTEGER : : GetElmIPCount
      INTEGER : : intElmID
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      GetElmIPCount = 0
      IF ( IsElmIDValid ( elmID ) .EQV. .TRUE. ) THEN
      intElmID = GetElmIntID ( ElmID )
      IF ( intElmID .EQ. 0) THEN
      CALL QUIT(1234)
      ELSE
      CALL SetEl ( IntElmID )
      GetElmIPCount = jintel
      END IF
      ELSE
      CALL QUIT(1234)
      END IF
      RETURN
      END FUNCTION GetElmIPCount      
c      
      FUNCTION GetElmAveVal ( elmID , elmCode )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID , elmCode
      REAL*8 : : GetElmAveVal
      INTEGER : : nIP , IP , IntElmID
      REAL*8 : : curElmVal , totElmVal
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      curElmVal = 0.D0
      totElmVal = 0.D0
      intElmID = GetElmIntID ( elmID )
      IF ( intElmID .EQ. 0) THEN
      CALL QUIT(1234)
      ELSE
      nIP = GetElmIPCount ( elmID )
      DO IP = 1 , nIP
      CALL elmvar ( elmCode , elmID , IP , 0 , curElmVal )
      totElmVal = totElmVal + curElmVal
      END DO
      GetElmAveVal = totElmVal / nIP
      END IF
      RETURN
      END FUNCTION GetElmAveVal      
c
      FUNCTION GetElmArea(elmID)
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID
      REAL*8 : : GetElmArea
      INTEGER , ALLOCATABLE : : nodLst ( : )
      REAL*8 , ALLOCATABLE : : nodCoord ( : , : )
      REAL*8 : : elmArea , x1 , x2 , y1 , y2
      INTEGER : : nNodLst , iNod
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      CALL ExtractElmNodLst ( elmID , nodLst , nNodLst )
      IF ( nNodLst .EQ. 0) THEN
      CALL QUIT(1234)
      ELSE
      ALLOCATE ( nodCoord ( nNodLst , 3 ) )
      DO iNod = 1 , nNodLst
      nodCoord ( iNod , : ) = GetNodCoord ( nodLst ( iNod ) , 1)
      END DO
      elmArea = 0.D0
      DO iNod = 1 , nNodLst
      x1 = nodCoord ( iNod , 1 )
      y1 = nodCoord ( iNod , 2 )
      IF ( iNod .EQ. nNodLst ) THEN
      x2 = nodCoord (1 ,1)
      y2 = nodCoord (1 ,2)
      ELSE
      x2 = nodCoord ( iNod +1 ,1)
      y2 = nodCoord ( iNod +1 ,2)
      END IF
      elmArea = ( x1*y2 ) - ( y1*x2 ) + elmArea
      END DO
      GetElmArea = elmArea * 0.5D0
      END IF
      END FUNCTION GetElmArea      
c
      FUNCTION GetIPVal ( elmID , IP , elmCode )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID , IP , elmCode
      REAL*8 : : GetIPVal
      REAL*8 : : elmIPVal
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      IF ( ( IP .EQ. 0) .OR. ( elmID .EQ. 0) )THEN
      CALL QUIT(1234)
      ELSE
      CALL ElmVar ( elmCode , elmID , IP , 0 , elmIPVal )
      GetIPVal = elmIPVAl
      END IF
      RETURN
      END FUNCTION Get IPVal      
c      
      FUNCTION GetNodExtraVal ( elmID , nodID , IP , elmCode )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : elmID , nodID , IP , elmCode
      REAL*8 : : GetNodExtraVal
      REAL*8 , ALLOCATABLE : : IPValLst ( : )
      INTEGER : : nIP , iIP
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='elmID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'elmID = ',elmID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=elmID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      nIP = GetElmIPCount ( elmID )
      IF ( nIP .NE. 4) THEN
      CALL QUIT(1234)
      ELSE
      ALLOCATE ( IPValLst ( nIP ) )
      DO iIP = 1 , nIP
      IPValLst ( iIP ) = GetIPVal ( elmId , iIP , elmCode )
      END DO
      SELECT CASE ( IP )
      CASE( 1 )
      GetNodExtraVal =
     & 0.25D0 * ((1.D0 + 3.D0 * SQRT( 3.D0 ) ) * IPValLst (1) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (2) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (3) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (4))
      CASE( 2 )
      GetNodExtraVal =
     & 0.25D0 * ((1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (1) +
     &           (1.D0 + 3.D0 * SQRT( 3.D0 ) ) * IPValLst (2) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (3) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (4))
      CASE( 4 )
      GetNodExtraVal =
     & 0.25D0 * ((1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (1) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (2) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (3) +
     &           (1.D0 + 3.D0 * SQRT( 3.D0 ) ) * IPValLst (4))
      CASE( 3 )
      GetNodExtraVal =
     & 0.25D0 * ((1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (1) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (2) +
     &           (1.D0 + 3.D0 * SQRT( 3.D0 ) ) * IPValLst (3) +
     &           (1.D0 - 1.D0 * SQRT( 3.D0 ) ) * IPValLst (4))
      END SELECT
      END IF
      END FUNCTION GetNodExtraVal      
c      
      REAL*8 FUNCTION GetNodIPVal ( nodID , elmCode , calcMeth )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : nodID , elmCode , calcMeth
      INTEGER : : curElm , curIP , nItemLst , i
      INTEGER , ALLOCATABLE : : elmLst ( : ) , IPLst ( : )
      REAL*8 , ALLOCATABLE : : areaLst ( : )
      REAL*8 : : curVal, totVal, elmAve, elmCen(3), curArea, totArea
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nodID.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nodID = ',nodID
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nodID.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      totVal = 0.D0
      CALL ExtractNodCloseIPLst ( nodID , nI temLst , elmLst , IPLst )
      IF ( nItemLst .EQ. 0) THEN
      CALL QUIT(1234)
      ELSE
      ALLOCATE ( areaLst ( nItemLst ) )
      totArea = 0.D0
      DO i = 1 , nItemLst
      curElm = elmLst ( i )
      curIP = IPLst ( i )
      SELECT CASE ( calcMeth )
      CASE ( 1 )
      curVal = GetIPVal ( curElm , curIp , elmCode )
      arealst(i)=1.D0
      CASE ( 2 )
      curVal = GetNodExtraVal ( curElm , nodID , curIP , elmCode )
      arealst(i)=1.D0
      CASE ( 3 )
      curVal = GetElmAveVal ( curElm , elmCode )
      arealst(i)=1.D0
      CASE ( 4 )
      curVal = GetIPVal ( curElm , cur Ip , elmCode )
      arealst(i)=GetElmArea(curElm)
      CASE(5)
      curVal = GetNodExtraVal ( curElm , nodID , curIP , elmCode )
      arealst(i)=GetElmArea(curElm)
      CASE ( 6 )
      curVal = GetElmAveVal ( curElm , elmCode )
      arealst(i)=GetElmArea(curElm)
      END SELECT
      curArea = areaLst ( i )
      totArea = totArea + curArea
      totVal=totVal+(curVal*curArea)
      END DO
      GetNodIPVal=totVal/totArea
      END IF
      END FUNCTION GetNodIPVal      
c      
      FUNCTION GetElmEdgeVal ( nodID1 , nodID2 , elmCode , calcMeth )
c     We add a new code (beginning):
      use ifport, only: setenvqq
      use ifcore, only: TRACEBACKQQ      
c     We add a new code (end).
c     We add a new code (beginning):
c      IMPLICIT NONE    
c     We add a new code (end).
      INTEGER , INTENT ( IN ) : : nodID1 , nodID2 , elmCode , calcMeth
      REAL*8 : : GetElmEdgeVal
c     We add a new code (beginning):      
      integer lun
      logical lret
      lun = 0
      open( file='nodID1.log', newunit=lun, status='unknown',
     +      access='append' )
      if (lun /= 0) then
         write(lun,'(1x,I6,2x,A,2x,i12)') lun,'nodID1 = ',nodID1
         close(lun)
         lret = setenvqq("FOR_DIAGNOSTIC_LOG_FILE=nodID1.log")
         CALL TRACEBACKQQ("My application message string",
     +                     user_exit_code=-1)        
      end if      
c     We add a new code (end).
      GetElmEdgeVal =
     & ( GetNodIPVal ( nodID1 , elmCode , calcMeth ) +
     & GetNodIPVal ( nodID2 , elmCode , calcMeth ) ) / 2.D0
      END FUNCTION GetElmEdgeVal
      



