s4cumu3p.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "parit_c.inc"
#include "scr18_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s4cumu3p (offg, sti, fsky, fskyv, iads, f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, them, fthesky, condnsky, conde, nel, nft, jthe, nodadt_therm)

Function/Subroutine Documentation

s4cumu3p()

subroutine s4cumu3p	(		offg,
			sti,
			fsky,
			fskyv,
		integer, dimension(8,*)	iads,
			f11,
			f21,
			f31,
			f12,
			f22,
			f32,
			f13,
			f23,
			f33,
			f14,
			f24,
			f34,
			them,
			fthesky,
			condnsky,
			conde,
		integer, intent(in)	nel,
		integer, intent(in)	nft,
		integer, intent(in)	jthe,
		integer, intent(in)	nodadt_therm )

Definition at line 29 of file s4cumu3p.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "parit_c.inc"
#include      "scr18_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: NFT
      INTEGER, INTENT(IN) :: JTHE
      INTEGER, INTENT(IN) :: NODADT_THERM
      my_real
     .   offg(*),fskyv(lsky,8),fsky(8,lsky),sti(*),
     .   f11(*),f21(*),f31(*),f12(*),f22(*),f32(*),
     .   f13(*),f23(*),f33(*),f14(*),f24(*),f34(*),
     .   them(mvsiz,4),fthesky(*),condnsky(*),conde(*)
      INTEGER IADS(8,*)
CMasParINCLUDE 'scumu3.intmap.inc'
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II, K,J
      my_real
     .   off_l
C-----------------------------------------------
      off_l = 0.
      DO i=1,nel
Cf small3b        IF(OFF(I)<1.)OFFG(I) = OFF(I)
        off_l = min(off_l,offg(i))
      ENDDO
      IF(off_l<zero)THEN
        DO i=1,nel
         IF(offg(i)<zero)THEN
           f11(i)=zero
           f21(i)=zero
           f31(i)=zero
           f12(i)=zero
           f22(i)=zero
           f32(i)=zero
           f13(i)=zero
           f23(i)=zero
           f33(i)=zero
           f14(i)=zero
           f24(i)=zero
           f34(i)=zero
           sti(i)=zero
         ENDIF
        ENDDO
      ENDIF
      IF(jthe < 0 ) THEN
       IF(off_l<=zero)THEN
        DO j=1,4
         DO i=1,nel
          IF(offg(i)<=zero)THEN
             them(i,j)=zero
          ENDIF
         ENDDO
        ENDDO
       ENDIF
       IF(nodadt_therm == 1) THEN
        IF(off_l<zero)THEN
         DO i=1,nel
          IF(offg(i)<zero)THEN
             conde(i)=zero
          ENDIF
         ENDDO
        ENDIF
       ENDIF  
      ENDIF
C
C     because 2*Mnodal = 2*Melement/4
      DO i=1,nel
        sti(i)=half*sti(i)
      END DO
      IF(nodadt_therm == 1 ) THEN  
        DO i=1,nel
           conde(i)=fourth*conde(i)
        END DO
      ENDIF
C
      IF(ivector==1) THEN
#include "vectorize.inc"
        DO i=1,nel
          ii=i+nft
          k = iads(1,ii)
          fskyv(k,1)=f11(i)
          fskyv(k,2)=f21(i)
          fskyv(k,3)=f31(i)
          fskyv(k,4)=zero
          fskyv(k,5)=zero
          fskyv(k,6)=zero
          fskyv(k,7)=sti(i)
C
          k = iads(3,ii)
          fskyv(k,1)=f12(i)
          fskyv(k,2)=f22(i)
          fskyv(k,3)=f32(i)
          fskyv(k,4)=zero
          fskyv(k,5)=zero
          fskyv(k,6)=zero 
          fskyv(k,7)=sti(i)
C
          k = iads(6,ii)
          fskyv(k,1)=f13(i)
          fskyv(k,2)=f23(i)
          fskyv(k,3)=f33(i)
          fskyv(k,4)=zero
          fskyv(k,5)=zero
          fskyv(k,6)=zero 
          fskyv(k,7)=sti(i)
C
          k = iads(5,ii)
          fskyv(k,1)=f14(i)
          fskyv(k,2)=f24(i)
          fskyv(k,3)=f34(i)
          fskyv(k,4)=zero
          fskyv(k,5)=zero
          fskyv(k,6)=zero 
          fskyv(k,7)=sti(i)
C
        ENDDO
      ELSE
        DO i=1,nel
          ii=i+nft
          k = iads(1,ii)
          fsky(1,k)=f11(i)
          fsky(2,k)=f21(i)
          fsky(3,k)=f31(i)
          fsky(7,k)=sti(i)
C
          k = iads(3,ii)
          fsky(1,k)=f12(i)
          fsky(2,k)=f22(i)
          fsky(3,k)=f32(i)
          fsky(7,k)=sti(i)
C
          k = iads(6,ii)
          fsky(1,k)=f13(i)
          fsky(2,k)=f23(i)
          fsky(3,k)=f33(i)
          fsky(7,k)=sti(i)
C
          k = iads(5,ii)
          fsky(1,k)=f14(i)
          fsky(2,k)=f24(i)
          fsky(3,k)=f34(i)
          fsky(7,k)=sti(i)
C
        ENDDO
      ENDIF
C     
      IF(jthe < 0) THEN
        DO i=1,nel
          ii=i+nft
          k = iads(1,ii)
          fthesky(k)=them(i,1) 
C
          k = iads(3,ii)
          fthesky(k)=them(i,2)
C
          k = iads(6,ii)
          fthesky(k)=them(i,3)
C
          k = iads(5,ii)
          fthesky(k)=them(i,4)
C
        ENDDO
        IF(nodadt_therm == 1 ) THEN  
         DO i=1,nel
          ii=i+nft
          k = iads(1,ii)
          condnsky(k)=conde(i) 
C
          k = iads(3,ii)
          condnsky(k)=conde(i)
C
          k = iads(6,ii)
          condnsky(k)=conde(i)
C
          k = iads(5,ii)
          condnsky(k)=conde(i)
C
         ENDDO
        ENDIF
      ENDIF
C      
      RETURN