Changeset 2255

Timestamp:

Jun 7, 2017 11:58:09 AM (7 years ago)

Author:

knoop

Message:

Implemented PALM specific error message handling

File:

• palm/trunk/SOURCE/random_generator_parallel_mod.f90 (modified) (8 diffs)

palm/trunk/SOURCE/random_generator_parallel_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Implemented PALM specific error message handling
+! 
+! 2173 2017-03-08 15:56:54Z knoop
 !
 ! 2172 2017-03-08 15:55:25Z knoop
@@ -250 +253 @@
       !- even though they go beyond Fortran 90's integer model.
       
-      IF  ( hg /= 2147483647 ) CALL ran_error('ran_init: arith assump 1 fails')
-      IF  ( hgng >= 0 )        CALL ran_error('ran_init: arith assump 2 fails')
-      IF  ( hgt+1 /= hgng )    CALL ran_error('ran_init: arith assump 3 fails')
-      IF  ( not(hg) >= 0 )     CALL ran_error('ran_init: arith assump 4 fails')
-      IF  ( not(hgng) < 0 )    CALL ran_error('ran_init: arith assump 5 fails')
-      IF  ( hg+hgng >= 0 )     CALL ran_error('ran_init: arith assump 6 fails')
-      IF  ( not(-1_isp) < 0 )  CALL ran_error('ran_init: arith assump 7 fails')
-      IF  ( not(0_isp) >= 0 )  CALL ran_error('ran_init: arith assump 8 fails')
-      IF  ( not(1_isp) >= 0 )  CALL ran_error('ran_init: arith assump 9 fails')
+      IF  ( hg /= 2147483647 ) CALL ran_error('arithmetic assumption 1 failed')
+      IF  ( hgng >= 0 )        CALL ran_error('arithmetic assumption 2 failed')
+      IF  ( hgt+1 /= hgng )    CALL ran_error('arithmetic assumption 3 failed')
+      IF  ( not(hg) >= 0 )     CALL ran_error('arithmetic assumption 4 failed')
+      IF  ( not(hgng) < 0 )    CALL ran_error('arithmetic assumption 5 failed')
+      IF  ( hg+hgng >= 0 )     CALL ran_error('arithmetic assumption 6 failed')
+      IF  ( not(-1_isp) < 0 )  CALL ran_error('arithmetic assumption 7 failed')
+      IF  ( not(0_isp) >= 0 )  CALL ran_error('arithmetic assumption 8 failed')
+      IF  ( not(1_isp) >= 0 )  CALL ran_error('arithmetic assumption 9 failed')
       
       IF  ( lenran > 0) THEN                          !- Reallocate space, or ...
@@ -274 +277 @@
          !- Use of nearest is to ensure that returned random deviates are strictly lessthan 1.0.
          IF  (amm*hgng >= 1.0 .or. amm*hgng <= 0.0)                            &
-            CALL ran_error('ran_init: arith assump 10 fails')
+            CALL ran_error('arithmetic assumption 10 failed')
             
       END IF 
@@ -425 +428 @@
 !------------------------------------------------------------------------------!
    SUBROUTINE ran_error(string)
-   
-      CHARACTER(LEN=*), INTENT(IN) ::  string   !< 
-      
-      write (*,*) 'Error in module random_number_parallel: ',string
-      
-      STOP 'Program terminated by ran_error'
-      
+
+      USE control_parameters,                                                &
+        ONLY: message_string
+
+      CHARACTER(LEN=*), INTENT(IN) ::  string   !< Error message string
+
+      message_string = 'incompatible integer arithmetic: ' // TRIM( string )
+      CALL message( 'ran_init', 'PA0453', 1, 2, 0, 6, 0 )
+
    END SUBROUTINE ran_error
 
@@ -440 +445 @@
 !------------------------------------------------------------------------------!
    FUNCTION reallocate_iv( p, n )
+
+      USE control_parameters,                                                &
+        ONLY: message_string
    
       INTEGER(isp), DIMENSION(:), POINTER ::  p               !< 
@@ -451 +459 @@
       ALLOCATE(reallocate_iv(n),stat=ierr)
       
-      IF (ierr /= 0) CALL                                                      &
-         ran_error('reallocate_iv: problem in attempt to allocate memory')
-         
+      IF (ierr /= 0) THEN
+         message_string = 'problem in attempt to allocate memory'
+         CALL message( 'reallocate_iv', 'PA0454', 1, 2, 0, 6, 0 )
+      END IF
+
       IF (.not. associated(p)) RETURN
       
@@ -465 +475 @@
    
    FUNCTION reallocate_im( p, n, m )
+
+      USE control_parameters,                                                &
+        ONLY: message_string
    
       INTEGER(isp), DIMENSION(:,:), POINTER ::  p               !< 
@@ -478 +491 @@
       ALLOCATE(reallocate_im(n,m),stat=ierr)
       
-      IF (ierr /= 0) CALL                                                      &
-         ran_error('reallocate_im: problem in attempt to allocate memory')
-         
+      IF (ierr /= 0) THEN
+         message_string = 'problem in attempt to allocate memory'
+         CALL message( 'reallocate_im', 'PA0454', 1, 2, 0, 6, 0 )
+      END IF
+
       IF (.not. associated(p)) RETURN