OpenCMISS-Iron Internal API Documentation
base_routines.f90
Go to the documentation of this file.
1 
43 
46 
47  USE constants
48  USE kinds
49  USE iso_c_binding
52 
53  IMPLICIT NONE
54 
55  PRIVATE
56 
57  !Module parameters
58 
59  INTEGER(INTG), PARAMETER :: max_output_lines=500
60  INTEGER(INTG), PARAMETER :: max_output_width=132
61 
66  INTEGER(INTG), PARAMETER :: general_output_type=1
67  INTEGER(INTG), PARAMETER :: diagnostic_output_type=2
68  INTEGER(INTG), PARAMETER :: timing_output_type=3
69  INTEGER(INTG), PARAMETER :: error_output_type=4
70  INTEGER(INTG), PARAMETER :: warning_output_type=5
71  INTEGER(INTG), PARAMETER :: help_output_type=6
73 
78  INTEGER(INTG), PARAMETER :: echo_file_unit=10
79  INTEGER(INTG), PARAMETER :: diagnostics_file_unit=11
80  INTEGER(INTG), PARAMETER :: timing_file_unit=12
81  INTEGER(INTG), PARAMETER :: learn_file_unit=13
82  INTEGER(INTG), PARAMETER :: io1_file_unit=21
83  INTEGER(INTG), PARAMETER :: io2_file_unit=22
84  INTEGER(INTG), PARAMETER :: io3_file_unit=23
85  INTEGER(INTG), PARAMETER :: io4_file_unit=24
86  INTEGER(INTG), PARAMETER :: io5_file_unit=25
87  INTEGER(INTG), PARAMETER :: temporary_file_unit=80
88  INTEGER(INTG), PARAMETER :: open_comfile_unit=90
89  INTEGER(INTG), PARAMETER :: start_read_comfile_unit=90
90  INTEGER(INTG), PARAMETER :: stop_read_comfile_unit=99
92 
97  INTEGER(INTG), PARAMETER :: all_diag_type=1
98  INTEGER(INTG), PARAMETER :: in_diag_type=2
99  INTEGER(INTG), PARAMETER :: from_diag_type=3
101 
106  INTEGER(INTG), PARAMETER :: all_timing_type=1
107  INTEGER(INTG), PARAMETER :: in_timing_type=2
108  INTEGER(INTG), PARAMETER :: from_timing_type=3
110 
111  !Module types
112 
115  CHARACTER(LEN=63) :: name
116  INTEGER(INTG) :: number_of_invocations
117  REAL(SP) :: total_inclusive_cpu_time
118  REAL(SP) :: total_inclusive_system_time
119  REAL(SP) :: total_exclusive_cpu_time
120  REAL(SP) :: total_exclusive_system_time
121  TYPE(routine_list_item_type), POINTER :: next_routine
122  END TYPE routine_list_item_type
123 
126  TYPE(routine_list_item_type), POINTER :: head
127  END TYPE routine_list_type
128 
131  CHARACTER(LEN=63) :: name
132  REAL(SP) :: inclusive_cpu_time
133  REAL(SP) :: inclusive_system_time
134  REAL(SP) :: exclusive_cpu_time
135  REAL(SP) :: exclusive_system_time
136  LOGICAL :: diagnostics
137  LOGICAL :: timing
138  TYPE(routine_list_item_type), POINTER :: routine_list_item
139  TYPE(routine_stack_item_type), POINTER :: previous_routine
140  END TYPE routine_stack_item_type
141 
144  TYPE(routine_stack_item_type), POINTER :: stack_pointer
145  END TYPE routine_stack_type
146 
147  !Module variables
148 
149  INTEGER(INTG), SAVE :: my_computational_node_number
150  INTEGER(INTG), SAVE :: number_of_computational_nodes
151  INTEGER(INTG), ALLOCATABLE :: cmiss_random_seeds(:)
152  LOGICAL, SAVE :: diagnostics
153  LOGICAL, SAVE :: diagnostics1
154  LOGICAL, SAVE :: diagnostics2
155  LOGICAL, SAVE :: diagnostics3
156  LOGICAL, SAVE :: diagnostics4
157  LOGICAL, SAVE :: diagnostics5
158  LOGICAL, SAVE :: diagnostics_level1
159  LOGICAL, SAVE :: diagnostics_level2
160  LOGICAL, SAVE :: diagnostics_level3
161  LOGICAL, SAVE :: diagnostics_level4
162  LOGICAL, SAVE :: diagnostics_level5
163  LOGICAL, SAVE :: diag_all_subroutines
164  LOGICAL, SAVE :: diag_from_subroutine
165  LOGICAL, SAVE :: diag_file_open
166  LOGICAL, SAVE :: diag_or_timing
167  LOGICAL, SAVE :: echo_output
168  LOGICAL, SAVE :: timing
169  LOGICAL, SAVE :: timing_summary
170  LOGICAL, SAVE :: timing_all_subroutines
171  LOGICAL, SAVE :: timing_from_subroutine
172  LOGICAL, SAVE :: timing_file_open
173  CHARACTER(LEN=MAXSTRLEN), SAVE :: op_string(max_output_lines)
177 
178  !Interfaces
179 
180  INTERFACE
181 
182 !!!!NOTE: This module needs to call the c cputime function directly in order to avoid a circular module loop when timer uses
183 !!!! base_routines.
184 
185  SUBROUTINE cputimer(RETURN_TIME, TIME_TYPE, ERR, CERROR) BIND(C,NAME="CPUTimer")
186  USE iso_c_binding
187  REAL(C_DOUBLE), INTENT(OUT) :: RETURN_TIME
188  INTEGER(C_INT), INTENT(IN) :: TIME_TYPE
189  INTEGER(C_INT), INTENT(OUT) :: ERR
190  CHARACTER(C_CHAR), INTENT(OUT) :: CERROR(*)
191  END SUBROUTINE cputimer
192 
193  END INTERFACE
194 
196  MODULE PROCEDURE base_routines_finalise
197  END INTERFACE baseroutinesfinalise
198 
200  MODULE PROCEDURE base_routines_initialise
201  END INTERFACE baseroutinesinitialise
202 
204  MODULE PROCEDURE computational_node_numbers_set
205  END INTERFACE computationalnodenumbersset
206 
208  MODULE PROCEDURE diagnostics_set_on
209  END INTERFACE diagnosticsseton
210 
212  MODULE PROCEDURE diagnostics_set_off
213  END INTERFACE diagnosticssetoff
214 
216  MODULE PROCEDURE extract_error_message_c
217  MODULE PROCEDURE extract_error_message_vs
218  END INTERFACE extract_error_message
219 
221  MODULE PROCEDURE extract_error_message_c
222  MODULE PROCEDURE extract_error_message_vs
223  END INTERFACE extracterrormessage
224 
226  INTERFACE flag_error
227  MODULE PROCEDURE flag_error_c
228  MODULE PROCEDURE flag_error_vs
229  END INTERFACE flag_error
230 
232  INTERFACE flag_warning
233  MODULE PROCEDURE flag_warning_c
234  MODULE PROCEDURE flag_warning_vs
235  END INTERFACE flag_warning
236 
237  ! Allow using FlagError and FlagWarning etc, as we shift to the new code style
238 
240  INTERFACE flagerror
241  MODULE PROCEDURE flag_error_c
242  MODULE PROCEDURE flag_error_vs
243  END INTERFACE flagerror
244 
246  INTERFACE flagwarning
247  MODULE PROCEDURE flag_warning_c
248  MODULE PROCEDURE flag_warning_vs
249  END INTERFACE flagwarning
250 
251  INTERFACE outputseton
252  MODULE PROCEDURE output_set_on
253  END INTERFACE outputseton
254 
255  INTERFACE outputsetoff
256  MODULE PROCEDURE output_set_off
257  END INTERFACE outputsetoff
258 
259  INTERFACE randomseedsget
260  MODULE PROCEDURE random_seeds_get
261  END INTERFACE randomseedsget
262 
264  MODULE PROCEDURE random_seeds_size_get
265  END INTERFACE randomseedssizeget
266 
267  INTERFACE randomseedsset
268  MODULE PROCEDURE random_seeds_set
269  END INTERFACE randomseedsset
270 
271  INTERFACE timingseton
272  MODULE PROCEDURE timing_set_on
273  END INTERFACE timingseton
274 
275  INTERFACE timingsetoff
276  MODULE PROCEDURE timing_set_off
277  END INTERFACE timingsetoff
278 
280  MODULE PROCEDURE timing_summary_output
281  END INTERFACE timingsummaryoutput
282 
284  INTERFACE write_error
285  MODULE PROCEDURE writeerror
286  END INTERFACE write_error
287 
289  INTERFACE writestr
290  MODULE PROCEDURE write_str
291  END INTERFACE writestr
292 
294 
296 
298 
300 
302 
304 
305  PUBLIC cmiss_random_seeds
306 
307  PUBLIC op_string
308 
310 
312 
314 
316 
318 
320 
321  PUBLIC enters,errors,exits
322 
323  PUBLIC extract_error_message
324 
325  PUBLIC extracterrormessage
326 
327  PUBLIC flag_error,flag_warning
328 
329  PUBLIC flagerror,flagwarning
330 
332 
334 
336 
338 
340 
342 
343  PUBLIC timing_summary_output
344 
345  PUBLIC timingsummaryoutput
346 
347  PUBLIC write_error
348 
349  PUBLIC writeerror
350 
351  PUBLIC write_str
352 
353  PUBLIC writestr
354 
355 CONTAINS
356 
357  !
358  !================================================================================================================================
359  !
360 
362  SUBROUTINE enters(NAME,ERR,ERROR,*)
364  !Argument variables
365  CHARACTER(LEN=*), INTENT(IN) :: NAME
366  INTEGER(INTG), INTENT(OUT) :: ERR
367  TYPE(varying_string), INTENT(OUT) :: ERROR
368  !Local variables
369  CHARACTER(C_CHAR) :: CERROR(maxstrlen)
370  REAL(DP) :: ENTERS_CPU_TIME,ENTERS_SYSTEM_TIME
371  LOGICAL :: FINISHED
372  TYPE(routine_list_item_type), POINTER :: LIST_ROUTINE_PTR
373  TYPE(routine_stack_item_type), POINTER :: NEW_ROUTINE_PTR,ROUTINE_PTR
374 
375  IF(diag_or_timing) THEN
376  !$OMP CRITICAL(ENTERS_1)
377  ALLOCATE(new_routine_ptr,stat=err)
378  IF(err/=0) CALL flagerror("Could not allocate new routine stack item.",err,error,*999)
379  new_routine_ptr%DIAGNOSTICS=.false.
380  new_routine_ptr%TIMING=.false.
381  new_routine_ptr%NAME=name(1:len_trim(name))
382  IF(ASSOCIATED(routine_stack%STACK_POINTER)) THEN
383  new_routine_ptr%PREVIOUS_ROUTINE=>routine_stack%STACK_POINTER
384  routine_stack%STACK_POINTER=>new_routine_ptr
385  ELSE
386  NULLIFY(new_routine_ptr%PREVIOUS_ROUTINE)
387  routine_stack%STACK_POINTER=>new_routine_ptr
388  ENDIF
389  routine_ptr=>routine_stack%STACK_POINTER
390  NULLIFY(routine_ptr%ROUTINE_LIST_ITEM)
391  IF(diagnostics) THEN
392  IF(diag_all_subroutines) THEN !turn diagnostics on in all subroutines
393  routine_ptr%DIAGNOSTICS=.true.
394  ELSE !diagnostics on in selected subroutines
395  finished=.false.
396  list_routine_ptr=>diag_routine_list%HEAD
397  DO WHILE(ASSOCIATED(list_routine_ptr).AND..NOT.finished)
398  IF(list_routine_ptr%NAME(1:len_trim(list_routine_ptr%NAME))== &
399  & routine_ptr%NAME(1:len_trim(routine_ptr%NAME))) THEN
400  routine_ptr%DIAGNOSTICS=.true.
401  routine_ptr%ROUTINE_LIST_ITEM=>list_routine_ptr
402  finished=.true.
403  ELSE
404  list_routine_ptr=>list_routine_ptr%NEXT_ROUTINE
405  ENDIF
406  ENDDO
407  IF(diag_from_subroutine) THEN
408  IF(ASSOCIATED(routine_ptr%PREVIOUS_ROUTINE)) THEN
409  IF(routine_ptr%PREVIOUS_ROUTINE%DIAGNOSTICS) routine_ptr%DIAGNOSTICS=.true.
410  ENDIF
411  ENDIF
412  ENDIF
413  IF(routine_ptr%DIAGNOSTICS) THEN
419  ELSE
420  diagnostics1=.false.
421  diagnostics2=.false.
422  diagnostics3=.false.
423  diagnostics4=.false.
424  diagnostics5=.false.
425  ENDIF
426  IF(routine_ptr%DIAGNOSTICS) THEN
427  WRITE(op_string,'("*** Enters: ",A)') name(1:len_trim(name))
428  CALL write_str(diagnostic_output_type,err,error,*999)
429  ELSE IF(ASSOCIATED(routine_ptr%PREVIOUS_ROUTINE)) THEN
430  !CPB 16/05/2007 Only show the calls if we have level 3 diagnostics or higher
431  IF(diagnostics3) THEN
432  IF(routine_ptr%PREVIOUS_ROUTINE%DIAGNOSTICS) THEN
433  WRITE(op_string,'("*** Calls : ",A)') name(1:len_trim(name))
434  CALL write_str(diagnostic_output_type,err,error,*999)
435  ENDIF
436  ENDIF
437  ENDIF
438  ENDIF
439  IF(timing) THEN
440  CALL cputimer(enters_cpu_time,1,err,cerror)
441  CALL cputimer(enters_system_time,2,err,cerror)
442  routine_ptr%INCLUSIVE_CPU_TIME=REAL(enters_cpu_time,sp)
443  routine_ptr%INCLUSIVE_SYSTEM_TIME=REAL(enters_system_time,sp)
444  routine_ptr%EXCLUSIVE_CPU_TIME=0.0_sp
445  routine_ptr%EXCLUSIVE_SYSTEM_TIME=0.0_sp
446  IF(timing_all_subroutines) THEN
447  routine_ptr%TIMING=.true.
448  ELSE
449  finished=.false.
450  list_routine_ptr=>timing_routine_list%HEAD
451  DO WHILE(ASSOCIATED(list_routine_ptr).AND..NOT.finished)
452  IF(list_routine_ptr%NAME(1:len_trim(list_routine_ptr%NAME))== &
453  & routine_ptr%NAME(1:len_trim(routine_ptr%NAME))) THEN
454  routine_ptr%TIMING=.true.
455  routine_ptr%ROUTINE_LIST_ITEM=>list_routine_ptr
456  finished=.true.
457  ELSE
458  list_routine_ptr=>list_routine_ptr%NEXT_ROUTINE
459  ENDIF
460  ENDDO
461  IF(timing_from_subroutine) THEN
462  IF(ASSOCIATED(routine_ptr%PREVIOUS_ROUTINE)) THEN
463  IF(routine_ptr%PREVIOUS_ROUTINE%TIMING) routine_ptr%TIMING=.true.
464  ENDIF
465  ENDIF
466  ENDIF
467  ENDIF
468  !$OMP END CRITICAL(ENTERS_1)
469  ENDIF
470 
471  RETURN
472 999 RETURN 1
473  END SUBROUTINE enters
474 
475  !
476  !================================================================================================================================
477  !
478 
480  SUBROUTINE errors(NAME,ERR,ERROR)
482  !Argument variables
483  CHARACTER(LEN=*), INTENT(IN) :: NAME
484  INTEGER(INTG), INTENT(OUT) :: ERR
485  TYPE(varying_string), INTENT(INOUT) :: ERROR
486  !Local variables
487  TYPE(varying_string) :: LOCAL_ERROR
488 
489  IF(err==0) err=1
490  !CPB 20/02/07 aix compiler does not like varying strings so split the concatenate statement up into two statements
491  local_error=error//error_separator_constant
492  error=local_error//name(1:len_trim(name))
493 
494  RETURN
495 
496  END SUBROUTINE errors
497 
498  !
499  !================================================================================================================================
500  !
501 
503  SUBROUTINE exits(NAME)
505  !Argument variables
506  CHARACTER(LEN=*), INTENT(IN) :: NAME
507  !Local variables
508  CHARACTER(C_CHAR) :: CERROR(maxstrlen)
509  INTEGER(INTG) :: ERR
510  REAL(DP) :: EXITS_CPU_TIME,EXITS_SYSTEM_TIME
511  TYPE(varying_string) :: ERROR
512  TYPE(routine_stack_item_type), POINTER :: PREVIOUS_ROUTINE_PTR,ROUTINE_PTR
513 
514  IF(diag_or_timing) THEN
515  !$OMP CRITICAL(EXITS_1)
516  routine_ptr=>routine_stack%STACK_POINTER
517  IF(ASSOCIATED(routine_ptr)) THEN
518  previous_routine_ptr=>routine_ptr%PREVIOUS_ROUTINE
519  IF(diagnostics) THEN
520  IF(routine_ptr%DIAGNOSTICS) THEN
521  WRITE(op_string,'("*** Exits : ",A)') name(1:len_trim(name))
522  CALL write_str(diagnostic_output_type,err,error,*999)
523  ENDIF
524  IF(ASSOCIATED(previous_routine_ptr)) THEN
525  IF(previous_routine_ptr%DIAGNOSTICS) THEN
531  ELSE
532  diagnostics1=.false.
533  diagnostics2=.false.
534  diagnostics3=.false.
535  diagnostics4=.false.
536  diagnostics5=.false.
537  ENDIF
538  ENDIF
539  ENDIF
540 
541  IF(timing) THEN
542  CALL cputimer(exits_cpu_time,1,err,cerror)
543  CALL cputimer(exits_system_time,2,err,cerror)
544  routine_ptr%INCLUSIVE_CPU_TIME=abs(REAL(exits_cpu_time,sp)-ROUTINE_PTR%INCLUSIVE_CPU_TIME)
545  routine_ptr%INCLUSIVE_SYSTEM_TIME=abs(REAL(exits_system_time,sp)-ROUTINE_PTR%INCLUSIVE_SYSTEM_TIME)
546  IF(ASSOCIATED(previous_routine_ptr)) THEN
547  previous_routine_ptr%EXCLUSIVE_CPU_TIME=previous_routine_ptr%EXCLUSIVE_CPU_TIME+routine_ptr%INCLUSIVE_CPU_TIME
548  previous_routine_ptr%EXCLUSIVE_SYSTEM_TIME=previous_routine_ptr%EXCLUSIVE_SYSTEM_TIME+routine_ptr%INCLUSIVE_SYSTEM_TIME
549  ENDIF
550  IF(ASSOCIATED(routine_ptr%ROUTINE_LIST_ITEM)) THEN
551  routine_ptr%ROUTINE_LIST_ITEM%NUMBER_OF_INVOCATIONS=routine_ptr%ROUTINE_LIST_ITEM%NUMBER_OF_INVOCATIONS+1
552  routine_ptr%ROUTINE_LIST_ITEM%TOTAL_INCLUSIVE_CPU_TIME=routine_ptr%ROUTINE_LIST_ITEM%TOTAL_INCLUSIVE_CPU_TIME+ &
553  & routine_ptr%INCLUSIVE_CPU_TIME
554  routine_ptr%ROUTINE_LIST_ITEM%TOTAL_INCLUSIVE_SYSTEM_TIME=routine_ptr%ROUTINE_LIST_ITEM%TOTAL_INCLUSIVE_SYSTEM_TIME+ &
555  & routine_ptr%INCLUSIVE_SYSTEM_TIME
556  IF(ASSOCIATED(previous_routine_ptr)) THEN
557  IF(ASSOCIATED(previous_routine_ptr%ROUTINE_LIST_ITEM)) THEN
558  previous_routine_ptr%ROUTINE_LIST_ITEM%TOTAL_EXCLUSIVE_CPU_TIME=previous_routine_ptr%ROUTINE_LIST_ITEM% &
559  & total_exclusive_cpu_time+previous_routine_ptr%EXCLUSIVE_CPU_TIME
560  previous_routine_ptr%ROUTINE_LIST_ITEM%TOTAL_EXCLUSIVE_SYSTEM_TIME=previous_routine_ptr%ROUTINE_LIST_ITEM% &
561  & total_exclusive_system_time+previous_routine_ptr%EXCLUSIVE_SYSTEM_TIME
562  ENDIF
563  ENDIF
564  ENDIF
565  IF(routine_ptr%TIMING) THEN
566  IF(.NOT.timing_summary) THEN
567  WRITE(op_string,'("*** Timing : ",A)') name(1:len_trim(name))
568  CALL write_str(timing_output_type,err,error,*999)
569  IF(ASSOCIATED(routine_ptr%ROUTINE_LIST_ITEM)) THEN
570  WRITE(op_string,'("*** Number of invocations: ",I10)') routine_ptr%ROUTINE_LIST_ITEM%NUMBER_OF_INVOCATIONS
571  CALL write_str(timing_output_type,err,error,*999)
572  WRITE(op_string,'("*** Routine times: Call Inclusive Call Exclusive Total Inclusive Average Inclusive")')
573  CALL write_str(timing_output_type,err,error,*999)
574  WRITE(op_string,'("*** CPU (s): ",E14.6," ",E14.6," ",E15.6," ",E17.6)') &
575  & routine_ptr%INCLUSIVE_CPU_TIME,routine_ptr%INCLUSIVE_CPU_TIME-routine_ptr%EXCLUSIVE_CPU_TIME, &
576  & routine_ptr%ROUTINE_LIST_ITEM%TOTAL_INCLUSIVE_CPU_TIME,routine_ptr%ROUTINE_LIST_ITEM% &
577  & total_inclusive_cpu_time/REAL(routine_ptr%routine_list_item%number_of_invocations,sp)
578  CALL write_str(timing_output_type,err,error,*999)
579  WRITE(op_string,'("*** System (s): ",E14.6," ",E14.6," ",E15.6," ",E17.6)') &
580  & routine_ptr%INCLUSIVE_SYSTEM_TIME,routine_ptr%INCLUSIVE_SYSTEM_TIME-routine_ptr%EXCLUSIVE_SYSTEM_TIME, &
581  & routine_ptr%ROUTINE_LIST_ITEM%TOTAL_INCLUSIVE_SYSTEM_TIME,routine_ptr%ROUTINE_LIST_ITEM% &
582  & total_inclusive_system_time/REAL(routine_ptr%routine_list_item%number_of_invocations,sp)
583  CALL write_str(timing_output_type,err,error,*999)
584  ELSE
585  WRITE(op_string,'("*** Routine times: Call Inclusive Call Exclusive")')
586  CALL write_str(timing_output_type,err,error,*999)
587  WRITE(op_string,'("*** CPU (s): ",E14.6," ",E14.6)') &
588  & routine_ptr%INCLUSIVE_CPU_TIME,routine_ptr%INCLUSIVE_CPU_TIME-routine_ptr%EXCLUSIVE_CPU_TIME
589  CALL write_str(timing_output_type,err,error,*999)
590  WRITE(op_string,'("*** System (s): ",E14.6," ",E14.6)') &
591  & routine_ptr%INCLUSIVE_SYSTEM_TIME,routine_ptr%INCLUSIVE_SYSTEM_TIME-routine_ptr%EXCLUSIVE_SYSTEM_TIME
592  CALL write_str(timing_output_type,err,error,*999)
593  ENDIF
594  ENDIF
595  ENDIF
596  ENDIF
597 
598  IF(ASSOCIATED(previous_routine_ptr)) THEN
599  routine_stack%STACK_POINTER=>previous_routine_ptr
600  ELSE
601  NULLIFY(routine_stack%STACK_POINTER)
602  ENDIF
603 
604  !Delete the routine pointer
605  DEALLOCATE(routine_ptr)
606 
607  !ELSE ERROR????
608  ENDIF
609  !$OMP END CRITICAL(EXITS_1)
610  ENDIF
611 
612 999 RETURN
613  END SUBROUTINE exits
614 
615  !
616  !================================================================================================================================
617  !
618 
619 #include "macros.h"
620 
622  SUBROUTINE computational_node_numbers_set(MY_NODE_NUMBER,NUMBER_OF_NODES,ERR,ERROR,*)
624  !Argument variables
625  INTEGER(INTG), INTENT(IN) :: MY_NODE_NUMBER
626  INTEGER(INTG), INTENT(IN) :: NUMBER_OF_NODES
627  INTEGER(INTG), INTENT(OUT) :: ERR
628  TYPE(varying_string), INTENT(OUT) :: ERROR
629  !Local variables
630 
631  enters("COMPUTATIONAL_NODE_NUMBERS_SET",err,error,*999)
632 
633  IF(number_of_nodes>0) THEN
634  IF(my_node_number>=0.AND.my_node_number<=number_of_nodes-1) THEN
635  my_computational_node_number=my_node_number
636  number_of_computational_nodes=number_of_nodes
637  ELSE
638  CALL flagerror("Invalid node number.",err,error,*999)
639  ENDIF
640  ELSE
641  CALL flagerror("Invalid number of nodes.",err,error,*999)
642  ENDIF
643 
644  exits("COMPUTATIONAL_NODE_NUMBERS_SET")
645  RETURN
646 999 errorsexits("COMPUTATIONAL_NODE_NUMBERS_SET",err,error)
647  RETURN 1
648  END SUBROUTINE computational_node_numbers_set
649 
650  !
651  !================================================================================================================================
652  !
653 
655  SUBROUTINE extract_error_message_vs(ERROR_MESSAGE,ERR,ERROR,*)
657  !Argument variables
658  TYPE(varying_string), INTENT(OUT) :: ERROR_MESSAGE
659  INTEGER(INTG), INTENT(IN) :: ERR
660  TYPE(varying_string), INTENT(IN) :: ERROR
661  !Local Variables
662  INTEGER(INTG) :: POSITION
663 
664  position=index(error,error_separator_constant)
665  error_message=extract(error,1,position-1)
666 
667  RETURN
668  END SUBROUTINE extract_error_message_vs
669 
670  !
671  !================================================================================================================================
672  !
673 
675  SUBROUTINE extract_error_message_c(ERROR_MESSAGE,ERR,ERROR,*)
677  !Argument variables
678  CHARACTER(LEN=*), INTENT(OUT) :: ERROR_MESSAGE
679  INTEGER(INTG), INTENT(IN) :: ERR
680  TYPE(varying_string), INTENT(IN) :: ERROR
681  !Local Variables
682  INTEGER(INTG) :: POSITION
683 
684  position=index(error,error_separator_constant)
685  error_message=extract(error,1,position-1)
686 
687  RETURN
688  END SUBROUTINE extract_error_message_c
689 
690  !
691  !================================================================================================================================
692  !
693 
695  SUBROUTINE flag_error_c(STRING,ERR,ERROR,*)
697  !Argument variables
698  CHARACTER(LEN=*), INTENT(IN) :: STRING
699  INTEGER(INTG), INTENT(OUT) :: ERR
700  TYPE(varying_string), INTENT(OUT) :: ERROR
701  !Local variables
702  INTEGER(INTG) :: STRING_LENGTH
703 
704  IF(err==0) err=1
705  string_length=len_trim(string)
706  error=string(1:string_length)
707 
708  RETURN 1
709  END SUBROUTINE flag_error_c
710 
711  !
712  !================================================================================================================================
713  !
714 
716  SUBROUTINE flag_error_vs(STRING,ERR,ERROR,*)
718  !Argument variables
719  TYPE(varying_string), INTENT(IN) :: STRING
720  INTEGER(INTG), INTENT(OUT) :: ERR
721  TYPE(varying_string), INTENT(OUT) :: ERROR
722  !Local variables
723 
724  IF(err==0) err=1
725  error=string
726 
727  RETURN 1
728  END SUBROUTINE flag_error_vs
729 
730  !
731  !================================================================================================================================
732  !
733 
735  SUBROUTINE flag_warning_c(STRING,ERR,ERROR,*)
737  !Argument variables
738  CHARACTER(LEN=*), INTENT(IN) :: STRING
739  INTEGER(INTG), INTENT(OUT) :: ERR
740  TYPE(varying_string), INTENT(OUT) :: ERROR
741  !Local variables
742 
744  WRITE(op_string,'(">>WARNING (",I0,"): ",A)') my_computational_node_number,string
745  ELSE
746  WRITE(op_string,'(">>WARNING: ",A)') string
747  ENDIF
748  CALL write_str(warning_output_type,err,error,*999)
749 
750  RETURN
751 999 errors("FLAG_WARNING_C",err,error)
752  RETURN 1
753 
754  END SUBROUTINE flag_warning_c
755 
756  !
757  !================================================================================================================================
758  !
759 
761  SUBROUTINE flag_warning_vs(STRING,ERR,ERROR,*)
763  !Argument variables
764  TYPE(varying_string), INTENT(IN) :: STRING
765  INTEGER(INTG), INTENT(OUT) :: ERR
766  TYPE(varying_string), INTENT(OUT) :: ERROR
767  !Local variables
768 
770  WRITE(op_string,'(">>WARNING (",I0,"): ",A)') my_computational_node_number,char(string)
771  ELSE
772  WRITE(op_string,'(">>WARNING: ",A)') char(string)
773  ENDIF
774  CALL write_str(warning_output_type,err,error,*999)
775 
776  RETURN
777 999 errors("FLAG_WARNING_VS",err,error)
778  RETURN 1
779 
780  END SUBROUTINE flag_warning_vs
781 
782  !
783  !================================================================================================================================
784  !
785 
787  SUBROUTINE base_routines_finalise(ERR,ERROR,*)
789  !Argument variables
790  INTEGER(INTG), INTENT(OUT) :: ERR
791  TYPE(varying_string), INTENT(OUT) :: ERROR
792  !Local variables
793 
794  err=0
795  error=""
796  !Deallocate the random seeds
797  IF(ALLOCATED(cmiss_random_seeds)) DEALLOCATE(cmiss_random_seeds)
798 
799  RETURN
800 999 RETURN 1
801  END SUBROUTINE base_routines_finalise
802 
803  !
804  !================================================================================================================================
805  !
806 
808  SUBROUTINE base_routines_initialise(ERR,ERROR,*)
809 
810  !Argument variables
811  INTEGER(INTG), INTENT(OUT) :: ERR
812  TYPE(varying_string), INTENT(OUT) :: ERROR
813  !Local variables
814  INTEGER(INTG) :: i,j,RANDOM_SEEDS_SIZE,TIME(8)
815 
816  err=0
817  error=""
820  diagnostics=.false.
821  diagnostics1=.false.
822  diagnostics2=.false.
823  diagnostics3=.false.
824  diagnostics4=.false.
825  diagnostics5=.false.
826  diagnostics_level1=.false.
827  diagnostics_level2=.false.
828  diagnostics_level3=.false.
829  diagnostics_level4=.false.
830  diagnostics_level5=.false.
831  diag_all_subroutines=.true.
832  diag_from_subroutine=.false.
833  diag_file_open=.false.
834  diag_or_timing=.false.
835  echo_output=.false.
836  timing=.false.
837  timing_summary=.false.
839  timing_from_subroutine=.false.
840  timing_file_open=.false.
841  !Initialise loose tolerance here rather than in constants.f90
842  loose_tolerance=sqrt(epsilon(1.0_dp))
843  loose_tolerance_sp=sqrt(epsilon(1.0_sp))
844  !Setup the random seeds based on the time
845  CALL random_seed(size=random_seeds_size)
846  ALLOCATE(cmiss_random_seeds(random_seeds_size),stat=err)
847  IF(err/=0) CALL flagerror("Could not allocate random seeds.",err,error,*999)
848  cmiss_random_seeds(1:random_seeds_size)=[(i,i=1,random_seeds_size)]
849  CALL date_and_time(values=time)
850  cmiss_random_seeds(1)=3600000*time(5)+60000*time(6)+1000*time(7)+time(8)
851  CALL random_seed(put=cmiss_random_seeds)
852 
853  !Initialise OP_STRING
854  SELECT CASE(machine_os)
855  CASE(vms_os)
856  DO i=1,max_output_lines
857  op_string(i)(1:1)=char(0)
858  ENDDO !i
859  CASE(irix_os,linux_os,aix_os)
860  DO i=1,max_output_lines
861  DO j=1,maxstrlen
862  op_string(i)(j:j)=' '
863  ENDDO !j
864  ENDDO !i
865  CASE(windows_os)
866  DO i=1,max_output_lines
867  op_string(i)(1:1)=char(0)
868  ENDDO !i
869  CASE DEFAULT
870  CALL flagerror("Operating system not implemented.",err,error,*999)
871  END SELECT
872 
873  !Initialise diagnostics and tracing
874  NULLIFY(routine_stack%STACK_POINTER)
875  NULLIFY(diag_routine_list%HEAD)
876  NULLIFY(timing_routine_list%HEAD)
877 
878  RETURN
879 999 RETURN 1
880  END SUBROUTINE base_routines_initialise
881 
882  !
883  !================================================================================================================================
884  !
885 
887  SUBROUTINE diagnostics_set_off(ERR,ERROR,*)
889  !Argument variables
890  INTEGER(INTG), INTENT(OUT) :: ERR
891  TYPE(varying_string), INTENT(OUT) :: ERROR
892  !Local variables
893  TYPE(routine_list_item_type), POINTER :: NEXT_ROUTINE,ROUTINE
894 
895  enters("DIAGNOSTICS_SET_OFF",err,error,*999)
896 
897  IF(diagnostics) THEN
898  IF(diag_file_open) THEN
899  diag_file_open=.false.
900  CLOSE(unit=diagnostics_file_unit)
901  ENDIF
902  IF(diag_all_subroutines) THEN
903  diag_all_subroutines=.false.
904  ELSE
905  routine=>diag_routine_list%HEAD
906  DO WHILE(ASSOCIATED(routine))
907  next_routine=>routine%NEXT_ROUTINE
908  DEALLOCATE(routine)
909  routine=>next_routine
910  ENDDO
911  NULLIFY(diag_routine_list%HEAD)
912  diag_from_subroutine=.false.
913  ENDIF
914  diagnostics_level1=.false.
915  diagnostics_level2=.false.
916  diagnostics_level3=.false.
917  diagnostics_level4=.false.
918  diagnostics_level5=.false.
919  diagnostics1=.false.
920  diagnostics2=.false.
921  diagnostics3=.false.
922  diagnostics4=.false.
923  diagnostics5=.false.
924  diagnostics=.false.
926  ELSE
927  CALL flagerror("Diagnositics is not on.",err,error,*999)
928  ENDIF
929 
930  exits("DIAGNOSTICS_SET_OFF")
931  RETURN
932 999 errorsexits("DIAGNOSTICS_SET_OFF",err,error)
933  RETURN 1
934  END SUBROUTINE diagnostics_set_off
935 
936  !
937  !================================================================================================================================
938  !
939 
941  SUBROUTINE diagnostics_set_on(DIAG_TYPE,LEVEL_LIST,DIAG_FILENAME,ROUTINE_LIST,ERR,ERROR,*)
943  !Argument variables
944  INTEGER(INTG), INTENT(IN) :: DIAG_TYPE
945  INTEGER(INTG), INTENT(IN) :: LEVEL_LIST(:)
946  CHARACTER(LEN=*), INTENT(IN) :: DIAG_FILENAME
947  CHARACTER(LEN=*), INTENT(IN) :: ROUTINE_LIST(:)
948  INTEGER(INTG), INTENT(OUT) :: ERR
949  TYPE(varying_string), INTENT(OUT) :: ERROR
950  !Local variables
951  INTEGER(INTG) :: i,LEVEL
952  CHARACTER(LEN=MAXSTRLEN) :: FILENAME
953  TYPE(routine_list_item_type), POINTER :: NEXT_ROUTINE,PREVIOUS_ROUTINE,ROUTINE
954 
955  NULLIFY(routine)
956 
957  enters("DIAGNOSTICS_SET_ON",err,error,*999)
958 
959  IF(len_trim(diag_filename)>=1) THEN
960  IF(diag_file_open) CLOSE(unit=diagnostics_file_unit)
962  WRITE(filename,'(A,".diag.",I0)') diag_filename(1:len_trim(diag_filename)),my_computational_node_number
963  ELSE
964  filename=diag_filename(1:len_trim(diag_filename))//".diag"
965  ENDIF
966  OPEN(unit=diagnostics_file_unit,file=filename(1:len_trim(filename)),status="UNKNOWN",iostat=err)
967  IF(err/=0) CALL flagerror("Could not open diagnostics file.",err,error,*999)
968  diag_file_open=.true.
969  ENDIF
970  SELECT CASE(diag_type)
971  CASE(all_diag_type)
972  diag_all_subroutines=.true.
974  diag_all_subroutines=.false.
976  IF(ASSOCIATED(diag_routine_list%HEAD)) THEN
977  routine=>diag_routine_list%HEAD
978  DO WHILE(ASSOCIATED(routine))
979  next_routine=>routine%NEXT_ROUTINE
980  DEALLOCATE(routine)
981  routine=>next_routine
982  ENDDO
983  NULLIFY(diag_routine_list%HEAD)
984  ENDIF
985  ALLOCATE(routine,stat=err)
986  IF(err/=0) CALL flagerror("Could not allocate routine list item.",err,error,*999)
987  routine%NAME=routine_list(1)
988  previous_routine=>routine
989  NULLIFY(routine%NEXT_ROUTINE)
990  diag_routine_list%HEAD=>routine
991  DO i=2,SIZE(routine_list,1)
992  ALLOCATE(routine,stat=err)
993  IF(err/=0) CALL flagerror("Could not allocate routine list item.",err,error,*999)
994  routine%NAME=routine_list(i)
995  NULLIFY(routine%NEXT_ROUTINE)
996  previous_routine%NEXT_ROUTINE=>routine
997  previous_routine=>routine
998  ENDDO !i
999  CASE DEFAULT
1000  CALL flagerror("Invalid diagnostic type.",err,error,*999)
1001  END SELECT
1002  DO i=1,SIZE(level_list,1)
1003  level=level_list(i)
1004  SELECT CASE(level)
1005  CASE(1)
1006  diagnostics_level1=.true.
1007  CASE(2)
1008  diagnostics_level2=.true.
1009  CASE(3)
1010  diagnostics_level3=.true.
1011  CASE(4)
1012  diagnostics_level4=.true.
1013  CASE(5)
1014  diagnostics_level5=.true.
1015  CASE DEFAULT
1016  CALL flagerror("Invalid diagnostic level.",err,error,*999)
1017  END SELECT
1018  ENDDO !i
1019  diagnostics=.true.
1020  diag_or_timing=.true.
1021 
1022  exits("DIAGNOSTICS_SET_ON")
1023  RETURN
1024 999 IF(diag_file_open) THEN
1025  CLOSE(unit=diagnostics_file_unit)
1026  diag_file_open=.false.
1027  ENDIF
1028  routine=>diag_routine_list%HEAD
1029  DO WHILE(ASSOCIATED(routine))
1030  next_routine=>routine%NEXT_ROUTINE
1031  DEALLOCATE(routine)
1032  routine=>next_routine
1033  ENDDO
1034  NULLIFY(diag_routine_list%HEAD)
1035  diag_all_subroutines=.false.
1036  diag_from_subroutine=.false.
1037  diagnostics_level1=.false.
1038  diagnostics_level2=.false.
1039  diagnostics_level3=.false.
1040  diagnostics_level4=.false.
1041  diagnostics_level5=.false.
1042  diagnostics=.false.
1044  errorsexits("DIAGNOSTICS_SET_ON",err,error)
1045  RETURN 1
1046  END SUBROUTINE diagnostics_set_on
1047 
1048  !
1049  !================================================================================================================================
1050  !
1051 
1053  SUBROUTINE output_set_off(ERR,ERROR,*)
1055  !Argument variables
1056  INTEGER(INTG), INTENT(OUT) :: ERR
1057  TYPE(varying_string), INTENT(OUT) :: ERROR
1058  !Local variables
1059 
1060  enters("OUTPUT_SET_OFF",err,error,*999)
1061 
1062  IF(echo_output) THEN
1063  echo_output=.false.
1064  CLOSE(unit=echo_file_unit)
1065  ELSE
1066  CALL flagerror("Write output is not on.",err,error,*999)
1067  ENDIF
1068 
1069  exits("OUTPUT_SET_OFF")
1070  RETURN
1071 999 errorsexits("OUTPUT_SET_OFF",err,error)
1072  RETURN 1
1073  END SUBROUTINE output_set_off
1074 
1075  !
1076  !================================================================================================================================
1077  !
1078 
1080  SUBROUTINE output_set_on(ECHO_FILENAME,ERR,ERROR,*)
1082  !Argument variables
1083  CHARACTER(LEN=*), INTENT(IN) :: ECHO_FILENAME
1084  INTEGER(INTG), INTENT(OUT) :: ERR
1085  TYPE(varying_string), INTENT(OUT) :: ERROR
1086  !Local variables
1087  CHARACTER(LEN=MAXSTRLEN) :: FILENAME
1088 
1089  enters("OUTPUT_SET_ON",err,error,*999)
1090 
1091  IF(echo_output) THEN
1092  CALL flagerror("Write output is already on.",err,error,*999)
1093  ELSE
1095  WRITE(filename,'(A,".out.",I0)') echo_filename(1:len_trim(echo_filename)),my_computational_node_number
1096  ELSE
1097  filename=echo_filename(1:len_trim(echo_filename))//".out"
1098  ENDIF
1099  OPEN(unit=echo_file_unit,file=filename(1:len_trim(filename)),status="UNKNOWN",iostat=err)
1100  IF(err/=0) CALL flagerror("Could not open write output file.",err,error,*999)
1101  echo_output=.true.
1102  ENDIF
1103 
1104  exits("OUTPUT_SET_ON")
1105  RETURN
1106 999 errorsexits("OUTPUT_SET_ON",err,error)
1107  RETURN 1
1108  END SUBROUTINE output_set_on
1109 
1110  !
1111  !================================================================================================================================
1112  !
1113 
1115  SUBROUTINE random_seeds_get(RANDOM_SEEDS,ERR,ERROR,*)
1117  !Argument variables
1118  INTEGER(INTG), INTENT(OUT) :: RANDOM_SEEDS(:)
1119  INTEGER(INTG), INTENT(INOUT) :: ERR
1120  TYPE(varying_string), INTENT(INOUT) :: ERROR
1121  !Local Variables
1122  CHARACTER(LEN=MAXSTRLEN) :: LOCAL_ERROR
1123 
1124  enters("RANDOM_SEEDS_GET",err,error,*999)
1125 
1126  IF(SIZE(random_seeds,1)>=SIZE(cmiss_random_seeds,1)) THEN
1127  random_seeds(1:SIZE(cmiss_random_seeds,1))=cmiss_random_seeds(1:SIZE(cmiss_random_seeds,1))
1128  ELSE
1129  WRITE(local_error,'("The size of the supplied random seeds array of ",I2," is too small. The size must be >= ",I2,".")') &
1130  & SIZE(random_seeds,1),SIZE(cmiss_random_seeds,1)
1131  CALL flagerror(local_error,err,error,*999)
1132  ENDIF
1133 
1134  exits("RANDOM_SEED_GET")
1135  RETURN
1136 999 errorsexits("RANDOM_SEEDS_GET",err,error)
1137  RETURN 1
1138  END SUBROUTINE random_seeds_get
1139 
1140  !
1141  !================================================================================================================================
1142  !
1143 
1145  SUBROUTINE random_seeds_size_get(RANDOM_SEEDS_SIZE,ERR,ERROR,*)
1147  !Argument variables
1148  INTEGER(INTG), INTENT(OUT) :: RANDOM_SEEDS_SIZE
1149  INTEGER(INTG), INTENT(INOUT) :: ERR
1150  TYPE(varying_string), INTENT(INOUT) :: ERROR
1151  !Local Variables
1152 
1153  enters("RANDOM_SEEDS_SIZE_GET",err,error,*999)
1154 
1155  random_seeds_size=SIZE(cmiss_random_seeds,1)
1156 
1157  exits("RANDOM_SEED_SIZE_GET")
1158  RETURN
1159 999 errorsexits("RANDOM_SEEDS_SIZE_GET",err,error)
1160  RETURN 1
1161  END SUBROUTINE random_seeds_size_get
1162 
1163  !
1164  !================================================================================================================================
1165  !
1166 
1168  SUBROUTINE random_seeds_set(RANDOM_SEEDS,ERR,ERROR,*)
1170  !Argument variables
1171  INTEGER(INTG), INTENT(IN) :: RANDOM_SEEDS(:)
1172  INTEGER(INTG), INTENT(INOUT) :: ERR
1173  TYPE(varying_string), INTENT(INOUT) :: ERROR
1174  !Local Variables
1175 
1176  enters("RANDOM_SEEDS_SET",err,error,*999)
1177 
1178  IF(SIZE(random_seeds,1)>SIZE(cmiss_random_seeds,1)) THEN
1179  cmiss_random_seeds(1:SIZE(cmiss_random_seeds,1))=random_seeds(1:SIZE(cmiss_random_seeds,1))
1180  ELSE
1181  cmiss_random_seeds(1:SIZE(random_seeds,1))=random_seeds(1:SIZE(random_seeds,1))
1182  ENDIF
1183 
1184  exits("RANDOM_SEEDS_SET")
1185  RETURN
1186 999 errorsexits("RANDOM_SEEDS_SET",err,error)
1187  RETURN 1
1188  END SUBROUTINE random_seeds_set
1189 
1190  !
1191  !================================================================================================================================
1192  !
1193 
1195  SUBROUTINE timing_set_off(ERR,ERROR,*)
1197  !Argument variables
1198  INTEGER(INTG), INTENT(OUT) :: ERR
1199  TYPE(varying_string), INTENT(OUT) :: ERROR
1200  !Local variables
1201  TYPE(routine_list_item_type), POINTER :: NEXT_ROUTINE,ROUTINE
1202 
1203  enters("TIMING_SET_OFF",err,error,*999)
1204 
1205  IF(timing) THEN
1206  IF(timing_file_open) THEN
1207  timing_file_open=.false.
1208  CLOSE(unit=timing_file_unit)
1209  ENDIF
1210  IF(timing_all_subroutines) THEN
1211  timing_all_subroutines=.false.
1212  ELSE
1213  routine=>timing_routine_list%HEAD
1214  DO WHILE(ASSOCIATED(routine))
1215  next_routine=>routine%NEXT_ROUTINE
1216  DEALLOCATE(routine)
1217  routine=>next_routine
1218  ENDDO
1219  NULLIFY(timing_routine_list%HEAD)
1220  timing_from_subroutine=.false.
1221  ENDIF
1222  timing_summary=.false.
1223  timing=.false.
1225  ELSE
1226  CALL flagerror("Timing is not on.",err,error,*999)
1227  ENDIF
1228 
1229  exits("TIMING_SET_OFF")
1230  RETURN
1231 999 errorsexits("TIMING_SET_OFF",err,error)
1232  RETURN 1
1233  END SUBROUTINE timing_set_off
1234 
1235  !
1236  !================================================================================================================================
1237  !
1238 
1240  SUBROUTINE timing_set_on(TIMING_TYPE,TIMING_SUMMARY_FLAG,TIMING_FILENAME,ROUTINE_LIST,ERR,ERROR,*)
1242  !Argument variables
1243  INTEGER(INTG), INTENT(IN) :: TIMING_TYPE
1244  LOGICAL, INTENT(IN) :: TIMING_SUMMARY_FLAG
1245  CHARACTER(LEN=*), INTENT(IN) :: TIMING_FILENAME
1246  CHARACTER(LEN=*), INTENT(IN) :: ROUTINE_LIST(:)
1247  INTEGER(INTG), INTENT(OUT) :: ERR
1248  TYPE(varying_string), INTENT(OUT) :: ERROR
1249  !Local variables
1250  INTEGER(INTG) :: i
1251  CHARACTER(LEN=MAXSTRLEN) :: FILENAME
1252  TYPE(routine_list_item_type), POINTER :: NEXT_ROUTINE,PREVIOUS_ROUTINE,ROUTINE
1253 
1254  enters("TIMING_SET_ON",err,error,*999)
1255 
1256  NULLIFY(routine)
1257  IF(len_trim(timing_filename)>=1) THEN
1258  IF(timing_file_open) CLOSE(unit=timing_file_unit)
1260  WRITE(filename,'(A,".timing.",I0)') timing_filename(1:len_trim(timing_filename)),my_computational_node_number
1261  ELSE
1262  filename=timing_filename(1:len_trim(timing_filename))//".timing"
1263  ENDIF
1264  OPEN(unit=timing_file_unit,file=filename(1:len_trim(filename)),status="UNKNOWN",iostat=err)
1265  IF(err/=0) CALL flagerror("Could not open timing file.",err,error,*999)
1266  timing_file_open=.true.
1267  ENDIF
1268  SELECT CASE(timing_type)
1269  CASE(all_timing_type)
1270  timing_all_subroutines=.true.
1272  timing_all_subroutines=.false.
1274  IF(ASSOCIATED(timing_routine_list%HEAD)) THEN
1275  routine=>timing_routine_list%HEAD
1276  DO WHILE(ASSOCIATED(routine))
1277  next_routine=>routine%NEXT_ROUTINE
1278  DEALLOCATE(routine)
1279  routine=>next_routine
1280  ENDDO
1281  NULLIFY(timing_routine_list%HEAD)
1282  ENDIF
1283  ALLOCATE(routine,stat=err)
1284  IF(err/=0) CALL flagerror("Could not allocate routine list item.",err,error,*999)
1285  routine%NAME=routine_list(1)
1286  previous_routine=>routine
1287  NULLIFY(routine%NEXT_ROUTINE)
1288  timing_routine_list%HEAD=>routine
1289  routine%NUMBER_OF_INVOCATIONS=0
1290  routine%TOTAL_INCLUSIVE_CPU_TIME=0.0_sp
1291  routine%TOTAL_INCLUSIVE_SYSTEM_TIME=0.0_sp
1292  routine%TOTAL_EXCLUSIVE_CPU_TIME=0.0_sp
1293  routine%TOTAL_EXCLUSIVE_SYSTEM_TIME=0.0_sp
1294  DO i=2,SIZE(routine_list,1)
1295  ALLOCATE(routine,stat=err)
1296  IF(err/=0) CALL flagerror("Could not allocate routine list item.",err,error,*999)
1297  routine%NAME=routine_list(i)
1298  NULLIFY(routine%NEXT_ROUTINE)
1299  previous_routine%NEXT_ROUTINE=>routine
1300  previous_routine=>routine
1301  routine%NUMBER_OF_INVOCATIONS=0
1302  routine%TOTAL_INCLUSIVE_CPU_TIME=0.0_sp
1303  routine%TOTAL_INCLUSIVE_CPU_TIME=0.0_sp
1304  routine%TOTAL_EXCLUSIVE_CPU_TIME=0.0_sp
1305  routine%TOTAL_EXCLUSIVE_CPU_TIME=0.0_sp
1306  ENDDO !i
1307  CASE DEFAULT
1308  CALL flagerror("Invalid timing type.",err,error,*999)
1309  END SELECT
1310  timing_summary=timing_summary_flag
1311  timing=.true.
1312  diag_or_timing=.true.
1313 
1314  exits("TIMING_SET_ON")
1315  RETURN
1316 999 IF(timing_file_open) THEN
1317  CLOSE(unit=timing_file_unit)
1318  timing_file_open=.false.
1319  ENDIF
1320  routine=>timing_routine_list%HEAD
1321  DO WHILE(ASSOCIATED(routine))
1322  next_routine=>routine%NEXT_ROUTINE
1323  DEALLOCATE(routine)
1324  routine=>next_routine
1325  ENDDO
1326  NULLIFY(timing_routine_list%HEAD)
1327  timing_all_subroutines=.false.
1328  timing_from_subroutine=.false.
1329  timing=.false.
1331  errorsexits("TIMING_SET_ON",err,error)
1332  RETURN 1
1333  END SUBROUTINE timing_set_on
1334 
1335  !
1336  !================================================================================================================================
1337  !
1338 
1340  SUBROUTINE timing_summary_output(ERR,ERROR,*)
1342  !Argument variables
1343  INTEGER(INTG), INTENT(OUT) :: ERR
1344  TYPE(varying_string), INTENT(OUT) :: ERROR
1345  !Local variables
1346  TYPE(routine_list_item_type), POINTER :: ROUTINE_PTR
1347 
1348  NULLIFY(routine_ptr)
1349 
1350  enters("TIMING_SUMMARY_OUTPUT",err,error,*999)
1351 
1352  IF(timing) THEN
1353  WRITE(op_string,'("*** Timing Summary: ")')
1354  CALL write_str(timing_output_type,err,error,*999)
1355  routine_ptr=>timing_routine_list%HEAD
1356  DO WHILE(ASSOCIATED(routine_ptr))
1357  WRITE(op_string,'("*** Routine : ",A)') trim(routine_ptr%NAME)
1358  CALL write_str(timing_output_type,err,error,*999)
1359  WRITE(op_string,'("*** Number of invocations: ",I10)') routine_ptr%NUMBER_OF_INVOCATIONS
1360  CALL write_str(timing_output_type,err,error,*999)
1361  WRITE(op_string,'("*** Routine times: Total Exclusive Total Inclusive Average Exclusive Average Inclusive")')
1362  CALL write_str(timing_output_type,err,error,*999)
1363  IF(routine_ptr%NUMBER_OF_INVOCATIONS==0) THEN
1364  WRITE(op_string,'("*** CPU (s): ",E14.6," ",E14.6," ",E14.6," ",E14.6)') &
1365  & routine_ptr%TOTAL_EXCLUSIVE_CPU_TIME,routine_ptr%TOTAL_INCLUSIVE_CPU_TIME, &
1366  & REAL(ROUTINE_PTR%NUMBER_OF_INVOCATIONS,SP),REAL(routine_ptr%number_of_invocations,sp)
1367  CALL write_str(timing_output_type,err,error,*999)
1368  WRITE(op_string,'("*** System (s): ",E14.6," ",E14.6," ",E14.6," ",E14.6)') &
1369  & routine_ptr%TOTAL_EXCLUSIVE_SYSTEM_TIME,routine_ptr%TOTAL_INCLUSIVE_SYSTEM_TIME, &
1370  & REAL(ROUTINE_PTR%NUMBER_OF_INVOCATIONS,SP),REAL(routine_ptr%number_of_invocations,sp)
1371  CALL write_str(timing_output_type,err,error,*999)
1372  ELSE
1373  WRITE(op_string,'("*** CPU (s): ",E14.6," ",E14.6," ",E14.6," ",E14.6)') &
1374  & routine_ptr%TOTAL_EXCLUSIVE_CPU_TIME,routine_ptr%TOTAL_INCLUSIVE_CPU_TIME, &
1375  & routine_ptr%TOTAL_EXCLUSIVE_CPU_TIME/REAL(ROUTINE_PTR%NUMBER_OF_INVOCATIONS,SP), &
1376  & ROUTINE_PTR%TOTAL_INCLUSIVE_CPU_TIME/REAL(ROUTINE_PTR%NUMBER_OF_INVOCATIONS,SP)
1377  CALL WRITE_STR(timing_output_type,err,error,*999)
1378  WRITE(op_string,'("*** System (s): ",E14.6," ",E14.6," ",E14.6," ",E14.6)') &
1379  & routine_ptr%TOTAL_EXCLUSIVE_SYSTEM_TIME,routine_ptr%TOTAL_INCLUSIVE_SYSTEM_TIME, &
1380  & routine_ptr%TOTAL_EXCLUSIVE_SYSTEM_TIME/REAL(ROUTINE_PTR%NUMBER_OF_INVOCATIONS,SP), &
1381  & ROUTINE_PTR%TOTAL_INCLUSIVE_SYSTEM_TIME/REAL(ROUTINE_PTR%NUMBER_OF_INVOCATIONS,SP)
1382  CALL WRITE_STR(timing_output_type,err,error,*999)
1383  ENDIF
1384  routine_ptr=>routine_ptr%NEXT_ROUTINE
1385  ENDDO
1386  ELSE
1387  CALL flagerror("Timing is not on.",err,error,*999)
1388  ENDIF
1389 
1390  exits("TIMING_SUMMARY_OUTPUT")
1391  RETURN
1392 999 errorsexits("TIMING_SUMMARY_OUTPUT",err,error)
1393  RETURN 1
1394  END SUBROUTINE timing_summary_output
1395 
1396  !
1397  !================================================================================================================================
1398  !
1399 
1401  SUBROUTINE writeerror(err,error,*)
1403  !Argument variables
1404  INTEGER(INTG), INTENT(INOUT) :: err
1405  TYPE(varying_string), INTENT(INOUT) :: error
1406  !Local Variables
1407  INTEGER(INTG) :: endPosition,errorStringLength,indent,lastSpacePosition,localErr,position,startStringLength
1408  CHARACTER(LEN=MAXSTRLEN) :: indentString=">>"
1409  CHARACTER(LEN=MAXSTRLEN) :: startString
1410  TYPE(varying_string) :: localError,localError2
1411 
1412  indent=2
1414  WRITE(startstring,'(A,A,I0,A,X,I0,A)') indentstring(1:indent),"ERROR (",my_computational_node_number,"):", &
1415  & err,":"
1416  startstringlength=len_trim(startstring)
1417  ELSE
1418  WRITE(startstring,'(A,A,X,I0,A)') indentstring(1:indent),"ERROR: ",err,":"
1419  startstringlength=len_trim(startstring)
1420  ENDIF
1421  position=index(error,error_separator_constant)
1422  errorstringlength=position-1
1423  localerror=extract(error,1,errorstringlength)
1424  DO WHILE(errorstringlength+startstringlength+1>max_output_width)
1425  endPosition=MAX_OUTPUT_WIDTH-startStringLength-1
1426  lastspaceposition=index(extract(localerror,1,endposition)," ",back=.true.)
1427  IF(lastspaceposition/=0) endposition=lastspaceposition-1
1428  WRITE(op_string,'(A,X,A)') startstring(1:startstringlength),char(extract(localerror,1,endposition))
1429  CALL write_str(error_output_type,localerr,localerror2,*999)
1430  localerror=adjustl(extract(localerror,endposition+1,len_trim(localerror)))
1431  errorstringlength=len_trim(localerror)
1432  startstring=" "
1433  ENDDO !not finished
1434  WRITE(op_string,'(A,X,A)') startstring(1:startstringlength),char(localerror)
1435  CALL write_str(error_output_type,localerr,localerror2,*999)
1436  !CPB 20/02/07 aix compiler does not like varying strings so split the remove statement up into two statements
1437  localerror=remove(error,1,position)
1438  error=localerror
1439  position=index(error,error_separator_constant)
1440  indent=indent+2
1441  DO WHILE(position/=0)
1442  WRITE(op_string,'(A)') indentstring(1:indent)//char(extract(error,1,position-1))
1443  CALL write_str(error_output_type,localerr,localerror2,*999)
1444  !CPB 20/02/07 aix compiler does not like varying strings so split the remove statement up into two statements
1445  localerror=remove(error,1,position)
1446  error=localerror
1447  position=index(error,error_separator_constant)
1448  indent=indent+2
1449  ENDDO
1450  WRITE(op_string,'(A)') indentstring(1:indent)//char(error)
1451  CALL write_str(error_output_type,localerr,localerror2,*999)
1452 
1453  RETURN
1454  !Don't return an error code here otherwise we will get into a circular loop
1455 999 RETURN
1456  END SUBROUTINE writeerror
1457 
1458  !
1459  !================================================================================================================================
1460  !
1461 
1463  SUBROUTINE write_str(ID,ERR,ERROR,*)
1465 
1466 !!!!NOTE: No enters or exits is used here to avoid an infinite loop
1467 !!!!NOTE: This routine is, in general, OS dependent but needs to be defined here so that an module loop is avoided when MACHINE
1468 !!!! module routines need to use this module.
1469 
1470  !Argument Variables
1471  INTEGER(INTG), INTENT(IN) :: ID
1472  INTEGER(INTG), INTENT(OUT) :: ERR
1473  TYPE(varying_string), INTENT(OUT) :: ERROR
1474  !Local Variables
1475  INTEGER(INTG) :: END_LINE(max_output_lines),i,j,LENGTH,NUMBER_BLANKS,NUMBER_RECORDS
1476 
1477  !Calculate number of records in OP_STRING
1478  SELECT CASE(machine_os)
1479  CASE(vms_os)
1480  i=1
1481  DO WHILE(op_string(i)(1:1)/=char(0).AND.i<max_output_lines)
1482  i=i+1
1483  ENDDO
1484  number_records=i-1
1485  CASE(irix_os,linux_os,aix_os)
1486  i=1
1487  number_blanks=0
1488  DO WHILE(i<max_output_lines.AND.number_blanks<2)
1489  i=i+1
1490  length=len_trim(op_string(i))
1491  IF(length==0) THEN
1492  number_blanks=number_blanks+1
1493  ELSE
1494  number_blanks=0
1495  ENDIF
1496  ENDDO
1497  number_records=i-number_blanks
1498  CASE(windows_os)
1499  i=1
1500  DO WHILE(op_string(i)(1:1)/=char(0).AND.i<max_output_lines)
1501  i=i+1
1502  ENDDO
1503  number_records=i-1
1504  CASE DEFAULT
1505  CALL flagerror("Operating system not implemented.",err,error,*999)
1506  END SELECT
1507 
1508  DO i=1,number_records
1509  END_LINE(i)=LEN_TRIM(OP_STRING(i))
1510  ENDDO !i
1511 
1512  IF(diag_file_open.AND.id==diagnostic_output_type) THEN
1513  DO i=1,number_records
1514  IF(end_line(i)<=max_output_width) THEN
1515  WRITE(diagnostics_file_unit,'(A)') op_string(i)(1:end_line(i))
1516  ELSE IF(end_line(i)>max_output_width.AND.end_line(i)<=maxstrlen) THEN
1518  WRITE(diagnostics_file_unit,'(A)') op_string(i)(max_output_width+1:end_line(i))
1519  ELSE
1521  WRITE(diagnostics_file_unit,'(A)') op_string(i)(max_output_width+1:maxstrlen)
1522  ENDIF
1523  ENDDO !i
1524  ELSE IF(timing_file_open.AND.id==timing_output_type) THEN
1525  DO i=1,number_records
1526  IF(end_line(i)<=max_output_width) THEN
1527  WRITE(timing_file_unit,'(A)') op_string(i)(1:end_line(i))
1528  ELSE IF(end_line(i)>max_output_width.AND.end_line(i)<=maxstrlen) THEN
1529  WRITE(timing_file_unit,'(A)') op_string(i)(1:max_output_width)
1530  WRITE(timing_file_unit,'(A)') op_string(i)(max_output_width+1:end_line(i))
1531  ELSE
1532  WRITE(timing_file_unit,'(A)') op_string(i)(1:max_output_width)
1533  WRITE(timing_file_unit,'(A)') op_string(i)(max_output_width+1:maxstrlen)
1534  ENDIF
1535  ENDDO !i
1536  ELSE
1537  IF(id<=9) THEN !not file output
1538  DO i=1,number_records
1539  IF(end_line(i)<=max_output_width) THEN
1540  WRITE(*,'(A)') op_string(i)(1:end_line(i))
1541  ELSE IF(end_line(i)>max_output_width.AND.end_line(i)<=maxstrlen) THEN
1542  WRITE(*,'(A)') op_string(i)(1:max_output_width)
1543  WRITE(*,'(A)') op_string(i)(max_output_width+1:end_line(i))
1544  ELSE
1545  WRITE(*,'(A)') op_string(i)(1:max_output_width)
1546  WRITE(*,'(A)') op_string(i)(max_output_width+1:maxstrlen)
1547  ENDIF
1548  ENDDO !i
1549  ELSE !file output
1550  DO i=1,number_records
1551  WRITE(id,'(A)') op_string(i)(1:end_line(i))
1552  ENDDO !i
1553  ENDIF
1554 
1555  !Echo strings to output file if required
1556 
1557  IF(echo_output) THEN
1558  DO i=1,number_records
1559  IF(end_line(i)<=max_output_width) THEN
1560  WRITE(echo_file_unit,'(A)') op_string(i)(1:end_line(i))
1561  ELSE IF(end_line(i)>max_output_width.AND.end_line(i)<=maxstrlen) THEN
1562  WRITE(echo_file_unit,'(A)') op_string(i)(1:max_output_width)
1563  WRITE(echo_file_unit,'(A)') op_string(i)(max_output_width+1:end_line(i))
1564  ELSE
1565  WRITE(echo_file_unit,'(A)') op_string(i)(1:max_output_width)
1566  WRITE(echo_file_unit,'(A)') op_string(i)(max_output_width+1:maxstrlen)
1567  ENDIF
1568  ENDDO !i
1569  ENDIF
1570  ENDIF
1571 
1572  !Reset OP_STRING
1573  SELECT CASE(machine_os)
1574  CASE(vms_os)
1575  DO i=1,number_records
1576  op_string(i)(1:1)=char(0)
1577  ENDDO !i
1578  CASE(irix_os,linux_os,aix_os)
1579  DO i=1,number_records
1580  DO j=1,maxstrlen
1581  op_string(i)(j:j)=' '
1582  ENDDO !j
1583  ENDDO !i
1584  CASE(windows_os)
1585  DO i=1,number_records
1586  op_string(i)(1:1)=char(0)
1587  ENDDO !i
1588  CASE DEFAULT
1589  CALL flagerror("Operating system not implemented.",err,error,*999)
1590  END SELECT
1591 
1592  RETURN
1593 999 errorsexits("WRITE_STR",err,error)
1594  END SUBROUTINE write_str
1595 
1596  !
1597  !================================================================================================================================
1598  !
1599 
1600 END MODULE base_routines
subroutine, public output_set_on(ECHO_FILENAME, ERR, ERROR,)
Sets writes file echo output on.
subroutine extract_error_message_c(ERROR_MESSAGE, ERR, ERROR,)
Extracts the error message from a CMISS error string and returns it as a character array...
logical, save, public diagnostics4
.TRUE. if level 4 diagnostic output is active in the current routine
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public random_seeds_get(RANDOM_SEEDS, ERR, ERROR,)
Returns the random seeds for CMISS.
integer(intg), parameter, public stop_read_comfile_unit
Last file unit for read command files.
integer(intg), parameter, public all_timing_type
Type for setting timing output in all routines.
logical, save diagnostics_level5
.TRUE. if the user has requested level 5 diagnostic output to be active
logical, save diagnostics_level4
.TRUE. if the user has requested level 4 diagnostic output to be active
integer(intg), dimension(:), allocatable, public cmiss_random_seeds
The current error handling seeds for OpenCMISS.
logical, save diag_from_subroutine
.TRUE. if diagnostic output is required from a particular routine
integer(intg), parameter linux_os
Linux operating system type.
Definition: constants.f90:150
integer(intg), parameter, public help_output_type
Help output type.
integer(intg), parameter, public learn_file_unit
File unit for learn files.
subroutine, public output_set_off(ERR, ERROR,)
Sets writes file echo output off.
integer(intg), parameter, public io5_file_unit
File unit for general IO 5 files.
type(routine_stack_type), save routine_stack
The routime invocation stack.
subroutine, public diagnostics_set_on(DIAG_TYPE, LEVEL_LIST, DIAG_FILENAME, ROUTINE_LIST, ERR, ERROR,)
Sets diagnositics on.
logical, save diag_file_open
.TRUE. if the diagnostic output file is open
Contains information for an item in the routine invocation stack.
subroutine, public write_str(ID, ERR, ERROR,)
Writes the output string to a specified output stream.
Flags a warning to the user.
integer(intg), parameter machine_os
Contains information for an item in the routine list for diagnostics or timing.
logical, save diagnostics_level2
.TRUE. if the user has requested level 2 diagnostic output to be active
Flags a warning to the user.
integer(intg), parameter warning_output_type
Warning output type.
subroutine, public timing_summary_output(ERR, ERROR,)
Outputs the timing summary.
Flags a warning to the user.
logical, save, public diagnostics2
.TRUE. if level 2 diagnostic output is active in the current routine
subroutine extract_error_message_vs(ERROR_MESSAGE, ERR, ERROR,)
Extracts the error message from a CMISS error string and returns it as a varying string.
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
integer(intg), parameter max_output_width
Maximum width of output line.
logical, save timing_from_subroutine
.TRUE. if timing output is required from a particular routine
This module contains all program wide constants.
Definition: constants.f90:45
Flags a warning to the user.
subroutine flag_warning_vs(STRING, ERR, ERROR,)
Writes a warning message specified by a varying string to the user.
real(sp) loose_tolerance_sp
The loose tolerance for single precision convergence calculations. Loose tolerance is to be used in t...
Definition: constants.f90:74
integer(intg), parameter, public in_timing_type
Type for setting timing output in one routine.
logical, save diagnostics_level3
.TRUE. if the user has requested level 3 diagnostic output to be active
integer(intg), parameter, public from_timing_type
Type for setting timing output from one routine downwards.
subroutine flag_error_c(STRING, ERR, ERROR,)
Sets the error string specified by a character string and flags an error.
type(routine_list_type), save diag_routine_list
The list of routines for which diagnostic output is required.
integer(intg), parameter maxstrlen
Maximum string length fro character strings.
Definition: constants.f90:79
logical, save, public diagnostics3
.TRUE. if level 3 diagnostic output is active in the current routine
integer(intg), parameter, public io2_file_unit
File unit for general IO 2 files.
logical, save diag_all_subroutines
.TRUE. if diagnostic output is required in all routines
integer(intg), parameter, public from_diag_type
Type for setting diagnostic output from one routine downwards.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
integer(intg), parameter windows_os
Windows operating system type.
Definition: constants.f90:149
integer(intg), parameter max_output_lines
Maximum number of lines that can be output.
integer(intg), parameter irix_os
IRIX operating system type.
Definition: constants.f90:148
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
integer(intg), parameter, public general_output_type
General output type.
logical, save diag_or_timing
.TRUE. if diagnostics or time is .TRUE.
subroutine, public computational_node_numbers_set(MY_NODE_NUMBER, NUMBER_OF_NODES, ERR, ERROR,)
Set the computational node numbers. Note: this is done as a subroutine as COMPUTATIONAL_ENVIRONMENT d...
subroutine, public base_routines_finalise(ERR, ERROR,)
Finalises the base_routines module and deallocates all memory.
subroutine flag_warning_c(STRING, ERR, ERROR,)
Writes a warning message specified by a character string to the user.
subroutine, public diagnostics_set_off(ERR, ERROR,)
Sets diagnositics off.
Contains information for the routine invocation stack.
type(routine_list_type), save timing_routine_list
The list of routines for which timing output is required.
integer, parameter sp
Single precision real kind.
Definition: kinds.f90:67
integer(intg), parameter, public io3_file_unit
File unit for general IO 3 files.
logical, save timing_all_subroutines
.TRUE. if timing output is required in all routines
integer(intg), parameter echo_file_unit
File unit for echo files.
logical, save timing
.TRUE. if timing output is required in any routines.
integer(intg), save my_computational_node_number
The computational rank for this node.
subroutine, public timing_set_off(ERR, ERROR,)
Sets timing off.
subroutine, public writeerror(err, error,)
Writes the error string.
subroutine, public base_routines_initialise(ERR, ERROR,)
Initialises the variables required for the base_routines module.
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
character(len=1), parameter error_separator_constant
logical, save diagnostics
.TRUE. if diagnostic output is required in any routines.
logical, save timing_file_open
.TRUE. if the timing output file is open
logical, save, public diagnostics5
.TRUE. if level 5 diagnostic output is active in the current routine
integer(intg), parameter, public in_diag_type
Type for setting diagnostic output in one routine.
integer(intg), parameter, public io4_file_unit
File unit for general IO 4 files.
subroutine flag_error_vs(STRING, ERR, ERROR,)
Sets the error string specified by a varying string and flags an error.
subroutine, public random_seeds_size_get(RANDOM_SEEDS_SIZE, ERR, ERROR,)
Returns the size of the random seeds array for CMISS.
logical, save diagnostics_level1
.TRUE. if the user has requested level 1 diagnostic output to be active
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
real(dp) loose_tolerance
The loose tolerance for double precision convergence calculations. Loose tolerance is to be used in t...
Definition: constants.f90:68
integer(intg), parameter, public temporary_file_unit
File unit for temporary files.
integer(intg), parameter, public all_diag_type
Type for setting diagnostic output in all routines.
integer(intg), parameter vms_os
VMS operating system type.
Definition: constants.f90:147
integer(intg), parameter, public io1_file_unit
File unit for general IO 1 files.
integer(intg), parameter, public open_comfile_unit
File unit for open command files.
subroutine, public errors(NAME, ERR, ERROR)
Records the exiting error of the subroutine.
integer(intg), parameter, public timing_output_type
Timing output type.
integer(intg), parameter, public start_read_comfile_unit
First file unit for read command files.
integer(intg), parameter aix_os
AIX operating system type.
Definition: constants.f90:151
integer(intg), parameter timing_file_unit
File unit for timing files.
Contains information for the routine list for diagnostics or timing.
logical, save timing_summary
.TRUE. if timing output will be summary form via a TIMING_SUMMARY_OUTPUT call otherwise timing will b...
Flags an error condition.
subroutine, public timing_set_on(TIMING_TYPE, TIMING_SUMMARY_FLAG, TIMING_FILENAME, ROUTINE_LIST, ERR, ERROR,)
Sets timing on.
character(len=maxstrlen), dimension(max_output_lines), save, public op_string
The array of lines to output.
This module contains all machine dependent constants for AIX systems.
Flags an error condition.
subroutine, public random_seeds_set(RANDOM_SEEDS, ERR, ERROR,)
Sets the random seeds for cmiss.
integer(intg), save number_of_computational_nodes
The number of computational nodes.
integer(intg), parameter diagnostics_file_unit
File unit for diagnostic files.
integer(intg), parameter, public error_output_type
Error output type.
This module contains all kind definitions.
Definition: kinds.f90:45
logical, save echo_output
.TRUE. if all output is to be echoed to the echo file