#!/bin/ksh
#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
#MNH_LIC for details. version 1.
#set -x
# HP-UX 10
unset LANG
#-------------- 1.a environment variables
#. init_env_mnh
if [ '?' = "$1" ] ;then
cat << 'eoinfo' >>$OUTPUT
***********************************************************************
************************ spl ******************************************
***********************************************************************

purpose : spl splits a free form fortran 90 source file

synopsis: spl inputfile

example : spl solver.f90

eoinfo
exit
fi
#FOR_MANUAL
#.TH spl 1 "February 7th 1995"
#.SH PURPOSE
#.B spl
#splits a free form fortran 90 source file into its elementary routines, one per
#file
#.SH METHOD
#.B spl
#uses 
#.B awk
#to scan and treat the input file line per line. It is the Meso-NH fortran 90
#counterpart to
#.B fsplit
# Files may be written in mixed uppercase/lowercase characters and fortran code may
#begin in any column. A routine "SUBROUTINE ATHOS(a,b)" will be stored in file
#athos.f90 . The routine may have INTERFACEs and CONTAINS statements. The same
#holds for "MODULE PORTOS" which will be stored in portos.f90 . Note that
#a routine like "ARAMIS$n(x,y)" will be copied into aramisn.f90 .
#
# At the moment, the limitations for
#.B spl
#are the followings:
#
# - each fortran unit must begin with "STATEMENT something" and end
#   with "END STATEMENT something" or "END STATEMENT" or "END". The 
#   latter case allows
#.B spl
#to work on fixed form fortran 77 code. 
#   Example:
#       SUBROUTINE DARTAGNAN
#       (...code...)
#       END subroutine
#   ---> is ok
#       SUBROUTINE DARTAGNAN
#       (...code...)
#       END
#   ---> is ok too
#
# - Beginnings and ends of fortran units must be specified on one
#   single line:
#       SUBROUTINE DARTAGNAN
#       (...code...)
#       END subroutine
#   ---> is ok
#       SUBROUTINE DARTAGNAN
#       (...code...)
#       print*,variable ; return ; END
#   ---> will fail
#
#.SH SYNOPSIS
#.B spl inputfile
#
#.SH "SEE ALSO"
#.B awk
#
#.SH AUTHORS
#C. Fischer 07/02/95
#
#modified by C. Fischer to split fortran 77 (26/04/95)
#modified by C. Fischer to correct a bug PROGRAM-CONTAINS (16/02/96)
#
#.SH COPYRIGHT
#
#Copyright (c) 1995 Meteo-France/Univ. P. Sabatier
#FOR_MANUAL
if [ "$DEBUGSCRIPT" = 'ON' ] ;then
     set -x
