ale51_upwind3.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	ale51_upwind3 (pm, ixs, flux, flu1, ale_connect, itrimat, ddvol, qmv, iflg, nv46)

Function/Subroutine Documentation

ale51_upwind3()

subroutine ale51_upwind3	(		pm,
		integer, dimension(nixs,numels)	ixs,
			flux,
			flu1,
		type(t_ale_connectivity), intent(in)	ale_connect,
		integer	itrimat,
			ddvol,
		dimension(12,*), target	qmv,
		integer	iflg,
		integer	nv46 )

Definition at line 34 of file ale51_upwind3.F.

C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C  This subroutines computes from direct fluxes :
C  -1- FLUX(1:6,*), FLU1(*) : Decomposition Factors from Biased Upwind Method
C  -2- QMV(7:12)            :
C  -3- DDVOL                : D/DV . D/DT . VOL = DV/DT
C
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE i22tri_mod
      USE ale_connectivity_mod
      use element_mod , only : nixs
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "vect01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXS(NIXS,NUMELS), ITRIMAT,IFLG,NV46
      my_real pm(npropm,nummat), flux(nv46,*), flu1(*),ddvol(*)
      my_real,TARGET :: qmv(12,*)
      TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,II,MAT(MVSIZ),IAD2
      my_real reduc, upwl(nv46,mvsiz),flux1(mvsiz), flux2(mvsiz), flux3(mvsiz), flux4(mvsiz),flux5(mvsiz), flux6(mvsiz)
      my_real, TARGET :: qmvl(7:12,mvsiz)
      my_real, DIMENSION(:) ,POINTER :: pqmv7,pqmv8,pqmv9,pqmv10,pqmv11,pqmv12
      LOGICAL :: debug_outp
C-----------------------------------------------
C   S o u r c e   L i n e s 
C-----------------------------------------------
      DO i=lft,llt
        flux1(i) = flux(1,i)
        flux2(i) = flux(2,i)
        flux3(i) = flux(3,i)
        flux4(i) = flux(4,i)
      ENDDO
      IF(nv46==6)THEN
      DO i=lft,llt
        flux5(i) = flux(5,i)
        flux6(i) = flux(6,i)
      ENDDO      
      ENDIF
C-----------------------------------------------
      DO i=lft,llt
        ii=i+nft
        mat(i)=ixs(1,ii)
      ENDDO
