Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_WriteSolution.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: write 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_WriteSolution.F90,v 1.6 2009/10/26 00:19:32 mtcampbe Exp $
44 !
45 ! Copyright: (c) 2002 by the University of Illinois
46 !
47 !******************************************************************************
48 
49 SUBROUTINE plag_writesolution( 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_writedatafileint, rflo_writedatafilereal
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, ndimp, ndimt, ndvtile, npcls, nidnumberp
79  INTEGER, ALLOCATABLE, DIMENSION(:) :: ndimplag
80  INTEGER, ALLOCATABLE, DIMENSION(:) :: nextidnumber
81  INTEGER, ALLOCATABLE, DIMENSION(:,:) :: aivfile, ivar
82  INTEGER, POINTER, DIMENSION(:) :: pcvplagmass, pcvtilemass
83  INTEGER, POINTER, DIMENSION(:,:) :: paiv
84 
85  REAL(RFREAL), ALLOCATABLE, DIMENSION(:,:) :: arvfile, cvfile, dvfile, rvar
86  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv, pcv, pcvtile, pdvtile
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_WriteSolution.F90,v $ $Revision: 1.6 $'
96 
97  global => regions(1)%global
98 
99  CALL registerfunction( global,'PLAG_WriteSolution',&
100  'PLAG_WriteSolution.F90' )
101 
102  IF (.NOT. (global%plagUsed .eqv. .true.)) THEN
103  IF (global%myProcid == masterproc) THEN
104  WRITE(stdout,'(A,3X,A)') solver_name,'Warning: PLAG seems to be OFF.'
105  ENDIF
106  goto 999
107  ENDIF
108 
109  IF ( global%myProcid == masterproc .AND. &
110  global%verbLevel > verbose_none ) THEN
111  WRITE(stdout,'(A,3X,A)') solver_name,'Writing PLAG solution file...'
112  END IF ! global%verbLevel
113 
114 ! allocate fixed-size temporary data arrays -----------------------------------
115 
116  ALLOCATE( ivar(3,1),stat=errorflag )
117  global%error = errorflag
118  IF (global%error /= err_none) THEN
119  CALL errorstop( global,err_allocate,__line__,'ivar' )
120  END IF ! global%error
121 
122  ALLOCATE( rvar(1,1),stat=errorflag )
123  global%error = errorflag
124  IF (global%error /= err_none) THEN
125  CALL errorstop( global,err_allocate,__line__,'rvar' )
126  END IF ! global%error
127 
128  ALLOCATE( ndimplag(global%nRegions),stat=errorflag )
129  global%error = errorflag
130  IF (global%error /= err_none) THEN
131  CALL errorstop( global,err_allocate,__line__,'nDimPlag' )
132  END IF ! global%error
133 
134  ALLOCATE( nextidnumber(global%nRegions),stat=errorflag )
135  global%error = errorflag
136  IF (global%error /= err_none) THEN
137  CALL errorstop( global,err_allocate,__line__,'nextIdNumber' )
138  END IF ! global%error
139 
140  ndimplag = 0
141  nextidnumber = 0
142 
143 ! open solution file (only master proc.) --------------------------------------
144 
145  IF (global%myProcid == masterproc) THEN
146 
147  IF (global%solutFormat == format_ascii) THEN
148  WRITE(fname,'(A,1PE11.5)') &
149  trim(global%outDir)//trim(global%casename)//'.plag_sola_',global%currentTime
150  OPEN(if_solut,file=fname,form='formatted',status='unknown',iostat=errorflag)
151  ELSE IF (global%solutFormat == format_binary) THEN
152  WRITE(fname,'(A,1PE11.5)') &
153  trim(global%outDir)//trim(global%casename)//'.plag_solb_', global%currentTime
154  OPEN(if_solut,file=fname,form='unformatted',status='unknown',iostat=errorflag)
155  ENDIF ! global%solutFormat
156 
157  global%error = errorflag
158  IF (global%error /= err_none) THEN
159  CALL errorstop( global,err_file_open,__line__,'File: '//trim(fname) )
160  END IF ! global%error
161 
162  ENDIF ! MASTERPROC
163  rvar(1,1) = global%currentTime
164 
165 ! write current time to file -------------------------------------
166 
167  IF (global%myProcid == masterproc) THEN
168  CALL rflo_writedatafilereal( global,if_solut,global%solutFormat,1,1,rvar )
169  ENDIF
170 
171 ! communicate number of particles to master processor -------------------------
172 ! master receives and writes data, others send them
173 
174  DO ireg=1,global%nRegions
175 
176 ! - get dimensions
177 
178  ilev = regions(ireg)%currLevel
179 
180  IF ( global%myProcid == masterproc ) THEN
181  ndimplag(ireg) = regions(ireg)%levels(ilev)%plag%nPcls
182 
183 #ifdef MPI
184  IF ( regions(ireg)%procid /= masterproc ) THEN
185  CALL mpi_recv( ndimplag(ireg),1,mpi_integer, &
186  regions(ireg)%procid,ireg, &
187  global%mpiComm,status,global%mpierr )
188  IF ( global%mpierr /= err_none ) THEN
189  CALL errorstop( global,err_mpi_trouble,__line__ )
190  ENDIF ! global%mpierr
191  ENDIF ! regions(iReg)%procid
192 #endif
193 
194  ELSE ! not the master
195  ndimp = regions(ireg)%levels(ilev)%plag%nPcls
196 
197 #ifdef MPI
198  IF ( regions(ireg)%procid == global%myProcid ) THEN
199  CALL mpi_send( ndimp,1,mpi_integer,masterproc,ireg, &
200  global%mpiComm,global%mpierr )
201  IF ( global%mpierr /= err_none ) THEN
202  CALL errorstop( global,err_mpi_trouble,__line__ )
203  ENDIF ! global%mpierr
204  ENDIF ! regions(iReg)%procid
205 #endif
206 
207  ENDIF ! global%myProcid
208 
209  END DO !iReg
210 
211 ! broadcast nDimPlag ----------------------------------------------------------
212 
213 #ifdef MPI
214  CALL mpi_bcast( ndimplag,global%nRegions,mpi_integer,masterproc, &
215  global%mpiComm,global%mpierr )
216  IF ( global%mpierr /= err_none ) THEN
217  CALL errorstop( global,err_mpi_trouble,__line__ )
218  END IF ! global%mpierr
219 #endif
220 
221 ! communicate next Id number to master processor ------------------------------
222 ! master receives and writes data, others send them
223 
224  DO ireg=1,global%nRegions
225 
226 ! - get dimensions
227 
228  ilev = regions(ireg)%currLevel
229 
230  IF ( global%myProcid == masterproc ) THEN
231  nextidnumber(ireg) = regions(ireg)%levels(ilev)%plag%nextIdNumber
232 
233 #ifdef MPI
234  IF ( regions(ireg)%procid /= masterproc ) THEN
235  CALL mpi_recv( nextidnumber(ireg),1,mpi_integer, &
236  regions(ireg)%procid,ireg, &
237  global%mpiComm,status,global%mpierr )
238  IF ( global%mpierr /= err_none ) THEN
239  CALL errorstop( global,err_mpi_trouble,__line__ )
240  ENDIF ! global%mpierr
241  ENDIF ! regions(iReg)%procid
242 #endif
243 
244  ELSE ! not the master
245  nidnumberp = regions(ireg)%levels(ilev)%plag%nextIdNumber
246 
247 #ifdef MPI
248  IF ( regions(ireg)%procid == global%myProcid ) THEN
249  CALL mpi_send( nidnumberp,1,mpi_integer,masterproc,ireg, &
250  global%mpiComm,global%mpierr )
251  IF ( global%mpierr /= err_none ) THEN
252  CALL errorstop( global,err_mpi_trouble,__line__ )
253  ENDIF ! global%mpierr
254  ENDIF ! regions(iReg)%procid
255 #endif
256 
257  ENDIF ! global%myProcid
258 
259  END DO !iReg
260 
261 ! broadcast nextIdNumber ------------------------------------------------------
262 
263 #ifdef MPI
264  CALL mpi_bcast( nextidnumber,global%nRegions,mpi_integer,masterproc, &
265  global%mpiComm,global%mpierr )
266  IF ( global%mpierr /= err_none ) THEN
267  CALL errorstop( global,err_mpi_trouble,__line__ )
268  END IF ! global%mpierr
269 #endif
270 
271 ! write PLAG solution data ----------------------------------------------------
272 
273  DO ireg=1,global%nRegions
274 
275 ! - get dimensions ------------------------------------------------------------
276 
277  ilev = regions(ireg)%currLevel
278  ncont = regions(ireg)%plagInput%nCont
279  naiv = aiv_plag_last
280  narv = arv_plag_last
281  ncv = cv_plag_last+ncont
282  ndimp = ndimplag(ireg)
283 
284 ! - set pointers --------------------------------------------------------------
285 
286  pplag => regions(ireg)%levels(ilev)%plag
287  paiv => pplag%aiv
288  parv => pplag%arv
289  pcv => pplag%cv
290  pcvplagmass => pplag%cvPlagMass
291 
292 ! - write region number and dimensions (only master) --------------------------
293 
294  IF ( global%myProcid == masterproc ) THEN
295  ivar(1,1) = ireg
296  ivar(2,1) = ndimplag(ireg)
297  ivar(3,1) = nextidnumber(ireg)
298  CALL rflo_writedatafileint( global,if_solut,global%solutFormat,3,1,ivar )
299  ENDIF ! MASTERPROC
300 
301 ! - activate for number of particles greater than zero ------------------------
302 
303  SELECT CASE (ndimp)
304  CASE (one:)
305 
306 ! -- allocate memory for data field : aivFile ---------------------------------
307 
308  IF ( regions(ireg)%procid == global%myProcid .OR. &
309  global%myProcid==masterproc ) THEN
310  ALLOCATE( aivfile(naiv,ndimp),stat=errorflag )
311  global%error = errorflag
312  IF (global%error /= err_none) THEN
313  CALL errorstop( global,err_allocate,__line__,'aivFile' )
314  ENDIF ! global%error
315  ENDIF
316 
317 ! -- copy solution into data structure ----------------------------------------
318 
319  IF ( regions(ireg)%procid == global%myProcid ) THEN
320  n=0
321  DO i=1, ndimp
322  n = n+1
323  aivfile(1,n) = paiv(aiv_plag_pidini,i)
324  aivfile(2,n) = paiv(aiv_plag_regini,i)
325  aivfile(3,n) = paiv(aiv_plag_regcrt,i)
326  aivfile(4,n) = paiv(aiv_plag_icells,i)
327  aivfile(5,n) = paiv(aiv_plag_indexi,i)
328  aivfile(6,n) = paiv(aiv_plag_indexj,i)
329  aivfile(7,n) = paiv(aiv_plag_indexk,i)
330  aivfile(8,n) = paiv(aiv_plag_burnstat,i)
331  aivfile(9,n) = paiv(aiv_plag_status,i)
332  ENDDO ! i
333  END IF !regions(iReg)%procid
334 
335 ! -- master receives and writes data, others send them ------------------------
336 
337  IF ( global%myProcid == masterproc ) THEN
338 #ifdef MPI
339  IF ( regions(ireg)%procid /= masterproc ) THEN
340  CALL mpi_recv( aivfile,naiv*ndimp,mpi_integer, &
341  regions(ireg)%procid,ireg, &
342  global%mpiComm,status,global%mpierr )
343  IF ( global%mpierr /= err_none ) THEN
344  CALL errorstop( global,err_mpi_trouble,__line__ )
345  ENDIF ! global%mpierr
346  ENDIF ! regions(iReg)%procid
347 #endif
348  CALL rflo_writedatafileint( global,if_solut,global%solutFormat, &
349  naiv,ndimp,aivfile )
350 
351  ELSE ! not the master
352 #ifdef MPI
353  IF (regions(ireg)%procid == global%myProcid) THEN
354  CALL mpi_send( aivfile,naiv*ndimp,mpi_integer,masterproc,ireg, &
355  global%mpiComm,global%mpierr )
356  IF ( global%mpierr /= err_none ) THEN
357  CALL errorstop( global,err_mpi_trouble,__line__ )
358  ENDIF ! global%mpierr
359  ENDIF ! regions(iReg)%procid
360 #endif
361  ENDIF ! global%myProcid
362 
363 ! -- deallocate memory for data field : aivFile -------------------------------
364 
365  IF ( ALLOCATED(aivfile) ) THEN
366  DEALLOCATE( aivfile,stat=errorflag )
367  global%error = errorflag
368  IF ( global%error /= err_none ) THEN
369  CALL errorstop( global,err_deallocate,__line__,'aivFile' )
370  ENDIF ! global%error
371  ENDIF ! aivFile
372 
373 ! -- allocate memory for data field : arvFile ---------------------------------
374 
375  IF ( regions(ireg)%procid == global%myProcid .OR. &
376  global%myProcid==masterproc ) THEN
377  ALLOCATE( arvfile(narv,ndimp),stat=errorflag )
378  global%error = errorflag
379  IF ( global%error /= err_none ) THEN
380  CALL errorstop( global,err_allocate,__line__,'arvFile' )
381  ENDIF ! global%error
382  ENDIF ! regions(iReg)%procid
383 
384 ! -- copy solution into data structure ----------------------------------------
385 
386  IF ( regions(ireg)%procid == global%myProcid ) THEN
387  n=0
388  DO i=1, ndimp
389  n = n+1
390  arvfile(1,n) = parv(arv_plag_spload,i)
391  arvfile(2,n) = parv(arv_plag_distot,i)
392  ENDDO ! i
393  ENDIF ! regions(iReg)%procid
394 
395 ! -- master receives and writes data, others send them ------------------------
396 
397  IF ( global%myProcid == masterproc ) THEN
398 #ifdef MPI
399  IF ( regions(ireg)%procid /= masterproc ) THEN
400  CALL mpi_recv( arvfile,narv*ndimp,mpi_rfreal, &
401  regions(ireg)%procid,ireg, &
402  global%mpiComm,status,global%mpierr )
403  IF ( global%mpierr /= err_none ) THEN
404  CALL errorstop( global,err_mpi_trouble,__line__ )
405  ENDIF ! global%mpierr
406  ENDIF ! regions(iReg)%procid
407 #endif
408  CALL rflo_writedatafilereal( global,if_solut,global%solutFormat, &
409  narv,ndimp,arvfile )
410 
411  ELSE ! not the master
412 #ifdef MPI
413  IF ( regions(ireg)%procid == global%myProcid ) THEN
414  CALL mpi_send( arvfile,narv*ndimp,mpi_rfreal,masterproc,ireg, &
415  global%mpiComm,global%mpierr )
416  IF ( global%mpierr /= err_none ) THEN
417  CALL errorstop( global,err_mpi_trouble,__line__ )
418  ENDIF ! global%mpierr
419  ENDIF ! regions(iReg)%procid
420 #endif
421  ENDIF ! global%myProcid
422 
423 ! -- deallocate memory for data field : arvFile -------------------------------
424 
425  IF ( ALLOCATED(arvfile) ) THEN
426  DEALLOCATE( arvfile,stat=errorflag )
427  global%error = errorflag
428  IF (global%error /= err_none) THEN
429  CALL errorstop( global,err_deallocate,__line__,'arvFile' )
430  ENDIF ! global%error
431  ENDIF ! arvFile
432 
433 ! -- allocate memory for data field : cvFile ----------------------------------
434 
435  IF ( regions(ireg)%procid == global%myProcid .OR. &
436  global%myProcid==masterproc ) THEN
437  ALLOCATE( cvfile(ncv,ndimp),stat=errorflag )
438  global%error = errorflag
439  IF ( global%error /= err_none ) THEN
440  CALL errorstop( global,err_allocate,__line__,'cvFile' )
441  ENDIF ! global%error
442  ENDIF ! regions(iReg)%procid
443 
444 ! -- copy solution into data structure ----------------------------------------
445 
446  IF ( regions(ireg)%procid == global%myProcid ) THEN
447  n=0
448  DO i=1, ndimp
449  n = n+1
450  cvfile(1,n) = pcv(cv_plag_xmom,i)
451  cvfile(2,n) = pcv(cv_plag_ymom,i)
452  cvfile(3,n) = pcv(cv_plag_zmom,i)
453  cvfile(4,n) = pcv(cv_plag_ener,i)
454  cvfile(5,n) = pcv(cv_plag_xpos,i)
455  cvfile(6,n) = pcv(cv_plag_ypos,i)
456  cvfile(7,n) = pcv(cv_plag_zpos,i)
457  cvfile(8,n) = pcv(cv_plag_enervapor,i)
458  DO icont = 1, ncont
459  cvfile(cv_plag_last+icont,n) = pcv(pcvplagmass(icont),i)
460  ENDDO ! iCont
461  ENDDO ! i
462  ENDIF !regions(iReg)%procid
463 
464 ! -- master receives and writes data, others send them ------------------------
465 
466  IF ( global%myProcid == masterproc ) THEN
467 #ifdef MPI
468  IF ( regions(ireg)%procid /= masterproc ) THEN
469  CALL mpi_recv( cvfile,ncv*ndimp,mpi_rfreal, &
470  regions(ireg)%procid,ireg, &
471  global%mpiComm,status,global%mpierr )
472  IF ( global%mpierr /= err_none ) THEN
473  CALL errorstop( global,err_mpi_trouble,__line__ )
474  ENDIF ! global%mpierr
475  ENDIF ! regions(iReg)%procid
476 #endif
477  CALL rflo_writedatafilereal( global,if_solut,global%solutFormat, &
478  ncv,ndimp,cvfile )
479 
480  ELSE ! not the master
481 #ifdef MPI
482  IF ( regions(ireg)%procid == global%myProcid ) THEN
483  CALL mpi_send( cvfile,ncv*ndimp,mpi_rfreal,masterproc,ireg, &
484  global%mpiComm,global%mpierr )
485  IF ( global%mpierr /= err_none ) THEN
486  CALL errorstop( global,err_mpi_trouble,__line__ )
487  ENDIF ! global%mpierr
488  ENDIF ! regions(iReg)%procid
489 #endif
490  ENDIF ! global%myProcid
491 
492 ! -- deallocate memory for data field : cvFile --------------------------------
493 
494  IF ( ALLOCATED(cvfile) ) THEN
495  DEALLOCATE( cvfile,stat=errorflag )
496  global%error = errorflag
497  IF ( global%error /= err_none ) THEN
498  CALL errorstop( global,err_deallocate,__line__,'cvFile' )
499  ENDIF ! global%error
500  ENDIF ! cvFile
501 
502  END SELECT ! nDimP
503  END DO !iReg
504 
505 ! write tile solution data ----------------------------------------------------
506 
507  DO ireg=1,global%nRegions
508 
509 ! - get dimensions ------------------------------------------------------------
510 
511  ilev = regions(ireg)%currLevel
512  ncvtile = cv_tile_last+ncont
513  ndvtile = 3
514 
515 ! - loop over all patches -----------------------------------------------------
516 
517  DO ipatch=1,regions(ireg)%nPatches
518  ppatch => regions(ireg)%levels(ilev)%patches(ipatch)
519  bctype = ppatch%bcType
520 
521  IF ( bctype>=bc_injection .AND. bctype<=bc_injection+bc_range ) THEN
522 
523 ! -- get tile dimensions ------------------------------------------------------
524 
525  n1 = abs(ppatch%l1end -ppatch%l1beg ) + 1
526  n2 = abs(ppatch%l2end -ppatch%l2beg ) + 1
527  ndimt = n1*n2
528 
529 ! -- set pointers -------------------------------------------------------------
530 
531  ptileplag => ppatch%tilePlag
532  pcvtile => ptileplag%cv
533  pcvtilemass => ptileplag%cvTileMass
534  pdvtile => ptileplag%dv
535 
536 ! -- write region number and dimensions (only master) -------------------------
537 
538  IF ( global%myProcid == masterproc ) THEN
539  ivar(1,1) = ireg
540  ivar(2,1) = ndimt
541  CALL rflo_writedatafileint( global,if_solut,global%solutFormat, &
542  2,1,ivar )
543  ENDIF ! global%myProcid
544 
545 ! -- activate for number of tiles greater than zero ---------------------------
546 
547  SELECT CASE (ndimt)
548  CASE (one:)
549 
550 ! --- allocate memory for data field : cvFile ---------------------------------
551 
552  IF ( regions(ireg)%procid == global%myProcid .OR. &
553  global%myProcid==masterproc ) THEN
554  ALLOCATE( cvfile(ncvtile,ndimt),stat=errorflag )
555  global%error = errorflag
556  IF ( global%error /= err_none ) THEN
557  CALL errorstop( global,err_allocate,__line__,'cvFile' )
558  ENDIF ! global%error
559  ENDIF ! regions(iReg)%procid
560 
561 ! --- copy solution into file data structure ----------------------------------
562 
563  IF ( regions(ireg)%procid == global%myProcid ) THEN
564  n=0
565  DO i=1, ndimt
566  n = n+1
567  cvfile(1,n) = pcvtile(cv_tile_momnrm,i)
568  cvfile(2,n) = pcvtile(cv_tile_ener, i)
569  DO icont = 1, ncont
570  cvfile(2+icont,n) = pcvtile(pcvtilemass(icont),i)
571  ENDDO ! iCont
572  ENDDO ! i
573  END IF !regions(iReg)%procid
574 
575 ! --- master receives and writes data, others send them -----------------------
576 
577  IF ( global%myProcid == masterproc ) THEN
578 #ifdef MPI
579  IF ( regions(ireg)%procid /= masterproc ) THEN
580  CALL mpi_recv( cvfile,ncvtile*ndimt,mpi_rfreal, &
581  regions(ireg)%procid,ireg, &
582  global%mpiComm,status,global%mpierr )
583  IF ( global%mpierr /= err_none ) THEN
584  CALL errorstop( global,err_mpi_trouble,__line__ )
585  ENDIF ! global%mpierr
586  ENDIF ! regions(iReg)%procid
587 #endif
588  CALL rflo_writedatafilereal( global,if_solut,global%solutFormat, &
589  ncvtile,ndimt,cvfile )
590 
591  ELSE ! not the master
592 #ifdef MPI
593  IF ( regions(ireg)%procid == global%myProcid ) THEN
594  CALL mpi_send( cvfile,ncvtile*ndimt,mpi_rfreal,masterproc,ireg, &
595  global%mpiComm,global%mpierr )
596  IF ( global%mpierr /= err_none ) THEN
597  CALL errorstop( global,err_mpi_trouble,__line__ )
598  ENDIF ! global%mpierr
599  ENDIF ! regions(iReg)%procid
600 #endif
601  ENDIF ! global%myProcid
602 
603 ! --- deallocate memory for data field : cvFile -------------------------------
604 
605  IF ( ALLOCATED(cvfile) ) THEN
606  DEALLOCATE( cvfile,stat=errorflag )
607  global%error = errorflag
608  IF ( global%error /= err_none ) THEN
609  CALL errorstop( global,err_deallocate,__line__,'cvFile' )
610  ENDIF ! global%error
611  ENDIF ! cvFile
612 
613 ! --- allocate memory for data field : dvFile ---------------------------------
614 
615  IF ( regions(ireg)%procid == global%myProcid .OR. &
616  global%myProcid==masterproc ) THEN
617  ALLOCATE( dvfile(ndvtile,ndimt),stat=errorflag )
618  global%error = errorflag
619  IF ( global%error /= err_none ) THEN
620  CALL errorstop( global,err_allocate,__line__,'cvFile' )
621  ENDIF ! global%error
622  ENDIF ! regions(iReg)%procid
623 
624 ! --- copy solution into file data structure ----------------------------------
625 
626  IF ( regions(ireg)%procid == global%myProcid ) THEN
627  n=0
628  DO i=1, ndimt
629  n = n+1
630  dvfile(1,n) = pdvtile(dv_tile_countdown,i)
631  dvfile(2,n) = pdvtile(dv_tile_diam ,i)
632  dvfile(3,n) = pdvtile(dv_tile_spload ,i)
633  ENDDO ! i
634  ENDIF !regions(iReg)%procid
635 
636 ! --- master receives and writes data, others send them -----------------------
637 
638  IF ( global%myProcid == masterproc ) THEN
639 #ifdef MPI
640  IF ( regions(ireg)%procid /= masterproc ) THEN
641  CALL mpi_recv( dvfile,ndvtile*ndimt,mpi_rfreal, &
642  regions(ireg)%procid,ireg, &
643  global%mpiComm,status,global%mpierr )
644  IF ( global%mpierr /= err_none ) THEN
645  CALL errorstop( global,err_mpi_trouble,__line__ )
646  ENDIF ! global%mpierr
647  ENDIF ! regions(iReg)%procid
648 #endif
649  CALL rflo_writedatafilereal( global,if_solut,global%solutFormat, &
650  ndvtile,ndimt,dvfile )
651 
652  ELSE ! not the master
653 #ifdef MPI
654  IF ( regions(ireg)%procid == global%myProcid ) THEN
655  CALL mpi_send( dvfile,ndvtile*ndimt,mpi_rfreal,masterproc,ireg, &
656  global%mpiComm,global%mpierr )
657  IF ( global%mpierr /= err_none ) THEN
658  CALL errorstop( global,err_mpi_trouble,__line__ )
659  ENDIF ! global%mpierr
660  ENDIF ! regions(iReg)%procid
661 #endif
662  ENDIF ! global%myProcid
663 
664 ! --- deallocate memory for data field : dvFile -------------------------------
665 
666  IF ( ALLOCATED(dvfile) ) THEN
667  DEALLOCATE( dvfile,stat=errorflag )
668  global%error = errorflag
669  IF ( global%error /= err_none ) THEN
670  CALL errorstop( global,err_deallocate,__line__,'dvFile' )
671  ENDIF ! global%error
672  ENDIF ! dvFile
673 
674  END SELECT ! nDimT
675  ENDIF ! bcType
676  ENDDO ! iPatch
677 
678  ENDDO ! iReg
679 
680 ! deallocate fixed-size temporary data arrays ---------------------------------
681 
682  DEALLOCATE( ivar,stat=errorflag )
683  global%error = errorflag
684  IF (global%error /= err_none) THEN
685  CALL errorstop( global,err_deallocate,__line__,'ivar' )
686  END IF ! global%error
687 
688  DEALLOCATE( rvar,stat=errorflag )
689  global%error = errorflag
690  IF (global%error /= err_none) THEN
691  CALL errorstop( global,err_deallocate,__line__,'rvar' )
692  END IF ! global%error
693 
694  DEALLOCATE( ndimplag,stat=errorflag )
695  global%error = errorflag
696  IF (global%error /= err_none) THEN
697  CALL errorstop( global,err_deallocate,__line__,'nDimPlag' )
698  END IF ! global%error
699 
700 ! finalize --------------------------------------------------------------------
701 
702  IF (global%myProcid == masterproc) THEN
703  CLOSE(if_solut,iostat=errorflag)
704  global%error = errorflag
705  IF (global%error /= err_none) &
706  CALL errorstop( global,err_file_close,__line__,'File: '//trim(fname) )
707  ENDIF
708 
709 999 CONTINUE
710  CALL deregisterfunction( global )
711 
712 END SUBROUTINE plag_writesolution
713 
714 !******************************************************************************
715 !
716 ! RCS Revision history:
717 !
718 ! $Log: PLAG_WriteSolution.F90,v $
719 ! Revision 1.6 2009/10/26 00:19:32 mtcampbe
720 ! Updates for completion of NATIVE_MP_IO
721 !
722 ! Revision 1.5 2008/12/06 08:44:36 mtcampbe
723 ! Updated license.
724 !
725 ! Revision 1.4 2008/11/19 22:17:48 mtcampbe
726 ! Added Illinois Open Source License/Copyright
727 !
728 ! Revision 1.3 2006/04/07 15:19:24 haselbac
729 ! Removed tabs
730 !
731 ! Revision 1.2 2005/05/31 21:37:32 fnajjar
732 ! Added ARV_PLAG_DISTOT for proper IO capabilities
733 !
734 ! Revision 1.1 2004/12/01 20:58:22 fnajjar
735 ! Initial revision after changing case
736 !
737 ! Revision 1.13 2004/06/16 23:07:18 fnajjar
738 ! Renamed variabled for CRE kernel
739 !
740 ! Revision 1.12 2004/04/09 23:15:45 fnajjar
741 ! Added plag status to I/O
742 !
743 ! Revision 1.11 2004/03/05 22:09:04 jferry
744 ! created global variables for peul, plag, and inrt use
745 !
746 ! Revision 1.10 2004/03/05 16:26:42 fnajjar
747 ! Added dv(diam) and dv(spload) from tile datastructure to insure proper restart
748 !
749 ! Revision 1.9 2004/02/14 21:29:01 fnajjar
750 ! Bug fix for cvFile with incorrect index
751 !
752 ! Revision 1.8 2004/02/13 23:22:07 fnajjar
753 ! Included new cv and aiv definitions for particle burning module
754 !
755 ! Revision 1.7 2003/11/21 22:43:18 fnajjar
756 ! Removed nPclsTot and added nextIdNumber
757 !
758 ! Revision 1.6 2003/05/14 00:41:21 fnajjar
759 ! Moved pointer definitions outside IF statments
760 !
761 ! Revision 1.5 2003/04/14 16:31:05 jferry
762 ! added check that particles are used in some region
763 !
764 ! Revision 1.4 2003/02/25 20:16:46 fnajjar
765 ! Complete rewrite for proper IO capability
766 !
767 ! Revision 1.3 2002/12/05 16:14:23 f-najjar
768 ! Added dv for time factor in restart file
769 !
770 ! Revision 1.2 2002/12/04 15:37:15 f-najjar
771 ! Included restart capability for Rocpart
772 !
773 ! Revision 1.1 2002/10/25 14:20:32 f-najjar
774 ! Initial Import of Rocpart
775 !
776 !
777 !******************************************************************************
778 
779 
780 
781 
782 
783 
784 
rflo_writedatafileint
subroutine rflo_writedatafileint(global, fileId, form, nDim1, nDim2, ivar)
Definition: RFLO_WriteDataFile.F90:50
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
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
plag_writesolution
subroutine plag_writesolution(regions)
Definition: PLAG_WriteSolution.F90:49
rflo_writedatafilereal
subroutine rflo_writedatafilereal(global, fileId, form, nDim1, nDim2, var)
Definition: RFLO_WriteDataFile.F90:99
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