diff --git a/src/boundary_condition_routines.f90 b/src/boundary_condition_routines.f90 index 6b38a091..5103e320 100755 --- a/src/boundary_condition_routines.f90 +++ b/src/boundary_condition_routines.f90 @@ -127,18 +127,70 @@ MODULE BOUNDARY_CONDITIONS_ROUTINES !Interfaces + INTERFACE BoundaryConditions_AddConstant + MODULE PROCEDURE BOUNDARY_CONDITIONS_ADD_CONSTANT + END INTERFACE BoundaryConditions_AddConstant + !>Adds to the value of the specified local DOF and sets this as a boundary condition on the specified local DOF. INTERFACE BOUNDARY_CONDITIONS_ADD_LOCAL_DOF MODULE PROCEDURE BOUNDARY_CONDITIONS_ADD_LOCAL_DOF1 MODULE PROCEDURE BOUNDARY_CONDITIONS_ADD_LOCAL_DOFS - END INTERFACE !BOUNDARY_CONDITIONS_ADD_LOCAL_DOF + END INTERFACE BOUNDARY_CONDITIONS_ADD_LOCAL_DOF + + !>Adds to the value of the specified local DOF and sets this as a boundary condition on the specified local DOF. + INTERFACE BoundaryConditions_AddLocalDof + MODULE PROCEDURE BOUNDARY_CONDITIONS_ADD_LOCAL_DOF1 + MODULE PROCEDURE BOUNDARY_CONDITIONS_ADD_LOCAL_DOFS + END INTERFACE BoundaryConditions_AddLocalDof + INTERFACE BoundaryConditions_AddElement + MODULE PROCEDURE BOUNDARY_CONDITIONS_ADD_ELEMENT + END INTERFACE BoundaryConditions_AddElement + + INTERFACE BoundaryConditions_AddNode + MODULE PROCEDURE BOUNDARY_CONDITIONS_ADD_NODE + END INTERFACE BoundaryConditions_AddNode + + INTERFACE BoundaryConditions_CreateFinish + MODULE PROCEDURE BOUNDARY_CONDITIONS_CREATE_FINISH + END INTERFACE BoundaryConditions_CreateFinish + + INTERFACE BoundaryConditions_CreateStart + MODULE PROCEDURE BOUNDARY_CONDITIONS_CREATE_START + END INTERFACE BoundaryConditions_CreateStart + + INTERFACE BoundaryConditions_Destroy + MODULE PROCEDURE BOUNDARY_CONDITIONS_DESTROY + END INTERFACE BoundaryConditions_Destroy + + INTERFACE BoundaryConditions_SetConstant + MODULE PROCEDURE BOUNDARY_CONDITIONS_SET_CONSTANT + END INTERFACE BoundaryConditions_SetConstant + + INTERFACE BoundaryConditions_SetElement + MODULE PROCEDURE BOUNDARY_CONDITIONS_SET_ELEMENT + END INTERFACE BoundaryConditions_SetElement + !>Sets a boundary condition on the specified local DOF. INTERFACE BOUNDARY_CONDITIONS_SET_LOCAL_DOF MODULE PROCEDURE BOUNDARY_CONDITIONS_SET_LOCAL_DOF1 MODULE PROCEDURE BOUNDARY_CONDITIONS_SET_LOCAL_DOFS - END INTERFACE !BOUNDARY_CONDITIONS_SET_LOCAL_DOF + END INTERFACE BOUNDARY_CONDITIONS_SET_LOCAL_DOF + + !>Sets a boundary condition on the specified local DOF. + INTERFACE BoundaryConditions_SetLocalDof + MODULE PROCEDURE BOUNDARY_CONDITIONS_SET_LOCAL_DOF1 + MODULE PROCEDURE BOUNDARY_CONDITIONS_SET_LOCAL_DOFS + END INTERFACE BoundaryConditions_SetLocalDof + INTERFACE BoundaryConditions_SetNode + MODULE PROCEDURE BOUNDARY_CONDITIONS_SET_NODE + END INTERFACE BoundaryConditions_SetNode + + INTERFACE BoundaryConditions_VariableGet + MODULE PROCEDURE BOUNDARY_CONDITIONS_VARIABLE_GET + END INTERFACE BoundaryConditions_VariableGet + PUBLIC BOUNDARY_CONDITION_DOF_FREE,BOUNDARY_CONDITION_DOF_FIXED,BOUNDARY_CONDITION_DOF_MIXED,BOUNDARY_CONDITION_DOF_CONSTRAINED PUBLIC BOUNDARY_CONDITION_FREE,BOUNDARY_CONDITION_FIXED,BOUNDARY_CONDITION_FIXED_INLET,& @@ -152,16 +204,34 @@ MODULE BOUNDARY_CONDITIONS_ROUTINES PUBLIC BOUNDARY_CONDITION_SPARSE_MATRICES,BOUNDARY_CONDITION_FULL_MATRICES - PUBLIC BOUNDARY_CONDITIONS_CREATE_FINISH,BOUNDARY_CONDITIONS_CREATE_START,BOUNDARY_CONDITIONS_DESTROY - PUBLIC BOUNDARY_CONDITIONS_ADD_CONSTANT,BOUNDARY_CONDITIONS_ADD_LOCAL_DOF,BOUNDARY_CONDITIONS_ADD_ELEMENT, & - & BOUNDARY_CONDITIONS_ADD_NODE,BOUNDARY_CONDITIONS_VARIABLE_GET + & BOUNDARY_CONDITIONS_ADD_NODE - PUBLIC BOUNDARY_CONDITIONS_SET_CONSTANT,BOUNDARY_CONDITIONS_SET_LOCAL_DOF,BOUNDARY_CONDITIONS_SET_ELEMENT, & - & BOUNDARY_CONDITIONS_SET_NODE,BoundaryConditions_NeumannIntegrate,BoundaryConditions_NeumannSparsityTypeSet + PUBLIC BoundaryConditions_AddConstant,BoundaryConditions_AddLocalDof,BoundaryConditions_AddElement,BoundaryConditions_AddNode PUBLIC BoundaryConditions_ConstrainNodeDofsEqual + PUBLIC BOUNDARY_CONDITIONS_CREATE_FINISH,BOUNDARY_CONDITIONS_CREATE_START + + PUBLIC BoundaryConditions_CreateFinish,BoundaryConditions_CreateStart + + PUBLIC BOUNDARY_CONDITIONS_DESTROY + + PUBLIC BoundaryConditions_Destroy + + PUBLIC BoundaryConditions_NeumannIntegrate + + PUBLIC BoundaryConditions_NeumannSparsityTypeSet + + PUBLIC BOUNDARY_CONDITIONS_SET_CONSTANT,BOUNDARY_CONDITIONS_SET_LOCAL_DOF,BOUNDARY_CONDITIONS_SET_ELEMENT, & + & BOUNDARY_CONDITIONS_SET_NODE + + PUBLIC BoundaryConditions_SetConstant,BoundaryConditions_SetLocalDof,BoundaryConditions_SetElement,BoundaryConditions_SetNode + + PUBLIC BOUNDARY_CONDITIONS_VARIABLE_GET + + PUBLIC BoundaryConditions_VariableGet + CONTAINS ! diff --git a/src/distributed_matrix_vector.f90 b/src/distributed_matrix_vector.f90 index 5632b1fb..61625c85 100755 --- a/src/distributed_matrix_vector.f90 +++ b/src/distributed_matrix_vector.f90 @@ -614,6 +614,8 @@ MODULE DISTRIBUTED_MATRIX_VECTOR PUBLIC DistributedMatrix_MatrixByVectorAdd + PUBLIC DistributedMatrix_MatrixRowByVector + PUBLIC DISTRIBUTED_VECTOR_ALL_VALUES_SET PUBLIC DistributedVector_AllValuesSet @@ -5596,6 +5598,180 @@ SUBROUTINE DISTRIBUTED_MATRIX_BY_VECTOR_ADD(ROW_SELECTION_TYPE,ALPHA,DISTRIBUTED RETURN 1 END SUBROUTINE DISTRIBUTED_MATRIX_BY_VECTOR_ADD + ! + !================================================================================================================================ + ! + + !>Calculates a row of the matrix vector product of a distrubted matrix times a distributed vector and adds it to the distributed + !>product vector. NOTE: This will only work for specific CMISS distributed matrices i.e., ones in which the columns of the + !>matrix are distributed in the same way as the rows of the multiplied vector are distributed, and the rows of the matrix + !>are distributed in the same way as the rows of the product vector. + SUBROUTINE DistributedMatrix_MatrixRowByVector(localRow,distributedMatrix,distributedVector,result,err,error,*) + + !Argument variables + INTEGER(INTG), INTENT(IN) :: localRow !distributedMatrix%COLUMN_DOMAIN_MAPPING + IF(ASSOCIATED(columnMapping)) THEN + rowMapping=>distributedMatrix%ROW_DOMAIN_MAPPING + IF(ASSOCIATED(rowMapping)) THEN + IF(ASSOCIATED(columnMapping,distributedVector%DOMAIN_MAPPING)) THEN + IF(localRow>=1.AND.localRow<=rowMapping%TOTAL_NUMBER_OF_LOCAL) THEN + SELECT CASE(distributedMatrix%LIBRARY_TYPE) + CASE(DISTRIBUTED_MATRIX_VECTOR_CMISS_TYPE) + cmissMatrix=>distributedMatrix%cmiss + IF(ASSOCIATED(cmissMatrix)) THEN + matrix=>cmissMatrix%matrix + IF(ASSOCIATED(matrix)) THEN + cmissVector=>distributedVector%cmiss + IF(ASSOCIATED(cmissVector)) THEN + IF(matrix%DATA_TYPE==distributedVector%DATA_TYPE) THEN + SELECT CASE(matrix%DATA_TYPE) + CASE(DISTRIBUTED_MATRIX_VECTOR_INTG_TYPE) + CALL FlagError("Not implemented.",err,error,*999) + CASE(DISTRIBUTED_MATRIX_VECTOR_SP_TYPE) + CALL FlagError("Not implemented.",err,error,*999) + CASE(DISTRIBUTED_MATRIX_VECTOR_DP_TYPE) + SELECT CASE(matrix%STORAGE_TYPE) + CASE(MATRIX_BLOCK_STORAGE_TYPE) + sum=0.0_DP + DO localColumn=1,columnMapping%TOTAL_NUMBER_OF_LOCAL + globalColumn=columnMapping%LOCAL_TO_GLOBAL_MAP(localColumn) + sum=sum+matrix%DATA_DP(localRow+(globalColumn-1)*matrix%M)* & + & cmissVector%DATA_DP(localColumn) + ENDDO !localColumn + CASE(MATRIX_DIAGONAL_STORAGE_TYPE) + sum=matrix%DATA_DP(localRow)*cmissVector%DATA_DP(localRow) + CASE(MATRIX_COLUMN_MAJOR_STORAGE_TYPE) + sum=0.0_DP + DO localColumn=1,columnMapping%TOTAL_NUMBER_OF_LOCAL + globalColumn=columnMapping%LOCAL_TO_GLOBAL_MAP(localColumn) + sum=sum+matrix%DATA_DP(localRow+(globalColumn-1)*matrix%MAX_M)* & + & cmissVector%DATA_DP(localColumn) + ENDDO !localColumn + CASE(MATRIX_ROW_MAJOR_STORAGE_TYPE) + sum=0.0_DP + DO localColumn=1,columnMapping%TOTAL_NUMBER_OF_LOCAL + globalColumn=columnMapping%LOCAL_TO_GLOBAL_MAP(localColumn) + sum=sum+matrix%DATA_DP((localRow-1)*matrix%MAX_N+globalColumn)* & + & cmissVector%DATA_DP(localColumn) + ENDDO !localColumn + CASE(MATRIX_COMPRESSED_ROW_STORAGE_TYPE) + sum=0.0_DP + DO columnIdx=matrix%ROW_INDICES(localRow),matrix%ROW_INDICES(localRow+1)-1 + globalColumn=matrix%COLUMN_INDICES(columnIdx) + !This ranks global to local mappings are stored in the first position + localColumn=columnMapping%GLOBAL_TO_LOCAL_MAP(globalColumn)%LOCAL_NUMBER(1) + sum=sum+matrix%DATA_DP(columnIdx)*cmissVector%DATA_DP(localColumn) + ENDDO !columnIdx + CASE(MATRIX_COMPRESSED_COLUMN_STORAGE_TYPE) + location=0 + sum=0.0_DP + DO localColumn=1,columnMapping%TOTAL_NUMBER_OF_LOCAL + globalColumn=columnMapping%LOCAL_TO_GLOBAL_MAP(localColumn) + CALL Matrix_StorageLocationFind(matrix,localRow,globalColumn,location,err,error,*999) + IF(location/=0) sum=matrix%DATA_DP(rowIdx)*cmissVector%DATA_DP(localColumn) + ENDDO !localColumn + CASE(MATRIX_ROW_COLUMN_STORAGE_TYPE) + CALL FlagError("Not implemented.",err,error,*999) + CASE DEFAULT + localError="The matrix storage type of "// & + & TRIM(NumberToVString(matrix%STORAGE_TYPE,"*",err,error))//" is invalid." + CALL FlagError(localError,err,error,*999) + END SELECT + result=sum + CASE(DISTRIBUTED_MATRIX_VECTOR_L_TYPE) + CALL FlagError("Not implemented.",err,error,*999) + CASE DEFAULT + localError="The distributed matrix vector data type of "// & + & TRIM(NumberToVString(matrix%DATA_TYPE,"*",err,error))//" is invalid." + CALL FlagError(localError,err,error,*999) + END SELECT + ELSE + localError="The distributed vector data type of "// & + & TRIM(NumberToVString(distributedVector%DATA_TYPE,"*",err,error))// & + & " does not match the distributed matrix data type of "// & + & TRIM(NumberToVString(matrix%DATA_TYPE,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + CALL FlagError("Distributed vector CMISS vector is not associated.",err,error,*999) + ENDIF + ELSE + CALL FlagError("CMISS matrix matrix is not associated.",err,error,*999) + ENDIF + ELSE + CALL FlagError("Distrubuted matrix CMISS is not associated.",err,error,*999) + ENDIF + CASE(DISTRIBUTED_MATRIX_VECTOR_PETSC_TYPE) + CALL FlagError("Not implemented.",err,error,*999) + CASE DEFAULT + localError="The distributed matrix library type of "// & + & TRIM(NumberToVString(distributedMatrix%LIBRARY_TYPE,"*",err,error))//" is invalid" + CALL FlagError(localError,err,error,*999) + END SELECT + ELSE + CALL FlagError("The distributed matrix and the distributed product vector have different "// & + & "domain mappings.",err,error,*999) + ENDIF + ELSE + CALL FlagError("The distributed matrix and the distributed vector have different domain mappings.", & + & err,error,*999) + ENDIF + ELSE + CALL FlagError("The distributed matrix row domain mapping is not associated.",err,error,*999) + ENDIF + ELSE + CALL FlagError("The distributed matrix column domain mapping is not associated.",err,error,*999) + ENDIF + ELSE + localError="The distributed vector library type of "// & + & TRIM(NumberToVString(distributedVector%LIBRARY_TYPE,"*",err,error))// & + & " does not match the distributed matrix library type of "// & + & TRIM(NumberToVString(distributedMatrix%LIBRARY_TYPE,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + CALL FlagError("Distributed vector has not been finished.",err,error,*999) + ENDIF + ELSE + CALL FlagError("Distrubuted vector is not associated.",err,error,*999) + ENDIF + ELSE + CALL FlagError("Distributed matrix has not been finished.",err,error,*999) + ENDIF + ELSE + CALL FlagError("Distributed matrix is not associated",err,error,*999) + ENDIF + + EXITS("DistributedMatrix_MatrixRowByVector") + RETURN +999 ERRORSEXITS("DistributedMatrix_MatrixRowByVector",err,error) + RETURN 1 + + END SUBROUTINE DistributedMatrix_MatrixRowByVector + ! !================================================================================================================================ ! diff --git a/src/equations_set_routines.f90 b/src/equations_set_routines.f90 index 3ca9cbb3..0cd1a193 100644 --- a/src/equations_set_routines.f90 +++ b/src/equations_set_routines.f90 @@ -100,7 +100,7 @@ MODULE EQUATIONS_SET_ROUTINES PUBLIC EQUATIONS_SET_ASSEMBLE - PUBLIC EQUATIONS_SET_BACKSUBSTITUTE,EQUATIONS_SET_NONLINEAR_RHS_UPDATE + PUBLIC EquationsSet_Backsubstitute PUBLIC EQUATIONS_SET_BOUNDARY_CONDITIONS_ANALYTIC @@ -1818,414 +1818,282 @@ END SUBROUTINE EquationsSet_AssembleQuasistaticLinearFEM ! !>Backsubstitutes with an equations set to calculate unknown right hand side vectors - SUBROUTINE EQUATIONS_SET_BACKSUBSTITUTE(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*) + SUBROUTINE EquationsSet_Backsubstitute(equationsSet,boundaryConditions,err,error,*) !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !EQUATIONS_SET%DEPENDENT%DEPENDENT_FIELD - IF(ASSOCIATED(DEPENDENT_FIELD)) THEN - EQUATIONS=>EQUATIONS_SET%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - EQUATIONS_MATRICES=>EQUATIONS%EQUATIONS_MATRICES - IF(ASSOCIATED(EQUATIONS_MATRICES)) THEN - DYNAMIC_MATRICES=>EQUATIONS_MATRICES%DYNAMIC_MATRICES - IF(ASSOCIATED(DYNAMIC_MATRICES)) THEN - !CALL FlagError("Not implemented.",ERR,ERROR,*999) - ELSE - LINEAR_MATRICES=>EQUATIONS_MATRICES%LINEAR_MATRICES - IF(ASSOCIATED(LINEAR_MATRICES)) THEN - EQUATIONS_MAPPING=>EQUATIONS%EQUATIONS_MAPPING - IF(ASSOCIATED(EQUATIONS_MAPPING)) THEN - LINEAR_MAPPING=>EQUATIONS_MAPPING%LINEAR_MAPPING - IF(ASSOCIATED(LINEAR_MAPPING)) THEN - RHS_MAPPING=>EQUATIONS_MAPPING%RHS_MAPPING - SOURCE_MAPPING=>EQUATIONS_MAPPING%SOURCE_MAPPING - IF(ASSOCIATED(RHS_MAPPING)) THEN - IF(ASSOCIATED(BOUNDARY_CONDITIONS)) THEN - IF(ASSOCIATED(SOURCE_MAPPING)) THEN - SOURCE_VECTOR=>EQUATIONS_MATRICES%SOURCE_VECTOR - IF(ASSOCIATED(SOURCE_VECTOR)) THEN - SOURCE_DISTRIBUTED_VECTOR=>SOURCE_VECTOR%VECTOR - IF(ASSOCIATED(SOURCE_DISTRIBUTED_VECTOR)) THEN - CALL DISTRIBUTED_VECTOR_DATA_GET(SOURCE_DISTRIBUTED_VECTOR,SOURCE_VECTOR_DATA,ERR,ERROR,*999) - ELSE - CALL FlagError("Source distributed vector is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Source vector is not associated.",ERR,ERROR,*999) - ENDIF - ENDIF - RHS_VARIABLE=>RHS_MAPPING%RHS_VARIABLE - IF(ASSOCIATED(RHS_VARIABLE)) THEN - RHS_VARIABLE_TYPE=RHS_VARIABLE%VARIABLE_TYPE - RHS_DOMAIN_MAPPING=>RHS_VARIABLE%DOMAIN_MAPPING - IF(ASSOCIATED(RHS_DOMAIN_MAPPING)) THEN - CALL BOUNDARY_CONDITIONS_VARIABLE_GET(BOUNDARY_CONDITIONS,RHS_VARIABLE,RHS_BOUNDARY_CONDITIONS, & - & ERR,ERROR,*999) - IF(ASSOCIATED(RHS_BOUNDARY_CONDITIONS)) THEN - !Loop over the equations matrices - DO equations_matrix_idx=1,LINEAR_MATRICES%NUMBER_OF_LINEAR_MATRICES - DEPENDENT_VARIABLE=>LINEAR_MAPPING%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)%VARIABLE - IF(ASSOCIATED(DEPENDENT_VARIABLE)) THEN - VARIABLE_TYPE=DEPENDENT_VARIABLE%VARIABLE_TYPE - !Get the dependent field variable parameters - CALL Field_ParameterSetDataGet(DEPENDENT_FIELD,VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & DEPENDENT_PARAMETERS,ERR,ERROR,*999) - EQUATIONS_MATRIX=>LINEAR_MATRICES%MATRICES(equations_matrix_idx)%PTR - IF(ASSOCIATED(EQUATIONS_MATRIX)) THEN - COLUMN_DOMAIN_MAPPING=>LINEAR_MAPPING%EQUATIONS_MATRIX_TO_VAR_MAPS(equations_matrix_idx)% & - & COLUMN_DOFS_MAPPING - IF(ASSOCIATED(COLUMN_DOMAIN_MAPPING)) THEN - EQUATIONS_DISTRIBUTED_MATRIX=>EQUATIONS_MATRIX%MATRIX - IF(ASSOCIATED(EQUATIONS_DISTRIBUTED_MATRIX)) THEN - CALL DISTRIBUTED_MATRIX_STORAGE_TYPE_GET(EQUATIONS_DISTRIBUTED_MATRIX, & - & EQUATIONS_STORAGE_TYPE,ERR,ERROR,*999) - CALL DISTRIBUTED_MATRIX_DATA_GET(EQUATIONS_DISTRIBUTED_MATRIX,EQUATIONS_MATRIX_DATA, & - & ERR,ERROR,*999) - SELECT CASE(EQUATIONS_STORAGE_TYPE) - CASE(DISTRIBUTED_MATRIX_BLOCK_STORAGE_TYPE) - !Loop over the non ghosted rows in the equations set - DO equations_row_number=1,EQUATIONS_MAPPING%NUMBER_OF_ROWS - RHS_VALUE=0.0_DP - rhs_variable_dof=RHS_MAPPING%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number) - rhs_global_dof=RHS_DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof) - rhs_boundary_condition=RHS_BOUNDARY_CONDITIONS%DOF_TYPES(rhs_global_dof) - !For free RHS DOFs, set the right hand side field values by multiplying the - !row by the dependent variable value - SELECT CASE(rhs_boundary_condition) - CASE(BOUNDARY_CONDITION_DOF_FREE) - !Back substitute - !Loop over the local columns of the equations matrix - DO equations_column_idx=1,COLUMN_DOMAIN_MAPPING%TOTAL_NUMBER_OF_LOCAL - equations_column_number=COLUMN_DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP( & - & equations_column_idx) - variable_dof=equations_column_idx - MATRIX_VALUE=EQUATIONS_MATRIX_DATA(equations_row_number+ & - & (equations_column_number-1)*EQUATIONS_MATRICES%TOTAL_NUMBER_OF_ROWS) - DEPENDENT_VALUE=DEPENDENT_PARAMETERS(variable_dof) - RHS_VALUE=RHS_VALUE+MATRIX_VALUE*DEPENDENT_VALUE - ENDDO !equations_column_idx - CASE(BOUNDARY_CONDITION_DOF_FIXED) - !Do nothing - CASE(BOUNDARY_CONDITION_DOF_MIXED) - !Robin or is it Cauchy??? boundary conditions - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE DEFAULT - LOCAL_ERROR="The RHS variable boundary condition of "// & - & TRIM(NUMBER_TO_VSTRING(rhs_boundary_condition,"*",ERR,ERROR))// & - & " for RHS variable dof number "// & - & TRIM(NUMBER_TO_VSTRING(rhs_variable_dof,"*",ERR,ERROR))//" is invalid." - CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) - END SELECT - IF(ASSOCIATED(SOURCE_MAPPING)) THEN - SOURCE_VALUE=SOURCE_VECTOR_DATA(equations_row_number) - RHS_VALUE=RHS_VALUE-SOURCE_VALUE - ENDIF - CALL Field_ParameterSetUpdateLocalDOF(DEPENDENT_FIELD,RHS_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,rhs_variable_dof,RHS_VALUE,ERR,ERROR,*999) - ENDDO !equations_row_number - CASE(DISTRIBUTED_MATRIX_DIAGONAL_STORAGE_TYPE) - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE(DISTRIBUTED_MATRIX_COLUMN_MAJOR_STORAGE_TYPE) - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE(DISTRIBUTED_MATRIX_ROW_MAJOR_STORAGE_TYPE) - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE(DISTRIBUTED_MATRIX_COMPRESSED_ROW_STORAGE_TYPE) - CALL DISTRIBUTED_MATRIX_STORAGE_LOCATIONS_GET(EQUATIONS_DISTRIBUTED_MATRIX, & - & ROW_INDICES,COLUMN_INDICES,ERR,ERROR,*999) - !Loop over the non-ghosted rows in the equations set - DO equations_row_number=1,EQUATIONS_MAPPING%NUMBER_OF_ROWS - RHS_VALUE=0.0_DP - rhs_variable_dof=RHS_MAPPING%EQUATIONS_ROW_TO_RHS_DOF_MAP(equations_row_number) - rhs_global_dof=RHS_DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(rhs_variable_dof) - rhs_boundary_condition=RHS_BOUNDARY_CONDITIONS%DOF_TYPES(rhs_global_dof) - SELECT CASE(rhs_boundary_condition) - CASE(BOUNDARY_CONDITION_DOF_FREE) - !Back substitute - !Loop over the local columns of the equations matrix - DO equations_column_idx=ROW_INDICES(equations_row_number), & - ROW_INDICES(equations_row_number+1)-1 - equations_column_number=COLUMN_INDICES(equations_column_idx) - variable_dof=equations_column_idx-ROW_INDICES(equations_row_number)+1 - MATRIX_VALUE=EQUATIONS_MATRIX_DATA(equations_column_idx) - DEPENDENT_VALUE=DEPENDENT_PARAMETERS(variable_dof) - RHS_VALUE=RHS_VALUE+MATRIX_VALUE*DEPENDENT_VALUE - ENDDO !equations_column_idx - CASE(BOUNDARY_CONDITION_DOF_FIXED) - !Do nothing - CASE(BOUNDARY_CONDITION_DOF_MIXED) - !Robin or is it Cauchy??? boundary conditions - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE DEFAULT - LOCAL_ERROR="The global boundary condition of "// & - & TRIM(NUMBER_TO_VSTRING(rhs_boundary_condition,"*",ERR,ERROR))// & - & " for RHS variable dof number "// & - & TRIM(NUMBER_TO_VSTRING(rhs_variable_dof,"*",ERR,ERROR))//" is invalid." - CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) - END SELECT - IF(ASSOCIATED(SOURCE_MAPPING)) THEN - SOURCE_VALUE=SOURCE_VECTOR_DATA(equations_row_number) - RHS_VALUE=RHS_VALUE-SOURCE_VALUE - ENDIF - CALL Field_ParameterSetUpdateLocalDOF(DEPENDENT_FIELD,RHS_VARIABLE_TYPE, & - & FIELD_VALUES_SET_TYPE,rhs_variable_dof,RHS_VALUE,ERR,ERROR,*999) - ENDDO !equations_row_number - CASE(DISTRIBUTED_MATRIX_COMPRESSED_COLUMN_STORAGE_TYPE) - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE(DISTRIBUTED_MATRIX_ROW_COLUMN_STORAGE_TYPE) - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "// & - & TRIM(NUMBER_TO_VSTRING(EQUATIONS_STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." - CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) - END SELECT - CALL DISTRIBUTED_MATRIX_DATA_RESTORE(EQUATIONS_DISTRIBUTED_MATRIX,EQUATIONS_MATRIX_DATA, & - & ERR,ERROR,*999) - ELSE - CALL FlagError("Equations matrix distributed matrix is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Equations column domain mapping is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Equations equations matrix is not associated.",ERR,ERROR,*999) - ENDIF - !Restore the dependent field variable parameters - CALL Field_ParameterSetDataRestore(DEPENDENT_FIELD,VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & DEPENDENT_PARAMETERS,ERR,ERROR,*999) - ELSE - CALL FlagError("Dependent variable is not associated.",ERR,ERROR,*999) - ENDIF - ENDDO !equations_matrix_idx - !Start the update of the field parameters - CALL Field_ParameterSetUpdateStart(DEPENDENT_FIELD,RHS_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & ERR,ERROR,*999) - !Finish the update of the field parameters - CALL Field_ParameterSetUpdateFinish(DEPENDENT_FIELD,RHS_VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & ERR,ERROR,*999) - ELSE - CALL FlagError("RHS boundary conditions variable is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("RHS variable domain mapping is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("RHS variable is not associated.",ERR,ERROR,*999) - ENDIF - IF(ASSOCIATED(SOURCE_MAPPING)) THEN - CALL DISTRIBUTED_VECTOR_DATA_RESTORE(SOURCE_DISTRIBUTED_VECTOR,SOURCE_VECTOR_DATA,ERR,ERROR,*999) - ENDIF + IF(ASSOCIATED(equationsSet)) THEN + IF(equationsSet%EQUATIONS_SET_FINISHED) THEN + dependentField=>equationsSet%dependent%DEPENDENT_FIELD + IF(ASSOCIATED(dependentField)) THEN + equations=>equationsSet%equations + IF(ASSOCIATED(equations)) THEN + equationsMatrices=>equations%EQUATIONS_MATRICES + IF(ASSOCIATED(equationsMatrices)) THEN + equationsMapping=>equations%EQUATIONS_MAPPING + IF(ASSOCIATED(equationsMapping)) THEN + dynamicMapping=>equationsMapping%DYNAMIC_MAPPING + IF(ASSOCIATED(dynamicMapping)) THEN + !Setup any dynamic contributions + dynamicVariableType=dynamicMapping%DYNAMIC_VARIABLE_TYPE + dynamicVariable=>dynamicMapping%DYNAMIC_VARIABLE + IF(ASSOCIATED(dynamicVariable)) THEN + dynamicMatrices=>equationsMatrices%DYNAMIC_MATRICES + IF(ASSOCIATED(dynamicMatrices)) THEN + IF(dynamicMapping%STIFFNESS_MATRIX_NUMBER/=0) THEN + !Get stiffness matrix displacement data + stiffnessMatrix=>dynamicMatrices%matrices(dynamicMapping%STIFFNESS_MATRIX_NUMBER)%ptr + IF(ASSOCIATED(stiffnessMatrix)) THEN + distributedStiffnessMatrix=>stiffnessMatrix%matrix + NULLIFY(distributedDisplacementVector) + CALL Field_ParameterSetVectorGet(dependentField,dynamicVariableType, & + & FIELD_VALUES_SET_TYPE,distributedDisplacementVector,err,error,*999) ELSE - CALL FlagError("Boundary conditions are not associated.",ERR,ERROR,*999) + CALL FlagError("Dynamic stiffness matrix is not associated.",err,error,*999) + ENDIF + ENDIF + IF(dynamicMapping%DAMPING_MATRIX_NUMBER/=0.AND. & + & equations%TIME_DEPENDENCE>=EQUATIONS_FIRST_ORDER_DYNAMIC) THEN + !Get damping matrix velocity data + dampingMatrix=>dynamicMatrices%matrices(dynamicMapping%DAMPING_MATRIX_NUMBER)%ptr + IF(ASSOCIATED(dampingMatrix)) THEN + distributedDampingMatrix=>dampingMatrix%matrix + NULLIFY(distributedVelocityVector) + CALL Field_ParameterSetVectorGet(dependentField,dynamicVariableType, & + & FIELD_VELOCITY_VALUES_SET_TYPE,distributedVelocityVector,err,error,*999) + ELSE + CALL FlagError("Dynamic damping matrix is not associated.",err,error,*999) + ENDIF + ENDIF + IF(dynamicMapping%MASS_MATRIX_NUMBER/=0.AND. & + & equations%TIME_DEPENDENCE>=EQUATIONS_SECOND_ORDER_DYNAMIC) THEN + !Get mass matrix acceleration data + massMatrix=>dynamicMatrices%matrices(dynamicMapping%MASS_MATRIX_NUMBER)%ptr + IF(ASSOCIATED(massMatrix)) THEN + distributedMassMatrix=>massMatrix%matrix + NULLIFY(distributedAccelerationVector) + CALL Field_ParameterSetVectorGet(dependentField,dynamicVariableType, & + & FIELD_ACCELERATION_VALUES_SET_TYPE,distributedAccelerationVector,err,error,*999) + ELSE + CALL FlagError("Dynamic mass matrix is not associated.",err,error,*999) ENDIF - ELSE - CALL FlagError("Equations mapping RHS mappings is not associated.",ERR,ERROR,*999) ENDIF ELSE - CALL FlagError("Equations mapping linear mapping is not associated.",ERR,ERROR,*999) + CALL FlagError("Equations matrices dynamic matrices is not associated.",err,error,*999) ENDIF ELSE - CALL FlagError("Equations mapping is not associated.",ERR,ERROR,*999) + CALL FlagError("Dynamic mapping dynamic variable is not associated.",err,error,*999) ENDIF - ELSE - CALL FlagError("Equations matrices linear matrices is not associated.",ERR,ERROR,*999) ENDIF - ENDIF - ELSE - CALL FlagError("Equations matrices is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Equations is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Dependent field is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Equations set has not been finished.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Equations set is not associated",ERR,ERROR,*999) - ENDIF - - EXITS("EQUATIONS_SET_BACKSUBSTITUTE") - RETURN -999 ERRORSEXITS("EQUATIONS_SET_BACKSUBSTITUTE",ERR,ERROR) - RETURN 1 - - END SUBROUTINE EQUATIONS_SET_BACKSUBSTITUTE - - ! - !================================================================================================================================ - ! - - !>Updates the right hand side variable from the equations residual vector - SUBROUTINE EQUATIONS_SET_NONLINEAR_RHS_UPDATE(EQUATIONS_SET,BOUNDARY_CONDITIONS,ERR,ERROR,*) - - !Argument variables - TYPE(EQUATIONS_SET_TYPE), POINTER :: EQUATIONS_SET !EQUATIONS_SET%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - EQUATIONS_MAPPING=>EQUATIONS%EQUATIONS_MAPPING - IF(ASSOCIATED(EQUATIONS_MAPPING)) THEN - RHS_MAPPING=>EQUATIONS_MAPPING%RHS_MAPPING - IF(ASSOCIATED(RHS_MAPPING)) THEN - RHS_VARIABLE=>RHS_MAPPING%RHS_VARIABLE - IF(ASSOCIATED(RHS_VARIABLE)) THEN - !Get the right hand side variable - RHS_FIELD=>RHS_VARIABLE%FIELD - VARIABLE_TYPE=RHS_VARIABLE%VARIABLE_TYPE - ELSE - CALL FlagError("RHS mapping RHS variable is not associated.",ERR,ERROR,*999) - ENDIF - ELSE - CALL FlagError("Equations mapping RHS mapping is not associated.",ERR,ERROR,*999) - ENDIF - IF(ASSOCIATED(RHS_FIELD)) THEN - IF(ASSOCIATED(BOUNDARY_CONDITIONS)) THEN - RHS_DOMAIN_MAPPING=>RHS_VARIABLE%DOMAIN_MAPPING - IF(ASSOCIATED(RHS_DOMAIN_MAPPING)) THEN - CALL BOUNDARY_CONDITIONS_VARIABLE_GET(BOUNDARY_CONDITIONS,RHS_VARIABLE,RHS_BOUNDARY_CONDITIONS, & - & ERR,ERROR,*999) - IF(ASSOCIATED(RHS_BOUNDARY_CONDITIONS)) THEN - !Get the equations residual vector - EQUATIONS_MATRICES=>EQUATIONS%EQUATIONS_MATRICES - IF(ASSOCIATED(EQUATIONS_MATRICES)) THEN - NONLINEAR_MATRICES=>EQUATIONS_MATRICES%NONLINEAR_MATRICES - IF(ASSOCIATED(NONLINEAR_MATRICES)) THEN - RESIDUAL_VECTOR=>NONLINEAR_MATRICES%RESIDUAL - IF(ASSOCIATED(RESIDUAL_VECTOR)) THEN - !Get mapping from equations rows to field dofs - NONLINEAR_MAPPING=>EQUATIONS_MAPPING%NONLINEAR_MAPPING - IF(ASSOCIATED(NONLINEAR_MAPPING)) THEN - DO equations_matrix_idx=1,NONLINEAR_MAPPING%NUMBER_OF_RESIDUAL_VARIABLES - RESIDUAL_VARIABLE=>NONLINEAR_MAPPING%JACOBIAN_TO_VAR_MAP(equations_matrix_idx)%VARIABLE - IF(ASSOCIATED(RESIDUAL_VARIABLE)) THEN - DO row_idx=1,EQUATIONS_MAPPING%NUMBER_OF_ROWS - variable_dof=RHS_MAPPING%EQUATIONS_ROW_TO_RHS_DOF_MAP(row_idx) - rhs_global_dof=RHS_DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(variable_dof) - rhs_boundary_condition=RHS_BOUNDARY_CONDITIONS%DOF_TYPES(rhs_global_dof) - SELECT CASE(rhs_boundary_condition) - CASE(BOUNDARY_CONDITION_DOF_FREE) - !Add residual to field value - CALL DISTRIBUTED_VECTOR_VALUES_GET(RESIDUAL_VECTOR,row_idx,VALUE,ERR,ERROR,*999) - CALL Field_ParameterSetUpdateLocalDOF(RHS_FIELD,VARIABLE_TYPE,FIELD_VALUES_SET_TYPE, & - & variable_dof,VALUE,ERR,ERROR,*999) - CASE(BOUNDARY_CONDITION_DOF_FIXED) - !Do nothing - CASE(BOUNDARY_CONDITION_DOF_MIXED) - CALL FlagError("Not implemented.",ERR,ERROR,*999) - CASE DEFAULT - LOCAL_ERROR="The RHS variable boundary condition of "// & - & TRIM(NUMBER_TO_VSTRING(rhs_boundary_condition,"*",ERR,ERROR))// & - & " for RHS variable dof number "// & - & TRIM(NUMBER_TO_VSTRING(variable_dof,"*",ERR,ERROR))//" is invalid." - CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) - END SELECT - ENDDO - ELSE - CALL FlagError("Residual variable is not associated.",ERR,ERROR,*999) + linearMapping=>equationsMapping%LINEAR_MAPPING + IF(ASSOCIATED(linearMapping)) THEN + !Setup any linear contributions + linearMatrices=>equationsMatrices%LINEAR_MATRICES + IF(ASSOCIATED(linearMatrices)) THEN + DO linearMatrixIdx=1,linearMatrices%NUMBER_OF_LINEAR_MATRICES + linearMatrix=>linearMatrices%matrices(linearMatrixIdx)%ptr + IF(.NOT.ASSOCIATED(linearMatrix)) THEN + localError="Linear matrix number "//TRIM(NumberToVstring(linearMatrixIdx,"*",err,error))// & + & " is not associated." + CALL FlagError(localError,err,error,*999) + ENDIF + ENDDO !linearMatrixIdx + ELSE + CALL FlagError("Equations matrices linear matrices is not associated.",err,error,*999) + ENDIF + ENDIF + nonlinearMapping=>equationsMapping%NONLINEAR_MAPPING + IF(ASSOCIATED(nonlinearMapping)) THEN + !Setup any nonlinear contributions + nonlinearMatrices=>equationsMatrices%NONLINEAR_MATRICES + IF(ASSOCIATED(nonlinearMatrices)) THEN + distributedResidualVector=>nonlinearMatrices%residual + IF(ASSOCIATED(distributedResidualVector)) THEN + CALL DistributedVector_DataGet(distributedResidualVector,residualData,err,error,*999) + ELSE + CALL FlagError("Nonlinear matrices residual is not associated.",err,error,*999) + ENDIF + ELSE + CALL FlagError("Equations matrices nonlinear matrices is not associated.",err,error,*999) + ENDIF + ENDIF + sourceMapping=>equationsMapping%SOURCE_MAPPING + IF(ASSOCIATED(sourceMapping)) THEN + !Setup any source contributions + sourceVector=>equationsMatrices%SOURCE_VECTOR + IF(ASSOCIATED(sourceVector)) THEN + distributedSourceVector=>sourceVector%vector + IF(ASSOCIATED(distributedSourceVector)) THEN + CALL DistributedVector_DataGet(distributedSourceVector,sourceData,err,error,*999) + ELSE + CALL FlagError("Source vector distributed vector is not associated.",err,error,*999) + ENDIF + ELSE + CALL FlagError("Equations matrices source vector is not associated.",err,error,*999) + ENDIF + ENDIF + rhsMapping=>equationsMapping%RHS_MAPPING + IF(ASSOCIATED(rhsMapping)) THEN + !Calculate unknown RHS values + rhsVariableType=rhsMapping%RHS_VARIABLE_TYPE + rhsVariable=>rhsMapping%RHS_VARIABLE + IF(ASSOCIATED(rhsVariable)) THEN + domainMapping=>rhsVariable%DOMAIN_MAPPING + IF(ASSOCIATED(domainMapping)) THEN + NULLIFY(rhsBoundaryConditions) + CALL BoundaryConditions_VariableGet(boundaryConditions,rhsVariable,rhsBoundaryConditions,err,error,*999) + IF(ASSOCIATED(rhsBoundaryConditions)) THEN + !Loop over the non ghosted rows in the equations set + DO equationsRowNumber=1,equationsMapping%NUMBER_OF_ROWS + rhsVariableDOF=rhsMapping%EQUATIONS_ROW_TO_RHS_DOF_MAP(equationsRowNumber) + rhsGlobalDOF=domainMapping%LOCAL_TO_GLOBAL_MAP(rhsVariableDOF) + rhsBoundaryCondition=rhsBoundaryConditions%DOF_TYPES(rhsGlobalDOF) + !For free RHS DOFs, set the right hand side field values by multiplying the + !row by the dependent variable value +!!TODO: WHAT ABOUT POINT NEUMMAN CONDITIONS??? + SELECT CASE(rhsBoundaryCondition) + CASE(BOUNDARY_CONDITION_DOF_FREE) + !Back substitute + lhsValue=0.0 + IF(ASSOCIATED(dynamicMapping)) THEN + !Add in any dynamic contributions + IF(ASSOCIATED(stiffnessMatrix)) THEN + CALL DistributedMatrix_MatrixRowByVector(equationsRowNumber,distributedStiffnessMatrix, & + & distributedDisplacementVector,dynamicValue,err,error,*999) + lhsValue=lhsValue+dynamicValue + ENDIF + IF(ASSOCIATED(dampingMatrix)) THEN + CALL DistributedMatrix_MatrixRowByVector(equationsRowNumber,distributedDampingMatrix, & + & distributedVelocityVector,dynamicValue,err,error,*999) + lhsValue=lhsValue+dynamicValue + ENDIF + IF(ASSOCIATED(massMatrix)) THEN + CALL DistributedMatrix_MatrixRowByVector(equationsRowNumber,distributedMassMatrix, & + & distributedAccelerationVector,dynamicValue,err,error,*999) + lhsValue=lhsValue+dynamicValue + ENDIF ENDIF - ENDDO !equations_matrix_idx - ELSE - CALL FlagError("Nonlinear mapping is not associated.",ERR,ERROR,*999) - ENDIF + IF(ASSOCIATED(linearMapping)) THEN + !Add in any linear contributions + DO linearMatrixIdx=1,linearMatrices%NUMBER_OF_LINEAR_MATRICES + linearMatrix=>linearMatrices%matrices(linearMatrixIdx)%ptr + distributedLinearMatrix=>linearMatrix%matrix + linearVariableType=linearMapping%EQUATIONS_MATRIX_TO_VAR_MAPS(linearMatrixIdx)%VARIABLE_TYPE + NULLIFY(distributedLinearVector) + CALL Field_ParameterSetVectorGet(dependentField,linearVariableType,FIELD_VALUES_SET_TYPE, & + & distributedLinearVector,err,error,*999) + CALL DistributedMatrix_MatrixRowByVector(equationsRowNumber,distributedLinearMatrix, & + & distributedLinearVector,linearValue,err,error,*999) + lhsValue=lhsValue+linearValue + ENDDO !linearMatrixIdx + ENDIF + IF(ASSOCIATED(nonlinearMapping)) THEN + !Add in any nonlinear contributions + lhsValue=lhsValue+residualData(equationsRowNumber) + ENDIF + IF(ASSOCIATED(sourceMapping)) THEN + !Add in any source contributions + lhsValue=lhsValue+sourceData(equationsRowNumber) + ENDIF + !Make the equations row equal zero and set RHS value + rhsValue=-lhsValue + CALL Field_ParameterSetUpdateLocalDOF(dependentField,rhsVariableType,FIELD_VALUES_SET_TYPE, & + & rhsVariableDOF,rhsValue,err,error,*999) + CASE(BOUNDARY_CONDITION_DOF_FIXED) + !Do nothing + CASE(BOUNDARY_CONDITION_DOF_MIXED) + !Robin or is it Cauchy??? boundary conditions + CALL FlagError("Not implemented.",err,error,*999) + CASE DEFAULT + localError="The RHS variable boundary condition of "// & + & TRIM(NumberToVstring(rhsBoundaryCondition,"*",err,error))//" for RHS variable dof number "// & + & TRIM(NumberToVstring(rhsVariableDOF,"*",err,error))//" is invalid." + CALL FlagError(localError,err,error,*999) + END SELECT + ENDDO !equationsRowNumber ELSE - CALL FlagError("Residual vector is not associated.",ERR,ERROR,*999) + CALL FlagError("RHS boundary conditions is not associated.",err,error,*999) ENDIF ELSE - CALL FlagError("Nonlinear matrices is not associated.",ERR,ERROR,*999) + CALL FlagError("RHS variable domain mapping is not associated.",err,error,*999) ENDIF - ELSE - CALL FlagError("Equations matrices is not associated.",ERR,ERROR,*999) ENDIF - ELSE - CALL FlagError("RHS boundary conditions variable is not associated.",ERR,ERROR,*999) + !Start the update of the field parameters + CALL Field_ParameterSetUpdateStart(dependentField,rhsVariableType,FIELD_VALUES_SET_TYPE,err,error,*999) + !Restore data + IF(ASSOCIATED(sourceMapping)) THEN + CALL DistributedVector_DataRestore(distributedSourceVector,sourceData,err,error,*999) + ENDIF + IF(ASSOCIATED(nonlinearMapping)) THEN + CALL DistributedVector_DataRestore(distributedResidualVector,residualData,err,error,*999) + ENDIF + !Finish the update of the field parameters + CALL Field_ParameterSetUpdateFinish(dependentField,rhsVariableType,FIELD_VALUES_SET_TYPE,err,error,*999) ENDIF - ELSE - CALL FlagError("RHS variable domain mapping is not associated.",ERR,ERROR,*999) ENDIF ELSE - CALL FlagError("Boundary conditions are not associated.",ERR,ERROR,*999) + CALL FlagError("Equations matrices is not associated.",err,error,*999) ENDIF - CALL Field_ParameterSetUpdateStart(RHS_FIELD,VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,ERR,ERROR,*999) - CALL Field_ParameterSetUpdateFinish(RHS_FIELD,VARIABLE_TYPE,FIELD_VALUES_SET_TYPE,ERR,ERROR,*999) ELSE - CALL FlagError("RHS variable field is not associated.",ERR,ERROR,*999) + CALL FlagError("Equations is not associated.",err,error,*999) ENDIF ELSE - CALL FlagError("Equations mapping is not associated.",ERR,ERROR,*999) + CALL FlagError("Dependent field is not associated.",err,error,*999) ENDIF - ELSE - CALL FlagError("Equations set equations is not associated.",ERR,ERROR,*999) + ELSE + CALL FlagError("Equations set has not been finished.",err,error,*999) ENDIF ELSE - CALL FlagError("Equations set is not associated.",ERR,ERROR,*999) + CALL FlagError("Equations set is not associated",err,error,*999) ENDIF - - EXITS("EQUATIONS_SET_NONLINEAR_RHS_UPDATE") + + EXITS("EquationsSet_Backsubstitute") RETURN -999 ERRORSEXITS("EQUATIONS_SET_NONLINEAR_RHS_UPDATE",ERR,ERROR) +999 IF(ASSOCIATED(distributedSourceVector)) CALL DistributedVector_DataRestore(distributedSourceVector,sourceData, & + & err,error,*998) +998 IF(ASSOCIATED(distributedResidualVector)) CALL DistributedVector_DataRestore(distributedResidualVector,residualData, & + & err,error,*997) +997 ERRORSEXITS("EquationsSet_Backsubstitute",err,error) RETURN 1 - - END SUBROUTINE EQUATIONS_SET_NONLINEAR_RHS_UPDATE - + + END SUBROUTINE EquationsSet_Backsubstitute + ! !================================================================================================================================ ! diff --git a/src/matrix_vector.f90 b/src/matrix_vector.f90 index 7cf57648..62db1dc5 100755 --- a/src/matrix_vector.f90 +++ b/src/matrix_vector.f90 @@ -169,7 +169,7 @@ MODULE MATRIX_VECTOR INTEGER(INTG), PARAMETER :: MATRIX_ROW_COLUMN_STORAGE_TYPE=6 !@} - INTEGER(INTG), PARAMETER :: bisectionToLinearSearchThreshold=10 !MATRIX%MAXIMUM_COLUMN_INDICES_PER_ROW) MATRIX%MAXIMUM_COLUMN_INDICES_PER_ROW=COUNT ENDDO !row_idx CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT IF(MATRIX%SIZE>0) THEN @@ -563,7 +814,7 @@ SUBROUTINE MATRIX_CREATE_FINISH(MATRIX,ERR,ERROR,*) ALLOCATE(MATRIX%DATA_L(MATRIX%SIZE),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate matrix logical data.",ERR,ERROR,*999) CASE DEFAULT - LOCAL_ERROR="The matrix data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDIF @@ -641,7 +892,7 @@ SUBROUTINE MATRIX_DATA_GET_INTG(MATRIX,DATA,ERR,ERROR,*) IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_INTG_TYPE) THEN DATA=>MATRIX%DATA_INTG ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -685,7 +936,7 @@ SUBROUTINE MATRIX_DATA_GET_SP(MATRIX,DATA,ERR,ERROR,*) IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_SP_TYPE) THEN DATA=>MATRIX%DATA_SP ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -729,7 +980,7 @@ SUBROUTINE MATRIX_DATA_GET_DP(MATRIX,DATA,ERR,ERROR,*) IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_DP_TYPE) THEN DATA=>MATRIX%DATA_DP ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -773,7 +1024,7 @@ SUBROUTINE MATRIX_DATA_GET_L(MATRIX,DATA,ERR,ERROR,*) IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_L_TYPE) THEN DATA=>MATRIX%DATA_L ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -853,7 +1104,7 @@ SUBROUTINE MATRIX_DATA_TYPE_SET(MATRIX,DATA_TYPE,ERR,ERROR,*) CASE(MATRIX_VECTOR_L_TYPE) MATRIX%DATA_TYPE=MATRIX_VECTOR_L_TYPE CASE DEFAULT - LOCAL_ERROR="The matrix vector data type of "//TRIM(NUMBER_TO_VSTRING(DATA_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix vector data type of "//TRIM(NumberToVString(DATA_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDIF @@ -927,7 +1178,7 @@ SUBROUTINE MATRIX_DUPLICATE(MATRIX,NEW_MATRIX,ERR,ERROR,*) CALL MATRIX_NUMBER_NON_ZEROS_SET(NEW_MATRIX,MATRIX%NUMBER_NON_ZEROS,ERR,ERROR,*999) CALL MATRIX_STORAGE_LOCATIONS_SET(NEW_MATRIX,MATRIX%ROW_INDICES,MATRIX%COLUMN_INDICES,ERR,ERROR,*999) CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT CALL MATRIX_CREATE_FINISH(NEW_MATRIX,ERR,ERROR,*999) @@ -1016,6 +1267,215 @@ END SUBROUTINE MATRIX_INITIALISE !================================================================================================================================ ! + !>Add alpha times a matrix vector product to a vector + SUBROUTINE Matrix_MatrixByVectorAdd(A,x,alpha,y,err,error,*) + + !Argument variables + TYPE(MATRIX_TYPE), POINTER :: A !Add alpha times a matrix vector product to a vector + SUBROUTINE Matrix_MatrixByVectorAddRows(startRow,endRow,A,x,alpha,y,err,error,*) + + !Argument variables + INTEGER(INTG) :: startRow !=1.AND.startRow<=A%M) THEN + IF(endRow>=1.AND.endRow<=A%M) THEN + IF(endRow>=startRow) THEN + IF(ABS(alpha)>ZERO_TOLERANCE) THEN + IF(ASSOCIATED(x)) THEN + IF(x%VECTOR_FINISHED) THEN + IF(A%N==x%N) THEN + IF(ASSOCIATED(y)) THEN + IF(Y%VECTOR_FINISHED) THEN + IF(A%M==y%N) THEN + IF(A%DATA_TYPE==x%DATA_TYPE) THEN + IF(A%DATA_TYPE==y%DATA_TYPE) THEN + SELECT CASE(A%DATA_TYPE) + CASE(MATRIX_VECTOR_INTG_TYPE) + CALL FlagError("Not implemented.",ERR,ERROR,*999) + CASE(MATRIX_VECTOR_SP_TYPE) + CALL FlagError("Not implemented.",ERR,ERROR,*999) + CASE(MATRIX_VECTOR_DP_TYPE) + SELECT CASE(A%STORAGE_TYPE) + CASE(MATRIX_BLOCK_STORAGE_TYPE) + DO row=startRow,endRow + sumDP=0.0_DP + DO column=1,A%N + sumDP=sumDP+A%DATA_DP(row+(column-1)*A%M)*x%DATA_DP(column) + ENDDO !local_column + y%DATA_DP(row)=y%DATA_DP(row)+(alpha*sumDP) + ENDDO !row + CASE(MATRIX_DIAGONAL_STORAGE_TYPE) + DO row=startRow,endRow + sumDP=A%DATA_DP(row)*x%DATA_DP(row) + y%DATA_DP(row)=y%DATA_DP(row)+(alpha*sumDP) + ENDDO !row + CASE(MATRIX_COLUMN_MAJOR_STORAGE_TYPE) + DO row=startRow,endRow + sumDP=0.0_DP + DO column=1,A%N + sumDP=sumDP+A%DATA_DP(row+(column-1)*A%MAX_M)*x%DATA_DP(column) + ENDDO !column + y%DATA_DP(row)=y%DATA_DP(row)+(alpha*sumDP) + ENDDO !row + CASE(MATRIX_ROW_MAJOR_STORAGE_TYPE) + DO row=startRow,endRow + sumDP=0.0_DP + DO column=1,A%N + sumDP=sumDP+A%DATA_DP((row-1)*A%MAX_N+column)*x%DATA_DP(column) + ENDDO !column + y%DATA_DP(row)=y%DATA_DP(row)+(alpha*sumDP) + ENDDO !row + CASE(MATRIX_COMPRESSED_ROW_STORAGE_TYPE) + DO row=startRow,endRow + sumDP=0.0_DP + DO columnIdx=A%ROW_INDICES(row),A%ROW_INDICES(row+1)-1 + column=A%COLUMN_INDICES(columnIdx) + sumDP=sumDP+A%DATA_DP(columnIdx)*x%DATA_DP(column) + ENDDO !columnIdx + y%DATA_DP(row)=y%DATA_DP(row)+(alpha*sumDP) + ENDDO !row + CASE(MATRIX_COMPRESSED_COLUMN_STORAGE_TYPE) + IF(startRow==1.AND.endRow==A%M) THEN + !Whole matrix + DO column=1,A%N + DO rowIdx=A%COLUMN_INDICES(column),A%COLUMN_INDICES(column+1)-1 + row=A%ROW_INDICES(rowIdx) + y%DATA_DP(row)=y%DATA_DP(row)+alpha*A%DATA_DP(rowIdx)*x%DATA_DP(column) + ENDDO !rowIdx + ENDDO !column + ELSE + !Just part rows + location=0 + DO column=1,A%N + DO row=startRow,endRow + CALL Matrix_StorageLocationFind(A,row,column,location,err,error,*999) + IF(location/=0) y%DATA_DP(row)=y%DATA_DP(row)+alpha*A%DATA_DP(location)*x%DATA_DP(column) + ENDDO !row + ENDDO !column + ENDIF + CASE(MATRIX_ROW_COLUMN_STORAGE_TYPE) + CALL FlagError("Not implemented.",err,error,*999) + CASE DEFAULT + localError="The A matrix storage type of "// & + & TRIM(NumberToVString(A%STORAGE_TYPE,"*",err,error))//" is invalid." + CALL FlagError(localError,err,error,*999) + END SELECT + CASE(MATRIX_VECTOR_L_TYPE) + CALL FlagError("Not implemented.",err,error,*999) + CASE DEFAULT + localError="The A matrix data type of "//TRIM(NumberToVString(A%DATA_TYPE,"*",err,error))// & + & " is invalid." + CALL FlagError(localError,err,error,*999) + END SELECT + ELSE + localError="The A matrix data type of "//TRIM(NumberToVString(A%DATA_TYPE,"*",err,error))// & + & " does not match the y vector data type of "// & + & TRIM(NumberToVString(y%DATA_TYPE,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + localError="The A matrix data type of "//TRIM(NumberToVString(A%DATA_TYPE,"*",err,error))// & + & " does not match the x vector data type of "// & + & TRIM(NumberToVString(x%DATA_TYPE,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + localError="The number of A matrix rows of "//TRIM(NumberToVString(A%M,"*",err,error))// & + & " does not match the number of y vector rows of "//TRIM(NumberToVString(y%N,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + CALL FlagError("The y vector has not been finished.",err,error,*999) + ENDIF + ELSE + CALL FlagError("The y vector is not associated.",err,error,*999) + ENDIF + ELSE + localError="The number of A matrix columns of "//TRIM(NumberToVString(A%N,"*",err,error))// & + & " does not match the number of x vector rows of "//TRIM(NumberToVString(x%N,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + CALL FlagError("The x vector has not been finished.",err,error,*999) + ENDIF + ELSE + CALL FlagError("The x vector is not associated.",err,error,*999) + ENDIF + ENDIF + ELSE + localError="The end row number of "//TRIM(NumberToVString(endRow,"*",err,error))// & + & " is less than the start row number of "//TRIM(NumberToVString(startRow,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + localError="The end row number of "//TRIM(NumberToVString(endRow,"*",err,error))// & + & " is invalid. It must be >= 1 and <= "//TRIM(NumberToVString(A%M,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + localError="The start row number of "//TRIM(NumberToVString(startRow,"*",err,error))// & + & " is invalid. It must be >= 1 and <= "//TRIM(NumberToVString(A%M,"*",err,error))//"." + CALL FlagError(localError,err,error,*999) + ENDIF + ELSE + CALL FlagError("The A matrix has not been finished.",err,error,*999) + ENDIF + ELSE + CALL FlagError("Matrix is not associated.",err,error,*999) + ENDIF + + EXITS("Matrix_MatrixByVectorAddRows") + RETURN +999 ERRORSEXITS("Matrix_MatrixByVectorAddRows",err,error) + RETURN 1 + END SUBROUTINE Matrix_MatrixByVectorAddRows + + ! + !================================================================================================================================ + ! + !>Gets the maximum number of columns in each row of a distributed matrix. SUBROUTINE MATRIX_MAX_COLUMNS_PER_ROW_GET(MATRIX,MAX_COLUMNS_PER_ROW,ERR,ERROR,*) @@ -1078,12 +1538,12 @@ SUBROUTINE MATRIX_NUMBER_NON_ZEROS_SET(MATRIX,NUMBER_NON_ZEROS,ERR,ERROR,*) IF(NUMBER_NON_ZEROS>=0) THEN MATRIX%NUMBER_NON_ZEROS=NUMBER_NON_ZEROS ELSE - LOCAL_ERROR="The number of non-zeros ("//TRIM(NUMBER_TO_VSTRING(NUMBER_NON_ZEROS,"*",ERR,ERROR))// & - & ") is invalid. The number must be greater than or equal to zero." + LOCAL_ERROR="The number of non-zeros ("//TRIM(NumberToVString(NUMBER_NON_ZEROS,"*",ERR,ERROR))// & + & ") is invalid. The number must be >= 0." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDIF @@ -1122,7 +1582,7 @@ SUBROUTINE MATRIX_NUMBER_NON_ZEROS_GET(MATRIX,NUMBER_NON_ZEROS,ERR,ERROR,*) & MATRIX_ROW_COLUMN_STORAGE_TYPE) NUMBER_NON_ZEROS=MATRIX%NUMBER_NON_ZEROS CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE @@ -1228,22 +1688,22 @@ SUBROUTINE MATRIX_MAX_SIZE_SET(MATRIX,MAX_M,MAX_N,ERR,ERROR,*) MATRIX%MAX_M=MAX_M MATRIX%MAX_N=MAX_N ELSE - LOCAL_ERROR="The maximum number of matrix rows ("//TRIM(NUMBER_TO_VSTRING(MAX_N,"*",ERR,ERROR))// & - & ") must be >= the number of matrix rows ("//TRIM(NUMBER_TO_VSTRING(MATRIX%N,"*",ERR,ERROR))//")." + LOCAL_ERROR="The maximum number of matrix rows ("//TRIM(NumberToVString(MAX_N,"*",ERR,ERROR))// & + & ") must be >= the number of matrix rows ("//TRIM(NumberToVString(MATRIX%N,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The maximum number of matrix columns ("//TRIM(NUMBER_TO_VSTRING(MAX_M,"*",ERR,ERROR))// & - & ") must be >= the number of matrix columns ("//TRIM(NUMBER_TO_VSTRING(MATRIX%M,"*",ERR,ERROR))//")." + LOCAL_ERROR="The maximum number of matrix columns ("//TRIM(NumberToVString(MAX_M,"*",ERR,ERROR))// & + & ") must be >= the number of matrix columns ("//TRIM(NumberToVString(MATRIX%M,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The maximum number of matrix columns of "//TRIM(NUMBER_TO_VSTRING(MAX_N,"*",ERR,ERROR))// & + LOCAL_ERROR="The maximum number of matrix columns of "//TRIM(NumberToVString(MAX_N,"*",ERR,ERROR))// & & " is invalid. The number must be > 0." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The maximum number of matrix rows of "//TRIM(NUMBER_TO_VSTRING(MAX_M,"*",ERR,ERROR))// & + LOCAL_ERROR="The maximum number of matrix rows of "//TRIM(NumberToVString(MAX_M,"*",ERR,ERROR))// & & " is invalid. The number must be > 0." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -1284,23 +1744,23 @@ SUBROUTINE MATRIX_OUTPUT(ID,MATRIX,ERR,ERROR,*) CASE(MATRIX_BLOCK_STORAGE_TYPE) SELECT CASE(MATRIX%DATA_TYPE) CASE(MATRIX_VECTOR_INTG_TYPE) - CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_INTG,(/MATRIX%MAX_M,MATRIX%MAX_N/)), & + CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_INTG,[MATRIX%MAX_M,MATRIX%MAX_N]), & & WRITE_STRING_MATRIX_NAME_AND_INDICES,'("Matrix','(",I9,",:)',':",8(X,I13))','(20X,8(X,I13))', & & ERR,ERROR,*999) CASE(MATRIX_VECTOR_SP_TYPE) - CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_SP,(/MATRIX%MAX_M,MATRIX%MAX_N/)), & + CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_SP,[MATRIX%MAX_M,MATRIX%MAX_N]), & & WRITE_STRING_MATRIX_NAME_AND_INDICES,'("Matrix','(",I9,",:)',':",8(X,E13.6))','(20X,8(X,E13.6))', & & ERR,ERROR,*999) CASE(MATRIX_VECTOR_DP_TYPE) - CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_DP,(/MATRIX%MAX_M,MATRIX%MAX_N/)), & + CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_DP,[MATRIX%MAX_M,MATRIX%MAX_N]), & & WRITE_STRING_MATRIX_NAME_AND_INDICES,'("Matrix','(",I9,",:)',':",8(X,E13.6))','(20X,8(X,E13.6))', & & ERR,ERROR,*999) CASE(MATRIX_VECTOR_L_TYPE) - CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_L,(/MATRIX%MAX_M,MATRIX%MAX_N/)), & + CALL WRITE_STRING_MATRIX(ID,1,1,MATRIX%M,1,1,MATRIX%N,8,8,RESHAPE(MATRIX%DATA_L,[MATRIX%MAX_M,MATRIX%MAX_N]), & & WRITE_STRING_MATRIX_NAME_AND_INDICES,'("Matrix','(",I9,",:)',':",8(X,L13))','(20X,8(X,L13))', & & ERR,ERROR,*999) CASE DEFAULT - LOCAL_ERROR="The matrix data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT CASE(MATRIX_DIAGONAL_STORAGE_TYPE) @@ -1330,7 +1790,7 @@ SUBROUTINE MATRIX_OUTPUT(ID,MATRIX,ERR,ERROR,*) CALL WRITE_STRING_VECTOR(ID,MATRIX%ROW_INDICES(i),1,MATRIX%ROW_INDICES(i+1)-1,8,8,MATRIX%DATA_L,INITIAL_STRING, & & '(20X,8(X,L13))',ERR,ERROR,*999) CASE DEFAULT - LOCAL_ERROR="The matrix data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDDO !i @@ -1355,14 +1815,14 @@ SUBROUTINE MATRIX_OUTPUT(ID,MATRIX,ERR,ERROR,*) CALL WRITE_STRING_VECTOR(ID,MATRIX%COLUMN_INDICES(j),1,MATRIX%COLUMN_INDICES(j+1)-1,8,8,MATRIX%DATA_L, & & INITIAL_STRING,'(20X,8(X,L13))',ERR,ERROR,*999) CASE DEFAULT - LOCAL_ERROR="The matrix data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDDO !j CASE(MATRIX_ROW_COLUMN_STORAGE_TYPE) CALL FlagError("Not implemented.",ERR,ERROR,*999) CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE @@ -1405,12 +1865,12 @@ SUBROUTINE MATRIX_SIZE_SET(MATRIX,M,N,ERR,ERROR,*) MATRIX%M=M MATRIX%N=N ELSE - LOCAL_ERROR="The number of matrix columns of "//TRIM(NUMBER_TO_VSTRING(N,"*",ERR,ERROR))// & + LOCAL_ERROR="The number of matrix columns of "//TRIM(NumberToVString(N,"*",ERR,ERROR))// & & " is invalid. The number must be >0." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The number of matrix rows of "//TRIM(NUMBER_TO_VSTRING(M,"*",ERR,ERROR))// & + LOCAL_ERROR="The number of matrix rows of "//TRIM(NumberToVString(M,"*",ERR,ERROR))// & & " is invalid. The number must be >0." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -1450,13 +1910,13 @@ SUBROUTINE MATRIX_STORAGE_LOCATION_FIND(MATRIX,I,J,LOCATION,ERR,ERROR,*) IF(ASSOCIATED(MATRIX)) THEN IF(MATRIX%MATRIX_FINISHED) THEN IF(I<1.OR.I>MATRIX%M) THEN - LOCAL_ERROR="Row number "//TRIM(NUMBER_TO_VSTRING(I,"*",ERR,ERROR))//" is outside the matrix range of 1 to "// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%M,"*",ERR,ERROR))//"." + LOCAL_ERROR="Row number "//TRIM(NumberToVString(I,"*",ERR,ERROR))//" is outside the matrix range of 1 to "// & + & TRIM(NumberToVString(MATRIX%M,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF IF(J<1.OR.J>MATRIX%N) THEN - LOCAL_ERROR="Column number "//TRIM(NUMBER_TO_VSTRING(J,"*",ERR,ERROR))//" is outside the matrix range of 1 to "// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%M,"*",ERR,ERROR))//"." + LOCAL_ERROR="Column number "//TRIM(NumberToVString(J,"*",ERR,ERROR))//" is outside the matrix range of 1 to "// & + & TRIM(NumberToVString(MATRIX%M,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -1476,7 +1936,7 @@ SUBROUTINE MATRIX_STORAGE_LOCATION_FIND(MATRIX,I,J,LOCATION,ERR,ERROR,*) UPLIMIT=MATRIX%ROW_INDICES(I+1) IF(UPLIMIT>LOWLIMIT) THEN IF(J<=MATRIX%COLUMN_INDICES(UPLIMIT-1)) THEN - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%COLUMN_INDICES(MIDPOINT)>J) THEN UPLIMIT=MIDPOINT @@ -1509,7 +1969,7 @@ SUBROUTINE MATRIX_STORAGE_LOCATION_FIND(MATRIX,I,J,LOCATION,ERR,ERROR,*) ENDIF ENDDO IF(MATRIX%ROW_INDICES(LOWLIMIT)==I) LOCATION=LOWLIMIT - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%ROW_INDICES(MIDPOINT)>I) THEN UPLIMIT=MIDPOINT @@ -1546,7 +2006,7 @@ SUBROUTINE MATRIX_STORAGE_LOCATION_FIND(MATRIX,I,J,LOCATION,ERR,ERROR,*) ENDDO IF(.NOT.(FOUNDROW.AND.FOUNDCOLUMN)) LOCATION=0 CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE @@ -1601,7 +2061,7 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_GET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER ROW_INDICES=>MATRIX%ROW_INDICES COLUMN_INDICES=>MATRIX%COLUMN_INDICES CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE @@ -1656,10 +2116,10 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_SET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER IF(ROW_INDICES(MATRIX%M+1)==MATRIX%NUMBER_NON_ZEROS+1) THEN DO i=2,MATRIX%M+1 IF(ROW_INDICES(i)0) THEN IF(k>MATRIX%N) THEN - LOCAL_ERROR="Invalid column indices. Column index "//TRIM(NUMBER_TO_VSTRING(j,"*",ERR,ERROR))//" ("// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//") is greater than the number of columns ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%N,"*",ERR,ERROR))//")." + LOCAL_ERROR="Invalid column indices. Column index "//TRIM(NumberToVString(j,"*",ERR,ERROR))//" ("// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//") is greater than the number of columns ("// & + & TRIM(NumberToVString(MATRIX%N,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="Invalid column indices. Column index "//TRIM(NUMBER_TO_VSTRING(j,"*",ERR,ERROR))//" ("// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//") is less than zero." + LOCAL_ERROR="Invalid column indices. Column index "//TRIM(NumberToVString(j,"*",ERR,ERROR))//" ("// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//") is less than zero." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ENDDO !j @@ -1694,27 +2154,27 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_SET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER !ENDDO !i ELSE LOCAL_ERROR="Invalid row indices. The last row index ("// & - & TRIM(NUMBER_TO_VSTRING(ROW_INDICES(MATRIX%M+1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(ROW_INDICES(MATRIX%M+1),"*",ERR,ERROR))// & & ") does not equal the number of non-zeros + 1 ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%NUMBER_NON_ZEROS+1,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%NUMBER_NON_ZEROS+1,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="Invalid row indices. The first row index ("// & - & TRIM(NUMBER_TO_VSTRING(ROW_INDICES(1),"*",ERR,ERROR))//") does not equal 1." + & TRIM(NumberToVString(ROW_INDICES(1),"*",ERR,ERROR))//") does not equal 1." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The supplied number of column indices ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not match the number of non-zeros in the matrix ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The supplied number of row indices ("//TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + LOCAL_ERROR="The supplied number of row indices ("//TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not match the number of rows in the matrix + 1 ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%M+1,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%M+1,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF CASE(MATRIX_COMPRESSED_COLUMN_STORAGE_TYPE) @@ -1724,23 +2184,23 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_SET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER IF(COLUMN_INDICES(MATRIX%N+1)==MATRIX%NUMBER_NON_ZEROS+1) THEN IF(COLUMN_INDICES(1)/=1) THEN LOCAL_ERROR="Invalid column indices. Column index 1 ("// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(1),"*",ERR,ERROR))//") "// & + & TRIM(NumberToVString(COLUMN_INDICES(1),"*",ERR,ERROR))//") "// & & " should be equal to one." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END IF DO j=2,MATRIX%N+1 IF(COLUMN_INDICES(j)MATRIX%NUMBER_NON_ZEROS+1) THEN - LOCAL_ERROR="Invalid column indices. Column index "//TRIM(NUMBER_TO_VSTRING(j,"*",ERR,ERROR))//" ("// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//") "// & + LOCAL_ERROR="Invalid column indices. Column index "//TRIM(NumberToVString(j,"*",ERR,ERROR))//" ("// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//") "// & & " should be in the range of one to the number of non-zeros + 1 ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%NUMBER_NON_ZEROS+1,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%NUMBER_NON_ZEROS+1,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END IF ENDDO !i @@ -1749,14 +2209,14 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_SET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER k=ROW_INDICES(i) IF(k>0) THEN IF(k>MATRIX%M) THEN - LOCAL_ERROR="Invalid row indices. Row index "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" ("// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//") is greater than the number of rows ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%M,"*",ERR,ERROR))//")." + LOCAL_ERROR="Invalid row indices. Row index "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" ("// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//") is greater than the number of rows ("// & + & TRIM(NumberToVString(MATRIX%M,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="Invalid row indices. Row index "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" ("// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//") is less than zero." + LOCAL_ERROR="Invalid row indices. Row index "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" ("// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//") is less than zero." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ENDDO !i @@ -1775,28 +2235,28 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_SET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER !ENDDO !j ELSE LOCAL_ERROR="Invalid column indices. The last column index ("// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(MATRIX%N+1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(COLUMN_INDICES(MATRIX%N+1),"*",ERR,ERROR))// & & ") does not equal the number of non-zeros + 1 ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%NUMBER_NON_ZEROS+1,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%NUMBER_NON_ZEROS+1,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="Invalid column indices. The first column index ("// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(1),"*",ERR,ERROR))//") does not equal 1." + & TRIM(NumberToVString(COLUMN_INDICES(1),"*",ERR,ERROR))//") does not equal 1." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The supplied number of row indices ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not match the number of non-zeros in the matrix ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The supplied number of column indices ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not match the number of columns in the matrix + 1 ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%N+1,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%N+1,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF CASE(MATRIX_ROW_COLUMN_STORAGE_TYPE) @@ -1804,16 +2264,16 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_SET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER IF(SIZE(COLUMN_INDICES,1)==MATRIX%NUMBER_NON_ZEROS) THEN DO k=1,MATRIX%NUMBER_NON_ZEROS IF(ROW_INDICES(k)<1.OR.ROW_INDICES(k)>MATRIX%M) THEN - LOCAL_ERROR="Invalid row indices. Row index number "//TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" ("// & - & TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))// & + LOCAL_ERROR="Invalid row indices. Row index number "//TRIM(NumberToVString(k,"*",ERR,ERROR))//" ("// & + & TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))// & & ") is out of range. The row index must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%M,"*",ERR,ERROR))//"." + & TRIM(NumberToVString(MATRIX%M,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE IF(COLUMN_INDICES(k)<1.OR.COLUMN_INDICES(k)>MATRIX%N) THEN - LOCAL_ERROR="Invalid column indices. Column index number "//TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" ("// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))// & + LOCAL_ERROR="Invalid column indices. Column index number "//TRIM(NumberToVString(k,"*",ERR,ERROR))//" ("// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))// & & ") is out of range. The column index must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%N,"*",ERR,ERROR))//"." + & TRIM(NumberToVString(MATRIX%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ENDDO !k @@ -1822,20 +2282,20 @@ SUBROUTINE MATRIX_STORAGE_LOCATIONS_SET(MATRIX,ROW_INDICES,COLUMN_INDICES,ERR,ER !!TODO: sort the row and colum indices!!!!! ELSE LOCAL_ERROR="The supplied number of column indices ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not match the number of non-zeros in the matrix ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The supplied number of row indices ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not match the number of non-zeros in the matrix ("// & - & TRIM(NUMBER_TO_VSTRING(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." + & TRIM(NumberToVString(MATRIX%NUMBER_NON_ZEROS,"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDIF @@ -1918,7 +2378,7 @@ SUBROUTINE MATRIX_STORAGE_TYPE_SET(MATRIX,STORAGE_TYPE,ERR,ERROR,*) CASE(MATRIX_ROW_COLUMN_STORAGE_TYPE) MATRIX%STORAGE_TYPE=MATRIX_ROW_COLUMN_STORAGE_TYPE CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(STORAGE_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDIF @@ -1960,28 +2420,28 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,E DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -2022,14 +2482,14 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_INTG_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -2080,8 +2540,8 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(i,j) @@ -2096,8 +2556,8 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, COLUMN_INDEX=COLUMN_INDICES(j) IF(ROW_INDEX==COLUMN_INDEX) LOCATION=ROW_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(i,j) @@ -2111,8 +2571,8 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%MAX_M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(i,j) @@ -2126,8 +2586,8 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, COLUMN_INDEX=COLUMN_INDICES(j) LOCATION=(ROW_INDEX-1)*MATRIX%MAX_N+COLUMN_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(i,j) @@ -2150,7 +2610,7 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, UPLIMIT=MATRIX%ROW_INDICES(ROW_INDEX+1) ENDIF PREVIOUS_COLUMN_INDEX=COLUMN_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%COLUMN_INDICES(MIDPOINT)>COLUMN_INDEX) THEN UPLIMIT=MIDPOINT @@ -2166,8 +2626,8 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(i,j) @@ -2190,7 +2650,7 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, UPLIMIT=MATRIX%COLUMN_INDICES(COLUMN_INDEX+1) ENDIF PREVIOUS_ROW_INDEX=ROW_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%ROW_INDICES(MIDPOINT)>ROW_INDEX) THEN UPLIMIT=MIDPOINT @@ -2206,8 +2666,8 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(i,j) @@ -2238,8 +2698,8 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ENDDO IF(.NOT.(FOUNDROW.AND.FOUNDCOLUMN)) LOCATION=0 IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=MATRIX%DATA_INTG(LOCATION)+VALUES(i,j) @@ -2247,27 +2707,27 @@ SUBROUTINE MATRIX_VALUES_ADD_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ENDDO !j ENDDO !i CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & & " is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -2311,28 +2771,28 @@ SUBROUTINE MATRIX_VALUES_ADD_SP(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -2373,14 +2833,14 @@ SUBROUTINE MATRIX_VALUES_ADD_SP1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,* IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_SP_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -2431,8 +2891,8 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(i,j) @@ -2447,8 +2907,8 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER COLUMN_INDEX=COLUMN_INDICES(j) IF(ROW_INDEX==COLUMN_INDEX) LOCATION=ROW_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(i,j) @@ -2462,8 +2922,8 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%MAX_M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(i,j) @@ -2477,8 +2937,8 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER COLUMN_INDEX=COLUMN_INDICES(j) LOCATION=(ROW_INDEX-1)*MATRIX%MAX_N+COLUMN_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(i,j) @@ -2501,7 +2961,7 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER UPLIMIT=MATRIX%ROW_INDICES(ROW_INDEX+1) ENDIF PREVIOUS_COLUMN_INDEX=COLUMN_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%COLUMN_INDICES(MIDPOINT)>COLUMN_INDEX) THEN UPLIMIT=MIDPOINT @@ -2517,8 +2977,8 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(i,j) @@ -2541,7 +3001,7 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER UPLIMIT=MATRIX%COLUMN_INDICES(COLUMN_INDEX+1) ENDIF PREVIOUS_ROW_INDEX=ROW_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%ROW_INDICES(MIDPOINT)>ROW_INDEX) THEN UPLIMIT=MIDPOINT @@ -2557,8 +3017,8 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(i,j) @@ -2589,8 +3049,8 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO IF(.NOT.(FOUNDROW.AND.FOUNDCOLUMN)) LOCATION=0 IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=MATRIX%DATA_SP(LOCATION)+VALUES(i,j) @@ -2598,27 +3058,27 @@ SUBROUTINE MATRIX_VALUES_ADD_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO !j ENDDO !i CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & & " is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -2662,28 +3122,28 @@ SUBROUTINE MATRIX_VALUES_ADD_DP(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -2724,14 +3184,14 @@ SUBROUTINE MATRIX_VALUES_ADD_DP1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,* IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_DP_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -2782,8 +3242,8 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(i,j) @@ -2798,8 +3258,8 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER COLUMN_INDEX=COLUMN_INDICES(j) IF(ROW_INDEX==COLUMN_INDEX) LOCATION=ROW_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(i,j) @@ -2813,8 +3273,8 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%MAX_M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(i,j) @@ -2828,8 +3288,8 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER COLUMN_INDEX=COLUMN_INDICES(j) LOCATION=(ROW_INDEX-1)*MATRIX%MAX_N+COLUMN_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(i,j) @@ -2852,7 +3312,7 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER UPLIMIT=MATRIX%ROW_INDICES(ROW_INDEX+1) ENDIF PREVIOUS_COLUMN_INDEX=COLUMN_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%COLUMN_INDICES(MIDPOINT)>COLUMN_INDEX) THEN UPLIMIT=MIDPOINT @@ -2868,8 +3328,8 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(i,j) @@ -2892,7 +3352,7 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER UPLIMIT=MATRIX%COLUMN_INDICES(COLUMN_INDEX+1) ENDIF PREVIOUS_ROW_INDEX=ROW_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%ROW_INDICES(MIDPOINT)>ROW_INDEX) THEN UPLIMIT=MIDPOINT @@ -2908,8 +3368,8 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(i,j) @@ -2940,8 +3400,8 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO IF(.NOT.(FOUNDROW.AND.FOUNDCOLUMN)) LOCATION=0 IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=MATRIX%DATA_DP(LOCATION)+VALUES(i,j) @@ -2949,27 +3409,27 @@ SUBROUTINE MATRIX_VALUES_ADD_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO !j ENDDO !i CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & & " is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3013,28 +3473,28 @@ SUBROUTINE MATRIX_VALUES_ADD_L(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERRO DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3075,14 +3535,14 @@ SUBROUTINE MATRIX_VALUES_ADD_L1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,*) IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_L_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -3133,8 +3593,8 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(i,j) @@ -3149,8 +3609,8 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR COLUMN_INDEX=COLUMN_INDICES(j) IF(ROW_INDEX==COLUMN_INDEX) LOCATION=ROW_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(i,j) @@ -3164,8 +3624,8 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ROW_INDEX=ROW_INDICES(i) LOCATION=ROW_INDEX+(COLUMN_INDEX-1)*MATRIX%MAX_M IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(i,j) @@ -3179,8 +3639,8 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR COLUMN_INDEX=COLUMN_INDICES(j) LOCATION=(ROW_INDEX-1)*MATRIX%MAX_N+COLUMN_INDEX IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(i,j) @@ -3203,7 +3663,7 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR UPLIMIT=MATRIX%ROW_INDICES(ROW_INDEX+1) ENDIF PREVIOUS_COLUMN_INDEX=COLUMN_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%COLUMN_INDICES(MIDPOINT)>COLUMN_INDEX) THEN UPLIMIT=MIDPOINT @@ -3219,8 +3679,8 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(i,j) @@ -3243,7 +3703,7 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR UPLIMIT=MATRIX%COLUMN_INDICES(COLUMN_INDEX+1) ENDIF PREVIOUS_ROW_INDEX=ROW_INDEX - DO WHILE((UPLIMIT-LOWLIMIT)>bisectionToLinearSearchThreshold) + DO WHILE((UPLIMIT-LOWLIMIT)>MATRIX_BISECTION_TO_LINEAR_SEARCH_THRESHOLD) MIDPOINT=(UPLIMIT+LOWLIMIT)/2 IF(MATRIX%ROW_INDICES(MIDPOINT)>ROW_INDEX) THEN UPLIMIT=MIDPOINT @@ -3259,8 +3719,8 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDIF ENDDO !k IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(i,j) @@ -3291,8 +3751,8 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDDO IF(.NOT.(FOUNDROW.AND.FOUNDCOLUMN)) LOCATION=0 IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=MATRIX%DATA_L(LOCATION).OR.VALUES(i,j) @@ -3300,27 +3760,27 @@ SUBROUTINE MATRIX_VALUES_ADD_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDDO !j ENDDO !i CASE DEFAULT - LOCAL_ERROR="The matrix storage type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The matrix storage type of "//TRIM(NumberToVString(MATRIX%STORAGE_TYPE,"*",ERR,ERROR))// & & " is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3370,20 +3830,20 @@ SUBROUTINE MATRIX_VALUES_GET_INTG(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,E ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3429,7 +3889,7 @@ SUBROUTINE MATRIX_VALUES_GET_INTG1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR VALUE=MATRIX%DATA_INTG(LOCATION) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -3482,22 +3942,22 @@ SUBROUTINE MATRIX_VALUES_GET_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3547,20 +4007,20 @@ SUBROUTINE MATRIX_VALUES_GET_SP(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3606,7 +4066,7 @@ SUBROUTINE MATRIX_VALUES_GET_SP1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,* VALUE=MATRIX%DATA_SP(LOCATION) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -3659,22 +4119,22 @@ SUBROUTINE MATRIX_VALUES_GET_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3724,20 +4184,20 @@ SUBROUTINE MATRIX_VALUES_GET_DP(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3783,7 +4243,7 @@ SUBROUTINE MATRIX_VALUES_GET_DP1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,* VALUE=MATRIX%DATA_DP(LOCATION) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -3836,22 +4296,22 @@ SUBROUTINE MATRIX_VALUES_GET_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3901,20 +4361,20 @@ SUBROUTINE MATRIX_VALUES_GET_L(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERRO ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -3960,7 +4420,7 @@ SUBROUTINE MATRIX_VALUES_GET_L1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,*) VALUE=MATRIX%DATA_L(LOCATION) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4013,22 +4473,22 @@ SUBROUTINE MATRIX_VALUES_GET_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4072,28 +4532,28 @@ SUBROUTINE MATRIX_VALUES_SET_INTG(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,E DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4134,14 +4594,14 @@ SUBROUTINE MATRIX_VALUES_SET_INTG1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_INTG_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4187,8 +4647,8 @@ SUBROUTINE MATRIX_VALUES_SET_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, DO j=1,SIZE(COLUMN_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(i),COLUMN_INDICES(j),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_INTG(LOCATION)=VALUES(i,j) @@ -4196,22 +4656,22 @@ SUBROUTINE MATRIX_VALUES_SET_INTG2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR, ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4255,28 +4715,28 @@ SUBROUTINE MATRIX_VALUES_SET_SP(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4317,14 +4777,14 @@ SUBROUTINE MATRIX_VALUES_SET_SP1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,* IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_SP_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4370,8 +4830,8 @@ SUBROUTINE MATRIX_VALUES_SET_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER DO j=1,SIZE(COLUMN_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(i),COLUMN_INDICES(j),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_SP(LOCATION)=VALUES(i,j) @@ -4379,22 +4839,22 @@ SUBROUTINE MATRIX_VALUES_SET_SP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4438,28 +4898,28 @@ SUBROUTINE MATRIX_VALUES_SET_DP(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4500,14 +4960,14 @@ SUBROUTINE MATRIX_VALUES_SET_DP1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,* IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_DP_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4553,8 +5013,8 @@ SUBROUTINE MATRIX_VALUES_SET_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER DO j=1,SIZE(COLUMN_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(i),COLUMN_INDICES(j),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_DP(LOCATION)=VALUES(i,j) @@ -4562,22 +5022,22 @@ SUBROUTINE MATRIX_VALUES_SET_DP2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ER ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4621,28 +5081,28 @@ SUBROUTINE MATRIX_VALUES_SET_L(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERRO DO k=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(k),COLUMN_INDICES(k),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(k),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(k),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=VALUES(k) ENDIF ENDDO !k ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4683,14 +5143,14 @@ SUBROUTINE MATRIX_VALUES_SET_L1(MATRIX,ROW_INDEX,COLUMN_INDEX,VALUE,ERR,ERROR,*) IF(MATRIX%DATA_TYPE==MATRIX_VECTOR_L_TYPE) THEN CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDEX,COLUMN_INDEX,LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDEX,"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDEX,"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDEX,"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4736,8 +5196,8 @@ SUBROUTINE MATRIX_VALUES_SET_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR DO j=1,SIZE(ROW_INDICES,1) CALL MATRIX_STORAGE_LOCATION_FIND(MATRIX,ROW_INDICES(i),COLUMN_INDICES(j),LOCATION,ERR,ERROR,*999) IF(LOCATION==0) THEN - LOCAL_ERROR="Row "//TRIM(NUMBER_TO_VSTRING(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & - & TRIM(NUMBER_TO_VSTRING(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." + LOCAL_ERROR="Row "//TRIM(NumberToVString(ROW_INDICES(i),"*",ERR,ERROR))//" and column "// & + & TRIM(NumberToVString(COLUMN_INDICES(j),"*",ERR,ERROR))//" does not exist in the matrix." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE MATRIX%DATA_L(LOCATION)=VALUES(i,j) @@ -4745,22 +5205,22 @@ SUBROUTINE MATRIX_VALUES_SET_L2(MATRIX,ROW_INDICES,COLUMN_INDICES,VALUES,ERR,ERR ENDDO !j ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(MATRIX%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the column indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(COLUMN_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of columns in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,2),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,2),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE LOCAL_ERROR="The size of the row indices array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & + & TRIM(NumberToVString(SIZE(ROW_INDICES,1),"*",ERR,ERROR))// & & ") does not conform to the number of rows in the values array ("// & - & TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + & TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -4798,7 +5258,7 @@ SUBROUTINE VECTOR_ALL_VALUES_SET_INTG(VECTOR,VALUE,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_INTG_TYPE) THEN VECTOR%DATA_INTG=VALUE ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4837,7 +5297,7 @@ SUBROUTINE VECTOR_ALL_VALUES_SET_SP(VECTOR,VALUE,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_SP_TYPE) THEN VECTOR%DATA_SP=VALUE ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4876,7 +5336,7 @@ SUBROUTINE VECTOR_ALL_VALUES_SET_DP(VECTOR,VALUE,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_DP_TYPE) THEN VECTOR%DATA_DP=VALUE ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4915,7 +5375,7 @@ SUBROUTINE VECTOR_ALL_VALUES_SET_L(VECTOR,VALUE,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_L_TYPE) THEN VECTOR%DATA_L=VALUE ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -4967,7 +5427,7 @@ SUBROUTINE VECTOR_CREATE_FINISH(VECTOR,ERR,ERROR,*) ALLOCATE(VECTOR%DATA_L(VECTOR%SIZE),STAT=ERR) IF(ERR/=0) CALL FlagError("Could not allocate vector logical data.",ERR,ERROR,*999) CASE DEFAULT - LOCAL_ERROR="The vector data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The vector data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDIF @@ -5043,7 +5503,7 @@ SUBROUTINE VECTOR_DATA_GET_INTG(VECTOR,DATA,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_INTG_TYPE) THEN DATA=>VECTOR%DATA_INTG ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5087,7 +5547,7 @@ SUBROUTINE VECTOR_DATA_GET_SP(VECTOR,DATA,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_SP_TYPE) THEN DATA=>VECTOR%DATA_SP ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5131,7 +5591,7 @@ SUBROUTINE VECTOR_DATA_GET_DP(VECTOR,DATA,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_DP_TYPE) THEN DATA=>VECTOR%DATA_DP ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5175,7 +5635,7 @@ SUBROUTINE VECTOR_DATA_GET_L(VECTOR,DATA,ERR,ERROR,*) IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_L_TYPE) THEN DATA=>VECTOR%DATA_L ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the requested values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5255,7 +5715,7 @@ SUBROUTINE VECTOR_DATA_TYPE_SET(VECTOR,DATA_TYPE,ERR,ERROR,*) CASE(MATRIX_VECTOR_L_TYPE) VECTOR%DATA_TYPE=MATRIX_VECTOR_L_TYPE CASE DEFAULT - LOCAL_ERROR="The vector data type of "//TRIM(NUMBER_TO_VSTRING(DATA_TYPE,"*",ERR,ERROR))//" is invalid." + LOCAL_ERROR="The vector data type of "//TRIM(NumberToVString(DATA_TYPE,"*",ERR,ERROR))//" is invalid." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) END SELECT ENDIF @@ -5417,7 +5877,7 @@ SUBROUTINE VECTOR_SIZE_SET(VECTOR,N,ERR,ERROR,*) IF(N>0) THEN VECTOR%N=N ELSE - LOCAL_ERROR="The size of the vector ("//TRIM(NUMBER_TO_VSTRING(N,"*",ERR,ERROR))// & + LOCAL_ERROR="The size of the vector ("//TRIM(NumberToVString(N,"*",ERR,ERROR))// & & ") is invalid. The number must be >0." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5458,22 +5918,22 @@ SUBROUTINE VECTOR_VALUES_GET_INTG(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUES(i)=VECTOR%DATA_INTG(k) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -5511,14 +5971,14 @@ SUBROUTINE VECTOR_VALUES_GET_INTG1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_INTG_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUE=VECTOR%DATA_INTG(INDEX) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5561,22 +6021,22 @@ SUBROUTINE VECTOR_VALUES_GET_SP(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUES(i)=VECTOR%DATA_SP(k) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -5614,14 +6074,14 @@ SUBROUTINE VECTOR_VALUES_GET_SP1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_SP_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUE=VECTOR%DATA_SP(INDEX) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5664,22 +6124,22 @@ SUBROUTINE VECTOR_VALUES_GET_DP(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUES(i)=VECTOR%DATA_DP(k) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -5717,14 +6177,14 @@ SUBROUTINE VECTOR_VALUES_GET_DP1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_DP_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUE=VECTOR%DATA_DP(INDEX) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5767,22 +6227,22 @@ SUBROUTINE VECTOR_VALUES_GET_L(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUES(i)=VECTOR%DATA_L(k) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")" + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")" CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -5820,14 +6280,14 @@ SUBROUTINE VECTOR_VALUES_GET_L1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_L_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VALUE=VECTOR%DATA_L(INDEX) ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5870,22 +6330,22 @@ SUBROUTINE VECTOR_VALUES_SET_INTG(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_INTG(k)=VALUES(i) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -5923,14 +6383,14 @@ SUBROUTINE VECTOR_VALUES_SET_INTG1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_INTG_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_INTG(INDEX)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the integer data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -5973,22 +6433,22 @@ SUBROUTINE VECTOR_VALUES_SET_SP(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_SP(k)=VALUES(i) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -6026,14 +6486,14 @@ SUBROUTINE VECTOR_VALUES_SET_SP1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_SP_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_SP(INDEX)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the single precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -6076,22 +6536,22 @@ SUBROUTINE VECTOR_VALUES_SET_DP(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_DP(k)=VALUES(i) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -6129,14 +6589,14 @@ SUBROUTINE VECTOR_VALUES_SET_DP1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_DP_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_DP(INDEX)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the double precision data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF @@ -6179,22 +6639,22 @@ SUBROUTINE VECTOR_VALUES_SET_L(VECTOR,INDICES,VALUES,ERR,ERROR,*) DO i=1,SIZE(INDICES,1) k=INDICES(i) IF(k<1.OR.k>VECTOR%N) THEN - LOCAL_ERROR="Index number "//TRIM(NUMBER_TO_VSTRING(i,"*",ERR,ERROR))//" is invalid. The index is "// & - & TRIM(NUMBER_TO_VSTRING(k,"*",ERR,ERROR))//" and it must be between 1 and "// & - & TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="Index number "//TRIM(NumberToVString(i,"*",ERR,ERROR))//" is invalid. The index is "// & + & TRIM(NumberToVString(k,"*",ERR,ERROR))//" and it must be between 1 and "// & + & TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_L(k)=VALUES(i) ENDIF ENDDO !i ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given values." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE - LOCAL_ERROR="The size of the indices array ("//TRIM(NUMBER_TO_VSTRING(SIZE(INDICES,1),"*",ERR,ERROR))// & - & ") does not conform to the size of the values array ("//TRIM(NUMBER_TO_VSTRING(SIZE(VALUES,1),"*",ERR,ERROR))//")." + LOCAL_ERROR="The size of the indices array ("//TRIM(NumberToVString(SIZE(INDICES,1),"*",ERR,ERROR))// & + & ") does not conform to the size of the values array ("//TRIM(NumberToVString(SIZE(VALUES,1),"*",ERR,ERROR))//")." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF ELSE @@ -6232,14 +6692,14 @@ SUBROUTINE VECTOR_VALUES_SET_L1(VECTOR,INDEX,VALUE,ERR,ERROR,*) IF(VECTOR%VECTOR_FINISHED) THEN IF(VECTOR%DATA_TYPE==MATRIX_VECTOR_L_TYPE) THEN IF(INDEX<1.OR.INDEX>VECTOR%N) THEN - LOCAL_ERROR="The index value of "//TRIM(NUMBER_TO_VSTRING(INDEX,"*",ERR,ERROR))// & - & " is invalid. The index must be between 1 and "//TRIM(NUMBER_TO_VSTRING(VECTOR%N,"*",ERR,ERROR))//"." + LOCAL_ERROR="The index value of "//TRIM(NumberToVString(INDEX,"*",ERR,ERROR))// & + & " is invalid. The index must be between 1 and "//TRIM(NumberToVString(VECTOR%N,"*",ERR,ERROR))//"." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ELSE VECTOR%DATA_L(INDEX)=VALUE ENDIF ELSE - LOCAL_ERROR="The data type of "//TRIM(NUMBER_TO_VSTRING(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & + LOCAL_ERROR="The data type of "//TRIM(NumberToVString(VECTOR%DATA_TYPE,"*",ERR,ERROR))// & & " does not correspond to the logical data type of the given value." CALL FlagError(LOCAL_ERROR,ERR,ERROR,*999) ENDIF diff --git a/src/problem_routines.f90 b/src/problem_routines.f90 index c21cbda2..6b7f536d 100644 --- a/src/problem_routines.f90 +++ b/src/problem_routines.f90 @@ -2455,7 +2455,7 @@ SUBROUTINE Problem_SolverEquationsDynamicLinearSolve(SOLVER_EQUATIONS,ERR,ERROR, !Back-substitute to find flux values for linear problems DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%PTR - CALL EQUATIONS_SET_BACKSUBSTITUTE(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) + CALL EquationsSet_Backsubstitute(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) ENDDO !equations_set_idx ELSE CALL FlagError("Solver equations solver mapping is not associated.",ERR,ERROR,*999) @@ -2566,6 +2566,11 @@ SUBROUTINE Problem_SolverEquationsDynamicNonlinearSolve(SOLVER_EQUATIONS,ERR,ERR CALL SOLVER_DYNAMIC_TIMES_SET(SOLVER,CURRENT_TIME,TIME_INCREMENT,ERR,ERROR,*999) !Solve for the next time i.e., current time + time increment CALL SOLVER_SOLVE(SOLVER,ERR,ERROR,*999) + !Backsubstitute to find unknown RHS values + DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS + EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%PTR + CALL EquationsSet_Backsubstitute(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) + ENDDO !equations_set_idx ELSE CALL FlagError("Solver equations solver mapping is not associated.",ERR,ERROR,*999) ENDIF @@ -2638,7 +2643,7 @@ SUBROUTINE Problem_SolverEquationsQuasistaticLinearSolve(SOLVER_EQUATIONS,ERR,ER !Back-substitute to find flux values for linear problems DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%PTR - CALL EQUATIONS_SET_BACKSUBSTITUTE(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) + CALL EquationsSet_Backsubstitute(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) ENDDO !equations_set_idx ELSE CALL FlagError("Solver equations solver mapping is not associated.",ERR,ERROR,*999) @@ -2708,7 +2713,12 @@ SUBROUTINE Problem_SolverEquationsQuasistaticNonlinearSolve(SOLVER_EQUATIONS,ERR !CALL SOLVER_DYNAMIC_TIMES_SET(SOLVER,CURRENT_TIME,TIME_INCREMENT,ERR,ERROR,*999) !Solve for the next time i.e., current time + time increment CALL SOLVER_SOLVE(SOLVER,ERR,ERROR,*999) - ELSE + !Backsubstitute to find unknown RHS values + DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS + EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%PTR + CALL EquationsSet_Backsubstitute(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) + ENDDO !equations_set_idx + ELSE CALL FlagError("Solver equations solver mapping is not associated.",ERR,ERROR,*999) ENDIF ELSE @@ -2801,7 +2811,7 @@ SUBROUTINE Problem_SolverEquationsStaticLinearSolve(SOLVER_EQUATIONS,ERR,ERROR,* !Back-substitute to find flux values for linear problems DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%PTR - CALL EQUATIONS_SET_BACKSUBSTITUTE(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) + CALL EquationsSet_Backsubstitute(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) ENDDO !equations_set_idx #ifdef TAUPROF CALL TAU_STATIC_PHASE_STOP('EQUATIONS_SET_BACKSUBSTITUTE()') @@ -2875,23 +2885,10 @@ SUBROUTINE Problem_SolverEquationsStaticNonlinearSolve(SOLVER_EQUATIONS,ERR,ERRO ENDDO !interface_condition_idx !Solve CALL SOLVER_SOLVE(SOLVER,ERR,ERROR,*999) - !Update the rhs field variable with residuals or backsubstitute for any linear - !equations sets + !Backsubstitute to find unknown RHS values DO equations_set_idx=1,SOLVER_MAPPING%NUMBER_OF_EQUATIONS_SETS EQUATIONS_SET=>SOLVER_MAPPING%EQUATIONS_SETS(equations_set_idx)%PTR - EQUATIONS=>EQUATIONS_SET%EQUATIONS - IF(ASSOCIATED(EQUATIONS)) THEN - SELECT CASE(EQUATIONS%LINEARITY) - CASE(EQUATIONS_LINEAR,EQUATIONS_NONLINEAR_BCS) - CALL EQUATIONS_SET_BACKSUBSTITUTE(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) - CASE(EQUATIONS_NONLINEAR) - CALL EQUATIONS_SET_NONLINEAR_RHS_UPDATE(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) - CASE DEFAULT - CALL FlagError("Invalid linearity for equations set equations",ERR,ERROR,*999) - END SELECT - ELSE - CALL FlagError("Equations set equations is not associated.",ERR,ERROR,*999) - ENDIF + CALL EquationsSet_Backsubstitute(EQUATIONS_SET,SOLVER_EQUATIONS%BOUNDARY_CONDITIONS,ERR,ERROR,*999) ENDDO !equations_set_idx ELSE CALL FlagError("Solver equations solver mapping not associated.",ERR,ERROR,*999)