buildiface

fortran并行计算包

    }
}

#
# We allow a routine to specify an alternate weak decl by name
sub set_weak_decl {
    my $name = $_[0];
    my $decl = $_[1];
    my $rtype = $_[2];
    $name = lc($name);
    $altweak{$name}      = $decl;
    $altweakrtype{$name} = $rtype;
}
sub print_weak_decl {
    my $OUTFD = $_[0];
    my $name  = $_[1];
    my $args  = $_[2];
    my $lcname = $_[3];

    my $basename = lc($name);
    $basename =~ s/_*$//;
    if (defined($altweak{$basename})) {
	print $OUTFD "extern FORT_DLL_SPEC $altweakrtype{$basename} FORT_CALL $name($altweak{$basename});\n";
    }
    else {
	print $OUTFD "extern FORT_DLL_SPEC $returnType FORT_CALL $name";
	&print_args( $OUTFD, $args, 1, $lcname );
	print $OUTFD ";\n";
    }
}
#
# --------------------------------------------------------------------------
# Special processing
#
# Each parameter can be processed by a routine, with the suffix controlling
# the routine invoked for each step.  Roughly, these are:
# 
# void foo( MPI_Fint *v1, etc )
# {
# /* Special declarations needed for the variables */
# <name>_<direction>_decl( <argnum> )
# /* Special processing need for in variables */
# <name>_ftoc( <argnum> )
# /* Call the function.  Replace special arguments with the output from */
# <name>_<direction>_arg( <argnum> )
# /* Special post call processing (for out variables) */
# <name>_ctof( l$count, v$count ) /* local (C) variable name, fortran var name */
# 
# Special case: For parameters that are arrays, the size of the
# array is in $Array_size.
# 
# 
# --------------------------------------------------------------------------
# Buffer pointers
sub bufptr_ftoc {
    my $count = $_[0];
}
sub bufptr_in_decl {
    my $count = $_[0];
}
sub bufptr_in_arg {
    my $count = $_[0];
    if ($do_bufptr) {
	print $OUTFD "MPIR_F_PTR(v$count)";
    }
    else {
	print $OUTFD "v$count";
    }
}
# bufptr_ctof( cvar, fvar )
sub bufptr_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
}
# --------------------------------------------------------------------------
# MPI_IN_PLACE buffer pointers
sub inplace_ftoc {
    my $count = $_[0];
    &specialInitStatement( $OUTFD );
    print $OUTFD "    if (v$count == MPIR_F_MPI_IN_PLACE) v$count = MPI_IN_PLACE;\n";
}
sub inplace_in_decl {
    my $count = $_[0];
}
sub inplace_in_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}
# inplace_ctof( cvar, fvar )
sub inplace_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
}
# --------------------------------------------------------------------------
# Logical variables
sub logical_ftoc {
    my $count = $_[0];
    print $OUTFD "    l$count = MPIR_FROM_FLOG(*v$count);\n";
}
sub logical_in_decl {
    my $count = $_[0];
    if ($do_logical) {
	print $OUTFD "    int l$count;\n";
    }
}
sub logical_in_arg {
    my $count = $_[0];
    if ($do_logical) {
	print $OUTFD "l$count";
    }
    else {
	print $OUTFD "v$count";
    }
}
# logical_ctof( cvar, fvar )
sub logical_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    if ($do_logical) {
	print $OUTFD "    *$outvar = MPIR_TO_FLOG($coutvar);\n";
    }
}
sub logical_out_decl {
    my $count = $_[0];
    if ($do_logical) {
	print $OUTFD "    int l$count;\n";
    }
}
sub logical_out_arg {
    my $count = $_[0];
    if ($do_logical) {
	print $OUTFD "\&l$count";
    }
    else {
	print $OUTFD "v$count";
    }
}
# --------------------------------------------------------------------------
#
# Logical variables, but for an array.  
# Array args can use the global $Array_size and $Array_typedef if necessary
sub logical_array_ftoc {
    print $OUTFD "\
    {int li; 
     for (li=0; li<$Array_size; li++) {
        l$count\[li\] = MPIR_FROM_FLOG(v$count\[li\]);
     }
    }
";
}
sub logical_array_in_decl {
    my $count = $_[0];
    print $OUTFD "    int *l$count = (int *)$malloc($Array_size * sizeof(int));\n";
    $clean_up .= "    $free( l$count );\n";
}
sub logical_array_in_arg {
    my $count = $_[0];
    print $OUTFD "l$count";
}

sub logical_array_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    print $OUTFD "\
    {int li;
     for (li=0; li<$Array_size; li++) {
        $outvar\[li\] = MPIR_TO_FLOG($outvar\[li\]);
     }
    }
";
}
sub logical_array_out_decl {
}
sub logical_array_out_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}
# --------------------------------------------------------------------------
# 
# Index variables.
# Index variables are not optional, since the values of the variable
# are changed.
sub index_ftoc {
    my $count = $_[0];
}
sub index_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    print $OUTFD "    *$outvar = (MPI_Fint)$coutvar;\n";
    print $OUTFD "    if ($coutvar >= 0) *$outvar = *$outvar + 1;\n";
}
sub index_out_decl {
    my $count = $_[0];
    print $OUTFD "    int l$count;\n";
}
sub index_out_arg {
    my $count = $_[0];
    print $OUTFD " \&l$count";
}
#
# Index variables, but for an array.  
# Array args can use the global $Array_size and $Array_typedef if necessary
sub index_array_ftoc {
    my $count = $_[0];
}
sub index_array_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    print $OUTFD "\
    {int li;
     for (li=0; li<$Array_size; li++) {
        if ($outvar\[li\] >= 0) $outvar\[li\] += 1;
     }
    }
