mode_write_cover_tex.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.
!     ##########################
      MODULE mode_write_cover_tex
!     ##########################
!
!-------------------------------------------------------------------------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
CONTAINS
!
!-------------------------------------------------------------------------------
!
FUNCTION nb (PX,KMAX)  RESULT (KNB)
!
IMPLICIT NONE
!
REAL,    INTENT(IN)            :: PX   ! real
INTEGER, INTENT(IN), OPTIONAL  :: KMAX
INTEGER                        :: KNB  !
!
INTEGER :: IMAX     ! maximum number of decimals
INTEGER :: IX
INTEGER :: JK
INTEGER :: IDEC,IINT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:NB',0,zhook_handle)
imax=2
IF (PRESENT(kmax)) imax=kmax
!
iint=0
!

DO jk=0,8
  IF ( int(px/10**jk+1.e-7)/=0 ) iint=iint+1
END DO
!
DO jk=1,4
  ix=int(px*10**imax+1.e-7)
  IF (ix==0) THEN
    imax=imax+1
  ELSE
    EXIT
  END IF
END DO
IF (ix==0) imax=2
!
idec=imax
!
DO jk=1,imax
  IF ( ix == nint(ix/float(10**jk))*10**jk ) THEN
    idec=idec-1
  END IF
END DO
!
knb=max(iint,1)+idec+1
knb=knb+1
IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:NB',1,zhook_handle)
!
END FUNCTION nb
!
!-------------------------------------------------------------------------------
!
FUNCTION nbt (PX,KMAX)  RESULT (KNBT)
!
IMPLICIT NONE
!
REAL,    INTENT(IN)            :: PX   ! real
INTEGER, INTENT(IN), OPTIONAL  :: KMAX
INTEGER                        :: KNBT !
!
INTEGER :: IMAX     ! maximum number of decimals
INTEGER :: IX
INTEGER :: JK
INTEGER :: IDEC,IINT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:NBT',0,zhook_handle)
imax=2
IF (PRESENT(kmax)) imax=kmax
!
iint=0
!
DO jk=0,8
  IF ( int(px/10.**jk+1.e-7)/=0 ) iint=iint+1
END DO
!
DO jk=1,4
  ix=int(px*10**imax+1.e-7)
  IF (ix==0) THEN
    imax=imax+1
  ELSE
    EXIT
  END IF
END DO
IF (ix==0) imax=2
!
idec=imax
!
DO jk=1,imax
  IF ( ix == nint(ix/float(10**jk))*10**jk ) THEN
    idec=idec-1
  END IF
END DO
!
knbt=max(iint+idec+1,2)
knbt=knbt+1
IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:NBT',1,zhook_handle)
!
END FUNCTION nbt
!
!-------------------------------------------------------------------------------
!
FUNCTION dec (PX,KMAX) RESULT (KDEC)
!
IMPLICIT NONE
!
REAL,    INTENT(IN)            :: PX   ! real
INTEGER, INTENT(IN), OPTIONAL  :: KMAX
INTEGER                        :: KDEC ! number of decimals of PX
!
INTEGER :: IMAX     ! maximum number of decimals
INTEGER :: IX
INTEGER :: JK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:DEC',0,zhook_handle)
imax=2
IF (PRESENT(kmax)) imax=kmax
!
!
DO jk=1,4
  ix=int(px*10**imax+1.e-7)
  IF (ix==0) THEN
    imax=imax+1
  ELSE
    EXIT
  END IF
END DO
IF (ix==0) imax=2
!
kdec=imax
!
DO jk=1,imax
  IF ( ix == nint(ix/float(10**jk))*10**jk ) THEN
    kdec=kdec-1
  END IF
END DO
IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:DEC',1,zhook_handle)
!
!
END FUNCTION dec
!-------------------------------------------------------------------------------
SUBROUTINE hline(KTEX,GLINE,I)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN)    :: KTEX  ! logical unit
LOGICAL, INTENT(INOUT) :: GLINE ! flag to write one line
INTEGER, INTENT(IN)    :: I     ! line number
REAL(KIND=JPRB) :: ZHOOK_HANDLE

  IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:HLINE',0,zhook_handle)
  IF ((i==3 .OR. i==  7 .OR. i==  9 .OR. i==15  .OR. i== 23 .OR. i== 24 &
              .OR. i== 28 .OR. i== 33 .OR. i==47  .OR. i== 66 .OR. i== 79 &
              .OR. i== 87 .OR. i==104 .OR. i==122 .OR. i==123 .OR. i==125 &
              .OR. i==161 .OR. i==173 .OR. i==176 .OR. i==181 .OR. i==186 &
              .OR. i==191 .OR. i==197 .OR. i==198 .OR. i==207 .OR. i==214 &
              .OR. i==219 .OR. i==225 .OR. i==229 .OR. i==232 .OR. i==235 &
              .OR. i==241 .OR. i==243                                    )&
             .AND. gline ) THEN  
    WRITE(ktex,*) '\hline'
    gline=.false.
  END IF
IF (lhook) CALL dr_hook('MODE_WRITE_COVER_TEX:HLINE',1,zhook_handle)
END SUBROUTINE hline
!-------------------------------------------------------------------------------
END MODULE mode_write_cover_tex