read_ebcs.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/.
!||====================================================================
!||    read_ebcs                 ../starter/source/boundary_conditions/ebcs/read_ebcs.F
!||--- called by ------------------------------------------------------
!||    lectur                    ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                    ../starter/source/output/message/message.F
!||    hm_get_intv               ../starter/source/devtools/hm_reader/hm_get_intv.F
!||    hm_option_read_key        ../starter/source/devtools/hm_reader/hm_option_read_key.F
!||    hm_option_start           ../starter/source/devtools/hm_reader/hm_option_start.F
!||    hm_read_ebcs_fluxout      ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_fluxout.F
!||    hm_read_ebcs_gradp0       ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_gradp0.F
!||    hm_read_ebcs_inip         ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_inip.F
!||    hm_read_ebcs_iniv         ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_iniv.F
!||    hm_read_ebcs_inlet        ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_inlet.F
!||    hm_read_ebcs_monvol       ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_monvol.F
!||    hm_read_ebcs_normv        ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_normv.F
!||    hm_read_ebcs_nrf          ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_nrf.F
!||    hm_read_ebcs_pres         ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_pres.F
!||    hm_read_ebcs_propellant   ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_propellant.F90
!||    hm_read_ebcs_valvin       ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_valvin.F
!||    hm_read_ebcs_valvout      ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_valvout.F
!||    hm_read_ebcs_vel          ../starter/source/boundary_conditions/ebcs/hm_read_ebcs_vel.F
!||    ifrontplus                ../starter/source/spmd/node/frontplus.F
!||--- uses       -----------------------------------------------------
!||    front_mod                 ../starter/share/modules1/front_mod.F
!||    hm_option_read_mod        ../starter/share/modules1/hm_option_read_mod.F
!||    message_mod               ../starter/share/message_module/message_mod.F
!||    restmod                   ../starter/share/modules1/restart_mod.F
!||    submodel_mod              ../starter/share/modules1/submodel_mod.F
!||    table_mod                 ../starter/share/modules1/table_mod.F
!||====================================================================
      SUBROUTINE read_ebcs(IGRSURF,MULTI_FVM,NPC1,LSUBMODEL,EBCS_TAB)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE front_mod
      USE unitab_mod
      USE message_mod
      USE multi_fvm_mod
      USE groupdef_mod
      USE restmod
      USE table_mod
      USE submodel_mod
      USE ale_ebcs_mod
      USE ebcs_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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      "units_c.inc"
