Commit 666cd5d1 authored by Keith Bennett's avatar Keith Bennett

Merge branch 'keith/path_mesh' into 'master'

Added sdf_write_srl_path_mesh routine

See merge request !27
parents 0f8e24f4 9e5e001a
......@@ -168,6 +168,7 @@ MODULE sdf
PUBLIC :: sdf_write_plain_variable
PUBLIC :: sdf_write_point_mesh
PUBLIC :: sdf_write_point_variable
PUBLIC :: sdf_write_srl_path_mesh
PUBLIC :: sdf_write_srl_plain_mesh
PUBLIC :: sdf_write_srl_point_mesh
PUBLIC :: sdf_write_srl_point_variable
......
......@@ -27,6 +27,16 @@ MODULE sdf_output_cartesian
write_srl_3d_lag_mesh_r8
END INTERFACE sdf_write_srl_plain_mesh
INTERFACE sdf_write_srl_path_mesh
MODULE PROCEDURE &
write_srl_1d_mesh_r4, &
write_srl_1d_mesh_r8, &
write_srl_2d_path_mesh_r4, &
write_srl_3d_path_mesh_r4, &
write_srl_2d_path_mesh_r8, &
write_srl_3d_path_mesh_r8
END INTERFACE sdf_write_srl_path_mesh
INTERFACE sdf_write_plain_mesh
MODULE PROCEDURE &
write_1d_mesh_r4, &
......
......@@ -899,6 +899,217 @@ CONTAINS
!----------------------------------------------------------------------------
! Code to write a 1D path mesh for a 2D domain in serial from the node with
! rank {rank_write}
! Serial operation, so no need to specify dims
!----------------------------------------------------------------------------
SUBROUTINE write_srl_2d_path_mesh_r4(h, id, name, x, y, convert_in, &
dim_labels, dim_units, dim_mults, geometry, rank_write)
INTEGER, PARAMETER :: ndims = 2
TYPE(sdf_file_handle) :: h
CHARACTER(LEN=*), INTENT(IN) :: id, name
REAL(r4), DIMENSION(:), INTENT(IN) :: x, y
LOGICAL, INTENT(IN), OPTIONAL :: convert_in
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: dim_labels(:), dim_units(:)
REAL(r4), DIMENSION(:), INTENT(IN), OPTIONAL :: dim_mults
INTEGER, INTENT(IN), OPTIONAL :: geometry, rank_write
REAL(r4), DIMENSION(:), ALLOCATABLE :: r4array
INTEGER :: i, errcode, intn
TYPE(sdf_block_type), POINTER :: b
LOGICAL :: convert
CALL sdf_get_next_block(h)
b => h%current_block
intn = INT(SIZE(x),i4)
b%dims(:) = 1
b%dims(1) = intn
IF (PRESENT(convert_in)) THEN
convert = convert_in
ELSE
convert = .FALSE.
ENDIF
IF (convert) THEN
b%type_size = 4
b%datatype = c_datatype_real4
b%mpitype = MPI_REAL4
ALLOCATE(r4array(b%dims(1)))
ELSE
b%type_size = sof
b%datatype = datatype_real
b%mpitype = mpitype_real
ENDIF
IF (PRESENT(geometry)) THEN
b%geometry = geometry
ELSE
b%geometry = c_geometry_cartesian
ENDIF
b%ndims = ndims
IF (h%rank == h%rank_master) THEN
b%extents(1) = REAL(MINVAL(x(1:intn)),r8)
b%extents(2) = REAL(MINVAL(y(1:intn)),r8)
b%extents(ndims+1) = REAL(MAXVAL(x(1:intn)),r8)
b%extents(ndims+2) = REAL(MAXVAL(y(1:intn)),r8)
ENDIF
! Write header
b%blocktype = c_blocktype_lagrangian_mesh
CALL write_mesh_meta_r4(h, id, name, dim_labels, dim_units, dim_mults)
! Write the actual data
IF (h%rank == h%rank_master) THEN
h%current_location = b%data_location
CALL MPI_FILE_SEEK(h%filehandle, h%current_location, MPI_SEEK_SET, &
errcode)
IF (convert) THEN
r4array = REAL(x,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
r4array = REAL(y,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
DEALLOCATE(r4array)
ELSE
CALL MPI_FILE_WRITE(h%filehandle, x, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
CALL MPI_FILE_WRITE(h%filehandle, y, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
ENDIF
ENDIF
h%rank_master = h%default_rank
h%current_location = b%data_location + b%data_length
b%done_data = .TRUE.
END SUBROUTINE write_srl_2d_path_mesh_r4
!----------------------------------------------------------------------------
! Code to write a 1D path mesh for a 3D domain in serial from the node with
! rank {rank_write}
! Serial operation, so no need to specify dims
!----------------------------------------------------------------------------
SUBROUTINE write_srl_3d_path_mesh_r4(h, id, name, x, y, z, convert_in, &
dim_labels, dim_units, dim_mults, geometry, rank_write)
INTEGER, PARAMETER :: ndims = 3
TYPE(sdf_file_handle) :: h
CHARACTER(LEN=*), INTENT(IN) :: id, name
REAL(r4), DIMENSION(:), INTENT(IN) :: x, y, z
LOGICAL, INTENT(IN), OPTIONAL :: convert_in
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: dim_labels(:), dim_units(:)
REAL(r4), DIMENSION(:), INTENT(IN), OPTIONAL :: dim_mults
INTEGER, INTENT(IN), OPTIONAL :: geometry, rank_write
REAL(r4), DIMENSION(:), ALLOCATABLE :: r4array
INTEGER :: i, errcode, intn
TYPE(sdf_block_type), POINTER :: b
LOGICAL :: convert
CALL sdf_get_next_block(h)
b => h%current_block
intn = INT(SIZE(x),i4)
b%dims(:) = 1
b%dims(1) = intn
IF (PRESENT(convert_in)) THEN
convert = convert_in
ELSE
convert = .FALSE.
ENDIF
IF (convert) THEN
b%type_size = 4
b%datatype = c_datatype_real4
b%mpitype = MPI_REAL4
ALLOCATE(r4array(b%dims(1)))
ELSE
b%type_size = sof
b%datatype = datatype_real
b%mpitype = mpitype_real
ENDIF
IF (PRESENT(geometry)) THEN
b%geometry = geometry
ELSE
b%geometry = c_geometry_cartesian
ENDIF
b%ndims = ndims
IF (h%rank == h%rank_master) THEN
b%extents(1) = REAL(MINVAL(x(1:intn)),r8)
b%extents(2) = REAL(MINVAL(y(1:intn)),r8)
b%extents(3) = REAL(MINVAL(z(1:intn)),r8)
b%extents(ndims+1) = REAL(MAXVAL(x(1:intn)),r8)
b%extents(ndims+2) = REAL(MAXVAL(y(1:intn)),r8)
b%extents(ndims+3) = REAL(MAXVAL(z(1:intn)),r8)
ENDIF
! Write header
b%blocktype = c_blocktype_lagrangian_mesh
CALL write_mesh_meta_r4(h, id, name, dim_labels, dim_units, dim_mults)
! Write the actual data
IF (h%rank == h%rank_master) THEN
h%current_location = b%data_location
CALL MPI_FILE_SEEK(h%filehandle, h%current_location, MPI_SEEK_SET, &
errcode)
IF (convert) THEN
r4array = REAL(x,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
r4array = REAL(y,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
r4array = REAL(z,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
DEALLOCATE(r4array)
ELSE
CALL MPI_FILE_WRITE(h%filehandle, x, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
CALL MPI_FILE_WRITE(h%filehandle, y, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
CALL MPI_FILE_WRITE(h%filehandle, z, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
ENDIF
ENDIF
h%rank_master = h%default_rank
h%current_location = b%data_location + b%data_length
b%done_data = .TRUE.
END SUBROUTINE write_srl_3d_path_mesh_r4
!----------------------------------------------------------------------------
! Code to write a 1D lagrangian mesh in parallel using the
! mpitype {distribution} for distribution of data
......
......@@ -899,6 +899,217 @@ CONTAINS
!----------------------------------------------------------------------------
! Code to write a 1D path mesh for a 2D domain in serial from the node with
! rank {rank_write}
! Serial operation, so no need to specify dims
!----------------------------------------------------------------------------
SUBROUTINE write_srl_2d_path_mesh_r8(h, id, name, x, y, convert_in, &
dim_labels, dim_units, dim_mults, geometry, rank_write)
INTEGER, PARAMETER :: ndims = 2
TYPE(sdf_file_handle) :: h
CHARACTER(LEN=*), INTENT(IN) :: id, name
REAL(r8), DIMENSION(:), INTENT(IN) :: x, y
LOGICAL, INTENT(IN), OPTIONAL :: convert_in
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: dim_labels(:), dim_units(:)
REAL(r8), DIMENSION(:), INTENT(IN), OPTIONAL :: dim_mults
INTEGER, INTENT(IN), OPTIONAL :: geometry, rank_write
REAL(r4), DIMENSION(:), ALLOCATABLE :: r4array
INTEGER :: i, errcode, intn
TYPE(sdf_block_type), POINTER :: b
LOGICAL :: convert
CALL sdf_get_next_block(h)
b => h%current_block
intn = INT(SIZE(x),i4)
b%dims(:) = 1
b%dims(1) = intn
IF (PRESENT(convert_in)) THEN
convert = convert_in
ELSE
convert = .FALSE.
ENDIF
IF (convert) THEN
b%type_size = 4
b%datatype = c_datatype_real4
b%mpitype = MPI_REAL4
ALLOCATE(r4array(b%dims(1)))
ELSE
b%type_size = sof
b%datatype = datatype_real
b%mpitype = mpitype_real
ENDIF
IF (PRESENT(geometry)) THEN
b%geometry = geometry
ELSE
b%geometry = c_geometry_cartesian
ENDIF
b%ndims = ndims
IF (h%rank == h%rank_master) THEN
b%extents(1) = REAL(MINVAL(x(1:intn)),r8)
b%extents(2) = REAL(MINVAL(y(1:intn)),r8)
b%extents(ndims+1) = REAL(MAXVAL(x(1:intn)),r8)
b%extents(ndims+2) = REAL(MAXVAL(y(1:intn)),r8)
ENDIF
! Write header
b%blocktype = c_blocktype_lagrangian_mesh
CALL write_mesh_meta_r8(h, id, name, dim_labels, dim_units, dim_mults)
! Write the actual data
IF (h%rank == h%rank_master) THEN
h%current_location = b%data_location
CALL MPI_FILE_SEEK(h%filehandle, h%current_location, MPI_SEEK_SET, &
errcode)
IF (convert) THEN
r4array = REAL(x,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
r4array = REAL(y,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
DEALLOCATE(r4array)
ELSE
CALL MPI_FILE_WRITE(h%filehandle, x, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
CALL MPI_FILE_WRITE(h%filehandle, y, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
ENDIF
ENDIF
h%rank_master = h%default_rank
h%current_location = b%data_location + b%data_length
b%done_data = .TRUE.
END SUBROUTINE write_srl_2d_path_mesh_r8
!----------------------------------------------------------------------------
! Code to write a 1D path mesh for a 3D domain in serial from the node with
! rank {rank_write}
! Serial operation, so no need to specify dims
!----------------------------------------------------------------------------
SUBROUTINE write_srl_3d_path_mesh_r8(h, id, name, x, y, z, convert_in, &
dim_labels, dim_units, dim_mults, geometry, rank_write)
INTEGER, PARAMETER :: ndims = 3
TYPE(sdf_file_handle) :: h
CHARACTER(LEN=*), INTENT(IN) :: id, name
REAL(r8), DIMENSION(:), INTENT(IN) :: x, y, z
LOGICAL, INTENT(IN), OPTIONAL :: convert_in
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: dim_labels(:), dim_units(:)
REAL(r8), DIMENSION(:), INTENT(IN), OPTIONAL :: dim_mults
INTEGER, INTENT(IN), OPTIONAL :: geometry, rank_write
REAL(r4), DIMENSION(:), ALLOCATABLE :: r4array
INTEGER :: i, errcode, intn
TYPE(sdf_block_type), POINTER :: b
LOGICAL :: convert
CALL sdf_get_next_block(h)
b => h%current_block
intn = INT(SIZE(x),i4)
b%dims(:) = 1
b%dims(1) = intn
IF (PRESENT(convert_in)) THEN
convert = convert_in
ELSE
convert = .FALSE.
ENDIF
IF (convert) THEN
b%type_size = 4
b%datatype = c_datatype_real4
b%mpitype = MPI_REAL4
ALLOCATE(r4array(b%dims(1)))
ELSE
b%type_size = sof
b%datatype = datatype_real
b%mpitype = mpitype_real
ENDIF
IF (PRESENT(geometry)) THEN
b%geometry = geometry
ELSE
b%geometry = c_geometry_cartesian
ENDIF
b%ndims = ndims
IF (h%rank == h%rank_master) THEN
b%extents(1) = REAL(MINVAL(x(1:intn)),r8)
b%extents(2) = REAL(MINVAL(y(1:intn)),r8)
b%extents(3) = REAL(MINVAL(z(1:intn)),r8)
b%extents(ndims+1) = REAL(MAXVAL(x(1:intn)),r8)
b%extents(ndims+2) = REAL(MAXVAL(y(1:intn)),r8)
b%extents(ndims+3) = REAL(MAXVAL(z(1:intn)),r8)
ENDIF
! Write header
b%blocktype = c_blocktype_lagrangian_mesh
CALL write_mesh_meta_r8(h, id, name, dim_labels, dim_units, dim_mults)
! Write the actual data
IF (h%rank == h%rank_master) THEN
h%current_location = b%data_location
CALL MPI_FILE_SEEK(h%filehandle, h%current_location, MPI_SEEK_SET, &
errcode)
IF (convert) THEN
r4array = REAL(x,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
r4array = REAL(y,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
r4array = REAL(z,r4)
CALL MPI_FILE_WRITE(h%filehandle, r4array, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
DEALLOCATE(r4array)
ELSE
CALL MPI_FILE_WRITE(h%filehandle, x, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
CALL MPI_FILE_WRITE(h%filehandle, y, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
CALL MPI_FILE_WRITE(h%filehandle, z, intn, b%mpitype, &
MPI_STATUS_IGNORE, errcode)
ENDIF
ENDIF
h%rank_master = h%default_rank
h%current_location = b%data_location + b%data_length
b%done_data = .TRUE.
END SUBROUTINE write_srl_3d_path_mesh_r8
!----------------------------------------------------------------------------
! Code to write a 1D lagrangian mesh in parallel using the
! mpitype {distribution} for distribution of data
......
......@@ -557,9 +557,10 @@ CONTAINS
b => h%current_block
IF (PRESENT(id)) THEN
b%ndims = 0
IF (PRESENT(ndims)) THEN
b%ndims = ndims
ELSE
ELSE IF (PRESENT(variable_ids)) THEN
b%ndims = INT(SIZE(variable_ids),i4)
END IF
END IF
......@@ -575,9 +576,10 @@ CONTAINS
! Write header
IF (PRESENT(id)) THEN
b%stagger = stagger
CALL sdf_safe_copy_id(h, mesh_id, b%mesh_id)
CALL sdf_write_block_header(h, id, name)
b%stagger = c_stagger_cell_centre
IF (PRESENT(stagger)) b%stagger = stagger
IF (PRESENT(mesh_id)) CALL sdf_safe_copy_id(h, mesh_id, b%mesh_id)
IF (PRESENT(name)) CALL sdf_write_block_header(h, id, name)
ALLOCATE(b%variable_ids(b%ndims))
DO i = 1, b%ndims
CALL sdf_safe_copy_id(h, variable_ids(i), b%variable_ids(i))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment