Changeset 807 for palm/trunk/SOURCE
- Timestamp:
- Jan 25, 2012 11:53:51 AM (13 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 added
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/check_open.f90
r766 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 7 ! 7 8 ! 8 9 ! Former revisions: … … 116 117 IF ( openfile(file_id)%opened ) RETURN 117 118 119 #if .NOT. defined ( __check ) 118 120 ! 119 121 !-- Only certain files are allowed to be re-opened … … 138 140 END SELECT 139 141 ENDIF 142 #endif 140 143 141 144 ! … … 189 192 CASE ( 11 ) 190 193 194 #if defined ( __check ) 195 ! 196 !-- In case of a prior parameter file check, the p3d data is stored in 197 !-- PARIN, while the p3df is stored in PARINF. This only applies to 198 !-- check_namelist_files! 199 IF ( check_restart == 2 ) THEN 200 OPEN ( 11, FILE='PARINF'//coupling_char, FORM='FORMATTED', & 201 STATUS='OLD' ) 202 ELSE 203 OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', & 204 STATUS='OLD' ) 205 END IF 206 #else 207 191 208 OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', & 192 209 STATUS='OLD' ) 210 #endif 193 211 194 212 CASE ( 13 ) … … 219 237 CALL local_system( 'mkdir BINOUT' // coupling_char ) 220 238 ENDIF 221 #if defined( __parallel ) 239 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 222 240 ! 223 241 !-- Set a barrier in order to allow that all other processors in the … … 258 276 FORM='UNFORMATTED', POSITION='APPEND' ) 259 277 ELSE 260 #if defined( __parallel ) 278 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 261 279 ! 262 280 !-- Set a barrier in order to allow that all other processors in the … … 639 657 CALL local_system( 'mkdir PARTICLE_INFOS' // coupling_char ) 640 658 ENDIF 641 #if defined( __parallel ) 659 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 642 660 ! 643 661 !-- Set a barrier in order to allow that thereafter all other … … 688 706 CALL local_system( 'mkdir PARTICLE_DATA' // coupling_char ) 689 707 ENDIF 690 #if defined( __parallel ) 708 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 691 709 ! 692 710 !-- Set a barrier in order to allow that thereafter all other … … 1291 1309 TRIM( coupling_char ) // '/' ) 1292 1310 ENDIF 1293 #if defined( __parallel ) 1294 ! 1311 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 1312 ! 1295 1313 !-- Set a barrier in order to allow that all other processors in the 1296 1314 !-- directory created by PE0 can open their file -
palm/trunk/SOURCE/check_parameters.f90
r775 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 7 7 ! 8 8 ! Former revisions: … … 217 217 218 218 #if defined( __parallel ) 219 220 #if defined( __check ) 221 222 ! 223 !-- NOTE: coupled runs have not been implemented in the check_namelist_files 224 !-- program. 225 !-- check_namelist_files will need the following information of the other 226 !-- model (atmosphere/ocean). 227 dt_coupling = remote 228 dt_max = remote 229 restart_time = remote 230 dt_restart= remote 231 simulation_time_since_reference = remote 232 dx = remote 233 234 #endif 235 236 #if .NOT. defined( __check ) 219 237 IF ( myid == 0 ) THEN 220 238 CALL MPI_SEND( dt_coupling, 1, MPI_REAL, target_id, 11, comm_inter, & … … 224 242 ENDIF 225 243 CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr) 226 244 #endif 227 245 IF ( dt_coupling /= remote ) THEN 228 246 WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), & … … 232 250 ENDIF 233 251 IF ( dt_coupling <= 0.0 ) THEN 252 #if .NOT. defined( __check ) 234 253 IF ( myid == 0 ) THEN 235 254 CALL MPI_SEND( dt_max, 1, MPI_REAL, target_id, 19, comm_inter, ierr ) … … 238 257 ENDIF 239 258 CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr) 240 259 #endif 241 260 dt_coupling = MAX( dt_max, remote ) 242 261 WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), & … … 245 264 CALL message( 'check_parameters', 'PA0005', 0, 1, 0, 6, 0 ) 246 265 ENDIF 266 #if .NOT. defined( __check ) 247 267 IF ( myid == 0 ) THEN 248 268 CALL MPI_SEND( restart_time, 1, MPI_REAL, target_id, 12, comm_inter, & … … 252 272 ENDIF 253 273 CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr) 254 274 #endif 255 275 IF ( restart_time /= remote ) THEN 256 276 WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), & … … 259 279 CALL message( 'check_parameters', 'PA0006', 1, 2, 0, 6, 0 ) 260 280 ENDIF 281 #if .NOT. defined( __check ) 261 282 IF ( myid == 0 ) THEN 262 283 CALL MPI_SEND( dt_restart, 1, MPI_REAL, target_id, 13, comm_inter, & … … 266 287 ENDIF 267 288 CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr) 268 289 #endif 269 290 IF ( dt_restart /= remote ) THEN 270 291 WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), & … … 275 296 276 297 simulation_time_since_reference = end_time - coupling_start_time 298 #if .NOT. defined( __check ) 277 299 IF ( myid == 0 ) THEN 278 300 CALL MPI_SEND( simulation_time_since_reference, 1, MPI_REAL, target_id, & … … 282 304 ENDIF 283 305 CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr) 284 306 #endif 285 307 IF ( simulation_time_since_reference /= remote ) THEN 286 308 WRITE( message_string, * ) 'coupling mode "', TRIM( coupling_mode ), & … … 291 313 ENDIF 292 314 293 315 #if .NOT. defined( __check ) 294 316 IF ( myid == 0 ) THEN 295 317 CALL MPI_SEND( dx, 1, MPI_REAL, target_id, 15, comm_inter, ierr ) … … 299 321 CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr) 300 322 301 323 #endif 302 324 IF ( coupling_mode == 'atmosphere_to_ocean') THEN 303 325 … … 318 340 ENDIF 319 341 342 #if .NOT. defined( __check ) 320 343 IF ( myid == 0) THEN 321 344 CALL MPI_SEND( dy, 1, MPI_REAL, target_id, 16, comm_inter, ierr ) … … 324 347 ENDIF 325 348 CALL MPI_BCAST( remote, 1, MPI_REAL, 0, comm2d, ierr) 326 349 #endif 327 350 IF ( coupling_mode == 'atmosphere_to_ocean') THEN 328 351 … … 365 388 ENDIF 366 389 367 #if defined( __parallel ) 390 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 368 391 ! 369 392 !-- Exchange via intercommunicator … … 2933 2956 ! 2934 2957 2958 #if .NOT. defined( __check ) 2935 2959 !-- Check netcdf precison 2936 2960 ldum = .FALSE. 2937 2961 CALL define_netcdf_header( 'ch', ldum, 0 ) 2938 2962 #endif 2939 2963 ! 2940 2964 !-- Check, whether a constant diffusion coefficient shall be used -
palm/trunk/SOURCE/init_grid.f90
r760 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 7 7 ! 8 8 ! Former revisions: … … 534 534 535 535 ENDIF 536 #if defined( __parallel ) 536 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 537 537 CALL MPI_BARRIER( comm2d, ierr ) 538 538 #endif … … 739 739 ENDIF 740 740 ENDDO 741 741 #if .NOT. defined ( __check ) 742 742 ! 743 743 !-- Exchange of lateral boundary values (parallel computers) and cyclic … … 766 766 767 767 ENDIF 768 768 #endif 769 769 ENDIF 770 770 771 #if .NOT. defined ( __check ) 771 772 ! 772 773 !-- Preliminary: to be removed after completion of the topography code! … … 1160 1161 nzb_tmp, vertical_influence, wall_l, wall_n, wall_r, wall_s ) 1161 1162 1163 #endif 1162 1164 1163 1165 END SUBROUTINE init_grid -
palm/trunk/SOURCE/init_masks.f90
r773 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 6 7 ! 7 8 ! Former revisions: … … 346 347 !-- Set global masks along all three dimensions (required by 347 348 !-- define_netcdf_header). 348 #if defined( __parallel ) 349 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 349 350 ! 350 351 !-- PE0 receives partial arrays from all processors of the respective mask 351 352 !-- and outputs them. Here a barrier has to be set, because otherwise 352 353 !-- "-MPI- FATAL: Remote protocol queue full" may occur. 354 353 355 CALL MPI_BARRIER( comm2d, ierr ) 354 356 … … 438 440 ENDIF 439 441 440 #el se442 #elif .NOT. defined ( __parallel ) 441 443 ! 442 444 !-- Local arrays can be relocated directly. -
palm/trunk/SOURCE/init_pegrid.f90
r781 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 7 7 ! 8 8 ! ATTENTION: nnz_x undefined problem still has to be solved!!!!!!!! … … 215 215 IF ( bc_ns /= 'cyclic' ) cyclic(2) = .FALSE. 216 216 217 218 #if .NOT. defined( __check) 217 219 ! 218 220 !-- Create the virtual processor grid … … 240 242 CALL MPI_COMM_RANK( comm1dy, myidy, ierr ) 241 243 244 #endif 242 245 243 246 ! … … 525 528 DEALLOCATE( nxlf , nxrf , nynf , nysf ) 526 529 530 531 #if .NOT. defined( __check) 527 532 ! 528 533 !-- Collect index bounds from other PEs (to be written to restart file later) … … 554 559 555 560 ENDIF 561 562 #endif 556 563 557 564 #if defined( __print ) … … 589 596 #endif 590 597 591 #if defined( __parallel ) 598 #if defined( __parallel ) .AND. .NOT. defined( __check) 592 599 #if defined( __mpi2 ) 593 600 ! … … 933 940 934 941 IF ( i == mg_switch_to_pe0_level ) THEN 935 #if defined( __parallel ) 942 #if defined( __parallel ) .AND. .NOT. defined( __check ) 936 943 ! 937 944 !-- Save the grid size of the subdomain at the switch level, because … … 966 973 ( nzt_l - nzb + 2 ) 967 974 968 #el se975 #elif .NOT. defined ( __parallel ) 969 976 message_string = 'multigrid gather/scatter impossible ' // & 970 977 'in non parallel mode' … … 1008 1015 grid_level = 0 1009 1016 1010 #if defined( __parallel ) 1017 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 1011 1018 ! 1012 1019 !-- Gridpoint number for the exchange of ghost points (y-line for 2D-arrays) … … 1091 1098 #endif 1092 1099 1093 #if defined( __parallel ) 1100 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 1094 1101 ! 1095 1102 !-- Setting of flags for inflow/outflow conditions in case of non-cyclic … … 1151 1158 comm1dx, ierr ) 1152 1159 1153 #el se1160 #elif .NOT. defined ( __parallel ) 1154 1161 IF ( bc_lr == 'dirichlet/radiation' ) THEN 1155 1162 inflow_l = .TRUE. … … 1168 1175 ENDIF 1169 1176 #endif 1177 1170 1178 ! 1171 1179 !-- At the outflow, u or v, respectively, have to be calculated for one more -
palm/trunk/SOURCE/local_stop.f90
r668 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 6 7 ! 7 8 ! Former revisions: … … 41 42 42 43 43 #if defined( __parallel ) 44 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 44 45 IF ( coupling_mode == 'uncoupled' ) THEN 45 46 IF ( abort_mode == 1 ) THEN -
palm/trunk/SOURCE/modules.f90
r806 r807 5 5 ! Current revisions: 6 6 ! ----------------- 7 ! 7 ! New cpp directive "__check" implemented which is used by check_namelist_files. 8 ! New parameter check_restart has been defined which is needed by 9 ! check_namelist_files only. 8 10 ! 9 11 ! Former revisions: … … 351 353 w_av 352 354 END MODULE averaging 353 354 355 355 356 … … 520 521 vg_vertical_gradient_level_ind(10) = -9999, & 521 522 subs_vertical_gradient_level_i(10) = -9999 523 524 #if defined ( __check ) 525 INTEGER :: check_restart = 0 526 #endif 522 527 523 528 INTEGER, DIMENSION(:), ALLOCATABLE :: grid_level_count … … 1255 1260 !------------------------------------------------------------------------------! 1256 1261 1257 #if defined( __parallel ) 1262 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 1258 1263 #if defined( __lc ) 1259 1264 USE MPI … … 1285 1290 type_x, type_x_int, type_xy, type_y, type_y_int 1286 1291 1287 INTEGER :: ibuf(12), pcoord(2), pdims(2), status(MPI_STATUS_SIZE) 1292 INTEGER :: ibuf(12), pcoord(2), pdims(2) 1293 1294 #if .NOT. defined ( __check ) 1295 INTEGER :: status(MPI_STATUS_SIZE) 1296 #endif 1297 1288 1298 1289 1299 INTEGER, DIMENSION(:), ALLOCATABLE :: ngp_yz, type_xz, type_yz -
palm/trunk/SOURCE/parin.f90
r786 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 7 7 ! 8 8 ! Former revisions: … … 255 255 !-- machines one can not distinguish between errors produced by a wrong 256 256 !-- "inipar" namelist or because this namelist is totally missing. 257 READ ( 11, inipar, ERR=10, END=11 ) 258 GOTO 12 257 READ ( 11, inipar, ERR=10, END=11 ) 258 259 #if defined ( __check ) 260 ! 261 !-- In case of a namelist file check, &inipar from the p3d file is 262 !-- used. The p3d file here must be closed and the p3df file for reading 263 !-- 3dpar is opened. 264 IF ( check_restart == 1 ) THEN 265 CALL close_file( 11 ) 266 check_restart = 2 267 CALL check_open( 11 ) 268 initializing_actions = 'read_restart_data' 269 END IF 270 #endif 271 GOTO 12 272 259 273 10 message_string = 'errors in \$inipar &or no \$inipar-namelist ' // & 260 274 'found (CRAY-machines only)' … … 268 282 !-- a prior run). All PEs are reading from file created by PE0 (see 269 283 !-- check_open) 284 285 270 286 12 IF ( TRIM( initializing_actions ) == 'read_restart_data' ) THEN 271 287 #if .NOT. defined ( __check ) 272 288 CALL read_var_list 273 289 ! … … 278 294 !-- Increment the run count 279 295 runnr = runnr + 1 280 296 #endif 281 297 ENDIF 282 298 … … 342 358 343 359 ENDIF 344 #if defined( __parallel ) 360 #if defined( __parallel ) .AND. .NOT. ( __check ) 345 361 CALL MPI_BARRIER( MPI_COMM_WORLD, ierr ) 346 362 #endif -
palm/trunk/SOURCE/poisfft.f90
r764 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 7 ! (most of the code is unneeded by check_namelist_files). 8 ! 7 9 ! 8 10 ! Former revisions: … … 106 108 107 109 PRIVATE 110 111 #if .NOT. defined ( __check ) 108 112 PUBLIC poisfft, poisfft_init 109 113 … … 115 119 MODULE PROCEDURE poisfft_init 116 120 END INTERFACE poisfft_init 121 #else 122 PUBLIC poisfft_init 123 124 INTERFACE poisfft_init 125 MODULE PROCEDURE poisfft_init 126 END INTERFACE poisfft_init 127 #endif 117 128 118 129 CONTAINS … … 124 135 END SUBROUTINE poisfft_init 125 136 126 137 #if .NOT. defined ( __check ) 127 138 SUBROUTINE poisfft( ar, work ) 128 139 … … 1581 1592 1582 1593 #endif 1583 1594 #endif 1584 1595 END MODULE poisfft_mod -
palm/trunk/SOURCE/poisfft_hybrid.f90
r668 r807 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! New cpp directive "__check" implemented which is used by check_namelist_files 7 ! (most of the code is unneeded by check_namelist_files). 6 8 ! 7 9 ! Former revisions: … … 13 15 ! 14 16 ! 415 2009-12-15 10:26:23Z raasch 15 ! Dimension of array stat in cascade change to prevent type problems with 17 ! Dimension of array stat in cascade change to prevent type problems with___ 16 18 ! mpi2 libraries 17 19 ! … … 60 62 IMPLICIT NONE 61 63 62 PRIVATE63 PUBLIC poisfft_hybrid, poisfft_hybrid_ini64 65 64 INTEGER, PARAMETER :: switch_per_lpar = 2 66 65 … … 84 83 nodes, & ! number of nodes 85 84 tasks_per_logical_node = -1 ! default no cluster 86 85 86 87 PRIVATE 88 89 90 #if .NOT. defined ( __check ) 91 PUBLIC poisfft_hybrid, poisfft_hybrid_ini 92 87 93 88 94 ! … … 117 123 MODULE PROCEDURE cascade 118 124 END INTERFACE cascade 125 #else 126 PUBLIC poisfft_hybrid_ini 127 128 ! 129 !-- Public interfaces 130 INTERFACE poisfft_hybrid_ini 131 MODULE PROCEDURE poisfft_hybrid_ini 132 END INTERFACE poisfft_hybrid_ini 133 #endif 119 134 120 135 CONTAINS 121 136 122 137 123 138 SUBROUTINE poisfft_hybrid_ini 124 139 … … 153 168 nwords = ( nxr_p-nxl_p+1 ) * nz * ( nyn_p-nys_p+1 ) 154 169 155 #if defined( __KKMP ) 170 #if defined( __KKMP ) .AND. .NOT. defined ( __check ) 156 171 CALL LOCAL_GETENV( 'OMP_NUM_THREADS', 15, cdummy, idummy ) 157 172 READ ( cdummy, '(I8)' ) n_omp_threads … … 209 224 IF ( tasks_per_logical_node >= 2 ) THEN 210 225 211 #if defined( __parallel ) 226 #if defined( __parallel ) .AND. .NOT. defined ( __check ) 212 227 nodes = ( numprocs + tasks_per_logical_node - 1 ) / & 213 228 tasks_per_logical_node … … 231 246 ! write(0,*) 'who am i',myid,me,me_node,me_task,nodes,& 232 247 ! tasks_per_logical_node 233 #el se248 #elif .NOT. defined( __parallel ) 234 249 message_string = 'parallel environment (MPI) required' 235 250 CALL message( 'poisfft_hybrid_ini', 'PA0282', 1, 2, 0, 6, 0 ) … … 239 254 END SUBROUTINE poisfft_hybrid_ini 240 255 241 256 #if .NOT. defined ( __check ) 242 257 SUBROUTINE poisfft_hybrid( ar ) 243 258 … … 1063 1078 1064 1079 END SUBROUTINE cascade 1065 1080 #endif 1066 1081 END MODULE poisfft_hybrid_mod
Note: See TracChangeset
for help on using the changeset viewer.