Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_ReadSolution.F90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 !******************************************************************************
24 !
25 ! Purpose: read in PLAG solution.
26 !
27 ! Description: the following solution formats are supported:
28 ! - RocfloMP ASCII
29 ! - RocfloMP binary.
30 !
31 ! Input: regions = dimensions of all regions.
32 !
33 ! Output: region%levels%plag%cv = conservative variables (current grid
34 ! level)
35 ! region%levels%plag%aiv = auxilliary integer variables
36 ! region%levels%plag%arv = auxilliary real variables
37 ! region%levels%tile%cv = conservative variables
38 !
39 ! Notes: only unsteady solution file format is supported.
40 !
41 !******************************************************************************
42 !
43 ! $Id: PLAG_ReadSolution.F90,v 1.7 2009/10/26 00:19:32 mtcampbe Exp $
44 !
45 ! Copyright: (c) 2002 by the University of Illinois
46 !
47 !******************************************************************************
48 
49 SUBROUTINE plag_readsolution( regions )
50 
51  USE moddatatypes
52  USE modpartlag, ONLY : t_plag, t_tile_plag
53  USE modbndpatch, ONLY : t_patch
54  USE moddatastruct, ONLY : t_region, t_level
55  USE modglobal, ONLY : t_global
56  USE modinterfaces, ONLY : rflo_readdatafileint, rflo_readdatafilereal
57  USE moderror
58  USE modmpi
59  USE modparameters
60  USE plag_modparameters
61  IMPLICIT NONE
62 
63 ! ... parameters
64  TYPE(t_region), POINTER :: regions(:)
65 
66 ! ... loop variables
67  INTEGER :: i, icont, ipatch, ireg
68 
69 ! ... local variables
70  CHARACTER(CHRLEN+17) :: fname
71  CHARACTER(CHRLEN) :: rcsidentstring, msg, timestring
72 
73 #ifdef MPI
74  INTEGER :: status(mpi_status_size)
75 #endif
76  INTEGER, PARAMETER :: one = 1
77  INTEGER :: bctype, errorflag, ilev, iregfile, n, n1, n2, naiv, narv, &
78  ncont, ncv, ncvtile, ndimplag, ndimtile, ndvtile,ntiles, &
79  nextidnumber
80  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: aivfile, ivar
81  INTEGER, POINTER, DIMENSION(:) :: pcvplagmass, pcvtilemass
82  INTEGER, POINTER, DIMENSION(:,:) :: paiv
83 
84  REAL(RFREAL), ALLOCATABLE, DIMENSION(:,:) :: arvfile, cvfile, dvfile, rvar
85  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv, pcv, pcvtile, pdvtile
86  REAL(RFREAL) :: timediff
87 
88  TYPE(t_patch), POINTER :: ppatch
89  TYPE(t_plag), POINTER :: pplag
90  TYPE(t_tile_plag), POINTER :: ptileplag
91  TYPE(t_global), POINTER :: global
92 
93 !******************************************************************************
94 
95  rcsidentstring = '$RCSfile: PLAG_ReadSolution.F90,v $ $Revision: 1.7 $'
96 
97  global => regions(1)%global
98 
99  CALL registerfunction( global,'PLAG_ReadSolution',&
100  'PLAG_ReadSolution.F90' )
101 
102  IF (.NOT. global%plagUsed) goto 999
103 
104  IF ( global%myProcid == masterproc .AND. &
105  global%verbLevel > verbose_none ) THEN
106  WRITE(stdout,'(A,3X,A)') solver_name,'Reading PLAG solution file...'
107  END IF ! global%verbLevel
108 
109 ! allocate fixed-size temporary data arrays -----------------------------------
110 
111  ALLOCATE( ivar(3,1),stat=errorflag )
112  global%error = errorflag
113  IF (global%error /= err_none) THEN
114  CALL errorstop( global,err_allocate,__line__,'ivar' )
115  END IF ! global%error
116 
117  ALLOCATE( rvar(1,1),stat=errorflag )
118  global%error = errorflag
119  IF (global%error /= err_none) THEN
120  CALL errorstop( global,err_allocate,__line__,'rvar' )
121  END IF ! global%error
122 
123 ! copy time to string ---------------------------------------------------------
124 
125  IF (global%flowType == flow_unsteady) THEN
126  WRITE(timestring,'(1PE11.5)') global%timeStamp
127  ELSE
128  WRITE(timestring,'(1PE11.5)') 0._rfreal
129  ENDIF
130 
131 ! open solution file (only master proc.) --------------------------------------
132 
133  IF (global%myProcid == masterproc) THEN
134 
135  IF (global%solutFormat == format_ascii) THEN
136  IF( global%currentTime == 0.0_rfreal) THEN
137  WRITE(fname,'(A,1PE11.5)') &
138  trim(global%inDir)//trim(global%casename)//'.plag_sola_',global%timeStamp
139  OPEN(if_solut,file=fname,form='formatted',status='old',iostat=errorflag)
140  ELSE
141  WRITE(fname,'(A,1PE11.5)') &
142  trim(global%outDir)//trim(global%casename)//'.plag_sola_',global%timeStamp
143  OPEN(if_solut,file=fname,form='formatted',status='old',iostat=errorflag)
144  ENDIF
145  ELSE IF (global%solutFormat == format_binary) THEN
146  WRITE(fname,'(A,1PE11.5)') &
147  trim(global%inDir)//trim(global%casename)//'.plag_solb_', global%timeStamp
148  OPEN(if_solut,file=fname,form='unformatted',status='old',iostat=errorflag)
149  ENDIF ! global%solutFormat
150 
151  global%error = errorflag
152  IF (global%error /= err_none) THEN
153  CALL errorstop( global,err_file_open,__line__,'File: '//trim(fname) )
154  END IF ! global%error
155 
156  ENDIF ! MASTERPROC
157 
158 ! read & check time stamp in file ----------------------------------------------
159 
160  IF (global%myProcid == masterproc) THEN
161  CALL rflo_readdatafilereal( global,if_solut,global%solutFormat,1,1,rvar )
162  ENDIF
163 
164 #ifdef MPI
165  CALL mpi_bcast( rvar,1,mpi_rfreal,masterproc,global%mpiComm,global%mpierr )
166  IF (global%mpierr /= err_none) THEN
167  CALL errorstop( global,err_mpi_trouble,__line__ )
168  END IF ! global%mpierr
169 #endif
170 
171  IF (global%currentTime>0._rfreal) THEN
172  timediff = abs(global%currentTime - rvar(1,1))
173  IF (timediff.gt.1.0e-12) THEN
174  WRITE(msg,1000) rvar(1,1),global%currentTime
175  CALL errorstop( global,err_time_solution, __line__,msg//' File: '//trim(fname) )
176  ENDIF
177  ENDIF
178 
179 ! read solution data ----------------------------------------------------------
180 
181  DO ireg=1,global%nRegions
182 
183 ! - get dimensions and pointers for PLAG datastructure
184 
185  ilev = regions(ireg)%currLevel
186 
187  ncont = regions(ireg)%plagInput%nCont
188  naiv = aiv_plag_last
189  narv = arv_plag_last
190  ncv = cv_plag_last+ncont
191 
192  pplag => regions(ireg)%levels(ilev)%plag
193  paiv => pplag%aiv
194  parv => pplag%arv
195  pcv => pplag%cv
196  pcvplagmass => pplag%cvPlagMass
197 
198 ! - read region number and dimensions (only master)
199 
200  IF (global%myProcid == masterproc) THEN
201  CALL rflo_readdatafileint( global,if_solut,global%solutFormat,3,1,ivar )
202  iregfile = ivar(1,1)
203  ndimplag = ivar(2,1)
204  nextidnumber = ivar(3,1)
205 
206  IF (iregfile /= ireg) &
207  CALL errorstop( global,err_region_number,__line__,'File: '//trim(fname) )
208  ENDIF ! global%myProcid
209 
210 ! - broadcast current value of nDimPlag to other processors
211 
212 #ifdef MPI
213  CALL mpi_bcast( ndimplag,1,mpi_integer,masterproc,global%mpiComm,global%mpierr )
214  IF (global%mpierr /= err_none) THEN
215  CALL errorstop( global,err_mpi_trouble,__line__ )
216  END IF ! global%mpierr
217 #endif
218 
219 ! - broadcast current value of nextIdNumber to other processors
220 
221 #ifdef MPI
222  CALL mpi_bcast( nextidnumber,1,mpi_integer,masterproc,global%mpiComm,global%mpierr )
223  IF (global%mpierr /= err_none) THEN
224  CALL errorstop( global,err_mpi_trouble,__line__ )
225  END IF ! global%mpierr
226 #endif
227 
228 ! - activate for number of particles greater than zero
229 
230  SELECT CASE (ndimplag)
231  CASE (one:)
232 
233 ! -- master reads Aiv & sends data, others receive them
234 
235  IF (global%myProcid == masterproc) THEN
236 
237  ALLOCATE( aivfile(naiv,ndimplag),stat=errorflag )
238  global%error = errorflag
239  IF (global%error /= err_none) THEN
240  CALL errorstop( global,err_allocate,__line__,'aivFile' )
241  END IF ! global%error
242 
243  CALL rflo_readdatafileint( global,if_solut,global%solutFormat, &
244  naiv,ndimplag,aivfile )
245 
246 #ifdef MPI
247  IF (regions(ireg)%procid /= masterproc) THEN
248  CALL mpi_send( aivfile,naiv*ndimplag,mpi_integer, &
249  regions(ireg)%procid,ireg, &
250  global%mpiComm,global%mpierr )
251  IF (global%mpierr /= err_none ) THEN
252  CALL errorstop( global,err_mpi_trouble,__line__ )
253  END IF ! global%mpierr
254 
255  ENDIF ! regions(iReg)%procid
256 #endif
257 
258  ELSE ! not the master
259 
260  IF (regions(ireg)%procid == global%myProcid) THEN
261  ALLOCATE( aivfile(naiv,ndimplag),stat=errorflag )
262  global%error = errorflag
263  IF (global%error /= err_none) THEN
264  CALL errorstop( global,err_allocate,__line__,'aivFile' )
265  ENDIF !global%error
266 
267 #ifdef MPI
268  CALL mpi_recv( aivfile,naiv*ndimplag,mpi_integer,masterproc,ireg, &
269  global%mpiComm,status,global%mpierr )
270  IF (global%mpierr /= err_none) THEN
271  CALL errorstop( global,err_mpi_trouble,__line__ )
272  END IF ! global%mpierr
273 #endif
274  END IF !regions(iReg)%procid
275 
276  END IF !global%myProcid
277 
278 ! -- copy solution into data structure
279 
280  IF (regions(ireg)%procid == global%myProcid) THEN
281 
282 ! -- copy nDimPlag to nPcls
283  pplag%nPcls = ndimplag
284  pplag%nextIdNumber = nextidnumber
285 
286  n=0
287  DO i=1, ndimplag
288  n = n+1
289  paiv(aiv_plag_pidini,i) = aivfile(1,n)
290  paiv(aiv_plag_regini,i) = aivfile(2,n)
291  paiv(aiv_plag_regcrt,i) = aivfile(3,n)
292  paiv(aiv_plag_icells,i) = aivfile(4,n)
293  paiv(aiv_plag_indexi,i) = aivfile(5,n)
294  paiv(aiv_plag_indexj,i) = aivfile(6,n)
295  paiv(aiv_plag_indexk,i) = aivfile(7,n)
296  paiv(aiv_plag_burnstat,i) = aivfile(8,n)
297  paiv(aiv_plag_status,i) = aivfile(9,n)
298  ENDDO ! i
299  END IF !regions(iReg)%procid
300 
301  IF (ALLOCATED(aivfile)) THEN
302  DEALLOCATE( aivfile,stat=errorflag )
303  global%error = errorflag
304  IF (global%error /= err_none) THEN
305  CALL errorstop( global,err_deallocate,__line__,'aivFile' )
306  ENDIF ! global%error
307  ENDIF ! aivFile
308 
309 ! -- master reads Arv & sends data, others receive them
310 
311  IF (global%myProcid == masterproc) THEN
312  ALLOCATE( arvfile(narv,ndimplag),stat=errorflag )
313  global%error = errorflag
314  IF (global%error /= err_none) THEN
315  CALL errorstop( global,err_allocate,__line__,'aivFile' )
316  END IF ! global%error
317  CALL rflo_readdatafilereal( global,if_solut,global%solutFormat, &
318  narv,ndimplag,arvfile )
319 
320 #ifdef MPI
321  IF (regions(ireg)%procid /= masterproc) THEN
322  CALL mpi_send( arvfile,narv*ndimplag,mpi_rfreal, &
323  regions(ireg)%procid,ireg, &
324  global%mpiComm,global%mpierr )
325  IF (global%mpierr /= err_none ) THEN
326  CALL errorstop( global,err_mpi_trouble,__line__ )
327  END IF ! global%mpierr
328 
329  ENDIF ! regions(iReg)%procid
330 #endif
331 
332  ELSE ! not the master
333 
334  IF (regions(ireg)%procid == global%myProcid) THEN
335  ALLOCATE( arvfile(narv,ndimplag),stat=errorflag )
336  global%error = errorflag
337  IF (global%error /= err_none) THEN
338  CALL errorstop( global,err_allocate,__line__,'arvFile' )
339  ENDIF !global%error
340 
341 #ifdef MPI
342  CALL mpi_recv( arvfile,narv*ndimplag,mpi_rfreal,masterproc,ireg, &
343  global%mpiComm,status,global%mpierr )
344  IF (global%mpierr /= err_none) THEN
345  CALL errorstop( global,err_mpi_trouble,__line__ )
346  END IF ! global%mpierr
347 #endif
348  END IF !regions(iReg)%procid
349 
350  END IF !global%myProcid
351 
352 ! -- copy solution into data structure
353 
354  IF (regions(ireg)%procid == global%myProcid) THEN
355  n=0
356  DO i=1, ndimplag
357  n = n+1
358  parv(arv_plag_spload,i) = arvfile(1,n)
359  parv(arv_plag_distot,i) = arvfile(2,n)
360  ENDDO ! i
361  END IF !regions(iReg)%procid
362 
363  IF (ALLOCATED(arvfile)) THEN
364  DEALLOCATE( arvfile,stat=errorflag )
365  global%error = errorflag
366  IF (global%error /= err_none) THEN
367  CALL errorstop( global,err_deallocate,__line__,'arvFile' )
368  ENDIF ! global%error
369  ENDIF ! arvFile
370 
371 ! -- master reads Cv & sends data, others receive them
372 
373  IF (global%myProcid == masterproc) THEN
374  ALLOCATE( cvfile(ncv,ndimplag),stat=errorflag )
375  global%error = errorflag
376  IF (global%error /= err_none) THEN
377  CALL errorstop( global,err_allocate,__line__,'cvFile' )
378  END IF ! global%error
379 
380  CALL rflo_readdatafilereal( global,if_solut,global%solutFormat, &
381  ncv,ndimplag,cvfile )
382 
383 #ifdef MPI
384  IF (regions(ireg)%procid /= masterproc) THEN
385  CALL mpi_send( cvfile,ncv*ndimplag,mpi_rfreal, &
386  regions(ireg)%procid,ireg, &
387  global%mpiComm,global%mpierr )
388  IF (global%mpierr /= err_none ) THEN
389  CALL errorstop( global,err_mpi_trouble,__line__ )
390  END IF ! global%mpierr
391 
392  ENDIF ! regions(iReg)%procid
393 #endif
394 
395  ELSE ! not the master
396 
397  IF (regions(ireg)%procid == global%myProcid) THEN
398  ALLOCATE( cvfile(ncv,ndimplag),stat=errorflag )
399  global%error = errorflag
400  IF (global%error /= err_none) THEN
401  CALL errorstop( global,err_allocate,__line__,'cvFile' )
402  ENDIF !global%error
403 
404 #ifdef MPI
405  CALL mpi_recv( cvfile,ncv*ndimplag,mpi_rfreal,masterproc,ireg, &
406  global%mpiComm,status,global%mpierr )
407  IF (global%mpierr /= err_none) THEN
408  CALL errorstop( global,err_mpi_trouble,__line__ )
409  END IF ! global%mpierr
410 #endif
411  END IF !regions(iReg)%procid
412 
413  END IF !global%myProcid
414 
415 ! -- copy solution into data structure
416 
417  IF (regions(ireg)%procid == global%myProcid) THEN
418  n=0
419  DO i=1, ndimplag
420  n = n+1
421  pcv(cv_plag_xmom,i) = cvfile(1,n)
422  pcv(cv_plag_ymom,i) = cvfile(2,n)
423  pcv(cv_plag_zmom,i) = cvfile(3,n)
424  pcv(cv_plag_ener,i) = cvfile(4,n)
425  pcv(cv_plag_xpos,i) = cvfile(5,n)
426  pcv(cv_plag_ypos,i) = cvfile(6,n)
427  pcv(cv_plag_zpos,i) = cvfile(7,n)
428  pcv(cv_plag_enervapor,i) = cvfile(8,n)
429  DO icont = 1, ncont
430  pcv(pcvplagmass(icont),i) = cvfile(cv_plag_last+icont,n)
431  ENDDO ! iCont
432  ENDDO ! i
433  END IF !regions(iReg)%procid
434 
435  IF (ALLOCATED(cvfile)) THEN
436  DEALLOCATE( cvfile,stat=errorflag )
437  global%error = errorflag
438  IF (global%error /= err_none) THEN
439  CALL errorstop( global,err_deallocate,__line__,'cvFile' )
440  ENDIF ! global%error
441  ENDIF ! cvFile
442 
443  END SELECT ! nDimPlag
444  ENDDO ! iReg
445 
446 ! read tile datastructure -----------------------------------------------------
447 
448  DO ireg=1,global%nRegions
449 
450 ! - get dimensions ------------------------------------------------------------
451 
452  ilev = regions(ireg)%currLevel
453  ncont = regions(ireg)%plagInput%nCont
454  ncvtile = cv_tile_last+ncont
455  ndvtile = 3
456 
457  DO ipatch=1,regions(ireg)%nPatches
458 
459 ! - set pointers
460 
461  ppatch => regions(ireg)%levels(ilev)%patches(ipatch)
462  bctype = ppatch%bcType
463 
464  IF ( bctype>=bc_injection .AND. bctype<=bc_injection+bc_range ) THEN
465 
466 ! -- get total tile dimensions ------------------------------------------------
467 
468  n1 = abs(ppatch%l1end -ppatch%l1beg ) + 1
469  n2 = abs(ppatch%l2end -ppatch%l2beg ) + 1
470  ntiles = n1*n2
471 
472 ! -- set tile pointers --------------------------------------------------------
473 
474  ptileplag => ppatch%tilePlag
475  pcvtile => ptileplag%cv
476  pcvtilemass => ptileplag%cvTileMass
477  pdvtile => ptileplag%dv
478 
479 ! -- read dimensions (only master)
480 
481  IF (global%myProcid == masterproc) THEN
482  CALL rflo_readdatafileint( global,if_solut,global%solutFormat, &
483  2,1,ivar )
484  iregfile = ivar(1,1)
485  ndimtile = ivar(2,1)
486 
487  IF (iregfile /= ireg) &
488  CALL errorstop( global,err_region_number,__line__, &
489  'File: '//trim(fname) )
490 
491  IF (ndimtile > ntiles) &
492  CALL errorstop( global,err_plag_tilesize,__line__, &
493  'File: '//trim(fname) )
494  ENDIF ! global%myProcid
495 
496 ! - broadcast current value of nDimTile to other processors
497 
498 #ifdef MPI
499  CALL mpi_bcast( ndimtile,1,mpi_integer,masterproc,global%mpiComm,global%mpierr )
500  IF (global%mpierr /= err_none) THEN
501  CALL errorstop( global,err_mpi_trouble,__line__ )
502  END IF ! global%mpierr
503 #endif
504 
505 ! -- activate for number of tiles greater than zero
506 
507  SELECT CASE (ndimtile)
508  CASE (one:)
509 
510 ! --- master reads cv & sends data, others receive them
511 
512  IF (global%myProcid == masterproc) THEN
513  ALLOCATE( cvfile(ncvtile,ndimtile),stat=errorflag )
514  global%error = errorflag
515  IF (global%error /= err_none) THEN
516  CALL errorstop( global,err_allocate,__line__,'cvFile' )
517  END IF ! global%error
518 
519  CALL rflo_readdatafilereal( global,if_solut, global%solutFormat, &
520  ncvtile,ndimtile,cvfile )
521 
522 #ifdef MPI
523  IF (regions(ireg)%procid /= masterproc) THEN
524  CALL mpi_send( cvfile,ncvtile*ndimtile,mpi_rfreal, &
525  regions(ireg)%procid,ireg, &
526  global%mpiComm,global%mpierr )
527  IF (global%mpierr /= err_none ) THEN
528  CALL errorstop( global,err_mpi_trouble,__line__ )
529  END IF ! global%mpierr
530 
531  ENDIF ! regions(iReg)%procid
532 #endif
533 
534  ELSE ! not the master
535 
536  IF (regions(ireg)%procid == global%myProcid) THEN
537  ALLOCATE( cvfile(ncvtile,ndimtile),stat=errorflag )
538  global%error = errorflag
539  IF (global%error /= err_none) THEN
540  CALL errorstop( global,err_allocate,__line__,'cvFile' )
541  ENDIF !global%error
542 
543 #ifdef MPI
544  CALL mpi_recv( cvfile,ncvtile*ndimtile,mpi_rfreal,&
545  masterproc,ireg, &
546  global%mpiComm,status,global%mpierr )
547  IF (global%mpierr /= err_none) THEN
548  CALL errorstop( global,err_mpi_trouble,__line__ )
549  END IF ! global%mpierr
550 #endif
551  END IF !regions(iReg)%procid
552 
553  END IF !global%myProcid
554 
555 ! --- copy solution into data structure
556 
557  IF (regions(ireg)%procid == global%myProcid) THEN
558  n=0
559  DO i=1, ndimtile
560  n = n+1
561  pcvtile(cv_tile_momnrm,i) = cvfile(1,n)
562  pcvtile(cv_tile_ener, i) = cvfile(2,n)
563  DO icont = 1, ncont
564  pcvtile(pcvtilemass(icont),i) = cvfile(2+icont,n)
565  ENDDO ! iCont
566  ENDDO ! i
567  END IF !regions(iReg)%procid
568 
569  IF (ALLOCATED(cvfile)) THEN
570  DEALLOCATE( cvfile,stat=errorflag )
571  global%error = errorflag
572  IF (global%error /= err_none) THEN
573  CALL errorstop( global,err_deallocate,__line__,'cvFile' )
574  ENDIF ! global%error
575  ENDIF ! cvFile
576 
577 ! --- master reads dv & sends data, others receive them
578 
579  IF (global%myProcid == masterproc) THEN
580  ALLOCATE( dvfile(ndvtile,ndimtile),stat=errorflag )
581  global%error = errorflag
582  IF (global%error /= err_none) THEN
583  CALL errorstop( global,err_allocate,__line__,'cvFile' )
584  END IF ! global%error
585 
586  CALL rflo_readdatafilereal( global,if_solut, global%solutFormat, &
587  ndvtile,ndimtile,dvfile )
588 
589 #ifdef MPI
590  IF (regions(ireg)%procid /= masterproc) THEN
591  CALL mpi_send( dvfile,ndvtile*ndimtile,mpi_rfreal, &
592  regions(ireg)%procid,ireg, &
593  global%mpiComm,global%mpierr )
594  IF (global%mpierr /= err_none ) THEN
595  CALL errorstop( global,err_mpi_trouble,__line__ )
596  END IF ! global%mpierr
597 
598  ENDIF ! regions(iReg)%procid
599 #endif
600 
601  ELSE ! not the master
602 
603  IF (regions(ireg)%procid == global%myProcid) THEN
604  ALLOCATE( dvfile(ndvtile,ndimtile),stat=errorflag )
605  global%error = errorflag
606  IF (global%error /= err_none) THEN
607  CALL errorstop( global,err_allocate,__line__,'cvFile' )
608  ENDIF !global%error
609 
610 #ifdef MPI
611  CALL mpi_recv( dvfile,ndvtile*ndimtile,mpi_rfreal,&
612  masterproc,ireg, &
613  global%mpiComm,status,global%mpierr )
614  IF (global%mpierr /= err_none) THEN
615  CALL errorstop( global,err_mpi_trouble,__line__ )
616  END IF ! global%mpierr
617 #endif
618  END IF !regions(iReg)%procid
619 
620  END IF !global%myProcid
621 
622 ! --- copy solution into data structure
623 
624  IF (regions(ireg)%procid == global%myProcid) THEN
625  n=0
626  DO i=1, ndimtile
627  n = n+1
628  pdvtile(dv_tile_countdown,i) = dvfile(1,n)
629  pdvtile(dv_tile_diam ,i) = dvfile(2,n)
630  pdvtile(dv_tile_spload ,i) = dvfile(3,n)
631  ENDDO ! i
632  END IF !regions(iReg)%procid
633 
634  IF (ALLOCATED(dvfile)) THEN
635  DEALLOCATE( dvfile,stat=errorflag )
636  global%error = errorflag
637  IF (global%error /= err_none) THEN
638  CALL errorstop( global,err_deallocate,__line__,'dvFile' )
639  ENDIF ! global%error
640  ENDIF ! dvFile
641 
642  END SELECT ! nDimTile
643 
644  END IF ! bcType
645  ENDDO ! iPatch
646  ENDDO ! iReg
647 
648 ! invoke MPI_barrier to insure all processors are insync ----------------------
649 
650 #ifdef MPI
651  CALL mpi_barrier( global%mpiComm,global%mpierr )
652  IF (global%mpierr /= err_none ) THEN
653  CALL errorstop( global,err_mpi_trouble,__line__ )
654  END IF ! global%mpierr
655 #endif
656 
657 ! deallocate fixed-size temporary data arrays ---------------------------------
658 
659  DEALLOCATE( ivar,stat=errorflag )
660  global%error = errorflag
661  IF (global%error /= err_none) THEN
662  CALL errorstop( global,err_deallocate,__line__,'ivar' )
663  END IF ! global%error
664 
665  DEALLOCATE( rvar,stat=errorflag )
666  global%error = errorflag
667  IF (global%error /= err_none) THEN
668  CALL errorstop( global,err_deallocate,__line__,'rvar' )
669  END IF ! global%error
670 
671 ! finalize --------------------------------------------------------------------
672 
673  IF (global%myProcid == masterproc) THEN
674  CLOSE(if_solut,iostat=errorflag)
675  global%error = errorflag
676  IF (global%error /= err_none) &
677  CALL errorstop( global,err_file_close,__line__,'File: '//trim(fname) )
678  ENDIF
679 
680  IF ( global%myProcid == masterproc .AND. &
681  global%verbLevel > verbose_none ) THEN
682  WRITE(stdout,'(A,3X,A)') solver_name,'Reading PLAG solution file done...'
683  END IF ! global%verbLevel
684 
685 999 CONTINUE
686  CALL deregisterfunction( global )
687 
688 1000 FORMAT('Time in file is= ',1pe12.5,' but it should be= ',e12.5,'.')
689 
690 END SUBROUTINE plag_readsolution
691 
692 !******************************************************************************
693 !
694 ! RCS Revision history:
695 !
696 ! $Log: PLAG_ReadSolution.F90,v $
697 ! Revision 1.7 2009/10/26 00:19:32 mtcampbe
698 ! Updates for completion of NATIVE_MP_IO
699 !
700 ! Revision 1.6 2008/12/06 08:44:36 mtcampbe
701 ! Updated license.
702 !
703 ! Revision 1.5 2008/11/19 22:17:48 mtcampbe
704 ! Added Illinois Open Source License/Copyright
705 !
706 ! Revision 1.4 2006/04/07 15:19:24 haselbac
707 ! Removed tabs
708 !
709 ! Revision 1.3 2005/05/31 21:37:32 fnajjar
710 ! Added ARV_PLAG_DISTOT for proper IO capabilities
711 !
712 ! Revision 1.2 2005/02/01 16:46:51 fnajjar
713 ! Added IO informin that solution reading operation is complete
714 !
715 ! Revision 1.1 2004/12/01 20:58:08 fnajjar
716 ! Initial revision after changing case
717 !
718 ! Revision 1.17 2004/06/16 23:07:17 fnajjar
719 ! Renamed variabled for CRE kernel
720 !
721 ! Revision 1.16 2004/04/09 23:15:45 fnajjar
722 ! Added plag status to I/O
723 !
724 ! Revision 1.15 2004/03/05 22:09:03 jferry
725 ! created global variables for peul, plag, and inrt use
726 !
727 ! Revision 1.14 2004/03/05 16:26:42 fnajjar
728 ! Added dv(diam) and dv(spload) from tile datastructure to insure proper restart
729 !
730 ! Revision 1.13 2004/02/13 23:22:07 fnajjar
731 ! Included new cv and aiv definitions for particle burning module
732 !
733 ! Revision 1.12 2003/11/21 22:43:18 fnajjar
734 ! Removed nPclsTot and added nextIdNumber
735 !
736 ! Revision 1.11 2003/05/14 00:41:21 fnajjar
737 ! Moved pointer definitions outside IF statments
738 !
739 ! Revision 1.10 2003/04/09 15:01:29 jferry
740 ! added check that particles are used in some region
741 !
742 ! Revision 1.9 2003/02/25 23:29:29 fnajjar
743 ! Included nTiles check
744 !
745 ! Revision 1.8 2003/02/25 22:49:45 fnajjar
746 ! Bug fix for nCont in reading Tile data
747 !
748 ! Revision 1.7 2003/02/25 22:21:45 fnajjar
749 ! Deallocate temporary arrays
750 !
751 ! Revision 1.6 2003/02/25 22:06:57 fnajjar
752 ! Bug fix for inconsistent pointers
753 !
754 ! Revision 1.5 2003/02/04 19:05:27 f-najjar
755 ! Added ifdef call around MPI_Barrier
756 !
757 ! Revision 1.4 2003/01/24 16:59:35 f-najjar
758 ! Invoke MPI_Bcast for nDimPlag and nDimTile and place MPI_Barrier at routine end
759 !
760 ! Revision 1.3 2002/12/05 16:14:23 f-najjar
761 ! Added dv for time factor in restart file
762 !
763 ! Revision 1.2 2002/12/04 15:37:15 f-najjar
764 ! Included restart capability for Rocpart
765 !
766 ! Revision 1.1 2002/10/25 14:19:16 f-najjar
767 ! Initial Import of Rocpart
768 !
769 !******************************************************************************
770 
771 
772 
773 
774 
775 
776 
plag_readsolution
subroutine plag_readsolution(regions)
Definition: PLAG_ReadSolution.F90:49
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
Attribute::status
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
rflo_readdatafileint
subroutine rflo_readdatafileint(global, fileId, form, nDim1, nDim2, ivar)
Definition: RFLO_ReadDataFile.F90:49
modpartlag::t_tile_plag
Definition: ModPartLag.F90:155
modpartlag::t_plag
Definition: ModPartLag.F90:124
i
blockLoc i
Definition: read.cpp:79
form
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE form
Definition: RFLO_ReadDataFileInt.h:26
n
const NT & n
Definition: rational_rotation.h:72
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
plag_modparameters
Definition: PLAG_ModParameters.F90:44
COM_exception::msg
msg(m)
Definition: roccom_exception.h:64
modbndpatch::t_patch
Definition: ModBndPatch.F90:91
rflo_readdatafilereal
subroutine rflo_readdatafilereal(global, fileId, form, nDim1, nDim2, var)
Definition: RFLO_ReadDataFile.F90:98