fi
#--------------- 1.b arguments
if [ $# -lt 1 ] ;then
   echo "no input file specified">>$OUTPUT
   exit 1
fi
#--------------- 1.c local variables
FILE=$1
#--------------- 2. input file is saved to prevent a possible conflict
cp $FILE /tmp/splfile.${USER}.$$
SAVE=`basename $FILE .f90`
REST=${SAVE}.f90$$
mv $FILE $REST
#--------------- 3. this is the heart of it !
# a. change all characters to uppercase
# b. test if a PROGRAM file begins + begin if test is true
# c. test if INTERFACE is encountered: this code is ignored until END
# d. test if no INTERFACE and no MODULE, then:
#    d.1. test if CONTAINS: a flag is set if test true
#    d.2. if no CONTAINS: test if SUBROUTINE or FUNCTION begins + begin if true
#    d.3. if CONTAINS: a counter is set
#    d.4. test if MODULE: begin of a MODULE file + flag if test true
#    d.5. test if already MODULE: a counter is set
# e. test if END; a file is ended when:
#    e.1. end PROGRAM
#    e.2. no CONTAINS (counter=0) and end SUBROUTINE or end FUNCTION
#    e.3. end MODULE
# f. print current line into current file
# g. go on with next line
#---------------
awk '
{ REC=toupper($0) ;
  split(REC,u) ;
  u1=(u[1]) ; u2=(u[2]) ; u3=(u[3])
}
{ if((i_mod) != "open")
  { if((substr(u1,1,7)) == "PROGRAM")
    { split(u2,p_name,"(");
      l_name=(tolower(p_name[1]));
      split((l_name),e_name,"$");
      f_name=(e_name[1]) (e_name[2]) ".f90"; 
      print (f_name); i_flag="bof";
      print "!     ######spl" > (f_name)
    }   
  }
}
{ if((substr(u1,1,9)) == "INTERFACE")
    { i_interf="open" }
}
{ if((substr(u1,1,3)) == "END")
  { if((substr(u2,1,9)) == "INTERFACE")
    { i_interf="clos" }
  }
}
{ if((i_interf) != "open")
  { if((i_mod) != "open")
    {
      { if((substr(u1,1,8)) == "CONTAINS")
        { i_conta="open"
        }
      }
      { if((i_conta) != "open")
        {
		  { if((substr(u1,1,9)) == "RECURSIVE")
            { if((substr(u2,1,10)) == "SUBROUTINE")
              { split(u3,p_name,"(");
                l_name=(tolower(p_name[1]));
                split((l_name),e_name,"$");
                f_name=(e_name[1]) (e_name[2]) ".f90"; 
                print (f_name); i_flag="bof";
                print "!     ######spl" > (f_name);
                n_unit=(n_unit) + 0
              }   
            }   
		  }
		  { if((substr(u1,1,9)) == "RECURSIVE")
            { if((substr(u2,1,8)) == "FUNCTION")
              { split(u3,p_name,"(");
                l_name=(tolower(p_name[1]));
                split((l_name),e_name,"$");
                f_name=(e_name[1]) (e_name[2]) ".f90"; 
                print (f_name); i_flag="bof";
                print "!     ######spl" > (f_name);
                n_unit=(n_unit) + 0
              }   
            }
		  }
          { if((substr(u1,1,10)) == "SUBROUTINE")
            { split(u2,p_name,"(");
              l_name=(tolower(p_name[1]));
              split((l_name),e_name,"$");
              f_name=(e_name[1]) (e_name[2]) ".f90"; 
              print (f_name); i_flag="bof";
              print "!     ######spl" > (f_name);
              n_unit=(n_unit) + 0
            }   
          }   
          { if((substr(u1,1,8)) == "FUNCTION")
            { split(u2,p_name,"(");
              l_name=(tolower(p_name[1]));
              split((l_name),e_name,"$");
              f_name=(e_name[1]) (e_name[2]) ".f90"; 
              print (f_name); i_flag="bof";
              print "!     ######spl" > (f_name);
              n_unit=(n_unit) + 0
            }   
          }
        }
        else
        {
		  { if((substr(u1,1,9)) == "RECURSIVE")
            { if((substr(u2,1,10)) == "SUBROUTINE")
              { n_unit=(n_unit) + 1 }
            }
          }
		  { if((substr(u1,1,9)) == "RECURSIVE")
            { if((substr(u2,1,8)) == "FUNCTION")
              { n_unit=(n_unit) + 1 }
            }
          }
          { if((substr(u1,1,10)) == "SUBROUTINE")
            { n_unit=(n_unit) + 1 }
          }
          { if((substr(u1,1,8)) == "FUNCTION")
            { n_unit=(n_unit) + 1 }
          }
        }
      }
      { if((substr(u1,1,6)) == "MODULE")
        { split(u2,p_name,"(");
          l_name=(tolower(p_name[1]));
          split((l_name),e_name,"$");
          f_name=(e_name[1]) (e_name[2]) ".f90"; 
          print (f_name); i_flag="bof";
          print "!     ######spl" > (f_name);
          i_mod="open"; n_mod=(n_mod) + 0
        }   
      }
    }
    else
    { if((substr(u1,1,6)) == "MODULE")
      { n_mod=(n_mod) + 1 
      }   
    }
  }
}
{ if((substr(u1,1)) == "END")
  { if((i_mod) != "open")
    { if((i_interf) != "open")
      {
        { if((n_unit) == 0)
          {
            { if((substr(u2,1,7)) == "PROGRAM")
              { i_flag="eof"; i_conta="clos" ;
                print $0 >>(f_name);
                close((f_name))
              }
            }
            { if((substr(u2,1,10)) == "SUBROUTINE")
              { i_flag="eof"; i_conta="clos" ;
                print $0 >>(f_name);
                close((f_name)) 
              }
            }
            { if((substr(u2,1,8)) == "FUNCTION")
              { i_flag="eof"; i_conta="clos" ;
                print $0 >>(f_name);
                close((f_name)) 
              }
            }
            { if((u2) == "")
              { i_flag="eof"; i_conta="clos" ;
                print $0 >>(f_name);
                close((f_name)) 
              }
            }
          }
          else
          {
            { if((substr(u2,1,10)) == "SUBROUTINE")
              { n_unit=(n_unit) - 1 }
            }
            { if((substr(u2,1,8)) == "FUNCTION")
              { n_unit=(n_unit) - 1 }
            }
            { if((u2) == "")
              { n_unit=(n_unit) - 1 }
            }
          }
        }
      }
    }   
    else
    { if((substr(u2,1,6)) == "MODULE")
      { if((n_mod) == 0)
        { i_mod="clos"; i_flag="eof"; 
          print $0 >>(f_name);
          close((f_name)) 
        }
        else
        { n_mod=(n_mod) - 1
        }
      }
    }   
  }
}
{ if((i_flag) == "bof")
    { print $0 >>(f_name) }
}

' /tmp/splfile.${USER}.$$ 
rm -f /tmp/splfile.${USER}.$$
#--------------- 4. it may be that a routine generates the same file name
#                   than the initial input file. In this case, the input is
#                   saved in $REST; otherwise we keep it in $FILE.
rm $REST
exit
if [ -f $FILE ] ;then
#  echo "$FILE was rewritten by spl">>$OUTPUT
#  echo "spl has however saved the old file in $REST">>$OUTPUT
   exit 1
  rm $REST 
else
  rm $REST 
  mv $REST $FILE
fi
