OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_constraints.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "lagmult.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"
#include "sphcom.inc"
#include "fxbcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_constraints (nom_opt, inom_opt, npby, lpby, rby, ibftemp, fbftemp, ibfflux, fbfflux, itab, icode, iskew, ibcslag, ibfvel, fbfvel, nimpdisp, nimpvel, nimpacc, rwbuf, nprw, lprw, ibcscyc, irbe3, lrbe3, frbe3, mgrby, ispcond, irbe2, lrbe2, npbyl, lpbyl, rbyl, ibmpc, ibmpc2, ibmpc3, ibmpc4, rbmpc, ljoint, nnlink, lnlink, llinal, linale, gjbufi, gjbufr, ms, in, fxbipm, fxbfile_tab, glob_therm)

Function/Subroutine Documentation

◆ st_qaprint_constraints()

subroutine st_qaprint_constraints ( integer, dimension(lnopt1,snom_opt1), intent(in) nom_opt,
integer, dimension(sinom_opt), intent(in) inom_opt,
integer, dimension(nnpby,nrbykin), intent(in) npby,
integer, dimension(*), intent(in) lpby,
dimension(nrby,nrbykin), intent(in) rby,
integer, dimension(glob_therm%nift,glob_therm%nfxtemp), intent(in) ibftemp,
dimension(glob_therm%lfacther,glob_therm%nfxtemp), intent(in) fbftemp,
integer, dimension(glob_therm%nitflux,glob_therm%nfxflux), intent(in) ibfflux,
dimension(glob_therm%lfacther,glob_therm%nfxflux), intent(in) fbfflux,
integer, dimension(numnod), intent(in) itab,
integer, dimension(numnod), intent(in) icode,
integer, dimension(numnod), intent(in) iskew,
integer, dimension(5,nbcslag), intent(in) ibcslag,
integer, dimension(nifv,nfxvel), intent(in) ibfvel,
dimension(lfxvelr,nfxvel), intent(in) fbfvel,
integer, intent(in) nimpdisp,
integer, intent(in) nimpvel,
integer, intent(in) nimpacc,
dimension(nrwlp,nrwall), intent(in) rwbuf,
integer, dimension(nrwall,nnprw), intent(in) nprw,
integer, dimension(slprw), intent(in) lprw,
integer, dimension(4,nbcscyc), intent(in) ibcscyc,
integer, dimension(nrbe3l,nrbe3), intent(in) irbe3,
integer, dimension(slrbe3), intent(in) lrbe3,
dimension(6,*), intent(in) frbe3,
integer, dimension(nmgrby,smgrby), intent(in) mgrby,
integer, dimension(nispcond,*), intent(in) ispcond,
integer, dimension(nrbe2l,nrbe2), intent(in) irbe2,
integer, dimension(slrbe2), intent(in) lrbe2,
integer, dimension(nnpby,nrbylag), intent(in) npbyl,
integer, dimension(*), intent(in) lpbyl,
dimension(nrby,nrbylag), intent(in) rbyl,
integer, dimension(nummpc), intent(in) ibmpc,
integer, dimension(lmpc), intent(in) ibmpc2,
integer, dimension(lmpc), intent(in) ibmpc3,
integer, dimension(lmpc), intent(in) ibmpc4,
dimension(srbmpc), intent(in) rbmpc,
integer, dimension(*), intent(in) ljoint,
integer, dimension(10,snnlink), intent(in) nnlink,
integer, dimension(slnlink), intent(in) lnlink,
integer, intent(in) llinal,
integer, dimension(llinal), intent(in) linale,
integer, dimension(lkjni,*), intent(in) gjbufi,
dimension(lkjnr,*), intent(in) gjbufr,
dimension(*), intent(in) ms,
dimension(*), intent(in) in,
integer, dimension(nbipm,nfxbody), intent(in) fxbipm,
character, dimension(nfxbody) fxbfile_tab,
type (glob_therm_), intent(in) glob_therm )

Definition at line 32 of file st_qaprint_constraints.F.

