examples/smpi/energy/f77/sef.f

   1 ! Copyright (c) 2013-2014. The SimGrid Team.
   2 ! All rights reserved.
   3
   4 ! This program is free software; you can redistribute it and/or modify it
   5 ! under the terms of the license (GNU LGPL) which comes with this package.
   6
   7       program main
   8       include 'mpif.h'
   9
  10       integer ierr
  11       integer rank, pstates
  12       integer i
  13       double precision p, t, e
  14
  15       call MPI_Init(ierr)
  16       if (ierr .ne. MPI_SUCCESS) then
  17          print *, 'MPI_Init failed:', ierr
  18          stop 1
  19       endif
  20       call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr)
  21       if (ierr .ne. MPI_SUCCESS) then
  22          print *, 'MPI_Comm_rank failed:', ierr
  23          call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
  24          stop 1
  25       endif
  26
  27       pstates = smpi_get_host_nb_pstates()
  28
  29       t = MPI_Wtime()
  30
  31       print '(1a,F15.8,1a,i2,1a,i2,1a)', '[', t, '] [rank ', rank, '] ',
  32      &     pstates, ' pstates available'
  33
  34       do i = 0, pstates - 1
  35          p = smpi_get_host_power_peak_at(i)
  36          print '(1a,F15.8,1a,i2,1a,F15.4)', '[', t, '] [rank ',
  37      &     rank, '] Power: ', p
  38       end do
  39
  40       do i = 0, pstates - 1
  41          call smpi_set_host_pstate(i)
  42          t = MPI_Wtime()
  43          p = smpi_get_host_current_power_peak()
  44          print '(1a,F15.8,1a,i2,1a,i2,1a,F15.4)', '[', t, '] [rank ',
  45      &         rank,'] Current pstate: ', i,'; Current power: ', p
  46
  47          e = 1e9
  48          call smpi_execute_flops(e)
  49
  50          t = MPI_Wtime()
  51          e = smpi_get_host_consumed_energy()
  52          print '(1a,F15.8,1a,i2,1a,1a,F15.4)', '[', t, '] [rank ',
  53      &         rank, ']',' Energy consumed (Joules): ', e
  54       end do
  55
  56       flush(6)
  57
  58       call MPI_Finalize(ierr)
  59       if (ierr .ne. MPI_SUCCESS) then
  60          print *, 'MPI_Finalize failed:', ierr
  61          call MPI_Abort(MPI_COMM_WORLD, 1, ierr)
  62          stop 1
  63       endif
  64
  65       end program main