tool1.f

!*****************************************************************!
!*                                                               *!
!*              4C (FORESEE) Simulation Model                    *!
!*                                                               *!
!*                                                               *!
!*              Subroutines for standard tasks                   *!
!*                                                               *!
!*   contains:                                                   *!
!*   DAINTZ		    Date to day of the year                      *!
!*   TZINDA		    Day of the year to date                      *!
!*   TAB_INT        Table function                               *!
!*   CHARACTER_IN_INTEGER  Conversion of character in integer    *!
!*   INTEGER_IN_CHARACTER  Conversion of integer in character    *!
!*   QUANTILE       calculates the 0.05 and 0.95 quantile        *!
!*   QUANT_CALC     calculates a quantile of a sorted array      *!
!*                                                               *!
!*                  Copyright (C) 1996-2018                      *!
!*     Potsdam Institute for Climate Impact Reserach (PIK)       *!
!*          Authors and contributors see AUTHOR file             *!
!*  This file is part of 4C and is licensed under BSD-2-Clause   *!
!*                   See LICENSE file or under:                  *!
!*     http://www.https://opensource.org/licenses/BSD-2-Clause   *!
!*                           Contact:                            *!
!*       https://gitlab.pik-potsdam.de/foresee/4C                *!
!*                                                               *!
!*****************************************************************!


      SUBROUTINE DAINTZ(IT,IM,IJ,TZ)

!    Umrechnen von Datum in Tageszaehler

      implicit none

      INTEGER IT, IM, IJ, TZ
      INTEGER I, ME
      REAL, DIMENSION(12):: MNL   
!      COMMON /MONTH/ MMM(12),JAHR,JS,IC
      DATA MNL /31,28,31,30,31,30,31,31,30,31,30,31/
      
      TZ=IT
      IF (IM.EQ.1) RETURN
      ME=IM-1
      
      if (mod(IJ,4).EQ.0) MNL(2)=29
      if ((IJ .eq. 1900) .or. (IJ .eq. 1800) .or. (IJ .eq. 1700)) MNL(2)=28
      DO I=1,ME
         TZ=TZ+MNL(I)
      enddo
      MNL(2)=28
        
      END SUBROUTINE DAINTZ

!***********************************************************************

      SUBROUTINE TZINDA(T,M,J,TZ)

!    Umrechnen von Tageszaehler in Datum 

      implicit none

      INTEGER MNL(12)
      INTEGER T, M, J, TZ
      DATA MNL /31,28,31,30,31,30,31,31,30,31,30,31/
      
      if (mod(J,4).EQ.0) MNL(2)=29
      if ((J .eq. 1900) .or. (J .eq. 1800) .or. (J .eq. 1700)) MNL(2)=28
      T=TZ
      M=1
      do while (T .gt. MNL(M))
        T=T-MNL(M)
        M=M+1
        if (M .gt. 12) return
      enddo
      MNL(2)=28      
      
      END SUBROUTINE TZINDA                             
      
!***********************************************************************
 
SUBROUTINE tab_int(x,y,idim,arg,val)

! Read a table function with ordered pairs x,y (sortet)
! linear interpolation between 

implicit none

!  input
integer idim                    ! dimension of array x, y 
real, dimension(idim)  :: x, y  ! table values
real    arg                     ! argument of function
! output
real    val                   ! result
integer i

if (arg .le. x(1)) then
    val = y(1)
else if	(arg .ge. x(idim)) then
    val = y(idim)
else
    i = 2
    do while ((i .lt. idim) .and. (arg .gt. x(i)))
       i = i+1 
    enddo
    if (arg .eq. x(i)) then
        val = y(i)
    else
        val = y(i) + (y(i)-y(i-1)) * (arg-x(i)) / (x(i)-x(i-1))
    endif
endif

END subroutine tab_int

!***********************************************************************

SUBROUTINE character_in_integer(string, vint)

! Conversion of character variable in integer variable

implicit none

integer vint
character (100) string
character (10) help

    write(help,'(A)') string
    read(help,*) vint

END subroutine character_in_integer

!**************************************************************

SUBROUTINE integer_in_character(vint, string)

! Conversion of integer variable in character variable

implicit none

integer vint
character (10) string
character (10) help


    write(help,'(I10)') vint
    read(help,*) string

END subroutine integer_in_character

!**************************************************************

 SUBROUTINE quantile(idim, arr, quant05, quant95, median)
 
 ! sorts and calculates the 0.05 and 0.95 quantile of an array with dimension idim

 implicit none

 !  input
integer idim                  ! dimension of array arr 
real, dimension(idim) :: arr  ! array
! output
real quant05, quant95, median         ! 0.05 and 0.95 quantile

call sort(idim,arr) 

call quant_calc(idim, arr, 0.05, quant05)   ! 0.05 quantile
call quant_calc(idim, arr, 0.95, quant95)   ! 0.95 quantile
call quant_calc(idim, arr, 0.5, median)     ! 0.95 quantile

END SUBROUTINE quantile

!**************************************************************

 SUBROUTINE quant_calc(idim, arr, pord, quant)
 
 ! calculates a quantile of a sorted array with dimension idim

 implicit none

integer idim                    ! dimension of array arr 
real, dimension(idim) :: arr    ! array
real    quant                   ! quantile
real    pord, help              ! order
integer ihelp

help = idim * pord
ihelp = int(help)
if (ihelp*1.0 .lt. help) then
    quant = arr(ihelp+1)
else
    quant = (arr(ihelp+1) + arr(ihelp)) / 2.
endif

END SUBROUTINE quant_calc

!**************************************************************