Initial commit from Polytechnique Montreal

1 files changed, 36 insertions, 0 deletions

diff --git a/Dragon/data/assertS.c2m b/Dragon/data/assertS.c2m
new file mode 100644
index 0000000..1b9c714
--- /dev/null
+++ b/Dragon/data/assertS.c2m
@@ -0,0 +1,36 @@
+*
+* Assert procedure for non-regression testing
+* Recover a value from a real array
+* Author: A. Hebert
+*
+PARAMETER LCMNAM :: ::: LINKED_LIST LCMNAM ; ;
+CHARACTER KEY ;
+INTEGER ISET IPOS ;
+REAL REFVALUE ;
+:: >>KEY<< >>IPOS<< >>REFVALUE<< ;
+INTEGER ITYLCM ;
+REAL VALUE DELTA ;
+DOUBLE PRECISION DVALUE ;
+MODULE GREP: ABORT: END: ;
+*
+GREP: LCMNAM :: TYPE <<KEY>> >>ITYLCM<< ;
+IF ITYLCM 2 = THEN
+  GREP: LCMNAM :: GETVAL <<KEY>> <<IPOS>> >>VALUE<< ;
+ELSEIF ITYLCM 4 = THEN
+  GREP: LCMNAM :: GETVAL <<KEY>> <<IPOS>> >>DVALUE<< ;
+  EVALUATE VALUE := DVALUE D_TO_R ;
+ELSE
+  PRINT "assertS: INVALID TYPE=" ITYLCM ;
+  ABORT: ;
+ENDIF ;
+EVALUATE DELTA := VALUE REFVALUE - REFVALUE / ABS ;
+IF DELTA 1.0E-4 < THEN
+  PRINT "TEST SUCCESSFUL; DELTA=" DELTA ;
+ELSE
+  PRINT "------------" ;
+  PRINT "TEST FAILURE" ;
+  PRINT "------------" ;
+  PRINT "REFERENCE=" REFVALUE " CALCULATED=" VALUE ;
+  ABORT: ;
+ENDIF ;
+END: ;