No commit message

No commit message

.gitattributes

@@ -77,10 +77,13 @@ examples/cdi_copy_file.c -text
 examples/cdi_read.c -text
 examples/cdi_read_example.f90 -text
 examples/cdi_read_f.f -text
+examples/cdi_read_f2003.f90 -text
 examples/cdi_read_records.c -text
 examples/cdi_write.c -text
 examples/cdi_write_f.f -text
+examples/cdi_write_f2003.f90 -text
 examples/compf -text
+m4/acx_sl_mod_suffix.m4 -text
 src/Makefile.am -text
 src/Makefile.in -text
 src/basetime.c -text
@@ -124,6 +127,7 @@ src/institution.c -text
 src/lock.h -text
 src/make_cdilib -text
 src/make_fint.c -text
+src/mo_cdi.f90 -text
 src/model.c -text
 src/service.h -text
 src/servicelib.c -text

examples/cdi_read_f2003.f90

+PROGRAM CDIREADF2003
+  use iso_c_binding
+  use mo_cdi
+
+  IMPLICIT NONE
+
+  INTEGER :: gsize, nlevel, nvars, code
+  INTEGER :: vdate, vtime, nmiss, status, ilev
+  INTEGER :: streamID, varID, gridID, zaxisID
+  INTEGER :: tsID, vlistID, taxisID
+  DOUBLE PRECISION, ALLOCATABLE :: field(:,:)
+  CHARACTER(kind=c_char,len=256) :: name, longname, units
+
+  ! Open the dataset
+  streamID = streamOpenRead(C_CHAR_"example.nc"//C_NULL_CHAR)
+  IF ( streamID < 0 ) THEN
+    PRINT *,'Could not Read the file.'
+    WRITE(0,*) cdiStringError(streamID)
+    STOP
+  END IF
+
+  ! Get the variable list of the dataset
+  vlistID = streamInqVlist(streamID)
+
+  nvars = vlistNvars(vlistID)
+
+  DO varID = 0, nvars-1
+    code = vlistInqVarCode(vlistID, varID)
+    CALL vlistInqVarName(vlistID, varID, name)
+    CALL vlistInqVarLongname(vlistID, varID, longname)
+    CALL vlistInqVarUnits(vlistID, varID, units)
+    
+    CALL ctrim(name)
+    CALL ctrim(longname)
+    CALL ctrim(units)
+
+    WRITE(*,*) 'Parameter: ', varID+1, code,' ',trim(name),' ', &
+                trim(longname),' ',trim(units), ' |'
+
+  END DO
+
+  ! Get the Time axis form the variable list
+  taxisID = vlistInqTaxis(vlistID)
+
+  ! Loop over the time steps
+  DO tsID = 0, 999999
+    ! Read the time step
+    status = streamInqTimestep(streamID, tsID)
+    IF ( status == 0 ) exit
+
+    ! Get the verification date and time
+    vdate = taxisInqVdate(taxisID)
+    vtime = taxisInqVtime(taxisID)
+
+    WRITE(*,*) 'Timestep: ', tsID+1, vdate, vtime
+
+    ! Read the variables at the current timestep
+    DO varID = 0, nvars-1
+      gridID = vlistInqVarGrid(vlistID, varID)
+      gsize = gridInqSize(gridID)
+      zaxisID = vlistInqVarZaxis(vlistID, varID)
+      nlevel = zaxisInqSize(zaxisID)
+      ALLOCATE(field(gsize, nlevel))
+      CALL streamReadVar(streamID, varID, field, nmiss)
+      DO ilev = 1, nlevel
+        WRITE(*,*) '   var=', varID+1, ' level=', ilev, ':', &
+                  MINVAL(field(:,ilev)), MAXVAL(field(:,ilev))
+      END DO
+      DEALLOCATE(field)
+    END DO
+  END DO
+
+  ! Close the input stream
+  CALL streamClose(streamID)
+
+END PROGRAM CDIREADF2003

examples/cdi_write_f2003.f90

+      PROGRAM CDIWRITEF2003
+
+      USE iso_c_binding
+      USE mo_cdi
+
+      IMPLICIT NONE
+
+      INTEGER NLON, NLAT, NLEV, NTIME
+      PARAMETER (NLON  = 12)   ! Number of longitudes
+      PARAMETER (NLAT  =  6)   ! Number of latitudes
+      PARAMETER (NLEV  =  5)   ! Number of levels
+      PARAMETER (NTIME =  3)   ! Number of time steps
+
+      INTEGER gridID, zaxisID1, zaxisID2, taxisID
+      INTEGER vlistID, varID1, varID2, streamID, tsID
+      INTEGER i, nmiss, status
+      DOUBLE PRECISION lons(NLON), lats(NLAT), levs(NLEV)
+      DOUBLE PRECISION var1(NLON*NLAT), var2(NLON*NLAT*NLEV)
+      CHARACTER(len=256) :: varname
+
+      DATA lons /0, 30, 60, 90, 120, 150, 180, 210, 240, 270, 300, 330/
+      DATA lats /-75, -45, -15, 15, 45, 75/
+      DATA levs /101300, 92500, 85000, 50000, 20000/
+
+      nmiss = 0
+
+!     Create a regular lon/lat grid
+      gridID = gridCreate(GRID_LONLAT, NLON*NLAT)
+      CALL gridDefXsize(gridID, NLON)
+      CALL gridDefYsize(gridID, NLAT)
+      CALL gridDefXvals(gridID, lons)
+      CALL gridDefYvals(gridID, lats)
+
+!     Create a surface level Z-axis
+      zaxisID1 = zaxisCreate(ZAXIS_SURFACE, 1)
+
+!     Create a pressure level Z-axis
+      zaxisID2 = zaxisCreate(ZAXIS_PRESSURE, NLEV)
+      CALL zaxisDefLevels(zaxisID2, levs)
+ 
+!     Create a variable list
+      vlistID = vlistCreate()
+
+!     Define the variables
+      varID1 = vlistDefVar(vlistID, gridID, zaxisID1, TIME_VARIABLE)
+      varID2 = vlistDefVar(vlistID, gridID, zaxisID2, TIME_VARIABLE)
+
+!     Define the variable names
+      varname = "varname1"
+      CALL vlistDefVarName(vlistID, varID1, TRIM(varname)//C_NULL_CHAR)
+      CALL vlistDefVarName(vlistID, varID2, C_CHAR_"varname2"//C_NULL_CHAR)
+
+!     Create a Time axis
+      taxisID = taxisCreate(TAXIS_ABSOLUTE)
+
+!     Assign the Time axis to the variable list
+      CALL vlistDefTaxis(vlistID, taxisID)
+
+!     Create a dataset in netCDF fromat
+      streamID = streamOpenWrite(C_CHAR_"example.nc"//C_NULL_CHAR, FILETYPE_NC)
+      IF ( streamID < 0 ) THEN
+         WRITE(0,*) cdiStringError(streamID)
+         STOP
+      END IF
+
+!     Assign the variable list to the dataset
+      CALL streamDefVlist(streamID, vlistID)
+
+!     Loop over the number of time steps
+      DO tsID = 0, NTIME-1
+!        Set the verification date to 1985-01-01 + tsID
+         CALL taxisDefVdate(taxisID, 19850101+tsID)
+!        Set the verification time to 12:00
+         CALL taxisDefVtime(taxisID, 1200)
+!        Define the time step
+         status = streamDefTimestep(streamID, tsID)
+
+!        Init var1 and var2
+         DO i = 1, NLON*NLAT
+            var1(i) = 1.1
+         END DO
+         DO i = 1, NLON*NLAT*NLEV
+            var2(i) = 2.2
+         END DO
+
+!        Write var1 and var2
+         CALL streamWriteVar(streamID, varID1, var1, nmiss)
+         CALL streamWriteVar(streamID, varID2, var2, nmiss)
+      END DO
+
+!     Close the output stream
+      CALL streamClose(streamID)
+
+!     Destroy the objects
+      CALL vlistDestroy(vlistID)
+      CALL taxisDestroy(taxisID)
+      CALL zaxisDestroy(zaxisID1)
+      CALL zaxisDestroy(zaxisID2)
+      CALL gridDestroy(gridID)
+
+      END PROGRAM CDIWRITEF2003

m4/acx_sl_mod_suffix.m4

+# ACX_SL_FC_MOD_SUFFIX([ACTION-IF-FOUND],[ACTION-IF-NOT-FOUND])
+# -----------------
+# Determines the form of the filename of modules produced
+# by the Fortran compiler.
+# Tests for all forms of file extension I've (TOHW) found in the
+# wild. Note that at least one compiler (PGI??) changes the
+# case of the basename as well. Whether this happens is
+# encoded in the variable ac_fc_mod_uppercase.
+#
+# This macro depends, of course, on the Fortran compiler producing
+# module files. See comment to AC_FC_MOD_PATH_FLAG.
+#
+# FIXME: This will fail if an F77-only compiler is used.
+# Currently we warn and continue. We should maybe error out.
+#
+AC_DEFUN([ACX_SL_FC_MOD_SUFFIX],
+  [AC_MSG_CHECKING([for suffix of module files])
+   AC_ARG_VAR([FCMODEXT], [file extension of compiled Fortran module files])
+   ac_fc_mod_uppercase=no
+   AC_LANG_PUSH([Fortran])
+   AC_COMPILE_IFELSE([
+      module conftest
+       implicit none
+       integer :: i
+      end module conftest
+     ])
+   while :; do
+     acx_fc_mod_name=
+   m4_foreach([acx_fc_mod_name],dnl
+     [[conftest.$FCMODEXT], [conftest.mod], [conftest.MOD], [conftest.M],
+      [CONFTEST.MOD]],dnl
+     [AS_IF([test -n "acx_fc_mod_name" -a -f "acx_fc_mod_name"],dnl
+        [[acx_fc_mod_name]="acx_fc_mod_name" ; break])
+     ])
+     break
+   done
+   rm -f conftest*
+   AC_LANG_POP([Fortran])
+dnl
+   AS_CASE(["$acx_fc_mod_name"],dnl
+     [conftest.$FCMODEXT], [:],
+     [CONFTEST.$FCMODEXT], [ac_fc_mod_uppercase=yes],
+     [conftest.mod], [FCMODEXT=mod],
+     [conftest.MOD], [FCMODEXT=MOD],
+     [conftest.M], [FCMODEXT=M],
+     [CONFTEST.MOD], [FCMODEXT=MOD
+        ac_fc_mod_uppercase=yes])
+   AC_MSG_RESULT([${FCMODEXT-not found}])
+   AS_VAR_TEST_SET([FCMODEXT], [$1], [m4_ifval([$2],[$2],dnl
+     [AC_MSG_WARN([Could not find Fortran module file extension.])])])
+dnl
+   AS_IF([test $ac_fc_mod_uppercase = yes],
+     [AC_MSG_NOTICE([Fortran module filenames are uppercase.])])
+   AC_SUBST([FCMODEXT])
+])dnl _ACX_SL_FC_MOD_SUFFIX
+dnl
+dnl Local Variables:
+dnl mode: autoconf
+dnl End: