OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rm_imp0.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rmdim_imp (ixc, ixtg, ndof, nnmax, nkine, inloc, nrow, itab, sh4tree, sh3tree)
subroutine rmind_imp (nnmax, inloc, nrowk, icok)
subroutine rm_imp0 (nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b, itab)
subroutine rm_imp1 (nir, irect, i, nr, nods, itab, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
subroutine rm_imp2 (ixc, ixtg, v, vr, sh4tree, sh3tree)

Function/Subroutine Documentation

◆ rm_imp0()

subroutine rm_imp0 ( integer nddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
integer, dimension(*) ndof,
integer, dimension(*) iddl,
integer, dimension(*) ikc,
b,
integer, dimension(*) itab )

Definition at line 383 of file rm_imp0.F.

385C-----------------------------------------------
386C M o d u l e s
387C-----------------------------------------------
388 USE remesh_mod
389C-----------------------------------------------
390C I m p l i c i t T y p e s
391C-----------------------------------------------
392#include "implicit_f.inc"
393C-----------------------------------------------
394C D u m m y A r g u m e n t s
395C-----------------------------------------------
396 INTEGER NDDL,
397 . IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*),ITAB(*)
398 my_real
399 . diag_k(*),lt_k(*),b(*)
400C-----------------------------------------------
401C L o c a l V a r i a b l e s
402C-----------------------------------------------
403 INTEGER I,J,K,NS,NR
404C-----------------------------------------------
405 DO i = 1, nsh_kin
406 ns = ish_ns(i)
407 nr = iad_nj(i+1)-iad_nj(i)
408 CALL rm_imp1(2 ,ish_ms(1,i),ns ,nr ,
409 2 jdi_nj(iad_nj(i)) ,
410 3 itab ,ikc ,ndof ,nddl ,iddl ,
411 4 iadk ,jdik ,diag_k,lt_k ,b )
412 END DO
413C
414 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
remesh_mod
Definition remesh_mod.F:50
remesh_mod::iad_nj
integer, dimension(:), allocatable iad_nj
Definition remesh_mod.F:88
remesh_mod::ish_ms
integer, dimension(:,:), allocatable ish_ms
Definition remesh_mod.F:90
remesh_mod::ish_ns
integer, dimension(:), allocatable ish_ns
Definition remesh_mod.F:88
remesh_mod::jdi_nj
integer, dimension(:), allocatable jdi_nj
Definition remesh_mod.F:88
remesh_mod::nsh_kin
integer nsh_kin
Definition remesh_mod.F:91
rm_imp1
subroutine rm_imp1(nir, irect, i, nr, nods, itab, ikc, ndof, nddl, iddl, iadk, jdik, diag_k, lt_k, b)
Definition rm_imp0.F:433

◆ rm_imp1()

subroutine rm_imp1 ( integer nir,
integer, dimension(*) irect,
integer i,
integer nr,
integer, dimension(*) nods,
integer, dimension(*) itab,
integer, dimension(*) ikc,
integer, dimension(*) ndof,
integer nddl,
integer, dimension(*) iddl,
integer, dimension(*) iadk,
integer, dimension(*) jdik,
diag_k,
lt_k,
b )

Definition at line 430 of file rm_imp0.F.

