trans_chaine.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!
SUBROUTINE trans_chaine(HCHAINE,KENTIER,KOPTION)
!----------------------------------------------------------
!
! transforme l'entier 23416 en la chaine de caracteres '23416' 
! option est utilise si superieur a 0. Dans ce cas si l'entier
! a un nombre de digits inferieur a option, la difference est
! remplie avec des '0' dans chaine.
!
!
! ex: entier=256 option=0  ===>   chaine='256'
!     entier=256 option=2  ===>   chaine='256'
!     entier=256 option=7  ===>   chaine='0000256'
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
INTEGER,          INTENT(IN ) :: kentier, koption
 CHARACTER(LEN=*), INTENT(OUT) :: hchaine
!
 CHARACTER :: yc
INTEGER :: idivi
INTEGER :: ireste, inbdigit, inum
INTEGER:: i, j
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('TRANS_CHAINE',0,zhook_handle)
!
hchaine = ''
!
ireste   = kentier
!
IF (kentier==0) THEN
  inbdigit = 1
ELSE
  inbdigit = int( log(kentier*1.)/log(10.)+0.001 ) + 1
ENDIF
!
idivi = 10**(inbdigit-1)
!
IF ( koption.GT.max(0,inbdigit) ) THEN
  !
  DO i = 1, koption-inbdigit
    hchaine(i:i) = '0'
  END DO
  !     
ENDIF
!
DO i = 1,inbdigit
!
  inum = int(ireste*1./idivi)
  yc = char(inum+48)
  IF (koption.GT.0) THEN
    j = koption-inbdigit+i
  ELSEIF (koption.EQ.0) THEN
    j = i
  ENDIF
  hchaine(j:j) = yc
  ireste = ireste - inum*idivi
  idivi = idivi/10
!
END DO
!
IF (lhook) CALL dr_hook('TRANS_CHAINE',1,zhook_handle)
!---------------
END SUBROUTINE trans_chaine