ale51_init.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "inter22.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	ale51_init (iparg, pm, ixs, ixq, x, flux, flu2, ale_connect, itask, flux_sav, qmv, nv46, elbuf_tab)

Function/Subroutine Documentation

ale51_init()

subroutine ale51_init	(	integer, dimension(nparg,ngroup)	iparg,
			pm,
		integer, dimension(nixs,numels)	ixs,
		integer, dimension(7,numelq)	ixq,
			x,
			flux,
			flu2,
		type(t_ale_connectivity), intent(in)	ale_connect,
		integer	itask,
			flux_sav,
			qmv,
		integer	nv46,
		type(elbuf_struct_), dimension(ngroup), target	elbuf_tab )

Definition at line 41 of file ale51_init.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE initbuf_mod
      USE elbufdef_mod    
      USE i22bufbric_mod
      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   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"
#include      "task_c.inc"
#include      "inter22.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB      
      my_real pm(npropm,nummat), x(3,numnod),
     .        flux(nv46,*), flu2(*),
     .        flux_sav(nv46,*), qmv(*)
      INTEGER IPARG(NPARG,NGROUP), IXS(NIXS,NUMELS), IXQ(7,NUMELQ), ITASK, NV46, J
      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 :: NG, K, II, NF1
      my_real :: bid(1)
      INTEGER :: NIN, IB, NBF, NBL, IE, MLW
C-----------------------------------------------
C   S o u r c e   L i n e s 
C-----------------------------------------------
 
      CALL my_barrier
 
C-----------------------------------------------
C     VOLUME FLUXES BACKUP
C-----------------------------------------------
      DO ng=itask+1,ngroup,nthread
C     ALE ON / OFF
        IF (iparg(76, ng)  ==  1) cycle ! --> OFF
        CALL initbuf(iparg    ,ng      ,                  
     2     mtn     ,llt     ,nft     ,iad     ,ity     ,   
     3     npt     ,jale    ,ismstr  ,jeul    ,jtur    ,   
     4     jthe    ,jlag    ,jmult   ,jhbe    ,jivf    ,   
     5     nvaux   ,jpor    ,jcvt    ,jclose  ,jplasol ,   
     6     irep    ,iint    ,igtyp   ,israt   ,isrot   ,   
     7     icsen   ,isorth  ,isorthg ,ifailure,jsms    )
        !--------------------!
        ! UNPLUG CONDITIONS  !
        !--------------------!
        IF(jale+jeul == 0)    cycle
        IF(iparg(8,ng) == 1)  cycle
        IF(iparg(1,ng) /= 51) cycle
        !------------------------------!
        lft=1                   
        DO k=1,nv46
            DO ii=nft+lft,nft+llt
              flux_sav(k,ii)=flux(k,ii)
            ENDDO
        ENDDO        
      END DO !next NG
 
C--------------------
      CALL my_barrier
C--------------------
 
C-----------------------------------------------
C    UPDATE VOLUME FLUXES & UPWIND
C-----------------------------------------------
      DO ng=itask+1,ngroup,nthread
C     ALE ON / OFF
        IF (iparg(76, ng)  ==  1) cycle ! --> OFF
        CALL initbuf(iparg    ,ng      ,                  
     2     mtn     ,llt     ,nft     ,iad     ,ity     ,   
     3     npt     ,jale    ,ismstr  ,jeul    ,jtur    ,   
     4     jthe    ,jlag    ,jmult   ,jhbe    ,jivf    ,   
     5     nvaux   ,jpor    ,jcvt    ,jclose  ,jplasol ,   
     6     irep    ,iint    ,igtyp   ,israt   ,isrot   ,   
     7     icsen   ,isorth  ,isorthg ,ifailure,jsms    )
        IF(jale+jeul == 0)    cycle
        IF(iparg(8,ng) == 1)  cycle
        IF(iparg(1,ng) /= 51) cycle
        lft=1
        nf1=nft+1
        !------------------------------!
        ! UPWIND, QMV, DDVOL           !
        !------------------------------!
        IF(n2d == 0)THEN
          CALL ale51_upwind3(pm,ixs,flux(1,nf1),flu2(nf1),ale_connect,
     +                       0 ,bid,qmv(12*nft+1),1,
     +                       nv46 )
        ELSE
          CALL ale51_upwind2(pm,x,ixq,flux(1,nf1),flu2(nf1),ale_connect,
     +                       0,bid,qmv(8*nft+1),1)
        ENDIF
      END DO !next NG
 
C--------------------
      CALL my_barrier
C--------------------
 
      IF(int22 /= 0)THEN !OBSOLETE
        !Restore Direct Fluxes
        nin = 1
        nbf = 1+itask*nb/nthread
        nbl = (itask+1)*nb/nthread
        nbl = min(nbl,nb)
        DO ib=nbf,nbl
          ie  = brick_list(nin,ib)%ID 
          mlw = brick_list(nin,ib)%MLW 
          IF(mlw /= 51)cycle
          DO j=1,6
          brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(1) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(1)
          brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(2) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(2)
          brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(3) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(3)
          brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(4) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(4)
          brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_UpwFLUX(5) = brick_list(nin,ib)%POLY(1:9)%FACE(j)%Adjacent_FLUX(5)
          ENDDO
        ENDDO   
        
        !Computing Upwind fluxes
        CALL ale51_upwind3_int22
     +                      (pm   , ixs        ,0     ,  1,
     +                       iparg, elbuf_tab  ,itask     )
      ENDIF
 
C-----------------------------------------------
      RETURN