OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
freoutp.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine freoutp (ikad, key0, koutp, sensors)
subroutine get_keys_id (cart, key2, key3, key4, id)

Function/Subroutine Documentation

◆ freoutp()

subroutine freoutp ( integer, dimension(0:*) ikad,
character, dimension(*) key0,
integer koutp,
type (sensors_), intent(inout) sensors )

Definition at line 37 of file freoutp.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE message_mod
42 USE sensor_mod
43 USE names_and_titles_mod, ONLY: ncharline100
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IKAD(0:*),
52 . KOUTP
53 CHARACTER KEY0(*)*5
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "units_c.inc"
58#include "scr14_c.inc"
59#include "scr16_c.inc"
60C-----------------------------------------------
61C E x t e r n a l F u n c t i o n s
62C-----------------------------------------------
63 INTEGER NVAR
64 TYPE (SENSORS_), INTENT(INOUT) :: SENSORS
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, NBC, K, IKEY, N1, N
69 CHARACTER KEY2*5, KEY3*5, KEY4*5
70 CHARACTER(LEN=NCHARLINE100)::CART
71 CHARACTER(LEN=NCHARLINE100)::LINE
72C
73 ikey=koutp
74 toutp0 = zero
75 dtoutp0 = zero
76 DO i = 1,mx_outp
77 outp_v(i) = 0
78 outp_ss(i) = 0
79 outp_st(i) = 0
80 outp_cs(i) = 0
81 outp_ct(i) = 0
82 outp_ts(i) = 0
83 outp_ps(i) = 0
84 outp_pt(i) = 0
85 outp_rs(i) = 0
86 outp_rt(i) = 0
87 outp_sps(i)=0
88 outp_spt(i)=0
89 ENDDO
90c
91 IF(ikad(ikey)/=ikad(ikey+1))THEN
92 k=0
93 1175 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)') cart
94 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)') line
95
96 CALL get_keys_id(cart,key2,key3,key4,nbc)
97 k=k+1
98 IF(key2=='DT ')THEN
99 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
100 READ(iusc2,*)toutp0,dtoutp0
101 ELSEIF(key2(1:4)=='VECT')THEN
102 IF (key3(1:3)=='VEL')THEN
103 outp_v(1) = 1
104 ELSEIF(key3(1:3)=='DIS')THEN
105 outp_v(2) = 1
106 ELSEIF(key3(1:3)=='ACC')THEN
107 outp_v(3) = 1
108 ELSEIF(key3(1:4)=='CONT')THEN
109 outp_v(4) = 1
110 ELSEIF(key3(1:4)=='FINT')THEN
111 outp_v(5) = 1
112 ELSEIF(key3(1:4)=='FEXT')THEN
113 outp_v(6) = 1
114 ELSEIF(key3(1:4)=='FOPT')THEN
115 outp_v(7) = 1
116 outp_v(8) = 1
117 ELSEIF(key3(1:4)=='VROT')THEN
118 outp_v(9) = 1
119 ELSEIF(key3(1:5)=='PCONT')THEN
120 outp_v(12) = 1
121 ELSE
122 GOTO 9990
123 ENDIF
124 ELSEIF(key2(1:4)=='NODA')THEN
125 IF (key3(1:2)=='DT')THEN
126 outp_n(1) = 1
127 ELSEIF(key3(1:4)=='DMAS')THEN
128 outp_n(2) = 1
129 ELSEIF(key3(1:5)=='DINER')THEN
130 outp_n(3) = 1
131 ELSE
132 GOTO 9990
133 ENDIF
134 ELSEIF(key2(1:4)=='BRIC'.OR.key2(1:4)=='SOLI'.OR.
135 . key2(1:4)=='QUAD')THEN
136 IF (key3(1:3)=='OFF')THEN
137 outp_ss(1) = 1
138 ELSEIF(key3(1:4)=='EPSP')THEN
139 outp_ss(2) = 1
140 ELSEIF(key3(1:4)=='ENER')THEN
141 outp_ss(3) = 1
142 ELSEIF(key3(1:4)=='DENS')THEN
143 outp_ss(4) = 1
144 ELSEIF(key3(1:4)=='TEMP')THEN
145 outp_ss(5) = 1
146 ELSEIF(key3(1:1)=='P')THEN
147 outp_ss(6) = 1
148 ELSEIF(key3(1:4)=='VONM')THEN
149 outp_ss(7) = 1
150 ELSEIF(key3(1:5)=='STRES')THEN
151C IF(KEY4(1:1)=='')THEN
152C OUTP_ST(1) = 1
153 IF(key4(1:4)=='FULL')THEN
154 outp_st(2) = 1
155 ELSE
156 outp_st(1) = 1
157 ENDIF
158 ELSEIF(key3(1:5)=='USER1')THEN
159 outp_ss(20) = 1
160 ELSEIF(key3(1:5)=='USER2')THEN
161 outp_ss(21) = 1
162 ELSEIF(key3(1:5)=='USER3')THEN
163 outp_ss(22) = 1
164 ELSEIF(key3(1:5)=='USER4')THEN
165 outp_ss(23) = 1
166 ELSEIF(key3(1:5)=='USER5')THEN
167 outp_ss(24) = 1
168 ELSEIF(key3(1:4)=='HOUR')THEN
169 outp_ss(25) = 1
170 ELSEIF(key3(1:5)=='USERS')THEN
171 IF(key4(1:4)=='FULL')THEN
172 outp_ss(26) = 1
173 ELSE
174 ENDIF
175 ELSEIF(key3(1:5)=='STRAI')THEN
176 IF(key4(1:4)=='FULL')THEN
177 outp_st(3) = 1
178 ELSE
179 outp_st(3) = 1
180 ENDIF
181C-----------------------------------------------
182C element equivalent stress criteria
183C-----------------------------------------------
184 ELSEIF(key3(1:5)=='SIGEQ')THEN
185 outp_ss(27) = 1
186 ELSE
187 GOTO 9990
188 ENDIF
189 ELSEIF(key2(1:4)=='SHEL')THEN
190 IF (key3(1:3)=='OFF')THEN
191 outp_cs(1) = 1
192 ELSEIF(key3(1:4)=='EPSP')THEN
193 outp_cs(2) = 1
194 ELSEIF(key3(1:5)=='USER1')THEN
195 outp_cs(20) = 1
196 ELSEIF(key3(1:5)=='USER2')THEN
197 outp_cs(21) = 1
198 ELSEIF(key3(1:5)=='USER3')THEN
199 outp_cs(22) = 1
200 ELSEIF(key3(1:5)=='USER4')THEN
201 outp_cs(23) = 1
202 ELSEIF(key3(1:5)=='USER5')THEN
203 outp_cs(24) = 1
204 ELSEIF(key3(1:5)=='USR01' .OR.key3(1:4)=='USR1')THEN
205 IF (key4(1:4)=='FULL') outp_cs(27) = 1
206 ELSEIF(key3(1:5)=='USR02')THEN
207 IF (key4(1:4)=='FULL') outp_cs(28) = 1
208 ELSEIF(key3(1:5)=='USR03')THEN
209 IF (key4(1:4)=='FULL') outp_cs(29) = 1
210 ELSEIF(key3(1:5)=='USR04')THEN
211 IF (key4(1:4)=='FULL') outp_cs(30) = 1
212 ELSEIF(key3(1:5)=='USR05')THEN
213 IF (key4(1:4)=='FULL') outp_cs(31) = 1
214 ELSEIF(key3(1:5)=='USR06')THEN
215 IF (key4(1:4)=='FULL') outp_cs(32) = 1
216 ELSEIF(key3(1:5)=='USR07')THEN
217 IF (key4(1:4)=='FULL') outp_cs(33) = 1
218 ELSEIF(key3(1:5)=='USR08')THEN
219 IF (key4(1:4)=='FULL') outp_cs(34) = 1
220 ELSEIF(key3(1:5)=='usr09')THEN
221 IF (KEY4(1:4)=='full') OUTP_CS(35) = 1
222 ELSEIF(KEY3(1:5)=='usr10')THEN
223 IF (KEY4(1:4)=='full') OUTP_CS(36) = 1
224 ELSEIF(KEY3(1:5)=='usr11')THEN
225 IF (KEY4(1:4)=='full') OUTP_CS(37) = 1
226 ELSEIF(KEY3(1:5)=='usr12')THEN
227 IF (KEY4(1:4)=='full') OUTP_CS(38) = 1
228 ELSEIF(KEY3(1:5)=='usr13')THEN
229 IF (KEY4(1:4)=='full') OUTP_CS(39) = 1
230 ELSEIF(KEY3(1:5)=='usr14')THEN
231 IF (KEY4(1:4)=='full') OUTP_CS(40) = 1
232 ELSEIF(KEY3(1:5)=='usr15')THEN
233 IF (KEY4(1:4)=='full') OUTP_CS(41) = 1
234 ELSEIF(KEY3(1:5)=='usr16')THEN
235 IF (KEY4(1:4)=='full') OUTP_CS(42) = 1
236 ELSEIF(KEY3(1:5)=='usr17')THEN
237 IF (KEY4(1:4)=='full') OUTP_CS(43) = 1
238 ELSEIF(KEY3(1:5)=='usr18')THEN
239 IF (KEY4(1:4)=='full') OUTP_CS(44) = 1
240 ELSEIF(KEY3(1:5)=='usr19')THEN
241 IF (KEY4(1:4)=='full') OUTP_CS(45) = 1
242 ELSEIF(KEY3(1:5)=='usr20')THEN
243 IF (KEY4(1:4)=='full') OUTP_CS(46) = 1
244 ELSEIF(KEY3(1:5)=='usr21')THEN
245 IF (KEY4(1:4)=='full') OUTP_CS(47) = 1
246 ELSEIF(KEY3(1:5)=='usr22')THEN
247 IF (KEY4(1:4)=='full') OUTP_CS(48) = 1
248 ELSEIF(KEY3(1:5)=='usr23')THEN
249 IF (KEY4(1:4)=='full') OUTP_CS(49) = 1
250 ELSEIF(KEY3(1:5)=='usr24')THEN
251 IF (KEY4(1:4)=='full') OUTP_CS(50) = 1
252 ELSEIF(KEY3(1:5)=='usr25')THEN
253 IF (KEY4(1:4)=='full') OUTP_CS(51) = 1
254 ELSEIF(KEY3(1:5)=='usr26')THEN
255 IF (KEY4(1:4)=='full') OUTP_CS(52) = 1
256 ELSEIF(KEY3(1:5)=='usr27')THEN
257 IF (KEY4(1:4)=='full') OUTP_CS(53) = 1
258 ELSEIF(KEY3(1:5)=='usr28')THEN
259 IF (KEY4(1:4)=='full') OUTP_CS(54) = 1
260 ELSEIF(KEY3(1:5)=='usr29')THEN
261 IF (KEY4(1:4)=='full') OUTP_CS(55) = 1
262 ELSEIF(KEY3(1:5)=='usr30')THEN
263 IF (KEY4(1:4)=='full') OUTP_CS(56) = 1
264 ELSEIF(KEY3(1:5)=='usr31')THEN
265 IF (KEY4(1:4)=='full') OUTP_CS(57) = 1
266 ELSEIF(KEY3(1:5)=='usr32')THEN
267 IF (KEY4(1:4)=='full') OUTP_CS(58) = 1
268 ELSEIF(KEY3(1:5)=='usr33')THEN
269 IF (KEY4(1:4)=='full') OUTP_CS(59) = 1
270 ELSEIF(KEY3(1:5)=='usr34')THEN
271 IF (KEY4(1:4)=='full') OUTP_CS(60) = 1
272 ELSEIF(KEY3(1:5)=='usr35')THEN
273 IF (KEY4(1:4)=='full') OUTP_CS(61) = 1
274 ELSEIF(KEY3(1:5)=='usr36')THEN
275 IF (KEY4(1:4)=='full') OUTP_CS(62) = 1
276 ELSEIF(KEY3(1:5)=='usr37')THEN
277 IF (KEY4(1:4)=='full') OUTP_CS(63) = 1
278 ELSEIF(KEY3(1:5)=='usr38')THEN
279 IF (KEY4(1:4)=='full') OUTP_CS(64) = 1
280 ELSEIF(KEY3(1:5)=='usr39')THEN
281 IF (KEY4(1:4)=='full') OUTP_CS(65) = 1
282 ELSEIF(KEY3(1:5)=='usr40')THEN
283 IF (KEY4(1:4)=='full') OUTP_CS(66) = 1
284 ELSEIF(KEY3(1:5)=='usr41')THEN
285 IF (KEY4(1:4)=='full') OUTP_CS(67) = 1
286 ELSEIF(KEY3(1:5)=='usr42')THEN
287 IF (KEY4(1:4)=='full') OUTP_CS(68) = 1
288 ELSEIF(KEY3(1:5)=='usr43')THEN
289 IF (KEY4(1:4)=='full') OUTP_CS(69) = 1
290 ELSEIF(KEY3(1:5)=='usr44')THEN
291 IF (KEY4(1:4)=='full') OUTP_CS(70) = 1
292 ELSEIF(KEY3(1:5)=='usr45')THEN
293 IF (KEY4(1:4)=='full') OUTP_CS(71) = 1
294 ELSEIF(KEY3(1:5)=='usr46')THEN
295 IF (KEY4(1:4)=='full') OUTP_CS(72) = 1
296 ELSEIF(KEY3(1:5)=='usr47')THEN
297 IF (KEY4(1:4)=='full') OUTP_CS(73) = 1
298 ELSEIF(KEY3(1:5)=='usr48')THEN
299 IF (KEY4(1:4)=='full') OUTP_CS(74) = 1
300 ELSEIF(KEY3(1:5)=='usr49')THEN
301 IF (KEY4(1:4)=='full') OUTP_CS(75) = 1
302 ELSEIF(KEY3(1:5)=='usr50')THEN
303 IF (KEY4(1:4)=='full') OUTP_CS(76) = 1
304 ELSEIF(KEY3(1:5)=='usr51')THEN
305 IF (KEY4(1:4)=='full') OUTP_CS(77) = 1
306 ELSEIF(KEY3(1:5)=='usr52')THEN
307 IF (KEY4(1:4)=='full') OUTP_CS(78) = 1
308 ELSEIF(KEY3(1:5)=='usr53')THEN
309 IF (KEY4(1:4)=='full') OUTP_CS(79) = 1
310 ELSEIF(KEY3(1:5)=='usr54')THEN
311 IF (KEY4(1:4)=='full') OUTP_CS(80) = 1
312 ELSEIF(KEY3(1:5)=='usr55')THEN
313 IF (KEY4(1:4)=='full') OUTP_CS(81) = 1
314 ELSEIF(KEY3(1:5)=='usr56')THEN
315 IF (KEY4(1:4)=='full') OUTP_CS(82) = 1
316 ELSEIF(KEY3(1:5)=='usr57')THEN
317 IF (KEY4(1:4)=='full') OUTP_CS(83) = 1
318 ELSEIF(KEY3(1:5)=='usr58')THEN
319 IF (KEY4(1:4)=='full') outp_cs(84) = 1
320 ELSEIF(key3(1:5)=='USR59')THEN
321 IF (key4(1:4)=='FULL') outp_cs(85) = 1
322 ELSEIF(key3(1:5)=='USR60')THEN
323 IF (key4(1:4)=='FULL') outp_cs(86) = 1
324 ELSEIF(key3(1:4)=='HOUR')THEN
325 outp_cs(25) = 1
326 ELSEIF(key3(1:4)=='ENER')THEN
327 outp_cs(3) = 1
328 ELSEIF(key3(1:4)=='THIC')THEN
329 outp_cs(4) = 1
330 ELSEIF(key3(1:4)=='VONM')THEN
331 outp_cs(7) = 1
332 ELSEIF(key3(1:5)=='STRES')THEN
333 IF (key4(1:4)=='MEMB')THEN
334 outp_ct(1) = 1
335 ELSEIF(key4(1:4)=='BEND')THEN
336 outp_ct(2) = 1
337 ELSEIF(key4(1:5)=='UPPER')THEN
338 outp_ct(3) = 1
339 ELSEIF(key4(1:5)=='LOWER')THEN
340 outp_ct(4) = 1
341 ELSEIF(key4(1:4)=='FULL')THEN
342 outp_ct(95) = 1
343 ELSE
344 READ(key4,'(I5)')n1
345 IF(n1>=0.AND.n1<=30)THEN
346 outp_ct(10+n1) = 1
347 ELSE
348 GOTO 9990
349 ENDIF
350 ENDIF
351 ELSEIF(key3(1:5)=='USERS')THEN
352 IF(key4(1:4)=='FULL')THEN
353 outp_cs(26) = 1
354 ELSE
355 GOTO 9990
356 ENDIF
357 ELSEIF(key3(1:5)=='STRAI')THEN
358 IF (key4(1:4)=='MEMB')THEN
359 outp_ct(5) = 1
360 ELSEIF(key4(1:4)=='BEND')THEN
361 outp_ct(6) = 1
362 ELSEIF(key4(1:5)=='UPPER')THEN
363 outp_ct(7) = 1
364 ELSEIF(key4(1:5)=='LOWER')THEN
365 outp_ct(8) = 1
366 ELSEIF(key4(1:4)=='FULL')THEN
367 outp_ct(96) = 1
368 ELSE
369 READ(key4,'(I5)')n1
370 IF(n1>0.AND.n1<=30)THEN
371 outp_ct(50+n1) = 1
372 ELSE
373 GOTO 9990
374 ENDIF
375 ENDIF
376 ELSEIF(key3(1:5)=='EPSDO')THEN
377 iepsdot = 1
378 IF (key4(1:4)=='MEMB')THEN
379 outp_ct(91) = 1
380 ELSEIF(key4(1:4)=='BEND')THEN
381 outp_ct(92) = 1
382 ELSEIF(key4(1:5)=='UPPER')THEN
383 outp_ct(93) = 1
384 ELSEIF(key4(1:5)=='LOWER')THEN
385 outp_ct(94) = 1
386 ELSE
387 READ(key4,'(I5)')n1
388 IF(n1>0.AND.n1<=30)THEN
389 outp_ct(100+n1) = 1
390 ELSE
391 GOTO 9990
392 ENDIF
393 ENDIF
394C-----------------------------------------------
395C element equivalent stress criteria
396C-----------------------------------------------
397 ELSEIF(key3(1:5)=='SIGEQ')THEN
398 outp_cs(87) = 1
399 ELSE
400 GOTO 9990
401 ENDIF
402 ELSEIF(key2(1:4)=='TRUS')THEN
403 IF (key3(1:3)=='OFF')THEN
404 outp_ts(1) = 1
405 ELSEIF(key3(1:4)=='EPSP')THEN
406 outp_ts(2) = 1
407 ELSE
408 GOTO 9990
409 ENDIF
410 ELSEIF(key2(1:4)=='BEAM')THEN
411 IF (key3(1:3)=='OFF')THEN
412 outp_ps(1) = 1
413 ELSEIF(key3(1:4)=='EPSP')THEN
414 outp_ps(2) = 1
415 ELSE
416 GOTO 9990
417 ENDIF
418 ELSEIF(key2(1:4)=='SPRI')THEN
419 IF (key3(1:3)=='OFF')THEN
420 outp_rs(1) = 1
421 ELSEIF(key3(1:4)=='FULL')THEN
422 outp_rs(2) = 1
423 ELSE
424 GOTO 9990
425 ENDIF
426 ELSEIF(key2(1:3)=='SPH')THEN
427 IF (key3(1:3)=='OFF')THEN
428 outp_sps(1) = 1
429 ELSEIF(key3(1:4)=='EPSP')THEN
430 outp_sps(2) = 1
431 ELSEIF(key3(1:4)=='ENER')THEN
432 outp_sps(3) = 1
433 ELSEIF(key3(1:4)=='DENS')THEN
434 outp_sps(4) = 1
435 ELSEIF(key3(1:4)=='TEMP')THEN
436 outp_sps(5) = 1
437 ELSEIF(key3(1:1)=='P')THEN
438 outp_sps(6) = 1
439 ELSEIF(key3(1:4)=='VONM')THEN
440 outp_sps(7) = 1
441 ELSEIF(key3(1:5)=='STRES')THEN
442 IF(key4(1:4)=='FULL')THEN
443 outp_spt(2) = 1
444 ELSE
445 outp_spt(1) = 1
446 ENDIF
447 ELSEIF(key3(1:5)=='USER1')THEN
448 outp_sps(20) = 1
449 ELSEIF(key3(1:5)=='USER2')THEN
450 outp_sps(21) = 1
451 ELSEIF(key3(1:5)=='USER3')THEN
452 outp_sps(22) = 1
453 ELSEIF(key3(1:5)=='USER4')THEN
454 outp_sps(23) = 1
455 ELSEIF(key3(1:5)=='USER5')THEN
456 outp_sps(24) = 1
457 ELSEIF(key3(1:4)=='SLEN')THEN
458 outp_sps(25) = 1
459C-----------------------------------------------
460C element equivalent stress criteria
461C-----------------------------------------------
462 ELSEIF(key3(1:5)=='SIGEQ')THEN
463 outp_sps(26) = 1
464 ELSE
465 GOTO 9990
466 ENDIF
467 ELSEIF(key2(1:4)=='ELEM')THEN
468 IF (key3(1:3)=='OFF')THEN
469 outp_ss(1) = 1
470 outp_cs(1) = 1
471 outp_ts(1) = 1
472 outp_ps(1) = 1
473 outp_rs(1) = 1
474 outp_sps(1) = 1
475 ELSEIF(key3(1:4)=='EPSP')THEN
476 outp_ss(2) = 1
477 outp_cs(2) = 1
478 outp_ts(2) = 1
479 outp_ps(2) = 1
480 outp_sps(2) = 1
481 ELSEIF(key3(1:4)=='ENER')THEN
482 outp_ss(3) = 1
483 outp_cs(3) = 1
484 outp_sps(3) = 1
485 ELSEIF(key3(1:4)=='VONM')THEN
486 outp_ss(7) = 1
487 outp_cs(7) = 1
488 outp_sps(7) = 1
489 ELSEIF(key3(1:5)=='USER1')THEN
490 outp_ss(20) = 1
491 outp_cs(20) = 1
492 outp_sps(20) = 1
493 ELSEIF(key3(1:5)=='USER2')THEN
494 outp_ss(21) = 1
495 outp_cs(21) = 1
496 outp_sps(21) = 1
497 ELSEIF(key3(1:5)=='USER3')THEN
498 outp_ss(22) = 1
499 outp_cs(22) = 1
500 outp_sps(22) = 1
501 ELSEIF(key3(1:5)=='USER4')THEN
502 outp_ss(23) = 1
503 outp_cs(23) = 1
504 outp_sps(23) = 1
505 ELSEIF(key3(1:5)=='USER5')THEN
506 outp_ss(24) = 1
507 outp_cs(24) = 1
508 outp_sps(24) = 1
509 ELSEIF(key3(1:4)=='HOUR')THEN
510 outp_ss(25) = 1
511 outp_cs(25) = 1
512 ELSEIF(key3(1:4)=='SLEN')THEN
513 outp_sps(25) = 1
514C-----------------------------------------------
515C element equivalent stress criteria
516C-----------------------------------------------
517 ELSEIF(key3(1:5)=='SIGEQ')THEN
518 outp_ss(27) = 1
519 outp_cs(87) = 1
520 outp_sps(26) = 1
521 ELSE
522 GOTO 9990
523 ENDIF
524 ELSEIF (key2=='LSENS')THEN
525 DO i=1,nbc
526 READ(iusc1,rec=ikad(ikey)+k+i-1,fmt='(A)',err=9990)cart
527 CALL wriusc2(ikad(ikey)+k+i-1,1,key0(ikey))
528 READ(iusc2,*,err=9990,END=9990)
529 . (sensors%OUTP_TMP(n),n=1,nvar(cart))
530 sensors%NOUTP = sensors%NOUTP + nvar(cart)
531 ENDDO
532 ELSE
533 GOTO 9990
534 ENDIF
535 k=k+nbc
536 IF(ikad(ikey)+k/=ikad(ikey+1))GO TO 1175
537 ENDIF
538 nv_outp = 0
539 nss_outp = 0
540 nst_outp = 0
541 ncs_outp = 0
542 nct_outp = 0
543 nts_outp = 0
544 nps_outp = 0
545 npt_outp = 0
546 nrs_outp = 0
547 nrt_outp = 0
548 nsps_outp = 0
549 nspt_outp = 0
550 DO i = 1,mx_outp
551 nv_outp = nv_outp + outp_v(i)
552 nss_outp = nss_outp + outp_ss(i)
553 nst_outp = nst_outp + outp_st(i)
554 ncs_outp = ncs_outp + outp_cs(i)
555 nct_outp = nct_outp + outp_ct(i)
556 nts_outp = nts_outp + outp_ts(i)
557 nps_outp = nps_outp + outp_ps(i)
558 npt_outp = npt_outp + outp_pt(i)
559 nrs_outp = nrs_outp + outp_rs(i)
560 nrt_outp = nrt_outp + outp_rt(i)
561 nsps_outp = nsps_outp + outp_sps(i)
562 nspt_outp = nspt_outp + outp_spt(i)
563 ENDDO
564 IF(outp_v(12)==1)nv_outp=nv_outp+1
565C
566 RETURN
567C
568 9990 CONTINUE
569 CALL ancmsg(msgid=73,anmode=aninfo,
570 . c1=key0(ikey),c2=line(1:35))
571 CALL arret(0)
get_keys_id
subroutine get_keys_id(cart, key2, key3, key4, id)
Definition freoutp.F:582
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
nvar
integer function nvar(text)
Definition nvar.F:32
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
arret
subroutine arret(nn)
Definition arret.F:87
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60

