[Getdata-commits] SF.net SVN: getdata:[609] trunk/getdata
Scientific Database Format
Brought to you by:
ketiltrout
Menu
▾
▴
[Getdata-commits] SF.net SVN: getdata:[609] trunk/getdata
|
From: <ket...@us...> - 2011-10-20 22:53:10
|
Revision: 609
http://getdata.svn.sourceforge.net/getdata/?rev=609&view=rev
Author: ketiltrout
Date: 2011-10-20 22:53:01 +0000 (Thu, 20 Oct 2011)
Log Message:
-----------
Fix interoperability between seek/tell/HERE and FRAMEOFFSET. Add the missing
gd_[m]constants/gd_[m]strings Fortran bindings. All bindings tests for these
plus seek/tell.
Modified Paths:
--------------
trunk/getdata/ChangeLog
trunk/getdata/bindings/cxx/test/big_test.cpp
trunk/getdata/bindings/f77/fgetdata.c
trunk/getdata/bindings/f77/fgetdata.h
trunk/getdata/bindings/f77/getdata.f.in
trunk/getdata/bindings/f77/getdata.f90.in
trunk/getdata/bindings/f77/test/big_test.f
trunk/getdata/bindings/f77/test/big_test95.f90
trunk/getdata/bindings/idl/getdata.c
trunk/getdata/bindings/idl/test/big_test.pro
trunk/getdata/bindings/make_parameters.c
trunk/getdata/bindings/perl/Makefile.am
trunk/getdata/bindings/perl/t/big_test.t
trunk/getdata/bindings/perl/typemap
trunk/getdata/bindings/python/pydirfile.c
trunk/getdata/bindings/python/test/big_test.py
trunk/getdata/doc/README.f77
trunk/getdata/doc/README.f95
trunk/getdata/doc/list.tests
trunk/getdata/man/gd_mstrings.3
trunk/getdata/man/gd_strings.3
trunk/getdata/src/fpos.c
trunk/getdata/src/getdata.c
trunk/getdata/test/Makefile.am
Added Paths:
-----------
trunk/getdata/test/get_here_foffs.c
trunk/getdata/test/seek_foffs.c
Property Changed:
----------------
trunk/getdata/test/
Modified: trunk/getdata/ChangeLog
===================================================================
--- trunk/getdata/ChangeLog 2011-10-19 10:15:31 UTC (rev 608)
+++ trunk/getdata/ChangeLog 2011-10-20 22:53:01 UTC (rev 609)
@@ -1,3 +1,31 @@
+2011-10-20 D. V. Wiebe <ge...@ke...> svn:609
+ * test/get_here_foffs.c test/seek_foffs.c: Added.
+
+ * src/getdata.c (_GD_DoRaw): Update file->pos after calling FillZero.
+ * src/fpos.c (_GD_GetFilePos): Adjust for SPF.
+ * src/fpos.c (_GD_Seek): If seeking before FRAMEOFFSET, set file->pos < 0.
+
+ * bindings/python/pydirfile.c (gdpy_dirfile_seek): Fix type of frame_num,
+ sample_num.
+
+ * bindings/perl/typemap: off64_t is signed.
+
+ * bindings/f77/fgetdata.c (GDCONS GDMCOS GDSTRS GDMSTS GDSTRX GDMSTX):
+ Added.
+ * bindings/f77/getdata.f90.in (fgd_constants_i1 fgd_constants_i2
+ fgd_constants_i4 fgd_constants_i8 fgd_constants_r4 fgd_constants_r8
+ fgd_constants_c8 fgd_constants_c16 fgd_mconstants_i1 fgd_mconstants_i2
+ fgd_mconstants_i4 fgd_mconstants_i8 fgd_mconstants_r4 fgd_mconstants_r8
+ fgd_mconstants_c8 fgd_mconstants_c16 fgd_string_value_max fgd_strings
+ fgd_mstring_value_max fgd_mstrings): Added.
+
+ * bindings/idl/getdata.c (gdidl_getdata gdidl_putdata): Add /HERE.
+
+ * bindings/python/test/big_test.py bindings/cxx/test/big_test.cpp
+ bindings/perl/t/big_test.t bindings/f77/test/big_test.f
+ bindings/f77/test/big_test95.f90 bindings/idl/test/big_test.pro: Added tests
+ 183-204.
+
2011-10-18 D. V. Wiebe <ge...@ke...> svn:607
* man/gd_seek.3 man/gd_tell.3: Added.
Modified: trunk/getdata/bindings/cxx/test/big_test.cpp
===================================================================
--- trunk/getdata/bindings/cxx/test/big_test.cpp 2011-10-19 10:15:31 UTC (rev 608)
+++ trunk/getdata/bindings/cxx/test/big_test.cpp 2011-10-20 22:53:01 UTC (rev 609)
@@ -80,13 +80,14 @@
ne++; cerr << "d(" << i << ")[" << t << ", " << m << "] = " << (v) << endl; }
#define CHECK_STRING(t,v,g) \
- if (strcmp((v), (g))) { ne++; cerr << "s[" << t << "] = " << (v) << endl; }
+ if (strcmp((v), (g))) { ne++; cerr << "s[" << t << "] = \"" << (v) << "\"" \
+ << endl; }
#define CHECK_STRING2(t,m,v,g) \
if (strcmp((v), (g))) { \
- ne++; cerr << "s[" << t << ", " << m << "] = " << (v) << endl; }
+ ne++; cerr << "s[" << t << ", " << m << "] = \"" << (v) << "\"" << endl; }
#define CHECK_STRING_ARRAY(t,m,v,g) \
for (i = 0; i < m; ++i) if (strcmp((v), (g))) { \
- ne++; cerr << "s(" << i << ")[" << t << "] = " << (v) << endl; }
+ ne++; cerr << "s(" << i << ")[" << t << "] = \"" << (v) << "\"" << endl; }
#define CHECK_COMPLEX2(t,m,v,g) \
if (abs((v) - (g)) > 1e-10) { \
@@ -127,9 +128,10 @@
unsigned char c[8];
unsigned char data_data[80];
signed char sc;
- int n, i, e, ne = 0;
+ int m, n, i, e, ne = 0;
float fl;
double dp, p[6], q[6];
+ const double *qp;
complex<double> cq[6];
const char **list;
const char* str;
@@ -156,6 +158,7 @@
(char*)"linterp", (char*)"mult", (char*)"phase", (char*)"polynom",
(char*)"recip", (char*)"sbit", (char*)"string", NULL, NULL, NULL, NULL,
NULL, NULL, NULL};
+ char *strings[3];
// Write the test dirfile
mkdir(filedir, 0777);
@@ -1311,8 +1314,55 @@
CHECK_INT2(181,4,ent->ArrayLen(),12);
delete ent;
+ // 183: gd_constants
+ p[0] = 61.;
+ p[1] = 0.;
+ n = d->NFieldsByType(ConstEntryType);
+ qp = reinterpret_cast<const double *>(d->Constants());
+ CHECK_OK(183);
+ CHECK_DOUBLE_ARRAY(183,0,n,qp[i],p[i]);
+ // 184: gd_mconstants
+ p[0] = 3.3;
+ p[1] = 0.;
+ n = d->NMFieldsByType("data", ConstEntryType);
+ qp = reinterpret_cast<const double *>(d->MConstants("data"));
+ CHECK_OK(184);
+ CHECK_DOUBLE_ARRAY(184,0,n,qp[i],p[i]);
+ // 199: gd_strings
+ strings[0] = (char *)"Lorem ipsum";
+ strings[1] = (char *)"";
+ strings[2] = (char *)"Arthur Dent";
+ n = d->NFieldsByType(StringEntryType);
+ list = d->Strings();
+ CHECK_OK(199);
+ CHECK_STRING_ARRAY(199,n,list[i],strings[i]);
+
+ // 200: gd_strings
+ strings[0] = (char *)"This is a string constant.";
+ n = d->NMFieldsByType("data", StringEntryType);
+ list = d->MStrings("data");
+ CHECK_OK(200);
+ CHECK_STRING_ARRAY(200,n,list[i],strings[i]);
+
+ // 203: gd_seek
+ n = d->Seek("data", 35, 0, GD_SEEK_SET);
+ CHECK_OK2(203,0);
+ m = d->GetData("data", GD_HERE, 0, 1, 0, UInt8, c);
+ CHECK_OK2(203,1);
+ CHECK_INT2(203,0,n,280);
+ CHECK_INT2(203,1,m,8);
+ CHECK_INT_ARRAY(203,8,c[i],17 + i);
+
+ // 204: gd_tell
+ n = d->Tell("data");
+ CHECK_OK(204);
+ CHECK_INT(204,n,288);
+
+
+
+
// ===================================================================
d->Discard();
delete d;
Modified: trunk/getdata/bindings/f77/fgetdata.c
===================================================================
--- trunk/getdata/bindings/f77/fgetdata.c 2011-10-19 10:15:31 UTC (rev 608)
+++ trunk/getdata/bindings/f77/fgetdata.c 2011-10-20 22:53:01 UTC (rev 609)
@@ -219,12 +219,18 @@
const int* num_frames, const int* num_samples, const int* return_type,
void* data_out)
{
+ dtrace("%p, %i, %p, %i, %i, %i, %i, %i, 0x%x, %p", n_read, *dirfile,
+ field_code, *field_code_l, *first_frame, *first_sample, *num_frames,
+ *num_samples, *return_type, data_out);
+
char* out = (char *)malloc(*field_code_l + 1);
*n_read = gd_getdata(_GDF_GetDirfile(*dirfile), _GDF_CString(out, field_code,
*field_code_l), *first_frame, *first_sample, *num_frames,
*num_samples, (gd_type_t)*return_type, data_out);
free(out);
+
+ dreturn("%i", *n_read);
}
/* Return the maximum field name length */
@@ -1312,7 +1318,11 @@
void F77_FUNC(gdnfdt, GDNFDT) (int* nfields, const int* dirfile,
const int* type)
{
+ dtrace("%p, %i, 0x%x", nfields, *dirfile, *type);
+
*nfields = gd_nfields_by_type(_GDF_GetDirfile(*dirfile), (gd_entype_t)*type);
+
+ dreturn("%i", *nfields);
}
/* gd_nvectors wrapper */
@@ -1331,7 +1341,7 @@
if (D->error)
return;
- if (*field_num <= (int)nfields) {
+ if (*field_num > 0 && *field_num <= (int)nfields) {
fl = gd_field_list_by_type(D, (gd_entype_t)*type);
_GDF_FString(name, name_l, fl[*field_num - 1]);
} else
@@ -1354,7 +1364,7 @@
if (D->error)
return;
- if (*field_num <= (int)nfields) {
+ if (*field_num > 0 && *field_num <= (int)nfields) {
fl = gd_vector_list(D);
_GDF_FString(name, name_l, fl[*field_num - 1]);
} else
@@ -1381,7 +1391,7 @@
return;
}
- if (*field_num <= (int)nfields) {
+ if (*field_num > 0 && *field_num <= (int)nfields) {
fl = gd_mfield_list_by_type(D, pa, (gd_entype_t)*type);
_GDF_FString(name, name_l, fl[*field_num - 1]);
} else
@@ -1407,7 +1417,7 @@
return;
}
- if (*field_num <= (int)nfields) {
+ if (*field_num > 0 && *field_num <= (int)nfields) {
fl = gd_mvector_list(D, pa);
_GDF_FString(name, name_l, fl[*field_num - 1]);
} else
@@ -2080,10 +2090,14 @@
void F77_FUNC(gdnmft, GDNMFT) (int* nfields, const int* dirfile,
const char* parent, const int* parent_l, const int* type)
{
+ dtrace("%p, %i, %p, %i, 0x%x", nfields, *dirfile, parent, *parent_l, *type);
+
char* pa = (char *)malloc(*parent_l + 1);
*nfields = gd_nmfields_by_type(_GDF_GetDirfile(*dirfile), _GDF_CString(pa,
parent, *parent_l), (gd_entype_t)*type);
free(pa);
+
+ dreturn("%i", *nfields);
}
/* gd_nmvectors wrapper */
@@ -2956,3 +2970,148 @@
free(fc);
dreturn("%i", *pos);
}
+
+/* gd_constants wrapper -- this only returns one value */
+void F77_FUNC(gdcons, GDCONS) (void *value, const int *dirfile,
+ const int *return_type, const int *field_num)
+{
+ const void *v;
+
+ dtrace("%p, %i, 0x%x, %i", value, *dirfile, *return_type, *field_num);
+
+ DIRFILE *D = _GDF_GetDirfile(*dirfile);
+ unsigned int nfields = gd_nfields_by_type(D, GD_CONST_ENTRY);
+
+ if (!D->error && (*field_num > 0) && (*field_num <= (int)nfields)) {
+ v = gd_constants(D, (gd_type_t)*return_type);
+ if (!D->error)
+ memcpy(value, (char*)v + (*field_num - 1) * GD_SIZE(*return_type),
+ GD_SIZE(*return_type));
+ }
+ dreturnvoid();
+}
+
+/* gd_mconstants wrapper -- this only returns one value */
+void F77_FUNC(gdmcos, GDMCOS) (void *value, const int *dirfile,
+ const char *parent, const int *parent_l, const int *return_type,
+ const int *field_num)
+{
+ const void *v;
+
+ dtrace("%p, %i, %p, %i, 0x%x, %i", value, *dirfile, parent, *parent_l,
+ *return_type, *field_num);
+
+ DIRFILE *D = _GDF_GetDirfile(*dirfile);
+
+ char *pa = (char *)malloc(*parent_l + 1);
+ _GDF_CString(pa, parent, *parent_l);
+
+ unsigned int nfields = gd_nmfields_by_type(D, pa, GD_CONST_ENTRY);
+
+ if (!D->error && (*field_num > 0) && (*field_num <= (int)nfields)) {
+ v = gd_mconstants(D, pa, (gd_type_t)*return_type);
+ if (!D->error)
+ memcpy(value, (char*)v + (*field_num - 1) * GD_SIZE(*return_type),
+ GD_SIZE(*return_type));
+ }
+
+ free(pa);
+ dreturnvoid();
+}
+
+/* gd_strings wrapper -- this only returns one value */
+void F77_FUNC(gdstrs, GDSTRS) (char *value, int *value_l, const int *dirfile,
+ const int *field_num)
+{
+ const char **v;
+
+ dtrace("%p, %i, %i, %i", value, *value_l, *dirfile, *field_num);
+
+ DIRFILE *D = _GDF_GetDirfile(*dirfile);
+ unsigned int nfields = gd_nfields_by_type(D, GD_STRING_ENTRY);
+
+ if (!D->error && (*field_num > 0) && (*field_num <= (int)nfields)) {
+ v = gd_strings(D);
+ _GDF_FString(value, value_l, D->error ? "" : v[*field_num - 1]);
+ } else
+ *value_l = 0;
+
+ dreturn("%i", *value_l);
+}
+
+/* gd_mstrings wrapper -- this only returns one value */
+void F77_FUNC(gdmsts, GDMSTS) (void *value, int *value_l, const int *dirfile,
+ const char *parent, const int *parent_l, const int *field_num)
+{
+ const char **v;
+
+ dtrace("%p, %i, %i, %p, %i, %i", value, *value_l, *dirfile, parent,
+ *parent_l, *field_num);
+
+ DIRFILE *D = _GDF_GetDirfile(*dirfile);
+
+ char *pa = (char *)malloc(*parent_l + 1);
+ _GDF_CString(pa, parent, *parent_l);
+
+ unsigned int nfields = gd_nmfields_by_type(D, pa, GD_STRING_ENTRY);
+
+ if (!D->error && (*field_num > 0) && (*field_num <= (int)nfields)) {
+ v = gd_mstrings(D, pa);
+ _GDF_FString(value, value_l, D->error ? "" : v[*field_num - 1]);
+ } else
+ *value_l = 0;
+
+ free(pa);
+ dreturnvoid();
+}
+
+/* Return the maximum string value length */
+void F77_FUNC(gdstrx, GDSTRX) (int *max, const int *dirfile)
+{
+ dtrace("%p, %i", max, *dirfile);
+
+ const char **v;
+ size_t len = 0;
+ DIRFILE *D = _GDF_GetDirfile(*dirfile);
+ unsigned int i, nfields = gd_nfields_by_type(D, GD_STRING_ENTRY);
+
+ if (!D->error) {
+ v = gd_strings(D);
+
+ for (i = 0; i < nfields; ++i)
+ if (strlen(v[i]) > len)
+ len = strlen(v[i]);
+ }
+
+ *max = (int)len;
+
+ dreturn("%i", *max);
+}
+
+/* Return the maximum meta string value length */
+void F77_FUNC(gdmstx, GDMSTX) (int *max, const int *dirfile, const char *parent,
+ const int *parent_l)
+{
+ dtrace("%p, %i, %p, %i", max, *dirfile, parent, *parent_l);
+
+ const char **v;
+ size_t len = 0;
+ DIRFILE *D = _GDF_GetDirfile(*dirfile);
+
+ char *pa = (char *)malloc(*parent_l + 1);
+ _GDF_CString(pa, parent, *parent_l);
+
+ unsigned int i, nfields = gd_nmfields_by_type(D, pa, GD_STRING_ENTRY);
+
+ if (!D->error) {
+ v = gd_mstrings(D, pa);
+
+ for (i = 0; i < nfields; ++i)
+ if (strlen(v[i]) > len)
+ len = strlen(v[i]);
+ }
+
+ *max = (int)len;
+
+ dreturn("%i", *max);
+}
Modified: trunk/getdata/bindings/f77/fgetdata.h
===================================================================
--- trunk/getdata/bindings/f77/fgetdata.h 2011-10-19 10:15:31 UTC (rev 608)
+++ trunk/getdata/bindings/f77/fgetdata.h 2011-10-20 22:53:01 UTC (rev 609)
@@ -564,6 +564,24 @@
void F77_FUNC(gdtell, GDTELL) (int* pos, const int* dirfile,
const char* field_code, const int* field_code_l);
+
+void F77_FUNC(gdcons, GDCONS) (void *value, const int *dirfile,
+ const int *return_type, const int *field_num);
+
+void F77_FUNC(gdmcos, GDMCOS) (void *value, const int *dirfile,
+ const char *parent, const int *parent_l, const int *return_type,
+ const int *field_num);
+
+void F77_FUNC(gdstrs, GDSTRS) (char *value, int *value_l, const int *dirfile,
+ const int *field_num);
+
+void F77_FUNC(gdmsts, GDMSTS) (void *value, int *value_l, const int *dirfile,
+ const char *parent, const int *parent_l, const int *field_num);
+
+void F77_FUNC(gdstrx, GDSTRX) (int *max, const int *dirfile);
+
+void F77_FUNC(gdmstx, GDMSTX) (int *max, const int *dirfile, const char *parent,
+ const int *parent_l);
#ifdef __cplusplus
}
#endif
Modified: trunk/getdata/bindings/f77/getdata.f.in
===================================================================
--- trunk/getdata/bindings/f77/getdata.f.in 2011-10-19 10:15:31 UTC (rev 608)
+++ trunk/getdata/bindings/f77/getdata.f.in 2011-10-20 22:53:01 UTC (rev 609)
@@ -107,6 +107,8 @@
EXTERNAL GDCLBK
C Corresponding to gd_close(3)
EXTERNAL GDCLOS
+C Corresponding to gd_constants(3) (sort of)
+ EXTERNAL GDCONS
C Corresponding to gd_copen(3)
EXTERNAL GDCOPN
C Check whether an entry contains complex scalars
@@ -197,6 +199,8 @@
EXTERNAL GDINCL
C Corresponding to gd_invalid_dirfile(3)
EXTERNAL GDINVD
+C Corresponding to gd_mconstants(3) (sort of)
+ EXTERNAL GDMCOS
C Corresponding to gd_madd_bit(3)
EXTERNAL GDMDBT
C Corresponding to gd_madd_carray(3)
@@ -241,6 +245,11 @@
EXTERNAL GDMLSP
C Correpsonding to gd_move(3)
EXTERNAL GDMOVE
+C Corresponding to gd_mstrings(3) (sort of)
+ EXTERNAL GDMSTS
+C Returns the maximum length of the longest string metafield for a
+C field
+ EXTERNAL GDMSTX
C Corresponding to gd_mvector_list(3) (sort of)
EXTERNAL GDMVEN
C Corresponding to gd_dirfilename(3)
@@ -285,8 +294,16 @@
EXTERNAL GDRFRG
C Corresponding to gd_raw_filename(3)
EXTERNAL GDRWFN
+C Corresponding to gd_seek(3)
+ EXTERNAL GDSEEK
C Corresponding to gd_dirfile_standards(3)
EXTERNAL GDSTDV
+C Corresponding to gd_strings(3) (sort of)
+ EXTERNAL GDSTRS
+C Returns the length of the longest string field
+ EXTERNAL GDSTRX
+C Corresponding to gd_tell(3)
+ EXTERNAL GDTELL
C Corresponding to gd_uninclude(3)
EXTERNAL GDUINC
C Corresponding to gd_vector_list(3) (sort of)
Modified: trunk/getdata/bindings/f77/getdata.f90.in
===================================================================
--- trunk/getdata/bindings/f77/getdata.f90.in 2011-10-19 10:15:31 UTC (rev 608)
+++ trunk/getdata/bindings/f77/getdata.f90.in 2011-10-20 22:53:01 UTC (rev 609)
@@ -2143,4 +2143,287 @@
call gdtell(fgd_tell, dirfile, TRIM(field_name), LEN_TRIM(field_name))
end function
+! gd_constants with return_type=GD_INT8
+subroutine fgd_constants_i1 (constants, dirfile)
+ integer*1, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_INT8, i)
+ end do
+end subroutine
+
+! gd_constants with return_type=GD_INT16
+subroutine fgd_constants_i2 (constants, dirfile)
+ integer*2, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_INT16, i)
+ end do
+end subroutine
+
+! gd_constants with return_type=GD_INT32
+subroutine fgd_constants_i4 (constants, dirfile)
+ integer*4, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_INT32, i)
+ end do
+end subroutine
+
+! gd_constants with return_type=GD_INT64
+subroutine fgd_constants_i8 (constants, dirfile)
+ integer*8, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_INT64, i)
+ end do
+end subroutine
+
+! gd_constants with return_type=GD_FLOAT32
+subroutine fgd_constants_r4 (constants, dirfile)
+ real*4, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_FLOAT32, i)
+ end do
+end subroutine
+
+! gd_constants with return_type=GD_FLOAT64
+subroutine fgd_constants_r8 (constants, dirfile)
+ real*8, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_FLOAT64, i)
+ end do
+end subroutine
+
+! gd_constants with return_type=GD_COMPLEX64
+subroutine fgd_constants_c8 (constants, dirfile)
+ complex, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_COMPLEX64, i)
+ end do
+end subroutine
+
+! gd_constants with return_type=GD_COMPLEX128
+subroutine fgd_constants_c16 (constants, dirfile)
+ double complex, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+
+ nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdcons(constants(i), dirfile, GD_COMPLEX128, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_INT8
+subroutine fgd_mconstants_i1 (constants, dirfile, parent)
+ integer*1, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_INT8, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_INT16
+subroutine fgd_mconstants_i2 (constants, dirfile, parent)
+ integer*2, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_INT16, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_INT32
+subroutine fgd_mconstants_i4 (constants, dirfile, parent)
+ integer*4, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_INT32, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_INT64
+subroutine fgd_mconstants_i8 (constants, dirfile, parent)
+ integer*8, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_INT64, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_FLOAT32
+subroutine fgd_mconstants_r4 (constants, dirfile, parent)
+ real*4, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_FLOAT32, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_FLOAT64
+subroutine fgd_mconstants_r8 (constants, dirfile, parent)
+ real*8, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_FLOAT64, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_COMPLEX64
+subroutine fgd_mconstants_c8 (constants, dirfile, parent)
+ complex, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_COMPLEX64, i)
+ end do
+end subroutine
+
+! gd_mconstants with return_type=GD_COMPLEX128
+subroutine fgd_mconstants_c16 (constants, dirfile, parent)
+ double complex, dimension(:), intent(out) :: constants
+ integer, intent(in) :: dirfile
+ integer :: nfields, i
+ character (len=*), intent(in) :: parent
+
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
+ GD_COMPLEX128, i)
+ end do
+end subroutine
+
+function fgd_string_value_max (dirfile)
+ integer :: fgd_string_value_max
+ integer, intent(in) :: dirfile
+
+ ! call f77 library
+ call gdstrx(fgd_string_value_max, dirfile)
+end function
+
+subroutine fgd_strings (strings, dirfile, string_len)
+ character(len=*), dimension(:), intent(out) :: strings
+ integer, intent(in) :: dirfile
+ integer, intent(inout) :: string_len
+ integer :: max_len, nfields, i
+
+ ! make sure the string list is large enough
+ max_len = fgd_string_value_max(dirfile)
+
+ if (string_len .lt. max_len) then
+ string_len = max_len
+ else
+ nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdstrs(strings(i), string_len, dirfile, i)
+ end do
+ end if
+end subroutine
+
+function fgd_mstring_value_max (dirfile, parent)
+ integer :: fgd_mstring_value_max
+ integer, intent(in) :: dirfile
+ character (len=*), intent(in) :: parent
+
+ ! call f77 library
+ call gdmstx(fgd_mstring_value_max, dirfile, TRIM(parent), LEN_TRIM(parent))
+end function
+
+subroutine fgd_mstrings (strings, dirfile, parent, string_len)
+ character(len=*), dimension(:), intent(out) :: strings
+ integer, intent(in) :: dirfile
+ integer, intent(inout) :: string_len
+ integer :: max_len, nfields, i
+ character (len=*), intent(in) :: parent
+
+ ! make sure the field list is large enough
+ max_len = fgd_mstring_value_max(dirfile, parent)
+
+ if (string_len .lt. max_len) then
+ string_len = max_len
+ else
+ nfields = fgd_nmfields_by_type(dirfile, parent, GD_STRING_ENTRY)
+ do i=1,nfields
+ ! call f77 library
+ call gdmsts(strings(i), string_len, dirfile, TRIM(parent), &
+ LEN_TRIM(parent), i)
+ end do
+ end if
+end subroutine
+
end module
Modified: trunk/getdata/bindings/f77/test/big_test.f
===================================================================
--- trunk/getdata/bindings/f77/test/big_test.f 2011-10-19 10:15:31 UTC (rev 608)
+++ trunk/getdata/bindings/f77/test/big_test.f 2011-10-20 22:53:01 UTC (rev 609)
@@ -40,10 +40,13 @@
PARAMETER (flen = 7)
INTEGER nfields
PARAMETER (nfields = 14)
+ INTEGER slen
+ PARAMETER (slen = 26)
+ CHARACTER*26 strings(3)
CHARACTER*7 fields(nfields + 7)
CHARACTER*7 fn
- CHARACTER*20 str
+ CHARACTER*26 str
INTEGER*1 c(8)
INTEGER*1 datdat(80)
INTEGER*1 k
@@ -121,7 +124,7 @@
ne = 0
IF (e .NE. GD_EOP) THEN
ne = ne + 1
- WRITE(*, 2001) 0, e
+ WRITE(*, 9001) 0, e
ENDIF
C 1: GDOPEN check
@@ -130,7 +133,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 1, e
+ WRITE(*, 9001) 1, e
ENDIF
C 2: GDGETD check
@@ -139,18 +142,18 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 2, e
+ WRITE(*, 9001) 2, e
ENDIF
IF (n .NE. 8) THEN
ne = ne + 1
- WRITE(*, 2002) 2, n
+ WRITE(*, 9002) 2, n
ENDIF
DO 20 i = 1, 8
IF (c(i) .NE. 40 + i) THEN
ne = ne + 1
- WRITE(*, 2004) i, 2, c(i)
+ WRITE(*, 9004) i, 2, c(i)
ENDIF
20 CONTINUE
@@ -160,12 +163,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 3, e
+ WRITE(*, 9001) 3, e
ENDIF
IF (abs(fl - 5.5) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2005) 3, fl
+ WRITE(*, 9005) 3, fl
ENDIF
C 4: GDFDNX check
@@ -174,12 +177,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 4, e
+ WRITE(*, 9001) 4, e
ENDIF
IF (i .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2002) 4, i
+ WRITE(*, 9002) 4, i
ENDIF
C 5: GDMFNX check
@@ -188,12 +191,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 5, e
+ WRITE(*, 9001) 5, e
ENDIF
IF (i .NE. 6) THEN
ne = ne + 1
- WRITE(*, 2002) 5, i
+ WRITE(*, 9002) 5, i
ENDIF
C 6: GDNFLD check
@@ -202,12 +205,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 6, e
+ WRITE(*, 9001) 6, e
ENDIF
IF (n .NE. nfields) THEN
ne = ne + 1
- WRITE(*, 2002) 6, n
+ WRITE(*, 9002) 6, n
ENDIF
C 7: This is a check of (one of many instances of) _GDF_FString
@@ -217,12 +220,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 7, e
+ WRITE(*, 9001) 7, e
ENDIF
IF (l .NE. 5) THEN
ne = ne + 1
- WRITE(*, 2002) 7, l
+ WRITE(*, 9002) 7, l
ENDIF
C 8: GDFLDN check
@@ -233,17 +236,17 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 8, i, e
+ WRITE(*, 9006) 8, i, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 8, i, l
+ WRITE(*, 9007) 8, i, l
ENDIF
IF (fn .NE. fields(i)) THEN
ne = ne + 1
- WRITE(*, 2008) i, 8, fn
+ WRITE(*, 9008) i, 8, fn
ENDIF
80 CONTINUE
@@ -253,12 +256,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 9, e
+ WRITE(*, 9001) 9, e
ENDIF
IF (n .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2002) 9, n
+ WRITE(*, 9002) 9, n
ENDIF
C 10: GDMFDN check
@@ -272,17 +275,17 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 10, i, e
+ WRITE(*, 9006) 10, i, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 10, i, l
+ WRITE(*, 9007) 10, i, l
ENDIF
IF (fn .NE. fields(i)) THEN
ne = ne + 1
- WRITE(*, 2008) i, 10, fn
+ WRITE(*, 9008) i, 10, fn
ENDIF
100 CONTINUE
@@ -292,12 +295,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 11, e
+ WRITE(*, 9001) 11, e
ENDIF
IF (n .NE. 10) THEN
ne = ne + 1
- WRITE(*, 2002) 11, n
+ WRITE(*, 9002) 11, n
ENDIF
C 12: GDGSPF check
@@ -306,12 +309,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 12, e
+ WRITE(*, 9001) 12, e
ENDIF
IF (n .NE. 8) THEN
ne = ne + 1
- WRITE(*, 2002) 12, n
+ WRITE(*, 9002) 12, n
ENDIF
C 13: GDPUTD check
@@ -328,12 +331,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 13, e
+ WRITE(*, 9001) 13, e
ENDIF
IF (n .NE. 4) THEN
ne = ne + 1
- WRITE(*, 2002) 13, n
+ WRITE(*, 9002) 13, n
ENDIF
CALL GDGETD(n, d, 'data', 4, 5, 0, 1, 0, GD_I8, c)
@@ -342,17 +345,17 @@
IF (((i .EQ. 1 .OR. i .GT. 5) .AND. c(i) .NE. 40 + i) .OR.
+(i .GT. 1 .AND. i .LT. 6) .AND. c(i) .NE. 11 + i) THEN
ne = ne + 1
- WRITE(*, 2004) i, 13, c(i)
+ WRITE(*, 9004) i, 13, c(i)
ENDIF
130 CONTINUE
C 14: GDESTR check
CALL GDGETD(n, d, 'x', 1, 5, 0, 1, 0, GD_I8, c)
- CALL GDESTR(d, str, 20)
+ CALL GDESTR(d, str, slen)
IF (str .NE. 'Field not found: x ') THEN
ne = ne + 1
- WRITE(*, 2009) 14, str
+ WRITE(*, 9009) 14, str
ENDIF
C 15: GDENTY check
@@ -361,12 +364,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 15, e
+ WRITE(*, 9001) 15, e
ENDIF
IF (n .NE. GD_RWE) THEN
ne = ne + 1
- WRITE(*, 2002) 15, n
+ WRITE(*, 9002) 15, n
ENDIF
C 16: GDGERW check
@@ -375,22 +378,22 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 16, e
+ WRITE(*, 9001) 16, e
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 16, 1, n
+ WRITE(*, 9007) 16, 1, n
ENDIF
IF (l .NE. 8) THEN
ne = ne + 1
- WRITE(*, 2007) 16, 2, l
+ WRITE(*, 9007) 16, 2, l
ENDIF
IF (i .NE. GD_I8) THEN
ne = ne + 1
- WRITE(*, 2007) 16, 3, i
+ WRITE(*, 9007) 16, 3, i
ENDIF
C 17: GDGELC check
@@ -401,37 +404,37 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 17, e
+ WRITE(*, 9001) 17, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 17, 1, l
+ WRITE(*, 9007) 17, 1, l
ENDIF
IF (i .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 17, 2, i
+ WRITE(*, 9007) 17, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 17, 3, n
+ WRITE(*, 9007) 17, 3, n
ENDIF
IF (fields(1) .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 17, 4, fields(1)
+ WRITE(*, 9008) 17, 4, fields(1)
ENDIF
IF (fields(2) .NE. 'INDEX') THEN
ne = ne + 1
- WRITE(*, 2008) 17, 5, fields(2)
+ WRITE(*, 9008) 17, 5, fields(2)
ENDIF
IF (fields(3) .NE. 'linterp') THEN
ne = ne + 1
- WRITE(*, 2008) 17, 6, fields(3)
+ WRITE(*, 9008) 17, 6, fields(3)
ENDIF
q(1) = 1.1
@@ -443,7 +446,7 @@
DO 170 i=1,6
IF (abs(p(i) - q(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2010) i, 17, p(i)
+ WRITE(*, 9010) i, 17, p(i)
ENDIF
170 CONTINUE
@@ -455,37 +458,37 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 18, e
+ WRITE(*, 9001) 18, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 18, 1, l
+ WRITE(*, 9007) 18, 1, l
ENDIF
IF (i .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 18, 2, i
+ WRITE(*, 9007) 18, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 18, 3, n
+ WRITE(*, 9007) 18, 3, n
ENDIF
IF (fields(1) .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 18, 4, fields(1)
+ WRITE(*, 9008) 18, 4, fields(1)
ENDIF
IF (fields(2) .NE. 'INDEX') THEN
ne = ne + 1
- WRITE(*, 2008) 18, 5, fields(2)
+ WRITE(*, 9008) 18, 5, fields(2)
ENDIF
IF (fields(3) .NE. 'linterp') THEN
ne = ne + 1
- WRITE(*, 2008) 18, 6, fields(3)
+ WRITE(*, 9008) 18, 6, fields(3)
ENDIF
cq(1) = cmplx(1.1, 0.0)
@@ -497,7 +500,7 @@
DO 180 i=1,6
IF (abs(cp(i) - cq(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2011) i, 18, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
+ WRITE(*, 9011) i, 18, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
ENDIF
180 CONTINUE
@@ -509,27 +512,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 19, e
+ WRITE(*, 9001) 19, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 19, 1, l
+ WRITE(*, 9007) 19, 1, l
ENDIF
IF (i .NE. 5) THEN
ne = ne + 1
- WRITE(*, 2007) 19, 2, i
+ WRITE(*, 9007) 19, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 19, 3, n
+ WRITE(*, 9007) 19, 3, n
ENDIF
IF (fn .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 19, 4, fn
+ WRITE(*, 9008) 19, 4, fn
ENDIF
q(1) = 1.1
@@ -541,7 +544,7 @@
DO 190 i=1,6
IF (abs(p(i) - q(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2010) i, 19, p(i)
+ WRITE(*, 9010) i, 19, p(i)
ENDIF
190 CONTINUE
@@ -553,27 +556,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 20, e
+ WRITE(*, 9001) 20, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 20, 1, l
+ WRITE(*, 9007) 20, 1, l
ENDIF
IF (i .NE. 5) THEN
ne = ne + 1
- WRITE(*, 2007) 20, 2, i
+ WRITE(*, 9007) 20, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 20, 3, n
+ WRITE(*, 9007) 20, 3, n
ENDIF
IF (fn .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 20, 4, fn
+ WRITE(*, 9008) 20, 4, fn
ENDIF
cq(1) = cmplx(1.1, 0.0)
@@ -585,38 +588,38 @@
DO 200 i=1,6
IF (abs(cp(i) - cq(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2011) i, 30, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
+ WRITE(*, 9011) i, 30, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
ENDIF
200 CONTINUE
C 21: GDGELT check
l = flen
- CALL GDGELT(fn, l, str, 20, n, d, 'linterp', 7)
+ CALL GDGELT(fn, l, str, slen, n, d, 'linterp', 7)
CALL GDEROR(e, d)
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 21, e
+ WRITE(*, 9001) 21, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 21, 1, l
+ WRITE(*, 9007) 21, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 21, 2, n
+ WRITE(*, 9007) 21, 2, n
ENDIF
IF (fn .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 21, 3, fn
+ WRITE(*, 9008) 21, 3, fn
ENDIF
IF (str .NE. '/look/up/file') THEN
ne = ne + 1
- WRITE(*, 2008) 21, 4, str
+ WRITE(*, 9008) 21, 4, str
ENDIF
C 22: GDGEBT check
@@ -626,32 +629,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 22, e
+ WRITE(*, 9001) 22, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 22, 1, l
+ WRITE(*, 9007) 22, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 22, 2, n
+ WRITE(*, 9007) 22, 2, n
ENDIF
IF (i .NE. 4) THEN
ne = ne + 1
- WRITE(*, 2007) 22, 3, i
+ WRITE(*, 9007) 22, 3, i
ENDIF
IF (m .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 22, 4, m
+ WRITE(*, 9007) 22, 4, m
ENDIF
IF (fn .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 22, 5, fn
+ WRITE(*, 9008) 22, 5, fn
ENDIF
C 23: GDGESB check
@@ -661,32 +664,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 23, e
+ WRITE(*, 9001) 23, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 23, 1, l
+ WRITE(*, 9007) 23, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 23, 2, n
+ WRITE(*, 9007) 23, 2, n
ENDIF
IF (i .NE. 6) THEN
ne = ne + 1
- WRITE(*, 2007) 23, 3, i
+ WRITE(*, 9007) 23, 3, i
ENDIF
IF (m .NE. 5) THEN
ne = ne + 1
- WRITE(*, 2007) 23, 4, m
+ WRITE(*, 9007) 23, 4, m
ENDIF
IF (fn .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 23, 5, fn
+ WRITE(*, 9008) 23, 5, fn
ENDIF
C 24: GDGEMT check
@@ -696,27 +699,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 24, e
+ WRITE(*, 9001) 24, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 24, 1, l
+ WRITE(*, 9007) 24, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 24, 2, n
+ WRITE(*, 9007) 24, 2, n
ENDIF
IF (fields(1) .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 24, 3, fields(1)
+ WRITE(*, 9008) 24, 3, fields(1)
ENDIF
IF (fields(2) .NE. 'sbit') THEN
ne = ne + 1
- WRITE(*, 2008) 24, 4, fields(2)
+ WRITE(*, 9008) 24, 4, fields(2)
ENDIF
C 25: GDGEPH check
@@ -726,27 +729,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 25, e
+ WRITE(*, 9001) 25, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 25, 1, l
+ WRITE(*, 9007) 25, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 25, 2, n
+ WRITE(*, 9007) 25, 2, n
ENDIF
IF (i .NE. 11) THEN
ne = ne + 1
- WRITE(*, 2007) 25, 3, i
+ WRITE(*, 9007) 25, 3, i
ENDIF
IF (fn .NE. 'data') THEN
ne = ne + 1
- WRITE(*, 2008) 25, 4, fn
+ WRITE(*, 9008) 25, 4, fn
ENDIF
C 26: GDGECO check
@@ -755,17 +758,17 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 26, e
+ WRITE(*, 9001) 26, e
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 26, 1, n
+ WRITE(*, 9007) 26, 1, n
ENDIF
IF (i .NE. GD_F64) THEN
ne = ne + 1
- WRITE(*, 2007) 26, 2, i
+ WRITE(*, 9007) 26, 2, i
ENDIF
C 27: GDFRGI check
@@ -774,12 +777,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 27, e
+ WRITE(*, 9001) 27, e
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2002) 27, n
+ WRITE(*, 9002) 27, n
ENDIF
C 28: GDADRW check
@@ -788,7 +791,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 28, 1, e
+ WRITE(*, 9006) 28, 1, e
ENDIF
CALL GDGERW(l, i, n, d, 'new1', 4)
@@ -796,22 +799,22 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 28, 2, e
+ WRITE(*, 9006) 28, 2, e
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 28, 3, n
+ WRITE(*, 9007) 28, 3, n
ENDIF
IF (l .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 28, 4, l
+ WRITE(*, 9007) 28, 4, l
ENDIF
IF (i .NE. GD_F64) THEN
ne = ne + 1
- WRITE(*, 2007) 28, 5, i
+ WRITE(*, 9007) 28, 5, i
ENDIF
C 29: GDADLC check
@@ -821,7 +824,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 29, 1, e
+ WRITE(*, 9006) 29, 1, e
ENDIF
l = flen
@@ -831,32 +834,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 29, 2, e
+ WRITE(*, 9006) 29, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 29, 3, l
+ WRITE(*, 9007) 29, 3, l
ENDIF
IF (i .NE. 2) THEN
ne = ne + 1
- WRITE(*, 2007) 29, 4, i
+ WRITE(*, 9007) 29, 4, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 29, 5, n
+ WRITE(*, 9007) 29, 5, n
ENDIF
IF (fields(1) .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 29, 6, fields(1)
+ WRITE(*, 9008) 29, 6, fields(1)
ENDIF
IF (fields(2) .NE. 'in2') THEN
ne = ne + 1
- WRITE(*, 2008) 29, 7, fields(2)
+ WRITE(*, 9008) 29, 7, fields(2)
ENDIF
q(1) = 9.9
@@ -868,7 +871,7 @@
DO 290 i=1,4
IF (abs(p(i) - q(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2010) i, 29, p(i)
+ WRITE(*, 9010) i, 29, p(i)
ENDIF
290 CONTINUE
@@ -883,7 +886,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 30, 1, e
+ WRITE(*, 9006) 30, 1, e
ENDIF
l = flen
@@ -893,32 +896,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 30, e
+ WRITE(*, 9001) 30, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 30, 1, l
+ WRITE(*, 9007) 30, 1, l
ENDIF
IF (i .NE. 2) THEN
ne = ne + 1
- WRITE(*, 2007) 30, 2, i
+ WRITE(*, 9007) 30, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 30, 3, n
+ WRITE(*, 9007) 30, 3, n
ENDIF
IF (fields(1) .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 30, 4, fields(1)
+ WRITE(*, 9008) 30, 4, fields(1)
ENDIF
IF (fields(2) .NE. 'in2') THEN
ne = ne + 1
- WRITE(*, 2008) 30, 5, fields(2)
+ WRITE(*, 9008) 30, 5, fields(2)
ENDIF
cq(1) = cmplx(1.1, 1.2)
@@ -928,7 +931,7 @@
DO 300 i=1,4
IF (abs(cp(i) - cq(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2011) i, 30, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
+ WRITE(*, 9011) i, 30, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
ENDIF
300 CONTINUE
@@ -939,7 +942,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 31, 1, e
+ WRITE(*, 9006) 31, 1, e
ENDIF
l = flen
@@ -949,27 +952,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 31, 2, e
+ WRITE(*, 9006) 31, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 31, 1, l
+ WRITE(*, 9007) 31, 1, l
ENDIF
IF (i .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 31, 2, i
+ WRITE(*, 9007) 31, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 31, 3, n
+ WRITE(*, 9007) 31, 3, n
ENDIF
IF (fn .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 31, 4, fn
+ WRITE(*, 9008) 31, 4, fn
ENDIF
q(1) = 3d3
@@ -982,7 +985,7 @@
DO 310 i=1,4
IF (abs(p(i) - q(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2010) i, 31, p(i)
+ WRITE(*, 9010) i, 31, p(i)
ENDIF
310 CONTINUE
@@ -997,7 +1000,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 32, 1, e
+ WRITE(*, 9006) 32, 1, e
ENDIF
l = flen
@@ -1007,27 +1010,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 32, 2, e
+ WRITE(*, 9006) 32, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 32, 1, l
+ WRITE(*, 9007) 32, 1, l
ENDIF
IF (i .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 32, 2, i
+ WRITE(*, 9007) 32, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 32, 3, n
+ WRITE(*, 9007) 32, 3, n
ENDIF
IF (fn .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 32, 4, fn
+ WRITE(*, 9008) 32, 4, fn
ENDIF
cq(1) = cmplx(3.1, 7.0)
@@ -1037,7 +1040,7 @@
DO 320 i=1,4
IF (abs(cp(i) - cq(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2011) i, 32, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
+ WRITE(*, 9011) i, 32, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
ENDIF
320 CONTINUE
@@ -1047,36 +1050,36 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 33, 1, e
+ WRITE(*, 9006) 33, 1, e
ENDIF
l = flen
- CALL GDGELT(fn, l, str, 20, n, d, 'new6', 4)
+ CALL GDGELT(fn, l, str, slen, n, d, 'new6', 4)
CALL GDEROR(e, d)
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 33, 2, e
+ WRITE(*, 9006) 33, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 33, 1, l
+ WRITE(*, 9007) 33, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 33, 2, n
+ WRITE(*, 9007) 33, 2, n
ENDIF
IF (fn .NE. 'in') THEN
ne = ne + 1
- WRITE(*, 2008) 33, 3, fn
+ WRITE(*, 9008) 33, 3, fn
ENDIF
IF (str .NE. './some/table') THEN
ne = ne + 1
- WRITE(*, 2008) 33, 4, str
+ WRITE(*, 9008) 33, 4, str
ENDIF
C 34: GDADBT check
@@ -1085,7 +1088,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 34, 1, e
+ WRITE(*, 9006) 34, 1, e
ENDIF
l = flen
@@ -1094,32 +1097,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 34, 2, e
+ WRITE(*, 9006) 34, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 34, 1, l
+ WRITE(*, 9007) 34, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 34, 2, n
+ WRITE(*, 9007) 34, 2, n
ENDIF
IF (i .NE. 12) THEN
ne = ne + 1
- WRITE(*, 2007) 34, 3, i
+ WRITE(*, 9007) 34, 3, i
ENDIF
IF (m .NE. 13) THEN
ne = ne + 1
- WRITE(*, 2007) 34, 4, m
+ WRITE(*, 9007) 34, 4, m
ENDIF
IF (fn .NE. 'in') THEN
ne = ne + 1
- WRITE(*, 2008) 34, 5, fn
+ WRITE(*, 9008) 34, 5, fn
ENDIF
C 35: GDADSB check
@@ -1128,7 +1131,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 35, 1, e
+ WRITE(*, 9006) 35, 1, e
ENDIF
l = flen
@@ -1137,32 +1140,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 35, 2, e
+ WRITE(*, 9006) 35, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 35, 1, l
+ WRITE(*, 9007) 35, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 35, 2, n
+ WRITE(*, 9007) 35, 2, n
ENDIF
IF (i .NE. 12) THEN
ne = ne + 1
- WRITE(*, 2007) 35, 3, i
+ WRITE(*, 9007) 35, 3, i
ENDIF
IF (m .NE. 13) THEN
ne = ne + 1
- WRITE(*, 2007) 35, 4, m
+ WRITE(*, 9007) 35, 4, m
ENDIF
IF (fn .NE. 'in') THEN
ne = ne + 1
- WRITE(*, 2008) 35, 5, fn
+ WRITE(*, 9008) 35, 5, fn
ENDIF
C 36: GDADMT check
@@ -1171,7 +1174,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 36, 1, e
+ WRITE(*, 9006) 36, 1, e
ENDIF
l = flen
@@ -1180,27 +1183,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 36, 2, e
+ WRITE(*, 9006) 36, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 36, 1, l
+ WRITE(*, 9007) 36, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 36, 2, n
+ WRITE(*, 9007) 36, 2, n
ENDIF
IF (fields(1) .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 36, 3, fields(1)
+ WRITE(*, 9008) 36, 3, fields(1)
ENDIF
IF (fields(2) .NE. 'in2') THEN
ne = ne + 1
- WRITE(*, 2008) 36, 4, fields(2)
+ WRITE(*, 9008) 36, 4, fields(2)
ENDIF
C 37: GDADPH check
@@ -1209,7 +1212,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 37, 1, e
+ WRITE(*, 9006) 37, 1, e
ENDIF
l = flen
@@ -1218,27 +1221,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 37, 2, e
+ WRITE(*, 9006) 37, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 37, 1, l
+ WRITE(*, 9007) 37, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 37, 2, n
+ WRITE(*, 9007) 37, 2, n
ENDIF
IF (i .NE. 22) THEN
ne = ne + 1
- WRITE(*, 2007) 37, 3, i
+ WRITE(*, 9007) 37, 3, i
ENDIF
IF (fn .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 37, 4, fn
+ WRITE(*, 9008) 37, 4, fn
ENDIF
C 38: GDADCO check
@@ -1247,7 +1250,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 38, 1, e
+ WRITE(*, 9006) 38, 1, e
ENDIF
CALL GDGECO(i, n, d, 'new11', 5)
@@ -1255,17 +1258,17 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 38, 2, e
+ WRITE(*, 9006) 38, 2, e
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 38, 1, n
+ WRITE(*, 9007) 38, 1, n
ENDIF
IF (i .NE. GD_F64) THEN
ne = ne + 1
- WRITE(*, 2007) 38, 2, i
+ WRITE(*, 9007) 38, 2, i
ENDIF
CALL GDGTCO(d, 'new11', 5, GD_F32, fl)
@@ -1273,26 +1276,26 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 38, 3, e
+ WRITE(*, 9006) 38, 3, e
ENDIF
IF (abs(fl + 8.1) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2005) 38, fl
+ WRITE(*, 9005) 38, fl
ENDIF
C 39: GDFRGN check
- CALL GDFRGN(str, 20, d, 0)
+ CALL GDFRGN(str, slen, d, 0)
CALL GDEROR(e, d)
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 39, e
+ WRITE(*, 9001) 39, e
ENDIF
IF (str .NE. 'test_dirfile/format') THEN
ne = ne + 1
- WRITE(*, 2009), 39, str
+ WRITE(*, 9009), 39, str
ENDIF
C 40: GDNFRG check
@@ -1301,12 +1304,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 40, e
+ WRITE(*, 9001) 40, e
ENDIF
IF (n .NE. 1) THEN
ne = ne + 1
- WRITE(*, 2002), 40, n
+ WRITE(*, 9002), 40, n
ENDIF
C 41: GDINCL check
@@ -1315,7 +1318,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 41, 3, e
+ WRITE(*, 9006) 41, 3, e
ENDIF
CALL GDGTCO(d, 'const2', 6, GD_I8, c(1))
@@ -1323,12 +1326,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 41, 3, e
+ WRITE(*, 9006) 41, 3, e
ENDIF
IF (c(1) .NE. -19) THEN
ne = ne + 1
- WRITE(*, 2004) 1, 41, c(1)
+ WRITE(*, 9004) 1, 41, c(1)
ENDIF
C 42: GDNFDT check
@@ -1337,12 +1340,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 42, e
+ WRITE(*, 9001) 42, e
ENDIF
IF (n .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2002), 42, n
+ WRITE(*, 9002), 42, n
ENDIF
C 43: GDFDNT check
@@ -1356,17 +1359,17 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 43, i, e
+ WRITE(*, 9006) 43, i, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 43, i, l
+ WRITE(*, 9007) 43, i, l
ENDIF
IF (fn .NE. fields(i)) THEN
ne = ne + 1
- WRITE(*, 2008) i, 43, fn
+ WRITE(*, 9008) i, 43, fn
ENDIF
430 CONTINUE
@@ -1376,12 +1379,12 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 44, e
+ WRITE(*, 9001) 44, e
ENDIF
IF (n .NE. 21) THEN
ne = ne + 1
- WRITE(*, 2002), 44, n
+ WRITE(*, 9002), 44, n
ENDIF
C 45: GDVECN check
@@ -1413,17 +1416,17 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 45, i, e
+ WRITE(*, 9006) 45, i, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 45, i, l
+ WRITE(*, 9007) 45, i, l
ENDIF
IF (fn .NE. fields(i)) THEN
ne = ne + 1
- WRITE(*, 2008) i, 45, fn
+ WRITE(*, 9008) i, 45, fn
ENDIF
450 CONTINUE
@@ -1434,7 +1437,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 46, 1, e
+ WRITE(*, 9006) 46, 1, e
ENDIF
l = flen
@@ -1444,32 +1447,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 46, 2, e
+ WRITE(*, 9006) 46, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 46, 3, l
+ WRITE(*, 9007) 46, 3, l
ENDIF
IF (i .NE. 2) THEN
ne = ne + 1
- WRITE(*, 2007) 46, 4, i
+ WRITE(*, 9007) 46, 4, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 46, 5, n
+ WRITE(*, 9007) 46, 5, n
ENDIF
IF (fields(1) .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 46, 6, fields(1)
+ WRITE(*, 9008) 46, 6, fields(1)
ENDIF
IF (fields(2) .NE. 'in2') THEN
ne = ne + 1
- WRITE(*, 2008) 46, 7, fields(2)
+ WRITE(*, 9008) 46, 7, fields(2)
ENDIF
q(1) = 9.9
@@ -1481,7 +1484,7 @@
DO 460 i=1,4
IF (abs(p(i) - q(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2010) i, 46, p(i)
+ WRITE(*, 9010) i, 46, p(i)
ENDIF
460 CONTINUE
@@ -1496,7 +1499,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 47, 1, e
+ WRITE(*, 9006) 47, 1, e
ENDIF
l = flen
@@ -1506,32 +1509,32 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2001) 47, e
+ WRITE(*, 9001) 47, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 47, 1, l
+ WRITE(*, 9007) 47, 1, l
ENDIF
IF (i .NE. 2) THEN
ne = ne + 1
- WRITE(*, 2007) 47, 2, i
+ WRITE(*, 9007) 47, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 47, 3, n
+ WRITE(*, 9007) 47, 3, n
ENDIF
IF (fields(1) .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 47, 4, fields(1)
+ WRITE(*, 9008) 47, 4, fields(1)
ENDIF
IF (fields(2) .NE. 'in2') THEN
ne = ne + 1
- WRITE(*, 2008) 47, 5, fields(2)
+ WRITE(*, 9008) 47, 5, fields(2)
ENDIF
cq(1) = cmplx(1.1, 1.2)
@@ -1541,7 +1544,7 @@
DO 470 i=1,4
IF (abs(cp(i) - cq(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2011) i, 47, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
+ WRITE(*, 9011) i, 47, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
ENDIF
470 CONTINUE
@@ -1552,7 +1555,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 48, 1, e
+ WRITE(*, 9006) 48, 1, e
ENDIF
l = flen
@@ -1562,27 +1565,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 48, 2, e
+ WRITE(*, 9006) 48, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 48, 1, l
+ WRITE(*, 9007) 48, 1, l
ENDIF
IF (i .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 48, 2, i
+ WRITE(*, 9007) 48, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 48, 3, n
+ WRITE(*, 9007) 48, 3, n
ENDIF
IF (fn .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 48, 4, fn
+ WRITE(*, 9008) 48, 4, fn
ENDIF
q(1) = 3d3
@@ -1594,7 +1597,7 @@
DO 480 i=1,4
IF (abs(p(i) - q(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2010) i, 48, p(i)
+ WRITE(*, 9010) i, 48, p(i)
ENDIF
480 CONTINUE
@@ -1609,7 +1612,7 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 49, 1, e
+ WRITE(*, 9006) 49, 1, e
ENDIF
l = flen
@@ -1619,27 +1622,27 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 49, 2, e
+ WRITE(*, 9006) 49, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 49, 1, l
+ WRITE(*, 9007) 49, 1, l
ENDIF
IF (i .NE. 3) THEN
ne = ne + 1
- WRITE(*, 2007) 49, 2, i
+ WRITE(*, 9007) 49, 2, i
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 49, 3, n
+ WRITE(*, 9007) 49, 3, n
ENDIF
IF (fn .NE. 'in1') THEN
ne = ne + 1
- WRITE(*, 2008) 49, 4, fn
+ WRITE(*, 9008) 49, 4, fn
ENDIF
cq(1) = cmplx(1.1, 0.0)
@@ -1649,7 +1652,7 @@
DO 490 i=1,4
IF (abs(cp(i) - cq(i)) .gt. 0.001) THEN
ne = ne + 1
- WRITE(*, 2011) i, 49, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
+ WRITE(*, 9011) i, 49, REAL(REAL(cp(i))), REAL(AIMAG(cp(i)))
ENDIF
490 CONTINUE
@@ -1659,36 +1662,36 @@
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 50, 1, e
+ WRITE(*, 9006) 50, 1, e
ENDIF
l = flen
- CALL GDGELT(fn, l, str, 20, n, d, 'data/mnew6', 10)
+ CALL GDGELT(fn, l, str, slen, n, d, 'data/mnew6', 10)
CALL GDEROR(e, d)
IF (e .NE. GD_EOK) THEN
ne = ne + 1
- WRITE(*, 2006) 50, 2, e
+ WRITE(*, 9006) 50, 2, e
ENDIF
IF (l .NE. flen) THEN
ne = ne + 1
- WRITE(*, 2007) 50, 1, l
+ WRITE(*, 9007) 50, 1, l
ENDIF
IF (n .NE. 0) THEN
ne = ne + 1
- WRITE(*, 2007) 50, 2, n
+ WRITE(*, 9007) 50, 2, n
ENDIF
IF (fn .NE. 'in') THEN
ne = ne + 1
- ...
[truncated message content] |
