i2therm.F File Reference

#include "implicit_f.inc"
#include "com08_c.inc"
#include "scr18_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i2therm (x, nsn, nsv, irtl, ms, weight, irect, crst, iadi2, kthe, temp, areas, fthe, ftheskyi, condn, condnskyi, i0, itab, idt_therm, theaccfact)

Function/Subroutine Documentation

i2therm()

subroutine i2therm	(		x,
		integer	nsn,
		integer, dimension(*)	nsv,
		integer, dimension(*)	irtl,
			ms,
		integer, dimension(*)	weight,
		integer, dimension(4,*)	irect,
			crst,
		integer, dimension(4,*)	iadi2,
			kthe,
			temp,
			areas,
			fthe,
			ftheskyi,
			condn,
			condnskyi,
		integer	i0,
		integer, dimension(*)	itab,
		integer, intent(in)	idt_therm,
		intent(in)	theaccfact )

Definition at line 28 of file i2therm.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      "com08_c.inc"
#include      "scr18_c.inc"
#include      "parit_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NSN,I0
      INTEGER  IRECT(4,*),NSV(*),IRTL(*),WEIGHT(*), IADI2(4,*),ITAB(*)
      INTEGER ,intent(in) :: IDT_THERM
      my_real ,intent(in) :: theaccfact
      my_real :: kthe
      my_real :: x(3,*),temp(*),ms(*),crst(2,*),areas(*),fthe(*),ftheskyi(*),
     .   condn(*),condnskyi(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II,L,W,IX1,IX2,IX3,IX4,NN
C     REAL
      my_real
     .   s, t, sp ,sm  , tp, tm ,h1,h2,h3,h4,ax1,ay1,az1,ax2,ay2,az2,ax,ay,az,
     .   phi1,phi2,phi3,phi4,aream,areac,temps,tempm,phi,condint
 
C-----------------------------------------------
 
      DO ii=1,nsn
         i=nsv(ii)
C
         IF(i>0)THEN
           l=irtl(ii)
C
           w = weight(i)
           s = crst(1,ii)  
           t = crst(2,ii)  
           sp=one + s          
           sm=one - s          
           tp=fourth*(one + t)  
           tm=fourth*(one - t)  
C
           ix1 = irect(1,l)                                       
           ix2 = irect(2,l)                                       
           ix3 = irect(3,l)                                       
           ix4 = irect(4,l)  
           IF(ix3==ix4) THEN
              h1=tm*sm                                         
              h2=tm*sp  
              h3=one-h1-h2
              h4=zero
           ELSE
              h1=tm*sm                                         
              h2=tm*sp                                         
              h3=tp*sp                                         
              h4=tp*sm      
           ENDIF                                              
C            
           ax1 = x(1,ix3) - x(1,ix1)
           ay1 = x(2,ix3) - x(2,ix1)
           az1 = x(3,ix3) - x(3,ix1)
           ax2 = x(1,ix4) - x(1,ix2)
           ay2 = x(2,ix4) - x(2,ix2)
           az2 = x(3,ix4) - x(3,ix2)
C            
           ax  = ay1*az2 - az1*ay2
           ay  = az1*ax2 - ax1*az2
           az  = ax1*ay2 - ay1*ax2
C
           aream = one_over_8*sqrt(ax*ax+ay*ay+az*az)      
           areac = min(areas(ii),aream)
C            
           temps = temp(i)
           tempm = h1*temp(ix1)+h2*temp(ix2)+h3*temp(ix3)+h4*temp(ix4)
C                    
           phi  =  areac*(tempm - temps)*dt1*kthe*theaccfact 
 
C
           condint = areac*kthe*theaccfact
 
           phi1 = -phi *h1
           phi2 = -phi *h2
           phi3 = -phi *h3
           phi4 = -phi *h4
c
           fthe(i)=fthe(i)+phi
 
           IF(idt_therm == 1) condn(i) = condn(i) + condint*w   
c
           IF (iparit == 0.AND.w == 1) THEN
               fthe(ix1)=fthe(ix1)+phi1 
               fthe(ix2)=fthe(ix2)+phi2 
               fthe(ix3)=fthe(ix3)+phi3              
               fthe(ix4)=fthe(ix4)+phi4   
               IF(idt_therm == 1) THEN
                  condn(ix1)=condn(ix1)+abs(h1)*condint
                  condn(ix2)=condn(ix2)+abs(h2)*condint 
                  condn(ix3)=condn(ix3)+abs(h3)*condint              
                  condn(ix4)=condn(ix4)+abs(h4)*condint
               ENDIF
           ELSEIF (iparit > 0.AND.w == 1) THEN
               i0 = i0 + 1                                                                                                         
               nn = iadi2(1,i0)
               ftheskyi(nn)=phi1
               nn = iadi2(2,i0) 
               ftheskyi(nn)=phi2 
               nn = iadi2(3,i0)
               ftheskyi(nn)=phi3
               nn = iadi2(4,i0) 
               ftheskyi(nn)=phi4 
               IF(idt_therm == 1) THEN
                  nn = iadi2(1,i0)
                  condnskyi(nn)=abs(h1)*condint
                  nn = iadi2(2,i0) 
                  condnskyi(nn)=abs(h2)*condint
                  nn = iadi2(3,i0)
                  condnskyi(nn)=abs(h3)*condint
                  nn = iadi2(4,i0)                            
                  condnskyi(nn)=abs(h4)*condint
               ENDIF      
           ENDIF
         ELSE
           l = irtl(ii)
C
           ix1 = irect(1,l)                                       
           ix2 = irect(2,l)                                       
           ix3 = irect(3,l)                                          
           ix4 = irect(4,l)  
           fthe(i)= zero
           fthe(ix1)=zero 
           fthe(ix2)=zero 
           fthe(ix3)=zero             
           fthe(ix4)=zero  
           condn(i)= zero
           condn(ix1)=zero 
           condn(ix2)=zero 
           condn(ix3)=zero             
           condn(ix4)=zero    
         ENDIF
        ENDDO   
C
      RETURN