read_rwall.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	read_rwall (rwl, nprw, lprw, ifi, ms, v, itab, itabm1, x, ixs, ixq, npc, ikine, igrnod, mfi, imerge, unitab, ikine1lag, iddlevel, lsubmodel, rtrans, nom_opt, itagnd, lnspen)

Function/Subroutine Documentation

read_rwall()

subroutine read_rwall	(		rwl,
		integer, dimension(*)	nprw,
		integer, dimension(*)	lprw,
		integer	ifi,
			ms,
			v,
		integer, dimension(*)	itab,
		integer, dimension(*)	itabm1,
			x,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(nixq,*)	ixq,
		integer, dimension(*)	npc,
		integer, dimension(*)	ikine,
		type (group_), dimension(ngrnod), target	igrnod,
		integer	mfi,
		integer, dimension(*)	imerge,
		type (unit_type_), intent(in)	unitab,
		integer, dimension(*)	ikine1lag,
		integer	iddlevel,
		type(submodel_data), dimension(*)	lsubmodel,
			rtrans,
		integer, dimension(lnopt1,*)	nom_opt,
		integer, dimension(*)	itagnd,
		integer, intent(inout)	lnspen )

Definition at line 42 of file read_rwall.F.

C-------------------------------------
C     LECTURE MUR RIGIDE
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
      USE unitab_mod
      USE submodel_mod
      USE message_mod
      USE r2r_mod
      USE groupdef_mod
      USE hm_option_read_mod
      use element_mod , only : nixs,nixq
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      "com04_c.inc"
#include      "units_c.inc"
#include      "scr17_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB 
      INTEGER IFI,MFI,IDDLEVEL 
      INTEGER NPRW(*), LPRW(*), ITAB(*), ITABM1(*),IXS(NIXS,*),
     .        IXQ(NIXQ,*), NPC(*), IKINE(*),
     .        IMERGE(*),
     .        IKINE1LAG(*),ITAGND(*)
      TYPE(SUBMODEL_DATA) LSUBMODEL(*)
C     REAL
      my_real
     .   rwl(nrwlp,*), ms(*), v(3,*), x(3,*),
     .   rtrans(ntransf,*)
      INTEGER NOM_OPT(LNOPT1,*)
      INTEGER, INTENT (INOUT) :: LNSPEN 
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,DIMENSION(:),ALLOCATABLE :: IKINE1
      INTEGER K,I,NCHPLAN,NCHCYL,NCHSPHER,NCHPARAL,
     .   OFFS,NCHLAGM,NCHTHERM,N,NSL,IPEN
      my_real
     .   bid
      CHARACTER MESS*40
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      DATA mess/'STANDARD RIGID WALL DEFINITION          '/
C=======================================================================
C-----------------------------------------------
C     B e g i n n i n g   o f   s o u r c e
C-----------------------------------------------
      CALL my_alloc(ikine1,3*numnod)
C     Beginning of RWALL cards in the IIN file
      WRITE(iout,1000)
C
C     Initialization of variable
      k    = 0
      ! Offset
      offs = 0
      ! Flag for therm rigid wall
      DO i=1,3*numnod
        ikine1(i) = 0
      ENDDO
C
C-----------------------------------------------      
!     **************************    !
!     RWALL read with hm reader     !
!     **************************    !
C-----------------------------------------------
C     Counting RWALL type
      CALL hm_option_count('/RWALL/PLANE' ,nchplan  )
      CALL hm_option_count('/RWALL/CYL'   ,nchcyl   )
      CALL hm_option_count('/rwall/spher' ,NCHSPHER )
      CALL HM_OPTION_COUNT('/rwall/paral' ,NCHPARAL )
      CALL HM_OPTION_COUNT('/rwall/lagmul',NCHLAGM  )
      CALL HM_OPTION_COUNT('/rwall/therm' ,NCHTHERM )
