D:/demona/2.0/manual/doc/2-31set/problems/bratu/1/setRule.f90

Go to the documentation of this file.

!subroutine setRule(resVec,set,aveNorm)
subroutine setRule(resVec,n,norm,normRMS)


use global


implicit none

integer n

real(8) resVec(n)

integer i

real(8) myval,norm,normRMS

integer myT,myI,myJ,myII

integer,pointer :: myDofVectorArray(:,:),IM(:,:,:,:)

integer dummy

real(8) averageRes



dof=>myModel%physics(currentPhysics)%dof



if (allocated(setTol)) deallocate(setTol)

allocate(setTol(dof))


averageRes=0.d0

do i=1,size(resVec)

averageRes=resVec(i)+averageRes


end do

averageRes=averageRes/(size(resVec)*1.d0)



!print*,normRMS,averageRes
!pause




!setTol=1e-2
!setTol=min(1e-2,1e-2*normF)
setTol=norm*1e-2
!setTol(2)=1.d0

!print*,norm,normRMS
!stop


!setTol=1e-8
!setTol=0.d0

!print*,(norm/normRMS)


!setTOL=(normRMS/(norm/normRMS))**1.d0

!print*,setTol
!stop

!print*,resvec(1)


!if (resvec(1).eq.settol(1)) stop


setTol=normRMS
setTol=averageRes*1e-3
setTol=normRMS
setTol=norm*1e-2

!print*,norm
!pause

!setTol=0.d0

myDofVectorArray=>myModel%physics(currentPhysics)%domain(currentDomain)%dofVector

IM=>myModel%physics(currentPhysics)%domain(currentDomain)%dofMatrix

dummy=0



!call DBGcheckFlag(1)


!IM(:,:,:,flag)=1

!do i=1,globalcurrentsetlength
do i=1,size(resVec)

        !print*,'********',i


        !myII=setVec(i)
        myII=i

        !myVal=resVec(myII)
        myVal=resVec(i)
        myT=myDofVectorArray(myII,4)

        myI=myDofVectorArray(myII,2)
        myJ=myDofVectorArray(myII,3)


        !if (dabs(myVal).gt.setTol(myT)) then
        if (dabs(myVal).ge.setTol(myT)) then

                !print*,i,dabs(myVal),setTol(myT)

                IM(myI,myJ,myT,flag)=1

                dummy=dummy+1

        else

                !print*,'++'

                !print*,myI,myJ,myT,setVEc(i)

                IM(myI,myJ,myT,flag)=0

        end if


end do


!call DBGcheckFlag(1)

print*,'values kept=',dummy


!pause








end subroutine setRule

---