time_storage.F90       coverage:  83.33 %func     48.17 %block


     1) module Time_Storage_module
     2)  
     3)   use PFLOTRAN_Constants_module
     4) 
     5)   implicit none
     6) 
     7)   private
     8) 
     9) #include "petsc/finclude/petscsys.h"
    10)   
    11)   type, public :: time_storage_type
    12)     PetscReal, pointer :: times(:)
    13)     PetscReal :: cur_time
    14)     PetscReal :: cur_time_fraction
    15)     PetscInt :: cur_time_index
    16)     PetscInt :: max_time_index
    17)     PetscBool :: is_cyclic
    18)     PetscReal :: time_shift    ! shift for cyclic data sets 
    19)     PetscBool :: cur_time_index_changed
    20)     PetscBool :: cur_time_fraction_changed
    21)     PetscInt :: time_interpolation_method
    22)     PetscBool :: force_update
    23)   end type time_storage_type
    24)   
    25)   public :: TimeStorageCreate, &
    26)             TimeStorageGetTimes, &
    27)             TimeStorageVerify, &
    28)             TimeStorageUpdate, &
    29)             TimeStoragePrint, &
    30)             TimeStorageDestroy
    31) 
    32) contains
    33) 
    34) ! ************************************************************************** !
    35) 
    36) function TimeStorageCreate()
    37)   ! 
    38)   ! Initializes a time storage
    39)   ! 
    40)   ! Author: Glenn Hammond
    41)   ! Date: 10/26/11, 05/03/13
    42)   ! 
    43) 
    44)   implicit none
    45)   
    46)   type(time_storage_type), pointer :: time_storage
    47)   type(time_storage_type), pointer :: TimeStorageCreate
    48) 
    49)   allocate(time_storage)
    50)   nullify(time_storage%times)
    51)   time_storage%cur_time = 0.d0
    52)   time_storage%cur_time_fraction = 0.d0
    53)   time_storage%cur_time_index = 0
    54)   time_storage%max_time_index = 0
    55)   time_storage%is_cyclic = PETSC_FALSE
    56)   time_storage%time_shift = 0.d0
    57)   time_storage%cur_time_index_changed = PETSC_FALSE
    58)   time_storage%cur_time_fraction_changed = PETSC_FALSE
    59)   time_storage%time_interpolation_method = INTERPOLATION_NULL
    60)   time_storage%force_update = PETSC_FALSE
    61)   
    62)   TimeStorageCreate => time_storage
    63)     
    64) end function TimeStorageCreate
    65) 
    66) ! ************************************************************************** !
    67) 
    68) subroutine TimeStorageVerify(default_time, time_storage, &
    69)                              default_time_storage, option)
    70)   ! 
    71)   ! Verifies the data in a time storage
    72)   ! 
    73)   ! Author: Glenn Hammond
    74)   ! Date: 10/26/11, 05/03/13
    75)   ! 
    76) 
    77)   use Option_module
    78) 
    79)   implicit none
    80)   
    81)   PetscReal :: default_time
    82)   type(time_storage_type), pointer :: time_storage
    83)   type(time_storage_type), pointer :: default_time_storage
    84)   type(option_type) :: option
    85)   
    86)   PetscInt :: array_size
    87)   
    88)   if (.not.associated(time_storage)) return
    89)   
    90)   if (associated(default_time_storage)) then
    91)     if (default_time_storage%is_cyclic) time_storage%is_cyclic = PETSC_TRUE
    92)     if (time_storage%time_interpolation_method == INTERPOLATION_NULL) then
    93)       time_storage%time_interpolation_method = &
    94)         default_time_storage%time_interpolation_method
    95)     endif
    96)   endif
    97)   
    98)   if (time_storage%time_interpolation_method == INTERPOLATION_NULL) then
    99)     option%io_buffer = 'Time interpolation method must be specified.'
   100)     call printErrMsg(option)
   101)   endif
   102)   
   103)   time_storage%max_time_index = 1
   104)   if (.not.associated(time_storage%times)) then
   105)     if (associated(default_time_storage)) then
   106)       if (.not.associated(default_time_storage%times)) then
   107)         array_size = 1
   108)         allocate(time_storage%times(array_size))
   109)         time_storage%times = default_time
   110)       else
   111)         array_size = size(default_time_storage%times,1)
   112)         allocate(time_storage%times(array_size))
   113)         time_storage%times(1:array_size) = &
   114)           default_time_storage%times(1:array_size)
   115)       endif
   116)     else
   117)       array_size = 1
   118)       allocate(time_storage%times(array_size))
   119)       time_storage%times = default_time
   120)     endif
   121)   endif
   122)   time_storage%max_time_index = size(time_storage%times,1) 
   123)   time_storage%cur_time_index = 1
   124)   
   125)   time_storage%time_shift = time_storage%times(time_storage%max_time_index)
   126) 
   127) end subroutine TimeStorageVerify
   128) 
   129) ! ************************************************************************** !
   130) 
   131) subroutine TimeStorageGetTimes(time_storage, option, max_sim_time, time_array)
   132)   ! 
   133)   ! Fills an array of times based on time storage
   134)   ! 
   135)   ! Author: Glenn Hammond
   136)   ! Date: 10/26/11, 05/03/13
   137)   ! 
   138) 
   139)   use Option_module
   140) 
   141)   implicit none
   142)   
   143)   type(time_storage_type), pointer :: time_storage
   144)   type(option_type) :: option
   145)   PetscReal :: max_sim_time
   146)   PetscReal, pointer :: time_array(:)
   147)   
   148)   PetscInt :: num_times
   149)   PetscInt :: itime
   150)   PetscReal :: time_shift
   151)   PetscReal, allocatable :: temp_times(:)
   152) 
   153)   if (.not.associated(time_storage)) then
   154)     nullify(time_array)
   155)     return
   156)   endif
   157)   
   158)   if (.not.time_storage%is_cyclic .or. time_storage%max_time_index == 1) then
   159)     allocate(time_array(time_storage%max_time_index))
   160)     time_array =  time_storage%times
   161)   else ! cyclic
   162)     num_times = (int(max_sim_time / &
   163)                      time_storage%times(time_storage%max_time_index))+1)* &
   164)                 time_storage%max_time_index
   165)     allocate(temp_times(num_times))
   166)     temp_times = 0.d0
   167) 
   168)     num_times = 0
   169)     itime = 0
   170)     time_shift = 0.d0
   171)     do
   172)       num_times = num_times + 1
   173)       itime = itime + 1
   174)       ! exit for non-cyclic - but is will never enter conditional given 
   175)       ! conditional above.
   176)       if (itime > time_storage%max_time_index) exit
   177)       temp_times(num_times) = time_storage%times(itime) + time_shift
   178)       if (mod(itime,time_storage%max_time_index) == 0) then
   179)         itime = 0
   180)         time_shift = time_shift + time_storage%times(time_storage%max_time_index) 
   181)       endif 
   182)       ! exit for cyclic
   183)       if (temp_times(num_times) >= max_sim_time) exit
   184)     enddo
   185) 
   186)     allocate(time_array(num_times))
   187)     time_array(:) = temp_times(1:num_times)
   188)     deallocate(temp_times)
   189)   endif
   190)  
   191) end subroutine TimeStorageGetTimes
   192) 
   193) ! ************************************************************************** !
   194) 
   195) subroutine TimeStoragePrint(time_storage,option)
   196)   ! 
   197)   ! Prints time storage info
   198)   ! 
   199)   ! Author: Glenn Hammond
   200)   ! Date: 10/26/11, 05/03/13
   201)   ! 
   202) 
   203)   use Option_module
   204) 
   205)   implicit none
   206)   
   207)   type(time_storage_type) :: time_storage
   208)   type(option_type) :: option
   209)   
   210)   character(len=MAXSTRINGLENGTH) :: string
   211) 
   212)   write(option%fid_out,'(8x,''Time Storage'')')
   213)   if (time_storage%is_cyclic) then
   214)     string = 'yes'
   215)   else
   216)     string = 'no'
   217)   endif
   218)   write(option%fid_out,'(8x,''Is cyclic: '',a)') trim(string)
   219)   if (size(time_storage%times) > 1) then  
   220)     write(option%fid_out,'(8x,''  Number of values: '', i7)') &
   221)       time_storage%max_time_index
   222)     write(option%fid_out,'(8x,''Start value:'',es16.8)') &
   223)       time_storage%times(1)
   224)     write(option%fid_out,'(8x,''End value:'',es16.8)') &
   225)       time_storage%times(time_storage%max_time_index)
   226)   else
   227)     write(option%fid_out,'(8x,''Value:'',es16.8)') time_storage%times(1)
   228)   endif
   229) 
   230)             
   231) end subroutine TimeStoragePrint
   232) 
   233) ! ************************************************************************** !
   234) 
   235) subroutine TimeStorageUpdate(time_storage)
   236)   ! 
   237)   ! Updates a time storage
   238)   ! 
   239)   ! Author: Glenn Hammond
   240)   ! Date: 10/26/11, 05/03/13
   241)   ! 
   242) 
   243)   use Option_module
   244)   
   245)   implicit none
   246)   
   247)   type(time_storage_type) :: time_storage
   248)   
   249)   PetscInt :: irank
   250)   PetscInt :: cur_time_index
   251)   PetscInt :: next_time_index
   252)   
   253)   ! cycle times if at max_time_index and cyclic
   254)   if (time_storage%cur_time_index == time_storage%max_time_index .and. &
   255)       time_storage%is_cyclic .and. time_storage%max_time_index > 1) then
   256)     do cur_time_index = 1, time_storage%max_time_index
   257)       time_storage%times(cur_time_index) = &
   258)         time_storage%times(cur_time_index) + time_storage%time_shift
   259)     enddo
   260)     time_storage%cur_time_index = 1
   261)   endif
   262)  
   263)   cur_time_index = time_storage%cur_time_index
   264)   next_time_index = min(time_storage%cur_time_index+1, &
   265)                         time_storage%max_time_index)
   266) 
   267)   ! initialize to no change
   268)   time_storage%cur_time_index_changed = PETSC_FALSE
   269)   ! find appropriate time interval
   270)   do
   271)     if (time_storage%cur_time < time_storage%times(next_time_index) .or. &
   272)         cur_time_index == next_time_index) &
   273)       exit
   274)     
   275)     if (cur_time_index /= next_time_index) &
   276)       ! toggle flag indicating a change in index
   277)       time_storage%cur_time_index_changed = PETSC_TRUE
   278)     cur_time_index = next_time_index
   279)     ! ensure that time index does not go beyond end of array
   280)     if (next_time_index < time_storage%max_time_index) then
   281)       next_time_index = next_time_index + 1
   282)     ! this conditional enable the code to find the correct
   283)     ! time index for a cyclic dataset
   284)     else if (time_storage%is_cyclic .and. time_storage%max_time_index > 1) then
   285)       do cur_time_index = 1, time_storage%max_time_index
   286)         time_storage%times(cur_time_index) = &
   287)           time_storage%times(cur_time_index) + time_storage%time_shift
   288)       enddo
   289)       cur_time_index = 1
   290)       next_time_index = 2
   291)     endif
   292)   enddo
   293)     
   294)   time_storage%cur_time_index = cur_time_index
   295)   if (cur_time_index < 1) then
   296)     return
   297)   else if (cur_time_index < time_storage%max_time_index) then
   298)     time_storage%cur_time_fraction_changed = PETSC_TRUE
   299)     ! fraction = (t-t1)/(t2-t1)
   300)     time_storage%cur_time_fraction = (time_storage%cur_time- &
   301)                                       time_storage%times(cur_time_index)) / &
   302)                                      (time_storage%times(next_time_index) - &
   303)                                       time_storage%times(cur_time_index))
   304)   else
   305)     if (dabs(time_storage%cur_time_fraction - 1.d0) < 1.d-10) then
   306)       ! essentially zero change
   307)       time_storage%cur_time_fraction_changed = PETSC_FALSE
   308)     else
   309)       time_storage%cur_time_fraction_changed = PETSC_TRUE
   310)       time_storage%cur_time_fraction = 1.d0
   311)     endif
   312)   endif
   313) 
   314)   if (time_storage%force_update) then
   315)     time_storage%cur_time_fraction_changed = PETSC_TRUE
   316)     time_storage%cur_time_index_changed = PETSC_TRUE
   317)     time_storage%force_update = PETSC_FALSE
   318)   endif
   319) 
   320) end subroutine TimeStorageUpdate
   321) 
   322) ! ************************************************************************** !
   323) 
   324) subroutine TimeStorageDestroy(time_storage)
   325)   ! 
   326)   ! Destroys a time storage associated with a sub_condition
   327)   ! 
   328)   ! Author: Glenn Hammond
   329)   ! Date: 10/26/11, 05/03/13
   330)   ! 
   331) 
   332)   implicit none
   333)   
   334)   type(time_storage_type), pointer :: time_storage
   335)   
   336)   if (.not.associated(time_storage)) return
   337)   
   338)   if (associated(time_storage%times)) deallocate(time_storage%times)
   339)   nullify(time_storage%times)
   340)   
   341)   deallocate(time_storage)
   342)   nullify(time_storage)
   343) 
   344) end subroutine TimeStorageDestroy
   345) 
   346) end module Time_Storage_module

generated by
Intel(R) C++/Fortran Compiler code-coverage tool
Web-Page Owner: Nobody