OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsor0.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "sphcom.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine parsor0 (iadd, iparg, mater, el2fa, dd_iad, iadg, kxsp, ipartsp, nodglob)

Function/Subroutine Documentation

◆ parsor0()

subroutine parsor0 ( integer, dimension(*) iadd,
integer, dimension(nparg,*) iparg,
integer, dimension(*) mater,
integer, dimension(*) el2fa,
integer, dimension(nspmd+1,*) dd_iad,
integer, dimension(nspmd,*) iadg,
integer, dimension(nisp,*) kxsp,
integer, dimension(*) ipartsp,
integer, dimension(*) nodglob )

Definition at line 32 of file parsor0.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "com01_c.inc"
43#include "com04_c.inc"
44#include "sphcom.inc"
45#include "param_c.inc"
46#include "task_c.inc"
47#include "spmd_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51C REAL
52 INTEGER IADD(*),IPARG(NPARG,*),
53 . MATER(*),EL2FA(*),
54 . IADG(NSPMD,*),
55 . DD_IAD(NSPMD+1,*),
56 . KXSP(NISP,*),IPARTSP(*),
57 . NODGLOB(*)
58C-----------------------------------------------
59C REAL
60 INTEGER II, IE, NG, ITY, LFT, LLT, N, I,
61 . NEL, IAD, NPAR, NFT, IPRT,
62 . NN1,NN2,
63 . JJ, INOD,
64 . NP(NUMSPH),BUF,BUFP
65C-----------------------------------------------
66C
67 nn1 = 1
68 nn2 = nn1 + numsph+maxpjet
69 ie = 0
70C-----------------------------------------------
71C MID
72C-----------------------------------------------
73 npar = 0
74 jj = 0
75C
76 DO 100 iprt = 1 , npart
77C
78 IF(mater(iprt)/=4) GOTO 100
79 npar = npar + 1
80 DO 90 ng=1,ngroup
81 nel =iparg(2,ng)
82 nft =iparg(3,ng)
83 iad =iparg(4,ng)
84 ity =iparg(5,ng)
85 lft=1
86 llt=nel
87 IF(ity==51)THEN
88C-----------------------------------------------
89C PARTICULES SPH.
90C-----------------------------------------------
91 DO 20 i=lft,llt
92 n = i + nft
93 IF(ipartsp(n)/=iprt) GOTO 20
94 inod=kxsp(3,n)
95 IF (nspmd == 1) THEN
96 ii = inod-1
97 CALL write_i_c(ii,1)
98 ELSE
99 np(jj+1) = nodglob(inod)-1
100 END IF
101 jj = jj+1
102 ie = ie + 1
103 el2fa(nn1+n) = ie
104 20 CONTINUE
105 ELSE
106 ENDIF
107 90 CONTINUE
108C-----------------------------------------------
109C PART ADRESS
110C-----------------------------------------------
111 iadd(npar) = ie
112 100 CONTINUE
113C
114 IF (nspmd > 1) THEN
115 IF (ispmd==0) THEN
116 bufp = npart
117 buf = numsphg
118 ELSE
119 bufp = 1
120 buf=1
121 END IF
122
123 CALL spmd_iglob_partn(iadd,npar,iadg,bufp)
124 CALL spmd_iget_partn(1,jj,np,npar,iadg,buf,1)
125 ELSE ! IADG filling for mono/multi compatibility
126 DO i = 1, npart
127 iadg(1,i) = iadd(i)
128 END DO
129 ENDIF
130C-----------------------------------------------
131 RETURN
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
subroutine spmd_iglob_partn(iad, nbpart, iadg, sbuf)
void write_i_c(int *w, int *len)