OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zfac_mem_alloc_cb.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine zmumps_alloc_cb (inplace, min_space_in_place, ssarbr, process_bande, myid, n, keep, keep8, dkeep, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, slavef, procnode_steps, dad, ptrist, ptrast, step, pimaster, pamaster, lreq, lreqcb, node_arg, state_arg, set_header, comp, lrlus, lrlusm, iflag, ierror)

Function/Subroutine Documentation

◆ zmumps_alloc_cb()

subroutine zmumps_alloc_cb ( logical inplace,
integer(8) min_space_in_place,
logical ssarbr,
logical process_bande,
integer myid,
integer n,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230) dkeep,
integer, dimension(liw) iw,
integer liw,
complex(kind=8), dimension(la) a,
integer(8) la,
integer(8) lrlu,
integer(8) iptrlu,
integer iwpos,
integer iwposcb,
integer, intent(in) slavef,
integer, dimension(keep(28)), intent(in) procnode_steps,
integer, dimension(keep(28)), intent(in) dad,
integer, dimension(keep(28)) ptrist,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer lreq,
integer(8) lreqcb,
integer node_arg,
integer state_arg,
logical set_header,
integer comp,
integer(8) lrlus,
integer(8) lrlusm,
integer iflag,
integer ierror )

Definition at line 14 of file zfac_mem_alloc_cb.F.

