Merge pull request ESMCI#1653 from jedwards4b/short_type_in_fortran

Short type in fortran
jedwards4b · Jun 9, 2020 · 1ff0f44 · 1ff0f44
2 parents 30a1b79 + b089073
commit 1ff0f44
Show file tree

Hide file tree

Showing 15 changed files with 289 additions and 215 deletions.
diff --git a/scripts/genf90.pl b/scripts/genf90.pl
@@ -9,8 +9,8 @@
 # to generate F90 code for all of the desired specific types.
 #
 # Keywords are delimited by curly brackets: {}
-# 
-# {TYPE} and {DIMS} are used to generate the specific subroutine names from the 
+#
+# {TYPE} and {DIMS} are used to generate the specific subroutine names from the
 #            generic template
 # {TYPE} : Variable type name; implemented types are character, 4 or 8 byte real,
 #          and 4 or 8 byte integer.
@@ -20,7 +20,7 @@
 #                if {TYPE}=double then {VTYPE} is "real(r8)"
 # {ITYPE}, {ITYPENAME} : Used to generate CPP statements for the specific type.
 # {MPITYPE} : Used to generate MPI types corresponding to the specific type.
-# 
+#
 # {DIMS} : Rank of arrays, "0" for scalar.
 #                allowed values: 0-7
 #                default values : 0-5
@@ -33,40 +33,46 @@
 #                expands to this:
 #                foo(1, bar), foo(2, bar), foo(3, bar), ...
 
-# defaults 
-my @types = qw(text real double int);
-my $vtype = {'text' => 'character(len=*)', 
-	     'real' => 'real(r4)', 
+# defaults
+my @types = qw(text real double int short);
+my $vtype = {'text' => 'character(len=*)',
+	     'real' => 'real(r4)',
 	     'double' => 'real(r8)',
 	     'int'    => 'integer(i4)',
+	     'short'  => 'integer(i2)',
 	     'long'   => 'integer(i8)',
              'logical' => 'logical' };
-my $itype = {'text' => 100, 
-	     'real' => 101, 
+my $itype = {'text' => 100,
+	     'real' => 101,
 	     'double' => 102,
 	     'int'    => 103,
 	     'long'   => 104,
-             'logical' => 105};
-my $itypename = {'text' => 'TYPETEXT', 
-	     'real' =>  'TYPEREAL', 
+             'logical' => 105,
+             'short'  => 106};
+my $itypename = {'text' => 'TYPETEXT',
+	     'real' =>  'TYPEREAL',
 	     'double' => 'TYPEDOUBLE',
 	     'int'    => 'TYPEINT',
+	     'short'  => 'TYPESHORT',
 	     'long'   =>  'TYPELONG',
              'logical' => 'TYPELOGICAL'};
 my $mpitype = {'text' => 'MPI_CHARACTER',
 	       'real' => 'MPI_REAL4',
+	       'short' => 'MPI_SHORT',
 	       'double' => 'MPI_REAL8',
 	       'int' => 'MPI_INTEGER'};
 # Netcdf C datatypes
 my $nctype = {'text' => 'text',
 	      'real' => 'float',
+	      'short' => 'short',
 	      'double' => 'double',
 	      'int' => 'int'};
 # C interoperability types
 my $ctype = {'text' => 'character(C_CHAR)',
 	     'real' => 'real(C_FLOAT)',
 	     'double' => 'real(C_DOUBLE)',
-	     'int' => 'integer(C_INT)'};
+	     'int' => 'integer(C_INT)',
+             'short' => 'integer(C_SHORT)'};
 
 
 
@@ -108,9 +114,9 @@
     my @unit;
     my $unitcnt=0;
     my $date = localtime();
-    my $preamble = 
+    my $preamble =
 "!===================================================
-! DO NOT EDIT THIS FILE, it was generated using $0 
+! DO NOT EDIT THIS FILE, it was generated using $0
 ! Any changes you make to this file may be lost
 !===================================================\n";
     my @output ;
@@ -134,7 +140,7 @@
 	$itypeflag=1 if($line =~ /TYPEINT/);
 	$itypeflag=1 if($line =~ /TYPELONG/);
 
-	
+
         if($contains==0){
 	    if($line=~/\s*!\s*DIMS\s+[\d,]+!*/){
 		$dimmodifier=$line;
@@ -186,12 +192,12 @@
 	    if(defined $dimmodifier){
 		$line = $dimmodifier.$line;
 		undef $dimmodifier;
-	    } 
+	    }
 	    if(defined $typemodifier){
 		$line = $typemodifier.$line;
 		undef $typemodifier;
-	    } 
-	    
+	    }
+
 	    push(@output, buildout($line));
             if(($line =~ /^\s*contains\s*!*/i && ! $in_type_block) or
                ($line =~ /^\s*!\s*Not a module/i)){
@@ -218,7 +224,7 @@
                 }
 	    }
 
