S.Riette 15/11/2016 : Change INQ1
[MNH-git_open_source-lfs.git] / bin / make_intfbl_f77.pl
1 #!/usr/bin/perl
2 #SURFEX_LIC Copyright 1994-2014 Meteo-France 
3 #SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
4 #SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
5 #SURFEX_LIC for details. version 1.
6
7 use strict;
8 use warnings;
9 use Fortran77_stuff_interface;
10 use Data::Dumper;
11
12 $Data::Dumper::Indent = 1;
13 {
14   my (@files);
15   (@files) = @ARGV;
16   &setup_parse();
17   my $locintfbldir=$ENV{LOC_INTFBDIR} or die "LOC_INTFBDIR not defined ";
18   my $intfbldir=$ENV{INTFBDIR} or die "INTFBDIR not defined ";
19   our $study_called;
20   for (@files) {
21     my (@interface_block);
22     my (@line_hash);
23     chomp;
24  # Read in lines from file
25     my $fname = $_;
26     print "Working on file $fname \n";
27     my @lines = &readfile($fname);
28     my @statements=();
29     my %prog_info=();
30     &expcont(\@lines,\@statements);
31     $study_called=0;
32     &study(\@statements,\%prog_info);
33     print Dumper(\%prog_info);
34     unless($prog_info{is_module}) {
35       &create_interface_block(\@statements,\@interface_block);
36       &cont_lines(\@interface_block,\@lines,\@line_hash);
37       my $int_block_fname=$fname;
38       $int_block_fname=~s/\.F90/.intfb.h/;
39       $int_block_fname=~s#.*/(.+)$#$1#;
40       my $ofname=$intfbldir.'/'.$int_block_fname;
41       my $remake=1;
42       if ( -f $ofname ) {
43         my @oldlines=&readfile($ofname);
44         $remake=0 if(&eq_array(\@oldlines, \@lines));
45         print "INTERFACE BLOCK $int_block_fname UNCHANGED \n" unless ($remake);
46       }
47       if($remake) {
48         print "WRITE INTERFACE BLOCK $int_block_fname \n";
49         $int_block_fname=$locintfbldir.'/modi_'.$int_block_fname;
50         #$int_block_fname=$locintfbldir.'/_'.$int_block_fname;
51         print "$int_block_fname \n";
52         &writefile($int_block_fname,\@lines);
53       }
54     }
55   }
56 }
57 sub eq_array {
58     my ($ra, $rb) = @_;
59     return 0 unless $#$ra == $#$rb;
60     for my $i (0..$#$ra) {
61         return 0 unless $ra->[$i] eq $rb->[$i];
62     }
63     return 1;
64 }
65