/OPENFVS_DIR_RESTRUCT_TEST_BRANCH/src/base/opexpn.f

      SUBROUTINE OPEXPN (IOUT,NCYC,IY)

      IMPLICIT NONE

C----------

C  **OPEXPN DATE OF LAST REVISION:  07/23/08

C----------

C

C     OPTION PROCESSING ROUTINE - NL CROOKSTON - JAN 1981 - MOSCOW

C     FROM 1991 TO 2003 THERE WERE NO CHANGES TO THIS ROUTINE!

C     IN MAY 2003 CROOKSTON ADDED PROVISIONS FOR CHARACTER ARGUMENTS

C

C     EXPANDS THE ACTIVITY LIST SUCH THAT ACTIVITIES SPECIFIED FOR

C     ALL CYCLES ARE DUPLICATED ONCE FOR EACH CYCLE.  AN ACTIVITY

C     SPECIFIED FOR ALL CYCLES WILL NOT BE ADDED TO A CYCLE WHICH

C     ALREADY CONTAINS THAT ACTIVITY.

C

COMMONS

C

C

      INCLUDE 'PRGPRM.F77'

C

C

      INCLUDE 'OPCOM.F77'

C

C

COMMONS

C

      INTEGER IY(MAXCY1),NCYC,IOUT,I,IY1,IMG3,IPSYR,ISYR,IC,J,IP,K

      INTEGER IY2,IP1,IPS,IPY,L

C

C     STEP01: CONVERT ANY CYCLE NUMBERS IN THE DATE ARRAY TO DATES,

C     THEN SORT IOPSRT ON IDATE AND ISEQ.

C

      IMG2=IMGL-1

C

C     IF THERE ARE NO ACTIVITIES;

C     THEN: THE JOB IS DONE--RETURN.

C

      IF (IMG2 .LE. 0) RETURN

      DO 10 I=1,IMG2

      IY1=IDATE(I)

      IF (IY1.LE.MAXCYC .AND. IY1.GT.0) THEN

          IF (IY(IY1).GT.0) IY1=IY(IY1)

      ENDIF

      IDATE(I)=IY1

      ISEQ(I)=I

   10 CONTINUE

      ISEQDN=IMGL

      CALL OPSORT(IMG2,IDATE,ISEQ,IOPSRT,.TRUE.)

C

C     STEP02: FIND THE STARTING YEAR (ISYR) IN THE

C     ACTIVITY DATE ARRAY (IDATE), AND:

C     SET IPSYR=1 IF THERE ARE NO 'ALL-CYCLE' ACTIVITIES.

C     SET IPSYR=0 IF ALL ACTIVITIES ARE 'ALL-CYCLE' ACTIVITIES.

C     SET IPSYR>1 TO EXPAND THE 'ALL-CYCLE' ACTIVITIES STORED IN

C         IACT((IOPSRT(J),J=1,IPSYR-1),*).

C

      DO 20 I=1,IMG2

      IMG3=IOPSRT(I)

      IF (IDATE(IMG3).LE.0) GOTO 20

      IPSYR=I

      ISYR=IDATE(IMG3)

      GOTO 30

   20 CONTINUE

      IPSYR=0

   30 CONTINUE

C

C     IF IPSYR=1, THERE ARE NO 'ALL-CYCLE' ACTIVITIES;

C     THEN: PROCESSING IS COMPLETE, RETURN.

C

      IF (IPSYR .EQ. 1) RETURN

C

C     ELSE:

C     STEP03: EXPAND THE 'ALL-CYCLE' ACTIVITIES.

C

C     IF IPSYR>1 SOME SPICIFICLY DATED AND SOME 'ALL-CYCLE'

C     ACTIVITIES EXIST. THEN: BRANCH TO SPECIAL CODE.

C

      IF (IPSYR .GT. 1) GOTO 70

C

C     ELSE: ALL ACTIVITIES MUST BE ASSIGNED TO ALL CYCLES.

C

C     ASSIGN THE FIRST DATE TO THE SPECIFIED ACTIVITIES.

C

      ISYR=IY(1)

      DO 40 I=1,IMG2

      IDATE(I)=ISYR

   40 CONTINUE

C

C     IF THE NUMBER OF CYCLES = 1;

C     THEN: WE'ER DONE; RETURN

C

      IF (NCYC .EQ. 1) RETURN

C

C     ELSE: COPY THE SPECIFIED ACTIVITIES TO THE BOTTOM OF THE

C     ACTIVITY ARRAY AND ASSIGN THE NEXT CYCLE STARTING DATE

C     TO THE DATE ARRAY (IDATE). DO THIS FOR ALL CYCLES.

C

C     MAKE SURE ALL OF THE ACTIVITIES WILL FIT.

C

      IC=MAXACT/IMG2

      IF (IC.GE.NCYC) GOTO 50

      WRITE (IOUT,6010) NCYC,IC,IY(IC+1)

 6010 FORMAT (/1X,I3,' CYCLES REQUESTED, ',I3,' CYCLES POSSIBLE.  ',

     >        'PROJECTION WILL END IN ',I4)

      CALL ERRGRO (.TRUE.,10)

      NCYC=IC

   50 CONTINUE

C

C     COPY THE ACTIVITIES.

