Commit de95b2eb authored by Uwe Schulzweida's avatar Uwe Schulzweida
Browse files

Fortran interface update.

parent 297c6dc2
......@@ -4,7 +4,7 @@
!
! Author:
! -------
! Uwe Schulzweida, MPI-MET, Hamburg, February 2019
! Uwe Schulzweida, MPI-MET, Hamburg, April 2019
!
INTEGER CDI_MAX_NAME
......@@ -2029,9 +2029,6 @@
! (INTEGER gridID)
EXTERNAL gridInqScanningMode
!
! ZAXIS routines
!
! zaxisName
! (INTEGER zaxistype,
! CHARACTER*(*) zaxisname)
......@@ -2062,10 +2059,6 @@
! (INTEGER zaxisID)
EXTERNAL zaxisDuplicate
! zaxisPrint
! (INTEGER zaxisID)
EXTERNAL zaxisPrint
! zaxisDefLevels
! (INTEGER zaxisID,
! DOUBLEPRECISION levels(*))
......@@ -2189,6 +2182,15 @@
! (INTEGER zaxisID)
EXTERNAL zaxisInqLtype
! zaxisDefLtype2
! (INTEGER zaxisID,
! INTEGER ltype2)
EXTERNAL zaxisDefLtype2
INTEGER zaxisInqLtype2
! (INTEGER zaxisID)
EXTERNAL zaxisInqLtype2
! zaxisDefVct
! (INTEGER zaxisID,
! INTEGER size,
......@@ -2585,8 +2587,7 @@
! Generate a "query object" out of a key-value pair.
!
!
! Generate an AND-combined "query object" out of two previous
! query objects.
! Generate an AND-combined "query object" out of two previous query objects.
!
INTEGER subtypeInqTile
! (INTEGER subtypeID,
......@@ -2612,3 +2613,9 @@
! INTEGER revision_version)
EXTERNAL gribapiLibraryVersion
! gaussianLatitudes
! (DOUBLEPRECISION latitudes,
! DOUBLEPRECISION weights,
! INTEGER nlat)
EXTERNAL gaussianLatitudes
......@@ -622,9 +622,6 @@ FCALLSCSUB2 (gridDefComplexPacking, GRIDDEFCOMPLEXPACKING, griddefcomplexpacking
FCALLSCFUN1 (INT, gridInqComplexPacking, GRIDINQCOMPLEXPACKING, gridinqcomplexpacking, INT)
FCALLSCSUB2 (gridDefScanningMode, GRIDDEFSCANNINGMODE, griddefscanningmode, INT, INT)
FCALLSCFUN1 (INT, gridInqScanningMode, GRIDINQSCANNINGMODE, gridinqscanningmode, INT)
/* ZAXIS routines */
FCALLSCSUB2 (zaxisName, ZAXISNAME, zaxisname, INT, PSTRING)
FCALLSCFUN1 (STRING, zaxisNamePtr, ZAXISNAMEPTR, zaxisnameptr, INT)
FCALLSCFUN2 (INT, zaxisCreate, ZAXISCREATE, zaxiscreate, INT, INT)
......@@ -632,7 +629,6 @@ FCALLSCSUB1 (zaxisDestroy, ZAXISDESTROY, zaxisdestroy, INT)
FCALLSCFUN1 (INT, zaxisInqType, ZAXISINQTYPE, zaxisinqtype, INT)
FCALLSCFUN1 (INT, zaxisInqSize, ZAXISINQSIZE, zaxisinqsize, INT)
FCALLSCFUN1 (INT, zaxisDuplicate, ZAXISDUPLICATE, zaxisduplicate, INT)
FCALLSCSUB1 (zaxisPrint, ZAXISPRINT, zaxisprint, INT)
FCALLSCSUB2 (zaxisDefLevels, ZAXISDEFLEVELS, zaxisdeflevels, INT, DOUBLEV)
FCALLSCFUN2 (INT, zaxisInqLevels, ZAXISINQLEVELS, zaxisinqlevels, INT, DOUBLEV)
FCALLSCFUN1 (INT, zaxisInqCLen, ZAXISINQCLEN, zaxisinqclen, INT)
......@@ -659,6 +655,8 @@ FCALLSCSUB1 (zaxisDefScalar, ZAXISDEFSCALAR, zaxisdefscalar, INT)
FCALLSCFUN1 (INT, zaxisInqScalar, ZAXISINQSCALAR, zaxisinqscalar, INT)
FCALLSCSUB2 (zaxisDefLtype, ZAXISDEFLTYPE, zaxisdefltype, INT, INT)
FCALLSCFUN1 (INT, zaxisInqLtype, ZAXISINQLTYPE, zaxisinqltype, INT)
FCALLSCSUB2 (zaxisDefLtype2, ZAXISDEFLTYPE2, zaxisdefltype2, INT, INT)
FCALLSCFUN1 (INT, zaxisInqLtype2, ZAXISINQLTYPE2, zaxisinqltype2, INT)
FCALLSCSUB3 (zaxisDefVct, ZAXISDEFVCT, zaxisdefvct, INT, INT, DOUBLEV)
FCALLSCSUB2 (zaxisInqVct, ZAXISINQVCT, zaxisinqvct, INT, DOUBLEV)
FCALLSCFUN1 (INT, zaxisInqVctSize, ZAXISINQVCTSIZE, zaxisinqvctsize, INT)
......@@ -809,13 +807,17 @@ FCALLSCSUB2 (subtypeDefActiveIndex, SUBTYPEDEFACTIVEINDEX, subtypedefactiveindex
/* Generate a "query object" out of a key-value pair. */
/* Generate an AND-combined "query object" out of two previous
query objects. */
/* Generate an AND-combined "query object" out of two previous query objects. */
FCALLSCFUN3 (INT, subtypeInqTile, SUBTYPEINQTILE, subtypeinqtile, INT, INT, INT)
FCALLSCFUN4 (INT, subtypeInqAttribute, SUBTYPEINQATTRIBUTE, subtypeinqattribute, INT, INT, STRING, PINT)
FCALLSCFUN2 (INT, vlistInqVarSubtype, VLISTINQVARSUBTYPE, vlistinqvarsubtype, INT, INT)
FCALLSCSUB3 (gribapiLibraryVersion, GRIBAPILIBRARYVERSION, gribapilibraryversion, PINT, PINT, PINT)
static void gaussianLatitudes_fwrap(double *latitudes, double *weights, int nlat)
{
gaussianLatitudes(latitudes, weights, (size_t)nlat);
}
FCALLSCSUB3 (gaussianLatitudes_fwrap, GAUSSIANLATITUDES, gaussianlatitudes, PDOUBLE, PDOUBLE, INT)
#if defined __clang__
# pragma GCC diagnostic pop
......
......@@ -475,6 +475,7 @@ module mo_cdi
integer(c_int), public, parameter :: CDI_KEY_GRIB2LOCALSECTIONNUMBER = 818
integer(c_int), public, parameter :: CDI_KEY_SECTION2PADDINGLENGTH = 819
integer(c_int), public, parameter :: CDI_KEY_SECTION2PADDING = 820
integer(c_int), public, parameter :: CDI_KEY_UVRELATIVETOGRID = 821
public :: cdiDefKeyInt
public :: cdiInqKeyInt
public :: cdiDefKeyBytes
......@@ -562,8 +563,6 @@ module mo_cdi
public :: gridChangeType
public :: gridDefComplexPacking
public :: gridInqComplexPacking
public :: gridDefUvRelativeToGrid
public :: gridInqUvRelativeToGrid
public :: gridDefScanningMode
public :: gridInqScanningMode
public :: zaxisName
......@@ -573,7 +572,6 @@ module mo_cdi
public :: zaxisInqType
public :: zaxisInqSize
public :: zaxisDuplicate
public :: zaxisPrint
public :: zaxisDefLevels
public :: zaxisInqLevels
public :: zaxisInqCLen
......@@ -600,6 +598,8 @@ module mo_cdi
public :: zaxisInqScalar
public :: zaxisDefLtype
public :: zaxisInqLtype
public :: zaxisDefLtype2
public :: zaxisInqLtype2
public :: zaxisDefVct
public :: zaxisInqVct
public :: zaxisInqVctSize
......@@ -683,6 +683,7 @@ module mo_cdi
public :: subtypeInqAttribute
public :: vlistInqVarSubtype
public :: gribapiLibraryVersion
public :: gaussianLatitudes
interface
subroutine cdiReset() bind(c, name = 'cdiReset')
......@@ -2357,20 +2358,6 @@ module mo_cdi
integer(c_int) :: f_result
end function gridInqComplexPacking
subroutine gridDefUvRelativeToGrid(gridID_dummy, uvRelativeToGrid_dummy)&
& bind(c, name = 'gridDefUvRelativeToGrid')
import c_int
integer(c_int), value :: gridID_dummy
integer(c_int), value :: uvRelativeToGrid_dummy
end subroutine gridDefUvRelativeToGrid
function gridInqUvRelativeToGrid(gridID_dummy) bind(c, name =&
& 'gridInqUvRelativeToGrid') result(f_result)
import c_int
integer(c_int), value :: gridID_dummy
integer(c_int) :: f_result
end function gridInqUvRelativeToGrid
subroutine gridDefScanningMode(gridID_dummy, mode_dummy) bind(c, name =&
& 'gridDefScanningMode')
import c_int
......@@ -2419,11 +2406,6 @@ module mo_cdi
integer(c_int) :: f_result
end function zaxisDuplicate
subroutine zaxisPrint(zaxisID_dummy) bind(c, name = 'zaxisPrint')
import c_int
integer(c_int), value :: zaxisID_dummy
end subroutine zaxisPrint
subroutine zaxisDefLevels(zaxisID_dummy, levels_dummy) bind(c, name =&
& 'zaxisDefLevels')
import c_double, c_int
......@@ -2558,6 +2540,20 @@ module mo_cdi
integer(c_int) :: f_result
end function zaxisInqLtype
subroutine zaxisDefLtype2(zaxisID_dummy, ltype2_dummy) bind(c, name =&
& 'zaxisDefLtype2')
import c_int
integer(c_int), value :: zaxisID_dummy
integer(c_int), value :: ltype2_dummy
end subroutine zaxisDefLtype2
function zaxisInqLtype2(zaxisID_dummy) bind(c, name = 'zaxisInqLtype2')&
& result(f_result)
import c_int
integer(c_int), value :: zaxisID_dummy
integer(c_int) :: f_result
end function zaxisInqLtype2
subroutine zaxisDefVct(zaxisID_dummy, size_dummy, vct_dummy) bind(c, name =&
& 'zaxisDefVct')
import c_double, c_int
......@@ -3001,6 +2997,14 @@ module mo_cdi
integer(c_int), intent(inout) :: revision_version_dummy
end subroutine gribapiLibraryVersion
subroutine gaussianLatitudes(latitudes_dummy, weights_dummy, nlat_dummy)&
& bind(c, name = 'gaussianLatitudes')
import c_double, c_size_t
real(c_double), intent(inout) :: latitudes_dummy
real(c_double), intent(inout) :: weights_dummy
integer(c_size_t), value :: nlat_dummy
end subroutine gaussianLatitudes
end interface
contains
......
......@@ -1402,12 +1402,11 @@ void zaxisPrintKernel(zaxis_t *zaxisptr, FILE *fp)
{
xassert(zaxisptr);
int zaxisID = zaxisptr->self;
int type = zaxisptr->type;
int nlevels = zaxisptr->size;
int datatype = zaxisptr->datatype;
const int type = zaxisptr->type;
const int nlevels = zaxisptr->size;
const int datatype = zaxisptr->datatype;
int dig = (datatype == CDI_DATATYPE_FLT64) ? 15 : 7;
const int dig = (datatype == CDI_DATATYPE_FLT64) ? 15 : 7;
int nbyte;
int nbyte0 = 0;
......@@ -1415,7 +1414,7 @@ void zaxisPrintKernel(zaxis_t *zaxisptr, FILE *fp)
fprintf(fp, "size = %d\n", nlevels);
if ( nlevels == 1 )
{
bool zscalar = (bool)zaxisptr->scalar;
const bool zscalar = (bool)zaxisptr->scalar;
if ( zscalar ) fprintf(fp, "scalar = true\n");
}
if ( zaxisptr->name[0] ) fprintf(fp, "name = %s\n", zaxisptr->name);
......@@ -1439,21 +1438,6 @@ void zaxisPrintKernel(zaxis_t *zaxisptr, FILE *fp)
fprintf(fp, "\n");
}
if ( zaxisptr->cvals )
{
dig = datatype;
nbyte0 = fprintf(fp, "types = ");
nbyte = nbyte0;
for ( int levelID = 0; levelID < nlevels; levelID++ )
{
fprintf(fp, "\n");
fprintf(fp, "%*s", nbyte0, "");
nbyte = nbyte0;
nbyte += fprintf(fp, "%.*s [%d]", dig, zaxisptr->cvals[levelID], levelID+1);
}
fprintf(fp, "\n");
}
if ( zaxisptr->lbounds && zaxisptr->ubounds )
{
nbyte0 = fprintf(fp, "lbounds = ");
......@@ -1487,7 +1471,7 @@ void zaxisPrintKernel(zaxis_t *zaxisptr, FILE *fp)
if ( type == ZAXIS_HYBRID || type == ZAXIS_HYBRID_HALF )
{
int vctsize = zaxisptr->vctsize;
const int vctsize = zaxisptr->vctsize;
const double *vct = zaxisptr->vct;
fprintf(fp, "vctsize = %d\n", vctsize);
if ( vctsize )
......@@ -1504,33 +1488,6 @@ void zaxisPrintKernel(zaxis_t *zaxisptr, FILE *fp)
nbyte += fprintf(fp, "%.15g ", vct[i]);
}
fprintf(fp, "\n");
/*
nbyte0 = fprintf(fp, "vct_b = ");
nbyte = nbyte0;
for ( i = 0; i < vctsize/2; i++ )
{
if ( nbyte > 70 )
{
fprintf(fp, "\n%*s", nbyte0, "");
nbyte = nbyte0;
}
nbyte += fprintf(fp, "%.15g ", vct[vctsize/2+i]);
}
fprintf(fp, "\n");
*/
}
}
if ( type == ZAXIS_REFERENCE )
{
unsigned char uuid[CDI_UUID_SIZE];
zaxisInqUUID(zaxisID, uuid);
if ( *uuid )
{
const unsigned char *d = uuid;
fprintf(fp, "uuid = %02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x\n",
d[0], d[1], d[2], d[3], d[4], d[5], d[6], d[7],
d[8], d[9], d[10], d[11], d[12], d[13], d[14], d[15]);
}
}
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment