i25buce_crit.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i25buce_crit (x, nsv, msr, nsn, nmn, itask, xsav, nin, stfn, v, xslv_g, xmsr_g, vslv_g, vmsr_g)

Function/Subroutine Documentation

i25buce_crit()

subroutine i25buce_crit	(		x,
		integer, dimension(*)	nsv,
		integer, dimension(*)	msr,
		integer	nsn,
		integer	nmn,
		integer	itask,
			xsav,
		integer	nin,
			stfn,
			v,
			xslv_g,
			xmsr_g,
			vslv_g,
			vmsr_g )

Definition at line 28 of file i25buce_crit.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSN,NMN,ITASK,NIN,NSV(*),MSR(*)
      my_real
     .   x(3,*), v(3,*), xsav(3,*), stfn(*),
     .   xslv_g(*),xmsr_g(*), vslv_g(*), vmsr_g(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NSNF,NMNF,NSNL,NMNL,I, J, K, II, N,IAD,NES,JG,
     .        IE, I1, I2, N1, N2 
      my_real
     .  xslv(18),xmsr(12), vslv(6), vmsr(6)
C-----------------------------------------------
C
C     0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON
C
C
      xslv(1) = -ep30
      xslv(2) = -ep30
      xslv(3) = -ep30
      xslv(4) =  ep30
      xslv(5) =  ep30
      xslv(6) =  ep30
 
      xmsr(1) = -ep30
      xmsr(2) = -ep30
      xmsr(3) = -ep30
      xmsr(4) =  ep30
      xmsr(5) =  ep30
      xmsr(6) =  ep30
 
      vslv(1) = -ep30
      vslv(2) = -ep30
      vslv(3) = -ep30
      vslv(4) =  ep30
      vslv(5) =  ep30
      vslv(6) =  ep30
 
      vmsr(1) = -ep30
      vmsr(2) = -ep30
      vmsr(3) = -ep30
      vmsr(4) =  ep30
      vmsr(5) =  ep30
      vmsr(6) =  ep30
 
      nsnf = 1 + itask*nsn / nthread
      nsnl = (itask+1)*nsn / nthread
      nmnf = 1 + itask*nmn / nthread
      nmnl = (itask+1)*nmn / nthread
 
C=======================================================================
      IF(nsn+nmn < numnod)THEN
C
#include "vectorize.inc"
        DO i=nsnf,nsnl
          j=nsv(i)
          IF(stfn(i)/=zero .AND. j<=numnod) THEN
 
            xslv(1) =max(xslv(1),x(1,j)-xsav(1,i))
            xslv(2) =max(xslv(2),x(2,j)-xsav(2,i))
            xslv(3) =max(xslv(3),x(3,j)-xsav(3,i))
            xslv(4) =min(xslv(4),x(1,j)-xsav(1,i))
            xslv(5) =min(xslv(5),x(2,j)-xsav(2,i))
            xslv(6) =min(xslv(6),x(3,j)-xsav(3,i))
 
            vslv(1)=max(vslv(1),v(1,j))
            vslv(2)=max(vslv(2),v(2,j))
            vslv(3)=max(vslv(3),v(3,j))
            vslv(4)=min(vslv(4),v(1,j))
            vslv(5)=min(vslv(5),v(2,j))
            vslv(6)=min(vslv(6),v(3,j))
          ENDIF
        END DO
#include "vectorize.inc"
        DO i=nmnf,nmnl
          ii = i+nsn
          j=msr(i)
          IF(j>0) THEN
 
            xmsr(1) =max(xmsr(1),x(1,j)-xsav(1,ii))
            xmsr(2) =max(xmsr(2),x(2,j)-xsav(2,ii))
            xmsr(3) =max(xmsr(3),x(3,j)-xsav(3,ii))
            xmsr(4) =min(xmsr(4),x(1,j)-xsav(1,ii))
            xmsr(5) =min(xmsr(5),x(2,j)-xsav(2,ii))
            xmsr(6) =min(xmsr(6),x(3,j)-xsav(3,ii))
 
            vmsr(1)=max(vmsr(1),v(1,j))
            vmsr(2)=max(vmsr(2),v(2,j))
            vmsr(3)=max(vmsr(3),v(3,j))
            vmsr(4)=min(vmsr(4),v(1,j))
            vmsr(5)=min(vmsr(5),v(2,j))
            vmsr(6)=min(vmsr(6),v(3,j))
          ENDIF
        END DO
      ELSE
C
#include "vectorize.inc"
        DO i=nsnf,nsnl
          j=nsv(i)
          IF(stfn(i)/=zero .AND. j<=numnod) THEN
 
            xslv(1)=max(xslv(1),x(1,j)-xsav(1,j))
            xslv(2)=max(xslv(2),x(2,j)-xsav(2,j))
            xslv(3)=max(xslv(3),x(3,j)-xsav(3,j))
            xslv(4)=min(xslv(4),x(1,j)-xsav(1,j))
            xslv(5)=min(xslv(5),x(2,j)-xsav(2,j))
            xslv(6)=min(xslv(6),x(3,j)-xsav(3,j))
 
            vslv(1)=max(vslv(1),v(1,j))
            vslv(2)=max(vslv(2),v(2,j))
            vslv(3)=max(vslv(3),v(3,j))
            vslv(4)=min(vslv(4),v(1,j))
            vslv(5)=min(vslv(5),v(2,j))
            vslv(6)=min(vslv(6),v(3,j))
C            
           
          ENDIF
        END DO
#include "vectorize.inc"
        DO i=nmnf,nmnl
          j=msr(i)
          IF(j>0) THEN
 
            xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,j))
            xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,j))
            xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,j))
            xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,j))
            xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,j))
            xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,j))
 
            vmsr(1)=max(vmsr(1),v(1,j))
            vmsr(2)=max(vmsr(2),v(2,j))
            vmsr(3)=max(vmsr(3),v(3,j))
            vmsr(4)=min(vmsr(4),v(1,j))
            vmsr(5)=min(vmsr(5),v(2,j))
            vmsr(6)=min(vmsr(6),v(3,j))
          ENDIF
        ENDDO
      ENDIF       
