"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "src/tests/cgread_f03.F90" between
CGNS-4.1.2.tar.gz and CGNS-4.2.0.tar.gz

About: The CGNS (CFD General Notation System) provides a standard for recording and recovering computer data associated with the numerical solution of fluid dynamics equations.

cgread_f03.F90  (CGNS-4.1.2):cgread_f03.F90  (CGNS-4.2.0)
skipping to change at line 16 skipping to change at line 16
#endif #endif
USE ISO_C_BINDING USE ISO_C_BINDING
USE CGNS USE CGNS
IMPLICIT NONE IMPLICIT NONE
! This program reads a 3D mesh, structured or unstructured. ! This program reads a 3D mesh, structured or unstructured.
INTEGER :: Ndim, Nglobal INTEGER :: Ndim, Nglobal
PARAMETER (Ndim = 3) PARAMETER (Ndim = 3)
PARAMETER (Nglobal = 500) PARAMETER (Nglobal = 500)
INTEGER, PARAMETER :: sp = KIND(1.0)
INTEGER, PARAMETER :: dp = KIND(1.d0)
INTEGER :: i, narrays, iarray INTEGER :: i, narrays, iarray
INTEGER :: nintegrals, integral INTEGER :: nintegrals, integral
INTEGER :: ndescriptors, idescr INTEGER :: ndescriptors, idescr
INTEGER(cgenum_t) :: nzonetype INTEGER(cgenum_t) :: nzonetype
INTEGER(cgsize_t) :: nptsets INTEGER(cgsize_t) :: nptsets
INTEGER(cgenum_t) :: ndonor_ptset_type, ndonor_data_type INTEGER(cgenum_t) :: ndonor_ptset_type, ndonor_data_type
INTEGER :: idataset, dirichletflag, neumannflag INTEGER :: idataset, dirichletflag, neumannflag
INTEGER IndexDim, CellDim, PhysDim INTEGER IndexDim, CellDim, PhysDim
INTEGER ier, n INTEGER ier, n
INTEGER(cgenum_t) :: zonetype INTEGER(cgenum_t) :: zonetype
INTEGER nbases, nzones INTEGER nbases, nzones
INTEGER(cgsize_t) :: rmin(3), DataSize(Ndim) INTEGER(cgsize_t) :: rmin(3), DataSize(Ndim)
INTEGER(cgsize_t) :: SIZE(Ndim*3) INTEGER(cgsize_t) :: SIZE(Ndim*3)
INTEGER :: ncoords, nsols, nfields INTEGER :: ncoords, nsols, nfields
INTEGER(cgenum_t) :: location INTEGER(cgenum_t) :: location
INTEGER(cgenum_t) :: TYPE INTEGER(cgenum_t) :: TYPE
INTEGER :: nholes, nconns, n1to1, n1to1_global, nbocos INTEGER :: nholes, nconns, n1to1, n1to1_global, nbocos
INTEGER(cgenum_t) :: ptset_type INTEGER(cgenum_t) :: ptset_type
INTEGER(cgsize_t) :: npnts, pnts(100000), donor_pnts(100000) INTEGER(cgsize_t) :: npnts, pnts(100000), donor_pnts(100000)
INTEGER(cgsize_t) :: npnts_donor INTEGER(cgsize_t) :: npnts_donor
INTEGER(cgenum_t) :: bocotype, datatype INTEGER(cgenum_t) :: bocotype, datatype
CHARACTER*32 basename, zonename, solname, fieldname CHARACTER(len=32) basename, zonename, solname, fieldname
CHARACTER*32 coordname, holename CHARACTER(len=32) coordname, holename
#ifndef CG_BASESCOPE #ifndef CG_BASESCOPE
CHARACTER*32 connectname, donorname CHARACTER(len=32) connectname, donorname
#else #else
CHARACTER*65 connectname, donorname CHARACTER(len=65) connectname, donorname
#endif #endif
CHARACTER*32 boconame CHARACTER(len=32) boconame
INTEGER cg, base, zone, coord, sol, field, discr INTEGER cg, base, zone, coord, sol, field, discr
INTEGER :: hole, conn, one21, boco INTEGER :: hole, conn, one21, boco
INTEGER(cgsize_t) :: RANGE(Ndim, 2), donor_range(Ndim, 2) INTEGER(cgsize_t) :: RANGE(Ndim, 2), donor_range(Ndim, 2)
INTEGER transform(Ndim) INTEGER transform(Ndim)
INTEGER(cgsize_t) :: G_range(Ndim*2, Nglobal) INTEGER(cgsize_t) :: G_range(Ndim*2, Nglobal)
INTEGER(cgsize_t) :: G_donor_range(Ndim*2, Nglobal) INTEGER(cgsize_t) :: G_donor_range(Ndim*2, Nglobal)
INTEGER :: G_transform(Ndim, Nglobal) INTEGER :: G_transform(Ndim, Nglobal)
CHARACTER*32 G_zonename(Nglobal) CHARACTER(len=32) G_zonename(Nglobal)
#ifndef CG_BASESCOPE #ifndef CG_BASESCOPE
CHARACTER*32 G_connectname(Nglobal), G_donorname(Nglobal) CHARACTER(len=32) G_connectname(Nglobal), G_donorname(Nglobal)
#else #else
CHARACTER*65 G_connectname(Nglobal), G_donorname(Nglobal) CHARACTER(len=65) G_connectname(Nglobal), G_donorname(Nglobal)
#endif #endif
CHARACTER*32 name, filename CHARACTER(len=32) name, filename
CHARACTER*40 text, NormDefinitions, StateDescription CHARACTER(len=40) text, NormDefinitions, StateDescription
INTEGER :: equation_dimension, GoverningEquationsFlag INTEGER :: equation_dimension, GoverningEquationsFlag
INTEGER :: GasModelFlag, ViscosityModelFlag INTEGER :: GasModelFlag, ViscosityModelFlag
INTEGER :: ThermalConductivityModelFlag INTEGER :: ThermalConductivityModelFlag
INTEGER :: TurbulenceClosureFlag, TurbulenceModelFlag INTEGER :: TurbulenceClosureFlag, TurbulenceModelFlag
INTEGER :: diffusion_model(6) INTEGER :: diffusion_model(6)
INTEGER :: niterations INTEGER :: niterations
INTEGER :: rind(6), ndiscrete, num INTEGER :: rind(6), ndiscrete, num
INTEGER :: nndim INTEGER :: nndim
INTEGER(cgsize_t) :: dim_vals(12) INTEGER(cgsize_t) :: dim_vals(12)
INTEGER(cgenum_t) :: mass, length, time, temp, deg INTEGER(cgenum_t) :: mass, length, time, temp, deg
INTEGER :: NormalIndex(3), ndataset INTEGER :: NormalIndex(3), ndataset
INTEGER(cgsize_t) :: NormalListSize INTEGER(cgsize_t) :: NormalListSize
REAL*4 data_single(100000) REAL(KIND=sp) data_single(100000)
DOUBLE PRECISION data_double(100000) REAL(KIND=dp) data_double(100000)
REAL*4 version REAL(KIND=sp) version
INTEGER one, is_cgns INTEGER one, is_cgns
PARAMETER (one = 1) PARAMETER (one = 1)
! *** open file ! *** open file
! write(6,*) 'Input filename' ! write(6,*) 'Input filename'
! read(5,600) filename ! read(5,600) filename
WRITE(filename,'(a)')'cgtest.cgns' WRITE(filename,'(a)')'cgtest.cgns'
! *** check if the file is CGNS ! *** check if the file is CGNS
CALL cg_is_cgns_f(filename, is_cgns, ier) CALL cg_is_cgns_f(filename, is_cgns, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
IF ((is_cgns.NE.CG_FILE_ADF).AND.(is_cgns.NE.CG_FILE_HDF5).AND. & IF ((is_cgns.NE.CG_FILE_ADF).AND.(is_cgns.NE.CG_FILE_HDF5).AND. &
(is_cgns.NE.CG_FILE_ADF2)) & (is_cgns.NE.CG_FILE_ADF2)) &
CALL cg_error_exit_f CALL cg_error_exit_f
! *** check if the user passes a file name with the null terminator ! *** check if the user passes a file name with the null terminator
skipping to change at line 221 skipping to change at line 223
CALL cg_goto_f(cg,base,ier, 'FlowEquationSet_t', one, & CALL cg_goto_f(cg,base,ier, 'FlowEquationSet_t', one, &
'GoverningEquations_t', one ,'end') 'GoverningEquations_t', one ,'end')
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
! *** Governing Equations attribute: Diffusion model ! *** Governing Equations attribute: Diffusion model
CALL cg_diffusion_read_f(diffusion_model, ier) CALL cg_diffusion_read_f(diffusion_model, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
IF (ier.EQ.ALL_OK)WRITE(6,103)' Diffusion model=', & IF (ier.EQ.ALL_OK)WRITE(6,103)' Diffusion model=', &
(diffusion_model(i), i=1,6) (diffusion_model(i), i=1,6)
ENDIF ! If Governing Equations are defined ENDIF ! If Governing Equations are defined
ENDIF ! If FlowEquationSet_t exists under CGNSBase_t ENDIF ! If FlowEquationSet_t exists under CGNSBase_t
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
CALL cg_nzones_f(cg, base, nzones, ier) CALL cg_nzones_f(cg, base, nzones, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,200)'nzones=',nzones WRITE(6,200)'nzones=',nzones
! *** zone ! *** zone
DO zone=1, nzones DO zone=1, nzones
CALL cg_zone_read_f(cg, base, zone, zonename, size, ier) CALL cg_zone_read_f(cg, base, zone, zonename, size, ier)
skipping to change at line 379 skipping to change at line 381
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
! *** DattaArray_t attribute: DimensionalExponents_t ! *** DattaArray_t attribute: DimensionalExponents_t
CALL cg_exponents_info_f(datatype, ier) CALL cg_exponents_info_f(datatype, ier)
IF (ier .EQ. ERROR) THEN IF (ier .EQ. ERROR) THEN
CALL cg_error_exit_f CALL cg_error_exit_f
ELSEIF (ier .EQ. ALL_OK) THEN ELSEIF (ier .EQ. ALL_OK) THEN
WRITE(6,600)' Datatype for exponents is ', & WRITE(6,600)' Datatype for exponents is ', &
DataTypeName(datatype) DataTypeName(datatype)
IF (datatype .EQ. RealSingle) THEN IF (datatype .EQ. RealSingle) THEN
CALL cg_exponents_read_f(data_single, ier) CALL cg_exponents_read_f(data_single, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,110)' Exponents:',(data_single(n),n=1,5) WRITE(6,110)' Exponents:',(data_single(n),n=1,5)
ELSEIF (datatype .EQ. RealDouble) THEN ELSEIF (datatype .EQ. RealDouble) THEN
CALL cg_exponents_read_f(data_double, ier) CALL cg_exponents_read_f(data_double, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,110)' Exponents:',(data_double(n),n=1,5) WRITE(6,110)' Exponents:',(data_double(n),n=1,5)
ENDIF ENDIF
ENDIF ENDIF
! *** DattaArray_t attribute: DataConversion_t ! *** DattaArray_t attribute: DataConversion_t
CALL cg_conversion_info_f(datatype, ier) CALL cg_conversion_info_f(datatype, ier)
IF (ier .EQ. ERROR) THEN IF (ier .EQ. ERROR) THEN
skipping to change at line 407 skipping to change at line 409
CALL cg_conversion_read_f(data_single, ier) CALL cg_conversion_read_f(data_single, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,110)' Conversion:',(data_single(n),n=1,2) WRITE(6,110)' Conversion:',(data_single(n),n=1,2)
ELSEIF (datatype .EQ. RealDouble) THEN ELSEIF (datatype .EQ. RealDouble) THEN
CALL cg_conversion_read_f(data_double, ier) CALL cg_conversion_read_f(data_double, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,110)' Conversion:',(data_double(n),n=1,2) WRITE(6,110)' Conversion:',(data_double(n),n=1,2)
ENDIF ENDIF
ENDIF ENDIF
ENDDO ! loop through DataArray_t ENDDO ! loop through DataArray_t
ENDDO ! loop through IntegralData_t ENDDO ! loop through IntegralData_t
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
! *** zone coordinate attribute: GOTO GridCoordinates_t node ! *** zone coordinate attribute: GOTO GridCoordinates_t node
CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, &
'GridCoordinates_t', one, 'end') 'GridCoordinates_t', one, 'end')
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
IF (ier .EQ. ALL_OK) THEN IF (ier .EQ. ALL_OK) THEN
! *** GridCoordinates_t attribute: dimensional units ! *** GridCoordinates_t attribute: dimensional units
skipping to change at line 485 skipping to change at line 487
CALL cg_ndescriptors_f(ndescriptors, ier) CALL cg_ndescriptors_f(ndescriptors, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,105) 'No. of descriptors=',ndescriptors WRITE(6,105) 'No. of descriptors=',ndescriptors
DO idescr=1, ndescriptors DO idescr=1, ndescriptors
CALL cg_descriptor_read_f(idescr, name, text, ier) CALL cg_descriptor_read_f(idescr, name, text, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,500) ' DescriptorName="',TRIM(name),'"', & WRITE(6,500) ' DescriptorName="',TRIM(name),'"', &
' DescriptorText="',TRIM(text),'"' ' DescriptorText="',TRIM(text),'"'
ENDDO ENDDO
ENDDO ! loop through data arrays ENDDO ! loop through data arrays
! *** read coordinates using coordinate arrays' specific functions: ! *** read coordinates using coordinate arrays' specific functions:
WRITE(6,400)'Specific functions to read coordinates arrays' WRITE(6,400)'Specific functions to read coordinates arrays'
CALL cg_ncoords_f(cg, base, zone, ncoords, ier) CALL cg_ncoords_f(cg, base, zone, ncoords, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,103)'no. of coordinates=',ncoords WRITE(6,103)'no. of coordinates=',ncoords
! ** Compute the nr of data to be read ! ** Compute the nr of data to be read
DO i=1,IndexDim DO i=1,IndexDim
skipping to change at line 521 skipping to change at line 523
data_single, ier) data_single, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
ELSEIF (datatype .EQ. RealDouble) THEN ELSEIF (datatype .EQ. RealDouble) THEN
CALL cg_coord_read_f(cg, base, zone, coordname, & CALL cg_coord_read_f(cg, base, zone, coordname, &
cg_get_type(data_double(1)), rmin, DataSize, & cg_get_type(data_double(1)), rmin, DataSize, &
data_double, ier) data_double, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
ENDIF ENDIF
ENDDO ENDDO
ENDIF ! if GridCoordinates_t exists ENDIF ! if GridCoordinates_t exists
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
! *** solution ! *** solution
CALL cg_nsols_f(cg, base, zone, nsols, ier) CALL cg_nsols_f(cg, base, zone, nsols, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,113) nsols,' FlowSolution_t node(s)', & WRITE(6,113) nsols,' FlowSolution_t node(s)', &
'found for ',zonename 'found for ',zonename
skipping to change at line 605 skipping to change at line 607
deg, ier) deg, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
IF (ier .EQ. ALL_OK) THEN IF (ier .EQ. ALL_OK) THEN
WRITE(6,100)& WRITE(6,100)&
' Dimensional Units:', & ' Dimensional Units:', &
MassUnitsName(mass), LengthUnitsName(length), & MassUnitsName(mass), LengthUnitsName(length), &
TemperatureUnitsName(temp), TimeUnitsName(time), & TemperatureUnitsName(temp), TimeUnitsName(time), &
AngleUnitsName(deg) AngleUnitsName(deg)
ENDIF ENDIF
ENDDO ! loop through DataArray_t ENDDO ! loop through DataArray_t
WRITE(6,103)' ' WRITE(6,103)' '
! *** Reading solution data with solution specific functions: ! *** Reading solution data with solution specific functions:
CALL cg_sol_info_f(cg, base, zone, sol, solname, & CALL cg_sol_info_f(cg, base, zone, sol, solname, &
location, ier) location, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,115)'sol #',sol,':', & WRITE(6,115)'sol #',sol,':', &
' solname="',TRIM(solname),'"', & ' solname="',TRIM(solname),'"', &
' location=',GridLocationName(location) ' location=',GridLocationName(location)
skipping to change at line 646 skipping to change at line 648
WRITE(6,115)' field #',field,':', & WRITE(6,115)' field #',field,':', &
' fieldname="',TRIM(fieldname),'"', & ' fieldname="',TRIM(fieldname),'"', &
' datatype=',DataTypeName(TYPE) ' datatype=',DataTypeName(TYPE)
! *** read entire range of solution data and record in double prec ision ! *** read entire range of solution data and record in double prec ision
CALL cg_field_read_f(cg, base, zone, sol, fieldname, & CALL cg_field_read_f(cg, base, zone, sol, fieldname, &
RealDouble, rmin, DataSize, data_double, ier) RealDouble, rmin, DataSize, data_double, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
ENDDO ! field loop ENDDO ! field loop
ENDDO ! loop through FlowSolution_t ENDDO ! loop through FlowSolution_t
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
! *** discrete data under zone ! *** discrete data under zone
CALL cg_ndiscrete_f(cg, base, zone, ndiscrete, ier) CALL cg_ndiscrete_f(cg, base, zone, ndiscrete, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
IF (ier .EQ. ALL_OK) WRITE(6,113)ndiscrete, & IF (ier .EQ. ALL_OK) WRITE(6,113)ndiscrete, &
' DiscreteData_t node(s) found under ',zonename ' DiscreteData_t node(s) found under ',zonename
DO discr=1, ndiscrete DO discr=1, ndiscrete
skipping to change at line 718 skipping to change at line 720
CALL cg_units_read_f(mass, length, time, temp, deg, ier) CALL cg_units_read_f(mass, length, time, temp, deg, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
IF (ier .EQ. ALL_OK) THEN IF (ier .EQ. ALL_OK) THEN
WRITE(6,100)& WRITE(6,100)&
' Dimensional Units for DiscreteData_t:', & ' Dimensional Units for DiscreteData_t:', &
MassUnitsName(mass), LengthUnitsName(length), & MassUnitsName(mass), LengthUnitsName(length), &
TemperatureUnitsName(temp), TimeUnitsName(time), & TemperatureUnitsName(temp), TimeUnitsName(time), &
AngleUnitsName(deg) AngleUnitsName(deg)
ENDIF ENDIF
ENDDO ! loop through DataArray_t ENDDO ! loop through DataArray_t
ENDDO ENDDO
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
! *** Interblock Connectivity: ! *** Interblock Connectivity:
WRITE(6,401)'Interblock Connectivity for ',zonename WRITE(6,401)'Interblock Connectivity for ',zonename
! *** ZoneGridConnectivity attributes: GOTO ZoneGridConnectivity_t node ! *** ZoneGridConnectivity attributes: GOTO ZoneGridConnectivity_t node
CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, &
'ZoneGridConnectivity_t', one, 'end') 'ZoneGridConnectivity_t', one, 'end')
skipping to change at line 780 skipping to change at line 782
CALL cg_ndescriptors_f(ndescriptors, ier) CALL cg_ndescriptors_f(ndescriptors, ier)
IF (ier .NE. 0) CALL cg_error_exit_f IF (ier .NE. 0) CALL cg_error_exit_f
WRITE(6,117)& WRITE(6,117)&
ndescriptors, ' descriptors for ',holename ndescriptors, ' descriptors for ',holename
DO idescr=1, ndescriptors DO idescr=1, ndescriptors
CALL cg_descriptor_read_f(idescr, name, text, ier) CALL cg_descriptor_read_f(idescr, name, text, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,500) ' DescriptorName="',TRIM(name),'"', & WRITE(6,500) ' DescriptorName="',TRIM(name),'"', &
' DescriptorText="',TRIM(text),'"' ' DescriptorText="',TRIM(text),'"'
ENDDO ENDDO
ENDDO !hole loop ENDDO !hole loop
! *** general connectivity ! *** general connectivity
CALL cg_nconns_f(cg, base, zone, nconns, ier) CALL cg_nconns_f(cg, base, zone, nconns, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,107) nconns,' GridConnectivity_t found' WRITE(6,107) nconns,' GridConnectivity_t found'
DO conn=1, nconns DO conn=1, nconns
CALL cg_conn_info_f(cg, base, zone, conn, connectname, & CALL cg_conn_info_f(cg, base, zone, conn, connectname, &
location, TYPE, ptset_type, npnts, donorname, & location, TYPE, ptset_type, npnts, donorname, &
nzonetype, ndonor_ptset_type, ndonor_data_type, & nzonetype, ndonor_ptset_type, ndonor_data_type, &
npnts_donor, ier) npnts_donor, ier)
skipping to change at line 879 skipping to change at line 881
WRITE(6,117)& WRITE(6,117)&
ndescriptors, ' descriptors for ',connectname ndescriptors, ' descriptors for ',connectname
DO idescr=1, ndescriptors DO idescr=1, ndescriptors
CALL cg_descriptor_read_f(idescr, name, text, ier) CALL cg_descriptor_read_f(idescr, name, text, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,500) ' DescriptorName="',TRIM(name),'"', & WRITE(6,500) ' DescriptorName="',TRIM(name),'"', &
' DescriptorText="',TRIM(text),'"' ' DescriptorText="',TRIM(text),'"'
ENDDO ENDDO
ENDIF ENDIF
ENDDO ENDDO
ENDIF ! if ZoneGridConnectivity exists ENDIF ! if ZoneGridConnectivity exists
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
! *** bocos ! *** bocos
WRITE(6,600)'Boundary Conditions for ',zonename WRITE(6,600)'Boundary Conditions for ',zonename
! *** Zone bound. condition attributes: GOTO ZoneBC_t node ! *** Zone bound. condition attributes: GOTO ZoneBC_t node
CALL cg_goto_f(cg, base,ier, 'Zone_t', zone, & CALL cg_goto_f(cg, base,ier, 'Zone_t', zone, &
'ZoneBC_t', one, 'end') 'ZoneBC_t', one, 'end')
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
skipping to change at line 942 skipping to change at line 944
CALL cg_units_read_f(mass, length, time, temp, & CALL cg_units_read_f(mass, length, time, temp, &
deg, ier) deg, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
IF (ier .EQ. ALL_OK) THEN IF (ier .EQ. ALL_OK) THEN
WRITE(6,100)& WRITE(6,100)&
' Dimensional Units:', & ' Dimensional Units:', &
MassUnitsName(mass), LengthUnitsName(length), & MassUnitsName(mass), LengthUnitsName(length), &
TemperatureUnitsName(temp), TimeUnitsName(time), & TemperatureUnitsName(temp), TimeUnitsName(time), &
AngleUnitsName(deg) AngleUnitsName(deg)
ENDIF ENDIF
ENDIF !if ReferenceState exists under ZoneBC_t ENDIF !if ReferenceState exists under ZoneBC_t
CALL cg_nbocos_f(cg, base, zone, nbocos, ier) CALL cg_nbocos_f(cg, base, zone, nbocos, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,113)nbocos,' bound. conditions found for ', & WRITE(6,113)nbocos,' bound. conditions found for ', &
zonename zonename
DO boco=1, nbocos DO boco=1, nbocos
CALL cg_boco_info_f(cg, base, zone, boco, boconame, & CALL cg_boco_info_f(cg, base, zone, boco, boconame, &
bocotype, ptset_type, npnts, & bocotype, ptset_type, npnts, &
NormalIndex, NormalListSize, datatype, & NormalIndex, NormalListSize, datatype, &
skipping to change at line 1036 skipping to change at line 1038
WRITE(6,600)' BCType=',BCTypeName(TYPE) WRITE(6,600)' BCType=',BCTypeName(TYPE)
! ** boundary condition data: GOTO BCData_t node ! ** boundary condition data: GOTO BCData_t node
IF (DirichletFlag.EQ.1) THEN IF (DirichletFlag.EQ.1) THEN
CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, &
'ZoneBC_t', one, 'BC_t', boco, 'BCDataSet_t', & 'ZoneBC_t', one, 'BC_t', boco, 'BCDataSet_t', &
idataset,'BCData_t',Dirichlet,'end') idataset,'BCData_t',Dirichlet,'end')
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
! ** boundary condition data attributes: DataClass_t ! ** boundary condition data attributes: DataClass_t
WRITE(6,401)' Dirichlet DataSet:' WRITE(6,401)' Dirichlet DataSet:'
CALL cg_dataclass_read_f(TYPE,ier) CALL cg_dataclass_read_f(TYPE,ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,600)' DataClass=', & WRITE(6,600)' DataClass=', &
DataClassName(TYPE) DataClassName(TYPE)
! ** boundary condition data attributes: DataArray_t ! ** boundary condition data attributes: DataArray_t
CALL cg_narrays_f(narrays, ier) CALL cg_narrays_f(narrays, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,127) ' DirichletData', & WRITE(6,127) ' DirichletData', &
' contains ', narrays,' data arrays' ' contains ', narrays,' data arrays'
DO iarray=1, narrays DO iarray=1, narrays
CALL cg_array_info_f(iarray, name, datatype, & CALL cg_array_info_f(iarray, name, datatype, &
nndim, dim_vals, ier) nndim, dim_vals, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,105) ' DataArray #',iarray,':' WRITE(6,105) ' DataArray #',iarray,':'
WRITE(6,600)' Name =',name WRITE(6,600)' Name =',name
skipping to change at line 1070 skipping to change at line 1072
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,106)& WRITE(6,106)&
(data_single(n),n=1,dim_vals(1)) (data_single(n),n=1,dim_vals(1))
ELSEIF (datatype .EQ. RealDouble) THEN ELSEIF (datatype .EQ. RealDouble) THEN
CALL cg_array_read_f(iarray, data_double, ier) CALL cg_array_read_f(iarray, data_double, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,106)& WRITE(6,106)&
(data_double(n),n=1,dim_vals(1)) (data_double(n),n=1,dim_vals(1))
ENDIF ENDIF
ENDDO ENDDO
ENDIF ENDIF
IF (NeumannFlag.EQ.1) THEN IF (NeumannFlag.EQ.1) THEN
CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, &
'ZoneBC_t', one, 'BC_t', boco, 'BCDataSet_t', & 'ZoneBC_t', one, 'BC_t', boco, 'BCDataSet_t', &
idataset, 'BCData_t', Neumann,'end') idataset, 'BCData_t', Neumann,'end')
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
! ** boundary condition data attributes: DataClass_t ! ** boundary condition data attributes: DataClass_t
CALL cg_dataclass_read_f(TYPE,ier) CALL cg_dataclass_read_f(TYPE,ier)
skipping to change at line 1114 skipping to change at line 1116
WRITE(6,106)& WRITE(6,106)&
(data_single(n),n=1,dim_vals(1)) (data_single(n),n=1,dim_vals(1))
ELSEIF (datatype .EQ. RealDouble) THEN ELSEIF (datatype .EQ. RealDouble) THEN
CALL cg_array_read_f(iarray, data_double, ier) CALL cg_array_read_f(iarray, data_double, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,106)& WRITE(6,106)&
(data_double(n),n=1,num) (data_double(n),n=1,num)
ENDIF ENDIF
ENDDO ! loop through DataArray ENDDO ! loop through DataArray
ENDIF ! if Neumann ENDIF ! if Neumann
ENDDO ! loop through dataset ENDDO ! loop through dataset
ENDDO ! loop through boco ENDDO ! loop through boco
ENDIF ! if ZoneBC_t exists ENDIF ! if ZoneBC_t exists
ENDDO ! zone loop ENDDO ! zone loop
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
! *** connectivity 1to1 - Global ! *** connectivity 1to1 - Global
WRITE(6,600)' Reading 1to1 connectivity for entire Base' WRITE(6,600)' Reading 1to1 connectivity for entire Base'
CALL cg_n1to1_global_f(cg, base, n1to1_global, ier) CALL cg_n1to1_global_f(cg, base, n1to1_global, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
WRITE(6,200)'n1to1_global=',n1to1_global WRITE(6,200)'n1to1_global=',n1to1_global
IF (n1to1_global .GT. 0) THEN IF (n1to1_global .GT. 0) THEN
skipping to change at line 1158 skipping to change at line 1160
G_donor_range(3,i), ') to (', & G_donor_range(3,i), ') to (', &
G_donor_range(4,i), ',', G_donor_range(5,i), ',', & G_donor_range(4,i), ',', G_donor_range(5,i), ',', &
G_donor_range(6,i), ')' G_donor_range(6,i), ')'
WRITE(6,133) 'Transform: ', '(', & WRITE(6,133) 'Transform: ', '(', &
G_transform(1,i), ',', & G_transform(1,i), ',', &
G_transform(2,i), ',', G_transform(3,i), ')' G_transform(2,i), ',', G_transform(3,i), ')'
ENDDO ENDDO
ENDIF ENDIF
ENDDO ! loop through bases ENDDO ! loop through bases
WRITE(6,400)' * * *' WRITE(6,400)' * * *'
CALL cg_close_f(cg, ier) CALL cg_close_f(cg, ier)
IF (ier .EQ. ERROR) CALL cg_error_exit_f IF (ier .EQ. ERROR) CALL cg_error_exit_f
100 FORMAT(a/,' Mass units: ',a/,' Length units: ',a/, & 100 FORMAT(a/,' Mass units: ',a/,' Length units: ',a/, &
' Temperature units: ',a/,' Time units: ',a/, & ' Temperature units: ',a/,' Time units: ',a/, &
' Angle units:',a) ' Angle units:',a)
101 FORMAT(A,I1,A,4(/A),/A,i4,A,/A,/A,/A,I4) 101 FORMAT(A,I1,A,4(/A),/A,i4,A,/A,/A,/A,I4)
 End of changes. 28 change blocks. 
42 lines changed or deleted 44 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)