42C============================================================================
43C M o d u l e s
44C-----------------------------------------------
45 USE qa_out_mod
46 USE r2r_mod
47 USE bcs_mod
48 USE names_and_titles_mod , ONLY : nchartitle
49 use glob_therm_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com04_c.inc"
58#include "lagmult.inc"
59#include "param_c.inc"
60#include "scr17_c.inc"
61#include "tabsiz_c.inc"
62#include "sphcom.inc"
63#include "fxbcom.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER, INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
68 INTEGER, INTENT(IN) :: ITAB(NUMNOD)
69 TYPE (glob_therm_) ,intent(in) :: glob_therm
70C-----------------------------------------------
71C NOM_OPT(LNOPT1,SNOM_OPT1)
72C * Possibly, NOM_OPT(1) = ID
73C NOM_OPT(LNOPT1-LTITL+1:LTITL) <=> TITLES of the OPTIONS
74C--------------------------------------------------
75C SNOM_OPT1= NRBODY+NACCELM+NVOLU+NINTER+NINTSUB+
76C + NRWALL+NJOINT+NSECT+NLINK+
77C + NUMSKW+1+NUMFRAM+1+NFXBODY+NFLOW+NRBE2+
78C + NRBE3+NSUBMOD+NFXVEL+NUMBCS+NUMMPC+
79C + NGJOINT+NUNIT0+NFUNCT+NADMESH+
80C + NSPHIO+NSPCOND+NRBYKIN+NEBCS+
81C + NINICRACK+NODMAS+NBGAUGE+NCLUSTER+NINTERFRIC+
82C + NRBMERGE
83C-----------------------------------------------
84C INOM_OPT(SINOM_OPT)
85C--------------------------------------------------
86C INOM_OPT(1) = NRBODY
87C INOM_OPT(2) = INOM_OPT(1) + NACCELM
88C INOM_OPT(3) = INOM_OPT(2) + NVOLU
89C INOM_OPT(4) = INOM_OPT(3) + NINTER
90C INOM_OPT(5) = INOM_OPT(4) + NINTSUB
91C INOM_OPT(6) = INOM_OPT(5) + NRWALL
92C INOM_OPT(7) = INOM_OPT(6)
93C INOM_OPT(8) = INOM_OPT(7) + NJOINT
94C INOM_OPT(9) = INOM_OPT(8) + NSECT
95C INOM_OPT(10)= INOM_OPT(9) + NLINK
96C INOM_OPT(11)= INOM_OPT(10)+ NUMSKW+1+NUMFRAM+1+NSUBMOD
97C INOM_OPT(12)= INOM_OPT(11)+ NFXBODY
98C INOM_OPT(13)= INOM_OPT(12)+ NFLOW
99C INOM_OPT(14)= INOM_OPT(13)+ NRBE2
100C INOM_OPT(15)= INOM_OPT(14)+ NRBE3
101C INOM_OPT(16)= INOM_OPT(15)+ NFXVEL
102C INOM_OPT(17)= INOM_OPT(16)+ NUMBCS
103C INOM_OPT(18)= INOM_OPT(17)+ NUMMPC
104C INOM_OPT(19)= INOM_OPT(18)+ NGJOINT
105C INOM_OPT(20)= INOM_OPT(19)+ NUNIT0
106C INOM_OPT(21)= INOM_OPT(20)+ NFUNCT
107C INOM_OPT(22)= INOM_OPT(21)+ NADMESH
108C INOM_OPT(23)= INOM_OPT(22)+ NSPHIO
109C INOM_OPT(24)= INOM_OPT(23)+ NSPCOND
110C INOM_OPT(25)= INOM_OPT(24)+ NEBCS
111C INOM_OPT(26)= INOM_OPT(25)+ NINICRACK
112C INOM_OPT(27)= INOM_OPT(26)+ NODMAS
113C INOM_OPT(28)= INOM_OPT(27)+ NBGAUGE
114C INOM_OPT(29)= INOM_OPT(28)+ NCLUSTER
115C INOM_OPT(30)= INOM_OPT(29)+ NINTERFRIC
116C INOM_OPT(31)= INOM_OPT(30)+ NRBMERGE
117C .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
118C-----------------------------------------------
119 INTEGER, INTENT(IN) :: NIMPDISP,NIMPVEL,NIMPACC
120 INTEGER, INTENT(IN) :: NPBY(NNPBY,NRBYKIN), NPBYL(NNPBY,NRBYLAG),
121 . LPBY(*), LPBYL(*), IBCSCYC(4,NBCSCYC)
122 INTEGER, INTENT(IN) :: IBFTEMP(GLOB_THERM%NIFT,GLOB_THERM%NFXTEMP)
123 INTEGER, INTENT(IN) :: IBFFLUX(GLOB_THERM%NITFLUX,GLOB_THERM%NFXFLUX)
124 INTEGER, INTENT(IN) :: ICODE(NUMNOD), ISKEW(NUMNOD),IBFVEL(NIFV,NFXVEL)
125 INTEGER, INTENT(IN) :: IBCSLAG(5,NBCSLAG),NPRW(NRWALL,NNPRW),LPRW(SLPRW)
126 INTEGER, INTENT(IN) :: IRBE3(NRBE3L,NRBE3), LRBE3(SLRBE3)
127 INTEGER, INTENT(IN) :: IRBE2(NRBE2L,NRBE2), LRBE2(SLRBE2)
128 INTEGER, INTENT(IN) :: NNLINK(10,SNNLINK), LNLINK(SLNLINK)
129 INTEGER, DIMENSION(NRWALL) :: IDX, IDS
130 INTEGER, DIMENSION(NFXBODY) :: IDXFX, IDSFX
131 INTEGER, INTENT(IN) :: MGRBY(NMGRBY,SMGRBY)
132 INTEGER, INTENT(IN) :: ISPCOND(NISPCOND,*),LJOINT(*),GJBUFI(LKJNI,*)
133 INTEGER, INTENT(IN) :: IBMPC(NUMMPC),IBMPC2(LMPC),IBMPC3(LMPC),IBMPC4(LMPC)
134 my_real, INTENT(IN) ::
135 . rby(nrby,nrbykin),rbyl(nrby,nrbylag),frbe3(6,*),gjbufr(lkjnr,*),ms(*),in(*)
136 my_real, INTENT(IN) :: fbftemp(glob_therm%LFACTHER,glob_therm%NFXTEMP)
137 my_real, INTENT(IN) :: fbfflux(glob_therm%LFACTHER,glob_therm%NFXFLUX)
138 my_real, INTENT(IN) :: fbfvel(lfxvelr,nfxvel)
139 my_real, INTENT(IN) ::
140 . rwbuf(nrwlp,nrwall)
141 my_real, INTENT(IN) ::
142 . rbmpc(srbmpc)
143 INTEGER, INTENT(IN) :: LLINAL
144 INTEGER, DIMENSION(LLINAL), INTENT(IN) :: LINALE
145 INTEGER, INTENT(IN) :: FXBIPM(NBIPM,NFXBODY)
146 CHARACTER, DIMENSION(NFXBODY) :: FXBFILE_TAB*2148
147C--------------------------------------------------
148C L o c a l V a r i a b l e s
149C-----------------------------------------------
150 INTEGER I, II, MY_ID, MY_RBODY, MY_CONSTRAINT, MY_NODE, MY_RWALL, POSI(NRWALL+1),
151 . MY_MERGE, TNSL, K, NS, MY_FXBODY
152 CHARACTER(LEN=NCHARTITLE) :: TITR
153 CHARACTER (LEN=255) :: VARNAME
154 DOUBLE PRECISION TEMP_DOUBLE
155 INTEGER TEMP_INTEGER
156 INTEGER IADS,ITMP
157C-----------------------------------------------
158C Rigid Bodies
159C-----------------------------------------------
160 IF (myqakey('/RBODY')) THEN
161 DO my_rbody=1,nrbykin
162C
163 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,my_rbody),ltitr)
164 my_id = npby(6,my_rbody)
165 IF(len_trim(titr)/=0)THEN
166 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
167 ELSE
168 CALL qaprint('A_RIGID_BODY_FAKE_NAME',my_id,0.0_8)
169 END IF
170C
171 DO i=1,nnpby
172 IF(npby(i,my_rbody) /=0)THEN
173C
174C VARNAME: variable name in ref.extract (without blanks)
175 WRITE(varname,'(A,I0)') 'NPBY_',i
176 CALL qaprint(varname(1:len_trim(varname)),npby(i,my_rbody),0.0_8)
177 END IF
178 END DO
179C
180 DO i=npby(11,my_rbody)+1,npby(11,my_rbody)+npby(2,my_rbody)
181C
182C VARNAME: variable name in ref.extract (without blanks)
183 WRITE(varname,'(A,I0)') 'LPBY_',i
184 CALL qaprint(varname(1:len_trim(varname)),lpby(i),0.0_8)
185 END DO
186C
187 DO i=1,nrby
188 IF(rby(i,my_rbody)/=zero)THEN
189C
190C VARNAME: variable name in ref.extract (without blanks)
191 WRITE(varname,'(A,I0)') 'RBY_',i
192 temp_double = rby(i,my_rbody)
193 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
194 END IF
195 END DO
196C
197 END DO ! MY_RBODY=1,NRBYKIN
198C-------
199 tnsl=0
200 DO my_rbody=1,nrbylag
201C
202 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,nrbykin+my_rbody),ltitr)
203 my_id = npbyl(6,my_rbody)
204 IF(len_trim(titr)/=0)THEN
205 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
206 ELSE
207 CALL qaprint('A_RIGID_BODY_FAKE_NAME',my_id,0.0_8)
208 END IF
209C
210 DO i=1,nnpby
211 IF(npbyl(i,my_rbody) /=0)THEN
212C
213C VARNAME: variable name in ref.extract (without blanks)
214 WRITE(varname,'(A,I0)') 'NPBYL_',i
215 CALL qaprint(varname(1:len_trim(varname)),npbyl(i,my_rbody),0.0_8)
216 END IF
217 END DO
218C
219 DO i=1,npbyl(2,my_rbody)-1
220C
221C VARNAME: variable name in ref.extract (without blanks)
222 WRITE(varname,'(A,I0)') 'LPBYL_',i
223 CALL qaprint(varname(1:len_trim(varname)),itab(lpbyl(tnsl+i)),0.0_8)
224 END DO
225C
226 DO i=1,nrby
227 IF(rbyl(i,my_rbody)/=zero)THEN
228C
229C VARNAME: variable name in ref.extract (without blanks)
230 WRITE(varname,'(A,I0)') 'RBYL_',i
231 temp_double = rbyl(i,my_rbody)
232 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
233 END IF
234 END DO
235C
236 tnsl=tnsl+3*npbyl(2,my_rbody)
237 END DO ! MY_RBODY=1,NRBODY
238 END IF
239C-----------------------------------------------
240C BCS
241C-----------------------------------------------
242 IF (myqakey('/BCS') .OR. myqakey('/ALE/BCS')) THEN
243 DO my_node=1,numnod
244C
245 my_id = itab(my_node)
246C
247 IF(icode(my_node)/=0)THEN
248C VARNAME: variable name in ref.extract (without blanks)
249 WRITE(varname,'(A,I0,I0)') 'ICODE_',my_id
250 CALL qaprint(varname(1:len_trim(varname)),icode(my_node),0.0_8)
251 END IF
252C
253 IF(iskew(my_node)/=0)THEN
254C
255C VARNAME: variable name in ref.extract (without blanks)
256 WRITE(varname,'(A,I0,I0)') 'ISKEW_',my_id
257 CALL qaprint(varname(1:len_trim(varname)),iskew(my_node),0.0_8)
258 END IF
259C
260 END DO ! MY_NODE=1,NUMNOD
261 END IF
262C-----------------------------------------------
263C /IMPTEMP
264C-----------------------------------------------
265 IF (myqakey('/IMPTEMP')) THEN
266 DO my_constraint=1,glob_therm%NFXTEMP
267C
268C Title of the option was not stored in NOM_OPT ... TBD
269C and Imptemp ID is not stored
270 titr(1:nchartitle)=''
271 IF(len_trim(titr)/=0)THEN
272 CALL qaprint(titr(1:len_trim(titr)),my_constraint,0.0_8)
273 ELSE
274 CALL qaprint('A_IMPTEMP_FAKE_NAME',my_constraint,0.0_8)
275 END IF
276C
277 DO i=1,glob_therm%NIFT
278 IF(ibftemp(i,my_constraint) /=0)THEN
279C
280C VARNAME: variable name in ref.extract (without blanks)
281 WRITE(varname,'(A,I0)') 'IBFTEMP_',i ! IBFTEMP(11) => 'IBFTEMP_11'
282 CALL qaprint(varname(1:len_trim(varname)),ibftemp(i,my_constraint),0.0_8)
283 END IF
284 END DO
285C
286 DO i=1,glob_therm%LFACTHER
287 IF(fbftemp(i,my_constraint)/=zero)THEN
288C
289C VARNAME: variable name in ref.extract (without blanks)
290 WRITE(varname,'(A,I0)') 'FBFTEMP_',i
291 temp_double = fbftemp(i,my_constraint)
292 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
293 END IF
294 END DO
295C
296 END DO ! MY_CONSTRAINT=1,NFXTEMP
297 END IF
298C-----------------------------------------------
299C /IMPDISP
300C-----------------------------------------------
301 IF (myqakey('/IMPDISP')) THEN
302 DO my_constraint=1,nimpdisp
303C
304 titr(1:nchartitle)=''
305 IF(len_trim(titr)/=0)THEN
306 CALL qaprint(titr(1:len_trim(titr)),my_constraint,0.0_8)
307 ELSE
308 CALL qaprint('A_IMPACC_FAKE_NAME',my_constraint,0.0_8)
309 END IF
310C
311 DO i=1,nifv
312 IF (ibfvel(i,my_constraint) /=0) THEN
313C
314C VARNAME: variable name in ref.extract (without blanks)
315 WRITE(varname,'(A,I0)') 'IBFVEL_',i
316 CALL qaprint(varname(1:len_trim(varname)),ibfvel(i,my_constraint),0.0_8)
317 END IF
318 END DO
319C
320 DO i=1,lfxvelr
321 IF(fbfvel(i,my_constraint)/=zero)THEN
322C
323C VARNAME: variable name in ref.extract (without blanks)
324 WRITE(varname,'(A,I0)') 'FBFVEL_',i
325 temp_double = fbfvel(i,my_constraint)
326 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
327 END IF
328 END DO
329C
330 END DO ! MY_CONSTRAINT=NFXVEL-NIMPACC+1,NFXVEL
331 END IF
332C-----------------------------------------------
333C /IMPVEL
334C-----------------------------------------------
335 IF (myqakey('/IMPVEL')) THEN
336 DO my_constraint=nimpdisp+1,nimpdisp+nimpvel
337C
338 titr(1:nchartitle)=''
339 IF(len_trim(titr)/=0)THEN
340 CALL qaprint(titr(1:len_trim(titr)),my_constraint,0.0_8)
341 ELSE
342 CALL qaprint('A_IMPACC_FAKE_NAME',my_constraint,0.0_8)
343 END IF
344C
345 DO i=1,nifv
346 IF (ibfvel(i,my_constraint) /=0) THEN
347C
348C VARNAME: variable name in ref.extract (without blanks)
349 WRITE(varname,'(A,I0)') 'IBFVEL_',i
350 CALL qaprint(varname(1:len_trim(varname)),ibfvel(i,my_constraint),0.0_8)
351 END IF
352 END DO
353C
354 DO i=1,lfxvelr
355 IF(fbfvel(i,my_constraint)/=zero)THEN
356C
357C VARNAME: variable name in ref.extract (without blanks)
358 WRITE(varname,'(A,I0)') 'FBFVEL_',i
359 temp_double = fbfvel(i,my_constraint)
360 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
361 END IF
362 END DO
363C
364 END DO ! MY_CONSTRAINT=NFXVEL-NIMPACC+1,NFXVEL
365 END IF
366C-----------------------------------------------
367C /IMPACC
368C-----------------------------------------------
369 IF (myqakey('/IMPACC')) THEN
370 DO my_constraint=nfxvel-nimpacc+1,nfxvel
371C
372C Title of the option was not stored in NOM_OPT ... TBD
373C and Impvel ID is not stored
374 titr(1:nchartitle)=''
375 IF(len_trim(titr)/=0)THEN
376 CALL qaprint(titr(1:len_trim(titr)),my_constraint,0.0_8)
377 ELSE
378 CALL qaprint('A_IMPACC_FAKE_NAME',my_constraint,0.0_8)
379 END IF
380C
381 DO i=1,nifv
382 IF (ibfvel(i,my_constraint) /=0) THEN
383C
384C VARNAME: variable name in ref.extract (without blanks)
385 WRITE(varname,'(A,I0)') 'IBFVEL_',i
386 CALL qaprint(varname(1:len_trim(varname)),ibfvel(i,my_constraint),0.0_8)
387 END IF
388 END DO
389C
390 DO i=1,lfxvelr
391 IF(fbfvel(i,my_constraint)/=zero)THEN
392C
393C VARNAME: variable name in ref.extract (without blanks)
394 WRITE(varname,'(A,I0)') 'FBFVEL_',i
395 temp_double = fbfvel(i,my_constraint)
396 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
397 END IF
398 END DO
399C
400 END DO ! MY_CONSTRAINT=NFXVEL-NIMPACC+1,NFXVEL
401 END IF
402C-----------------------------------------------
403C /IMPFLUX
404C-----------------------------------------------
405 IF (myqakey('/IMPFLUX')) THEN
406 DO my_constraint=1,glob_therm%NFXFLUX
407C
408C Title of the option was not stored in NOM_OPT ... TBD
409C and Impflux ID is not stored
410 titr(1:nchartitle)=''
411 IF(len_trim(titr)/=0)THEN
412 CALL qaprint(titr(1:len_trim(titr)),my_constraint,0.0_8)
413 ELSE
414 CALL qaprint('A_IMPFLUX_FAKE_NAME',my_constraint,0.0_8)
415 END IF
416C
417 DO i=1,glob_therm%NITFLUX
418 IF(ibfflux(i,my_constraint) /=0)THEN
419C
420C VARNAME: variable name in ref.extract (without blanks)
421 WRITE(varname,'(A,I0)') 'IBFFLUX_',i ! IBFFLUX(11) => 'IBFFLUX_11'
422 CALL qaprint(varname(1:len_trim(varname)),ibfflux(i,my_constraint),0.0_8)
423 END IF
424 END DO
425C
426 DO i=1,glob_therm%LFACTHER
427 IF(fbfflux(i,my_constraint)/=zero)THEN
428C
429C VARNAME: variable name in ref.extract (without blanks)
430 WRITE(varname,'(A,I0)') 'FBFFLUX_',i
431 temp_double = fbfflux(i,my_constraint)
432 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
433 END IF
434 END DO
435C
436 END DO ! MY_CONSTRAINT=1,NFXFLUX
437 END IF
438C-----------------------------------------------
439C /BCS/LAGMUL
440C-----------------------------------------------
441 IF (myqakey('/BCS/LAGMUL')) THEN
442 DO my_constraint=1,nbcslag
443C
444 titr(1:nchartitle)=''
445 my_id = ibcslag(5,my_constraint)
446 IF(len_trim(titr)/=0)THEN
447 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
448 ELSE
449 CALL qaprint('A_BCS_LAGMUL_FAKE_NAME',my_id,0.0_8)
450 END IF
451C
452 DO i=1,5
453C
454 IF(ibcslag(i,my_constraint)/=0)THEN
455C
456C VARNAME: variable name in ref.extract (without blanks)
457 WRITE(varname,'(A,I0,I0)') 'IBCSLAG_',i ! IBCSLAG(11) => 'IBCSLAG_11'
458 CALL qaprint(varname(1:len_trim(varname)),ibcslag(i,my_constraint),0.0_8)
459 END IF
460C
461 END DO
462C
463 END DO ! MY_CONSTRAINT=1,NBCSLAG
464 END IF
465C-----------------------------------------------
466C /BCS/CYCLIC
467C-----------------------------------------------
468 IF (myqakey('/BCS/CYCLIC')) THEN
469 DO my_constraint=1,nbcscyc
470C
471 titr(1:nchartitle)=''
472 my_id = ibcscyc(4,my_constraint)
473 IF(len_trim(titr)/=0)THEN
474 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
475 ELSE
476 CALL qaprint('A_BCS_CYCLIC_FAKE_NAME',my_id,0.0_8)
477 END IF
478C
479 DO i=1,4
480C
481 IF(ibcscyc(i,my_constraint)/=0)THEN
482C
483C VARNAME: variable name in ref.extract (without blanks)
484 WRITE(varname,'(A,I0,I0)') 'IBCSCYC_',i
485 CALL qaprint(varname(1:len_trim(varname)),ibcscyc(i,my_constraint),0.0_8)
486 END IF
487C
488 END DO
489C
490 END DO ! MY_CONSTRAINT=1,NBCSCYC
491 END IF
492C-----------------------------------------------
493C /BCS/WALL
494C-----------------------------------------------
495 IF (myqakey('/BCS/WALL')) THEN
496 DO my_constraint=1,bcs%NUM_WALL
497
498 titr(1:nchartitle)=''
499 my_id = bcs%WALL(my_constraint)%user_id
500 IF(len_trim(titr)/=0)THEN
501 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
502 ELSE
503 CALL qaprint('A_BCS_WALL_FAKE_NAME',my_id,0.0_8)
504 END IF
505 !
506 WRITE(varname,'(A,I0,A)') 'BCS_WALL_',my_constraint,'__IS_DEPENDING_ON_TIME_'
507 temp_integer = 0
508 IF(bcs%WALL(my_constraint)%IS_DEPENDING_ON_TIME)temp_integer=1
509 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
510 !
511 WRITE(varname,'(A,I0,A)') 'BCS_WALL_',my_constraint,'__IS_DEPENDING_ON_SENSOR_'
512 temp_integer = 0
513 IF(bcs%WALL(my_constraint)%IS_DEPENDING_ON_SENSOR)temp_integer=1
514 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
515 !
516 WRITE(varname,'(A,I0,A)') 'BCS_WALL_',my_constraint,'__GRNOD_ID_'
517 temp_integer = bcs%WALL(my_constraint)%GRNOD_ID
518 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
519 !
520 WRITE(varname,'(A,I0,A)') 'BCS_WALL_',my_constraint,'__SENSOR_ID_'
521 temp_integer = bcs%WALL(my_constraint)%SENSOR_ID
522 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
523 !
524 WRITE(varname,'(A,I0,A)') 'BCS_WALL_',my_constraint,'__TSTART_'
525 temp_double = bcs%WALL(my_constraint)%TSTART
526 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
527 !
528 WRITE(varname,'(A,I0,A)') 'BCS_WALL_',my_constraint,'__TSTOP_'
529 temp_double = bcs%WALL(my_constraint)%TSTOP
530 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
531 !
532 WRITE(varname,'(A,I0,A)') 'bcs_wall_',MY_CONSTRAINT,'__list__size_'
533 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%SIZE
534 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
535 !
536 ITMP=TEMP_INTEGER
537 IF(ITMP == 1)THEN
538 WRITE(VARNAME,'(a,i0,a)') 'bcs_wall_',MY_CONSTRAINT,'__list__elem_1_'
539 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%ELEM(1)
540 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
541 !
542 WRITE(VARNAME,'(a,i0,a)') 'bcs_wall_',MY_CONSTRAINT,'__list__face_1_'
543 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%FACE(1)
544 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
545 ELSEIF(ITMP > 1)THEN
546 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%ELEM(1)
547 WRITE(VARNAME,'(a,i0,a,i0,a)') 'bcs_wall_',MY_CONSTRAINT,'__list__elems_ ',TEMP_INTEGER,' ...'
548 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%ELEM(ITMP)
549 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
550 !
551 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%FACE(1)
552 WRITE(VARNAME,'(a,i0,a,i0,a)') 'bcs_wall_',MY_CONSTRAINT,'__list__faces_ ',TEMP_INTEGER,' ...'
553 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%FACE(ITMP)
554 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
555 ENDIF
556
557 END DO ! MY_CONSTRAINT=1,BCS%NUM_WALL
558 END IF
559C-----------------------------------------------
560C /RWALL
561C-----------------------------------------------
562 IF (MYQAKEY('/rwall')) THEN
563 IF (NRWALL > 0) THEN
564C
565! Sort by ID to ensure internal order independent output
566 POSI(1) = 1
567 DO I = 1, NRWALL
568 IDS(I) = NOM_OPT(LNOPT1*INOM_OPT(5)+1,I)
569 IDX(I) = I
570 POSI(I+1) = POSI(I) + NPRW(I,1)+INT(RWBUF(8,I))
571 ENDDO
572 CALL QUICKSORT_I2(IDS, IDX, 1, NRWALL)
573C
574! Loop over RWALLs
575 DO II = 1,NRWALL
576C
577 MY_RWALL = IDX(II)
578 TITR(1:nchartitle)=''
579 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,MY_RWALL),LTITR)
580 MY_ID = NOM_OPT(1,MY_RWALL + INOM_OPT(5))
581 IF (LEN_TRIM(TITR) /= 0) THEN
582 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
583 ELSE
584 CALL QAPRINT('a_rwall_fake_name',MY_ID,0.0_8)
585 END IF
586C
587 DO I = 1,NNPRW
588 IF (NPRW(MY_RWALL,I) /= 0) THEN
589C
590C VARNAME: variable name in ref.extract (without blanks)
591 WRITE(VARNAME,'(a,i0)') 'nprw_',I
592 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),NPRW(MY_RWALL,I),0.0_8)
593 END IF
594 END DO
595C
596 DO I = 1,NRWLP
597 IF (RWBUF(I,MY_RWALL) /= ZERO) THEN
598C
599C VARNAME: variable name in ref.extract (without blanks)
600 WRITE(VARNAME,'(a,i0)') 'rwbuf_',I
601 TEMP_DOUBLE = RWBUF(I,MY_RWALL)
602 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
603 END IF
604 END DO
605C
606 DO I = POSI(MY_RWALL),POSI(MY_RWALL+1)-1
607 IF (LPRW(I) /= 0) THEN
608C
609C VARNAME: variable name in ref.extract (without blanks)
610 WRITE(VARNAME,'(a,i0)') 'lprw_',I-POSI(MY_RWALL)+1
611 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LPRW(I),0.0_8)
612 END IF
613 END DO
614C
615 END DO
616C
617 ENDIF
618 ENDIF
619C-----------------------------------------------
620C RBE3
621C-----------------------------------------------
622 IF (MYQAKEY('/rbe3')) THEN
623 iads = slrbe3/2
624 DO my_constraint=1,nrbe3
625C
626 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,my_constraint + inom_opt(14)),ltitr)
627 my_id = irbe3(2,my_constraint)
628 IF(len_trim(titr)/=0)THEN
629 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
630 ELSE
631 CALL qaprint('A_RBE3_FAKE_NAME',my_id,0.0_8)
632 END IF
633C
634 DO i=1,nrbe3l
635 IF(irbe3(i,my_constraint) /=0)THEN
636C
637C VARNAME: variable name in ref.extract (without blanks)
638 WRITE(varname,'(A,I0)') 'IRBE3_',i
639 CALL qaprint(varname(1:len_trim(varname)),irbe3(i,my_constraint),0.0_8)
640 END IF
641 END DO
642C
643 DO i=irbe3(1,my_constraint)+1,irbe3(1,my_constraint)+irbe3(5,my_constraint)
644C
645C VARNAME: variable name in ref.extract (without blanks)
646 WRITE(varname,'(A,I0)') 'LRBE3_',i
647 CALL qaprint(varname(1:len_trim(varname)),lrbe3(i),0.0_8)
648 END DO
649C
650 DO i=irbe3(1,my_constraint)+1,irbe3(1,my_constraint)+irbe3(5,my_constraint)
651C
652C VARNAME: variable name in ref.extract (without blanks)
653 WRITE(varname,'(A,I0)') 'LRBE3s_',i
654 CALL qaprint(varname(1:len_trim(varname)),lrbe3(i+iads),0.0_8)
655 END DO
656C
657 DO i=irbe3(1,my_constraint)+1,irbe3(1,my_constraint)+irbe3(5,my_constraint)
658C
659 DO ii = 1,6
660 IF(frbe3(ii,i) /=one.AND.frbe3(ii,i) /=zero)THEN
661 WRITE(varname,'(A,I1,A,I0)') 'FRBE3_',ii,'_',i
662 temp_double = frbe3(ii,i)
663 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
664 END IF
665 END DO !II = 1,6
666 END DO
667C
668 END DO ! MY_CONSTRAINT=1,NRBE3
669 END IF
670C-----------------------------------------------
671C Merge Rigid Bodies
672C-----------------------------------------------
673 IF (myqakey('/MERGE')) THEN
674 ii = 1
675 DO my_constraint=1,nrbmerge
676C
677 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(30)+my_constraint),ltitr)
678 my_id = mgrby(6,ii)
679 IF(len_trim(titr)/=0)THEN
680 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
681 ELSE
682 CALL qaprint('A_MERGE_FAKE_NAME',my_id,0.0_8)
683 END IF
684C
685 DO my_merge=ii,smgrby
686 IF(mgrby(6,my_merge) /= my_id) THEN
687 ii = my_merge
688 EXIT
689 ENDIF
690 DO i=1,nmgrby
691 IF(mgrby(i,my_merge) /=0)THEN
692C VARNAME: variable name in ref.extract (without blanks)
693 WRITE(varname,'(A,I0)') 'MGRBY_',i
694 CALL qaprint(varname(1:len_trim(varname)),mgrby(i,my_merge),0.0_8)
695 END IF
696 END DO
697 END DO ! MY_MERGE=II,SMGRBY
698
699 END DO ! MY_CONSTRAINT=1,NRBMERGE
700 END IF
701C-----------------------------------------------
702C /SPHBCS
703C-----------------------------------------------
704 IF (myqakey('/SPHBCS')) THEN
705 DO my_constraint=1,nspcond
706CC
707 titr(1:nchartitle)=''
708 my_id = ispcond(4,my_constraint)
709 IF(len_trim(titr)/=0)THEN
710 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
711 ELSE
712 CALL qaprint('A_SPHBCS_FAKE_NAME',my_id,0.0_8)
713 END IF
714C
715 DO i=1,nispcond
716 IF(ispcond(i,my_constraint)/=0)THEN
717C VARNAME: variable name in ref.extract (without blanks)
718 WRITE(varname,'(A,I0,I0)') 'ISPCOND_',i
719 CALL qaprint(varname(1:len_trim(varname)),ispcond(i,my_constraint),0.0_8)
720 END IF
721C
722 END DO
723C
724 END DO ! MY_CONSTRAINT=1,NSPCOND
725 END IF
726C-----------------------------------------------
727C /RBE2
728C-----------------------------------------------
729 IF (myqakey('/RBE2')) THEN
730 DO my_constraint=1,nrbe2
731C
732 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,my_constraint + inom_opt(13)),ltitr)
733 my_id = irbe2(2,my_constraint)
734 IF(len_trim(titr)/=0)THEN
735 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
736 ELSE
737 CALL qaprint('A_RBE2_FAKE_NAME',my_id,0.0_8)
738 END IF
739C
740 DO i=1,nrbe2l
741 IF(irbe2(i,my_constraint) /=0)THEN
742C
743C VARNAME: variable name in ref.extract (without blanks)
744 WRITE(varname,'(A,I0)') 'IRBE2_',i
745 CALL qaprint(varname(1:len_trim(varname)),irbe2(i,my_constraint),0.0_8)
746 END IF
747 END DO
748C
749 DO i=irbe2(1,my_constraint)+1,irbe2(1,my_constraint)+irbe2(5,my_constraint)
750C
751C VARNAME: variable name in ref.extract (without blanks)
752 WRITE(varname,'(A,I0)') 'LRBE2_',i
753 CALL qaprint(varname(1:len_trim(varname)),lrbe2(i),0.0_8)
754 END DO
755C
756 END DO ! MY_CONSTRAINT=1,NRBE2
757 END IF
758C-----------------------------------------------
759C /MPC
760C-----------------------------------------------
761 IF (myqakey('/MPC')) THEN
762 ii=0
763 DO my_constraint=1,nummpc
764C
765 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(17) + my_constraint),ltitr)
766
767 my_id = nom_opt(1,inom_opt(17)+my_constraint)
768 IF(len_trim(titr)/=0)THEN
769 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
770 ELSE
771 CALL qaprint('A_MPC_FAKE_NAME',my_id,0.0_8)
772 END IF
773C
774 DO i=1,ibmpc(my_constraint)
775
776 IF(ibmpc2(ii+i) /=0)THEN
777C VARNAME: variable name in ref.extract (without blanks)
778 WRITE(varname,'(A,I0)') 'NOD_',i
779 CALL qaprint(varname(1:len_trim(varname)),ibmpc2(ii+i),0.0_8)
780 END IF
781
782 IF(ibmpc3(ii+i) /=0)THEN
783C VARNAME: variable name in ref.extract (without blanks)
784 WRITE(varname,'(A,I0)') 'IDOF_',i
785 CALL qaprint(varname(1:len_trim(varname)),ibmpc3(ii+i),0.0_8)
786 END IF
787
788 IF(ibmpc4(ii+i) /=0)THEN
789C VARNAME: variable name in ref.extract (without blanks)
790 WRITE(varname,'(A,I0)') 'ISKEW_',i
791 CALL qaprint(varname(1:len_trim(varname)),ibmpc4(ii+i),0.0_8)
792 END IF
793
794 IF(rbmpc(ii+i) /=0)THEN
795 WRITE(varname,'(A,I1,A,I0)') 'ALPHA_',i
796 temp_double = rbmpc(ii+i)
797 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
798 END IF
799
800 END DO
801 ii = ii + ibmpc(my_constraint)
802C
803 END DO ! MY_CONSTRAINT=1,NUMMPC
804 END IF
805C-----------------------------------------------
806C /CYL_JOINT
807C-----------------------------------------------
808 IF (myqakey('/CYL_JOINT')) THEN
809C
810 ii = 1
811C
812 DO my_constraint=1,njoint
813C
814 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(7)+my_constraint),ltitr)
815 my_id = nom_opt(1,inom_opt(7)+my_constraint)
816 IF(len_trim(titr)/=0)THEN
817 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
818 ELSE
819 CALL qaprint('A_CYLJOINT_FAKE_NAME',my_id,0.0_8)
820 END IF
821C
822 ns = ljoint(ii)
823C
824 DO i=1,ns
825 WRITE(varname,'(A,I0)') 'NOD_',i
826 CALL qaprint(varname(1:len_trim(varname)),itab(ljoint(ii+i)),0.0_8)
827 ENDDO
828C
829 ii=ii+ns+1
830C
831 END DO
832 END IF
833C-----------------------------------------------
834C /GJOINT
835C-----------------------------------------------
836 IF (myqakey('/GJOINT')) THEN
837C
838 DO my_constraint=1,ngjoint
839C
840 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(18) + my_constraint),ltitr)
841 my_id = nom_opt(1,inom_opt(18)+my_constraint)
842 IF(len_trim(titr)/=0)THEN
843 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
844 ELSE
845 CALL qaprint('A_GJOINT_FAKE_NAME',my_id,0.0_8)
846 END IF
847C
848 DO i=1,lkjni
849 WRITE(varname,'(A,I0)') 'GJBUFI_',i
850 CALL qaprint(varname(1:len_trim(varname)),gjbufi(i,my_constraint),0.0_8)
851 ENDDO
852C
853 DO i=1,lkjnr
854 WRITE(varname,'(A,I0)') 'GJBUFR_',i
855 temp_double = gjbufr(i,my_constraint)
856 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
857 ENDDO
858C
859 DO i=1,4
860 WRITE(varname,'(A,I0)') 'MASS_',i
861 IF (gjbufi(2+i,my_constraint) > 0) THEN
862 temp_double = ms(gjbufi(2+i,my_constraint))
863 ELSE
864 temp_double = zero
865 ENDIF
866 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
867 ENDDO
868C
869 DO i=1,4
870 WRITE(varname,'(A,I0)') 'INER_',i
871 IF (gjbufi(2+i,my_constraint) > 0) THEN
872 temp_double = in(gjbufi(2+i,my_constraint))
873 ELSE
874 temp_double = zero
875 ENDIF
876 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
877 ENDDO
878C
879 END DO
880 END IF
881C-----------------------------------------------
882C RLINK
883C-----------------------------------------------
884 IF (myqakey('/RLINK')) THEN
885C
886 IF (nlink > 0) THEN
887C
888C
889 DO my_constraint = 1, nlink
890c
891 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(9)+my_constraint),ltitr)
892 my_id = nom_opt(1,inom_opt(9)+my_constraint)
893 IF(len_trim(titr)/=0)THEN
894 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
895 ELSE
896 CALL qaprint('A_RLINK_NAME',my_id,0.0_8)
897 END IF
898c
899 DO i = 1,10
900 IF(nnlink(i,my_constraint) /=0)THEN
901 WRITE(varname,'(A,I0)') 'NNLINK_',i
902 CALL qaprint(varname(1:len_trim(varname)),nnlink(i,my_constraint),0.0_8)
903 END IF
904 ENDDO
905c
906 ENDDO
907 DO i = 1,slnlink
908 IF(lnlink(i) /=0)THEN
909 WRITE(varname,'(A,I0)') 'LNLINK_',i
910 CALL qaprint(varname(1:len_trim(varname)),lnlink(i),0.0_8)
911 END IF
912 ENDDO
913
914
915 ENDIF
916 END IF
917C-----------------------------------------------
918C /ALE/LINK
919C-----------------------------------------------
920 IF (myqakey('/ALE/LINK')) THEN
921 DO ii = 1, llinal
922 WRITE(varname,'(A,I0)') 'LINALE_', ii
923 CALL qaprint(varname(1:len_trim(varname)),linale(ii),0.0_8)
924 ENDDO
925 ENDIF
926C-----------------------------------------------
927C /FXBODY
928C-----------------------------------------------
929 IF (myqakey('/FXBODY')) THEN
930 IF (nfxbody > 0) THEN
931C
932! Sort by ID to ensure internal order independent output
933 DO i = 1, nfxbody
934 idsfx(i) = fxbipm(1,i)
935 idxfx(i) = i
936 ENDDO
937 CALL quicksort_i2(idsfx, idxfx, 1, nfxbody)
938C
939! Loop over FXBODY
940 DO ii = 1,nfxbody
941C
942 my_fxbody = idxfx(ii)
943 titr(1:nchartitle)=''
944 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,inom_opt(11)+my_fxbody),ltitr)
945 my_id = nom_opt(1,inom_opt(11)+my_fxbody)
946 IF (len_trim(titr) /= 0) THEN
947 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
948 ELSE
949 CALL qaprint('A_FXBODY_FAKE_NAME',my_id,0.0_8)
950 END IF
951C
952 DO i = 1,nbipm
953 IF (fxbipm(i,my_fxbody) /= 0) THEN
954 WRITE(varname,'(A,I0)') 'FXBIPM_',i
955 CALL qaprint(varname(1:len_trim(varname)),fxbipm(i,my_fxbody),0.0_8)
956 ENDIF
957 ENDDO
958C
959 CALL qaprint('FXBODY_FILE_NAME',0,0.0_8)
960 CALL qaprint(fxbfile_tab(my_fxbody)(1:len_trim(fxbfile_tab(my_fxbody))),0,0.0_8)
961C
962 ENDDO
963 ENDIF
964 ENDIF
965C-----------------------------------------------
966 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
qa_out_mod
Definition qa_out_mod.F:78
qa_out_mod::myqakey
logical function myqakey(value)
@purpose Check if a given value is part of the values set by env variable Useful to make a condition ...
Definition qa_out_mod.F:694
qa_out_mod::qaprint
subroutine qaprint(name, idin, value)
@purpose print one entry to QA extract file example of call for real print CALL QAPRINT('MY_LABEL',...
Definition qa_out_mod.F:390
r2r_mod
Definition r2r_mod.F:125
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804