43
44
45
46#include "implicit_f.inc"
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
63 INTEGER IOUT, ITYP, SKFLAG,IUNIT
65
66 INTEGER ID
67 CHARACTER(LEN=NCHARTITLE) :: TITR
68 LOGICAL IS_ENCRYPTED
69 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
70
71
72
73 INTEGER IERROR,IDSK1,IDSK2,IFUN_RX,IFUN_CRX,ZEROI,OFLAG
75 . xk,xtyp,xflg,xsk1,xsk2,knn,krx,cr,crx,mass,iner,
76 . fac_m,fac_l,fac_t,fac_ct,fac_cr,fac_kt,fac_kr,fac_ctx,fac_crx,
77 . fac_mm
78
79 INTEGER SET_U_PNU,SET_U_GEO,KFUNC
81 parameter(kfunc=29)
82 DATA zeroi/0/
83 LOGICAL IS_AVAILABLE
84
85
86
87 fac_m = unitab%FAC_M(iunit)
88 fac_l = unitab%FAC_L(iunit)
89 fac_t = unitab%FAC_T(iunit)
90 fac_mm = one / fac_t
91 fac_ct = fac_m / fac_t
92 fac_cr = fac_m * fac_l**2 / fac_t
93 fac_kt = fac_ct / fac_t
94 fac_kr = fac_cr / fac_t
95 fac_ctx = fac_t / fac_l
96 fac_crx = fac_t
97 oflag = 0
98
99
100
101
102 CALL hm_get_intv(
'Idsk1',idsk1,is_available,lsubmodel)
103 CALL hm_get_intv(
'Idsk2',idsk2,is_available,lsubmodel)
104 CALL hm_get_intv(
'Xr_fun',ifun_rx,is_available,lsubmodel)
105
106
107
112
113
114
115
116 CALL HM_GET_INTV('crx_fun',IFUN_CRX,IS_AVAILABLE,LSUBMODEL)
117.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
118
119
120
121 CALL HM_GET_FLOATV('crx',CRX,IS_AVAILABLE,LSUBMODEL,UNITAB)
122.NOT. IF(IS_AVAILABLE) OFLAG = OFLAG + 1
123
124.OR. IF (IDSK1<=0IDSK1<=0) THEN
125 CALL ANCMSG(MSGID=386,
126 . MSGTYPE=MSGERROR,
127 . ANMODE=ANINFO_BLIND_1,
128 . I1=ID,
129 . C1=TITR)
130 ENDIF
131 IF (KNN==0.) THEN
132 CALL ANCMSG(MSGID=387,
133 . MSGTYPE=MSGERROR,
134 . ANMODE=ANINFO_BLIND_1,
135 . I1=ID,
136 . C1=TITR)
137 ENDIF
138.OR. IF (CR<ZEROCR>1.) THEN
139 CALL ANCMSG(MSGID=388,
140 . MSGTYPE=MSGERROR,
141 . ANMODE=ANINFO_BLIND_1,
142 . I1=ID,
143 . C1=TITR)
144 ENDIF
145 IF (CR==ZERO) CR = FIVEEM2
146
147 XTYP = ITYP
148 XFLG = SKFLAG
149 XSK1 = IDSK1
150 XSK2 = IDSK2
151 MASS = ZERO
152 INER = ZERO
153
154.AND. IF(CRX==ZEROIFUN_CRX/=0)CRX = ONE
155.AND. IF(KRX==ZEROIFUN_RX/=0) KRX = ONE
156
157
158 IF (IFUN_RX /= 0) KRX = KRX * FAC_MM
159 IF (IFUN_CRX /= 0) CRX = CRX * FAC_MM
160
161 PARGEO(1) = 0
162 PARGEO(2) = XK
163 PARGEO(3) = 0
164
165 IERROR = SET_U_GEO(1,XTYP)
166 IERROR = SET_U_GEO(2,XSK1)
167 IERROR = SET_U_GEO(3,XSK2)
168 IERROR = SET_U_GEO(4,KNN)
169 IERROR = SET_U_GEO(5,KNN)
170 IERROR = SET_U_GEO(6,KNN)
171 IERROR = SET_U_GEO(7,KRX)
172 IERROR = SET_U_GEO(8,KNN)
173 IERROR = SET_U_GEO(9,KNN)
174 IERROR = SET_U_GEO(10,KNN)
175 IERROR = SET_U_GEO(11,ZERO)
176 IERROR = SET_U_GEO(12,MASS)
177 IERROR = SET_U_GEO(13,INER)
178 IERROR = SET_U_GEO(14,XFLG)
179 IERROR = SET_U_GEO(15,CR)
180 IERROR = SET_U_GEO(16,CR)
181 IERROR = SET_U_GEO(17,CR)
182 IERROR = SET_U_GEO(18,ZERO)
183 IERROR = SET_U_GEO(19,CR)
184 IERROR = SET_U_GEO(20,CR)
185 IERROR = SET_U_GEO(21,ZERO)
186 IERROR = SET_U_GEO(22,ZERO)
187 IERROR = SET_U_GEO(23,ZERO)
188 IERROR = SET_U_GEO(24,CRX)
189 IERROR = SET_U_GEO(25,ZERO)
190 IERROR = SET_U_GEO(26,ZERO)
191 IERROR = SET_U_GEO(27,FAC_CTX)
192 IERROR = SET_U_GEO(28,FAC_CRX)
193 IERROR = SET_U_PNU(1,ZEROI,KFUNC)
194 IERROR = SET_U_PNU(2,ZEROI,KFUNC)
195 IERROR = SET_U_PNU(3,ZEROI,KFUNC)
196 IERROR = SET_U_PNU(4,IFUN_RX,KFUNC)
197 IERROR = SET_U_PNU(5,ZEROI,KFUNC)
198 IERROR = SET_U_PNU(6,ZEROI,KFUNC)
199 IERROR = SET_U_PNU(7,ZEROI,KFUNC)
200 IERROR = SET_U_PNU(8,ZEROI,KFUNC)
201 IERROR = SET_U_PNU(9,ZEROI,KFUNC)
202 IERROR = SET_U_PNU(10,IFUN_CRX,KFUNC)
203 IERROR = SET_U_PNU(11,ZEROI,KFUNC)
204 IERROR = SET_U_PNU(12,ZEROI,KFUNC)
205
206 WRITE(IOUT,500)
207 IF(IS_ENCRYPTED)THEN
208 WRITE(IOUT,'(5x,a,//)')'CONFIDENTIAL DATA'
209 ELSE
210 IF (oflag==2) THEN
211 WRITE(iout,1001)idsk1,idsk2,xk,cr,knn,krx,ifun_rx
212 ELSE
213 WRITE(iout,1000)idsk1,idsk2,xk,cr,knn,krx,ifun_rx,crx,ifun_crx
214 ENDIF
215 ENDIF
216
217 RETURN
218 500 FORMAT(
219 & 5x,'JOINT TYPE . . . . . . . . REVOLUTE JOINT'//)
220 1000 FORMAT(
221 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
222 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
223 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
224 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
225 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20.13/,
226 & 5x,'LINEAR ROTATIONAL STIFFNESS KRX. . . . =',1pg20.13/,
227 & 5x,'ROTATIONAL FUNCTION ID. . . . . . . . .=',i10/,
228 & 5x,'LINEAR DAMPING CRX . . . . . . . . . . =',1pg20.13/,
229 & 5x,'USER RX DAMPING FUNCTION . . . . . . . =',i10//)
230 1001 FORMAT(
231 & 5x,'SKEW 1 FRAME ID. . . . . . . . . . . . =',i10/,
232 & 5x,'SKEW 2 FRAME ID. . . . . . . . . . . . =',i10/,
233 & 5x,'STIFFNESS FOR INTERFACE K=E*A/L. . . . =',1pg20.13/,
234 & 5x,'CRITICAL DAMPING COEFFICIENT . . . . . =',1pg20.13/,
235 & 5x,'BLOCKING STIFFNESS KNN . . . . . . . . =',1pg20
236 & 5x,'LINEAR ROTATIONAL STIFFNESS KRX. . . . =',1pg20.13/,
237 & 5x,'ROTATIONAL FUNCTION ID. . . . . . . . .=',i10//)
238 RETURN
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
integer, parameter nchartitle
integer function set_u_pnu(ivar, ip, k)
integer function set_u_geo(ivar, a)