1 2PROGRAM read_cgns_1 3 4 5#ifdef WINNT 6 INCLUDE 'cgnswin_f.h' 7#endif 8 USE ISO_C_BINDING 9 USE CGNS 10 IMPLICIT NONE 11 12 ! This program reads a 3D mesh, structured or unstructured. 13 14 15 INTEGER :: Ndim, Nglobal 16 PARAMETER (Ndim = 3) 17 PARAMETER (Nglobal = 500) 18 19 INTEGER :: i, narrays, iarray 20 INTEGER :: nintegrals, integral 21 INTEGER :: ndescriptors, idescr 22 INTEGER(cgenum_t) :: nzonetype 23 INTEGER(cgsize_t) :: nptsets 24 INTEGER(cgenum_t) :: ndonor_ptset_type, ndonor_data_type 25 INTEGER :: idataset, dirichletflag, neumannflag 26 INTEGER IndexDim, CellDim, PhysDim 27 INTEGER ier, n 28 INTEGER(cgenum_t) :: zonetype 29 INTEGER nbases, nzones 30 INTEGER(cgsize_t) :: rmin(3), DataSize(Ndim) 31 INTEGER(cgsize_t) :: SIZE(Ndim*3) 32 INTEGER :: ncoords, nsols, nfields 33 INTEGER(cgenum_t) :: location 34 INTEGER(cgenum_t) :: TYPE 35 INTEGER :: nholes, nconns, n1to1, n1to1_global, nbocos 36 INTEGER(cgenum_t) :: ptset_type 37 INTEGER(cgsize_t) :: npnts, pnts(100000), donor_pnts(100000) 38 INTEGER(cgsize_t) :: npnts_donor 39 INTEGER(cgenum_t) :: bocotype, datatype 40 CHARACTER*32 basename, zonename, solname, fieldname 41 CHARACTER*32 coordname, holename 42#ifndef CG_BASESCOPE 43 CHARACTER*32 connectname, donorname 44#else 45 CHARACTER*65 connectname, donorname 46#endif 47 CHARACTER*32 boconame 48 INTEGER cg, base, zone, coord, sol, field, discr 49 INTEGER :: hole, conn, one21, boco 50 INTEGER(cgsize_t) :: RANGE(Ndim, 2), donor_range(Ndim, 2) 51 INTEGER transform(Ndim) 52 INTEGER(cgsize_t) :: G_range(Ndim*2, Nglobal) 53 INTEGER(cgsize_t) :: G_donor_range(Ndim*2, Nglobal) 54 INTEGER :: G_transform(Ndim, Nglobal) 55 CHARACTER*32 G_zonename(Nglobal) 56#ifndef CG_BASESCOPE 57 CHARACTER*32 G_connectname(Nglobal), G_donorname(Nglobal) 58#else 59 CHARACTER*65 G_connectname(Nglobal), G_donorname(Nglobal) 60#endif 61 CHARACTER*32 name, filename 62 CHARACTER*40 text, NormDefinitions, StateDescription 63 INTEGER :: equation_dimension, GoverningEquationsFlag 64 INTEGER :: GasModelFlag, ViscosityModelFlag 65 INTEGER :: ThermalConductivityModelFlag 66 INTEGER :: TurbulenceClosureFlag, TurbulenceModelFlag 67 INTEGER :: diffusion_model(6) 68 INTEGER :: niterations 69 INTEGER :: rind(6), ndiscrete, num 70 INTEGER :: nndim 71 INTEGER(cgsize_t) :: dim_vals(12) 72 INTEGER(cgenum_t) :: mass, length, time, temp, deg 73 INTEGER :: NormalIndex(3), ndataset 74 INTEGER(cgsize_t) :: NormalListSize 75 REAL*4 data_single(100000) 76 DOUBLE PRECISION data_double(100000) 77 REAL*4 version 78 79 INTEGER one, is_cgns 80 PARAMETER (one = 1) 81 82 ! *** open file 83 ! write(6,*) 'Input filename' 84 ! read(5,600) filename 85 WRITE(filename,'(a)')'cgtest.cgns' 86 87 ! *** check if the file is CGNS 88 CALL cg_is_cgns_f(filename, is_cgns, ier) 89 IF (ier .EQ. ERROR) CALL cg_error_exit_f 90 IF ((is_cgns.NE.CG_FILE_ADF).AND.(is_cgns.NE.CG_FILE_HDF5).AND. & 91 (is_cgns.NE.CG_FILE_ADF2)) & 92 CALL cg_error_exit_f 93 94 ! *** check if the user passes a file name with the null terminator 95 CALL cg_is_cgns_f(TRIM(filename)//C_NULL_CHAR, is_cgns, ier) 96 IF (ier .EQ. ERROR) CALL cg_error_exit_f 97 IF ((is_cgns.NE.CG_FILE_ADF).AND.(is_cgns.NE.CG_FILE_HDF5).AND. & 98 (is_cgns.NE.CG_FILE_ADF2)) & 99 CALL cg_error_exit_f 100 101 CALL cg_open_f(filename, CG_MODE_READ, cg, ier) 102 IF (ier .EQ. ERROR) CALL cg_error_exit_f 103 WRITE(6,600)'READING FILE ',filename 104 105 ! *** CGNS Library Version used for file creation: 106 CALL cg_version_f(cg, version, ier) 107 IF (ier .EQ. ERROR) CALL cg_error_exit_f 108 WRITE(6,102) & 109 'Library Version used for file creation: ',version 110 111 ! *** base 112 CALL cg_nbases_f(cg, nbases, ier) 113 IF (ier .EQ. ERROR) CALL cg_error_exit_f 114 WRITE(6,200)'nbases=',nbases 115 116 DO base=1, nbases 117 118 CALL cg_base_read_f(cg, base, basename, CellDim, PhysDim, ier) 119 IF (ier .EQ. ERROR) CALL cg_error_exit_f 120 WRITE(6,300)'BaseName = "',TRIM(basename),'"', & 121 'cell_dimension=',CellDim 122 123 ! *** base attribute: GOTO base node 124 CALL cg_goto_f(cg, base, ier, 'end') 125 IF (ier .EQ. ERROR) CALL cg_error_exit_f 126 127 ! *** base attribute: Descriptor 128 CALL cg_descriptor_read_f(one, name, text, ier) 129 IF (ier .EQ. ERROR) CALL cg_error_exit_f 130 IF (ier.EQ.ALL_OK) THEN 131 WRITE(6,400)'Base Descriptor_t Information:' 132 WRITE(6,500)' DescriptorName="',TRIM(name),'"', & 133 ' DescriptorText="',TRIM(text),'"' 134 ENDIF 135 136 ! *** base attribute: flow equation set: 137 CALL cg_equationset_read_f(equation_dimension, & 138 GoverningEquationsFlag, GasModelFlag, & 139 ViscosityModelFlag, ThermalConductivityModelFlag, & 140 TurbulenceClosureFlag, TurbulenceModelFlag, ier) 141 IF (ier .EQ. ERROR) THEN 142 CALL cg_error_exit_f 143 ELSEIF (ier .EQ. NODE_NOT_FOUND) THEN 144 WRITE(6,200)& 145 'FlowEquationSet_t not defined under CGNSBase_t #',base 146 ELSEIF (ier .EQ. INCORRECT_PATH) THEN 147 WRITE(6,400)'Incorrect path input to cg_goto_f' 148 ELSE 149 WRITE(6,400) 'FlowEquationSet_t Information:' 150 WRITE(6,100)' equation_dimension=',equation_dimension 151 152 ! *** flow equation set attributes: GOTO FlowEquationSet_t node 153 CALL cg_goto_f(cg,base,ier,'FlowEquationSet_t',one,'end') 154 IF (ier .EQ. ERROR) CALL cg_error_exit_f 155 156 ! *** flow equation set attribute: Descriptor 157 CALL cg_descriptor_read_f(one, name,text,ier) 158 IF (ier .EQ. ERROR) CALL cg_error_exit_f 159 IF (ier .EQ. ALL_OK) WRITE(6,500) & 160 ' DescriptorName="',TRIM(name),'"',' DescriptorText="',TRIM(text),'"' 161 162 ! *** flow equation set attribute: Gas Model Type 163 IF (GasModelFlag.EQ.1) THEN 164 CALL cg_model_read_f('GasModel_t', TYPE, ier) 165 IF (ier .EQ. ERROR) CALL cg_error_exit_f 166 IF (ier .EQ. ALL_OK) WRITE(6,600) & 167 ' GasModelType="',TRIM(ModelTypeName(TYPE)),'"' 168 ENDIF 169 170 ! *** flow equation set attribute: ViscosityModel Type 171 IF (ViscosityModelFlag.EQ.1) THEN 172 CALL cg_model_read_f('ViscosityModel_t', TYPE, ier) 173 IF (ier .EQ. ERROR) CALL cg_error_exit_f 174 IF (ier .EQ. ALL_OK) WRITE(6,600) & 175 ' ViscosityModelType="',TRIM(ModelTypeName(TYPE)),'"' 176 ENDIF 177 178 ! *** flow equation set attribute: TypmlConductivityModel Type 179 IF (ThermalConductivityModelFlag.EQ.1) THEN 180 CALL cg_model_read_f('ThermalConductivityModel_t', & 181 TYPE, ier) 182 IF (ier .EQ. ERROR) CALL cg_error_exit_f 183 IF (ier .EQ. ALL_OK) WRITE(6,600) & 184 ' ThermalConductivityModelType=', & 185 TRIM(ModelTypeName(TYPE)),'"' 186 ENDIF 187 188 ! *** flow equation set attribute: TurbulenceClosureType 189 IF (TurbulenceClosureFlag.EQ.1) THEN 190 CALL cg_model_read_f('TurbulenceClosure_t', TYPE, ier) 191 IF (ier .EQ. ERROR) CALL cg_error_exit_f 192 IF (ier .EQ. ALL_OK) WRITE(6,600) & 193 ' TurbulenceClosureType="', TRIM(ModelTypeName(TYPE)),'"' 194 ENDIF 195 196 ! *** flow equation set attribute: TurbulenceModelType 197 IF (TurbulenceModelFlag.EQ.1) THEN 198 CALL cg_model_read_f('TurbulenceModel_t', TYPE, ier) 199 IF (ier .EQ. ERROR) CALL cg_error_exit_f 200 IF (ier .EQ. ALL_OK) WRITE(6,600) & 201 ' TurbulenceModelType="',TRIM(ModelTypeName(TYPE)),'"' 202 ENDIF 203 204 ! *** flow equation set attribute: Governing Equations Type 205 IF (GoverningEquationsFlag .EQ. 1) THEN 206 CALL cg_governing_read_f(TYPE, ier) 207 IF (ier .EQ. ERROR) CALL cg_error_exit_f 208 IF (ier.EQ.ALL_OK)& 209 WRITE(6,600)' GoverningEquationsType="', & 210 TRIM(GoverningEquationsTypeName(TYPE)),'"' 211 212 ! *** Governing Equations attribute: GOTO GoverningEquations_t node 213 CALL cg_goto_f(cg,base,ier, 'FlowEquationSet_t', one, & 214 'GoverningEquations_t', one ,'end') 215 IF (ier .EQ. ERROR) CALL cg_error_exit_f 216 217 218 ! *** Governing Equations attribute: Diffusion model 219 CALL cg_diffusion_read_f(diffusion_model, ier) 220 IF (ier .EQ. ERROR) CALL cg_error_exit_f 221 IF (ier.EQ.ALL_OK)WRITE(6,103)' Diffusion model=', & 222 (diffusion_model(i), i=1,6) 223 ENDIF ! If Governing Equations are defined 224 ENDIF ! If FlowEquationSet_t exists under CGNSBase_t 225 226 227 WRITE(6,400)' * * *' 228 229 CALL cg_nzones_f(cg, base, nzones, ier) 230 IF (ier .EQ. ERROR) CALL cg_error_exit_f 231 WRITE(6,200)'nzones=',nzones 232 233 ! *** zone 234 DO zone=1, nzones 235 CALL cg_zone_read_f(cg, base, zone, zonename, size, ier) 236 IF (ier .EQ. ERROR) CALL cg_error_exit_f 237 WRITE(6,104)'Name of Zone',zone,' is "',TRIM(zonename),'"' 238 239 CALL cg_zone_type_f(cg, base, zone, zonetype, ier) 240 IF (ier .EQ. ERROR) CALL cg_error_exit_f 241 WRITE(6,600)' Zone type is ', ZoneTypeName(zonetype) 242 243 244 IF (zonetype.EQ.Structured) THEN 245 IndexDim=CellDim 246 ELSE 247 IndexDim=1 248 ENDIF 249 250 251 WRITE(6,104)' IndexDimension=',IndexDim 252 253 ! *** zone attribute: GOTO zone node 254 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, 'end') 255 IF (ier .EQ. ERROR) CALL cg_error_exit_f 256 257 ! *** zone attribute: ordinal 258 CALL cg_ordinal_read_f(num, ier) 259 IF (ier .EQ. ERROR) CALL cg_error_exit_f 260 IF (ier .EQ. ALL_OK)& 261 WRITE(6,200)' Zone ordinal=',num 262 263 264 ! *** zone attribute: convergence history 265 CALL cg_convergence_read_f(niterations, & 266 NormDefinitions, ier) 267 IF (ier .EQ. ERROR) CALL cg_error_exit_f 268 269 IF (ier .EQ. ALL_OK) THEN 270 WRITE(6,600)'Convergence History of ',zonename 271 WRITE(6,104) ' niterations=',niterations, & 272 ' NormDefinitions="',TRIM(NormDefinitions),'"' 273 274 ! ** ConvergenceHistory_t attributes: 275 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 276 'ConvergenceHistory_t', one, 'end') 277 IF (ier .EQ. ERROR) CALL cg_error_exit_f 278 279 ! ** ConvergenceHistory_t attributes: DataArray_t 280 CALL cg_narrays_f(narrays, ier) 281 IF (ier .EQ. ERROR) CALL cg_error_exit_f 282 WRITE(6,105) 'ConvergenceHistory_t contains ', & 283 narrays,' array(s)' 284 DO iarray=1, narrays 285 CALL cg_array_info_f(iarray, name, datatype, & 286 nndim, dim_vals, ier) 287 IF (ier .EQ. ERROR) CALL cg_error_exit_f 288 289 WRITE(6,600) ' DataArrayName="',TRIM(name),'"' 290 WRITE(6,600) ' DataType="',TRIM(DataTypeName(datatype)),'"' 291 WRITE(6,200) ' DataNdim=',nndim 292 WRITE(6,200) ' DataDim=',dim_vals(1) 293 294 WRITE(6,105) ' Data:' 295 IF (datatype .EQ. RealSingle) THEN 296 CALL cg_array_read_f(iarray, data_single, ier) 297 IF (ier .EQ. ERROR) CALL cg_error_exit_f 298 WRITE(6,106) (data_single(n),n=1,dim_vals(1)) 299 ELSEIF (datatype .EQ. RealDouble) THEN 300 CALL cg_array_read_f(iarray, data_double, ier) 301 IF (ier .EQ. ERROR) CALL cg_error_exit_f 302 WRITE(6,106) (data_double(n),n=1,dim_vals(1)) 303 ENDIF 304 ENDDO 305 306 ! ** ConvergenceHistory_t attributes: DataClass_t 307 CALL cg_dataclass_read_f(TYPE,ier) 308 IF (ier .EQ. ERROR) CALL cg_error_exit_f 309 WRITE(6,600)'DataClassName=',DataClassName(TYPE) 310 311 ! ** ConvergenceHistory_t attributes: DimensionalUnits_t 312 CALL cg_units_read_f(mass, length, time, temp, deg, ier) 313 IF (ier .EQ. ERROR) CALL cg_error_exit_f 314 IF (ier .EQ. ALL_OK) THEN 315 WRITE(6,100) & 316 'Dimensional Units:', & 317 MassUnitsName(mass), LengthUnitsName(length), & 318 TemperatureUnitsName(temp), TimeUnitsName(time), & 319 AngleUnitsName(deg) 320 ENDIF 321 ENDIF 322 WRITE(6,400)' * * *' 323 324 ! *** zone attribute: return to Zone_t node 325 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, 'end') 326 IF (ier .EQ. ERROR) CALL cg_error_exit_f 327 WRITE(6,401)'Integral Data Information of ',zonename 328 329 CALL cg_nintegrals_f(nintegrals, ier) 330 IF (ier .EQ. ERROR) CALL cg_error_exit_f 331 WRITE(6,107) nintegrals, ' IntegralData_t node in ', & 332 zonename 333 334 ! *** zone attribute: IntegralData_t 335 DO integral=1, nintegrals 336 CALL cg_integral_read_f(integral, name, ier) 337 IF (ier .EQ. ERROR) CALL cg_error_exit_f 338 WRITE(6,104) 'IntegralData_t #',integral, & 339 ' is named "', TRIM(name),'"' 340 341 ! *** IntegralData_t attribute: GOTO IntegralData_t node 342 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 343 'IntegralData_t', integral, 'end') 344 IF (ier .EQ. ERROR) CALL cg_error_exit_f 345 346 CALL cg_narrays_f(narrays, ier) 347 IF (ier .EQ. ERROR) CALL cg_error_exit_f 348 WRITE(6,108) 'IntegralData_t #',integral, & 349 ' contains ', narrays,' data' 350 351 DO iarray=1, narrays 352 353 ! *** IntegralData_t attribute: DataArray_t 354 CALL cg_array_info_f(iarray, name, datatype, & 355 nndim, dim_vals, ier) 356 IF (ier .EQ. ERROR) CALL cg_error_exit_f 357 WRITE(6,600) ' DataArrayName="',TRIM(name),'"' 358 WRITE(6,600) ' DataType=',DataTypeName(datatype) 359 WRITE(6,108) ' DataNdim=',nndim, & 360 ', DataDim=',dim_vals(1) 361 362 IF (datatype .EQ. RealSingle) THEN 363 CALL cg_array_read_f(iarray, data_single, ier) 364 IF (ier .EQ. ERROR) CALL cg_error_exit_f 365 WRITE(6,109) ' integraldata=',data_single(1) 366 ELSEIF (datatype .EQ. RealDouble) THEN 367 CALL cg_array_read_f(iarray, data_double, ier) 368 IF (ier .EQ. ERROR) CALL cg_error_exit_f 369 WRITE(6,109) 'integraldata=',data_double(1) 370 ENDIF 371 372 ! *** DattaArray_t attribute: GOTO DataArray_t 373 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 374 'IntegralData_t', integral, & 375 'DataArray_t', iarray, 'end') 376 IF (ier .EQ. ERROR) CALL cg_error_exit_f 377 378 379 ! *** DattaArray_t attribute: DimensionalExponents_t 380 CALL cg_exponents_info_f(datatype, ier) 381 IF (ier .EQ. ERROR) THEN 382 CALL cg_error_exit_f 383 ELSEIF (ier .EQ. ALL_OK) THEN 384 WRITE(6,600)' Datatype for exponents is ', & 385 DataTypeName(datatype) 386 IF (datatype .EQ. RealSingle) THEN 387 CALL cg_exponents_read_f(data_single, ier) 388 IF (ier .EQ. ERROR) CALL cg_error_exit_f 389 WRITE(6,110)' Exponents:',(data_single(n),n=1,5) 390 ELSEIF (datatype .EQ. RealDouble) THEN 391 CALL cg_exponents_read_f(data_double, ier) 392 IF (ier .EQ. ERROR) CALL cg_error_exit_f 393 WRITE(6,110)' Exponents:',(data_double(n),n=1,5) 394 ENDIF 395 ENDIF 396 397 ! *** DattaArray_t attribute: DataConversion_t 398 CALL cg_conversion_info_f(datatype, ier) 399 IF (ier .EQ. ERROR) THEN 400 CALL cg_error_exit_f 401 ELSEIF (ier .EQ. ALL_OK) THEN 402 WRITE(6,600)' Datatype for conversion is ', & 403 DataTypeName(datatype) 404 IF (datatype .EQ. RealSingle) THEN 405 CALL cg_conversion_read_f(data_single, ier) 406 IF (ier .EQ. ERROR) CALL cg_error_exit_f 407 WRITE(6,110)' Conversion:',(data_single(n),n=1,2) 408 ELSEIF (datatype .EQ. RealDouble) THEN 409 CALL cg_conversion_read_f(data_double, ier) 410 IF (ier .EQ. ERROR) CALL cg_error_exit_f 411 WRITE(6,110)' Conversion:',(data_double(n),n=1,2) 412 ENDIF 413 ENDIF 414 415 ENDDO ! loop through DataArray_t 416 ENDDO ! loop through IntegralData_t 417 418 WRITE(6,400)' * * *' 419 420 ! *** zone coordinate attribute: GOTO GridCoordinates_t node 421 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 422 'GridCoordinates_t', one, 'end') 423 IF (ier .EQ. ERROR) CALL cg_error_exit_f 424 IF (ier .EQ. ALL_OK) THEN 425 426 ! *** GridCoordinates_t attribute: dimensional units 427 CALL cg_units_read_f(mass, length, time, temp, deg, ier) 428 IF (ier .EQ. ERROR) CALL cg_error_exit_f 429 IF (ier .EQ. ALL_OK) WRITE(6,400) & 430 'Dimensional Units for GridCoordinates_t: ', & 431 LengthUnitsName(length) 432 433 ! *** GridCoordinates_t attribute: Rind 434 CALL cg_rind_read_f(rind, ier) 435 IF (ier .EQ. ERROR) CALL cg_error_exit_f 436 WRITE(6,103)'GC Rind Data is ',(rind(i),i=1,6) 437 438 ! *** coordinate array 439 CALL cg_narrays_f(narrays, ier) 440 IF (ier .EQ. ERROR) CALL cg_error_exit_f 441 WRITE(6,105) 'GridCoordinates_t contains ', & 442 narrays,' arrays' 443 DO iarray=1,narrays 444 445 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 446 'GridCoordinates_t', one, 'end') 447 IF (ier .EQ. ERROR) CALL cg_error_exit_f 448 449 ! *** GridCoordinates_t attribute: DataArray_t 450 CALL cg_array_info_f(iarray, name, datatype, & 451 nndim, dim_vals, ier) 452 IF (ier .EQ. ERROR) CALL cg_error_exit_f 453 WRITE(6,600)' DataArrayName="',TRIM(name),'"' 454 WRITE(6,600)' DataType=',DataTypeName(datatype) 455 WRITE(6,104)' DataNdim=',nndim 456 DO i=1,nndim 457 WRITE(6,111)' DataDim(',i,')=',dim_vals(i) 458 ENDDO 459 460 ! *** Compute nr of data in data array: 461 num = 1 462 DO i=1,nndim 463 num = num*dim_vals(i) 464 ENDDO 465 466 IF (datatype .EQ. RealSingle) THEN 467 CALL cg_array_read_f(iarray, data_single, ier) 468 IF (ier .EQ. ERROR) CALL cg_error_exit_f 469 WRITE(6,106) (data_single(i),i=1,2) 470 WRITE(6,106) (data_single(i),i=num-1,num) 471 ELSEIF (datatype .EQ. RealDouble) THEN 472 CALL cg_array_read_f(iarray, data_double, ier) 473 IF (ier .EQ. ERROR) CALL cg_error_exit_f 474 WRITE(6,106) (data_double(i),i=1,2) 475 WRITE(6,106) (data_double(i),i=num-1,num) 476 ENDIF 477 478 ! *** coordinate attribute: GOTO coordinate array node 479 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 480 'GridCoordinates_t', one, 'DataArray_t', iarray, 'end') 481 IF (ier .EQ. ERROR) CALL cg_error_exit_f 482 483 CALL cg_ndescriptors_f(ndescriptors, ier) 484 IF (ier .EQ. ERROR) CALL cg_error_exit_f 485 WRITE(6,105) 'No. of descriptors=',ndescriptors 486 DO idescr=1, ndescriptors 487 CALL cg_descriptor_read_f(idescr, name, text, ier) 488 IF (ier .EQ. ERROR) CALL cg_error_exit_f 489 WRITE(6,500) ' DescriptorName="',TRIM(name),'"', & 490 ' DescriptorText="',TRIM(text),'"' 491 ENDDO 492 493 ENDDO ! loop through data arrays 494 495 ! *** read coordinates using coordinate arrays' specific functions: 496 497 WRITE(6,400)'Specific functions to read coordinates arrays' 498 CALL cg_ncoords_f(cg, base, zone, ncoords, ier) 499 IF (ier .EQ. ERROR) CALL cg_error_exit_f 500 WRITE(6,103)'no. of coordinates=',ncoords 501 502 ! ** Compute the nr of data to be read 503 DO i=1,IndexDim 504 rmin(i)=1 505 DataSize(i)=SIZE(i) + rind(2*i-1) + rind(2*i) 506 ENDDO 507 508 DO coord=1, ncoords 509 CALL cg_coord_info_f(cg, base, zone, coord, datatype, & 510 coordname, ier) 511 IF (ier .EQ. ERROR) CALL cg_error_exit_f 512 WRITE(6,112)'coord #',coord, & 513 ' datatype=',DataTypeName(datatype), & 514 ' name="',TRIM(coordname),'"' 515 516 IF (datatype .EQ. RealSingle) THEN 517 CALL cg_coord_read_f(cg, base, zone, coordname, & 518 cg_get_type(data_single(1)), rmin, DataSize, & 519 data_single, ier) 520 IF (ier .EQ. ERROR) CALL cg_error_exit_f 521 522 ELSEIF (datatype .EQ. RealDouble) THEN 523 CALL cg_coord_read_f(cg, base, zone, coordname, & 524 cg_get_type(data_double(1)), rmin, DataSize, & 525 data_double, ier) 526 IF (ier .EQ. ERROR) CALL cg_error_exit_f 527 ENDIF 528 ENDDO 529 ENDIF ! if GridCoordinates_t exists 530 531 WRITE(6,400)' * * *' 532 533 ! *** solution 534 535 CALL cg_nsols_f(cg, base, zone, nsols, ier) 536 IF (ier .EQ. ERROR) CALL cg_error_exit_f 537 WRITE(6,113) nsols,' FlowSolution_t node(s)', & 538 'found for ',zonename 539 540 ! *** Read solution with general cg_array_read function 541 DO sol=1, nsols 542 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 543 'FlowSolution_t', sol, 'end') 544 IF (ier .EQ. ERROR) CALL cg_error_exit_f 545 546 ! *** FlowSolution_t attribute: DataArray_t 547 CALL cg_narrays_f(narrays, ier) 548 IF (ier .EQ. ERROR) CALL cg_error_exit_f 549 WRITE(6,108) ' FlowSolution_t #',sol, & 550 ' contains ',narrays,' solution arrays' 551 552 ! *** FlowSolution_t attribute: GridLocation 553 CALL cg_gridlocation_read_f(location, ier) 554 IF (ier .EQ. ERROR) CALL cg_error_exit_f 555 WRITE(6,600)' The solution data are recorded at the ', & 556 GridLocationName(location) 557 558 ! *** FlowSolution_t attribute: Rind 559 CALL cg_rind_read_f(rind, ier) 560 IF (ier .EQ. ERROR) CALL cg_error_exit_f 561 WRITE(6,103)' The Rind Data is ',(rind(i),i=1,6) 562 563 DO iarray=1,narrays 564 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 565 'FlowSolution_t', sol, 'end') 566 IF (ier .EQ. ERROR) CALL cg_error_exit_f 567 568 CALL cg_array_info_f(iarray, name, datatype, & 569 nndim, dim_vals, ier) 570 IF (ier .EQ. ERROR) CALL cg_error_exit_f 571 WRITE(6,114) ' DataArray #',iarray 572 WRITE(6,600) ' Name="',TRIM(name),'"' 573 WRITE(6,600) ' DataType=',DataTypeName(datatype) 574 WRITE(6,103) ' DataNdim=',nndim 575 DO i=1,nndim 576 WRITE(6,111)' DataDim(',i,')=',dim_vals(i) 577 ENDDO 578 579 ! *** For dynamic memory allocation, compute the number of data to be read: 580 num = 1 581 DO i=1,nndim 582 num = num*dim_vals(i) 583 ENDDO 584 WRITE(6,200) 'Nr of data in solution vector=',num 585 586 IF (datatype .EQ. RealSingle) THEN 587 CALL cg_array_read_f(iarray, data_single, ier) 588 IF (ier .EQ. ERROR) CALL cg_error_exit_f 589 !write(6,106) (data_single(i),i=1,num) 590 ELSEIF (datatype .EQ. RealDouble) THEN 591 CALL cg_array_read_f(iarray, data_double, ier) 592 IF (ier .EQ. ERROR) CALL cg_error_exit_f 593 !write(6,106) (data_double(i),i=1,num) 594 ENDIF 595 596 ! *** solution field attribute: GOTO solution array node 597 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 598 'FlowSolution_t',sol,'DataArray_t',iarray,'end') 599 IF (ier .EQ. ERROR) CALL cg_error_exit_f 600 601 ! *** solution field attribute: DimensionalUnits 602 CALL cg_units_read_f(mass, length, time, temp, & 603 deg, ier) 604 IF (ier .EQ. ERROR) CALL cg_error_exit_f 605 IF (ier .EQ. ALL_OK) THEN 606 WRITE(6,100)& 607 ' Dimensional Units:', & 608 MassUnitsName(mass), LengthUnitsName(length), & 609 TemperatureUnitsName(temp), TimeUnitsName(time), & 610 AngleUnitsName(deg) 611 ENDIF 612 613 ENDDO ! loop through DataArray_t 614 WRITE(6,103)' ' 615 616 ! *** Reading solution data with solution specific functions: 617 CALL cg_sol_info_f(cg, base, zone, sol, solname, & 618 location, ier) 619 IF (ier .EQ. ERROR) CALL cg_error_exit_f 620 WRITE(6,115)'sol #',sol,':', & 621 ' solname="',TRIM(solname),'"', & 622 ' location=',GridLocationName(location) 623 624 ! *** Compute the nr of data to be read 625 626 IF (zonetype.EQ.Structured) THEN 627 DO i=1,3 628 DataSize(i)=SIZE(i) + rind(2*i-1) + rind(2*i) 629 IF (location.EQ.CellCenter) DataSize(i)=DataSize(i)-1 630 ENDDO 631 ELSE 632 DataSize(1)=SIZE(2) 633 ENDIF 634 635 ! *** solution field 636 CALL cg_nfields_f(cg, base, zone, sol, nfields, ier) 637 IF (ier .EQ. ERROR) CALL cg_error_exit_f 638 WRITE(6,105)' nfields=',nfields 639 640 DO field=1, nfields 641 CALL cg_field_info_f(cg, base, zone, sol, field, & 642 TYPE, fieldname, ier) 643 IF (ier .EQ. ERROR) CALL cg_error_exit_f 644 WRITE(6,115)' field #',field,':', & 645 ' fieldname="',TRIM(fieldname),'"', & 646 ' datatype=',DataTypeName(TYPE) 647 648 ! *** read entire range of solution data and record in double precision 649 CALL cg_field_read_f(cg, base, zone, sol, fieldname, & 650 RealDouble, rmin, DataSize, data_double, ier) 651 IF (ier .EQ. ERROR) CALL cg_error_exit_f 652 ENDDO ! field loop 653 654 ENDDO ! loop through FlowSolution_t 655 656 WRITE(6,400)' * * *' 657 658 ! *** discrete data under zone 659 CALL cg_ndiscrete_f(cg, base, zone, ndiscrete, ier) 660 IF (ier .EQ. ERROR) CALL cg_error_exit_f 661 IF (ier .EQ. ALL_OK) WRITE(6,113)ndiscrete, & 662 ' DiscreteData_t node(s) found under ',zonename 663 664 DO discr=1, ndiscrete 665 CALL cg_discrete_read_f(cg, base,zone, discr, name, ier) 666 IF (ier .EQ. ERROR) CALL cg_error_exit_f 667 WRITE(6,600)' name=',name 668 669 ! *** discrete data attribute: GOTO DiscreteData_t node 670 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 671 'DiscreteData_t', discr, 'end') 672 IF (ier .EQ. ERROR) CALL cg_error_exit_f 673 674 ! *** discrete data attribute: GridLocation_t 675 CALL cg_gridlocation_read_f(location, ier) 676 IF (ier .EQ. ERROR) CALL cg_error_exit_f 677 IF (ier .EQ. ALL_OK) WRITE(6,600) & 678 ' The location of the DiscreteData vector is ', & 679 GridLocationName(location) 680 681 ! *** discrete data arrays: 682 CALL cg_narrays_f(narrays, ier) 683 IF (ier .EQ. ERROR) CALL cg_error_exit_f 684 WRITE(6,116) ' DiscreteData #', discr, & 685 ' contains ', narrays,' arrays' 686 DO iarray=1, narrays 687 CALL cg_array_info_f(iarray, name, datatype, & 688 nndim, dim_vals, ier) 689 IF (ier .EQ. ERROR) CALL cg_error_exit_f 690 691 WRITE(6,116) 'DataArray #',iarray,':' 692 WRITE(6,600)' Name =',name 693 WRITE(6,600)' Datatype=', & 694 DataTypeName(datatype) 695 696 ! *** compute nr of data to be read 697 num=1 698 DO n=1, nndim 699 num=num*dim_vals(n) 700 ENDDO 701 702 IF (datatype .EQ. RealSingle) THEN 703 CALL cg_array_read_f(iarray, data_single, ier) 704 IF (ier .EQ. ERROR) CALL cg_error_exit_f 705 !write(6,*) (data_single(n),n=1,num) 706 ELSEIF (datatype .EQ. RealDouble) THEN 707 CALL cg_array_read_f(iarray, data_double, ier) 708 IF (ier .EQ. ERROR) CALL cg_error_exit_f 709 !write(6,*) (data_double(n),n=1,num) 710 ENDIF 711 712 ! *** discrete data arrays attribute: GOTO DataArray node 713 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 714 'DiscreteData_t', discr, 'DataArray_t', iarray, 'end') 715 IF (ier .EQ. ERROR) CALL cg_error_exit_f 716 717 CALL cg_units_read_f(mass, length, time, temp, deg, ier) 718 IF (ier .EQ. ERROR) CALL cg_error_exit_f 719 IF (ier .EQ. ALL_OK) THEN 720 WRITE(6,100)& 721 ' Dimensional Units for DiscreteData_t:', & 722 MassUnitsName(mass), LengthUnitsName(length), & 723 TemperatureUnitsName(temp), TimeUnitsName(time), & 724 AngleUnitsName(deg) 725 ENDIF 726 ENDDO ! loop through DataArray_t 727 ENDDO 728 729 WRITE(6,400)' * * *' 730 731 ! *** Interblock Connectivity: 732 WRITE(6,401)'Interblock Connectivity for ',zonename 733 734 ! *** ZoneGridConnectivity attributes: GOTO ZoneGridConnectivity_t node 735 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 736 'ZoneGridConnectivity_t', one, 'end') 737 IF (ier .EQ. ERROR) CALL cg_error_exit_f 738 739 IF (ier.EQ. ALL_OK) THEN 740 ! *** ZoneGridConnectivity attributes: Descriptor_t 741 CALL cg_ndescriptors_f(ndescriptors, ier) 742 IF (ier .NE. 0) CALL cg_error_exit_f 743 WRITE(6,117)& 744 ndescriptors, ' descriptors for ZoneGridConnectivity_t' 745 DO idescr=1, ndescriptors 746 CALL cg_descriptor_read_f(idescr, name, text, ier) 747 IF (ier .EQ. ERROR) CALL cg_error_exit_f 748 WRITE(6,500) ' DescriptorName="',TRIM(name),'"', & 749 ' DescriptorText="',TRIM(text),'"' 750 ENDDO 751 752 753 ! *** overset holes 754 CALL cg_nholes_f(cg, base, zone, nholes, ier) 755 IF (ier .EQ. ERROR) CALL cg_error_exit_f 756 WRITE(6,107) nholes, ' holes found' 757 758 DO hole=1, nholes 759 CALL cg_hole_info_f(cg, base, zone, hole, holename, & 760 location, ptset_type, nptsets, npnts, ier) 761 IF (ier .EQ. ERROR) CALL cg_error_exit_f 762 WRITE(6,118)& 763 ' hole #',hole,':', ' holename="',TRIM(holename),'"', & 764 ' data location=',GridLocationName(location), & 765 ' nptsets = ',nptsets, & 766 ', total no. of points =',npnts 767 768 IF (npnts .LT. 30000) THEN 769 CALL cg_hole_read_f(cg, base, zone, hole, pnts, ier) 770 IF (ier .EQ. ERROR) CALL cg_error_exit_f 771 ENDIF 772 773 ! *** overset holes attributes: GOTO OversetHoles_t node 774 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 775 'ZoneGridConnectivity_t', one, & 776 'OversetHoles_t', hole, 'end') 777 IF (ier .NE. 0) CALL cg_error_exit_f 778 779 CALL cg_ndescriptors_f(ndescriptors, ier) 780 IF (ier .NE. 0) CALL cg_error_exit_f 781 WRITE(6,117)& 782 ndescriptors, ' descriptors for ',holename 783 DO idescr=1, ndescriptors 784 CALL cg_descriptor_read_f(idescr, name, text, ier) 785 IF (ier .EQ. ERROR) CALL cg_error_exit_f 786 WRITE(6,500) ' DescriptorName="',TRIM(name),'"', & 787 ' DescriptorText="',TRIM(text),'"' 788 ENDDO 789 ENDDO !hole loop 790 791 792 793 ! *** general connectivity 794 CALL cg_nconns_f(cg, base, zone, nconns, ier) 795 IF (ier .EQ. ERROR) CALL cg_error_exit_f 796 WRITE(6,107) nconns,' GridConnectivity_t found' 797 DO conn=1, nconns 798 CALL cg_conn_info_f(cg, base, zone, conn, connectname, & 799 location, TYPE, ptset_type, npnts, donorname, & 800 nzonetype, ndonor_ptset_type, ndonor_data_type, & 801 npnts_donor, ier) 802 IF (ier .EQ. ERROR) CALL cg_error_exit_f 803 804 WRITE(6, 101) & 805 ' GridConnectivity #',conn,':', & 806 ' connect name ='//TRIM(connectname), & 807 ' Grid location='//TRIM(GridLocationName(location)), & 808 ' Connect-type ='//TRIM(GridConnectivityTypeName(TYPE)), & 809 ' ptset type ="'//TRIM(PointSetTypeName(ptset_type))//'"', & 810 ' npnts=',npnts,' donorname="'//TRIM(donorname)//'"', & 811 ' donor zonetype='//TRIM(ZoneTypeName(nzonetype)), & 812 ' donor ptset type='//TRIM(PointSetTypeName(ndonor_ptset_type)), & 813 ' npnts_donor=',npnts_donor 814 815 CALL cg_conn_read_f(cg, base, zone, conn, pnts, & 816 cg_get_type(donor_pnts(1)), & 817 donor_pnts, ier) 818 IF (ier .EQ. ERROR) CALL cg_error_exit_f 819 820 WRITE(6,119) ' Current zone:', & 821 ' first point:', pnts(1),pnts(2),pnts(3), & 822 ' last point :', pnts(3*npnts-2), pnts(3*npnts-1), & 823 pnts(3*npnts) 824 WRITE(6,119) ' Donor zone:', & 825 ' first point:', donor_pnts(1),donor_pnts(2), & 826 donor_pnts(3), & 827 ' last point :', donor_pnts(3*npnts-2), & 828 donor_pnts(3*npnts-1), & 829 donor_pnts(3*npnts) 830 831 ! *** general connectivity attributes: GOTO GridConnectivity_t node 832 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 833 'ZoneGridConnectivity_t', one, & 834 'GridConnectivity_t', conn, 'end') 835 IF (ier .EQ. ERROR) CALL cg_error_exit_f 836 837 CALL cg_ordinal_read_f(num, ier) 838 IF (ier .EQ. ERROR) CALL cg_error_exit_f 839 IF (ier .EQ. ALL_OK) WRITE(6,200)' Ordinal=',num 840 ENDDO 841 842 ! *** connectivity 1to1 843 CALL cg_n1to1_f(cg, base, zone, n1to1, ier) 844 IF (ier .EQ. ERROR) CALL cg_error_exit_f 845 WRITE(6,107) n1to1,' GridConnectivity1to1_t found' 846 847 DO one21=1, n1to1 848 CALL cg_1to1_read_f(cg, base, zone, one21, connectname, & 849 donorname, range, donor_range, transform, ier) 850 IF (ier .EQ. ERROR) CALL cg_error_exit_f 851 852 WRITE(6,105) 'GridConnectivity1to1 #',one21 853 WRITE(6,600) 'connectname="',TRIM(connectname),'"' 854 WRITE(6,600) 'donorname ="',TRIM(donorname),'"' 855 856 WRITE(6,120) ' range: ', & 857 '(',RANGE(1,1),',',RANGE(2,1),',',RANGE(3,1), & 858 ') to (',RANGE(1,2),',',RANGE(2,2),',',RANGE(3,2),')' 859 860 WRITE(6,121)' donor_range: ', & 861 '(', donor_range(1,1), ',', donor_range(2,1), ',', & 862 donor_range(3,1), ') to (', & 863 donor_range(1,2), ',', donor_range(2,2), ',', & 864 donor_range(3,2), ')' 865 866 WRITE(6,122) ' Transform: ', '(', & 867 transform(1), ',', & 868 transform(2), ',', transform(3), ')' 869 870 871 ! *** connectivity 1to1 attributes: GOTO GridConnectivity1to1_t node 872 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 873 'ZoneGridConnectivity_t', one, & 874 'GridConnectivity1to1_t', one21, 'end') 875 IF (ier .EQ. ERROR) CALL cg_error_exit_f 876 IF (ier .EQ. ALL_OK) THEN 877 878 ! *** connectivity 1to1 attributes: Descriptor_t 879 CALL cg_ndescriptors_f(ndescriptors, ier) 880 IF (ier .NE. 0) CALL cg_error_exit_f 881 WRITE(6,117)& 882 ndescriptors, ' descriptors for ',connectname 883 DO idescr=1, ndescriptors 884 CALL cg_descriptor_read_f(idescr, name, text, ier) 885 IF (ier .EQ. ERROR) CALL cg_error_exit_f 886 WRITE(6,500) ' DescriptorName="',TRIM(name),'"', & 887 ' DescriptorText="',TRIM(text),'"' 888 ENDDO 889 ENDIF 890 ENDDO 891 ENDIF ! if ZoneGridConnectivity exists 892 893 WRITE(6,400)' * * *' 894 895 ! *** bocos 896 WRITE(6,600)'Boundary Conditions for ',zonename 897 898 899 ! *** Zone bound. condition attributes: GOTO ZoneBC_t node 900 CALL cg_goto_f(cg, base,ier, 'Zone_t', zone, & 901 'ZoneBC_t', one, 'end') 902 IF (ier .EQ. ERROR) CALL cg_error_exit_f 903 IF (ier .EQ. ALL_OK) THEN 904 905 ! *** Zone bound. condition attributes: ReferenceState_t 906 CALL cg_state_read_f(StateDescription, ier) 907 IF (ier .EQ. ERROR) CALL cg_error_exit_f 908 IF (ier.EQ.ALL_OK) THEN 909 WRITE(6,600)' ReferenceState defined under ZoneBC_t' 910 WRITE(6,600)' StateDescription=',StateDescription 911 912 ! ** ReferenceState_t attributes: GOTO ReferenceState_t 913 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 914 'ZoneBC_t', one, 'ReferenceState_t', one, 'end') 915 IF (ier .EQ. ERROR) CALL cg_error_exit_f 916 917 CALL cg_narrays_f(narrays, ier) 918 IF (ier .EQ. ERROR) CALL cg_error_exit_f 919 WRITE(6,105) ' ReferenceState_t contains ', & 920 narrays,' array(s)' 921 922 DO iarray=1, narrays 923 924 CALL cg_array_info_f(iarray, name, datatype, & 925 nndim, dim_vals, ier) 926 IF (ier .EQ. ERROR) CALL cg_error_exit_f 927 928 WRITE(6,105) ' DataArray #',iarray,':' 929 WRITE(6,600)' Name =',name 930 WRITE(6,600)' Datatype=',DataTypeName(datatype) 931 932 WRITE(6,600)' Data:' 933 IF (datatype .EQ. RealSingle) THEN 934 CALL cg_array_read_f(iarray, data_single, ier) 935 IF (ier .EQ. ERROR) CALL cg_error_exit_f 936 WRITE(6,124) data_single(1) 937 ELSEIF (datatype .EQ. RealDouble) THEN 938 CALL cg_array_read_f(iarray, data_double, ier) 939 IF (ier .EQ. ERROR) CALL cg_error_exit_f 940 WRITE(6,124) data_double(1) 941 ENDIF 942 ENDDO 943 944 945 ! ** ReferenceState_t attributes: DimensionalUnits_t 946 CALL cg_units_read_f(mass, length, time, temp, & 947 deg, ier) 948 IF (ier .EQ. ERROR) CALL cg_error_exit_f 949 IF (ier .EQ. ALL_OK) THEN 950 WRITE(6,100)& 951 ' Dimensional Units:', & 952 MassUnitsName(mass), LengthUnitsName(length), & 953 TemperatureUnitsName(temp), TimeUnitsName(time), & 954 AngleUnitsName(deg) 955 ENDIF 956 ENDIF !if ReferenceState exists under ZoneBC_t 957 958 CALL cg_nbocos_f(cg, base, zone, nbocos, ier) 959 IF (ier .EQ. ERROR) CALL cg_error_exit_f 960 WRITE(6,113)nbocos,' bound. conditions found for ', & 961 zonename 962 963 DO boco=1, nbocos 964 CALL cg_boco_info_f(cg, base, zone, boco, boconame, & 965 bocotype, ptset_type, npnts, & 966 NormalIndex, NormalListSize, datatype, & 967 ndataset, ier) 968 IF (ier .EQ. ERROR) CALL cg_error_exit_f 969 WRITE(6,105) ' boundary condition #',boco 970 WRITE(6,600) ' boconame=',boconame 971 WRITE(6,600) ' bocotype=',BCTypeName(bocotype) 972 WRITE(6,600) ' ptset_type=', & 973 PointSetTypeName(ptset_type) 974 WRITE(6,103) ' NormalIndex=', & 975 NormalIndex(1),NormalIndex(2), NormalIndex(3) 976 WRITE(6,104) ' NormalListSize=',NormalListSize 977 WRITE(6,600) ' datatype for normals=', & 978 DataTypeName(datatype) 979 980 ! read patch points and InwardNormalList 981 IF (datatype.EQ.RealSingle) THEN 982 CALL cg_boco_read_f(cg, base, zone, boco, pnts, & 983 data_single, ier) 984 IF (ier .EQ. ERROR) CALL cg_error_exit_f 985 ELSEIF (datatype.EQ.RealDouble) THEN 986 CALL cg_boco_read_f(cg, base, zone, boco, pnts, & 987 data_double, ier) 988 IF (ier .EQ. ERROR) CALL cg_error_exit_f 989 ENDIF 990 991 WRITE(6,119) ' Bound. Condition Patch:', & 992 ' first point:', pnts(1),pnts(2),pnts(3), & 993 ' last point :', pnts(3*npnts-2), pnts(3*npnts-1), & 994 pnts(3*npnts) 995 996 IF (NormalListSize .NE. 0) THEN 997 IF (datatype.EQ.RealSingle) & 998 WRITE(6,126) ' Normals:', & 999 ' first point:', data_single(1),data_single(2), & 1000 data_single(3), & 1001 ' last point :', data_single(3*npnts-2), & 1002 data_single(3*npnts-1), & 1003 data_single(3*npnts) 1004 IF (datatype.EQ.RealDouble) & 1005 WRITE(6,126) ' Normals:', & 1006 ' first point:', data_double(1),data_double(2), & 1007 data_double(3), & 1008 ' last point :', data_double(3*npnts-2), & 1009 data_double(3*npnts-1), & 1010 data_double(3*npnts) 1011 ENDIF 1012 ! *** bound. condition attributes: GOTO BC_t node 1013 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 1014 'ZoneBC_t', one, 'BC_t', boco, 'end') 1015 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1016 1017 ! *** bound. condition attributes: DataClass_t 1018 CALL cg_dataclass_read_f(TYPE,ier) 1019 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1020 IF (ier.EQ.ALL_OK)& 1021 WRITE(6,600)' B.C. DataClass=', & 1022 DataClassName(TYPE) 1023 1024 ! *** boundary condition attributes: GridLocation_t 1025 CALL cg_gridlocation_read_f(location, ier) 1026 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1027 IF (ier.EQ.ALL_OK)& 1028 WRITE(6,600)' data location=', & 1029 GridLocationName(location) 1030 1031 ! ** boundary condition dataset 1032 WRITE(6,103) ' ndataset=',ndataset 1033 DO idataset=1, ndataset 1034 CALL cg_dataset_read_f(cg, base, zone, boco,idataset, & 1035 name, TYPE, DirichletFlag, NeumannFlag, ier) 1036 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1037 1038 WRITE(6,103)' Dataset #',idataset 1039 WRITE(6,600)' Name=',name 1040 WRITE(6,600)' BCType=',BCTypeName(TYPE) 1041 1042 ! ** boundary condition data: GOTO BCData_t node 1043 IF (DirichletFlag.EQ.1) THEN 1044 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 1045 'ZoneBC_t', one, 'BC_t', boco, 'BCDataSet_t', & 1046 idataset,'BCData_t',Dirichlet,'end') 1047 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1048 1049 ! ** boundary condition data attributes: DataClass_t 1050 WRITE(6,401)' Dirichlet DataSet:' 1051 CALL cg_dataclass_read_f(TYPE,ier) 1052 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1053 WRITE(6,600)' DataClass=', & 1054 DataClassName(TYPE) 1055 1056 ! ** boundary condition data attributes: DataArray_t 1057 CALL cg_narrays_f(narrays, ier) 1058 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1059 WRITE(6,127) ' DirichletData', & 1060 ' contains ', narrays,' data arrays' 1061 DO iarray=1, narrays 1062 CALL cg_array_info_f(iarray, name, datatype, & 1063 nndim, dim_vals, ier) 1064 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1065 1066 WRITE(6,105) ' DataArray #',iarray,':' 1067 WRITE(6,600)' Name =',name 1068 WRITE(6,600)' Datatype=', & 1069 DataTypeName(datatype) 1070 1071 WRITE(6,105)' Dirichlet Data:' 1072 IF (datatype .EQ. RealSingle) THEN 1073 CALL cg_array_read_f(iarray, data_single, ier) 1074 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1075 WRITE(6,106)& 1076 (data_single(n),n=1,dim_vals(1)) 1077 1078 ELSEIF (datatype .EQ. RealDouble) THEN 1079 CALL cg_array_read_f(iarray, data_double, ier) 1080 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1081 WRITE(6,106)& 1082 (data_double(n),n=1,dim_vals(1)) 1083 ENDIF 1084 ENDDO 1085 ENDIF 1086 1087 IF (NeumannFlag.EQ.1) THEN 1088 CALL cg_goto_f(cg, base, ier, 'Zone_t', zone, & 1089 'ZoneBC_t', one, 'BC_t', boco, 'BCDataSet_t', & 1090 idataset, 'BCData_t', Neumann,'end') 1091 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1092 1093 ! ** boundary condition data attributes: DataClass_t 1094 CALL cg_dataclass_read_f(TYPE,ier) 1095 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1096 WRITE(6,600)' DataClass=', & 1097 DataClassName(TYPE) 1098 1099 ! ** boundary condition data attributes: DataArray_t 1100 CALL cg_narrays_f(narrays, ier) 1101 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1102 WRITE(6,105) & 1103 ' Neumann Data contains ', narrays,' data arrays' 1104 DO iarray=1, narrays 1105 CALL cg_array_info_f(iarray, name, datatype, & 1106 nndim, dim_vals, ier) 1107 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1108 1109 WRITE(6,105) ' DataArray #',iarray,':' 1110 WRITE(6,600)' Name =',name 1111 WRITE(6,600)' Datatype=', & 1112 DataTypeName(datatype) 1113 1114 WRITE(6,400)' Neumann Data:' 1115 IF (datatype .EQ. RealSingle) THEN 1116 CALL cg_array_read_f(iarray, data_single, ier) 1117 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1118 WRITE(6,106)& 1119 (data_single(n),n=1,dim_vals(1)) 1120 1121 ELSEIF (datatype .EQ. RealDouble) THEN 1122 CALL cg_array_read_f(iarray, data_double, ier) 1123 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1124 WRITE(6,106)& 1125 (data_double(n),n=1,num) 1126 ENDIF 1127 1128 ENDDO ! loop through DataArray 1129 ENDIF ! if Neumann 1130 ENDDO ! loop through dataset 1131 ENDDO ! loop through boco 1132 ENDIF ! if ZoneBC_t exists 1133 ENDDO ! zone loop 1134 1135 WRITE(6,400)' * * *' 1136 1137 ! *** connectivity 1to1 - Global 1138 WRITE(6,600)' Reading 1to1 connectivity for entire Base' 1139 CALL cg_n1to1_global_f(cg, base, n1to1_global, ier) 1140 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1141 WRITE(6,200)'n1to1_global=',n1to1_global 1142 1143 IF (n1to1_global .GT. 0) THEN 1144 CALL cg_1to1_read_global_f(cg, base, & 1145 G_connectname, G_zonename, G_donorname, & 1146 G_range, G_donor_range, G_transform, ier) 1147 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1148 1149 DO i=1, n1to1_global 1150 WRITE(6,600) ' ' 1151 WRITE(6,130) '*** interface #',i,' ***' 1152 WRITE(6,600) 'G_connectname="',TRIM(G_connectname(i)),'"' 1153 WRITE(6,600) 'G_zonename ="',TRIM(G_zonename(i)),'"' 1154 WRITE(6,600) 'G_donorname ="',TRIM(G_donorname(i)),'"' 1155 1156 WRITE(6,131) 'G_range: ', & 1157 '(',G_range(1,i),',',G_range(2,i),',',G_range(3,i), & 1158 ') to (',G_range(4,i),',',G_range(5,i),',',G_range(6,i),')' 1159 1160 WRITE(6,132) 'G_donor_range: ', & 1161 '(', G_donor_range(1,i), ',', G_donor_range(2,i), ',', & 1162 G_donor_range(3,i), ') to (', & 1163 G_donor_range(4,i), ',', G_donor_range(5,i), ',', & 1164 G_donor_range(6,i), ')' 1165 1166 WRITE(6,133) 'Transform: ', '(', & 1167 G_transform(1,i), ',', & 1168 G_transform(2,i), ',', G_transform(3,i), ')' 1169 ENDDO 1170 ENDIF 1171 1172 1173 ENDDO ! loop through bases 1174 1175 WRITE(6,400)' * * *' 1176 1177 CALL cg_close_f(cg, ier) 1178 IF (ier .EQ. ERROR) CALL cg_error_exit_f 1179 1180100 FORMAT(a/,' Mass units: ',a/,' Length units: ',a/, & 1181 ' Temperature units: ',a/,' Time units: ',a/, & 1182 ' Angle units:',a) 1183101 FORMAT(A,I1,A,4(/A),/A,i4,A,/A,/A,/A,I4) 1184102 FORMAT(a,f5.3) 1185103 FORMAT(a,6i2) 1186104 FORMAT(a,i5,3a) 1187105 FORMAT(a,i2,a) 1188106 FORMAT(6f10.3) 1189107 FORMAT(i2,2a) 1190108 FORMAT(a,i2,a,i2,a) 1191109 FORMAT(a,f5.1) 1192110 FORMAT(a,5f5.1) 1193111 FORMAT(a,i1,a,i8) 1194112 FORMAT(a,i1/2a/3a) 1195113 FORMAT(i1,3a) 1196114 FORMAT(/a, i1) 1197115 FORMAT(a,i1,a/3a/2a) 1198116 FORMAT(a,i1,a,i1,a) 1199117 FORMAT(/i4,2a) 1200118 FORMAT(a,i1,a/3a/2a/a,i1,a,i5) 1201119 FORMAT(a/a,3i2/a,3i2) 1202120 FORMAT(a10, 3(a1,i1),a6,3(i1,a1)) 1203121 FORMAT(a16,3(a1,i1),a6,3(i1,a1)) 1204122 FORMAT(a12,3(a1,i2),a1) 1205124 FORMAT(4x, f7.2) 1206126 FORMAT(a/a,3f5.2/a,3f5.2) 1207127 FORMAT(2a,i1,a) 1208130 FORMAT(a15, i2, a4) 1209131 FORMAT(a10, 3(a1,i1),a6,3(i1,a1)) 1210132 FORMAT(a16,3(a1,i1),a6,3(i1,a1)) 1211133 FORMAT(a12,3(a1,i2),a1) 1212200 FORMAT(a,i5) 1213300 FORMAT(3a/a,i2) 1214400 FORMAT(/a/) 1215401 FORMAT(/2a/) 1216500 FORMAT(3a/3a) 1217600 FORMAT(3a) 1218 12199999 END PROGRAM read_cgns_1 1220