a_precision_detector.F90 2.66 KB
Newer Older
Femi Kadri's avatar
Femi Kadri committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
! precision_detector.f90

      MODULE precision_detector

          IMPLICIT NONE
          PUBLIC
          SAVE
          INTEGER,PRIVATE ::   my_mpi_real_data_type_private
		  
		  LOGICAL :: use_quad_precision = .FALSE.

!		  global_x_min_real, global_x_max_real,                           &
!     &        global_y_min_real, global_y_max_real,                           &
!     &        global_z_min_real, global_z_max_real


      CONTAINS !! input_and_set_globals

!==============================================================================================================
          SUBROUTINE input_and_set_globals ( variable_tested_for_precision )
  
              IMPLICIT NONE

              INCLUDE "mpif.h"
 

              REAL,INTENT(IN) :: variable_tested_for_precision
			  INTEGER :: my_real_kind_private
			  INTEGER :: real_single_kind_private
			  INTEGER :: real_double_kind_private
			  INTEGER :: real_quad_kind_private


		  my_real_kind_private = KIND(variable_tested_for_precision)

          real_single_kind_private = SELECTED_REAL_KIND( 5, 30)
          
		  real_double_kind_private = SELECTED_REAL_KIND(12, 70)

		  real_quad_kind_private   = SELECTED_REAL_KIND(20,400)
          
!		  WRITE (0,*) my_rank, ": my_real_kind_private     = ", my_real_kind_private
!         WRITE (0,*) my_rank, ": real_single_kind_private = ", real_single_kind_private
!         WRITE (0,*) my_rank, ": real_double_kind_private = ", real_double_kind_private
          
		  IF (my_real_kind_private == real_single_kind_private) THEN
          
		      my_mpi_real_data_type_private = MPI_REAL 
          
		  ELSE IF (my_real_kind_private == real_double_kind_private) THEN
              
			  my_mpi_real_data_type_private = MPI_DOUBLE_PRECISION 

          ELSE IF (my_real_kind_private == real_quad_kind_private) THEN

		      use_quad_precision = .TRUE.

          ELSE   !! (my_real_kind_private == real_double_kind_private)
              
			  WRITE (0,*) "ERROR: MODULE precision_detector - can't figure out &
			  & my_mpi_real_data_type_private"
			  STOP
			  !CALL MPI_Abort(MPI_COMM_WORLD,mpi_error_code, mpi_error_code)
          END IF !! (my_real_kind_private == real_double_kind_private...ELSE)

          
		  END SUBROUTINE input_and_set_globals
!==============================================================================================================
			
		  !THIS FUNCTION WILL FUNNEL my_mpi_real_data_type_private TO WHOEVER NEEDS IT

          INTEGER FUNCTION get_my_mpi_real_data_type ()

              IMPLICIT NONE

              get_my_mpi_real_data_type = my_mpi_real_data_type_private

          END FUNCTION get_my_mpi_real_data_type


      END MODULE precision_detector