433C-----------------------------------------------
434C I m p l i c i t T y p e s
435C-----------------------------------------------
436#include "implicit_f.inc"
437C-----------------------------------------------
438C D u m m y A r g u m e n t s
439C-----------------------------------------------
440 INTEGER
441 . NIR,IRECT(*),I,NR,NODS(*),ITAB(*)
442 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
443C REAL
444 my_real
445 . diag_k(*),lt_k(*),b(*)
446C-----------------------------------------------
447C L o c a l V a r i a b l e s
448C-----------------------------------------------
449 INTEGER J, J1, J2, J3, J4, K, JD, II, L, JJ,
450 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
451 . NIR1,IR
452C REAL
453 my_real
454 . kdd(6,6),bd(6),kii(6,6),bi(6),facm,facm2
455C --------------------------------------------------
456 ndm = 0
457 DO j=1,nir
458 nj=irect(j)
459 ndm = max(ndm,ndof(nj))
460 ENDDO
461 IF (ndm==0) RETURN
462 facm = one / nir
463 facm2 = facm*facm
464 DO k=1,ndof(i)
465 id = iddl(i)+k
466 ikc(id)=12
467 bd(k)=b(id)
468 ENDDO
469 DO k=ndof(i)+1,6
470 bd(k)=zero
471 ENDDO
472 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(i))
473C-------Update K(main node),B---
474 DO j=1,nir
475 nj=irect(j)
476 nd = min(ndm,ndof(nj))
477 CALL updkdd(nd,kdd,kii,facm2,1)
478 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,nd)
479 DO k=1,nd
480 id = iddl(nj)+k
481 b(id) = b(id) + facm*bd(k)
482 ENDDO
483 DO i1=j+1,nir
484 nm=irect(i1)
485 nd = min(nd,ndof(nm))
486 CALL updkdd(nd,kdd,kii,facm2,0)
487 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kii,nd,nd,ir)
488 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,3 )
489 ENDDO
490 ENDDO
491C--------no diag--Kjm=sum(KjsCsm)--
492 DO i1 = 1,nr
493 ni=nods(i1)
494 nidof=ndof(ni)
495 IF (nidof==0) cycle
496 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(i),ir)
497 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,3 )
498C------- Update ---
499 ndi = min(ndm,nidof)
500 DO j=1,nir
501 nj=irect(j)
502 ndj = min(ndm,ndof(nj))
503 IF (ndj>0) THEN
504 IF (nj==ni) THEN
505 CALL updkdd1(nidof,ndj,kdd,kii,facm,1)
506 CALL put_kii(nj ,iddl ,iadk,diag_k,lt_k,kii,ndj)
507 ELSE
508 CALL updkdd1(ndi,ndof(i),kdd,kii,facm,0)
509 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,ndi,ndj,ir)
510 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,3 )
511 ENDIF
512 ENDIF
513 ENDDO
514 ENDDO
515C
516 RETURN
updkdd
subroutine updkdd(ndl, kdd, kii, h2, isym)
Definition i2_imp1.F:1071
updkdd1
subroutine updkdd1(ndi, ndj, kdd, kii, h, isym)
Definition i2_imp1.F:1118
print_wkij
subroutine print_wkij(ni, nj, iflag)
Definition imp_glob_k.F:890
put_kii
subroutine put_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:653
put_kij
subroutine put_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:810
get_kii
subroutine get_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:591
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:713
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4

◆ rm_imp2()

subroutine rm_imp2 ( integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
v,
vr,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree )

Definition at line 525 of file rm_imp0.F.

