parsor0.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/.
!||====================================================================
!||    parsor0            ../engine/source/output/anim/generate/parsor0.F
!||--- called by ------------------------------------------------------
!||    genani             ../engine/source/output/anim/generate/genani.F
!||--- calls      -----------------------------------------------------
!||    spmd_iget_partn    ../engine/source/mpi/anim/spmd_iget_partn.F
!||    spmd_iglob_partn   ../engine/source/mpi/anim/spmd_iglob_partn.F
!||    write_i_c          ../common_source/tools/input_output/write_routines.c
!||====================================================================
      SUBROUTINE parsor0(IADD ,IPARG   ,MATER   ,EL2FA   , 
     2                DD_IAD,IADG               ,
     3                KXSP    ,IPARTSP ,NODGLOB)
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      "sphcom.inc"
#include      "param_c.inc"
#include      "task_c.inc"
#include      "spmd_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
C     REAL
      INTEGER IADD(*),IPARG(NPARG,*),
     .        MATER(*),EL2FA(*),
     .        iadg(nspmd,*),
     .        dd_iad(nspmd+1,*),
     .        kxsp(nisp,*),ipartsp(*),
     .        nodglob(*)
C-----------------------------------------------
C     REAL
      INTEGER II, IE, NG, ITY, LFT, LLT, N, I, 
     .        NEL, IAD, NPAR, NFT, IPRT,
     . nn1,nn2,
     .        jj, inod,
     .        np(numsph),buf,bufp
C-----------------------------------------------
C
      nn1 = 1
      nn2 = nn1 + numsph+maxpjet
      ie = 0
C-----------------------------------------------
C     MID
C-----------------------------------------------
      npar = 0
      jj = 0
C
      DO 100 iprt = 1 , npart
C
       IF(mater(iprt)/=4) GOTO 100
       npar = npar + 1
       DO 90 ng=1,ngroup
        nel   =iparg(2,ng)
        nft   =iparg(3,ng)
        iad   =iparg(4,ng)
        ity   =iparg(5,ng)
        lft=1
        llt=nel
        IF(ity==51)THEN
C-----------------------------------------------
C         PARTICULES SPH.
C-----------------------------------------------
          DO 20 i=lft,llt
           n = i + nft
           IF(ipartsp(n)/=iprt) GOTO 20
             inod=kxsp(3,n)
             IF (nspmd == 1) THEN 
               ii = inod-1
               CALL write_i_c(ii,1)
             ELSE
               np(jj+1) = nodglob(inod)-1
             END IF
             jj = jj+1
             ie = ie + 1
             el2fa(nn1+n) = ie
 20      CONTINUE
        ELSE
        ENDIF
 90    CONTINUE
C-----------------------------------------------
C       PART ADRESS
C-----------------------------------------------
       iadd(npar) = ie
 100  CONTINUE
C
      IF (nspmd > 1) THEN
        IF (ispmd==0) THEN
          bufp = npart
          buf = numsphg
        ELSE
          bufp = 1
          buf=1
        END IF
 
          CALL spmd_iglob_partn(iadd,npar,iadg,bufp)
          CALL spmd_iget_partn(1,jj,np,npar,iadg,buf,1)
      ELSE ! IADG filling for mono/multi compatibility
        DO i = 1, npart
          iadg(1,i) = iadd(i)
        END DO
      ENDIF
C-----------------------------------------------
      RETURN
      END