OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
state_n_vel.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!|| stat_n_vel ../engine/source/output/sta/state_n_vel.F
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.F
27!||--- calls -----------------------------------------------------
28!|| spmd_dstat_vgath ../engine/source/mpi/output/spmd_stat.F
29!|| strs_txt50 ../engine/source/output/sta/sta_txt.F
30!||--- uses -----------------------------------------------------
31!|| my_alloc_mod ../common_source/tools/memory/my_alloc.f90
32!||====================================================================
33 SUBROUTINE stat_n_vel(NUMNOD ,ITAB ,ITABG ,LENG ,NODGLOB,
34 . WEIGHT ,NODTAG ,V ,VR )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE my_alloc_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "units_c.inc"
47#include "task_c.inc"
48#include "scr14_c.inc"
49#include "spmd_c.inc"
50#include "com01_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER ITAB(*),NUMNOD,WEIGHT(*),ITABG(*),LENG,
55 . nodglob(*),nodtag(*)
56 my_real
57 . v(3,*),vr(3,*)
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I,J
62 INTEGER,DIMENSION(:),ALLOCATABLE :: NODTAGLOB
63 my_real,DIMENSION(:,:),ALLOCATABLE :: vg
64 my_real,DIMENSION(:,:),ALLOCATABLE :: vrg
65 CHARACTER(LEN=100) :: LINE
66 INTEGER LEN_LINE
67C-----------------------------------------------
68 CALL my_alloc(nodtaglob,leng)
69 CALL my_alloc(vg,3,leng)
70 CALL my_alloc(vrg,3,leng)
71C-----------------------------------------------
72!
73 IF (nspmd > 1) THEN
74 CALL spmd_dstat_vgath(v,nodglob,weight,vg,nodtag,
75 . nodtaglob)
76 CALL spmd_dstat_vgath(vr,nodglob,weight,vrg,nodtag,
77 . nodtaglob)
78 IF (ispmd /= 0) RETURN
79 ENDIF
80
81 IF (izipstrs == 0) THEN
82 WRITE(iugeo,'(A)') '/INIVEL/NODE/1'
83 WRITE(iugeo,'(A)') 'INITIAL NODAL VELOCITY'
84 ELSE
85 ! Write STATE File in GZIP format
86 WRITE(line,'(A)') '/INIVEL/NODE/1'
87 len_line=len_trim(line)
88 CALL strs_txt50(line,len_line)
89!
90 WRITE(line,'(A)') 'INITIAL NODAL VELOCITY'
91 len_line=len_trim(line)
92 CALL strs_txt50(line,len_line)
93 ENDIF
94!
95 IF (nspmd == 1) THEN
96 DO i=1,numnod
97 IF(nodtag(i) /= 0) THEN
98 IF (izipstrs == 0) THEN
99 WRITE(iugeo,'(2I10,1P3E20.9)') itab(i),0,(v(j,i),j=1,3)
100 IF (iroddl == 0)THEN
101 WRITE(iugeo,'(20X)')
102 ELSE
103 WRITE(iugeo,'(20X,1P3E20.9)') (vr(j,i),j=1,3)
104 END IF
105 ELSE
106 ! Write STATE File in GZIP format
107 WRITE(line,'(2I10,1P3E20.9)') itab(i),0,(v(j,i),j=1,3)
108 len_line=len_trim(line)
109 CALL strs_txt50(line,len_line)
110
111 IF (iroddl == 0) THEN
112 WRITE(line,'(20X)')
113 len_line=len_trim(line)
114 CALL strs_txt50(line,len_line)
115 ELSE
116 WRITE(line,'(20X,1P3E20.9)')(vr(j,i),j=1,3)
117 len_line=len_trim(line)
118 CALL strs_txt50(line,len_line)
119 END IF
120
121 END IF
122 END IF
123 END DO
124 ELSE
125 DO i=1,numnodg
126 IF(nodtaglob(i) /= 0)THEN
127 IF (izipstrs == 0) THEN
128 WRITE(iugeo,'(2I10,1P3E20.9)') itabg(i),0,(vg(j,i),j=1,3)
129 IF (iroddl == 0) THEN
130 WRITE(iugeo,'(20X)')
131 ELSE
132 WRITE(iugeo,'(20x,1p3e20.9)') (VRG(J,I),J=1,3)
133 END IF
134 ELSE
135 ! Write STATE File in GZIP format
136 WRITE(LINE,'(2i10,1p3e20.9)') ITABG(I),0,(VG(J,I),J=1,3)
137 LEN_LINE=LEN_TRIM(LINE)
138 CALL STRS_TXT50(LINE,LEN_LINE)
139
140 IF (IRODDL == 0) THEN
141 WRITE(LINE,'(20x)')
142 LEN_LINE=LEN_TRIM(LINE)
143 CALL STRS_TXT50(LINE,LEN_LINE)
144 ELSE
145 WRITE(LINE,'(20x,1p3e20.9)') (VRG(J,I),J=1,3)
146 LEN_LINE=LEN_TRIM(LINE)
147 CALL STRS_TXT50(LINE,LEN_LINE)
148 END IF
149
150 END IF
151 END IF
152 END DO
153 ENDIF
154C-----------------------------------------------
155 DEALLOCATE(NODTAGLOB)
156 DEALLOCATE(VG)
157 DEALLOCATE(VRG)
158 RETURN
159 END
my_real
#define my_real
Definition cppsort.cpp:32
spmd_dstat_vgath
subroutine spmd_dstat_vgath(v, nodglob, weight, vgath, nodtag, nodtaglob)
Definition spmd_stat.F:212
strs_txt50
subroutine strs_txt50(text, length)
Definition sta_txt.F:87
stat_n_vel
subroutine stat_n_vel(numnod, itab, itabg, leng, nodglob, weight, nodtag, v, vr)
Definition state_n_vel.F:35