OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spmd_msin.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| spmd_msin ../starter/source/elements/initia/spmd_msin.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!||====================================================================
29 SUBROUTINE spmd_msin(
30 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
31 2 IXR ,IXTG ,MSS ,MSQ ,
32 3 MSC ,MST ,MSP ,MSR ,MSTG ,
33 4 INC ,INP ,INR ,INTG ,
34 5 INDEX,ITRI ,MS ,IN ,
35 6 PTG ,GEO ,IXS10,IXS20,
36 7 IXS16,MSSX ,MSNF ,MSSF ,VNS ,
37 8 VNSX ,STC ,STT ,STP ,STR ,
38 9 STTG ,STUR ,BNS ,BNSX ,VOLNOD ,
39 A BVOLNOD ,ETNOD ,STIFINT,INS ,
40 B MCPC ,MCP ,MCPS ,MCPSX ,
41 C MCPTG,SH4TREE,SH3TREE,MS_LAYERC,ZI_LAYERC,
42 D MS_LAYER , ZI_LAYER,MSZ2C,MSZ2,ZPLY,
43 E KXIG3D ,IXIG3D ,MSIG3D,NCTRLMAX,STRC,
44 F STRP,STRR,STRTG,STIFINTR,NSHNOD,VNIGE,BNIGE,
45 G MCPP ,ITHERM_FE)
46C
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "param_c.inc"
57#include "scr12_c.inc"
58#include "remesh_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*),
63 . IXT(NIXT,*),IXP(NIXP,*), IXR(NIXR,*), IXTG(6,*),
64 . INDEX(*), ITRI(*),
65 . IXS10(6,*),IXS20(12,*),IXS16(8,*),
66 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),KXIG3D(NIXIG3D,*),
67 . IXIG3D(*),NSHNOD(*)
68 INTEGER, INTENT(IN) :: ITHERM_FE
69C REAL
70 my_real
71 . MSS(8,*), MSQ(*),MSC(*),MST(*),MSP(*),MSR(3,*),
72 . MSTG(*),MSSX(12,*),INC(*),
73 . INP(*),INR(3,*),INTG(*),
74 . MS(*), IN(*),PTG(3,*), GEO(NPROPG,*),
75 . MSNF(*), MSSF(8,*),
76 . VNS(8,*) ,VNSX(12,*) ,STC(*) ,STT(*) ,STP(*) ,STR(*) ,
77 . STTG(*) ,STUR(*) ,BNS(8,*) ,BNSX(12,*) ,
78 . volnod(*) ,bvolnod(*) ,etnod(*), stifint(*), ins(8,*),
79 . mcp(*),mcpc(*),mcps(8,*),mcpsx(12,*),mcptg(*),
80 . ms_layerc(numelc,*),zi_layerc(numelc,*),
81 . ms_layer(numnod,*),zi_layer(numnod,*),msz2c(*),msz2(*),
82 . zply(*),msig3d(numelig3d,nctrlmax),strc(*),strp(*),strr(*),
83 . strtg(*),stifintr(*), vnige(nctrlmax,*),bnige(nctrlmax,*),
84 . mcpp(*)
85C
86 INTEGER IDEB,NCTRLMAX
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I, J, K, N, IGTYP, WORK(70000),IP
91C
92 DO I = 1, numels
93 itri(i) = ixs(11,i)
94 ENDDO
95C
96 CALL my_orders(0,work,itri,index,numels8,1)
97
98 ideb=numels8+1
99 CALL my_orders(0,work,itri(ideb),index(ideb),numels10,1)
100
101 DO j=1,numels10
102 index(ideb+j-1) = index(ideb+j-1)+numels8
103 ENDDO
104
105 ideb = ideb + numels10
106 CALL my_orders(0,work,itri(ideb),index(ideb),numels20,1)
107 DO j = 1, numels20
108 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10
109 ENDDO
110
111 ideb = ideb + numels20
112 CALL my_orders(0,work,itri(ideb),index(ideb),numels16,1)
113 DO j = 1, numels16
114 index(ideb+j-1) = index(ideb+j-1)+numels8+numels10+numels20
115 ENDDO
116C
117 IF(itherm_fe == 0 ) THEN
118 DO j=1,numels
119 i = index(j)
120 DO k=1,8
121 n = ixs(k+1,i)
122 ms(n) = ms(n) + mss(k,i)
123 ENDDO
124 ENDDO
125 ELSE
126 DO j=1,numels
127 i = index(j)
128 DO k=1,8
129 n = ixs(k+1,i)
130 ms(n) = ms(n) + mss(k,i)
131 mcp(n) = mcp(n) + mcps(k,i)
132 ENDDO
133 ENDDO
134 ENDIF
135C
136 IF(iale==1.OR.ieuler==1 .OR. ialelag==1) THEN
137 DO j=1,numels
138 i = index(j)
139 DO k=1,8
140 n = ixs(k+1,i)
141 msnf(n) = msnf(n) + mssf(k,i)
142 ENDDO
143 ENDDO
144 ENDIF
145C
146 IF(itherm_fe== 0 ) THEN
147 IF(numels10>0) THEN
148 DO j=1,numels10
149 i = index(numels8+j)
150 DO k=1,6
151 n = ixs10(k,i-numels8)
152 IF (n/=0) THEN
153 ms(n) = ms(n) + mssx(k,i)
154 END IF
155 ENDDO
156 ENDDO
157 ENDIF
158
159 IF(numels20>0)THEN
160 DO j=1,numels20
161 i = index(numels8+numels10+j)
162 DO k=1,12
163 n = ixs20(k,i-numels8-numels10)
164 IF (n/=0) THEN
165 ms(n) = ms(n) + mssx(k,i)
166 END IF
167 ENDDO
168 ENDDO
169 ENDIF
170C
171 IF(numels16>0)THEN
172 DO j=1,numels16
173 i = index(numels8+numels10+numels20+j)
174 DO k=1,8
175 n = ixs16(k,i-numels8-numels10-numels20)
176 IF (n/=0) THEN
177 ms(n) = ms(n) + mssx(k,i)
178 END IF
179 ENDDO
180 ENDDO
181 ENDIF
182 ELSE
183C
184C + heat transfer
185C
186 IF(numels10>0) THEN
187 DO j=1,numels10
188 i = index(numels8+j)
189 DO k=1,6
190 n = ixs10(k,i-numels8)
191 IF (n/=0) THEN
192 ms(n) = ms(n) + mssx(k,i)
193 mcp(n) = mcp(n) + mcpsx(k,i)
194 END IF
195 ENDDO
196 ENDDO
197 ENDIF
198
199 IF(numels20>0)THEN
200 DO j=1,numels20
201 i = index(numels8+numels10+j)
202 DO k=1,12
203 n = ixs20(k,i-numels8-numels10)
204 IF (n/=0) THEN
205 ms(n) = ms(n) + mssx(k,i)
206 mcp(n) = mcp(n) + mcpsx(k,i)
207 END IF
208 ENDDO
209 ENDDO
210 ENDIF
211C
212 IF(numels16>0)THEN
213 DO j=1,numels16
214 i = index(numels8+numels10+numels20+j)
215 DO k=1,8
216 n = ixs16(k,i-numels8-numels10-numels20)
217 IF (n/=0) THEN
218 ms(n) = ms(n) + mssx(k,i)
219 mcp(n) = mcp(n) + mcpsx(k,i)
220 END IF
221 ENDDO
222 ENDDO
223 ENDIF
224 ENDIF
225C
226
227 IF(iroddl /= 0)THEN
228 DO j=1,numels8+numels10
229 i = index(j)
230 DO k=1,8
231 n = ixs(k+1,i)
232 in(n) = in(n) + ins(k,i)
233 ENDDO
234 ENDDO
235 ENDIF
236C
237 IF(i7stifs/=0)THEN
238 DO j=1,numels
239 i = index(j)
240 DO k=1,8
241 n = ixs(k+1,i)
242 volnod(n) = volnod(n) + vns(k,i)
243 bvolnod(n) = bvolnod(n) + bns(k,i)
244 ENDDO
245 ENDDO
246C
247 IF(numels10>0) THEN
248 DO j=1,numels10
249 i = index(numels8+j)
250 DO k=1,6
251 n = ixs10(k,i-numels8)
252 IF (n/=0) THEN
253 volnod(n) = volnod(n) + vnsx(k,i)
254 bvolnod(n) = bvolnod(n) + bnsx(k,i)
255 END IF
256 ENDDO
257 ENDDO
258 ENDIF
259C
260 IF(numels20>0)THEN
261 DO j=1,numels20
262 i = index(numels8+numels10+j)
263 DO k=1,12
264 n = ixs20(k,i-numels8-numels10)
265 IF (n/=0) THEN
266 volnod(n) = volnod(n) + vnsx(k,i)
267 bvolnod(n) = bvolnod(n) + bnsx(k,i)
268 END IF
269 ENDDO
270 ENDDO
271 ENDIF
272C
273 IF(numels16>0)THEN
274 DO j=1,numels16
275 i = index(numels8+numels10+numels20+j)
276 DO k=1,8
277 n = ixs16(k,i-numels8-numels10-numels20)
278 IF (n/=0) THEN
279 volnod(n) = volnod(n) + vnsx(k,i)
280 bvolnod(n) = bvolnod(n) + bnsx(k,i)
281 END IF
282 ENDDO
283 ENDDO
284 ENDIF
285C
286 IF(numelig3d>0) THEN
287 DO i = 1, numelig3d
288 itri(i) = kxig3d(5,i)
289 ENDDO
290 CALL my_orders(0,work,itri,index,numelig3d,1)
291 DO j=1,numelig3d
292 i = index(j)
293 DO k=1,kxig3d(3,i)
294 n = ixig3d(kxig3d(4,i)+k-1)
295 IF (n/=0) THEN
296 volnod(n) = volnod(n) + vnige(k,i)
297 bvolnod(n) = bvolnod(n) + bnige(k,i)
298 END IF
299 ENDDO
300 ENDDO
301 ENDIF
302 ENDIF
303C
304 DO i = 1, numelq
305 itri(i) = ixq(7,i)
306 ENDDO
307 CALL my_orders(0,work,itri,index,numelq,1)
308 DO j=1,numelq
309 i = index(j)
310 DO k=1,4
311 n = ixq(k+1,i)
312 ms(n) = ms(n) + msq(i)
313 ENDDO
314 ENDDO
315C
316 DO i = 1, numelc
317 itri(i) = ixc(7,i)
318 ENDDO
319C
320 CALL my_orders(0,work,itri,index,numelc,1)
321C
322 IF(itherm_fe == 0 ) THEN
323 IF(nadmesh==0)THEN
324 DO j=1,numelc
325 i = index(j)
326 DO k=1,4
327 n = ixc(k+1,i)
328 ms(n) = ms(n) + msc(i)
329 in(n) = in(n) + inc(i)
330 ENDDO
331 ENDDO
332 ELSE
333 IF(istatcnd==0)THEN
334 DO j=1,numelc
335 i = index(j)
336 IF(sh4tree(3,i) >= 0)THEN
337 DO k=1,4
338 n = ixc(k+1,i)
339 ms(n) = ms(n) + msc(i)
340 in(n) = in(n) + inc(i)
341 ENDDO
342 END IF
343 ENDDO
344 ELSE
345 DO j=1,numelc
346 i = index(j)
347 IF(sh4tree(3,i) == 0 .OR. sh4tree(3,i) == -1)THEN
348 DO k=1,4
349 n = ixc(k+1,i)
350 ms(n) = ms(n) + msc(i)
351 in(n) = in(n) + inc(i)
352 ENDDO
353 END IF
354 ENDDO
355 END IF
356 END IF
357 ELSE ! ITHERM_FE /= 0
358 IF(nadmesh==0)THEN
359 DO j=1,numelc
360 i = index(j)
361 DO k=1,4
362 n = ixc(k+1,i)
363 ms(n) = ms(n) + msc(i)
364 in(n) = in(n) + inc(i)
365 mcp(n) = mcp(n) + mcpc(i)
366 ENDDO
367 ENDDO
368 ELSE
369 IF(istatcnd==0)THEN
370 DO j=1,numelc
371 i = index(j)
372 IF(sh4tree(3,i) >= 0)THEN
373 DO k=1,4
374 n = ixc(k+1,i)
375 ms(n) = ms(n) + msc(i)
376 in(n) = in(n) + inc(i)
377 mcp(n) = mcp(n) + mcpc(i)
378 ENDDO
379 END IF
380 ENDDO
381 ELSE
382 DO j=1,numelc
383 i = index(j)
384 IF(sh4tree(3,i) == -1)THEN
385 DO k=1,4
386 n = ixc(k+1,i)
387 ms(n) = ms(n) + msc(i)
388 in(n) = in(n) + inc(i)
389 ENDDO
390 ELSEIF(sh4tree(3,i) == 0) THEN
391 DO k=1,4
392 n = ixc(k+1,i)
393 ms(n) = ms(n) + msc(i)
394 in(n) = in(n) + inc(i)
395 mcp(n) = mcp(n) + mcpc(i)
396 ENDDO
397 ELSEIF(sh4tree(3,i) > 0) THEN
398 DO k=1,4
399 n = ixc(k+1,i)
400 mcp(n) = mcp(n) + mcpc(i)
401 ENDDO
402 END IF
403 ENDDO
404 END IF
405 END IF
406 ENDIF
407C
408 IF(iplyxfem > 0) THEN
409 DO ip=1,nplymax
410 DO j=1,numelc
411 i = index(j)
412 DO k=1,4
413 n = ixc(k+1,i)
414 ms_layer(n,ip) = ms_layer(n,ip) + ms_layerc(i,ip)
415 IF(zi_layerc(i,ip) == zero) THEN
416 zi_layer(n,ip) = zply(ip)
417 ELSE
418 zi_layer(n,ip) = zi_layerc(i,ip)
419 ENDIF
420 ENDDO
421
422 ENDDO
423 ENDDO
424C sum mi*zi*zi
425 DO j=1,numelc
426 i = index(j)
427 DO k=1,4
428 n = ixc(k+1,i)
429 msz2(n) = msz2(n) + msz2c(i)
430 ENDDO
431 ENDDO
432 ENDIF
433C
434 IF(i7stifs/=0)THEN
435C
436 DO j=1,numelc
437 i = index(j)
438 DO k=1,4
439 n = ixc(k+1,i)
440 etnod(n) = etnod(n) + stc(i)
441 stifintr(n) = stifintr(n) + strc(i)/nshnod(n)
442 ENDDO
443 ENDDO
444C
445 ENDIF
446C
447 DO i = 1, numelt
448 itri(i) = ixt(5,i)
449 ENDDO
450 CALL my_orders(0,work,itri,index,numelt,1)
451 DO j=1,numelt
452 i = index(j)
453 DO k=1,2
454 n = ixt(k+1,i)
455 ms(n) = ms(n) + mst(i)
456 ENDDO
457 ENDDO
458C
459 IF(i7stifs/=0)THEN
460 DO j=1,numelt
461 i = index(j)
462 DO k=1,2
463 n = ixt(k+1,i)
464 stifint(n) = stifint(n) + stt(i)
465 ENDDO
466 ENDDO
467 ENDIF
468C
469 DO i = 1, numelp
470 itri(i) = ixp(6,i)
471 ENDDO
472 CALL my_orders(0,work,itri,index,numelp,1)
473 IF(itherm_fe == 0) THEN
474 DO j=1,numelp
475 i = index(j)
476 n = ixp(2,i)
477 ms(n) = ms(n) + msp(i)
478 in(n) = in(n) + inp(i)
479 n = ixp(3,i)
480 ms(n) = ms(n) + msp(i)
481 in(n) = in(n) + inp(i)
482 ENDDO
483 ELSE
484 DO j=1,numelp
485 i = index(j)
486 n = ixp(2,i)
487 ms(n) = ms(n) + msp(i)
488 in(n) = in(n) + inp(i)
489 mcp(n) = mcp(n) + mcpp(i)
490 n = ixp(3,i)
491 ms(n) = ms(n) + msp(i)
492 in(n) = in(n) + inp(i)
493 mcp(n) = mcp(n) + mcpp(i)
494 ENDDO
495 ENDIF
496C
497 IF(i7stifs/=0)THEN
498 DO j=1,numelp
499 i = index(j)
500 n = ixp(2,i)
501 stifint(n) = stifint(n) + stp(i)
502 stifintr(n) = stifintr(n) + strp(i)
503 n = ixp(3,i)
504 stifint(n) = stifint(n) + stp(i)
505 stifintr(n) = stifintr(n) + strp(i)
506 ENDDO
507 ENDIF
508C
509 DO i = 1, numelr
510 itri(i) = ixr(6,i)
511 ENDDO
512 CALL my_orders(0,work,itri,index,numelr,1)
513 DO j=1,numelr
514 i = index(j)
515 DO k=1,2
516 n = ixr(k+1,i)
517 ms(n) = ms(n) + msr(k,i)
518 in(n) = in(n) + inr(k,i)
519 ENDDO
520 igtyp = nint(geo(12,ixr(1,i)))
521 IF(igtyp==12) THEN
522 n = ixr(4,i)
523 ms(n) = ms(n) + msr(3,i)
524 in(n) = in(n) + inr(3,i)
525 ENDIF
526 ENDDO
527C
528 IF(i7stifs/=0)THEN
529 DO j=1,numelr
530 i = index(j)
531 DO k=1,2
532 n = ixr(k+1,i)
533 stifint(n) = stifint(n) + str(i)
534 stifintr(n) = stifintr(n) + strr(i)
535 ENDDO
536 igtyp = nint(geo(12,ixr(1,i)))
537 IF(igtyp==12) THEN
538 n = ixr(4,i)
539 stifint(n) = stifint(n) + two*str(i)
540 ENDIF
541 ENDDO
542 ENDIF
543C
544 DO i = 1, numeltg
545 itri(i) = ixtg(6,i)
546 ENDDO
547 CALL my_orders(0,work,itri,index,numeltg,1)
548 IF(itherm _fe== 0 ) THEN
549 IF(nadmesh==0)THEN
550 DO j=1,numeltg
551 i = index(j)
552 DO k=1,3
553 n = ixtg(k+1,i)
554 ms(n) = ms(n) + mstg(i)*ptg(k,i)
555 in(n) = in(n) + intg(i)*ptg(k,i)
556 ENDDO
557 ENDDO
558 ELSE
559 IF(istatcnd==0)THEN
560 DO j=1,numeltg
561 i = index(j)
562 IF(sh3tree(3,i) >= 0)THEN
563 DO k=1,3
564 n = ixtg(k+1,i)
565 ms(n) = ms(n) + mstg(i)*ptg(k,i)
566 in(n) = in(n) + intg(i)*ptg(k,i)
567 ENDDO
568 END IF
569 ENDDO
570 ELSE
571 DO j=1,numeltg
572 i = index(j)
573 IF(sh3tree(3,i) == 0 .OR. sh3tree(3,i) == -1)THEN
574 DO k=1,3
575 n = ixtg(k+1,i)
576 ms(n) = ms(n) + mstg(i)*ptg(k,i)
577 in(n) = in(n) + intg(i)*ptg(k,i)
578 ENDDO
579 END IF
580 ENDDO
581 END IF
582 END IF
583 ELSE ! ITHERM_FE /= 0
584 IF(nadmesh==0)THEN
585 DO j=1,numeltg
586 i = index(j)
587 DO k=1,3
588 n = ixtg(k+1,i)
589 ms(n) = ms(n) + mstg(i)*ptg(k,i)
590 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
591 ENDDO
592 ENDDO
593 ELSE
594 IF(istatcnd==0)THEN
595 DO j=1,numeltg
596 i = index(j)
597 IF(sh3tree(3,i) >= 0)THEN
598 DO k=1,3
599 n = ixtg(k+1,i)
600 ms(n) = ms(n) + mstg(i)*ptg(k,i)
601 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
602 ENDDO
603 END IF
604 ENDDO
605 ELSE
606 DO j=1,numeltg
607 i = index(j)
608 IF(sh3tree(3,i) == -1)THEN
609 DO k=1,3
610 n = ixtg(k+1,i)
611 ms(n) = ms(n) + mstg(i)*ptg(k,i)
612 ENDDO
613 ELSEIF(sh3tree(3,i) == 0)THEN
614 DO k=1,3
615 n = ixtg(k+1,i)
616 ms(n) = ms(n) + mstg(i)*ptg(k,i)
617 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
618 ENDDO
619 ELSEIF(sh3tree(3,i) > 0)THEN
620 DO k=1,3
621 n = ixtg(k+1,i)
622 mcp(n) = mcp(n) + mcptg(i)*ptg(k,i)
623 ENDDO
624 END IF
625 ENDDO
626 END IF
627 END IF
628 ENDIF
629C
630 IF(i7stifs/=0)THEN
631 DO j=1,numeltg
632 i = index(j)
633 DO k=1,3
634 n = ixtg(k+1,i)
635 etnod(n) = etnod(n) + sttg(i)
636 stifintr(n) = stifintr(n) + strtg(i)/nshnod(n)
637 ENDDO
638 ENDDO
639 ENDIF
640C
641 DO i = 1, numelig3d
642 itri(i) = kxig3d(5,i)
643 ENDDO
644 CALL my_orders(0,work,itri,index,numelig3d,1)
645 DO j=1,numelig3d
646 i = index(j)
647 DO k=1,kxig3d(3,i)
648 n = ixig3d(kxig3d(4,i)+k-1)
649 ms(n) = ms(n) + msig3d(i,k)
650 ENDDO
651 ENDDO
652C
653 RETURN
654 END
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
subroutine spmd_msin(ixs, ixq, ixc, ixt, ixp, ixr, ixtg, mss, msq, msc, mst, msp, msr, mstg, inc, inp, inr, intg, index, itri, ms, in, ptg, geo, ixs10, ixs20, ixs16, mssx, msnf, mssf, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, stifint, ins, mcpc, mcp, mcps, mcpsx, mcptg, sh4tree, sh3tree, ms_layerc, zi_layerc, ms_layer, zi_layer, msz2c, msz2, zply, kxig3d, ixig3d, msig3d, nctrlmax, strc, strp, strr, strtg, stifintr, nshnod, vnige, bnige, mcpp, itherm_fe)
Definition spmd_msin.F:46
character *8 function strr(y)
Definition strr.F:34