526C-----------------------------------------------
527C M o d u l e s
528C-----------------------------------------------
529 USE remesh_mod
530C-----------------------------------------------
531C I m p l i c i t T y p e s
532C-----------------------------------------------
533#include "implicit_f.inc"
534C-----------------------------------------------
535C G l o b a l P a r a m e t e r s
536C-----------------------------------------------
537#include "param_c.inc"
538#include "remesh_c.inc"
539C-----------------------------------------------
540C D u m m y A r g u m e n t s
541C-----------------------------------------------
542 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
543 2 SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*)
544 my_real
545 . v(3,*),vr(3,*)
546C-----------------------------------------------
547C L o c a l V a r i a b l e s
548C-----------------------------------------------
549 INTEGER N, NN, LEVEL, IP, NLEV, IERR
550 INTEGER SON,M(4),MC,N1,N2,N3,N4,J
551C-----------------------------------------------
552 tagnod=0
553C-------
554 DO level=0,levelmax-1
555
556 DO nn=psh4kin(level)+1,psh4kin(level+1)
557 n =lsh4kin(nn)
558C
559 n1=ixc(2,n)
560 n2=ixc(3,n)
561 n3=ixc(4,n)
562 n4=ixc(5,n)
563C
564 son=sh4tree(2,n)
565C
566 mc=ixc(3,son+3)
567
568 IF(tagnod(mc)==0)THEN
569 tagnod(mc)=1
570 DO j=1,3
571 v(j,mc)= fourth*(v(j,n1)+v(j,n2)+v(j,n3)+v(j,n4))
572 END DO
573 DO j=1,3
574 vr(j,mc)= fourth*(vr(j,n1)+vr(j,n2)+vr(j,n3)+vr(j,n4))
575 END DO
576 ELSE
577 END IF
578C
579 m(1)=ixc(3,son )
580 m(2)=ixc(4,son+1)
581 m(3)=ixc(5,son+2)
582 m(4)=ixc(2,son+3)
583
584 IF(tagnod(m(1))==0)THEN
585 tagnod(m(1))=1
586 DO j=1,3
587 v(j,m(1))= half*(v(j,n1)+v(j,n2))
588 END DO
589 DO j=1,3
590 vr(j,m(1))= half*(vr(j,n1)+vr(j,n2))
591 END DO
592 ELSE
593 END IF
594
595 IF(tagnod(m(2))==0)THEN
596 tagnod(m(2))=1
597 DO j=1,3
598 v(j,m(2))= half*(v(j,n2)+v(j,n3))
599 END DO
600 DO j=1,3
601 vr(j,m(2))= half*(vr(j,n2)+vr(j,n3))
602 END DO
603 ELSE
604 END IF
605
606 IF(tagnod(m(3))==0)THEN
607 tagnod(m(3))=1
608 DO j=1,3
609 v(j,m(3))= half*(v(j,n3)+v(j,n4))
610 END DO
611 DO j=1,3
612 vr(j,m(3))= half*(vr(j,n3)+vr(j,n4))
613 END DO
614 ELSE
615 END IF
616
617 IF(tagnod(m(4))==0)THEN
618 tagnod(m(4))=1
619 DO j=1,3
620 v(j,m(4))= half*(v(j,n4)+v(j,n1))
621 END DO
622 DO j=1,3
623 vr(j,m(4))= half*(vr(j,n4)+vr(j,n1))
624 END DO
625 ELSE
626 END IF
627 END DO
628
629 DO nn=psh3kin(level)+1,psh3kin(level+1)
630 n =lsh3kin(nn)
631C
632 n1=ixtg(2,n)
633 n2=ixtg(3,n)
634 n3=ixtg(4,n)
635C
636 son=sh3tree(2,n)
637C
638 m(1)=ixtg(4,son+3)
639 m(2)=ixtg(2,son+3)
640 m(3)=ixtg(3,son+3)
641
642 IF(tagnod(m(1))==0)THEN
643 tagnod(m(1))=1
644 DO j=1,3
645 v(j,m(1))= half*(v(j,n1)+v(j,n2))
646 END DO
647 DO j=1,3
648 vr(j,m(1))= half*(vr(j,n1)+vr(j,n2))
649 END DO
650 ELSE
651 END IF
652
653 IF(tagnod(m(2))==0)THEN
654 tagnod(m(2))=1
655 DO j=1,3
656 v(j,m(2))= half*(v(j,n2)+v(j,n3))
657 END DO
658 DO j=1,3
659 vr(j,m(2))= half*(vr(j,n2)+vr(j,n3))
660 END DO
661 ELSE
662 END IF
663
664 IF(tagnod(m(3))==0)THEN
665 tagnod(m(3))=1
666 DO j=1,3
667 v(j,m(3))= half*(v(j,n3)+v(j,n1))
668 END DO
669 DO j=1,3
670 vr(j,m(3))= half*(vr(j,n3)+vr(j,n1))
671 END DO
672 ELSE
673 END IF
674 END DO
675C
676 END DO
677C
678 RETURN
remesh_mod::lsh4kin
integer, dimension(:), allocatable lsh4kin
Definition remesh_mod.F:62
remesh_mod::lsh3kin
integer, dimension(:), allocatable lsh3kin
Definition remesh_mod.F:62
remesh_mod::psh4kin
integer, dimension(:), allocatable psh4kin
Definition remesh_mod.F:62
remesh_mod::psh3kin
integer, dimension(:), allocatable psh3kin
Definition remesh_mod.F:62
remesh_mod::tagnod
integer, dimension(:), allocatable tagnod
Definition remesh_mod.F:77

