Skip to content

Commit

Permalink
GitHub Issue NOAA-EMC#13. Continuing to clear through coding standard…
Browse files Browse the repository at this point in the history
… issues in the master. Finished through src/gsi/m_stubtimer.f90.
  • Loading branch information
MichaelLueken committed Aug 19, 2020
1 parent 856d5f8 commit e65cf4a
Show file tree
Hide file tree
Showing 2 changed files with 94 additions and 94 deletions.
8 changes: 4 additions & 4 deletions src/gsi/m_stats.f90
Original file line number Diff line number Diff line change
Expand Up @@ -56,15 +56,15 @@ module m_stats
! use m_stats,only : stats_allreduce
!
! type vectors
! real(r_kind),dimension(:),pointer :: v
! real(r_kind),dimension(:),pointer :: v
! endtype vectors
! type(vectors),dimension(:) :: a
!
! real(r_kind) :: vdot,vsum,vmin,vmax
! integer(i_kind) :: vnum
!
! do i=1,size(a)
! call stats_sum(a(i)%v,vdot,vsum,vmin,vmax,vnum,add=i>1)
! call stats_sum(a(i)%v,vdot,vsum,vmin,vmax,vnum,add=i>1)
! enddo
! call stats_allreduce(vdot,vsum,vmin,vmax,vnum,comm)
!
Expand Down Expand Up @@ -113,8 +113,8 @@ subroutine sum_(v,vdot,vsum,vmin,vmax,vdim,add)
if(.not.add_) then
vdot=zero
vsum=zero
vmin=+HUGE(vmin)
vmax=-HUGE(vmax)
vmin=+huge(vmin)
vmax=-huge(vmax)
vdim=0
endif

Expand Down
180 changes: 90 additions & 90 deletions src/gsi/m_stubTimer.f90 → src/gsi/m_stubtimer.f90
Original file line number Diff line number Diff line change
@@ -1,19 +1,19 @@
module m_abstractTimer
module m_abstracttimer
!$$$ subprogram documentation block
! . . . .
! subprogram: module m_abstractTimer
! subprogram: module m_abstracttimer
! prgmmr: j guo <jguo@nasa.gov>
! org: NASA/GSFC, Global Modeling and Assimilation Office, 610.3
! date: 2017-06-30
!
! abstract: an abstract multi-timer replacing stub_timermod.f90 with m_stubTimer
! abstract: an abstract multi-timer replacing stub_timermod.f90 with m_stubtimer
!
! program history log:
! 2017-06-30 j guo - Replaced stub_timermod with this module and module
! m_stubTimer, in the same file m_stubTimer.f90.
! . With abstractTimer type and stubTimer type, this
! implementation is extensible either from abstractTimer
! or from default stubTimer.
! m_stubtimer, in the same file m_stubtimer.f90.
! . With abstracttimer type and stubtimer type, this
! implementation is extensible either from abstracttimer
! or from default stubtimer.
!
! input argument list: see Fortran inline document below
!
Expand All @@ -30,110 +30,110 @@ module m_abstractTimer
use mpeu_util, only: tell
implicit none
private
public:: abstractTimer
public:: abstractTimer_typename

interface abstractTimer_typename; module procedure typename_; end interface

type, abstract:: abstractTimer
private
contains
procedure(mytype ),nopass,deferred:: mytype ! typename inquiry
procedure(on ), deferred:: on ! turn on a single named timer
procedure(off ), deferred:: off ! turn off a single named timer
procedure(reset ), deferred:: reset ! reset all timers
procedure(flush ), deferred:: flush ! summerize all local timers
procedure(allflush), deferred:: allflush ! reduce-summarize distributed timers
end type abstractTimer
public:: abstracttimer
public:: abstracttimer_typename

interface abstracttimer_typename; module procedure typename_; end interface

type, abstract:: abstracttimer
private
contains
procedure(mytype ),nopass,deferred:: mytype ! typename inquiry
procedure(on ), deferred:: on ! turn on a single named timer
procedure(off ), deferred:: off ! turn off a single named timer
procedure(reset ), deferred:: reset ! reset all timers
procedure(flush ), deferred:: flush ! summerize all local timers
procedure(allflush), deferred:: allflush ! reduce-summarize distributed timers
end type abstracttimer

abstract interface
function mytype() result(type_)
implicit none
character(:),allocatable:: type_
end function mytype
function mytype() result(type_)
implicit none
character(:),allocatable:: type_
end function mytype
end interface

abstract interface
subroutine on(tm,name)
import abstractTimer
implicit none
class(abstractTimer), intent(inout):: tm
character(len=*) , intent(in ):: name
end subroutine on
subroutine on(tm,name)
import abstracttimer
implicit none
class(abstracttimer), intent(inout):: tm
character(len=*) , intent(in ):: name
end subroutine on
end interface

abstract interface
subroutine off(tm,name)
import abstractTimer
implicit none
class(abstractTimer), intent(inout):: tm
character(len=*) , intent(in ):: name
end subroutine off
subroutine off(tm,name)
import abstracttimer
implicit none
class(abstracttimer), intent(inout):: tm
character(len=*) , intent(in ):: name
end subroutine off
end interface

abstract interface
subroutine reset(tm)
import abstractTimer
implicit none
class(abstractTimer), intent(inout):: tm
end subroutine reset
subroutine reset(tm)
import abstracttimer
implicit none
class(abstracttimer), intent(inout):: tm
end subroutine reset
end interface

