MAPL_Sleep.F90 Source File


Files dependent on this one

sourcefile~~mapl_sleep.f90~~AfferentGraph sourcefile~mapl_sleep.f90 MAPL_Sleep.F90 sourcefile~maplshared.f90 MaplShared.F90 sourcefile~maplshared.f90->sourcefile~mapl_sleep.f90 sourcefile~extdataroot_gridcomp.f90 ExtDataRoot_GridComp.F90 sourcefile~extdataroot_gridcomp.f90->sourcefile~maplshared.f90 sourcefile~mapl.f90 MAPL.F90 sourcefile~extdataroot_gridcomp.f90->sourcefile~mapl.f90 sourcefile~mapl_generic.f90 MAPL_Generic.F90 sourcefile~mapl_generic.f90->sourcefile~maplshared.f90 sourcefile~capdriver.f90 CapDriver.F90 sourcefile~capdriver.f90->sourcefile~extdataroot_gridcomp.f90 sourcefile~capdriver.f90->sourcefile~mapl.f90 sourcefile~comp_testing_driver.f90 Comp_Testing_Driver.F90 sourcefile~comp_testing_driver.f90->sourcefile~mapl_generic.f90 sourcefile~comp_testing_driver.f90->sourcefile~mapl.f90 sourcefile~mapl_capgridcomp.f90 MAPL_CapGridComp.F90 sourcefile~comp_testing_driver.f90->sourcefile~mapl_capgridcomp.f90 sourcefile~extdatadriver.f90 ExtDataDriver.F90 sourcefile~extdatadriver.f90->sourcefile~extdataroot_gridcomp.f90 sourcefile~extdatadrivermod.f90 ExtDataDriverMod.F90 sourcefile~extdatadriver.f90->sourcefile~extdatadrivermod.f90 sourcefile~extdatadriver.f90->sourcefile~mapl.f90 sourcefile~extdatadrivermod.f90->sourcefile~extdataroot_gridcomp.f90 sourcefile~extdatadrivermod.f90->sourcefile~mapl.f90 sourcefile~extdatagridcompmod.f90 ExtDataGridCompMod.F90 sourcefile~extdatagridcompmod.f90->sourcefile~mapl_generic.f90 sourcefile~extdatagridcompng.f90 ExtDataGridCompNG.F90 sourcefile~extdatagridcompng.f90->sourcefile~mapl_generic.f90 sourcefile~mapl.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_capgridcomp.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_capgridcomp.f90->sourcefile~extdatagridcompmod.f90 sourcefile~mapl_capgridcomp.f90->sourcefile~extdatagridcompng.f90 sourcefile~mapl_historygridcomp.f90 MAPL_HistoryGridComp.F90 sourcefile~mapl_capgridcomp.f90->sourcefile~mapl_historygridcomp.f90 sourcefile~mapl_geosatmaskmod.f90 MAPL_GeosatMaskMod.F90 sourcefile~mapl_geosatmaskmod.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_historycollection.f90 MAPL_HistoryCollection.F90 sourcefile~mapl_historycollection.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_historycollection.f90->sourcefile~mapl_geosatmaskmod.f90 sourcefile~mapl_stationsamplermod.f90 MAPL_StationSamplerMod.F90 sourcefile~mapl_historycollection.f90->sourcefile~mapl_stationsamplermod.f90 sourcefile~mapl_trajectorymod.f90 MAPL_TrajectoryMod.F90 sourcefile~mapl_historycollection.f90->sourcefile~mapl_trajectorymod.f90 sourcefile~mapl_historygridcomp.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_historygridcomp.f90->sourcefile~mapl_geosatmaskmod.f90 sourcefile~mapl_historygridcomp.f90->sourcefile~mapl_historycollection.f90 sourcefile~mapl_historygridcomp.f90->sourcefile~mapl_stationsamplermod.f90 sourcefile~mapl_historygridcomp.f90->sourcefile~mapl_trajectorymod.f90 sourcefile~mapl_orbgridcompmod.f90 MAPL_OrbGridCompMod.F90 sourcefile~mapl_orbgridcompmod.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_stationsamplermod.f90->sourcefile~mapl_generic.f90 sourcefile~mapl_trajectorymod.f90->sourcefile~mapl_generic.f90 sourcefile~extdatadrivergridcomp.f90 ExtDataDriverGridComp.F90 sourcefile~extdatadrivergridcomp.f90->sourcefile~extdatagridcompmod.f90 sourcefile~extdatadrivergridcomp.f90->sourcefile~extdatagridcompng.f90 sourcefile~extdatadrivergridcomp.f90->sourcefile~mapl.f90 sourcefile~extdatadrivergridcomp.f90->sourcefile~mapl_historygridcomp.f90 sourcefile~mapl_cap.f90 MAPL_Cap.F90 sourcefile~mapl_cap.f90->sourcefile~mapl_capgridcomp.f90 sourcefile~mapl_demo_fargparse.f90 MAPL_demo_fargparse.F90 sourcefile~mapl_demo_fargparse.f90->sourcefile~mapl.f90 sourcefile~mapl_geosatmaskmod_smod.f90 MAPL_GeosatMaskMod_smod.F90 sourcefile~mapl_geosatmaskmod_smod.f90->sourcefile~mapl_geosatmaskmod.f90 sourcefile~mapl_trajectorymod_smod.f90 MAPL_TrajectoryMod_smod.F90 sourcefile~mapl_trajectorymod_smod.f90->sourcefile~mapl_trajectorymod.f90 sourcefile~pfio_mapl_demo.f90 pfio_MAPL_demo.F90 sourcefile~pfio_mapl_demo.f90->sourcefile~mapl.f90 sourcefile~regrid_util.f90 Regrid_Util.F90 sourcefile~regrid_util.f90->sourcefile~mapl.f90 sourcefile~time_ave_util.f90 time_ave_util.F90 sourcefile~time_ave_util.f90->sourcefile~mapl.f90 sourcefile~ut_extdata.f90 ut_ExtData.F90 sourcefile~ut_extdata.f90->sourcefile~extdatagridcompmod.f90 sourcefile~varspecdescription.f90 VarspecDescription.F90 sourcefile~varspecdescription.f90->sourcefile~mapl.f90

Source Code

module MAPL_SleepMod

use, intrinsic :: iso_fortran_env, only: REAL64,INT64
implicit none
private

public MAPL_Sleep

contains

! wait time in seconds
subroutine MAPL_Sleep(wait_time)
real, intent(in) :: wait_time

integer(kind=INT64) :: s1,s2,count_max,count_rate,delta
real(kind=REAL64) :: seconds_elapsed

call system_clock(count=s1,count_rate=count_rate,count_max=count_max)

do 

   call system_clock(count=s2)
   delta = s2-s1
   if (delta < 0) delta= s2 + (count_max - mod(s1,count_max))
   seconds_elapsed = dble(delta)/dble(count_rate)
   if (seconds_elapsed > wait_time) exit

enddo

end subroutine
end module MAPL_SleepMod