! ttesta.f90
!-----------------------------------------------------------------------------
! Test program to show the difference of treatment between a "regular array"
! and an "Allocatable" array in a derived type
!
! This snippet derives from the experience gained during a port of a large
! production system, the Telemac hydrodynamics solver
! (http://www.telemacsystem.com).
!
! Originally issued by Jean-Michel Hervouet - EDF - France
! Modified by Arnaud Desitter - (then at) Nag Ltd. - UK
!
! Use separate compilation and static archiving to defeat artificial
! optimization.
! typical example on Unix:
! f95 -O -c tlib.f90; f95 -O -c tdefa.f90; f95 -O -c tliba.f90;
! ar cr tlib.a tlib.o tdefp.o tliba.o;
! f95 -O -c ttesta.f90;  f95 -O -o ttest ttesta.o tlib.a; ./ttest
!-----------------------------------------------------------------------------
PROGRAM TTEST
  USE T_DEFA
  USE T_LIB
  USE T_LIBA
  IMPLICIT NONE
  !
  INTEGER :: I
  INTEGER, PARAMETER :: N1=1000, N2=200, N=1000
  DOUBLE PRECISION :: t1, t2
  DOUBLE PRECISION :: timings(14)
  TYPE(T_OBJ)                   :: A_STRUCT   ,B_STRUCT
  DOUBLE PRECISION, ALLOCATABLE :: A_NORMAL(:,:),B_NORMAL(:,:)
  !
  ALLOCATE(A_STRUCT%R(N1,N2))
  ALLOCATE(B_STRUCT%R(N1,N2))
  ALLOCATE(A_NORMAL(N1,N2))
  ALLOCATE(B_NORMAL(N1,N2))
  B_STRUCT%R = 1.D0
  B_NORMAL = 1.D0
  !
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV(A_NORMAL,B_NORMAL,N1,N2)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(1)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV(A_STRUCT%R,B_STRUCT%R,N1,N2)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(2)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH1(A_NORMAL,B_NORMAL)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(3)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH1(A_STRUCT%R,B_STRUCT%R)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(4)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH2(A_NORMAL,B_NORMAL)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(5)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH2(A_STRUCT%R,B_STRUCT%R)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(6)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_DT(A_STRUCT,B_STRUCT)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(7)=(T2-T1)
  !
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_AN(A_NORMAL,B_NORMAL,N1,N2)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(8)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_AN(A_STRUCT%R,B_STRUCT%R,N1,N2)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(9)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH1_AN(A_NORMAL,B_NORMAL)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(10)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH1_AN(A_STRUCT%R,B_STRUCT%R)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(11)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH2_AN(A_NORMAL,B_NORMAL)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(12)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_SH2_AN(A_STRUCT%R,B_STRUCT%R)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(13)=(T2-T1)
  CALL TIME_IN_SECONDS(T1)
  DO I=1,N
     CALL OV_DT_AN(A_STRUCT,B_STRUCT)
  ENDDO
  CALL TIME_IN_SECONDS(T2)
  timings(14)=(T2-T1)
  !
  timings=timings/timings(1)
  WRITE(unit=*,fmt=10) timings(2:)
10 FORMAT(&
        1x,"Abstraction penalty versus",/,&
        1x," regular array + assumed size dummy argument + do loop",/,&
        1x,"(1 means no penalty)",/,&
        1x,"Using Do loop",/,&
        1x," Derived type allocatable + assumed size    : ",F8.2,/,&
        1x," Regular array + assumed shape 1            : ",F8.2,/,&
        1x," Derived type allocatable + assumed shape 1 : ",F8.2,/,&
        1x," Regular array + assumed shape 2            : ",F8.2,/,&
        1x," Derived type allocatable + assumed shape 2 : ",F8.2,/,&
        1x," Derived type allocatable + Derived type    : ",F8.2,/,&
        1x,"Using array notation",/,&
        1x," Regular array + assumed size               : ",F8.2,/,&
        1x," Derived type allocatable + assumed size    : ",F8.2,/,&
        1x," Regular array + assumed shape 1            : ",F8.2,/,&
        1x," Derived type allocatable + assumed shape 1 : ",F8.2,/,&
        1x," Regular array + assumed shape 2            : ",F8.2,/,&
        1x," Derived type allocatable + assumed shape 2 : ",F8.2,/,&
        1x," Derived type allocatable + Derived type    : ",F8.2,/)
CONTAINS
  SUBROUTINE TIME_IN_SECONDS ( t )
    IMPLICIT NONE
    !
    DOUBLE PRECISION, INTENT(out) :: T
    INTEGER :: TEMPS,PARSEC
    INTRINSIC dble
    !
    CALL SYSTEM_CLOCK(COUNT=TEMPS,COUNT_RATE=PARSEC)
    T = DBLE(TEMPS) / PARSEC
    !
    RETURN
  END SUBROUTINE TIME_IN_SECONDS
END PROGRAM TTEST