r2r_domdec.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	r2r_domdec (iexter, igrnod, frontb_r2r, dt_r2r, flag)

Function/Subroutine Documentation

r2r_domdec()

subroutine r2r_domdec	(	integer, dimension(nr2r,*)	iexter,
		type (group_), dimension(ngrnod)	igrnod,
		integer, dimension(sfrontb_r2r,*)	frontb_r2r,
			dt_r2r,
		integer	flag )

Definition at line 38 of file r2r_domdec.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE restmod
        USE message_mod
        USE r2r_mod
        USE groupdef_mod
        USE inoutfile_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      "com01_c.inc"
#include      "com04_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,*),FLAG,FRONTB_R2R(SFRONTB_R2R,*)
        my_real
     .     dt_r2r(4,*)
        TYPE (GROUP_)  , DIMENSION(NGRNOD)   :: IGRNOD
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER REF,I,J,K,L,IDG,NJ,NJS,ERR,DOMLEN,FL_EXIT,SPLIST
        CHARACTER NAM*150,CHRUN*4,MESS*40
        INTEGER, DIMENSION(:), ALLOCATABLE :: PLIST
C-----------------------------------------------
 
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
        INTEGER USR2SYS
        INTEGER NLOCAL
        INTEGER :: LEN_TMP_NAME
        CHARACTER(len=4096) :: TMP_NAME
C-----------------------------------------------
 
        ref = 991982
 
        WRITE(chrun,'(I4.4)') irun
        IF (ipid==0) THEN
          nam = trim(dom_name)//'_'//chrun//'.domdec'
          domlen = len_trim(dom_name)+12
        ELSE
C-----------only 1 subdomain
          nam=dom_name(isubdom(8,1):isubdom(8,1)+
     .                 isubdom(7,1)-1)//'_'//chrun//'.domdec'
          domlen = isubdom(7,1)+12
        ENDIF
 
        tmp_name=outfile_name(1:outfile_name_len)//nam(1:len_trim(nam))
        len_tmp_name = outfile_name_len+len_trim(nam)
        OPEN(unit=ref,file=tmp_name(1:len_tmp_name),
     .        access='SEQUENTIAL',form='FORMATTED',status='UNKNOWN')
 
        IF (flag == 1) THEN
C-------------------------------------
          ALLOCATE(plist(nspmd))
          plist(1:nspmd) = -1
C------ Information for FSI
          WRITE(ref,1303,iostat=err) flg_fsi
C------ Information for speedup computation
          DO i=1,4
            WRITE(ref,1304,iostat=err) dt_r2r(i,1)
          END DO
C------
          DO i=1,nr2rlnk
            idg = iexter(1,i)
C--  70 -> nlocal link - nodes already defined in link type 4
            IF (iexter(5,i) /= 70) THEN
              DO j=1,igrnod(idg)%NENTITY
                nj = igrnod(idg)%ENTITY(j)
                fl_exit = 0
                splist=0
                CALL plist_ifront(plist,nj,splist)
C
                WRITE(ref,1302,iostat=err) itab(nj),splist
                DO l=1,splist
                  k = plist(l)
                  WRITE(ref,1303,iostat=err) (k)
                  IF (err/=0) THEN
                    CALL ancmsg(msgid=950,
     .              msgtype=msgerror,
     .              anmode=aninfo_blind_1)
                    fl_exit = 1
                    EXIT
                  ENDIF
                ENDDO
                IF (fl_exit==1) EXIT
              END DO
            ENDIF
          END DO
C
          CLOSE(unit=ref,status='KEEP')
          DEALLOCATE(plist)
 
        ELSEIF (flag == 0) THEN
C------ Information for FSI
          READ(ref,1303,iostat=err) flg_fsi
C------ Information for speedup computation
          DO i=1,4
            READ(ref,1304,iostat=err) dt_r2r(i,1)
          END DO
C
          DO i=1,nr2rlnk
            idg = iexter(1,i)
C--  70 -> nlocal link - nodes already defined in link type 4
            IF (iexter(5,i) /= 70) THEN
              DO j=1,igrnod(idg)%NENTITY
                fl_exit = 0
                READ(ref,1302,iostat=err) njs,splist
                nj = usr2sys(njs,itabm1,mess,0)
                DO k=1,nspmd
                  frontb_r2r(nj,k) = idg
                END DO
                DO l=1,splist
                  READ(ref,1303,iostat=err) k
                  IF (err/=0) THEN
                    CALL ancmsg(msgid=950,
     .              msgtype=msgerror,
     .              anmode=aninfo_blind_1)
                    fl_exit = 1
                    EXIT
                  ENDIF
                  frontb_r2r(nj,k) = -1
                  IF (nlocal(nj,k)/=1) CALL ifrontplus(nj,k)
                ENDDO
                IF (fl_exit==1) EXIT
              END DO
            ELSE
              DO j=1,igrnod(idg)%NENTITY
                nj = igrnod(idg)%ENTITY(j)
                DO k=1,nspmd
                  IF (frontb_r2r(nj,k) > 0) frontb_r2r(nj,k) = frontb_r2r(nj,k) + ngrnod*idg
                END DO
              END DO
            ENDIF
          END DO
          CLOSE(unit=ref,status='KEEP')
 
        ELSE
C------------------------------------
          CLOSE(unit=ref,status='DELETE')
 
C-------------------------------------
        ENDIF
 
C--------------------------------------------------------------C
        RETURN
 
1302    FORMAT( 1x,i20,i9)
1303    FORMAT( 1x,i9)
1304    FORMAT( 1x,e9.4)
 
C--------------------------------------------------------------C
 
        RETURN
 
C-----------
 
        RETURN