hm_read_alebcs.F File Reference

#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr10_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_alebcs (icode, iskew, itab, itabm1, ikine, igrnod, ibcslag, lag_ncf, lag_nkf, lag_nhf, ikine1lag, iskn, nom_opt, lsubmodel)

Function/Subroutine Documentation

hm_read_alebcs()

subroutine hm_read_alebcs	(	integer, dimension(numnod), intent(inout)	icode,
		integer, dimension(*), intent(inout)	iskew,
		integer, dimension(numnod), intent(in)	itab,
		integer, dimension(*), intent(in)	itabm1,
		integer, dimension(*), intent(in)	ikine,
		type (group_), dimension(ngrnod), target	igrnod,
		integer, dimension(5,*), intent(in)	ibcslag,
		integer, intent(in)	lag_ncf,
		integer, intent(in)	lag_nkf,
		integer, intent(in)	lag_nhf,
		integer, dimension(*), intent(in)	ikine1lag,
		integer, dimension(liskn,*), intent(in)	iskn,
		integer, dimension(lnopt1,*), intent(in)	nom_opt,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel )

Definition at line 40 of file hm_read_alebcs.F.

C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is reading /ALE/BCS options in user input file
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : ncharfield, nchartitle
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      "scr17_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "scr10_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) ::  ITAB(NUMNOD), ITABM1(*), IKINE(*), IBCSLAG(5,*), LAG_NCF,LAG_NKF,LAG_NHF,IKINE1LAG(*),ISKN(LISKN,*)
      INTEGER,INTENT(IN) ::  NOM_OPT(LNOPT1,*)
      INTEGER,INTENt(INOUT) :: ISKEW(*),ICODE(NUMNOD)
      TYPE(SUBMODEL_DATA), INTENT(IN), DIMENSION(NSUBMOD) :: LSUBMODEL
C-----------------------------------------------
      TYPE (GROUP_)  ,TARGET, DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IC, NC, N, IS, IC1, IC2,
     .        NOSYS, J,IGR,IGRS,IBCALE,J6(6),
     .        IC0, IC01, IC02, IC03, IC04, ID ,ILAGM,
     .        CHKCOD,NOD,SUB_INDEX
      INTEGER IUN
      CHARACTER MESS*40,CODE*7
      CHARACTER(LEN=NCHARFIELD) :: STRING
      CHARACTER(LEN=NCHARTITLE) :: TITR
      LOGICAL :: IS_AVAILABLE, FOUND
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS,MY_OR,CHECK_NEW,NGR2USR
      INTEGER, DIMENSION(:), POINTER :: INGR2USR
C-----------------------------------------------
C   D a t a
C-----------------------------------------------
      DATA iun/1/
      DATA mess/'BOUNDARY CONDITIONS                     '/
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      is_available = .false.
      sub_index = 0
 
      CALL hm_option_start('/ALE/BCS')
 
      DO i = 1, nalebcs
         CALL hm_option_read_key(lsubmodel,
     .                       option_id = id,
     .                       option_titr = titr,
     .                       submodel_index = sub_index)
         CALL hm_get_string('dofstring', string, ncharfield, is_available)
         CALL hm_get_intv('inputsystem', is, is_available, lsubmodel)
         IF(is == 0 .AND. sub_index /= 0 ) is = lsubmodel(sub_index)%SKEW
         CALL hm_get_intv('entityid', igr, is_available, lsubmodel)
         found = .false.
         DO j = 0, numskw + nsubmod
            IF(is == iskn(4, j + 1)) THEN
               is = j + 1
               found = .true.
               EXIT
            ENDIF
         ENDDO
         IF (.NOT. found) THEN
            CALL ancmsg(msgid = 137, anmode = aninfo, msgtype = msgerror,
     .           c1 = 'BOUNDARY CONDITION', c2 = 'BOUNDARY CONDITION',
     .           i2 = is, i1 = n, c3 = titr)
         ENDIF
!         CODE = STRING(LFIELD - 6 : LFIELD)
         code = string(1:7)
         READ(code,fmt='(3I1,1X,3I1)') j6
         chkcod = 0
         DO j=1,6
            IF (j6(j) >= 2) THEN
               chkcod = 1
            ENDIF
         ENDDO
         IF (chkcod == 1) THEN
           CALL ancmsg(msgid = 1051, anmode = aninfo_blind,msgtype = msgerror, i1 = id, c1 = titr, c2 = code)
         ENDIF
         ic1=j6(1)*4 +j6(2)*2 +j6(3)
         ic2=j6(4)*4 +j6(5)*2 +j6(6)
         ic=ic1*8+ic2
         ingr2usr => igrnod(1:ngrnod)%ID
         igrs=ngr2usr(igr,ingr2usr,ngrnod)
         IF(igrs /= 0)THEN
            DO j=1,igrnod(igrs)%NENTITY
               nosys=igrnod(igrs)%ENTITY(j)
               icode(nosys)=my_or(ic,icode(nosys))
               IF(iskew(nosys) == -1.OR.iskew(nosys) == is)THEN
                  check_new=is
               ELSE
                  CALL ancmsg(msgid=148,anmode=aninfo,msgtype=msgerror,i1=itab(nosys),prmod=msg_cumu)
               ENDIF
               iskew(nosys)=check_new
            ENDDO
            CALL ancmsg(msgid=148,anmode=aninfo,msgtype=msgerror,i1=id,c1=titr,prmod=msg_print)
         ELSE
            CALL ancmsg(msgid=678,anmode=aninfo,msgtype=msgerror,i1=id,i2=igr,c1=titr)
         ENDIF
      ENDDO
C-----------------------------------------------      
      RETURN