OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rm_imp0.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| rmdim_imp ../engine/source/model/remesh/rm_imp0.F
25!||--- called by ------------------------------------------------------
26!|| dim_kinmax ../engine/source/implicit/ind_glob_k.F
27!||--- calls -----------------------------------------------------
28!|| cp_int ../engine/source/implicit/produt_v.F
29!|| reorder_a ../engine/source/implicit/ind_glob_k.F
30!||--- uses -----------------------------------------------------
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!|| remesh_mod ../engine/share/modules/remesh_mod.F
33!||====================================================================
34 SUBROUTINE rmdim_imp(IXC ,IXTG ,NDOF ,NNMAX ,NKINE,
35 1 INLOC,NROW ,ITAB ,SH4TREE,SH3TREE)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE remesh_mod
40 use element_mod , only : nixc,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C G l o b a l P a r a m e t e r s
47C-----------------------------------------------
48#include "param_c.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "remesh_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),NDOF(*),NNMAX,
57 1 nkine,inloc(*),nrow(*),itab(*),
58 2 sh4tree(ksh4tree,*), sh3tree(ksh3tree,*)
59C-----------------------------------------------
60C External function
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER N, NN, LEVEL, IP, NLEV,I,J,K,L,M1,M2,MK1,MK2
65 INTEGER SON,M(4),MC,NI(5),MN,NS,NZ,NR,NK,NKS,IS
66 INTEGER, DIMENSION(:),ALLOCATABLE :: NROWK
67 INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICOK
68C-----------------------------------------------
69 tagnod=0
70 nsh_kin=0
71 DO level=levelmax-1,0,-1
72
73 DO nn=psh4kin(level)+1,psh4kin(level+1)
74 n =lsh4kin(nn)
75
76 son=sh4tree(2,n)
77C
78 mc=ixc(4,son)
79
80 tagnod(mc)=1
81C
82 m(1)=ixc(3,son )
83 m(2)=ixc(4,son+1)
84 m(3)=ixc(5,son+2)
85 m(4)=ixc(2,son+3)
86 DO j = 1 , 4
87 mn = m(j)
88 IF(tagnod(mn)==0.AND.ndof(mn)>0) nsh_kin= nsh_kin + 1
89 tagnod(mn)=1
90 END DO
91 END DO
92
93 DO nn=psh3kin(level)+1,psh3kin(level+1)
94 n =lsh3kin(nn)
95
96 son=sh3tree(2,n)
97C
98 m(1)=ixtg(4,son+3)
99 m(2)=ixtg(2,son+3)
100 m(3)=ixtg(3,son+3)
101 DO j = 1 , 3
102 mn = m(j)
103 IF(tagnod(mn)==0.AND.ndof(mn)>0) nsh_kin= nsh_kin + 1
104 tagnod(mn)=1
105 END DO
106 END DO
107
108 END DO
109
110 IF (nsh_kin==0) RETURN
111
112 ALLOCATE(ish_ns(nsh_kin),ish_ms(2,nsh_kin))
113
114 ns = 0
115 tagnod=0
116 DO level=levelmax-1,0,-1
117
118 DO nn=psh4kin(level)+1,psh4kin(level+1)
119 n =lsh4kin(nn)
120
121 son=sh4tree(2,n)
122
123 DO j = 1 , 4
124 ni(j) = ixc(j+1,n)
125 END DO
126 ni(5) = ni(1)
127C
128 mc=ixc(4,son)
129
130 tagnod(mc)=1
131C
132 m(1)=ixc(3,son )
133 m(2)=ixc(4,son+1)
134 m(3)=ixc(5,son+2)
135 m(4)=ixc(2,son+3)
136 DO j = 1 , 4
137 mn = m(j)
138 IF(tagnod(mn)==0.AND.ndof(mn)>0) THEN
139 ns= ns + 1
140 ish_ns(ns) = mn
141 ish_ms(1,ns) = ni(j)
142 ish_ms(2,ns) = ni(j+1)
143 END IF
144 tagnod(mn)=1
145 END DO
146 END DO
147
148
149 DO nn=psh3kin(level)+1,psh3kin(level+1)
150 n =lsh3kin(nn)
151
152 son=sh3tree(2,n)
153
154 DO j = 1 , 3
155 ni(j) = ixtg(j+1,n)
156 END DO
157 ni(4) = ni(1)
158C
159 m(1)=ixtg(4,son+3)
160 m(2)=ixtg(2,son+3)
161 m(3)=ixtg(3,son+3)
162 DO j = 1 , 3
163 mn = m(j)
164 IF(tagnod(mn)==0.AND.ndof(mn)>0) THEN
165 ns= ns + 1
166 ish_ns(ns) = mn
167 ish_ms(1,ns) = ni(j)
168 ish_ms(2,ns) = ni(j+1)
169 END IF
170 tagnod(mn)=1
171 END DO
172 END DO
173
174 END DO
175
176 tagnod=0
177 nk = 0
178 DO i = 1, nsh_kin
179 ns = ish_ns(i)
180 IF (tagnod(ns)==0) THEN
181 nk=nk+1
182 tagnod(ns)=nk
183 END IF
184 END DO
185 nks = nk
186C-------i,j<->j,i
187 DO nn=1,nsh4act
188 n =lsh4act(nn)
189 is = 0
190 DO j=1,4
191 m(j)=ixc(j+1,n)
192 mn = tagnod(m(j))
193 IF (mn>0.AND.mn<=nks) is = mn
194 ENDDO
195 IF (is > 0) THEN
196 DO j=1,4
197 ns=m(j)
198 IF (tagnod(ns)==0) THEN
199 nk=nk+1
200 tagnod(ns)=nk
201 END IF
202 END DO
203 END IF
204 END DO
205 DO nn=1,nsh3act
206 n =lsh3act(nn)
207 is = 0
208 DO j=1,3
209 m(j)=ixtg(j+1,n)
210 mn = tagnod(m(j))
211 IF (mn>0.AND.mn<=nks) is = mn
212 ENDDO
213 IF (is > 0) THEN
214 DO j=1,3
215 ns=m(j)
216 IF (tagnod(ns)==0) THEN
217 nk=nk+1
218 tagnod(ns)=nk
219 END IF
220 END DO
221 END IF
222 END DO
223C
224 l=4**levelmax
225 ALLOCATE(nrowk(nk),icok(nnmax+l,nk))
226 nrowk=0
227C-----------------elementary connectivity -----
228 DO nn=1,nsh4act
229 n =lsh4act(nn)
230 DO j=1,4
231 m(j)=ixc(j+1,n)
232 ENDDO
233 DO j=1,4
234 ns=m(j)
235 k=tagnod(ns)
236 IF (k > 0) THEN
237 DO l=1,4
238 IF (ns/=m(l)) THEN
239 CALL reorder_a(nrowk(k),icok(1,k),m(l))
240 ENDIF
241 ENDDO
242 ENDIF
243 ENDDO
244 END DO
245 DO nn=1,nsh3act
246 n =lsh3act(nn)
247 DO j=1,3
248 m(j)=ixtg(j+1,n)
249 ENDDO
250 DO j=1,3
251 ns=m(j)
252 k=tagnod(ns)
253 IF (k > 0) THEN
254 DO l=1,3
255 IF (ns/=m(l)) THEN
256 CALL reorder_a(nrowk(k),icok(1,k),m(l))
257 ENDIF
258 ENDDO
259 ENDIF
260 ENDDO
261 END DO
262C-----------------new connectivity due to kin-----
263 DO i = 1, nsh_kin
264 ns = ish_ns(i)
265 m1 = ish_ms(1,i)
266 m2 = ish_ms(2,i)
267 k=tagnod(ns)
268 mk1 = tagnod(m1)
269 mk2 = tagnod(m2)
270 DO j=1,nrowk(k)
271 nn = icok(j,k)
272 mn = tagnod(nn)
273 IF (nn/=m1) THEN
274 CALL reorder_a(nrowk(mk1),icok(1,mk1),nn)
275 CALL reorder_a(nrowk(mn),icok(1,mn),m1)
276 END IF
277 IF (nn/=m2) THEN
278 CALL reorder_a(nrowk(mk2),icok(1,mk2),nn)
279 CALL reorder_a(nrowk(mn),icok(1,mn),m2)
280 END IF
281 END DO
282 END DO
283C
284 nz = 0
285 DO i = 1, nsh_kin
286 ns = ish_ns(i)
287 k=tagnod(ns)
288 IF (inloc(ns)==0) THEN
289 nkine=nkine+1
290 inloc(ns)=nkine
291 END IF
292 nrow(ns)=max(nrow(ns),nrowk(k))
293 DO j=1,nrowk(k)
294 nn = icok(j,k)
295 mn = tagnod(nn)
296 nnmax=max(nnmax,nrowk(mn))
297 IF (inloc(nn)==0) THEN
298 nkine=nkine+1
299 inloc(nn)=nkine
300 END IF
301 nrow(nn)=max(nrow(nn),nrowk(mn))
302 END DO
303 nz = nz + nrowk(k)
304 END DO
305C
306
307 ALLOCATE(iad_nj(nsh_kin+1),jdi_nj(nz))
308
309 iad_nj(1) = 1
310
311 DO i = 1, nsh_kin
312 ns = ish_ns(i)
313 k=tagnod(ns)
314 iad_nj(i+1) = iad_nj(i) + nrowk(k)
315 CALL cp_int(nrowk(k),icok(1,k),jdi_nj(iad_nj(i)))
316 END DO
317
318C
319 DEALLOCATE(nrowk,icok)
320C
321 RETURN
322 END
323
324!||====================================================================
325!|| rmind_imp ../engine/source/model/remesh/rm_imp0.F
326!||--- called by ------------------------------------------------------
327!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
328!||--- calls -----------------------------------------------------
329!|| reorder_a ../engine/source/implicit/ind_glob_k.F
330!||--- uses -----------------------------------------------------
331!|| remesh_mod ../engine/share/modules/remesh_mod.F
332!||====================================================================
333 SUBROUTINE rmind_imp(NNMAX,INLOC,NROWK,ICOK )
334C-----------------------------------------------
335C M o d u l e s
336C-----------------------------------------------
337 USE remesh_mod
338C-----------------------------------------------
339C I m p l i c i t T y p e s
340C-----------------------------------------------
341#include "implicit_f.inc"
342C-----------------------------------------------
343C D u m m y A r g u m e n t s
344C-----------------------------------------------
345 INTEGER NNMAX
346 INTEGER INLOC(*),NROWK(*),ICOK(NNMAX,*)
347C-----------------------------------------------
348C L o c a l V a r i a b l e s
349C-----------------------------------------------
350 INTEGER N, NN, LEVEL, IP, NLEV,I,J,K,M1,M2,MK1,MK2
351 INTEGER MN,NS,NZ,NR,NK
352C-----------------------------------------------
353 DO i = 1, nsh_kin
354 ns = ish_ns(i)
355 m1 = ish_ms(1,i)
356 m2 = ish_ms(2,i)
357 mk1 = inloc(m1)
358 mk2 = inloc(m2)
359 DO j=iad_nj(i),iad_nj(i+1)-1
360 nn = jdi_nj(j)
361 mn = inloc(nn)
362 IF (nn/=m1) THEN
363 CALL reorder_a(nrowk(mk1),icok(1,mk1),nn)
364 CALL reorder_a(nrowk(mn),icok(1,mn),m1)
365 END IF
366 IF (nn/=m2) THEN
367 CALL reorder_a(nrowk(mk2),icok(1,mk2),nn)
368 CALL reorder_a(nrowk(mn),icok(1,mn),m2)
369 END IF
370 END DO
371 END DO
372C
373 RETURN
374 END
375
376!||====================================================================
377!|| rm_imp0 ../engine/source/model/remesh/rm_imp0.F
378!||--- called by ------------------------------------------------------
379!|| upd_glob_k ../engine/source/implicit/upd_glob_k.F
380!||--- calls -----------------------------------------------------
381!|| rm_imp1 ../engine/source/model/remesh/rm_imp0.F
382!||--- uses -----------------------------------------------------
383!|| remesh_mod ../engine/share/modules/remesh_mod.F
384!||====================================================================
385 SUBROUTINE rm_imp0(NDDL ,IADK ,JDIK ,DIAG_K ,LT_K ,
386 1 NDOF ,IDDL ,IKC ,B ,ITAB )
387C-----------------------------------------------
388C M o d u l e s
389C-----------------------------------------------
390 USE remesh_mod
391C-----------------------------------------------
392C I m p l i c i t T y p e s
393C-----------------------------------------------
394#include "implicit_f.inc"
395C-----------------------------------------------
396C D u m m y A r g u m e n t s
397C-----------------------------------------------
398 INTEGER NDDL,
399 . IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*),ITAB(*)
400 my_real
401 . diag_k(*),lt_k(*),b(*)
402C-----------------------------------------------
403C L o c a l V a r i a b l e s
404C-----------------------------------------------
405 INTEGER I,J,K,NS,NR
406C-----------------------------------------------
407 DO i = 1, nsh_kin
408 ns = ish_ns(i)
409 nr = iad_nj(i+1)-iad_nj(i)
410 CALL rm_imp1(2 ,ish_ms(1,i),ns ,nr ,
411 2 jdi_nj(iad_nj(i)) ,
412 3 itab ,ikc ,ndof ,nddl ,iddl ,
413 4 iadk ,jdik ,diag_k,lt_k ,b )
414 END DO
415C
416 RETURN
417 END
418
419!||====================================================================
420!|| rm_imp1 ../engine/source/model/remesh/rm_imp0.F
421!||--- called by ------------------------------------------------------
422!|| rm_imp0 ../engine/source/model/remesh/rm_imp0.F
423!||--- calls -----------------------------------------------------
424!|| get_kii ../engine/source/implicit/imp_glob_k.F
425!|| get_kij ../engine/source/implicit/imp_glob_k.F
426!|| print_wkij ../engine/source/implicit/imp_glob_k.F
427!|| put_kii ../engine/source/implicit/imp_glob_k.F
428!|| put_kij ../engine/source/implicit/imp_glob_k.F
429!|| updkdd ../engine/source/interfaces/interf/i2_imp1.F
430!|| updkdd1 ../engine/source/interfaces/interf/i2_imp1.F
431!||====================================================================
432 SUBROUTINE rm_imp1(NIR ,IRECT ,I ,NR ,NODS ,
433 3 ITAB ,IKC ,NDOF ,NDDL ,IDDL ,
434 4 IADK ,JDIK ,DIAG_K,LT_K ,B )
435C-----------------------------------------------
436C I m p l i c i t T y p e s
437C-----------------------------------------------
438#include "implicit_f.inc"
439C-----------------------------------------------
440C D u m m y A r g u m e n t s
441C-----------------------------------------------
442 INTEGER
443 . NIR,IRECT(*),I,NR,NODS(*),ITAB(*)
444 INTEGER NDDL,IADK(*),JDIK(*),NDOF(*),IDDL(*),IKC(*)
445C REAL
446 my_real
447 . diag_k(*),lt_k(*),b(*)
448C-----------------------------------------------
449C L o c a l V a r i a b l e s
450C-----------------------------------------------
451 INTEGER J, J1, J2, J3, J4, K, JD, II, L, JJ,
452 . I1,ID,NL,NI,NJ,NIDOF,ND,NDI,NDJ,NDM,NM,L1,NM1,
453 . NIR1,IR
454C REAL
455 my_real
456 . kdd(6,6),bd(6),kii(6,6),bi(6),facm,facm2
457C --------------------------------------------------
458 ndm = 0
459 DO j=1,nir
460 nj=irect(j)
461 ndm = max(ndm,ndof(nj))
462 ENDDO
463 IF (ndm==0) RETURN
464 facm = one / nir
465 facm2 = facm*facm
466 DO k=1,ndof(i)
467 id = iddl(i)+k
468 ikc(id)=12
469 bd(k)=b(id)
470 ENDDO
471 DO k=ndof(i)+1,6
472 bd(k)=zero
473 ENDDO
474 CALL get_kii(i ,iddl ,iadk,diag_k,lt_k ,kdd,ndof(i))
475C-------Update K(main node),B---
476 DO j=1,nir
477 nj=irect(j)
478 nd = min(ndm,ndof(nj))
479 CALL updkdd(nd,kdd,kii,facm2,1)
480 CALL put_kii(nj,iddl ,iadk,diag_k,lt_k ,kii,nd)
481 DO k=1,nd
482 id = iddl(nj)+k
483 b(id) = b(id) + facm*bd(k)
484 ENDDO
485 DO i1=j+1,nir
486 nm=irect(i1)
487 nd = min(nd,ndof(nm))
488 CALL updkdd(nd,kdd,kii,facm2,0)
489 CALL put_kij(nj,nm,iddl,iadk,jdik,lt_k,kii,nd,nd,ir)
490 IF (ir==1) CALL print_wkij(itab(nj) ,itab(nm) ,3 )
491 ENDDO
492 ENDDO
493C--------no diag--Kjm=sum(KjsCsm)--
494 DO i1 = 1,nr
495 ni=nods(i1)
496 nidof=ndof(ni)
497 IF (nidof==0) cycle
498 CALL get_kij(ni,i,iddl,iadk,jdik,lt_k,kdd,nidof,ndof(i),ir)
499 IF (ir==1) CALL print_wkij(itab(ni) ,itab(i) ,3 )
500C------- Update ---
501 ndi = min(ndm,nidof)
502 DO j=1,nir
503 nj=irect(j)
504 ndj = min(ndm,ndof(nj))
505 IF (ndj>0) THEN
506 IF (nj==ni) THEN
507 CALL updkdd1(nidof,ndj,kdd,kii,facm,1)
508 CALL put_kii(nj ,iddl ,iadk,diag_k,lt_k,kii,ndj)
509 ELSE
510 CALL updkdd1(ndi,ndof(i),kdd,kii,facm,0)
511 CALL put_kij(ni,nj,iddl,iadk,jdik,lt_k,kii,ndi,ndj,ir)
512 IF (ir==1) CALL print_wkij(itab(ni) ,itab(nj) ,3 )
513 ENDIF
514 ENDIF
515 ENDDO
516 ENDDO
517C
518 RETURN
519 END
520!||====================================================================
521!|| rm_imp2 ../engine/source/model/remesh/rm_imp0.F
522!||--- called by ------------------------------------------------------
523!|| recukin ../engine/source/implicit/recudis.F
524!||--- uses -----------------------------------------------------
525!|| element_mod ../common_source/modules/elements/element_mod.F90
526!|| remesh_mod ../engine/share/modules/remesh_mod.F
527!||====================================================================
528 SUBROUTINE rm_imp2(IXC,IXTG,V ,VR ,SH4TREE,SH3TREE)
529C-----------------------------------------------
530C M o d u l e s
531C-----------------------------------------------
532 USE remesh_mod
533 use element_mod , only : nixc,nixtg
534C-----------------------------------------------
535C I m p l i c i t T y p e s
536C-----------------------------------------------
537#include "implicit_f.inc"
538C-----------------------------------------------
539C G l o b a l P a r a m e t e r s
540C-----------------------------------------------
541#include "param_c.inc"
542#include "remesh_c.inc"
543C-----------------------------------------------
544C D u m m y A r g u m e n t s
545C-----------------------------------------------
546 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
547 2 SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*)
548 my_real
549 . V(3,*),VR(3,*)
550C-----------------------------------------------
551C L o c a l V a r i a b l e s
552C-----------------------------------------------
553 INTEGER N, NN, LEVEL, IP, NLEV, IERR
554 INTEGER SON,M(4),MC,N1,N2,N3,N4,J
555C-----------------------------------------------
556 TAGNOD=0
557C-------
558 DO level=0,levelmax-1
559
560 DO nn=psh4kin(level)+1,psh4kin(level+1)
561 n =lsh4kin(nn)
562C
563 n1=ixc(2,n)
564 n2=ixc(3,n)
565 n3=ixc(4,n)
566 n4=ixc(5,n)
567C
568 son=sh4tree(2,n)
569C
570 mc=ixc(3,son+3)
571
572 IF(tagnod(mc)==0)THEN
573 tagnod(mc)=1
574 DO j=1,3
575 v(j,mc)= fourth*(v(j,n1)+v(j,n2)+v(j,n3)+v(j,n4))
576 END DO
577 DO j=1,3
578 vr(j,mc)= fourth*(vr(j,n1)+vr(j,n2)+vr(j,n3)+vr(j,n4))
579 END DO
580 ELSE
581 END IF
582C
583 m(1)=ixc(3,son )
584 m(2)=ixc(4,son+1)
585 m(3)=ixc(5,son+2)
586 m(4)=ixc(2,son+3)
587
588 IF(tagnod(m(1))==0)THEN
589 tagnod(m(1))=1
590 DO j=1,3
591 v(j,m(1))= half*(v(j,n1)+v(j,n2))
592 END DO
593 DO j=1,3
594 vr(j,m(1))= half*(vr(j,n1)+vr(j,n2))
595 END DO
596 ELSE
597 END IF
598
599 IF(tagnod(m(2))==0)THEN
600 tagnod(m(2))=1
601 DO j=1,3
602 v(j,m(2))= half*(v(j,n2)+v(j,n3))
603 END DO
604 DO j=1,3
605 vr(j,m(2))= half*(vr(j,n2)+vr(j,n3))
606 END DO
607 ELSE
608 END IF
609
610 IF(tagnod(m(3))==0)THEN
611 tagnod(m(3))=1
612 DO j=1,3
613 v(j,m(3))= half*(v(j,n3)+v(j,n4))
614 END DO
615 DO j=1,3
616 vr(j,m(3))= half*(vr(j,n3)+vr(j,n4))
617 END DO
618 ELSE
619 END IF
620
621 IF(tagnod(m(4))==0)THEN
622 tagnod(m(4))=1
623 DO j=1,3
624 v(j,m(4))= half*(v(j,n4)+v(j,n1))
625 END DO
626 DO j=1,3
627 vr(j,m(4))= half*(vr(j,n4)+vr(j,n1))
628 END DO
629 ELSE
630 END IF
631 END DO
632
633 DO nn=psh3kin(level)+1,psh3kin(level+1)
634 n =lsh3kin(nn)
635C
636 n1=ixtg(2,n)
637 n2=ixtg(3,n)
638 n3=ixtg(4,n)
639C
640 son=sh3tree(2,n)
641C
642 m(1)=ixtg(4,son+3)
643 m(2)=ixtg(2,son+3)
644 m(3)=ixtg(3,son+3)
645
646 IF(tagnod(m(1))==0)THEN
647 tagnod(m(1))=1
648 DO j=1,3
649 v(j,m(1))= half*(v(j,n1)+v(j,n2))
650 END DO
651 DO j=1,3
652 vr(j,m(1))= half*(vr(j,n1)+vr(j,n2))
653 END DO
654 ELSE
655 END IF
656
657 IF(tagnod(m(2))==0)THEN
658 tagnod(m(2))=1
659 DO j=1,3
660 v(j,m(2))= half*(v(j,n2)+v(j,n3))
661 END DO
662 DO j=1,3
663 vr(j,m(2))= half*(vr(j,n2)+vr(j,n3))
664 END DO
665 ELSE
666 END IF
667
668 IF(tagnod(m(3))==0)THEN
669 tagnod(m(3))=1
670 DO j=1,3
671 v(j,m(3))= half*(v(j,n3)+v(j,n1))
672 END DO
673 DO j=1,3
674 vr(j,m(3))= half*(vr(j,n3)+vr(j,n1))
675 END DO
676 ELSE
677 END IF
678 END DO
679C
680 END DO
681C
682 RETURN
683 END
my_real
#define my_real
Definition cppsort.cpp:32
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:892
put_kii
subroutine put_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:655
put_kij
subroutine put_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:812
get_kii
subroutine get_kii(ni, iddl, iadk, k_diag, k_lt, kii, nd)
Definition imp_glob_k.F:593
get_kij
subroutine get_kij(ni, nj, iddl, iadk, jdik, k_lt, kij, nk, nl, ierr)
Definition imp_glob_k.F:715
reorder_a
subroutine reorder_a(n, ic, id)
Definition ind_glob_k.F:4286
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
remesh_mod
Definition remesh_mod.F:50
remesh_mod::lsh3act
integer, dimension(:), allocatable lsh3act
Definition remesh_mod.F:62
remesh_mod::iad_nj
integer, dimension(:), allocatable iad_nj
Definition remesh_mod.F:88
remesh_mod::lsh4kin
integer, dimension(:), allocatable lsh4kin
Definition remesh_mod.F:62
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::lsh3kin
integer, dimension(:), allocatable lsh3kin
Definition remesh_mod.F:62
remesh_mod::psh4kin
integer, dimension(:), allocatable psh4kin
Definition remesh_mod.F:62
remesh_mod::nsh_kin
integer nsh_kin
Definition remesh_mod.F:91
remesh_mod::psh3kin
integer, dimension(:), allocatable psh3kin
Definition remesh_mod.F:62
remesh_mod::tagnod
integer, dimension(:), allocatable tagnod
Definition remesh_mod.F:77
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
rm_imp2
subroutine rm_imp2(ixc, ixtg, v, vr, sh4tree, sh3tree)
Definition rm_imp0.F:529
rmind_imp
subroutine rmind_imp(nnmax, inloc, nrowk, icok)
Definition rm_imp0.F:334
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:435
rm_imp0
subroutine rm_imp0(nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b, itab)
Definition rm_imp0.F:387
rmdim_imp
subroutine rmdim_imp(ixc, ixtg, ndof, nnmax, nkine, inloc, nrow, itab, sh4tree, sh3tree)
Definition rm_imp0.F:36