! UNIV. OF ATHENS - OCEAN GROUP - G.KORRES 07/03/2001
!***********************************************************************
PROGRAM chief
!     USE DFPORT
! ----------------------------------------------------------------------
!**** *CHIEF* - SUPERVISES WAVE MODEL EXECUTION.
!     LIANA ZAMBRESKY      GKSS/ECMWF  JUNE 1989
!     H. GUNTHER           ECMWF       JUNE 1990  MODIFIED FOR CYCLE_4.
!*    PURPOSE.
!     --------
!       THIS PROGRAM SUPERVISES THE EXECUTION OF THE WAM MODEL.
!**   INTERFACE.
!     ----------
!       IN ORDER FOR THE WAM MODEL TO EXECUTE, IT NEEDS
!       FILES FROM ESSENTIALLY FIVE SOURCES.
!       1. THE UNFORMATED FILES CREATED BY THE JOB PREPROC
!       2. USER INPUT FILE
!       3. THE WIND INPUT FILE.
!       4  THE BOUNDARY VALUE INPUT FILES CREATED BY JOB BOUINT.
!          THESE FILES ARE DYNAMICALLY ASSIGNED.
!       5. THE START FILES:
!          THE RESTART FILES HAVE TO BE CREATED BY JOB
!          PRESET, IF A COLD START HAS TO BE DONE.
!          THESE FILES OR FILES FROM A PREVIOUS MODEL RUN
!          ARE AUTOMATICALLY ASSIGNED. (SEE SUB GSFILE).
!       EXPLANATIONS FOR ALL FILES ARE GIVEN IN DETAIL IN SUB INITMDL
!     LIBRARIES.
!     ----------
!         NONE.
!     METHOD.
!     -------
!       THIS VERSION OF THE WAM MODEL HAS BEEN PRODUCED
!       BY MERGING AND CORRECTLY INTERFACING WHAT USED
!       TO BE THE STAND ALONE PROGRAMS:
!               PREWIND AND THE WAM MODEL.
!       PREWIND REFORMATS WINDS INTO THE WAM MODEL BLOCKED
!       STRUCTURE.  STARTING WITH THE INITIAL SEA STATE
!       FILES, THE WAM MODEL CAN THEN INTEGRATE FORWARD
!       IN TIME, DRIVEN BY THE REFORMATTED WINDS.
!       THE SEA STATE AND RESULT FILES ARE SAVED IN REGULAR
!       INTERVALLS. THE SEA STATE FILE SERVE AS THE INITIAL
!       CONDITION FOR A RESTART.
!       EACH CALL OF THE SUB WAVEMDL INTEGRATES FORWARD IN
!       TIME BY ONE WIND INPUT TIMESTEP OR ONE PROPAGATION
!       TIMESTEP, WHAT EVER IS LONGER.
!       IN THE FIRST CALL TO WAVEMDL AN INITIALIZATION IS
!       DONE IN ADDITION.
!     EXTERNALS.
!     ----------
!       *WAVEMDL*   - SUPERVISES THE OVERALL FLOW THROUGH
!                     THE MAIN MODULES: INITMDL, PREWIND
!                     AND WAMODEL.
!     REFERENCE.
!     ----------
!       EACH MODULE IS OF ITSELF THOROUGHLY DOCUMENTED.
! ----------------------------------------------------------------------
!     1) THE RESTRICTION IN WAM CYCLE_4 THAT SOURCE TERM TIME STEP
!     SHOULD BE SMALLER THAN PROPGATION TIME STEP IS REMOVED.
USE stat ; USE idfout ; USE idfout1 ; USE couple_mpi
IMPLICIT NONE
 integer :: etaserverandwam
 integer :: ixx,istaxx,iendxx,icolor,mype,npes,irlr,mpi_comm_comp
 integer :: iqserver,iquilt_group,iwork1,iwork2,istaq,i,j,iendq
 integer :: inumq(100),icc,comdup,iss,issl,jj,kk,iworld
 integer :: igroup,igroup_x,iworld_minus
 logical yes
 integer, allocatable :: irank ( : )


! -------------------------------------
!  0. Initialize MPI
! -------------------------------------

       CALL MPI_INIT(ierr)

