PROGRAM mpp_optimiz_nc
 !!---------------------------------------------------------------------
 !!
 !!                       PROGRAM MPP_OPTIMIZ_NC
 !!                     ***********************
 !!
 !!  PURPOSE :
 !!  ---------
 !!              This program is build to optimize the domain beakdown into
 !!              subdomain for mpp computing.
 !!              Once the grid size, and the land/sea mask is known, it looks
 !!              for all the possibilities within a range of setting parameters
 !!              and determine the optimal.
 !!
 !!              Optimization is done with respect to the maximum number of
 !!              sea processors and to the maximum numbers of procs (jprocx)
 !!                     
 !!              Optional optimization can be performed takink into account
 !!              the maximum available processor memory ppmcal. This is
 !!              activated if jpmen =1
 !!
 !! history:
 !! --------
 !!       original  : 95-12 (Imbard M) for OPA8.1, CLIPPER
 !!       f90       : 03-06 (Molines JM), namelist as input
 !!                 : 05-05 (Molines JM), bathy in ncdf
 !!----------------------------------------------------------------------
 !! * modules used
  USE netcdf

  IMPLICIT NONE

  INTEGER ::  jprocx=250   !: maximum number of proc. (Read from namelist)
  INTEGER ::  jpmem=0      !: memory constraint (1) or no constraint (0)
     !                     !  (use 1 with caution as the memory size of 
     !                     !   the code lays on OPA 8.1 estimates ...)
     !
  INTEGER          ::  &
       jpk    = 46  ,    & !: vertical levels (namelist)
       jpiglo = 1442,    & !: I-size of the model (namelist)
       jpjglo = 1021,    & !: J-size of the model (namelist)
       jpidta = 1442,    & !: I-size of the data file (namelist)
       jpjdta = 1021,   &  !: J-size of the data files (namelist)
       nizoom = 1 ,     &  !: I zoom indicator (namelist)
       njzoom = 1 ,     &  !: J zoom indicatori (namelist)
       numnam = 4          !: logical unit for the namelist
  NAMELIST /namspace/ jpk,jpiglo,jpjglo,jpidta,jpjdta,nizoom,njzoom
  NAMELIST /namproc/ jprocx, jpmem

  INTEGER ::  jpnix ,jpnjx  
  !
  INTEGER,PARAMETER :: jpreci=1 ,jprecj=1
  !
  ! Following variables are used only if jpmem=1
  REAL(KIND=4) ::  ppmpt ,   &
       ppmcal = 225000000., &  !: maximum memory of one processor for a given machine (in 8 byte words)
       ppmin  = 0.4,         & !: minimum ratio to fill the memory
       ppmax  = 0.9            !: maximum ration to fill the memory
  ! Aleph
  !     PARAMETER(ppmcal= 16000000.)
  !Brodie
  !     PARAMETER(ppmcal=250000000.)
  ! Uqbar
  !     PARAMETER(ppmcal=3750000000.)
  ! Zahir
  !     PARAMETER(ppmcal=225000000.)

  CHARACTER(LEN=80) :: cbathy, &       !: File name of the netcdf bathymetry (namelist)
      &                clvar           !: Variable name in netcdf for the bathy to be read
  LOGICAL ::  ln_zps=.false.           !: Logical flag for partial cells.
  NAMELIST /namfile/ cbathy, ln_zps
  NAMELIST /namparam/ ppmcal, ppmin, ppmax
  !
  INTEGER :: iumout = 1
  INTEGER :: ji,jj,jn,jni,jnj,jni2,jnj2
  INTEGER :: iumbat,ifreq,il1,il2
  INTEGER :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
  INTEGER :: iilb,ijlb,ireci,irecj,in
  INTEGER :: ipi,ipj
  INTEGER :: inf10,inf30,inf50,iptx,isw
  INTEGER :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
  !
  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
  !
  REAL(KIND=4)                           ::  zmin,zmax,zper,zmem
  REAL(KIND=4)                           ::  zzmin,zzmax,zperx
  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask ,&  ! jpiglo -jpjglo
      &                                        zdta      ! jpidta -jpjdta

 ! CDF stuff
  INTEGER :: ncid, ivarid, istatus
  LOGICAL ::  llbon=.false.
  !
  ! 0. Initialisation
  ! -----------------
  OPEN(numnam,FILE='namelist')
  REWIND(numnam)
  READ(numnam,namspace)

  REWIND(numnam)
  READ(numnam,namfile)

  REWIND(numnam)
  READ(numnam,namparam)

  REWIND(numnam)
  READ(numnam,namproc)

  ! estimated  code size expressed in number of 3D arrays (valid for OPA8.1)
  ppmpt = 55.+73./jpk
  jpnix = jprocx ; jpnjx=jprocx

  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo),zdta(jpidta,jpjdta) )
  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )

  OPEN(iumout,FILE='processor.layout')
  WRITE(iumout,*)
  WRITE(iumout,*) ' optimisation de la partition'
  WRITE(iumout,*) ' ----------------------------'
  WRITE(iumout,*)
  !
  ! * Read cdf bathy file
  !
         IF ( ln_zps ) THEN        ! partial steps
            clvar = 'Bathymetry'
         ELSE 
            clvar = 'Bathy_level'  ! full steps
         ENDIF

         INQUIRE( FILE=cbathy, EXIST=llbon )
      IF( llbon ) THEN
            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
            istatus=NF90_CLOSE(ncid)
      ELSE
          PRINT *,' File missing : ', trim(cbathy)
          STOP
      ENDIF
  ibathy(:,:)=zdta(:,:)

  !
  ! Building the mask
  DO jj=1,jpjglo
     DO ji=1,jpiglo
        zmask(ji,jj) = float(ibathy(ji+nizoom - 1,jj+njzoom -1))
     END DO
  END DO

  DO jj=1,jpjglo
     DO ji=1,jpiglo
        zmask(ji,jj)=  min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))  ! Old vector coding rule ...
     END DO
  END DO
  !
  !  Main loop on processors
  ! ------------------------
  iii=1 ; iij=1
  iiii=jpiglo ; iijj=jpjglo
  iptx=0
  iimoy=0
  zzmin=0. ; zzmax=0.
  iinf10=0 ; iinf30=0 ; iinf50=0
  zperx=1.
  in=0
  DO jni=1,jpnix
     DO jnj=1,jpnjx
        !
        ! Limitation ob the maxumun number of PE's
        IF(jni*jnj >  jprocx) goto 1000
        !
        ! Partition
        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
        !
        ! Memory optimization ?
        isw=0
        zmem=ppmpt*ipi*ipj*jpk
        IF(zmem > ppmcal) go to 1000
        IF(jpmem == 1) THEN
           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
        ENDIF
        IF(isw.EQ.1) go to 1000
        in=in+1
        !
        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
        WRITE(iumout,*) ' '
        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
        !
        ! Coin en bas a gauche de chaque processeur
        !
        iilb=1
        ijlb=1
        ireci=2*jpreci
        irecj=2*jprecj
        iresti = MOD ( jpiglo - ireci , jni )
        irestj = MOD ( jpjglo - irecj , jnj )
        !
        IF (iresti.EQ.0) iresti = jni
        DO jj=1,jnj
           DO ji=1,iresti
              ippdi(ji,jj) = ipi
           END DO
           DO ji=iresti+1,jni
              ippdi(ji,jj) = ipi -1
           END DO
        END DO
        IF (irestj.EQ.0) irestj = jnj
        DO ji=1,jni
           DO jj=1,irestj
              ippdj(ji,jj) = ipj
           END DO
           DO jj=irestj+1,jnj
              ippdj(ji,jj) = ipj -1
           END DO
        END DO
        DO jj=1,jnj
           DO ji=1,jni
              iidom(ji,jj)=iilb
              ijdom(ji,jj)=ijlb
           END DO
        END DO
        WRITE(iumout,*) " iresti=",iresti," irestj=",irestj
        !
        !  2. Boucle sur les processeurs
        ! ------------------------------
        !
        ivide=0
        imoy=0
        zmin=1.e+20
        zmax=-1.e+20
        inf10=0
        inf30=0
        inf50=0
        !
        DO jni2=1,jni
           DO jnj2=1,jnj

              IF(jni.GT.1)THEN
                 DO jj=1,jnj
                    DO ji=2,jni
                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
                    END DO
                 END DO
                 iilb=iidom(jni2,jnj2)
              ENDIF
              IF(jnj.GT.1)THEN
                 DO jj=2,jnj
                    DO ji=1,jni
                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
                    END DO
                 END DO
                 ijlb=ijdom(jni2,jnj2)
              ENDIF

              ! Check wet points over the entire domain to preserve the MPI communication stencil
              isurf=0
              DO jj=1,ippdj(jni2,jnj2)
                 DO  ji=1,ippdi(jni2,jnj2)
                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
                 END DO
              END DO

              IF(isurf.EQ.0) THEN
                 ivide=ivide+1
              ELSE
                 imoy=imoy+isurf
              ENDIF
              zper=float(isurf)/float(ipi*ipj)
              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
              !
              !
              ! 3. Fin de boucle sur les processeurs, impression
              ! ------------------------------------------------
              !
           END DO
        END DO
        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10 -inf30
        WRITE(iumout,*) ' nombre de points integres   ', (jni*jnj-ivide)*ipi*ipj
        WRITE(iumout,*) ' nbr de pts supplementaires  ', (jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
        WRITE(iumout,*) ' % sup                       ',zper
        WRITE(iumout,*)
        ! 
        ! 
        ! 4. Recherche de l optimum
        ! -------------------------
        !
        IF(ivide.GT.iptx) THEN
           iii=jni
           iij=jnj
           iiii=ipi
           iijj=ipj
           iptx=ivide
           iimoy=imoy
           zzmin=zmin
           zzmax=zmax
           iinf10=inf10
           iinf30=inf30
           iinf50=inf50
           zperx=zper
        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
           iii=jni
           iij=jnj
           iiii=ipi
           iijj=ipj
           iimoy=imoy
           zzmin=zmin
           zzmax=zmax
           iinf10=inf10
           iinf30=inf30
           iinf50=inf50
           zperx=zper
        ENDIF
        !
        ! 5. Fin de boucle sur le nombre de processeurs
        ! ---------------------------------------------
        !
      1000 continue
     END DO
  END DO
  !
  !
  ! 6. Affichage resultat
  ! ---------------------
  !
  IF(in.EQ.0) THEN
     WRITE(iumout,*) ' le choix n'' a pas pu etre fait '
     WRITE(iumout,*)
     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
     STOP 
  ENDIF
  WRITE(iumout,*) ' choix optimum'
  WRITE(iumout,*) ' ============='
  WRITE(iumout,*) 
  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
  WRITE(iumout,*) ' '
  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
  WRITE(iumout,*) 
  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10 -iinf30
  WRITE(iumout,*) ' nombre de points integres   ', (iii*iij-iptx)*iiii*iijj
  WRITE(iumout,*) ' nbr de pts supplementaires  ', (iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
  WRITE(iumout,*) ' % sup                       ',zperx
  WRITE(iumout,*)
  CLOSE(iumout)
  !
  !
  !
  STOP
END PROGRAM mpp_optimiz_nc
