NORMA (1158464), страница 7
Текст из файла (страница 7)
For example, subroutine
SUBROUTINE SINXY(Y,N,X)
REAL X(N), Y(N)
DO 1 I=1,N
X(I) = SIN(Y(I))
1 CONTINUE
RETURN
END
can be called as it is shown here:
Oi : ( I=1..N ). VARIABLE X,Y DEFINED ON Oi. INPUT Y ON Oi.
DOMAIN PARAMETERS N = 10.
COMPUTE SINXY(Y ON Oi, N RESULT X ON Oi).
5.2.6. Setting of sequential computing mode
The order of carrying out operations (operators) is often important in computational algorithms realization. The order may have an influence on convergence, stability of solution method etc. There is a possibility of sequential computations mode setting in Norma. It allows user to fix the order of computation. On this purpose delimiters # ... # are used. Operators put in the delimiters # ..# are performed in the order written in program. Correctness of operators’ sequence in Norma is under control: reassignment, using of undeclared values, etc. are fixed. The notation
#
X=5.0 . Z=SIN(X+0.5) . Y=COS(X)-Z*X.
#
is correct, but notation
#
X=5.0. Y=COS(X)-Z*X . Z=SIN(X+0.5) .
#
is incorrect because undefined value of Z variable is used in the second operator( if we take off delimiters then both notation are correct).
5.3. Iteration
iteration :
head-of-iteration
[ boundary-value ]
initial-value
body-of-iteration
exit-condition
end-iteration
head-of-iteration :
ITERATION list-iterated-element ON name-iteration-index .
iterated-element :
name-variable [ ( list-name-result ) ]
boundary-value :
BOUNDARY { operator .}+ END BOUNDARY
initial-value :
INITIAL name-iteration-index = 0 : { element-of-initial .}+
END INITIAL
element-of--initial :
operator
declaration-of-input
declaration-of-output
body-of-iteration :
{ element-of-iteration-body . }+
element-of-iteration-body :
operator
iteration
declaration-of-output
exit-condition :
EXIT WHEN log-expression
end-iteration :
END ITERATION name-iteration-index
Computation process often is iterative in mathematical physics problems solutions. Such process may be set by previously described tools of the NORMA language. You should extend domains’ declarations adding extra direction corresponding to iteration index. But to use such an extension isn’t always correct because the direction is fictitious and it represents the way of computation but not space-time grid. Besides the boundaries of such fictitious direction are often unknown.
Special construction ITERATION allows possibility to set iterative computational process avoiding all the difficulties mentioned above.
Informally iteration set iterative computations with iteration index changing from 0 to some integer positive value which is a condition of iteration’s end.
Let’s take iterative computational process dealt with the system of equations solution:
and set by formulae
exit condition
This process written in NORMA:
Array : (Oi: (I=1..M) ; Oj : (J=1..M)) . O1,O2:Oj / j<>i.
VARIABLE X0,X,F DEFINED ON Oi. VARIABLE A DEFINED ON Array.
VARIABLE Epsilon.
DOMAIN PARAMETERS M = 100.
INPUT X0 ON Oi, A ON Array. INPUT Epsilon.
OUTPUT X, Xpred ON Oi.
ITERATION X (Xpred) ON N.
INITIAL N=0 :
FOR Oi ASSUME X = X0.
END INITIAL
FOR Oi ASSUME X = 1/A[j=i]*(F-SUM( (O1)A*X[I=J,N-1]).
EXIT WHEN MAX( (Oi) ABS(X[N] - X[N-1] ) ) < Epsilon.
END ITERATION N.
Iteration itself is the last 8 lines of example. There is iteration index (here it is N) and variables taking part in computations and presenting the result of these computations (X is the value from the last iteration step, and Xpred - the value from the before the last iteration step) in the iteration header. Value Xpred doesn’t require supplementary definition, it is considered to be declared in the same way as X. Values X and Xpred can be used for computations out of iteration; in the given example these values are declared output.
You can use the possibility of iterated variables boundary values of setting (in general it is not obliged). Boundary values of iterated variable are set by common Norma operators inside the block BOUNDARY ... END BOUNDARY. These values are considered unchangeable on iteration and defined on every its step.
Initial values for iterated variables are set by blocks INITIAL...END INITIAL.
Body of iteration is part of NORMA program. In particular you can define new iteration in another direction inside the iteration. In the given example body of iteration consists of the only ASSUME operator.
Iteration index can be used in the list of indexes indicated for iterated variable. In fact we can consider that iterated variable has supplementary index in boundaries of iteration ( on factitious direction ). Iteration index without displacement may be not indicated.
Only iterated variables can indicate iteration index.
The values of variables unindicated in the list of iterated variables may be computed in the body of ITERATION construction. Such variables may be used for interim results of each level iteration representation. The usage of such variables doesn’t break reassignment prohibition : we consider the a new copy of the variable is used at each step of iteration.
Iteration process ends if logical expression set in exit condition becomes true.
Appendix 1. Representation of initial program
Initial program is represented in initial file according to the rules :
1. Text of every part of NORMA program is written in unformatted representation. If you need to carry operator or declaration it is prohibited to break key words, identificators, constants. In other cases you can carry the words as you like it.
2. Key words, identificators, constants are separated by spaces, special symbols, end-line symbol.
Spaces are not meaningful symbols: the group of spaces are considered as one space.
3. The line or part of line beginning from symbol “!” is a commentary.
4. Information placed in the interval from the symbol “?” standing at the first position up to the symbol “?” also standing at the first position are not translated. It allows to choose from initial file those parts which you want to translate.
Appendix 2. Syntax rules
program :
{ part }+
part :
main-part
simple-part
part-function
main-part :
MAIN PART name-part . declaration-of-part
simple-part :
PART name-simple-part . declaration-of-part
part-function :
FUNCTION name-function [type-function] . declaration-of-function
declaration-of-part :
formal-parameters-of-part BEGIN body-of-part END PART
formal-parameters-of-part :
[ list-name ] [RESULT list-name]
declaration-of-function :
formal-parameters-of-function BEGIN body-of-part END PART
formal-parameters-of-function :
list-name
body-of-part :
{ element-of-part }*
element-of-part :
declaration .
operator .
iteration .
declaration :
declaration-of-domain
declaration-of-domain-indexes
declaration-of-scalar-variables
declaration-of-variables-on-domains
declaration-of-distribution-indexes
declaration-of-domain-parameters
declaration-of-input
declaration-of-output
declaration-of-external
declaration-of-domain :
declaration-of-unconditional-domain
declaration-of-conditional-domain
declaration-of-unconditional-domain
declaration-of-rectangular-domain
declaration-of-diagonal-domain
domain :
new-domain-without-name
name-domain
unconditional-domain :
new-domain-without-name
name-unconditional-domain
name-domain :
name-unconditional-domain
name-conditional-domain
name-unconditional-domain :
name-rectangular-domain
name-diagonal-domain
declaration-of-rectangular-domain :
multidimensional-domain
new-domain
multidimensional-domain :
onedimensional-domain
[ name-multidimensional-domain : ] ( domain-product )
domain-product :
component-domain { ; component-domain }+
component-domain :
multidimensional-domain
name-unconditional-domain
onedimensional-domain :
[ name-onedimensional-domain : ] ( name-index = value )
value :
range
const-expression
range :
const-expression .. const-expression
new-domain :
[ name-new-domain : ] new-domain-without-name
new-domain-without-name :
name-unconditional-domain / list-modification
modification :
name-index = value
name-onedimensional-domain { { +,- } boundary-function }+
boundary-function :
LEFT( const-expression )
RIGHT( const-expression )
name-rectangular-domain :
name-onedimensional-domain
name-multidimensional-domain
name-new-domain
declaration-of-diagonal-domain :
name-diagonal-domain : name-unconditional-domain / list-condition-on-index
declaration-of-conditional-domain :
name-conditional domain , name-conditional-domain : name-domain / condition-on-domain
declaration-of-domain-indexes :
INDEX list-name-index
declaration-of-scalar-variables :
VARIABLE list-name-scalar [ type ]
declaration-of-variables-on-domains :
VARIABLE list-name-variable-on-domain DEFINED ON name-unconditional-domain [ type ]
type :
{ REAL, INTEGER, DOUBLE }
declaration-of-domain-parameters :
DOMAIN PARAMETERS list-prescription
prescription :
name-domain-parameter = int-const
declaration-of-input :