Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Short type in fortran #1653

Merged
merged 9 commits into from
Jun 9, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 36 additions & 30 deletions scripts/genf90.pl
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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
Expand All @@ -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)'};



Expand Down Expand Up @@ -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 ;
Expand All @@ -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;
Expand Down Expand Up @@ -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)){
Expand All @@ -218,7 +224,7 @@
}
}


push(@{$unit[$unitcnt]},$line);
if ($line=~/^\s*interface/i) {
$block_type="interface";
Expand All @@ -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";
Expand Down Expand Up @@ -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
Expand All @@ -296,7 +302,7 @@ sub writedtypes{

sub buildout{
my ($func) = @_;

my $outstr;
my(@ldims, @ltypes);

Expand All @@ -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);
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
2 changes: 1 addition & 1 deletion set_flags.am
Original file line number Diff line number Diff line change
Expand Up @@ -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?
Expand Down
13 changes: 12 additions & 1 deletion src/clib/pio_darray.c
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down
2 changes: 1 addition & 1 deletion src/flib/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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 ""
Expand Down
2 changes: 1 addition & 1 deletion src/flib/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
13 changes: 6 additions & 7 deletions src/flib/pio.F90
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
!>
!! @file
!! @file
!! User interface Module for PIO, this is the only file a user program should 'use'.
!! @author Jim Edwards
!<
Expand Down Expand Up @@ -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, &
Expand All @@ -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, &
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down Expand Up @@ -172,4 +172,3 @@ end function PIOc_iosystem_is_active
end subroutine pio_iosystem_is_active

end module pio

3 changes: 2 additions & 1 deletion src/flib/pio_kinds.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
4 changes: 3 additions & 1 deletion src/flib/pio_types.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading