checkrby.F File Reference

#include "implicit_f.inc"
#include "analyse_name.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "scr03_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	checkrby (rby, npby, lpby, itab, ikine, iddlevel, nom_opt, numsl)

Function/Subroutine Documentation

checkrby()

subroutine checkrby	(		rby,
		integer, dimension(nnpby,*)	npby,
		integer, dimension(*)	lpby,
		integer, dimension(*)	itab,
		integer, dimension(*)	ikine,
		integer	iddlevel,
		integer, dimension(lnopt1,*)	nom_opt,
		integer	numsl )

Definition at line 35 of file checkrby.F.

C-------------------------------------
C     LECTURE STRUCTURE RIGIDES IFORM8=2
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   A n a l y s e   M o d u l e
C-----------------------------------------------
#include      "analyse_name.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "scr17_c.inc"
#include      "scr03_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NPBY(NNPBY,*), LPBY(*), ITAB(*)
      INTEGER IKINE(*), IDDLEVEL, NUMSL
      my_real rby(nrby,*)
      INTEGER NOM_OPT(LNOPT1,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,L,K,KK,M,N,NSL,NSKEW,IC,
     .   ISPHER,IDIR,P,IG,ID,ICDG,NSL_XTRA,
     .   NRB,NUMSL_TMP
      CHARACTER(LEN=NCHARTITLE)::TITR
      INTEGER, DIMENSION(:,:), ALLOCATABLE :: TABSL
      INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX,IKINE1
      INTEGER IWORK(70000),IOLD
      INTEGER IFLAGI1,IFLAGDBL,IRB
C-----------------------------------
C   NPBY( 1,N) = main NODE
C   NPBY( 2,N) = NUMBER OF SECND NODES
C   NPBY( 3,N) = ICDG
C   NPBY( 4,N) = ISENS gw117
C   NPBY( 5,N) = FLAG SPHERICAL INERTIA
C   NPBY( 6,N) = IDENTIFICATEUR
C   NPBY( 7,N) = 1 ON(1) OFF(0)
C   NPBY( 8,N) = ISU
C   NPBY( 9,N) = NSKEW
C   NPBY(10,N) = IEXPAMS (AMS - Hidden)
C                 = 1 (default) : AMS expansion ; = 2 (Hidden) : No expansion
C   NPBY(11,N) = IAD => secnd nodes LPBY(IAD+1:IAD+NSN)
C   NPBY(12,N) = RBODY LEVEL
C   NPBY(13,N) = RBODY IFLAG
C   NPBY(14,N) = NUMBER OF XTRA_NODE with Iflag=1
C   NPBY(15,N) = NUMBER OF XTRA_NODE with Iflag=2
C   NPBY(16,N) = NUMBER OF XTRA_NODE with Iflag=3
C=======================================================================
      IF (numsl > 0) THEN
        ALLOCATE(tabsl(2,numsl))
        ALLOCATE(index(3*numsl))
        tabsl=0
        index=0
      END IF
      n=0
      k=0
      kk=0
      nrb = 0
C
      ALLOCATE(ikine1(3*numnod))
      DO i=1,3*numnod
        ikine1(i) = 0
      ENDDO
C
      DO n=1,nrbykin
        nsl=npby(2,n)
        nsl_xtra=npby(14,n)+npby(15,n)+npby(16,n)
        ispher = npby(5,n)
        icdg = npby(3,n)
        id=nom_opt(1,n)
c
        DO j=1,nsl-nsl_xtra
          CALL anodset(lpby(j+k), check_rb_s)
          tabsl(1,j+kk)=itab(lpby(j+k))
          tabsl(2,j+kk)=n
        ENDDO
C
        IF(iddlevel==0)THEN
         IF(ikrem == 0)THEN
          DO j=1,nsl
           DO idir=1,6
             CALL kinset(8,itab(lpby(j+k)),ikine(lpby(j+k)),idir,0,
     .                   ikine1(lpby(j+k)))
           ENDDO
          ENDDO
         ELSE
          DO j=1,nsl
           DO idir=1,6
             CALL kinset(128,itab(lpby(j+k)),ikine(lpby(j+k)),idir,0,
     .                   ikine1(lpby(j+k)))
           ENDDO
          ENDDO
         ENDIF
        ENDIF
C
        k=k+nsl
        kk=kk+nsl-nsl_xtra
      ENDDO
      numsl_tmp=kk
C-------------------------------------
C Bilan secnd nodes doubles (sans les XTRA_NODES qui sont teste avant)
C-------------------------------------
      IF (nrbykin > 1) THEN
      iwork=0
      iflagdbl=0
      DO i=1,numsl_tmp
        index(i)=i
      END DO
      CALL my_orders(0,iwork,tabsl,index,numsl_tmp,2)
      IF (numsl_tmp > 0) THEN
        iold=-1
        DO i=1,numsl_tmp
        IF (tabsl(1,index(i))==iold) THEN
          IF (iflagdbl==0) THEN
            iflagi1=i-1
          END IF
          iflagdbl=1
        ELSE
          IF (iflagdbl/=0) THEN
            DO j=iflagi1,i-1
              irb=tabsl(2,index(j))
              id=nom_opt(1,irb)
              CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,irb),ltitr)
              CALL ancmsg(msgid=1026,
     .                    msgtype=msgwarning,
     .                    anmode=aninfo_blind_2,
     .                    i1=id,
     .                    c1=titr,
     .                    prmod=msg_cumu)
            END DO
            CALL ancmsg(msgid=1026,
     .                  msgtype=msgwarning,
     .                  anmode=aninfo_blind_1,
     .                  i1=tabsl(1,index(iflagi1)),
     .                  prmod=msg_print)
            iflagdbl=0
          END IF
        END IF
        iold=tabsl(1,index(i))     
        END DO
      END IF
      END IF
C
C------------------------------------
      IF(ALLOCATED(tabsl))DEALLOCATE(tabsl)
      IF(ALLOCATED(index))DEALLOCATE(index)
      IF(ALLOCATED(ikine1)) DEALLOCATE(ikine1)
C------------------------------------
      RETURN
C