source: CIVL/examples/fortran/nek5000/core/reader_rea.f

main
Last change on this file was ea777aa, checked in by Alex Wilton <awilton@…>, 3 years ago

Moved examples, include, build_default.properties, common.xml, and README out from dev.civl.com into the root of the repo.

git-svn-id: ​svn://vsl.cis.udel.edu/civl/trunk@5704 fb995dde-84ed-4084-dfe6-e5aef3e2452c
  • Property mode set to 100755
File size: 33.5 KB
Line 
1c-----------------------------------------------------------------------
2 subroutine rdparam
3C
4C .Read in parameters supplied by preprocessor and
5C (eventually) echo check.
6C
7C .Broadcast run parameters to all processors
8C
9 INCLUDE 'SIZE'
10 INCLUDE 'INPUT'
11 INCLUDE 'PARALLEL'
12 INCLUDE 'CTIMER'
13
14 character*132 string(100)
15
16 VNEKTON = 3 ! dummy not really used anymore
17
18 optlevel = 1! fixed for now
19 loglevel = 1! fixed for now
20
21 IF(NID.EQ.0) THEN
22 READ(9,*,ERR=400)
23 READ(9,*,ERR=400)
24 READ(9,*,ERR=400) ldimr
25 READ(9,*,ERR=400) NPARAM
26 DO 20 I=1,NPARAM
27 READ(9,*,ERR=400) PARAM(I)
28 20 CONTINUE
29 ENDIF
30 call bcast(ldimr,ISIZE)
31 call bcast(NPARAM,ISIZE)
32 call bcast(PARAM ,200*WDSIZE)
33
34 NPSCAL=INT(PARAM(23))
35 NPSCL1=NPSCAL+1
36 NPSCL2=NPSCAL+2
37
38 IF (NPSCL1.GT.LDIMT) THEN
39 if(nid.eq.0) then
40 WRITE(6,21) LDIMT,NPSCL1
41 21 FORMAT(//,2X,'Error: This NEKTON Solver has been compiled'
42 $ /,2X,' for',I4,' passive scalars. This run'
43 $ /,2X,' requires that LDIMT be set to',I4,'.')
44 endif
45 call exitt
46 ENDIF
47
48c Use same tolerances for all fields
49 restol(0) = param(22) ! mesh
50 restol(1) = param(22)
51 do i=1,ldimt
52 restol(1+i) = param(22)
53 enddo
54 call bcast(restol, (ldimt1+1)*wdsize)
55
56c
57c Read in the passive scalar conduct and rhocp's:
58c
59c fluid
60c .viscosity is PARAM(2)
61c .if it is negative, it indicates that Re has been input
62c .therefore, redefine PARAM(2) = -1.0/PARAM(2)
63c
64 if(param(2) .lt.0.0) param(2) = -1.0/param(2)
65 if(param(8) .lt.0.0) param(8) = -1.0/param(8)
66 if(param(29).lt.0.0) param(29) = -1.0/param(29)
67C
68 CPFLD(1,1)=PARAM(2)
69 CPFLD(1,2)=PARAM(1)
70C temperature
71 CPFLD(2,1)=PARAM(8)
72 CPFLD(2,2)=PARAM(7)
73 CPFLD(2,3)=PARAM(9)
74c
75c passive scalars
76c
77 IF(NID.EQ.0) THEN
78 READ(9,*,ERR=400) NSKIP
79 IF (NSKIP.GT.0 .AND. NPSCAL.GT.0) THEN
80 READ(9,*,ERR=400)(CPFLD(I,1),I=3,NPSCL2)
81 IF(NPSCL2.LT.9)READ(9,*)
82 READ(9,*,ERR=400)(CPFLD(I,2),I=3,NPSCL2)
83 IF(NPSCL2.LT.9)READ(9,*)
84 do i=3,npscl2
85 if (cpfld(i,1).lt.0) cpfld(i,1) = -1./cpfld(i,1)
86 if (cpfld(i,2).lt.0) cpfld(i,2) = -1./cpfld(i,2)
87 enddo
88 ELSE
89 DO 25 I=1,NSKIP
90 READ(9,*,ERR=500)
91 25 CONTINUE
92 ENDIF
93 ENDIF
94 call bcast(cpfld,WDSIZE*LDIMT1*3)
95
96C
97C Read logical equation type descriptors....
98C
99 IFTMSH(0) = .false.
100 IFPROJFLD(0) = .false.
101 IFDGFLD(0) = .false.
102 do i=1,NPSCL2
103 IFTMSH(i) = .false.
104 IFADVC(i) = .false.
105 IFDGFLD(i) = .false.
106 IFFILTER(i) = .false.
107 IFDIFF(i) = .true.
108 IFDEAL(i) = .true. ! still depends on param(99)
109 IFPROJFLD(i) = .false.
110 if (param(94).gt.0) IFPROJFLD(i) = .true.
111 enddo
112
113 do i=1,NPSCL1
114 IDPSS(i) = 0 ! use Helmholtz for passive scalars
115 enddo
116
117 IFFLOW = .false.
118 IFHEAT = .false.
119 IFTRAN = .false.
120 IFAXIS = .false.
121 IFAZIV = .false.
122 IFSTRS = .false.
123 IFLOMACH = .false.
124 IFMODEL = .false.
125 IFKEPS = .false.
126 IFMVBD = .false.
127 IFCHAR = .false.
128 IFDG = .false.
129 IFANLS = .false.
130 IFMOAB = .false.
131 IFCOUP = .false.
132 IFVCOUP = .false.
133 IFMHD = .false.
134 IFESSR = .false.
135 IFTMSH(0) = .false.
136 IFUSERVP = .false.
137 IFCONS = .false. ! Use conservation form?
138 IFUSERMV = .false.
139 IFCYCLIC = .false.
140 IFSYNC = .false.
141 IFEXPLVIS = .false.
142 IFSCHCLOB = .false.
143c IFSPLIT = .false.
144
145 ifbase = .true.
146 ifpert = .false.
147
148 ifreguo = .false. ! by default we dump the data based on the GLL mesh
149
150 ifrich = .false.
151
152 IF(NID.EQ.0) READ(9,*,ERR=500) NLOGIC
153 call bcast(NLOGIC,ISIZE)
154 IF(NLOGIC.GT.100) THEN
155 if(nid.eq.0)
156 $ write(6,*) 'ABORT: Too many logical switches', NLOGIC
157 call exitt
158 ENDIF
159
160 if(nid.eq.0) READ(9,'(A132)',ERR=500) (string(i),i=1,NLOGIC)
161 call bcast(string,100*132*CSIZE)
162
163 do i = 1,NLOGIC
164 call capit(string(i),132)
165 if (indx1(string(i),'IFTMSH' ,6).gt.0) then
166 read(string(i),*,ERR=490) (IFTMSH(II),II=0,NPSCL2)
167 elseif (indx1(string(i),'IFNAV' ,5).gt.0 .and.
168 & indx1(string(i),'IFADVC' ,6).gt.0) then
169 read(string(i),*,ERR=490) (IFADVC(II),II=1,NPSCL2)
170 elseif (indx1(string(i),'IFADVC' ,6).gt.0) then
171 read(string(i),*,ERR=490) (IFADVC(II),II=1,NPSCL2)
172 elseif (indx1(string(i),'IFFLOW' ,6).gt.0) then
173 read(string(i),*) IFFLOW
174 elseif (indx1(string(i),'IFHEAT' ,6).gt.0) then
175 read(string(i),*) IFHEAT
176 elseif (indx1(string(i),'IFTRAN' ,6).gt.0) then
177 read(string(i),*) IFTRAN
178 elseif (indx1(string(i),'IFAXIS' ,6).gt.0) then
179 read(string(i),*) IFAXIS
180 elseif (indx1(string(i),'IFAZIV' ,6).gt.0) then
181 read(string(i),*) IFAZIV
182 elseif (indx1(string(i),'IFSTRS' ,6).gt.0) then
183 read(string(i),*) IFSTRS
184 elseif (indx1(string(i),'IFLO' ,4).gt.0) then
185 read(string(i),*) IFLOMACH
186 elseif (indx1(string(i),'IFMGRID',7).gt.0) then
187c read(string(i),*) IFMGRID
188 elseif (indx1(string(i),'IFKEPS' ,6).gt.0) then
189 read(string(i),*) IFKEPS
190 elseif (indx1(string(i),'IFMODEL',7).gt.0) then
191 read(string(i),*) IFMODEL
192 elseif (indx1(string(i),'IFMVBD' ,6).gt.0) then
193 read(string(i),*) IFMVBD
194 elseif (indx1(string(i),'IFCHAR' ,6).gt.0) then
195 read(string(i),*) IFCHAR
196 elseif (indx1(string(i),'IFDG' ,4).gt.0) then
197 read(string(i),*) IFDG
198 elseif (indx1(string(i),'IFANLS' ,6).gt.0) then
199 read(string(i),*) IFANLS
200 elseif (indx1(string(i),'IFCOUP' ,6).gt.0) then
201 read(string(i),*) IFCOUP
202 elseif (indx1(string(i),'IFVCOUP' ,7).gt.0) then
203 read(string(i),*) IFVCOUP
204 elseif (indx1(string(i),'IFMHD' ,5).gt.0) then
205 read(string(i),*) IFMHD
206 elseif (indx1(string(i),'IFCONS' ,6).gt.0) then
207 read(string(i),*) IFCONS
208 elseif (indx1(string(i),'IFUSERVP',8).gt.0) then
209 read(string(i),*) IFUSERVP
210 elseif (indx1(string(i),'IFUSERMV',8).gt.0) then
211 read(string(i),*) IFUSERMV
212 elseif (indx1(string(i),'IFCYCLIC',8).gt.0) then
213 read(string(i),*) IFCYCLIC
214 elseif (indx1(string(i),'IFPERT' ,6).gt.0) then
215 read(string(i),*) IFPERT
216 elseif (indx1(string(i),'IFBASE' ,6).gt.0) then
217 read(string(i),*) IFBASE
218 elseif (indx1(string(i),'IFSYNC' ,6).gt.0) then
219 read(string(i),*) IFSYNC
220 elseif (indx1(string(i),'IFSCHCLOB',9).gt.0) then
221 read(string(i),*) IFSCHCLOB
222 elseif (indx1(string(i),'IFSPLIT' ,7).gt.0) then
223c read(string,*) IFSPLIT
224 else
225 if(nid.eq.0) then
226 write(6,'(1X,2A)') 'ABORT: Unknown logical flag', string
227 write(6,'(30(A,/))')
228 & ' Available logical flags:',
229 & ' IFTMSH' ,
230 & ' IFADVC' ,
231 & ' IFFLOW' ,
232 & ' IFHEAT' ,
233 & ' IFTRAN' ,
234 & ' IFAXIS' ,
235 & ' IFCYCLIC' ,
236 & ' IFSTRS' ,
237 & ' IFLOMACH' ,
238 & ' IFMGRID' ,
239 & ' IFKEPS' ,
240 & ' IFMVBD' ,
241 & ' IFCHAR' ,
242 & ' IFDG' ,
243 & ' IFANLS' ,
244 & ' IFUSERVP' ,
245 & ' IFUSERMV' ,
246 & ' IFSYNC' ,
247 & ' IFCYCLIC' ,
248 & ' IFSPLIT' ,
249 & ' IFEXPLVIS',
250 & ' IFCONS' ,
251 & ' IFCOUP' ,
252 & ' IFVCOUP'
253 endif
254 call exitt
255 endif
256 490 continue
257 enddo
258
259 ifmgrid = .false.
260 if (ifsplit) ifmgrid = .true.
261
262 if (ifaxis.and..not.ifsplit) then ! Use standard Schwarz/PCG solver
263 ifmgrid = .false.
264 param(42) = 1.00000 ! p042 0=gmres/1=pcg
265 param(43) = 1.00000 ! p043 0=semg/1=schwarz
266 param(44) = 1.00000 ! p044 0=E-based/1=A-based prec.
267 endif
268
269 if (param(29).ne.0.) ifmhd = .true.
270 if (ifmhd) ifessr = .true.
271 if (ifmhd) npscl1 = npscl1 + 1
272 if (param(30).gt.0) ifuservp = .true.
273 if (param(31).ne.0.) ifpert = .true.
274 if (param(31).lt.0.) ifbase = .false. ! don't time adv base flow
275 npert = abs(param(31))
276
277 IF (NPSCL1.GT.LDIMT .AND. IFMHD) THEN
278 if(nid.eq.0) then
279 WRITE(6,22) LDIMT,NPSCL1
280 22 FORMAT(/s,2X,'Error: This NEKTON Solver has been compiled'
281 $ /,2X,' for',I4,' passive scalars. A MHD run'
282 $ /,2X,' requires that LDIMT be set to',I4,'.')
283 endif
284 call exitt
285 ENDIF
286
287 if (ifmvbd) then
288 if (lx1.ne.lx1m.or.ly1.ne.ly1m.or.lz1.ne.lz1m)
289 $ call exitti('Need lx1m=lx1 etc. in SIZE . $',lx1m)
290 endif
291
292 ifldmhd = npscal + 3
293 if (ifmhd) then
294 cpfld(ifldmhd,1) = param(29) ! magnetic viscosity
295 cpfld(ifldmhd,2) = param( 1) ! magnetic rho same as for fluid
296 endif
297C
298C Set up default time dependent coefficients - NSTEPS,DT.
299C
300 if (.not.iftran) then
301 if (ifflow.and.ifsplit) then
302 iftran=.true.
303 else
304 param(11) = 1.0
305 param(12) = 1.0
306 param(19) = 0.0
307 endif
308 endif
309C
310C Do some checks
311C
312 IF(ldimr.NE.LDIM)THEN
313 IF(NID.EQ.0) THEN
314 WRITE(6,10) LDIM,ldimr
315 10 FORMAT(//,2X,'ERROR: This NEKTON Solver has been compiled'
316 $ /,2X,' for spatial dimension equal to',I2,'.'
317 $ /,2X,' The data file has dimension',I2,'.')
318 ENDIF
319 call exitt
320 ENDIF
321 IF (ldim.EQ.3) IF3D=.TRUE.
322 IF (ldim.NE.3) IF3D=.FALSE.
323
324 if (if3d) then
325 if (ly1.ne.lx1.or.lz1.ne.lx1) then
326 if (nid.eq.0) write(6,13) lx1,ly1,lz1
327 13 format('ERROR: lx1,ly1,lz1:',3i5,' must be equal for 3D')
328 call exitt
329 endif
330 if (ly2.ne.lx2.or.lz2.ne.lx2) then
331 if (nid.eq.0) write(6,14) lx2,ly2,lz2
332 14 format('ERROR: lx2,ly2,lz2:',3i5,' must be equal for 3D')
333 call exitt
334 endif
335 else
336 if (ly1.ne.lx1.or.lz1.ne.1) then
337 if (nid.eq.0) write(6,12) lx1,ly1,lz1
338 12 format('ERROR: ',3i5,' must have lx1=ly1; lz1=1, for 2D')
339 call exitt
340 endif
341 if (ly2.ne.lx2.or.lz2.ne.1) then
342 if (nid.eq.0) write(6,11) lx2,ly2,lz2
343 11 format('ERROR: ',3i5,' must have lx2=ly2; lz2=1, for 2D')
344 call exitt
345 endif
346 endif
347
348 if (lgmres.lt.5 .and. param(42).eq.0) then
349 if(nid.eq.0) write(6,*)
350 $ 'WARNING: lgmres might be too low!'
351 endif
352
353
354 if (ifsplit) then
355 if (lx1.ne.lx2) then
356 if (nid.eq.0) write(6,43) lx1,lx2
357 43 format('ERROR: lx1,lx2:',2i4,' must be equal for IFSPLIT=T')
358 call exitt
359 endif
360 else
361 if (lx2.lt.lx1-2) then
362 if (nid.eq.0) write(6,44) lx1,lx2
363 44 format('ERROR: lx1,lx2:',2i4,' lx2 must be lx-2 for IFSPLIT=F')
364 call exitt
365 endif
366 endif
367
368 if (param(40).eq.3 .and. .not.ifsplit) then
369 call exitti
370 $ ('ERROR: Selected preconditioner requires lx2=lx1$',lx2)
371 endif
372
373 if (ifcvode) then
374 if(nid.eq.0) write(6,*)
375 $ 'ABORT: Using CVODE requires .par file!'
376 call exitt
377 endif
378
379 if (ifsplit .and. ifuservp .and. .not.ifstrs) then
380 if(nid.eq.0) write(6,*)
381 $ 'Enable stress formulation to support PN/PN and IFUSERVP=T'
382 ifstrs = .true.
383 endif
384
385 if (ifcyclic .and. .not.ifstrs) then
386 if(nid.eq.0) write(6,*)
387 $ 'Enable stress formulation to support cyclic BC'
388 ifstrs = .true.
389 endif
390
391 ktest = (lx1-lx1m) + (ly1-ly1m) + (lz1-lz1m)
392 if (ifstrs.and.ktest.ne.0) then
393 if(nid.eq.0) write(6,*)
394 $ 'ABORT: Stress formulation requires lx1m=lx1, etc. in SIZE'
395 call exitt
396 endif
397
398c if (ifsplit .and. ifstrs) then
399c if(nid.eq.0) write(6,*)
400c $ 'ABORT: Stress formulation in Pn-Pn is not supported'
401c call exitt
402c endif
403
404 if (ifsplit .and. ifmhd) then
405 if(nid.eq.0) write(6,*)
406 $ 'ABORT: MHD in Pn-Pn is not supported'
407 call exitt
408 endif
409
410 if (ifneknekc.and.(nelgv.ne.nelgt)) call exitti(
411 $ 'ABORT: nek-nek not supported w/ conj. ht transfer$',1)
412
413 if (ifchar.and.(nelgv.ne.nelgt)) call exitti(
414 $ 'ABORT: IFCHAR curr. not supported w/ conj. ht transfer$',nelgv)
415
416 if (ifmhd .and. lbx1.ne.lx1) then
417 if(nid.eq.0) write(6,*)
418 $ 'ABORT: For MHD, need lbx1=lx1, etc.; Change SIZE '
419 call exitt
420 endif
421
422 if (ifpert .and. lpx1.ne.lx1) then
423 if(nid.eq.0) write(6,*)
424 $ 'ABORT: For Lyapunov, need lpx1=lx1, etc.; Change SIZE '
425 endif
426
427 if (if3d) ifaxis = .false.
428
429 if (iflomach .and. .not.ifsplit) then
430 if(nid.eq.0) write(6,*)
431 $ 'ABORT: For lowMach, need lx2=lx1, etc.; Change SIZE '
432 call exitt
433 endif
434
435 if (iflomach .and. .not.ifheat) then
436 if(nid.eq.0) write(6,*)
437 $ 'ABORT For lowMach, need ifheat=true; Change IFHEAT'
438 call exitt
439 endif
440
441 if (ifmhd) ifchar = .false. ! For now, at least.
442
443c set dealiasing handling
444 if (param(99).lt.0) then
445 param(99) = -1 ! No dealiasing
446 else
447 param(99) = 4 ! default
448 if (ifaxis) param(99) = 3 ! For now, at least.
449 if (ifmvbd) param(99) = 3 ! For now, at least.
450 endif
451
452 if (ifchar .and. param(99).lt.0) then
453 if (nid.eq.0) write(6,*)
454 & 'ABORT: Characteristic scheme needs dealiasing!'
455 call exitt
456 endif
457
458 if (.not.ifsplit .and. ifaxis .and. ifstrs) then
459 if (nid.eq.0) write(6,*)
460 $ 'ABORT: Axisymetric and stress formulation not supported ' //
461 $ 'for PN/PN-2$'
462 call exitt
463 endif
464
465 if (param(99).gt.-1 .and. (lxd.lt.lx1 .or. lyd.lt.ly1 .or.
466 & lzd.lt.lz1)) then
467 if(nid.eq.0) write(6,*)
468 & 'ABORT: Dealiasing space too small; Check lxd,lyd,lzd in SIZE '
469 call exitt
470 endif
471
472c SET PRESSURE SOLVER DEFAULTS, ADJUSTED IN USR FILE ONLY
473 param(41) = 0 ! use additive SEMG
474 ! 1 use hybrid SEMG (not yet working... but coming soon!)
475 param(42) = 0 ! use GMRES for iterative solver w/ nonsymmetric weighting
476 ! 1 use PCG for iterative solver, do not use weighting
477 param(43) = 0 ! use additive multilevel scheme (requires param(42).eq.0)
478 ! 1 use original 2 level scheme
479 param(44) = 0 ! base top-level additive Schwarz on restrictions of E
480 ! 1 base top-level additive Schwarz on restrictions of A
481
482c SET DEFAULT TO 6, ADJUSTED IN USR FILE ONLY
483 param(66) = 6
484 param(67) = 6
485
486 param(59) = 1 ! No fast operator eval, ADJUSTED IN USR FILE ONLY
487 param(33) = 0
488
489 fem_amg_param(1) = 0
490 crs_param(1) = 0
491
492 filterType = 0
493 if (param(103).gt.0) then
494 filterType = 1
495 call ltrue(iffilter,size(iffilter))
496 endif
497
498 return
499
500C
501C Error handling:
502C
503 400 CONTINUE
504 if(nid.eq.0) WRITE(6,401)
505 401 FORMAT(2X,'ERROR READING PARAMETER DATA'
506 $ ,/,2X,'ABORTING IN ROUTINE RDPARAM.')
507 call exitt
508C
509 500 CONTINUE
510 if(nid.eq.0) WRITE(6,501)
511 501 FORMAT(2X,'ERROR READING LOGICAL DATA'
512 $ ,/,2X,'ABORTING IN ROUTINE RDPARAM.')
513 call exitt
514C
515 return
516 END
517c-----------------------------------------------------------------------
518 subroutine rdmesh
519C
520C .Read number of elements
521C
522C .Construct sequential element-processor partition according
523C to number of elements and processors
524C
525C .Selectively read mesh (defined by element vertices, and group numbers)
526C on each processor
527C
528 include 'SIZE'
529 include 'INPUT'
530 include 'PARALLEL'
531 character*1 adum
532 real dum(4)
533
534
535c Read elemental mesh data, formatted
536 iffmtin = .true.
537
538 NSIDES=ldim*2
539 DO 40 IEG=1,NELGT
540 IF (GLLNID(IEG).EQ.NID) THEN
541 IEL=GLLEL(IEG)
542
543 igroup(iel) = 0
544c read(9,30,err=31,end=600) igroup(iel)
545c 30 format(43x,i5)
546 read(9,*,err=31,end=600) adum
547 31 continue
548
549C Read Corner data
550 IF(ldim.EQ.2)THEN
551 READ(9,*,ERR=500,END=600) (XC(IC,IEL),IC=1,4)
552 READ(9,*,ERR=500,END=600) (YC(IC,IEL),IC=1,4)
553 call rzero (zc(1 ,iel) ,4)
554 ELSE IF(ldim.EQ.3)THEN
555 READ(9,*,ERR=500,END=600) (XC(IC,IEL),IC=1,4)
556 READ(9,*,ERR=500,END=600) (YC(IC,IEL),IC=1,4)
557 READ(9,*,ERR=500,END=600) (ZC(IC,IEL),IC=1,4)
558 READ(9,*,ERR=500,END=600) (XC(IC,IEL),IC=5,8)
559 READ(9,*,ERR=500,END=600) (YC(IC,IEL),IC=5,8)
560 READ(9,*,ERR=500,END=600) (ZC(IC,IEL),IC=5,8)
561 ENDIF
562 ELSE
563C Skip over this data for element NOT on this processor
564 READ(9,41,ERR=500,END=600) ADUM
565C Read Corner data
566 IF(ldim.EQ.2)THEN
567 READ(9,41,ERR=500,END=600) ADUM
568 READ(9,41,ERR=500,END=600) ADUM
569 ELSE IF(ldim.EQ.3)THEN
570 READ(9,41,ERR=500,END=600) ADUM
571 READ(9,41,ERR=500,END=600) ADUM
572 READ(9,41,ERR=500,END=600) ADUM
573 READ(9,41,ERR=500,END=600) ADUM
574 READ(9,41,ERR=500,END=600) ADUM
575 READ(9,41,ERR=500,END=600) ADUM
576 ENDIF
577 ENDIF
578 40 CONTINUE
579 41 FORMAT(A1)
580C
581C End of mesh read.
582C
583 return
584C
585C Error handling:
586C
587 400 CONTINUE
588 if(nid.eq.0) WRITE(6,401)
589 401 FORMAT(2X,'ERROR READING SCALE FACTORS, CHECK READ FILE'
590 $ ,/,2X,'ABORTING IN ROUTINE RDMESH.')
591 call exitt
592
593 500 CONTINUE
594 if(nid.eq.0) WRITE(6,501) IEG
595 501 FORMAT(2X,'ERROR READING MESH DATA NEAR ELEMENT',I12
596 $ ,/,2X,'ABORTING IN ROUTINE RDMESH.')
597 call exitt
598
599 600 CONTINUE
600 if(nid.eq.0) WRITE(6,601) IEG
601 601 FORMAT(2X,'ERROR 2 READING MESH DATA NEAR ELEMENT',I12
602 $ ,/,2X,'ABORTING IN ROUTINE RDMESH.')
603 call exitt
604
605 return
606 end
607c-----------------------------------------------------------------------
608 subroutine rdcurve
609C
610C .Read curve side data
611C
612C .Disperse curve side data to all processors according
613C to sequential partition scheme
614C
615C
616 INCLUDE 'SIZE'
617 INCLUDE 'INPUT'
618 INCLUDE 'PARALLEL'
619 CHARACTER*1 ANS
620C
621C
622C
623 IF (IFFMTIN) THEN
624C
625C Read formatted curve side data
626C
627 READ(9,*)
628 READ(9,*)NCURVE
629 CALL RZERO(CURVE ,72*LELT)
630 CALL BLANK(CCURVE,12*LELT)
631 IF (NCURVE.GT.0) THEN
632 DO 50 ICURVE=1,NCURVE
633 IF (NELGT.LT.1000) THEN
634 READ(9,60,ERR=500,END=500) IEDG,IEG,R1,R2,R3,R4,R5,ANS
635 ELSEIF (NELGT.LT.1 000 000) THEN
636 READ(9,61,ERR=500,END=500) IEDG,IEG,R1,R2,R3,R4,R5,ANS
637 ELSE
638 READ(9,62,ERR=500,END=500) IEDG,IEG,R1,R2,R3,R4,R5,ANS
639 ENDIF
640 60 FORMAT(I3,I3 ,5G14.6,1X,A1)
641 61 FORMAT(I2,I6 ,5G14.6,1X,A1)
642 62 FORMAT(I2,I12,5G14.6,1X,A1)
643
644 IF (GLLNID(IEG).EQ.NID) THEN
645 IEL=GLLEL(IEG)
646 CURVE (1,IEDG,IEL)=R1
647 CURVE (2,IEDG,IEL)=R2
648 CURVE (3,IEDG,IEL)=R3
649 CURVE (4,IEDG,IEL)=R4
650 CURVE (5,IEDG,IEL)=R5
651 CCURVE( IEDG,IEL)=ANS
652 ENDIF
653 50 CONTINUE
654 ENDIF
655 return
656C
657C Error handling:
658C
659 500 CONTINUE
660 if(nid.eq.0) WRITE(6,501)
661 501 FORMAT(2X,'ERROR READING CURVE SIDE DATA'
662 $ ,/,2X,'ABORTING IN ROUTINE RDCURVE.')
663 call exitt
664 return
665C
666 ELSE
667C
668C Read unformatted curve side data
669C
670 READ(8) NCURVE
671 CALL RZERO(CURVE ,72*LELT)
672 CALL BLANK(CCURVE,12*LELT)
673 IF (NCURVE.GT.0) THEN
674 DO 1050 ICURVE=1,NCURVE
675 READ(8,ERR=1500,END=1500) IEDG,IEG,R1,R2,R3,R4,R5,ANS
676 IF (GLLNID(IEG).EQ.NID) THEN
677 IEL=GLLEL(IEG)
678 CURVE (1,IEDG,IEL)=R1
679 CURVE (2,IEDG,IEL)=R2
680 CURVE (3,IEDG,IEL)=R3
681 CURVE (4,IEDG,IEL)=R4
682 CURVE (5,IEDG,IEL)=R5
683 CCURVE( IEDG,IEL)=ANS
684 ENDIF
685 1050 CONTINUE
686 ENDIF
687 return
688C
689C Error handling:
690C
691 1500 CONTINUE
692 if(nid.eq.0) WRITE(6,1501)
693 1501 FORMAT(2X,'ERROR READING unformatted CURVE SIDE DATA'
694 $ ,/,2X,'ABORTING IN ROUTINE RDCURVE.')
695 call exitt
696C
697 return
698 ENDIF
699 END
700c-----------------------------------------------------------------------
701 subroutine rdbdry
702C
703C .Read Boundary Conditions (and connectivity data)
704C
705C .Disperse boundary condition data to all processors
706C according to sequential partition scheme
707C
708 INCLUDE 'SIZE'
709 INCLUDE 'INPUT'
710 INCLUDE 'PARALLEL'
711 INCLUDE 'SCRCT'
712 CHARACTER CBC1*1,CBC3*3,CHTEMP*1,CHTMP3*3
713 EQUIVALENCE (CHTEMP,CHTMP3)
714 character*132 string
715C
716C Set up TEMPORARY value for NFIELD - NFLDT
717C
718 NFLDT = 1
719 IF (IFHEAT) NFLDT=2+NPSCAL
720 if (ifmhd ) nfldt=2+npscal+1
721 NBCS = NFLDT
722 IBCS = 2
723 IF (IFFLOW) IBCS = 1
724 NSIDES = 2*ldim
725C
726C Read boundary conditions for all fields
727C
728 LCBC=18*LELT*(LDIMT1 + 1)
729 LRBC=30*LELT*(LDIMT1 + 1)
730 CALL RZERO(BC ,LRBC)
731 CALL BLANK(CBC,LCBC)
732C
733C-----------------------------------------------------------------
734C Formatted Reads
735C-----------------------------------------------------------------
736C
737 IF (IFFMTIN) THEN
738C
739 READ(9,*,ERR=500,END=500) ! ***** BOUNDARY CONDITIONS *****
740 ibcnew = 1
741 DO 100 IFIELD=ibcnew,NBCS ! DO 100 IFIELD=IBCS,NBCS
742 NEL=NELGT
743 if (.not.iftmsh(ifield)) nel = nelgv
744C Fluid and/or thermal
745 read(9,81) string ! ***** FLUID BOUNDARY CONDITIONS *****
746 call capit(string,132)
747
748c write(6,*) 'reading BC:',ifield,ibcs,nbcs
749c write(6,81) string
750c if1 = indx1(string,'NO ',3)
751c write(6,*) if1,' if NO. quit.',ifield,ibcs,nbcs
752c write(6,*) ifield,iftmsh(ifield),nel,' iftmsh'
753c call exitt
754
755
756 if (indx1(string,'NO ',3).eq.0) then ! we have acitve bc info
757C
758 IF(VNEKTON .LE. 2.52) NBCREA = 3
759 IF(VNEKTON .GE. 2.55) NBCREA = 5
760C
761 DO 80 IEG=1,NEL
762 DO 80 ISIDE=1,NSIDES
763 IF (GLLNID(IEG).EQ.NID) THEN
764 IEL=GLLEL(IEG)
765 IF (NELGT.LT.1000) THEN
766 READ(9,50,ERR=500,END=500)
767 $ CHTEMP,
768 $ CBC(ISIDE,IEL,IFIELD),ID1,ID2,
769 $ (BC(II,ISIDE,IEL,IFIELD),II=1,NBCREA)
770c write(6,50)
771c $ CHTEMP,
772c $ CBC(ISIDE,IEL,IFIELD),ID1,ID2,
773c $ (BC(II,ISIDE,IEL,IFIELD),II=1,NBCREA)
774 50 FORMAT(A1,A3,2I3,5G14.6)
775 ELSEIF (NELGT.LT.100 000) THEN
776 READ(9,51,ERR=500,END=500)
777 $ CHTEMP,
778 $ CBC(ISIDE,IEL,IFIELD),ID1,ID2,
779 $ (BC(II,ISIDE,IEL,IFIELD),II=1,NBCREA)
780 51 FORMAT(A1,A3,I5,I1,5G14.6)
781 ELSEIF (NELGT.LT.1 000 000) THEN
782 READ(9,52,ERR=500,END=500)
783 $ CHTEMP,
784 $ CBC(ISIDE,IEL,IFIELD),ID1,
785 $ (BC(II,ISIDE,IEL,IFIELD),II=1,NBCREA)
786 52 FORMAT(A1,A3,I6,5G14.6)
787 ELSE
788 READ(9,53,ERR=500,END=500)
789 $ CHTEMP,
790 $ CBC(ISIDE,IEL,IFIELD),ID1,
791 $ (BC(II,ISIDE,IEL,IFIELD),II=1,NBCREA)
792 53 FORMAT(A1,A3,I12,5G18.11)
793 ENDIF
794C Mesh B.C.'s in 1st column of 1st field
795 IF (CHTEMP.NE.' ') CBC(ISIDE,IEL,0)(1:1)= CHTEMP
796C check for fortran function as denoted by lower case bc's:
797 CBC1=CBC(ISIDE,IEL,IFIELD)
798 CBC3=CBC(ISIDE,IEL,IFIELD)
799 ICBC1=ICHAR(CBC1)
800c IF (ICBC1.GE.97.AND.ICBC1.LE.122) THEN
801c IF(CBC3(3:3).NE.'i')NLINES=BC(1,ISIDE,IEL,IFIELD)
802c IF(CBC3(3:3).EQ.'i')NLINES=BC(4,ISIDE,IEL,IFIELD)
803c DO 60 I=1,NLINES
804c 60 READ(9,*,ERR=500,END=500)
805c ENDIF
806 ELSE
807 READ(9,*,ERR=500,END=500) cbc1 ! dummy read, pff 4/28/05
808 ENDIF
809 80 CONTINUE
810 endif
811 81 format(a132)
812 100 CONTINUE
813C
814C END OF BC READ
815C
816C Check for dummy line: "NO THERMAL B.C.'S"
817 IF (NFLDT.EQ.1) READ(9,*,ERR=500,END=500)
818C
819 return
820C
821C Error handling:
822C
823 500 CONTINUE
824 if(nid.eq.0) WRITE(6,501) IFIELD,IEG
825 501 FORMAT(2X,'ERROR READING BOUNDARY CONDITIONS FOR FIELD',I4,I12
826 $ ,/,2X,'ABORTING IN ROUTINE RDBDRY.')
827 call exitt
828 return
829C
830C
831 ELSE
832C
833C-----------------------------------------------------------------
834C UNformatted Reads
835C-----------------------------------------------------------------
836C
837c READ(8,ERR=500,END=500)
838 DO 1100 IFIELD=IBCS,NBCS
839 NEL=NELGT
840C Fluid and/or thermal
841 NBCREA = 5
842C
843 DO 1080 IEG=1,NEL
844 DO 1080 ISIDE=1,NSIDES
845 IF (GLLNID(IEG).EQ.NID) THEN
846 IEL=GLLEL(IEG)
847 READ(8,ERR=1500,END=1500)
848 $ CHTMP3,
849 $ CBC(ISIDE,IEL,IFIELD),ID1,ID2,
850 $ (BC(II,ISIDE,IEL,IFIELD),II=1,NBCREA)
851C
852C Mesh B.C.'s in 1st column of 1st field
853 IF (CHTEMP.NE.' ') CBC(ISIDE,IEL,0)(1:1)= CHTEMP
854C check for fortran function as denoted by lower case bc's:
855 ELSE
856 IEL=1
857 READ(8,ERR=1500,END=1500) CHTMP3,
858 $ CBCS(ISIDE,IEL),ID1,ID2,(BCS(II,ISIDE,IEL),II=1,NBCREA)
859C check for fortran function as denoted by lower case bcs:
860 ENDIF
861 1080 CONTINUE
862 1100 CONTINUE
863C
864C END OF BC READ
865C
866 return
867C
868C Error handling:
869C
870 1500 CONTINUE
871 if(nid.eq.0) WRITE(6,1501) IFIELD,IEG
872 1501 FORMAT(2X,'ERROR READING BOUNDARY CONDITIONS FOR FIELD',I4,I12
873 $ ,/,2X,'(unformatted) ABORTING IN ROUTINE RDBDRY.')
874 call exitt
875 ENDIF
876C
877 return
878 END
879c-----------------------------------------------------------------------
880 subroutine rdicdf
881C
882C .Read Initial Conditions / Drive Force
883C
884C .Broadcast ICFILE to all processors
885C
886 include 'SIZE'
887 include 'INPUT'
888 include 'PARALLEL'
889
890 character*132 line
891 logical ifgtil
892
893 ierr = 0
894
895 if (nid.eq.0) then ! Read names of restart files
896
897 call blank(initc,15*132)
898 read (9,80,err=200,end=200) line
899 call capit(line,132)
900 if (indx1(line,'RESTART',7).ne.0) then
901 if (.not.ifgtil(nskip,line)) goto 200
902C read(line,*,err=200,end=200) nskip
903 do 50 i=1,nskip
904 read(9,80,err=200,end=200) initc(i)
905 50 continue
906 read(9,80,err=200,end=200) line
907 endif
908 80 format(a132)
909
910 if (.not.ifgtil(nskip,line)) goto 200
911
912C Read initial conditions
913 do 100 i=1,nskip
914 read(9,80,err=200,end=200) line
915 100 continue
916
917C Read drive force data
918 read(9,*,err=200,end=200)
919 read(9,*,err=200,end=200) nskip
920 do 110 i=1,nskip
921 read(9,80,err=200,end=200) line
922 110 continue
923 endif
924
925 ierr = iglmax(ierr,1)
926 if (ierr.eq.0) then
927 call bcast(initc,15*132*csize)
928 return
929 else
930 goto 210
931 endif
932c
933c Error handling:
934c
935 200 ierr = 1
936 ierr = iglmax(ierr,1)
937
938 210 continue
939 if (nid.eq.0) write(6,300)
940 300 format(2x,'Error reading initial condition/drive force data'
941 $ ,/,2x,'aborting in routine rdicdf.')
942 call exitti('rdicdf error$',ierr)
943
944 return
945 end
946c-----------------------------------------------------------------------
947 subroutine rdmatp
948C
949C .Read materials property data
950C
951C .Disperse material properties to all processors according
952C to sequential partition scheme
953C
954 INCLUDE 'SIZE'
955 INCLUDE 'INPUT'
956 INCLUDE 'PARALLEL'
957
958 CHARACTER*132 LINE
959C
960 CALL IZERO(MATYPE,16*LDIMT1)
961 CALL RZERO(CPGRP ,48*LDIMT1)
962C
963C Read material property data
964C
965 IF(NID.EQ.0) THEN
966 READ(9,*,ERR=200,END=200)
967 READ(9,*,ERR=200,END=200) NSKIP
968 READ(9,*,ERR=200,END=200) NPACKS
969 DO 100 IIG=1,NPACKS
970 IFVPS=.TRUE.
971 READ(9,*)IGRP,IFLD,ITYPE
972 MATYPE(IGRP,IFLD)=ITYPE
973 DO 100 IPROP=1,3
974 IF(ITYPE.EQ.1) READ(9,* ) CPGRP(IGRP,IFLD,IPROP)
975 IF(ITYPE.EQ.2) READ(9,80) LINE
976 80 FORMAT(A132)
977 100 CONTINUE
978 ENDIF
979
980 CALL BCAST(MATYPE,16*LDIMT1*ISIZE)
981 CALL BCAST(CPGRP ,48*LDIMT1*WDSIZE)
982
983 return
984C
985C Error handling:
986C
987 200 CONTINUE
988 if(nid.eq.0) WRITE(6,201)
989 201 FORMAT(2X,'ERROR READING MATERIAL PROPERTIES DATA'
990 $ ,/,2X,'ABORTING IN ROUTINE RDMATP.')
991 call exitt
992C
993 return
994 END
995c-----------------------------------------------------------------------
996 subroutine rdhist
997C
998C .Read history data
999C
1000C .Broadcast to all processors
1001C
1002 INCLUDE 'SIZE'
1003 INCLUDE 'INPUT'
1004 INCLUDE 'PARALLEL'
1005C
1006 ierr=0
1007 if(nid.eq.0) then
1008c read history data
1009 read (9,*)
1010 read (9,*,err=200,end=200) nhis
1011 do i = 1,nhis
1012 read (9,*)
1013 enddo
1014 endif
1015
1016 return
1017C
1018C Error handling:
1019C
1020 200 CONTINUE
1021 if(nid.eq.0) WRITE(6,201)
1022 201 FORMAT(2X,'ERROR READING HISTORY DATA'
1023 $ ,/,2X,'ABORTING IN ROUTINE RDHIST.')
1024 call exitt
1025C
1026 return
1027 END
1028c-----------------------------------------------------------------------
1029 subroutine rdout
1030C
1031C .Read output specs
1032C
1033C .Broadcast to all processors
1034C
1035 INCLUDE 'SIZE'
1036 INCLUDE 'INPUT'
1037 INCLUDE 'PARALLEL'
1038
1039 logical lbuf(5+ldimt1)
1040
1041 call lfalse(lbuf,5+ldimt1)
1042 iflag = 0 ! Check for valid ipsco read
1043
1044 IF(NID.EQ.0) THEN ! Read output specs
1045
1046 READ(9,*,ERR=200,END=200)
1047 READ(9,*,ERR=200,END=200) NOUTS
1048 READ(9,*,ERR=200,END=200) IFXYO
1049 READ(9,*,ERR=200,END=200) IFVO
1050 READ(9,*,ERR=200,END=200) IFPO
1051 READ(9,*,ERR=200,END=200) IFTO
1052 READ(9,*,ERR=200,END=200) IFBO ! IFTGO
1053
1054 lbuf(1) = IFXYO
1055 lbuf(2) = IFVO
1056 lbuf(3) = IFPO
1057 lbuf(4) = IFTO
1058 lbuf(5) = IFBO
1059
1060 k = 5
1061
1062 call lfalse(ifpsco,ldimt1)
1063 read(9,*,err=200,end=200) ipsco
1064 if (ipsco.gt.0) then
1065 if (ipsco.gt.ldimt1) then ! Invalid ifpsco read
1066 iflag = 1
1067 else
1068 do i=1,ipsco
1069 read(9,*,err=200,end=200) ifpsco(i)
1070 k = k+1
1071 lbuf(k) = ifpsco(i)
1072 enddo
1073 endif
1074 endif
1075
1076 endif
1077
1078
1079 iflag = iglmax(iflag,1) ! Check for valid ipsco read
1080 if (iflag.gt.0) call exitti ! Invalid ifpsco read
1081 $ ('Error in rdout. Increase ldimt1 in SIZE to$',ipsco)
1082
1083 k = 5+ldimt1
1084 call bcast(lbuf ,LSIZE*k)
1085 call bcast(IPSCO,ISIZE )
1086
1087 ifxyo = lbuf(1)
1088 ifvo = lbuf(2)
1089 ifpo = lbuf(3)
1090 ifto = lbuf(4)
1091 ifbo = lbuf(5)
1092
1093 k = 5
1094 do i=1,ipsco
1095 k = k+1
1096 ifpsco(i) = lbuf(k)
1097 enddo
1098
1099 return
1100
1101C
1102C Error handling:
1103C
1104 200 CONTINUE
1105 WRITE(6,201)
1106 201 FORMAT(2X,'ERROR READING OUTPUT SPECIFICATION DATA'
1107 $ ,/,2X,'ABORTING IN ROUTINE RDOUT.')
1108 call exitt
1109C
1110 return
1111 END
1112c-----------------------------------------------------------------------
1113 subroutine rdobj
1114C
1115C .Read objects
1116C
1117C .Broadcast to all processors
1118C
1119 INCLUDE 'SIZE'
1120 INCLUDE 'INPUT'
1121 INCLUDE 'PARALLEL'
1122C
1123C Default if no data is read No Objects
1124C
1125 ierr=0
1126 IF(NID.EQ.0) THEN
1127 NOBJ=0
1128 READ(9,*,ERR=200,END=200)
1129 READ(9,*,ERR=200,END=200) NOBJ
1130
1131 IF(NOBJ.GT.MAXOBJ) ierr=1
1132
1133 if(ierr.eq.0) then
1134 DO 10 IOBJ = 1,NOBJ
1135 READ(9,*,ERR=200,END=200) NMEMBER(IOBJ)
1136 IF(NMEMBER(IOBJ).GT.MAXMBR)THEN
1137 PRINT*,'ERROR: Too many members in object ',IOBJ
1138 ierr=2
1139 ENDIF
1140 if(ierr.eq.0) then
1141 DO 5 MEMBER=1,NMEMBER(IOBJ)
1142 READ(9,*,ERR=200,END=200) OBJECT(IOBJ,MEMBER,1),
1143 $ OBJECT(IOBJ,MEMBER,2)
1144 5 CONTINUE
1145 endif
1146 10 CONTINUE
1147 write(6,*) nobj,' objects found'
1148 $ ,(nmember(k),k=1,nobj)
1149 endif
1150 endif
1151 call err_chk(ierr,'ERROR, too many objects:$')
1152
1153 call bcast(NOBJ ,ISIZE)
1154 call bcast(NMEMBER,MAXOBJ*ISIZE)
1155 call bcast(OBJECT ,MAXOBJ*MAXMBR*2*ISIZE)
1156
1157
1158 return
1159C
1160C Error handling: For old versions, default to no objects
1161C
1162 200 CONTINUE
1163 NOBJ=0
1164
1165 return
1166 END
1167
Note: See TracBrowser for help on using the repository browser.