ebcs_main.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/.
!||====================================================================
!||    ebcs_main          ../engine/source/boundary_conditions/ebcs/ebcs_main.f
!||--- called by ------------------------------------------------------
!||    alemain            ../engine/source/ale/alemain.F
!||--- calls      -----------------------------------------------------
!||    ebcs0              ../engine/source/boundary_conditions/ebcs/ebcs0.F
!||    ebcs1              ../engine/source/boundary_conditions/ebcs/ebcs1.F
!||    ebcs10             ../engine/source/boundary_conditions/ebcs/ebcs10.F
!||    ebcs11             ../engine/source/boundary_conditions/ebcs/ebcs11.F90
!||    ebcs4              ../engine/source/boundary_conditions/ebcs/ebcs4.F
!||    ebcs5              ../engine/source/boundary_conditions/ebcs/ebcs5.F
!||    ebcs6              ../engine/source/boundary_conditions/ebcs/ebcs6.F
!||    ebcs7              ../engine/source/boundary_conditions/ebcs/ebcs7.f
!||    ebcs_vol2seg       ../engine/source/boundary_conditions/ebcs/ebcs_vol2seg.f
!||--- uses       -----------------------------------------------------
!||    ebcs_mod           ../common_source/modules/boundary_conditions/ebcs_mod.F90
!||    elbufdef_mod       ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    groupdef_mod       ../common_source/modules/groupdef_mod.F
!||    multi_fvm_mod      ../common_source/modules/ale/multi_fvm_mod.F90
!||    python_funct_mod   ../common_source/modules/python_mod.F90
!||    segvar_mod         ../engine/share/modules/segvar_mod.F
!||    sensor_mod         ../common_source/modules/sensor_mod.F90
!||    th_surf_mod        ../common_source/modules/interfaces/th_surf_mod.F
!||====================================================================
      SUBROUTINE ebcs_main(IGRSURF,SEGVAR,VOLMON,A,V,W,X,
     .                     FSAV,FV,MS,STIFN,IPARG,ELBUF_TAB,EBCS_TAB,MULTI_FVM,IXQ,IXS,IXTG,
     .                     FSKY,FSAVSURF,TIME,DT1,
     .                     NSENSOR,SENSOR_TAB,PYTHON,
     .                     NPC, TF ,SNPC, STF)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE segvar_mod, ONLY : t_segvar
      USE elbufdef_mod  
      USE groupdef_mod
      USE ebcs_mod
      USE multi_fvm_mod
      USE th_surf_mod , only : th_surf_num_channel
      USE sensor_mod, ONLY : sensor_str_
      USE python_funct_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      "param_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "parit_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real,INTENT(IN) :: dt1 !time step
      my_real,INTENT(IN) :: time !simulation time
      my_real,INTENT(INOUT) :: fsavsurf(th_surf_num_channel,nsurf)
      INTEGER IPARG(NPARG,NGROUP)
      INTEGER,INTENT(IN) :: IXQ(NIXQ,NUMELQ),IXS(NIXS,NUMELS),IXTG(NIXTG,NUMELTG)
      my_real volmon(*),v(3,numnod),w(3,numnod),a(3,numnod),x(3,numnod),fsav(nthvki,*),
     .        fv(*),stifn(numnod)
      my_real,intent(inout) :: ms(numnod)
      TYPE(elbuf_struct_), DIMENSION(NGROUP) :: ELBUF_TAB
      TYPE (SURF_)   , DIMENSION(NSURF)   :: IGRSURF
      TYPE(t_ebcs_tab), TARGET, INTENT(INOUT) :: EBCS_TAB
      TYPE(multi_fvm_struct),INTENT(IN) :: MULTI_FVM
      my_real, DIMENSION(8,LSKY), INTENT(INOUT) :: fsky ! acceleration array for parith/on option
      INTEGER,INTENT(IN) :: NSENSOR
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
      TYPE (PYTHON_), INTENT(IN) :: PYTHON
      INTEGER,INTENT(IN) :: SNPC, STF
      INTEGER,INTENT(IN) :: NPC(SNPC)
      my_real :: tf(stf)
      TYPE(t_segvar) :: SEGVAR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,TYP,ISU,NSEG,VOLU,NOD
      CLASS(t_ebcs), POINTER :: EBCS
      LOGICAL HAS_TH
