lagm_ini.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	lagm_ini (nhf, iadhf, iadll, jll, lll, ipari, intbuf_tab, igrnod, ibcslag, mass, iner, gjbufi, ibufnc, ibufnn, ibufdl, ibufsk, ibfv, vel, itab, nom_opt, ptr_nopt_inter, ptr_nopt_fxv, ptr_nopt_bcs, ptr_nopt_mpc, ptr_nopt_gjoint)

Function/Subroutine Documentation

lagm_ini()

subroutine lagm_ini	(	integer	nhf,
		integer, dimension(*)	iadhf,
		integer, dimension(*)	iadll,
		integer, dimension(*)	jll,
		integer, dimension(*)	lll,
		integer, dimension(npari,ninter)	ipari,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		type (group_), dimension(ngrnod)	igrnod,
		integer, dimension(5,*)	ibcslag,
			mass,
			iner,
		integer, dimension(lkjni,*)	gjbufi,
		integer, dimension(*)	ibufnc,
		integer, dimension(*)	ibufnn,
		integer, dimension(*)	ibufdl,
		integer, dimension(*)	ibufsk,
		integer, dimension(nifv,*)	ibfv,
			vel,
		integer, dimension(*)	itab,
		integer, dimension(lnopt1,*)	nom_opt,
		integer	ptr_nopt_inter,
		integer	ptr_nopt_fxv,
		integer	ptr_nopt_bcs,
		integer	ptr_nopt_mpc,
		integer	ptr_nopt_gjoint )

Definition at line 37 of file lagm_ini.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE intbufdef_mod
      USE groupdef_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      "param_c.inc"
#include      "com04_c.inc"
#include      "lagmult.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NHF
      INTEGER IADHF(*), IADLL(*), JLL(*), LLL(*),
     .        IPARI(NPARI,NINTER),IBCSLAG(5,*),
     .        GJBUFI(LKJNI,*),IBFV(NIFV,*),
     .        IBUFNC(*),IBUFNN(*),IBUFDL(*),IBUFSK(*),ITAB(*)
      my_real
     .        vel(lfxvelr,*),mass(*),iner(*)
      INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_INTER,PTR_NOPT_FXV,
     .        PTR_NOPT_BCS,PTR_NOPT_MPC,PTR_NOPT_GJOINT
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: LTSM
      INTEGER IC, IK, J, JC, NCF, HIJ, ERR
C======================================================================|
      ALLOCATE(ltsm(6,numnod),  stat=err)
      IF (err /= 0) THEN
        CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,
     .                         c1='LTSM')
      ENDIF
      ncf      = 0
      ltsm     = 0
      nhf      = 1
      iadll(1) = 1
      iadhf(1) = 1
c---
      IF (nbcslag > 0)
     .  CALL lgmini_bc(iadll  ,jll    ,lll   ,igrnod   ,ibcslag,
     .                 mass   ,iner   ,ncf   ,nom_opt(1,ptr_nopt_bcs+1))
      CALL lgmini_i2(iadll  ,jll    ,lll    ,intbuf_tab  ,ipari  ,ncf,
     .               mass, itab    ,nom_opt(1,ptr_nopt_inter+1))
      IF (ngjoint > 0)
     .  CALL lgmini_gj (iadll  ,jll    ,lll    ,gjbufi ,ncf, mass,
     .                  iner, itab    ,nom_opt(1,ptr_nopt_gjoint+1))
      IF (nummpc > 0)
     .  CALL lgmini_mpc(iadll  ,jll    ,lll    ,ibufnc ,ibufnn ,
     .                  ibufdl ,ibufsk ,ncf, mass, iner, itab    ,
     .                  nom_opt(1,ptr_nopt_mpc+1))
      IF (nfvlag > 0)
     .  CALL lgmini_fxv(iadll  ,jll    ,lll    ,ibfv   ,vel    ,
     .                  ncf, mass, iner, itab,nom_opt(1,ptr_nopt_fxv+1))
c---
      DO ic=1,ncf
        DO ik=iadll(ic),iadll(ic+1)-1
          ltsm(jll(ik),lll(ik)) = 1
        ENDDO
        DO jc=ic+1,ncf
          hij = 0
          DO ik=iadll(jc),iadll(jc+1)-1
            hij = hij + ltsm(jll(ik),lll(ik))
          ENDDO
          IF (hij > 0) nhf = nhf + 1
        ENDDO
        iadhf(ic+1) = nhf
        DO ik=iadll(ic),iadll(ic+1)-1
          ltsm(jll(ik),lll(ik)) = 0
        ENDDO
      ENDDO
      nhf = nhf-1
      IF (ALLOCATED(ltsm)) DEALLOCATE(ltsm)
C-----------
      RETURN