Changeset 108 for palm/trunk/SOURCE
- Timestamp:
- Aug 24, 2007 3:10:38 PM (17 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 16 edited
-
CURRENT_MODIFICATIONS (modified) (4 diffs)
-
check_for_restart.f90 (modified) (3 diffs)
-
check_parameters.f90 (modified) (10 diffs)
-
data_output_2d.f90 (modified) (1 diff)
-
header.f90 (modified) (5 diffs)
-
init_3d_model.f90 (modified) (4 diffs)
-
init_pegrid.f90 (modified) (6 diffs)
-
local_stop.f90 (modified) (2 diffs)
-
modules.f90 (modified) (6 diffs)
-
palm.f90 (modified) (3 diffs)
-
parin.f90 (modified) (2 diffs)
-
prandtl_fluxes.f90 (modified) (3 diffs)
-
production_e.f90 (modified) (2 diffs)
-
surface_coupler.f90 (modified) (11 diffs)
-
time_integration.f90 (modified) (4 diffs)
-
timestep.f90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/CURRENT_MODIFICATIONS
r107 r108 8 8 communication between the two models is done using the intercommunicator 9 9 comm_inter, 10 local files opened by the ocean model get the additional suffic "_O" 10 local files opened by the ocean model get the additional suffic "_O". 11 Assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean. 11 12 12 13 A momentum flux can be set as top boundary condition using the new … … 19 20 Initial profiles are reset to constant profiles in case that initializing_actions /= 'set_constant_profiles'. (init_rankine) 20 21 21 boundary_conds, check_open, check_parameters, diffusion_u, diffusion_v, flow_statistics, header, init_pegrid, init_rankine, init_3d_model, modules, palm, parin, pres, prognostic_equations, read_var_list, read_3d_binary, swap_timelevel, time_integration, write_var_list, write_3d_binary 22 Optionally calculate km and kh from initial TKE e_init. 23 24 boundary_conds, check_open, check_parameters, diffusion_u, diffusion_v, flow_statistics, header, init_pegrid, init_rankine, init_3d_model, modules, palm, parin, pres, prandtl_fluxes, prognostic_equations, read_var_list, read_3d_binary, swap_timelevel, time_integration, write_var_list, write_3d_binary 22 25 23 26 New: … … 34 37 velocity field after the first substep. 35 38 36 advec_particles, init_particles, time_integration 39 Initialization of km,kh = 0.00001 for ocean = .T. (for ocean = .F. it remains 0.01). 40 41 Allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of cloud_physics = .T.). 42 43 Modifications to terminate coupled runs. 44 45 advec_particles, check_for_restart, check_parameters, init_particles, init_3d_model, local_stop, timestep, time_integration 37 46 38 47 … … 55 64 Bugfix: Error message concerning output of particle concentration (pc) modified (check_parameters). 56 65 57 advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, boundary_conds, buoyancy, check_parameters, coriolis, diffusion_u, diffusion_v, init_pegrid, init_3d_model, modules, production_e, prognostic_equations, user_interface 66 Bugfix: Rayleigh damping for ocean fixed. 67 68 advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, boundary_conds, buoyancy, check_parameters, coriolis, diffusion_u, diffusion_v, header, init_pegrid, init_3d_model, modules, production_e, prognostic_equations, user_interface -
palm/trunk/SOURCE/check_for_restart.f90
r4 r108 4 4 ! Actual revisions: 5 5 ! ----------------- 6 ! modifications to terminate coupled runs 6 7 ! 7 8 ! … … 67 68 68 69 ! 70 !-- In case of coupled runs inform the remote model of the termination 71 !-- and its reason, provided the remote model has not already been 72 !-- informed of another termination reason (terminate_coupled > 0) before, 73 !-- or vice versa (terminate_coupled_remote > 0). 74 IF ( terminate_run .AND. TRIM( coupling_mode ) /= 'uncoupled' & 75 .AND. terminate_coupled == 0 & 76 .AND. terminate_coupled_remote == 0 ) THEN 77 terminate_coupled = 3 78 CALL MPI_SENDRECV( & 79 terminate_coupled, 1, MPI_INTEGER, myid, 0, & 80 terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, & 81 comm_inter, status, ierr ) 82 ENDIF 83 84 ! 69 85 !-- Set the stop flag also, if restart is forced by user 70 86 IF ( time_restart /= 9999999.9 .AND. time_restart < simulated_time ) & … … 89 105 PRINT*, ' new restart time is: ', time_restart, ' s' 90 106 ENDIF 91 ELSE 107 ! 108 !-- In case of coupled runs inform the remote model of the termination 109 !-- and its reason, provided the remote model has not already been 110 !-- informed of another termination reason (terminate_coupled > 0) before, 111 !-- or vice versa (terminate_coupled_remote > 0). 112 IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0 & 113 .AND. terminate_coupled_remote == 0) THEN 114 IF ( dt_restart /= 9999999.9 ) THEN 115 terminate_coupled = 4 116 ELSE 117 terminate_coupled = 5 118 ENDIF 119 CALL MPI_SENDRECV( & 120 terminate_coupled, 1, MPI_INTEGER, myid, 0, & 121 terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, & 122 comm_inter, status, ierr ) 123 ENDIF 124 ELSE 92 125 time_restart = 9999999.9 93 126 ENDIF -
palm/trunk/SOURCE/check_parameters.f90
r106 r108 9 9 ! Bugfix: Error message concerning output of particle concentration (pc) 10 10 ! modified 11 ! More checks and more default values for coupled runs 12 ! allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of 13 ! cloud_physics = .T.) 14 ! Rayleigh damping for ocean fixed. 11 15 ! 12 16 ! Former revisions: … … 76 80 CHARACTER (LEN=100) :: action 77 81 78 INTEGER :: i, ilen, intervals, iter, j, k, nnxh, nnyh, position, prec 82 INTEGER :: i, ilen, intervals, iremote = 0, iter, j, k, nnxh, nnyh, & 83 position, prec 79 84 LOGICAL :: found, ldum 80 REAL :: gradient, maxn, maxp 81 85 REAL :: gradient, maxn, maxp, remote = 0.0 82 86 83 87 ! … … 103 107 CALL local_stop 104 108 ENDIF 109 110 ! 111 !-- Check dt_coupling, restart_time, dt_restart, end_time, dx, dy, nx and ny 112 IF ( coupling_mode /= 'uncoupled' ) THEN 113 IF ( dt_coupling == 9999999.9 ) THEN 114 IF ( myid == 0 ) THEN 115 PRINT*, '+++ check_parameters:' 116 PRINT*, ' dt_coupling is not set but required for coupling ', & 117 'mode: ', TRIM( coupling_mode ) 118 ENDIF 119 CALL local_stop 120 ENDIF 121 #if defined( __parallel ) && defined( __mpi2 ) 122 CALL MPI_SEND( dt_coupling, 1, MPI_REAL, myid, 11, comm_inter, ierr ) 123 CALL MPI_RECV( remote, 1, MPI_REAL, myid, 11, comm_inter, status, ierr ) 124 IF ( dt_coupling /= remote ) THEN 125 IF ( myid == 0 ) THEN 126 PRINT*, '+++ check_parameters:' 127 PRINT*, ' TRIM( coupling_mode ): dt_coupling = ', dt_coupling 128 PRINT*, ' is not equal to dt_coupling_remote = ', remote 129 ENDIF 130 CALL local_stop 131 ENDIF 132 CALL MPI_SEND( restart_time, 1, MPI_REAL, myid, 12, comm_inter, ierr ) 133 CALL MPI_RECV( remote, 1, MPI_REAL, myid, 12, comm_inter, status, ierr ) 134 IF ( restart_time /= remote ) THEN 135 IF ( myid == 0 ) THEN 136 PRINT*, '+++ check_parameters:' 137 PRINT*, ' TRIM( coupling_mode ): restart_time = ', restart_time 138 PRINT*, ' is not equal to restart_time_remote = ', remote 139 ENDIF 140 CALL local_stop 141 ENDIF 142 CALL MPI_SEND( dt_restart, 1, MPI_REAL, myid, 13, comm_inter, ierr ) 143 CALL MPI_RECV( remote, 1, MPI_REAL, myid, 13, comm_inter, status, ierr ) 144 IF ( dt_restart /= remote ) THEN 145 IF ( myid == 0 ) THEN 146 PRINT*, '+++ check_parameters:' 147 PRINT*, ' TRIM( coupling_mode ): dt_restart = ', dt_restart 148 PRINT*, ' is not equal to dt_restart_remote = ', remote 149 ENDIF 150 CALL local_stop 151 ENDIF 152 CALL MPI_SEND( end_time, 1, MPI_REAL, myid, 14, comm_inter, ierr ) 153 CALL MPI_RECV( remote, 1, MPI_REAL, myid, 14, comm_inter, status, ierr ) 154 IF ( end_time /= remote ) THEN 155 IF ( myid == 0 ) THEN 156 PRINT*, '+++ check_parameters:' 157 PRINT*, ' TRIM( coupling_mode ): end_time = ', end_time 158 PRINT*, ' is not equal to end_time_remote = ', remote 159 ENDIF 160 CALL local_stop 161 ENDIF 162 CALL MPI_SEND( dx, 1, MPI_REAL, myid, 15, comm_inter, ierr ) 163 CALL MPI_RECV( remote, 1, MPI_REAL, myid, 15, comm_inter, status, ierr ) 164 IF ( dx /= remote ) THEN 165 IF ( myid == 0 ) THEN 166 PRINT*, '+++ check_parameters:' 167 PRINT*, ' TRIM( coupling_mode ): dx = ', dx 168 PRINT*, ' is not equal to dx_remote = ', remote 169 ENDIF 170 CALL local_stop 171 ENDIF 172 CALL MPI_SEND( dy, 1, MPI_REAL, myid, 16, comm_inter, ierr ) 173 CALL MPI_RECV( remote, 1, MPI_REAL, myid, 16, comm_inter, status, ierr ) 174 IF ( dy /= remote ) THEN 175 IF ( myid == 0 ) THEN 176 PRINT*, '+++ check_parameters:' 177 PRINT*, ' TRIM( coupling_mode ): dy = ', dy 178 PRINT*, ' is not equal to dy_remote = ', remote 179 ENDIF 180 CALL local_stop 181 ENDIF 182 CALL MPI_SEND( nx, 1, MPI_INTEGER, myid, 17, comm_inter, ierr ) 183 CALL MPI_RECV( iremote, 1, MPI_INTEGER, myid, 17, comm_inter, status, & 184 ierr ) 185 IF ( nx /= iremote ) THEN 186 IF ( myid == 0 ) THEN 187 PRINT*, '+++ check_parameters:' 188 PRINT*, ' TRIM( coupling_mode ): nx = ', nx 189 PRINT*, ' is not equal to nx_remote = ', iremote 190 ENDIF 191 CALL local_stop 192 ENDIF 193 CALL MPI_SEND( ny, 1, MPI_INTEGER, myid, 18, comm_inter, ierr ) 194 CALL MPI_RECV( iremote, 1, MPI_INTEGER, myid, 18, comm_inter, status, & 195 ierr ) 196 IF ( ny /= iremote ) THEN 197 IF ( myid == 0 ) THEN 198 PRINT*, '+++ check_parameters:' 199 PRINT*, ' TRIM( coupling_mode ): ny = ', ny 200 PRINT*, ' is not equal to ny_remote = ', iremote 201 ENDIF 202 CALL local_stop 203 ENDIF 204 #endif 205 ENDIF 206 207 #if defined( __parallel ) && defined( __mpi2 ) 208 ! 209 !-- Exchange via intercommunicator 210 IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN 211 CALL MPI_SEND( humidity, & 212 1, MPI_LOGICAL, myid, 19, comm_inter, ierr ) 213 ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN 214 CALL MPI_RECV( humidity_remote, & 215 1, MPI_LOGICAL, myid, 19, comm_inter, status, ierr ) 216 ENDIF 217 #endif 218 105 219 106 220 ! … … 821 935 822 936 ! 823 !-- Ocean version is using flux boundary conditions at the top 824 IF ( ocean ) use_top_fluxes = .TRUE. 937 !-- Ocean version must use flux boundary conditions at the top 938 IF ( ocean .AND. .NOT. use_top_fluxes ) THEN 939 IF ( myid == 0 ) PRINT*, '+++ check_parameters: use_top_fluxes ',& 940 'must be .TRUE. in ocean version' 941 CALL local_stop 942 ENDIF 825 943 826 944 ! … … 1256 1374 CALL local_stop 1257 1375 ENDIF 1258 IF ( bc_uv_t == 'dirichlet' ) THEN 1259 ibc_uv_t = 0 1260 ELSEIF ( bc_uv_t == 'neumann' ) THEN 1376 IF ( coupling_mode == 'ocean_to_atmosphere' ) THEN 1377 bc_uv_t = 'neumann' 1261 1378 ibc_uv_t = 1 1262 1379 ELSE 1263 IF ( myid == 0 ) THEN 1264 PRINT*, '+++ check_parameters:' 1265 PRINT*, ' unknown boundary condition: bc_uv_t = ', bc_uv_t 1266 ENDIF 1267 CALL local_stop 1380 IF ( bc_uv_t == 'dirichlet' ) THEN 1381 ibc_uv_t = 0 1382 ELSEIF ( bc_uv_t == 'neumann' ) THEN 1383 ibc_uv_t = 1 1384 ELSE 1385 IF ( myid == 0 ) THEN 1386 PRINT*, '+++ check_parameters:' 1387 PRINT*, ' unknown boundary condition: bc_uv_t = ', bc_uv_t 1388 ENDIF 1389 CALL local_stop 1390 ENDIF 1268 1391 ENDIF 1269 1392 … … 1289 1412 1290 1413 IF ( rayleigh_damping_height == -1.0 ) THEN 1291 rayleigh_damping_height = 0.66666666666 * zu(nzt) 1414 IF ( .NOT. ocean ) THEN 1415 rayleigh_damping_height = 0.66666666666 * zu(nzt) 1416 ELSE 1417 rayleigh_damping_height = 0.66666666666 * zu(nzb) 1418 ENDIF 1292 1419 ELSE 1293 IF ( rayleigh_damping_height < 0.0 .OR. & 1294 rayleigh_damping_height > zu(nzt) ) THEN 1295 IF ( myid == 0 ) THEN 1296 PRINT*, '+++ check_parameters:' 1297 PRINT*, ' rayleigh_damping_height = ', rayleigh_damping_height,& 1298 ' out of range [0.0,', zu(nzt), ']' 1299 ENDIF 1300 CALL local_stop 1420 IF ( .NOT. ocean ) THEN 1421 IF ( rayleigh_damping_height < 0.0 .OR. & 1422 rayleigh_damping_height > zu(nzt) ) THEN 1423 IF ( myid == 0 ) THEN 1424 PRINT*, '+++ check_parameters:' 1425 PRINT*, ' rayleigh_damping_height = ', rayleigh_damping_height,& 1426 ' out of range [0.0,', zu(nzt), ']' 1427 ENDIF 1428 CALL local_stop 1429 ENDIF 1430 ELSE 1431 IF ( rayleigh_damping_height > 0.0 .OR. & 1432 rayleigh_damping_height < zu(nzb) ) THEN 1433 IF ( myid == 0 ) THEN 1434 PRINT*, '+++ check_parameters:' 1435 PRINT*, ' rayleigh_damping_height = ', rayleigh_damping_height,& 1436 ' out of range [0.0,', zu(nzb), ']' 1437 ENDIF 1438 CALL local_stop 1439 ENDIF 1301 1440 ENDIF 1302 1441 ENDIF … … 1695 1834 1696 1835 CASE ( 'q', '#q' ) 1697 IF ( .NOT. cloud_physics) THEN1836 IF ( .NOT. humidity ) THEN 1698 1837 IF ( myid == 0 ) THEN 1699 1838 PRINT*, '+++ check_parameters: data_output_pr = ', & 1700 1839 data_output_pr(i), & 1701 ' is not implemented for cloud_physics= FALSE'1840 ' is not implemented for humidity = FALSE' 1702 1841 ENDIF 1703 1842 CALL local_stop … … 1804 1943 1805 1944 CASE ( 'w"q"' ) 1806 IF ( .NOT. cloud_physics )THEN1945 IF ( .NOT. humidity ) THEN 1807 1946 IF ( myid == 0 ) THEN 1808 1947 PRINT*, '+++ check_parameters: data_output_pr = ', & 1809 1948 data_output_pr(i), & 1810 ' is not implemented for cloud_physics= FALSE'1949 ' is not implemented for humidity = FALSE' 1811 1950 ENDIF 1812 1951 CALL local_stop … … 1818 1957 1819 1958 CASE ( 'w*q*' ) 1820 IF ( .NOT. cloud_physics )THEN1959 IF ( .NOT. humidity ) THEN 1821 1960 IF ( myid == 0 ) THEN 1822 1961 PRINT*, '+++ check_parameters: data_output_pr = ', & 1823 1962 data_output_pr(i), & 1824 ' is not implemented for cloud_physics= FALSE'1963 ' is not implemented for humidity = FALSE' 1825 1964 ENDIF 1826 1965 CALL local_stop … … 1832 1971 1833 1972 CASE ( 'wq' ) 1834 IF ( .NOT. cloud_physics )THEN1973 IF ( .NOT. humidity ) THEN 1835 1974 IF ( myid == 0 ) THEN 1836 1975 PRINT*, '+++ check_parameters: data_output_pr = ', & 1837 1976 data_output_pr(i), & 1838 ' is not implemented for cloud_physics= FALSE'1977 ' is not implemented for humidity = FALSE' 1839 1978 ENDIF 1840 1979 CALL local_stop -
palm/trunk/SOURCE/data_output_2d.f90
r98 r108 732 732 CASE ( 'xz' ) 733 733 ! 734 !-- Update the NetCDF x ycross section time axis734 !-- Update the NetCDF xz cross section time axis 735 735 IF ( myid == 0 ) THEN 736 736 IF ( simulated_time /= do2d_xz_last_time(av) ) THEN -
palm/trunk/SOURCE/header.f90
r103 r108 6 6 ! Output of informations for coupled model runs (boundary conditions etc.) 7 7 ! + output of momentumfluxes at the top boundary 8 ! Rayleigh damping for ocean, e_init 8 9 ! 9 10 ! Former revisions: … … 241 242 IF ( use_upstream_for_tke ) WRITE ( io, 143 ) 242 243 IF ( rayleigh_damping_factor /= 0.0 ) THEN 243 WRITE ( io, 123 ) rayleigh_damping_height, rayleigh_damping_factor 244 IF ( .NOT. ocean ) THEN 245 WRITE ( io, 123 ) 'above', rayleigh_damping_height, & 246 rayleigh_damping_factor 247 ELSE 248 WRITE ( io, 123 ) 'below', rayleigh_damping_height, & 249 rayleigh_damping_factor 250 ENDIF 244 251 ENDIF 245 252 IF ( humidity ) THEN … … 1091 1098 ENDIF 1092 1099 IF ( .NOT. constant_diffusion) THEN 1100 IF ( e_init > 0.0 ) WRITE ( io, 455 ) e_init 1093 1101 IF ( e_min > 0.0 ) WRITE ( io, 454 ) e_min 1094 1102 IF ( wall_adjustment ) WRITE ( io, 453 ) wall_adjustment_factor … … 1240 1248 ' timestep changes') 1241 1249 122 FORMAT (' --> Time differencing scheme: ',A) 1242 123 FORMAT (' --> Rayleigh-Damping active, starts abovez = ',F8.2,' m'/ &1250 123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ & 1243 1251 ' maximum damping coefficient: ',F5.3, ' 1/s') 1244 1252 124 FORMAT (' Spline-overshoots are being suppressed') … … 1468 1476 453 FORMAT (' Mixing length is limited to ',F4.2,' * z') 1469 1477 454 FORMAT (' TKE is not allowed to fall below ',E9.2,' (m/s)**2') 1478 455 FORMAT (' initial TKE is prescribed as ',E9.2,' (m/s)**2') 1470 1479 470 FORMAT (//' Actions during the simulation:'/ & 1471 1480 ' -----------------------------'/) -
palm/trunk/SOURCE/init_3d_model.f90
r106 r108 9 9 ! Flux initialization in case of coupled runs, +momentum fluxes at top boundary, 10 10 ! +arrays for phase speed c_u, c_v, c_w, indices for u|v|w_m_l|r changed 11 ! +qswst_remote in case of atmosphere model with humidity coupled to ocean 12 ! Rayleigh damping for ocean 13 ! optionally calculate km and kh from initial TKE e_init 11 14 ! 12 15 ! Former revisions: … … 204 207 rho => rho_1 ! routine calc_mean_profile requires density to be a 205 208 ! pointer 209 IF ( humidity_remote ) THEN 210 ALLOCATE( qswst_remote(nys-1:nyn+1,nxl-1:nxr+1) ) 211 qswst_remote = 0.0 212 ENDIF 206 213 ENDIF 207 214 … … 507 514 km = km_constant 508 515 kh = km / prandtl_number 516 e = 0.0 517 ELSEIF ( e_init > 0.0 ) THEN 518 DO k = nzb+1, nzt 519 km(k,:,:) = 0.1 * l_grid(k) * SQRT( e_init ) 520 ENDDO 521 km(nzb,:,:) = km(nzb+1,:,:) 522 km(nzt+1,:,:) = km(nzt,:,:) 523 kh = km / prandtl_number 524 e = e_init 509 525 ELSE 510 kh = 0.01 ! there must exist an initial diffusion, because 511 km = 0.01 ! otherwise no TKE would be produced by the 512 ! production terms, as long as not yet 513 ! e = (u*/cm)**2 at k=nzb+1 514 ENDIF 515 e = 0.0 526 IF ( .NOT. ocean ) THEN 527 kh = 0.01 ! there must exist an initial diffusion, because 528 km = 0.01 ! otherwise no TKE would be produced by the 529 ! production terms, as long as not yet 530 ! e = (u*/cm)**2 at k=nzb+1 531 ELSE 532 kh = 0.00001 533 km = 0.00001 534 ENDIF 535 e = 0.0 536 ENDIF 516 537 rif = 0.0 517 538 ts = 0.0 … … 892 913 rdf = 0.0 893 914 IF ( rayleigh_damping_factor /= 0.0 ) THEN 894 DO k = nzb+1, nzt 895 IF ( zu(k) >= rayleigh_damping_height ) THEN 896 rdf(k) = rayleigh_damping_factor * & 915 IF ( .NOT. ocean ) THEN 916 DO k = nzb+1, nzt 917 IF ( zu(k) >= rayleigh_damping_height ) THEN 918 rdf(k) = rayleigh_damping_factor * & 897 919 ( SIN( pi * 0.5 * ( zu(k) - rayleigh_damping_height ) & 898 920 / ( zu(nzt) - rayleigh_damping_height ) )& 899 921 )**2 900 ENDIF 901 ENDDO 922 ENDIF 923 ENDDO 924 ELSE 925 DO k = nzt, nzb+1, -1 926 IF ( zu(k) <= rayleigh_damping_height ) THEN 927 rdf(k) = rayleigh_damping_factor * & 928 ( SIN( pi * 0.5 * ( rayleigh_damping_height - zu(k) ) & 929 / ( rayleigh_damping_height - zu(nzb+1)))& 930 )**2 931 ENDIF 932 ENDDO 933 ENDIF 902 934 ENDIF 903 935 -
palm/trunk/SOURCE/init_pegrid.f90
r106 r108 4 4 ! Actual revisions: 5 5 ! ----------------- 6 ! TEST OUTPUT (TO BE REMOVED) logging mpi2 ierr values 6 7 ! Intercommunicator (comm_inter) and derived data type (type_xy) for 7 ! coupled model runs created, 8 ! coupled model runs created, assign coupling_mode_remote 8 9 ! indices nxlu and nysv are calculated (needed for non-cyclic boundary 9 10 ! conditions) … … 467 468 468 469 ! 469 !-- Rec ieve data from the other PEs470 !-- Receive data from the other PEs 470 471 DO i = 1,numprocs-1 471 472 CALL MPI_RECV( ibuf, 12, MPI_INTEGER, i, MPI_ANY_TAG, comm2d, status, & … … 494 495 495 496 CALL MPI_OPEN_PORT( MPI_INFO_NULL, port_name, ierr ) 497 ! 498 !-- TEST OUTPUT (TO BE REMOVED) 499 WRITE(9,*) TRIM( coupling_mode ), & 500 ', ierr after MPI_OPEN_PORT: ', ierr 501 CALL LOCAL_FLUSH( 9 ) 502 496 503 CALL MPI_PUBLISH_NAME( 'palm_coupler', MPI_INFO_NULL, port_name, & 497 504 ierr ) 505 ! 506 !-- TEST OUTPUT (TO BE REMOVED) 507 WRITE(9,*) TRIM( coupling_mode ), & 508 ', ierr after MPI_PUBLISH_NAME: ', ierr 509 CALL LOCAL_FLUSH( 9 ) 510 498 511 ! 499 512 !-- Write a flag file for the ocean model and the other atmosphere … … 519 532 520 533 CALL MPI_LOOKUP_NAME( 'palm_coupler', MPI_INFO_NULL, port_name, ierr ) 534 ! 535 !-- TEST OUTPUT (TO BE REMOVED) 536 WRITE(9,*) TRIM( coupling_mode ), & 537 ', ierr after MPI_LOOKUP_NAME: ', ierr 538 CALL LOCAL_FLUSH( 9 ) 539 521 540 522 541 ENDIF … … 535 554 print*, '--- ierr = ', ierr 536 555 print*, '--- comm_inter atmosphere = ', comm_inter 556 557 coupling_mode_remote = 'ocean_to_atmosphere' 537 558 538 559 ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN … … 544 565 print*, '--- ierr = ', ierr 545 566 print*, '--- comm_inter ocean = ', comm_inter 567 568 coupling_mode_remote = 'atmosphere_to_ocean' 546 569 547 570 ENDIF -
palm/trunk/SOURCE/local_stop.f90
r4 r108 4 4 ! Actual revisions: 5 5 ! ----------------- 6 ! modifications to terminate coupled runs 6 7 ! 7 8 ! … … 24 25 25 26 USE pegrid 27 USE control_parameters 26 28 27 29 #if defined( __parallel ) 28 CALL MPI_FINALIZE( ierr ) 29 #endif 30 IF ( coupling_mode == 'uncoupled' ) THEN 31 CALL MPI_FINALIZE( ierr ) 32 ELSE 33 34 SELECT CASE ( terminate_coupled_remote ) 35 36 CASE ( 0 ) 37 IF ( myid == 0 ) THEN 38 PRINT*, '+++ local_stop:' 39 PRINT*, ' local model "', TRIM( coupling_mode ), & 40 '" stops now' 41 ENDIF 42 ! 43 !-- Inform the remote model of the termination and its reason, provided 44 !-- the remote model has not already been informed of another 45 !-- termination reason (terminate_coupled > 0) before. 46 IF ( terminate_coupled == 0 ) THEN 47 terminate_coupled = 1 48 CALL MPI_SENDRECV( & 49 terminate_coupled, 1, MPI_INTEGER, myid, 0, & 50 terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, & 51 comm_inter, status, ierr ) 52 ENDIF 53 CALL MPI_FINALIZE( ierr ) 54 55 CASE ( 1 ) 56 IF ( myid == 0 ) THEN 57 PRINT*, '+++ local_stop:' 58 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 59 '" stopped' 60 ENDIF 61 CALL MPI_FINALIZE( ierr ) 62 63 CASE ( 2 ) 64 IF ( myid == 0 ) THEN 65 PRINT*, '+++ local_stop:' 66 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 67 '" terminated' 68 PRINT*, ' with stop_dt = .T.' 69 ENDIF 70 stop_dt = .TRUE. 71 72 CASE ( 3 ) 73 IF ( myid == 0 ) THEN 74 PRINT*, '+++ local_stop:' 75 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 76 '" terminated' 77 PRINT*, ' with terminate_run = .T. (CPU-time limit)' 78 ENDIF 79 terminate_run = .TRUE. 80 81 CASE ( 4 ) 82 IF ( myid == 0 ) THEN 83 PRINT*, '+++ local_stop:' 84 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 85 '" terminated' 86 PRINT*, ' with terminate_run = .T. (restart)' 87 ENDIF 88 terminate_run = .TRUE. 89 time_restart = time_restart + dt_restart 90 91 CASE ( 5 ) 92 IF ( myid == 0 ) THEN 93 PRINT*, '+++ local_stop:' 94 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 95 '" terminated' 96 PRINT*, ' with terminate_run = .T. (single restart)' 97 ENDIF 98 terminate_run = .TRUE. 99 time_restart = 9999999.9 100 101 END SELECT 102 103 ENDIF 104 105 #else 30 106 31 107 STOP 32 108 109 #endif 110 33 111 END SUBROUTINE local_stop -
palm/trunk/SOURCE/modules.f90
r106 r108 6 6 ! ----------------- 7 7 ! +comm_inter, constant_top_momentumflux, coupling_char, coupling_mode, 8 ! c_u, c_v, c_w, dt_coupling, ngp_xy, nxlu, nysv, port_name, time_coupling, 9 ! top_momentumflux_u|v, type_xy, uswst*, vswst* 8 ! coupling_mode_remote, c_u, c_v, c_w, dt_coupling, e_init, humidity_remote, 9 ! ngp_xy, nxlu, nysv, port_name, qswst_remote, terminate_coupled, 10 ! terminate_coupled_remote, time_coupling, top_momentumflux_u|v, type_xy, 11 ! uswst*, vswst* 10 12 ! 11 13 ! Former revisions: … … 106 108 REAL, DIMENSION(:,:), ALLOCATABLE :: & 107 109 c_u, c_v, c_w, dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg, pt_slope_ref, & 108 qs, ts, us, z0110 qs, qswst_remote, ts, us, z0 109 111 110 112 REAL, DIMENSION(:,:), ALLOCATABLE, TARGET :: & … … 253 255 bc_uv_b = 'dirichlet', bc_uv_t = 'dirichlet', & 254 256 coupling_mode = 'uncoupled', & 257 coupling_mode_remote = 'uncoupled', & 255 258 dissipation_1d = 'as_in_3d_model', & 256 259 fft_method = 'system-specific', & … … 292 295 nz_do1d, nz_do3d = -9999, outflow_damping_width = -1, & 293 296 prt_time_count = 0, runnr = 0, skip_do_avs = 0, & 297 terminate_coupled = 0, terminate_coupled_remote = 0, & 294 298 timestep_count = 0 295 299 … … 323 327 first_call_advec_particles = .TRUE., & 324 328 force_print_header = .FALSE., galilei_transformation = .FALSE.,& 325 humidity = .FALSE., inflow_l = .FALSE., inflow_n = .FALSE., & 329 humidity = .FALSE., humidity_remote = .FALSE., & 330 inflow_l = .FALSE., inflow_n = .FALSE., & 326 331 inflow_r = .FALSE., inflow_s = .FALSE., iso2d_output = .FALSE.,& 327 332 mg_switch_to_pe0 = .FALSE., & … … 366 371 dt_run_control = 60.0, dt_3d = -1.0, dz = -1.0, & 367 372 dz_max = 9999999.9, dz_stretch_factor = 1.08, & 368 dz_stretch_level = 100000.0, e_min = 0.0, end_time = 0.0, & 373 dz_stretch_level = 100000.0, e_init = 0.0, e_min = 0.0, & 374 end_time = 0.0, & 369 375 f = 0.0, fs = 0.0, g = 9.81, kappa = 0.4, km_constant = -1.0, & 370 376 km_damp_max = -1.0, long_filter_factor = 0.0, & -
palm/trunk/SOURCE/palm.f90
r102 r108 5 5 ! ----------------- 6 6 ! Get coupling mode from environment variable 7 ! Change localtion of debug output 7 8 ! 8 9 ! Former revisions: … … 101 102 CALL MPI_COMM_RANK( comm_palm, myid, ierr ) 102 103 #endif 103 CALL init_dvrp_logging104 105 !106 !-- Read control parameters from NAMELIST files and read environment-variables107 CALL parin108 109 !110 !-- Determine processor topology and local array indices111 CALL init_pegrid112 104 113 105 ! 114 106 !-- Open a file for debug output 107 WRITE (myid_char,'(''_'',I4.4)') myid 115 108 OPEN( 9, FILE='DEBUG'//TRIM( coupling_char )//myid_char, FORM='FORMATTED' ) 116 109 … … 122 115 print*, '*** PE', myid, ' ', TRIM( coupling_mode ) 123 116 #endif 117 118 CALL init_dvrp_logging 119 120 ! 121 !-- Read control parameters from NAMELIST files and read environment-variables 122 CALL parin 123 124 ! 125 !-- Determine processor topology and local array indices 126 CALL init_pegrid 124 127 125 128 ! -
palm/trunk/SOURCE/parin.f90
r102 r108 4 4 ! Actual revisions: 5 5 ! ----------------- 6 ! + top_momentumflux_u|v in inipar, +dt_coupling in d3par6 ! +e_init, top_momentumflux_u|v in inipar, +dt_coupling in d3par 7 7 ! 8 8 ! Former revisions: … … 72 72 conserve_volume_flow, cut_spline_overshoot, damp_level_1d, & 73 73 dissipation_1d, dt, dt_pr_1d, dt_run_control_1d, dx, dy, dz, & 74 dz_max, dz_stretch_factor, dz_stretch_level, e_min, end_time_1d, & 74 dz_max, dz_stretch_factor, dz_stretch_level, e_init, e_min, & 75 end_time_1d, & 75 76 fft_method, galilei_transformation, grid_matching, humidity, & 76 77 inflow_disturbance_begin, inflow_disturbance_end, & -
palm/trunk/SOURCE/prandtl_fluxes.f90
r77 r108 4 4 ! Actual revisions: 5 5 ! ----------------- 6 ! 6 ! assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean 7 7 ! 8 8 ! Former revisions: … … 36 36 37 37 INTEGER :: i, j, k 38 REAL :: a, b, rifm, uv_total, z_p38 REAL :: a, b, e_q, rifm, uv_total, z_p 39 39 40 40 ! … … 297 297 z_p = zu(k+1) - zw(k) 298 298 299 ! 300 !-- assume saturation for atmosphere coupled to ocean 301 IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN 302 e_q = 6.1 * & 303 EXP( 0.07 * ( MIN(pt(0,j,i),pt(1,j,i)) - 273.15 ) ) 304 q(k,j,i) = 0.622 * e_q / ( surface_pressure - e_q ) 305 ENDIF 299 306 IF ( rif(j,i) >= 0.0 ) THEN 300 307 ! -
palm/trunk/SOURCE/production_e.f90
r106 r108 8 8 ! u_0 and v_0 are calculated for nxr+1, nyn+1 also (otherwise these values are 9 9 ! not available in case of non-cyclic boundary conditions) 10 ! Bugfix for ocean density flux at bottom 10 11 ! 11 12 ! Former revisions: … … 810 811 !-- So far in the ocean no special treatment of density flux in the 811 812 !-- bottom and top surface layer 812 DO k = nzb_s_inner(j,i), nzt 813 k= nzb_s_inner(j,i) 814 tend(k,j,i) = tend(k,j,i) + kh(k,j,i) * g / prho_reference * & 815 ( rho(k+1,j,i) - rho(k,j,i) ) * dzu(k+1) 816 DO k = nzb_s_inner(j,i)+1, nzt 813 817 tend(k,j,i) = tend(k,j,i) + kh(k,j,i) * g / prho_reference * & 814 818 ( rho(k+1,j,i) - rho(k-1,j,i) ) * dd2zu(k) -
palm/trunk/SOURCE/surface_coupler.f90
r102 r108 4 4 ! Actual revisions: 5 5 ! ----------------- 6 ! include latent heatflux and salinity flux for atmosphere runs with moisture 7 ! modifications to terminate coupled runs 6 8 ! 7 9 ! … … 27 29 IMPLICIT NONE 28 30 29 INTEGER :: k31 INTEGER :: i, j, k 30 32 31 33 REAL :: simulated_time_remote … … 36 38 37 39 ! 38 !-- First exchange the current simulated time between the models, 40 !-- In case of model termination initiated by the remote model 41 !-- (terminate_coupled_remote > 0), initiate termination of the local model. 42 !-- The rest of the coupler must then be skipped because it would cause an MPI 43 !-- intercomminucation hang. 44 !-- If necessary, the coupler will be called at the beginning of the next 45 !-- restart run. 46 CALL MPI_SENDRECV( terminate_coupled, 1, MPI_INTEGER, myid, 0, & 47 terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, & 48 comm_inter, status, ierr ) 49 IF ( terminate_coupled_remote > 0 ) THEN 50 IF ( myid == 0 ) THEN 51 PRINT*, '+++ surface_coupler:' 52 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 53 '" terminated' 54 PRINT*, ' with terminate_coupled_remote = ', & 55 terminate_coupled_remote 56 PRINT*, ' local model "', TRIM( coupling_mode ), & 57 '" has' 58 PRINT*, ' terminate_coupled = ', & 59 terminate_coupled 60 ENDIF 61 CALL local_stop 62 RETURN 63 ENDIF 64 ! 65 !-- Exchange the current simulated time between the models, 39 66 !-- currently just for testing 40 67 CALL MPI_SEND( simulated_time, 1, MPI_REAL, myid, 11, comm_inter, ierr ) … … 58 85 59 86 ! 87 !-- Send humidity flux at bottom surface to the ocean model 88 IF ( humidity ) THEN 89 WRITE ( 9, * ) '*** send qsws to ocean' 90 CALL local_flush( 9 ) 91 CALL MPI_SEND( qsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 13, & 92 comm_inter, ierr ) 93 WRITE ( 9, * ) ' ready' 94 CALL local_flush( 9 ) 95 ENDIF 96 97 ! 60 98 !-- Receive temperature at the bottom surface from the ocean model 61 99 WRITE ( 9, * ) '*** receive pt from ocean' 62 100 CALL local_flush( 9 ) 63 CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, myid, 1 3, comm_inter, &101 CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, & 64 102 status, ierr ) 65 103 WRITE ( 9, * ) ' ready' … … 70 108 WRITE ( 9, * ) '*** send usws to ocean' 71 109 CALL local_flush( 9 ) 72 CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 1 4, &110 CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, & 73 111 comm_inter, ierr ) 74 112 WRITE ( 9, * ) ' ready' … … 79 117 WRITE ( 9, * ) '*** send vsws to ocean' 80 118 CALL local_flush( 9 ) 81 CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 1 5, &119 CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, & 82 120 comm_inter, ierr ) 83 121 WRITE ( 9, * ) ' ready' … … 96 134 97 135 ! 136 !-- Receive humidity flux from the atmosphere model (bottom) 137 !-- and add it to the heat flux at the sea surface (top)... 138 IF ( humidity_remote ) THEN 139 WRITE ( 9, * ) '*** receive qswst_remote from atmosphere' 140 CALL local_flush( 9 ) 141 CALL MPI_RECV( qswst_remote(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, & 142 13, comm_inter, status, ierr ) 143 WRITE ( 9, * ) ' ready' 144 CALL local_flush( 9 ) 145 146 tswst = tswst + qswst_remote * 2.2626108e6 147 !latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol 148 ! 149 !-- ...and convert it to a salinity flux at the sea surface (top) 150 !-- following Steinhorn (1991), JPO 21, pp. 1681-1683: 151 !-- S'w' = -S * evaporation / ( rho_water * ( 1 - S ) ) 152 saswst = -1.0 * sa(nzt,:,:) * qswst_remote / & 153 ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) ) 154 ENDIF 155 156 ! 98 157 !-- Adjust the kinematic heat flux with respect to ocean density 99 158 !-- (constants are the specific heat capacities for air and water) 100 tswst = tswst / rho _surface* 1005.0 / 4218.0159 tswst = tswst / rho(nzt,:,:) * 1005.0 / 4218.0 101 160 102 161 ! … … 104 163 WRITE ( 9, * ) '*** send pt to atmosphere' 105 164 CALL local_flush( 9 ) 106 CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 1 3, comm_inter, &165 CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, & 107 166 ierr ) 108 167 WRITE ( 9, * ) ' ready' … … 114 173 WRITE ( 9, * ) '*** receive uswst from atmosphere' 115 174 CALL local_flush( 9 ) 116 CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 1 4, &175 CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, & 117 176 comm_inter, status, ierr ) 118 177 WRITE ( 9, * ) ' ready' … … 124 183 WRITE ( 9, * ) '*** receive vswst from atmosphere' 125 184 CALL local_flush( 9 ) 126 CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 1 5, &185 CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, & 127 186 comm_inter, status, ierr ) 128 187 WRITE ( 9, * ) ' ready' … … 131 190 ! 132 191 !-- Adjust the momentum fluxes with respect to ocean density 133 uswst = uswst / rho _surface134 vswst = vswst / rho _surface192 uswst = uswst / rho(nzt,:,:) 193 vswst = vswst / rho(nzt,:,:) 135 194 136 195 ENDIF -
palm/trunk/SOURCE/time_integration.f90
r106 r108 9 9 ! random perturbation has to be added to the velocity fields also after the 10 10 ! first substep 11 ! modifications to terminate coupled runs 12 ! 11 13 ! 12 14 ! Former revisions: … … 78 80 CALL run_control 79 81 82 ! 83 !-- Data exchange between coupled models in case that a call has been omitted 84 !-- at the end of the previous run of a job chain. 85 IF ( coupling_mode /= 'uncoupled' ) THEN 86 ! 87 !-- In case of model termination initiated by the local model the coupler 88 !-- must not be called because this would again cause an MPI hang. 89 DO WHILE ( time_coupling >= dt_coupling .AND. terminate_coupled == 0 ) 90 CALL surface_coupler 91 time_coupling = time_coupling - dt_coupling 92 ENDDO 93 ENDIF 94 95 80 96 #if defined( __dvrp_graphics ) 81 97 ! … … 306 322 IF ( coupling_mode /= 'uncoupled' ) THEN 307 323 time_coupling = time_coupling + dt_3d 308 DO WHILE ( time_coupling >= dt_coupling ) 324 ! 325 !-- In case of model termination initiated by the local model 326 !-- (terminate_coupled > 0), the coupler must be skipped because it would 327 !-- cause an MPI intercomminucation hang. 328 !-- If necessary, the coupler will be called at the beginning of the 329 !-- next restart run. 330 DO WHILE ( time_coupling >= dt_coupling .AND. terminate_coupled == 0 ) 309 331 CALL surface_coupler 310 332 time_coupling = time_coupling - dt_coupling … … 327 349 !-- Check, if restart is necessary (because cpu-time is expiring or 328 350 !-- because it is forced by user) and set stop flag 329 CALL check_for_restart 351 !-- This call is skipped if the remote model has already initiated a restart. 352 IF ( .NOT. terminate_run ) CALL check_for_restart 330 353 331 354 ! -
palm/trunk/SOURCE/timestep.f90
r4 r108 4 4 ! Actual revisions: 5 5 ! ----------------- 6 ! modifications to terminate coupled runs 6 7 ! 7 8 ! … … 192 193 IF ( dt_3d < ( 0.00001 * dt_max ) ) THEN 193 194 stop_dt = .TRUE. 195 194 196 IF ( myid == 0 ) THEN 195 197 PRINT*,'+++ time_step: Time step has reached minimum limit.' … … 207 209 ' j=', w_max_ijk(2), ' i=', w_max_ijk(3) 208 210 ENDIF 211 ! 212 !-- In case of coupled runs inform the remote model of the termination 213 !-- and its reason, provided the remote model has not already been 214 !-- informed of another termination reason (terminate_coupled > 0) before. 215 IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0 ) THEN 216 terminate_coupled = 2 217 CALL MPI_SENDRECV( & 218 terminate_coupled, 1, MPI_INTEGER, myid, 0, & 219 terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, & 220 comm_inter, status, ierr ) 221 ENDIF 222 209 223 ENDIF 210 224
Note: See TracChangeset
for help on using the changeset viewer.
