spmd_collect_nlocal.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/.
!||====================================================================
!||    spmd_collect_nlocal   ../engine/source/mpi/output/spmd_collect_nlocal.F
!||--- called by ------------------------------------------------------
!||    resol                 ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||    debug_mod             ../engine/share/modules/debug_mod.F
!||    inoutfile_mod         ../common_source/modules/inoutfile_mod.F
!||    nlocal_reg_mod        ../common_source/modules/nlocal_reg_mod.F
!||    spmd_comm_world_mod   ../engine/source/mpi/spmd_comm_world.F90
!||====================================================================
      SUBROUTINE spmd_collect_nlocal(A      ,SIZEA   ,NUMNOD_LOCAL,
     .                               POSI   ,NLOC_DMG,SIZP0       ,
     .                               NODGLOB,ITAB    )
 
      USE inoutfile_mod
      USE debug_mod
      USE nlocal_reg_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
        USE spmd_comm_world_mod, ONLY : spmd_comm_world
#include      "implicit_f.inc"
C-----------------------------------------------------------------
C   M e s s a g e   P a s s i n g
C-----------------------------------------------
#include "spmd.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "task_c.inc"
#include      "spmd_c.inc"
#include      "chara_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ITAB(*),NUMNOD_LOCAL,NODGLOB(*)
      INTEGER NPOS,SIZP0
      INTEGER MSGOFF,MSGOFF0,MSGTYP,I,K,N,
     .        empl,sdnodg(numnodm),filen 
      double precision
     .        aglob(2,numnodm),recglob(2,sizp0) 
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER POSI(*)
      INTEGER SIZEA
      my_real 
     .   a(sizea)
      TYPE(nlocal_str_), TARGET                  :: NLOC_DMG 
      CHARACTER FILNAM*100,CYCLENUM*7
 
      INTEGER :: LEN_TMP_NAME
      CHARACTER(len=2148) :: TMP_NAME
 
#ifdef MPI 
      INTEGER STATUS(MPI_STATUS_SIZE),IERROR
 
      DATA msgoff0/176/
      DATA msgoff/177/
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
      recglob(1:2,1:sizp0) = -1
      IF (ispmd/=0) THEN
      n=0
      DO i = 1,numnod_local
        npos = posi(i)                              ! Position of its first d.o.f in A
        
        n=n+1
        sdnodg(n) = nodglob(nloc_dmg%INDX(i))
        aglob(1,n) = itab( nloc_dmg%INDX(i) )
        aglob(2,n) = a(npos)
      ENDDO
 
 
        msgtyp=msgoff0
        CALL mpi_send(sdnodg,n,mpi_integer,
     .                it_spmd(1),msgtyp,
     .                spmd_comm_world,ierror)
        msgtyp=msgoff
        CALL mpi_send(aglob,2*n,mpi_double_precision,
     .                it_spmd(1),msgtyp,
     .                spmd_comm_world,ierror)
      ELSE
 
        DO k=2,nspmd
            msgtyp=msgoff0
            CALL mpi_recv(sdnodg,numnodm,mpi_integer,
     .                    it_spmd(k),msgtyp,
     .                    spmd_comm_world,status,ierror)
 
            CALL mpi_get_count(status,mpi_integer,n,ierror)
 
            msgtyp=msgoff
            CALL mpi_recv(aglob,2*n,mpi_double_precision,
     .                    it_spmd(k),msgtyp,
     .                    spmd_comm_world,status,ierror)
 
 
            DO i=1,n
                empl = sdnodg(i)
                recglob(1,empl) = aglob(1,i)
                recglob(2,empl) = aglob(2,i)
            ENDDO
        END DO
      ENDIF
#endif
C
 
        IF(ispmd==0) THEN
            WRITE(cyclenum,'(I7.7)')ncycle
            filnam=rootnam(1:rootlen)//'_NLOCAL_'//chrun//'_'//cyclenum//'.adb'
 
            len_tmp_name = outfile_name_len + len_trim(filnam)
            tmp_name=outfile_name(1:outfile_name_len)//filnam(1:len_trim(filnam)) 
       
            OPEN(unit=idbg5,file=tmp_name(1:len_tmp_name),access='SEQUENTIAL',
     .                  form='FORMATTED',status='UNKNOWN')
 
            filen = rootlen+17
 
            DO i=1,numnod_local
                npos = posi(i)                              ! Position of its first d.o.f in A
                n =  nodglob(nloc_dmg%INDX(i))
                recglob(1,n) = itab( nloc_dmg%INDX(i) )
                recglob(2,n) = a(npos)
            ENDDO
 
        
            DO i = 1, numnodg
                IF(nint(recglob(1,i))/=-1) THEN
                    WRITE(idbg5,'(A,I10,I10,Z20)' ) '>',ncycle,nint(recglob(1,i)),recglob(2,i)
                ENDIF
            END DO
            WRITE (iout,1300)  filnam(1:filen)
            WRITE (istdo,1300) filnam(1:filen)
            CLOSE(unit=idbg5)
 
      END IF
C
 1300   FORMAT (4x,' DEBUG ANALYSIS NLOCAL FILE :',1x,a,' WRITTEN')
      RETURN
      END SUBROUTINE spmd_collect_nlocal