OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_move_funct.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!|| hm_read_move_funct ../starter/source/tools/curve/hm_read_move_funct.f
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
30!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
31!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
32!||--- uses -----------------------------------------------------
33!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!|| table_mod ../starter/share/modules1/table_mod.F
36!||====================================================================
37 SUBROUTINE hm_read_move_funct(NPC,PLD,NFUNCT,TABLE,NTABLE,FUNCRYPT,UNITAB, LSUBMODEL)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE unitab_mod
42 USE table_mod
43 USE submodel_mod
44 USE hm_option_read_mod
45 USE names_and_titles_mod , ONLY : nchartitle
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NFUNCT, NTABLE
54 INTEGER NPC(*),FUNCRYPT(*)
55 my_real pld(*)
56 TYPE(ttable) TABLE(*)
57 TYPE(unit_type_), INTENT(IN) :: UNITAB
58 TYPE(submodel_data), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "units_c.inc"
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,J,N,ID,IFIX_TMP,CPT
67 my_real scx,scy,shx,shy
68 my_real, DIMENSION(:),ALLOCATABLE :: pld_tmp
69 INTEGER :: NMOVE_FUNCT
70 LOGICAL :: IS_AVAILABLE
71 CHARACTER(LEN=NCHARTITLE) :: TITR
72! *************************** !
73! * Count /MOVE_FUNCT cards * !
74! *************************** !
75 CALL hm_option_count('/MOVE_FUNCT', nmove_funct)
76
77 IF (nmove_funct > 0) THEN
78 WRITE (iout, 2000)
79 CALL hm_option_start('/MOVE_FUNCT')
80 DO i = 1, nmove_funct
81 CALL hm_option_read_key(lsubmodel, option_id = id, option_titr = titr)
82 CALL hm_get_floatv('Ascalex', scx, is_available, lsubmodel, unitab)
83 CALL hm_get_floatv('Fscaley', scy, is_available, lsubmodel, unitab)
84 CALL hm_get_floatv('Ashiftx', shx, is_available, lsubmodel, unitab)
85 CALL hm_get_floatv('Fshifty', shy, is_available, lsubmodel, unitab)
86
87 IF (scx == zero) scx = one
88 IF (scy == zero) scy = one
89 DO n = 1,nfunct
90 IF (npc(nfunct+1+n) == id) THEN
91 IF (funcrypt(n) == 0) THEN
92 WRITE (iout,2100) id,scx,scy,shx,shy
93 ELSE
94 WRITE (iout,2200) id,scx,scy,shx,shy
95 ENDIF
96 IF(scx >= zero) THEN
97 DO j = npc(n),npc(n+1)-1,2
98 pld(j) = pld(j) *scx
99 pld(j+1) = pld(j+1)*scy
100 pld(j) = pld(j) +shx
101 pld(j+1) = pld(j+1)+shy
102 IF (funcrypt(n) == 0) WRITE(iout,'(8X,1PG20.13,2X,1G20.13)')pld(j),pld(j+1)
103 ENDDO
104 ELSEIF(scx < zero) THEN
105 ALLOCATE(pld_tmp(npc(n+1)))
106 cpt = 1
107 DO j = npc(n),npc(n+1)-1,2
108 pld_tmp(j) = pld(npc(n+1)-1-cpt) *scx
109 pld_tmp(j+1) = pld(npc(n+1)-cpt)*scy
110 pld_tmp(j) = pld_tmp(j) +shx
111 pld_tmp(j+1) = pld_tmp(j+1)+shy
112 cpt = cpt + 2
113 ENDDO
114 DO j = npc(n),npc(n+1)-1,2
115 pld(j) = pld_tmp(j)
116 pld(j+1) = pld_tmp(j+1)
117 IF (funcrypt(n) == 0) WRITE(iout,'(8X,1PG20.13,2X,1G20.13)')pld(j),pld(j+1)
118 ENDDO
119 IF(ALLOCATED(pld_tmp)) DEALLOCATE(pld_tmp)
120 ENDIF
121 EXIT
122 ENDIF
123 ENDDO
124 DO n = 1,ntable
125 IF (table(n)%NOTABLE == id) THEN
126 IF(scx >= zero) THEN
127 DO j = 1,SIZE(table(n)%X(1)%VALUES)
128 table(n)%X(1)%VALUES(j)= table(n)%X(1)%VALUES(j) *scx
129 table(n)%Y%VALUES(j) = table(n)%Y%VALUES(j) *scy
130 table(n)%X(1)%VALUES(j)= table(n)%X(1)%VALUES(j) +shx
131 table(n)%Y%VALUES(j) = table(n)%Y%VALUES(j) +shy
132 ENDDO
133 ELSE
134 ALLOCATE(pld_tmp(SIZE(table(n)%X(1)%VALUES)*2))
135 cpt = 1
136 DO j = 1,2*SIZE(table(n)%X(1)%VALUES),2
137 pld_tmp(j) = table(n)%X(1)%VALUES(cpt) *scx +shx
138 pld_tmp(j+1) = table(n)%Y%VALUES(cpt) *scy +shy
139 cpt = cpt + 1
140 ENDDO
141
142 cpt = 1
143 DO j = 1,SIZE(table(n)%X(1)%VALUES)
144 table(n)%X(1)%VALUES(j) = pld_tmp(2*SIZE(table(n)%X(1)%VALUES)-cpt)
145 table(n)%Y%VALUES(j) = pld_tmp(2*SIZE(table(n)%X(1)%VALUES)-cpt+1)
146 cpt = cpt + 2
147 ENDDO
148
149 IF(ALLOCATED(pld_tmp)) DEALLOCATE(pld_tmp)
150 ENDIF
151 EXIT
152 ENDIF
153 ENDDO
154 ENDDO
155 ENDIF
156C
157 RETURN
158C-----------------------------------------------------------------
1592000 FORMAT(//
160 . ' FUNCTION TRANSFORMATION '/)
1612100 FORMAT(/
162 . ' LOAD FUNCTION NUMBER. . . . . =',i10/
163 . ' X SCALE = ',e20.13/,
164 . ' Y SCALE = ',e20.13/,
165 . ' X SHIFT = ',e20.13/,
166 . ' Y SHIFT = ',e20.13/,
167 . ' TRANSFORMED VALUES :'/,
168 . ' X Y ')
1692200 FORMAT(/
170 . ' LOAD FUNCTION NUMBER. . . . . =',i10/
171 . ' X SCALE = ',e20.13/,
172 . ' Y SCALE = ',e20.13/,
173 . ' X SHIFT = ',e20.13/,
174 . ' Y SHIFT = ',e20.13/,
175 . ' TRANSFORMED VALUES : CONFIDENTIAL DATA')
176 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_move_funct
subroutine hm_read_move_funct(npc, pld, nfunct, table, ntable, funcrypt, unitab, lsubmodel)
Definition hm_read_move_funct.F:38
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
hm_option_read_mod
Definition hm_option_read_mod.F:408
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
table_mod
Definition table_mod.F:112
unitab_mod
Definition unitab_mod.F:513
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723
table_mod::ttable
Definition table_mod.F:125
unitab_mod::unit_type_
Definition unitab_mod.F:520