sms_thbcs.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	sms_thbcs (nodft, nodlast, indx1, icodt, icodr, iskew, skew, a, ar, fthreac, nodreac, cptreac)

Function/Subroutine Documentation

sms_thbcs()

subroutine sms_thbcs	(	integer	nodft,
		integer	nodlast,
		integer, dimension(*)	indx1,
		integer, dimension(*)	icodt,
		integer, dimension(*)	icodr,
		integer, dimension(*)	iskew,
			skew,
			a,
			ar,
			fthreac,
		integer, dimension(*)	nodreac,
		integer	cptreac )

Definition at line 30 of file sms_thbcs.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      "com01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NODLAST,INDX1(*),CPTREAC
      INTEGER NODFT,ICODT(*),ICODR(*),ISKEW(*),NODREAC(*)
      my_real
     .    a(3,*),ar(3,*),skew(lskew,*),fthreac(6,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J, N, K, ISK, LCOD, NINDX,
     .        INDX(1024),L,FLAG_MOM
C-----------------------------------------------
C
      IF (cptreac >= 1) THEN
        flag_mom = 0
        DO 420 i = nodft,nodlast,1024
          nindx = 0
          DO 400 j=i,min(nodlast,i+1023)
            n=indx1(j)
            IF (icodt(n)/=0 .AND. nodreac(n)/=0)THEN
              nindx = nindx + 1
              indx(nindx) = n
            ENDIF
  400     CONTINUE
          CALL sms_bcs1th(nindx ,indx   ,iskew  ,icodt  ,a    ,
     2                    skew  ,fthreac,nodreac,flag_mom)
  420   CONTINUE
C
        IF(iroddl/=0) THEN
          flag_mom = 1
          DO 440 i = nodft,nodlast,1024
            nindx = 0
            DO 430 j=i,min(nodlast,i+1023)
              n=indx1(j)
              IF (icodr(n)/=0 .AND. nodreac(n)>0)THEN
                nindx = nindx + 1
                indx(nindx) = n
              ENDIF
  430       CONTINUE
            CALL sms_bcs1th(nindx,indx,iskew,icodr,ar,
     &                  skew,fthreac,nodreac,flag_mom)
  440     CONTINUE
        ENDIF
      ENDIF
C
      RETURN