!--------------------------------------------------------------------------!
! client_output.f
!--------------------------------------------------------------------------!
!                                  ___   __                                !
!                  __    __       / _ \ / /           _/\_                 !
!    ___  _ _     / /__ / /      / / \// /__ ___ _ _ /  _/                 !
!   | _ \/ ` \ _ / // // _ \ *   \ \/\/ // // -_/ ' \/ /                   !
!   | ,_/_,_,_\  \_/\_/\___/ *    \__/\_/\_/\__//_/_/\_/                   !
!   |_|                                                                    !
!                            Mads M. Hejlesen* and Jens H. Walther*^       !
!                            * Technical University of Denmark             !
!                            ^ ETH-Zurich                                  !
!                                                                          !
!--------------------------------------------------------------------------!
! Copyright (c) 2014 Technical University of Denmark, 
!                    Department of Mechanical Engineering
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 2 of the License, or
! (at your option) any later version.
! 
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, see <http://www.gnu.org/licenses/>
!
! Contact: mmhej@mek.dtu.dk or jhwa@mek.dtu.dk
!---------------------------------------------------------------------------
MODULE client_mod_output

USE client_mod_parameters

USE pmlib_mod_parameters
USE pmlib_mod_write

IMPLICIT NONE

CONTAINS

SUBROUTINE client_output_plot(tag,topo,mesh,max_val,ierr)

USE client_mod_penalisation

USE pmlib_mod_communication
USE pmlib_mod_topology

IMPLICIT NONE
!---------------------------------------------------------------------------
! arguments
!---------------------------------------------------------------------------
  CHARACTER(LEN=*), INTENT(IN)                    :: tag
  TYPE(class_topology)                            :: topo
  REAL(MK), DIMENSION(:,:,:),POINTER, INTENT(IN)  :: mesh
  REAL(MK), INTENT(IN)                            :: max_val 
  INTEGER, INTENT(OUT)                            :: ierr

!---------------------------------------------------------------------------
! Local variables
!---------------------------------------------------------------------------
  CHARACTER(LEN=5)                                :: background
  INTEGER, PARAMETER                              :: IO_unit_ps = 10
  CHARACTER(LEN=256)                              :: outfile
  INTEGER                                         :: ltag
  INTEGER                                         :: i,j,k,l
  REAL(SELECTED_REAL_KIND(22))                    :: base10
  INTEGER,DIMENSION(4)                            :: b
  INTEGER,DIMENSION(5)                            :: c
  CHARACTER(LEN=5)                                :: asc
  INTEGER                                         :: lasc, lline

  INTEGER                                         :: nvar
  REAL(MK)                                        :: var_mag

  INTEGER,DIMENSION(:),POINTER                    :: rgb
  INTEGER,DIMENSION(2)                            :: npixel

  REAL(MK), DIMENSION(:,:,:),POINTER              :: solid

  REAL(MK)                                        :: px,py

  REAL(MK),DIMENSION(ndim)                     :: xmin, dx
  INTEGER,DIMENSION(ndim)                      :: ncell
  INTEGER,DIMENSION(2*ndim)                    :: nghost

!---------------------------------------------------------------------------
! Initiate subroutine
!---------------------------------------------------------------------------
  ierr = 0
!  background = "black"
  background = "white"

!---------------------------------------------------------------------------
! find number of pixels
!---------------------------------------------------------------------------
  nvar   = SIZE(mesh,1)
  npixel = topo%ncell

!---------------------------------------------------------------------------
! Map penalisation mask to mesh
!---------------------------------------------------------------------------
  ALLOCATE( solid(1, &
          & 1-topo%nghost(1):topo%ncell(1)+topo%nghost(2), &
          & 1-topo%nghost(3):topo%ncell(2)+topo%nghost(4)), &
          & stat=ierr)
  solid = 0.0_MK
  IF(penalisation)THEN
    CALL pmlib_mesh_map(topo_penal%cuboid,topo,1,ierr)
    CALL pmlib_comm_pack(mesh_penal%solid,ierr)
    CALL pmlib_comm_unpack(topo,solid,ierr)
    CALL pmlib_comm_finalise(ierr)
  END IF

!---------------------------------------------------------------------------
! Re-size to 1D array
!---------------------------------------------------------------------------
  ALLOCATE( rgb(3*npixel(1)*npixel(2)) )
  l = 0

  SELECT CASE ( TRIM(background) )
    CASE ('black')
      DO k = 1,npixel(2)
        DO j = 1,npixel(1)

          IF(nvar .EQ. 1)THEN
            var_mag = mesh(1,j,k)
          ELSE
            var_mag = 0.0_MK
            DO i = 1,nvar
              var_mag = var_mag + mesh(i,j,k)**2
            END DO
            var_mag = SQRT(var_mag)
          END IF

          IF(solid(1,j,k) .NE. 0.0_MK)THEN
            l = l + 1
            rgb(l) = 51
            l = l + 1
            rgb(l) = 51
            l = l + 1
            rgb(l) = 51 
          ELSE
            IF( var_mag .GT. 0.0_MK)THEN
              l = l + 1
              rgb(l) = FLOOR(MIN( ABS( var_mag)/max_val &
                                      & * 255.0_MK, 255.0_MK) )
              l = l + 1
              rgb(l) = 0
              l = l + 1
              rgb(l) = 0
            ELSEIF( var_mag .LT. 0.0_MK)THEN
              l = l + 1
              rgb(l) = 0
              l = l + 1
              rgb(l) = 0
              l = l + 1
              rgb(l) = FLOOR(MIN( ABS( var_mag)/max_val &
                                     & * 255.0_MK, 255.0_MK))
            ELSE
              l = l + 1
              rgb(l) = 0
              l = l + 1
              rgb(l) = 0
              l = l + 1
              rgb(l) = 0
            END IF
          END IF
        END DO
      END DO

    CASE ('white')
      DO k = 1,npixel(2)
        DO j = 1,npixel(1)
 
          IF(nvar .EQ. 1)THEN
            var_mag = mesh(1,j,k)
          ELSE
            var_mag = 0.0_MK
            DO i = 1,nvar
              var_mag = var_mag + mesh(i,j,k)**2
            END DO
            var_mag = SQRT(var_mag)
          END IF

          IF(solid(1,j,k) .NE. 0.0_MK)THEN
            l = l + 1
            rgb(l) = 51
            l = l + 1
            rgb(l) = 51
            l = l + 1
            rgb(l) = 51 
          ELSE

            IF( var_mag .GT. 0.0_MK)THEN
              l = l + 1
              rgb(l) = 255
              l = l + 1
              rgb(l) = 255 - FLOOR(MIN( ABS( var_mag)/max_val &
                                      & * 255.0_MK, 255.0_MK) )
              l = l + 1
              rgb(l) = 255 - FLOOR(MIN( ABS( var_mag)/max_val & 
                                      & * 255.0_MK, 255.0_MK))
            ELSEIF( var_mag .LT. 0.0_MK)THEN
              l = l + 1
              rgb(l) = 255 - FLOOR(MIN( ABS( var_mag)/max_val &
                                      & * 255.0_MK, 255.0_MK))
              l = l + 1
              rgb(l) = 255 - FLOOR(MIN( ABS( var_mag)/max_val &
                                      & * 255.0_MK, 255.0_MK))
              l = l + 1
              rgb(l) = 255
            ELSE
              l = l + 1
              rgb(l) = 255
              l = l + 1
              rgb(l) = 255
              l = l + 1
              rgb(l) = 255
            END IF

          END IF
        END DO
      END DO
  END SELECT

!---------------------------------------------------------------------------
! Write window to eps file
!---------------------------------------------------------------------------
  WRITE(outfile,'(A,A)') TRIM(tag),'.ps'

!---------------------------------------------------------------------------
! Write postscript file
!---------------------------------------------------------------------------
  OPEN(IO_unit_ps,FILE=outfile,FORM='FORMATTED')

  WRITE(IO_unit_ps,'(A)') '%!PS-Adobe-2.0 EPSF-2.0'
  WRITE(IO_unit_ps,'(A,2I6)') '%%BoundingBox: 0 0 ',npixel(1),npixel(2)
  WRITE(IO_unit_ps,'(A)')''
  WRITE(IO_unit_ps,'(A)')'/DeviceRGB setcolorspace'
  WRITE(IO_unit_ps,'(A)')'gsave'
  WRITE(IO_unit_ps,'(A)')''
  WRITE(IO_unit_ps,'(A)') '%%%%BeginImage'
  WRITE(IO_unit_ps,'(A)') '0 0 translate'
  WRITE(IO_unit_ps,'(2I6,A)') npixel(1),npixel(2),' scale'
  WRITE(IO_unit_ps,'(A)') '<<'
  WRITE(IO_unit_ps,'(A)') '  /ImageType 1'
  WRITE(IO_unit_ps,'(A,I6)') '  /Width', npixel(1)
  WRITE(IO_unit_ps,'(A,I6)') '  /Height', npixel(2)
  WRITE(IO_unit_ps,'(A)') '  /BitsPerComponent 8'
  WRITE(IO_unit_ps,'(A,2(I6,A))') '  /ImageMatrix [ ', &
                        & npixel(1), ' 0 0 ', npixel(2), ' 0 0 ]'
  WRITE(IO_unit_ps,'(A)') '  /Decode [ 0 1 0 1 0 1 ]'
  WRITE(IO_unit_ps,'(A)') '  /DataSource currentfile /ASCII85Decode filter'
  WRITE(IO_unit_ps,'(A)') '  /MultipleDataSources false'
  WRITE(IO_unit_ps,'(A)') '  /Interpolate true'
  WRITE(IO_unit_ps,'(A)') '>>'
  WRITE(IO_unit_ps,'(A)') 'image'

!---------------------------------------------------------------------------
! Encode to ASCII85
!---------------------------------------------------------------------------
  lline = 0
  b = 0
  c = 0
  DO i = 1,CEILING(REAL(3*npixel(1)*npixel(2),MK)/4.0_MK)

    DO j = 1,4
      IF( 4*i-4+j .LE. 3*npixel(1)*npixel(2) )THEN
        b(5-j) = rgb(4*i-4+j)
      ELSE
        b(5-j) = 0
      END IF
    END DO

    base10 = REAL(b(1),MK)
    base10 = base10 + REAL(b(2),MK)*256
    base10 = base10 + REAL(b(3),MK)*(256**2)
    base10 = base10 + REAL(b(4),MK)*(256**3)

    DO j = 1,5
      c(6-j) = INT(MAX(0.0_MK, base10 - 85.0_MK*AINT(base10/85.0_MK) ))
      base10 = AINT(base10/85.0_MK)
    END DO

    IF( c(1) .EQ. 0 .AND. c(2) .EQ. 0 .AND. &
      & c(3) .EQ. 0 .AND. c(4) .EQ. 0 .AND. c(5) .EQ. 0)THEN
      WRITE(asc,'(A)') 'z'
      lasc = 1
    ELSE
      WRITE(asc,'(5A)') CHAR(c(1)+33),CHAR(c(2)+33), &
                      & CHAR(c(3)+33),CHAR(c(4)+33),CHAR(c(5)+33)
      lasc = 5
    END IF

    IF(lline .GT. 77)THEN
      WRITE(IO_unit_ps,'(A)',ADVANCE='YES') asc(1:lasc)
      lline = 0
    ELSE
      WRITE(IO_unit_ps,'(A)',ADVANCE='NO') asc(1:lasc)
      lline = lline + lasc
    END IF

  ENDDO

  WRITE(IO_unit_ps,'(A)',ADVANCE='YES')''
  WRITE(IO_unit_ps,'(A)')'~>'
  WRITE(IO_unit_ps,'(A)') '%%%%EndImage'
  WRITE(IO_unit_ps,'(A)') 'grestore' 
  WRITE(IO_unit_ps,'(A)') 'showpage'
  WRITE(IO_unit_ps,'(A)')'%%EOF'

  CLOSE(IO_unit_ps)

!---------------------------------------------------------------------------
! De-allocate local pointers
!---------------------------------------------------------------------------
  DEALLOCATE( rgb )
  DEALLOCATE( solid )

!---------------------------------------------------------------------------
! Return
!---------------------------------------------------------------------------
 9999 CONTINUE
RETURN

END SUBROUTINE client_output_plot


END MODULE client_mod_output