#include      "com04_c.inc"
#include      "titr_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (SURF_), DIMENSION(NSURF), TARGET, INTENT(IN) :: IGRSURF
      TYPE (MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
      INTEGER, INTENT(IN) :: NPC1
      TYPE(submodel_data) LSUBMODEL(NSUBMOD)
      TYPE(t_ebcs_tab), INTENT(INOUT) :: EBCS_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: LOCAL_ID
      INTEGER :: ID,TYP,UID
      INTEGER :: II, SURF_ID, JJ, SUB_INDEX
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER(LEN=NCHARKEY) :: KEY, KEY2
      LOGICAL :: IS_AVAILABLE, IS_EBCS_PARALLEL
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
 
      IF (nebcs > 0) THEN
        WRITE(iout,1000)
        WRITE(istdo,'(A)')titre(69)
        CALL ebcs_tab%CREATE(nebcs)  !     Create structure for collecting ebcs
        CALL hm_option_start('/EBCS') !     Prepare data structures
      ENDIF
 
 
      DO ii = 1, nebcs
         local_id = ii
         CALL hm_option_read_key(lsubmodel, option_id = id, unit_id = uid, option_titr = titr,
     .         keyword2 = key, keyword3 = key2, submodel_index = sub_index)
!     Allocate type
        SELECT CASE(key(1:len_trim(key)))
         CASE ('GRADP0')
 
            typ = 0
            allocate (t_ebcs_gradp0 :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_gradp0)
              CALL hm_read_ebcs_gradp0(igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
            end select
 
         CASE ('PRES')
 
            typ = 1
            allocate (t_ebcs_pres :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_pres)
              CALL hm_read_ebcs_pres(igrsurf, npc1,  multi_fvm, unitab, id, titr, lsubmodel, twf)
            end select
    
         CASE ('VALVIN')
 
            typ = 2
            allocate (t_ebcs_valvin :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_valvin)
              CALL hm_read_ebcs_valvin(igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
            end select
    
         CASE ('VALVOUT')
 
            typ = 3
            allocate (t_ebcs_valvout :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_valvout)
              CALL hm_read_ebcs_valvout( igrsurf, npc1, multi_fvm, unitab, id, titr,  lsubmodel, twf)
           end select
 
         CASE ('VEL')
 
            typ = 4
            allocate (t_ebcs_vel :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_vel)
              CALL hm_read_ebcs_vel(igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
           end select
 
         CASE ('NORMV')
 
            typ = 5
            allocate (t_ebcs_normv :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
 
            type is (t_ebcs_normv)
              CALL hm_read_ebcs_normv( igrsurf, npc1, multi_fvm, unitab, id, titr, lsubmodel, twf)
           end select
 
         CASE ('INIP')  
 
            typ = 6
            allocate (t_ebcs_inip :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_inip)
              CALL hm_read_ebcs_inip(igrsurf, multi_fvm, unitab, id, titr, lsubmodel, twf)
            end select
 
         CASE ('INIV')  
 
            typ = 7
            allocate (t_ebcs_iniv :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_iniv)
                CALL hm_read_ebcs_iniv(igrsurf, multi_fvm, unitab, id, titr, lsubmodel, twf)
           end select
 
         CASE ('INLET')
 
            typ = 8
            allocate (t_ebcs_inlet :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_inlet)
              CALL hm_read_ebcs_inlet(igrsurf, npc1, multi_fvm, unitab, id, titr, uid, lsubmodel, key2, sub_index, twf)
           end select
 
         CASE ('FLUXOUT') 
 
            typ = 9
            allocate (t_ebcs_fluxout :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_fluxout)
              CALL hm_read_ebcs_fluxout(igrsurf, multi_fvm, unitab, id, titr, uid, lsubmodel, twf)
            end select
 
         CASE ('NRF')
 
            typ = 10
            allocate (t_ebcs_nrf :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_nrf)
              CALL hm_read_ebcs_nrf(igrsurf, multi_fvm, unitab, id, titr, uid, lsubmodel, twf)
            end select
 
         CASE ('PROPELLANT')
 
            typ = 11
            allocate (t_ebcs_propellant :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_propellant)
              CALL hm_read_ebcs_propellant(igrsurf, multi_fvm, unitab, id, titr, uid, lsubmodel,nsurf, twf)
            end select
 
         CASE ('MONVOL')
 
            typ = 100
            allocate (t_ebcs_monvol :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_monvol)
              CALL hm_read_ebcs_monvol(igrsurf,multi_fvm,unitab, id, titr, uid, lsubmodel, twf)
            end select
 
         CASE DEFAULT
           typ = 0
           CALL ancmsg(msgid = 1602, msgtype = msgerror, anmode = aninfo,
     .          i1 = id, c1 = trim(titr), c2 = "\'"//trim(key)//"\'"//" IS NOT A VALID KEYWORD FOR EBCS OPTIONS")
         END SELECT
 
         ebcs_tab%tab(ii)%poly%type = typ
         ebcs_tab%tab(ii)%poly%ebcs_id = id
         !     Get surface id
         CALL hm_get_intv('entityid', surf_id, is_available, lsubmodel)
         jj = -huge(jj)
         IF (surf_id > 0) THEN
            ebcs_tab%tab(ii)%poly%surf_id = 0
            DO jj = 1, nsurf
               IF (igrsurf(jj)%ID == surf_id) THEN
                  ebcs_tab%tab(ii)%poly%surf_id = jj
                  EXIT
               ENDIF
            ENDDO
         ENDIF
         IF (ebcs_tab%tab(ii)%poly%surf_id > 0) THEN
            CALL ebcs_tab%tab(ii)%poly%set_nodes_elems(igrsurf(jj)%NSEG, numnod, igrsurf(jj)%NODES)         
 
            is_ebcs_parallel = .false.
            IF(ebcs_tab%tab(ii)%poly%type == 10 .OR. ebcs_tab%tab(ii)%poly%type == 11)THEN
              is_ebcs_parallel = .true.
            ENDIF
 
            IF(.NOT. is_ebcs_parallel) THEN
              DO jj = 1, ebcs_tab%tab(ii)%poly%nb_node
                CALL ifrontplus(ebcs_tab%tab(ii)%poly%node_list(jj), 1)
              ENDDO
            ENDIF
 
            DO jj = 1, ebcs_tab%tab(ii)%poly%nb_node
              flagkin(ebcs_tab%tab(ii)%poly%node_list(jj)) = 1
            ENDDO
 
         ELSE
           !     error
         ENDIF
         
      ENDDO
 
      RETURN
 1000 FORMAT(
     &     5x,'    ELEMENTARY BOUNDARY CONDITIONS'/,
     &     5x,'    ------------------------------')
      END SUBROUTINE