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

Go to the source code of this file.

Functions/Subroutines

subroutine write_array (array, idx1, idx2, tabvint, lvarint)

Function/Subroutine Documentation

◆ write_array()

subroutine write_array ( integer, dimension(*), intent(in) array,
integer, intent(in) idx1,
integer, intent(in) idx2,
integer, dimension(*), intent(inout) tabvint,
integer, intent(inout) lvarint )

Definition at line 28 of file write_array.F.

29C-----------------------------------------------
30C Description
31C-----------------------------------------------
32C This function is recording a given integer array
33C from range ARRAY(IDX1,IDX2)
34C inside TABVINT array which will we used to transmit
35C data from Strater/Engine
36C Only nonzero values are stored.
37C Nonzero values are first counted. This size is also stored.
38C Then array is parsed to store only non zero values.
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "scr14_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER,INTENT(IN) :: ARRAY(*)
51 INTEGER,INTENT(IN) :: IDX1,IDX2
52 INTEGER,INTENT(INOUT) :: LVARINT,TABVINT(*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER NUM
57 INTEGER I
58C-----------------------------------------------
59C P r e - C o n d i t i o n
60C-----------------------------------------------
61 !IF (SIZE(ARRAY)<=0)RETURN
62 !LB=LBOUND(ARRAY)
63 !UB=UBOUND(ARRAY)
64 !IF(IDX1<LB)IDX1=LB
65 !IF(IDX2>UB)IDX2=UB
66 !IF (IDX2<IDX1)RETURN
67C-----------------------------------------------
68C S o u r c e L i n e s
69C-----------------------------------------------
70 num=0
71 DO i=idx1,idx2
72 IF(array(i)/=0)num=num+1
73 ENDDO
74 lvarint=lvarint+1
75 tabvint(lvarint)=num
76
77 DO i=idx1,idx2
78 IF(array(i)/=0)THEN
79 lvarint=lvarint+1
80 tabvint(lvarint)=i
81 ENDIF
82 ENDDO
83
84 RETURN
85C-----------------------------------------------