OpenCMISS-Iron Internal API Documentation
history_routines.f90
Go to the documentation of this file.
1 
43 
45 MODULE history_routines
46 
47  USE base_routines
48  USE iso_varying_string
49  USE kinds
50  USE problem_constants
51  USE strings
52  USE types
53 
54 #include "macros.h"
55 
56  IMPLICIT NONE
57 
58  PRIVATE
59 
60  !Module parameters
61 
66  INTEGER(INTG), PARAMETER :: history_ascii_file_format=1
67  INTEGER(INTG), PARAMETER :: history_binary_file_format=2 !Binary history file format \see HISTORY_ROUTINES_FileFormatTypes,HISTORY_ROUTINES
69 
70 
71  !Module types
72 
73  !Module variables
74 
75  !Interfaces
76 
78  INTERFACE history_filename_set
79  MODULE PROCEDURE history_filename_set_c
80  MODULE PROCEDURE history_filename_set_vs
81  END INTERFACE !HISTORY_FILENAME_SET
82 
83  PUBLIC history_create_finish,history_create_start,history_destroy,history_file_format_set,history_filename_set
84 
85 CONTAINS
86 
87  !
88  !================================================================================================================================
89  !
90 
92  SUBROUTINE history_close(HISTORY,ERR,ERROR,*)
93 
94  !Argument variables
95  TYPE(history_type), POINTER :: HISTORY
96  INTEGER(INTG), INTENT(OUT) :: ERR
97  TYPE(varying_string), INTENT(OUT) :: ERROR
98  !Local Variables
99 
100  enters("HISTORY_CLOSE",err,error,*999)
101 
102  IF(ASSOCIATED(history)) THEN
103  history%UNIT_NUMBER=0
104  ELSE
105  CALL flagerror("History is not associated.",err,error,*999)
106  ENDIF
107 
108  exits("HISTORY_CLOSE")
109  RETURN
110 999 errorsexits("HISTORY_CLOSE",err,error)
111  RETURN 1
112  END SUBROUTINE history_close
113 
114  !
115  !================================================================================================================================
116  !
117 
119  SUBROUTINE history_create_finish(HISTORY,ERR,ERROR,*)
120 
121  !Argument variables
122  TYPE(history_type), POINTER :: HISTORY
123  INTEGER(INTG), INTENT(OUT) :: ERR
124  TYPE(varying_string), INTENT(OUT) :: ERROR
125  !Local Variables
126 
127  enters("HISTORY_CREATE_FINISH",err,error,*999)
128 
129  IF(ASSOCIATED(history)) THEN
130  history%HISTORY_FINISHED=.true.
131  ELSE
132  CALL flagerror("History is not associated.",err,error,*999)
133  ENDIF
134 
135  exits("HISTORY_CREATE_FINISH")
136  RETURN
137 999 errorsexits("HISTORY_CREATE_FINISH",err,error)
138  RETURN 1
139  END SUBROUTINE history_create_finish
140 
141  !
142  !================================================================================================================================
143  !
144 
146  SUBROUTINE history_create_start(CONTROL_LOOP,HISTORY,ERR,ERROR,*)
147 
148  !Argument variables
149  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
150  TYPE(history_type), POINTER :: HISTORY
151  INTEGER(INTG), INTENT(OUT) :: ERR
152  TYPE(varying_string), INTENT(OUT) :: ERROR
153  !Local Variables
154 
155  enters("HISTORY_CREATE_START",err,error,*999)
156 
157  IF(ASSOCIATED(control_loop)) THEN
158  IF(ASSOCIATED(history)) THEN
159  CALL flagerror("History is already associated.",err,error,*999)
160  ELSE
161  ENDIF
162  ELSE
163  CALL flagerror("Control loop is not associated.",err,error,*999)
164  ENDIF
165 
166  exits("HISTORY_CREATE_START")
167  RETURN
168 999 errorsexits("HISTORY_CREATE_START",err,error)
169  RETURN 1
170  END SUBROUTINE history_create_start
171 
172  !
173  !================================================================================================================================
174  !
175 
177  SUBROUTINE history_destroy(HISTORY,ERR,ERROR,*)
178 
179  !Argument variables
180  TYPE(history_type), POINTER :: HISTORY
181  INTEGER(INTG), INTENT(OUT) :: ERR
182  TYPE(varying_string), INTENT(OUT) :: ERROR
183  !Local Variables
184 
185  enters("HISTORY_DESTROY",err,error,*999)
186 
187  IF(ASSOCIATED(history)) THEN
188  CALL history_finalise(history,err,error,*999)
189  ELSE
190  CALL flagerror("History is not associated.",err,error,*999)
191  ENDIF
192 
193  exits("HISTORY_DESTROY")
194  RETURN
195 999 errorsexits("HISTORY_DESTROY",err,error)
196  RETURN 1
197  END SUBROUTINE history_destroy
198 
199  !
200  !================================================================================================================================
201  !
202 
204  SUBROUTINE history_finalise(HISTORY,ERR,ERROR,*)
205 
206  !Argument variables
207  TYPE(history_type), POINTER :: HISTORY
208  INTEGER(INTG), INTENT(OUT) :: ERR
209  TYPE(varying_string), INTENT(OUT) :: ERROR
210  !Local Variables
211 
212  enters("HISTORY_FINALISE",err,error,*999)
213 
214  IF(ASSOCIATED(history)) THEN
215  IF(history%UNIT_NUMBER/=0) CALL history_close(history,err,error,*999)
216  DEALLOCATE(history)
217  ENDIF
218 
219  exits("HISTORY_FINALISE")
220  RETURN
221 999 errorsexits("HISTORY_FINALISE",err,error)
222  RETURN 1
223  END SUBROUTINE history_finalise
224 
225  !
226  !================================================================================================================================
227  !
228 
230  SUBROUTINE history_initialise(CONTROL_LOOP,ERR,ERROR,*)
231 
232  !Argument variables
233  TYPE(control_loop_type), POINTER :: CONTROL_LOOP
234  INTEGER(INTG), INTENT(OUT) :: ERR
235  TYPE(varying_string), INTENT(OUT) :: ERROR
236  !Local Variables
237 
238  enters("HISTORY_INITIALISE",err,error,*999)
239 
240  IF(ASSOCIATED(control_loop)) THEN
241  IF(ASSOCIATED(control_loop%HISTORY)) THEN
242  CALL flagerror("Control loop history is already associated.",err,error,*999)
243  ELSE
244  ALLOCATE(control_loop%HISTORY,stat=err)
245  IF(err/=0) CALL flagerror("Could not allocate control loop history.",err,error,*999)
246  control_loop%HISTORY%CONTROL_LOOP=>control_loop
247  control_loop%HISTORY%HISTORY_FINISHED=.false.
248  control_loop%HISTORY%FILE_FORMAT=history_binary_file_format
249  control_loop%HISTORY%FILENAME="History"
250  control_loop%HISTORY%UNIT_NUMBER=0
251  ENDIF
252  ELSE
253  CALL flagerror("Control loop is not associated.",err,error,*999)
254  ENDIF
255 
256  exits("HISTORY_INITIALISE")
257  RETURN
258 999 errorsexits("HISTORY_INITIALISE",err,error)
259  RETURN 1
260  END SUBROUTINE history_initialise
261 
262  !
263  !================================================================================================================================
264  !
265 
267  SUBROUTINE history_file_format_set(HISTORY,FILE_FORMAT,ERR,ERROR,*)
268 
269  !Argument variables
270  TYPE(history_type), POINTER :: HISTORY
271  INTEGER(INTG), INTENT(IN) :: FILE_FORMAT
272  INTEGER(INTG), INTENT(OUT) :: ERR
273  TYPE(varying_string), INTENT(OUT) :: ERROR
274  !Local Variables
275  TYPE(varying_string) :: LOCAL_ERROR
276 
277  enters("HISTORY_FILE_FORMAT_SET",err,error,*999)
278 
279  IF(ASSOCIATED(history)) THEN
280  IF(history%HISTORY_FINISHED) THEN
281  CALL flagerror("History has been finished.",err,error,*999)
282  ELSE
283  SELECT CASE(file_format)
284  CASE(history_ascii_file_format)
285  history%FILE_FORMAT=history_ascii_file_format
286  CASE(history_binary_file_format)
287  history%FILE_FORMAT=history_binary_file_format
288  CASE DEFAULT
289  local_error="The supplied file format of "//trim(number_to_vstring(file_format,"*",err,error))//" is invalid."
290  CALL flagerror(local_error,err,error,*999)
291  END SELECT
292  ENDIF
293  ELSE
294  CALL flagerror("History is not associated.",err,error,*999)
295  ENDIF
296 
297  exits("HISTORY_FILE_FORMAT_SET")
298  RETURN
299 999 errorsexits("HISTORY_FILE_FORMAT_SET",err,error)
300  RETURN 1
301  END SUBROUTINE history_file_format_set
302 
303  !
304  !================================================================================================================================
305  !
306 
308  SUBROUTINE history_filename_set_c(HISTORY,FILENAME,ERR,ERROR,*)
309 
310  !Argument variables
311  TYPE(history_type), POINTER :: HISTORY
312  CHARACTER(LEN=*), INTENT(IN) :: FILENAME
313  INTEGER(INTG), INTENT(OUT) :: ERR
314  TYPE(varying_string), INTENT(OUT) :: ERROR
315  !Local Variables
316 
317  enters("HISTORY_FILENAME_SET_C",err,error,*999)
318 
319  IF(ASSOCIATED(history)) THEN
320  IF(history%HISTORY_FINISHED) THEN
321  CALL flagerror("History has been finished.",err,error,*999)
322  ELSE
323 !!TODO: Check filename???
324  history%FILENAME=filename
325  ENDIF
326  ELSE
327  CALL flagerror("History is not associated.",err,error,*999)
328  ENDIF
329 
330  exits("HISTORY_FILENAME_SET_C")
331  RETURN
332 999 errorsexits("HISTORY_FILENAME_SET_C",err,error)
333  RETURN 1
334  END SUBROUTINE history_filename_set_c
335 
336  !
337  !================================================================================================================================
338  !
339 
341  SUBROUTINE history_filename_set_vs(HISTORY,FILENAME,ERR,ERROR,*)
342 
343  !Argument variables
344  TYPE(history_type), POINTER :: HISTORY
345  TYPE(varying_string), INTENT(IN) :: FILENAME
346  INTEGER(INTG), INTENT(OUT) :: ERR
347  TYPE(varying_string), INTENT(OUT) :: ERROR
348  !Local Variables
349 
350  enters("HISTORY_FILENAME_SET_VS",err,error,*999)
351 
352  IF(ASSOCIATED(history)) THEN
353  IF(history%HISTORY_FINISHED) THEN
354  CALL flagerror("History has been finished.",err,error,*999)
355  ELSE
356 !!TODO: Check filename???
357  history%FILENAME=filename
358  ENDIF
359  ELSE
360  CALL flagerror("Problem is not associated.",err,error,*999)
361  ENDIF
362 
363  exits("HISTORY_FILENAME_SET_VS")
364  RETURN
365 999 errorsexits("HISTORY_FILENAME_SET_VS",err,error)
366  RETURN 1
367  END SUBROUTINE history_filename_set_vs
368 
369  !
370  !================================================================================================================================
371  !
372 
374  SUBROUTINE history_open(HISTORY,ERR,ERROR,*)
375 
376  !Argument variables
377  TYPE(history_type), POINTER :: HISTORY
378  INTEGER(INTG), INTENT(OUT) :: ERR
379  TYPE(varying_string), INTENT(OUT) :: ERROR
380  !Local Variables
381 
382  enters("HISTORY_OPEN",err,error,*999)
383 
384  IF(ASSOCIATED(history)) THEN
385  IF(history%HISTORY_FINISHED) THEN
386  ELSE
387  CALL flagerror("History has not been finished.",err,error,*999)
388  ENDIF
389  ELSE
390  CALL flagerror("History is not associated.",err,error,*999)
391  ENDIF
392 
393  exits("HISTORY_OPEN")
394  RETURN
395 999 errorsexits("HISTORY_OPEN",err,error)
396  RETURN 1
397  END SUBROUTINE history_open
398 
399  !
400  !================================================================================================================================
401  !
402 
403 END MODULE history_routines
404 
history_routines::history_file_format_set
subroutine, public history_file_format_set(HISTORY, FILE_FORMAT, ERR, ERROR,)
Sets/changes the file type for a history file.
Definition: history_routines.f90:268
base_routines::enters
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
Definition: base_routines.f90:363
history_routines::history_filename_set
Sets/changes the filename for a history file.
Definition: history_routines.f90:78
problem_constants
This module handles all problem wide constants.
Definition: problem_constants.f90:45
strings::number_to_vstring
Converts a number to its equivalent varying string representation.
Definition: strings.f90:161
history_routines::history_finalise
subroutine history_finalise(HISTORY, ERR, ERROR,)
Finalises a history file and deallocates all memory.
Definition: history_routines.f90:205
history_routines::history_filename_set_c
subroutine history_filename_set_c(HISTORY, FILENAME, ERR, ERROR,)
Sets/changes the character string filename for a history file.
Definition: history_routines.f90:309
history_routines::history_filename_set_vs
subroutine history_filename_set_vs(HISTORY, FILENAME, ERR, ERROR,)
Sets/changes the varying string filename for a history file.
Definition: history_routines.f90:342
strings
This module contains all string manipulation and transformation routines.
Definition: strings.f90:45
types::control_loop_type
Contains information on a control loop.
Definition: types.f90:3185
iso_varying_string
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
Definition: iso_varying_string.f90:62
history_routines
This module handles all history file routines.
Definition: history_routines.f90:45
iso_varying_string::varying_string
Definition: iso_varying_string.f90:75
history_routines::history_close
subroutine history_close(HISTORY, ERR, ERROR,)
Closes a history file.
Definition: history_routines.f90:93
history_routines::history_open
subroutine history_open(HISTORY, ERR, ERROR,)
Opens a history file.
Definition: history_routines.f90:375
base_routines::exits
subroutine, public exits(NAME)
Records the exit out of the named procedure.
Definition: base_routines.f90:504
types
This module contains all type definitions in order to avoid cyclic module references.
Definition: types.f90:70
base_routines
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
Definition: base_routines.f90:45
iso_varying_string::trim
Definition: iso_varying_string.f90:204
history_routines::history_destroy
subroutine, public history_destroy(HISTORY, ERR, ERROR,)
Destroys a history file.
Definition: history_routines.f90:178
types::history_type
Contains information about a history file for a control loop.
Definition: types.f90:3118
history_routines::history_create_start
subroutine, public history_create_start(CONTROL_LOOP, HISTORY, ERR, ERROR,)
Starts the process of creating a history file.
Definition: history_routines.f90:147
history_routines::history_create_finish
subroutine, public history_create_finish(HISTORY, ERR, ERROR,)
Finishes the process of creating a history file.
Definition: history_routines.f90:120
history_routines::history_ascii_file_format
integer(intg), parameter history_ascii_file_format
ASCII history file format.
Definition: history_routines.f90:66
base_routines::flagerror
Flags an error condition.
Definition: base_routines.f90:240
kinds
This module contains all kind definitions.
Definition: kinds.f90:45
history_routines::history_binary_file_format
integer(intg), parameter history_binary_file_format
Definition: history_routines.f90:67
history_routines::history_initialise
subroutine history_initialise(CONTROL_LOOP, ERR, ERROR,)
Initialises a history file.
Definition: history_routines.f90:231