spmd__wiout_8F_source.html

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/.

C

!||====================================================================

!||    spmd_wiout            ../engine/source/mpi/generic/spmd_wiout.F

!||--- called by ------------------------------------------------------

!||    fvstats               ../engine/source/airbag/fvstats.F

!||    fxbypid               ../engine/source/constraints/fxbody/fxbypid.F

!||    lectur                ../engine/source/input/lectur.F

!||    rbypid                ../engine/source/constraints/general/rbody/rbypid.F

!||    resol                 ../engine/source/engine/resol.F

!||    sz_print              ../engine/source/output/restart/arralloc.F

!||--- calls      -----------------------------------------------------

!||--- uses       -----------------------------------------------------

!||    io_mod                ../engine/share/modules/io_mod.F

!||    message_mod           ../engine/share/message_module/message_mod.F

!||    spmd_comm_world_mod   ../engine/source/mpi/spmd_comm_world.F90

!||====================================================================


      SUBROUTINE spmd_wiout(IOUT,IWIOUT)

C ecrit le buffer L01 sur p0

      USE message_mod

      USE io_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"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER IOUT, IWIOUT

C-----------------------------------------------

C   L o c a l  V a r i a b l e s

C-----------------------------------------------

#ifdef MPI

      INTEGER MSGTYP,INFO,LOC_PROC,

     .        BUFSIZ,MSGOFF,SIZ,I,P,LEN,N,II,

     .        IOS,STATUS(MPI_STATUS_SIZE),IERROR,IBLANC,LNEW

      INTEGER, DIMENSION(:),ALLOCATABLE :: IWA


      INTEGER :: NINDX_PROC,SIZE_MESSAGE

            INTEGER, DIMENSION(NSPMD) :: IWIOUT_SPMD

            INTEGER, DIMENSION(NSPMD) :: PROC_RCV,DISPLACEMENT

      INTEGER :: INDX,REQ_S

      INTEGER, DIMENSION(NSPMD) :: REQ_R


      DATA msgoff/105/

      CHARACTER(LEN=NCHAROUT) :: LINE

C-----------------------------------------------

C   S o u r c e  L i n e s

C-----------------------------------------------

C IWIOUT est utilise pour connaitre le nb max de characteres a echanger

      ! MPI comm : every proc sends its IWIOUT_SAVE to the main proc

      iwiout_spmd(1:nspmd) = 0

      CALL mpi_gather( iwiout_save,1,mpi_integer,

     .                 iwiout_spmd,1,mpi_integer,

     .                 0,spmd_comm_world,ierror)


      loc_proc = ispmd + 1

      len = ncharout

      IF(ispmd/=0) ALLOCATE(iwa(iwiout+1))

!   ---------------------------------

!   Main proc : receives the message from other proc and writes the message in the *.out file

      IF(ispmd==0) THEN

        nindx_proc = 0

        size_message = 0

        !   ------------------

        displacement(1:nspmd) = 0

        DO p = 2, nspmd

            IF(iwiout_spmd(p)/=0) THEN

                nindx_proc = nindx_proc + 1

                proc_rcv(nindx_proc) = p

                displacement(nindx_proc) = size_message

                size_message = size_message + iwiout_spmd(p) + 1

            ENDIF

        ENDDO

        ALLOCATE(iwa(size_message))

        !   ------------------

        DO i=1,nindx_proc

          p = proc_rcv(i)

          msgtyp = msgoff

          CALL mpi_irecv(iwa(1+displacement(i)),iwiout_spmd(p)+1,mpi_integer,it_spmd(p),

     .                  msgtyp,spmd_comm_world,req_r(i),ierror)


        ENDDO

        !   ------------------

        DO ii=1,nindx_proc

            CALL mpi_waitany(nindx_proc,req_r,indx,status,ierror)

            p = proc_rcv(indx)

            siz = iwiout_spmd(p)

            DO n = 1, siz, len

C   traitement special pour eliminer les blancs de fin de chaine

                i = len

                iblanc = ichar(' ')

                DO WHILE (iwa(displacement(indx)+n+i)==iblanc.AND.i>1)

                    i = i-1

                ENDDO

                lnew = i

C

                DO i = 1, lnew

                    line(i:i) = char(iwa(displacement(indx)+n+i))

                ENDDO

                WRITE(iout,fmt='(A)')line(1:lnew)

            ENDDO

        ENDDO

        !   ------------------

!   ---------------------------------

      ELSE

!   Secondary proc : sends the message to the main proc

C rewind fait ds check        REWIND(UNIT=IOUT)

        IF(iwiout_save>0) THEN

            ios = 0

            siz = 1

            !   ------------------

            DO WHILE(ios==0)

              READ(unit=iout,iostat=ios,fmt='(A)') line

              IF(ios==0) THEN

                DO i = 1, len

                  iwa(siz+i) = ichar(line(i:i))

                ENDDO

                siz = siz + len

              ENDIF

            ENDDO

            !   ------------------

            iwa(1) = siz-1

            rewind(unit=iout)

            WRITE(unit=iout,iostat=ios,fmt='(A)')

            msgtyp = msgoff

            CALL mpi_isend(iwa   ,siz           ,mpi_integer,it_spmd(1),

     .                    msgtyp,spmd_comm_world,req_s,ierror     )


            CALL mpi_wait(req_s,status,ierror)

            !   ------------------

        ENDIF

      ENDIF

!   ---------------------------------

      DEALLOCATE(iwa)

C


#endif

      RETURN


      END SUBROUTINE spmd_wiout

mpi_isend
subroutine mpi_isend(buf, cnt, datatype, dest, tag, comm, ireq, ierr)
Definition mpi.f:382

mpi_wait
subroutine mpi_wait(ireq, status, ierr)
Definition mpi.f:525

mpi_waitany
subroutine mpi_waitany(cnt, array_of_requests, index, status, ierr)
Definition mpi.f:549

mpi_gather
subroutine mpi_gather(sendbuf, cnt, datatype, recvbuf, reccnt, rectype, root, comm, ierr)
Definition mpi.f:56

mpi_irecv
subroutine mpi_irecv(buf, cnt, datatype, source, tag, comm, ireq, ierr)
Definition mpi.f:372

io_mod
Definition io_mod.F:29

io_mod::iwiout_save
integer iwiout_save
Definition io_mod.F:30

message_mod
Definition message_mod.F:1249

spmd_wiout
subroutine spmd_wiout(iout, iwiout)
Definition spmd_wiout.F:40