C dist calcule une fois pour toutes les interfaces dans COMCRIT (ci-dessous)
C
      IF(nspmd==1) THEN
C traitement deplace dans SPMD_GET_STIF en SPMD
        DO i=nsnf,nsnl
          stfn(i)=max(stfn(i),zero)
        ENDDO
      ENDIF
C
#include "lockon.inc"
C
      xslv_g(1)=max(xslv_g(1),xslv(1))
      xslv_g(2)=max(xslv_g(2),xslv(2))
      xslv_g(3)=max(xslv_g(3),xslv(3))
      xslv_g(4)=min(xslv_g(4),xslv(4))
      xslv_g(5)=min(xslv_g(5),xslv(5))
      xslv_g(6)=min(xslv_g(6),xslv(6))
 
      xmsr_g(1)=max(xmsr_g(1),xmsr(1))
      xmsr_g(2)=max(xmsr_g(2),xmsr(2))
      xmsr_g(3)=max(xmsr_g(3),xmsr(3))
      xmsr_g(4)=min(xmsr_g(4),xmsr(4))
      xmsr_g(5)=min(xmsr_g(5),xmsr(5))
      xmsr_g(6)=min(xmsr_g(6),xmsr(6))
 
      vslv_g(1)=max(vslv_g(1),vslv(1))
      vslv_g(2)=max(vslv_g(2),vslv(2))
      vslv_g(3)=max(vslv_g(3),vslv(3))
      vslv_g(4)=min(vslv_g(4),vslv(4))
      vslv_g(5)=min(vslv_g(5),vslv(5))
      vslv_g(6)=min(vslv_g(6),vslv(6))
      vmsr_g(1)=max(vmsr_g(1),vmsr(1))
      vmsr_g(2)=max(vmsr_g(2),vmsr(2))
      vmsr_g(3)=max(vmsr_g(3),vmsr(3))
      vmsr_g(4)=min(vmsr_g(4),vmsr(4))
      vmsr_g(5)=min(vmsr_g(5),vmsr(5))
      vmsr_g(6)=min(vmsr_g(6),vmsr(6))
C
#include "lockoff.inc"
C
      RETURN