*
* $Id: siarra.F,v 1.1.1.1 1995/12/12 14:36:15 mclareni Exp $
*
* $Log: siarra.F,v $
* Revision 1.1.1.1  1995/12/12 14:36:15  mclareni
* Imported sources
*
*
#include "sigma/pilot.h"
*CMZ :  1.09/04 26/10/93  09.49.17  by  Carlo E. Vandoni
*-- Author :
      SUBROUTINE SIARRA(LZ)
C    ....................................................
C
C
C         PURPOSE
C            PROCESSING ARRAY - FAMILY 200
C
C         USAGE
C            CALL SIARRA(LZ)
C
C         DESCRIPTION OF PARAMETERS
C            LZ=0,1,2 - NO. OF THINGS IN STACK - 0 FOR FILLING WITH ONES
C                       (BESIDES NCO)            1 FOR A VALUE PROVIDED
C                                                2 FOR TWO ENDS OF A RAN
C
C         COMM. BLOCKS USED
C            COM1
C            COMVAR USED: DYNA(),IADDR,LENGTH,MODE
C
C
C         SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C            SITRAC
C            IGETT2
C            SINERR
C            NGET
C            SISTR2
C            SIROUN
C            SIUSTK
C            SIX3ST
C            SIX4ST
C
C...  PAW VERSION  ...  MAY 1988
C
C    ......................................................
C
#include "sigma/sigc.inc"
#include "sigma/pawc.inc"
#include "sigma/siclin.inc"
C
      EQUIVALENCE (ALE,ILE)
      DIMENSION DIM(10),DIME(10)
      CALL SITRAC(' SIARRA   ')
