<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/env perl
#
#= Fortran 90/95 dependency lister
#
$AUTHORS="Yasuhiro MORIKAWA";
$VERSION='$Id: f90depend.pl,v 1.2 2009/07/12 01:16:12 morikawa Exp $';
$COPYRIGHT='Copyright (C) GFD Dennou Club, 2008. All rights reserved.';
#
# 蠑墓焚縺ｨ縺励※蜿励￠蜿悶ｋ Fortran 90/95 繝輔ぃ繧､繝ｫ蜀�� use 譁�♀繧医�
# module 譁�ｒ隗｣譫舌＠, 萓晏ｭ倬未菫ゅｒ險倥＠縺溘ヵ繧｡繧､繝ｫ繧� Makefile 蠖｢蠑�
# 縺ｧ讓呎ｺ門�蜉帙↓譖ｸ縺榊�縺�.
#
# Ruby 縺後う繝ｳ繧ｹ繝医�繝ｫ縺輔ｌ縺ｦ縺�↑縺�腸蠅�〒縺ｮ
# f90depend.rb 縺ｮ莉｣譖ｿ繝��繝ｫ
# (繧ｽ繝ｼ繧ｹ縺ｮ讀懃ｴ｢縺� Ruby 縺ｫ豈斐∋縺ｦ逕倥＞)
#

######################################################################
# Settings

# End Settings
######################################################################

sub f90dependhelp() {
    print STDOUT &lt;&lt;EOF;

  Usage: 
    f90depend.pl [OPTIONS] f90_file [f90_file [f90_file] .. ]

  Options
       -v:       verbose mode
       -q:       quiet mode
       -h:       show help messages

EOF

  &amp;f90dependprintversion;
}

sub f90dependprintversion() {
    print STDOUT &lt;&lt;EOF;
  f90depend.pl Version ${VERSION}

  ${AUTHORS}
    ${COPYRIGHT}

EOF
}

#
# 驥崎､�☆繧矩��岼繧貞炎髯､
#
sub uniqArray{
    my $array = shift;
    my $num = 0;
    my @uniqary = ();
    
    foreach my $af ( @$array ) {
        $new = 1;
        foreach (@uniqary) {
	    if ( $af eq $_ ) {
		$new = 0;
	    }
        }
        if ( $new ) {
	    $uniqary[$num] = $af;
	    $num = $num + 1;
        }
    }

    return @uniqary;
}

#
# 蠑墓焚蜿門ｾ�
#
$verbose = 0;
$num = 0;


while ( $#ARGV &gt; -1 ) {
    $argv0 = shift(@ARGV);
    if ( $argv0 =~ /^\-v/ ){
	$verbose = 1;
    } elsif ( $argv0 =~ /^\-q/ ) {
	$verbose = 0;
    } elsif ( $argv0 =~ /^\-h/ ) {
	&amp;f90dependhelp;
	exit 1
    } elsif ( $argv0 =~ /^\-/ ) {
	print STDERR "Error: \"$argv0\" is invalid option.\n";
	exit 1;
    } else {
	@ArgvFiles[$num] = $argv0;
	$num = $num + 1;
	if ( not -f $argv0 ) {
	    print STDERR "\n  Error: \"$argv0\" is not found or not a regular file.\n\n";
	    exit 1;
	}
    }
}

#
# 蠑墓焚縺� 2 縺､莉･荳翫↑縺��ｴ蜷医�繝倥Ν繝苓｡ｨ遉ｺ
#
if ( $#ArgvFiles &lt; 1 ) {
    f90dependhelp;
    exit 1;
}

#
# 驥崎､�☆繧九ヵ繧｡繧､繝ｫ繧貞炎髯､
#
@Files = uniqArray(\@ArgvFiles);

if ( $verbose ) {
    print "#--- File list --- \n";
    foreach (@Files) {
	print "#  $_\n";
    }
}

##
## 蠑墓焚縺� 2 縺､莉･荳翫↑縺��ｴ蜷医�繝倥Ν繝苓｡ｨ遉ｺ (謾ｹ繧√※)
##
if ( $#Files &lt; 1 ) {
    f90dependhelp;
    exit 1;
}

#
# 蜷� f90 繝輔ぃ繧､繝ｫ隱ｭ縺ｿ霎ｼ縺ｿ USE 譁�､懃ｴ｢
#
$num=0;
foreach $file (@Files) {
    open( F90FILE, $file ) || die "\"$file\" can not read.";
    @textary = &lt;F90FILE&gt;;
    close(F90FILE);
    @FileContent[$num] = join('', @textary);
    $num = $num + 1;
}

$num = 0;
if ( $verbose ) {
    print "#--- Cont list --- \n";
    foreach $cont (@FileContent) {
	@lines = split( /\n/, $cont );
	print "#  $Files[$num]: $#lines lines \n";
#	print $cont;
#	print "\n";
	$num = $num + 1;
    }
}

#
# 蜷� f90 繝輔ぃ繧､繝ｫ縺九ｉ USE 譁�､懃ｴ｢
#
$num = 0;
foreach $cont (@FileContent) {
    @lines = split( /\n/, $cont );
    @uses = ();
    foreach $line (@lines) {
	if ( $line =~ /^\s*USE\s+/i ) {
	    $line =~ s/^.*USE\s+//i;
	    $line =~ s/\,.*$//i;
	    $line =~ s/\!.*$//i;
	    $line =~ s/\s*$//i;

	    $new = 1;
	    foreach $alr (@uses) {
		if ( $alr eq $line ) {
		    $new = 0;
		}
	    }
	    if ( $new ) {
		push (@uses, $line);
	    }
	}
    }
    $UseList[$num] = join(" ", @uses);
    $num = $num + 1;
}

