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