r2r_domdec.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    r2r_domdec      ../starter/source/coupling/rad2rad/r2r_domdec.F
!||--- called by ------------------------------------------------------
!||    lectur          ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg          ../starter/source/output/message/message.F
!||    ifrontplus      ../starter/source/spmd/node/frontplus.F
!||    nlocal          ../starter/source/spmd/node/ddtools.F
!||    plist_ifront    ../starter/source/spmd/node/ddtools.F
!||    usr2sys         ../starter/source/system/sysfus.F
!||--- uses       -----------------------------------------------------
!||    message_mod     ../starter/share/message_module/message_mod.F
!||    r2r_mod         ../starter/share/modules1/r2r_mod.F
!||    restmod         ../starter/share/modules1/restart_mod.F
!||====================================================================
      SUBROUTINE r2r_domdec(IEXTER,IGRNOD,FRONTB_R2R,DT_R2R,FLAG)
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
      END SUBROUTINE r2r_domdec