sms_bcs.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	sms_bcs (nodft, nodlt, indx1, icodt, iskew, skew, a, nodlast)
subroutine	sms_bcs1v (nindx, indx, iskew, icodt, a, skew)

Function/Subroutine Documentation

sms_bcs()

subroutine sms_bcs	(	integer	nodft,
		integer	nodlt,
		integer, dimension(*)	indx1,
		integer, dimension(*)	icodt,
		integer, dimension(*)	iskew,
			skew,
			a,
		integer	nodlast )

Definition at line 32 of file sms_bcs.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NODLAST
      INTEGER NODFT,NODLT,INDX1(*),ICODT(*),ISKEW(*)
      my_real
     .    a(3,*),skew(lskew,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, NINDX,
     .        INDX(1024),L,J
C-----------------------------------------------
C     DO 420 I = NODFT,NODLT,1024
      DO 420 i = nodft,nodlast,1024
        nindx = 0
C       DO 400 N=I,MIN(NODLT,I+1023)
        DO 400 j=i,min(nodlast,i+1023)
          n=indx1(j)
          IF (icodt(n)/=0)THEN
            nindx = nindx + 1
            indx(nindx) = n
          ENDIF
  400   CONTINUE
        CALL sms_bcs1v(nindx,indx,iskew,icodt,
     .             a    ,skew )
  420 CONTINUE
C
      RETURN

sms_bcs1v()

subroutine sms_bcs1v	(	integer	nindx,
		integer, dimension(*)	indx,
		integer, dimension(*)	iskew,
		integer, dimension(*)	icodt,
			a,
			skew )

Definition at line 77 of file sms_bcs.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NINDX, INDX(*), ISKEW(*), ICODT(*)
C     REAL
      my_real
     .   a(3,*), skew(lskew,*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, K, L, ISK, LCOD
C     REAL
      my_real
     .   aa
C-----------------------------------------------
#include "vectorize.inc"
      DO k = 1, nindx
        l = indx(k)
        isk =iskew(l)
        lcod=icodt(l)
        IF(isk==1) THEN
C------------------
C     REPERE GLOBAL
C------------------
      IF(lcod==1)THEN
      a(3,l)=zero
      ELSEIF(lcod==2)THEN
      a(2,l)=zero
      ELSEIF(lcod==3)THEN
      a(2,l)=zero
      a(3,l)=zero
      ELSEIF(lcod==4)THEN
      a(1,l)=zero
      ELSEIF(lcod==5)THEN
      a(1,l)=zero
      a(3,l)=zero
      ELSEIF(lcod==6)THEN
      a(1,l)=zero
      a(2,l)=zero
      ELSEIF(lcod==7)THEN
      a(1,l)=zero
      a(2,l)=zero
      a(3,l)=zero
      ENDIF
C
      ELSE
C-------------------
C     REPERE OBLIQUE
C-------------------
      IF(lcod==1)THEN
      aa  =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(7,isk)*aa
      a(2,l)=a(2,l)-skew(8,isk)*aa
      a(3,l)=a(3,l)-skew(9,isk)*aa
      ELSEIF(lcod==2)THEN
      aa  =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(4,isk)*aa
      a(2,l)=a(2,l)-skew(5,isk)*aa
      a(3,l)=a(3,l)-skew(6,isk)*aa
      ELSEIF(lcod==3)THEN
      aa  =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(7,isk)*aa
      a(2,l)=a(2,l)-skew(8,isk)*aa
      a(3,l)=a(3,l)-skew(9,isk)*aa
      aa  =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(4,isk)*aa
      a(2,l)=a(2,l)-skew(5,isk)*aa
      a(3,l)=a(3,l)-skew(6,isk)*aa
      ELSEIF(lcod==4)THEN
      aa  =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(1,isk)*aa
      a(2,l)=a(2,l)-skew(2,isk)*aa
      a(3,l)=a(3,l)-skew(3,isk)*aa
      ELSEIF(lcod==5)THEN
      aa  =skew(7,isk)*a(1,l)+skew(8,isk)*a(2,l)+skew(9,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(7,isk)*aa
      a(2,l)=a(2,l)-skew(8,isk)*aa
      a(3,l)=a(3,l)-skew(9,isk)*aa
      aa  =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(1,isk)*aa
      a(2,l)=a(2,l)-skew(2,isk)*aa
      a(3,l)=a(3,l)-skew(3,isk)*aa
      ELSEIF(lcod==6)THEN
      aa  =skew(1,isk)*a(1,l)+skew(2,isk)*a(2,l)+skew(3,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(1,isk)*aa
      a(2,l)=a(2,l)-skew(2,isk)*aa
      a(3,l)=a(3,l)-skew(3,isk)*aa
      aa  =skew(4,isk)*a(1,l)+skew(5,isk)*a(2,l)+skew(6,isk)*a(3,l)
      a(1,l)=a(1,l)-skew(4,isk)*aa
      a(2,l)=a(2,l)-skew(5,isk)*aa
      a(3,l)=a(3,l)-skew(6,isk)*aa
      ELSEIF(lcod==7)THEN
      a(1,l)=zero
      a(2,l)=zero
      a(3,l)=zero
      ENDIF
C
      END IF
C
      ENDDO
C
      RETURN