psmile_char2buf.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_Char2buf
!
! !INTERFACE:
!
      subroutine psmile_char2buf (ilubuf, ndibuf, ipos, string)
!
! !USES:
!
      use psmile_common, dummy_interface => PSMILe_Char2buf

      implicit none
!
! !INPUT PARAMETERS:
!
      character (len=*), Intent(in) :: string

!     Character string, to be written to buffer.

      integer, Intent(in)           :: ndibuf

!     Dimension of buffer 'ILUBUF'.

!
! !INPUT/OUTPUT PARAMETERS:
!
      integer, Intent(inout)        :: ipos

!     Pointer to the last used index in 'ILUBUF'
!     Length of 'ILUBUF' currently used.

      integer, Intent(inout)        :: ilubuf (ndibuf)

!     Integer buffer.
!
! !LOCAL VARIABLES
!
      character (len=12)      :: form
      integer                 :: i, ilen, irest, lav, lenstr
!
! !DESCRIPTION:
!
!  Write Character String to Buffer
!
!  Subroutine "PSMILe_Char2buf" writes the character string 'STRING'
!  to buffer 'ILUBUF(IPOS+1:)' and 'IPOS' is updated to point to the
!  last index used in buffer 'ILUBUF'.
!
!  If character string 'STRING' is too long to be stored entirely in
!  the buffer, the storable length is stored in vector 'ILUBUF' and
!  'IPOS' points to the last or first index which corresponds to
!  the index in 'ILUBUF' necessary to store the string entirely.
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    H. Ritzdorf  created
!
!EOP
!-----------------------------------------------------------------------
!
!  $Id: psmile_char2buf.F90 2325 2010-04-21 15:00:07Z valcke $
!  $Autor$

   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_char2buf.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!-----------------------------------------------------------------------
!
!===> Initialization
!
      lenstr = len (string)
      ilen = (lenstr-1) / length_of_integer
!
      lav = ndibuf - ipos
!
!===> Create format ``form''
!
      irest = lenstr - ilen*length_of_integer
!
      if (ilen .gt. 0) then
         write (form, 9990) ilen, length_of_integer, irest
      else
         write (form, 9980) irest
      endif
!
!===> Write to buffer ``ilubuf''
!
      read (string, form) (ilubuf(ipos+i), i= 1, min (ilen+1, lav))
!
      ipos = ipos + (ilen+1)
!
      return
!
!  Formats:
!
9990  format ('(', i4, 'a', i1, ', a', i1, ')')
9980  format ('(a', i1, ')')
      end