47
48
49
55 USE sensor_mod
57 USE reader_old_mod , ONLY : irec
58
59
60
61#include "implicit_f.inc"
62
63
64
65#include "scr17_c.inc"
66#include "com04_c.inc"
67#include "units_c.inc"
68#include "param_c.inc"
69#include "sphcom.inc"
70
71
72
73 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
74 INTEGER IGRV(NIGRV,NGRAV), LGRAV(*), ITAB(*), ITABM1(*),
75 . NPC(*), ISKN(LISKN,*), ITAGND(*)
77 . grav(lfacgrv,ngrav)
78 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(NSUBMOD)
79 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96 TYPE (GROUP_) , DIMENSION(NGRNOD) ::
97
98
99
100 my_real fcx,fcy,fac_fcx,fac_fcy
101 INTEGER I, NCUR, NOSKEW,NSKW, ISENS,NN,IGU,IGS,UID,IAD,NS,J,K,ID,NCURS,TSENS, IFLAGUNIT, SUB_INDEX
102 CHARACTER(LEN=NCHARFIELD) :: XYZ
103 CHARACTER :: X*1, Y*1, Z*1, XX*2, YY*2, ZZ*2, MESS*40
104 CHARACTER(LEN=NCHARTITLE)::TITR
105 LOGICAL IS_AVAILABLE
106
107
108
109 INTEGER USR2SYS,NODGRNR5
111
112 DATA x/'X'/
113 DATA y/'y'/
114 DATA Z/'z'/
115 DATA XX/'xx'/
116 DATA YY/'yy'/
117 DATA ZZ/'zz'/
118 DATA MESS/'gravity loads definition '/
119
120 IS_AVAILABLE = .FALSE.
121
122
123 IAD=1
124 IF(NGRAV==0)RETURN
125
126 WRITE (IOUT,2000)
127
128
129
130 CALL HM_OPTION_START('/grav')
131
132
133
134 DO K=1,NGRAV
135 TITR = ''
136
137
138
139 CALL HM_OPTION_READ_KEY(LSUBMODEL,
140 . OPTION_ID = ID,
141 . UNIT_ID = UID,
142 . SUBMODEL_INDEX = SUB_INDEX,
143 . OPTION_TITR = TITR)
144
145
146
147 CALL HM_GET_STRING('rad_dir',XYZ,ncharfield,IS_AVAILABLE)
148
149
150
151 CALL HM_GET_INTV('curveid',NCUR,IS_AVAILABLE,LSUBMODEL)
152 CALL HM_GET_INTV('inputsystem',NOSKEW,IS_AVAILABLE,LSUBMODEL)
153.AND. IF(NOSKEW == 0 SUB_INDEX /= 0 ) NOSKEW = LSUBMODEL(SUB_INDEX)%SKEW
154 CALL HM_GET_INTV('rad_sensor_id',ISENS,IS_AVAILABLE,LSUBMODEL)
155 CALL HM_GET_INTV('entityid',IGU,IS_AVAILABLE,LSUBMODEL)
156
157
158
159 CALL HM_GET_FLOATV('xscale',FCX,IS_AVAILABLE,LSUBMODEL,UNITAB)
160 CALL HM_GET_FLOATV_DIM('xscale',FAC_FCX,IS_AVAILABLE,LSUBMODEL,UNITAB)
161 CALL HM_GET_FLOATV('magnitude',FCY,IS_AVAILABLE,LSUBMODEL,UNITAB)
162 CALL HM_GET_FLOATV_DIM('magnitude',FAC_FCY,IS_AVAILABLE,LSUBMODEL,UNITAB)
163
164 IFLAGUNIT = 0
165 DO J=1,UNITAB%NUNITS
166 IF (UNITAB%UNIT_ID(J) == UID) THEN
167 IFLAGUNIT = 1
168 EXIT
169 ENDIF
170 ENDDO
171.AND. IF (UID/=0IFLAGUNIT==0) THEN
172 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
173 . I2=UID,I1=ID,C1='gravity load',
174 . C2='gravity load',
175 . C3=TITR)
176 ENDIF
177 DO J=0,NUMSKW+MIN(1,NSPCOND)*NUMSPH+NSUBMOD
178 IF(NOSKEW == ISKN(4,J+1)) THEN
179 NOSKEW=J+1
180 GO TO 100
181 ENDIF
182 ENDDO
183 CALL ANCMSG(MSGID=137,ANMODE=ANINFO,MSGTYPE=MSGERROR,
184 . C1='gravity load',
185 . C2='gravity load',
186 . I2=NOSKEW,I1=ID,C3=TITR)
187 100 CONTINUE
188
189 IF (FCX == ZERO) FCX = FAC_FCX
190 IF (FCY == ZERO) FCY = FAC_FCY
191
192 NSKW=10*NOSKEW
193 NS=0
194 IF (XYZ(1:1)==X) THEN
195 NS=1+NSKW
196 ELSEIF(XYZ(1:1)==Y)THEN
197 NS=2+NSKW
198 ELSEIF(XYZ(1:1)==Z)THEN
199 NS=3+NSKW
200 ELSE
201 XYZ='z'
202 NS=3+NSKW
203
204
205 ENDIF
206
207 IF (IGU /= 0) THEN
208 NN = NODGRNR5(IGU,IGS,LGRAV(IAD),IGRNOD,ITABM1,MESS)
209 ELSE
210 NN = NUMNOD
211 DO I=1,NUMNOD
212 LGRAV(IAD-1+I)=I
213 ENDDO
214 ENDIF
215 IF (NS10E > 0 ) CALL REMOVE_ND(NN,LGRAV(IAD),ITAGND)
216
217 IREC = IREC + 1
218 IGRV(1,K)=NN
219 IGRV(2,K)=NS
220 NCURS=0
221 IF(NCUR/=0) THEN
222 DO J=1,NFUNCT
223 IF(NPC(NFUNCT+J+1)==NCUR)NCURS=J
224 ENDDO
225 IF(NCURS==0)THEN
226 CALL ANCMSG(MSGID=154,ANMODE=ANINFO,MSGTYPE=MSGERROR,
227 . I2=NCUR,I1=ID,C1=TITR)
228 ENDIF
229 ENDIF
230 IGRV(3,K)=NCURS
231 IGRV(4,K)=IAD
232 IGRV(5,K)=ID
233 IGRV(6,K)=ISENS
234 GRAV(1,K) = FCY
235 GRAV(2,K) = ONE/FCX
236 TSENS=0
237 DO J=1,SENSORS%NSENSOR
238 IF(ISENS/=0) THEN
239 IF (IGRV(6,K) == SENSORS%SENSOR_TAB(J)%SENS_ID) TSENS=J
240 ENDIF
241 ENDDO
242.AND. IF((TSENS==0)(IGRV(6,K)/=0))THEN
243 CALL ANCMSG(MSGID=521,ANMODE=ANINFO,MSGTYPE=MSGERROR,
244 . I2=IGRV(6,K),I1=ID,C1=TITR)
245 ENDIF
246 IF (NOSKEW > 0) NOSKEW = ISKN(4,NOSKEW)
247 WRITE (IOUT,3000) NOSKEW,XYZ(1:1),
248 . NCUR,ISENS,FCX,FCY
249 WRITE (IOUT,'(10i10)') (ITAB(LGRAV(J+IAD-1)),J=1,NN)
250 IAD=IAD+NN
251 ENDDO
252
253 RETURN
254
255 2000 FORMAT(//
256 .' gravity loads '/
257 .' ------------- '/
258 .' skew direction load curve',
259 .' sensor scale_x scale_y ')
260 3000 FORMAT(2X,I10,10X,A2,4X,I10,2X,I10,2X,1P2G20.13)
261
262 RETURN
integer, parameter nchartitle
integer, parameter ncharfield
integer function usr2sys(iu, itabm1, mess, id)