OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lectrans.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!|| lectrans ../starter/source/model/transformation/lectrans.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| euler_mrot ../starter/source/model/submodel/euler_mrot.F
30!|| euler_vrot ../starter/source/model/submodel/euler_vrot.F
31!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
34!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
35!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
36!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
37!|| min_dist_grnod_to_surface ../starter/source/model/transformation/min_distance_grnod_to_surface.F90
38!|| min_dist_grnod_to_xyzpos ../starter/source/model/transformation/min_distance_grnod_to_xyzpos.F90
39!|| ngr2usr ../starter/source/system/nintrr.F
40!|| points_to_frame ../starter/source/model/submodel/3points_to_frame.F
41!|| subrotpoint ../starter/source/model/submodel/subrot.F
42!|| subrotvect ../starter/source/model/submodel/subrot.F
43!|| transform_translate_in_local_skew ../starter/source/model/transformation/transform_translate_in_local_skew.F90
44!|| usrtos ../starter/source/system/sysfus.F
45!||--- uses -----------------------------------------------------
46!|| format_mod ../starter/share/modules1/format_mod.F90
47!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
48!|| message_mod ../starter/share/message_module/message_mod.F
49!|| min_dist_grnod_to_surface_mod ../starter/source/model/transformation/min_distance_grnod_to_surface.F90
50!|| min_dist_grnod_to_xyzpos_mod ../starter/source/model/transformation/min_distance_grnod_to_xyzpos.F90
51!|| submodel_mod ../starter/share/modules1/submodel_mod.F
52!|| transform_translate_in_local_skew_mod ../starter/source/model/transformation/transform_translate_in_local_skew.F90
53!||====================================================================
54 SUBROUTINE lectrans(X ,IGRNOD ,ITAB ,ITABM1,UNITAB,
55 . LSUBMODEL,RTRANS ,IGRSURF,ISKWN ,SKEW ,
56 . LISKN ,LSKEW ,NSPCOND,NUMSPH,SISKWN,
57 . SSKEW )
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE submodel_mod
63 USE message_mod
64 USE groupdef_mod
65 USE hm_option_read_mod
66 USE names_and_titles_mod , ONLY : nchartitle, ncharline, ncharfield
67 USE format_mod , ONLY : lfield
68 USE min_dist_grnod_to_surface_mod, ONLY : min_dist_grnod_to_surface
69 USE min_dist_grnod_to_xyzpos_mod, ONLY : min_dist_grnod_to_xyzpos
70 USE transform_translate_in_local_skew_mod, ONLY : transform_translate_in_local_skew
71C-----------------------------------------------
72C I m p l i c i t T y p e s
73C-----------------------------------------------
74#include "implicit_f.inc"
75C-----------------------------------------------
76C C o m m o n B l o c k s
77C-----------------------------------------------
78#include "com04_c.inc"
79#include "scr03_c.inc"
80#include "units_c.inc"
81C-----------------------------------------------
82C D u m m y A r g u m e n t s
83C-----------------------------------------------
84 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
85 INTEGER ITAB(*),ITABM1(*)
86 INTEGER, INTENT(IN) :: LISKN,LSKEW,NSPCOND,NUMSPH,SISKWN,SSKEW
87 INTEGER, INTENT(IN) :: ISKWN(LISKN,SISKWN/LISKN)
88 my_real, INTENT(IN) :: skew(lskew,sskew/lskew)
89 my_real
90 . x(3,*)
91 TYPE(submodel_data) LSUBMODEL(*)
92 my_real
93 . rtrans(ntransf,*)
94C-----------------------------------------------
95 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
96 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
97C-----------------------------------------------
98C L o c a l V a r i a b l e s
99C-----------------------------------------------
100 INTEGER I,I0,I1,I2,I3,I4,I5,I6,
101 . N0,N1,N2,N3,N4,N5,N6,IERROR,
102 . J,IS,ID,UID,IGU,IGS,NN,NTRANS,STAT,
103 . iflagunit,itranssub,sub_id,k,
104 . ibid,cpt,igsurf,isurf,iskew,idir,pflag,pflag0,xyzflag(3),
105 . nseg,nno,surfnod,sub_index,isk,isk0,xyzflag0(3)
106 my_real
107 . lx,ly,lz,tx,ty,tz,r,s,rx,ry,rz,sx,sy,sz,angle,at,fac_l,
108 . xp,yp,zp,gap
109 my_real
110 . vr(3),x0(3),x1(3),x2(3),x3(3),x4(3),x5(3),x6(3),
111 . rot(9),pp(3,3),qq(3,3),p(3),norm1, norm2, norm3, scal1,
112 . scal2, scal3, eps,xyzpos(3),xyzpos0(3)
113 CHARACTER(LEN=NCHARFIELD) :: KEY
114 CHARACTER(LEN=NCHARFIELD) :: MOT1
115 CHARACTER(LEN=NCHARTITLE) :: TITR
116 CHARACTER(LEN=NCHARLINE) ::SOLVERKEYWORD
117 CHARACTER(LEN=NCHARFIELD) :: DIR
118!
119 INTEGER, DIMENSION(:), POINTER :: INGR2USR
120 LOGICAL IS_AVAILABLE,IS_FOUND
121 INTEGER, DIMENSION(:), ALLOCATABLE :: INO, TAGNODE
122C-----------------------------------------------
123C E x t e r n a l F u n c t i o n s
124C-----------------------------------------------
125 INTEGER NGR2USR,USRTOS
126 EXTERNAL NGR2USR,USRTOS
127C--------------------------------------------------
128C COUNT NUMBER TRANSFORM OPTIONS
129C--------------------------------------------------
130 CALL hm_option_count('TRANSFORM',ntrans)
131 fac_l = one
132 is_available = .false.
133 IF (ntrans > 0) WRITE (iout,100)
134C--------------------------------------------------
135C START READING TRANSFORM OPTIONS
136C--------------------------------------------------
137 CALL hm_option_start('TRANSFORM')
138C--------------------------------------------------
139C BROWSING MODEL TRANSFORM 1->NTRANS
140C--------------------------------------------------
141 DO i=1,ntrans
142C--------------------------------------------------
143C EXTRACT DATAS OF /TRANSFORM/... LINE
144C--------------------------------------------------
145 CALL hm_option_read_key(lsubmodel,
146 . option_id = id,
147 . unit_id = uid,
148 . submodel_id = sub_id,
149 . submodel_index = sub_index,
150 . option_titr = titr,
151 . keyword2 = key)
152 rtrans(i,19) = id
153C----
154 IF (key(1:3) == 'TRA') THEN
155C--------------------------------------------------
156C EXTRACT DATAS (INTEGER VALUES)
157C--------------------------------------------------
158 CALL hm_get_intv('GR_NODE',igu,is_available,lsubmodel)
159 CALL hm_get_intv('node1',n0,is_available,lsubmodel)
160 CALL hm_get_intv('node2',n1,is_available,lsubmodel)
161 CALL hm_get_intv('SUBMODEL',itranssub,is_available,lsubmodel)
162 CALL hm_get_intv('skew_ID',isk0,is_available,lsubmodel)
163 IF( isk0 == 0 .AND. sub_index /= 0 ) isk0 = lsubmodel(sub_index)%SKEW
164C--------------------------------------------------
165C EXTRACT DATAS (REAL VALUES)
166C--------------------------------------------------
167 CALL hm_get_floatv('translation_x',tx,is_available,lsubmodel,unitab)
168 CALL hm_get_floatv('translation_y',ty,is_available,lsubmodel,unitab)
169 CALL hm_get_floatv('translation_z',tz,is_available,lsubmodel,unitab)
170c---------------------
171 IF (itranssub /= 0) cycle
172c---------------------
173 rtrans(i,2) = 1
174c---------------------
175 ingr2usr => igrnod(1:ngrnod)%ID
176 igs = ngr2usr(igu,ingr2usr,ngrnod)
177 IF (igs == 0) THEN
178 CALL ancmsg(msgid=1865,
179 . msgtype=msgerror,
180 . anmode=aninfo,
181 . i1= id,
182 . c1= titr,
183 . i2= igu)
184 ENDIF
185 rtrans(i,18)=igs
186
187 isk = 0
188 IF (isk0 > 0) THEN
189 is_found = .false.
190 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
191 IF (isk0 == iskwn(4,j+1)) THEN
192 isk=j+1
193 is_found = .true.
194 EXIT
195 ENDIF
196 ENDDO
197 IF(.NOT. is_found)THEN
198 CALL ancmsg(msgid=3117,
199 . msgtype=msgerror,
200 . anmode=aninfo,
201 . i1= id,
202 . c1= titr,
203 . i2= isk0)
204 ENDIF
205 ENDIF
206 IF (n0 > 0 .OR. n1 > 0) THEN
207 isk = 0
208 i0 = usrtos(n0,itabm1)
209 i1 = usrtos(n1,itabm1)
210 IF (i0 == 0) THEN
211 CALL ancmsg(msgid=694,
212 . msgtype=msgerror,
213 . anmode=aninfo,
214 . i1=id,
215 . c1=titr,
216 . i2=n0)
217 END IF
218 IF (i1 == 0) THEN
219 CALL ancmsg(msgid=694,
220 . msgtype=msgerror,
221 . anmode=aninfo,
222 . i1=id,
223 . c1=titr,
224 . i2=n1)
225 END IF
226 tx = x(1,i1) - x(1,i0)
227 ty = x(2,i1) - x(2,i0)
228 tz = x(3,i1) - x(3,i0)
229 ELSE
230 tx = tx * fac_l
231 ty = ty * fac_l
232 tz = tz * fac_l
233 ENDIF
234
235 CALL transform_translate_in_local_skew(
236 . igrnod(igs)%ENTITY ,igrnod(igs)%NENTITY ,x ,numnod , isk ,
237 . tx ,ty ,tz ,skew , lskew,
238 . sskew )
239
240 s = sqrt(tx*tx + ty*ty + tz*tz)
241C
242 WRITE(iout,500) id,igu
243 IF (n0 > 0 .AND. n1 > 0) WRITE(iout,200) n0,n1
244 WRITE(iout,510) s,tx,ty,tz,isk0
245 IF (ipri > 3) THEN
246 WRITE (iout,3000)
247 DO j=1,igrnod(igs)%NENTITY
248 is=igrnod(igs)%ENTITY(j)
249 WRITE(iout,3500) itab(is),x(1,is),x(2,is),x(3,is)
250 ENDDO
251 ENDIF
252C----
253 ELSEIF (key(1:3) == 'ROT') THEN
254C--------------------------------------------------
255C EXTRACT DATAS (INTEGER VALUES)
256C--------------------------------------------------
257 CALL hm_get_intv('GR_NODE',igu,is_available,lsubmodel)
258 CALL hm_get_intv('node1',n0,is_available,lsubmodel)
259 CALL hm_get_intv('node2',n1,is_available,lsubmodel)
260 CALL hm_get_intv('SUBMODEL',itranssub,is_available,lsubmodel)
261C--------------------------------------------------
262C EXTRACT DATAS (REAL VALUES)
263C--------------------------------------------------
264 CALL hm_get_floatv('rotation_point1_x',x0(1),is_available,lsubmodel,unitab)
265 CALL hm_get_floatv('rotation_point1_y',x0(2),is_available,lsubmodel,unitab)
266 CALL hm_get_floatv('rotation_point1_z',x0(3),is_available,lsubmodel,unitab)
267 CALL hm_get_floatv('rotation_point2_x',X1(1),IS_AVAILABLE,LSUBMODEL,UNITAB)
268 CALL HM_GET_FLOATV('rotation_point2_y',X1(2),IS_AVAILABLE,LSUBMODEL,UNITAB)
269 CALL HM_GET_FLOATV('rotation_point2_z',X1(3),IS_AVAILABLE,LSUBMODEL,UNITAB)
270 CALL HM_GET_FLOATV('rotation_angle',ANGLE,IS_AVAILABLE,LSUBMODEL,UNITAB)
271C--------------------------------------------------
272C APPLY //SUBMODEL TRANSFORMATIONs
273C--------------------------------------------------
274 IF(SUB_ID /= 0)
275 . CALL SUBROTPOINT(X0(1),X0(2),X0(3),RTRANS,SUB_ID,LSUBMODEL)
276c---------------------
277 IF(SUB_ID /= 0)
278 . CALL SUBROTPOINT(X1(1),X1(2),X1(3),RTRANS,SUB_ID,LSUBMODEL)
279c---------------------
280 IF (ITRANSSUB /= 0) CYCLE
281c---------------------
282 RTRANS(I,2) = 2
283c---------------------
284.OR. IF (N0 > 0 N1 > 0) THEN
285 I0 = USRTOS(N0,ITABM1)
286 I1 = USRTOS(N1,ITABM1)
287 IF (I0 == 0) THEN
288 CALL ANCMSG(MSGID=694,
289 . MSGTYPE=MSGERROR,
290 . ANMODE=ANINFO,
291 . I1=ID,
292 . C1=TITR,
293 . I2=N0)
294 END IF
295 IF (I1 == 0) THEN
296 CALL ANCMSG(MSGID=694,
297 . MSGTYPE=MSGERROR,
298 . ANMODE=ANINFO,
299 . I1=ID,
300 . C1=TITR,
301 . I2=N1)
302 END IF
303 X0(1) = X(1,I0)
304 X0(2) = X(2,I0)
305 X0(3) = X(3,I0)
306 X1(1) = X(1,I1)
307 X1(2) = X(2,I1)
308 X1(3) = X(3,I1)
309 ELSE
310 X0(1) = X0(1) * FAC_L
311 X0(2) = X0(2) * FAC_L
312 X0(3) = X0(3) * FAC_L
313 X1(1) = X1(1) * FAC_L
314 X1(2) = X1(2) * FAC_L
315 X1(3) = X1(3) * FAC_L
316 ENDIF
317 TX = X1(1) - X0(1)
318 TY = X1(2) - X0(2)
319 TZ = X1(3) - X0(3)
320 S = SQRT(TX*TX + TY*TY + TZ*TZ)
321 AT = ANGLE * PI/HUNDRED80 /MAX(EM20,S)
322 TX = TX * AT
323 TY = TY * AT
324 TZ = TZ * AT
325 INGR2USR => IGRNOD(1:NGRNOD)%ID
326 IGS = NGR2USR(IGU,INGR2USR,NGRNOD)
327 IF (IGS == 0) THEN
328 CALL ANCMSG(MSGID=1865,
329 . MSGTYPE=MSGERROR,
330 . ANMODE=ANINFO,
331 . I1= ID,
332 . C1= TITR,
333 . I2= IGU)
334 ENDIF
335 RTRANS(I,18)=IGS
336 IF (ANGLE /= ZERO) THEN
337 CALL EULER_MROT (TX,TY,TZ,ROT)
338 DO J=1,IGRNOD(IGS)%NENTITY
339 IS=IGRNOD(IGS)%ENTITY(J)
340 CALL EULER_VROT (X0,X(1,IS),ROT)
341 ENDDO
342 ENDIF
343C
344 WRITE(IOUT,600) ID,IGU
345.AND. IF (N0 > 0 N1 > 0) WRITE(IOUT,200) N0,N1
346 WRITE(IOUT,610) X0(1),X0(2),X0(3),TX,TY,TZ,ANGLE
347 IF (IPRI > 3) THEN
348 WRITE (IOUT,3000)
349 DO J=1,IGRNOD(IGS)%NENTITY
350 IS=IGRNOD(IGS)%ENTITY(J)
351 WRITE(IOUT,3500) ITAB(IS),X(1,IS),X(2,IS),X(3,IS)
352 ENDDO
353 ENDIF
354C----
355 ELSEIF (KEY(1:3) == 'sym') THEN
356C--------------------------------------------------
357C EXTRACT DATAS (INTEGER VALUES)
358C--------------------------------------------------
359 CALL HM_GET_INTV('gr_node',IGU,IS_AVAILABLE,LSUBMODEL)
360 CALL HM_GET_INTV('node1',N0,IS_AVAILABLE,LSUBMODEL)
361 CALL HM_GET_INTV('node2',N1,IS_AVAILABLE,LSUBMODEL)
362 CALL HM_GET_INTV('submodel',ITRANSSUB,IS_AVAILABLE,LSUBMODEL)
363C--------------------------------------------------
364C EXTRACT DATAS (REAL VALUES)
365C--------------------------------------------------
366 CALL HM_GET_FLOATV('reflect_point1_x',X0(1),IS_AVAILABLE,LSUBMODEL,UNITAB)
367 CALL HM_GET_FLOATV('reflect_point1_y',x0(2),is_available,lsubmodel,unitab)
368 CALL hm_get_floatv('reflect_point1_z',x0(3),is_available,lsubmodel,unitab)
369 CALL hm_get_floatv('reflect_point2_x',x1(1),is_available,lsubmodel,unitab)
370 CALL hm_get_floatv('reflect_point2_y',x1(2),is_available,lsubmodel,unitab)
371 CALL hm_get_floatv('reflect_point2_z',x1(3),is_available,lsubmodel,unitab)
372c---------------------
373 IF (itranssub /= 0) cycle
374c---------------------
375 rtrans(i,2) = 5
376C--------------------------------------------------
377 IF(sub_id /= 0)
378 . CALL subrotpoint(x0(1),x0(2),x0(3),rtrans,sub_id,lsubmodel)
379 IF(sub_id /= 0)
380 . CALL subrotpoint(x1(1),x1(2),x1(3),rtrans,sub_id,lsubmodel)
381C--------------------------------------------------
382 ingr2usr => igrnod(1:ngrnod)%ID
383 igs = ngr2usr(igu,ingr2usr,ngrnod)
384 IF (igs == 0) THEN
385 CALL ancmsg(msgid=1865,
386 . msgtype=msgerror,
387 . anmode=aninfo,
388 . i1= id,
389 . c1= titr,
390 . i2= igu)
391 ENDIF
392 rtrans(i,18)=igs
393 IF (n0 > 0 .OR. n1 > 0) THEN
394 i0 = usrtos(n0,itabm1)
395 i1 = usrtos(n1,itabm1)
396 IF (i0 == 0) THEN
397 CALL ancmsg(msgid=694,
398 . msgtype=msgerror,
399 . anmode=aninfo,
400 . i1=id,
401 . c1=titr,
402 . i2=n0)
403 END IF
404 IF (i1 == 0) THEN
405 CALL ancmsg(msgid=694,
406 . msgtype=msgerror,
407 . anmode=aninfo,
408 . i1=id,
409 . c1=titr,
410 . i2=n1)
411 END IF
412 x0(1) = x(1,i0)
413 x0(2) = x(2,i0)
414 x0(3) = x(3,i0)
415 x1(1) = x(1,i1)
416 x1(2) = x(2,i1)
417 x1(3) = x(3,i1)
418 ELSE
419 x0(1) = x0(1) * fac_l
420 x0(2) = x0(2) * fac_l
421 x0(3) = x0(3) * fac_l
422 x1(1) = x1(1) * fac_l
423 x1(2) = x1(2) * fac_l
424 x1(3) = x1(3) * fac_l
425 ENDIF
426 tx = x1(1) - x0(1)
427 ty = x1(2) - x0(2)
428 tz = x1(3) - x0(3)
429 s = one/max(sqrt(tx*tx + ty*ty + tz*tz),em20)
430 tx = tx*s
431 ty = ty*s
432 tz = tz*s
433 DO j=1,igrnod(igs)%NENTITY
434 is=igrnod(igs)%ENTITY(j)
435 sx = x(1,is) - x0(1)
436 sy = x(2,is) - x0(2)
437 sz = x(3,is) - x0(3)
438 s = sx*tx + sy*ty + sz*tz
439 x(1,is) = x(1,is) - two*tx*s
440 x(2,is) = x(2,is) - two*ty*s
441 x(3,is) = x(3,is) - two*tz*s
442 ENDDO
443C
444 WRITE(iout,700) id,igu
445 IF (n0 > 0 .AND. n1 > 0) WRITE(iout,200) n0,n1
446 WRITE(iout,710) x0(1),x0(2),x0(3),tx,ty,tz
447 IF (ipri > 3) THEN
448 WRITE (iout,3000)
449 DO j=1,igrnod(igs)%NENTITY
450 is=igrnod(igs)%ENTITY(j)
451 WRITE(iout,3500) itab(is),x(1,is),x(2,is),x(3,is)
452 ENDDO
453 ENDIF
454C----
455 ELSEIF (key(1:3) == 'SCA') THEN
456C--------------------------------------------------
457C EXTRACT DATAS (INTEGER VALUES)
458C--------------------------------------------------
459 CALL hm_get_intv('GR_NODE',igu,is_available,lsubmodel)
460 CALL hm_get_intv('node1',n0,is_available,lsubmodel)
461 CALL hm_get_intv('SUBMODEL',itranssub,is_available,lsubmodel)
462C--------------------------------------------------
463C EXTRACT DATAS (REAL VALUES)
464C--------------------------------------------------
465 CALL hm_get_floatv('scalefactor_x',tx,is_available,lsubmodel,unitab)
466 CALL hm_get_floatv('scalefactor_y',ty,is_available,lsubmodel,unitab)
467 CALL hm_get_floatv('scalefactor_z',tz,is_available,lsubmodel,unitab)
468c---------------------
469 IF (itranssub /= 0) cycle
470c---------------------
471 rtrans(i,2) = 6
472C--------------------------------------------------
473 IF (tx == zero) tx = one
474 IF (ty == zero) ty = one
475 IF (tz == zero) tz = one
476 IF(sub_id /= 0)
477 . CALL subrotvect(tx,ty,tz,rtrans,sub_id,lsubmodel)
478C--------------------------------------------------
479 ingr2usr => igrnod(1:ngrnod)%ID
480 igs = ngr2usr(igu,ingr2usr,ngrnod)
481 IF (igs == 0) THEN
482 CALL ancmsg(msgid=1865,
483 . msgtype=msgerror,
484 . anmode=aninfo,
485 . i1= id,
486 . c1= titr,
487 . i2= igu)
488 ENDIF
489 rtrans(i,18)=igs
490 IF (n0 > 0) THEN
491 i0 = usrtos(n0,itabm1)
492 IF (i0 == 0) THEN
493 CALL ancmsg(msgid=694,
494 . msgtype=msgerror,
495 . anmode=aninfo,
496 . i1=id,
497 . c1=titr,
498 . i2=n1)
499 END IF
500 x0(1) = x(1,i0)
501 x0(2) = x(2,i0)
502 x0(3) = x(3,i0)
503 ELSE
504 x0(1) = zero
505 x0(2) = zero
506 x0(3) = zero
507 ENDIF
508 DO j=1,igrnod(igs)%NENTITY
509 is=igrnod(igs)%ENTITY(j)
510 x(1,is) = x0(1) + (x(1,is) - x0(1)) * tx
511 x(2,is) = x0(2) + (x(2,is) - x0(2)) * ty
512 x(3,is) = x0(3) + (x(3,is) - x0(3)) * tz
513 ENDDO
514C
515 WRITE(iout,800) id,igu
516 IF (n0 > 0) WRITE(iout,300) n0
517 WRITE(iout,810) tx,ty,tz
518 IF (ipri > 3) THEN
519 WRITE (iout,3000)
520 DO j=1,igrnod(igs)%NENTITY
521 is=igrnod(igs)%ENTITY(j)
522 WRITE(iout,3500) itab(is),x(1,is),x(2,is),x(3,is)
523 ENDDO
524 ENDIF
525C----
526 ELSEIF (key(1:6) == 'MATRIX') THEN
527
528 CALL hm_get_intv('GR_NODE',igu,is_available,lsubmodel)
529 CALL hm_get_floatv('vector_1_x',rtrans(i,3),is_available,lsubmodel,unitab)
530 CALL hm_get_floatv('vector_1_y',rtrans(i,6),is_available,lsubmodel,unitab)
531 CALL hm_get_floatv('vector_1_z',rtrans(i,9),is_available,lsubmodel,unitab)
532 CALL hm_get_floatv('vector_2_x',rtrans(i,4),is_available,lsubmodel,unitab)
533 CALL hm_get_floatv('vector_2_y',rtrans(i,7),is_available,lsubmodel,unitab)
534 CALL hm_get_floatv('vector_2_z',rtrans(i,10),is_available,lsubmodel,unitab)
535 CALL hm_get_floatv('vector_3_x',rtrans(i,5),is_available,lsubmodel,unitab)
536 CALL hm_get_floatv('vector_3_y',rtrans(i,8),is_available,lsubmodel,unitab)
537 CALL hm_get_floatv('vector_3_z',rtrans(i,11),is_available,lsubmodel,unitab)
538 CALL hm_get_floatv('position_x',rtrans(i,15),is_available,lsubmodel,unitab)
539 CALL hm_get_floatv('position_y',rtrans(i,16),is_available,lsubmodel,unitab)
540 CALL hm_get_floatv('position_z',rtrans(i,17),is_available,lsubmodel,unitab)
541 CALL hm_get_intv('SUBMODEL',itranssub,is_available,lsubmodel)
542c---------------------
543 IF (itranssub /= 0) cycle
544c---------------------
545 rtrans(i,2) = 3
546c---------------------
547 ingr2usr => igrnod(1:ngrnod)%ID
548 igs = ngr2usr(igu,ingr2usr,ngrnod)
549 IF (igs == 0) THEN
550 CALL ancmsg(msgid=1865,
551 . msgtype=msgerror,
552 . anmode=aninfo,
553 . i1= id,
554 . c1= titr,
555 . i2= igu)
556 ENDIF
557 rtrans(i,18)=igs
558c
559 eps = em3
560 norm1 = sqrt(rtrans(i,3)**2+rtrans(i,6)**2+rtrans(i,9)**2)
561 norm2 = sqrt(rtrans(i,4)**2+rtrans(i,7)**2+rtrans(i,10)**2)
562 norm3 = sqrt(rtrans(i,5)**2+rtrans(i,8)**2+rtrans(i,11)**2)
563 scal1 = rtrans(i,3)*rtrans(i,4)+rtrans(i,6)*rtrans(i,7)+
564 . rtrans(i,9)*rtrans(i,10)
565 scal2 = rtrans(i,3)*rtrans(i,5)+rtrans(i,6)*rtrans(i,8)+
566 . rtrans(i,9)*rtrans(i,11)
567 scal3 = rtrans(i,4)*rtrans(i,5)+rtrans(i,7)*rtrans(i,8)+
568 . rtrans(i,10)*rtrans(i,11)
569 IF(abs(one-norm1) > eps .OR. abs(one-norm2) > eps .OR.
570 . abs(one-norm3) > eps .OR.
571 . scal1 > (eps * norm1*norm2) .OR. scal2 > (eps * norm1*norm3)
572 . .OR. scal3 > (eps * norm2*norm3))THEN
573 CALL ancmsg(msgid=986,
574 . msgtype=msgerror,
575 . anmode=aninfo)
576 ENDIF
577c---------------------
578 DO j=1,igrnod(igs)%NENTITY
579 is=igrnod(igs)%ENTITY(j)
580 xp = rtrans(i,3)*x(1,is) + rtrans(i,6)*x(2,is) + rtrans(i,9)*x(3,is)
581 . + rtrans(i,15)
582 yp = rtrans(i,4)*x(1,is) + rtrans(i,7)*x(2,is) + rtrans(i,10)*x(3,is)
583 . + rtrans(i,16)
584 zp = rtrans(i,5)*x(1,is) + rtrans(i,8)*x(2,is) + rtrans(i,11)*x(3,is)
585 . + rtrans(i,17)
586 x(1,is) = xp
587 x(2,is) = yp
588 x(3,is) = zp
589 ENDDO
590c
591 WRITE(iout,900) id,igu
592c
593 WRITE(iout,910)
594 . rtrans(i,3),rtrans(i,6),rtrans(i,9),rtrans(i,15),
595 . rtrans(i,4),rtrans(i,7),rtrans(i,10),rtrans(i,16),
596 . rtrans(i,5),rtrans(i,8),rtrans(i,11),rtrans(i,17)
597C----
598 ELSEIF (key(1:8) == 'POSITION') THEN
599C--------------------------------------------------
600 CALL hm_get_intv('GR_NODE',igu,is_available,lsubmodel)
601 CALL hm_get_intv('SUBMODEL',itranssub,is_available,lsubmodel)
602C--------------------------------------------------
603C
604 CALL hm_get_intv('node1',n1,is_available,lsubmodel)
605 CALL hm_get_intv('node2',n2,is_available,lsubmodel)
606 CALL hm_get_intv('node3',n3,is_available,lsubmodel)
607 CALL hm_get_intv('node4',n4,is_available,lsubmodel)
608 CALL hm_get_intv('node5',n5,is_available,lsubmodel)
609 CALL hm_get_intv('node6',n6,is_available,lsubmodel)
610C
611 CALL hm_get_floatv('X_Point_1',x1(1),is_available,lsubmodel,unitab)
612 CALL hm_get_floatv('Y_Point_1',x1(2),is_available,lsubmodel,unitab)
613 CALL hm_get_floatv('Z_Point_1',x1(3),is_available,lsubmodel,unitab)
614 CALL hm_get_floatv('X_Point_2',x2(1),is_available,lsubmodel,unitab)
615 CALL hm_get_floatv('Y_Point_2',x2(2),is_available,lsubmodel,unitab)
616 CALL hm_get_floatv('Z_Point_2',x2(3),is_available,lsubmodel,unitab)
617 CALL hm_get_floatv('X_Point_3',x3(1),is_available,lsubmodel,unitab)
618 CALL hm_get_floatv('Y_Point_3',x3(2),is_available,lsubmodel,unitab)
619 CALL hm_get_floatv('Z_Point_3',x3(3),is_available,lsubmodel,unitab)
620 CALL hm_get_floatv('X_Point_4',x4(1),is_available,lsubmodel,unitab)
621 CALL hm_get_floatv('Y_Point_4',x4(2),is_available,lsubmodel,unitab)
622 CALL hm_get_floatv('Z_Point_4',x4(3),is_available,lsubmodel,unitab)
623 CALL hm_get_floatv('X_Point_5',x5(1),is_available,lsubmodel,unitab)
624 CALL hm_get_floatv('Y_Point_5',x5(2),is_available,lsubmodel,unitab)
625 CALL hm_get_floatv('Z_Point_5',x5(3),is_available,lsubmodel,unitab)
626 CALL hm_get_floatv('X_Point_6',x6(1),is_available,lsubmodel,unitab)
627 CALL hm_get_floatv('Y_Point_6',x6(2),is_available,lsubmodel,unitab)
628 CALL hm_get_floatv('Z_Point_6',x6(3),is_available,lsubmodel,unitab)
629c---------------------
630 IF (itranssub /= 0) cycle
631c---------------------
632 rtrans(i,2) = 4
633C--------------------------------------------------
634C APPLY //SUBMODEL TRANSFORMATIONs
635C--------------------------------------------------
636 IF(sub_id /= 0)THEN
637 CALL subrotpoint(x1(1),x1(2),x1(3),rtrans,sub_id,lsubmodel)
638 CALL subrotpoint(x2(1),x2(2),x2(3),rtrans,sub_id,lsubmodel)
639 CALL subrotpoint(x3(1),x3(2),x3(3),rtrans,sub_id,lsubmodel)
640 CALL subrotpoint(x4(1),x4(2),x4(3),rtrans,sub_id,lsubmodel)
641 CALL subrotpoint(x5(1),x5(2),x5(3),rtrans,sub_id,lsubmodel)
642 CALL subrotpoint(x6(1),x6(2),x6(3),rtrans,sub_id,lsubmodel)
643 END IF
644c---------------------
645 ingr2usr => igrnod(1:ngrnod)%ID
646 igs = ngr2usr(igu,ingr2usr,ngrnod)
647 IF (igs == 0) THEN
648 CALL ancmsg(msgid=1865,
649 . msgtype=msgerror,
650 . anmode=aninfo,
651 . i1= id,
652 . c1= titr,
653 . i2= igu)
654 ENDIF
655 rtrans(i,18)=igs
656c---------------------
657C
658 IF (n1 > 0 .OR. n2 > 0 .OR. n3 > 0 .OR.
659 . n4 > 0 .OR. n5 > 0 .OR. n6 > 0) THEN
660 i1 = usrtos(n1,itabm1)
661 i2 = usrtos(n2,itabm1)
662 i3 = usrtos(n3,itabm1)
663 i4 = usrtos(n4,itabm1)
664 i5 = usrtos(n5,itabm1)
665 i6 = usrtos(n6,itabm1)
666 IF (i1 == 0) THEN
667 CALL ancmsg(msgid=694,
668 . msgtype=msgerror,
669 . anmode=anstop,
670 . i1=id,
671 . c1=titr,
672 . i2=n1)
673 END IF
674 x1(1) = x(1,i1)
675 x1(2) = x(2,i1)
676 x1(3) = x(3,i1)
677 IF (i2 == 0) THEN
678 CALL ancmsg(msgid=694,
679 . msgtype=msgerror,
680 . anmode=anstop,
681 . i1=id,
682 . c1=titr,
683 . i2=n2)
684 END IF
685 x2(1) = x(1,i2)
686 x2(2) = x(2,i2)
687 x2(3) = x(3,i2)
688 IF (i3 == 0) THEN
689 CALL ancmsg(msgid=694,
690 . msgtype=msgerror,
691 . anmode=anstop,
692 . i1=id,
693 . c1=titr,
694 . i2=n3)
695 END IF
696 x3(1) = x(1,i3)
697 x3(2) = x(2,i3)
698 x3(3) = x(3,i3)
699 IF (i4 == 0) THEN
700 CALL ancmsg(msgid=694,
701 . msgtype=msgerror,
702 . anmode=anstop,
703 . i1=id,
704 . c1=titr,
705 . i2=n4)
706 END IF
707 x4(1) = x(1,i4)
708 x4(2) = x(2,i4)
709 x4(3) = x(3,i4)
710 IF (i5 == 0) THEN
711 CALL ancmsg(msgid=694,
712 . msgtype=msgerror,
713 . anmode=anstop,
714 . i1=id,
715 . c1=titr,
716 . i2=n5)
717 END IF
718 x5(1) = x(1,i5)
719 x5(2) = x(2,i5)
720 x5(3) = x(3,i5)
721 IF (i6 == 0) THEN
722 CALL ancmsg(msgid=694,
723 . msgtype=msgerror,
724 . anmode=anstop,
725 . i1=id,
726 . c1=titr,
727 . i2=n6)
728 END IF
729 x6(1) = x(1,i6)
730 x6(2) = x(2,i6)
731 x6(3) = x(3,i6)
732 ELSE
733 x1(1) = x1(1) * fac_l
734 x1(2) = x1(2) * fac_l
735 x1(3) = x1(3) * fac_l
736 x2(1) = x2(1) * fac_l
737 x2(2) = x2(2) * fac_l
738 x2(3) = x2(3) * fac_l
739 x3(1) = x3(1) * fac_l
740 x3(2) = x3(2) * fac_l
741 x3(3) = x3(3) * fac_l
742 x4(1) = x4(1) * fac_l
743 x4(2) = x4(2) * fac_l
744 x4(3) = x4(3) * fac_l
745 x5(1) = x5(1) * fac_l
746 x5(2) = x5(2) * fac_l
747 x5(3) = x5(3) * fac_l
748 x6(1) = x6(1) * fac_l
749 x6(2) = x6(2) * fac_l
750 x6(3) = x6(3) * fac_l
751 END IF
752C--------------------------------------------------
753 CALL points_to_frame(x1,x2,x3,pp,ierror)
754 IF(ierror==1.OR.ierror==3)THEN
755 CALL ancmsg(msgid=1866,
756 . msgtype=msgerror,
757 . anmode=aninfo_blind_1,
758 . i1=id,c1=titr)
759 END IF
760 IF(ierror >= 2)THEN
761 CALL ancmsg(msgid=1867,
762 . msgtype=msgwarning,
763 . anmode=aninfo_blind_1,
764 . i1=id,c1=titr)
765 END IF
766 CALL points_to_frame(x4,x5,x6,qq,ierror)
767 IF(ierror == 1)THEN
768 CALL ancmsg(msgid=1868,
769 . msgtype=msgerror,
770 . anmode=aninfo_blind_1,
771 . i1=id,c1=titr)
772C
773 rot(1:9)=zero
774 rot(1) = one
775 rot(5) = one
776 rot(9) = one
777 DO j=1,9
778 rtrans(i,j+2) = rot(j)
779 ENDDO
780 rtrans(i,12:14) = zero
781 rtrans(i,15:17) = zero
782C
783 ELSE
784C
785 IF(ierror == 2)THEN
786 CALL ancmsg(msgid=1869,
787 . msgtype=msgwarning,
788 . anmode=aninfo_blind_1,
789 . i1=id,c1=titr)
790 END IF
791C
792 rot(1)=qq(1,1)*pp(1,1)+qq(1,2)*pp(1,2)+qq(1,3)*pp(1,3) ! QQ . Transpose(PP)
793 rot(4)=qq(1,1)*pp(2,1)+qq(1,2)*pp(2,2)+qq(1,3)*pp(2,3)
794 rot(7)=qq(1,1)*pp(3,1)+qq(1,2)*pp(3,2)+qq(1,3)*pp(3,3)
795 rot(2)=qq(2,1)*pp(1,1)+qq(2,2)*pp(1,2)+qq(2,3)*pp(1,3)
796 rot(5)=qq(2,1)*pp(2,1)+qq(2,2)*pp(2,2)+qq(2,3)*pp(2,3)
797 rot(8)=qq(2,1)*pp(3,1)+qq(2,2)*pp(3,2)+qq(2,3)*pp(3,3)
798 rot(3)=qq(3,1)*pp(1,1)+qq(3,2)*pp(1,2)+qq(3,3)*pp(1,3)
799 rot(6)=qq(3,1)*pp(2,1)+qq(3,2)*pp(2,2)+qq(3,3)*pp(2,3)
800 rot(9)=qq(3,1)*pp(3,1)+qq(3,2)*pp(3,2)+qq(3,3)*pp(3,3)
801C
802 DO j=1,9
803 rtrans(i,j+2) = rot(j)
804 ENDDO
805 DO j=1,3
806 rtrans(i,j+11) = x1(j)
807 ENDDO
808 DO j=1,3
809 rtrans(i,j+14) = x4(j) ! Xnew = X4 + ROT(Xold-X1)
810 ENDDO
811C
812 END IF
813C--------------------------------------------------
814 DO j=1,igrnod(igs)%NENTITY
815 k = igrnod(igs)%ENTITY(j)
816 xp = x(1,k) - x1(1)
817 yp = x(2,k) - x1(2)
818 zp = x(3,k) - x1(3)
819 x(1,k) = x4(1) + rot(1)*xp + rot(4)*yp + rot(7)*zp
820 x(2,k) = x4(2) + rot(2)*xp + rot(5)*yp + rot(8)*zp
821 x(3,k) = x4(3) + rot(3)*xp + rot(6)*yp + rot(9)*zp
822 END DO
823C
824 WRITE(iout,1000) id,igu
825 WRITE(iout,1010)
826 . (rtrans(i,k+11) , k=1,3),
827 . (rtrans(i,k+14) , k=1,3),
828 . rtrans(i,3),rtrans(i,6), rtrans(i,9),
829 . rtrans(i,4),rtrans(i,7),rtrans(i,10),
830 . rtrans(i,5),rtrans(i,8),rtrans(i,11)
831C
832 IF (ipri > 3) THEN
833 WRITE (iout,3000)
834 DO j=1,igrnod(igs)%NENTITY
835 is=igrnod(igs)%ENTITY(j)
836 WRITE(iout,3500) itab(is),x(1,is),x(2,is),x(3,is)
837 ENDDO
838 ENDIF
839 ELSEIF (key(1:12) == 'AUTOPOSITION') THEN
840
841 rtrans(i,2) = 7
842
843 ! read line 1
844
845 CALL hm_get_intv('GR_NODE',igu,is_available,lsubmodel)
846 CALL hm_get_intv('GR_SURF',igsurf,is_available,lsubmodel)
847
848 CALL hm_get_intv('skew_ID',isk0,is_available,lsubmodel)
849
850 IF( isk0 == 0 .AND. sub_index /= 0 ) isk0 = lsubmodel(sub_index)%SKEW
851
852 CALL hm_get_string('Dir',dir,ncharfield,is_available)
853 DO k = 1,lfield
854 IF(dir(k:k) == 'X'.OR.dir(k:k) == 'x')idir = 1
855 IF(dir(k:k) == 'Y'.OR.dir(k:k) == 'y')idir = 2
856 IF(dir(k:k) == 'Z'.OR.dir(k:k) == 'z')idir = 3
857 ENDDO
858 CALL hm_get_floatv('Gap',gap,is_available,lsubmodel,unitab)
859 CALL hm_get_intv('Pflag',pflag,is_available,lsubmodel)
860 !CALL HM_GET_INTV('SUBMODEL',ITRANSSUB,IS_AVAILABLE,LSUBMODEL)
861
862 ! read line 2
863
864 CALL hm_get_floatv('Xpos',xyzpos(1),is_available,lsubmodel,unitab)
865 CALL hm_get_floatv('Ypos',xyzpos(2),is_available,lsubmodel,unitab)
866 CALL hm_get_floatv('Zpos',xyzpos(3),is_available,lsubmodel,unitab)
867
868 CALL hm_get_intv('Xflag',xyzflag(1),is_available,lsubmodel)
869 CALL hm_get_intv('Yflag',xyzflag(2),is_available,lsubmodel)
870 CALL hm_get_intv('Zflag',xyzflag(3),is_available,lsubmodel)
871
872 !---------------------
873 !IF (ITRANSSUB /= 0) CYCLE
874 !---------------------
875 pflag0 = pflag
876 xyzpos0(:) = xyzpos(:)
877 xyzflag0(:) = xyzflag(:)
878 !---------------------
879 if(pflag == 0) pflag = 1 ! by default
880 if(xyzflag(1) == 0) xyzflag(1) = 1 ! by default
881 if(xyzflag(2) == 0) xyzflag(2) = 1 ! by default
882 if(xyzflag(3) == 0) xyzflag(3) = 1 ! by default
883 !
884 isk = 0
885 IF (isk0 > 0) THEN
886 is_found = .false.
887 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
888 IF (isk0 == iskwn(4,j+1)) THEN
889 isk=j+1
890 is_found = .true.
891 EXIT
892 ENDIF
893 ENDDO
894 IF(.NOT. is_found)THEN
895 CALL ancmsg(msgid=3112,
896 . msgtype=msgerror,
897 . anmode=aninfo,
898 . i1= id,
899 . c1= titr,
900 . i2= isk0)
901 ENDIF
902 ENDIF
903
904 ingr2usr => igrnod(1:ngrnod)%ID
905 igs = ngr2usr(igu,ingr2usr,ngrnod)
906
907 IF (igs == 0) THEN
908 CALL ancmsg(msgid=1865,
909 . msgtype=msgerror,
910 . anmode=aninfo,
911 . i1= id,
912 . c1= titr,
913 . i2= igu)
914 ENDIF
915 !
916 rtrans(i,18)=igs
917 !
918 isurf = 0
919 nno=0
920 IF (igsurf > 0) THEN
921 DO j=1,nsurf
922 nseg=igrsurf(j)%NSEG
923 IF(igrsurf(j)%ID == igsurf) THEN
924 isurf = j
925 ENDIF
926 ENDDO
927 !
928 IF (isurf == 0 . and. igsurf > 0) THEN
929 CALL ancmsg(msgid=3110,
930 . msgtype=msgerror,
931 . anmode=aninfo,
932 . i1=id,
933 . c1=titr,
934 . i2=igsurf)
935 ENDIF
936 !
937 ! create a list of nodes from the surface group
938 !
939 ALLOCATE(ino(1:4*igrsurf(isurf)%NSEG))
940 ino(1:4*igrsurf(isurf)%NSEG)=0
941 ALLOCATE(tagnode(1:numnod))
942 tagnode(1:numnod)=0
943 !
944 DO j=1,igrsurf(isurf)%NSEG
945 DO k=1,4
946 surfnod = igrsurf(isurf)%NODES(j,k)
947 IF(surfnod /= 0) THEN
948 IF (tagnode(surfnod) == 0) THEN
949 nno=nno+1
950 ino(nno)=surfnod
951 tagnode(surfnod)=1
952 ENDIF
953 ENDIF
954 ENDDO
955 ENDDO
956 ENDIF
957 !
958 !--------------------------------------
959 ! igrnod is defined to be the node group to be moved
960 !--------------------------------------
961 IF (igs > 0) THEN
962 IF (isurf > 0) THEN
963 ! surface defined - transform nodes by positioning them at minimum distance
964 ! from the surface with a gap GAP in the direction IDIR
965 CALL min_dist_grnod_to_surface(
966 . igrnod(igs)%ENTITY, igrnod(igs)%NENTITY, ino , nno ,x ,
967 . numnod , pflag , idir , gap ,isk ,
968 . skew , lskew , sskew ,id ,titr,
969 . nchartitle )
970 ELSE
971 ! no surface defined - transform nodes by positioning them at XYZPOS
972 ! with flags XYZFLAG
973 CALL min_dist_grnod_to_xyzpos(
974 . igrnod(igs)%ENTITY, igrnod(igs)%NENTITY, xyzpos, xyzflag, x ,
975 . numnod , isk , skew , lskew , sskew )
976 ENDIF
977 ENDIF
978 !
979 !---------------------------
980 !
981 IF(ALLOCATED(ino)) DEALLOCATE(ino)
982 IF(ALLOCATED(tagnode)) DEALLOCATE(tagnode)
983 !
984 WRITE(iout,2000) id,igu
985 WRITE(iout,2100) igsurf,isk0,dir(1:1),gap,pflag0,
986 . xyzpos0(1),xyzpos0(2),xyzpos0(3),
987 . xyzflag0(1),xyzflag0(2),xyzflag0(3)
988 !
989 IF (ipri > 3) THEN
990 WRITE (iout,3000)
991 DO j=1,igrnod(igs)%NENTITY
992 is=igrnod(igs)%ENTITY(j)
993 WRITE(iout,3500) itab(is),x(1,is),x(2,is),x(3,is)
994 ENDDO
995 ENDIF
996 ENDIF
997 ENDDO
998C-----------------------
999 RETURN
1000C-----------------------
1001 100 FORMAT(//
1002 .' NODAL TRANSFORMATIONS '/,
1003 .' ---------------------- ')
1004 200 FORMAT(10x,' NODES N0 . . . . .= ',i10/,
1005 . 10x,' N1 . . . . .= ',i10)
1006 300 FORMAT(10x,' CENTER NODE N0 . . . . .= ',i10)
1007 500 FORMAT(/
1008 . ' NODAL TRANSLATION, TRANSFORMATION ID = ',i10/,
1009 . ' NODE GROUP ID. . . . . . . . . . . .= ',i10/,
1010 . ' TRANSLATION VECTOR :')
1011 510 FORMAT(10x,' VALUE. . . . . . . . . . . . .= ',e20.13/,
1012 . ' COORDINATES X. . . . . . .= ',e20.13/,
1013 . ' Y. . . . . . .= ',e20.13/,
1014 . ' Z. . . . . . .= ',e20.13/,
1015 . ' Skew_ID . . . . . . . . . . .= ',i10)
1016 600 FORMAT(/
1017 . ' NODAL ROTATION, TRANSFORMATION ID. = ',i10/,
1018 . ' NODE GROUP ID. . . . . . . . . . . .= ',i10/,
1019 . ' ROTATION VECTOR: ')
1020 610 FORMAT(10x,' CENTER X. . . . . . .= ',e20.13/,
1021 . ' Y. . . . . . .= ',e20.13/,
1022 . ' Z. . . . . . .= ',e20.13/,
1023 . ' DIRECTION X. . . . . . .= ',e20.13/,
1024 . ' Y. . . . . . .= ',e20.13/,
1025 . ' Z. . . . . . .= ',e20.13/,
1026 . ' ANGLE . . . . . . .= ',e20.13)
1027 700 FORMAT(/
1028 . ' PLANE SYMMETRY, TRANSFORMATION ID = ',i10/,
1029 . ' NODE GROUP ID. . . . . . . . . . . .= ',i10/,
1030 . ' VECTOR ORTHOGONAL TO PLANE: ')
1031 710 FORMAT(10x,' CENTER X. . . . . . .= ',e20.13/,
1032 . ' Y. . . . . . .= ',e20.13/,
1033 . ' Z. . . . . . .= ',e20.13/,
1034 . ' DIRECTION X. . . . . . .= ',e20.13/,
1035 . ' Y. . . . . . .= ',e20.13/,
1036 . ' Z. . . . . . .= ',e20.13)
1037 800 FORMAT(/
1038 . ' SCALING, TRANSFORMATION ID = ',i10/,
1039 . ' NODE GROUP ID. . . . . . . . . . . .= ',i10)
1040 810 FORMAT(10x,' SCALE COEFF. X. . . . . . .= ',e20.13/,
1041 . ' Y. . . . . . .= ',e20.13/,
1042 . ' Z. . . . . . .= ',e20.13)
1043 900 FORMAT(/
1044 . ' MATRIX TRANSFORMATION, TRANSFORMATION ID.= ',i10/,
1045 . ' NODE GROUP ID. . . . . . . . . . . .= ',i10/)
1046 910 FORMAT(4x,'MATRIX '/,
1047 .' '/,
1048 . 17x,'M11',17x,'M12',17x,'M13',18x,'TX' /,
1049 . 4e20.13/,
1050 . 17x,'M21',17x,'M22',17x,'M23',18x,'TY' /,
1051 . 4e20.13/,
1052 . 17x,'M31',17x,'M32',17x,'M33',18x,'TZ' /,
1053 . 4e20.13/)
1054 1000 FORMAT(/
1055 . ' SUBMODEL TRANSFORMATION WRT 6 POSITIONS',/,
1056 . ' TRANSFORMATION ID. . . . . . . . . . . = ',i10/,
1057 . ' NODE GROUP ID. . . . . . . . . . . . . = ',i10)
1058 1010 FORMAT(
1059 . ' CENTER N1 X1 . . . . . .= ',e20.13/,
1060 . ' Y1 . . . . . .= ',e20.13/,
1061 . ' Z1 . . . . . .= ',e20.13/,
1062 . ' CENTER N4 X4 . . . . . .= ',e20.13/,
1063 . ' Y4 . . . . . .= ',e20.13/,
1064 . ' Z4 . . . . . .= ',e20.13/,
1065 . ' ROTATION MATRIX . . . . . . . = ',/,
1066 . ' . . . . . . . . M11 . . . . . . . . M12 . . . . . . . . M13',/,
1067 . 3e20.13/,
1068 . ' . . . . . . . . M21 . . . . . . . . M22 . . . . . . . . M23',/,
1069 . 3e20.13/,
1070 . ' . . . . . . . . M31 . . . . . . . . M32 . . . . . . . . M33',/,
1071 . 3e20.13/)
1072 2000 FORMAT(/
1073 . ' NODAL AUTOPOSITION, TRANSFORMATION ID = ',i10/,
1074 . ' NODE GROUP ID. . . . . . . . . . . .= ',i10)
1075 2100 FORMAT(10x,' Surf_ID . . . . . .= ',i10/,
1076 . 10x,' Skew_ID . . . . . .= ',i10/,
1077 . 10x,' Motion direction . . . . . .= ',a10/,
1078 . 10x,' Minimum distance Gap . . . . .= ',e20.13/,
1079 . 10x,' Positioning flag . . . . . .= ',i10/,
1080 . 10x,' Xpos . . . . . .= ',e20.13/,
1081 . 10x,' Ypos . . . . . .= ',e20.13/,
1082 . 10x,' Zpos . . . . . .= ',e20.13/,
1083 . 10x,' Xflag . . . . . .= ',i10/,
1084 . 10x,' Yflag . . . . . .= ',i10/,
1085 . 10x,' Zflag . . . . . .= ',i10)
1086 3000 FORMAT(/10x,'NEW NODE COORDINATES',14x,'X',24x,'Y',24x,'Z')
1087 3500 FORMAT( 17x,i10,3(5x,e20.13))
1088C-----------------------
1089 RETURN
1090 END SUBROUTINE lectrans
points_to_frame
subroutine points_to_frame(x1, x2, x3, pp, ierror)
Definition 3points_to_frame.F:32
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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:78
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:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
lectrans
subroutine lectrans(x, igrnod, itab, itabm1, unitab, lsubmodel, rtrans, igrsurf, iskwn, skew, liskn, lskew, nspcond, numsph, siskwn, sskew)
Definition lectrans.F:58
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
submodel_mod::submodel_data
Definition submodel_mod.F:728
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54
subrotpoint
subroutine subrotpoint(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:180