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)

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 )

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
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,*)
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
      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 Recherche des ID doubles
C-------------------------------------
      CALL udouble(nom_opt,lnopt1,nrwall,mess,0,bid)
      DEALLOCATE(ikine1)
      RETURN
 1000 FORMAT(
     . '      RIGID WALL DEFINITIONS '/
     . '      ---------------------- '/)