program main !*****************************************************************************80 ! !! ice_io_test() tests ice_io(). ! ! Discussion: ! ! We begin by creating a file. ! ! The FORTRAN90 version of NETCDF was so unpleasant to install ! (modules, what a concept!) that this file was finished a month ! after the C version. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 19 November 2010 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Russ Rew, Glenn Davis, Steve Emmerson, Harvey Davies, Ed Hartne, ! The NETCDF User"s Guide, ! Unidata Program Center, March 2009. ! implicit none character ( len = 255 ) filename call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ICE_IO_TEST():' write ( *, '(a)' ) ' FORTRAN90 version' write ( *, '(a)' ) ' Test ICE_IO().' ! ! Create "hexahexa_2x2x2.nc" ! filename = 'hexahexa_2x2x2.nc' call test01 ( filename ) ! ! Read "hexahexa_2x2x2.nc" ! call test02 ( filename ) ! ! Create "cyl248.nc" ! filename = 'cyl248.nc' call test03 ( filename ) ! ! Read "cyl248.nc" ! call test02 ( filename ) ! ! Terminate. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ICE_IO_TEST():' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) ' ' call timestamp ( ) stop 0 end subroutine test01 ( filename ) !*****************************************************************************80 ! !! TEST01 creates the HEXAHEXA_2X2X2 dataset and writes it to NETCDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 23 October 2010 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Russ Rew, Glenn Davis, Steve Emmerson, Harvey Davies, Ed Hartne, ! The NETCDF User"s Guide, ! Unidata Program Center, March 2009. ! ! Parameters: ! ! Input, character ( len = * ) FILENAME, the name of the file to be created. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer dim integer, allocatable :: edge_label(:) integer, allocatable :: edge_vertex(:,:) integer edges character ( len = * ) filename integer, allocatable :: hexahedron_label(:) integer, allocatable :: hexahedron_vertex(:,:) integer hexahedrons integer, allocatable :: quadrilateral_label(:) integer, allocatable :: quadrilateral_vertex(:,:) integer quadrilaterals integer, allocatable :: tetrahedron_label(:) integer, allocatable :: tetrahedron_vertex(:,:) integer tetrahedrons integer, allocatable :: triangle_label(:) integer, allocatable :: triangle_vertex(:,:) integer triangles real ( kind = rk ), allocatable :: vertex_coordinate(:,:) integer, allocatable :: vertex_label(:) integer vertices write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST01:' write ( *, '(a)' ) ' Create an ICE grid dataset, print it,' write ( *, '(a)' ) ' and write it to an NETCDF file.' ! ! Get sizes. ! call hexahexa_2x2x2_size ( dim, vertices, edges, triangles, & quadrilaterals, tetrahedrons, hexahedrons ) ! ! Print sizes; ! call size_print ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons ) ! ! Allocate memory. ! allocate ( vertex_coordinate(3,vertices) ) allocate ( vertex_label(vertices) ) allocate ( edge_vertex(2,edges) ) allocate ( edge_label(edges) ) allocate ( triangle_vertex(3,triangles) ) allocate ( triangle_label(triangles) ) allocate ( quadrilateral_vertex(4,quadrilaterals) ) allocate ( quadrilateral_label(quadrilaterals) ) allocate ( tetrahedron_vertex(4,tetrahedrons) ) allocate ( tetrahedron_label(tetrahedrons) ) allocate ( hexahedron_vertex(8,hexahedrons) ) allocate ( hexahedron_label(hexahedrons) ) ! ! Get data. ! call hexahexa_2x2x2_data ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons, vertex_coordinate, vertex_label, edge_vertex, & edge_label, triangle_vertex, triangle_label, quadrilateral_vertex, & quadrilateral_label, tetrahedron_vertex, tetrahedron_label, & hexahedron_vertex, hexahedron_label ) ! ! Print the data. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Data to be written to "' // trim ( filename ) // '".' call data_print ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons, vertex_coordinate, vertex_label, edge_vertex, & edge_label, triangle_vertex, triangle_label, quadrilateral_vertex, & quadrilateral_label, tetrahedron_vertex, tetrahedron_label, & hexahedron_vertex, hexahedron_label ) ! ! Create the file. ! call ice_write ( filename, dim, vertices, edges, triangles, & quadrilaterals, tetrahedrons, hexahedrons, vertex_coordinate, & vertex_label, edge_vertex, edge_label, triangle_vertex, triangle_label, & quadrilateral_vertex, quadrilateral_label, tetrahedron_vertex, & tetrahedron_label, hexahedron_vertex, hexahedron_label ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Created the file "' // trim ( filename ) // '".' ! ! Free memory. ! deallocate ( vertex_coordinate ) deallocate ( vertex_label ) deallocate ( edge_vertex ) deallocate ( edge_label ) deallocate ( triangle_vertex ) deallocate ( triangle_label ) deallocate ( quadrilateral_vertex ) deallocate ( quadrilateral_label ) deallocate ( tetrahedron_vertex ) deallocate ( tetrahedron_label ) deallocate ( hexahedron_vertex ) deallocate ( hexahedron_label ) return end subroutine test02 ( filename ) !*****************************************************************************80 ! !! TEST02 reads an ICE grid dataset from a NETCDF file. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 19 November 2010 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Russ Rew, Glenn Davis, Steve Emmerson, Harvey Davies, Ed Hartne, ! The NETCDF User"s Guide, ! Unidata Program Center, March 2009. ! ! Parameters: ! ! Input, character ( len = * ) FILENAME, the name of the file to be read. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer dim integer, allocatable :: edge_label(:) integer, allocatable :: edge_vertex(:,:) integer edges character ( len = * ) filename integer, allocatable :: hexahedron_label(:) integer, allocatable :: hexahedron_vertex(:,:) integer hexahedrons integer, allocatable :: quadrilateral_label(:) integer, allocatable :: quadrilateral_vertex(:,:) integer quadrilaterals integer, allocatable :: tetrahedron_label(:) integer, allocatable :: tetrahedron_vertex(:,:) integer tetrahedrons integer, allocatable :: triangle_label(:) integer, allocatable :: triangle_vertex(:,:) integer triangles real ( kind = rk ), allocatable :: vertex_coordinate(:,:) integer, allocatable :: vertex_label(:) integer vertices write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST02' write ( *, '(a)' ) ' Read an ICE grid dataset from a NETCDF file,' write ( *, '(a)' ) ' and print the data.' ! ! Read sizes; ! call size_read ( filename, dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons ) ! ! Print sizes; ! call size_print ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons ) ! ! Allocate memory. ! allocate ( vertex_coordinate ( 3, vertices ) ) allocate ( vertex_label ( vertices ) ) allocate ( edge_vertex ( 2, edges ) ) allocate ( edge_label ( edges ) ) allocate ( triangle_vertex ( 3, triangles ) ) allocate ( triangle_label ( triangles ) ) allocate ( quadrilateral_vertex ( 4, quadrilaterals ) ) allocate ( quadrilateral_label ( quadrilaterals ) ) allocate ( tetrahedron_vertex ( 4, tetrahedrons ) ) allocate ( tetrahedron_label ( tetrahedrons ) ) allocate ( hexahedron_vertex ( 8, hexahedrons ) ) allocate ( hexahedron_label ( hexahedrons ) ) ! ! Read the file ! call data_read ( filename, dim, vertices, edges, triangles, & quadrilaterals, tetrahedrons, hexahedrons, vertex_coordinate, & vertex_label, edge_vertex, edge_label, triangle_vertex, triangle_label, & quadrilateral_vertex, quadrilateral_label, tetrahedron_vertex, & tetrahedron_label, hexahedron_vertex, hexahedron_label ) ! ! Print the data. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Data from file ' // trim ( filename ) // '".' call data_print ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons, vertex_coordinate, vertex_label, edge_vertex, & edge_label, triangle_vertex, triangle_label, quadrilateral_vertex, & quadrilateral_label, tetrahedron_vertex, tetrahedron_label, & hexahedron_vertex, hexahedron_label ) ! ! Free memory. ! deallocate ( vertex_coordinate ) deallocate ( vertex_label ) deallocate ( edge_vertex ) deallocate ( edge_label ) deallocate ( triangle_vertex ) deallocate ( triangle_label ) deallocate ( quadrilateral_vertex ) deallocate ( quadrilateral_label ) deallocate ( tetrahedron_vertex ) deallocate ( tetrahedron_label ) deallocate ( hexahedron_vertex ) deallocate ( hexahedron_label ) return end subroutine test03 ( filename ) !*****************************************************************************80 ! !! TEST03 creates the HEXAHEXA_2X2X2 dataset and writes it to NETCDF. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 19 November 2010 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Russ Rew, Glenn Davis, Steve Emmerson, Harvey Davies, Ed Hartne, ! The NETCDF User"s Guide, ! Unidata Program Center, March 2009. ! ! Parameters: ! ! Input, character ( len = * ) FILENAME, the name of the file to be created. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer dim integer, allocatable :: edge_label(:) integer, allocatable :: edge_vertex(:,:) integer edges character ( len = * ) filename integer, allocatable :: hexahedron_label(:) integer, allocatable :: hexahedron_vertex(:,:) integer hexahedrons integer, allocatable :: quadrilateral_label(:) integer, allocatable :: quadrilateral_vertex(:,:) integer quadrilaterals integer, allocatable :: tetrahedron_label(:) integer, allocatable :: tetrahedron_vertex(:,:) integer tetrahedrons integer, allocatable :: triangle_label(:) integer, allocatable :: triangle_vertex(:,:) integer triangles real ( kind = rk ), allocatable :: vertex_coordinate(:,:) integer, allocatable :: vertex_label(:) integer vertices write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST03:' write ( *, '(a)' ) ' Create an ICE grid dataset, print it,' write ( *, '(a)' ) ' and write it to an NETCDF file.' ! ! Get sizes. ! call cyl248_size ( dim, vertices, edges, triangles, & quadrilaterals, tetrahedrons, hexahedrons ) ! ! Print sizes; ! call size_print ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons ) ! ! Allocate memory. ! allocate ( vertex_coordinate(3,vertices) ) allocate ( vertex_label(vertices) ) allocate ( edge_vertex(2,edges) ) allocate ( edge_label(edges) ) allocate ( triangle_vertex(3,triangles) ) allocate ( triangle_label(triangles) ) allocate ( quadrilateral_vertex(4,quadrilaterals) ) allocate ( quadrilateral_label(quadrilaterals) ) allocate ( tetrahedron_vertex(4,tetrahedrons) ) allocate ( tetrahedron_label(tetrahedrons) ) allocate ( hexahedron_vertex(8,hexahedrons) ) allocate ( hexahedron_label(hexahedrons) ) ! ! Get data. ! call cyl248_data ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons, vertex_coordinate, vertex_label, edge_vertex, & edge_label, triangle_vertex, triangle_label, quadrilateral_vertex, & quadrilateral_label, tetrahedron_vertex, tetrahedron_label, & hexahedron_vertex, hexahedron_label ) ! ! Print the data. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Data to be written to "' // trim ( filename ) // '".' call data_print ( dim, vertices, edges, triangles, quadrilaterals, & tetrahedrons, hexahedrons, vertex_coordinate, vertex_label, edge_vertex, & edge_label, triangle_vertex, triangle_label, quadrilateral_vertex, & quadrilateral_label, tetrahedron_vertex, tetrahedron_label, & hexahedron_vertex, hexahedron_label ) ! ! Create the file. ! call ice_write ( filename, dim, vertices, edges, triangles, & quadrilaterals, tetrahedrons, hexahedrons, vertex_coordinate, & vertex_label, edge_vertex, edge_label, triangle_vertex, triangle_label, & quadrilateral_vertex, quadrilateral_label, tetrahedron_vertex, & tetrahedron_label, hexahedron_vertex, hexahedron_label ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Created the file "' // trim ( filename ) // '".' ! ! Free memory. ! deallocate ( vertex_coordinate ) deallocate ( vertex_label ) deallocate ( edge_vertex ) deallocate ( edge_label ) deallocate ( triangle_vertex ) deallocate ( triangle_label ) deallocate ( quadrilateral_vertex ) deallocate ( quadrilateral_label ) deallocate ( tetrahedron_vertex ) deallocate ( tetrahedron_label ) deallocate ( hexahedron_vertex ) deallocate ( hexahedron_label ) return end