waypoint.F90       coverage:  72.73 %func     45.93 %block


     1) module Waypoint_module
     2)  
     3)   use Option_module
     4)   use PFLOTRAN_Constants_module
     5) 
     6)   implicit none
     7)   
     8)   private
     9) 
    10) #include "petsc/finclude/petscsys.h"
    11) 
    12)   ! linked-list for waypoints in the simulation
    13)   type, public :: waypoint_type
    14)     PetscReal :: time
    15)     PetscBool :: sync
    16)     PetscBool :: print_snap_output
    17)     PetscBool :: print_obs_output
    18)     PetscBool :: print_msbl_output
    19)     PetscBool :: print_checkpoint
    20) !    type(output_option_type), pointer :: output_option
    21)     PetscBool :: update_conditions
    22)     PetscReal :: dt_max
    23)     PetscBool :: final  ! any waypoint after this will be deleted
    24)     type(waypoint_type), pointer :: prev
    25)     type(waypoint_type), pointer :: next
    26)   end type waypoint_type
    27)   
    28)   type, public :: waypoint_list_type
    29)     PetscInt :: num_waypoints
    30)     type(waypoint_type), pointer :: first
    31)     type(waypoint_type), pointer :: last
    32)     type(waypoint_type), pointer :: array(:)    
    33)   end type waypoint_list_type
    34)   
    35)   interface WaypointCreate
    36)     module procedure WaypointCreate1
    37)     module procedure WaypointCreate2
    38)   end interface  
    39)   
    40)   public :: WaypointCreate, &
    41)             WaypointListCreate, &
    42)             WaypointListDestroy, &
    43)             WaypointInsertInList, &
    44)             WaypointDeleteFromList, &
    45)             WaypointListFillIn, &
    46)             WaypointListCopy, &
    47)             WaypointListMerge, &
    48)             WaypointListCopyAndMerge, &
    49)             WaypointListRemoveExtraWaypnts, &
    50)             WaypointConvertTimes, &
    51)             WaypointReturnAtTime, &
    52)             WaypointSkipToTime, &
    53)             WaypointForceMatchToTime, &
    54)             WaypointListPrint, &
    55)             WaypointListGetFinalTime, &
    56)             WaypointCreateSyncWaypointList, &
    57)             WaypointInputRecord
    58) 
    59) contains
    60) 
    61) ! ************************************************************************** !
    62) 
    63) function WaypointCreate1()
    64)   ! 
    65)   ! Creates a simulation waypoint
    66)   ! 
    67)   ! Author: Glenn Hammond
    68)   ! Date: 11/07/07
    69)   ! 
    70) 
    71)   implicit none
    72)   
    73)   type(waypoint_type), pointer :: WaypointCreate1
    74)   
    75)   type(waypoint_type), pointer :: waypoint
    76)   
    77)   allocate(waypoint)
    78)   waypoint%time = 0.d0
    79)   waypoint%sync = PETSC_FALSE
    80)   waypoint%print_snap_output = PETSC_FALSE
    81)   waypoint%print_obs_output = PETSC_FALSE
    82)   waypoint%print_msbl_output = PETSC_FALSE
    83)   waypoint%print_checkpoint = PETSC_FALSE
    84)   waypoint%final = PETSC_FALSE
    85)   waypoint%update_conditions = PETSC_FALSE
    86)   waypoint%dt_max = 0.d0
    87)   nullify(waypoint%next)
    88)   nullify(waypoint%prev)
    89)     
    90)   WaypointCreate1 => waypoint
    91)   
    92) end function WaypointCreate1
    93) 
    94) ! ************************************************************************** !
    95) 
    96) function WaypointCreate2(original_waypoint)
    97)   ! 
    98)   ! Creates a simulation waypoint
    99)   ! 
   100)   ! Author: Glenn Hammond
   101)   ! Date: 11/07/07
   102)   ! 
   103) 
   104)   implicit none
   105)   
   106)   type(waypoint_type), pointer :: original_waypoint
   107)   
   108)   type(waypoint_type), pointer :: WaypointCreate2
   109)   
   110)   type(waypoint_type), pointer :: waypoint
   111)   
   112)   waypoint => WaypointCreate()
   113)   waypoint%time = original_waypoint%time
   114)   waypoint%sync = original_waypoint%sync
   115)   waypoint%print_snap_output = original_waypoint%print_snap_output
   116)   waypoint%print_obs_output = original_waypoint%print_obs_output
   117)   waypoint%print_msbl_output = original_waypoint%print_msbl_output
   118)   waypoint%print_checkpoint = original_waypoint%print_checkpoint
   119)   waypoint%final = original_waypoint%final
   120)   waypoint%update_conditions = original_waypoint%update_conditions
   121)   waypoint%dt_max = original_waypoint%dt_max
   122)     
   123)   WaypointCreate2 => waypoint
   124)   
   125) end function WaypointCreate2
   126) 
   127) ! ************************************************************************** !
   128) 
   129) function WaypointListCreate()
   130)   ! 
   131)   ! Creates a simulation waypoint list
   132)   ! 
   133)   ! Author: Glenn Hammond
   134)   ! Date: 11/07/07
   135)   ! 
   136) 
   137)   implicit none
   138)   
   139)   type(waypoint_list_type), pointer :: WaypointListCreate
   140)   
   141)   type(waypoint_list_type), pointer :: waypoint_list
   142)   
   143)   allocate(waypoint_list)
   144)   nullify(waypoint_list%first)
   145)   nullify(waypoint_list%last)
   146)   nullify(waypoint_list%array)
   147)   waypoint_list%num_waypoints = 0
   148) 
   149)   WaypointListCreate => waypoint_list
   150)   
   151) end function WaypointListCreate 
   152) 
   153) 
   154) ! ************************************************************************** !
   155) 
   156) subroutine WaypointListMerge(waypoint_list1,waypoint_list2,option)
   157)   ! 
   158)   ! Creates a simulation waypoint list
   159)   ! 
   160)   ! Author: Glenn Hammond
   161)   ! Date: 02/03/16
   162)   ! 
   163)   use Option_module
   164)   
   165)   implicit none
   166)   
   167)   type(waypoint_list_type), pointer :: waypoint_list1
   168)   type(waypoint_list_type), pointer :: waypoint_list2
   169)   
   170)   type(option_type) :: option
   171)   type(waypoint_type), pointer :: cur_waypoint, next_waypoint
   172)   
   173)   if (.not.associated(waypoint_list1) .and. &
   174)       .not.associated(waypoint_list2)) then
   175)     option%io_buffer = 'Two null waypoints lists.  Send input deck to &
   176)       &pflotran-dev.'
   177)     call printErrMsg(option)
   178)   else if (.not.associated(waypoint_list1)) then
   179)     waypoint_list1 => waypoint_list2
   180)     return
   181)   else if (.not.associated(waypoint_list2)) then
   182)     waypoint_list2 => waypoint_list1
   183)     return
   184)   endif
   185)   
   186)   cur_waypoint => waypoint_list2%first
   187)   do
   188)     if (.not.associated(cur_waypoint)) exit
   189)     next_waypoint => cur_waypoint%next
   190)     nullify(cur_waypoint%next)
   191)     call WaypointInsertInList(cur_waypoint,waypoint_list1)
   192)     cur_waypoint => next_waypoint
   193)     nullify(next_waypoint)
   194)   enddo
   195)   ! must nullify the first waypoint in waypoint_list2 to avoid deleting 
   196)   ! first waypoint which will subsequently delete all waypoints after it 
   197)   ! in waypoint_list1
   198)   nullify(waypoint_list2%first)
   199)   call WaypointListDestroy(waypoint_list2)
   200)   waypoint_list2 => waypoint_list1
   201)   
   202) end subroutine WaypointListMerge 
   203) 
   204) ! ************************************************************************** !
   205) 
   206) subroutine WaypointListCopyAndMerge(waypoint_list1,waypoint_list2,option)
   207)   ! 
   208)   ! Creates a simulation waypoint list
   209)   ! 
   210)   ! Author: Glenn Hammond
   211)   ! Date: 02/03/16
   212)   ! 
   213)   use Option_module
   214)   
   215)   implicit none
   216)   
   217)   type(waypoint_list_type), pointer :: waypoint_list1
   218)   type(waypoint_list_type), pointer :: waypoint_list2
   219)   
   220)   type(option_type) :: option
   221)  
   222)   type(waypoint_list_type), pointer :: new_waypoint_list
   223) 
   224)   new_waypoint_list => WaypointListCopy(waypoint_list2)
   225)   call WaypointListMerge(waypoint_list1,new_waypoint_list,option)
   226)   nullify(new_waypoint_list)
   227)   
   228) end subroutine WaypointListCopyAndMerge 
   229) 
   230) ! ************************************************************************** !
   231) 
   232) subroutine WaypointInsertInList(new_waypoint,waypoint_list)
   233)   ! 
   234)   ! Correctly inserts a waypoing in a list
   235)   ! 
   236)   ! Author: Glenn Hammond
   237)   ! Date: 11/09/07
   238)   ! 
   239) 
   240)   use Utility_module
   241) 
   242)   type(waypoint_type), pointer :: new_waypoint
   243)   type(waypoint_list_type) :: waypoint_list
   244) 
   245)   type(waypoint_type), pointer :: waypoint
   246)     
   247)     ! place new waypoint in proper location within list
   248)   waypoint => waypoint_list%first
   249)   if (associated(waypoint)) then ! list exists
   250)     ! if waypoint time matches another waypoint time, merge them
   251) !geh    if ((new_waypoint%time > 0.999999d0*waypoint%time .and. &
   252) !geh         new_waypoint%time < 1.000001d0*waypoint%time) .or. &
   253)          ! need to account for waypoint%time = 0.d0
   254)     if (Equal(new_waypoint%time,waypoint%time) .or. &
   255)         (new_waypoint%time < 1.d-40 .and. &
   256)          waypoint%time < 1.d-40)) then ! same
   257)       call WaypointMerge(waypoint,new_waypoint)
   258)       return
   259)     else
   260)       ! if waypoint time is less than any previous, insert at beginning of list
   261)       if (new_waypoint%time < waypoint%time) then 
   262)         waypoint_list%first => new_waypoint
   263)         new_waypoint%next => waypoint
   264)         new_waypoint%next%prev => new_waypoint
   265)       else
   266)         ! find its location in the list
   267)         do
   268)           if (associated(waypoint)) then 
   269)             if (Equal(new_waypoint%time,waypoint%time)) then
   270) !geh            if (new_waypoint%time > 0.999999d0*waypoint%time .and. &
   271) !geh                new_waypoint%time < 1.000001d0*waypoint%time) then ! same
   272)               call WaypointMerge(waypoint,new_waypoint)
   273)               return
   274)             else if (associated(waypoint%next)) then 
   275)               if (new_waypoint%time-waypoint%time > 1.d-10 .and. & ! within list
   276)                   new_waypoint%time-waypoint%next%time < -1.d-10) then 
   277)                 new_waypoint%next => waypoint%next
   278)                 new_waypoint%next%prev => new_waypoint
   279)                 waypoint%next => new_waypoint
   280)                 new_waypoint%prev => waypoint
   281)                 waypoint_list%num_waypoints = waypoint_list%num_waypoints+1
   282)                 return
   283)               else
   284)                 waypoint => waypoint%next
   285)                 cycle
   286)               endif
   287)             else ! at end of list
   288)               waypoint%next => new_waypoint
   289)               new_waypoint%prev => waypoint
   290)               waypoint_list%last => new_waypoint
   291)               exit
   292)             endif
   293)           endif
   294)         enddo
   295)       endif
   296)     endif
   297)   else
   298)     waypoint_list%first => new_waypoint
   299)     waypoint_list%last => new_waypoint 
   300)   endif
   301)   waypoint_list%num_waypoints = waypoint_list%num_waypoints + 1
   302) 
   303) end subroutine WaypointInsertInList
   304) 
   305) ! ************************************************************************** !
   306) 
   307) subroutine WaypointDeleteFromList(obsolete_waypoint,waypoint_list)
   308)   ! 
   309)   ! Deletes a waypoing in a list
   310)   ! 
   311)   ! Author: Gautam Bisht
   312)   ! Date: 01/20/11
   313)   ! 
   314) 
   315)   implicit none
   316) 
   317)   type(waypoint_type), pointer :: obsolete_waypoint
   318)   type(waypoint_type), pointer :: waypoint, prev_waypoint
   319)   type(waypoint_list_type) :: waypoint_list
   320) 
   321)   waypoint => waypoint_list%first
   322) 
   323)   if (associated(waypoint)) then ! list exists
   324) 
   325)     ! Is the waypoint to be deleted is the first waypoint?
   326)     if (waypoint%time == obsolete_waypoint%time) then
   327)       waypoint_list%first => waypoint%next
   328)       call WaypointDestroy(waypoint)
   329)       waypoint_list%num_waypoints = waypoint_list%num_waypoints - 1
   330)       return
   331)     else
   332) 
   333)       prev_waypoint => waypoint
   334)       waypoint => waypoint%next
   335)       do
   336)         if (associated(waypoint)) then
   337)           if (dabs(waypoint%time-obsolete_waypoint%time) < 1.d-10) then
   338)             prev_waypoint%next => waypoint%next
   339)             call WaypointDestroy(waypoint)
   340)             waypoint_list%num_waypoints = waypoint_list%num_waypoints - 1
   341)             return
   342)           endif
   343)           prev_waypoint => waypoint
   344)           waypoint => waypoint%next
   345)           cycle
   346)         else
   347)          ! at the end of the list, didn't find obsolete waypoint
   348)           return
   349)         endif
   350)       enddo
   351)     endif
   352)   else
   353)     ! list does not exists
   354)     return
   355)   endif
   356)   
   357) end subroutine WaypointDeleteFromList
   358) 
   359) ! ************************************************************************** !
   360) 
   361) subroutine WaypointListFillIn(waypoint_list,option)
   362)   ! 
   363)   ! Fills in missing values (e.g. dt_max) in waypoint list
   364)   ! 
   365)   ! Author: Glenn Hammond
   366)   ! Date: 11/09/07
   367)   ! 
   368)   
   369)   implicit none
   370)   
   371)   type(waypoint_list_type) :: waypoint_list
   372)   type(option_type) :: option
   373)   
   374)   type(waypoint_type), pointer :: waypoint, prev_waypoint
   375)   PetscReal :: dt_max = UNINITIALIZED_DOUBLE
   376)   
   377)   ! find first value of dt_max > 0.d0 in list
   378)   waypoint => waypoint_list%first
   379)   do
   380)     if (.not.associated(waypoint)) exit
   381)     if (waypoint%dt_max > 1.d-40) then
   382)       dt_max = waypoint%dt_max
   383)       exit
   384)     endif
   385)     waypoint => waypoint%next
   386)   enddo
   387) 
   388)   if (dt_max <= 1.d-40) then
   389)     option%io_buffer = 'All values of dt_max in input file uninitialized'
   390)     call printErrMsg(option)
   391)   endif
   392)   
   393)   ! assign that value to the first waypoint, if waypoint%dt_max not already > 1.d-40
   394)   waypoint => waypoint_list%first
   395)   if (waypoint%dt_max < 1.d-40) waypoint%dt_max = dt_max
   396)   
   397)   ! fill in missing values
   398)   do
   399)     prev_waypoint => waypoint
   400)     waypoint => waypoint%next
   401)     if (.not.associated(waypoint)) exit 
   402)     if (waypoint%dt_max < 1.d-40) then
   403)       waypoint%dt_max = prev_waypoint%dt_max
   404)     endif
   405)   enddo
   406)   
   407)   ! IMPORTANT NOTE:  The dt_max must be assigned to the "next" waypoint.  The
   408)   ! "current" waypoint in the stepper is always the next waypoint .  Therefore
   409)   ! we must shift all the dt_max entries. 
   410)   waypoint => waypoint_list%last
   411)   ! work backwards
   412)   do
   413)     prev_waypoint => waypoint%prev
   414)     if (.not.associated(prev_waypoint)) exit 
   415)     waypoint%dt_max = prev_waypoint%dt_max
   416)     waypoint => prev_waypoint
   417)   enddo
   418)   
   419)   waypoint => waypoint_list%first
   420)   do
   421)     if (.not.associated(waypoint)) exit 
   422)     waypoint => waypoint%next
   423)   enddo
   424) 
   425) end subroutine WaypointListFillIn 
   426) 
   427) ! ************************************************************************** !
   428) 
   429) subroutine WaypointConvertTimes(waypoint_list,time_conversion)
   430)   ! 
   431)   ! Converts time units to seconds
   432)   ! 
   433)   ! Author: Glenn Hammond
   434)   ! Date: 11/09/07
   435)   ! 
   436) 
   437)   implicit none
   438)   
   439)   type(waypoint_list_type) :: waypoint_list
   440)   PetscReal :: time_conversion
   441)   
   442)   type(waypoint_type), pointer :: waypoint
   443)   
   444)   waypoint => waypoint_list%first
   445)   do
   446)     if (.not.associated(waypoint)) exit
   447)     waypoint%time = waypoint%time * time_conversion
   448)     waypoint%dt_max = waypoint%dt_max * time_conversion
   449)     waypoint => waypoint%next
   450)   enddo
   451)   
   452) end subroutine WaypointConvertTimes 
   453) 
   454) ! ************************************************************************** !
   455) 
   456) subroutine WaypointListRemoveExtraWaypnts(waypoint_list,option)
   457)   ! 
   458)   ! Author: Glenn Hammond
   459)   ! Date: 11/09/07
   460)   ! 
   461) 
   462)   implicit none
   463)   
   464)   type(waypoint_list_type) :: waypoint_list
   465)   type(option_type) :: option
   466)   
   467)   type(waypoint_type), pointer :: waypoint, prev_waypoint
   468)   
   469)   waypoint => waypoint_list%first
   470)   do
   471)     if (.not.associated(waypoint) .or. waypoint%final) exit
   472)     waypoint => waypoint%next
   473)   enddo
   474)   
   475)   if (associated(waypoint)) then
   476)     prev_waypoint => waypoint
   477)     waypoint => waypoint%next
   478)     nullify(prev_waypoint%next)
   479)   endif
   480)   
   481)   do
   482)     if (.not.associated(waypoint)) exit
   483)     prev_waypoint => waypoint
   484)     waypoint => waypoint%next
   485)     write(option%io_buffer,'("Waypoint at time:", 1pe12.4, &
   486)   &       " is beyond the end of simulation")') &
   487)           prev_waypoint%time
   488)     call printWrnMsg(option)
   489)     call WaypointDestroy(prev_waypoint)   
   490)     waypoint_list%num_waypoints = waypoint_list%num_waypoints - 1
   491)   enddo
   492) 
   493) end subroutine WaypointListRemoveExtraWaypnts 
   494) 
   495) ! ************************************************************************** !
   496) 
   497) subroutine WaypointMerge(old_waypoint,new_waypoint)
   498)   ! 
   499)   ! Merges 2 waypoints performing an OR operation on logicals
   500)   ! 
   501)   ! Author: Glenn Hammond
   502)   ! Date: 10/28/03
   503)   ! 
   504) 
   505)   implicit none
   506) 
   507)   type(waypoint_type), pointer :: old_waypoint, new_waypoint
   508) 
   509)   new_waypoint%time = 0.d0
   510) 
   511) !    PetscReal :: time
   512) !    PetscBool :: print_output
   513) !    type(output_option_type), pointer :: output_option
   514) !    PetscBool :: update_bcs
   515) !    PetscBool :: update_srcs
   516) !    PetscReal :: dt_max
   517) !    PetscBool :: final  ! any waypoint after this will be deleted
   518)     
   519)   if (old_waypoint%sync .or. new_waypoint%sync) then
   520)     old_waypoint%sync = PETSC_TRUE
   521)   else
   522)     old_waypoint%sync = PETSC_FALSE
   523)   endif
   524) 
   525)   if (old_waypoint%print_snap_output .or. new_waypoint%print_snap_output) then
   526)     old_waypoint%print_snap_output = PETSC_TRUE
   527)   else
   528)     old_waypoint%print_snap_output = PETSC_FALSE
   529)   endif
   530) 
   531)   if (old_waypoint%print_obs_output .or. new_waypoint%print_obs_output) then
   532)     old_waypoint%print_obs_output = PETSC_TRUE
   533)   else
   534)     old_waypoint%print_obs_output = PETSC_FALSE
   535)   endif
   536) 
   537)   if (old_waypoint%print_msbl_output .or. new_waypoint%print_msbl_output) then
   538)     old_waypoint%print_msbl_output = PETSC_TRUE
   539)   else
   540)     old_waypoint%print_msbl_output = PETSC_FALSE
   541)   endif
   542) 
   543)   if (old_waypoint%update_conditions .or. new_waypoint%update_conditions) then
   544)     old_waypoint%update_conditions = PETSC_TRUE
   545)   else
   546)     old_waypoint%update_conditions = PETSC_FALSE
   547)   endif
   548) 
   549)   if (new_waypoint%dt_max > 0.d0) then
   550)     old_waypoint%dt_max = new_waypoint%dt_max
   551)   endif
   552)   
   553)   if (old_waypoint%final .or. new_waypoint%final) then
   554)     old_waypoint%final = PETSC_TRUE
   555)   else
   556)     old_waypoint%final = PETSC_FALSE
   557)   endif
   558) 
   559)   if (old_waypoint%print_checkpoint .or. new_waypoint%print_checkpoint) then
   560)     old_waypoint%print_checkpoint = PETSC_TRUE
   561)   else
   562)     old_waypoint%print_checkpoint = PETSC_FALSE
   563)   endif
   564) 
   565)   ! deallocate new waypoint
   566)   deallocate(new_waypoint)
   567)   ! point new_waypoint to old
   568)   new_waypoint => old_waypoint
   569) 
   570) end subroutine WaypointMerge
   571) 
   572) ! ************************************************************************** !
   573) 
   574) function WaypointReturnAtTime(list,time)
   575)   ! 
   576)   ! Returns a pointer to the first waypoint after time
   577)   ! 
   578)   ! Author: Glenn Hammond
   579)   ! Date: 1/03/08
   580)   ! 
   581) 
   582)   implicit none
   583) 
   584)   type(waypoint_list_type), pointer :: list
   585)   PetscReal :: time
   586) 
   587)   type(waypoint_type), pointer :: WaypointReturnAtTime
   588)   type(waypoint_type), pointer :: waypoint
   589)   
   590)   waypoint => list%first
   591)   do 
   592)     if (.not.associated(waypoint)) exit
   593)     if (waypoint%time > time) exit
   594)     waypoint => waypoint%next
   595)   enddo
   596) 
   597)   if (associated(waypoint)) then
   598)     WaypointReturnAtTime => waypoint
   599)   else
   600)     nullify(WaypointReturnAtTime)
   601)   endif
   602) 
   603) end function WaypointReturnAtTime
   604) 
   605) ! ************************************************************************** !
   606) 
   607) subroutine WaypointSkipToTime(cur_waypoint,time)
   608)   ! 
   609)   ! Skips the waypoint ahead to the correct time.
   610)   ! 
   611)   ! Author: Glenn Hammond
   612)   ! Date: 07/31/13
   613)   ! 
   614) 
   615)   implicit none
   616) 
   617)   PetscReal :: time
   618)   type(waypoint_type), pointer :: cur_waypoint
   619)   
   620)   do 
   621)     if (.not.associated(cur_waypoint)) exit
   622)     if (cur_waypoint%time > time) exit
   623)     cur_waypoint => cur_waypoint%next
   624)   enddo
   625) 
   626) end subroutine WaypointSkipToTime
   627) 
   628) ! ************************************************************************** !
   629) 
   630) subroutine WaypointListPrint(list,option,output_option)
   631)   ! 
   632)   ! Prints a waypoint
   633)   ! 
   634)   ! Author: Glenn Hammond
   635)   ! Date: 05/20/11
   636)   ! 
   637)   use Output_Aux_module
   638)   use Option_module
   639) 
   640)   implicit none
   641)   
   642)   type(waypoint_list_type), pointer :: list
   643)   type(option_type) :: option
   644)   type(output_option_type) :: output_option
   645) 
   646)   type(waypoint_type), pointer :: cur_waypoint
   647)   PetscInt :: icount
   648) 
   649)   100 format(/)
   650)   110 format(a)
   651)   20 format('  ',a20,':',10i6)
   652) 
   653)   if (OptionPrintToScreen(option)) then
   654)     write(*,100)
   655)     write(*,110) 'List of Waypoints:'
   656)     write(*,100)
   657)   endif
   658) 
   659)   if (OptionPrintToFile(option)) then
   660)     write(option%fid_out,100)
   661)     write(option%fid_out,110) 'List of Waypoints:'
   662)     write(option%fid_out,100)
   663)   endif
   664) 
   665)   icount = 0
   666)   cur_waypoint => list%first
   667)   do 
   668)     if (.not.associated(cur_waypoint)) exit
   669)     call WaypointPrint(cur_waypoint,option,output_option)
   670)     icount = icount + 1
   671)     cur_waypoint => cur_waypoint%next
   672)   enddo
   673) 
   674)   if (OptionPrintToScreen(option)) then
   675)     write(*,20) 'Total Waypoints:', icount
   676)     write(*,100)
   677)   endif
   678) 
   679)   if (OptionPrintToFile(option)) then
   680)     write(option%fid_out,20) 'Total Waypoints:', icount
   681)     write(option%fid_out,100)
   682)   endif
   683) 
   684) end subroutine WaypointListPrint
   685) 
   686) ! ************************************************************************** !
   687) 
   688) function WaypointListCopy(list)
   689)   ! 
   690)   ! Copies a waypoint list
   691)   ! 
   692)   ! Author: Glenn Hammond
   693)   ! Date: 03/19/13
   694)   ! 
   695) 
   696)   use Option_module
   697) 
   698)   implicit none
   699)   
   700)   type(waypoint_list_type), pointer :: WaypointListCopy
   701)   
   702)   type(waypoint_list_type), pointer :: list
   703)   type(waypoint_type), pointer :: new_waypoint
   704)   type(waypoint_type), pointer :: prev_new_waypoint
   705)   
   706)   type(waypoint_list_type), pointer :: new_list
   707)   type(waypoint_type), pointer :: cur_waypoint
   708) 
   709)   new_list => WaypointListCreate()
   710)   
   711)   nullify(prev_new_waypoint)
   712)   
   713)   cur_waypoint => list%first
   714)   do 
   715)     if (.not.associated(cur_waypoint)) exit
   716)     new_waypoint => WaypointCreate(cur_waypoint)
   717)     if (associated(prev_new_waypoint)) then
   718)       prev_new_waypoint%next => new_waypoint
   719)     else
   720)       new_list%first => new_waypoint
   721)     endif
   722)     new_list%num_waypoints = new_list%num_waypoints + 1
   723)     prev_new_waypoint => new_waypoint
   724)     nullify(new_waypoint)
   725)     cur_waypoint => cur_waypoint%next
   726)   enddo
   727)   
   728)   WaypointListCopy => new_list
   729) 
   730) end function WaypointListCopy
   731) 
   732) ! ************************************************************************** !
   733) 
   734) function WaypointForceMatchToTime(waypoint)
   735)   ! 
   736)   ! Forces a match to waypoint time if condition is
   737)   ! true.
   738)   ! 
   739)   ! Author: Glenn Hammond
   740)   ! Date: 03/19/13
   741)   ! 
   742) 
   743)   implicit none
   744)   
   745)   type(waypoint_type) :: waypoint
   746)   
   747)   PetscBool :: WaypointForceMatchToTime
   748)   
   749)   WaypointForceMatchToTime = PETSC_FALSE
   750) 
   751)   if (waypoint%sync .or. &
   752)       waypoint%update_conditions .or. &
   753)       waypoint%print_snap_output .or. &
   754)       waypoint%print_obs_output .or. &
   755)       waypoint%print_msbl_output .or. &
   756)       waypoint%print_checkpoint .or. &
   757)       waypoint%final &
   758)       ) then
   759)     WaypointForceMatchToTime = PETSC_TRUE
   760)   endif
   761)   
   762) end function WaypointForceMatchToTime
   763) 
   764) 
   765) ! ************************************************************************** !
   766) 
   767) function WaypointCreateSyncWaypointList(waypoint_list)
   768)   !
   769)   ! Creates a list of waypoints for outer synchronization of simulation process
   770)   ! model couplers
   771)   !
   772)   ! Author: Glenn Hammond
   773)   ! Date: 10/08/14
   774)   !
   775) 
   776)   use Option_module
   777) 
   778)   implicit none
   779) 
   780)   type(waypoint_list_type), pointer :: waypoint_list
   781) 
   782)   type(waypoint_list_type), pointer :: WaypointCreateSyncWaypointList
   783) 
   784)   type(waypoint_list_type), pointer :: new_waypoint_list
   785)   type(waypoint_type), pointer :: cur_waypoint
   786)   type(waypoint_type), pointer :: new_waypoint
   787) 
   788)   new_waypoint_list => WaypointListCreate()
   789) 
   790)   cur_waypoint => waypoint_list%first
   791)   do
   792)     if (.not.associated(cur_waypoint)) exit
   793)     if (cur_waypoint%sync .or. cur_waypoint%final) then
   794)       new_waypoint => WaypointCreate(cur_waypoint)
   795)       call WaypointInsertInList(new_waypoint,new_waypoint_list)
   796)       if (cur_waypoint%final) exit
   797)     endif
   798)     cur_waypoint => cur_waypoint%next
   799)   enddo
   800)   WaypointCreateSyncWaypointList => new_waypoint_list
   801) 
   802) end function WaypointCreateSyncWaypointList
   803) 
   804) ! ************************************************************************** !
   805) 
   806) subroutine WaypointPrint(waypoint,option,output_option)
   807)   ! 
   808)   ! Prints a waypoint
   809)   ! 
   810)   ! Author: Glenn Hammond
   811)   ! Date: 05/20/11
   812)   ! 
   813)   use Output_Aux_module
   814)   use Option_module
   815) 
   816)   implicit none
   817)   
   818)   type(waypoint_type), pointer :: waypoint
   819)   type(option_type) :: option
   820)   type(output_option_type) :: output_option
   821) 
   822)   character(len=MAXSTRINGLENGTH) :: string
   823) 
   824)   10 format('  ',a20,':',10es13.5)
   825)   20 format('  ',a20,':',10i6)
   826)   30 format('  ',a20,':',10l)
   827)   40 format('  ',a20,':',a20)
   828)   100 format(/)
   829)   110 format(a)
   830) 
   831)   if (OptionPrintToScreen(option)) then
   832)     write(*,110) 'Waypoint:'
   833)     write(string,*) 'Time [' // trim(adjustl(output_option%tunit)) // ']'
   834)     write(*,10) trim(string), waypoint%time/output_option%tconv
   835)     write(*,30) 'Sync', waypoint%sync
   836)     write(*,30) 'Print Snapshot Output', waypoint%print_snap_output
   837)     write(*,30) 'Print Observation Output', waypoint%print_obs_output
   838)     write(*,30) 'Print Mass Balance Output', waypoint%print_msbl_output
   839)     write(*,30) 'Print Checkpoint', waypoint%print_checkpoint
   840)     write(*,30) 'Update Conditions', waypoint%update_conditions
   841)     write(string,*) 'Max DT [' // trim(adjustl(output_option%tunit)) // ']'
   842)     write(*,10) trim(string), waypoint%dt_max/output_option%tconv
   843)     write(*,30) 'Final', waypoint%final
   844)     write(*,100)
   845)   endif
   846) 
   847)   if (OptionPrintToFile(option)) then
   848)     write(option%fid_out,110) 'Waypoint:'
   849)     write(string,*) 'Time [' // trim(adjustl(output_option%tunit)) // ']'
   850)     write(option%fid_out,10) trim(string), waypoint%time/output_option%tconv
   851)     write(option%fid_out,30) 'Sync', waypoint%sync
   852)     write(option%fid_out,30) 'Print Snapshot Output', waypoint%print_snap_output
   853)     write(option%fid_out,30) 'Print Observation Output', &
   854)                                                        waypoint%print_obs_output
   855)     write(option%fid_out,30) 'Print Mass Balance Output', &
   856)                                                       waypoint%print_msbl_output
   857)     write(option%fid_out,30) 'Print Checkpoint', waypoint%print_checkpoint
   858)     write(option%fid_out,30) 'Update Conditions', waypoint%update_conditions
   859)     write(string,*) 'Max DT [' // trim(adjustl(output_option%tunit)) // ']'
   860)     write(option%fid_out,10) trim(string), waypoint%dt_max/output_option%tconv
   861)     write(option%fid_out,30) 'Final', waypoint%final
   862)     write(option%fid_out,100)
   863)   endif
   864)  
   865) end subroutine WaypointPrint
   866) 
   867) ! ************************************************************************** !
   868) 
   869) subroutine WaypointInputRecord(output_option,waypoint_list)
   870)   !
   871)   ! Prints ingested time information to the input record file.
   872)   !
   873)   ! Author: Jenn Frederick
   874)   ! Date: 05/09/2016
   875)   !
   876)   use Output_Aux_module
   877)   
   878)   implicit none
   879)   
   880)   type(output_option_type), pointer :: output_option
   881)   type(waypoint_list_type), pointer :: waypoint_list
   882)   
   883)   type(waypoint_type), pointer :: cur_waypoint
   884)   character(len=MAXWORDLENGTH) :: word1, word2
   885)   character(len=MAXSTRINGLENGTH) :: string
   886)   PetscReal :: final_time
   887)   PetscReal :: max_dt
   888)   PetscReal :: prev_time
   889)   PetscInt :: id = INPUT_RECORD_UNIT
   890)   character(len=10) :: Format
   891)   
   892)   Format = '(ES14.7)'
   893)   
   894)   write(id,'(a)') ' '
   895)   write(id,'(a)') '---------------------------------------------------------&
   896)                   &-----------------------'
   897)   write(id,'(a29)',advance='no') '---------------------------: '
   898)   write(id,'(a)') 'TIME'
   899)   
   900)   final_time = 0.d0
   901)   prev_time = 0.d0
   902)   max_dt = 0.d0
   903)   
   904)   cur_waypoint => waypoint_list%first
   905)   do
   906)     if (.not.associated(cur_waypoint)) exit
   907)     if (cur_waypoint%final .or. cur_waypoint%time > final_time) then
   908)       final_time = cur_waypoint%time
   909)     endif
   910)     if (cur_waypoint%dt_max /= max_dt) then
   911)       write(id,'(a29)',advance='no') 'max. timestep: '
   912)       write(word1,Format) cur_waypoint%dt_max/output_option%tconv
   913)       write(word2,Format) prev_time/output_option%tconv
   914)       write(id,'(a)') adjustl(trim(word1)) // ' ' // &
   915)         trim(output_option%tunit) // ' at time ' // adjustl(trim(word2)) &
   916)         // ' ' // trim(output_option%tunit)
   917)     endif
   918)     max_dt = cur_waypoint%dt_max
   919)     prev_time = cur_waypoint%time
   920)     cur_waypoint => cur_waypoint%next
   921)   enddo
   922)   
   923)   write(id,'(a29)',advance='no') 'final time: '
   924)   write(word1,Format) final_time/output_option%tconv
   925)   write(id,'(a)') adjustl(trim(word1)) // ' ' // trim(output_option%tunit)
   926) 
   927) end subroutine WaypointInputRecord
   928) 
   929) ! ************************************************************************** !
   930) 
   931) function WaypointListGetFinalTime(waypoint_list)
   932)   ! 
   933)   ! Returns the final time in the waypoint list
   934)   ! 
   935)   ! Author: Glenn Hammond
   936)   ! Date: 06/12/13
   937)   ! 
   938) 
   939)   implicit none
   940)   
   941)   type(waypoint_list_type) :: waypoint_list
   942)   
   943)   PetscReal :: WaypointListGetFinalTime
   944)   
   945)   type(waypoint_type), pointer :: cur_waypoint
   946) 
   947)   WaypointListGetFinalTime = 0.d0
   948)   
   949)   cur_waypoint => waypoint_list%first
   950)   do
   951)     if (.not.associated(cur_waypoint)) exit
   952)     if (cur_waypoint%final .or. &
   953)         cur_waypoint%time > WaypointListGetFinalTime) then
   954)       WaypointListGetFinalTime = cur_waypoint%time
   955)       if (cur_waypoint%final) exit
   956)     endif
   957)     cur_waypoint => cur_waypoint%next
   958)   enddo
   959)   
   960) end function WaypointListGetFinalTime 
   961) 
   962) ! ************************************************************************** !
   963) 
   964) subroutine WaypointListDestroy(waypoint_list)
   965)   ! 
   966)   ! Destroys a simulation waypoint list
   967)   ! 
   968)   ! Author: Glenn Hammond
   969)   ! Date: 11/07/07
   970)   ! 
   971) 
   972)   implicit none
   973)   
   974)   type(waypoint_list_type), pointer :: waypoint_list
   975)   
   976)   type(waypoint_type), pointer :: cur_waypoint, next_waypoint
   977)   
   978)   if (.not.associated(waypoint_list)) return
   979)   
   980)   cur_waypoint => waypoint_list%first
   981)   do
   982)     if (.not.associated(cur_waypoint)) exit
   983)     next_waypoint => cur_waypoint%next
   984)     call WaypointDestroy(cur_waypoint)
   985)     cur_waypoint => next_waypoint
   986)   enddo
   987)   
   988)   nullify(waypoint_list%first)
   989)   nullify(waypoint_list%last)
   990)   if (associated(waypoint_list%array)) deallocate(waypoint_list%array)
   991)   nullify(waypoint_list%array)
   992) 
   993)   deallocate(waypoint_list)
   994)   nullify(waypoint_list)
   995)   
   996) end subroutine WaypointListDestroy 
   997) 
   998) ! ************************************************************************** !
   999) 
  1000) subroutine WaypointDestroy(waypoint)
  1001)   ! 
  1002)   ! Deallocates a waypoint
  1003)   ! geh: DO NOT make this subroutine recursive as waypoints within lists need to
  1004)   ! be destroyed without recursively destroying the remainder of the list.
  1005)   ! 
  1006)   ! Author: Glenn Hammond
  1007)   ! Date: 11/09/07
  1008)   ! 
  1009) 
  1010)   implicit none
  1011)   
  1012)   type(waypoint_type), pointer :: waypoint
  1013)   
  1014)   if (.not.associated(waypoint)) return
  1015) 
  1016)   nullify(waypoint%prev)
  1017)   nullify(waypoint%next)
  1018)   deallocate(waypoint)
  1019)   nullify(waypoint)
  1020)   
  1021) end subroutine WaypointDestroy
  1022) 
  1023) end module Waypoint_module

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