Nek5000
SEM for Incompressible NS
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
connect2.F90
Go to the documentation of this file.
1 !-----------------------------------------------------------------------
3 subroutine readat()
4  use kinds, only : dp
5  use size_m, only : nid, lelt, ndim, lx1, lx2, lx3
6  use ctimer, only : dnekclock
7  use input, only : reafle, ifmoab, h5mfle, numflu, numoth, ifheat
8  use input, only : matids, matindx, imatie, ifchar, numsts
9  use input, only : numbcs, ibcsts, bcf, bctyps
10  use parallel, only : nelgv, nelgt, isize
11  use string, only : cscan
12  use zper, only : ifgtp
13  implicit none
14 
15  logical :: ifre2
16  character(132) :: tmp_string
17  real(DP) :: etime_tmp
18  integer :: idum(3*numsts+3)
19 
20  real(DP) :: edif, e1, e2
21  integer :: i, iset, nelgs
22 
23 ! Test timer accuracy
24  edif = 0.0
25  do i = 1,10
26  e1 = dnekclock()
27  e2 = dnekclock()
28  edif = edif + e2-e1
29  enddo
30  edif = edif/10.
31  if(nid == 0) write(6,'(A,1pE15.7,A,/)') &
32  ' timer accuracy: ', edif, ' sec'
33 
34  etime_tmp = dnekclock()
35 
36 ! Open .rea file
37  if(nid == 0) then
38  write(6,*) 'read .rea file'
39  OPEN (unit=9,file=reafle,status='OLD')
40  endif
41 
42 ! Read parameters and logical flags
43  CALL rdparam
44 
45 ! Read Mesh Info
46  if(nid == 0) then
47  read(9,*) ! xfac,yfac,xzero,yzero
48  read(9,*) ! dummy
49  if (ifmoab) then
50  read(9,*) h5mfle
51  ! read fluid/solid material set ids
52  read(9,*) numflu, numoth
53  if (numflu+numoth > numsts) then
54  write(6,'(A)') &
55  'Number of fluid+other material sets too large.'
56  write(6, '(A)') &
57  'Need to increase NUMSTS in file INPUT.'
58  call exitt
59  else if (numoth > 0 .AND. .NOT. ifheat) then
60  call exitt( &
61  'Error: no. of other sets is non-zero but ifheat = false.')
62  endif
63  read(9,*) (matids(i), i = 1, numflu+numoth)
64  do i = numflu+numoth+1, numsts
65  matids(i) = -1
66  enddo
67  read(9,*) (matindx(i), i = 1, numflu+numoth)
68  do i = numflu+numoth+1, numsts
69  matindx(i) = -1
70  enddo
71  do i = 1, lelt
72  imatie(i) = -1
73  enddo
74  read(9,*) numbcs
75  if (numbcs > numsts) then
76  write(6,'(A)') &
77  'Number of BC sets too large.'
78  write(6, '(A)') &
79  'Need to increase NUMSTS in file INPUT.'
80  call exitti
81  endif
82  do iset = 1, numbcs
83  read(9,'(2I5,A3)') ibcsts(iset), bcf(iset), bctyps(iset)
84 
85  enddo
86  nelgs = 0
87  do iset = numbcs+1, numsts
88  bcf(iset) = -1
89  bctyps(iset) = 'E '
90  ibcsts(iset) = -1
91  enddo
92  else
93  read(9,*) nelgs,ndim,nelgv
94  nelgt = abs(nelgs)
95  endif
96  endif
97  call bcast(nelgs,isize)
98  call bcast(ndim ,isize)
99  call bcast(nelgv,isize)
100  call bcast(nelgt,isize)
101  call bcast(h5mfle,132)
102  if (ifmoab) then
103  ! pack into long int array and bcast as that
104  if (nid == 0) then
105  idum(1) = numflu
106  idum(2) = numoth
107  idum(3) = numbcs
108  do iset = 1, numsts
109  idum(3+iset) = matids(iset)
110  enddo
111  do iset = 1, numsts
112  idum(3+numflu+numoth+iset) = ibcsts(iset)
113  enddo
114  do iset = 1, numsts
115  idum(3+numflu+numoth+numbcs+iset) = matindx(iset)
116  enddo
117  endif
118  call bcast(idum, isize*(3+3*numsts))
119  call bcast(bctyps, 3*numsts)
120  call bcast(bcf, isize*numsts)
121 
122  if (nid /= 0) then
123  numflu = idum(1)
124  numoth = idum(2)
125  numbcs = idum(3)
126  do iset = 1, numsts
127  matids(iset) = idum(3+iset)
128  enddo
129  do iset = 1, numsts
130  ibcsts(iset) = idum(3+numflu+numoth+iset)
131  enddo
132  do iset = 1, numsts
133  matindx(iset) = idum(3+numflu+numoth+numbcs+iset)
134  enddo
135  endif
136  endif
137  ifre2 = .false.
138  if(nelgs < 0) ifre2 = .true. ! use new .re2 reader
139 
140  ifgtp = .false.
141  if (ndim < 0) ifgtp = .true. ! domain is a global tensor product
142 
143  if (ifmoab) then
144 #ifdef MOAB
145  call nekmoab_import
146 #endif
147  else
148 !max if (ifre2) call open_bin_file(ifbswap) ! rank0 will open and read
149  if (nid == 0) then
150  write(6,12) 'nelgt/nelgv/lelt:',nelgt,nelgv,lelt
151  write(6,12) 'lx1 /lx2 /lx3 :',lx1,lx2,lx3
152  12 format(1x,a,4i12,/,/)
153  endif
154 
155  call chk_nel ! make certain sufficient array sizes
156 
157  if ( .NOT. ifgtp) call mapelpr ! read .map file, est. gllnid, etc.
158  if (ifre2) then
159  write(*,*) "Oops: ifre2"
160 !max call bin_rd1(ifbswap) ! rank0 will read mesh data + distribute
161  else
162 
163 #if 1
164  ! generate the mesh without reading
165  call nekgsync()
166  call genmesh
167 #else
168  maxrd = 32 ! max # procs to read at once
169  mread = (np-1)/maxrd+1 ! mod param
170  iread = 0 ! mod param
171  x = 0
172  do i=0,np-1,maxrd
173  call nekgsync()
174  if (mod(nid,mread) == iread) then
175  if (nid /= 0) then
176  open(unit=9,file=reafle,status='OLD')
177  call cscan(tmp_string,'MESH DATA',9)
178  read(9,*) tmp_string
179  endif
180  if (ifgtp) then
181 !max call genbox
182  else
183  call rdmesh
184  call rdcurve ! Curved side data
185  call rdbdry ! Boundary Conditions
186  endif
187  if (nid /= 0) close(unit=9)
188  endif
189  iread = iread + 1
190  enddo
191 #endif
192  endif
193  endif
194 
195  if (nid == 0) then
196  call cscan(tmp_string,'TAIL OPTS',9)
197  endif
198 
199 ! Read Restart options / Initial Conditions / Drive Force
200  CALL rdicdf
201 ! Read materials property data
202  CALL rdmatp
203 ! Read history data
204  CALL rdhist
205 ! Read output specs
206  CALL rdout
207 ! Read objects
208  CALL rdobj
209 
210  call nekgsync()
211 
212 ! End of input data, close read file.
213  IF(nid == 0) THEN
214  CLOSE(unit=9)
215  write(6,'(A,g13.5,A,/)') ' done :: read .rea file ', &
216  dnekclock()-etime_tmp,' sec'
217  ENDIF
218 
219 ! This is not an excellent place for this check, but will
220 ! suffice for now. 5/6/10
221  if (ifchar .AND. (nelgv /= nelgt)) call exitti( &
222  'ABORT: IFCHAR curr. not supported w/ conj. ht transfer$',nelgv)
223 
224 
225  return
226 end subroutine readat
227 
228 !-----------------------------------------------------------------------
232 subroutine rdparam
233  use size_m, only : nid, ndim, ldimt, ldimt1, npert
234  use size_m, only : ldim, ly2, lx2, lz2, lgmres, lfdm, lbx1, lpx1
235  use size_m, only : lxd, lyd, lzd
236  use size_m, only : lx1, lx1m, ly1, ly1m, lz1, lz1m
237  use ctimer, only : ifsync
238  use input, only : vnekton, param, npscal, cpfld
239  use input, only : iftmsh, ifadvc, ifflow, ifheat, iftran, ifaxis, iflomach
240  use input, only : ifusermv, ifcons, ifuservp, ifessr, ifmhd, ifvcoup
241  use input, only : ifmgrid, ifpert, ifbase, ifschclob, ifexplvis, ifcyclic
242  use input, only : ifmvbd, ifchar, if3d, ifsplit, ifldmhd
243  use input, only : ifmoab, ifcoup, ifkeps, ifanls, ifmodel, ifstrs, ifaziv
244  use parallel, only : isize, wdsize, csize
245  use string, only : indx1, capit
246  use zper, only : nelx, nely, nelz, ifzper, ifgfdm
247  implicit none
248 
249  character(132) :: tmp_string(100)
250  integer :: nparam, i, npscl1, npscl2, nskip, nlogic, ii, n_o, ktest
251 
252  vnekton = 3 ! dummy not really used anymore
253 
254  IF(nid == 0) THEN
255  READ(9,*,err=400)
256  READ(9,*,err=400)
257  READ(9,*,err=400) ndim
258  READ(9,*,err=400) nparam
259  DO 20 i=1,nparam
260  READ(9,*,err=400) param(i)
261  20 END DO
262  ENDIF
263  call bcast(ndim ,isize)
264  call bcast(nparam,isize)
265  call bcast(param ,200*wdsize)
266 
267  npscal=int(param(23))
268  npscl1=npscal+1
269  npscl2=npscal+2
270 
271  IF (npscl1 > ldimt) THEN
272  if(nid == 0) then
273  WRITE(6,21) ldimt,npscl1
274  21 FORMAT(//,2x,'Error: This NEKTON Solver has been compiled' &
275  /,2x,' for',i4,' passive scalars. This run' &
276  /,2x,' requires that LDIMT be set to',i4,'.')
277  endif
278  call exitt
279  ENDIF
280 
281 
282 ! Read in the passive scalar conduct and rhocp's:
283 
284 ! fluid
285 ! .viscosity is PARAM(2)
286 ! .if it is negative, it indicates that Re has been input
287 ! .therefore, redefine PARAM(2) = -1.0/PARAM(2)
288 
289  if(param(2) < 0.0) param(2) = -1.0/param(2)
290  if(param(8) < 0.0) param(8) = -1.0/param(8)
291  if(param(29) < 0.0) param(29) = -1.0/param(29)
292 
293  cpfld(1,1)=param(2)
294  cpfld(1,2)=param(1)
295 ! temperature
296  cpfld(2,1)=param(8)
297  cpfld(2,2)=param(7)
298  cpfld(2,3)=param(9)
299 
300 ! passive scalars
301 
302  IF(nid == 0) THEN
303  READ(9,*,err=400) nskip
304  IF (nskip > 0 .AND. npscal > 0) THEN
305  READ(9,*,err=400)(cpfld(i,1),i=3,npscl2)
306  IF(npscl2 < 9)READ(9,*)
307  READ(9,*,err=400)(cpfld(i,2),i=3,npscl2)
308  IF(npscl2 < 9)READ(9,*)
309  do i=3,npscl2
310  if (cpfld(i,1) < 0) cpfld(i,1) = -1./cpfld(i,1)
311  if (cpfld(i,2) < 0) cpfld(i,2) = -1./cpfld(i,2)
312  enddo
313  ELSE
314  DO 25 i=1,nskip
315  READ(9,*,err=500)
316  25 END DO
317  ENDIF
318  ENDIF
319  call bcast(cpfld,wdsize*ldimt1*3)
320 
321 
322 ! Read logical equation type descriptors....
323 
324  iftmsh(0) = .false.
325  do i=1,npscl2
326  iftmsh(i) = .false.
327  ifadvc(i) = .false.
328  enddo
329  ifflow = .false.
330  ifheat = .false.
331  iftran = .false.
332  ifaxis = .false.
333  ifaziv = .false.
334  ifstrs = .false.
335  iflomach = .false.
336  ifmodel = .false.
337  ifkeps = .false.
338  ifmvbd = .false.
339  ifchar = .false.
340  ifanls = .false.
341  ifmoab = .false.
342  ifcoup = .false.
343  ifvcoup = .false.
344  ifmhd = .false.
345  ifessr = .false.
346  iftmsh(0) = .false.
347  ifuservp = .false.
348  ifcons = .false. ! Use conservation form?
349  ifusermv = .false.
350  ifcyclic = .false.
351  ifsync = .false.
352  ifexplvis = .false.
353  ifschclob = .false.
354 ! IFSPLIT = .false.
355 
356  ifbase = .true.
357  ifpert = .false.
358 
359 
360  IF(nid == 0) READ(9,*,err=500) nlogic
361  call bcast(nlogic,isize)
362  IF(nlogic > 100) THEN
363  if(nid == 0) &
364  write(6,*) 'ABORT: Too many logical switches', nlogic
365  call exitt
366  ENDIF
367 
368  if(nid == 0) READ(9,'(A132)',err=500) (tmp_string(i),i=1,nlogic)
369  call bcast(tmp_string,100*132*csize)
370 
371  do i = 1,nlogic
372  call capit(tmp_string(i),132)
373  if (indx1(tmp_string(i),'IFTMSH' ,6) > 0) then
374  read(tmp_string(i),*,err=490) (iftmsh(ii),ii=0,npscl2)
375  elseif (indx1(tmp_string(i),'IFNAV' ,5) > 0 .AND. &
376  indx1(tmp_string(i),'IFADVC' ,6) > 0) then
377  read(tmp_string(i),*,err=490) (ifadvc(ii),ii=1,npscl2)
378  elseif (indx1(tmp_string(i),'IFADVC' ,6) > 0) then
379  read(tmp_string(i),*,err=490) (ifadvc(ii),ii=1,npscl2)
380  elseif (indx1(tmp_string(i),'IFFLOW' ,6) > 0) then
381  read(tmp_string(i),*) ifflow
382  elseif (indx1(tmp_string(i),'IFHEAT' ,6) > 0) then
383  read(tmp_string(i),*) ifheat
384  elseif (indx1(tmp_string(i),'IFTRAN' ,6) > 0) then
385  read(tmp_string(i),*) iftran
386  elseif (indx1(tmp_string(i),'IFAXIS' ,6) > 0) then
387  read(tmp_string(i),*) ifaxis
388  elseif (indx1(tmp_string(i),'IFAZIV' ,6) > 0) then
389  read(tmp_string(i),*) ifaziv
390  elseif (indx1(tmp_string(i),'IFSTRS' ,6) > 0) then
391  read(tmp_string(i),*) ifstrs
392  elseif (indx1(tmp_string(i),'IFLO' ,4) > 0) then
393  read(tmp_string(i),*) iflomach
394  elseif (indx1(tmp_string(i),'IFMGRID',7) > 0) then
395  ! read(tmp_string(i),*) IFMGRID
396  elseif (indx1(tmp_string(i),'IFKEPS' ,6) > 0) then
397  read(tmp_string(i),*) ifkeps
398  elseif (indx1(tmp_string(i),'IFMODEL',7) > 0) then
399  read(tmp_string(i),*) ifmodel
400  elseif (indx1(tmp_string(i),'IFMVBD' ,6) > 0) then
401  read(tmp_string(i),*) ifmvbd
402  elseif (indx1(tmp_string(i),'IFCHAR' ,6) > 0) then
403  read(tmp_string(i),*) ifchar
404  elseif (indx1(tmp_string(i),'IFANLS' ,6) > 0) then
405  read(tmp_string(i),*) ifanls
406  elseif (indx1(tmp_string(i),'IFMOAB' ,6) > 0) then
407  read(tmp_string(i),*) ifmoab
408  elseif (indx1(tmp_string(i),'IFCOUP' ,6) > 0) then
409  read(tmp_string(i),*) ifcoup
410  elseif (indx1(tmp_string(i),'IFVCOUP' ,7) > 0) then
411  read(tmp_string(i),*) ifvcoup
412  elseif (indx1(tmp_string(i),'IFMHD' ,5) > 0) then
413  read(tmp_string(i),*) ifmhd
414  elseif (indx1(tmp_string(i),'IFCONS' ,6) > 0) then
415  read(tmp_string(i),*) ifcons
416  elseif (indx1(tmp_string(i),'IFUSERVP',8) > 0) then
417  read(tmp_string(i),*) ifuservp
418  elseif (indx1(tmp_string(i),'IFUSERMV',8) > 0) then
419  read(tmp_string(i),*) ifusermv
420  elseif (indx1(tmp_string(i),'IFCYCLIC',8) > 0) then
421  read(tmp_string(i),*) ifcyclic
422  elseif (indx1(tmp_string(i),'IFPERT' ,6) > 0) then
423  read(tmp_string(i),*) ifpert
424  elseif (indx1(tmp_string(i),'IFBASE' ,6) > 0) then
425  read(tmp_string(i),*) ifbase
426  elseif (indx1(tmp_string(i),'IFSYNC' ,6) > 0) then
427  read(tmp_string(i),*) ifsync
428  elseif (indx1(tmp_string(i),'IFEXPLVIS',9) > 0) then
429  read(tmp_string(i),*) ifexplvis
430  elseif (indx1(tmp_string(i),'IFSCHCLOB',9) > 0) then
431  read(tmp_string(i),*) ifschclob
432  elseif (indx1(tmp_string(i),'IFSPLIT' ,7) > 0) then
433  ! read(string,*) IFSPLIT
434  else
435  if(nid == 0) then
436  write(6,'(1X,2A)') 'ABORT: Unknown logical flag', tmp_string
437  write(6,'(30(A,/))') &
438  ' Available logical flags:', &
439  ' IFTMSH' , &
440  ' IFADVC' , &
441  ' IFFLOW' , &
442  ' IFHEAT' , &
443  ' IFTRAN' , &
444  ' IFAXIS' , &
445  ' IFCYCLIC' , &
446  ' IFSTRS' , &
447  ' IFLOMACH' , &
448  ' IFMGRID' , &
449  ' IFKEPS' , &
450  ' IFMVBD' , &
451  ' IFCHAR' , &
452  ' IFANLS' , &
453  ' IFUSERVP' , &
454  ' IFUSERMV' , &
455  ' IFSYNC' , &
456  ' IFCYCLIC' , &
457  ' IFSPLIT' , &
458  ' IFEXPLVIS', &
459  ' IFCONS' , &
460  ' IFMOAB' , &
461  ' IFCOUP' , &
462  ' IFVCOUP'
463  endif
464  call exitt
465  endif
466  490 continue
467  enddo
468 
469  ifmgrid = .false.
470  if (ifsplit) ifmgrid = .true.
471  if (ifaxis ) ifmgrid = .false.
472 
473  if (param(29) /= 0.) ifmhd = .true.
474  if (ifmhd) ifessr = .true.
475  if (ifmhd) npscl1 = npscl1 + 1
476  if (param(30) > 0) ifuservp = .true.
477  if (param(31) /= 0.) ifpert = .true.
478  if (param(31) < 0.) ifbase = .false. ! don't time adv base flow
479  npert = int(abs(param(31)))
480 
481  IF (npscl1 > ldimt .AND. ifmhd) THEN
482  if(nid == 0) then
483  WRITE(6,22) ldimt,npscl1
484  22 FORMAT(/s,2x,'Error: This NEKTON Solver has been compiled' &
485  /,2x,' for',i4,' passive scalars. A MHD run' &
486  /,2x,' requires that LDIMT be set to',i4,'.')
487  endif
488  call exitt
489  ENDIF
490 
491  if (ifmvbd) then
492  if (lx1 /= lx1m .OR. ly1 /= ly1m .OR. lz1 /= lz1m) &
493  call exitti('Need lx1m=lx1 etc. in SIZE . $',lx1m)
494  endif
495 
496  ifldmhd = npscal + 3
497  if (ifmhd) then
498  cpfld(ifldmhd,1) = param(29) ! magnetic viscosity
499  cpfld(ifldmhd,2) = param( 1) ! magnetic rho same as for fluid
500  endif
501 
502 ! Set up default time dependent coefficients - NSTEPS,DT.
503 
504  if ( .NOT. iftran) then
505  if (ifflow .AND. ifsplit) then
506  iftran= .true.
507  else
508  param(11) = 1.0
509  param(12) = 1.0
510  param(19) = 0.0
511  endif
512  endif
513 
514 ! Check here for global fast diagonalization method or z-homogeneity.
515 ! This is here because it influence the mesh read, which follows.
516  nelx = int(abs(param(116))) ! check for global tensor-product structure
517  nely = int(abs(param(117)))
518  nelz = int(abs(param(118)))
519  n_o = 0
520 
521  if (n_o == 0) then
522  ifzper= .false.
523  ifgfdm= .false.
524  if (nelz > 0) ifzper= .true.
525  if (nelx > 0) ifgfdm= .true.
526  if (nelx > 0) ifzper= .false.
527  endif
528 
529 
530 
531 ! Do some checks
532 
533  IF(ndim /= ldim)THEN
534  IF(nid == 0) THEN
535  WRITE(6,10) ldim,ndim
536  10 FORMAT(//,2x,'ERROR: This NEKTON Solver has been compiled' &
537  /,2x,' for spatial dimension equal to',i2,'.' &
538  /,2x,' The data file has dimension',i2,'.')
539  ENDIF
540  call exitt
541  ENDIF
542  IF (ndim == 3) if3d= .true.
543  IF (ndim /= 3) if3d= .false.
544 
545  if (if3d) then
546  if (ly1 /= lx1 .OR. lz1 /= lx1) then
547  if (nid == 0) write(6,13) lx1,ly1,lz1
548  13 format('ERROR: lx1,ly1,lz1:',3i5,' must be equal for 3D')
549  call exitt
550  endif
551  if (ly2 /= lx2 .OR. lz2 /= lx2) then
552  if (nid == 0) write(6,14) lx2,ly2,lz2
553  14 format('ERROR: lx2,ly2,lz2:',3i5,' must be equal for 3D')
554  call exitt
555  endif
556  else
557  if (ly1 /= lx1 .OR. lz1 /= 1) then
558  if (nid == 0) write(6,12) lx1,ly1,lz1
559  12 format('ERROR: ',3i5,' must have lx1=ly1; lz1=1, for 2D')
560  call exitt
561  endif
562  if (ly2 /= lx2 .OR. lz2 /= 1) then
563  if (nid == 0) write(6,11) lx2,ly2,lz2
564  11 format('ERROR: ',3i5,' must have lx2=ly2; lz2=1, for 2D')
565  call exitt
566  endif
567  endif
568 
569  if (lgmres < 5 .AND. param(42) == 0) then
570  if(nid == 0) write(6,*) &
571  'WARNING: lgmres might be too low!'
572  endif
573 
574  if (ifsplit) then
575  if (lx1 /= lx2) then
576  if (nid == 0) write(6,43) lx1,lx2
577  43 format('ERROR: lx1,lx2:',2i4,' must be equal for IFSPLIT=T')
578  call exitt
579  endif
580  else
581  if (lx2 < lx1-2) then
582  if (nid == 0) write(6,44) lx1,lx2
583  44 format('ERROR: lx1,lx2:',2i4,' lx2 must be lx-2 for IFSPLIT=F')
584  call exitt
585  endif
586  endif
587 
588  if (ifmvbd .AND. ifsplit) then
589  if(nid == 0) write(6,*) &
590  'ABORT: Moving boundary in Pn-Pn is not supported'
591  call exitt
592  endif
593  if (ifmoab .AND. .NOT. ifsplit) then
594  if(nid == 0) write(6,*) &
595  'ABORT: MOAB in Pn-Pn-2 is not supported'
596  call exitt
597  endif
598 
599  ktest = (lx1-lx1m) + (ly1-ly1m) + (lz1-lz1m)
600  if (ifstrs .AND. ktest /= 0) then
601  if(nid == 0) write(6,*) &
602  'ABORT: Stress formulation requires lx1m=lx1, etc. in SIZE'
603  call exitt
604  endif
605 
606  if (ifgfdm .AND. ifsplit) call exitti &
607  ('ERROR: FDM (p116>0) requires lx2=lx1-2 in SIZE$',lx2)
608 
609  if (ifgfdm .AND. lfdm == 0) call exitti &
610  ('ERROR: FDM requires lfdm=1 in SIZE$',lfdm)
611 
612  if (ifsplit .AND. ifstrs) then
613  if(nid == 0) write(6,*) &
614  'ABORT: Stress formulation in Pn-Pn is not supported'
615  call exitt
616  endif
617 
618  if (ifsplit .AND. ifmhd) then
619  if(nid == 0) write(6,*) &
620  'ABORT: MHD in Pn-Pn is not supported'
621  call exitt
622  endif
623 
624  if (ifmhd .AND. lbx1 /= lx1) then
625  if(nid == 0) write(6,*) &
626  'ABORT: For MHD, need lbx1=lx1, etc.; Change SIZE '
627  call exitt
628  endif
629 
630  if (ifpert .AND. lpx1 /= lx1) then
631  if(nid == 0) write(6,*) &
632  'ABORT: For Lyapunov, need lpx1=lx1, etc.; Change SIZE '
633  endif
634 
635  if (if3d) ifaxis = .false.
636 
637  if (iflomach .AND. .NOT. ifsplit) then
638  if(nid == 0) write(6,*) &
639  'ABORT: For lowMach, need lx2=lx1, etc.; Change SIZE '
640  call exitt
641  endif
642 
643  if (iflomach .AND. .NOT. ifheat) then
644  if(nid == 0) write(6,*) &
645  'ABORT For lowMach, need ifheat=true; Change IFHEAT'
646  call exitt
647  endif
648 
649 ! if (ifsplit .and. param(55).ne.0) then
650 ! if(nid.eq.0) write(6,*)
651 ! $ 'ABORT: Fixed mass flux not supported for Pn-Pn'
652 ! call exitt
653 ! endif
654 
655 
656  if (ifmhd) ifchar = .false. ! For now, at least.
657 
658 ! set dealiasing handling
659  if (param(99) < 0) then
660  param(99) = -1 ! No dealiasing
661  else
662  param(99) = 4 ! default
663  if (ifaxis) param(99) = 3 ! For now, at least.
664  if (ifmvbd) param(99) = 3 ! For now, at least.
665  endif
666 
667  if (ifchar .AND. param(99) < 0) then
668  if (nid == 0) write(6,*) &
669  'ABORT: Characteristic scheme needs dealiasing!'
670  call exitt
671  endif
672 
673  if (param(99) > -1 .AND. (lxd < lx1 .OR. lyd < ly1 .OR. &
674  lzd < lz1)) then
675  if(nid == 0) write(6,*) &
676  'ABORT: Dealiasing space too small; Check lxd,lyd,lzd in SIZE '
677  call exitt
678  endif
679 
680 ! set I/O format handling
681 ! if (param(67).lt.0) then
682 ! param(67) = 0 ! ASCII
683 ! else ! elseif (param(67).ne.4) then
684 ! param(67) = 6 ! binary is default
685 ! endif
686 
687 ! if (param(66).lt.0) then
688 ! param(66) = 0 ! ASCII
689 ! else ! elseif (param(66).ne.4) then
690 ! param(66) = 6 ! binary is default
691 ! endif
692 
693 ! SET DEFAULT TO 6, ADJUSTED IN USR FILE ONLY
694  param(66) = 6
695  param(67) = 6
696 
697 #ifndef MOAB
698  if (ifmoab) then
699  print *,"ABORT: ifmoab = .TRUE. in input but this ", &
700  "version of nek not compiled with MOAB."
701  call exitti
702  endif
703 #endif
704 
705  return
706 
707 
708 ! Error handling:
709 
710  400 CONTINUE
711  if(nid == 0) WRITE(6,401)
712  401 FORMAT(2x,'ERROR READING PARAMETER DATA' &
713  ,/,2x,'ABORTING IN ROUTINE RDPARAM.')
714  call exitt
715 
716  500 CONTINUE
717  if(nid == 0) WRITE(6,501)
718  501 FORMAT(2x,'ERROR READING LOGICAL DATA' &
719  ,/,2x,'ABORTING IN ROUTINE RDPARAM.')
720  call exitt
721 
722  return
723 end subroutine rdparam
724 
725 !-----------------------------------------------------------------------
731 subroutine genmesh
732  use kinds, only : dp
733  use size_m, only : ndim, nid, lelt, nelt
734  use input, only : iffmtin, igroup, xc, yc, zc
735  use input, only : curve, ccurve
736  use input, only : bc, cbc
737  use mesh, only : shape_x, start_x, end_x
738  use mesh, only : boundaries, tboundaries
739  use parallel, only : gllnid, gllel, wdsize
740  use parallel, only : lglel
741  implicit none
742 
743  integer :: nsides, ieg, iel, lcbc, ldimt1
744  integer :: ix(3)
745  real(DP) :: dx(3)
746  real(DP) :: root(3)
747 
748 ! Read elemental mesh data, formatted
749  iffmtin = .true.
750 
751  if (nid == 0) then
752  read(9,*) start_x(1), end_x(1), shape_x(1)
753  read(9,*) start_x(2), end_x(2), shape_x(2)
754  read(9,*) start_x(3), end_x(3), shape_x(3)
755  read(9,*) boundaries(1:6)
756  read(9,*) tboundaries(1:6)
757  endif
758 
759  call bcast(start_x,3*wdsize)
760  call bcast(end_x, 3*wdsize)
761  call bcast(shape_x,3*wdsize)
762  call bcast(boundaries,3*6)
763  call bcast(tboundaries,3*6)
764 
765  dx = (end_x - start_x) / shape_x
766 
767  ldimt1 = 2
768  curve = 0._dp
769  CALL blank(ccurve,12*lelt)
770  lcbc=18*lelt*(ldimt1 + 1)
771  bc = 0._dp
772  CALL blank(cbc,lcbc)
773 
774  nsides=ndim*2
775  do iel = 1, nelt
776  ieg = lglel(iel)
777 
778  ix(1) = mod(ieg - 1, shape_x(1))
779  ix(2) = mod((ieg-1)/shape_x(1), shape_x(2))
780  ix(3) = mod((ieg-1)/(shape_x(1)*shape_x(2)), shape_x(3))
781 
782  root = start_x + ix * dx
783 
784  igroup(iel) = 0
785  xc(1,iel) = root(1)
786  xc(2,iel) = root(1) + dx(1)
787  xc(3,iel) = root(1) + dx(1)
788  xc(4,iel) = root(1)
789  xc(5,iel) = root(1)
790  xc(6,iel) = root(1) + dx(1)
791  xc(7,iel) = root(1) + dx(1)
792  xc(8,iel) = root(1)
793 
794  yc(1,iel) = root(2)
795  yc(2,iel) = root(2)
796  yc(3,iel) = root(2) + dx(2)
797  yc(4,iel) = root(2) + dx(2)
798  yc(5,iel) = root(2)
799  yc(6,iel) = root(2)
800  yc(7,iel) = root(2) + dx(2)
801  yc(8,iel) = root(2) + dx(2)
802 
803  zc(1,iel) = root(3)
804  zc(2,iel) = root(3)
805  zc(3,iel) = root(3)
806  zc(4,iel) = root(3)
807  zc(5,iel) = root(3) + dx(3)
808  zc(6,iel) = root(3) + dx(3)
809  zc(7,iel) = root(3) + dx(3)
810  zc(8,iel) = root(3) + dx(3)
811 
812  cbc(:,iel,:) = 'E'
813  if (ix(2) == 0) then
814  cbc(1,iel,:) = boundaries(1)
815  cbc(1,iel,2) = tboundaries(1)
816  bc(1,1,iel,:) = ieg + (shape_x(2)-1)*shape_x(1)
817  else
818  bc(1,1,iel,:) = ieg - shape_x(1)
819  endif
820 
821  if (ix(2) == shape_x(2) - 1) then
822  cbc(3,iel,:) = boundaries(3)
823  cbc(3,iel,2) = tboundaries(3)
824  bc(1,3,iel,:) = ieg - ix(2)*shape_x(1)
825  else
826  bc(1,3,iel,:) = ieg + shape_x(1)
827  endif
828 
829  if (ix(1) == 0) then
830  cbc(4,iel,:) = boundaries(4)
831  cbc(4,iel,2) = tboundaries(4)
832  bc(1,4,iel,:) = ieg + (shape_x(1) - 1)
833  else
834  bc(1,4,iel,:) = ieg - 1
835  endif
836 
837  if (ix(1) == shape_x(1) - 1) then
838  cbc(2,iel,:) = boundaries(2)
839  cbc(2,iel,2) = tboundaries(2)
840  bc(1,2,iel,:) = ieg - ix(1)
841  else
842  bc(1,2,iel,:) = ieg +1
843  endif
844 
845  if (ix(3) == 0) then
846  cbc(5,iel,1) = boundaries(5)
847  cbc(5,iel,2) = tboundaries(5)
848  bc(1,5,iel,:) = ieg + (shape_x(3) - 1)*shape_x(2)*shape_x(1)
849  else
850  bc(1,5,iel,:) = ieg - shape_x(2)*shape_x(1)
851  endif
852  if (ix(3) == shape_x(3) - 1) then
853  cbc(6,iel,1) = boundaries(6)
854  cbc(6,iel,2) = tboundaries(6)
855  bc(1,6,iel,:) = ieg - ix(3) * shape_x(2)*shape_x(1)
856  else
857  bc(1,6,iel,:) = ieg + shape_x(2)*shape_x(1)
858  endif
859 
860  bc(2, 1, iel, :) = 3
861  bc(2, 2, iel, :) = 4
862  bc(2, 3, iel, :) = 1
863  bc(2, 4, iel, :) = 2
864  bc(2, 5, iel, :) = 6
865  bc(2, 6, iel, :) = 5
866 
867  END DO
868 
869  return
870 end subroutine genmesh
871 
872 !-----------------------------------------------------------------------
878 subroutine rdmesh
879  use kinds, only : dp
880  use size_m, only : ndim, nid
881  use input, only : iffmtin, igroup, xc, yc, zc
882  use parallel, only : nelgt, gllnid, gllel
883  implicit none
884 
885  character(1) :: adum
886  integer :: nsides, ieg, iel, ic
887 
888 ! Read elemental mesh data, formatted
889  iffmtin = .true.
890 
891  nsides=ndim*2
892  DO 40 ieg=1,nelgt
893  IF (gllnid(ieg) == nid) THEN
894  iel=gllel(ieg)
895 
896  igroup(iel) = 0
897  read(9,30,err=31,end=600) igroup(iel)
898  30 format(43x,i5)
899  ! read(9,*,err=31,end=600) adum
900  31 continue
901 
902  ! Read Corner data
903  IF(ndim == 2)THEN
904  READ(9,*,err=500,end=600) (xc(ic,iel),ic=1,4)
905  READ(9,*,err=500,end=600) (yc(ic,iel),ic=1,4)
906  zc(:,iel) = 0._dp
907  ELSE IF(ndim == 3)THEN
908  READ(9,*,err=500,end=600) (xc(ic,iel),ic=1,4)
909  READ(9,*,err=500,end=600) (yc(ic,iel),ic=1,4)
910  READ(9,*,err=500,end=600) (zc(ic,iel),ic=1,4)
911  READ(9,*,err=500,end=600) (xc(ic,iel),ic=5,8)
912  READ(9,*,err=500,end=600) (yc(ic,iel),ic=5,8)
913  READ(9,*,err=500,end=600) (zc(ic,iel),ic=5,8)
914  ENDIF
915  ELSE
916  ! Skip over this data for element NOT on this processor
917  READ(9,41,err=500,end=600) adum
918  ! Read Corner data
919  IF(ndim == 2)THEN
920  READ(9,41,err=500,end=600) adum
921  READ(9,41,err=500,end=600) adum
922  ELSE IF(ndim == 3)THEN
923  READ(9,41,err=500,end=600) adum
924  READ(9,41,err=500,end=600) adum
925  READ(9,41,err=500,end=600) adum
926  READ(9,41,err=500,end=600) adum
927  READ(9,41,err=500,end=600) adum
928  READ(9,41,err=500,end=600) adum
929  ENDIF
930  ENDIF
931  40 END DO
932  41 FORMAT(a1)
933 
934 ! End of mesh read.
935 
936  return
937 
938 ! Error handling:
939 
940  if(nid == 0) WRITE(6,401)
941  401 FORMAT(2x,'ERROR READING SCALE FACTORS, CHECK READ FILE' &
942  ,/,2x,'ABORTING IN ROUTINE RDMESH.')
943  call exitt
944 
945  500 CONTINUE
946  if(nid == 0) WRITE(6,501) ieg
947  501 FORMAT(2x,'ERROR READING MESH DATA NEAR ELEMENT',i12 &
948  ,/,2x,'ABORTING IN ROUTINE RDMESH.')
949  call exitt
950 
951  600 CONTINUE
952  if(nid == 0) WRITE(6,601) ieg
953  601 FORMAT(2x,'ERROR 2 READING MESH DATA NEAR ELEMENT',i12 &
954  ,/,2x,'ABORTING IN ROUTINE RDMESH.')
955  call exitt
956 
957  return
958 end subroutine rdmesh
959 
960 !-----------------------------------------------------------------------
964 subroutine rdcurve
965  use kinds, only : dp
966  use size_m, only : lelt, nid
967  use input, only : iffmtin, curve, ccurve
968  use parallel, only : nelgt, gllnid, gllel
969  implicit none
970 
971  CHARACTER(1) :: ANS
972  integer :: ncurve, icurve, iedg, ieg, iel
973  real(DP) :: r1, r2, r3, r4, r5
974 
975  IF (iffmtin) THEN
976 
977  ! Read formatted curve side data
978 
979  READ(9,*)
980  READ(9,*)ncurve
981  curve = 0._dp
982  CALL blank(ccurve,12*lelt)
983  IF (ncurve > 0) THEN
984  DO 50 icurve=1,ncurve
985  IF (nelgt < 1000) THEN
986  READ(9,60,err=500,end=500) iedg,ieg,r1,r2,r3,r4,r5,ans
987  ELSEIF (nelgt < 1000000) THEN
988  READ(9,61,err=500,end=500) iedg,ieg,r1,r2,r3,r4,r5,ans
989  ELSE
990  READ(9,62,err=500,end=500) iedg,ieg,r1,r2,r3,r4,r5,ans
991  ENDIF
992  60 FORMAT(i3,i3 ,5g14.6,1x,a1)
993  61 FORMAT(i2,i6 ,5g14.6,1x,a1)
994  62 FORMAT(i2,i12,5g14.6,1x,a1)
995 
996  IF (gllnid(ieg) == nid) THEN
997  iel=gllel(ieg)
998  curve(1,iedg,iel)=r1
999  curve(2,iedg,iel)=r2
1000  curve(3,iedg,iel)=r3
1001  curve(4,iedg,iel)=r4
1002  curve(5,iedg,iel)=r5
1003  ccurve( iedg,iel)=ans
1004  ENDIF
1005  50 END DO
1006  ENDIF
1007  return
1008 
1009  ! Error handling:
1010 
1011  500 CONTINUE
1012  if(nid == 0) WRITE(6,501)
1013  501 FORMAT(2x,'ERROR READING CURVE SIDE DATA' &
1014  ,/,2x,'ABORTING IN ROUTINE RDCURVE.')
1015  call exitt
1016  return
1017 
1018  ELSE
1019 
1020  ! Read unformatted curve side data
1021 
1022  READ(8) ncurve
1023  curve = 0._dp
1024  CALL blank(ccurve,12*lelt)
1025  IF (ncurve > 0) THEN
1026  DO 1050 icurve=1,ncurve
1027  READ(8,err=1500,end=1500) iedg,ieg,r1,r2,r3,r4,r5,ans
1028  IF (gllnid(ieg) == nid) THEN
1029  iel=gllel(ieg)
1030  curve(1,iedg,iel)=r1
1031  curve(2,iedg,iel)=r2
1032  curve(3,iedg,iel)=r3
1033  curve(4,iedg,iel)=r4
1034  curve(5,iedg,iel)=r5
1035  ccurve( iedg,iel)=ans
1036  ENDIF
1037  1050 END DO
1038  ENDIF
1039  return
1040 
1041  ! Error handling:
1042 
1043  1500 CONTINUE
1044  if(nid == 0) WRITE(6,1501)
1045  1501 FORMAT(2x,'ERROR READING unformatted CURVE SIDE DATA' &
1046  ,/,2x,'ABORTING IN ROUTINE RDCURVE.')
1047  call exitt
1048 
1049  return
1050  ENDIF
1051  end subroutine rdcurve
1052 
1053 !-----------------------------------------------------------------------
1057 subroutine rdbdry
1058  use kinds, only : dp
1059  use size_m, only : ndim, lelt, ldimt1, nid
1060  use input, only : cbc, bc, vnekton, npscal
1061  use input, only : ifheat, ifmhd, ifflow, iffmtin, iftmsh
1062  use parallel, only : nelgt, nelgv, gllnid, gllel
1063  use scratch, only : cbcs, bcs
1064  use string, only : capit, indx1
1065  implicit none
1066 
1067  CHARACTER(1) :: CBC1, chtemp
1068  character(3) :: CBC3, chtmp3
1069  equivalence(chtemp,chtmp3)
1070  character(132) :: tmp_string
1071  integer :: nfldt, nbcs, ibcs, nsides, lcbc, ibcnew, ifield, nel, nbcrea, ieg
1072  integer :: ii, iside, icbc1, id2, id1, iel, lrbc
1073 
1074 ! Set up TEMPORARY value for NFIELD - NFLDT
1075 
1076  nfldt = 1
1077  IF (ifheat) nfldt=2+npscal
1078  if (ifmhd ) nfldt=2+npscal+1
1079  nbcs = nfldt
1080  ibcs = 2
1081  IF (ifflow) ibcs = 1
1082  nsides = 2*ndim
1083 
1084 ! Read boundary conditions for all fields
1085 
1086  lcbc=18*lelt*(ldimt1 + 1)
1087  lrbc=30*lelt*(ldimt1 + 1)
1088  bc = 0._dp
1089  CALL blank(cbc,lcbc)
1090 
1091 !-----------------------------------------------------------------
1092 ! Formatted Reads
1093 !-----------------------------------------------------------------
1094 
1095  IF (iffmtin) THEN
1096 
1097  READ(9,*,err=500,end=500) ! ***** BOUNDARY CONDITIONS *****
1098  ibcnew = 1
1099  DO 100 ifield=ibcnew,nbcs ! DO 100 IFIELD=IBCS,NBCS
1100  nel=nelgt
1101  if ( .NOT. iftmsh(ifield)) nel = nelgv
1102  ! Fluid and/or thermal
1103  read(9,81) tmp_string ! ***** FLUID BOUNDARY CONDITIONS *****
1104  call capit(tmp_string,132)
1105 
1106  ! write(6,*) 'reading BC:',ifield,ibcs,nbcs
1107  ! write(6,81) string
1108  ! if1 = indx1(string,'NO ',3)
1109  ! write(6,*) if1,' if NO. quit.',ifield,ibcs,nbcs
1110  ! write(6,*) ifield,iftmsh(ifield),nel,' iftmsh'
1111  ! call exitt
1112 
1113 
1114  if (indx1(tmp_string,'NO ',3) == 0) then ! we have acitve bc info
1115 
1116  nbcrea = -1 ! below should catch
1117  IF(vnekton <= 2.52) nbcrea = 3
1118  IF(vnekton >= 2.55) nbcrea = 5
1119 
1120  DO ieg=1,nel
1121  DO iside=1,nsides
1122  IF (gllnid(ieg) == nid) THEN
1123  iel=gllel(ieg)
1124  IF (nelgt < 1000) THEN
1125  READ(9,50,err=500,end=500) &
1126  chtemp, &
1127  cbc(iside,iel,ifield),id1,id2, &
1128  (bc(ii,iside,iel,ifield),ii=1,nbcrea)
1129  ! write(6,50)
1130  ! $ CHTEMP,
1131  ! $ CBC(ISIDE,IEL,IFIELD),ID1,ID2,
1132  ! $ (BC(II,ISIDE,IEL,IFIELD),II=1,NBCREA)
1133  50 FORMAT(a1,a3,2i3,5g14.6)
1134  ELSEIF (nelgt < 100000) THEN
1135  READ(9,51,err=500,end=500) &
1136  chtemp, &
1137  cbc(iside,iel,ifield),id1,id2, &
1138  (bc(ii,iside,iel,ifield),ii=1,nbcrea)
1139  51 FORMAT(a1,a3,i5,i1,5g14.6)
1140  ELSEIF (nelgt < 1000000) THEN
1141  READ(9,52,err=500,end=500) &
1142  chtemp, &
1143  cbc(iside,iel,ifield),id1, &
1144  (bc(ii,iside,iel,ifield),ii=1,nbcrea)
1145  52 FORMAT(a1,a3,i6,5g14.6)
1146  ELSE
1147  READ(9,53,err=500,end=500) &
1148  chtemp, &
1149  cbc(iside,iel,ifield),id1, &
1150  (bc(ii,iside,iel,ifield),ii=1,nbcrea)
1151  53 FORMAT(a1,a3,i12,5g18.11)
1152  ENDIF
1153  ! Mesh B.C.'s in 1st column of 1st field
1154  IF (chtemp /= ' ') cbc(iside,iel,0)(1:1)= chtemp
1155  ! check for fortran function as denoted by lower case bc's:
1156  cbc3=cbc(iside,iel,ifield)
1157  icbc1=ichar(cbc3(1:1))
1158  ! IF (ICBC1.GE.97.AND.ICBC1.LE.122) THEN
1159  ! IF(CBC3(3:3).NE.'i')NLINES=BC(1,ISIDE,IEL,IFIELD)
1160  ! IF(CBC3(3:3).EQ.'i')NLINES=BC(4,ISIDE,IEL,IFIELD)
1161  ! DO 60 I=1,NLINES
1162  ! 60 READ(9,*,ERR=500,END=500)
1163  ! ENDIF
1164  ELSE
1165  READ(9,*,err=500,end=500) cbc1 ! dummy read, pff 4/28/05
1166  ENDIF
1167  enddo
1168  END DO
1169  endif
1170  81 format(a132)
1171  100 END DO
1172 
1173  ! END OF BC READ
1174 
1175  ! Check for dummy line: "NO THERMAL B.C.'S"
1176  IF (nfldt == 1) READ(9,*,err=500,end=500)
1177 
1178  return
1179 
1180  ! Error handling:
1181 
1182  500 CONTINUE
1183  if(nid == 0) WRITE(6,501) ifield,ieg
1184  501 FORMAT(2x,'ERROR READING BOUNDARY CONDITIONS FOR FIELD',i4,i12 &
1185  ,/,2x,'ABORTING IN ROUTINE RDBDRY.')
1186  call exitt
1187  return
1188 
1189 
1190  ELSE
1191 
1192  !-----------------------------------------------------------------
1193  ! UNformatted Reads
1194  !-----------------------------------------------------------------
1195 
1196  ! READ(8,ERR=500,END=500)
1197  DO ifield=ibcs,nbcs
1198  nel=nelgt
1199  ! Fluid and/or thermal
1200  nbcrea = 5
1201 
1202  DO ieg=1,nel
1203  DO iside=1,nsides
1204  IF (gllnid(ieg) == nid) THEN
1205  iel=gllel(ieg)
1206  READ(8,err=1500,end=1500) &
1207  chtmp3, &
1208  cbc(iside,iel,ifield),id1,id2, &
1209  (bc(ii,iside,iel,ifield),ii=1,nbcrea)
1210 
1211  ! Mesh B.C.'s in 1st column of 1st field
1212  IF (chtemp /= ' ') cbc(iside,iel,0)(1:1)= chtemp
1213  ! check for fortran function as denoted by lower case bc's:
1214  ELSE
1215  iel=1
1216  READ(8,err=1500,end=1500) chtmp3, &
1217  cbcs(iside,iel),id1,id2,(bcs(ii,iside,iel),ii=1,nbcrea)
1218  ! check for fortran function as denoted by lower case bcs:
1219  ENDIF
1220  enddo
1221  END DO
1222  END DO
1223 
1224  ! END OF BC READ
1225 
1226  return
1227 
1228  ! Error handling:
1229 
1230  1500 CONTINUE
1231  if(nid == 0) WRITE(6,1501) ifield,ieg
1232  1501 FORMAT(2x,'ERROR READING BOUNDARY CONDITIONS FOR FIELD',i4,i12 &
1233  ,/,2x,'(unformatted) ABORTING IN ROUTINE RDBDRY.')
1234  call exitt
1235  ENDIF
1236 
1237  return
1238 end subroutine rdbdry
1239 
1240 !-----------------------------------------------------------------------
1243 subroutine rdicdf
1244  use size_m, only : nid
1245  use input, only : initc
1246  use parallel, only : csize
1247  use string, only : capit, indx1, ifgtil
1248  implicit none
1249 
1250  character(132) :: line
1251  integer :: ierr, nskip, i
1252  integer, external :: iglmax
1253 
1254  ierr = 0
1255 
1256  if (nid == 0) then ! Read names of restart files
1257 
1258  call blank(initc,15*132)
1259  read (9,80,err=200,end=200) line
1260  call capit(line,132)
1261  if (indx1(line,'RESTART',7) /= 0) then
1262  if ( .NOT. ifgtil(nskip,line)) goto 200
1263  ! read(line,*,err=200,end=200) nskip
1264  do 50 i=1,nskip
1265  read(9,80,err=200,end=200) initc(i)
1266  50 END DO
1267  read(9,80,err=200,end=200) line
1268  endif
1269  80 format(a132)
1270 
1271  if ( .NOT. ifgtil(nskip,line)) goto 200
1272 
1273  ! Read initial conditions
1274  do 100 i=1,nskip
1275  read(9,80,err=200,end=200) line
1276  100 END DO
1277 
1278  ! Read drive force data
1279  read(9,*,err=200,end=200)
1280  read(9,*,err=200,end=200) nskip
1281  do 110 i=1,nskip
1282  read(9,80,err=200,end=200) line
1283  110 END DO
1284  endif
1285 
1286  ierr = iglmax(ierr,1)
1287  if (ierr == 0) then
1288  call bcast(initc,15*132*csize)
1289  return
1290  else
1291  goto 210
1292  endif
1293 
1294 ! Error handling:
1295 
1296  200 ierr = 1
1297  ierr = iglmax(ierr,1)
1298 
1299  210 continue
1300  if (nid == 0) write(6,300)
1301  300 format(2x,'Error reading initial condition/drive force data' &
1302  ,/,2x,'aborting in routine rdicdf.')
1303  call exitti('rdicdf error$',ierr)
1304 
1305  return
1306 end subroutine rdicdf
1307 
1308 !-----------------------------------------------------------------------
1312 subroutine rdmatp
1313  use kinds, only : dp
1314  use size_m, only : ldimt1, nid
1315  use input, only : matype, cpgrp, ifvps
1316  use parallel, only : isize, wdsize
1317  implicit none
1318 
1319  CHARACTER(132) :: LINE
1320  integer :: nskip, npacks, iig, igrp, ifld, itype, iprop
1321 
1322  matype = 0
1323  cpgrp = 0._dp
1324 
1325 ! Read material property data
1326 
1327  IF(nid == 0) THEN
1328  READ(9,*,err=200,end=200)
1329  READ(9,*,err=200,end=200) nskip
1330  READ(9,*,err=200,end=200) npacks
1331  DO iig=1,npacks
1332  ifvps= .true.
1333  READ(9,*)igrp,ifld,itype
1334  matype(igrp,ifld)=itype
1335  DO iprop=1,3
1336  IF(itype == 1) READ(9,* ) cpgrp(igrp,ifld,iprop)
1337  IF(itype == 2) READ(9,80) line
1338  80 FORMAT(a132)
1339  enddo
1340  END DO
1341  ENDIF
1342 
1343  CALL bcast(matype,16*ldimt1*isize)
1344  CALL bcast(cpgrp ,48*ldimt1*wdsize)
1345 
1346  return
1347 
1348 ! Error handling:
1349 
1350  200 CONTINUE
1351  if(nid == 0) WRITE(6,201)
1352  201 FORMAT(2x,'ERROR READING MATERIAL PROPERTIES DATA' &
1353  ,/,2x,'ABORTING IN ROUTINE RDMATP.')
1354  call exitt
1355 
1356  return
1357 end subroutine rdmatp
1358 
1359 !-----------------------------------------------------------------------
1362 subroutine rdhist
1363  use size_m, only : lhis, nid, nx1, ny1, nz1
1364  use input, only : lochis, hcode, nhis
1365  use parallel, only : nelgt, isize, csize
1366  implicit none
1367 
1368  integer :: ierr, i, ii, i2
1369 
1370  CALL blank(hcode ,11*lhis)
1371  lochis = 0
1372 
1373  ierr=0
1374  IF(nid == 0) THEN
1375  ! Read history data
1376  READ (9,*)
1377  READ (9,*,err=200,end=200) nhis
1378  if (nhis > lhis) then
1379  write(6,*) nid,' Too many history pts. RESET LHIS.',nhis,lhis
1380  ierr=1
1381  endif
1382 
1383  if(ierr == 0) then
1384  ! HCODE(10) IS WHETHER IT IS HISTORY, STREAKLINE, PARTICLE, ETC.
1385  if (nhis > 0) then
1386  do i=1,nhis
1387  if (nelgt < 100000) then
1388  read(9,130,err=200,end=200) &
1389  (hcode(ii,i),ii=1,11),(lochis(i2,i),i2=1,4)
1390  130 format(1x,11a1,1x,4i5)
1391  else
1392  read(9,131,err=200,end=200) &
1393  (hcode(ii,i),ii=1,11),(lochis(i2,i),i2=1,4)
1394  131 format(1x,11a1,1x,3i5,i10)
1395  endif
1396 
1397  ! threshold lochis locations to allow easy specification of "NX,NY,NZ"
1398  ! pff 1/7/97
1399 
1400  if (hcode(10,i) == 'H') then
1401  lochis(1,i) = min(lochis(1,i),nx1)
1402  lochis(2,i) = min(lochis(2,i),ny1)
1403  lochis(3,i) = min(lochis(3,i),nz1)
1404 
1405  ! if lochis_k = -1, set it to nxk/2 pff 8/21/03
1406 
1407  if (lochis(1,i) == -1) lochis(1,i) = (nx1+1)/2
1408  if (lochis(2,i) == -1) lochis(2,i) = (ny1+1)/2
1409  if (lochis(3,i) == -1) lochis(3,i) = (nz1+1)/2
1410  endif
1411  enddo
1412  endif
1413  endif
1414  ENDIF
1415  call err_chk(ierr,' Too many histroy pts. RESET LHIS$')
1416 
1417  call bcast(nhis ,isize)
1418  call bcast(hcode ,11*lhis*csize)
1419  call bcast(lochis,4*lhis*isize)
1420 
1421  return
1422 
1423 ! Error handling:
1424 
1425  200 CONTINUE
1426  if(nid == 0) WRITE(6,201)
1427  201 FORMAT(2x,'ERROR READING HISTORY DATA' &
1428  ,/,2x,'ABORTING IN ROUTINE RDHIST.')
1429  call exitt
1430 
1431  return
1432 end subroutine rdhist
1433 
1434 !-----------------------------------------------------------------------
1436 subroutine rdout
1437  use size_m, only : nid, ldimt1
1438  use input, only : ifpsco, ifxyo, ifvo, ifpo, ifto, ifbo, ipsco
1439  use parallel, only : lsize, isize
1440  implicit none
1441 
1442  logical :: lbuf(5+ldimt1)
1443  integer :: iflag, nouts, k, i
1444  integer, external :: iglmax
1445 
1446  call lfalse(lbuf,5+ldimt1)
1447  iflag = 0 ! Check for valid ipsco read
1448 
1449  IF(nid == 0) THEN ! Read output specs
1450 
1451  READ(9,*,err=200,end=200)
1452  READ(9,*,err=200,end=200) nouts
1453  READ(9,*,err=200,end=200) ifxyo
1454  READ(9,*,err=200,end=200) ifvo
1455  READ(9,*,err=200,end=200) ifpo
1456  READ(9,*,err=200,end=200) ifto
1457  READ(9,*,err=200,end=200) ifbo ! IFTGO
1458 
1459  lbuf(1) = ifxyo
1460  lbuf(2) = ifvo
1461  lbuf(3) = ifpo
1462  lbuf(4) = ifto
1463  lbuf(5) = ifbo
1464 
1465  k = 5
1466 
1467  call lfalse(ifpsco,ldimt1)
1468  read(9,*,err=200,end=200) ipsco
1469  if (ipsco > 0) then
1470  if (ipsco > ldimt1) then ! Invalid ifpsco read
1471  iflag = 1
1472  else
1473  do i=1,ipsco
1474  read(9,*,err=200,end=200) ifpsco(i)
1475  k = k+1
1476  lbuf(k) = ifpsco(i)
1477  enddo
1478  endif
1479  endif
1480 
1481  endif
1482 
1483 
1484  iflag = iglmax(iflag,1) ! Check for valid ipsco read
1485  if (iflag > 0) call exitti & ! Invalid ifpsco read
1486  ('Error in rdout. Increase ldimt1 in SIZE to$',ipsco)
1487 
1488  k = 5+ldimt1
1489  call bcast(lbuf ,lsize*k)
1490  call bcast(ipsco,isize )
1491 
1492  ifxyo = lbuf(1)
1493  ifvo = lbuf(2)
1494  ifpo = lbuf(3)
1495  ifto = lbuf(4)
1496  ifbo = lbuf(5)
1497 
1498  k = 5
1499  do i=1,ipsco
1500  k = k+1
1501  ifpsco(i) = lbuf(k)
1502  enddo
1503 
1504  return
1505 
1506 
1507 ! Error handling:
1508 
1509  200 CONTINUE
1510  WRITE(6,201)
1511  201 FORMAT(2x,'ERROR READING OUTPUT SPECIFICATION DATA' &
1512  ,/,2x,'ABORTING IN ROUTINE RDOUT.')
1513  call exitt
1514 
1515  return
1516  end subroutine rdout
1517 
1518 !-----------------------------------------------------------------------
1520 subroutine rdobj
1521  use size_m, only : nid, maxobj, maxmbr
1522  use input, only : nobj, nmember, object
1523  use parallel, only : isize
1524  implicit none
1525 
1526  integer :: ierr, iobj, member, k
1527 
1528 ! Default if no data is read No Objects
1529  ierr=0
1530  IF(nid == 0) THEN
1531  nobj=0
1532  READ(9,*,err=200,end=200)
1533  READ(9,*,err=200,end=200) nobj
1534 
1535  IF(nobj > maxobj) ierr=1
1536 
1537  if(ierr == 0) then
1538  DO 10 iobj = 1,nobj
1539  READ(9,*,err=200,end=200) nmember(iobj)
1540  IF(nmember(iobj) > maxmbr)THEN
1541  print*,'ERROR: Too many members in object ',iobj
1542  ierr=2
1543  ENDIF
1544  if(ierr == 0) then
1545  DO 5 member=1,nmember(iobj)
1546  READ(9,*,err=200,end=200) object(iobj,member,1), &
1547  object(iobj,member,2)
1548  5 END DO
1549  endif
1550  10 END DO
1551  write(6,*) nobj,' objects found' &
1552  ,(nmember(k),k=1,nobj)
1553  endif
1554  endif
1555  call err_chk(ierr,'ERROR, too many objects:$')
1556 
1557  call bcast(nobj ,isize)
1558  call bcast(nmember,maxobj*isize)
1559  call bcast(object ,maxobj*maxmbr*2*isize)
1560 
1561 
1562  return
1563 
1564 ! Error handling: For old versions, default to no objects
1565 
1566  200 CONTINUE
1567  nobj=0
1568 
1569  return
1570 end subroutine rdobj
1571 
1572 !=====================================================================
1577 !=====================================================================
1578 subroutine vrdsmsh()
1579  use kinds, only : dp
1580  use size_m, only : lx1, ly1, lz1, lelt
1581  use size_m, only : nx1, ny1, nz1, nelt, ndim, nid
1582  use geom, only : xm1, ym1, zm1
1583  use input, only : ifheat, cbc, if3d
1584  use parallel, only : lglel
1585  use soln, only : tmult, vmult
1586  use tstep, only : ifield
1587  implicit none
1588 
1589  real(DP), allocatable :: TA(:,:,:,:),TB(:,:,:,:) &
1590  ,QMASK(:,:,:,:)
1591  real(DP) :: tmp(2)
1592 
1593  CHARACTER(3) :: CB
1594  integer :: ierr, nxyz1, ntot, nfaces, ie, ieg, ix, iy, iz, iface, iel
1595  real(DP) :: eps, xmx, xmn, ymx, ymn, zmx, zmn, xscmax, xscmin
1596  real(DP) :: scal1, scal2, scal3, xscale, yscmax, yscmin, zscale
1597  real(DP) :: yscale, zscmax, zscmin
1598  real(DP), external :: glmin, glmax
1599  integer :: iglsum
1600 
1601 ! call vrdsmshx ! verify mesh topology
1602 
1603  allocate(ta(lx1,ly1,lz1,lelt),tb(lx1,ly1,lz1,lelt) &
1604  ,qmask(lx1,ly1,lz1,lelt))
1605 
1606  if(nid == 0) write(*,*) 'verify mesh topology'
1607 
1608  ierr = 0
1609  eps = 1.0e-04
1610  eps = 1.0e-03
1611  ifield = 1
1612  IF (ifheat) ifield = 2
1613  nxyz1 = nx1*ny1*nz1
1614  ntot = nx1*ny1*nz1*nelt
1615  nfaces = 2*ndim
1616 
1617  xmx = glmax(xm1,ntot)
1618  xmn = glmin(xm1,ntot)
1619  ymx = glmax(ym1,ntot)
1620  ymn = glmin(ym1,ntot)
1621  zmx = glmax(zm1,ntot)
1622  zmn = glmin(zm1,ntot)
1623  if (nid == 0) write(6,*) xmn,xmx,' Xrange'
1624  if (nid == 0) write(6,*) ymn,ymx,' Yrange'
1625  if (nid == 0) write(6,*) zmn,zmx,' Zrange'
1626 ! return
1627 
1628 ! First check - use 1/Multiplicity
1629 
1630  IF (ifheat) THEN
1631  CALL copy(ta,tmult,ntot)
1632  ELSE
1633  CALL copy(ta,vmult,ntot)
1634  ENDIF
1635 
1636 ! write(6,1)
1637 ! $(nid,'tab4',lglel(ie),(ta(k,1,1,ie),k=1,nx1*ny1),ie=1,nelt)
1638 ! 1 format(i3,a4,i3,16f5.2)
1639 
1640  CALL dssum(ta)
1641 
1642 ! write(6,1)
1643 ! $(nid,'taaf',lglel(ie),(ta(k,1,1,ie),k=1,nx1*ny1),ie=1,nelt)
1644 
1645  tb = 1._dp - ta
1646  DO ie=1,nelt
1647  ieg=lglel(ie)
1648  DO iz=1,nz1
1649  DO iy=1,ny1
1650  DO ix=1,nx1
1651  IF (abs(tb(ix,iy,iz,ie)) > eps ) THEN
1652  WRITE(6,1005) ix,iy,iz,ieg &
1653  ,xm1(ix,iy,iz,ie),ym1(ix,iy,iz,ie),zm1(ix,iy,iz,ie) &
1654  ,ta(ix,iy,iz,ie),eps
1655  ! WRITE(7,1005) IX,IY,IZ,IEG
1656  ! $ ,XM1(IX,IY,IZ,IE),TB(IX,IY,IZ,IE),TA(IX,IY,IZ,IE)
1657  ! $ ,QMASK(IX,IY,IZ,IE)
1658  1005 FORMAT(2x,'WARNING: DSSUM problem at:',/ &
1659  ,1x,'I,J,K,IE:',3i5,i12,/ &
1660  ,2x,'Near X =',3g16.8,', d:',2g16.8)
1661  ierr=4
1662  ENDIF
1663  enddo
1664  enddo
1665  enddo
1666  END DO
1667 
1668 ! Set up QMASK quickly to annihilate checks on periodic bc's
1669 
1670  qmask = 1._dp
1671  DO iel=1,nelt
1672  DO iface=1,nfaces
1673  cb =cbc(iface,iel,ifield)
1674  IF (cb == 'P ' .OR. cb == 'p ') &
1675  CALL facev(qmask,iel,iface,0.0,nx1,ny1,nz1)
1676  enddo
1677  END DO
1678  CALL dsop(qmask,'MUL')
1679 
1680 ! xxmin = glmin(xm1,ntot)
1681 ! yymin = glmin(ym1,ntot)
1682 ! zzmin = glmin(zm1,ntot)
1683 ! xxmax = glmax(xm1,ntot)
1684 ! yymax = glmax(ym1,ntot)
1685 ! zzmax = glmax(zm1,ntot)
1686 ! if (nid.eq.0) write(6,7) xxmin,yymin,zzmin,xxmax,yymax,zzmax
1687 ! 7 format('xyz minmx2:',6g13.5)
1688 
1689 
1690 
1691 
1692 ! X-component
1693 
1694  CALL copy(ta,xm1,ntot)
1695  CALL copy(tb,xm1,ntot)
1696  CALL dsop(ta,'MIN')
1697  CALL dsop(tb,'MAX')
1698  ta = (ta - xm1) * qmask
1699  tb = (tb - xm1) * qmask
1700  DO ie=1,nelt
1701  xscmax = maxval(xm1(:,:,:,ie))
1702  xscmin = minval(xm1(:,:,:,ie))
1703  scal1=abs(xscmax-xscmin)
1704  scal2=abs(xscmax)
1705  scal3=abs(xscmin)
1706  scal1=max(scal1,scal2)
1707  scal1=max(scal1,scal3)
1708  xscale = 1./scal1
1709  ieg=lglel(ie)
1710  DO iz=1,nz1
1711  DO iy=1,ny1
1712  DO ix=1,nx1
1713  if (abs(ta(ix,iy,iz,ie)*xscale) > eps .OR. &
1714  abs(tb(ix,iy,iz,ie)*xscale) > eps ) then
1715  write(6,1105) ix,iy,iz,ieg &
1716  ,xm1(ix,iy,iz,ie),ym1(ix,iy,iz,ie),zm1(ix,iy,iz,ie) &
1717  ,tb(ix,iy,iz,ie),ta(ix,iy,iz,ie),xscale
1718  1105 format(1x,'WARNING1 Element mesh mismatch at:',/ &
1719  ,1x,'i,j,k,ie:',3i5,i12,/ &
1720  ,1x,'Near X =',3g16.8,', d:',3g16.8)
1721  ierr=1
1722  endif
1723  enddo
1724  enddo
1725  enddo
1726  enddo
1727 
1728 ! Y-component
1729 
1730  CALL copy(ta,ym1,ntot)
1731  CALL copy(tb,ym1,ntot)
1732  CALL dsop(ta,'MIN')
1733  CALL dsop(tb,'MAX')
1734  ta = (ta - ym1) * qmask
1735  tb = (tb - ym1) * qmask
1736  DO ie=1,nelt
1737  yscmax = maxval(ym1(:,:,:,ie))
1738  yscmin = minval(ym1(:,:,:,ie))
1739  scal1=abs(yscmax-yscmin)
1740  scal2=abs(yscmax)
1741  scal3=abs(yscmin)
1742  scal1=max(scal1,scal2)
1743  scal1=max(scal1,scal3)
1744  yscale = 1./scal1
1745  ieg=lglel(ie)
1746  DO iz=1,nz1
1747  DO iy=1,ny1
1748  DO ix=1,nx1
1749  IF (abs(ta(ix,iy,iz,ie)*yscale) > eps .OR. &
1750  abs(tb(ix,iy,iz,ie)*yscale) > eps ) THEN
1751  WRITE(6,1205) ix,iy,iz,ieg &
1752  ,xm1(ix,iy,iz,ie),ym1(ix,iy,iz,ie),zm1(ix,iy,iz,ie) &
1753  ,tb(ix,iy,iz,ie),ta(ix,iy,iz,ie),yscale
1754  1205 FORMAT(1x,'WARNING2 Element mesh mismatch at:',/ &
1755  ,1x,'I,J,K,IE:',3i5,i12,/ &
1756  ,1x,'Near Y =',3g16.8,', d:',3g16.8)
1757  ierr=2
1758  ENDIF
1759  enddo
1760  enddo
1761  enddo
1762  enddo
1763 
1764 ! Z-component
1765 
1766  IF (if3d) THEN
1767  CALL copy(ta,zm1,ntot)
1768  CALL copy(tb,zm1,ntot)
1769  CALL dsop(ta,'MIN')
1770  CALL dsop(tb,'MAX')
1771  ta = (ta - zm1) * qmask
1772  tb = (tb - zm1) * qmask
1773  DO ie=1,nelt
1774  zscmax = maxval(zm1(:,:,:,ie))
1775  zscmin = minval(zm1(:,:,:,ie))
1776  scal1=abs(zscmax-zscmin)
1777  scal2=abs(zscmax)
1778  scal3=abs(zscmin)
1779  scal1=max(scal1,scal2)
1780  scal1=max(scal1,scal3)
1781  zscale = 1./scal1
1782  ieg=lglel(ie)
1783  DO iz=1,nz1
1784  DO iy=1,ny1
1785  DO ix=1,nx1
1786  IF (abs(ta(ix,iy,iz,ie)*zscale) > eps .OR. &
1787  abs(tb(ix,iy,iz,ie)*zscale) > eps ) THEN
1788  WRITE(6,1305) ix,iy,iz,ieg &
1789  ,xm1(ix,iy,iz,ie),ym1(ix,iy,iz,ie),zm1(ix,iy,iz,ie) &
1790  ,tb(ix,iy,iz,ie),ta(ix,iy,iz,ie),zscale
1791  1305 FORMAT(1x,'WARNING3 Element mesh mismatch at:',/ &
1792  ,1x,'I,J,K,IE:',3i5,i12,/ &
1793  ,1x,'Near Z =',3g16.8,', d:',3g16.8)
1794  ierr=3
1795  ENDIF
1796  enddo
1797  enddo
1798  enddo
1799  enddo
1800  ENDIF
1801 
1802  ierr = iglsum(ierr,1)
1803  IF (ierr > 0) THEN
1804  if(nid == 0) WRITE(6,1400)
1805  1400 FORMAT &
1806  (' Mesh consistency check failed. EXITING in VRDSMSH.')
1807  call exitt
1808  ENDIF
1809 
1810  tmp(1)=ierr
1811  CALL gop(tmp,tmp(2),'M ',1)
1812  IF (tmp(1) >= 4.0) THEN
1813  WRITE(6,1400) &
1814  (' Mesh consistency check failed. EXITING in VRDSMSH.')
1815  call exitt
1816  ENDIF
1817 
1818  if(nid == 0) then
1819  write(6,*) 'done :: verify mesh topology'
1820  write(6,*) ' '
1821  endif
1822 
1823  return
1824 end subroutine vrdsmsh
1825 
1826 !-----------------------------------------------------------------------
1827 subroutine chk_nel
1828  use size_m, only : lelt, lelv, lelg, nid, nelt
1829  use parallel, only : np, nelgt, nelgv!, nelgt_max
1830  implicit none
1831 
1832  integer :: neltmx, nelvmx, lelt_needed
1833  integer, external :: iglmax
1834 
1835  neltmx=np*lelt
1836  nelvmx=np*lelv
1837 
1838  neltmx=min(neltmx,lelg)
1839  nelvmx=min(nelvmx,lelg)
1840 
1841  nelgt = iglmax(nelgt,1)
1842  nelgv = iglmax(nelgv,1)
1843 
1844 ! write(6,*) nid,' inside chk_nel',nelgt,neltmx,nelvmx
1845 
1846  if (nelgt > neltmx .OR. nelgv > nelvmx) then
1847  if (nid == 0) then
1848  lelt_needed = nelgt/np
1849  if (mod(nelgt,np) /= 0) lelt_needed = lelt_needed + 1
1850  write(6,12) lelt,lelg,lelt_needed,np,nelgt
1851  12 format(//,2x,'ABORT: Problem size too large!' &
1852  ,/,2x &
1853  ,/,2x,'This solver has been compiled for:' &
1854  ,/,2x,' number of elements/proc (lelt):',i12 &
1855  ,/,2x,' total number of elements (lelg):',i12 &
1856  ,/,2x &
1857  ,/,2x,'Recompile with the following SIZE parameters:' &
1858  ,/,2x,' lelt >= ',i12,' for np = ',i12 &
1859  ,/,2x,' lelg >= ',i12,/)
1860  ! write(6,*)'help:',lp,np,nelvmx,nelgv,neltmx,nelgt
1861  ! write(6,*)'help:',lelt,lelv,lelgv
1862  endif
1863  call exitt
1864  endif
1865 
1866 #if 0
1867  if(nelgt > nelgt_max) then
1868  if(nid == 0) write(6,*) &
1869  'ABORT: Total number of elements too large!', &
1870  ' nel_max = ', nelgt_max
1871  call exitt
1872  endif
1873 #endif
1874 
1875  if (nelt > lelt) then
1876  write(6,'(A,3I12)') 'ABORT: nelt>lelt!', nid, nelt, lelt
1877  call exitt
1878  endif
1879 
1880  return
1881 end subroutine chk_nel
1882 
parallel::gllel
integer function gllel(ieg)
Definition: parallel_mod.F90:162
dssum
subroutine dssum(u)
Direct stiffness sum.
Definition: dssum.F90:54
bcast
subroutine bcast(buf, len)
Definition: comm_mpi.F90:289
rdhist
subroutine rdhist
.Read history data .Broadcast to all processors
Definition: connect2.F90:1362
scratch
cleaned
Definition: scratch_mod.F90:2
tstep
cleaned
Definition: tstep_mod.F90:2
input
Input parameters from preprocessors.
Definition: input_mod.F90:11
soln
Definition: soln_mod.F90:1
rdbdry
subroutine rdbdry
Read Boundary Conditions (and connectivity data). .Disperse boundary condition data to all processors...
Definition: connect2.F90:1057
rdmatp
subroutine rdmatp
.Read materials property data .Disperse material properties to all processors according to sequential...
Definition: connect2.F90:1312
exitt
void exitt()
Definition: comm_mpi.F90:411
string::indx1
integer function indx1(S1, S2, L2)
Definition: string_mod.F90:43
rdobj
subroutine rdobj
Read objects, Broadcast to all processors.
Definition: connect2.F90:1520
mesh
cleaned
Definition: mesh_mod.F90:2
ctimer::dnekclock
real(dp) function dnekclock()
Definition: ctimer_mod.F90:103
parallel::lglel
integer function lglel(iel)
Definition: parallel_mod.F90:176
copy
subroutine copy(a, b, n)
Definition: math.F90:52
readat
subroutine readat()
Read in data from preprocessor input file (.rea)
Definition: connect2.F90:3
zper
Cleaned.
Definition: zper_mod.F90:2
parallel::gllnid
integer function gllnid(ieg)
Definition: parallel_mod.F90:115
rdcurve
subroutine rdcurve
.Read curve side data .Disperse curve side data to all processors according to sequential partition s...
Definition: connect2.F90:964
dsop
subroutine dsop(u, op)
generalization of dssum to other reducers.
Definition: dssum.F90:134
rdout
subroutine rdout
Read output specs, broadcast to all processors.
Definition: connect2.F90:1436
parallel
cleaned
Definition: parallel_mod.F90:2
string::capit
subroutine capit(lettrs, n)
Capitalizes string of length n.
Definition: string_mod.F90:161
blank
subroutine blank(A, N)
blank a string
Definition: math.F90:38
lfalse
subroutine lfalse(IFA, N)
Definition: bdry.F90:1051
string::ifgtil
logical function ifgtil(IVALUE, LINE)
Read IVALUE from LINE and set IFGTIL to .TRUE. if successful, IFGTIL to .FALSE. otherwise. This complicated function is necessary thanks to the Ardent, which won't allow free formatted reads (*) from internal strings!
Definition: string_mod.F90:229
chk_nel
subroutine chk_nel
Definition: connect2.F90:1827
string::cscan
subroutine cscan(sout, key, nk)
Definition: string_mod.F90:278
nekgsync
subroutine nekgsync()
Definition: comm_mpi.F90:318
geom
Geometry arrays.
Definition: geom_mod.F90:2
genmesh
subroutine genmesh
Generate local mesh elements.
Definition: connect2.F90:731
gop
subroutine gop(x, w, op, n)
Global vector commutative operation.
Definition: comm_mpi.F90:104
rdicdf
subroutine rdicdf
Read Initial Conditions / Drive Force. Broadcast ICFILE to all processors.
Definition: connect2.F90:1243
err_chk
subroutine err_chk(ierr, istring)
Definition: comm_mpi.F90:356
np
static uint np
Definition: findpts_test.c:63
mapelpr
subroutine mapelpr()
Definition: map2.F90:2
facev
subroutine facev(a, ie, iface, val, nx, ny, nz)
Assign the value VAL to face(IFACE,IE) of array A. IFACE is the input in the pre-processor ordering s...
Definition: connect1.F90:1041
vrdsmsh
subroutine vrdsmsh()
Verify that mesh and dssum are properly defined by performing a direct stiffness operation on the X...
Definition: connect2.F90:1578
rdmesh
subroutine rdmesh
Read number of elements. .Construct sequential element-processor partition according to number of ele...
Definition: connect2.F90:878
exitti
subroutine exitti(stringi, idata)
Definition: comm_mpi.F90:328
rdparam
subroutine rdparam
Read in parameters supplied by preprocessor and (eventually) echo check. .Broadcast run parameters to...
Definition: connect2.F90:232
Generated on Tue Jul 14 2015 10:52:58 for Nek5000 by   doxygen 1.8.8