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!|| remesh_mod ../engine/share/modules/remesh_mod.F
32!||====================================================================
33 SUBROUTINE rmdim_imp(IXC ,IXTG ,NDOF ,NNMAX ,NKINE,
34 1 INLOC,NROW ,ITAB ,SH4TREE,SH3TREE)
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
320 END
321
322!||====================================================================
323!|| rmind_imp ../engine/source/model/remesh/rm_imp0.F
324!||--- called by ------------------------------------------------------
325!|| ind_kine_k ../engine/source/implicit/ind_glob_k.F
326!||--- calls -----------------------------------------------------
327!|| reorder_a ../engine/source/implicit/ind_glob_k.F
328!||--- uses -----------------------------------------------------
329!|| remesh_mod ../engine/share/modules/remesh_mod.F
330!||====================================================================
331 SUBROUTINE rmind_imp(NNMAX,INLOC,NROWK,ICOK )
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
372 END
373
374!||====================================================================
375!|| rm_imp0 ../engine/source/model/remesh/rm_imp0.F
376!||--- called by ------------------------------------------------------
377!|| upd_glob_k ../engine/source/implicit/upd_glob_k.F
378!||--- calls -----------------------------------------------------
379!|| rm_imp1 ../engine/source/model/remesh/rm_imp0.F
380!||--- uses -----------------------------------------------------
381!|| remesh_mod ../engine/share/modules/remesh_mod.F
382!||====================================================================
383 SUBROUTINE rm_imp0(NDDL ,IADK ,JDIK ,DIAG_K ,LT_K ,
384 1 NDOF ,IDDL ,IKC ,B ,ITAB )
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
415 END
416
417!||====================================================================
418!|| rm_imp1 ../engine/source/model/remesh/rm_imp0.F
419!||--- called by ------------------------------------------------------
420!|| rm_imp0 ../engine/source/model/remesh/rm_imp0.F
421!||--- calls -----------------------------------------------------
422!|| get_kii ../engine/source/implicit/imp_glob_k.F
423!|| get_kij ../engine/source/implicit/imp_glob_k.F
424!|| print_wkij ../engine/source/implicit/imp_glob_k.F
425!|| put_kii ../engine/source/implicit/imp_glob_k.F
426!|| put_kij ../engine/source/implicit/imp_glob_k.F
427!|| updkdd ../engine/source/interfaces/interf/i2_imp1.F
428!|| updkdd1 ../engine/source/interfaces/interf/i2_imp1.F
429!||====================================================================
430 SUBROUTINE rm_imp1(NIR ,IRECT ,I ,NR ,NODS ,
431 3 ITAB ,IKC ,NDOF ,NDDL ,IDDL ,
432 4 IADK ,JDIK ,DIAG_K,LT_K ,B )
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
517 END
518!||====================================================================
519!|| rm_imp2 ../engine/source/model/remesh/rm_imp0.F
520!||--- called by ------------------------------------------------------
521!|| recukin ../engine/source/implicit/recudis.f
522!||--- uses -----------------------------------------------------
523!|| remesh_mod ../engine/share/modules/remesh_mod.F
524!||====================================================================
525 SUBROUTINE rm_imp2(IXC,IXTG,V ,VR ,SH4TREE,SH3TREE)
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
679 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: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
reorder_a
subroutine reorder_a(n, ic, id)
Definition ind_glob_k.F:4268
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
recudis
subroutine recudis(nddl, iddl, ndof, ikc, lx, d, dr, inloc)
Definition recudis.F:31
recukin
subroutine recukin(rby, lpby, npby, skew, iskew, itab, weight, ms, in, ibfv, vel, icodt, icodr, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, d, dr, x, xframe, lj, ixr, ixc, ixtg, sh4tree, sh3tree, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition recudis.F:103
rm_imp2
subroutine rm_imp2(ixc, ixtg, v, vr, sh4tree, sh3tree)
Definition rm_imp0.F:526
rmind_imp
subroutine rmind_imp(nnmax, inloc, nrowk, icok)
Definition rm_imp0.F:332
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_imp0
subroutine rm_imp0(nddl, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, b, itab)
Definition rm_imp0.F:385
rmdim_imp
subroutine rmdim_imp(ixc, ixtg, ndof, nnmax, nkine, inloc, nrow, itab, sh4tree, sh3tree)
Definition rm_imp0.F:35