C     
C     /RWALL/PLANE
      IF (NCHPLAN > 0) THEN 
        CALL HM_READ_RWALL_PLANE(RWL     ,NPRW    ,LPRW    ,IFI     ,MS      ,
     .                           V       ,ITAB    ,ITABM1  ,X       ,IKINE   ,
     .                           IGRNOD  ,MFI     ,IMERGE  ,UNITAB  ,IDDLEVEL,
     .                          LSUBMODEL,RTRANS  ,NOM_OPT ,ITAGND  ,NCHPLAN ,
     .                           K       ,OFFS    ,IKINE1  )
      ENDIF
C
C     /RWALL/CYL
      IF (NCHCYL > 0) THEN
        CALL HM_READ_RWALL_CYL(RWL     ,NPRW    ,LPRW    ,IFI     ,MS      ,
     .                         V       ,ITAB    ,ITABM1  ,X       ,IKINE   ,
     .                         IGRNOD  ,MFI     ,IMERGE  ,UNITAB  ,IDDLEVEL,
     .                        LSUBMODEL,RTRANS  ,NOM_OPT ,ITAGND  ,NCHCYL  ,
     .                         K       ,OFFS    ,IKINE1  )  
      ENDIF
C
C     /RWALL/SPHER
      IF (NCHSPHER > 0) THEN
        CALL HM_READ_RWALL_SPHER(RWL     ,NPRW    ,LPRW    ,IFI     ,MS      ,
     .                           V       ,ITAB    ,ITABM1  ,X       ,IKINE   ,
     .                           IGRNOD  ,MFI     ,IMERGE  ,UNITAB  ,IDDLEVEL,
     .                          LSUBMODEL,RTRANS  ,NOM_OPT ,ITAGND  ,NCHSPHER,
     .                           K       ,OFFS    ,IKINE1  ) 
      ENDIF
C
C     /RWALL/PARAL
      IF (NCHPARAL > 0) THEN
        CALL HM_READ_RWALL_PARAL(RWL     ,NPRW    ,LPRW    ,IFI     ,MS      ,
     .                           V       ,ITAB    ,ITABM1  ,X       ,IKINE   ,
     .                           IGRNOD  ,MFI     ,IMERGE  ,UNITAB  ,IDDLEVEL,
     .                          LSUBMODEL,RTRANS  ,NOM_OPT ,ITAGND  ,NCHPARAL,
     .                           K       ,OFFS    ,IKINE1  ) 
      ENDIF
C
C     /RWALL/LAGMUL
      IF (NCHLAGM > 0) THEN 
        CALL HM_READ_RWALL_LAGMUL(RWL     ,NPRW    ,LPRW    ,IFI     ,MS      ,
     .                            V       ,ITAB    ,ITABM1  ,X       ,IKINE   ,
     .                            IGRNOD  ,MFI     ,IMERGE  ,UNITAB  ,IDDLEVEL,
     .                           LSUBMODEL,RTRANS  ,NOM_OPT ,ITAGND  ,NCHLAGM ,
     .                            K       ,OFFS    ,IKINE1LAG)
      ENDIF
C
C     /RWALL/THERM
      IF (NCHTHERM > 0) THEN 
        CALL HM_READ_RWALL_THERM(RWL      ,NPRW    ,LPRW    ,IFI     ,MS      ,
     .                            V       ,ITAB    ,ITABM1  ,X       ,IKINE   ,
     .                            IGRNOD  ,MFI     ,IMERGE  ,UNITAB  ,IDDLEVEL,
     .                           LSUBMODEL,RTRANS  ,NOM_OPT ,ITAGND  ,NCHTHERM,
     .                            K       ,OFFS    ,IKINE1  ,IXS     ,IXQ     ,
     .                            NPC     )
      ENDIF
C
C-------------------------------------
C Search for double IDs
C-------------------------------------
      CALL UDOUBLE(NOM_OPT,LNOPT1,NRWALL,MESS,0,BID)
      DO N=1,NRWALL
        NSL =  NPRW(N)
        IPEN = NPRW(N+8*NRWALL)
        IF (IPEN > 0) LNSPEN = LNSPEN + NSL + 1 ! stif+leng_m
      END DO
      DEALLOCATE(IKINE1)
      RETURN
 1000 FORMAT(
     . '      rigid wall definitions '/
     . '      ---------------------- '/)