PROGRAM Z_UPDATE

! **********************************************************************
! *              .      .    .                                       
! * PROGRAM:	Z_UPDATE
! * PRGMMR:	M. ZUPANSKI	ORG: CIRA/CSU	DATE: 2001-06-06
! *
! * ABSTRACT:	UPDATE THE CONTROL VARIABLE IN ENSEMBLE SPACE
! *
! * PROGRAM LOG:
! *
! * 06/06/2001    ..... M. ZUPANSKI: 
! * 02/10/2002    ..... M. ZUPANSKI: upgraded for ensembles 
! * 09/09/2003    ..... M. ZUPANSKI: Fortran-90 + further upgrade with latest code
! *
!-------------------------------------------------------------------
!   INPUT:    z(i)     = control variable (ensemble subspace)
!
!   INPUT:    ALFA     = Step-length
!
!   INPUT:    d(i)     = descent direction
!
!  OUTPUT:    z_step   = z + ALFA * d
!
!-------------------------------------------------------------------
      integer,parameter:: icntrl=21        ! cntrl vrbl z (ensemble space)
      integer,parameter :: ialfa=22        ! step-length file
      integer,parameter :: idesc=23        ! descent direction file
      integer,parameter :: istep=51        ! cntrl vrbl z_step (ensemble space)

!---------------------------------------------------------------------------------------------
      real,parameter :: diff_max=50.0      ! max allowed increment in ensemble space (alfa*d)
!!    real,parameter :: diff_max=4.0       ! max allowed increment in ensemble space (alfa*d)
!!    real,parameter :: diff_max=2.0       ! max allowed increment in ensemble space (alfa*d)
!---------------------------------------------------------------------------------------------

      real ALFA
      integer NENS
      integer NENS_START
      integer iout,ioutm1,index
      character*8 alfaname
      character*11 descname
      logical write_new_alfa

      real,allocatable::z(:)
      real,allocatable::d(:)
      real,allocatable::z_trial(:)

!
!  DECLARE NAMELISTS
!
      NAMELIST /ENSEMBLE_SIZE/ NENS_START,NENS
      NAMELIST /CURRENT_ITERATION/ iout,ioutm1,index

!==============start calculation===================
      WRITE(3,*)"START Z_UPDATE CALCULATION "
      WRITE(*,*)"START Z_UPDATE CALCULATION "

!-- read current iteration

       REWIND 13
       READ(13,CURRENT_ITERATION)

       write(*,*) "z_update: iout,ioutm1,index=",iout,ioutm1,index

!-- read ensemble size

       REWIND 15
       READ(15,ENSEMBLE_SIZE)

       write(*,*) "z_step: NENS_START,NENS=",NENS_START,NENS

!    read cntrl vrbl in ensemble space (z)

        allocate(z(NENS_START:NENS))

      CLOSE(icntrl)
      OPEN(UNIT=icntrl,FILE='zcntrl_file',FORM='UNFORMATTED',IOSTAT=IER)
      IF(IER.NE.0) WRITE(*,*)' icntrl OPEN UNIT ERROR IER=',IER
      READ(icntrl) z
      CLOSE(icntrl,status='KEEP')

!--------------------------------------------------

      write(alfaname,100) iout
 100  format('alfa_',i2.2)


!-- read alfa
      close(ialfa)
      open(UNIT=ialfa,FILE=alfaname,FORM='UNFORMATTED',IOSTAT=IER)
      IF(IER.NE.0)WRITE(*,*)' ialfa OPEN UNIT ERROR IER=',IER
      read(ialfa) ALFA

      write(*,*) "READ ALFA=",ALFA," from file alfaname=",alfaname

!--- read descent direction

      write(descname,200) iout
 200  format('descent_',i2.2)

      allocate(d(NENS_START:NENS))
      close(idesc)
      open(UNIT=idesc,FILE=descname,FORM='UNFORMATTED',IOSTAT=IER)
      IF(IER.NE.0) WRITE(*,*)' idesc OPEN UNIT ERROR IER=',IER
      read(idesc) (d(K),K=NENS_START,NENS)
      close(idesc,status='KEEP')


!==== alfa safeguard ========================
      write_new_alfa=.false.
      write(*,*) " min,max ALFA*d=",ALFA*minval(d),ALFA*maxval(d)

      d1max=abs(maxval(d))
      d2max=abs(minval(d))

           if (abs(ALFA*d1max).gt.diff_max.or.abs(ALFA*d2max).gt.diff_max) then
        write(*,*) " alfa_old=",ALFA
        ALFA=sign(1.,ALFA)*diff_max/max(d1max,d2max)
        write_new_alfa=.true.
        write(*,*) " alfa_new=",ALFA
          endif

!============================================

      allocate(z_trial(NENS_START:NENS))

      z_trial(:)=z(:)+ALFA*d(:)

      write(*,*) " min,max z=",minval(z),maxval(z)
      write(*,*) " min,max z_trial=",minval(z_trial),maxval(z_trial)

      deallocate(d)
      deallocate(z)
!------------------------------------------
      if(write_new_alfa) then
      write(*,*) "WRITE NEW ALFA AFTER SAFEGUARD"
      rewind ialfa
      write (ialfa) ALFA
      else
      write(*,*) "NO NEED TO CHANGE ALFA AFTER SAFEGUARD"
      endif

      CLOSE(ialfa,status='KEEP')
!------------------------------------------
      CLOSE(istep)
      OPEN(UNIT=istep,FILE='z_out',FORM='UNFORMATTED',IOSTAT=IER)
      IF(IER.NE.0) WRITE(*,*)' istep OPEN UNIT ERROR IER=',IER
      write(istep) z_trial
      CLOSE(istep,status='KEEP')

      deallocate(z_trial)

      WRITE(3,*)"END Z_UPDATE CALCULATION "
      WRITE(*,*)"END Z_UPDATE CALCULATION "
!===========================================================
                      STOP
                      END