abstract interface
subroutine flush(tm,lu)
import abstractTimer
import i_kind
implicit none
class(abstractTimer), intent(in):: tm
integer(kind=i_kind), intent(in):: lu
end subroutine flush
subroutine flush(tm,lu)
import abstracttimer
import i_kind
implicit none
class(abstracttimer), intent(in):: tm
integer(kind=i_kind), intent(in):: lu
end subroutine flush
end interface

abstract interface
subroutine allflush(tm,lu,comm,root)
import abstractTimer
import i_kind
implicit none
class(abstractTimer), intent(in):: tm
integer(kind=i_kind), intent(in):: lu
integer(kind=i_kind), intent(in):: comm
integer(kind=i_kind), intent(in):: root
end subroutine allflush
subroutine allflush(tm,lu,comm,root)
import abstracttimer
import i_kind
implicit none
class(abstracttimer), intent(in):: tm
integer(kind=i_kind), intent(in):: lu
integer(kind=i_kind), intent(in):: comm
integer(kind=i_kind), intent(in):: root
end subroutine allflush
end interface

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
character(len=*),parameter :: myname='m_abstractTimer'
character(len=*),parameter :: myname='m_abstracttimer'

contains
function typename_() result(typename)
!-- Return the type name.
implicit none
character(len=:),allocatable:: typename
typename="[abstractTimer]"
typename="[abstracttimer]"
end function typename_

end module m_abstractTimer
end module m_abstracttimer

module m_stubTimer
module m_stubtimer
!$$$ subprogram documentation block
! . . . .
! subprogram: module m_abstractTimer
! subprogram: module m_abstracttimer
! prgmmr: todling org: gmao date: 2007-10-01
!
! abstract: a do-nothing multi-timer
!
! program history log:
! 2007-10-01 todling - Original stub_timermod
! 2009-02-26 todling - if-def from GMAO_FVGSI to GEOS_PERT
! 2009-02-26 todling - if-def from gmao_fvgsi to geos_pert
! 2009-08-13 lueken - update documentation
! 2010-06-16 guo - separated stub implementation with implicit interfaces
! from module implementation with explicit interfaces.
! 2011-08-01 lueken - replaced F90 with f90 (no machine logic)
! 2017-06-30 j guo - replaced stub_timermod.f90 with this module and module
! m_stubTimer, in the same file m_stubTimer.f90.
! . With abstractTimer type and stubTimer type, this
! implementation is extensible either from abstractTimer
! or from default stubTimer.
! m_stubtimer, in the same file m_stubtimer.f90.
! . With abstracttimer type and stubtimer type, this
! implementation is extensible either from abstracttimer
! or from default stubtimer.
!
! input argument list: see Fortran inline document below
!
Expand All @@ -145,27 +145,27 @@ module m_stubTimer
!
!$$$ end subprogram documentation block

use m_abstractTimer, only: abstractTimer
use m_abstracttimer, only: abstracttimer
use kinds , only: i_kind
use mpeu_util, only: tell,die
implicit none
private
public:: timer
public:: timer_typemold

type, extends(abstractTimer):: timer
private
contains
! see m_abstractTimer for more information
procedure,nopass:: mytype
procedure:: on
procedure:: off
procedure:: reset
procedure:: flush
procedure:: allflush
type, extends(abstracttimer):: timer
private
contains
! see m_abstracttimer for more information
procedure,nopass:: mytype
procedure:: on
procedure:: off
procedure:: reset
procedure:: flush
procedure:: allflush
end type timer

character(len=*),parameter:: myname ="m_stubTimer"
character(len=*),parameter:: myname ="m_stubtimer"
type(timer),target:: typemold_

logical,parameter:: verbose=.false.
Expand All @@ -181,8 +181,8 @@ function timer_typemold() result(typemold)
end function timer_typemold

!--------------------------------------------------
! type-bound-procedures. See type(abstrctTimer) in module
! m_abstractTimer for sepcifications.
! type-bound-procedures. See type(abstrcttimer) in module
! m_abstracttimer for specifications.
function mytype()
implicit none
character(len=:), allocatable:: mytype
Expand Down Expand Up @@ -217,19 +217,19 @@ subroutine flush(tm,lu)
end subroutine flush

subroutine allflush(tm,lu,comm,root)
use mpeu_mpif,only: MPI_ikind
use mpeu_mpif,only: mpi_ikind
implicit none
class(timer) , intent(in):: tm ! a handle to this timer
integer(kind=i_kind), intent(in):: lu ! output logic unit
integer(kind=i_kind), intent(in):: comm ! communicator
integer(kind=i_kind), intent(in):: root ! root PE
integer(kind=i_kind), intent(in):: root ! root pe

character(len=*),parameter:: myname_=myname//'::allflush'
integer(kind=MPI_ikind):: myPE,ier
integer(kind=mpi_ikind):: mype,ier

call MPI_comm_rank(comm,myPE,ier)
if(ier/=0) call die(myname_,'MPI_comm_rank(), ierror =',ier)
if(verbose.and.myPE==root) call tell(tm%mytype()//'%allflush','no action taken, lu =',lu)
call mpi_comm_rank(comm,mype,ier)
if(ier/=0) call die(myname_,'mpi_comm_rank(), ierror =',ier)
if(verbose.and.mype==root) call tell(tm%mytype()//'%allflush','no action taken, lu =',lu)
end subroutine allflush

end module m_stubTimer
end module m_stubtimer

0 comments on commit e65cf4a

Please sign in to comment.