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