"
}
sub index_array_out_decl {
}
sub index_array_out_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}
# --------------------------------------------------------------------------
#
# Address and attribute handling
# Note that this construction can lead to compiler warnings on systems
# where an address is larger than an MPI_Fint.  This is correct; these
# routines are for the MPI-1 routines that use an MPI_Fint where the 
# C code uses a void * (MPI_Aint in MPI-2).  
# A possible extension is to provide an error warning (much as 
# MPI_Address does) when the attribute value loses bits when assigned into
# the MPI_Fint.
#in:addrint
#out:attrint:4
sub addrint_ftoc {
    my $count = $_[0];
}
sub addrint_in_decl {
}
sub addrint_in_arg {
    my $count = $_[0];
    print $OUTFD "(void *)(MPI_Aint)((int)*(int *)v$count)";
}

sub attrint_ctof {
    my $fvar = $_[0];
    my $cvar = $_[1];
    my $flagarg = 4; # get from option
    # The double cast of attr$cvar first to MPI_Aint and then to MPI_Fint
    # keeps some compilers happy on 64-bit platforms
    print $OUTFD "
    if ((int)*ierr || !l$flagarg) {
        *(MPI_Fint*)$cvar = 0;
    }
    else {
        *(MPI_Fint*)$cvar = (MPI_Fint)(MPI_Aint)attr$cvar;
    }\n";
}

sub attrint_out_decl {
    my $count = $_[0];
    print $OUTFD "    void *attrv$count;\n";
}

sub attrint_out_arg {
    my $count = $_[0];
    print $OUTFD "&attrv$count";
}
# --------------------------------------------------------------------------
# Address and attribute handling
# This version of attrint uses Aints instead of ints, and is appropriate
# for the MPI-2 attribute caching functions
#in:addraint
#out:attraint:4
sub addraint_ftoc {
    my $count = $_[0];
}
sub addraint_in_decl {
}
sub addraint_in_arg {
    my $count = $_[0];
    print $OUTFD "(void *)(MPI_Aint)((MPI_Aint)*(MPI_Aint *)v$count)";
}

sub attraint_ctof {
    my $fvar = $_[0];
    my $cvar = $_[1];
    my $flagarg = 4; # get from option
    print $OUTFD "
    if ((int)*ierr || !l$flagarg) {
        *(MPI_Aint*)$cvar = 0;
    }
    else {
        *(MPI_Aint*)$cvar = (MPI_Aint)attr$cvar;
    }\n";
}

sub attraint_out_decl {
    my $count = $_[0];
    print $OUTFD "    void *attrv$count;\n";
}

sub attraint_out_arg {
    my $count = $_[0];
    print $OUTFD "&attrv$count";
}
# --------------------------------------------------------------------------
#
# Buffer Address output handling (Buffer_detach)
#out:bufaddr
sub bufaddr_ftoc {
}
sub bufaddr_out_decl {
    my $count =$_[0];
    print $OUTFD "    void *t$count = v$count;\n";
}
sub bufaddr_out_arg {
    my $count = $_[0];
    print $OUTFD "&t$count";
}

sub bufaddr_ctof {
    my $fvar = $_[0];
    my $cvar = $_[1];
}
# --------------------------------------------------------------------------
# 
# Handle MPI_STATUS_IGNORE and MPI_STATUSES_IGNORE
sub status_ftoc {
    my $count = $_[0];
    # Cast MPI_STATUS_IGNORE back to an MPI_Fint (we'll re-cast it back
    # to (MPI_Status *) in the call to the C version of the routine)
    &specialInitStatement( $OUTFD );
    print $OUTFD "\
    if (v$count == MPI_F_STATUS_IGNORE) { v$count = (MPI_Fint*)MPI_STATUS_IGNORE; }\n";
}
sub status_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
}
sub status_in_decl {
    my $count = $_[0];
}
sub status_in_arg {
    my $count = $_[0];
    print $OUTFD "(MPI_Status *)v$count";
}
# --------------------------------------------------------------------------
# 
# Handle MPI_ERRCODES_IGNORE
sub errcodesignore_ftoc {
    my $count = $_[0];
    &specialInitStatement( $OUTFD );
    print $OUTFD "\
    if (v$count == MPI_F_ERRCODES_IGNORE) { v$count = MPI_ERRCODES_IGNORE; }\n";
}
sub errcodesignore_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
}
sub errcodesignore_in_decl {
    my $count = $_[0];
}
sub errcodesignore_in_arg {
    my $count = $_[0];
    print $OUTFD "(int *)v$count";
}
# --------------------------------------------------------------------------
#
# Index variables, but for an array.  
# Array args can use the global $Array_size and $Array_typedef if necessary
sub status_array_ftoc {
    my $count = $_[0];
    &specialInitStatement( $OUTFD );
    print $OUTFD "\
    if (v$count == MPI_F_STATUSES_IGNORE) { v$count = (MPI_Fint *)MPI_STATUSES_IGNORE; }\n";
}
sub status_array_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
}
sub status_array_in_decl {
}