! ----------------------------------------------------------------------
!*    1. CALLS TO WAVEMDL UNTIL MODEL DATE REACHES END DATE.
!*       EACH CALL INTEGRATES ONE WIND INPUT TIMESTEP, OR ONE
!*       PROPAGATION TIMESTEP, WHAT EVER IS LONGER.
!        ---------------------------------------------------
! ---------------------------------------------------------------------
!*    1.1 OPEN USER INPUT FILE AND GRID ORGANISATION FILE
!     ----------------------------------
 CALL MPI_COMM_SIZE(MPI_COMM_WORLD,npes,ierr)
 CALL MPI_COMM_RANK(MPI_COMM_WORLD,mype,ierr)
      npes2=npes
      mype2=mype
      etaserverandwam=-1
      etaserverandwam = max(inpes,jnpes) !get the max for I/O servers
      if (etaserverandwam.eq.-1) then
         print*,'SETUP_SERVERS ERROR ',etaserverandwam
         print*,'RECOMPILE WITH EVEN INPES OR JNPES'
         CALL MPI_ABORT(MPI_COMM_WORLD,1,IERR)
      end if
      iqserver = etaserverandwam
      iquilt_group = 1
      if ( iqserver .eq. 0 ) then
         if ( mype .eq. 0 ) then
           print *, ' WAM *** you specified 0 I/O servers '
         end if
         iquilt_group = 0
      end if
      if ( iquilt_group .gt. iqserver )  then
          iquilt_group = iqserver
          print *, ' ***** NOT ENOUGH SERVERS'
          print *, ' ***** WE NEED TO REDUCE THE NUMB OF SERVER GROUPS'
          print *, ' ***** NUMB OF SERVER GROUPS IS ', iquilt_group
      end if
      do i = 0, iquilt_group - 1
         iwork1 = ( iqserver - 1 + 1 ) / iquilt_group
         iwork2 = mod ( iqserver - 1 + 1, iquilt_group )
         istaq = i * iwork1 + 1 + min ( i, iwork2 )
         iendq = istaq + iwork1 - 1
         if ( iwork2 .gt. i ) iendq = iendq + 1
         inumq(i+1) = iendq-istaq+1
         if ( mype .eq. 0 ) print *, ' i, inumq = ',i+1,inumq(i+1)
      end do
      if ( mype .lt. NPES_MOD ) then
         icolor = 0
      else
         istaxx = NPES_MOD
         do i = 1, iquilt_group
            iendxx = istaxx + inumq(i) - 1
            if ( mype .ge. istaxx .and. mype .le. iendxx ) then
               icolor = i
            end if
            istaxx = iendxx + 1
         end do
      end if
!
      call mpi_comm_dup(MPI_COMM_WORLD,comdup,ierr)
      call mpi_comm_split(comdup,icolor,mype,mpi_comm_comp,ierr)

!      print*,'WAM comdup,icolor,mype ',comdup,icolor,mype
!
      allocate ( irank ( iqserver ) )
      ixx = NPES_MOD
      do i = 1, iquilt_group
         yes = .true.
         if ( mype .lt. NPES_MOD ) then
            irlr = ixx
         else
            irlr = 0
         end if
      icc = 0
      iss = NPES_MOD
      do jj = 1, iquilt_group
         if ( jj .ne. i ) then
            issl = iss
            do kk = 1, inumq(jj)
               icc = icc + 1
               irank(icc)= issl
               if ( mype .eq. issl ) yes = .false.
               issl = issl + 1
            end do
         end if
         iss = iss + inumq(jj)
      end do
!
      iworld = MPI_COMM_WORLD
      call mpi_comm_group(iworld,igroup,ierr)
!      print*,'WAM igroup ',igroup
      call mpi_group_excl(igroup,icc,irank,igroup_x,ierr)
!      print*,'WAM icc,irank,igroup_x ',icc,irank,igroup_x
      call mpi_comm_create(iworld,igroup_x,iworld_minus,ierr)
!      print*,'WAM iworld_minus ',iworld_minus
      call mpi_group_free(igroup,ierr)
      call mpi_group_free(igroup_x,ierr)
      call mpi_barrier(MPI_COMM_WORLD,ierr)
!
      end do

!=============================================================
!if (myrank .eq. wam_proc) then

!NIKOS Added file descriptor #70. Used to read options file from command line
CALL op_files (95, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 70)

CLOSE(UNIT = 3, STATUS = 'KEEP')

! ----------------------------------------------------------------------
CALL initomp (1)

IDTPRO = '000000000000' ; IDTSOU = '000000000000'
CALL wavemdl
DO WHILE(idtpro .LT. idatee)
   print *, 'calling wavemdl: ',idtpro
   CALL wavemdl
ENDDO
!write(6,*) 'Write last_analysis',idatee
OPEN(UNIT = 3, FILE = "last_analysis")  
WRITE(3,*) idatee
CLOSE(UNIT = 3, STATUS = 'KEEP')
!print *, 'After last_analysis'
CALL initomp (0)
!write(*,*) 'After initomp(0)'
!end if
!call mpi_barrier(MPI_COMM_WORLD,ierr)
! -------------------------------------
!  2. Finalize MPI
! -------------------------------------
    CALL MPI_FINALIZE(ierr)


STOP  
END PROGRAM chief
