read_ebcs.F File Reference

#include "implicit_f.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "titr_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	read_ebcs (igrsurf, multi_fvm, npc1, lsubmodel, ebcs_tab, n2d)

Function/Subroutine Documentation

read_ebcs()

subroutine read_ebcs	(	type (surf_), dimension(nsurf), intent(in), target	igrsurf,
		type (multi_fvm_struct), intent(inout)	multi_fvm,
		integer, intent(in)	npc1,
		type(submodel_data), dimension(nsubmod)	lsubmodel,
		type(t_ebcs_tab), intent(inout)	ebcs_tab,
		integer, intent(in)	n2d )

Definition at line 57 of file read_ebcs.F.

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
      use hm_read_ebcs_propellant_mod, only : hm_read_ebcs_propellant
      use hm_read_ebcs_cyclic_mod, only : hm_read_ebcs_cyclic
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
      INTEGER,INTENT(IN) :: N2D
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: LOCAL_ID
      INTEGER :: ID,TYP,UID,SURF_ID2
      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 ('CYCLIC')
 
            typ = 12
            allocate (t_ebcs_cyclic :: ebcs_tab%tab(ii)%poly)
            select type (twf => ebcs_tab%tab(ii)%poly)
            type is (t_ebcs_cyclic)
              CALL hm_read_ebcs_cyclic(igrsurf, multi_fvm, id, titr, lsubmodel,nsurf, twf, n2d, numnod, itab )
            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)
            !secondary surface with  EBCS/CYCLIC
            IF(ebcs_tab%tab(ii)%poly%type == 12)then
              surf_id2 = ebcs_tab%tab(ii)%poly%surf_id2
              CALL ebcs_tab%tab(ii)%poly%set_nodes_elems_secondary_surface(igrsurf(surf_id2)%NSEG, numnod, igrsurf(surf_id2)%NODES)
            endif
 
            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,'    ------------------------------')