C-----------------------------------------------
C   S o u r  c e   L i n e s
C-----------------------------------------------
 
      !/TH/SURF (RESET)
      DO i = 1, nebcs
         IF(.NOT.ebcs_tab%need_to_compute(i)) cycle     !EBCS may be on domain 0 only depending on ebcs type
         ebcs => ebcs_tab%tab(i)%poly
         has_th = ebcs%has_th
         IF(has_th)THEN
           isu = ebcs%surf_id
           fsavsurf(1:5,isu) = zero
           ! fsavsurf(6,isu) is cumulative value : not reset
         ENDIF
      ENDDO
 
      DO i = 1, nebcs
         IF(.NOT.ebcs_tab%need_to_compute(i)) cycle
         ebcs => ebcs_tab%tab(i)%poly
         IF(ebcs%is_multifluid)return
         typ = ebcs%type
         isu = ebcs%surf_id
         nseg = ebcs%nb_elem
         nod = ebcs%nb_node
         IF (typ == 0) THEN
            select type (twf => ebcs_tab%tab(i)%poly)
            type is (t_ebcs_gradp0) 
            CALL ebcs0(nseg, ebcs%iseg, segvar,
     .           a, v, x, 
     .           ebcs%node_list, nod, ebcs%elem_list,ebcs%ielem,
     .           ebcs%vold, ebcs%pold, ebcs%p0,
     .           ebcs%la, fv, ms, stifn, iparg, elbuf_tab, twf)
            end select
         ELSE IF (typ <= 3)THEN
            CALL ebcs1(nseg,ebcs%iseg,segvar,
     .           a,v,x,
     .           ebcs%node_list,nod,ebcs%elem_list,
     .           ebcs%vold,ebcs%pold,ebcs%la,
     .           fv,ms,stifn,ebcs_tab, i)
         ELSE IF (typ == 4) THEN
            select type (twf => ebcs_tab%tab(i)%poly)
            type is (t_ebcs_vel) 
            CALL ebcs4(nseg,ebcs%iseg,segvar,
     .           a,v,x,
     .           ebcs%node_list,nod,ebcs%elem_list,
     .           ebcs%la,fv,ms,stifn,twf)     
            end select
         ELSE IF (typ == 5) THEN
            select type (twf => ebcs_tab%tab(i)%poly)
            type is (t_ebcs_normv) 
            CALL ebcs5(nseg,ebcs%iseg,segvar,
     .           a,v,x,
     .           ebcs%node_list,nod,ebcs%elem_list,
     .           ebcs%la,fv,ms,stifn,twf)     
            end select
         ELSE IF (typ == 6) THEN
            select type (twf => ebcs_tab%tab(i)%poly)
            type is (t_ebcs_inip) 
            CALL ebcs6(nseg,ebcs%iseg,segvar,
     .           a,v,x,
     .           ebcs%node_list,nod,ebcs%elem_list,
     .           ebcs%ro0,ebcs%en0,ebcs%p0,
     .           ebcs%vold,ebcs%pold,ebcs%la,
     .           ms,stifn,twf)
            end select
         ELSE IF (typ == 7) THEN
            select type (twf => ebcs_tab%tab(i)%poly)
            type is (t_ebcs_iniv) 
            CALL ebcs7(nseg,ebcs%iseg,segvar,
     .           a,v,x,
     .           ebcs%node_list,nod,ebcs%elem_list,
     .           ebcs%ro0,ebcs%en0,ebcs%v0,
     .           ebcs%la,ms,stifn,twf)     
             end select
         ELSE IF (typ == 10) THEN
            select type (twf => ebcs)
             type is (t_ebcs_nrf)
              CALL ebcs10(nseg,twf%iseg,segvar,
     .             a,v,w,x,
     .             twf%node_list,nod,twf%elem_list,twf%ielem,twf%iface,
     .             twf%la,twf,iparg,elbuf_tab,multi_fvm,ixq,ixs,ixtg,
     .             ebcs_parithon(i)%ELEM_ADRESS,fsky,fsavsurf)
             end select
         ELSE IF (typ == 11) THEN
            select type (twf => ebcs)
             type is (t_ebcs_propellant)
              call ebcs11(nseg,twf%iseg,segvar,
     .                    v,w,x,
     .                    twf%node_list,nod,twf%elem_list,twf%ielem,twf%iface,
     .                    twf%la,ms,stifn,twf,iparg,elbuf_tab,ixq,ixs,ixtg,
     .                    fsavsurf,time,iparit,dt1,
     .                    numels, numelq, numeltg,numnod, nparg, ngroup, nixs, nixq, nixtg, nsurf, iale, n2d,
     .                    nfunct, npc, tf ,snpc, stf, python,
     .                    nsensor, sensor_tab)
            end select
         ELSE IF (typ == 100) THEN
            SELECT TYPE(ebcs)
            TYPE IS (t_ebcs_monvol)
              volu = ebcs%monvol_id
              CALL ebcs_vol2seg(nseg,igrsurf(isu)%NODES,ebcs%iseg,segvar,a,v,x,volmon(nrvolu*(volu-1)+1),fsav(1,volu))
              END SELECT
         ENDIF
      ENDDO
 
c-----------
      RETURN
      END