OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_unit.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_unit ../starter/source/general_controls/computation/hm_read_unit.f
25!||--- called by ------------------------------------------------------
26!|| contrl ../starter/source/starter/contrl.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| ascii_encoding_mu_letter ../starter/source/starter/ascii_encoding_mu_letter.F90
30!|| hm_get_floatv_without_uid ../starter/source/devtools/hm_reader/hm_get_floatv_without_uid.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
33!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.f
34!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
35!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
36!|| udouble_wo_title ../starter/source/system/sysfus.F
37!|| unit_code ../starter/source/general_controls/computation/unit_code.F
38!||--- uses -----------------------------------------------------
39!|| ascii_encoding_mu_letter_mod ../starter/source/starter/ascii_encoding_mu_letter.F90
40!|| format_mod ../starter/share/modules1/format_mod.F90
41!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
42!|| message_mod ../starter/share/message_module/message_mod.F
43!|| submodel_mod ../starter/share/modules1/submodel_mod.F
44!||====================================================================
45 SUBROUTINE hm_read_unit(UNITAB,LSUBMODEL)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE unitab_mod
51 USE hm_option_read_mod
52 USE submodel_mod , ONLY : submodel_data, nsubmod
53 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
54 USE format_mod , ONLY : fmt_f
55 USE user_id_mod , ONLY : id_limit
56 USE ascii_encoding_mu_letter_mod
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 TYPE (UNIT_TYPE_) ::UNITAB
65 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(NSUBMOD)
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "scr17_c.inc"
70#include "units_c.inc"
71#include "sysunit.inc"
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I,ID,N,IWRITE,IERR0,LEN,I1,J,K,IREELM,IREELL,IREELT,
76 . IERR1,ID_OPT(NUNIT0+1),IS_M_STRING,IS_L_STRING,IS_T_STRING
77 my_real unite, bid, m_unit, l_unit, t_unit
78 CHARACTER(LEN=NCHARFIELD) :: KEY
79 CHARACTER(LEN=NCHARFIELD) :: FIELD1,FIELD2,FIELD3
80 CHARACTER*20 FIELD11(NUNIT0+NSUBMOD),
81 . FIELD22(NUNIT0+NSUBMOD),
82 . FIELD33(NUNIT0+NSUBMOD),
83 . KEYMSUB, KEYLSUB, KEYTSUB, KEYMISUB, KEYLISUB, KEYTISUB
84 CHARACTER*40 MESS
85 LOGICAL :: IS_AVAILABLE
86 CHARACTER(LEN=NCHARFIELD) :: UNIT_NAME
87 INTEGER NB_BEGIN,SCHAR,SUB_INDEX,NBUNIT_SUB
88 my_real fac_m_sub,fac_l_sub,fac_t_sub
89C-----------------------------------------------
90C S o u r c e L i n e s
91C-----------------------------------------------
92 unite = 0
93 DO i = 1, nunit0+nsubmod
94C 12345678901234567890
95 field11(i) = ' '
96 field22(i) = ' '
97 field33(i) = ' '
98 ENDDO
99
100 is_available = .false.
101C----------------------------------------------
102 WRITE(iout,1000)
103
104 unite = 0
105 unitab%NUNITS = nunit0+nsubmod+1
106 unitab%NUNIT0 = nunit0
107 ALLOCATE(unitab%UNIT_ID(nunit0+nsubmod+1))
108 ALLOCATE(unitab%FAC_M (nunit0+nsubmod+1))
109 ALLOCATE(unitab%FAC_L (nunit0+nsubmod+1))
110 ALLOCATE(unitab%FAC_T (nunit0+nsubmod+1))
111
112 fac_m_input = zero
113 fac_l_input = zero
114 fac_t_input = zero
115 fac_m_work = zero
116 fac_l_work = zero
117 fac_t_work = zero
118 fac_m_sub = zero
119 fac_l_sub = zero
120 fac_t_sub = zero
121 field1 = ''
122 field2 = ''
123 field3 = ''
124 m_unit = zero
125 l_unit = zero
126 t_unit = zero
127 ierr1 = 1
128 len = ncharfield
129 id_opt(1:nunit0) = 0
130C global unit must be defined once
131C (input vers <= 90)
132 IF ( flag_key_m > 1) THEN
133 CALL ancmsg(msgid=575,msgtype=msgerror,anmode=aninfo_blind_1,c1='GLOBAL UNIT')
134 ENDIF
135 IF ( flag_key_l > 1) THEN
136 CALL ancmsg(msgid=575,msgtype=msgerror,anmode=aninfo_blind_1,c1='GLOBAL UNIT')
137 ENDIF
138 IF ( flag_key_t > 1) THEN
139 CALL ancmsg(msgid=575,msgtype=msgerror,anmode=aninfo_blind_1,c1='GLOBAL UNIT')
140 ENDIF
141C
142 CALL unit_code(len,keymi,'MASS' ,fac_m_input, ierr1, 0)
143 CALL unit_code(len,keyli,'LENGTH',fac_l_input, ierr1, 0)
144 CALL unit_code(len,keyti,'TIME' ,fac_t_input, ierr1, 0)
145 CALL unit_code(len,keym ,'MASS' ,fac_m_work , ierr1, 0)
146 IF (fac_m_input == zero) fac_m_input = fac_m_work
147 IF (fac_m_work == zero) fac_m_work = fac_m_input
148 CALL unit_code(len,keyl ,'LENGTH',fac_l_work , ierr1, 0)
149 IF (fac_l_input == zero) fac_l_input = fac_l_work
150 IF (fac_l_work == zero) fac_l_work = fac_l_input
151 CALL unit_code(len,keyt ,'TIME' ,fac_t_work , ierr1, 0)
152 IF (fac_t_input == zero) fac_t_input = fac_t_work
153 IF (fac_t_work == zero) fac_t_work = fac_t_input
154
155 fac_mass = fac_m_work
156 fac_length = fac_l_work
157 fac_time = fac_t_work
158
159 unitab%FAC_MASS = fac_m_work
160 unitab%FAC_LENGTH = fac_l_work
161 unitab%FAC_TIME = fac_t_work
162
163 unitab%FAC_M_WORK = fac_m_work
164 unitab%FAC_L_WORK = fac_l_work
165 unitab%FAC_T_WORK = fac_t_work
166 nunits = 1
167 iwrite = 1
168
169 IF (fac_m_input /= fac_m_work .OR.
170 . fac_l_input /= fac_l_work .OR.
171 . fac_t_input /= fac_t_work) THEN
172 CALL ancmsg(msgid=754,msgtype=msgwarning,anmode=aninfo)
173 ENDIF
174
175 CALL hm_option_start('/UNIT')
176C
177 DO n=1,nunit0
178 CALL hm_option_read_key(lsubmodel,option_id = id,keyword2 = key)
179c
180 unit_name = ''
181 CALL hm_get_string('UNIT_NAME',unit_name,ncharfield,is_available)
182 IF(unit_name /= 'LENGTH' .AND. unit_name /= 'MASS' .AND. unit_name /= 'TIME') THEN
183 ierr0 = 1
184 nunits = nunits + 1
185 id_opt(nunits)=id
186
187 CALL hm_get_intv('IS_M_STRING',is_m_string,is_available,lsubmodel)
188 IF(is_m_string == 1) THEN
189 CALL hm_get_string('MUNIT_S',field1,ncharfield,is_available)
190 ELSE
191 CALL hm_get_floatv_without_uid('MUNIT',m_unit,is_available)
192 ENDIF
193 CALL hm_get_intv('IS_L_STRING',is_l_string,is_available,lsubmodel)
194 IF(is_l_string == 1) THEN
195 CALL hm_get_string('LUNIT_S',field2,ncharfield,is_available)
196 ELSE
197 CALL hm_get_floatv_without_uid('LUNIT',l_unit,is_available)
198 ENDIF
199 CALL hm_get_intv('IS_T_STRING',is_t_string,is_available,lsubmodel)
200 IF(is_t_string == 1) THEN
201 CALL hm_get_string('TUNIT_S',field3,ncharfield,is_available)
202 ELSE
203 CALL hm_get_floatv_without_uid('TUNIT',t_unit,is_available)
204 ENDIF
205
206 IF(is_m_string == 1) THEN
207 CALL unit_code(len,field1,'MASS',unitab%FAC_M(nunits),ierr0,id)
208 iwrite = min(ierr0,iwrite)
209 DO k=1,20
210 field11(nunits-1)(k:k) = field1(k:k)
211 ENDDO
212 ELSE
213 unitab%FAC_M(nunits) = m_unit
214 field11(nunits-1) = 'N.A'
215 ENDIF
216 IF(is_l_string == 1) THEN
217 CALL unit_code(len,field2,'LENGTH',unitab%FAC_L(nunits),ierr0,id)
218 iwrite = min(ierr0,iwrite)
219 DO k=1,20
220 field22(nunits-1)(k:k) = field2(k:k)
221 ENDDO
222 ELSE
223 unitab%FAC_L(nunits) = l_unit
224 field22(nunits-1) = 'N.A'
225 ENDIF
226 IF(is_t_string == 1) THEN
227 CALL unit_code(len,field3,'TIME',unitab%FAC_T(nunits),ierr0,id)
228 iwrite = min(ierr0,iwrite)
229 DO k=1,20
230 field33(nunits-1)(k:k) = field3(k:k)
231 ENDDO
232 ELSE
233 unitab%FAC_T(nunits) = t_unit
234 field33(nunits-1) = 'N.A'
235 ENDIF
236 unitab%UNIT_ID(nunits) = id
237 ENDIF
238C
239 ENDDO
240C---
241 IF (fac_mass == zero) THEN
242 CALL ancmsg(msgid=574,msgtype=msgerror,anmode=aninfo,i1=id,c1='WORK MASS')
243 ENDIF
244 IF (fac_length == zero) THEN
245 CALL ancmsg(msgid=574,msgtype=msgerror,anmode=aninfo,i1=id,c1='WORK LENGTH')
246 ENDIF
247 IF (fac_time == zero) THEN
248 CALL ancmsg(msgid=574,msgtype=msgerror,anmode=aninfo,i1=id,c1='WORK TIME')
249 ENDIF
250
251 unitab%UNIT_ID(1) = 0
252 unitab%FAC_M(1) = fac_mass
253 unitab%FAC_L(1) = fac_length
254 unitab%FAC_T(1) = fac_time
255
256 mess = 'UNITS '
257 CALL udouble_wo_title(id_opt,1,nunits,mess,0,bid)
258
259 IF(nsubmod > 0)THEN
260 CALL hm_option_count('/BEGIN',nb_begin)
261 schar = 20
262 nbunit_sub = 0
263 IF (nb_begin /= 0) THEN
264 CALL hm_option_start('/BEGIN')
265 DO i=1,nb_begin
266 CALL hm_option_read_key(lsubmodel,submodel_index = sub_index)
267 IF (sub_index /= 0) THEN
268 nbunit_sub = nbunit_sub + 1
269 nunits = nunits + 1
270
271 CALL hm_get_string('length_inputunit_code',keylisub,schar,is_available)
272 CALL hm_get_string('mass_inputunit_code',keymisub,schar,is_available)
273 CALL hm_get_string('time_inputunit_code',keytisub,schar,is_available)
274 CALL hm_get_string('length_workunit_code',keylsub,schar,is_available)
275 CALL hm_get_string('mass_workunit_code',keymsub,schar,is_available)
276 CALL hm_get_string('time_workunit_code',keytsub,schar,is_available)
277
278 !convert into ascci format specific encoding of greek letter \mu
279 CALL ascii_encoding_mu_letter(keylisub, keymisub, keytisub, keylsub, keymsub, keytsub)
280
281 DO k=1,20
282 field11(nunits-1)(k:k) = keymisub(k:k)
283 ENDDO
284 DO k=1,20
285 field22(nunits-1)(k:k) = keylisub(k:k)
286 ENDDO
287 DO k=1,20
288 field33(nunits-1)(k:k) = keytisub(k:k)
289 ENDDO
290
291 CALL unit_code(len,keymisub,'MASS' ,fac_m_sub, ierr1, 0)
292 CALL unit_code(len,keylisub,'LENGTH',fac_l_sub, ierr1, 0)
293 CALL unit_code(len,keytisub,'TIME' ,fac_t_sub, ierr1, 0)
294
295 unitab%UNIT_ID(nunits) = id_limit%UNIT + nbunit_sub
296 unitab%FAC_M(nunits) = fac_m_sub
297 unitab%FAC_L(nunits) = fac_l_sub
298 unitab%FAC_T(nunits) = fac_t_sub
299
300 ENDIF
301 ENDDO
302 ENDIF
303 ENDIF
304c
305C---
306 IF (iwrite == 1) THEN
307C---
308c Reduction of work mass unit system string character
309C---
310 ireelm = 0
311 READ(keym,err=100,fmt=fmt_f) unite
312 ireelm = 1
313100 CONTINUE
314 i = 1
315 j = 0
316C Skip leading spaces
317 DO WHILE (i <= ncharfield)
318 IF (keym(i:i) /= ' ') EXIT
319 i=i+1
320 ENDDO
321C Read, skip trailing spaces
322 DO WHILE (i <= ncharfield)
323 IF (keym(i:i) == ' ') EXIT
324 j=j+1
325 i=i+1
326 ENDDO
327 IF ( ireelm /= 1) THEN
328 DO k=1,j
329 keym(k:k) = keym(k+i-j-1:k+i-j-1)
330 ENDDO
331 ENDIF
332C---
333c Reduction of work length unit system string character
334C---
335 ireell = 0
336 READ(keyl,err=200,fmt=fmt_f) unite
337 ireell = 1
338200 CONTINUE
339 i = 1
340 j = 0
341C Skip leading spaces
342 DO WHILE (i <= ncharfield)
343 IF (keyl(i:i) /= ' ') EXIT
344 i=i+1
345 ENDDO
346C Read, skip trailing spaces
347 DO WHILE (i <= ncharfield)
348 IF (keyl(i:i) == ' ') EXIT
349 j=j+1
350 i=i+1
351 ENDDO
352 IF ( ireell /= 1) THEN
353 DO k=1,j
354 keyl(k:k) = keyl(k+i-j-1:k+i-j-1)
355 ENDDO
356 ENDIF
357C---
358c Reduction of work time unit system string character
359C---
360 ireelt = 0
361 READ(keyt,err=300,fmt=fmt_f) unite
362 ireelt = 1
363300 CONTINUE
364 i = 1
365 j = 0
366C Skip leading spaces
367 DO WHILE (i <= ncharfield)
368 IF (keyt(i:i) /= ' ') EXIT
369 i=i+1
370 ENDDO
371C Read, skip trailing spaces
372 DO WHILE (i <= ncharfield)
373 IF (keyt(i:i) == ' ') EXIT
374 j=j+1
375 i=i+1
376 ENDDO
377 IF ( ireelt /= 1) THEN
378 DO k=1,j
379 keyt(k:k) = keyt(k+i-j-1:k+i-j-1)
380 ENDDO
381 ENDIF
382C---
383 IF ( ireelm == 1) THEN
384 keym(1:3) = 'N.A'
385 ENDIF
386
387 IF ( ireell == 1) THEN
388 keyl(1:3) = 'N.A'
389 ENDIF
390
391 IF ( ireelt == 1) THEN
392 keyt(1:3) = 'N.A'
393 ENDIF
394
395 WRITE(iout,1001) keym,keyl,keyt,fac_mass,fac_length,fac_time
396C---
397c Reduction of input mass unit system string character
398C---
399 ireelm = 0
400 READ(keymi,err=700,fmt=fmt_f) unite
401 ireelm = 1
402700 CONTINUE
403 i = 1
404 j = 0
405C Skip leading spaces
406 DO WHILE (i <= ncharfield)
407 IF (keymi(i:i) /= ' ') EXIT
408 i=i+1
409 ENDDO
410C Read, skip trailing spaces
411 DO WHILE (i <= ncharfield)
412 IF (keymi(i:i) == ' ') EXIT
413 j=j+1
414 i=i+1
415 ENDDO
416 IF ( ireelm /= 1) THEN
417 DO k=1,j
418 keymi(k:k) = keymi(k+i-j-1:k+i-j-1)
419 ENDDO
420 ENDIF
421C---
422c Reduction of input length unit system string character
423C---
424 ireell = 0
425 READ(keyli,err=800,fmt=fmt_f) unite
426 ireell = 1
427800 CONTINUE
428 i = 1
429 j = 0
430C Skip leading spaces
431 DO WHILE (i <= ncharfield)
432 IF (keyli(i:i) /= ' ') EXIT
433 i=i+1
434 ENDDO
435C Read, skip trailing spaces
436 DO WHILE (i <= ncharfield)
437 IF (keyli(i:i) == ' ') EXIT
438 j=j+1
439 i=i+1
440 ENDDO
441 IF ( ireell /= 1) THEN
442 DO k=1,j
443 keyli(k:k) = keyli(k+i-j-1:k+i-j-1)
444 ENDDO
445 ENDIF
446C---
447c Reduction of input time unit system string character
448C---
449 ireelt = 0
450 READ(keyti,err=900,fmt=fmt_f) unite
451 ireelt = 1
452900 CONTINUE
453 i = 1
454 j = 0
455C Skip leading spaces
456 DO WHILE (i <= ncharfield)
457 IF (keyti(i:i) /= ' ') EXIT
458 i=i+1
459 ENDDO
460C Read, skip trailing spaces
461 DO WHILE (i <= ncharfield)
462 IF (keyti(i:i) == ' ') EXIT
463 j=j+1
464 i=i+1
465 ENDDO
466 IF ( ireelt /= 1) THEN
467 DO k=1,j
468 keyti(k:k) = keyti(k+i-j-1:k+i-j-1)
469 ENDDO
470 ENDIF
471C---
472 IF ( ireelm == 1) THEN
473 keymi(1:3) = 'N.A'
474 ENDIF
475
476 IF ( ireell == 1) THEN
477 keyli(1:3) = 'N.A'
478 ENDIF
479
480 IF ( ireelt == 1) THEN
481 keyti(1:3) = 'N.A'
482 ENDIF
483
484 WRITE(iout,1003) keymi,keyli,keyti,
485 . fac_m_input,fac_l_input,fac_t_input
486 DO i=2,nunits
487c------------------------------------------------------------
488 DO k=1,20
489 field1(k:k) = field11(i-1)(k:k)
490 field2(k:k) = field22(i-1)(k:k)
491 field3(k:k) = field33(i-1)(k:k)
492 ENDDO
493C---
494c Reduction of local mass unit system string character
495C---
496 ireelm = 0
497 READ(field1,err=400,fmt=fmt_f) unite
498 ireelm = 1
499400 CONTINUE
500 i1 = 1
501 j = 0
502C Skip leading spaces
503 DO WHILE (i1 <= 20)
504 IF (field1(i1:i1) /= ' ') EXIT
505 i1=i1+1
506 ENDDO
507C Read, skip trailing spaces
508 DO WHILE (i1 <= 20)
509 IF (field1(i1:i1) == ' ') EXIT
510 j=j+1
511 i1=i1+1
512 ENDDO
513 IF ( ireelm /= 1) THEN
514 DO k=1,j
515 field1(k:k) = field1(k+i1-j-1:k+i1-j-1)
516 ENDDO
517 ENDIF
518C---
519c Reduction of local length unit system string character
520C---
521 ireell = 0
522 READ(field2,err=500,fmt=fmt_f) unite
523 ireell = 1
524500 CONTINUE
525 i1 = 1
526 j = 0
527C Skip leading spaces
528 DO WHILE (i1 <= 20)
529 IF (field2(i1:i1) /= ' ') EXIT
530 i1=i1+1
531 ENDDO
532C Read, skip trailing spaces
533 DO WHILE (i1 <= 20)
534 IF (field2(i1:i1) == ' ') EXIT
535 j=j+1
536 i1=i1+1
537 ENDDO
538 IF ( ireell /= 1) THEN
539 DO k=1,j
540 field2(k:k) = field2(k+i1-j-1:k+i1-j-1)
541 ENDDO
542 ENDIF
543C---
544c Reduction of local time unit system string character
545C---
546 ireelt = 0
547 READ(field3,err=600,fmt=fmt_f) unite
548 ireelt = 1
549600 CONTINUE
550 i1 = 1
551 j = 0
552C Skip leading spaces
553 DO WHILE (i1 <= 20)
554 IF (field3(i1:i1) /= ' ') EXIT
555 i1=i1+1
556 ENDDO
557C Read, skip trailing spaces
558 DO WHILE (i1 <= 20)
559 IF (field3(i1:i1) == ' ') EXIT
560 j=j+1
561 i1=i1+1
562 ENDDO
563 IF ( ireelt /= 1) THEN
564 DO k=1,j
565 field3(k:k) = field3(k+i1-j-1:k+i1-j-1)
566 ENDDO
567 ENDIF
568C---
569 IF ( ireelm == 1) THEN
570 field1(1:3) = 'N.A'
571 ENDIF
572
573 IF ( ireell == 1) THEN
574 field2(1:3) = 'N.A'
575 ENDIF
576
577 IF ( ireelt == 1) THEN
578 field3(1:3) = 'N.A'
579 ENDIF
580
581c-----------------------------------------------------------
582 WRITE(iout,1002) unitab%UNIT_ID(i),field1,field2,field3,
583 . unitab%FAC_M(i),unitab%FAC_L(i),unitab%FAC_T(i)
584 ENDDO
585 ENDIF
586C
587C transformation into relative values compared to global units
588C
589 DO n=1,nunits
590 IF (n >= 2) THEN
591
592 IF (unitab%FAC_M(n) == zero) THEN
593 unitab%FAC_M(n) = one
594 ELSE
595 unitab%FAC_M(n) = unitab%FAC_M(n) / unitab%FAC_M(1)
596 ENDIF
597
598 IF (unitab%FAC_L(n) == zero) THEN
599 unitab%FAC_L(n) = one
600 ELSE
601 unitab%FAC_L(n) = unitab%FAC_L(n) / unitab%FAC_L(1)
602 ENDIF
603
604 IF (unitab%FAC_T(n) == zero) THEN
605 unitab%FAC_T(n) = one
606 ELSE
607 unitab%FAC_T(n) = unitab%FAC_T(n) / unitab%FAC_T(1)
608 ENDIF
609
610 ENDIF
611 ENDDO
612 unitab%UNIT_ID(1) = 0
613 unitab%FAC_M(1) = fac_m_input / fac_mass
614 unitab%FAC_L(1) = fac_l_input / fac_length
615 unitab%FAC_T(1) = fac_t_input / fac_time
616
617 unitab%NUNITS = nunits
618C-----
619 RETURN
620C-----
6211000 FORMAT(
622 . //,' UNIT SYSTEMS DEFINITION '/
623 . ' ----------------------- ',/
624 ./ 58x,'MASS',16x,'LENGTH',14x,'TIME')
6251001 FORMAT
626 .(4x, 'WORK UNIT SYSTEM . . . . . . ','( ',a3,', ',a3,', ',a3,' )',
627 . 1pe20.13,1pe20.13,1pe20.13)
6281002 FORMAT
629 .(4x, 'UNIT SYSTEM, ID = ',i10,' ','( ',a3,', ',a3,', ',a3,' )',
630 . 1pe20.13,1pe20.13,1pe20.13)
6311003 FORMAT
632 .(4x, 'INPUT UNIT SYSTEM . . . . . ','( ',a3,', ',a3,', ',a3,' )',
633 . 1pe20.13,1pe20.13,1pe20.13)
634 END
635
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv_without_uid
subroutine hm_get_floatv_without_uid(name, rval, is_available)
Definition hm_get_floatv_without_uid.F:34
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_read_unit
subroutine hm_read_unit(unitab, lsubmodel)
Definition hm_read_unit.F:46
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
min
#define min(a, b)
Definition macros.h:20
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
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
udouble_wo_title
subroutine udouble_wo_title(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:973
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:728
unit_code
subroutine unit_code(length, field, key, fac, ierr1, id)
Definition unit_code.F:34