◆ get_keys_id()

subroutine get_keys_id ( character, dimension(*) cart,
character, dimension(*) key2,
character, dimension(*) key3,
character, dimension(*) key4,
integer id )

Definition at line 581 of file freoutp.F.

582C-----------------------------------------------
583C I m p l i c i t T y p e s
584C-----------------------------------------------
585#include "implicit_f.inc"
586C-----------------------------------------------
587C G l o b a l V a r i a b l e s
588C-----------------------------------------------
589 CHARACTER CART*(*), KEY2*(*),KEY3*(*),KEY4*(*)
590 CHARACTER MOT1*80
591 INTEGER I1,I2,I3,I4,ID
592C======================================================================|
593C /Key/Id/
594C-----------------------------------------------
595 i1=8
596 DO WHILE(cart(i1:i1)/='/')
597 i1=i1+1
598 ENDDO
599 key2=cart(8:i1-1)
600 i1=i1+1
601 i2=i1
602 DO WHILE(cart(i2:i2)/='/')
603 i2=i2+1
604 ENDDO
605 key3 = cart(i1:i2-1)
606 i2=i2+1
607 i3=i2
608 DO WHILE(cart(i3:i3)/='/')
609 i3=i3+1
610 ENDDO
611 key4 = cart(i2:i3-1)
612 i3=i3+1
613 i4=i3
614 mot1 = cart(i4+25:i4+34)
615 READ(mot1,'(i10)')ID
616C---
617 RETURN