◆ rmdim_imp()

subroutine rmdim_imp ( integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) ndof,
integer nnmax,
integer nkine,
integer, dimension(*) inloc,
integer, dimension(*) nrow,
integer, dimension(*) itab,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree )

Definition at line 33 of file rm_imp0.F.

35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE remesh_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "param_c.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "remesh_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),NDOF(*),NNMAX,
55 1 NKINE,INLOC(*),NROW(*),ITAB(*),
56 2 SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*)
57C-----------------------------------------------
58C External function
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER N, NN, LEVEL, IP, NLEV,I,J,K,L,M1,M2,MK1,MK2
63 INTEGER SON,M(4),MC,NI(5),MN,NS,NZ,NR,NK,NKS,IS
64 INTEGER, DIMENSION(:),ALLOCATABLE :: NROWK
65 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICOK
66C-----------------------------------------------
67 tagnod=0
68 nsh_kin=0
69 DO level=levelmax-1,0,-1
70
71 DO nn=psh4kin(level)+1,psh4kin(level+1)
72 n =lsh4kin(nn)
73
74 son=sh4tree(2,n)
75C
76 mc=ixc(4,son)
77
78 tagnod(mc)=1
79C
80 m(1)=ixc(3,son )
81 m(2)=ixc(4,son+1)
82 m(3)=ixc(5,son+2)
83 m(4)=ixc(2,son+3)
84 DO j = 1 , 4
85 mn = m(j)
86 IF(tagnod(mn)==0.AND.ndof(mn)>0) nsh_kin= nsh_kin + 1
87 tagnod(mn)=1
88 END DO
89 END DO
90
91 DO nn=psh3kin(level)+1,psh3kin(level+1)
92 n =lsh3kin(nn)
93
94 son=sh3tree(2,n)
95C
96 m(1)=ixtg(4,son+3)
97 m(2)=ixtg(2,son+3)
98 m(3)=ixtg(3,son+3)
99 DO j = 1 , 3
100 mn = m(j)
101 IF(tagnod(mn)==0.AND.ndof(mn)>0) nsh_kin= nsh_kin + 1
102 tagnod(mn)=1
103 END DO
104 END DO
105
106 END DO
107
108 IF (nsh_kin==0) RETURN
109
110 ALLOCATE(ish_ns(nsh_kin),ish_ms(2,nsh_kin))
111
112 ns = 0
113 tagnod=0
114 DO level=levelmax-1,0,-1
115
116 DO nn=psh4kin(level)+1,psh4kin(level+1)
117 n =lsh4kin(nn)
118
119 son=sh4tree(2,n)
120
121 DO j = 1 , 4
122 ni(j) = ixc(j+1,n)
123 END DO
124 ni(5) = ni(1)
125C
126 mc=ixc(4,son)
127
128 tagnod(mc)=1
129C
130 m(1)=ixc(3,son )
131 m(2)=ixc(4,son+1)
132 m(3)=ixc(5,son+2)
133 m(4)=ixc(2,son+3)
134 DO j = 1 , 4
135 mn = m(j)
136 IF(tagnod(mn)==0.AND.ndof(mn)>0) THEN
137 ns= ns + 1
138 ish_ns(ns) = mn
139 ish_ms(1,ns) = ni(j)
140 ish_ms(2,ns) = ni(j+1)
141 END IF
142 tagnod(mn)=1
143 END DO
144 END DO
145
146
147 DO nn=psh3kin(level)+1,psh3kin(level+1)
148 n =lsh3kin(nn)
149
150 son=sh3tree(2,n)
151
152 DO j = 1 , 3
153 ni(j) = ixtg(j+1,n)
154 END DO
155 ni(4) = ni(1)
156C
157 m(1)=ixtg(4,son+3)
158 m(2)=ixtg(2,son+3)
159 m(3)=ixtg(3,son+3)
160 DO j = 1 , 3
161 mn = m(j)
162 IF(tagnod(mn)==0.AND.ndof(mn)>0) THEN
163 ns= ns + 1
164 ish_ns(ns) = mn
165 ish_ms(1,ns) = ni(j)
166 ish_ms(2,ns) = ni(j+1)
167 END IF
168 tagnod(mn)=1
169 END DO
170 END DO
171
172 END DO
173
174 tagnod=0
175 nk = 0
176 DO i = 1, nsh_kin
177 ns = ish_ns(i)
178 IF (tagnod(ns)==0) THEN
179 nk=nk+1
180 tagnod(ns)=nk
181 END IF
182 END DO
183 nks = nk
184C-------i,j<->j,i
185 DO nn=1,nsh4act
186 n =lsh4act(nn)
187 is = 0
188 DO j=1,4
189 m(j)=ixc(j+1,n)
190 mn = tagnod(m(j))
191 IF (mn>0.AND.mn<=nks) is = mn
192 ENDDO
193 IF (is > 0) THEN
194 DO j=1,4
195 ns=m(j)
196 IF (tagnod(ns)==0) THEN
197 nk=nk+1
198 tagnod(ns)=nk
199 END IF
200 END DO
201 END IF
202 END DO
203 DO nn=1,nsh3act
204 n =lsh3act(nn)
205 is = 0
206 DO j=1,3
207 m(j)=ixtg(j+1,n)
208 mn = tagnod(m(j))
209 IF (mn>0.AND.mn<=nks) is = mn
210 ENDDO
211 IF (is > 0) THEN
212 DO j=1,3
213 ns=m(j)
214 IF (tagnod(ns)==0) THEN
215 nk=nk+1
216 tagnod(ns)=nk
217 END IF
218 END DO
219 END IF
220 END DO
221C
222 l=4**levelmax
223 ALLOCATE(nrowk(nk),icok(nnmax+l,nk))
224 nrowk=0
225C-----------------elementary connectivity -----
226 DO nn=1,nsh4act
227 n =lsh4act(nn)
228 DO j=1,4
229 m(j)=ixc(j+1,n)
230 ENDDO
231 DO j=1,4
232 ns=m(j)
233 k=tagnod(ns)
234 IF (k > 0) THEN
235 DO l=1,4
236 IF (ns/=m(l)) THEN
237 CALL reorder_a(nrowk(k),icok(1,k),m(l))
238 ENDIF
239 ENDDO
240 ENDIF
241 ENDDO
242 END DO
243 DO nn=1,nsh3act
244 n =lsh3act(nn)
245 DO j=1,3
246 m(j)=ixtg(j+1,n)
247 ENDDO
248 DO j=1,3
249 ns=m(j)
250 k=tagnod(ns)
251 IF (k > 0) THEN
252 DO l=1,3
253 IF (ns/=m(l)) THEN
254 CALL reorder_a(nrowk(k),icok(1,k),m(l))
255 ENDIF
256 ENDDO
257 ENDIF
258 ENDDO
259 END DO
260C-----------------new connectivity due to kin-----
261 DO i = 1, nsh_kin
262 ns = ish_ns(i)
263 m1 = ish_ms(1,i)
264 m2 = ish_ms(2,i)
265 k=tagnod(ns)
266 mk1 = tagnod(m1)
267 mk2 = tagnod(m2)
268 DO j=1,nrowk(k)
269 nn = icok(j,k)
270 mn = tagnod(nn)
271 IF (nn/=m1) THEN
272 CALL reorder_a(nrowk(mk1),icok(1,mk1),nn)
273 CALL reorder_a(nrowk(mn),icok(1,mn),m1)
274 END IF
275 IF (nn/=m2) THEN
276 CALL reorder_a(nrowk(mk2),icok(1,mk2),nn)
277 CALL reorder_a(nrowk(mn),icok(1,mn),m2)
278 END IF
279 END DO
280 END DO
281C
282 nz = 0
283 DO i = 1, nsh_kin
284 ns = ish_ns(i)
285 k=tagnod(ns)
286 IF (inloc(ns)==0) THEN
287 nkine=nkine+1
288 inloc(ns)=nkine
289 END IF
290 nrow(ns)=max(nrow(ns),nrowk(k))
291 DO j=1,nrowk(k)
292 nn = icok(j,k)
293 mn = tagnod(nn)
294 nnmax=max(nnmax,nrowk(mn))
295 IF (inloc(nn)==0) THEN
296 nkine=nkine+1
297 inloc(nn)=nkine
298 END IF
299 nrow(nn)=max(nrow(nn),nrowk(mn))
300 END DO
301 nz = nz + nrowk(k)
302 END DO
303C
304
305 ALLOCATE(iad_nj(nsh_kin+1),jdi_nj(nz))
306
307 iad_nj(1) = 1
308
309 DO i = 1, nsh_kin
310 ns = ish_ns(i)
311 k=tagnod(ns)
312 iad_nj(i+1) = iad_nj(i) + nrowk(k)
313 CALL cp_int(nrowk(k),icok(1,k),jdi_nj(iad_nj(i)))
314 END DO
315
316C
317 DEALLOCATE(nrowk,icok)
318C
319 RETURN
reorder_a
subroutine reorder_a(n, ic, id)
Definition ind_glob_k.F:4268
remesh_mod::lsh3act
integer, dimension(:), allocatable lsh3act
Definition remesh_mod.F:62
remesh_mod::nsh3act
integer nsh3act
Definition remesh_mod.F:66
remesh_mod::nsh4act
integer nsh4act
Definition remesh_mod.F:66
remesh_mod::lsh4act
integer, dimension(:), allocatable lsh4act
Definition remesh_mod.F:62
cp_int
subroutine cp_int(n, x, xc)
Definition produt_v.F:916