$num = 0;
if ( $verbose ) {
    print "#--- Uses list --- \n";
    foreach (@Files) {
	print "#  $_: $UseList[$num] \n";
	$num = $num + 1;
    }
}


#
# 蜷� f90 繝輔ぃ繧､繝ｫ縺九ｉ MODULE 譁�､懃ｴ｢
#
$num = 0;
foreach $cont (@FileContent) {
    @lines = split( /\n/, $cont );
    @modules = ();
    foreach $line (@lines) {
	if ( $line =~ /^\s*MODULE\s+/i ) {
	    next if ( $line =~ /^\s*MODULE\s+PROCEDURE\s+/i );
	    $line =~ s/^.*MODULE\s+//i;
	    $line =~ s/\!.*$//i;
	    $line =~ s/\s*$//i;

	    $new = 1;
	    foreach $alr (@modules) {
		if ( $alr eq $line ) {
		    $new = 0;
		}
	    }
	    if ( $new ) {
		push (@modules, $line);
	    }
	}
    }
    $ModuleList[$num] = join(" ", @modules);
    $num = $num + 1;
}

$num = 0;
if ( $verbose ) {
    print "#--- Modules list --- \n";
    foreach (@Files) {
	print "#  $_: $ModuleList[$num] \n";
	$num = $num + 1;
    }
}


#
# 蜷� f90 繝輔ぃ繧､繝ｫ縺九ｉ繝｡繧､繝ｳ繝輔ぃ繧､繝ｫ讀懃ｴ｢
#
$num = 0;
foreach $cont (@FileContent) {
    @lines = split( /\n/, $cont );
    @mains = ();
    $MainList[$num] = "";
    foreach $line (@lines) {
	if ( $line =~ /^\s*PROGRAM\s+/i ) {
	    $file = $Files[$num];
	    $file =~ s/\.f9[05]$//i;
	    push (@mains, $file);
	}
    }
    $MainList[$num] = join(" ", @mains);
    $num = $num + 1;
}

$num = 0;
if ( $verbose ) {
    print "#--- Mains list --- \n";
    foreach (@Files) {
	print "#  $_: $MainList[$num] \n";
	$num = $num + 1;
    }
}

#
# 繧ｪ繝悶ず繧ｧ繧ｯ繝医ヵ繧｡繧､繝ｫ蜷阪�菴懈�
#
$num = 0;
foreach (@Files) {
    @ObjFiles[$num] = $_;
    @ObjFiles[$num] =~ s/\.f9[05]$/.o/i;
    $num = $num + 1;
}

#
# USE 繧ｨ繝ｳ繝医Μ諠��ｱ繧偵ヵ繧｡繧､繝ｫ蜷阪↓螟画鋤 (蟄伜惠縺励↑縺�ｂ縺ｮ縺ｯ蜑企勁)
#
for ($num = 0; $num &lt;= $#Files; $num++) {
    $DependList[$num] = '';
    @uses = split( / /, $UseList[$num] );
    UL: foreach $ul (@uses) {
	next if ( $ul eq $ModuleList[$num] );
	$fnum = 0;
	foreach $file (@Files) {
	    @modules = split( / /, $ModuleList[$fnum] );
	    foreach $ml (@modules) {
		if ( $ul eq $ml ) {
		    $DependList[$num] = $DependList[$num] . ' ' . $ObjFiles[$fnum];
		    next UL;
		}
	    }
	    $fnum = $fnum + 1;
	}
    }
}

$num = 0;
if ( $verbose ) {
    print "#--- Depend list --- \n";
    foreach (@Files) {
	print "#  $_: \n";
	print "#    $DependList[$num] \n";
	$num = $num + 1;
    }
}



#
# 荳ｻ繝励Ο繧ｰ繝ｩ繝�縺ｫ髢｢縺吶ｋ萓晏ｭ倥Μ繧ｹ繝井ｽ懈�
#

for ($num = 0; $num &lt;= $#Files; $num++) {
    next if ( $MainList[$num] eq '' );
    $MainDepList[$num] = $DependList[$num];
    $PrevMainDepList = $MainDepList[$num];

    while ( 1 ) {
	@depends = split( / /, $MainDepList[$num] );
	foreach $dl (@depends) {
	    $fnum = 0;
	    foreach $ob (@ObjFiles) {
		if ( $dl eq $ob ) {
		    $MainDepList[$num] =
			$MainDepList[$num] . ' ' . $ob . ' ' . $DependList[$fnum]
		    }
		$fnum = $fnum + 1;
	    }
	}
	@mdepl = split( / /, $MainDepList[$num] );
	@mdepl = uniqArray(\@mdepl);
	@mdepl = sort @mdepl;
	$MainDepList[$num] = join( " ", @mdepl );

	if ( $PrevMainDepList eq $MainDepList[$num] ) {
	    last;
	} else {
	    $PrevMainDepList = $MainDepList[$num];
	}
    }

}

$num = 0;
if ( $verbose ) {
    print "#--- MainDep list --- \n";
    foreach (@Files) {
	print "#  $_: \n";
	print "#    $MainDepList[$num] \n";
	$num = $num + 1;
    }
}

#
# 蜃ｺ蜉�
#
for ($num = 0; $num &lt;= $#Files; $num++) {
    print "$ObjFiles[$num]: $DependList[$num]\n"
}

for ($num = 0; $num &lt;= $#Files; $num++) {
    next if ( $MainList[$num] eq '' );
    print "$MainList[$num]: $MainDepList[$num]\n"
}
</pre></body></html>