39
40
41
42 USE my_alloc_mod
48
49
50
51#include "implicit_f.inc"
52
53
54
55#include "com04_c.inc"
56
57
58
59 INTEGER ITABM1(*)
60
61 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
62 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
63
64
65
66 INTEGER J10(10)
67 INTEGER I,J,K,ID,NNOD,NL,IGS,KK,JJ,NENTITY,UID,NN
68 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
69 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
70 CHARACTER MESS*40
71 LOGICAL IS_AVAILABLE
72
73
74
75 INTEGER USR2SYS
76 DATA mess/'NODENS GROUP DEFINITION '/
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101 is_available = .false.
102
103
104
105 igs=0
106 titr1='NODENS GROUP'
107
109
110
111
112 DO i=1,ngrnod
113
114
117 . option_titr = titr ,
118 . unit_id = uid,
119 . keyword2 = key ,
120 . keyword3 = key2)
121
122
123 igs=igs+1
124
125
127 igrnod(igs)%GRTYPE=0
128 igrnod(igs)%SORTED=0
129 igrnod(igs)%LEVEL=1
130 igrnod(igs)%TITLE=titr
131 nn=0
132 nnod=0
133
134
135 IF(key(1:6) == 'NODENS') THEN
136
137 CALL hm_get_intv(
'idsmax' ,nentity,is_available,lsubmodel)
138 DO kk = 1,nentity
140 IF (jj /= 0) THEN
141 nnod = nnod + 1
142 ENDIF
143 ENDDO
144 igrnod(igs)%NENTITY = nnod
145 igrnod(igs)%GRPGRP = 1
146 CALL my_alloc(igrnod(igs)%ENTITY,nnod)
147 igrnod(igs)%SORTED = 1
148 DO kk = 1,nentity
150 IF (jj /= 0) THEN
151 nn = nn + 1
152 igrnod(igs)%ENTITY(nn)=
usr2sys(jj,itabm1,mess,
id)
153 ENDIF
154 ENDDO
155 ENDIF
156 ENDDO
157
158 RETURN
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_start(entity_type)
integer, parameter nchartitle
integer, parameter ncharkey
integer function usr2sys(iu, itabm1, mess, id)