-	       
+
 	    push(@{$unit[$unitcnt]},$line);
 	    if ($line=~/^\s*interface/i) {
 		$block_type="interface";
@@ -242,10 +248,10 @@
 	if(defined($unit[$i])){
 		my $func = join('',@{$unit[$i]});
 		push(@output, buildout($func));
-	}	
+	}
     }
     push(@output,@{$unit[$#unit]}) if($unitcnt==$#unit);
-    push(@output, $end);	
+    push(@output, $end);
     if($itypeflag==1){
 	my $str;
 	$str.="#include \"dtypes.h\"\n";
@@ -283,9 +289,9 @@ sub build_repeatstr{
 
 sub writedtypes{
     open(F,">dtypes.h");
-    print F 
+    print F
 "#define TYPETEXT 100
-#define TYPEREAL 101	
+#define TYPEREAL 101
 #define TYPEDOUBLE 102
 #define TYPEINT 103
 #define TYPELONG 104
@@ -296,7 +302,7 @@ sub writedtypes{
 
 sub buildout{
     my ($func) = @_;
-    
+
     my $outstr;
     my(@ldims, @ltypes);
 
@@ -306,12 +312,12 @@ sub buildout{
 	@ldims = @dims;
     }
     if($func=~/\s*!\s*TYPE\s+([^!\s]+)\s*/){
-	@ltypes = split(/,/,$1);	
+	@ltypes = split(/,/,$1);
 #	print ">$func<>@ltypes<\n";
     }else{
 	@ltypes = @types;
     }
-    
+
 
     if(($func =~ /{TYPE}/ && $func =~ /{DIMS}/) ){
 	my ($type, $dims);
@@ -330,7 +336,7 @@ sub buildout{
 		}
 
 		my $repeatstr = build_repeatstr($dims);
-		
+
 		my $str = $func;
 		$str =~ s/{TYPE}/$type/g;
 		$str =~ s/{VTYPE}/$vtype->{$type}/g;
@@ -358,9 +364,9 @@ sub buildout{
 	    }else{
 		$dimstr='';
 	    }
-		
+
 	    my $repeatstr = build_repeatstr($dims);
-		
+
 	    my $str = $func;
 	    $str =~ s/{DIMS}/$dims/g;
 	    $str =~ s/{DIMSTR}/$dimstr/g;

diff --git a/set_flags.am b/set_flags.am
@@ -9,7 +9,7 @@ AM_CPPFLAGS = -I$(top_srcdir)/src/flib -D_NETCDF
 
 # Is the user building with pnetcdf?
 if BUILD_PNETCDF
-AM_CPPFLAGS += -D_PETCDF
+AM_CPPFLAGS += -D_PNETCDF
 endif
 
 # Is the user building with netCDF-4 parallel I/O?

diff --git a/src/clib/pio_darray.c b/src/clib/pio_darray.c
@@ -988,8 +988,19 @@ PIOc_read_darray(int ncid, int varid, int ioid, PIO_Offset arraylen,
     {
         if (!(tmparray = malloc(iodesc->piotype_size * iodesc->maplen)))
             return pio_err(ios, NULL, PIO_ENOMEM, __FILE__, __LINE__);
-        for (int m = 0; m < iodesc->maplen; m++)
+	if(iodesc->piotype_size == 1){
+	  for (int m = 0; m < iodesc->maplen; m++)
+            ((signed char *)array)[m] = -1;
+	}else if(iodesc->piotype_size == 2){
+	  for (int m = 0; m < iodesc->maplen; m++)
+            ((short *)array)[m] = -1;
+	}else if(iodesc->piotype_size == 4){
+	  for (int m = 0; m < iodesc->maplen; m++)
             ((int *)array)[m] = -1;
+	}else if(iodesc->piotype_size == 8){
+	  for (int m = 0; m < iodesc->maplen; m++)
+            ((double *)array)[m] = -1;
+	}
     }
     else
         tmparray = array;

diff --git a/src/flib/CMakeLists.txt b/src/flib/CMakeLists.txt
@@ -116,7 +116,7 @@ else ()
   ExternalProject_Add (genf90
     PREFIX ${CMAKE_CURRENT_BINARY_DIR}/genf90
     GIT_REPOSITORY https://github.com/PARALLELIO/genf90
-    GIT_TAG genf90_140121
+    GIT_TAG genf90_200608
     UPDATE_COMMAND ""
     CONFIGURE_COMMAND ""
     BUILD_COMMAND ""

diff --git a/src/flib/Makefile.am b/src/flib/Makefile.am
@@ -7,7 +7,7 @@
 # The library we are building.
 lib_LTLIBRARIES = libpiof.la
 
-AM_CPPFLAGS = -D_NETCDF -D_NETCDF4 -D_PETCDF
+AM_CPPFLAGS = -D_NETCDF -D_NETCDF4 -D_PNETCDF
 
 # These linker flags specify libtool version info.
 # See http://www.gnu.org/software/libtool/manual/libtool.html#Libtool-versioning

diff --git a/src/flib/pio.F90 b/src/flib/pio.F90
@@ -1,5 +1,5 @@
 !>
-!! @file 
+!! @file
 !! User interface Module for PIO, this is the only file a user program should 'use'.
 !! @author Jim Edwards
 !<
@@ -33,7 +33,7 @@ module pio
        pio_rearr_opt_t, pio_rearr_comm_fc_opt_t, pio_rearr_comm_fc_2d_enable,&
        pio_rearr_comm_fc_1d_comp2io, pio_rearr_comm_fc_1d_io2comp,&
        pio_rearr_comm_fc_2d_disable, pio_rearr_comm_unlimited_pend_req,&
-       pio_rearr_comm_p2p, pio_rearr_comm_coll,&
+       pio_rearr_comm_p2p, pio_rearr_comm_coll, pio_short, &
        pio_int, pio_real, pio_double, pio_noerr, iotype_netcdf, &
        iotype_pnetcdf,  pio_iotype_netcdf4p, pio_iotype_netcdf4c, &
        pio_iotype_pnetcdf,pio_iotype_netcdf, &
@@ -45,7 +45,7 @@ module pio
        pio_64bit_offset, pio_64bit_data, &
        pio_internal_error, pio_bcast_error, pio_return_error, pio_default
 
-  use piodarray, only : pio_read_darray, pio_write_darray, pio_set_buffer_size_limit  
+  use piodarray, only : pio_read_darray, pio_write_darray, pio_set_buffer_size_limit
 
   use pio_nf, only:        &
        PIO_enddef,            &
@@ -124,11 +124,11 @@ integer(C_INT) function PIOc_iam_iotask(iosysid, iotask) &
          logical(C_BOOL), intent(out) :: iotask
        end function PIOc_iam_iotask
     end interface
-    
+
     ierr = PIOc_iam_iotask(iosystem%iosysid, ctask)
     task = ctask
   end function pio_iam_iotask
-  
+
   !>
   !! Integer function returns rank of IO task.
   !! @author Jim Edwards
@@ -144,7 +144,7 @@ integer(C_INT) function PIOc_iotask_rank(iosysid, rank) &
          integer(C_INT), intent(out) :: rank
        end function PIOc_iotask_rank
     end interface
-    
+
     ierr = PIOc_iotask_rank(iosystem%iosysid, rank)
   end function pio_iotask_rank
 
@@ -172,4 +172,3 @@ end function PIOc_iosystem_is_active
   end subroutine pio_iosystem_is_active
 
 end module pio
-
diff --git a/src/flib/pio_kinds.F90 b/src/flib/pio_kinds.F90
@@ -22,12 +22,13 @@ module pio_kinds
       char_len  = 360                    ,& !< char len
       log_kind  = kind(.true.)           ,& !< logical kind
       int_kind  = kind(1)                ,& !< int kind
+      i2        = selected_int_kind(4)   ,& !< i2 (short) kind
       i4        = selected_int_kind(6)   ,& !< i4 kind
       i8        = selected_int_kind(13)  ,& !< i8 kind
       r4        = selected_real_kind(6)  ,& !< r4 kind
       r8        = selected_real_kind(13)    !< r8 kind
 !
-!  MPI defines MPI_OFFSET_KIND as the byte size of the 
+!  MPI defines MPI_OFFSET_KIND as the byte size of the
 !  type, which is not nessasarily the type kind
 !
 !> Byte size of the MPI_OFFSET type.

diff --git a/src/flib/pio_types.F90 b/src/flib/pio_types.F90
@@ -35,9 +35,10 @@
 !!
 !! @defgroup PIO_kinds PIO Fortran Type Kinds
 !! PIO supports different kinds of Fortran types.
-!!  - PIO_double : 8-byte reals or double precision
+!!  - PIO_doauble : 8-byte reals or double precision
 !!  - PIO_real : 4-byte reals
 !!  - PIO_int :  4-byte integers
+!!  - PIO_short : 2-byte integers
 !!  - PIO_char : character
 
 module pio_types
@@ -136,6 +137,7 @@ module pio_types
   integer, public, parameter :: PIO_double = nf_double       !< double type
   integer, public, parameter :: PIO_real   = nf_real         !< real type
   integer, public, parameter :: PIO_int    = nf_int          !< int type
+  integer, public, parameter :: PIO_short  = nf_short        !< short int type
   integer, public, parameter :: PIO_char   = nf_char         !< char type
   integer, public, parameter :: PIO_noerr  = nf_noerr        !< no error
   integer, public, parameter :: PIO_WRITE  = nf_write        !< read-write