r2r_check.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	r2r_check (iexter, igrnod, ipartl)

Function/Subroutine Documentation

r2r_check()

subroutine r2r_check	(	integer, dimension(nr2r,*)	iexter,
		type (group_), dimension(ngrnod)	igrnod,
		integer, dimension(lipart1,*)	ipartl )

Definition at line 35 of file r2r_check.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE groupdef_mod
        USE message_mod
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE restmod
        USE r2r_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      "scr17_c.inc"
#include      "param_c.inc"
#include      "r2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER IEXTER(NR2R,*),IPARTL(LIPART1,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER STAT,I,IGR,IGRS,N,K,ADD
        CHARACTER MESS*40
        INTEGER, DIMENSION(:), ALLOCATABLE :: TAGPART
C-----------------------------------------------
        TYPE (GROUP_)  ,DIMENSION(NGRNOD)  :: IGRNOD
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
        INTEGER GRFIND
C
        DATA mess/' ** ERROR EXTERNAL COUPLING DEFINITION '/
 
C----- Check if Id of subdomains-----------------------------------C
 
        IF (nsubdom>0) THEN
          DO n=1,nsubdom-1
            igr = isubdom(2,n)
            DO i=n+1,nsubdom
              IF (igr==isubdom(2,i)) THEN
                CALL ancmsg(msgid=792,
     .                    msgtype=msgerror,
     .                    anmode=aninfo,
     .                    i1=igr)
                ierr=ierr+1
              ENDIF
            END DO
          END DO
        ENDIF
 
C----- Check of parts of subdomains-------------------------------C
 
        ALLOCATE(tagpart(npart))
        tagpart = 0
 
        DO n=1,nsubdom
          add = isubdom(3,n)
          DO k=1,npart
            DO i=1,isubdom(1,n)
              IF(k == isubdom_part(i+add))THEN
                tagpart(k)=tagpart(k)+1
                IF (tagpart(k)>1) THEN
                  CALL ancmsg(msgid=827,
     .                        msgtype=msgerror,
     .                        anmode=aninfo,i1=isubdom(1,n),
     .                        i2=ipart(lipart1*(k-1)+4))
                  ierr=ierr+1
                ENDIF
              ENDIF
            ENDDO
          END DO
        END DO
 
C----- Check of common nodes between interfaces---------------------C
 
!        DO N=1,NR2RLNK-1
!     DO I=N+1,NR2RLNK
C                 CALL ANSTCKI(22)
C                 CALL ANSTCKI(9)
C                 CALL ANSTCKI(8)
C               CALL ANCERR(792,ANINFO)
C     IERR=IERR+1
!     END DO
!  END DO
 
C----- Check of multidomains node groups-----------------------------C
 
        DO n=1,nr2rlnk
          igr = iexter(1,n)
          igrs = grfind(igr,igrnod,mess)
          iexter(1,n) = igrs
          IF (igrs==0) ierr=ierr+1
        END DO
 
C--------------------------------------------------------------------C
 
        RETURN