OpenCMISS-Iron Internal API Documentation
control_loop_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE base_routines
49  USE kinds
51  USE solver_routines
52  USE strings
53  USE types
54 
55 #include "macros.h"
56 
57  IMPLICIT NONE
58 
59  PRIVATE
60 
61  !Module parameters
62 
67  INTEGER(INTG), PARAMETER :: control_loop_node=0
69 
74  INTEGER(INTG), PARAMETER :: control_loop_no_output=0
75  INTEGER(INTG), PARAMETER :: control_loop_progress_output=1
76  INTEGER(INTG), PARAMETER :: control_loop_timing_output=2
78 
79  !Module types
80 
81  !Module variables
82 
83  !Interfaces
84 
86  INTERFACE control_loop_get
87  MODULE PROCEDURE control_loop_get_0
88  MODULE PROCEDURE control_loop_get_1
89  END INTERFACE !CONTROL_LOOP_GET
90 
92  MODULE PROCEDURE control_loop_label_get_c
93  MODULE PROCEDURE control_loop_label_get_vs
94  END INTERFACE !CONTROL_LOOP_LABEL_GET
95 
97  MODULE PROCEDURE control_loop_label_set_c
98  MODULE PROCEDURE control_loop_label_set_vs
99  END INTERFACE !CONTROL_LOOP_LABEL_SET
100 
101  PUBLIC control_loop_node
102 
104 
106 
108 
109  PUBLIC control_loop_destroy
110 
111  PUBLIC control_loop_get
112 
114 
116 
118 
120 
122 
124 
126 
128 
130 
132 
134 
136 
138 
139  PUBLIC control_loop_type_set
140 
142 
144 
145 CONTAINS
146 
147  !
148  !================================================================================================================================
149  !
150 
152  RECURSIVE SUBROUTINE control_loop_create_finish(CONTROL_LOOP,ERR,ERROR,*)
154  !Argument variables
155  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
156  INTEGER(INTG), INTENT(OUT) :: ERR
157  TYPE(varying_string), INTENT(OUT) :: ERROR
158  !Local Variables
159  INTEGER(INTG) :: loop_idx
160  TYPE(control_loop_type), POINTER :: CONTROL_LOOP2
161 
162  enters("CONTROL_LOOP_CREATE_FINISH",err,error,*999)
163 
164  IF(ASSOCIATED(control_loop)) THEN
165  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
166  CALL flagerror("Control loop has already been finished.",err,error,*999)
167  ELSE
168  !Finish the sub-loops first
169  IF(control_loop%NUMBER_OF_SUB_LOOPS>0) THEN
170  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
171  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
172  CALL control_loop_create_finish(control_loop2,err,error,*999)
173  ENDDO !loop_idx
174  ENDIF
175  !Finish this control loop
176  control_loop%CONTROL_LOOP_FINISHED=.true.
177  ENDIF
178  ELSE
179  CALL flagerror("Control loop is not associated.",err,error,*999)
180  ENDIF
181 
182  exits("CONTROL_LOOP_CREATE_FINISH")
183  RETURN
184 999 errorsexits("CONTROL_LOOP_CREATE_FINISH",err,error)
185  RETURN 1
186  END SUBROUTINE control_loop_create_finish
187 
188  !
189  !================================================================================================================================
190  !
191 
193  SUBROUTINE control_loop_create_start(PROBLEM,CONTROL_LOOP,ERR,ERROR,*)
195  !Argument variables
196  TYPE(problem_type), POINTER, INTENT(INOUT) :: PROBLEM
197  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
198  INTEGER(INTG), INTENT(OUT) :: ERR
199  TYPE(varying_string), INTENT(OUT) :: ERROR
200  !Local Variables
201  INTEGER(INTG) :: DUMMY_ERR
202  TYPE(varying_string) :: DUMMY_ERROR
203 
204  enters("CONTROL_LOOP_CREATE_START",err,error,*998)
205 
206  IF(ASSOCIATED(problem)) THEN
207  IF(ASSOCIATED(control_loop)) THEN
208  CALL flagerror("Control loop is already associated.",err,error,*998)
209  ELSE
210  NULLIFY(control_loop)
211  CALL control_loop_initialise(problem,err,error,*999)
212  control_loop=>problem%CONTROL_LOOP
213  ENDIF
214  ELSE
215  CALL flagerror("Problem is not associated.",err,error,*998)
216  ENDIF
217 
218  exits("CONTROL_LOOP_CREATE_START")
219  RETURN
220 999 CALL control_loop_finalise(problem%CONTROL_LOOP,dummy_err,dummy_error,*998)
221 998 errorsexits("CONTROL_LOOP_CREATE_START",err,error)
222  RETURN 1
223  END SUBROUTINE control_loop_create_start
224 
225  !
226  !================================================================================================================================
227  !
228 
230  SUBROUTINE control_loop_current_times_get(CONTROL_LOOP,CURRENT_TIME,TIME_INCREMENT,ERR,ERROR,*)
232  !Argument variables
233  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
234  REAL(DP), INTENT(OUT) :: CURRENT_TIME
235  REAL(DP), INTENT(OUT) :: TIME_INCREMENT
236  INTEGER(INTG), INTENT(OUT) :: ERR
237  TYPE(varying_string), INTENT(OUT) :: ERROR
238  !Local Variables
239  TYPE(control_loop_time_type), POINTER :: TIME_LOOP
240  TYPE(control_loop_type), POINTER :: PARENT_LOOP
241  INTEGER(INTG), POINTER :: CONTROL_LOOP_LEVEL
242  INTEGER(INTG) :: I
243 
244  enters("CONTROL_LOOP_CURRENT_TIMES_GET",err,error,*999)
245 
246  IF(ASSOCIATED(control_loop)) THEN
247  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
248  control_loop_level=>control_loop%CONTROL_LOOP_LEVEL
249  parent_loop=>control_loop
250  DO i=control_loop_level,1,-1
251  IF(control_loop_level==0) THEN
252  CALL flagerror("The specified control loop is not a time control loop.",err,error,*999)
253  ELSE
254  IF(parent_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
255  time_loop=>parent_loop%TIME_LOOP
256  IF(ASSOCIATED(time_loop)) THEN
257  current_time=time_loop%CURRENT_TIME
258  time_increment=time_loop%TIME_INCREMENT
259  ELSE
260  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
261  ENDIF
262  EXIT
263  ELSE
264  parent_loop=>parent_loop%PARENT_LOOP
265  ENDIF
266  ENDIF
267  ENDDO
268  ELSE
269  CALL flagerror("Control loop has not been finished.",err,error,*999)
270  ENDIF
271  ELSE
272  CALL flagerror("Control loop is not associated.",err,error,*999)
273  ENDIF
274 
275  exits("CONTROL_LOOP_CURRENT_TIMES_GET")
276  RETURN
277 999 errorsexits("CONTROL_LOOP_CURRENT_TIMES_GET",err,error)
278  RETURN 1
279 
280  END SUBROUTINE control_loop_current_times_get
281 
282  !
283  !================================================================================================================================
284  !
285 
287  SUBROUTINE control_loop_destroy(CONTROL_LOOP,ERR,ERROR,*)
289  !Argument variables
290  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
291  INTEGER(INTG), INTENT(OUT) :: ERR
292  TYPE(varying_string), INTENT(OUT) :: ERROR
293  !Local Variables
294 
295  enters("CONTROL_LOOP_DESTROY",err,error,*999)
296 
297  IF(ASSOCIATED(control_loop)) THEN
298  CALL control_loop_finalise(control_loop,err,error,*999)
299  ELSE
300  CALL flagerror("Control loop is not associated.",err,error,*999)
301  ENDIF
302 
303  exits("CONTROL_LOOP_DESTROY")
304  RETURN
305 999 errorsexits("CONTROL_LOOP_DESTROY",err,error)
306  RETURN 1
307  END SUBROUTINE control_loop_destroy
308 
309  !
310  !================================================================================================================================
311  !
312 
314  RECURSIVE SUBROUTINE control_loop_finalise(CONTROL_LOOP,ERR,ERROR,*)
316  !Argument variables
317  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
318  INTEGER(INTG), INTENT(OUT) :: ERR
319  TYPE(varying_string), INTENT(OUT) :: ERROR
320  !Local Variables
321  INTEGER(INTG) :: loop_idx
322  TYPE(control_loop_type), POINTER :: CONTROL_LOOP2
323 
324  enters("CONTROL_LOOP_FINALISE",err,error,*999)
325 
326  IF(ASSOCIATED(control_loop)) THEN
327  !Finalise any sub control loops first
328  IF(control_loop%NUMBER_OF_SUB_LOOPS>0) THEN
329  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
330  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
331  CALL control_loop_finalise(control_loop2,err,error,*999)
332  ENDDO !loop_idx
333  DEALLOCATE(control_loop%SUB_LOOPS)
334  ENDIF
335  !Finalise any solvers
336  IF(ASSOCIATED(control_loop%SOLVERS)) CALL solvers_destroy(control_loop%SOLVERS,err,error,*999)
337  !Now finalise this control loop
338  control_loop%LABEL=""
339  CALL control_loop_simple_finalise(control_loop%SIMPLE_LOOP,err,error,*999)
340  CALL control_loop_fixed_finalise(control_loop%FIXED_LOOP,err,error,*999)
341  CALL control_loop_load_increment_finalise(control_loop%LOAD_INCREMENT_LOOP,err,error,*999)
342  CALL control_loop_time_finalise(control_loop%TIME_LOOP,err,error,*999)
343  CALL control_loop_while_finalise(control_loop%WHILE_LOOP,err,error,*999)
344  DEALLOCATE(control_loop)
345  ENDIF
346 
347  exits("CONTROL_LOOP_FINALISE")
348  RETURN
349 999 errorsexits("CONTROL_LOOP_FINALISE",err,error)
350  RETURN 1
351  END SUBROUTINE control_loop_finalise
352 
353  !
354  !================================================================================================================================
355  !
356 
358  SUBROUTINE control_loop_initialise(PROBLEM,ERR,ERROR,*)
360  !Argument variables
361  TYPE(problem_type), POINTER, INTENT(INOUT) :: PROBLEM
362  INTEGER(INTG), INTENT(OUT) :: ERR
363  TYPE(varying_string), INTENT(OUT) :: ERROR
364  !Local Variables
365  INTEGER(INTG) :: DUMMY_ERR
366  TYPE(varying_string) :: DUMMY_ERROR
367 
368  enters("CONTROL_LOOP_INITIALISE",err,error,*998)
369 
370  IF(ASSOCIATED(problem)) THEN
371  IF(ASSOCIATED(problem%CONTROL_LOOP)) THEN
372  CALL flagerror("Control loop is already associated for this problem.",err,error,*998)
373  ELSE
374  ALLOCATE(problem%CONTROL_LOOP,stat=err)
375  IF(err/=0) CALL flagerror("Could not allocate problem control loop.",err,error,*999)
376  problem%CONTROL_LOOP%PROBLEM=>problem
377  NULLIFY(problem%CONTROL_LOOP%PARENT_LOOP)
378  problem%CONTROL_LOOP%CONTROL_LOOP_FINISHED=.false.
379  problem%CONTROL_LOOP%LABEL=" "
380  problem%CONTROL_LOOP%LOOP_TYPE=problem_control_simple_type
381  problem%CONTROL_LOOP%CONTROL_LOOP_LEVEL=1
382  problem%CONTROL_LOOP%SUB_LOOP_INDEX=0
383  problem%CONTROL_LOOP%OUTPUT_TYPE=control_loop_no_output
384  NULLIFY(problem%CONTROL_LOOP%SIMPLE_LOOP)
385  NULLIFY(problem%CONTROL_LOOP%FIXED_LOOP)
386  NULLIFY(problem%CONTROL_LOOP%TIME_LOOP)
387  NULLIFY(problem%CONTROL_LOOP%WHILE_LOOP)
388  NULLIFY(problem%CONTROL_LOOP%LOAD_INCREMENT_LOOP)
389  problem%CONTROL_LOOP%NUMBER_OF_SUB_LOOPS=0
390  NULLIFY(problem%CONTROL_LOOP%SOLVERS)
391  CALL control_loop_simple_initialise(problem%CONTROL_LOOP,err,error,*999)
392  ENDIF
393  ELSE
394  CALL flagerror("Problem is not associated.",err,error,*998)
395  ENDIF
396 
397  exits("CONTROL_LOOP_INITIALISE")
398  RETURN
399 999 CALL control_loop_finalise(problem%CONTROL_LOOP,dummy_err,dummy_error,*998)
400 998 errorsexits("CONTROL_LOOP_INITIALISE",err,error)
401  RETURN 1
402  END SUBROUTINE control_loop_initialise
403 
404  !
405  !================================================================================================================================
406  !
407 
409  SUBROUTINE control_loop_fixed_finalise(FIXED_LOOP,ERR,ERROR,*)
411  !Argument variables
412  TYPE(control_loop_fixed_type), POINTER, INTENT(INOUT) :: FIXED_LOOP
413  INTEGER(INTG), INTENT(OUT) :: ERR
414  TYPE(varying_string), INTENT(OUT) :: ERROR
415  !Local Variables
416 
417  enters("CONTROL_LOOP_FIXED_FINALISE",err,error,*999)
418 
419  IF(ASSOCIATED(fixed_loop)) THEN
420  DEALLOCATE(fixed_loop)
421  ENDIF
422 
423  exits("CONTROL_LOOP_FIXED_FINALISE")
424  RETURN
425 999 errorsexits("CONTROL_LOOP_FIXED_FINALISE",err,error)
426  RETURN 1
427  END SUBROUTINE control_loop_fixed_finalise
428 
429  !
430  !================================================================================================================================
431  !
432 
434  SUBROUTINE control_loop_get_0(CONTROL_LOOP_ROOT,CONTROL_LOOP_IDENTIFIER,CONTROL_LOOP,ERR,ERROR,*)
436  !Argument variables
437  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP_ROOT
438  INTEGER(INTG), INTENT(IN) :: CONTROL_LOOP_IDENTIFIER
439  !TYPE(CONTROL_LOOP_TYPE), POINTER, INTENT(OUT) :: CONTROL_LOOP !<On exit, the specified control loop
440  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
441  INTEGER(INTG), INTENT(OUT) :: ERR
442  TYPE(varying_string), INTENT(OUT) :: ERROR
443  !Local Variables
444 
445  enters("CONTROL_LOOP_GET_0",err,error,*999)
446 
447  CALL control_loop_get_1(control_loop_root,[control_loop_identifier],control_loop,err,error,*999)
448 
449  exits("CONTROL_LOOP_GET_0")
450  RETURN
451 999 errorsexits("CONTROL_LOOP_GET_0",err,error)
452  RETURN 1
453  END SUBROUTINE control_loop_get_0
454 
455  !
456  !================================================================================================================================
457  !
458 
460  SUBROUTINE control_loop_get_1(CONTROL_LOOP_ROOT,CONTROL_LOOP_IDENTIFIER,CONTROL_LOOP,ERR,ERROR,*)
462  !Argument variables
463  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP_ROOT
464  INTEGER(INTG), INTENT(IN) :: CONTROL_LOOP_IDENTIFIER(:)
465  !TYPE(CONTROL_LOOP_TYPE), POINTER, INTENT(OUT) :: CONTROL_LOOP !<On exit, the specified control loop. Must not be associated on entry.
466  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
467  INTEGER(INTG), INTENT(OUT) :: ERR
468  TYPE(varying_string), INTENT(OUT) :: ERROR
469  !Local Variables
470  INTEGER(INTG) :: control_loop_idx
471  TYPE(varying_string) :: LOCAL_ERROR
472 
473  enters("CONTROL_LOOP_GET_1",err,error,*998)
474 
475  IF(ASSOCIATED(control_loop_root)) THEN
476  !IF(CONTROL_LOOP_ROOT%CONTROL_LOOP_FINISHED) THEN
477  IF(ASSOCIATED(control_loop)) THEN
478  CALL flagerror("Control loop is already associated.",err,error,*998)
479  ELSE
480  NULLIFY(control_loop)
481  IF(count(control_loop_identifier==control_loop_node)==1) THEN
482  IF(control_loop_identifier(SIZE(control_loop_identifier,1))==control_loop_node) THEN
483  control_loop=>control_loop_root
484  DO control_loop_idx=1,SIZE(control_loop_identifier,1)
485  IF(control_loop_identifier(control_loop_idx)==control_loop_node) THEN
486  EXIT
487  ELSE
488  IF(control_loop_identifier(control_loop_idx)>0.AND. &
489  & control_loop_identifier(control_loop_idx)<=control_loop%NUMBER_OF_SUB_LOOPS) THEN
490  control_loop=>control_loop%SUB_LOOPS(control_loop_identifier(control_loop_idx))%PTR
491  IF(.NOT.ASSOCIATED(control_loop)) THEN
492  local_error="Control sub loop number "// &
493  & trim(number_to_vstring(control_loop_identifier(control_loop_idx),"*",err,error))// &
494  & " at identifier index "//trim(number_to_vstring(control_loop_idx,"*",err,error))// &
495  & " is not associated."
496  CALL flagerror(local_error,err,error,*999)
497  ENDIF
498  ELSE
499  local_error="Invalid control loop identifier. The identifier at index "// &
500  & trim(number_to_vstring(control_loop_idx,"*",err,error))//" is "// &
501  & trim(number_to_vstring(control_loop_identifier(control_loop_idx),"*",err,error))// &
502  & ". The identifier must be between 1 and "// &
503  & trim(number_to_vstring(control_loop%NUMBER_OF_SUB_LOOPS,"*",err,error))//"."
504  CALL flagerror(local_error,err,error,*999)
505  ENDIF
506  ENDIF
507  ENDDO !control_loop_idx
508  ELSE
509  local_error="Invalid control loop identifier. The last value in the identifier vector is "// &
510  & trim(number_to_vstring(control_loop_identifier(SIZE(control_loop_identifier,1)),"*",err,error))// &
511  & " and it should be "//trim(number_to_vstring(control_loop_node,"*",err,error))//"."
512  CALL flagerror(local_error,err,error,*999)
513  ENDIF
514  ELSE
515  local_error="Invalid control loop identifier. The control loop identifier has "// &
516  & trim(number_to_vstring(count(control_loop_identifier==control_loop_node),"*",err,error))// &
517  & " control loop node identifiers and it should only have 1."
518  CALL flagerror(local_error,err,error,*999)
519  ENDIF
520  ENDIF
521  !ELSE
522  ! CALL FlagError("Control loop root has not been finished.",ERR,ERROR,*998)
523  !ENDIF
524  ELSE
525  CALL flagerror("Control loop root is not associated.",err,error,*998)
526  ENDIF
527 
528  exits("CONTROL_LOOP_GET_1")
529  RETURN
530 999 NULLIFY(control_loop)
531 998 errorsexits("CONTROL_LOOP_GET_1",err,error)
532  RETURN 1
533  END SUBROUTINE control_loop_get_1
534 
535  !
536  !================================================================================================================================
537  !
538 
540  SUBROUTINE control_loop_fixed_initialise(CONTROL_LOOP,ERR,ERROR,*)
542  !Argument variables
543  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
544  INTEGER(INTG), INTENT(OUT) :: ERR
545  TYPE(varying_string), INTENT(OUT) :: ERROR
546  !Local Variables
547  INTEGER(INTG) :: DUMMY_ERR
548  TYPE(varying_string) :: DUMMY_ERROR
549 
550  enters("CONTROL_LOOP_FIXED_INITIALISE",err,error,*998)
551 
552  IF(ASSOCIATED(control_loop)) THEN
553  IF(ASSOCIATED(control_loop%FIXED_LOOP)) THEN
554  CALL flagerror("The fixed loop is already associated for this control loop.",err,error,*998)
555  ELSE
556  ALLOCATE(control_loop%FIXED_LOOP,stat=err)
557  IF(err/=0) CALL flagerror("Could not allocate fixed loop for the control loop.",err,error,*999)
558  control_loop%FIXED_LOOP%CONTROL_LOOP=>control_loop
559  control_loop%FIXED_LOOP%ITERATION_NUMBER=0
560  control_loop%FIXED_LOOP%START_ITERATION=1
561  control_loop%FIXED_LOOP%STOP_ITERATION=100
562  control_loop%FIXED_LOOP%ITERATION_INCREMENT=1
563  ENDIF
564  ELSE
565  CALL flagerror("Control loop is not associated.",err,error,*998)
566  ENDIF
567 
568  exits("CONTROL_LOOP_FIXED_INITIALISE")
569  RETURN
570 999 CALL control_loop_fixed_finalise(control_loop%FIXED_LOOP,dummy_err,dummy_error,*998)
571 998 errorsexits("CONTROL_LOOP_FIXED_INITIALISE",err,error)
572  RETURN 1
573  END SUBROUTINE control_loop_fixed_initialise
574 
575  !
576  !================================================================================================================================
577  !
578 
580  SUBROUTINE control_loop_iterations_set(CONTROL_LOOP,START_ITERATION,STOP_ITERATION,ITERATION_INCREMENT,ERR,ERROR,*)
582  !Argument variables
583  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
584  INTEGER(INTG), INTENT(IN) :: START_ITERATION
585  INTEGER(INTG), INTENT(IN) :: STOP_ITERATION
586  INTEGER(INTG), INTENT(IN) :: ITERATION_INCREMENT
587  INTEGER(INTG), INTENT(OUT) :: ERR
588  TYPE(varying_string), INTENT(OUT) :: ERROR
589  !Local Variables
590  TYPE(control_loop_fixed_type), POINTER :: FIXED_LOOP
591  TYPE(varying_string) :: LOCAL_ERROR
592 
593  enters("CONTROL_LOOP_ITERATIONS_SET",err,error,*999)
594 
595  IF(ASSOCIATED(control_loop)) THEN
596  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
597  CALL flagerror("Control loop has been finished.",err,error,*999)
598  ELSE
599  IF(control_loop%LOOP_TYPE==problem_control_fixed_loop_type) THEN
600  fixed_loop=>control_loop%FIXED_LOOP
601  IF(ASSOCIATED(fixed_loop)) THEN
602  IF(iteration_increment==0) THEN
603  local_error="The specified time increment of "//trim(number_to_vstring(iteration_increment,"*",err,error))// &
604  & " is invalid. The iteration increment must not be zero."
605  CALL flagerror(local_error,err,error,*999)
606  ELSE
607  IF(iteration_increment>0) THEN
608  IF(stop_iteration<=start_iteration) THEN
609  local_error="The specified stop iteration of "//trim(number_to_vstring(stop_iteration,"*",err,error))// &
610  & " is incompatiable with a specified start increment of "// &
611  & trim(number_to_vstring(start_iteration,"*",err,error))// &
612  & ". For a positive iteration increment the stop iteration must be > than the start iteration."
613  CALL flagerror(local_error,err,error,*999)
614  ENDIF
615  ELSE
616  IF(start_iteration<=stop_iteration) THEN
617  local_error="The specified start iteration of "//trim(number_to_vstring(start_iteration,"*",err,error))// &
618  & " is incompatiable with a specified stop iteration of "// &
619  & trim(number_to_vstring(stop_iteration,"*",err,error))// &
620  & ". For a negative iteration increment the stop iteration must be < than the start iteration."
621  CALL flagerror(local_error,err,error,*999)
622  ENDIF
623  ENDIF
624  ENDIF
625  fixed_loop%START_ITERATION=start_iteration
626  fixed_loop%STOP_ITERATION=stop_iteration
627  fixed_loop%ITERATION_INCREMENT=iteration_increment
628  ELSE
629  CALL flagerror("Control loop fixed loop is not associated.",err,error,*999)
630  ENDIF
631  ELSE
632  CALL flagerror("The specified control loop is not a fixed control loop.",err,error,*999)
633  ENDIF
634  ENDIF
635  ELSE
636  CALL flagerror("Control loop is not associated.",err,error,*999)
637  ENDIF
638 
639  exits("CONTROL_LOOP_ITERATIONS_SET")
640  RETURN
641 999 errorsexits("CONTROL_LOOP_ITERATIONS_SET",err,error)
642  RETURN 1
643  END SUBROUTINE control_loop_iterations_set
644 
645  !
646  !================================================================================================================================
647  !
648 
650  SUBROUTINE control_loop_label_get_c(CONTROL_LOOP,LABEL,ERR,ERROR,*)
652  !Argument variables
653  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
654  CHARACTER(LEN=*), INTENT(OUT) :: LABEL
655  INTEGER(INTG), INTENT(OUT) :: ERR
656  TYPE(varying_string), INTENT(OUT) :: ERROR
657  !Local Variables
658  INTEGER(INTG) :: C_LENGTH,VS_LENGTH
659 
660  enters("CONTROL_LOOP_LABEL_GET_C",err,error,*999)
661 
662  IF(ASSOCIATED(control_loop)) THEN
663  c_length=len(label)
664  vs_length=len_trim(control_loop%LABEL)
665  IF(c_length>vs_length) THEN
666  label=char(control_loop%LABEL,vs_length)
667  ELSE
668  label=char(control_loop%LABEL,c_length)
669  ENDIF
670  ELSE
671  CALL flagerror("Control loop is not associated.",err,error,*999)
672  ENDIF
673 
674  exits("CONTROL_LOOP_LABEL_GET_C")
675  RETURN
676 999 errorsexits("CONTROL_LOOP_LABEL_GET_C",err,error)
677  RETURN 1
678 
679  END SUBROUTINE control_loop_label_get_c
680 
681  !
682  !================================================================================================================================
683  !
684 
686  SUBROUTINE control_loop_label_get_vs(CONTROL_LOOP,LABEL,ERR,ERROR,*)
688  !Argument variables
689  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
690  TYPE(varying_string), INTENT(OUT) :: LABEL
691  INTEGER(INTG), INTENT(OUT) :: ERR
692  TYPE(varying_string), INTENT(OUT) :: ERROR
693  !Local Variables
694 
695  enters("CONTROL_LOOP_LABEL_GET_VS",err,error,*999)
696 
697  IF(ASSOCIATED(control_loop)) THEN
698  label=var_str(char(control_loop%LABEL))
699  ELSE
700  CALL flagerror("Control loop is not associated.",err,error,*999)
701  ENDIF
702 
703  exits("CONTROL_LOOP_LABEL_GET_VS")
704  RETURN
705 999 errorsexits("CONTROL_LOOP_LABEL_GET_VS",err,error)
706  RETURN 1
707 
708  END SUBROUTINE control_loop_label_get_vs
709 
710  !
711  !================================================================================================================================
712  !
713 
715  SUBROUTINE control_loop_label_set_c(CONTROL_LOOP,LABEL,ERR,ERROR,*)
717  !Argument variables
718  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
719  CHARACTER(LEN=*), INTENT(IN) :: LABEL
720  INTEGER(INTG), INTENT(OUT) :: ERR
721  TYPE(varying_string), INTENT(OUT) :: ERROR
722  !Local Variables
723 
724  enters("CONTROL_LOOP_LABEL_SET_C",err,error,*999)
725 
726  IF(ASSOCIATED(control_loop)) THEN
727  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
728  CALL flagerror("Control loop has been finished.",err,error,*999)
729  ELSE
730  control_loop%LABEL=label
731  ENDIF
732  ELSE
733  CALL flagerror("Control loop is not associated.",err,error,*999)
734  ENDIF
735 
736  exits("CONTROL_LOOP_LABEL_SET_C")
737  RETURN
738 999 errorsexits("CONTROL_LOOP_LABEL_SET_C",err,error)
739  RETURN 1
740 
741  END SUBROUTINE control_loop_label_set_c
742 
743  !
744  !================================================================================================================================
745  !
746 
748  SUBROUTINE control_loop_label_set_vs(CONTROL_LOOP,LABEL,ERR,ERROR,*)
750  !Argument variables
751  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
752  TYPE(varying_string), INTENT(IN) :: LABEL
753  INTEGER(INTG), INTENT(OUT) :: ERR
754  TYPE(varying_string), INTENT(OUT) :: ERROR
755  !Local Variables
756 
757  enters("CONTROL_LOOP_LABEL_SET_VS",err,error,*999)
758 
759  IF(ASSOCIATED(control_loop)) THEN
760  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
761  CALL flagerror("Control loop has been finished.",err,error,*999)
762  ELSE
763  control_loop%LABEL=label
764  ENDIF
765  ELSE
766  CALL flagerror("Control loop is not associated.",err,error,*999)
767  ENDIF
768 
769  exits("CONTROL_LOOP_LABEL_SET_VS")
770  RETURN
771 999 errorsexits("CONTROL_LOOP_LABEL_SET_VS",err,error)
772  RETURN 1
773 
774  END SUBROUTINE control_loop_label_set_vs
775 
776  !
777  !================================================================================================================================
778  !
779 
781  SUBROUTINE control_loop_maximum_iterations_set(CONTROL_LOOP,MAXIMUM_ITERATIONS,ERR,ERROR,*)
783  !Argument variables
784  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
785  INTEGER(INTG), INTENT(IN) :: MAXIMUM_ITERATIONS
786  INTEGER(INTG), INTENT(OUT) :: ERR
787  TYPE(varying_string), INTENT(OUT) :: ERROR
788  !Local Variables
789  TYPE(control_loop_while_type), POINTER :: WHILE_LOOP
790  TYPE(control_loop_load_increment_type), POINTER :: LOAD_INCREMENT_LOOP
791  TYPE(varying_string) :: LOCAL_ERROR
792 
793  enters("CONTROL_LOOP_MAXIMUM_ITERATIONS_SET",err,error,*999)
794 
795  IF(ASSOCIATED(control_loop)) THEN
796  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
797  !allow to update the maximum number of iterations at a later time for the load increment loop type
798  IF(control_loop%LOOP_TYPE==problem_control_load_increment_loop_type) THEN
799  load_increment_loop=>control_loop%LOAD_INCREMENT_LOOP
800  IF(ASSOCIATED(load_increment_loop)) THEN
801  IF(maximum_iterations<=0) THEN
802  local_error="The specified maximum number of iterations of "// &
803  & trim(number_to_vstring(maximum_iterations,"*",err,error))// &
804  & " is invalid. The maximum number of iterations must be greater than zero."
805  CALL flagerror(local_error,err,error,*999)
806  ENDIF
807  load_increment_loop%MAXIMUM_NUMBER_OF_ITERATIONS=maximum_iterations
808  ELSE
809  CALL flagerror("Control loop load incremented loop is not associated.",err,error,*999)
810  ENDIF
811  ELSE
812  CALL flagerror("Control loop has been finished.",err,error,*999)
813  ENDIF
814  ELSE
815  IF(control_loop%LOOP_TYPE==problem_control_while_loop_type) THEN
816  while_loop=>control_loop%WHILE_LOOP
817  IF(ASSOCIATED(while_loop)) THEN
818  IF(maximum_iterations<=0) THEN
819  local_error="The specified maximum number of iterations of "// &
820  & trim(number_to_vstring(maximum_iterations,"*",err,error))// &
821  & " is invalid. The maximum number of iterations must be greater than zero."
822  CALL flagerror(local_error,err,error,*999)
823  ENDIF
824  while_loop%MAXIMUM_NUMBER_OF_ITERATIONS=maximum_iterations
825  ELSE
826  CALL flagerror("Control loop while loop is not associated.",err,error,*999)
827  ENDIF
828  ELSEIF(control_loop%LOOP_TYPE==problem_control_load_increment_loop_type) THEN
829  load_increment_loop=>control_loop%LOAD_INCREMENT_LOOP
830  IF(ASSOCIATED(load_increment_loop)) THEN
831  IF(maximum_iterations<=0) THEN
832  local_error="The specified maximum number of iterations of "// &
833  & trim(number_to_vstring(maximum_iterations,"*",err,error))// &
834  & " is invalid. The maximum number of iterations must be greater than zero."
835  CALL flagerror(local_error,err,error,*999)
836  ENDIF
837  load_increment_loop%MAXIMUM_NUMBER_OF_ITERATIONS=maximum_iterations
838  ELSE
839  CALL flagerror("Control loop load increment loop is not associated.",err,error,*999)
840  ENDIF
841  ELSE
842  CALL flagerror("The specified control loop is not a while or load increment control loop.",err,error,*999)
843  ENDIF
844  ENDIF
845  ELSE
846  CALL flagerror("Control loop is not associated.",err,error,*999)
847  ENDIF
848 
849  exits("CONTROL_LOOP_MAXIMUM_ITERATIONS_SET")
850  RETURN
851 999 errorsexits("CONTROL_LOOP_MAXIMUM_ITERATIONS_SET",err,error)
852  RETURN 1
854 
855  !
856  !================================================================================================================================
857  !
858 
860  SUBROUTINE control_loop_load_output_set(CONTROL_LOOP,OUTPUT_FREQUENCY,ERR,ERROR,*)
862  !Argument variables
863  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
864  INTEGER(INTG), INTENT(IN) :: OUTPUT_FREQUENCY
865  INTEGER(INTG), INTENT(OUT) :: ERR
866  TYPE(varying_string), INTENT(OUT) :: ERROR
867  !Local Variables
868  TYPE(control_loop_load_increment_type), POINTER :: LOAD_INCREMENT_LOOP
869 
870  enters("CONTROL_LOOP_LOAD_OUTPUT_SET",err,error,*999)
871 
872  IF(ASSOCIATED(control_loop)) THEN
873  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
874  CALL flagerror("Control loop has been finished.",err,error,*999)
875  ELSE
876  IF(control_loop%LOOP_TYPE==problem_control_load_increment_loop_type) THEN
877  load_increment_loop=>control_loop%LOAD_INCREMENT_LOOP
878  IF(ASSOCIATED(load_increment_loop)) THEN
879  load_increment_loop%OUTPUT_NUMBER=output_frequency
880  ELSE
881  CALL flagerror("Control loop load increment loop is not associated.",err,error,*999)
882  ENDIF
883  ELSE
884  CALL flagerror("The specified control loop is not a load increment control loop.",err,error,*999)
885  ENDIF
886  ENDIF
887  ELSE
888  CALL flagerror("Control loop is not associated.",err,error,*999)
889  ENDIF
890 
891  exits("CONTROL_LOOP_LOAD_OUTPUT_SET")
892  RETURN
893 999 errorsexits("CONTROL_LOOP_LOAD_OUTPUT_SET",err,error)
894  RETURN 1
895  END SUBROUTINE control_loop_load_output_set
896 
897  !
898  !================================================================================================================================
899  !
900 
902  SUBROUTINE controlloop_absolutetoleranceset(controlLoop,absoluteTolerance,err,error,*)
904  !Argument variables
905  TYPE(control_loop_type), POINTER, INTENT(IN) :: controlLoop
906  REAL(DP), INTENT(IN) :: absoluteTolerance
907  INTEGER(INTG), INTENT(OUT) :: err
908  TYPE(varying_string), INTENT(OUT) :: error
909  !Local Variables
910  TYPE(control_loop_while_type), POINTER :: whileLoop
911  TYPE(varying_string) :: localError
912 
913  enters("ControlLoop_AbsoluteToleranceSet",err,error,*999)
914 
915  IF(ASSOCIATED(controlloop)) THEN
916  IF(controlloop%CONTROL_LOOP_FINISHED) THEN
917  CALL flagerror("Control loop has been finished.",err,error,*999)
918  ELSE
919  IF(controlloop%LOOP_TYPE==problem_control_while_loop_type) THEN
920  whileloop=>controlloop%WHILE_LOOP
921  IF(ASSOCIATED(whileloop)) THEN
922  IF(absolutetolerance<=0) THEN
923  localerror="The specified absolute tolerance of "// &
924  & trim(number_to_vstring(absolutetolerance,"*",err,error))// &
925  & " is invalid for a while loop. The tolerance must be greater than zero."
926  CALL flagerror(localerror,err,error,*999)
927  ENDIF
928  whileloop%ABSOLUTE_TOLERANCE=absolutetolerance
929  ELSE
930  CALL flagerror("Control loop while loop is not associated.",err,error,*999)
931  ENDIF
932  ENDIF
933  ENDIF
934  ELSE
935  CALL flagerror("Control loop is not associated.",err,error,*999)
936  ENDIF
937 
938  exits("ControlLoop_AbsoluteToleranceSet")
939  RETURN
940 999 errorsexits("ControlLoop_AbsoluteToleranceSet",err,error)
941  RETURN 1
942 
943  END SUBROUTINE controlloop_absolutetoleranceset
944 
945  !
946  !================================================================================================================================
947  !
948 
950  SUBROUTINE control_loop_number_of_iterations_set(CONTROL_LOOP,NUMBER_OF_ITERATIONS,ERR,ERROR,*)
952  !Argument variables
953  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
954  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_ITERATIONS
955  INTEGER(INTG), INTENT(OUT) :: ERR
956  TYPE(varying_string), INTENT(OUT) :: ERROR
957  !Local Variables
958  TYPE(control_loop_time_type), POINTER :: TIME_LOOP
959  TYPE(varying_string) :: LOCAL_ERROR
960 
961  enters("CONTROL_LOOP_NUMBER_OF_ITERATIONS_SET",err,error,*999)
962 
963  IF(ASSOCIATED(control_loop)) THEN
964  IF(control_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
965  time_loop=>control_loop%TIME_LOOP
966  IF(ASSOCIATED(time_loop)) THEN
967  IF(number_of_iterations<0) THEN
968  local_error="The specified number of iterations of "//trim(number_to_vstring(number_of_iterations,"*",err,error))// &
969  & " is invalid. The number must be non-negative."
970  CALL flagerror(local_error,err,error,*999)
971  ENDIF
972  time_loop%NUMBER_OF_ITERATIONS=number_of_iterations
973 
974  !Update time increment if number of iterations differs from time stepping settings
975  IF (ceiling((time_loop%STOP_TIME-time_loop%START_TIME)/time_loop%TIME_INCREMENT) &
976  & /= time_loop%NUMBER_OF_ITERATIONS) THEN
977  time_loop%TIME_INCREMENT = (time_loop%STOP_TIME-time_loop%START_TIME)/time_loop%NUMBER_OF_ITERATIONS
978  ENDIF
979 
980  ELSE
981  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
982  ENDIF
983  ELSE
984  CALL flagerror("The specified control loop is not a time control loop.",err,error,*999)
985  ENDIF
986  ELSE
987  CALL flagerror("Control loop is not associated.",err,error,*999)
988  ENDIF
989 
990  exits("CONTROL_LOOP_NUMBER_OF_ITERATIONS_SET")
991  RETURN
992 999 errorsexits("CONTROL_LOOP_NUMBER_OF_ITERATIONS_SET",err,error)
993  RETURN 1
995 
996  !
997  !================================================================================================================================
998  !
999 
1001  SUBROUTINE control_loop_number_of_iterations_get(CONTROL_LOOP,NUMBER_OF_ITERATIONS,ERR,ERROR,*)
1003  !Argument variables
1004  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1005  INTEGER(INTG), INTENT(OUT) :: NUMBER_OF_ITERATIONS
1006  INTEGER(INTG), INTENT(OUT) :: ERR
1007  TYPE(varying_string), INTENT(OUT) :: ERROR
1008  !Local Variables
1009  TYPE(control_loop_time_type), POINTER :: TIME_LOOP
1010  TYPE(varying_string) :: LOCAL_ERROR
1011 
1012  enters("CONTROL_LOOP_NUMBER_OF_ITERATIONS_GET",err,error,*999)
1013 
1014  IF(ASSOCIATED(control_loop)) THEN
1015  IF(control_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
1016  time_loop=>control_loop%TIME_LOOP
1017  IF(ASSOCIATED(time_loop)) THEN
1018  number_of_iterations=time_loop%NUMBER_OF_ITERATIONS
1019  ELSE
1020  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
1021  ENDIF
1022  ELSE
1023  CALL flagerror("The specified control loop is not a time control loop.",err,error,*999)
1024  ENDIF
1025  ELSE
1026  CALL flagerror("Control loop is not associated.",err,error,*999)
1027  ENDIF
1028 
1029  exits("CONTROL_LOOP_NUMBER_OF_ITERATIONS_GET")
1030  RETURN
1031 999 errorsexits("CONTROL_LOOP_NUMBER_OF_ITERATIONS_GET",err,error)
1032  RETURN 1
1034 
1035  !
1036  !================================================================================================================================
1037  !
1038 
1040  SUBROUTINE control_loop_number_of_sub_loops_get(CONTROL_LOOP,NUMBER_OF_SUB_LOOPS,ERR,ERROR,*)
1042  !Argument variables
1043  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1044  INTEGER(INTG), INTENT(OUT) :: NUMBER_OF_SUB_LOOPS
1045  INTEGER(INTG), INTENT(OUT) :: ERR
1046  TYPE(varying_string), INTENT(OUT) :: ERROR
1047  !Local Variables
1048 
1049  enters("CONTROL_LOOP_NUMBER_OF_SUB_LOOPS_GET",err,error,*999)
1050 
1051  IF(ASSOCIATED(control_loop)) THEN
1052  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1053  CALL flagerror("Control loop has already been finished.",err,error,*999)
1054  ELSE
1055  number_of_sub_loops=control_loop%NUMBER_OF_SUB_LOOPS
1056  ENDIF
1057  ELSE
1058  CALL flagerror("Control loop is not associated.",err,error,*999)
1059  ENDIF
1060 
1061  exits("CONTROL_LOOP_NUMBER_OF_SUB_LOOPS_GET")
1062  RETURN
1063 999 errorsexits("CONTROL_LOOP_NUMBER_OF_SUB_LOOPS_GET",err,error)
1064  RETURN 1
1066 
1067  !
1068  !================================================================================================================================
1069  !
1070 
1072  SUBROUTINE control_loop_number_of_sub_loops_set(CONTROL_LOOP,NUMBER_OF_SUB_LOOPS,ERR,ERROR,*)
1074  !Argument variables
1075  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
1076  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_SUB_LOOPS
1077  INTEGER(INTG), INTENT(OUT) :: ERR
1078  TYPE(varying_string), INTENT(OUT) :: ERROR
1079  !Local Variables
1080  INTEGER(INTG) :: loop_idx
1081  TYPE(control_loop_ptr_type), ALLOCATABLE :: OLD_SUB_LOOPS(:)
1082  TYPE(varying_string) :: LOCAL_ERROR
1083 
1084  enters("CONTROL_LOOP_NUMBER_OF_SUB_LOOPS_SET",err,error,*999)
1085 
1086  IF(ASSOCIATED(control_loop)) THEN
1087  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1088  CALL flagerror("Control loop has already been finished.",err,error,*999)
1089  ELSE
1090  IF(number_of_sub_loops>=0) THEN
1091  IF(number_of_sub_loops/=control_loop%NUMBER_OF_SUB_LOOPS) THEN
1092  IF(control_loop%NUMBER_OF_SUB_LOOPS>0) THEN
1093  ALLOCATE(old_sub_loops(control_loop%NUMBER_OF_SUB_LOOPS),stat=err)
1094  IF(err/=0) CALL flagerror("Could not allocate old sub loops.",err,error,*999)
1095  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
1096  old_sub_loops(loop_idx)%PTR=>control_loop%SUB_LOOPS(loop_idx)%PTR
1097  ENDDO !loop_idx
1098  DEALLOCATE(control_loop%SUB_LOOPS)
1099  ENDIF
1100  ALLOCATE(control_loop%SUB_LOOPS(number_of_sub_loops),stat=err)
1101  IF(err/=0) CALL flagerror("Could not allocate control loop sub loops.",err,error,*999)
1102  IF(number_of_sub_loops>control_loop%NUMBER_OF_SUB_LOOPS) THEN
1103  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
1104  control_loop%SUB_LOOPS(loop_idx)%PTR=>old_sub_loops(loop_idx)%PTR
1105  ENDDO !loop_idx
1106  DO loop_idx=control_loop%NUMBER_OF_SUB_LOOPS+1,number_of_sub_loops
1107  ALLOCATE(control_loop%SUB_LOOPS(loop_idx)%PTR,stat=err)
1108  IF(err/=0) CALL flagerror("Could not allocate sub loops control loop.",err,error,*999)
1109  control_loop%SUB_LOOPS(loop_idx)%PTR%PROBLEM=>control_loop%PROBLEM
1110  control_loop%SUB_LOOPS(loop_idx)%PTR%PARENT_LOOP=>control_loop
1111  control_loop%SUB_LOOPS(loop_idx)%PTR%CONTROL_LOOP_FINISHED=.false.
1112  control_loop%SUB_LOOPS(loop_idx)%PTR%LOOP_TYPE=problem_control_simple_type
1113  control_loop%SUB_LOOPS(loop_idx)%PTR%CONTROL_LOOP_LEVEL=control_loop%CONTROL_LOOP_LEVEL+1
1114  control_loop%SUB_LOOPS(loop_idx)%PTR%SUB_LOOP_INDEX=loop_idx
1115  NULLIFY(control_loop%SUB_LOOPS(loop_idx)%PTR%SIMPLE_LOOP)
1116  NULLIFY(control_loop%SUB_LOOPS(loop_idx)%PTR%FIXED_LOOP)
1117  NULLIFY(control_loop%SUB_LOOPS(loop_idx)%PTR%TIME_LOOP)
1118  NULLIFY(control_loop%SUB_LOOPS(loop_idx)%PTR%WHILE_LOOP)
1119  NULLIFY(control_loop%SUB_LOOPS(loop_idx)%PTR%LOAD_INCREMENT_LOOP)
1120  control_loop%SUB_LOOPS(loop_idx)%PTR%NUMBER_OF_SUB_LOOPS=0
1121  NULLIFY(control_loop%SUB_LOOPS(loop_idx)%PTR%SOLVERS)
1122  CALL control_loop_simple_initialise(control_loop%SUB_LOOPS(loop_idx)%PTR,err,error,*999)
1123  ENDDO !loop_idx
1124  ELSE
1125  DO loop_idx=1,number_of_sub_loops
1126  control_loop%SUB_LOOPS(loop_idx)%PTR=>old_sub_loops(loop_idx)%PTR
1127  ENDDO !loop_idx
1128  DO loop_idx=number_of_sub_loops+1,control_loop%NUMBER_OF_SUB_LOOPS
1129  CALL control_loop_finalise(old_sub_loops(loop_idx)%PTR,err,error,*999)
1130  ENDDO !loop_idx
1131  ENDIF
1132  IF(ALLOCATED(old_sub_loops)) DEALLOCATE(old_sub_loops)
1133  control_loop%NUMBER_OF_SUB_LOOPS=number_of_sub_loops
1134  ENDIF
1135  ELSE
1136  local_error="The given number of sub loops of "//trim(number_to_vstring(number_of_sub_loops,"*",err,error))// &
1137  & " is invalid. The number of sub loops must be >= 0."
1138  CALL flagerror(local_error,err,error,*999)
1139  ENDIF
1140  ENDIF
1141  ELSE
1142  CALL flagerror("Control loop is not associated.",err,error,*999)
1143  ENDIF
1144 
1145  exits("CONTROL_LOOP_NUMBER_OF_SUB_LOOPS_SET")
1146  RETURN
1147 999 IF(ALLOCATED(old_sub_loops)) DEALLOCATE(old_sub_loops)
1148  errorsexits("CONTROL_LOOP_NUMBER_OF_SUB_LOOPS_SET",err,error)
1149  RETURN 1
1151 
1152  !
1153  !================================================================================================================================
1154  !
1155 
1157  SUBROUTINE control_loop_output_type_get(CONTROL_LOOP,OUTPUT_TYPE,ERR,ERROR,*)
1159  !Argument variables
1160  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1161  INTEGER(INTG), INTENT(OUT) :: OUTPUT_TYPE
1162  INTEGER(INTG), INTENT(OUT) :: ERR
1163  TYPE(varying_string), INTENT(OUT) :: ERROR
1164  !Local Variables
1165 
1166  enters("CONTROL_LOOP_OUTPUT_TYPE_GET",err,error,*999)
1167 
1168  IF(ASSOCIATED(control_loop)) THEN
1169  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1170  output_type=control_loop%OUTPUT_TYPE
1171  ELSE
1172  CALL flagerror("Control loop has not been finished.",err,error,*999)
1173  ENDIF
1174  ELSE
1175  CALL flagerror("Control loop is not associated.",err,error,*999)
1176  ENDIF
1177 
1178  exits("CONTROL_LOOP_OUTPUT_TYPE_GET")
1179  RETURN
1180 999 errorsexits("CONTROL_LOOP_OUTPUT_TYPE_GET",err,error)
1181  RETURN 1
1182  END SUBROUTINE control_loop_output_type_get
1183 
1184  !
1185  !================================================================================================================================
1186  !
1187 
1189  SUBROUTINE control_loop_output_type_set(CONTROL_LOOP,OUTPUT_TYPE,ERR,ERROR,*)
1191  !Argument variables
1192  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1193  INTEGER(INTG), INTENT(IN) :: OUTPUT_TYPE
1194  INTEGER(INTG), INTENT(OUT) :: ERR
1195  TYPE(varying_string), INTENT(OUT) :: ERROR
1196  !Local Variables
1197  TYPE(varying_string) :: LOCAL_ERROR
1198 
1199  enters("CONTROL_LOOP_OUTPUT_TYPE_SET",err,error,*999)
1200 
1201  IF(ASSOCIATED(control_loop)) THEN
1202  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1203  CALL flagerror("Control loop has already been finished.",err,error,*999)
1204  ELSE
1205  SELECT CASE(output_type)
1207  control_loop%OUTPUT_TYPE=control_loop_no_output
1209  control_loop%OUTPUT_TYPE=control_loop_progress_output
1210  CASE(solver_timing_output)
1211  control_loop%OUTPUT_TYPE=control_loop_timing_output
1212  CASE DEFAULT
1213  local_error="The specified control loop output type of "// &
1214  & trim(number_to_vstring(output_type,"*",err,error))//" is invalid."
1215  CALL flagerror(local_error,err,error,*999)
1216  END SELECT
1217  ENDIF
1218  ELSE
1219  CALL flagerror("Control loop is not associated.",err,error,*999)
1220  ENDIF
1221 
1222  exits("CONTROL_LOOP_OUTPUT_TYPE_SET")
1223  RETURN
1224 999 errorsexits("CONTROL_LOOP_OUTPUT_TYPE_SET",err,error)
1225  RETURN 1
1226 
1227  END SUBROUTINE control_loop_output_type_set
1228 
1229  !
1230  !================================================================================================================================
1231  !
1232 
1234  SUBROUTINE control_loop_simple_finalise(SIMPLE_LOOP,ERR,ERROR,*)
1236  !Argument variables
1237  TYPE(control_loop_simple_type), POINTER, INTENT(INOUT) :: SIMPLE_LOOP
1238  INTEGER(INTG), INTENT(OUT) :: ERR
1239  TYPE(varying_string), INTENT(OUT) :: ERROR
1240  !Local Variables
1241 
1242  enters("CONTROL_LOOP_SIMPLE_FINALISE",err,error,*999)
1243 
1244  IF(ASSOCIATED(simple_loop)) THEN
1245  DEALLOCATE(simple_loop)
1246  ENDIF
1247 
1248  exits("CONTROL_LOOP_SIMPLE_FINALISE")
1249  RETURN
1250 999 errorsexits("CONTROL_LOOP_SIMPLE_FINALISE",err,error)
1251  RETURN 1
1252  END SUBROUTINE control_loop_simple_finalise
1253 
1254  !
1255  !================================================================================================================================
1256  !
1257 
1259  SUBROUTINE control_loop_simple_initialise(CONTROL_LOOP,ERR,ERROR,*)
1261  !Argument variables
1262  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
1263  INTEGER(INTG), INTENT(OUT) :: ERR
1264  TYPE(varying_string), INTENT(OUT) :: ERROR
1265  !Local Variables
1266  INTEGER(INTG) :: DUMMY_ERR
1267  TYPE(varying_string) :: DUMMY_ERROR
1268 
1269  enters("CONTROL_LOOP_SIMPLE_INITIALISE",err,error,*998)
1270 
1271  IF(ASSOCIATED(control_loop)) THEN
1272  IF(ASSOCIATED(control_loop%SIMPLE_LOOP)) THEN
1273  CALL flagerror("The simple loop is already associated for this control loop.",err,error,*998)
1274  ELSE
1275  ALLOCATE(control_loop%SIMPLE_LOOP,stat=err)
1276  IF(err/=0) CALL flagerror("Could not allocate simple loop for the control loop.",err,error,*999)
1277  control_loop%SIMPLE_LOOP%CONTROL_LOOP=>control_loop
1278  ENDIF
1279  ELSE
1280  CALL flagerror("Control loop is not associated.",err,error,*998)
1281  ENDIF
1282 
1283  exits("CONTROL_LOOP_SIMPLE_INITIALISE")
1284  RETURN
1285 999 CALL control_loop_simple_finalise(control_loop%SIMPLE_LOOP,dummy_err,dummy_error,*998)
1286 998 errorsexits("CONTROL_LOOP_SIMPLE_INITIALISE",err,error)
1287  RETURN 1
1288  END SUBROUTINE control_loop_simple_initialise
1289 
1290  !
1291  !================================================================================================================================
1292  !
1293 
1295  RECURSIVE SUBROUTINE control_loop_solvers_destroy(CONTROL_LOOP,ERR,ERROR,*)
1297  !Argument variables
1298  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1299  INTEGER(INTG), INTENT(OUT) :: ERR
1300  TYPE(varying_string), INTENT(OUT) :: ERROR
1301  !Local Variables
1302  INTEGER(INTG) :: loop_idx
1303  TYPE(control_loop_type), POINTER :: CONTROL_LOOP2
1304 
1305  enters("CONTROL_LOOP_SOLVERS_DESTROY",err,error,*999)
1306 
1307  IF(ASSOCIATED(control_loop)) THEN
1308  !Destroy the solvers in any sub control loops first
1309  IF(control_loop%NUMBER_OF_SUB_LOOPS>0) THEN
1310  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
1311  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
1312  CALL control_loop_solvers_destroy(control_loop2,err,error,*999)
1313  ENDDO !loop_idx
1314  ENDIF
1315  !Destroy the solvers in this control loop
1316  IF(ASSOCIATED(control_loop%SOLVERS)) CALL solvers_destroy(control_loop%SOLVERS,err,error,*999)
1317  ELSE
1318  CALL flagerror("Control loop is not associated.",err,error,*999)
1319  ENDIF
1320 
1321  exits("CONTROL_LOOP_SOLVERS_DESTROY")
1322  RETURN
1323 999 errorsexits("CONTROL_LOOP_SOLVERS_DESTROY",err,error)
1324  RETURN 1
1325  END SUBROUTINE control_loop_solvers_destroy
1326 
1327  !
1328  !================================================================================================================================
1329  !
1330 
1332  RECURSIVE SUBROUTINE control_loop_solvers_get(CONTROL_LOOP,SOLVERS,ERR,ERROR,*)
1334  !Argument variables
1335  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1336 ! TYPE(SOLVERS_TYPE), POINTER, INTENT(OUT) :: SOLVERS !<On exit, a pointer to the control loop solvers. Must not be associated on entry.
1337  TYPE(solvers_type), POINTER :: SOLVERS
1338  INTEGER(INTG), INTENT(OUT) :: ERR
1339  TYPE(varying_string), INTENT(OUT) :: ERROR
1340  !Local Variables
1341 
1342  enters("CONTROL_LOOP_SOLVERS_GET",err,error,*999)
1343 
1344  IF(ASSOCIATED(control_loop)) THEN
1345  IF(ASSOCIATED(solvers)) THEN
1346  CALL flagerror("Solvers is already associated.",err,error,*999)
1347  ELSE
1348  solvers=>control_loop%SOLVERS
1349  IF(.NOT.ASSOCIATED(solvers)) CALL flagerror("Solvers is not associated.",err,error,*999)
1350  ENDIF
1351  ELSE
1352  CALL flagerror("Control loop is not associated.",err,error,*999)
1353  ENDIF
1354 
1355  exits("CONTROL_LOOP_SOLVERS_GET")
1356  RETURN
1357 999 errorsexits("CONTROL_LOOP_SOLVERS_GET",err,error)
1358  RETURN 1
1359 
1360  END SUBROUTINE control_loop_solvers_get
1361 
1362  !
1363  !================================================================================================================================
1364  !
1365 
1367  RECURSIVE SUBROUTINE control_loop_solver_equations_destroy(CONTROL_LOOP,ERR,ERROR,*)
1369  !Argument variables
1370  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1371  INTEGER(INTG), INTENT(OUT) :: ERR
1372  TYPE(varying_string), INTENT(OUT) :: ERROR
1373  !Local Variables
1374  INTEGER(INTG) :: loop_idx,solver_idx
1375  TYPE(control_loop_type), POINTER :: CONTROL_LOOP2
1376  TYPE(solver_type), POINTER :: SOLVER
1377  TYPE(solver_equations_type), POINTER :: SOLVER_EQUATIONS
1378 
1379  enters("CONTROL_LOOP_SOLVER_EQUATIONS_DESTROY",err,error,*999)
1380 
1381  IF(ASSOCIATED(control_loop)) THEN
1382  !Destroy the solver equations in any sub control loops first
1383  IF(control_loop%NUMBER_OF_SUB_LOOPS>0) THEN
1384  DO loop_idx=1,control_loop%NUMBER_OF_SUB_LOOPS
1385  control_loop2=>control_loop%SUB_LOOPS(loop_idx)%PTR
1386  CALL control_loop_solver_equations_destroy(control_loop2,err,error,*999)
1387  ENDDO !loop_idx
1388  ENDIF
1389  !Destroy the solver equations in this control loop
1390  IF(ASSOCIATED(control_loop%SOLVERS)) THEN
1391  DO solver_idx=1,control_loop%SOLVERS%NUMBER_OF_SOLVERS
1392  solver=>control_loop%SOLVERS%SOLVERS(solver_idx)%PTR
1393  IF(ASSOCIATED(solver)) THEN
1394  solver_equations=>solver%SOLVER_EQUATIONS
1395  IF(ASSOCIATED(solver_equations)) CALL solver_equations_destroy(solver_equations,err,error,*999)
1396  ELSE
1397  CALL flagerror("Solver is not associated.",err,error,*999)
1398  ENDIF
1399  ENDDO !solver_idx
1400  ENDIF
1401  ELSE
1402  CALL flagerror("Control loop is not associated.",err,error,*999)
1403  ENDIF
1404 
1405  exits("CONTROL_LOOP_SOLVER_EQUATIONS_DESTROY")
1406  RETURN
1407 999 errorsexits("CONTROL_LOOP_SOLVER_EQUATIONS_DESTROY",err,error)
1408  RETURN 1
1410 
1411  !
1412  !================================================================================================================================
1413  !
1414 
1416  SUBROUTINE control_loop_sub_loop_get(CONTROL_LOOP,SUB_LOOP_INDEX,SUB_LOOP,ERR,ERROR,*)
1418  !Argument variables
1419  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1420  INTEGER(INTG), INTENT(IN) :: SUB_LOOP_INDEX
1421 ! TYPE(CONTROL_LOOP_TYPE), POINTER, INTENT(OUT) :: SUB_LOOP !<On return, a pointer to the specified sub loop. Must not be associated on entry.
1422  TYPE(control_loop_type), POINTER :: SUB_LOOP
1423  INTEGER(INTG), INTENT(OUT) :: ERR
1424  TYPE(varying_string), INTENT(OUT) :: ERROR
1425  !Local Variables
1426  TYPE(varying_string) :: LOCAL_ERROR
1427 
1428  enters("CONTROL_LOOP_SUB_LOOP_GET",err,error,*999)
1429 
1430  IF(ASSOCIATED(control_loop)) THEN
1431  IF(ASSOCIATED(sub_loop)) THEN
1432  CALL flagerror("Sub loop is already associated.",err,error,*999)
1433  ELSE
1434  NULLIFY(sub_loop)
1435  IF(sub_loop_index>0.AND.sub_loop_index<=control_loop%NUMBER_OF_SUB_LOOPS) THEN
1436  sub_loop=>control_loop%SUB_LOOPS(sub_loop_index)%PTR
1437  ELSE
1438  local_error="The specified sub loop index of "//trim(number_to_vstring(sub_loop_index,"*",err,error))// &
1439  & " is invalid. The sub loop index must be > 0 and <= "// &
1440  & trim(number_to_vstring(control_loop%NUMBER_OF_SUB_LOOPS,"*",err,error))//"."
1441  CALL flagerror(local_error,err,error,*999)
1442  ENDIF
1443  ENDIF
1444  ELSE
1445  CALL flagerror("Control loop is not associated.",err,error,*999)
1446  ENDIF
1447 
1448  exits("CONTROL_LOOP_SUB_LOOP_GET")
1449  RETURN
1450 999 errorsexits("CONTROL_LOOP_SUB_LOOP_GET",err,error)
1451  RETURN 1
1452  END SUBROUTINE control_loop_sub_loop_get
1453 
1454  !
1455  !================================================================================================================================
1456  !
1457 
1459  SUBROUTINE control_loop_time_finalise(TIME_LOOP,ERR,ERROR,*)
1461  !Argument variables
1462  TYPE(control_loop_time_type), POINTER, INTENT(INOUT) :: TIME_LOOP
1463  INTEGER(INTG), INTENT(OUT) :: ERR
1464  TYPE(varying_string), INTENT(OUT) :: ERROR
1465  !Local Variables
1466 
1467  enters("CONTROL_LOOP_TIME_FINALISE",err,error,*999)
1468 
1469  IF(ASSOCIATED(time_loop)) THEN
1470  DEALLOCATE(time_loop)
1471  ENDIF
1472 
1473  exits("CONTROL_LOOP_TIME_FINALISE")
1474  RETURN
1475 999 errorsexits("CONTROL_LOOP_TIME_FINALISE",err,error)
1476  RETURN 1
1477  END SUBROUTINE control_loop_time_finalise
1478 
1479  !
1480  !================================================================================================================================
1481  !
1482 
1484  SUBROUTINE control_loop_time_initialise(CONTROL_LOOP,ERR,ERROR,*)
1486  !Argument variables
1487  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
1488  INTEGER(INTG), INTENT(OUT) :: ERR
1489  TYPE(varying_string), INTENT(OUT) :: ERROR
1490  !Local Variables
1491  INTEGER(INTG) :: DUMMY_ERR
1492  TYPE(varying_string) :: DUMMY_ERROR
1493 
1494  enters("CONTROL_LOOP_TIME_INITIALISE",err,error,*998)
1495 
1496  IF(ASSOCIATED(control_loop)) THEN
1497  IF(ASSOCIATED(control_loop%TIME_LOOP)) THEN
1498  CALL flagerror("The time loop is already associated for this control loop.",err,error,*998)
1499  ELSE
1500  ALLOCATE(control_loop%TIME_LOOP,stat=err)
1501  IF(err/=0) CALL flagerror("Could not allocate time loop for the control loop.",err,error,*999)
1502  control_loop%TIME_LOOP%CONTROL_LOOP=>control_loop
1503  control_loop%TIME_LOOP%ITERATION_NUMBER=0
1504  control_loop%TIME_LOOP%NUMBER_OF_ITERATIONS=0
1505  control_loop%TIME_LOOP%GLOBAL_ITERATION_NUMBER=0
1506  control_loop%TIME_LOOP%CURRENT_TIME=0.0_dp
1507  control_loop%TIME_LOOP%START_TIME=0.0_dp
1508  control_loop%TIME_LOOP%STOP_TIME=1.0_dp
1509  control_loop%TIME_LOOP%TIME_INCREMENT=0.01_dp
1510  control_loop%TIME_LOOP%OUTPUT_NUMBER=0
1511  control_loop%TIME_LOOP%INPUT_NUMBER=0
1512  ENDIF
1513  ELSE
1514  CALL flagerror("Control loop is not associated.",err,error,*998)
1515  ENDIF
1516 
1517  exits("CONTROL_LOOP_TIME_INITIALISE")
1518  RETURN
1519 999 CALL control_loop_time_finalise(control_loop%TIME_LOOP,dummy_err,dummy_error,*998)
1520 998 errorsexits("CONTROL_LOOP_TIME_INITIALISE",err,error)
1521  RETURN 1
1522 
1523  END SUBROUTINE control_loop_time_initialise
1524 
1525  !
1526  !================================================================================================================================
1527  !
1528 
1530  SUBROUTINE control_loop_times_get(CONTROL_LOOP,START_TIME,STOP_TIME,CURRENT_TIME,TIME_INCREMENT, &
1531  & current_loop_iteration,output_iteration_number,err,error,*)
1533  !Argument variables
1534  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1535  REAL(DP), INTENT(OUT) :: START_TIME
1536  REAL(DP), INTENT(OUT) :: STOP_TIME
1537  REAL(DP), INTENT(OUT) :: CURRENT_TIME
1538  REAL(DP), INTENT(OUT) :: TIME_INCREMENT
1539  INTEGER(INTG), INTENT(OUT) :: CURRENT_LOOP_ITERATION
1540  INTEGER(INTG), INTENT(OUT) :: OUTPUT_ITERATION_NUMBER
1541  INTEGER(INTG), INTENT(OUT) :: ERR
1542  TYPE(varying_string), INTENT(OUT) :: ERROR
1543  !Local Variables
1544  TYPE(control_loop_time_type), POINTER :: TIME_LOOP
1545  TYPE(control_loop_type), POINTER :: PARENT_LOOP
1546  INTEGER(INTG), POINTER :: CONTROL_LOOP_LEVEL
1547  INTEGER(INTG) :: I
1548 
1549  enters("CONTROL_LOOP_TIMES_GET",err,error,*999)
1550 
1551  IF(ASSOCIATED(control_loop)) THEN
1552  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1553  control_loop_level=>control_loop%CONTROL_LOOP_LEVEL
1554  parent_loop=>control_loop
1555  DO i=control_loop_level,1,-1
1556  IF(control_loop_level==0) THEN
1557  CALL flagerror("The specified control loop is not a time control loop.",err,error,*999)
1558  ELSE
1559  IF(parent_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
1560  time_loop=>parent_loop%TIME_LOOP
1561  IF(ASSOCIATED(time_loop)) THEN
1562  start_time=time_loop%START_TIME
1563  stop_time=time_loop%STOP_TIME
1564  current_time=time_loop%CURRENT_TIME
1565  time_increment=time_loop%TIME_INCREMENT
1566  current_loop_iteration=time_loop%ITERATION_NUMBER
1567  output_iteration_number=time_loop%OUTPUT_NUMBER
1568  ELSE
1569  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
1570  ENDIF
1571  EXIT
1572  ELSE
1573  parent_loop=>parent_loop%PARENT_LOOP
1574  ENDIF
1575  ENDIF
1576  ENDDO
1577  ELSE
1578  CALL flagerror("Control loop has not been finished.",err,error,*999)
1579  ENDIF
1580  ELSE
1581  CALL flagerror("Control loop is not associated.",err,error,*999)
1582  ENDIF
1583 
1584  exits("CONTROL_LOOP_TIMES_GET")
1585  RETURN
1586 999 errorsexits("CONTROL_LOOP_TIMES_GET",err,error)
1587  RETURN 1
1588  END SUBROUTINE control_loop_times_get
1589 
1590  !
1591  !================================================================================================================================
1592  !
1593 
1595  SUBROUTINE control_loop_times_set(CONTROL_LOOP,START_TIME,STOP_TIME,TIME_INCREMENT,ERR,ERROR,*)
1597  !Argument variables
1598  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1599  REAL(DP), INTENT(IN) :: START_TIME
1600  REAL(DP), INTENT(IN) :: STOP_TIME
1601  REAL(DP), INTENT(IN) :: TIME_INCREMENT
1602  INTEGER(INTG), INTENT(OUT) :: ERR
1603  TYPE(varying_string), INTENT(OUT) :: ERROR
1604  !Local Variables
1605  TYPE(control_loop_time_type), POINTER :: TIME_LOOP
1606  TYPE(varying_string) :: LOCAL_ERROR
1607 
1608  enters("CONTROL_LOOP_TIMES_SET",err,error,*999)
1609 
1610  IF(ASSOCIATED(control_loop)) THEN
1611  IF(control_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
1612  time_loop=>control_loop%TIME_LOOP
1613  IF(ASSOCIATED(time_loop)) THEN
1614  IF(abs(time_increment)<=zero_tolerance) THEN
1615  local_error="The specified time increment of "//trim(number_to_vstring(time_increment,"*",err,error))// &
1616  & " is invalid. The time increment must not be zero."
1617  CALL flagerror(local_error,err,error,*999)
1618  ELSE
1619  IF(time_increment>0.0_dp) THEN
1620  IF(stop_time<=start_time) THEN
1621  local_error="The specified stop time of "//trim(number_to_vstring(stop_time,"*",err,error))// &
1622  & " is incompatiable with a specified start time of "//trim(number_to_vstring(start_time,"*",err,error))// &
1623  & ". For a positive time increment the stop time must be > than the start time."
1624  CALL flagerror(local_error,err,error,*999)
1625  ENDIF
1626  ELSE
1627  IF(start_time<=stop_time) THEN
1628  local_error="The specified start time of "//trim(number_to_vstring(start_time,"*",err,error))// &
1629  & " is incompatiable with a specified stop time of "//trim(number_to_vstring(stop_time,"*",err,error))// &
1630  & ". For a negative time increment the stop time must be < than the start time."
1631  CALL flagerror(local_error,err,error,*999)
1632  ENDIF
1633  ENDIF
1634  ENDIF
1635  time_loop%START_TIME=start_time
1636  time_loop%STOP_TIME=stop_time
1637  time_loop%TIME_INCREMENT=time_increment
1638  time_loop%NUMBER_OF_ITERATIONS=0 ! reset number of iterations
1639  ELSE
1640  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
1641  ENDIF
1642  ELSE
1643  CALL flagerror("The specified control loop is not a time control loop.",err,error,*999)
1644  ENDIF
1645  ELSE
1646  CALL flagerror("Control loop is not associated.",err,error,*999)
1647  ENDIF
1648 
1649  exits("CONTROL_LOOP_TIMES_SET")
1650  RETURN
1651 999 errorsexits("CONTROL_LOOP_TIMES_SET",err,error)
1652  RETURN 1
1653  END SUBROUTINE control_loop_times_set
1654 
1655  !
1656  !================================================================================================================================
1657  !
1658 
1660  SUBROUTINE control_loop_time_output_set(CONTROL_LOOP,OUTPUT_FREQUENCY,ERR,ERROR,*)
1662  !Argument variables
1663  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1664  INTEGER(INTG) :: OUTPUT_FREQUENCY
1665  INTEGER(INTG), INTENT(OUT) :: ERR
1666  TYPE(varying_string), INTENT(OUT) :: ERROR
1667  !Local Variables
1668  TYPE(control_loop_time_type), POINTER :: TIME_LOOP
1669 
1670  enters("CONTROL_LOOP_TIME_OUTPUT_SET",err,error,*999)
1671 
1672  IF(ASSOCIATED(control_loop)) THEN
1673  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1674  CALL flagerror("Control loop has been finished.",err,error,*999)
1675  ELSE
1676  IF(control_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
1677  time_loop=>control_loop%TIME_LOOP
1678  IF(ASSOCIATED(time_loop)) THEN
1679  IF(output_frequency>=0) THEN
1680  time_loop%OUTPUT_NUMBER=output_frequency
1681  ELSE
1682  CALL flagerror("Invalid output frequency. The frequency should be greater than or equal to zero, but is "// &
1683  & trim(number_to_vstring(output_frequency,"*",err,error))//".",err,error,*999)
1684  END IF
1685  ELSE
1686  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
1687  ENDIF
1688  ELSE
1689  CALL flagerror("The specified control loop is not a time control loop.",err,error,*999)
1690  ENDIF
1691  ENDIF
1692  ELSE
1693  CALL flagerror("Control loop is not associated.",err,error,*999)
1694  ENDIF
1695 
1696  exits("CONTROL_LOOP_TIME_OUTPUT_SET")
1697  RETURN
1698 999 errorsexits("CONTROL_LOOP_TIME_OUTPUT_SET",err,error)
1699  RETURN 1
1700  END SUBROUTINE control_loop_time_output_set
1701 
1702  !
1703  !================================================================================================================================
1704  !
1705 
1707  SUBROUTINE control_loop_time_input_set(CONTROL_LOOP,INPUT_OPTION,ERR,ERROR,*)
1709  !Argument variables
1710  TYPE(control_loop_type), POINTER, INTENT(IN) :: CONTROL_LOOP
1711  INTEGER(INTG) :: INPUT_OPTION
1712  INTEGER(INTG), INTENT(OUT) :: ERR
1713  TYPE(varying_string), INTENT(OUT) :: ERROR
1714  !Local Variables
1715  TYPE(control_loop_time_type), POINTER :: TIME_LOOP
1716 
1717  enters("CONTROL_LOOP_TIME_INPUT_SET",err,error,*999)
1718 
1719  IF(ASSOCIATED(control_loop)) THEN
1720  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1721  CALL flagerror("Control loop has been finished.",err,error,*999)
1722  ELSE
1723  IF(control_loop%LOOP_TYPE==problem_control_time_loop_type) THEN
1724  time_loop=>control_loop%TIME_LOOP
1725  IF(ASSOCIATED(time_loop)) THEN
1726  time_loop%INPUT_NUMBER=input_option
1727  ELSE
1728  CALL flagerror("Control loop time loop is not associated.",err,error,*999)
1729  ENDIF
1730  ELSE
1731  CALL flagerror("The specified control loop is not a time control loop.",err,error,*999)
1732  ENDIF
1733  ENDIF
1734  ELSE
1735  CALL flagerror("Control loop is not associated.",err,error,*999)
1736  ENDIF
1737 
1738  exits("CONTROL_LOOP_TIME_INPUT_SET")
1739  RETURN
1740 999 errorsexits("CONTROL_LOOP_TIME_INPUT_SET",err,error)
1741  RETURN 1
1742  END SUBROUTINE control_loop_time_input_set
1743 
1744  !
1745  !================================================================================================================================
1746  !
1747 
1749  SUBROUTINE control_loop_type_set(CONTROL_LOOP,LOOP_TYPE,ERR,ERROR,*)
1751  !Argument variables
1752  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
1753  INTEGER(INTG), INTENT(IN) :: LOOP_TYPE
1754  INTEGER(INTG), INTENT(OUT) :: ERR
1755  TYPE(varying_string), INTENT(OUT) :: ERROR
1756  !Local Variables
1757  TYPE(varying_string) :: LOCAL_ERROR
1758 
1759  enters("CONTROL_LOOP_TYPE_SET",err,error,*999)
1760 
1761  IF(ASSOCIATED(control_loop)) THEN
1762  IF(control_loop%CONTROL_LOOP_FINISHED) THEN
1763  CALL flagerror("Control loop has already been finished.",err,error,*999)
1764  ELSE
1765  IF(loop_type/=control_loop%LOOP_TYPE) THEN
1766  !Initialise the new loop type
1767  SELECT CASE(loop_type)
1769  CALL control_loop_simple_initialise(control_loop,err,error,*999)
1771  CALL control_loop_fixed_initialise(control_loop,err,error,*999)
1773  CALL control_loop_time_initialise(control_loop,err,error,*999)
1775  CALL control_loop_while_initialise(control_loop,err,error,*999)
1777  CALL control_loop_load_increment_initialise(control_loop,err,error,*999)
1778  CASE DEFAULT
1779  local_error="The loop type of "//trim(number_to_vstring(loop_type,"*",err,error))//" is invalid."
1780  CALL flagerror(local_error,err,error,*999)
1781  END SELECT
1782  !Finialise the old loop type
1783  SELECT CASE(control_loop%LOOP_TYPE)
1785  CALL control_loop_simple_finalise(control_loop%SIMPLE_LOOP,err,error,*999)
1787  CALL control_loop_fixed_finalise(control_loop%FIXED_LOOP,err,error,*999)
1789  CALL control_loop_time_finalise(control_loop%TIME_LOOP,err,error,*999)
1791  CALL control_loop_while_finalise(control_loop%WHILE_LOOP,err,error,*999)
1793  CALL control_loop_load_increment_finalise(control_loop%LOAD_INCREMENT_LOOP,err,error,*999)
1794  CASE DEFAULT
1795  local_error="The control loop type of "//trim(number_to_vstring(control_loop%LOOP_TYPE,"*",err,error))//" is invalid."
1796  CALL flagerror(local_error,err,error,*999)
1797  END SELECT
1798  control_loop%LOOP_TYPE=loop_type
1799  ENDIF
1800  ENDIF
1801  ELSE
1802  CALL flagerror("Control loop is not associated.",err,error,*999)
1803  ENDIF
1804 
1805  exits("CONTROL_LOOP_TYPE_SET")
1806  RETURN
1807 999 errorsexits("CONTROL_LOOP_TYPE_SET",err,error)
1808  RETURN 1
1809  END SUBROUTINE control_loop_type_set
1810 
1811  !
1812  !================================================================================================================================
1813  !
1814 
1816  SUBROUTINE control_loop_while_finalise(WHILE_LOOP,ERR,ERROR,*)
1818  !Argument variables
1819  TYPE(control_loop_while_type), POINTER, INTENT(INOUT) :: WHILE_LOOP
1820  INTEGER(INTG), INTENT(OUT) :: ERR
1821  TYPE(varying_string), INTENT(OUT) :: ERROR
1822  !Local Variables
1823 
1824  enters("CONTROL_LOOP_WHILE_FINALISE",err,error,*999)
1825 
1826  IF(ASSOCIATED(while_loop)) THEN
1827  DEALLOCATE(while_loop)
1828  ENDIF
1829 
1830  exits("CONTROL_LOOP_WHILE_FINALISE")
1831  RETURN
1832 999 errorsexits("CONTROL_LOOP_WHILE_FINALISE",err,error)
1833  RETURN 1
1834  END SUBROUTINE control_loop_while_finalise
1835 
1836  !
1837  !================================================================================================================================
1838  !
1839 
1841  SUBROUTINE control_loop_while_initialise(CONTROL_LOOP,ERR,ERROR,*)
1843  !Argument variables
1844  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
1845  INTEGER(INTG), INTENT(OUT) :: ERR
1846  TYPE(varying_string), INTENT(OUT) :: ERROR
1847  !Local Variables
1848  INTEGER(INTG) :: DUMMY_ERR
1849  TYPE(varying_string) :: DUMMY_ERROR
1850 
1851  enters("CONTROL_LOOP_WHILE_INITIALISE",err,error,*998)
1852 
1853  IF(ASSOCIATED(control_loop)) THEN
1854  IF(ASSOCIATED(control_loop%WHILE_LOOP)) THEN
1855  CALL flagerror("The while loop is already associated for this control loop.",err,error,*998)
1856  ELSE
1857  ALLOCATE(control_loop%WHILE_LOOP,stat=err)
1858  IF(err/=0) CALL flagerror("Could not allocate while loop for the control loop.",err,error,*999)
1859  control_loop%WHILE_LOOP%CONTROL_LOOP=>control_loop
1860  control_loop%WHILE_LOOP%ITERATION_NUMBER=0
1861  control_loop%WHILE_LOOP%MAXIMUM_NUMBER_OF_ITERATIONS=100
1862  control_loop%WHILE_LOOP%ABSOLUTE_TOLERANCE=1.0e-5_dp
1863  control_loop%WHILE_LOOP%CONTINUE_LOOP=.true.
1864  ENDIF
1865  ELSE
1866  CALL flagerror("Control loop is not associated.",err,error,*998)
1867  ENDIF
1868 
1869  exits("CONTROL_LOOP_WHILE_INITIALISE")
1870  RETURN
1871 999 CALL control_loop_while_finalise(control_loop%WHILE_LOOP,dummy_err,dummy_error,*998)
1872 998 errorsexits("CONTROL_LOOP_WHILE_INITIALISE",err,error)
1873  RETURN 1
1874  END SUBROUTINE control_loop_while_initialise
1875 
1876  !
1877  !================================================================================================================================
1878  !
1879 
1881  SUBROUTINE control_loop_load_increment_finalise(LOAD_INCREMENT_LOOP,ERR,ERROR,*)
1883  !Argument variables
1884  TYPE(control_loop_load_increment_type), POINTER, INTENT(INOUT) :: LOAD_INCREMENT_LOOP
1885  INTEGER(INTG), INTENT(OUT) :: ERR
1886  TYPE(varying_string), INTENT(OUT) :: ERROR
1887  !Local Variables
1888 
1889  enters("CONTROL_LOOP_LOAD_INCREMENT_FINALISE",err,error,*999)
1890 
1891  IF(ASSOCIATED(load_increment_loop)) THEN
1892  DEALLOCATE(load_increment_loop)
1893  ENDIF
1894 
1895  exits("CONTROL_LOOP_LOAD_INCREMENT_FINALISE")
1896  RETURN
1897 999 errorsexits("CONTROL_LOOP_LOAD_INCREMENT_FINALISE",err,error)
1898  RETURN 1
1900 
1901  !
1902  !================================================================================================================================
1903  !
1904 
1906  SUBROUTINE control_loop_load_increment_initialise(CONTROL_LOOP,ERR,ERROR,*)
1908  !Argument variables
1909  TYPE(control_loop_type), POINTER, INTENT(INOUT) :: CONTROL_LOOP
1910  INTEGER(INTG), INTENT(OUT) :: ERR
1911  TYPE(varying_string), INTENT(OUT) :: ERROR
1912  !Local Variables
1913  INTEGER(INTG) :: DUMMY_ERR
1914  TYPE(varying_string) :: DUMMY_ERROR
1915 
1916  enters("CONTROL_LOOP_LOAD_INCREMENT_INITIALISE",err,error,*998)
1917 
1918  IF(ASSOCIATED(control_loop)) THEN
1919  IF(ASSOCIATED(control_loop%LOAD_INCREMENT_LOOP)) THEN
1920  CALL flagerror("The load increment loop is already associated for this control loop.",err,error,*998)
1921  ELSE
1922  ALLOCATE(control_loop%LOAD_INCREMENT_LOOP,stat=err)
1923  IF(err/=0) CALL flagerror("Could not allocate load increment loop for the control loop.",err,error,*999)
1924  control_loop%LOAD_INCREMENT_LOOP%CONTROL_LOOP=>control_loop
1925  control_loop%LOAD_INCREMENT_LOOP%ITERATION_NUMBER=0
1926  control_loop%LOAD_INCREMENT_LOOP%MAXIMUM_NUMBER_OF_ITERATIONS=1 ! default is full load in one step
1927  control_loop%LOAD_INCREMENT_LOOP%OUTPUT_NUMBER=0
1928  ENDIF
1929  ELSE
1930  CALL flagerror("Control loop is not associated.",err,error,*998)
1931  ENDIF
1932 
1933  exits("CONTROL_LOOP_LOAD_INCREMENT_INITIALISE")
1934  RETURN
1935 999 CALL control_loop_load_increment_finalise(control_loop%LOAD_INCREMENT_LOOP,dummy_err,dummy_error,*998)
1936 998 errorsexits("CONTROL_LOOP_LOAD_INCREMENT_INITIALISE",err,error)
1937  RETURN 1
1939 
1940  !
1941  !================================================================================================================================
1942  !
1943 
1944 END MODULE control_loop_routines
1945 
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
integer(intg), parameter, public control_loop_progress_output
Progress output from control loop.
subroutine control_loop_while_initialise(CONTROL_LOOP, ERR, ERROR,)
Initialises a while loop for a control loop.
subroutine control_loop_label_get_c(CONTROL_LOOP, LABEL, ERR, ERROR,)
Returns the label of a control loop.
integer(intg), parameter, public solver_timing_output
Timing output from the solver routines plus below.
integer(intg), parameter problem_control_time_loop_type
Time control loop.
Contains information on a time iteration control loop.
Definition: types.f90:3148
recursive subroutine, public control_loop_solver_equations_destroy(CONTROL_LOOP, ERR, ERROR,)
Recursively destroys the solver equations for a control loop and all sub control loops.
subroutine control_loop_time_finalise(TIME_LOOP, ERR, ERROR,)
Finalises a time control loop and deallocates all memory.
This module handles all problem wide constants.
integer(intg), parameter, public control_loop_node
The identifier for a each "leaf" node in a control loop.
subroutine control_loop_load_increment_finalise(LOAD_INCREMENT_LOOP, ERR, ERROR,)
Finalises a load increment loop and deallocates all memory.
subroutine, public control_loop_maximum_iterations_set(CONTROL_LOOP, MAXIMUM_ITERATIONS, ERR, ERROR,)
Sets the maximum number of iterations for a while or load increment control loop. ...
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
subroutine, public control_loop_sub_loop_get(CONTROL_LOOP, SUB_LOOP_INDEX, SUB_LOOP, ERR, ERROR,)
Gets/returns a pointer to the sub loops as specified by the sub loop index for a control loop...
Contains information on the type of solver to be used.
Definition: types.f90:2777
subroutine, public control_loop_time_output_set(CONTROL_LOOP, OUTPUT_FREQUENCY, ERR, ERROR,)
Sets the output parameters for a time control loop.
subroutine, public control_loop_number_of_sub_loops_get(CONTROL_LOOP, NUMBER_OF_SUB_LOOPS, ERR, ERROR,)
Gets the number of sub loops for a control loop.
integer(intg), parameter problem_control_fixed_loop_type
Fixed iteration control loop.
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
Contains information on the solvers to be used in a control loop.
Definition: types.f90:2805
integer(intg), parameter problem_control_simple_type
Simple, one iteration control loop.
subroutine, public control_loop_load_output_set(CONTROL_LOOP, OUTPUT_FREQUENCY, ERR, ERROR,)
Sets/changes the output for a load incremented control loop identified by an object.
Contains information on a simple (execute once) control loop.
Definition: types.f90:3134
subroutine, public control_loop_current_times_get(CONTROL_LOOP, CURRENT_TIME, TIME_INCREMENT, ERR, ERROR,)
Gets the current time parameters for a time control loop.
Contains information on a control loop.
Definition: types.f90:3185
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Contains information on a load-increment control loop.
Definition: types.f90:3172
subroutine, public control_loop_output_type_get(CONTROL_LOOP, OUTPUT_TYPE, ERR, ERROR,)
Gets the output type for a control loop.
subroutine, public control_loop_times_get(CONTROL_LOOP, START_TIME, STOP_TIME, CURRENT_TIME, TIME_INCREMENT, CURRENT_LOOP_ITERATION, OUTPUT_ITERATION_NUMBER, ERR, ERROR,)
Gets the current time parameters for a time control loop.
integer(intg), parameter, public control_loop_no_output
No output from the control loop.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
recursive subroutine, public control_loop_solvers_get(CONTROL_LOOP, SOLVERS, ERR, ERROR,)
Returns a pointer to the solvers for a control loop.
subroutine control_loop_fixed_finalise(FIXED_LOOP, ERR, ERROR,)
Finalises a fixed control loop and deallocates all memory.
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
subroutine, public control_loop_time_input_set(CONTROL_LOOP, INPUT_OPTION, ERR, ERROR,)
Sets the input parameters for a time control loop.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
subroutine control_loop_load_increment_initialise(CONTROL_LOOP, ERR, ERROR,)
Initialises a load increment loop for a control loop.
subroutine, public controlloop_absolutetoleranceset(controlLoop, absoluteTolerance, err, error,)
Sets the absolute tolerance (convergence condition tolerance) for a while control loop...
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine, public control_loop_type_set(CONTROL_LOOP, LOOP_TYPE, ERR, ERROR,)
Sets/changes the control loop type.
subroutine control_loop_get_1(CONTROL_LOOP_ROOT, CONTROL_LOOP_IDENTIFIER, CONTROL_LOOP, ERR, ERROR,)
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
Contains information on a do-while control loop.
Definition: types.f90:3163
subroutine, public solver_equations_destroy(SOLVER_EQUATIONS, ERR, ERROR,)
Destroys the solver equations.
Contains information about the solver equations for a solver.
Definition: types.f90:2452
subroutine control_loop_get_0(CONTROL_LOOP_ROOT, CONTROL_LOOP_IDENTIFIER, CONTROL_LOOP, ERR, ERROR,)
Returns the specified control loop as indexed by the control loop identifier from the control loop ro...
subroutine control_loop_while_finalise(WHILE_LOOP, ERR, ERROR,)
Finalises a while control loop and deallocates all memory.
subroutine control_loop_simple_finalise(SIMPLE_LOOP, ERR, ERROR,)
Finalises a simple control loop and deallocates all memory.
Contains information for a problem.
Definition: types.f90:3221
integer(intg), parameter, public solver_progress_output
Progress output from solver routines.
subroutine, public control_loop_destroy(CONTROL_LOOP, ERR, ERROR,)
Destroy a control loop.
This module handles all solver routines.
recursive subroutine control_loop_finalise(CONTROL_LOOP, ERR, ERROR,)
Finalise a control loop and deallocate all memory.
subroutine, public solvers_destroy(SOLVERS, ERR, ERROR,)
Destroys the solvers.
subroutine control_loop_simple_initialise(CONTROL_LOOP, ERR, ERROR,)
Initialises a simple loop for a control loop.
subroutine control_loop_initialise(PROBLEM, ERR, ERROR,)
Initialise the control for a problem.
subroutine, public control_loop_create_start(PROBLEM, CONTROL_LOOP, ERR, ERROR,)
Start the process of creating a control loop for a problem.
subroutine control_loop_label_get_vs(CONTROL_LOOP, LABEL, ERR, ERROR,)
Returns the label of a control loop.
subroutine control_loop_label_set_c(CONTROL_LOOP, LABEL, ERR, ERROR,)
Sets the label of a control loop.
recursive subroutine, public control_loop_solvers_destroy(CONTROL_LOOP, ERR, ERROR,)
Recursively destroys the solvers for a control loop and all sub control loops.
subroutine, public control_loop_output_type_set(CONTROL_LOOP, OUTPUT_TYPE, ERR, ERROR,)
Sets/changes the output type for a control loop.
A buffer type to allow for an array of pointers to a CONTROL_LOOP_TYPE.
Definition: types.f90:3180
integer(intg), parameter problem_control_load_increment_loop_type
Load increment control loop.
Contains information on a fixed iteration control loop.
Definition: types.f90:3139
subroutine, public control_loop_times_set(CONTROL_LOOP, START_TIME, STOP_TIME, TIME_INCREMENT, ERR, ERROR,)
Sets the time parameters for a time control loop.
subroutine, public control_loop_iterations_set(CONTROL_LOOP, START_ITERATION, STOP_ITERATION, ITERATION_INCREMENT, ERR, ERROR,)
Sets the iteration parameters for a fixed control loop.
This module handles all control loop routines.
subroutine control_loop_fixed_initialise(CONTROL_LOOP, ERR, ERROR,)
Initialises a fixed loop for a control loop.
integer(intg), parameter, public control_loop_timing_output
Timing output from the control loop.
subroutine, public control_loop_number_of_iterations_get(CONTROL_LOOP, NUMBER_OF_ITERATIONS, ERR, ERROR,)
Gets the number of iterations for a time type control loop. If the value is not set to something /=0...
recursive subroutine, public control_loop_create_finish(CONTROL_LOOP, ERR, ERROR,)
Finish the process of creating a control loop.
subroutine control_loop_time_initialise(CONTROL_LOOP, ERR, ERROR,)
Initialises a time loop for a control loop.
subroutine, public control_loop_number_of_iterations_set(CONTROL_LOOP, NUMBER_OF_ITERATIONS, ERR, ERROR,)
Sets the number of iterations for a time type control loop. If set to 0 (default), it will be computed by start and stop time and time increment.
subroutine, public control_loop_number_of_sub_loops_set(CONTROL_LOOP, NUMBER_OF_SUB_LOOPS, ERR, ERROR,)
Sets/changes the number of sub loops in a control loop.
subroutine control_loop_label_set_vs(CONTROL_LOOP, LABEL, ERR, ERROR,)
Sets the label of a control loop.
Flags an error condition.
integer(intg), parameter problem_control_while_loop_type
While control loop.
This module contains all kind definitions.
Definition: kinds.f90:45