OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
manctr.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "units_c.inc"
#include "scr06_c.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "chara_c.inc"
#include "task_c.inc"
#include "rad2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine manctr (output, sensors, h3d_data)

Function/Subroutine Documentation

◆ manctr()

subroutine manctr ( type(output_), intent(inout) output,
type (sensors_), intent(inout) sensors,
type(h3d_database) h3d_data )

Definition at line 38 of file manctr.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE names_and_titles_mod, ONLY: ncharline100
43 USE h3d_mod
44 USE inoutfile_mod
45 USE sensor_mod
46 USE output_mod
47 USE ale_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "com06_c.inc"
58#include "com08_c.inc"
59#include "units_c.inc"
60#include "scr06_c.inc"
61#include "scr07_c.inc"
62#include "scr14_c.inc"
63#include "chara_c.inc"
64#include "task_c.inc"
65#include "rad2r_c.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
70 TYPE(H3D_DATABASE) :: H3D_DATA
71 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
72C-----------------------------------------------
73C L o c a l P a r a m e t e r s
74C-----------------------------------------------
75 INTEGER NKEY,I
76 parameter(nkey = 13)
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER MANIM0, MREST0, MSTOP0, MFILR, MCYCLE, LK2, IKEY, WMCHECK0,
81 . MSG_R2R,ICTLSTOP0, MH3D0,SENS_ID
82 my_real tmpman(50), tman
83 CHARACTER FILNAM*100, KEY2*80, FMT*80, KEY0(NKEY)*5,REC*1
84 CHARACTER(LEN=NCHARLINE100)::CARTE
85 INTEGER :: LEN_TMP_NAME
86 CHARACTER(len=2148) :: TMP_NAME
87C-----------------------------------------------
88C E x t e r n a l F u n c t i o n s
89C-----------------------------------------------
90C REAL
91C-----------------------------------------------
92 SAVE manim0,mrest0,mstop0,mfilr,key0,ictlstop0,mh3d0
93 DATA mfilr/0/
94 DATA manim0/0/
95 DATA mrest0/0/
96 DATA mstop0/0/
97 DATA mcycle/0/
98 DATA tman/0.0/
99 DATA wmcheck0/0/
100 DATA ictlstop0/0/
101 DATA mh3d0/0/
102 DATA key0/'TIME ','CYCLE','GFILE','PATRA','RFILE','STOP ',
103 . 'KILL ','INFO ','ANIM ','OUTP ','LFLUS','CHKPT',
104 . 'H3D '/
105C-----------------------------
106C INTERVENTION MANUELLE
107C-----------------------------
108 mdess=0
109 mrest=0
110 manim=0
111 mstop=0
112 wmcheck = 0
113 h3d_data%MH3D=0
114 mh3d0=0
115
116 msg_r2r = 0
117 IF ((irad2r==1).AND.(ncycle<2)) r2r_mfilr = 0
118C
119 IF(ale%SUB%IALESUB/=0 .AND. tt+dt2<=t1s+dt2s)RETURN
120C SOUS CYCLAGE ALE
121C-----------------------------
122C SENSOR
123C-----------------------------
124 IF (sensors%ANIM_ID > 0)THEN
125 IF (tt > sensors%SENSOR_TAB(sensors%ANIM_ID)%TSTART) THEN
126C ACTIVATION
127 sensors%ANIM_ID = -sensors%ANIM_ID
128 output%TANIMSENS = tt + sensors%ANIM_DT
129 manim=4
130 mdess=mdess+manim
131 ENDIF
132 ELSEIF (sensors%ANIM_ID < 0) THEN
133 IF (tt < sensors%SENSOR_TAB(-sensors%ANIM_ID)%TSTART) THEN
134C DEACTIVATION
135 sensors%ANIM_ID = -sensors%ANIM_ID
136 ELSEIF (tt > output%TANIMSENS) THEN
137C ACTIF
138 output%TANIMSENS = output%TANIMSENS + sensors%ANIM_DT
139 manim=4
140 mdess=mdess+manim
141 RETURN
142 ENDIF
143 ENDIF
144c
145 IF (sensors%NANIM > 0) THEN
146 DO i=1,sensors%NANIM
147 sens_id = sensors%ANIM(i)
148 IF (sensors%ANIM(i) > 0) THEN
149 IF (tt > sensors%SENSOR_TAB(sens_id)%TSTART) THEN ! ACTIVATION
150 sensors%ANIM(i) = -sens_id
151 manim=4
152 mdess=mdess+manim
153 ENDIF
154 ELSEIF (sens_id < 0) THEN
155 IF (tt < sensors%SENSOR_TAB(-sens_id)%TSTART) THEN ! DEACTIVATION
156 sensors%ANIM(i) = -sens_id
157 ENDIF
158 ENDIF
159 ENDDO
160 ENDIF
161c
162 IF(h3d_data%N_SENS_H3D>0)THEN
163 DO i=1,h3d_data%N_SENS_H3D
164 IF(h3d_data%LSENS_H3D(i)>0)THEN
165 IF (tt > sensors%SENSOR_TAB(h3d_data%LSENS_H3D(i))%TSTART) THEN
166C ACTIVATION
167 h3d_data%LSENS_H3D(i)=-h3d_data%LSENS_H3D(i)
168 h3d_data%MH3D=1
169 ENDIF
170 ELSEIF (h3d_data%LSENS_H3D(i)<0) THEN
171 IF (tt < sensors%SENSOR_TAB(-h3d_data%LSENS_H3D(i))%TSTART) THEN
172C DEACTIVATION
173 h3d_data%LSENS_H3D(i)=-h3d_data%LSENS_H3D(i)
174 ENDIF
175 ENDIF
176 ENDDO
177 ENDIF
178C-----------------------------
179C INTERVENTION MANUELLE
180C-----------------------------
181C
182 IF((ncycle/ncinp)*ncinp==ncycle)THEN
183 IF(ispmd==0)THEN
184 filnam=rootnam(1:rootlen)//'_'//chrun//'.ctl'
185 len_tmp_name = infile_name_len + len_trim(filnam)
186 tmp_name=infile_name(1:infile_name_len)//filnam(1:len_trim(filnam))
187 OPEN(unit=iusc3,file=tmp_name(1:len_tmp_name),
188 . status='OLD',err=999)
189 READ(iusc3,'(A)',err=990,END=990)carte
190 IF(carte(1:1)/='/')GOTO 990
191 mrest=0
192 manim=0
193 mstop=0
194 mrest0=0
195 manim0=0
196 mstop0=0
197 tman=0.
198 mcycle=0
199 ictlstop=0
200 ictlstop0=0
201 mh3d0 = 0
202C
203 5 CALL redkey2(key2,lk2,key0,nkey,carte,ikey)
204 GOTO (10,20,30,40,50,60,70,80,90,95,96,97,98)ikey
205 GOTO 100
206C TIME
207 10 IF(lk2>1.AND.lk2<10)THEN
208 WRITE(fmt,'(A,I1,A)')'(E',lk2,'.0)'
209 ELSEIF(lk2<100)THEN
210 WRITE(fmt,'(A,I2,A)')'(E',lk2,'.0)'
211 ELSE
212 GOTO 100
213 ENDIF
214 READ(key2,fmt,err=990,END=990)tman
215 GOTO 100
216C CYCLE
217 20 IF(lk2>1.AND.lk2<10)THEN
218 WRITE(fmt,'(A,I1,A)')'(I',lk2,')'
219 ELSEIF(lk2<100)THEN
220 WRITE(fmt,'(A,I2,A)')'(I',lk2,')'
221 ELSE
222 GOTO 100
223 ENDIF
224 READ(key2,fmt,err=990,END=990)mcycle
225C MCYCLE DESATIVE EN MULTIDOMAINES
226 IF (irad2r==1) THEN
227 msg_r2r = 1
228 mcycle = 0
229 ENDIF
230 GOTO 100
231C PLOT
232 30 manim0=manim0+1
233 GOTO 100
234C PATRAN
235 40 manim0=manim0+2
236 GOTO 100
237C RESTART
238 50 mrest0=1
239 GOTO 100
240C STOP
24160 mstop0=1
242 mrest0=1
243 ictlstop0 = 1
244 GOTO 100
245C KILL
246 70 mstop0=1
247 ictlstop0 = 1
248 GOTO 100
249C INFO
250 80 GOTO 100
251C ANIM PLOT
252 90 manim0=manim0+4
253 GOTO 100
254C OUTP PLOT
255 95 manim0=manim0+8
256 GOTO 100
257C L01 FLUSH
258 96 backspace(iout)
259 READ(iout,'(A)')rec
260 GOTO 100
261 97 wmcheck0 = 1
262 GOTO 100
263C H3D PLOT
264 98 mh3d0=1
265 GOTO 100
266 100 CONTINUE
267 READ(iusc3,'(A)',err=400,END=400)carte
268 GOTO 5
269C
270 400 mdess=1
271 rewind iusc3
272C
273 WRITE (iusc3,'(A)',err=990) ' RUN CONTROL FILE'
274 WRITE (iusc3,'(A,/)',err=990) ' ----------------'
275 IF(tman==0.0.AND.mcycle==0)THEN
276 IF (msg_r2r==1) THEN
277 WRITE (iusc3,'(A)',err=990)
278 . ' MULTIDOMAINS -> /CYCLE NOT ALLOWED'
279 ENDIF
280 WRITE(carte,'(A)')' AT CURRENT CYCLE'
281 ELSEIF(tman==0.0)THEN
282 WRITE(carte,'(A,I10)')' AT CYCLE',mcycle
283 ELSEIF(mcycle==0)THEN
284 WRITE(carte,'(A,G14.7)')' AT TIME ',tman
285 ELSE
286 WRITE(carte,'(A,G14.7,A,I10)')' IF TIME >=',tman,
287 . ' AND IF CYCLE >=',mcycle
288 ENDIF
289 IF(manim0==1 .OR.manim0== 3.OR.
290 . manim0==5 .OR.manim0== 7.OR.
291 . manim0==9 .OR.manim0==11.OR.
292 . manim0==13.OR.manim0==15)
293 . WRITE(iusc3,'(/A,A)',err=990)' WRITE NEXT PLOT FILE',carte
294 IF(manim0== 2.OR.manim0== 3.OR.
295 . manim0== 6.OR.manim0== 7.OR.
296 . manim0==10.OR.manim0==11.OR.
297 . manim0==14.OR.manim0==15)
298 . WRITE(iusc3,'(A,A)',err=990)' WRITE NEXT PATRAN FILES',carte
299 IF(manim0== 4.OR.manim0== 5.OR.
300 . manim0== 6.OR.manim0== 7.OR.
301 . manim0==12.OR.manim0==13.OR.
302 . manim0==14.OR.manim0==15)
303 . WRITE(iusc3,'(A,A)',err=990)' WRITE NEXT ANIMATION FILES',
304 . carte
305 IF(manim0== 8.OR.manim0== 9.OR.
306 . manim0==10.OR.manim0==11.OR.
307 . manim0==12.OR.manim0==13.OR.
308 . manim0==14.OR.manim0==15)
309 . WRITE(iusc3,'(A,A)',err=990)' WRITE NEXT OUTPUT FILES',
310 . carte
311 IF(mrest0==1)
312 . WRITE(iusc3,'(A,A)',err=990)' WRITE NEXT RESTART FILE',carte
313 IF(mstop0==1)
314 . WRITE(iusc3,'(A,A)',err=990)' RUN STOP',carte
315 IF(mh3d0 == 1)
316 . WRITE(iusc3,'(A,A)',err=990)' UPDATE H3D FILE', carte
317 mfilr=1
318 IF (irad2r==1) r2r_mfilr=1
319 GOTO 999
320 990 CONTINUE
321 CLOSE (iusc3)
322 999 CONTINUE
323 ENDIF
324C
325 ENDIF
326C
327C---------------------------------
328C MULTI-DOMAIN TREATMENT
329C---------------------------------
330
331 IF (irad2r==1) THEN
332 IF (ispmd==0) THEN
333C *** FLAG MSTOP treatment ***
334 mstop = r2r_mstop
335 r2r_mstop = mstop0
336 mstop0 = mstop
337 IF (r2r_mfilr == 1) THEN
338C *** storage of flags for sending rad2rad ***
339 tman_r2r = tman
340 r2r_ctr(1) = mrest0
341 r2r_ctr(2) = manim0
342 r2r_ctr(3) = wmcheck0
343 ELSEIF (r2r_mfilr == 2) THEN
344C *** applying the flags received from rad2rad ***
345 mfilr = 1
346 r2r_mfilr = 0
347 tman = tman_r2r
348 manim0 = r2r_ctr(2)
349 wmcheck0= r2r_ctr(3)
350 ENDIF
351 ENDIF
352 IF(nspmd > 1) CALL spmd_ibcast(mfilr,mfilr,1,1,0,2)
353 ENDIF
354
355C---------------------------------
356C ECHANGE MULTIPROCS
357C---------------------------------
358 IF((sensors%ANIM_ID /=0 .OR. sensors%NANIM /=0 .OR. h3d_data%N_SENS_H3D > 0) .OR.
359 . ((ncycle/ncinp)*ncinp==ncycle) .OR. (irad2r==1 .AND. mfilr==1)) THEN
360 IF (ispmd==0) THEN
361 tmpman(1) = mdess
362 tmpman(2) = mrest0
363 tmpman(3) = mrest
364 tmpman(4) = mstop0
365 tmpman(5) = mstop
366 tmpman(6) = manim0
367 tmpman(7) = manim
368 tmpman(8) = mcycle
369 tmpman(9) = mfilr
370 tmpman(10)= tman
371 tmpman(11)= wmcheck0
372 tmpman(12) = ictlstop0
373 tmpman(13) = mh3d0
374 tmpman(14) = h3d_data%MH3D
375 ENDIF
376 IF(nspmd > 1)CALL spmd_rbcast(tmpman,tmpman,1,14,0,2)
377 IF (ispmd/=0)THEN
378 mdess = nint(tmpman(1))
379 mrest0 = nint(tmpman(2))
380 mrest = nint(tmpman(3))
381 mstop0 = nint(tmpman(4))
382 mstop = nint(tmpman(5))
383 manim0 = nint(tmpman(6))
384 manim = nint(tmpman(7))
385 mcycle = nint(tmpman(8))
386 mfilr = nint(tmpman(9))
387 tman = tmpman(10)
388 wmcheck0 = nint(tmpman(11))
389 ictlstop0 = nint(tmpman(12))
390 mh3d0 = nint(tmpman(13))
391 h3d_data%MH3D = nint(tmpman(14))
392 ENDIF
393 ENDIF
394C---------------------------------
395
396 IF(mfilr==1)THEN
397 IF(tt>=tman.AND.ncycle>=mcycle)THEN
398 mfilr=0
399 mrest=mrest0
400 manim=manim0
401 mstop=mstop0
402 mdess=mdess+manim
403 wmcheck = wmcheck0
404 ictlstop = ictlstop0
405 h3d_data%MH3D=mh3d0
406 ENDIF
407 ENDIF
408C
409 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
h3d_mod
Definition h3d_mod.F:311
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1007
redkey2
subroutine redkey2(key2, lk2, key0, nkey, carte, ikey)
Definition redkey2.F:29
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_rbcast
subroutine spmd_rbcast(tabi, tabr, n1, n2, from, add)
Definition spmd_rbcast.F:62