From 1358525288bde7e22e485496be5d62dc4d54ce47 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Wed, 30 Nov 2022 14:34:52 +0100
Subject: [PATCH] Philippe 30/11/2022: spl: add support for PURE and ELEMENTAL
functions and subroutines
---
bin/spl | 85 +++++++++++++++++++++++++++++++++++++++++++++++++++------
1 file changed, 77 insertions(+), 8 deletions(-)
diff --git a/bin/spl b/bin/spl
index 7d6e4158a..9497c5b36 100755
--- a/bin/spl
+++ b/bin/spl
@@ -1,7 +1,7 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1995-2022 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 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
@@ -83,6 +83,7 @@ fi
#
#modified by C. Fischer to split fortran 77 (26/04/95)
#modified by C. Fischer to correct a bug PROGRAM-CONTAINS (16/02/96)
+#modified by P. Wautelet to add support for PURE and ELEMENTAL functions and subroutines (30/11/2022)
#
#.SH COPYRIGHT
#
@@ -153,7 +154,55 @@ awk '
}
{ if((i_conta) != "open")
{
- { if((substr(u1,1,9)) == "RECURSIVE")
+ { if((substr(u1,1,9)) == "ELEMENTAL")
+ { 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)) == "ELEMENTAL")
+ { 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,4)) == "PURE")
+ { 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,4)) == "PURE")
+ { 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,9)) == "RECURSIVE")
{ if((substr(u2,1,10)) == "SUBROUTINE")
{ split(u3,p_name,"(");
l_name=(tolower(p_name[1]));
@@ -164,8 +213,8 @@ awk '
n_unit=(n_unit) + 0
}
}
- }
- { if((substr(u1,1,9)) == "RECURSIVE")
+ }
+ { if((substr(u1,1,9)) == "RECURSIVE")
{ if((substr(u2,1,8)) == "FUNCTION")
{ split(u3,p_name,"(");
l_name=(tolower(p_name[1]));
@@ -176,7 +225,7 @@ awk '
n_unit=(n_unit) + 0
}
}
- }
+ }
{ if((substr(u1,1,10)) == "SUBROUTINE")
{ split(u2,p_name,"(");
l_name=(tolower(p_name[1]));
@@ -200,12 +249,32 @@ awk '
}
else
{
- { if((substr(u1,1,9)) == "RECURSIVE")
+ { if((substr(u1,1,9)) == "ELEMENTAL")
+ { if((substr(u2,1,10)) == "SUBROUTINE")
+ { n_unit=(n_unit) + 1 }
+ }
+ }
+ { if((substr(u1,1,9)) == "ELEMENTAL")
+ { if((substr(u2,1,8)) == "FUNCTION")
+ { n_unit=(n_unit) + 1 }
+ }
+ }
+ { if((substr(u1,1,4)) == "PURE")
+ { if((substr(u2,1,10)) == "SUBROUTINE")
+ { n_unit=(n_unit) + 1 }
+ }
+ }
+ { if((substr(u1,1,4)) == "PURE")
+ { if((substr(u2,1,8)) == "FUNCTION")
+ { n_unit=(n_unit) + 1 }
+ }
+ }
+ { 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(u1,1,9)) == "RECURSIVE")
{ if((substr(u2,1,8)) == "FUNCTION")
{ n_unit=(n_unit) + 1 }
}
--
GitLab