hm_read_spcnd.F File Reference

#include "implicit_f.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_spcnd (ispcond, iskew, itab, itabm1, ikine, igrnod, nod2sp, iframe, nom_opt, lsubmodel)

Function/Subroutine Documentation

hm_read_spcnd()

subroutine hm_read_spcnd	(	integer, dimension(nispcond,*)	ispcond,
		integer, dimension(*)	iskew,
		integer, dimension(*)	itab,
		integer, dimension(*)	itabm1,
		integer, dimension(*)	ikine,
		type (group_), dimension(ngrnod), target	igrnod,
		integer, dimension(*)	nod2sp,
		integer, dimension(liskn,*)	iframe,
		integer, dimension(lnopt1,*)	nom_opt,
		type(submodel_data), dimension(*)	lsubmodel )

Definition at line 42 of file hm_read_spcnd.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE r2r_mod
      USE groupdef_mod
      USE submodel_mod        
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
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      "sphcom.inc"
#include      "units_c.inc"
#include      "param_c.inc"
#include      "r2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ISPCOND(NISPCOND,*), ISKEW(*), ITAB(*), ITABM1(*),
     .        IKINE(*),NOD2SP(*),IFRAME(LISKN,*)
      INTEGER NOM_OPT(LNOPT1,*)
      TYPE(SUBMODEL_DATA) 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,ID, IC, N, IS, IC1, IC2, IC3, IC4,
     .        NOSYS, J,IGR,IGRS,K,
     .        NCELL,
     .        ILEV, NY
      CHARACTER MESS*40
      CHARACTER(LEN=NCHARTITLE) :: TITR
      CHARACTER(LEN=NCHARKEY) :: KEY
      CHARACTER(LEN=NCHARFIELD) :: DIR
      LOGICAL IS_AVAILABLE
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NGR2USR
      INTEGER, DIMENSION(:), POINTER :: INGR2USR
C-----------------------------------------------
      DATA mess/'SPECIFIC TO SPH SYMMETRY CONDITIONS      '/
C-----------------------------------------------
      WRITE(iout,1000)
      ny = 0
      CALL hm_option_start('/SPHBCS')
 
        DO i=1,nspcond
          ny=ny+1
C----------Multidomaines --> on ignore les BCS SPH non tagees-----------
          IF(nsubdom>0)THEN
              IF(tagsphbcs(ny)==0)CALL hm_sz_r2r(tagsphbcs,ny,lsubmodel)
          END IF
C--------------------------------------------------
C EXTRACT DATAS OF /SPHBCS/... LINE
C--------------------------------------------------
          CALL hm_option_read_key(lsubmodel,
     .                         option_id = id,
     .                         option_titr = titr,
     .                         keyword2 = key)
          nom_opt(1,i)=id
          CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
          IF (key(1:5)=='SLIDE')THEN
           ispcond(5,i)=1
          ELSEIF (key(1:4)=='TIED')THEN
           ispcond(5,i)=0
          ELSE
             CALL ancmsg(msgid=398,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   c1=key)
          ENDIF
          ispcond(nispcond,i)=id
C--------------------------------------------------
C EXTRACT DATAS (INTEGER VALUES)
C--------------------------------------------------
          CALL hm_get_intv('inputsystem',is,is_available,lsubmodel)
          CALL hm_get_intv('entityid',igr,is_available,lsubmodel)
          CALL hm_get_intv('rad_sphbcs_ilev',ilev,is_available,lsubmodel)
C--------------------------------------------------
C EXTRACT DATAS (STRING)
C--------------------------------------------------
          CALL hm_get_string('rad_dir',dir,ncharfield,is_available)
C
          IF(dir(1:1)=='X')THEN
            ic=1
          ELSEIF(dir(1:1)=='Y')THEN
            ic=2
          ELSEIF(dir(1:1)=='Z')THEN
            ic=3
          ENDIF
          IF(ilev/=0.AND.ilev/=1)THEN
             CALL ancmsg(msgid=399,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   i1=ilev)
          ENDIF
          ispcond(1,i)=ilev
          ispcond(2,i)=ic
          IF (is==0)THEN
           ispcond(3,i)=1
           GOTO 111
          ELSE
           DO j=1,numfram
            IF (iframe(4,j+1)==is)THEN
             ispcond(3,i)=j+1
             GOTO 111
            ENDIF
           ENDDO
          ENDIF
             CALL ancmsg(msgid=400,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   i1=is)
 111      CONTINUE
C
          ingr2usr => igrnod(1:ngrnod)%ID
          igrs=ngr2usr(igr,ingr2usr,ngrnod)
          ispcond(4,i)=igrs
C
          DO nosys=1,numnod
              ncell=nod2sp(nosys)
              IF (ncell==0) THEN
              ELSE
              ENDIF
          ENDDO
          WRITE(iout,1100)id,trim(titr),dir(1:1),is,igr,ilev
        ENDDO
C-------------------------------------
      RETURN
C
1000  FORMAT(
     . '      SPECIFIC TO SPH SYMMETRY CONDITIONS '/
     . '      ---------------------------------- '/)
1100  FORMAT(/5x,'CONDITION ID                               ',i10,1x,a
     .       /10x,'NORMAL DIRECTION TO SYMMETRY PLANE         ',a10,
     .       /10x,'REFERENCE FRAME ID                        ',i10,
     .       /10x,'NODES GROUP ID FOR KINEMATIC CONDITIONS   ',i10,
     .       /10x,'FORMULATION LEVEL                         ',i10)