<p><b>duda</b> 2012-04-02 17:21:37 -0600 (Mon, 02 Apr 2012)</p><p>BRANCH COMMIT<br>
<br>
Add code in low-level IO layer for reading and writing character strings.<br>
<br>
<br>
M src/framework/mpas_io.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/io/src/framework/mpas_io.F
===================================================================
--- branches/omp_blocks/io/src/framework/mpas_io.F 2012-04-02 22:18:19 UTC (rev 1740)
+++ branches/omp_blocks/io/src/framework/mpas_io.F 2012-04-02 23:21:37 UTC (rev 1741)
@@ -43,8 +43,9 @@
MPAS_IO_ERR_WRONG_ATT_TYPE = -13, &
MPAS_IO_ERR_NO_DECOMP = -14, &
MPAS_IO_ERR_TWO_UNLIMITED_DIMS = -15, &
- MPAS_IO_ERR_WRONG_MODE = -16, &
- MPAS_IO_ERR_NO_UNLIMITED_DIM = -17
+ MPAS_IO_ERR_WRONG_MODE = -16, &
+ MPAS_IO_ERR_NO_UNLIMITED_DIM = -17, &
+ MPAS_IO_ERR_UNIMPLEMENTED = -18
type MPAS_IO_Handle_type
@@ -76,6 +77,7 @@
module procedure MPAS_io_get_var_real2d
module procedure MPAS_io_get_var_real3d
module procedure MPAS_io_get_var_real4d
+ module procedure MPAS_io_get_var_char0d
end interface MPAS_io_get_var
interface MPAS_io_put_var
@@ -89,6 +91,7 @@
module procedure MPAS_io_put_var_real2d
module procedure MPAS_io_put_var_real3d
module procedure MPAS_io_put_var_real4d
+ module procedure MPAS_io_put_var_char0d
end interface MPAS_io_put_var
interface MPAS_io_get_att
@@ -1122,7 +1125,8 @@
subroutine MPAS_io_get_var_generic(handle, fieldname, intVal, intArray1d, intArray2d, intArray3d, intArray4d, &
- realVal, realArray1d, realArray2d, realArray3d, realArray4d, ierr)
+ realVal, realArray1d, realArray2d, realArray3d, realArray4d, &
+ charVal, ierr)
implicit none
@@ -1138,10 +1142,15 @@
real (kind=RKIND), dimension(:,:), intent(out), optional :: realArray2d
real (kind=RKIND), dimension(:,:,:), intent(out), optional :: realArray3d
real (kind=RKIND), dimension(:,:,:,:), intent(out), optional :: realArray4d
+ character (len=*), intent(out), optional :: charVal
integer, intent(out), optional :: ierr
integer :: pio_ierr
- integer, dimension(1) :: start
+ integer, dimension(1) :: start1
+ integer, dimension(1) :: count1
+ integer, dimension(2) :: start2
+ integer, dimension(2) :: count2
+ character (len=1024), dimension(1) :: tempchar
type (fieldlist_type), pointer :: field_cursor
! Sanity checks
@@ -1171,7 +1180,7 @@
!
! Check that we have a decomposition for this field
!
- if (.not.present(intVal) .and. .not.present(realVal)) then
+ if (.not.present(intVal) .and. .not.present(realVal) .and. .not.present(charVal)) then
if (.not. associated(field_cursor % fieldhandle % decomp)) then
if (present(ierr)) ierr = MPAS_IO_ERR_NO_DECOMP
return
@@ -1182,21 +1191,34 @@
if (field_cursor % fieldhandle % has_unlimited_dim) then
call PIO_setframe(field_cursor % fieldhandle % field_desc, handle % frame_number)
- start(1) = handle % frame_number
+ start1(1) = handle % frame_number
+ count1(1) = 1
+
+ start2(1) = 1
+ start2(2) = handle % frame_number
+ count2(2) = 1
end if
if (present(realVal)) then
if (field_cursor % fieldhandle % has_unlimited_dim) then
- pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start, realVal)
+ pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start1, realVal)
else
pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, realVal)
end if
else if (present(intVal)) then
if (field_cursor % fieldhandle % has_unlimited_dim) then
- pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start, intVal)
+ pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start1, intVal)
else
pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, intVal)
end if
+ else if (present(charVal)) then
+ if (field_cursor % fieldhandle % has_unlimited_dim) then
+ count2(1) = field_cursor % fieldhandle % dims(1) % dimsize
+ pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, tempchar)
+ charVal(1:count2(1)) = tempchar(1)(1:count2(1))
+ else
+ pio_ierr = PIO_get_var(handle % pio_file, field_cursor % fieldhandle % field_desc, charVal)
+ end if
else if (present(realArray1d)) then
call PIO_read_darray(handle % pio_file, field_cursor % fieldhandle % field_desc, field_cursor % fieldhandle % decomp % pio_iodesc, &
realArray1d, pio_ierr)
@@ -1432,8 +1454,29 @@
end subroutine MPAS_io_get_var_real4d
+ subroutine MPAS_io_get_var_char0d(handle, fieldname, val, ierr)
+
+ implicit none
+
+ type (MPAS_IO_Handle_type), intent(inout) :: handle
+ character (len=*), intent(in) :: fieldname
+ character (len=*), intent(out) :: val
+ integer, intent(out), optional :: ierr
+
+ integer :: pio_ierr
+ type (fieldlist_type), pointer :: field_cursor
+
+ write(0,*) 'Called MPAS_io_get_var_char0d()'
+ if (present(ierr)) ierr = MPAS_IO_NOERR
+
+ call MPAS_io_get_var_generic(handle, fieldname, charVal=val, ierr=ierr)
+
+ end subroutine MPAS_io_get_var_char0d
+
+
subroutine MPAS_io_put_var_generic(handle, fieldname, intVal, intArray1d, intArray2d, intArray3d, intArray4d, &
- realVal, realArray1d, realArray2d, realArray3d, realArray4d, ierr)
+ realVal, realArray1d, realArray2d, realArray3d, realArray4d, &
+ charVal, ierr)
implicit none
@@ -1449,10 +1492,14 @@
real (kind=RKIND), dimension(:,:), intent(in), optional :: realArray2d
real (kind=RKIND), dimension(:,:,:), intent(in), optional :: realArray3d
real (kind=RKIND), dimension(:,:,:,:), intent(in), optional :: realArray4d
+ character (len=*), intent(in), optional :: charVal
integer, intent(out), optional :: ierr
integer :: pio_ierr
- integer, dimension(1) :: start
+ integer, dimension(1) :: start1
+ integer, dimension(1) :: count1
+ integer, dimension(2) :: start2
+ integer, dimension(2) :: count2
type (fieldlist_type), pointer :: field_cursor
! Sanity checks
@@ -1493,7 +1540,7 @@
!
! Check that we have a decomposition for this field
!
- if (.not.present(intVal) .and. .not.present(realVal)) then
+ if (.not.present(intVal) .and. .not.present(realVal) .and. .not.present(charVal)) then
if (.not. associated(field_cursor % fieldhandle % decomp)) then
if (present(ierr)) ierr = MPAS_IO_ERR_NO_DECOMP
return
@@ -1502,21 +1549,33 @@
if (field_cursor % fieldhandle % has_unlimited_dim) then
call PIO_setframe(field_cursor % fieldhandle % field_desc, handle % frame_number)
- start(1) = handle % frame_number
+ start1(1) = handle % frame_number
+ count1(1) = 1
+
+ start2(1) = 1
+ start2(2) = handle % frame_number
+ count2(2) = 1
end if
if (present(realVal)) then
if (field_cursor % fieldhandle % has_unlimited_dim) then
- pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start, realVal)
+ pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start1, realVal)
else
pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, realVal)
end if
else if (present(intVal)) then
if (field_cursor % fieldhandle % has_unlimited_dim) then
- pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start, intVal)
+ pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, start1, intVal)
else
pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, intVal)
end if
+ else if (present(charVal)) then
+ if (field_cursor % fieldhandle % has_unlimited_dim) then
+ count2(1) = field_cursor % fieldhandle % dims(1) % dimsize
+ pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % fieldid, start2, count2, (/charVal/))
+ else
+ pio_ierr = PIO_put_var(handle % pio_file, field_cursor % fieldhandle % field_desc, charVal)
+ end if
else if (present(realArray1d)) then
call PIO_write_darray(handle % pio_file, field_cursor % fieldhandle % field_desc, field_cursor % fieldhandle % decomp % pio_iodesc, &
realArray1d, pio_ierr)
@@ -1752,6 +1811,26 @@
end subroutine MPAS_io_put_var_real4d
+ subroutine MPAS_io_put_var_char0d(handle, fieldname, val, ierr)
+
+ implicit none
+
+ type (MPAS_IO_Handle_type), intent(inout) :: handle
+ character (len=*), intent(in) :: fieldname
+ character (len=*), intent(in) :: val
+ integer, intent(out), optional :: ierr
+
+ integer :: pio_ierr
+ type (fieldlist_type), pointer :: field_cursor
+
+ write(0,*) 'Called MPAS_io_put_var_char0d()'
+ if (present(ierr)) ierr = MPAS_IO_NOERR
+
+ call MPAS_io_put_var_generic(handle, fieldname, charVal=val, ierr=ierr)
+
+ end subroutine MPAS_io_put_var_char0d
+
+
subroutine MPAS_io_get_att_int0d(handle, attName, attValue, fieldname, ierr)
implicit none
@@ -3345,6 +3424,8 @@
write(0,*) 'MPAS IO Error: Operation not permitted in this file mode'
case (MPAS_IO_ERR_NO_UNLIMITED_DIM)
write(0,*) 'MPAS IO Error: No unlimited dimension found in dataset'
+ case (MPAS_IO_ERR_UNIMPLEMENTED)
+ write(0,*) 'MPAS IO Error: Unimplemented functionality'
case default
write(0,*) 'MPAS IO Error: Unrecognized error code...'
end select
</font>
</pre>