Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLO_InitGenxInterface.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: register grid and flow variables with GenX.
26 !
27 ! Description: none.
28 !
29 ! Input: regions = dimensions of boundary patches, types of BC`s
30 ! handle, solver = GenX stuff.
31 !
32 ! Output: to Roccom.
33 !
34 ! Notes: none.
35 !
36 !******************************************************************************
37 !
38 ! $Id: RFLO_InitGenxInterface.F90,v 1.31 2010/02/18 21:47:38 juzhang Exp $
39 !
40 ! Copyright: (c) 2002 by the University of Illinois
41 !
42 !******************************************************************************
43 
44 SUBROUTINE rflo_initgenxinterface( regions,handle,solver,inSurf,inVolPlag, &
46 
47  USE moddatatypes
48  USE modglobal, ONLY : t_global
49  USE modbndpatch, ONLY : t_patch
50  USE moddatastruct, ONLY : t_region
52 #ifdef PEUL
54 #endif
55 #ifdef PLAG
57 #endif
58 #ifdef RADI
60 #endif
61 #ifdef TURB
63 #endif
65  USE moderror
66  USE modparameters
67  USE modmpi
68 
69  IMPLICIT NONE
70  include 'roccomf90.h'
71 
72 ! ... parameters
73  CHARACTER(*) :: insurf, involplag
74  INTEGER, INTENT(IN) :: handle, solver, obtain_attribute
75 
76  TYPE(t_region), POINTER :: regions(:)
77 
78 ! ... loop variables
79  INTEGER :: ireg, ipatch
80 
81 ! ... local variables
82  CHARACTER(CHRLEN) :: wins, winv, invol
83 #ifdef PLAG
84  CHARACTER(CHRLEN) :: inplag
85 #endif
86 #ifdef STATS
87  CHARACTER(CHRLEN), POINTER :: statnm(:,:,:)
88  INTEGER :: istat
89 #endif
90  INTEGER :: ilev, bctype, pid, icount, errorflag, ilb, mpierr
91  INTEGER :: idnbeg, idnend, jdnbeg, jdnend, kdnbeg, kdnend, iproc
92  INTEGER, POINTER :: dims(:), iconstrtype
93  LOGICAL :: fileexist
94 
95  TYPE(t_global), POINTER :: global
96  TYPE(t_patch) , POINTER :: patch
97 
98 !******************************************************************************
99 
100  global => regions(1)%global
101 
102  CALL registerfunction( global,'RFLO_InitGenxInterface',&
103  'RFLO_InitGenxInterface.F90' )
104 
105 ! open data windows and register variables ------------------------------------
106 
107  wins = trim(global%winName)//'_surf'
108  winv = trim(global%winName)//'_vol'
109 
110 #ifdef PLAG
111 ! obtain names of inVol and inPlag
112  READ (involplag, *) invol, inplag
113 #else
114  READ (involplag, *) invol
115 #endif
116 
117  CALL mpi_barrier(mpi_comm_world,mpierr)
118  IF ( regions(1)%global%myProcid == masterproc .AND. &
119  regions(1)%global%verbLevel>= verbose_high ) THEN
120  WRITE(stdout,'(A,1X,A)') solver_name,'Creating Rocstar surface windows'
121  ENDIF
122 
123  CALL com_new_window( trim(wins) )
124 
125  CALL mpi_barrier(mpi_comm_world,mpierr)
126  IF ( regions(1)%global%myProcid == masterproc .AND. &
127  regions(1)%global%verbLevel>= verbose_high ) THEN
128  WRITE(stdout,'(A,1X,A)') solver_name,'Creating Rocstar surface input attributes'
129  ENDIF
130 ! input data
131 
132  CALL com_new_attribute( trim(wins)//'.du_alp' ,'n',com_double,3, &
133  'm' )
134  CALL com_new_attribute( trim(wins)//'.mdot_alp' ,'e',com_double,1, &
135  'kg/(m^2s)' )
136  CALL com_new_attribute( trim(wins)//'.rhofvf_alp','e',com_double,3, &
137  'kg/(m^2s)' )
138  CALL com_new_attribute( trim(wins)//'.Tflm_alp' ,'e',com_double,1, &
139  'K' )
140 
141  CALL mpi_barrier(mpi_comm_world,mpierr)
142  IF ( regions(1)%global%myProcid == masterproc .AND. &
143  regions(1)%global%verbLevel>= verbose_high ) THEN
144  WRITE(stdout,'(A,1X,A)') solver_name,'Creating Rocstar surface output attributes'
145  ENDIF
146 ! output data
147 
148  CALL com_new_attribute( trim(wins)//'.pf' ,'e',com_double,1, &
149  'Pa' )
150  CALL com_new_attribute( trim(wins)//'.qc' ,'e',com_double,1, &
151  'kgK/(m^2s)' )
152  CALL com_new_attribute( trim(wins)//'.qr' ,'e',com_double,1, &
153  'kgK/(m^2s)' )
154  CALL com_new_attribute( trim(wins)//'.rhof_alp','e',com_double,1, &
155  'kg/m^3' )
156  CALL com_new_attribute( trim(wins)//'.nf_alp' ,'e',com_double,3, &
157  '' )
158  CALL com_new_attribute( trim(wins)//'.tf' ,'e',com_double,3, &
159  'Pa' )
160  CALL com_new_attribute( trim(wins)//'.Tf' ,'e',com_double,1, &
161  'K' )
162  CALL com_new_attribute( trim(wins)//'.Tv' ,'e',com_double,1, &
163  'K' )
164  CALL com_new_attribute( trim(wins)//'.dn' ,'e',com_double,1, &
165  'm' )
166  CALL com_new_attribute( trim(wins)//'.bflag' ,'e',com_integer,1,'' )
167 
168  CALL com_new_attribute( trim(wins)//'.bcflag' ,'p',com_integer,1,'' )
169 
170  CALL com_new_attribute( trim(wins)//'.cnstr_type','p',com_integer,1,'' )
171 
172 ! restart data (si/j/kvel, cv) and additional plot data (dv=p, T, c)
173 
174  CALL mpi_barrier(mpi_comm_world,mpierr)
175  IF ( regions(1)%global%myProcid == masterproc .AND. &
176  regions(1)%global%verbLevel>= verbose_high ) THEN
177  WRITE(stdout,'(A,1X,A)') solver_name,'Creating Rocstar volume windows'
178  ENDIF
179 
180  CALL com_new_window( trim(winv) )
181 
182  CALL com_new_attribute( trim(winv)//'.siVel','n' ,com_double,1,'m/s' )
183  CALL com_new_attribute( trim(winv)//'.sjVel','n' ,com_double,1,'m/s' )
184  CALL com_new_attribute( trim(winv)//'.skVel','n' ,com_double,1,'m/s' )
185 
186  CALL com_new_attribute( trim(winv)//'.dtf','e',com_double,1,'s' )
187 
188  CALL com_new_attribute( trim(winv)//'.rhof' ,'e',com_double,1,&
189  'kg/(m^3)')
190  CALL com_new_attribute( trim(winv)//'.rhovf','e',com_double,3,&
191  'kg/(m^2 s)')
192  CALL com_new_attribute( trim(winv)//'.rhoEf','e',com_double,1,&
193  '(J/kg)')
194 
195  CALL com_new_attribute( trim(winv)//'.vf','e',com_double,3,'m/s' )
196  CALL com_new_attribute( trim(winv)//'.Tf','e',com_double,1,'K' )
197  CALL com_new_attribute( trim(winv)//'.pf','e',com_double,1,'Pa' )
198  CALL com_new_attribute( trim(winv)//'.Tv','e',com_double,1,'K' )
199  CALL com_new_attribute( trim(winv)//'.dn','e',com_double,1,'m' )
200  CALL com_new_attribute( trim(winv)//'.af','e',com_double,1,'m/s' )
201 
202  CALL mpi_barrier(mpi_comm_world,mpierr)
203  IF ( regions(1)%global%myProcid == masterproc .AND. &
204  regions(1)%global%verbLevel>= verbose_high ) THEN
205  WRITE(stdout,'(A,1X,A)') solver_name,'Main windows created.'
206  ENDIF
207 
208 ! statistics
209 
210 #ifdef STATS
211  CALL mpi_barrier(mpi_comm_world,mpierr)
212  IF ( regions(1)%global%myProcid == masterproc .AND. &
213  regions(1)%global%verbLevel>= verbose_high ) THEN
214  WRITE(stdout,'(A,1X,A)') solver_name,'Adding statistics attributes'
215  ENDIF
216 
217  IF ((global%flowType == flow_unsteady) .AND. (global%doStat == active)) THEN
218 
219 ! - stats global data
220  CALL com_new_attribute( trim(winv)//'.tStat','w',com_double,1,'s' )
221 
222  IF (global%mixtNStat > 0) THEN
223  statnm => global%mixtStatNm
224  DO istat=1,global%mixtNStat
225  CALL com_new_attribute( trim(winv)//'.'//trim(statnm(1,1,istat)),'e', &
226  com_double,1,trim(statnm(1,2,istat)) )
227  ENDDO
228  ENDIF
229  CALL com_set_array( trim(winv)//'.tStat',0, global%integrTime )
230 
231  ENDIF ! unsteady and dostat
232 #endif
233 
234 ! store pointers to variables -------------------------------------------------
235 
236  ALLOCATE( dims(3),stat=errorflag )
237  global%error = errorflag
238  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
239 
240 ! loop over all regions
241 
242  CALL mpi_barrier(mpi_comm_world,mpierr)
243  IF ( regions(1)%global%myProcid == masterproc .AND. &
244  regions(1)%global%verbLevel>= verbose_high ) THEN
245  WRITE(stdout,'(A,1X,A)') solver_name,'Processing Rocstar surface windows'
246  ENDIF
247 
248  DO ireg=1,global%nRegions
249  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
250  regions(ireg)%active==active) THEN ! on my processor
251 
252  ilev = regions(ireg)%currLevel
253  icount = 0
254 
255 ! --- surface data
256 
257  DO ipatch=1,regions(ireg)%nPatches
258  patch => regions(ireg)%levels(ilev)%patches(ipatch)
259  bctype = patch%bcType
260 ! WRITE(*,*) 'doing patch with bc ',bcType
261 ! IF(bcType .NE. BC_SYMMETRY) THEN
262  IF ( patch%bcCoupled == bc_external .OR. & ! data from outside
263  (patch%bcCoupled == bc_internal .AND. & ! data from internal APN
264  bctype == bc_injection_apn)) THEN
265  icount = icount + 1
266  pid = ireg*regoff + icount
267 ! WRITE(*,*) ' external bc on patch '
268 ! ------- burning pane?
269 
270  ALLOCATE( patch%bcFlag(1),stat=errorflag )
271  global%error = errorflag
272  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
273 
274  CALL com_set_size(trim(wins)//'.bcflag',pid,1)
275  CALL com_set_array( trim(wins)//'.bcflag',pid,patch%bcFlag )
276 
277  IF (bctype>=bc_injection .AND. bctype<=bc_injection+bc_range) THEN
278  patch%bcFlag(1) = 1 ! ignitable patch
279  ELSE
280  patch%bcFlag(1) = 0 ! non-ignitable patch
281  ENDIF
282 
283 ! ------- surface grid
284 
285  dims(1) = abs(patch%l1end-patch%l1beg) + 2 ! nodal values
286  dims(2) = abs(patch%l2end-patch%l2beg) + 2
287 
288  ALLOCATE( patch%surfCoord(3,dims(1),dims(2)),stat=errorflag )
289  global%error = errorflag
290  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
291 
292  CALL com_set_array_const( trim(wins)//'.:st2:',pid,dims )
293  CALL com_set_array( trim(wins)//'.nc',pid,patch%surfCoord )
294 
295 ! ------- input data
296 
297  dims(1) = abs(patch%l1end-patch%l1beg) + 2 ! nodal values
298  dims(2) = abs(patch%l2end-patch%l2beg) + 2
299  ALLOCATE( patch%duAlp(3,dims(1),dims(2)),stat=errorflag )
300  global%error = errorflag
301  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
302 
303  CALL com_set_array( trim(wins)//'.du_alp',pid,patch%duAlp )
304 
305  dims(1) = abs(patch%l1end-patch%l1beg) + 1 ! cell values
306  dims(2) = abs(patch%l2end-patch%l2beg) + 1
307  ALLOCATE( patch%mdotAlp ( dims(1),dims(2)),stat=errorflag )
308  ALLOCATE( patch%rhofvfAlp(3,dims(1),dims(2)),stat=errorflag )
309  ALLOCATE( patch%tflmAlp ( dims(1),dims(2)),stat=errorflag )
310  global%error = errorflag
311  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
312 
313  CALL com_set_array( trim(wins)//'.mdot_alp' ,pid,patch%mdotAlp )
314  CALL com_set_array( trim(wins)//'.rhofvf_alp',pid,patch%rhofvfAlp )
315  CALL com_set_array( trim(wins)//'.Tflm_alp' ,pid,patch%tflmAlp )
316 
317 ! ------- output data
318 
319  dims(1) = abs(patch%l1end-patch%l1beg) + 1 ! cell values
320  dims(2) = abs(patch%l2end-patch%l2beg) + 1
321  ALLOCATE( patch%pf ( dims(1),dims(2)),stat=errorflag )
322  ALLOCATE( patch%qc ( dims(1),dims(2)),stat=errorflag )
323  ALLOCATE( patch%qr ( dims(1),dims(2)),stat=errorflag )
324  ALLOCATE( patch%rhofAlp( dims(1),dims(2)),stat=errorflag )
325  ALLOCATE( patch%tempf ( dims(1),dims(2)),stat=errorflag )
326  ALLOCATE( patch%tempv ( dims(1),dims(2)),stat=errorflag )
327  ALLOCATE( patch%dnml ( dims(1),dims(2)),stat=errorflag )
328  ALLOCATE( patch%nfAlp (3,dims(1),dims(2)),stat=errorflag )
329  ALLOCATE( patch%tracf (3,dims(1),dims(2)),stat=errorflag )
330  ALLOCATE( patch%bFlag ( dims(1),dims(2)),stat=errorflag )
331  global%error = errorflag
332  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
333 
334  CALL com_set_array( trim(wins)//'.pf' ,pid,patch%pf )
335  CALL com_set_array( trim(wins)//'.qc' ,pid,patch%qc )
336  CALL com_set_array( trim(wins)//'.qr' ,pid,patch%qr )
337  CALL com_set_array( trim(wins)//'.rhof_alp',pid,patch%rhofAlp )
338  CALL com_set_array( trim(wins)//'.nf_alp' ,pid,patch%nfAlp )
339  CALL com_set_array( trim(wins)//'.tf' ,pid,patch%tracf )
340  CALL com_set_array( trim(wins)//'.Tf' ,pid,patch%tempf )
341  CALL com_set_array( trim(wins)//'.Tv' ,pid,patch%tempv )
342  CALL com_set_array( trim(wins)//'.dn' ,pid,patch%dnml )
343  CALL com_set_array( trim(wins)//'.bflag' ,pid,patch%bFlag )
344 
345 ! ------- constraint type
346 
347  CALL com_set_size(trim(wins)//'.cnstr_type',pid,1)
348  CALL com_allocate_array( trim(wins)//'.cnstr_type',pid,iconstrtype )
349 
350  iconstrtype = 0
351  IF (bctype==bc_symmetry_free) THEN
352  iconstrtype = 0
353  ELSEIF (bctype==bc_symmetry_fixed) THEN
354  iconstrtype = 2
355  ELSEIF (bctype==bc_symmetry_xslide) THEN
356  iconstrtype = 120
357  ELSEIF (bctype==bc_symmetry_yslide) THEN
358  iconstrtype = 121
359  ELSEIF (bctype==bc_symmetry_zslide) THEN
360  iconstrtype = 122
361  ELSEIF (bctype==bc_symmetry_xyslide) THEN
362  iconstrtype = -122
363  ELSEIF (bctype==bc_symmetry_xzslide) THEN
364  iconstrtype = -121
365  ELSEIF (bctype==bc_symmetry_yzslide) THEN
366  iconstrtype = -120
367  ENDIF
368  IF (bctype==bc_slipwall_free) THEN
369  iconstrtype = 0
370  ELSEIF (bctype==bc_slipwall_fixed) THEN
371  iconstrtype = 2
372  ELSEIF (bctype==bc_slipwall_xslide) THEN
373  iconstrtype = 120
374  ELSEIF (bctype==bc_slipwall_yslide) THEN
375  iconstrtype = 121
376  ELSEIF (bctype==bc_slipwall_zslide) THEN
377  iconstrtype = 122
378  ELSEIF (bctype==bc_slipwall_xyslide) THEN
379  iconstrtype = -122
380  ELSEIF (bctype==bc_slipwall_xzslide) THEN
381  iconstrtype = -121
382  ELSEIF (bctype==bc_slipwall_yzslide) THEN
383  iconstrtype = -120
384  ENDIF
385  IF (bctype==bc_noslipwall_free) THEN
386  iconstrtype = 0
387  ELSEIF (bctype==bc_noslipwall_fixed) THEN
388  iconstrtype = 2
389  ELSEIF (bctype==bc_noslipwall_xslide) THEN
390  iconstrtype = 120
391  ELSEIF (bctype==bc_noslipwall_yslide) THEN
392  iconstrtype = 121
393  ELSEIF (bctype==bc_noslipwall_zslide) THEN
394  iconstrtype = 122
395  ELSEIF (bctype==bc_noslipwall_xyslide) THEN
396  iconstrtype = -122
397  ELSEIF (bctype==bc_noslipwall_xzslide) THEN
398  iconstrtype = -121
399  ELSEIF (bctype==bc_noslipwall_yzslide) THEN
400  iconstrtype = -120
401  ENDIF
402  IF (bctype==bc_outflow_free) THEN
403  iconstrtype = 0
404  ELSEIF (bctype==bc_outflow_fixed) THEN
405  iconstrtype = 2
406  ELSEIF (bctype==bc_outflow_xslide) THEN
407  iconstrtype = 120
408  ELSEIF (bctype==bc_outflow_yslide) THEN
409  iconstrtype = 121
410  ELSEIF (bctype==bc_outflow_zslide) THEN
411  iconstrtype = 122
412  ELSEIF (bctype==bc_outflow_xyslide) THEN
413  iconstrtype = -122
414  ELSEIF (bctype==bc_outflow_xzslide) THEN
415  iconstrtype = -121
416  ELSEIF (bctype==bc_outflow_yzslide) THEN
417  iconstrtype = -120
418  ENDIF
419 ! PRINT *,'RFLO: bcType = ',bcType,' iConstrType = ',iConstrType
420 
421 ! ------- zero out radiation flux (set by Rocrad if active)
422 
423  patch%qr(:,:) = 0._rfreal
424 
425  ELSE ! internal BC
426 ! WRITE(*,*) ' internal bc on patch '
427 
428 #ifndef PRE_RFLOPREP_V2300
429  IF ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
430  (bctype>=bc_regionint .AND. bctype<=bc_regionint+bc_range) .OR. &
431  (bctype>=bc_regnonconf .AND. bctype<=bc_regnonconf+bc_range) .OR. &
432  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri+bc_range) .OR. &
433  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri+bc_range)) THEN
434 
435  ELSE
436  icount = icount + 1
437  pid = ireg*regoff + icount
438 
439  ALLOCATE( patch%bcFlag(1),stat=errorflag )
440  global%error = errorflag
441  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
442 
443  CALL com_set_size(trim(wins)//'.bcflag',pid,1)
444  CALL com_set_array( trim(wins)//'.bcflag',pid,patch%bcFlag )
445 
446  patch%bcFlag(1) = 2 ! non-interacting patch
447 
448 ! --------- surface grid
449 
450  dims(1) = abs(patch%l1end-patch%l1beg) + 2 ! nodal values
451  dims(2) = abs(patch%l2end-patch%l2beg) + 2
452 
453  ALLOCATE( patch%surfCoord(3,dims(1),dims(2)),stat=errorflag )
454  global%error = errorflag
455  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
456 
457  CALL com_set_array_const( trim(wins)//'.:st2:',pid,dims )
458  CALL com_set_array( trim(wins)//'.nc',pid,patch%surfCoord )
459 
460  ALLOCATE( patch%duAlp(3,dims(1),dims(2)),stat=errorflag )
461  global%error = errorflag
462  IF (global%error /= 0) CALL errorstop( global,err_allocate,__line__ )
463 
464  CALL com_set_array( trim(wins)//'.du_alp',pid,patch%duAlp )
465 
466 ! --------- constraint type
467 
468  CALL com_set_size(trim(wins)//'.cnstr_type',pid,1)
469  CALL com_allocate_array( trim(wins)//'.cnstr_type',pid,iconstrtype )
470 
471  iconstrtype = 2
472  IF (bctype==bc_symmetry_free) THEN
473  iconstrtype = 0
474  ELSEIF (bctype==bc_symmetry_fixed) THEN
475  iconstrtype = 2
476  ELSEIF (bctype==bc_symmetry_xslide) THEN
477  iconstrtype = 120
478  ELSEIF (bctype==bc_symmetry_yslide) THEN
479  iconstrtype = 121
480  ELSEIF (bctype==bc_symmetry_zslide) THEN
481  iconstrtype = 122
482  ELSEIF (bctype==bc_symmetry_xyslide) THEN
483  iconstrtype = -122
484  ELSEIF (bctype==bc_symmetry_xzslide) THEN
485  iconstrtype = -121
486  ELSEIF (bctype==bc_symmetry_yzslide) THEN
487  iconstrtype = -120
488  ENDIF
489  IF (bctype==bc_slipwall_free) THEN
490  iconstrtype = 0
491  ELSEIF (bctype==bc_slipwall_fixed) THEN
492  iconstrtype = 2
493  ELSEIF (bctype==bc_slipwall_xslide) THEN
494  iconstrtype = 120
495  ELSEIF (bctype==bc_slipwall_yslide) THEN
496  iconstrtype = 121
497  ELSEIF (bctype==bc_slipwall_zslide) THEN
498  iconstrtype = 122
499  ELSEIF (bctype==bc_slipwall_xyslide) THEN
500  iconstrtype = -122
501  ELSEIF (bctype==bc_slipwall_xzslide) THEN
502  iconstrtype = -121
503  ELSEIF (bctype==bc_slipwall_yzslide) THEN
504 ! write(*,*) 'RFLOn: BC_*YZSLIDE'
505  iconstrtype = -120
506  ENDIF
507  IF (bctype==bc_noslipwall_free) THEN
508  iconstrtype = 0
509  ELSEIF (bctype==bc_noslipwall_fixed) THEN
510  iconstrtype = 2
511  ELSEIF (bctype==bc_noslipwall_xslide) THEN
512  iconstrtype = 120
513  ELSEIF (bctype==bc_noslipwall_yslide) THEN
514  iconstrtype = 121
515  ELSEIF (bctype==bc_noslipwall_zslide) THEN
516  iconstrtype = 122
517  ELSEIF (bctype==bc_noslipwall_xyslide) THEN
518  iconstrtype = -122
519  ELSEIF (bctype==bc_noslipwall_xzslide) THEN
520  iconstrtype = -121
521  ELSEIF (bctype==bc_noslipwall_yzslide) THEN
522  ! write(*,*) 'RFLOn: BC_*YZSLIDE'
523  iconstrtype = -120
524  ENDIF
525  IF (bctype==bc_outflow_free) THEN
526  iconstrtype = 0
527  ELSEIF (bctype==bc_outflow_fixed) THEN
528  iconstrtype = 2
529  ELSEIF (bctype==bc_outflow_xslide) THEN
530  iconstrtype = 120
531  ELSEIF (bctype==bc_outflow_yslide) THEN
532  iconstrtype = 121
533  ELSEIF (bctype==bc_outflow_zslide) THEN
534  iconstrtype = 122
535  ELSEIF (bctype==bc_outflow_xyslide) THEN
536  iconstrtype = -122
537  ELSEIF (bctype==bc_outflow_xzslide) THEN
538  iconstrtype = -121
539  ELSEIF (bctype==bc_outflow_yzslide) THEN
540 ! write(*,*) 'RFLOn: BC_*YZSLIDE'
541  iconstrtype = -120
542  ENDIF
543 ! PRINT *,'RFLOn: bcType = ',bcType ,' iConstrType = ',iConstrType
544 
545  ENDIF
546 #endif
547  ENDIF ! external/internal BC
548 ! ENDIF
549 ! WRITE(*,*) ' done with patch having bc',bcType
550  ENDDO ! iPatch
551 
552 ! --- volume data
553 ! WRITE(*,*) 'now doing volume data'
554  CALL mpi_barrier(mpi_comm_world,mpierr)
555  IF ( regions(1)%global%myProcid == masterproc .AND. &
556  regions(1)%global%verbLevel>= verbose_high ) THEN
557  WRITE(stdout,'(A,1X,A)') solver_name,'Processing Rocstar volume windows.'
558  ENDIF
559 
560  pid = ireg*regoff
561 
562  CALL rflo_getdimensdummynodes( regions(ireg),ilev,idnbeg,idnend, &
563  jdnbeg,jdnend,kdnbeg,kdnend )
564  dims(1) = idnend - idnbeg + 1
565  dims(2) = jdnend - jdnbeg + 1
566  dims(3) = kdnend - kdnbeg + 1
567 
568  CALL com_set_size( trim(winv)//".:st3:",pid,3, regions(ireg)%nDumCells)
569  CALL com_set_array_const( trim(winv)//".:st3:",pid,dims )
570  CALL com_set_array( trim(winv)//'.nc',pid, &
571  regions(ireg)%levels(ilev)%grid%xyz )
572 
573 ! WRITE(*,*) 'setting arrays'
574  IF (regions(ireg)%mixtInput%moveGrid) THEN
575  CALL com_set_array( trim(winv)//'.siVel',pid, &
576  regions(ireg)%levels(ilev)%grid%siVel )
577  CALL com_set_array( trim(winv)//'.sjVel',pid, &
578  regions(ireg)%levels(ilev)%grid%sjVel )
579  CALL com_set_array( trim(winv)//'.skVel',pid, &
580  regions(ireg)%levels(ilev)%grid%skVel )
581  ENDIF
582 
583  ilb = lbound(regions(ireg)%levels(ilev)%mixt%cv,2)
584 
585  CALL com_set_array( trim(winv)//'.rhof',pid, &
586  regions(ireg)%levels(ilev)%mixt%cv(1,ilb),5)
587  CALL com_set_array( trim(winv)//'.1-rhovf',pid, &
588  regions(ireg)%levels(ilev)%mixt%cv(2,ilb),5)
589  CALL com_set_array( trim(winv)//'.2-rhovf',pid, &
590  regions(ireg)%levels(ilev)%mixt%cv(3,ilb),5)
591  CALL com_set_array( trim(winv)//'.3-rhovf',pid, &
592  regions(ireg)%levels(ilev)%mixt%cv(4,ilb),5)
593  CALL com_set_array( trim(winv)//'.rhoEf',pid, &
594  regions(ireg)%levels(ilev)%mixt%cv(5,ilb),5)
595 
596  CALL com_set_array( trim(winv)//'.1-vf',pid, &
597  regions(ireg)%levels(ilev)%mixt%dv(1,ilb),6)
598  CALL com_set_array( trim(winv)//'.2-vf',pid, &
599  regions(ireg)%levels(ilev)%mixt%dv(2,ilb),6)
600  CALL com_set_array( trim(winv)//'.3-vf',pid, &
601  regions(ireg)%levels(ilev)%mixt%dv(3,ilb),6)
602  CALL com_set_array( trim(winv)//'.Tf',pid, &
603  regions(ireg)%levels(ilev)%mixt%dv(4,ilb),6)
604  CALL com_set_array( trim(winv)//'.pf',pid, &
605  regions(ireg)%levels(ilev)%mixt%dv(5,ilb),6)
606  CALL com_set_array( trim(winv)//'.af',pid, &
607  regions(ireg)%levels(ilev)%mixt%dv(6,ilb),6)
608 
609  CALL com_set_array( trim(winv)//'.dtf',pid, &
610  regions(ireg)%levels(ilev)%dt(ilb),1)
611 
612 ! --- statistics
613 
614 #ifdef STATS
615  IF ((global%flowType==flow_unsteady) .AND. (global%doStat==active)) THEN
616  IF (global%mixtNStat > 0) THEN
617  DO istat=1,global%mixtNStat
618  CALL com_set_array( trim(winv)//'.'//trim(statnm(1,1,istat)), pid,&
619  regions(ireg)%levels(ilev)%mixt%tav(istat,ilb), global%mixtNStat)
620  ENDDO
621  ENDIF
622  ENDIF
623 #endif
624  ENDIF ! region on this processor and active
625  ENDDO ! iReg
626 
627  CALL mpi_barrier(mpi_comm_world,mpierr)
628  IF ( regions(1)%global%myProcid == masterproc .AND. &
629  regions(1)%global%verbLevel>= verbose_high ) THEN
630  WRITE(stdout,'(A,1X,A)') solver_name,'Initializing Rocstar interfaces for MP'
631  ENDIF
632 
633 ! Genx initialization of physical modules -------------------------------------
634 
635  CALL randinitgenxinterface( regions,wins,winv )
636 
637 #ifdef PEUL
638  IF (global%peulUsed) CALL peul_initgenxinterface( regions,wins,winv )
639 #endif
640 #ifdef PLAG
641 !#ifndef NATIVE_MP_IO
642  IF (global%plagUsed) CALL plag_initgenxinterface( regions,wins, &
643  inplag,obtain_attribute )
644 !#endif
645 #endif
646 #ifdef TURB
647  IF (global%turbActive) CALL turb_initgenxinterface( regions,wins,winv )
648 #endif
649 #ifdef RADI
650  IF (global%radiActive) CALL radi_initgenxinterface( regions,wins,winv )
651 #endif
652 
653 ! finalize --------------------------------------------------------------------
654 
655  CALL mpi_barrier(mpi_comm_world,mpierr)
656  IF ( global%myProcid == masterproc .AND. &
657  global%verbLevel>= verbose_high ) THEN
658  WRITE(stdout,'(A,1X,A)') solver_name,'Window setup done.'
659  ENDIF
660 
661  CALL com_window_init_done( trim(wins) )
662  CALL com_window_init_done( trim(winv) )
663 ! WRITE(*,*) 'getting to attribute grabbing'
664 
665  CALL mpi_barrier(mpi_comm_world,mpierr)
666  IF ( global%myProcid == masterproc .AND. &
667  global%verbLevel>= verbose_high ) THEN
668  WRITE(stdout,'(A,1X,A)') solver_name,'Populating volume windows.'
669  ENDIF
670 
671  DO iproc = 0, global%nprocalloc
672 ! IF(global%myProcid == MASTERPROC) THEN
673 ! WRITE(STDOUT,'(A,1X,A)') SOLVER_NAME,'Getting volume data.',iProc
674 ! ENDIF
675  IF(global%myProcid == iproc) THEN
676  CALL com_call_function( obtain_attribute,2, &
677  com_get_attribute_handle_const(trim(invol)//".all"), &
678  com_get_attribute_handle(trim(winv)//".all") )
679 
680 
681  ENDIF
682  CALL mpi_barrier(mpi_comm_world,mpierr)
683  ENDDo
684 
685 
686  CALL mpi_barrier(mpi_comm_world,mpierr)
687  IF ( regions(1)%global%myProcid == masterproc .AND. &
688  regions(1)%global%verbLevel>= verbose_high ) THEN
689  WRITE(stdout,'(A,1X,A)') solver_name,'Populating surface windows.'
690  ENDIF
691 
692  DO iproc = 0, global%nprocalloc
693 ! IF(global%myProcid == MASTERPROC) THEN
694 ! WRITE(STDOUT,'(A,1X,A)') SOLVER_NAME,'Getting surface data.',iProc
695 ! ENDIF
696  IF(global%myProcid == iproc) THEN
697  CALL com_call_function( obtain_attribute,2, &
698  com_get_attribute_handle_const(trim(insurf)//".all"), &
699  com_get_attribute_handle(trim(wins)//".all") )
700 
701  ENDIF
702  CALL mpi_barrier(mpi_comm_world,mpierr)
703  ENDDo
704 
705  CALL mpi_barrier(mpi_comm_world,mpierr)
706  IF ( global%myProcid == masterproc .AND. &
707  global%verbLevel>= verbose_high ) THEN
708  WRITE(stdout,'(A,1X,A)') solver_name,'Done Populating all windows.'
709  ENDIF
710 ! WRITE(*,*) 'past attribute grabbing'
711 #ifdef PLAG
712  CALL com_call_function( handle,3,trim(wins),&
713  trim(winv)//' '//trim(global%winp),solver )
714 #else
715  CALL com_call_function( handle,3,trim(wins),trim(winv),solver )
716 #endif
717 
718 ! set tav from actual time averaged to accumulated values --------------------
719 
720 #ifdef STATS
721  DO ireg=1,global%nRegions
722  IF (regions(ireg)%procid==global%myProcid .AND. & ! region active and
723  regions(ireg)%active==active) THEN ! on my processor
724  ilev = regions(ireg)%currLevel
725 
726  IF ((global%flowType==flow_unsteady) .AND. (global%doStat==active)) THEN
727  IF (global%mixtNStat > 0) THEN
728  DO istat=1,global%mixtNStat
729  regions(ireg)%levels(ilev)%mixt%tav(istat,:) = &
730  regions(ireg)%levels(ilev)%mixt%tav(istat,:)*global%integrTime
731  ENDDO
732  ENDIF ! mixtNstat
733 #ifdef TURB
734  IF ((global%turbActive .EQV. .true.) .AND. (global%turbNStat > 0)) THEN
735  DO istat=1,global%turbNStat
736  regions(ireg)%levels(ilev)%turb%tav(istat,:) = &
737  regions(ireg)%levels(ilev)%turb%tav(istat,:)*global%integrTime
738  ENDDO
739  ENDIF ! turbNstat
740 #endif
741  ENDIF ! unsteady and dostat
742  ENDIF ! region on this processor and active
743  ENDDO ! iReg
744 #endif
745 
746  CALL deregisterfunction( global )
747 
748 END SUBROUTINE rflo_initgenxinterface
749 
750 !******************************************************************************
751 !
752 ! RCS Revision history:
753 !
754 ! $Log: RFLO_InitGenxInterface.F90,v $
755 ! Revision 1.31 2010/02/18 21:47:38 juzhang
756 ! Heat transfer bc for non-propellant surface documented in Rocburn_PY_HT.pdf in Rocburn_PY directory is implemented within Rocburn_PY. Major changes were made to Rocburn, Rocman3, RocfluidMP/genx, RocfluidMP/modflo directories.
757 !
758 ! Revision 1.30 2009/08/27 14:04:49 mtcampbe
759 ! Updated to enable burning motion with symmetry boundaries and enhanced
760 ! burnout code.
761 !
762 ! Revision 1.29 2009/08/12 04:15:57 mtcampbe
763 ! Major update, bugfix from Abe development, more propagation compatibility,
764 ! some Rocstar IO changes, Ju's temporary clipping fix for turbulence. A bug
765 ! fix for initialization IO.
766 !
767 ! Revision 1.27 2008/12/06 08:44:00 mtcampbe
768 ! Updated license.
769 !
770 ! Revision 1.26 2008/11/19 22:17:14 mtcampbe
771 ! Added Illinois Open Source License/Copyright
772 !
773 ! Revision 1.25 2006/08/28 11:42:11 rfiedler
774 ! Add grid motion constraint types for outflow BC.
775 !
776 ! Revision 1.24 2006/08/24 14:58:46 rfiedler
777 ! Use numbers for constraints instead of ICHAR; print constraints.
778 !
779 ! Revision 1.22 2006/05/08 22:30:21 wasistho
780 ! added prop-NS capability
781 !
782 ! Revision 1.21 2006/03/03 07:06:06 wasistho
783 ! backed out from zeroing out incoming alpha variables
784 !
785 ! Revision 1.20 2006/03/03 06:07:31 wasistho
786 ! initialized incoming alpha variables
787 !
788 ! Revision 1.19 2006/01/23 22:44:03 wasistho
789 ! added condition for internal injectionAPN
790 !
791 ! Revision 1.18 2005/12/08 07:03:28 wasistho
792 ! added ifdef TURB
793 !
794 ! Revision 1.17 2005/12/08 02:34:21 wasistho
795 ! bug fixed move registration of global%integrTime outside regions loop
796 !
797 ! Revision 1.16 2005/12/08 00:18:46 wasistho
798 ! stored actual time averaged vars in hdf
799 !
800 ! Revision 1.15 2005/12/07 20:03:34 wasistho
801 ! removed attemp to store actual tav i.o. accumulated
802 !
803 ! Revision 1.14 2005/12/07 04:43:57 wasistho
804 ! modified statistics treatment
805 !
806 ! Revision 1.13 2005/12/07 02:23:36 wasistho
807 ! added integrTime with eps
808 !
809 ! Revision 1.12 2005/12/06 21:52:58 wasistho
810 ! devided and multiply tav with integrTime
811 !
812 ! Revision 1.11 2005/12/04 09:15:01 wasistho
813 ! added statistics integration time
814 !
815 ! Revision 1.10 2005/06/19 05:33:21 wasistho
816 ! shift index rocprop slipwalls and change default iConstrType
817 !
818 ! Revision 1.9 2005/06/17 03:09:26 wasistho
819 ! relocated cnstr_type kernel inside both external internal loops
820 !
821 ! Revision 1.8 2005/06/17 02:23:46 jiao
822 ! Fixed bug in registering cnstr_type.
823 !
824 ! Revision 1.7 2005/06/16 22:33:31 wasistho
825 ! added cnstr_type
826 !
827 ! Revision 1.6 2005/05/11 19:44:46 wasistho
828 ! changed REG_NONINTERACT to PRE_RFLOPREP_V2300
829 !
830 ! Revision 1.5 2005/05/10 15:01:40 wasistho
831 ! exclude block interfaces in registration of internal surfaces
832 !
833 ! Revision 1.4 2005/04/20 02:50:25 wasistho
834 ! added error msg for incorrect compile option
835 !
836 ! Revision 1.3 2005/04/18 20:34:55 wasistho
837 ! added ifdef REG_NONINTERACT
838 !
839 ! Revision 1.2 2005/04/18 18:11:44 wasistho
840 ! registered non-interacting patches
841 !
842 ! Revision 1.1 2004/12/01 21:23:52 haselbac
843 ! Initial revision after changing case
844 !
845 ! Revision 1.30 2004/07/02 22:48:40 jiao
846 ! Fixed function call to Rocman when PLAG is defined.
847 !
848 ! Revision 1.29 2004/07/02 22:06:41 fnajjar
849 ! Modified PLAG call for Roccom3 import
850 !
851 ! Revision 1.28 2004/06/30 04:05:56 wasistho
852 ! moved Genx related parameter REGOFF to ModParameters
853 !
854 ! Revision 1.27 2004/06/29 23:52:10 wasistho
855 ! migrated to Roccom-3
856 !
857 ! Revision 1.26 2004/06/07 23:05:21 wasistho
858 ! provide Genx statistics names, units, and anytime-activation
859 !
860 ! Revision 1.25 2004/03/05 22:08:58 jferry
861 ! created global variables for peul, plag, and inrt use
862 !
863 ! Revision 1.24 2003/12/05 02:05:53 rfiedler
864 ! Make the data in the fluids time step begin at index ilb like
865 ! the other variables. RAF
866 !
867 ! Revision 1.23 2003/12/03 03:02:37 jiao
868 ! Removed all calls involving COM_NULL.
869 !
870 ! Revision 1.22 2003/12/02 21:20:37 fnajjar
871 ! Included timestep size in output file
872 !
873 ! Revision 1.21 2003/11/21 22:17:36 fnajjar
874 ! Added PLAG, PEUL, and rand interfaces.
875 !
876 ! Revision 1.20 2003/11/20 16:40:34 mdbrandy
877 ! Backing out RocfluidMP changes from 11-17-03
878 !
879 ! Revision 1.17 2003/08/14 20:06:58 jblazek
880 ! Corrected bug associated with radiation flux qr.
881 !
882 ! Revision 1.16 2003/08/09 02:07:47 wasistho
883 ! added TURB and RADI_initGenxInterface
884 !
885 ! Revision 1.15 2003/05/15 02:57:00 jblazek
886 ! Inlined index function.
887 !
888 ! Revision 1.14 2003/05/09 17:01:03 jiao
889 ! Renamed the COM_call_function_handlers to COM_call_function.
890 !
891 ! Revision 1.13 2003/04/25 19:29:24 haselbac
892 ! Jiao: Added support for ghost cells/nodes in unstructured meshes.
893 !
894 ! Revision 1.12 2002/10/30 22:10:20 jiao
895 ! Split volume data into more descriptive attributes.
896 !
897 ! Revision 1.11 2002/10/19 00:40:30 jblazek
898 ! Added utility (rflosurf) to write out surface grids for GenX.
899 !
900 ! Revision 1.10 2002/10/18 16:49:19 jblazek
901 ! Changed parameter lists to some GenX routines.
902 !
903 ! Revision 1.9 2002/10/15 23:22:59 jblazek
904 ! dded Rocturb to GenX compilation path.
905 !
906 ! Revision 1.8 2002/10/15 21:09:25 jiao
907 ! Back to number of dummy cells again ...
908 !
909 ! Revision 1.7 2002/10/03 21:33:48 jblazek
910 ! Init. of bcflag moved from SendBoundaryValues to InitGenxInterface.
911 !
912 ! Revision 1.6 2002/10/01 00:05:30 jblazek
913 ! Removed st2 again.
914 !
915 ! Revision 1.5 2002/09/27 21:28:47 jblazek
916 ! Some more modifications regarding the interface to GenX.
917 !
918 ! Revision 1.4 2002/09/27 00:57:09 jblazek
919 ! Changed makefiles - no makelinks needed.
920 !
921 ! Revision 1.3 2002/09/25 17:44:56 jblazek
922 ! Added dependent variables to volume window.
923 !
924 ! Revision 1.2 2002/09/24 23:18:01 jblazek
925 ! Changed bcflag to a pointer.
926 !
927 ! Revision 1.1 2002/09/20 22:22:34 jblazek
928 ! Finalized integration into GenX.
929 !
930 !******************************************************************************
931 
932 
933 
934 
935 
936 
937 
size_t handle(const msq_std::string &name, MsqError &err) const
Get tag index from name.
subroutine radi_initgenxinterface(regions, wins, winv)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
**********************************************************************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 jdnbeg
**********************************************************************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 idnend
**********************************************************************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 jdnend
**********************************************************************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 idnbeg
Definition: patch.h:74
subroutine turb_initgenxinterface(regions, wins, winv)
subroutine randinitgenxinterface(regions, wins, winv)
subroutine rflo_getdimensdummynodes(region, iLev, idnbeg, idnend, jdnbeg, jdnend, kdnbeg, kdnend)
void obtain_attribute(const COM::Attribute *attribute_in, COM::Attribute *user_attribute, int *pane_id=NULL)
Fill the destination (second) attribute from files using the data corresponding to the source (first)...
Definition: Rocin.C:2431
subroutine peul_initgenxinterface(regions, wins, winv)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine rflo_initgenxinterface(regions, handle, solver, inSurf, inVolPlag, obtain_attribute)
subroutine plag_initgenxinterface(regions, wins, inPlag, obtain_attribute)
**********************************************************************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 kdnbeg