C

      DO 67 IC=2,NCYC

      ISYR=IY(IC)

      J=(IC-1)*IMG2

      DO 65 IP=1,IMG2

      IMG3=J+IP

      IDATE(IMG3)=ISYR

      ISEQ(IMG3)=IMG3

      IOPSRT(IMG3)=IMG3

      DO K=1,5

         IACT(IMG3,K)=IACT(IP,K)

      ENDDO

      IF (IACT(IMG3,2).LE.0) GOTO 65

      DO 64 I=IACT(IMG3,2),IACT(IMG3,3)

      PARMS(IMPL)=PARMS(I)

      IMPL=IMPL+1

      IF (IMPL.GT.ITOPRM) GOTO 200

   64 CONTINUE

      IACT(IMG3,2)=IMPL-(IACT(IMG3,3)-IACT(IMG3,2)+1)

      IACT(IMG3,3)=IMPL-1

   65 CONTINUE

   67 CONTINUE

      IMG2=IMG3

      IMGL=IMG2+1

C

      RETURN

   70 CONTINUE

C

C     STEP04:  ADD 'ALL-CYCLE' ACTIVITIES.

C

      IMG1=IPSYR

      IPSYR=IPSYR-1

      IMG3=IMG2

      K=IMG1

C

C     DO FOR ALL CYCLES.

C

      DO 170 IC=1,NCYC

C

C     FIND THE BEGINNING AND END OF THE CYCLE WITHIN THE ACTIVITY

C     ARRAY. NOTE THAT NO ACTIVITIES MAY YET EXIST FOR THE CYCLE.

C

      IY1=IY(IC)

      IY2=IY(IC+1)

      IP1=0

      DO 100 IP=K,IMG2

      IPS=IOPSRT(IP)

      IPY=IDATE(IPS)

      IF (IPY .LT. IY1 .OR. IPY .GE. IY2) GOTO 90

      IF (IP1 .EQ. 0) IP1=IP

   90 CONTINUE

      IF (IPY .LT. IY2) GOTO 100

      J=IP

      GOTO 105

  100 CONTINUE

      GOTO 110

  105 CONTINUE

      K=J

  110 CONTINUE

C

C     COPY THE ACTIVITIES.

C

      ISYR=IY1

C

C     DO FOR ALL 'ALL-CYCLE' ACTIVITIES.

C

      DO 160 I=1,IPSYR

      J=IOPSRT(I)

C

C     IF THERE IS NOT ENOUGH ROOM; THEN: BRANCH TO SPECIAL CODE.

C

      IMG3=IMG3+1

      IF (IMG3 .GT. MAXACT) GOTO 200

C

C     ELSE: ADD THE ACTIVITY

C

      IDATE(IMG3)=ISYR

      ISEQ(IMG3)=IMG3

      IOPSRT(IMG3)=IMG3

      DO 150 L=1,5

      IACT(IMG3,L)=IACT(J,L)

  150 CONTINUE

C

C     DUPLICATE THE PARMETER LIST (BRANCH TO SPECIAL CODE IF THERE

C     IS NOT ENOUGH ROOM).

C

      IF (IACT(IMG3,2).LE.0) GOTO 160

      DO 155 IP=IACT(IMG3,2),IACT(IMG3,3)

      PARMS(IMPL)=PARMS(IP)

      IMPL=IMPL+1

      IF (IMPL.GT.ITOPRM) GOTO 200

  155 CONTINUE

      IACT(IMG3,2)=IMPL-(IACT(IMG3,3)-IACT(IMG3,2)+1)

      IACT(IMG3,3)=IMPL-1

  160 CONTINUE

  170 CONTINUE

      GOTO 300

  200 CONTINUE

C

C     SPECIAL CASE: OUT OF ROOM IN THE ACTIVITY ARRAYS.

C     BACK UP TO THE LAST COMPLETED CYCLE. SET THE NCYC VALUE

C     EQUAL TO THAT CYCLE, WRITE A MESSAGE AND GO ON.  THIS

C     SHOULD BE A RATHER RARE EVENT, THEREFORE VERY LITTLE CODE

C     HAS BEEN WRITTEN TO TAKE MAX ADVANTAGE OF THE SITUATION.

C     (IF IT HAPPENS OFTEN, THE SOLUTION IS TO INCREASE THE SIZE OF

C     THE ACTIVITY ARRAYS.)

C

      IC=IC-1

      IMG3=IMG3-1

      WRITE (IOUT,6010) NCYC,IC,IY(IC+1)

      CALL ERRGRO (.TRUE.,10)

      NCYC=IC

  300 CONTINUE

C

C     STEP05: MOVE THE ACTIVITIES IN THE BOTTOM OF THE LIST UP TO

C     THE TOP, OVERWRITTING THE 'ALL-CLCLE' ACTIVITIES.

C

      IMG2=IMG3

      ISEQDN=IMG2+1

      DO 330 J=1,IPSYR

      I=IOPSRT(J)

      DO K=1,5

         IACT(I,K)=IACT(IMG2,K)

      ENDDO

      IDATE(I)=IDATE(IMG2)

      ISEQ(I)=ISEQ(IMG2)

      IMG2=IMG2-1

  330 CONTINUE

C

C     STEP06: REESTABLISH THE DATE SORT.

C

      CALL OPSORT(IMG2,IDATE,ISEQ,IOPSRT,.FALSE.)

      IMGL=IMG2+1

      RETURN

      END