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	thbcs (nodft, nodlast, icodt, icodr, iskew, skew, a, ar, ms, in, fthreac, nodreac, cptreac)

Function/Subroutine Documentation

thbcs()

subroutine thbcs	(	integer	nodft,
		integer	nodlast,
		integer, dimension(*)	icodt,
		integer, dimension(*)	icodr,
		integer, dimension(*)	iskew,
			skew,
			a,
			ar,
			ms,
			in,
			fthreac,
		integer, dimension(*)	nodreac,
		integer	cptreac )

Definition at line 30 of file 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,CPTREAC
      INTEGER NODFT,NODLT,ICODT(*),ICODR(*),ISKEW(*),NODREAC(*)
      my_real
     .    a(3,*), ar(3,*), ms(*),skew(lskew,*),
     .    fthreac(*),in(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, K, ISK, LCOD, NINDX,
     .        INDX(1024),L,J,FLAG_MOM
C-----------------------------------------------
C
      IF (cptreac >= 1) THEN
        flag_mom = 0
        DO 420 i = nodft,nodlast,1024
          nindx = 0
          DO 400 n=i,min(nodlast,i+1023)
            IF (icodt(n)/=0 .AND. nodreac(n)>0)THEN
              nindx = nindx + 1
              indx(nindx) = n
            ENDIF
  400     CONTINUE
          CALL bcs1th(nindx,indx,iskew,icodt,
     &                a,skew,ms,fthreac,
     &                nodreac,flag_mom,in)
  420   CONTINUE
C
        IF(iroddl/=0) THEN
          flag_mom = 1
          DO 440 i = nodft,nodlast,1024
            nindx = 0
            DO 430 n=i,min(nodlast,i+1023)
              IF (icodr(n)/=0 .AND. nodreac(n)>0)THEN
                nindx = nindx + 1
                indx(nindx) = n
              ENDIF
  430       CONTINUE
            CALL bcs1th(nindx,indx,iskew,icodr,
     &                  ar,skew,ms,fthreac,
     &                  nodreac,flag_mom,in)
  440     CONTINUE
        ENDIF
      ENDIF
C
      RETURN