C NCO OF NEW ARRAY IS ALWAYS ON THE BOTTOM OF STACK (POS 0,1,2 RESPECTIV
C NCO 1-DIM AND REAL
      DIME(1)=0.0
      CALL SINGET(ISI,LZ,DIME)
      IF(IERRNO.NE.0)RETURN
      IF(ISI.GE.3.OR.NDIM.NE.1.OR.MODE.NE.1)GO TO 962
      L=LENGTH
      IF(L.GT.3) GO TO 962
      ALE=1.
C ALE WILL BE TOTAL NO. OF COMPONENTS
      DO 10 I=1,L,MODE
         X1=SIROUN(DYNA(IADDR+I-1))
         IF(X1.LT.1.) GO TO 962
         ALE=ALE*X1
C DIM IS FILLED WITH NCO BACKWARDS

C         DIM(L-I+1)=X1
          DIM(I)=X1
   10 CONTINUE
      IF(DIM(1).EQ.0.)DIM(1)=1.0
      IF(L.GE.2.AND.DIM(2).EQ.0.)DIM(2)=1.0
      IF(L.EQ.3.AND.DIM(3).EQ.0.)DIM(3)=1.0
C ILE IS NO. OF WORDS NEEDED FOR COMPONENTS (AFTER MULT BY MODE)
      ILE=SIROUN(ALE)
       IF(LZ.EQ.1)GOTO 200
       IF(LZ.GT.1)GOTO 300
C FILL WITH ONES - MUST BE REAL
       CALL SIUSTK
C UNSTACK NCO
      MODE=1
C GET T2 ONLY IF NDIM+DIM.GT.2. OTHERWISE, THIRD SCALAR AREA.
       CALL SIGTT2(LA1,ILE,L,DIM)
      IF(IERRNO.NE.0)RETURN
C J IS LAST WORD OF NEW ARRAY
      J=ILE-1+LA1
      DO 110 I=LA1,J
  110 DYNA(I)=1.
C IF NDIM+DIM.EQ.2 (I.E. RESULT IS ARRAY(1) - SCALAR) ....
C CALL STORE TO PUT IN STACK ONLY
      RETURN
C FILL WITH VALUE(S) PROVIDED - MODE DEPENDS ON VALUES
  200 DIME(1)=0.0
      CALL SINGET(ISI,0,DIME)
      IF(IERRNO.NE.0)RETURN
      IF(ISI.GE.3) GO TO 913
C LA2 IS ADDRESS OF VALUES
      LA2=IADDR
      ILE=MODE*ILE
C GET T2 ONLY IF ARRAY, NOT SCALAR
       CALL SIGTT2(LA1,ILE,L,DIM)
      IF(IERRNO.NE.0)RETURN
C J IS THE LAST WORD THAT CAN BE SET FROM VALUES PROVIDED
      J=MIN0(ILE,LENGTH)+LA1-1
C K IS DIFFERENCE BETWEEN ADDRESS OF SOURCE VALUES AND TARGET NEW ARRAY
      K=LA2-LA1
      DO 210 I=LA1,J
  210 DYNA(I)=DYNA(I+K)
      I=ILE-LENGTH
C IF MORE VALUES THAN NECESS, FINISHED.
      IF(I.LE.0)GO TO 250
C OTHERWISE, FILL WITH 1I0.  (I IS NO. OF SURPLUS WORDS)
      DO 220 L=1,I,MODE
         DYNA(L+J)=1.
         IF(MODE.EQ.2)DYNA(L+J+1)=0.
  220 CONTINUE
C ELIMINATE NCO AND VALUES FROM STACK
  230 CALL SIX3ST
      RETURN
  250 IF(ILE.GT.MODE)GO TO 230
C ARRAY(1) I.E. SCALAR, SO PUT IN STACK
      CALL SISTR2(2)
      RETURN
C FILL WITH RANGE (INTERVAL). IF EITHER END IS CPX, NEW ARR IS CPX
C ENDS OF RANGE MUST BE SCALAR (ITYPE=0 OR 1)
  300 DIME(1)=0.0
      CALL SINGET(ISI,1,DIME)
      IF(IERRNO.NE.0)RETURN
      IF(ISI.GE.3) GO TO 966
      IF(LENGTH.NE.1) GO TO 966
      I=MODE
C X1,Y1,S1,V1 - REAL... START,END,STEP,INTERMEDIATE VALUE
C X2,Y2,S2,V2 - COMPLEX DITTO
      X1=DYNA(IADDR)
      X2=DYNA(IADDR+1)
      DIME(1)=0.0
      CALL SINGET(ISI,0,DIME)
      IF(IERRNO.NE.0)RETURN
      IF(ISI.GE.3) GO TO 966
      IF(LENGTH.NE.1) GO TO 966
      MODE=MAX0(I,MODE)
      Y1=DYNA(IADDR)
      Y2=DYNA(IADDR+1)
      ILE=MODE*ILE
C GET T2 IF NOT SCALAR
       CALL SIGTT2(LA1,ILE,L,DIM)
      IF(IERRNO.NE.0)RETURN
      IF(ILE.NE.MODE)GO TO 310
C IF SCALAR, VALUE=START. PUT IN STACK, ELIMINATING NCO,START,END FROM S
      DYNA(LA1)=X1
      DYNA(LA1+1)=X2
      CALL SISTR2(3)
      RETURN
C IF ROW LENGTH=1, ...
  310 IF(DIM(1).EQ.1.)GO TO 340
C OTHERWISE, CALCULATE STEPS ...
C
C     S2=1./(DIM(1)-1.)
      IRDIM=DIM(1)-1.
C
C     S1=S2*(Y1-X1)
      S1=(Y1-X1)/IRDIM
C
C
C     S2=S2*(Y2-X2)
C
      IF(MODE.EQ.2) THEN
C complex
      S2=(Y2-X2)/IRDIM
      ENDIF
C
C ... AND J (ROW LENGTH IN WORDS) & K (NO. OF ROWS)
      J=INT(DIM(1))*MODE
      K=ILE/J
C 330 - LOOP OVER ARRAY, 1 ROW AT A TIME
      DO 330 I=1,K
C RESET VALUE TO START AT BEGINNING OF EACH ROW
         V1=X1
         V2=X2
C 320 - LOOP OVER EACH ROW, 1 COMPONENT AT A TIME
         DO 320 L=1,J,MODE
            DYNA(LA1)=V1
C       PRINT *,LA1,DYNA(LA1)
            LA1=LA1+1
            V1=V1+S1
            IF(MODE.EQ.1)GO TO 320
            DYNA(LA1)=V2
C       PRINT *,LA1,DYNA(LA1)
            LA1=LA1+1
            V2=V2+S2
  320    CONTINUE
C RESET LAST COMPONENT IN EACH ROW TO EXACT END VALUE
         DYNA(LA1-MODE)=Y1
C       PRINT *,LA1,MODE,DYNA(LA1-MODE)
         IF(MODE.EQ.2)DYNA(LA1-1)=Y2
  330 CONTINUE
      GO TO 360
  340 J=LA1+ILE-1
C IF ROW LENGTH=1, WHOLE ARRAY=START VALUE
      DO 350 I=LA1,J,MODE
         DYNA(I)=X1
C       PRINT  *,DYNA(I),X1,I
         IF(MODE.EQ.2)DYNA(I+1)=X2
C       PRINT *,MODE,I,DYNA(I+1)
  350 CONTINUE
C ELIMINATE START,END,NCO FROM STACK
  360 CALL SIX4ST
      RETURN
C  13  WRONG VALUES
  913 CALL SINERR(13)
       RETURN
C  62  WRONG NCO
  962 CALL SINERR(62)
       RETURN
C  66  WRONG ENDS OF RANGE
  966 CALL SINERR(66)
C
 999  END