Changeset 254 for palm/trunk/SOURCE
- Timestamp:
- Mar 5, 2009 3:33:42 PM (15 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 17 edited
-
CURRENT_MODIFICATIONS (modified) (1 diff)
-
coriolis.f90 (modified) (3 diffs)
-
cpu_log.f90 (modified) (8 diffs)
-
data_output_2d.f90 (modified) (3 diffs)
-
data_output_3d.f90 (modified) (2 diffs)
-
data_output_dvrp.f90 (modified) (3 diffs)
-
data_output_profiles.f90 (modified) (3 diffs)
-
data_output_spectra.f90 (modified) (2 diffs)
-
fft_xy.f90 (modified) (8 diffs)
-
flow_statistics.f90 (modified) (2 diffs)
-
header.f90 (modified) (3 diffs)
-
init_1d_model.f90 (modified) (2 diffs)
-
init_3d_model.f90 (modified) (3 diffs)
-
init_dvrp.f90 (modified) (5 diffs)
-
init_grid.f90 (modified) (10 diffs)
-
init_particles.f90 (modified) (9 diffs)
-
init_pegrid.f90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/CURRENT_MODIFICATIONS
r253 r254 26 26 First constant in array den also defined as type double. (eqn_state_seawater) 27 27 28 advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, eqn_state_seawater, sort_particles28 advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_spectra, eqn_state_seawater, fft_xy, flow_statistics, header, init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid, sort_particles 29 29 30 30 -
palm/trunk/SOURCE/coriolis.f90
r110 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 106 107 CASE DEFAULT 107 108 108 IF ( myid == 0 ) PRINT*,'+++ coriolis: wrong component: ', & 109 component 110 CALL local_stop 109 WRITE( message_string, * ) ' wrong component: ', component 110 CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 ) 111 111 112 112 END SELECT … … 166 166 CASE DEFAULT 167 167 168 IF ( myid == 0 ) PRINT*,'+++ coriolis: wrong component: ', & 169 component 170 CALL local_stop 168 WRITE( message_string, * ) ' wrong component: ', component 169 CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 ) 171 170 172 171 END SELECT -
palm/trunk/SOURCE/cpu_log.f90
r239 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! Output of messages replaced by message handling routine. 6 7 ! Type of count and count_rate changed to default INTEGER on NEC machines 7 8 ! … … 31 32 !------------------------------------------------------------------------------! 32 33 34 USE control_parameters 33 35 USE cpulog 34 36 USE pegrid … … 56 58 log_event%place = place 57 59 ELSEIF ( log_event%place /= place ) THEN 58 IF ( myid == 0 ) THEN 59 PRINT*,'+++ cpu_log: wrong argument' 60 PRINT*,' expected: ',log_event%place,' given: ', place 61 ENDIF 62 CALL local_stop 60 WRITE( message_string, * ) 'wrong argument & expected: ', & 61 TRIM(log_event%place), ' given: ', TRIM( place ) 62 CALL message( 'cpu_log', 'PA0174', 1, 2, 0, 6, 0 ) 63 63 ENDIF 64 64 … … 71 71 mtime = IRTC( ) * 1E-9 72 72 #else 73 IF ( myid == 0 ) THEN 74 PRINT*, '+++ cpu_log: no time measurement defined on this host' 75 ENDIF 76 CALL local_stop 73 message_string = 'no time measurement defined on this host' 74 CALL message( 'cpu_log', 'PA0175', 1, 2, 0, 6, 0 ) 77 75 #endif 78 76 … … 84 82 ELSEIF ( modus == 'pause' ) THEN 85 83 IF ( ( mtime - log_event%mtime ) < 0.0 .AND. first ) THEN 86 PRINT*,'+++ WARNING: cpu_log: negative time interval occured' 87 PRINT*,'+++ PE',myid,' L=PAUSE "',TRIM(log_event%place),'" new=', & 88 mtime,' last=',log_event%mtime 84 WRITE( message_string, * ) 'negative time interval occured', & 85 ' &PE',myid,' L=PAUSE "',TRIM(log_event%place),'" new=', & 86 mtime,' last=',log_event%mtime 87 CALL message( 'cpu_log', 'PA0176', 0, 1, -1, 6, 0 ) 89 88 first = .FALSE. 90 89 ENDIF … … 94 93 IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0 .AND. & 95 94 first ) THEN 96 PRINT*,'+++ WARNING: cpu_log: negative time interval occured' 97 PRINT*,'+++ PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', & 98 mtime,' last=',log_event%mtime,' isum=',log_event%isum 95 WRITE( message_string, * ) 'negative time interval occured', & 96 ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', & 97 mtime,' last=',log_event%mtime,' isum=',log_event%isum 98 CALL message( 'cpu_log', 'PA0177', 0, 1, -1, 6, 0 ) 99 99 first = .FALSE. 100 100 ENDIF … … 103 103 log_event%sum = log_event%sum + log_event%mtime 104 104 IF ( log_event%sum < 0.0 .AND. first ) THEN 105 PRINT*,'+++ WARNING: cpu_log: negative time interval occured' 106 PRINT*,'+++ PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', & 107 log_event%sum,' mtime=',log_event%mtime 105 WRITE( message_string, * ) 'negative time interval occured',& 106 ' &PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', & 107 log_event%sum,' mtime=',log_event%mtime 108 CALL message( 'cpu_log', 'PA0178', 0, 1, -1, 6, 0 ) 108 109 first = .FALSE. 109 110 ENDIF … … 113 114 log_event%ivect = 0.0 114 115 ELSE 115 PRINT*, '+++ unknown modus of time measurement: ', modus 116 message_string = 'unknown modus of time measurement: ' // TRIM( modus ) 117 CALL message( 'cpu_log', 'PA0179', 0, 1, -1, 6, 0 ) 116 118 ENDIF 117 119 -
palm/trunk/SOURCE/data_output_2d.f90
r226 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 158 159 CASE DEFAULT 159 160 160 PRINT*,'+++ data_output_2d: unknown cross-section: ',mode161 CALL local_stop161 message_string = 'unknown cross-section: ' // TRIM( mode ) 162 CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 ) 162 163 163 164 END SELECT … … 518 519 519 520 IF ( .NOT. found ) THEN 520 PRINT*, '+++ data_output_2d: no output provided for: ', &521 do2d(av,if)521 message_string = 'no output provided for: ' // TRIM( do2d(av,if) ) 522 CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 ) 522 523 ENDIF 523 524 -
palm/trunk/SOURCE/data_output_3d.f90
r98 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 310 311 resorted = .TRUE. 311 312 312 IF ( myid == 0 .AND..NOT. found ) THEN313 PRINT*, '+++ data_output_3d: no output available for: ', &314 do3d(av,if)313 IF ( .NOT. found ) THEN 314 message_string = 'no output available for: ' // TRIM( do3d(av,if) ) 315 CALL message( 'data_output_3d', 'PA0182', 0, 0, 0, 6, 0 ) 315 316 ENDIF 316 317 -
palm/trunk/SOURCE/data_output_dvrp.f90
r246 r254 30 30 31 31 !------------------------------------------------------------------------------! 32 ! Actualrevisions:32 ! Current revisions: 33 33 ! ----------------- 34 ! Output of messages replaced by message handling routine. 34 35 ! TEST: different colours for isosurfaces 35 36 ! … … 398 399 ENDDO 399 400 ENDDO 400 ELSE 401 IF ( myid == 0 ) THEN 402 PRINT*, '+++ data_output_dvrp: if humidity/passive_scalar = ', & 403 'FALSE output of ', output_variable, & 404 'is not provided' 405 ENDIF 401 ELSE 402 message_string = 'if humidity/passive_scalar = ' // & 403 'FALSE output of ' // TRIM( output_variable ) // & 404 'is not provided' 405 CALL message( 'data_output_dvrp', 'PA0183', 0, 0, 0, 6, 0 ) 406 406 ENDIF 407 407 … … 415 415 ENDDO 416 416 ENDDO 417 ELSE 418 IF ( myid == 0 ) THEN419 PRINT*, '+++ data_output_dvrp: if cloud_physics = FALSE ', &420 'output of ', output_variable,'is not provided'421 ENDIF417 ELSE 418 message_string = 'if cloud_physics = FALSE ' // & 419 'output of ' // TRIM( output_variable) // & 420 'is not provided' 421 CALL message( 'data_output_dvrp', 'PA0184', 0, 0, 0, 6, 0 ) 422 422 ENDIF 423 423 -
palm/trunk/SOURCE/data_output_profiles.f90
r198 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 290 291 IF ( cross_normx_factor(k,j) == 0.0 .OR. & 291 292 cross_normy_factor(k,j) == 0.0 ) THEN 292 PRINT*,'+++ WARNING data_output_profiles: normalizi', & 293 'ng cross ',j, ' is not possible since one o', & 294 'f the' 295 PRINT*,' normalizing factors is ',& 296 'zero!' 297 PRINT*,' cross_normx_factor(',k,',',j,') = ', & 298 cross_normx_factor(k,j) 299 PRINT*,' cross_normy_factor(',k,',',j,') = ', & 300 cross_normy_factor(k,j) 293 WRITE( message_string, * ) 'data_output_profiles: normalizi', & 294 'ng cross ',j, ' is not possible since one o', & 295 'f the & normalizing factors is zero! & ', & 296 'cross_normx_factor(',k,',',j,') = ', & 297 cross_normx_factor(k,j), & 298 ' & cross_normy_factor(',k,',',j,') = ', & 299 cross_normy_factor(k,j) 300 CALL message( 'data_output_profiles', 'PA0185', 0, 1, 0, 6, 0 ) 301 301 cross_normx_factor(k,j) = 1.0 302 302 cross_normy_factor(k,j) = 1.0 … … 532 532 533 533 ! 534 !-- Check the normalizing factors for zeros and deactivate the535 !-- normalization, if required.534 !-- Check the normalizing factors for zeros and deactivate 535 !-- the normalization, if required. 536 536 IF ( cross_normx_factor(k,j) == 0.0 .OR. & 537 537 cross_normy_factor(k,j) == 0.0 ) THEN 538 PRINT*,'+++ WARNING data_output_profiles: normalizing ',j, & 539 ' cross is not possible since one of the' 540 PRINT*,' normalizing factors is zero!' 541 PRINT*,' cross_normx_factor(',k,',',j,') = ', & 542 cross_normx_factor(k,j) 543 PRINT*,' cross_normy_factor(',k,',',j,') = ', & 544 cross_normy_factor(k,j) 545 cross_normx_factor(k,j) = 1.0 546 cross_normy_factor(k,j) = 1.0 547 cross_normalized_x(j) = ' ' 548 cross_normalized_y(j) = ' ' 538 WRITE( message_string, * ) 'data_output_profiles: normalizi', & 539 'ng cross ',j, ' is not possible since one o', & 540 'f the & normalizing factors is zero! & ', & 541 'cross_normx_factor(',k,',',j,') = ', & 542 cross_normx_factor(k,j), & 543 ' & cross_normy_factor(',k,',',j,') = ', & 544 cross_normy_factor(k,j) 545 CALL message( 'data_output_profiles', 'PA0185', 0, 1, 0, 6, 0 ) 546 cross_normx_factor(k,j) = 1.0 547 cross_normy_factor(k,j) = 1.0 548 cross_normalized_x(j) = ' ' 549 cross_normalized_y(j) = ' ' 549 550 ENDIF 550 551 -
palm/trunk/SOURCE/data_output_spectra.f90
r198 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 92 93 !-- If necessary, calculate time average and reset average counter 93 94 IF ( average_count_sp == 0 ) THEN 94 PRINT*, '+++ data_output_spectra: no spectra data available' 95 message_string = 'no spectra data available' 96 CALL message( 'data_output_spectra', 'PA0186', 0, 0, 0, 6, 0 ) 95 97 ENDIF 96 98 IF ( average_count_sp /= 1 ) THEN -
palm/trunk/SOURCE/fft_xy.f90
r4 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 134 135 auy4, nau2 ) 135 136 #elif defined( __nec ) 136 PRINT*, '+++ fft_init: fft method "', fft_method,&137 '" currently does not work on NEC'138 CALL local_stop137 message_string = 'fft method "' // TRIM( fft_method) // & 138 '" currently does not work on NEC' 139 CALL message( 'fft_init', 'PA0187', 1, 2, 0, 6, 0 ) 139 140 140 141 ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)), & … … 163 164 trig_yb, worky, 0 ) 164 165 #else 165 PRINT*, '+++ fft_init:no system-specific fft-call available'166 CALL local_stop166 message_string = 'no system-specific fft-call available' 167 CALL message( 'fft_init', 'PA0188', 1, 2, 0, 6, 0 ) 167 168 #endif 168 169 ELSEIF ( fft_method == 'temperton-algorithm' ) THEN … … 181 182 ELSE 182 183 183 PRINT*, '+++ fft_init: fft method "', fft_method, & 184 '" not available' 185 CALL local_stop 186 184 message_string = 'fft method "' // TRIM( fft_method) // & 185 '" not available' 186 CALL message( 'fft_init', 'PA0189', 1, 2, 0, 6, 0 ) 187 187 ENDIF 188 188 … … 357 357 ENDIF 358 358 #else 359 PRINT*, '+++ fft_x:no system-specific fft-call available'360 CALL local_stop359 message_string = 'no system-specific fft-call available' 360 CALL message( 'fft_x', 'PA0188', 1, 2, 0, 6, 0 ) 361 361 #endif 362 362 ELSE 363 364 PRINT*, '+++ fft_x: fft method "', fft_method, '" not available' 365 CALL local_stop 363 message_string = 'fft method "' // TRIM( fft_method) // '" not available' 364 CALL message( 'fft_x', 'PA0189', 1, 2, 0, 6, 0 ) 366 365 367 366 ENDIF … … 537 536 ENDIF 538 537 #else 539 PRINT*, '+++ fft_y: no system-specific fft-call available' 540 CALL local_stop 538 message_string = 'no system-specific fft-call available' 539 CALL message( 'fft_y', 'PA0188', 1, 2, 0, 6, 0 ) 540 541 541 #endif 542 542 543 543 ELSE 544 544 545 PRINT*, '+++ fft_y: fft method "', fft_method,'" not available'546 CALL local_stop545 message_string = 'fft method "' // TRIM( fft_method) // '" not available' 546 CALL message( 'fft_y', 'PA0189', 1, 2, 0, 6, 0 ) 547 547 548 548 ENDIF … … 672 672 673 673 #else 674 PRINT*, '+++ fft_x_m:no system-specific fft-call available'675 STOP674 message_string = 'no system-specific fft-call available' 675 CALL message( 'fft_x_m', 'PA0188', 1, 2, 0, 6, 0 ) 676 676 #endif 677 677 678 678 ELSE 679 679 680 PRINT*, '+++ fft_x_m: fft method "', fft_method,'" not available'681 CALL local_stop680 message_string = 'fft method "' // TRIM( fft_method) // '" not available' 681 CALL message( 'fft_x_m', 'PA0189', 1, 2, 0, 6, 0 ) 682 682 683 683 ENDIF … … 807 807 808 808 #else 809 PRINT*, '+++ fft_y_m:no system-specific fft-call available'810 STOP809 message_string = 'no system-specific fft-call available' 810 CALL message( 'fft_y_m', 'PA0188', 1, 2, 0, 6, 0 ) 811 811 #endif 812 812 813 813 ELSE 814 815 PRINT*, '+++ fft_y_m: fft method "', fft_method,'" not available'816 CALL local_stop814 815 message_string = 'fft method "' // TRIM( fft_method) // '" not available' 816 CALL message( 'fft_x_m', 'PA0189', 1, 2, 0, 6, 0 ) 817 817 818 818 ENDIF -
palm/trunk/SOURCE/flow_statistics.f90
r220 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 93 94 !-- called once after the current time step 94 95 IF ( flow_statistics_called ) THEN 95 IF ( myid == 0 ) PRINT*, '+++ WARNING: flow_statistics is called two', & 96 ' times within one timestep' 97 CALL local_stop 96 97 message_string = 'flow_statistics is called two times within one timestep' 98 CALL message( 'flow_statistics', 'PA0190', 1, 2, 0, 6, 0 ) 99 98 100 ENDIF 99 101 -
palm/trunk/SOURCE/header.f90
r241 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! Output of messages replaced by message handling routine. 6 7 ! Output of cluster_size 7 8 ! +canyon_height, canyon_width_x, canyon_width_y, canyon_wall_left, … … 135 136 run_classification = '3D - run initialized by user' 136 137 ELSE 137 PRINT*,'+++ header: unknown action(s): ',initializing_actions 138 message_string = ' unknown action(s): ' // TRIM( initializing_actions ) 139 CALL message( 'header', 'PA0191', 0, 0, 0, 6, 0 ) 138 140 ENDIF 139 141 IF ( ocean ) THEN … … 634 636 ! 635 637 !-- 1D-profiles 636 dopr_chr = 'P rofile:'638 dopr_chr = 'Pofile:' 637 639 IF ( dopr_n /= 0 ) THEN 638 640 WRITE ( io, 331 ) -
palm/trunk/SOURCE/init_1d_model.f90
r198 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! Output of messages replaced by message handling routine. 7 ! 7 8 ! 8 9 ! Former revisions: … … 842 843 IF ( dt_1d < ( 0.00001 * dt_max_1d ) ) THEN 843 844 stop_dt_1d = .TRUE. 844 IF ( myid == 0 ) THEN 845 PRINT*,'+++ timestep_1d: timestep has exceeded the lower limit'846 PRINT*,'dt_1d = ',dt_1d,' s simulation stopped!'847 ENDIF848 CALL local_stop845 846 WRITE( message_string, * ) 'timestep has exceeded the lower limit &', & 847 'dt_1d = ',dt_1d,' s simulation stopped!' 848 CALL message( 'timestep_1d', 'PA0192', 1, 2, 0, 6, 0 ) 849 849 850 ENDIF 850 851 -
palm/trunk/SOURCE/init_3d_model.f90
r241 r254 5 5 6 6 !------------------------------------------------------------------------------! 7 ! Actualrevisions:7 ! Current revisions: 8 8 ! ----------------- 9 ! Output of messages replaced by message handling routine. 9 10 ! Set the starting level and the vertical smoothing factor used for 10 11 ! the external pressure gradient 11 ! +con verve_volume_flow_mode: 'default', 'initial_profiles', 'inflow_profile'12 ! +conserve_volume_flow_mode: 'default', 'initial_profiles', 'inflow_profile' 12 13 ! and 'bulk_velocity' 13 14 ! … … 1079 1080 ! 1080 1081 !-- Actually this part of the programm should not be reached 1081 IF ( myid == 0 ) PRINT*,'+++ init_3d_model: unknown initializing ', & 1082 'problem' 1083 CALL local_stop 1082 message_string = 'unknown initializing problem' 1083 CALL message( 'init_3d_model', 'PA0193', 1, 2, 0, 6, 0 ) 1084 1084 ENDIF 1085 1085 … … 1378 1378 1379 1379 IF ( dots_num > dots_max ) THEN 1380 IF ( myid == 0 ) THEN 1381 PRINT*, '+++ user_init: number of time series quantities exceeds', & 1382 ' its maximum of dots_max = ', dots_max 1383 PRINT*, ' Please increase dots_max in modules.f90.' 1384 ENDIF 1385 CALL local_stop 1380 WRITE( message_string, * ) 'number of time series quantities exceeds', & 1381 ' its maximum of dots_max = ', dots_max, & 1382 ' &Please increase dots_max in modules.f90.' 1383 CALL message( 'init_3d_model', 'PA0194', 1, 2, 0, 6, 0 ) 1386 1384 ENDIF 1387 1385 -
palm/trunk/SOURCE/init_dvrp.f90
r242 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! Output of messages replaced by message handling routine. 6 7 ! Clipping implemented. 7 8 ! Polygon reduction for building and ground plate isosurface. Reduction level … … 131 132 !-- and set default-values, where necessary 132 133 IF ( dvrp_username == ' ' ) THEN 133 IF ( myid == 0 ) THEN 134 PRINT*, '+++ init_dvrp: dvrp_username is undefined' 135 CALL local_stop 136 ENDIF 134 message_string = 'dvrp_username is undefined' 135 CALL message( 'init_dvrp', 'PA0195', 1, 2, 0, 6, 0 ) 137 136 ENDIF 138 137 139 138 IF ( dvrp_output /= 'ftp' .AND. dvrp_output /= 'rtsp' .AND. & 140 139 dvrp_output /= 'local' ) THEN 141 IF ( myid == 0 ) THEN 142 PRINT*, '+++ init_dvrp: dvrp_output="', dvrp_output, '" not allowed' 143 CALL local_stop 144 ENDIF 140 message_string = 'dvrp_output="' // TRIM( dvrp_output ) // '" not allowed' 141 CALL message( 'init_dvrp', 'PA0196', 1, 2, 0, 6, 0 ) 145 142 ENDIF 146 143 … … 151 148 IF ( dvrp_output /= 'local' ) THEN 152 149 IF ( dvrp_file /= 'default' .AND. dvrp_file /= '/dev/null' ) THEN 153 IF ( myid == 0 ) THEN 154 PRINT*, '+++ init_dvrp: dvrp_file="', dvrp_file, '" not allowed' 155 CALL local_stop 156 ENDIF 150 message_string = 'dvrp_file="' // TRIM( dvrp_file ) // '" not allowed' 151 CALL message( 'init_dvrp', 'PA0197', 1, 2, 0, 6, 0 ) 157 152 ENDIF 158 153 ENDIF … … 181 176 mode_dvrp(m)(1:9) /= 'pathlines' ) THEN 182 177 183 IF ( myid == 0 ) THEN 184 PRINT*, '+++ init_dvrp: mode_dvrp="', mode_dvrp, '" not allowed' 185 ENDIF 178 message_string = 'mode_dvrp="' // TRIM( mode_dvrp ) // '" not allowed' 179 CALL message( 'init_dvrp', 'PA0198', 1, 2, 0, 6, 0 ) 186 180 CALL local_stop 187 181 … … 693 687 #else 694 688 IF ( coupling_mode /= 'uncoupled' ) THEN 695 IF ( myid == 0 ) THEN 696 PRINT*, '+++ init_dvrp: split of communicator not realized with', & 689 message_string = 'split of communicator not realized with' // & 697 690 ' MPI1 coupling atmosphere-ocean' 698 ENDIF699 CALL local_stop691 CALL message( 'init_dvrp_logging', 'PA0199', 1, 2, 0, 6, 0 ) 692 700 693 ! CALL DVRP_SPLIT( comm_inter, comm_palm ) 701 694 ELSE -
palm/trunk/SOURCE/init_grid.f90
r240 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! Output of messages replaced by message handling routine. 6 7 ! new topography case 'single_street_canyon' 7 8 ! … … 78 79 !-- Compute height of u-levels from constant grid length and dz stretch factors 79 80 IF ( dz == -1.0 ) THEN 80 IF ( myid == 0 ) PRINT*,'+++ init_grid:missing dz'81 CALL local_stop81 message_string = 'missing dz' 82 CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 ) 82 83 ELSEIF ( dz <= 0.0 ) THEN 83 IF ( myid == 0 ) PRINT*,'+++ init_grid:dz=',dz,' <= 0.0'84 CALL local_stop84 WRITE( message_string, * ) 'dz=',dz,' <= 0.0' 85 CALL message( 'init_grid', 'PA0201', 1, 2, 0, 6, 0 ) 85 86 ENDIF 86 87 … … 309 310 IF ( l_grid(k) > 1.5 * dx * wall_adjustment_factor .OR. & 310 311 l_grid(k) > 1.5 * dy * wall_adjustment_factor ) THEN 311 IF ( myid == 0 ) THEN 312 PRINT*, '+++ WARNING: grid anisotropy exceeds '// & 313 'threshold given by only local' 314 PRINT*, ' horizontal reduction of near_wall '// & 315 'mixing length l_wall' 316 PRINT*, ' starting from height level k = ', k, '.' 317 ENDIF 312 WRITE( message_string, * ) 'grid anisotropy exceeds ', & 313 'threshold given by only local', & 314 ' &horizontal reduction of near_wall ', & 315 'mixing length l_wall', & 316 ' &starting from height level k = ', k, '.' 317 CALL message( 'init_grid', 'PA0202', 0, 1, 0, 6, 0 ) 318 318 EXIT 319 319 ENDIF … … 367 367 IF ( ( bxl < 1 ) .OR. ( bxr > nx-1 ) .OR. ( bxr < bxl+3 ) .OR. & 368 368 ( bys < 1 ) .OR. ( byn > ny-1 ) .OR. ( byn < bys+3 ) ) THEN 369 IF ( myid == 0 ) THEN 370 PRINT*, '+++ init_grid: inconsistent building parameters:' 371 PRINT*, ' bxl=', bxl, 'bxr=', bxr, 'bys=', bys, & 372 'byn=', byn, 'nx=', nx, 'ny=', ny 373 ENDIF 374 CALL local_stop 369 WRITE( message_string, * ) 'inconsistent building parameters:', & 370 '& bxl=', bxl, 'bxr=', bxr, 'bys=', bys, & 371 'byn=', byn, 'nx=', nx, 'ny=', ny 372 CALL message( 'init_grid', 'PA0203', 1, 2, 0, 6, 0 ) 375 373 ENDIF 376 374 … … 405 403 406 404 ELSE 407 IF ( myid == 0 ) THEN408 PRINT*, '+++ user_init_grid:no street canyon width given'409 ENDIF410 CALL local_stop405 406 message_string = 'no street canyon width given' 407 CALL message( 'init_grid', 'PA0204', 1, 2, 0, 6, 0 ) 408 411 409 ENDIF 412 410 … … 418 416 IF ( ( cxl < 1 ) .OR. ( cxr > nx-1 ) .OR. ( cwx < 3 ) .OR. & 419 417 ( ch < 3 ) ) THEN 420 IF ( myid == 0 ) THEN 421 PRINT*, '+++ user_init_grid: inconsistent canyon parameters:' 422 PRINT*, ' cxl=', cxl, 'cxr=', cxr, & 423 'cwx=', cwx, & 424 'ch=', ch, 'nx=', nx, 'ny=', ny 425 ENDIF 426 CALL local_stop 418 WRITE( message_string, * ) 'inconsistent canyon parameters:', & 419 '&cxl=', cxl, 'cxr=', cxr, & 420 'cwx=', cwx, & 421 'ch=', ch, 'nx=', nx, 'ny=', ny 422 CALL message( 'init_grid', 'PA0205', 1, 2, 0, 6, 0 ) 427 423 ENDIF 428 424 ELSEIF ( canyon_width_y /= 9999999.9 ) THEN 429 425 IF ( ( cys < 1 ) .OR. ( cyn > ny-1 ) .OR. ( cwy < 3 ) .OR. & 430 426 ( ch < 3 ) ) THEN 431 IF ( myid == 0 ) THEN 432 PRINT*, '+++ user_init_grid: inconsistent canyon parameters:' 433 PRINT*, ' cys=', cys, 'cyn=', cyn, & 434 'cwy=', cwy, & 435 'ch=', ch, 'nx=', nx, 'ny=', ny 436 ENDIF 437 CALL local_stop 427 WRITE( message_string, * ) 'inconsistent canyon parameters:', & 428 '&cys=', cys, 'cyn=', cyn, & 429 'cwy=', cwy, & 430 'ch=', ch, 'nx=', nx, 'ny=', ny 431 CALL message( 'init_grid', 'PA0206', 1, 2, 0, 6, 0 ) 438 432 ENDIF 439 433 ENDIF 440 434 IF ( canyon_width_x /= 9999999.9 .AND. canyon_width_y /= 9999999.9 ) & 441 435 THEN 442 IF ( myid == 0 ) THEN 443 PRINT*, '+++ user_init_grid: inconsistent canyon parameters:' 444 PRINT*, ' street canyon can only be oriented' 445 PRINT*, ' either in x- or in y-direction' 446 ENDIF 447 CALL local_stop 436 message_string = 'inconsistent canyon parameters:' // & 437 '&street canyon can only be oriented' // & 438 '&either in x- or in y-direction' 439 CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 ) 448 440 ENDIF 449 441 … … 480 472 481 473 GOTO 12 482 483 10 IF ( myid == 0 ) THEN 484 PRINT*, '+++ init_grid: file TOPOGRAPHY_DATA does not exist' 485 ENDIF 486 CALL local_stop 487 488 11 IF ( myid == 0 ) THEN 489 PRINT*, '+++ init_grid: errors in file TOPOGRAPHY_DATA' 490 ENDIF 491 CALL local_stop 474 475 10 message_string = 'file TOPOGRAPHY_DATA does not exist' 476 CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 ) 477 478 11 message_string = 'errors in file TOPOGRAPHY_DATA' 479 CALL message( 'init_grid', 'PA0209', 1, 2, 0, 6, 0 ) 492 480 493 481 12 CLOSE( 90 ) … … 519 507 !-- Consistency checks 520 508 IF ( MINVAL( nzb_local ) < 0 .OR. MAXVAL( nzb_local ) > nz + 1 ) THEN 521 IF ( myid == 0 ) THEN 522 PRINT*, '+++ init_grid: nzb_local values are outside the', & 523 'model domain' 524 PRINT*, ' MINVAL( nzb_local ) = ', MINVAL(nzb_local) 525 PRINT*, ' MAXVAL( nzb_local ) = ', MAXVAL(nzb_local) 526 ENDIF 527 CALL local_stop 509 WRITE( message_string, * ) 'nzb_local values are outside the', & 510 'model domain', & 511 '&MINVAL( nzb_local ) = ', MINVAL(nzb_local), & 512 '&MAXVAL( nzb_local ) = ', MAXVAL(nzb_local) 513 CALL message( 'init_grid', 'PA0210', 1, 2, 0, 6, 0 ) 528 514 ENDIF 529 515 … … 531 517 IF ( ANY( nzb_local(:,-1) /= nzb_local(:,nx) ) .OR. & 532 518 ANY( nzb_local(:,0) /= nzb_local(:,nx+1) ) ) THEN 533 IF ( myid == 0 ) THEN 534 PRINT*, '+++ init_grid: nzb_local does not fulfill cyclic', & 535 ' boundary condition in x-direction' 536 ENDIF 537 CALL local_stop 519 message_string = 'nzb_local does not fulfill cyclic' // & 520 ' boundary condition in x-direction' 521 CALL message( 'init_grid', 'PA0211', 1, 2, 0, 6, 0 ) 538 522 ENDIF 539 523 ENDIF … … 541 525 IF ( ANY( nzb_local(-1,:) /= nzb_local(ny,:) ) .OR. & 542 526 ANY( nzb_local(0,:) /= nzb_local(ny+1,:) ) ) THEN 543 IF ( myid == 0 ) THEN 544 PRINT*, '+++ init_grid: nzb_local does not fulfill cyclic', & 545 ' boundary condition in y-direction' 546 ENDIF 547 CALL local_stop 527 message_string = 'nzb_local does not fulfill cyclic' // & 528 ' boundary condition in y-direction' 529 CALL message( 'init_grid', 'PA0212', 1, 2, 0, 6, 0 ) 548 530 ENDIF 549 531 ENDIF -
palm/trunk/SOURCE/init_particles.f90
r229 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! Output of messages replaced by message handling routine 6 7 ! Bugfix: arrays for tails are allocated with a minimum size of 10 tails if 7 8 ! there is no tail initially … … 97 98 !-- Check the number of particle groups. 98 99 IF ( number_of_particle_groups > max_number_of_particle_groups ) THEN 99 PRINT*, '+++ WARNING: init_particles:', &100 'max_number_of_particle_groups =', &101 max_number_of_particle_groups102 PRINT*, '+++ number_of_particle_groups reset to ', &103 max_number_of_particle_groups100 WRITE( message_string, * ) 'max_number_of_particle_groups =', & 101 max_number_of_particle_groups , & 102 '&number_of_particle_groups reset to ', & 103 max_number_of_particle_groups 104 CALL message( 'init_particles', 'PA0213', 0, 1, 0, 6, 0 ) 104 105 number_of_particle_groups = max_number_of_particle_groups 105 106 ENDIF … … 152 153 particle_binary_version = '3.0' 153 154 IF ( TRIM( version_on_file ) /= TRIM( particle_binary_version ) ) THEN 154 IF ( myid == 0 ) THEN 155 PRINT*, '+++ init_particles: version mismatch concerning data ', & 156 'from prior run' 157 PRINT*, ' version on file = "', TRIM( version_on_file ),& 158 '"' 159 PRINT*, ' version in program = "', & 160 TRIM( particle_binary_version ), '"' 161 ENDIF 162 CALL local_stop 155 message_string = 'version mismatch concerning data from prior run' // & 156 '&version on file = "' // TRIM( version_on_file ) // & 157 '&version in program = "' // & 158 TRIM( particle_binary_version ) // '"' 159 CALL message( 'init_particles', 'PA0214', 1, 2, 0, 6, 0 ) 163 160 ENDIF 164 161 … … 234 231 DO i = 1, number_of_particle_groups 235 232 IF ( density_ratio(i) /= 0.0 .AND. radius(i) == 0 ) THEN 236 IF ( myid == 0 ) THEN 237 PRINT*, '+++ init_particles: particle group #', i, 'has a', & 238 'density ratio /= 0 but radius = 0' 239 ENDIF 240 CALL local_stop 233 WRITE( message_string, * ) 'particle group #', i, 'has a', & 234 'density ratio /= 0 but radius = 0' 235 CALL message( 'init_particles', 'PA0215', 1, 2, 0, 6, 0 ) 241 236 ENDIF 242 237 particle_groups(i)%density_ratio = density_ratio(i) … … 273 268 n = n + 1 274 269 IF ( n > maximum_number_of_particles ) THEN 275 PRINT*,'+++ init_particles: number of initial', & 276 ' particles (', n, ') exceeds' 277 PRINT*,' maximum_number_of_particles (', & 278 maximum_number_of_particles, ') on PE ', & 279 myid 280 #if defined( __parallel ) 281 CALL MPI_ABORT( comm2d, 9999, ierr ) 282 #else 283 CALL local_stop 284 #endif 270 WRITE( message_string, * ) 'number of initial', & 271 'particles (', n, ') exceeds', & 272 '&maximum_number_of_particles (', & 273 maximum_number_of_particles, ') on PE ', & 274 myid 275 CALL message( 'init_particles', 'PA0216', 2, 2, 0, 6, 0 ) 285 276 ENDIF 286 277 particles(n)%x = pos_x … … 519 510 520 511 CASE DEFAULT 521 IF ( myid == 0 ) THEN 522 PRINT*,'+++ init_particles: unknown boundary condition ', & 523 'bc_par_b = "', TRIM( bc_par_b ), '"' 524 ENDIF 525 CALL local_stop 512 WRITE( message_string, * ) 'unknown boundary condition ', & 513 'bc_par_b = "', TRIM( bc_par_b ), '"' 514 CALL message( 'init_particles', 'PA0217', 1, 2, 0, 6, 0 ) 526 515 527 516 END SELECT … … 535 524 536 525 CASE DEFAULT 537 IF ( myid == 0 ) THEN 538 PRINT*,'+++ init_particles: unknown boundary condition ', & 539 'bc_par_t = "', TRIM( bc_par_t ), '"' 540 ENDIF 541 CALL local_stop 526 WRITE( message_string, * ) 'unknown boundary condition ', & 527 'bc_par_t = "', TRIM( bc_par_t ), '"' 528 CALL message( 'init_particles', 'PA0218', 1, 2, 0, 6, 0 ) 542 529 543 530 END SELECT … … 554 541 555 542 CASE DEFAULT 556 IF ( myid == 0 ) THEN 557 PRINT*,'+++ init_particles: unknown boundary condition ', & 558 'bc_par_lr = "', TRIM( bc_par_lr ), '"' 559 ENDIF 560 CALL local_stop 543 WRITE( message_string, * ) 'unknown boundary condition ', & 544 'bc_par_lr = "', TRIM( bc_par_lr ), '"' 545 CALL message( 'init_particles', 'PA0219', 1, 2, 0, 6, 0 ) 561 546 562 547 END SELECT … … 573 558 574 559 CASE DEFAULT 575 IF ( myid == 0 ) THEN 576 PRINT*,'+++ init_particles: unknown boundary condition ', & 577 'bc_par_ns = "', TRIM( bc_par_ns ), '"' 578 ENDIF 579 CALL local_stop 560 WRITE( message_string, * ) 'unknown boundary condition ', & 561 'bc_par_ns = "', TRIM( bc_par_ns ), '"' 562 CALL message( 'init_particles', 'PA0220', 1, 2, 0, 6, 0 ) 580 563 581 564 END SELECT -
palm/trunk/SOURCE/init_pegrid.f90
r226 r254 2 2 3 3 !------------------------------------------------------------------------------! 4 ! Actualrevisions:4 ! Current revisions: 5 5 ! ----------------- 6 ! Output of messages replaced by message handling routine. 6 7 ! ATTENTION: nnz_x undefined problem still has to be solved!!!!!!!! 7 8 ! TEST OUTPUT (TO BE REMOVED) logging mpi2 ierr values … … 121 122 !-- must be equal to the number of PEs available to the job 122 123 IF ( ( npex * npey ) /= numprocs ) THEN 123 PRINT*, '+++ init_pegrid:' 124 PRINT*, ' number of PEs of the prescribed topology (', npex*npey, & 125 ') does not match the number of PEs available to the ', & 126 'job (', numprocs, ')' 127 CALL local_stop 124 WRITE( message_string, * ) 'number of PEs of the prescribed topology (', & 125 npex*npey,') does not match & the number of ', & 126 'PEs available to the job (', numprocs, ')' 127 CALL message( 'init_pegrid', 'PA0221', 1, 2, 0, 6, 0 ) 128 128 ENDIF 129 129 pdims(1) = npex … … 134 134 !-- If the processor topology is prescribed by the user, the number of 135 135 !-- PEs must be given in both directions 136 PRINT*, '+++ init_pegrid:' 137 PRINT*, ' if the processor topology is prescribed by the user, ', & 138 'both values of "npex" and "npey" must be given in the ', & 139 'NAMELIST-parameter file' 140 CALL local_stop 136 message_string = 'if the processor topology is prescribed by the user, ' // & 137 '& both values of "npex" and "npey" must be given in the ' // & 138 '&NAMELIST-parameter file' 139 CALL message( 'init_pegrid', 'PA0222', 1, 2, 0, 6, 0 ) 141 140 142 141 ENDIF … … 145 144 !-- The hybrid solver can only be used in case of a 1d-decomposition along x 146 145 IF ( pdims(2) /= 1 .AND. psolver == 'poisfft_hybrid' ) THEN 147 IF ( myid == 0 ) THEN 148 PRINT*, '*** init_pegrid: psolver = "poisfft_hybrid" can only be' 149 PRINT*, ' used in case of a 1d-decomposition along x' 150 ENDIF 146 message_string = 'psolver = "poisfft_hybrid" can only be' // & 147 '& used in case of a 1d-decomposition along x' 148 CALL message( 'init_pegrid', 'PA0223', 1, 2, 0, 6, 0 ) 151 149 ENDIF 152 150 … … 224 222 225 223 IF ( .NOT. found ) THEN 226 IF ( myid == 0 ) THEN 227 PRINT*,'+++ init_pegrid: no matching grid for transpositions found' 228 ENDIF 229 CALL local_stop 224 message_string = 'no matching grid for transpositions found' 225 CALL message( 'init_pegrid', 'PA0224', 1, 2, 0, 6, 0 ) 230 226 ENDIF 231 227 … … 239 235 240 236 IF ( MOD( nxa+1 , pdims(1) ) /= 0 ) THEN 241 IF ( myid == 0 ) THEN 242 PRINT*,'+++ x-direction: gridpoint number (',nx+1,') is not an' 243 PRINT*,' integral divisor of the number of proces', & 244 &'sors (', pdims(1),')' 245 ENDIF 246 CALL local_stop 237 WRITE( message_string, * ) 'x-direction: gridpoint number (',nx+1,') is not an',& 238 '& integral divisor of the number of proces', & 239 'sors (', pdims(1),')' 240 CALL message( 'init_pegrid', 'PA0225', 1, 2, 0, 6, 0 ) 247 241 ELSE 248 242 nnx = ( nxa + 1 ) / pdims(1) 249 243 IF ( nnx*pdims(1) - ( nx + 1) > nnx ) THEN 250 IF ( myid == 0 ) THEN 251 PRINT*,'+++ x-direction: nx does not match the requirements ', & 252 'given by the number of PEs' 253 PRINT*,' used' 254 PRINT*,' please use nx = ', nx - ( pdims(1) - ( nnx*pdims(1) & 255 - ( nx + 1 ) ) ), ' instead of nx =', nx 256 ENDIF 257 CALL local_stop 244 WRITE( message_string, * ) 'x-direction: nx does not match the', & 245 'requirements given by the number of PEs', & 246 '& used',& 247 '& please use nx = ', nx - ( pdims(1) - ( nnx*pdims(1) & 248 - ( nx + 1 ) ) ), ' instead of nx =', nx 249 CALL message( 'init_pegrid', 'PA0226', 1, 2, 0, 6, 0 ) 258 250 ENDIF 259 251 ENDIF … … 270 262 !-- Calculate array bounds in y-direction for every PE. 271 263 IF ( MOD( nya+1 , pdims(2) ) /= 0 ) THEN 272 IF ( myid == 0 ) THEN 273 PRINT*,'+++ y-direction: gridpoint number (',ny+1,') is not an' 274 PRINT*,' integral divisor of the number of proces', & 275 &'sors (', pdims(2),')' 276 ENDIF 277 CALL local_stop 264 WRITE( message_string, * ) 'y-direction: gridpoint number (',ny+1,') is not an', & 265 '& integral divisor of the number of proces', & 266 'sors (', pdims(2),')' 267 CALL message( 'init_pegrid', 'PA0227', 1, 2, 0, 6, 0 ) 278 268 ELSE 279 269 nny = ( nya + 1 ) / pdims(2) 280 270 IF ( nny*pdims(2) - ( ny + 1) > nny ) THEN 281 IF ( myid == 0 ) THEN 282 PRINT*,'+++ x-direction: nx does not match the requirements ', & 283 'given by the number of PEs' 284 PRINT*,' used' 285 PRINT*,' please use nx = ', nx - ( pdims(1) - ( nnx*pdims(1) & 286 - ( nx + 1 ) ) ), ' instead of nx =', nx 287 ENDIF 288 CALL local_stop 271 WRITE( message_string, * ) 'y-direction: ny does not match the',& 272 'requirements given by the number of PEs', & 273 '& used', & 274 '& please use ny = ', ny - ( pdims(2) - ( nnx*pdims(2) & 275 - ( ny + 1 ) ) ), ' instead of ny =', ny 276 CALL message( 'init_pegrid', 'PA0228', 1, 2, 0, 6, 0 ) 289 277 ENDIF 290 278 ENDIF … … 326 314 IF ( pdims(2) == 1 .AND. ( momentum_advec == 'ups-scheme' .OR. & 327 315 scalar_advec == 'ups-scheme' ) ) THEN 328 IF ( myid == 0 ) THEN 329 PRINT*,'+++ WARNING: init_pegrid: 1d-decomposition along x ', & 330 &'chosen but nz restrictions may occur' 331 PRINT*,' since ups-scheme is activated' 332 ENDIF 316 message_string = '1d-decomposition along x ' // & 317 'chosen but nz restrictions may occur' // & 318 '& since ups-scheme is activated' 319 CALL message( 'init_pegrid', 'PA0229', 0, 1, 0, 6, 0 ) 333 320 ENDIF 334 321 nys_x = nys … … 337 324 nny_x = nny 338 325 IF ( MOD( nza , pdims(1) ) /= 0 ) THEN 339 IF ( myid == 0 ) THEN 340 PRINT*,'+++ transposition z --> x:' 341 PRINT*,' nz=',nz,' is not an integral divisior of pdims(1)=', & 342 &pdims(1) 343 ENDIF 344 CALL local_stop 326 WRITE( message_string, * ) 'transposition z --> x:', & 327 '&nz=',nz,' is not an integral divisior of pdims(1)=', & 328 pdims(1) 329 CALL message( 'init_pegrid', 'PA0230', 1, 2, 0, 6, 0 ) 345 330 ENDIF 346 331 nnz_x = nza / pdims(1) … … 371 356 nzt_y = nzt_x 372 357 IF ( MOD( nxa+1 , pdims(2) ) /= 0 ) THEN 373 IF ( myid == 0 ) THEN 374 PRINT*,'+++ transposition x --> y:' 375 PRINT*,' nx+1=',nx+1,' is not an integral divisor of ',& 376 &'pdims(2)=',pdims(2) 377 ENDIF 378 CALL local_stop 358 WRITE( message_string, * ) 'transposition x --> y:', & 359 '&nx+1=',nx+1,' is not an integral divisor of ',& 360 'pdims(2)=',pdims(2) 361 CALL message( 'init_pegrid', 'PA0231', 1, 2, 0, 6, 0 ) 379 362 ENDIF 380 363 nnx_y = (nxa+1) / pdims(2) … … 399 382 nxr_z = nxr_y 400 383 IF ( MOD( nya+1 , pdims(1) ) /= 0 ) THEN 401 IF ( myid == 0 ) THEN 402 PRINT*,'+++ Transposition y --> z:' 403 PRINT*,' ny+1=',ny+1,' is not an integral divisor of ',& 404 &'pdims(1)=',pdims(1) 405 ENDIF 406 CALL local_stop 384 WRITE( message_string, * ) 'transposition y --> z:', & 385 '& ny+1=',ny+1,' is not an integral divisor of ',& 386 'pdims(1)=',pdims(1) 387 CALL message( 'init_pegrid', 'PA0232', 1, 2, 0, 6, 0 ) 407 388 ENDIF 408 389 nny_z = (nya+1) / pdims(1) … … 417 398 !-- x --> y. This condition must be fulfilled for a 1D-decomposition along x 418 399 IF ( MOD( nya+1 , pdims(1) ) /= 0 ) THEN 419 IF ( myid == 0 ) THEN 420 PRINT*,'+++ Transposition x --> y:' 421 PRINT*,' ny+1=',ny+1,' is not an integral divisor of ',& 422 &'pdims(1)=',pdims(1) 423 ENDIF 424 CALL local_stop 400 WRITE( message_string, * ) 'transposition x --> y:', & 401 '& ny+1=',ny+1,' is not an integral divisor of ',& 402 'pdims(1)=',pdims(1) 403 CALL message( 'init_pegrid', 'PA0233', 1, 2, 0, 6, 0 ) 425 404 ENDIF 426 405 … … 431 410 IF ( dt_dosp /= 9999999.9 ) THEN 432 411 IF ( MOD( nza, pdims(2) ) /= 0 ) THEN 433 IF ( myid == 0 ) THEN 434 PRINT*,'+++ Direct transposition z --> y (needed for spectra):' 435 PRINT*,' nz=',nz,' is not an integral divisor of ',& 436 &'pdims(2)=',pdims(2) 437 ENDIF 438 CALL local_stop 412 WRITE( message_string, * ) 'direct transposition z --> y (needed for spectra):', & 413 '& nz=',nz,' is not an integral divisor of ',& 414 'pdims(2)=',pdims(2) 415 CALL message( 'init_pegrid', 'PA0234', 1, 2, 0, 6, 0 ) 439 416 ELSE 440 417 nxl_yd = nxl … … 609 586 IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN 610 587 611 print*, '... before COMM_ACCEPT'588 PRINT*, '... before COMM_ACCEPT' 612 589 CALL MPI_COMM_ACCEPT( port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, & 613 590 comm_inter, ierr ) 614 print*, '--- ierr = ', ierr615 print*, '--- comm_inter atmosphere = ', comm_inter591 PRINT*, '--- ierr = ', ierr 592 PRINT*, '--- comm_inter atmosphere = ', comm_inter 616 593 617 594 coupling_mode_remote = 'ocean_to_atmosphere' … … 620 597 621 598 IF ( myid == 0 ) PRINT*, '*** read: ', port_name, ' ierr = ', ierr 622 print*, '... before COMM_CONNECT'599 PRINT*, '... before COMM_CONNECT' 623 600 CALL MPI_COMM_CONNECT( port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, & 624 601 comm_inter, ierr ) 625 print*, '--- ierr = ', ierr626 print*, '--- comm_inter ocean = ', comm_inter602 PRINT*, '--- ierr = ', ierr 603 PRINT*, '--- comm_inter ocean = ', comm_inter 627 604 628 605 coupling_mode_remote = 'atmosphere_to_ocean' … … 776 753 IF ( mg_switch_to_pe0_level < mg_switch_to_pe0_level_l .OR. & 777 754 mg_switch_to_pe0_level >= maximum_grid_level_l ) THEN 778 IF ( myid == 0 ) THEN 779 PRINT*, '+++ WARNING init_pegrid: mg_switch_to_pe0_level ', & 780 'out of range and reset to default (=0)' 781 ENDIF 755 message_string = 'mg_switch_to_pe0_level ' // & 756 'out of range and reset to default (=0)' 757 CALL message( 'init_pegrid', 'PA0235', 0, 1, 0, 6, 0 ) 782 758 mg_switch_to_pe0_level = 0 783 759 ELSE … … 836 812 837 813 IF ( gathered_size > subdomain_size ) THEN 838 IF ( myid == 0 ) THEN 839 PRINT*, '+++ init_pegrid: not enough memory for storing ', & 840 'gathered multigrid data on PE0' 841 ENDIF 842 CALL local_stop 814 message_string = 'not enough memory for storing ' // & 815 'gathered multigrid data on PE0' 816 CALL message( 'init_pegrid', 'PA0236', 1, 2, 0, 6, 0 ) 843 817 ENDIF 844 818 #else 845 PRINT*, '+++ init_pegrid: multigrid gather/scatter impossible ',&819 message_string = 'multigrid gather/scatter impossible ' // & 846 820 'in non parallel mode' 847 CALL local_stop821 CALL message( 'init_pegrid', 'PA0237', 1, 2, 0, 6, 0 ) 848 822 #endif 849 823 ENDIF … … 1062 1036 1063 1037 CASE DEFAULT 1064 IF ( myid == 0 ) PRINT*, '+++ init_pegrid: more than 10 ', & 1065 ' multigrid levels' 1066 CALL local_stop 1038 message_string = 'more than 10 multigrid levels' 1039 CALL message( 'init_pegrid', 'PA0238', 1, 2, 0, 6, 0 ) 1067 1040 1068 1041 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.
