ale51_init.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    ale51_init             ../engine/source/ale/ale51/ale51_init.F
!||--- called by ------------------------------------------------------
!||    alethe                 ../engine/source/ale/alethe.F
!||--- calls      -----------------------------------------------------
!||    ale51_upwind2          ../engine/source/ale/ale51/ale51_upwind2.F
!||    ale51_upwind3          ../engine/source/ale/ale51/ale51_upwind3.F
!||    ale51_upwind3_int22    ../engine/source/ale/alefvm/cut_cells/ale51_upwind3_int22.F
!||    initbuf                ../engine/share/resol/initbuf.F
!||    my_barrier             ../engine/source/system/machine.F
!||--- uses       -----------------------------------------------------
!||    ale_connectivity_mod   ../common_source/modules/ale/ale_connectivity_mod.F
!||    elbufdef_mod           ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    i22bufbric_mod         ../common_source/modules/interfaces/cut-cell-search_mod.F
!||    i22tri_mod             ../common_source/modules/interfaces/cut-cell-search_mod.F
!||    initbuf_mod            ../engine/share/resol/initbuf.F
!||====================================================================
      SUBROUTINE ale51_init(IPARG      ,PM      ,IXS     ,IXQ      ,
     2                      X          ,FLUX    ,FLU2    ,
     3                      ALE_CONNECT,ITASK   ,
     4                      FLUX_SAV   ,QMV     ,NV46    ,ELBUF_TAB)
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
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
      END
C