Ignore:
Timestamp:
Jun 7, 2017 11:58:09 AM (4 years ago)
Author:
knoop
Message:

Implemented PALM specific error message handling

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/random_generator_parallel_mod.f90

    r2173 r2255  
    2525! -----------------
    2626! $Id$
     27! Implemented PALM specific error message handling
     28!
     29! 2173 2017-03-08 15:56:54Z knoop
    2730!
    2831! 2172 2017-03-08 15:55:25Z knoop
     
    250253      !- even though they go beyond Fortran 90's integer model.
    251254     
    252       IF  ( hg /= 2147483647 ) CALL ran_error('ran_init: arith assump 1 fails')
    253       IF  ( hgng >= 0 )        CALL ran_error('ran_init: arith assump 2 fails')
    254       IF  ( hgt+1 /= hgng )    CALL ran_error('ran_init: arith assump 3 fails')
    255       IF  ( not(hg) >= 0 )     CALL ran_error('ran_init: arith assump 4 fails')
    256       IF  ( not(hgng) < 0 )    CALL ran_error('ran_init: arith assump 5 fails')
    257       IF  ( hg+hgng >= 0 )     CALL ran_error('ran_init: arith assump 6 fails')
    258       IF  ( not(-1_isp) < 0 )  CALL ran_error('ran_init: arith assump 7 fails')
    259       IF  ( not(0_isp) >= 0 )  CALL ran_error('ran_init: arith assump 8 fails')
    260       IF  ( not(1_isp) >= 0 )  CALL ran_error('ran_init: arith assump 9 fails')
     255      IF  ( hg /= 2147483647 ) CALL ran_error('arithmetic assumption 1 failed')
     256      IF  ( hgng >= 0 )        CALL ran_error('arithmetic assumption 2 failed')
     257      IF  ( hgt+1 /= hgng )    CALL ran_error('arithmetic assumption 3 failed')
     258      IF  ( not(hg) >= 0 )     CALL ran_error('arithmetic assumption 4 failed')
     259      IF  ( not(hgng) < 0 )    CALL ran_error('arithmetic assumption 5 failed')
     260      IF  ( hg+hgng >= 0 )     CALL ran_error('arithmetic assumption 6 failed')
     261      IF  ( not(-1_isp) < 0 )  CALL ran_error('arithmetic assumption 7 failed')
     262      IF  ( not(0_isp) >= 0 )  CALL ran_error('arithmetic assumption 8 failed')
     263      IF  ( not(1_isp) >= 0 )  CALL ran_error('arithmetic assumption 9 failed')
    261264     
    262265      IF  ( lenran > 0) THEN                          !- Reallocate space, or ...
     
    274277         !- Use of nearest is to ensure that returned random deviates are strictly lessthan 1.0.
    275278         IF  (amm*hgng >= 1.0 .or. amm*hgng <= 0.0)                            &
    276             CALL ran_error('ran_init: arith assump 10 fails')
     279            CALL ran_error('arithmetic assumption 10 failed')
    277280           
    278281      END IF
     
    425428!------------------------------------------------------------------------------!
    426429   SUBROUTINE ran_error(string)
    427    
    428       CHARACTER(LEN=*), INTENT(IN) ::  string   !<
    429      
    430       write (*,*) 'Error in module random_number_parallel: ',string
    431      
    432       STOP 'Program terminated by ran_error'
    433      
     430
     431      USE control_parameters,                                                &
     432        ONLY: message_string
     433
     434      CHARACTER(LEN=*), INTENT(IN) ::  string   !< Error message string
     435
     436      message_string = 'incompatible integer arithmetic: ' // TRIM( string )
     437      CALL message( 'ran_init', 'PA0453', 1, 2, 0, 6, 0 )
     438
    434439   END SUBROUTINE ran_error
    435440
     
    440445!------------------------------------------------------------------------------!
    441446   FUNCTION reallocate_iv( p, n )
     447
     448      USE control_parameters,                                                &
     449        ONLY: message_string
    442450   
    443451      INTEGER(isp), DIMENSION(:), POINTER ::  p               !<
     
    451459      ALLOCATE(reallocate_iv(n),stat=ierr)
    452460     
    453       IF (ierr /= 0) CALL                                                      &
    454          ran_error('reallocate_iv: problem in attempt to allocate memory')
    455          
     461      IF (ierr /= 0) THEN
     462         message_string = 'problem in attempt to allocate memory'
     463         CALL message( 'reallocate_iv', 'PA0454', 1, 2, 0, 6, 0 )
     464      END IF
     465
    456466      IF (.not. associated(p)) RETURN
    457467     
     
    465475   
    466476   FUNCTION reallocate_im( p, n, m )
     477
     478      USE control_parameters,                                                &
     479        ONLY: message_string
    467480   
    468481      INTEGER(isp), DIMENSION(:,:), POINTER ::  p               !<
     
    478491      ALLOCATE(reallocate_im(n,m),stat=ierr)
    479492     
    480       IF (ierr /= 0) CALL                                                      &
    481          ran_error('reallocate_im: problem in attempt to allocate memory')
    482          
     493      IF (ierr /= 0) THEN
     494         message_string = 'problem in attempt to allocate memory'
     495         CALL message( 'reallocate_im', 'PA0454', 1, 2, 0, 6, 0 )
     496      END IF
     497
    483498      IF (.not. associated(p)) RETURN
    484499     
Note: See TracChangeset for help on using the changeset viewer.