added optional fortran argument to GetSelectedOutputValue for the string length

git-svn-id: svn://136.177.114.72/svn_GW/IPhreeqc/trunk@10767 1feff8c3-07ed-0310-ac33-dd36852eb9cd
This commit is contained in:
Scott R Charlton 2016-01-30 00:21:32 +00:00
parent 6ecc3a10d2
commit d9b02af0e0
2 changed files with 15 additions and 7 deletions

View File

@ -655,15 +655,16 @@ INTEGER FUNCTION GetSelectedOutputRowCount(id)
return
END FUNCTION GetSelectedOutputRowCount
INTEGER FUNCTION GetSelectedOutputValue(id, row, col, vtype, dvalue, svalue)
INTEGER FUNCTION GetSelectedOutputValue(id, row, col, vtype, dvalue, svalue, c_length)
USE ISO_C_BINDING
IMPLICIT NONE
INTERFACE
INTEGER(KIND=C_INT) FUNCTION GetSelectedOutputValueF(id, row, col, vtype, dvalue, svalue, l) &
INTEGER(KIND=C_INT) FUNCTION GetSelectedOutputValueF(id, row, col, vtype, dvalue, svalue, sz) &
BIND(C, NAME='GetSelectedOutputValueF')
USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(KIND=C_INT), INTENT(in) :: id, row, col, l
INTEGER(KIND=C_INT), INTENT(in) :: id, row, col
INTEGER(KIND=C_INT), INTENT(inout) :: sz
INTEGER(KIND=C_INT), INTENT(out) :: vtype
REAL(KIND=C_DOUBLE), INTENT(out) :: dvalue
CHARACTER(KIND=C_CHAR), INTENT(out) :: svalue(*)
@ -673,9 +674,14 @@ INTEGER FUNCTION GetSelectedOutputValue(id, row, col, vtype, dvalue, svalue)
INTEGER, INTENT(out) :: vtype
DOUBLE PRECISION, INTENT(out) :: dvalue
CHARACTER(len=*), INTENT(out) :: svalue
INTEGER :: l
l = len(svalue)
GetSelectedOutputValue = GetSelectedOutputValueF(id, row, col, vtype, dvalue, svalue, l)
INTEGER, INTENT(out), OPTIONAL :: c_length
INTEGER :: sz, sz_fortran
sz = len(svalue)
sz_fortran = sz
GetSelectedOutputValue = GetSelectedOutputValueF(id, row, col, vtype, dvalue, svalue, sz)
if (sz > sz_fortran .and. present(c_length)) then
c_length = sz
endif
return
END FUNCTION GetSelectedOutputValue

View File

@ -28,13 +28,15 @@ f2cstring(char* fstring, size_t len)
void
padfstring(char *dest, const char *src, int* len)
{
int sofar;
int sofar, c_len;
c_len = (int)strlen(src);
for (sofar = 0; (sofar < *len) && (*src != '\0'); ++sofar)
*dest++ = *src++;
while (sofar++ < *len)
*dest++ = ' ';
*len = c_len;
}
IPQ_RESULT