C-----------------------------------------------
C     UPWIND
C-----------------------------------------------
      DO j=1,nv46
        DO i=lft,llt
          upwl(j,i)=pm(16,mat(i))
        ENDDO
      ENDDO
      !======================================================!
      !  BOUNDARY FACE : no volume flux by default           !
      !    slip wall bc                                      !
      !======================================================!
      DO i=lft,llt
       iad2 = ale_connect%ee_connect%iad_connect(i + nft)
       reduc=pm(92,mat(i))
       !---face1---!       
       ii=ale_connect%ee_connect%connected(iad2 + 1 - 1)
       IF(ii == 0)THEN
        flux1(i)=flux1(i)*reduc
       ENDIF
       !---face2---!
       ii=ale_connect%ee_connect%connected(iad2 + 2 - 1)
       IF(ii == 0)THEN
        flux2(i)=flux2(i)*reduc
       ENDIF
       !---face3---!
       ii=ale_connect%ee_connect%connected(iad2 + 3 - 1)
       IF(ii == 0)THEN
        flux3(i)=flux3(i)*reduc
       ENDIF
       !---face4---!
       ii=ale_connect%ee_connect%connected(iad2 + 4 - 1)
       IF(ii == 0)THEN
        flux4(i)=flux4(i)*reduc
       ENDIF
       IF(nv46==6)THEN
         !---face5---!
         ii=ale_connect%ee_connect%connected(iad2 + 5 - 1)
         IF(ii == 0)THEN
          flux5(i)=flux5(i)*reduc
         ENDIF
         !---face6---!
         ii=ale_connect%ee_connect%connected(iad2 + 6 - 1)
         IF(ii == 0)THEN
          flux6(i)=flux6(i)*reduc
         ENDIF
       ENDIF
       ! IF(NV46==6)THEN
      ENDDO
      
      DO i=lft,llt
        flux(1,i) = flux1(i)-upwl(1,i)*abs(flux1(i))
        flux(2,i) = flux2(i)-upwl(2,i)*abs(flux2(i))
        flux(3,i) = flux3(i)-upwl(3,i)*abs(flux3(i))
        flux(4,i) = flux4(i)-upwl(4,i)*abs(flux4(i))
      ENDDO  
      IF(nv46==6)THEN
      DO i=lft,llt
        flux(5,i) = flux5(i)-upwl(5,i)*abs(flux5(i))
        flux(6,i) = flux6(i)-upwl(6,i)*abs(flux6(i))
      ENDDO            
      ENDIF    
      
      IF(iflg == 1)THEN
        pqmv7  => qmv(07,lft:llt)
        pqmv8  => qmv(08,lft:llt)
        pqmv9  => qmv(09,lft:llt)
        pqmv10 => qmv(10,lft:llt)
        pqmv11 => qmv(11,lft:llt)
        pqmv12 => qmv(12,lft:llt)                                        
      ELSE
        pqmv7  => qmvl(07,lft:llt)
        pqmv8  => qmvl(08,lft:llt)
        pqmv9  => qmvl(09,lft:llt)
        pqmv10 => qmvl(10,lft:llt)
        pqmv11 => qmvl(11,lft:llt)
        pqmv12 => qmvl(12,lft:llt)      
      ENDIF           
      !MOMENTUM ADVECTION NEEDED FOR AMOMT3.F
 
      IF(nv46==6)THEN
        DO i=lft,llt
          pqmv7(i)  = flux1(i)+upwl(1,i)*abs(flux1(i))
          pqmv8(i)  = flux2(i)+upwl(2,i)*abs(flux2(i))
          pqmv9(i)  = flux3(i)+upwl(3,i)*abs(flux3(i))
          pqmv10(i) = flux4(i)+upwl(4,i)*abs(flux4(i))
          pqmv11(i) = flux5(i)+upwl(5,i)*abs(flux5(i))
          pqmv12(i) = flux6(i)+upwl(6,i)*abs(flux6(i))                    
          flu1(i) = pqmv7(i) + pqmv8(i) + pqmv9(i) + pqmv10(i) +pqmv11(i) + pqmv12(i)
        ENDDO           
        IF(itrimat  > 0)THEN
          DO i=lft,llt
            ddvol(i)=half*( flu1(i)+ flux(1,i)+flux(2,i)+flux(3,i)+flux(4,i)+flux(5,i)+flux(6,i) )
          ENDDO
        ENDIF                
      ELSE
        DO i=lft,llt
          pqmv7(i)  = flux1(i)+upwl(1,i)*abs(flux1(i))
          pqmv8(i)  = flux2(i)+upwl(2,i)*abs(flux2(i))
          pqmv9(i)  = flux3(i)+upwl(3,i)*abs(flux3(i))
          pqmv10(i) = flux4(i)+upwl(4,i)*abs(flux4(i))                
          flu1(i) = pqmv7(i) + pqmv8(i) + pqmv9(i) + pqmv10(i)
        ENDDO        
        IF(itrimat  > 0)THEN
          DO i=lft,llt
            ddvol(i)=half*( flu1(i)+ flux(1,i)+flux(2,i)+flux(3,i)+flux(4,i) )
          ENDDO
        ENDIF        
      ENDIF
 
      !INTERFACE 22 ONLY - OUTPUT---------------! OBSOLETE
      debug_outp = .false.      
      if(ibug22_upwind /= 0)then
        if(ibug22_upwind  > 0)then
          do i=lft,llt
            if(ixs(11,i+nft) == ibug22_upwind)debug_outp=.true.
          enddo
        elseif(ibug22_upwind==-1)then
          debug_outp = .true.
        endif
        if(((itrimat /= ibug22_itrimat).and.(ibug22_itrimat /= -1)))debug_outp=.false.
      endif
!#!include "lockon.inc"      
      if(debug_outp)then
        print *, "    |----ale51_upwind3.F-----|"
        print *, "    |   THREAD INFORMATION   |"
        print *, "    |------------------------|" 
        print *, "    NCYCLE=", ncycle
        do i=lft,llt
          if(ibug22_upwind/=ixs(11,i+nft).and.ibug22_upwind/=-1)cycle
          !if (tag22(i)==zero)print *,"       UNCUT"!cycle
          print *,                    "      brique    =", ixs(11,nft+i)
          print *,                    "      itrimat   =", itrimat
          write (*,fmt='(A,6E26.14)')"       Flux(1:6) =", flux(1:6,i)
          write (*,fmt='(A,1E26.14)')"       Flu1      =", flu1(i)
          print *, "      ------------------------"          
        enddo
!#!include "lockoff.inc"       
      endif
      !-----------------------------------------!
 
C-----------------------------------------------
      RETURN