diff options
Diffstat (limited to 'hl/fortran/test/tsttable.f90')
| -rwxr-xr-x | hl/fortran/test/tsttable.f90 | 727 |
1 files changed, 371 insertions, 356 deletions
diff --git a/hl/fortran/test/tsttable.f90 b/hl/fortran/test/tsttable.f90 index a6ce27f..66ec5c6 100755 --- a/hl/fortran/test/tsttable.f90 +++ b/hl/fortran/test/tsttable.f90 @@ -17,420 +17,435 @@ ! This file contains the FORTRAN90 tests for H5LT ! -program table_test +PROGRAM table_test -call test_table1() + CALL test_table1() -end program table_test +END PROGRAM table_test !------------------------------------------------------------------------- ! test_table1 !------------------------------------------------------------------------- -subroutine test_table1() - -use H5TB ! module of H5TB -use HDF5 ! module of HDF5 library - -implicit none - -character(len=8), parameter :: filename = "f1tab.h5" ! File name -character(LEN=5), parameter :: dsetname1 = "dset1" ! Dataset name -integer(HID_T) :: file_id ! File identifier -integer(HSIZE_T), parameter :: nfields = 4; ! nfields -integer(HSIZE_T), parameter :: nrecords = 5; ! nrecords -character(LEN=6), dimension(nfields) :: field_names ! field names -integer(SIZE_T), dimension(nfields) :: field_offset ! field offset -integer(HID_T), dimension(nfields) :: field_types ! field types -integer(HSIZE_T), parameter :: chunk_size = 5 ! chunk size -integer, parameter :: compress = 0 ! compress -integer :: errcode ! Error flag -integer :: i ! general purpose integer -integer(SIZE_T) :: type_size ! Size of the datatype -integer(SIZE_T) :: type_sizec ! Size of the character datatype -integer(SIZE_T) :: type_sizei ! Size of the integer datatype -integer(SIZE_T) :: type_sized ! Size of the double precision datatype -integer(SIZE_T) :: type_sizer ! Size of the real datatype -integer(HID_T) :: type_id_c ! Memory datatype identifier (for character field) -integer(SIZE_T) :: offset ! Member's offset -integer(HSIZE_T) :: start = 0 ! start record -integer, dimension(nrecords) :: bufi ! Data buffer -integer, dimension(nrecords) :: bufir ! Data buffer -real, dimension(nrecords) :: bufr ! Data buffer -real, dimension(nrecords) :: bufrr ! Data buffer -double precision, dimension(nrecords) :: bufd ! Data buffer -double precision, dimension(nrecords) :: bufdr ! Data buffer -character(LEN=2), dimension(nrecords), parameter :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer -character(LEN=2), dimension(nrecords) :: bufsr ! Data buffer -integer(HSIZE_T) :: nfieldsr ! nfields -integer(HSIZE_T) :: nrecordsr ! nrecords -character(LEN=6), dimension(nfields) :: field_namesr ! field names -integer(SIZE_T), dimension(nfields) :: field_offsetr ! field offset -integer(SIZE_T), dimension(nfields) :: field_sizesr ! field sizes -integer(SIZE_T) :: type_sizeout ! size of the datatype +SUBROUTINE test_table1() + + USE H5TB ! module of H5TB + USE HDF5 ! module of HDF5 library + + IMPLICIT NONE + + CHARACTER(len=8), PARAMETER :: filename = "f1tab.h5" ! File name + CHARACTER(LEN=5), PARAMETER :: dsetname1 = "dset1" ! Dataset name + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HSIZE_T), PARAMETER :: nfields = 4 ! nfields + INTEGER(HSIZE_T), PARAMETER :: nrecords = 5 ! nrecords + CHARACTER(LEN=10),DIMENSION(1:nfields) :: field_names ! field names + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offset ! field offset + INTEGER(HID_T), DIMENSION(1:nfields) :: field_types ! field types + INTEGER(HSIZE_T), PARAMETER :: chunk_size = 5 ! chunk size + INTEGER, PARAMETER :: compress = 0 ! compress + INTEGER :: errcode = 0 ! Error flag + INTEGER :: i ! general purpose integer + INTEGER(SIZE_T) :: type_size ! Size of the datatype + INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype + INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype + INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype + INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype + INTEGER(HID_T) :: type_id_c ! Memory datatype identifier (for character field) + INTEGER(SIZE_T) :: offset ! Member's offset + INTEGER(HSIZE_T) :: start = 0 ! start record + INTEGER, DIMENSION(nrecords) :: bufi ! Data buffer + INTEGER, DIMENSION(nrecords) :: bufir ! Data buffer + REAL, DIMENSION(nrecords) :: bufr ! Data buffer + REAL, DIMENSION(nrecords) :: bufrr ! Data buffer + DOUBLE PRECISION, DIMENSION(nrecords) :: bufd ! Data buffer + DOUBLE PRECISION, DIMENSION(nrecords) :: bufdr ! Data buffer + CHARACTER(LEN=2), DIMENSION(nrecords), PARAMETER :: bufs = (/"AB","CD","EF","GH","IJ"/) ! Data buffer + CHARACTER(LEN=2), DIMENSION(nrecords) :: bufsr ! Data buffer + INTEGER(HSIZE_T) :: nfieldsr ! nfields + INTEGER(HSIZE_T) :: nrecordsr ! nrecords + CHARACTER(LEN=9), DIMENSION(1:nfields) :: field_namesr ! field names + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_offsetr ! field offset + INTEGER(SIZE_T), DIMENSION(1:nfields) :: field_sizesr ! field sizes + INTEGER(SIZE_T) :: type_sizeout = 0 ! size of the datatype + INTEGER :: maxlen = 0 ! max chararter length of a field name + + + ! + ! Initialize the data arrays. + ! + DO i = 1, nrecords + bufi(i) = i + bufr(i) = i + bufd(i) = i + END DO + + ! + ! Initialize FORTRAN predefined datatypes. + ! + CALL h5open_f(errcode) + + ! + ! Create a new file using default properties. + ! + CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) + + + !------------------------------------------------------------------------- + ! make table + ! initialize the table parameters + !------------------------------------------------------------------------- + + field_names(1) = "field1" + field_names(2) = "field2a" + field_names(3) = "field3ab" + field_names(4) = "field4abc" + + ! + ! calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode) + type_size = 2 + CALL h5tset_size_f(type_id_c, type_size, errcode) + CALL h5tget_size_f(type_id_c, type_sizec, errcode) + CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode) + CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode) + CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode) + type_size = type_sizec + type_sizei + type_sized + type_sizer + + ! + ! type ID's + ! + field_types(1) = type_id_c + field_types(2) = H5T_NATIVE_INTEGER + field_types(3) = H5T_NATIVE_DOUBLE + field_types(4) = H5T_NATIVE_REAL + + ! + ! offsets + ! + offset = 0 + field_offset(1) = offset + offset = offset + type_sizec ! Offset of the second memeber is 2 + field_offset(2) = offset + offset = offset + type_sizei ! Offset of the second memeber is 6 + field_offset(3) = offset + offset = offset + type_sized ! Offset of the second memeber is 14 + field_offset(4) = offset + + !------------------------------------------------------------------------- + ! make table + !------------------------------------------------------------------------- + + CALL test_begin(' Make table ') + + CALL h5tbmake_table_f(dsetname1,& + file_id,& + dsetname1,& + nfields,& + nrecords,& + type_size,& + field_names,& + field_offset,& + field_types,& + chunk_size,& + compress,& + errcode ) + + CALL passed() + + + !------------------------------------------------------------------------- + ! write field + !------------------------------------------------------------------------- + + CALL test_begin(' Read/Write field by name ') + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufs,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufi,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufd,errcode) + + CALL h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufr,errcode) + + + !------------------------------------------------------------------------- + ! read field + !------------------------------------------------------------------------- + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& + bufsr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufsr(i) .NE. bufs(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufsr(i), ' and ', bufs(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& + bufir,errcode) + + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufir(i) .NE. bufi(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufir(i), ' and ', bufi(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& + bufdr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufdr(i) .NE. bufd(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufdr(i), ' and ', bufd(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& + bufrr,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO + + + CALL passed() + + !------------------------------------------------------------------------- + ! write field + !------------------------------------------------------------------------- + + CALL test_begin(' Read/Write field by index ') + + CALL h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufs,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufi,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufd,errcode) + + CALL h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufr,errcode) + + + !------------------------------------------------------------------------- + ! read field + !------------------------------------------------------------------------- + + CALL h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& + bufsr,errcode) -! -! Initialize the data arrays. -! -do i = 1, nrecords - bufi(i) = i; - bufr(i) = i; - bufd(i) = i; -end do - -! -! Initialize FORTRAN predefined datatypes. -! -call h5open_f(errcode) - -! -! Create a new file using default properties. -! -call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, errcode) - - -!------------------------------------------------------------------------- -! make table -! initialize the table parameters -!------------------------------------------------------------------------- - -field_names(1) = "field1" -field_names(2) = "field2" -field_names(3) = "field3" -field_names(4) = "field4" - -! -! calculate total size by calculating sizes of each member -! -call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id_c, errcode) -type_size = 2 -call h5tset_size_f(type_id_c, type_size, errcode) -call h5tget_size_f(type_id_c, type_sizec, errcode) -call h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, errcode) -call h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, errcode) -call h5tget_size_f(H5T_NATIVE_REAL, type_sizer, errcode) -type_size = type_sizec + type_sizei + type_sized + type_sizer - -! -! type ID's -! -field_types(1) = type_id_c -field_types(2) = H5T_NATIVE_INTEGER -field_types(3) = H5T_NATIVE_DOUBLE -field_types(4) = H5T_NATIVE_REAL - -! -! offsets -! -offset = 0 -field_offset(1) = offset -offset = offset + type_sizec ! Offset of the second memeber is 2 -field_offset(2) = offset -offset = offset + type_sizei ! Offset of the second memeber is 6 -field_offset(3) = offset -offset = offset + type_sized ! Offset of the second memeber is 14 -field_offset(4) = offset - -!------------------------------------------------------------------------- -! make table -!------------------------------------------------------------------------- - -call test_begin(' Make table ') - + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufsr(i) .NE. bufs(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufsr(i), ' and ', bufs(i) + STOP + ENDIF + END DO + + CALL h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& + bufir,errcode) + + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufir(i) .NE. bufi(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufir(i), ' and ', bufi(i) + STOP + ENDIF + END DO -call h5tbmake_table_f(dsetname1,& - file_id,& - dsetname1,& - nfields,& - nrecords,& - type_size,& - field_names,& - field_offset,& - field_types,& - chunk_size,& - compress,& - errcode ) + CALL h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& + bufdr,errcode) -call passed() + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufdr(i) .NE. bufd(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufdr(i), ' and ', bufd(i) + STOP + ENDIF + END DO -!------------------------------------------------------------------------- -! write field -!------------------------------------------------------------------------- + CALL h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& + bufrr,errcode) -call test_begin(' Read/Write field by name ') + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& - bufs,errcode) -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& - bufi,errcode) + CALL passed() -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& - bufd,errcode) -call h5tbwrite_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& - bufr,errcode) + !------------------------------------------------------------------------- + ! Insert field + ! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) + !------------------------------------------------------------------------- -!------------------------------------------------------------------------- -! read field -!------------------------------------------------------------------------- + CALL test_begin(' Insert field ') -call h5tbread_field_name_f(file_id,dsetname1,field_names(1),start,nrecords,type_sizec,& - bufsr,errcode) + CALL h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode) + CALL h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,& + bufrr,errcode) + ! + ! compare read and write buffers. + ! + DO i = 1, nrecords + IF ( bufrr(i) .NE. bufr(i) ) THEN + PRINT *, 'read buffer differs from write buffer' + PRINT *, bufrr(i), ' and ', bufr(i) + STOP + ENDIF + END DO -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufsr(i) .ne. bufs(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufsr(i), ' and ', bufs(i) - stop - endif -end do -call h5tbread_field_name_f(file_id,dsetname1,field_names(2),start,nrecords,type_sizei,& - bufir,errcode) + CALL passed() -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufir(i) .ne. bufi(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufir(i), ' and ', bufi(i) - stop - endif -end do + !------------------------------------------------------------------------- + ! Delete field + !------------------------------------------------------------------------- -call h5tbread_field_name_f(file_id,dsetname1,field_names(3),start,nrecords,type_sized,& - bufdr,errcode) + CALL test_begin(' Delete field ') -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufdr(i) .ne. bufd(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufdr(i), ' and ', bufd(i) - stop - endif -end do + CALL h5tbdelete_field_f(file_id,dsetname1,"field4abc",errcode) -call h5tbread_field_name_f(file_id,dsetname1,field_names(4),start,nrecords,type_sizer,& - bufrr,errcode) + CALL passed() -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufrr(i) .ne. bufr(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufrr(i), ' and ', bufr(i) - stop - endif -end do + !------------------------------------------------------------------------- + ! Gets the number of records and fields + !------------------------------------------------------------------------- -call passed() + CALL test_begin(' Get table info ') + CALL h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) -!------------------------------------------------------------------------- -! write field -!------------------------------------------------------------------------- + IF ( nfieldsr .NE. nfields .AND. nrecordsr .NE. nrecords ) THEN + PRINT *, 'h5tbget_table_info_f return error' + STOP + ENDIF -call test_begin(' Read/Write field by index ') + CALL passed() -call h5tbwrite_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& - bufs,errcode) + !------------------------------------------------------------------------- + ! Get information about fields + !------------------------------------------------------------------------- -call h5tbwrite_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& - bufi,errcode) + CALL test_begin(' Get fields info ') -call h5tbwrite_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& - bufd,errcode) + CALL h5tbget_field_info_f(file_id, dsetname1, nfields, field_namesr, field_sizesr,& + field_offsetr, type_sizeout, errcode, maxlen ) -call h5tbwrite_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& - bufr,errcode) + IF ( errcode.NE.0 ) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: RETURN ERROR")') + STOP + ENDIF + ! "field4abc" was deleted and "field5" was added. + field_names(4) = "field5" + IF ( maxlen .NE. 8 ) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: INCORRECT MAXIMUM CHARACTER LENGTH OF THE FIELD NAMES")') + WRITE(*,'(5X,"RETURNED VALUE = ", I0, ", CORRECT VALUE = ", I0)') maxlen, 8 + STOP + ENDIF -!------------------------------------------------------------------------- -! read field -!------------------------------------------------------------------------- - -call h5tbread_field_index_f(file_id,dsetname1,1,start,nrecords,type_sizec,& - bufsr,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufsr(i) .ne. bufs(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufsr(i), ' and ', bufs(i) - stop - endif -end do - -call h5tbread_field_index_f(file_id,dsetname1,2,start,nrecords,type_sizei,& - bufir,errcode) + DO i = 1, nfields + IF ( field_namesr(i) .NE. field_names(i)) THEN + WRITE(*,'(/,5X,"H5TBGET_FIELD_INFO_F: READ/WRITE FIELD NAMES DIFFER")') + WRITE(*,'(27X,A," AND ",A)') TRIM(field_namesr(i)), TRIM(field_names(i)) + STOP + ENDIF + END DO -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufir(i) .ne. bufi(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufir(i), ' and ', bufi(i) - stop - endif -end do - -call h5tbread_field_index_f(file_id,dsetname1,3,start,nrecords,type_sized,& - bufdr,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufdr(i) .ne. bufd(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufdr(i), ' and ', bufd(i) - stop - endif -end do + CALL passed() -call h5tbread_field_index_f(file_id,dsetname1,4,start,nrecords,type_sizer,& - bufrr,errcode) -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufrr(i) .ne. bufr(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufrr(i), ' and ', bufr(i) - stop - endif -end do - - -call passed() - - -!------------------------------------------------------------------------- -! Insert field -! we insert a field callsed "field5" with the same type and buffer as field 4 (Real) -!------------------------------------------------------------------------- - -call test_begin(' Insert field ') - -call h5tbinsert_field_f(file_id,dsetname1,"field5",field_types(4),4,bufr,errcode) - -call h5tbread_field_index_f(file_id,dsetname1,5,start,nrecords,type_sizer,& - bufrr,errcode) - -! -! compare read and write buffers. -! -do i = 1, nrecords - if ( bufrr(i) .ne. bufr(i) ) then - print *, 'read buffer differs from write buffer' - print *, bufrr(i), ' and ', bufr(i) - stop - endif -end do - -call passed() - - -!------------------------------------------------------------------------- -! Delete field -!------------------------------------------------------------------------- - -call test_begin(' Delete field ') - -call h5tbdelete_field_f(file_id,dsetname1,"field4",errcode) - -call passed() - - -!------------------------------------------------------------------------- -! Gets the number of records and fields -!------------------------------------------------------------------------- - -call test_begin(' Get table info ') - -call h5tbget_table_info_f(file_id,dsetname1,nfieldsr,nrecordsr,errcode ) - -if ( nfieldsr .ne. nfields .and. nrecordsr .ne. nrecords ) then - print *, 'h5tbget_table_info_f return error' - stop -endif - -call passed() - - -!------------------------------------------------------------------------- -! Get information about fields -!------------------------------------------------------------------------- - -!call test_begin(' Get fields info ') - -!call h5tbget_field_info_f(file_id,dsetname1,nfields,field_namesr,field_sizesr,& -! field_offsetr,type_sizeout,errcode ) - - -!call passed() - - - -!------------------------------------------------------------------------- -! end -!------------------------------------------------------------------------- - -! -! Close the file. -! -call h5fclose_f(file_id, errcode) - -! -! Close FORTRAN predefined datatypes. -! -call h5close_f(errcode) - - -! -! end function. -! -end subroutine test_table1 + !------------------------------------------------------------------------- + ! end + !------------------------------------------------------------------------- + ! + ! Close the file. + ! + CALL h5fclose_f(file_id, errcode) + ! + ! Close FORTRAN predefined datatypes. + ! + CALL h5close_f(errcode) + ! + ! end function. + ! +END SUBROUTINE test_table1 !------------------------------------------------------------------------- ! test_begin !------------------------------------------------------------------------- -subroutine test_begin(string) -character(LEN=*), intent(IN) :: string -write(*, fmt = '(14a)', advance = 'no') string -write(*, fmt = '(40x,a)', advance = 'no') ' ' -end subroutine test_begin +SUBROUTINE test_begin(string) + CHARACTER(LEN=*), INTENT(IN) :: string + WRITE(*, fmt = '(14a)', advance = 'no') string + WRITE(*, fmt = '(40x,a)', advance = 'no') ' ' +END SUBROUTINE test_begin !------------------------------------------------------------------------- ! passed !------------------------------------------------------------------------- -subroutine passed() -write(*, fmt = '(6a)') 'PASSED' -end subroutine passed +SUBROUTINE passed() + WRITE(*, fmt = '(6a)') 'PASSED' +END SUBROUTINE passed |