aniskewf.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	aniskewf (geo, skew, iparg, ixr, dd_iad, lrbuf)
subroutine	cntskew (iparg, cnt, cntg)

Function/Subroutine Documentation

aniskewf()

subroutine aniskewf	(		geo,
			skew,
		integer, dimension(nparg,*)	iparg,
		integer, dimension(nixr,*)	ixr,
		integer, dimension(nspmd+1,*)	dd_iad,
		integer	lrbuf )

Definition at line 35 of file aniskewf.F.

      use element_mod , only : nixr
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
      my_real
     .   geo(npropg,*), skew(lskew,*)
      INTEGER IXR(NIXR,*),IPARG(NPARG,*),LRBUF,
     .        DD_IAD(NSPMD+1,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ISK,
     .   NEL,LFT,LLT,NG,
     .   ITY,IAD,MLW,NFT,N,II,ISKK,MSGTAG,LEN,IGTYP
      INTEGER SRBUF(LRBUF)
      INTEGER, PARAMETER :: INTSIZE = 4
c
C-----------------------------------------------
C      SKEW
C-----------------------------------------------
      isk=numskw-1
C   spmd
        ii = 0
C   problem on ISK: incremented by for all elements!
        msgtag = 1000
        IF (nspmd > 1 .AND. ispmd/=0) THEN
 
          CALL rad_spmd_recv(isk,intsize,ispmd-1,
     .                       it_spmd,msgtag+ispmd,intsize)
 
        ENDIF
C-----------------------------------------------
C      SKEW ELEMENT 1D
C-----------------------------------------------
C
      DO ng=1,ngroup
        mlw   =iparg(1,ng)
        nel   =iparg(2,ng)
        ity   =iparg(5,ng)
        nft   =iparg(3,ng)
        iad   =iparg(4,ng)
        igtyp   =iparg(38,ng)
        lft = 1
        llt = nel
C-----------------------------------------------
C      TRUSS
C-----------------------------------------------
        IF(ity==4)THEN
            DO i=lft,llt
              isk=isk+1
              ii = ii + 1
              srbuf(ii) = isk
            ENDDO
C-----------------------------------------------
C       POUTRES
C-----------------------------------------------
        ELSEIF(ity==5)THEN
            DO i=lft,llt
              isk=isk+1
              ii = ii + 1
              srbuf(ii) = isk
            ENDDO
C-----------------------------------------------
C       RESSORTS
C-----------------------------------------------
        ELSEIF(ity==6)THEN
          IF(mlw==1.OR.mlw==7)THEN
            DO i=lft,llt
              isk=isk+1
              ii = ii + 1
              srbuf(ii) = isk
            ENDDO
          ELSEIF(mlw==2)THEN
            DO i=lft,llt
              n=i+nft
              iskk=nint(geo(2,ixr(1,n)))-1
              ii = ii + 1
              srbuf(ii) = iskk
            ENDDO
          ELSEIF(mlw==3)THEN
            DO i=lft,llt
              isk=isk+1
              ii = ii + 1
              srbuf(ii) = isk
              isk=isk+1
              ii = ii + 1
              srbuf(ii) = isk
            ENDDO
          ELSEIF((mlw >= 4 .AND. mlw <= 6 ) .OR. igtyp == 23)THEN
            DO i=lft,llt
              isk=isk+1
              ii = ii + 1
              srbuf(ii) = isk
            ENDDO
          ENDIF
        ELSE
        ENDIF
      ENDDO
 
      IF (nspmd > 1) THEN
        IF (ispmd/=nspmd-1) THEN
          CALL rad_spmd_send(isk,intsize,ispmd+1,
     .                       it_spmd,msgtag+ispmd+1,intsize)
        ENDIF
 
        CALL spmd_igath(srbuf,ii,len)
      ELSE
        len = ii
      END IF
      IF (ispmd==0) THEN
        CALL write_i_c(srbuf,len)
      ENDIF
C      ENDIF
 
C
      RETURN

cntskew()

subroutine cntskew	(	integer, dimension(nparg,*)	iparg,
		integer	cnt,
		integer	cntg )

Definition at line 173 of file aniskewf.F.

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      "com01_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
       INTEGER IPARG(NPARG,*),CNT,CNTG
 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
       INTEGER NG,MLW,NEL,ITY
       cnt = 0
       DO ng=1,ngroup
         mlw   =iparg(1,ng)
         nel   =iparg(2,ng)
         ity   =iparg(5,ng)
 
         IF (ity==4.OR.ity==5.OR.ity==6) THEN
           IF (mlw==3) THEN
            cnt=cnt+2*nel
           ELSE
            cnt = cnt+nel
           ENDIF
         ENDIF
       ENDDO
 
       cntg = cnt
       IF (nspmd > 1) CALL spmd_glob_isum9(cntg,1)