23!$ USE OMP_LIB
24 USE zmumps_load
25 IMPLICIT NONE
26 INTEGER N,LIW, KEEP(500)
27 INTEGER(8) LA, LRLU, IPTRLU, LRLUS, LRLUSM, LREQCB
28 INTEGER(8) PAMASTER(KEEP(28)), PTRAST(KEEP(28))
29 INTEGER IWPOS,IWPOSCB
30 INTEGER(8) :: MIN_SPACE_IN_PLACE
31 INTEGER NODE_ARG, STATE_ARG
32 INTEGER(8) KEEP8(150)
33 DOUBLE PRECISION DKEEP(230)
34 INTEGER IW(LIW),PTRIST(KEEP(28))
35 INTEGER STEP(N), PIMASTER(KEEP(28))
36 INTEGER, INTENT(IN) :: SLAVEF
37 INTEGER, INTENT(IN) :: PROCNODE_STEPS(KEEP(28)), DAD(KEEP(28))
38 INTEGER MYID, IXXP
39 COMPLEX(kind=8) A(LA)
40 LOGICAL INPLACE, PROCESS_BANDE, SSARBR, SET_HEADER
41 INTEGER COMP, LREQ, IFLAG, IERROR
42 include 'mumps_headers.h'
43 INTEGER INODE_LOC,NPIV,NASS,NROW,NCB
44 INTEGER ISIZEHOLE
45 INTEGER(8) :: MEM_GAIN, RSIZEHOLE, LREQCB_EFF, LREQCB_WISHED
46 INTEGER(8) :: DYN_SIZE, KEEP8TMPCOPY
47 IF ( inplace ) THEN
48 lreqcb_eff = min_space_in_place
49 IF ( min_space_in_place > 0_8 ) THEN
50 lreqcb_wished = lreqcb
51 ELSE
52 lreqcb_wished = 0_8
53 ENDIF
54 ELSE
55 lreqcb_eff = lreqcb
56 lreqcb_wished = lreqcb
57 ENDIF
58 IF (iwposcb.EQ.liw) THEN
59 IF (lreq.NE.keep(ixsz).OR.lreqcb.NE.0_8
60 & .OR. .NOT. set_header) THEN
61 WRITE(*,*) "Internal error in ZMUMPS_ALLOC_CB ",
62 & set_header, lreq, lreqcb
63 CALL mumps_abort()
64 ENDIF
65 IF (iwposcb-iwpos+1 .LT. keep(ixsz)) THEN
66 WRITE(*,*) "Problem with integer stack size",iwposcb,
67 & iwpos, keep(ixsz)
68 iflag = -8
69 ierror = lreq
70 RETURN
71 ENDIF
72 iwposcb=iwposcb-keep(ixsz)
73 iw(iwposcb+1+xxi)=keep(ixsz)
74 CALL mumps_storei8(0_8,iw(iwposcb+1+xxr))
75 CALL mumps_storei8(0_8,iw(iwposcb+1+xxd))
76 iw(iwposcb+1+xxn)=-919191
77 iw(iwposcb+1+xxs)=s_notfree
78 iw(iwposcb+1+xxp)=top_of_stack
79 RETURN
80 ENDIF
81 CALL mumps_geti8( dyn_size, iw(iwposcb+1 + xxd))
82 IF (dyn_size .EQ. 0_8
83 & .AND. keep(214).EQ.1.AND.
84 & keep(216).EQ.1.AND.
85 & iwposcb.NE.liw) THEN
86 IF (iw(iwposcb+1 + xxs).EQ.s_nolcbnocontig.OR.
87 & iw(iwposcb+1 + xxs).EQ.s_nolcbnocontig38) THEN
88 ncb = iw( iwposcb+1 + keep(ixsz) )
89 nrow = iw( iwposcb+1 + keep(ixsz) + 2)
90 npiv = iw( iwposcb+1 + keep(ixsz) + 3)
91 inode_loc= iw( iwposcb+1 + xxn)
92 CALL zmumps_get_sizehole(iwposcb+1,iw,liw,
93 & isizehole,rsizehole)
94 IF (iw(iwposcb+1 + xxs).EQ.s_nolcbnocontig) THEN
95 CALL zmumps_makecbcontig(a,la,iptrlu+1_8,
96 & nrow,ncb,npiv+ncb,0,
97 & iw(iwposcb+1 + xxs),rsizehole)
98 iw(iwposcb+1 + xxs) =s_nolcleaned
99 mem_gain = int(nrow,8)*int(npiv,8)
100 ENDIF
101 IF (iw(iwposcb+1 + xxs).EQ.s_nolcbnocontig38) THEN
102 nass = iw( iwposcb+1 + keep(ixsz) + 4)
103 CALL zmumps_makecbcontig(a,la,iptrlu+1_8,
104 & nrow,ncb,npiv+ncb,nass-npiv,
105 & iw(iwposcb+1 + xxs),rsizehole)
106 iw(iwposcb+1 + xxs) =s_nolcleaned38
107 mem_gain = int(nrow,8)*int(npiv+ncb-(nass-npiv),8)
108 ENDIF
109 IF (isizehole.NE.0) THEN
110 CALL zmumps_ishift( iw,liw,iwposcb+1,
111 & iwposcb+iw(iwposcb+1+xxi),
112 & isizehole )
113 iwposcb=iwposcb+isizehole
114 iw(iwposcb+1+xxp+iw(iwposcb+1+xxi))=iwposcb+1
115 ptrist(step(inode_loc))=ptrist(step(inode_loc))+
116 & isizehole
117 ENDIF
118 CALL mumps_subtri8toarray(iw(iwposcb+1+xxr), mem_gain)
119 iptrlu = iptrlu+mem_gain+rsizehole
120 lrlu = lrlu+mem_gain+rsizehole
121 ptrast(step(inode_loc))=
122 & ptrast(step(inode_loc))+mem_gain+rsizehole
123 ENDIF
124 ENDIF
125 IF (lrlu.LT.lreqcb_wished)THEN
126 IF (lreqcb_eff.LT.lreqcb_wished) THEN
127 CALL zmumps_compre_new(n,keep,iw,liw,a,la,
128 & lrlu,iptrlu,iwpos,iwposcb,
129 & ptrist,ptrast,
130 & step, pimaster,pamaster,lrlus,
131 & keep(ixsz), comp, dkeep(97), myid,
132 & slavef, procnode_steps, dad)
133 ENDIF
134 ENDIF
135 CALL zmumps_get_size_needed
136 & (lreq, lreqcb_eff, .false.,
137 & keep(1), keep8(1),
138 & n,iw,liw,a,la,
139 & lrlu,iptrlu,iwpos,iwposcb,
140 & ptrist,ptrast,
141 & step, pimaster,pamaster,lrlus,
142 & keep(ixsz), comp, dkeep(97), myid,
143 & slavef, procnode_steps, dad,
144 & iflag, ierror)
145 IF (iflag.LT.0) GOTO 650
146 ixxp=iwposcb+xxp+1
147 IF (ixxp.GT.liw) THEN
148 WRITE(*,*) "Internal error 3 in ZMUMPS_ALLOC_CB ",ixxp
149 ENDIF
150 IF (iw(ixxp).GT.0) THEN
151 WRITE(*,*) "Internal error 2 in ZMUMPS_ALLOC_CB ",iw(ixxp),ixxp
152 ENDIF
153 iwposcb = iwposcb - lreq
154 IF (set_header) THEN
155 iw(ixxp)= iwposcb + 1
156 iw(iwposcb+1:iwposcb+1+keep(ixsz))=-99999
157 iw(iwposcb+1+xxi)=lreq
158 CALL mumps_storei8(lreqcb, iw(iwposcb+1+xxr))
159 CALL mumps_storei8(0_8, iw(iwposcb+1+xxd))
160 iw(iwposcb+1+xxs)=state_arg
161 iw(iwposcb+1+xxn)=node_arg
162 iw(iwposcb+1+xxp)=top_of_stack
163 iw(iwposcb+1+xxnbpr)=0
164 ENDIF
165 iptrlu = iptrlu - lreqcb
166 lrlu = lrlu - lreqcb
167 lrlus = lrlus - lreqcb_eff
168 lrlusm = min(lrlus, lrlusm)
169 IF (keep(405) .EQ. 0) THEN
170 keep8(69) = keep8(69) + lreqcb_eff
171 keep8(68) = max(keep8(69), keep8(68))
172 ELSE
173!$OMP ATOMIC CAPTURE
174 keep8(69) = keep8(69) + lreqcb_eff
175 keep8tmpcopy = keep8(69)
176!$OMP END ATOMIC
177!$OMP ATOMIC UPDATE
178 keep8(68) = max(keep8tmpcopy, keep8(68))
179!$OMP END ATOMIC
180 ENDIF
181 CALL zmumps_load_mem_update(ssarbr,process_bande,
182 & la-lrlus,0_8,lreqcb_eff,keep,keep8,lrlus)
183 650 CONTINUE
184 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
zmumps_load
Definition zmumps_load.F:14
zmumps_load::myid
integer, save, private myid
Definition zmumps_load.F:57
zmumps_load::zmumps_load_mem_update
subroutine, public zmumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
Definition zmumps_load.F:920
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102
mumps_storei8
subroutine mumps_storei8(i8, int_array)
Definition tools_common.F:871
mumps_subtri8toarray
subroutine mumps_subtri8toarray(int_array, i8)
Definition tools_common.F:913
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888
zmumps_makecbcontig
subroutine zmumps_makecbcontig(a, la, rcurrent, nrow, ncb, ld, nelim, nodestate, ishift)
Definition zfac_mem_compress_cb.F:369
zmumps_get_size_needed
subroutine zmumps_get_size_needed(sizei_needed, sizer_needed, skip_top_stack, keep, keep8, n, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptrast, step, pimaster, pamaster, lrlus, xsize, comp, acc_time, myid, slavef, procnode_steps, dad, iflag, ierror)
Definition zfac_mem_compress_cb.F:437
zmumps_get_sizehole
subroutine zmumps_get_sizehole(irec, iw, liw, isizehole, rsizehole)
Definition zfac_mem_compress_cb.F:346
zmumps_ishift
subroutine zmumps_ishift(iw, liw, beg2shift, end2shift, isize2shift)
Definition zfac_mem_compress_cb.F:84
zmumps_compre_new
subroutine zmumps_compre_new(n, keep, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptrast, step, pimaster, pamaster, lrlus, xsize, comp, acc_time, myid, slavef, procnode_steps, dad)
Definition zfac_mem_compress_cb.F:120