◆ rmind_imp()

subroutine rmind_imp ( integer nnmax,
integer, dimension(*) inloc,
integer, dimension(*) nrowk,
integer, dimension(nnmax,*) icok )

Definition at line 331 of file rm_imp0.F.

332C-----------------------------------------------
333C M o d u l e s
334C-----------------------------------------------
335 USE remesh_mod
336C-----------------------------------------------
337C I m p l i c i t T y p e s
338C-----------------------------------------------
339#include "implicit_f.inc"
340C-----------------------------------------------
341C D u m m y A r g u m e n t s
342C-----------------------------------------------
343 INTEGER NNMAX
344 INTEGER INLOC(*),NROWK(*),ICOK(NNMAX,*)
345C-----------------------------------------------
346C L o c a l V a r i a b l e s
347C-----------------------------------------------
348 INTEGER N, NN, LEVEL, IP, NLEV,I,J,K,M1,M2,MK1,MK2
349 INTEGER MN,NS,NZ,NR,NK
350C-----------------------------------------------
351 DO i = 1, nsh_kin
352 ns = ish_ns(i)
353 m1 = ish_ms(1,i)
354 m2 = ish_ms(2,i)
355 mk1 = inloc(m1)
356 mk2 = inloc(m2)
357 DO j=iad_nj(i),iad_nj(i+1)-1
358 nn = jdi_nj(j)
359 mn = inloc(nn)
360 IF (nn/=m1) THEN
361 CALL reorder_a(nrowk(mk1),icok(1,mk1),nn)
362 CALL reorder_a(nrowk(mn),icok(1,mn),m1)
363 END IF
364 IF (nn/=m2) THEN
365 CALL reorder_a(nrowk(mk2),icok(1,mk2),nn)
366 CALL reorder_a(nrowk(mn),icok(1,mn),m2)
367 END IF
368 END DO
369 END DO
370C
371 RETURN