Changeset 4677
- Timestamp:
- Sep 14, 2020 7:55:28 AM (4 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 9 edited
-
Makefile (modified) (2 diffs)
-
local_stop.f90 (modified) (10 diffs)
-
local_system.f90 (modified) (3 diffs)
-
local_tremain.f90 (modified) (3 diffs)
-
local_tremain_ini.f90 (modified) (2 diffs)
-
message.f90 (modified) (11 diffs)
-
mod_kinds.f90 (modified) (2 diffs)
-
mod_particle_attributes.f90 (modified) (7 diffs)
-
model_1d_mod.f90 (modified) (47 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r4655 r4677 1 #-------------------------------------------------------------------------------- #1 #--------------------------------------------------------------------------------------------------# 2 2 # This file is part of the PALM model system. 3 3 # 4 # PALM is free software: you can redistribute it and/or modify it under the terms 5 # of the GNU General Public License as published by the Free Software Foundation,6 # either version 3 of the License, or(at your option) any later version.7 # 8 # PALM is distributed in the hope that it will be useful, but WITHOUT ANY 9 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR10 # A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.11 # 12 # You should have received a copy of the GNU General Public License along with 13 # PALM. If not, see<http://www.gnu.org/licenses/>.4 # PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 5 # Public License as published by the Free Software Foundation, either version 3 of the License, or 6 # (at your option) any later version. 7 # 8 # PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 9 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 10 # Public License for more details. 11 # 12 # You should have received a copy of the GNU General Public License along with PALM. If not, see 13 # <http://www.gnu.org/licenses/>. 14 14 # 15 15 # Copyright 1997-2020 Leibniz Universitaet Hannover 16 #-------------------------------------------------------------------------------- #16 #--------------------------------------------------------------------------------------------------# 17 17 # 18 18 # WARNING: don't write filenames with extension .f90 in this header!!!! … … 25 25 # ----------------- 26 26 # $Id$ 27 # file re-formatted to follow the PALM coding standard 28 # 29 # 4655 2020-08-28 14:28:34Z pavelkrc 27 30 # Bugfix: Add possibility to output surface data during spinup 28 31 # -
palm/trunk/SOURCE/local_stop.f90
r4564 r4677 1 1 !> @file local_stop.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 9 8 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 13 12 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see<http://www.gnu.org/licenses/>.13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: 21 20 ! ----------------- 22 ! 23 ! 21 ! 22 ! 24 23 ! Former revisions: 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4564 2020-06-12 14:03:36Z raasch 27 29 ! Vertical nesting method of Huq et al. (2019) removed 28 ! 30 ! 29 31 ! 4444 2020-03-05 15:59:50Z raasch 30 32 ! bugfix: misplaced cpp-directive moved 31 ! 33 ! 32 34 ! 4360 2020-01-07 11:25:50Z suehring 33 35 ! Corrected "Former revisions" section 34 ! 36 ! 35 37 ! 3655 2019-01-07 16:51:22Z knoop 36 38 ! Added an empty output string to stop keywords to clean up job protocol … … 43 45 ! ------------ 44 46 !> Stop program execution 45 !------------------------------------------------------------------------------ !47 !--------------------------------------------------------------------------------------------------! 46 48 SUBROUTINE local_stop 47 49 48 50 #if defined( __parallel ) 49 51 50 USE control_parameters, & 51 ONLY: abort_mode, coupling_mode, coupling_mode_remote, dt_restart, & 52 stop_dt, terminate_coupled, terminate_coupled_remote, & 53 terminate_run, time_restart 52 USE control_parameters, & 53 ONLY: abort_mode, coupling_mode, coupling_mode_remote, dt_restart, stop_dt, & 54 terminate_coupled, terminate_coupled_remote, terminate_run, time_restart 54 55 55 56 USE pegrid 56 57 57 USE pmc_interface, &58 USE pmc_interface, & 58 59 ONLY: nested_run 59 60 … … 63 64 IF ( nested_run ) THEN 64 65 ! 65 !-- Workaround: If any of the nested model crashes, it aborts the whole 66 !-- run with MPI_ABORT,regardless of the reason given by abort_mode66 !-- Workaround: If any of the nested model crashes, it aborts the whole run with MPI_ABORT, 67 !-- regardless of the reason given by abort_mode 67 68 CALL MPI_ABORT( MPI_COMM_WORLD, 9999, ierr ) 68 69 ELSE … … 84 85 IF ( myid == 0 ) THEN 85 86 PRINT*, '+++ local_stop:' 86 PRINT*, ' local model "', TRIM( coupling_mode ), & 87 '" stops now' 87 PRINT*, ' local model "', TRIM( coupling_mode ), '" stops now' 88 88 ENDIF 89 89 ! 90 !-- Inform the remote model of the termination and its reason, provided 91 !-- the remote model has not already been informed of another92 !-- termination reason (terminate_coupled > 0)before.90 !-- Inform the remote model of the termination and its reason, provided the remote model 91 !-- has not already been informed of another termination reason (terminate_coupled > 0) 92 !-- before. 93 93 IF ( terminate_coupled == 0 ) THEN 94 94 terminate_coupled = 1 95 95 IF ( myid == 0 ) THEN 96 CALL MPI_SENDRECV( &97 terminate_coupled, 1, MPI_INTEGER, target_id, 0, &98 terminate_coupled_remote, 1, MPI_INTEGER, target_id, 0, &96 CALL MPI_SENDRECV( & 97 terminate_coupled, 1, MPI_INTEGER, target_id, 0, & 98 terminate_coupled_remote, 1, MPI_INTEGER, target_id, 0, & 99 99 comm_inter, status, ierr ) 100 100 ENDIF … … 107 107 IF ( myid == 0 ) THEN 108 108 PRINT*, '+++ local_stop:' 109 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 110 '" stopped' 109 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), '" stopped' 111 110 ENDIF 112 111 CALL MPI_FINALIZE( ierr ) … … 116 115 IF ( myid == 0 ) THEN 117 116 PRINT*, '+++ local_stop:' 118 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 119 '" terminated' 117 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), '" terminated' 120 118 PRINT*, ' with stop_dt = .T.' 121 119 ENDIF … … 125 123 IF ( myid == 0 ) THEN 126 124 PRINT*, '+++ local_stop:' 127 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 128 '" terminated' 125 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), '" terminated' 129 126 PRINT*, ' with terminate_run = .T. (CPU-time limit)' 130 127 ENDIF … … 134 131 IF ( myid == 0 ) THEN 135 132 PRINT*, '+++ local_stop:' 136 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 137 '" terminated' 133 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), '" terminated' 138 134 PRINT*, ' with terminate_run = .T. (restart)' 139 135 ENDIF … … 144 140 IF ( myid == 0 ) THEN 145 141 PRINT*, '+++ local_stop:' 146 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & 147 '" terminated' 142 PRINT*, ' remote model "', TRIM( coupling_mode_remote ), '" terminated' 148 143 PRINT*, ' with terminate_run = .T. (single restart)' 149 144 ENDIF … … 161 156 #endif 162 157 163 END SUBROUTINE local_stop 158 END SUBROUTINE local_stop -
palm/trunk/SOURCE/local_system.f90
r4360 r4677 1 1 !> @file local_system.f90 2 ! ------------------------------------------------------------------------------!2 !!--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 9 8 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 13 12 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see<http://www.gnu.org/licenses/>.13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: 21 20 ! ----------------- 22 ! 23 ! 21 ! 22 ! 24 23 ! Former revisions: 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4360 2020-01-07 11:25:50Z suehring 27 29 ! Corrected "Former revisions" section 28 ! 30 ! 29 31 ! 3655 2019-01-07 16:51:22Z knoop 30 32 ! Corrected "Former revisions" section … … 37 39 ! ------------ 38 40 !> System calls for different operating systems 39 !------------------------------------------------------------------------------ !41 !--------------------------------------------------------------------------------------------------! 40 42 SUBROUTINE local_system( command ) 41 43 42 44 43 45 CHARACTER (LEN=*) :: command !< … … 45 47 CALL SYSTEM( command ) 46 48 47 END SUBROUTINE local_system 49 END SUBROUTINE local_system -
palm/trunk/SOURCE/local_tremain.f90
r4360 r4677 1 1 !> @file local_tremain.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 9 8 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 13 12 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see<http://www.gnu.org/licenses/>.13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: 21 20 ! ----------------- 22 ! 23 ! 21 ! 22 ! 24 23 ! Former revisions: 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4360 2020-01-07 11:25:50Z suehring 27 29 ! Corrected "Former revisions" section 28 ! 30 ! 29 31 ! 3655 2019-01-07 16:51:22Z knoop 30 32 ! Corrected "Former revisions" section … … 37 39 ! ------------ 38 40 !> For different operating systems get the remaining cpu-time of the job 39 !------------------------------------------------------------------------------ !41 !--------------------------------------------------------------------------------------------------! 40 42 SUBROUTINE local_tremain( remaining_time ) 41 42 43 43 USE control_parameters, & 44 45 USE control_parameters, & 44 46 ONLY: maximum_cpu_time_allowed 45 47 46 USE cpulog, &48 USE cpulog, & 47 49 ONLY: initial_wallclock_time 48 50 … … 56 58 INTEGER(idp) :: count_rate !< 57 59 58 REAL(wp) :: actual_wallclock_time !<60 REAL(wp) :: current_wallclock_time !< 59 61 REAL(wp) :: remaining_time !< 60 62 61 63 CALL SYSTEM_CLOCK( count, count_rate ) 62 actual_wallclock_time = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp ) 63 remaining_time = maximum_cpu_time_allowed - & 64 ( actual_wallclock_time - initial_wallclock_time ) 64 current_wallclock_time = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp ) 65 remaining_time = maximum_cpu_time_allowed - ( current_wallclock_time - initial_wallclock_time ) 65 66 66 67 END SUBROUTINE local_tremain -
palm/trunk/SOURCE/local_tremain_ini.f90
r4360 r4677 1 1 !> @file local_tremain_ini.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 9 8 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 13 12 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see<http://www.gnu.org/licenses/>.13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: 21 20 ! ----------------- 22 ! 23 ! 21 ! 22 ! 24 23 ! Former revisions: 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4360 2020-01-07 11:25:50Z suehring 27 29 ! Corrected "Former revisions" section 28 ! 30 ! 29 31 ! 3655 2019-01-07 16:51:22Z knoop 30 32 ! Corrected "Former revisions" section … … 37 39 ! ------------ 38 40 !> Initialization of CPU-time measurements for different operating systems 39 !------------------------------------------------------------------------------ !41 !--------------------------------------------------------------------------------------------------! 40 42 SUBROUTINE local_tremain_ini 41 42 43 USE cpulog, &43 44 45 USE cpulog, & 44 46 ONLY: initial_wallclock_time 45 47 46 48 USE kinds 47 49 -
palm/trunk/SOURCE/message.f90
r4580 r4677 1 1 !> @file message.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4580 2020-06-29 07:54:21Z raasch 27 29 ! bugfix for aborts in case of nested runs 28 ! 30 ! 29 31 ! 4578 2020-06-25 15:43:32Z gronemeier 30 32 ! bugfix : do not save input values from last call of routines debug_message and location_message … … 45 47 ! 46 48 ! 3885 2019-04-11 11:29:34Z kanani 47 ! Changes related to global restructuring of location messages and introduction 48 ! of additional debugmessages49 ! Changes related to global restructuring of location messages and introduction of additional debug 50 ! messages 49 51 ! 50 52 ! 3655 2019-01-07 16:51:22Z knoop … … 64 66 !> file_id: 6 - stdout (*) 65 67 !> flush_file: 0 - no action, 1 - flush the respective output buffer 66 !------------------------------------------------------------------------------ !67 SUBROUTINE message( routine_name, message_identifier, requested_action, &68 message_level,output_on_pe, file_id, flush_file )69 70 USE control_parameters, &68 !--------------------------------------------------------------------------------------------------! 69 SUBROUTINE message( routine_name, message_identifier, requested_action, message_level, & 70 output_on_pe, file_id, flush_file ) 71 72 USE control_parameters, & 71 73 ONLY: abort_mode, message_string 72 74 … … 75 77 USE pegrid 76 78 77 USE pmc_interface, &79 USE pmc_interface, & 78 80 ONLY: cpl_id, nested_run 79 81 … … 112 114 !-- Create the complete output string, starting with the message level 113 115 IF ( message_level == 0 ) THEN 114 header_string = '--- informative message' // TRIM(nest_string) // & 115 ' ---' 116 header_string = '--- informative message' // TRIM(nest_string) // ' ---' 116 117 ELSEIF ( message_level == 1 ) THEN 117 118 header_string = '+++ warning message' // TRIM(nest_string) // ' ---' … … 119 120 header_string = '+++ error message' // TRIM(nest_string) // ' ---' 120 121 ELSE 121 WRITE( header_string,'(A,I2)' ) '+++ unknown message level' // & 122 TRIM(nest_string) // ': ', & 123 message_level 122 WRITE( header_string,'(A,I2)' ) '+++ unknown message level' // & 123 TRIM(nest_string) // ': ', message_level 124 124 ENDIF 125 125 126 126 ! 127 127 !-- Add the message identifier and the generating routine 128 header_string_2 = 'ID: ' // message_identifier // &128 header_string_2 = 'ID: ' // message_identifier // & 129 129 ' generated by routine: ' // TRIM( routine_name ) 130 130 131 131 information_string_1 = 'Further information can be found at' 132 IF(message_identifier(1:2) == 'NC') THEN 133 information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc' // & 134 '/app/errmsg#NC' 132 IF ( message_identifier(1:2) == 'NC' ) THEN 133 information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc/app/errmsg#NC' 135 134 ELSE 136 information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc ' //&137 '/app/errmsg#' //message_identifier138 ENDIF 139 140 141 ! 142 !-- Output the output string and the corresponding message string which had 143 !-- been already assigned inthe calling subroutine.135 information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc/app/errmsg#' // & 136 message_identifier 137 ENDIF 138 139 140 ! 141 !-- Output the output string and the corresponding message string which had been already assigned in 142 !-- the calling subroutine. 144 143 ! 145 144 !-- First find out if output shall be done on this PE. … … 210 209 IF ( pe_out_of_range ) THEN 211 210 WRITE ( *, '(A)' ) '+++ WARNING from routine message:' 212 WRITE ( *, '(A,I6,A)' ) ' PE ', output_on_pe, & 213 ' choosed for output is larger ' 214 WRITE ( *, '(A,I6)' ) ' than the maximum number of used PEs', & 215 numprocs-1 211 WRITE ( *, '(A,I6,A)' ) ' PE ', output_on_pe, ' choosed for output is larger ' 212 WRITE ( *, '(A,I6)' ) ' than the maximum number of used PEs', numprocs-1 216 213 WRITE ( *, '(A)' ) ' Output is done on PE0 instead' 217 214 ENDIF … … 224 221 abort_mode = requested_action 225 222 ! 226 !-- Since nested runs always use MPI_ABORT, let only the PE which output a message initiate 227 !-- theabort. Others just wait.223 !-- Since nested runs always use MPI_ABORT, let only the PE which output a message initiate the 224 !-- abort. Others just wait. 228 225 IF ( nested_run .AND. requested_action == 1 .AND. .NOT. do_output ) THEN 229 226 #if defined( __parallel ) … … 342 339 343 340 344 !------------------------------------------------------------------------------ !341 !--------------------------------------------------------------------------------------------------! 345 342 ! Description: 346 343 ! ------------ 347 344 !> Abort routine for failures durin reading of namelists 348 !------------------------------------------------------------------------------ !345 !--------------------------------------------------------------------------------------------------! 349 346 SUBROUTINE parin_fail_message( location, line ) 350 347 351 USE control_parameters, &348 USE control_parameters, & 352 349 ONLY: message_string 353 350 … … 372 369 ENDDO 373 370 374 20 WRITE( message_string, '(A,I3,A)' ) & 375 'Error(s) in NAMELIST '// TRIM(location) // & 376 '&Reading fails on line ', line_counter, & 377 ' at&' // line 371 20 WRITE( message_string, '(A,I3,A)' ) 'Error(s) in NAMELIST '// TRIM(location) // & 372 '&Reading fails on line ', line_counter, ' at&' // line 378 373 CALL message( 'parin', 'PA0271', 1, 2, 0, 6, 0 ) 379 374 -
palm/trunk/SOURCE/mod_kinds.f90
r4360 r4677 1 1 !> @file mod_kinds.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 9 8 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 13 12 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see<http://www.gnu.org/licenses/>.13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: 21 20 ! ------------------ 22 ! 23 ! 21 ! 22 ! 24 23 ! Former revisions: 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4360 2020-01-07 11:25:50Z suehring 27 29 ! Corrected "Former revisions" section 28 ! 30 ! 29 31 ! 4000 2019-05-24 07:20:44Z raasch 30 32 ! preprocessor switch added for choosing the real precision 31 ! 33 ! 32 34 ! 3655 2019-01-07 16:51:22Z knoop 33 35 ! Corrected "Former revisions" section 34 ! 36 ! 35 37 ! 1306 2014-03-13 14:30:59Z raasch 36 38 ! Initial revision … … 39 41 ! ------------ 40 42 !> Standard kind definitions 41 !> wp (working precision) and iwp (integer working precision) are the kinds 42 !> used by default in allvariable declarations.43 !> wp (working precision) and iwp (integer working precision) are the kinds used by default in all 44 !> variable declarations. 43 45 !> By default, PALM is using wp = dp (64bit), and iwp = isp (32bit). 44 !> If you like to switch to other precision, then please set wp/iwp 45 !> appropriately by assigning otherkinds below.46 !------------------------------------------------------------------------------ !46 !> If you like to switch to other precision, then please set wp/iwp appropriately by assigning other 47 !> kinds below. 48 !--------------------------------------------------------------------------------------------------! 47 49 MODULE kinds 48 50 49 51 50 52 IMPLICIT NONE -
palm/trunk/SOURCE/mod_particle_attributes.f90
r4628 r4677 1 1 !> @file mod_particle_attributes.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 9 8 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! A PARTICULAR PURPOSE. See the GNU GeneralPublic License for more details.9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 13 12 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see<http://www.gnu.org/licenses/>.13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4628 2020-07-29 07:23:03Z raasch 27 29 ! extensions required for MPI-I/O of particle data to restart files 28 ! 30 ! 29 31 ! 4360 2020-01-07 11:25:50Z suehring 30 32 ! Corrected "Former revisions" section 31 ! 33 ! 32 34 ! 4043 2019-06-18 16:59:00Z schwenkel 33 35 ! Remove min_nr_particle 34 ! 36 ! 35 37 ! 4017 2019-06-06 12:16:46Z schwenkel 36 38 ! interoperable C datatypes introduced in particle type to avoid compiler warnings 37 ! 39 ! 38 40 ! 3720 2019-02-06 13:19:55Z knoop 39 41 ! time_prel replaced by last_particle_release_time 42 ! 40 43 ! 1359 2014-04-11 17:15:14Z hoffmann 41 44 ! new module containing all particle related variables … … 45 48 ! ------------ 46 49 !> Definition of variables used to compute particle transport 47 !------------------------------------------------------------------------------ !48 MODULE particle_attributes50 !--------------------------------------------------------------------------------------------------! 51 MODULE particle_attributes 49 52 50 53 USE, INTRINSIC :: ISO_C_BINDING … … 54 57 55 58 USE kinds 59 60 INTEGER(iwp), PARAMETER :: max_number_of_particle_groups = 10 !< maximum allowed number of particle groups 56 61 57 62 CHARACTER(LEN=varnamelength), DIMENSION(50) :: part_output = ' ' !< namelist parameter … … 63 68 INTEGER(iwp) :: ibc_par_t !< particle top boundary condition dummy 64 69 INTEGER(iwp) :: number_of_output_particles = 0 !< number of output particles 65 INTEGER(iwp) :: number_of_particles = 0 !< number of particles for each grid box (3d array is saved on prt_count) 70 INTEGER(iwp) :: number_of_particles = 0 !< number of particles for each grid box (3d array is saved on 71 !< prt_count) 66 72 INTEGER(iwp) :: number_of_particle_groups = 1 !< namelist parameter (see documentation) 67 73 INTEGER(iwp) :: part_inc = 1 !< increment of particles in output file 68 74 69 INTEGER(iwp), PARAMETER :: max_number_of_particle_groups = 10 !< maximum allowed number of particle groups75 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: prt_count !< 3d array of number of particles of every grid box 70 76 71 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: prt_count !< 3d array of number of particles of every grid box72 73 77 LOGICAL :: particle_advection = .FALSE. !< parameter to steer the advection of particles 74 78 LOGICAL :: unlimited_dimension = .TRUE. !< umlimited dimension for particle output 75 LOGICAL :: use_sgs_for_particles = .FALSE. !< namelist parameter (see documentation) 79 LOGICAL :: use_sgs_for_particles = .FALSE. !< namelist parameter (see documentation) 76 80 LOGICAL :: wang_kernel = .FALSE. !< flag for collision kernel 77 81 78 82 REAL(wp) :: alloc_factor = 20.0_wp !< namelist parameter (see documentation) 79 REAL(wp) :: oversize = 100.0_wp !< reserve spare particles in output file (in % relative to initial number) 83 REAL(wp) :: oversize = 100.0_wp !< reserve spare particles in output file (in % relative to initial 84 !< number) 80 85 REAL(wp) :: particle_advection_start = 0.0_wp !< namelist parameter (see documentation) 81 86 REAL(wp) :: part_percent = 100.0_wp !< percentage of particles in output file 82 87 83 88 TYPE, PUBLIC :: particle_type 84 REAL(wp) :: aux1 !< auxiliary multi-purpose feature85 REAL(wp) :: aux2 !< auxiliary multi-purpose feature86 REAL(wp) :: radius !< radius of particle87 REAL(wp) :: age !< age of particle88 REAL(wp) :: age_m !<89 REAL(wp) :: dt_sum !<90 REAL(wp) :: e_m !< interpolated sgs tke91 REAL(wp) :: origin_x !< origin x-position of particle (changed cyclic bc)92 REAL(wp) :: origin_y !< origin y-position of particle (changed cyclic bc)93 REAL(wp) :: origin_z !< origin z-position of particle (changed cyclic bc)94 REAL(wp) :: rvar1 !<95 REAL(wp) :: rvar2 !<96 REAL(wp) :: rvar3 !<97 REAL(wp) :: speed_x !< speed of particle in x98 REAL(wp) :: speed_y !< speed of particle in y99 REAL(wp) :: speed_z !< speed of particle in z100 REAL(wp) :: weight_factor !< weighting factor101 REAL(wp) :: x !< x-position102 REAL(wp) :: y !< y-position103 REAL(wp) :: z !< z-position104 INTEGER(iwp) :: class !< radius class needed for collision105 INTEGER(iwp) :: group !< number of particle group106 INTEGER(idp) :: id !< particle ID (64 bit integer)107 LOGICAL :: particle_mask !< if this parameter is set to false the particle will be deleted108 INTEGER(iwp) :: block_nr !< number for sorting (removable?)89 REAL(wp) :: aux1 !< auxiliary multi-purpose feature 90 REAL(wp) :: aux2 !< auxiliary multi-purpose feature 91 REAL(wp) :: radius !< radius of particle 92 REAL(wp) :: age !< age of particle 93 REAL(wp) :: age_m !< 94 REAL(wp) :: dt_sum !< 95 REAL(wp) :: e_m !< interpolated sgs tke 96 REAL(wp) :: origin_x !< origin x-position of particle (changed cyclic bc) 97 REAL(wp) :: origin_y !< origin y-position of particle (changed cyclic bc) 98 REAL(wp) :: origin_z !< origin z-position of particle (changed cyclic bc) 99 REAL(wp) :: rvar1 !< 100 REAL(wp) :: rvar2 !< 101 REAL(wp) :: rvar3 !< 102 REAL(wp) :: speed_x !< speed of particle in x 103 REAL(wp) :: speed_y !< speed of particle in y 104 REAL(wp) :: speed_z !< speed of particle in z 105 REAL(wp) :: weight_factor !< weighting factor 106 REAL(wp) :: x !< x-position 107 REAL(wp) :: y !< y-position 108 REAL(wp) :: z !< z-position 109 INTEGER(iwp) :: class !< radius class needed for collision 110 INTEGER(iwp) :: group !< number of particle group 111 INTEGER(idp) :: id !< particle ID (64 bit integer) 112 LOGICAL :: particle_mask !< if this parameter is set to false the particle will be deleted 113 INTEGER(iwp) :: block_nr !< number for sorting (removable?) 109 114 INTEGER(iwp) :: particle_nr=-1 !< particle number for particle IO (increment one 110 115 END TYPE particle_type … … 121 126 END TYPE particle_groups_type 122 127 123 TYPE(particle_groups_type), DIMENSION(max_number_of_particle_groups) :: & 124 particle_groups 128 TYPE(particle_groups_type), DIMENSION(max_number_of_particle_groups) :: particle_groups 125 129 126 130 TYPE grid_particle_def … … 145 149 146 150 147 END MODULE particle_attributes151 END MODULE particle_attributes -
palm/trunk/SOURCE/model_1d_mod.f90
r4586 r4677 1 1 !> @file model_1d_mod.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4586 2020-07-01 16:16:43Z gronemeier 27 29 ! renamed Richardson flux number into gradient Richardson number 28 30 ! … … 53 55 !> the 1D model uses different turbulence closure approaches at least if 54 56 !> the 3D model is set to LES-mode. 55 !------------------------------------------------------------------------------ !57 !--------------------------------------------------------------------------------------------------! 56 58 MODULE model_1d_mod 57 59 58 USE arrays_3d, & 59 ONLY: dd2zu, ddzu, ddzw, dzu, dzw, pt_init, q_init, ug, u_init, & 60 vg, v_init, zu 61 62 USE basic_constants_and_equations_mod, & 60 USE arrays_3d, & 61 ONLY: dd2zu, ddzu, ddzw, dzu, dzw, pt_init, q_init, ug, u_init, vg, v_init, zu 62 63 USE basic_constants_and_equations_mod, & 63 64 ONLY: g, kappa, pi 64 65 65 USE control_parameters, & 66 ONLY: constant_diffusion, constant_flux_layer, dissipation_1d, f, & 67 humidity, ibc_e_b, intermediate_timestep_count, & 68 intermediate_timestep_count_max, km_constant, & 69 message_string, mixing_length_1d, prandtl_number, & 70 roughness_length, run_description_header, simulated_time_chr, & 71 timestep_scheme, tsc, z0h_factor 72 73 USE indices, & 66 USE control_parameters, & 67 ONLY: constant_diffusion, constant_flux_layer, dissipation_1d, f, humidity, ibc_e_b, & 68 intermediate_timestep_count, intermediate_timestep_count_max, km_constant, & 69 message_string, mixing_length_1d, prandtl_number, roughness_length, & 70 run_description_header, simulated_time_chr, timestep_scheme, tsc, z0h_factor 71 72 USE indices, & 74 73 ONLY: nzb, nzb_diff, nzt 75 74 76 75 USE kinds 77 76 78 USE pegrid, &77 USE pegrid, & 79 78 ONLY: myid 80 79 … … 176 175 ! 177 176 !-- Public variables 178 PUBLIC damp_level_1d, damp_level_ind_1d, diss1d, dt_pr_1d, & 179 dt_run_control_1d, e1d, end_time_1d, kh1d, km1d, l1d, ri1d, u1d, & 180 us1d, usws1d, v1d, vsws1d 177 PUBLIC damp_level_1d, damp_level_ind_1d, diss1d, dt_pr_1d, dt_run_control_1d, e1d, & 178 end_time_1d, kh1d, km1d, l1d, ri1d, u1d, us1d, usws1d, v1d, vsws1d 181 179 182 180 … … 185 183 SUBROUTINE init_1d_model 186 184 187 USE grid_variables, &185 USE grid_variables, & 188 186 ONLY: dx, dy 189 187 … … 196 194 ! 197 195 !-- Allocate required 1D-arrays 198 ALLOCATE( diss1d(nzb:nzt+1), diss1d_p(nzb:nzt+1), &199 e1d(nzb:nzt+1), e1d_p(nzb:nzt+1), kh1d(nzb:nzt+1), &200 km1d(nzb:nzt+1), l1d(nzb:nzt+1), l1d_init(nzb:nzt+1), &201 l1d_diss(nzb:nzt+1), ri1d(nzb:nzt+1), te_diss(nzb:nzt+1), &202 te_dissm(nzb:nzt+1), te_e(nzb:nzt+1), &203 te_em(nzb:nzt+1), te_u(nzb:nzt+1), te_um(nzb:nzt+1), &204 te_v(nzb:nzt+1), te_vm(nzb:nzt+1), u1d(nzb:nzt+1), &196 ALLOCATE( diss1d(nzb:nzt+1), diss1d_p(nzb:nzt+1), & 197 e1d(nzb:nzt+1), e1d_p(nzb:nzt+1), kh1d(nzb:nzt+1), & 198 km1d(nzb:nzt+1), l1d(nzb:nzt+1), l1d_init(nzb:nzt+1), & 199 l1d_diss(nzb:nzt+1), ri1d(nzb:nzt+1), te_diss(nzb:nzt+1), & 200 te_dissm(nzb:nzt+1), te_e(nzb:nzt+1), & 201 te_em(nzb:nzt+1), te_u(nzb:nzt+1), te_um(nzb:nzt+1), & 202 te_v(nzb:nzt+1), te_vm(nzb:nzt+1), u1d(nzb:nzt+1), & 205 203 u1d_p(nzb:nzt+1), v1d(nzb:nzt+1), v1d_p(nzb:nzt+1) ) 206 204 … … 223 221 !-- Blackadar mixing length 224 222 IF ( f /= 0.0_wp ) THEN 225 lambda = 2.7E-4_wp * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / & 226 ABS( f ) + 1E-10_wp 223 lambda = 2.7E-4_wp * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / ABS( f ) + 1E-10_wp 227 224 ELSE 228 225 lambda = 30.0_wp … … 258 255 259 256 ! 260 !-- Set initial horizontal velocities at the lowest grid levels to a very small 261 !-- value in order to avoid too small time steps caused by the diffusion limit262 !-- in the initial phase of a run (at k=1,dz/2 occurs in the limiting formula!)257 !-- Set initial horizontal velocities at the lowest grid levels to a very small value in order to 258 !-- avoid too small time steps caused by the diffusion limit in the initial phase of a run (at k=1, 259 !-- dz/2 occurs in the limiting formula!) 263 260 u1d(0:1) = 0.1_wp 264 261 u1d_p(0:1) = 0.1_wp … … 310 307 311 308 312 !------------------------------------------------------------------------------ !309 !--------------------------------------------------------------------------------------------------! 313 310 ! Description: 314 311 ! ------------ 315 312 !> Runge-Kutta time differencing scheme for the 1D-model. 316 !------------------------------------------------------------------------------ !313 !--------------------------------------------------------------------------------------------------! 317 314 318 315 SUBROUTINE time_integration_1d … … 335 332 336 333 ! 337 !-- Determine the time step at the start of a 1D-simulation and 338 !-- determine and printout quantitiesused for run control334 !-- Determine the time step at the start of a 1D-simulation and determine and printout quantities 335 !-- used for run control 339 336 dt_1d = 0.01_wp 340 337 CALL run_control_1d … … 345 342 346 343 ! 347 !-- Depending on the timestep scheme, carry out one or more intermediate 348 !-- timesteps 344 !-- Depending on the timestep scheme, carry out one or more intermediate timesteps 349 345 350 346 intermediate_timestep_count = 0 351 DO WHILE ( intermediate_timestep_count < & 352 intermediate_timestep_count_max ) 347 DO WHILE ( intermediate_timestep_count < intermediate_timestep_count_max ) 353 348 354 349 intermediate_timestep_count = intermediate_timestep_count + 1 … … 357 352 358 353 ! 359 !-- Compute all tendency terms. If a constant-flux layer is simulated, 360 !-- k starts at nzb+2. 354 !-- Compute all tendency terms. If a constant-flux layer is simulated, k starts at nzb+2. 361 355 DO k = nzb_diff, nzt 362 356 … … 365 359 ! 366 360 !-- u-component 367 te_u(k) = f * ( v1d(k) - vg(k) ) + ( &368 kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) &369 - kmzm * ( u1d(k) - u1d(k-1) ) * ddzu(k) &361 te_u(k) = f * ( v1d(k) - vg(k) ) + ( & 362 kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) & 363 - kmzm * ( u1d(k) - u1d(k-1) ) * ddzu(k) & 370 364 ) * ddzw(k) 371 365 ! 372 366 !-- v-component 373 te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &374 kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) &375 - kmzm * ( v1d(k) - v1d(k-1) ) * ddzu(k) &367 te_v(k) = -f * ( u1d(k) - ug(k) ) + ( & 368 kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) & 369 - kmzm * ( v1d(k) - v1d(k-1) ) * ddzu(k) & 376 370 ) * ddzw(k) 377 371 ENDDO … … 387 381 ELSE 388 382 pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) ) 389 flux = ( ( pt_init(k+1) - pt_init(k-1) ) + &390 0.61_wp * ( pt_init(k+1) * q_init(k+1) - &391 pt_init(k-1) * q_init(k-1) ) &383 flux = ( ( pt_init(k+1) - pt_init(k-1) ) + & 384 0.61_wp * ( pt_init(k+1) * q_init(k+1) - & 385 pt_init(k-1) * q_init(k-1) ) & 392 386 ) * dd2zu(k) 393 387 ENDIF 394 388 395 389 ! 396 !-- Calculate dissipation rate if no prognostic equation is used for 397 !-- dissipation rate 390 !-- Calculate dissipation rate if no prognostic equation is used for dissipation rate. 398 391 IF ( dissipation_1d == 'detering' ) THEN 399 392 diss1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k) 400 393 ELSEIF ( dissipation_1d == 'as_in_3d_model' ) THEN 401 diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) &402 )* e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)394 diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) ) & 395 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k) 403 396 ENDIF 404 397 ! 405 398 !-- TKE 406 te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &407 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &408 ) &409 - g / pt_0 * kh1d(k) * flux &410 + ( &411 kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1) &412 - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k) &413 ) * ddzw(k) / sig_e &399 te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 & 400 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 & 401 ) & 402 - g / pt_0 * kh1d(k) * flux & 403 + ( & 404 kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1) & 405 - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k) & 406 ) * ddzw(k) / sig_e & 414 407 - diss1d(k) 415 408 … … 420 413 alpha_buoyancy = 1.0_wp - l1d(k) / lambda 421 414 ELSE 422 alpha_buoyancy = 1.0_wp - ( 1.0_wp + ( c_2 - 1.0_wp ) &423 / ( c_2 - c_1 ) ) &415 alpha_buoyancy = 1.0_wp - ( 1.0_wp + ( c_2 - 1.0_wp ) & 416 / ( c_2 - c_1 ) ) & 424 417 * l1d(k) / lambda 425 418 ENDIF 426 419 c_3 = ( c_1 - c_2 ) * alpha_buoyancy + 1.0_wp 427 te_diss(k) = ( km1d(k) * &428 ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &429 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &430 ) * ( c_1 + (c_2 - c_1) * l1d(k) / lambda ) &431 - g / pt_0 * kh1d(k) * flux * c_3 &432 - c_2 * diss1d(k) &433 ) * diss1d(k) / ( e1d(k) + 1.0E-20_wp ) &434 + ( kmzp * ( diss1d(k+1) - diss1d(k) ) &435 * ddzu(k+1) &436 - kmzm * ( diss1d(k) - diss1d(k-1) ) &437 * ddzu(k) &420 te_diss(k) = ( km1d(k) * & 421 ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 & 422 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 & 423 ) * ( c_1 + (c_2 - c_1) * l1d(k) / lambda ) & 424 - g / pt_0 * kh1d(k) * flux * c_3 & 425 - c_2 * diss1d(k) & 426 ) * diss1d(k) / ( e1d(k) + 1.0E-20_wp ) & 427 + ( kmzp * ( diss1d(k+1) - diss1d(k) ) & 428 * ddzu(k+1) & 429 - kmzm * ( diss1d(k) - diss1d(k-1) ) & 430 * ddzu(k) & 438 431 ) * ddzw(k) / sig_diss 439 432 … … 445 438 ! 446 439 !-- Tendency terms at the top of the constant-flux layer. 447 !-- Finite differences of the momentum fluxes are computed using half the 448 !-- normal grid length(2.0*ddzw(k)) for the sake of enhanced accuracy440 !-- Finite differences of the momentum fluxes are computed using half the normal grid length 441 !-- (2.0*ddzw(k)) for the sake of enhanced accuracy 449 442 IF ( constant_flux_layer ) THEN 450 443 … … 457 450 ELSE 458 451 pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) ) 459 flux = ( ( pt_init(k+1) - pt_init(k-1) ) + &460 0.61_wp * ( pt_init(k+1) * q_init(k+1) - &461 pt_init(k-1) * q_init(k-1) ) &452 flux = ( ( pt_init(k+1) - pt_init(k-1) ) + & 453 0.61_wp * ( pt_init(k+1) * q_init(k+1) - & 454 pt_init(k-1) * q_init(k-1) ) & 462 455 ) * dd2zu(k) 463 456 ENDIF 464 457 465 458 ! 466 !-- Calculate dissipation rate if no prognostic equation is used for 467 !-- dissipation rate 459 !-- Calculate dissipation rate if no prognostic equation is used for dissipation rate. 468 460 IF ( dissipation_1d == 'detering' ) THEN 469 461 diss1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k) 470 462 ELSEIF ( dissipation_1d == 'as_in_3d_model' ) THEN 471 diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) ) &463 diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l1d_init(k) ) & 472 464 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k) 473 465 ENDIF … … 475 467 ! 476 468 !-- u-component 477 te_u(k) = f * ( v1d(k) - vg(k) ) + ( &478 kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) + usws1d &469 te_u(k) = f * ( v1d(k) - vg(k) ) + ( & 470 kmzp * ( u1d(k+1) - u1d(k) ) * ddzu(k+1) + usws1d & 479 471 ) * 2.0_wp * ddzw(k) 480 472 ! 481 473 !-- v-component 482 te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &483 kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) + vsws1d &474 te_v(k) = -f * ( u1d(k) - ug(k) ) + ( & 475 kmzp * ( v1d(k+1) - v1d(k) ) * ddzu(k+1) + vsws1d & 484 476 ) * 2.0_wp * ddzw(k) 485 477 ! … … 490 482 !> while for u and v it is not? 491 483 !> 2018-04-23, gronemeier 492 te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &493 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &494 ) &495 - g / pt_0 * kh1d(k) * flux &496 + ( &497 kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1) &498 - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k) &499 ) * ddzw(k) / sig_e &484 te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 & 485 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 & 486 ) & 487 - g / pt_0 * kh1d(k) * flux & 488 + ( & 489 kmzp * ( e1d(k+1) - e1d(k) ) * ddzu(k+1) & 490 - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k) & 491 ) * ddzw(k) / sig_e & 500 492 - diss1d(k) 501 493 ENDIF … … 507 499 DO k = nzb+1, nzt 508 500 509 u1d_p(k) = u1d(k) + dt_1d * ( tsc(2) * te_u(k) + & 510 tsc(3) * te_um(k) ) 511 v1d_p(k) = v1d(k) + dt_1d * ( tsc(2) * te_v(k) + & 512 tsc(3) * te_vm(k) ) 501 u1d_p(k) = u1d(k) + dt_1d * ( tsc(2) * te_u(k) + tsc(3) * te_um(k) ) 502 v1d_p(k) = v1d(k) + dt_1d * ( tsc(2) * te_v(k) + tsc(3) * te_vm(k) ) 513 503 514 504 ENDDO … … 516 506 517 507 DO k = nzb+1, nzt 518 e1d_p(k) = e1d(k) + dt_1d * ( tsc(2) * te_e(k) + & 519 tsc(3) * te_em(k) ) 508 e1d_p(k) = e1d(k) + dt_1d * ( tsc(2) * te_e(k) + tsc(3) * te_em(k) ) 520 509 ENDDO 521 510 522 511 ! 523 !-- Eliminate negative TKE values, which can result from the 524 !-- integration due to numerical inaccuracies. In such cases the TKE 525 !-- value is reduced to 10 percent of its old value. 512 !-- Eliminate negative TKE values, which can result from the integration due to numerical 513 !-- inaccuracies. In such cases the TKE value is reduced to 10 percent of its old value. 526 514 WHERE ( e1d_p < 0.0_wp ) e1d_p = 0.1_wp * e1d 527 515 528 516 IF ( dissipation_1d == 'prognostic' ) THEN 529 517 DO k = nzb+1, nzt 530 diss1d_p(k) = diss1d(k) + dt_1d * ( tsc(2) * te_diss(k) + & 531 tsc(3) * te_dissm(k) ) 518 diss1d_p(k) = diss1d(k) + dt_1d * ( tsc(2) * te_diss(k) + tsc(3) * te_dissm(k) ) 532 519 ENDDO 533 520 WHERE ( diss1d_p < 0.0_wp ) diss1d_p = 0.1_wp * diss1d … … 556 543 ENDIF 557 544 558 ELSEIF ( intermediate_timestep_count < & 559 intermediate_timestep_count_max ) THEN 545 ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max ) THEN 560 546 561 547 DO k = nzb+1, nzt … … 570 556 IF ( dissipation_1d == 'prognostic' ) THEN 571 557 DO k = nzb+1, nzt 572 te_dissm(k) = -9.5625_wp * te_diss(k) & 573 + 5.3125_wp * te_dissm(k) 558 te_dissm(k) = -9.5625_wp * te_diss(k) + 5.3125_wp * te_dissm(k) 574 559 ENDDO 575 560 ENDIF … … 581 566 ! 582 567 !-- Boundary conditions for the prognostic variables. 583 !-- At the top boundary (nzt+1) u, v, e, and diss keep their initial 584 !-- v alues (ug(nzt+1), vg(nzt+1), 0, 0).585 !-- At the bottom boundary, Dirichlet condition is used for u and v (0) 586 !-- and Neumann conditionfor e and diss (e(nzb)=e(nzb+1)).568 !-- At the top boundary (nzt+1) u, v, e, and diss keep their initial values (ug(nzt+1), 569 !-- vg(nzt+1), 0, 0). 570 !-- At the bottom boundary, Dirichlet condition is used for u and v (0) and Neumann condition 571 !-- for e and diss (e(nzb)=e(nzb+1)). 587 572 u1d_p(nzb) = 0.0_wp 588 573 v1d_p(nzb) = 0.0_wp … … 611 596 ! 612 597 !-- Stable stratification 613 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &614 ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * ri1d(nzb+1) * &615 ( zu(nzb+1) - z0h1d ) / zu(nzb+1) &598 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / & 599 ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * ri1d(nzb+1) * & 600 ( zu(nzb+1) - z0h1d ) / zu(nzb+1) & 616 601 ) 617 602 ELSE … … 619 604 !-- Unstable stratification 620 605 a = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) ) 621 b = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / & 622 zu(nzb+1) * z0h1d ) 623 624 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / & 625 LOG( (a-1.0_wp) / (a+1.0_wp) * & 626 (b+1.0_wp) / (b-1.0_wp) ) 606 b = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / zu(nzb+1) * z0h1d ) 607 608 ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / & 609 LOG( (a-1.0_wp) / (a+1.0_wp) * (b+1.0_wp) / (b-1.0_wp) ) 627 610 ENDIF 628 611 … … 634 617 ! 635 618 !-- Compute the gradient Richardson numbers, 636 !-- first at the top of the constant-flux layer using u* of the 637 !-- previous time step(+1E-30, if u* = 0), then in the remaining area.619 !-- first at the top of the constant-flux layer using u* of the previous time step 620 !-- (+1E-30, if u* = 0), then in the remaining area. 638 621 !-- There, the Ri numbers of the previous time step are used. 639 622 … … 646 629 flux = ts1d + 0.61_wp * pt_init(k) * qs1d 647 630 ENDIF 648 ri1d(nzb+1) = zu(nzb+1) * kappa * g * flux / & 649 ( pt_0 * ( us1d**2 + 1E-30_wp ) ) 631 ri1d(nzb+1) = zu(nzb+1) * kappa * g * flux / ( pt_0 * ( us1d**2 + 1E-30_wp ) ) 650 632 ENDIF 651 633 … … 656 638 ELSE 657 639 pt_0 = pt_init(k) * ( 1.0_wp + 0.61_wp * q_init(k) ) 658 flux = ( ( pt_init(k+1) - pt_init(k-1) ) &659 + 0.61_wp &660 * ( pt_init(k+1) * q_init(k+1) &661 - pt_init(k-1) * q_init(k-1) ) &640 flux = ( ( pt_init(k+1) - pt_init(k-1) ) & 641 + 0.61_wp & 642 * ( pt_init(k+1) * q_init(k+1) & 643 - pt_init(k-1) * q_init(k-1) ) & 662 644 ) * dd2zu(k) 663 645 ENDIF 664 646 IF ( ri1d(k) >= 0.0_wp ) THEN 665 ri1d(k) = g / pt_0 * flux / &666 ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &667 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &668 + 1E-30_wp &647 ri1d(k) = g / pt_0 * flux / & 648 ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 & 649 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 & 650 + 1E-30_wp & 669 651 ) 670 652 ELSE 671 ri1d(k) = g / pt_0 * flux / &672 ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &673 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &674 + 1E-30_wp &653 ri1d(k) = g / pt_0 * flux / & 654 ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 & 655 + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 & 656 + 1E-30_wp & 675 657 ) * ( 1.0_wp - 16.0_wp * ri1d(k) )**0.25_wp 676 658 ENDIF 677 659 ENDDO 678 660 ! 679 !-- Richardson numbers must remain restricted to a realistic value 680 !-- range. It is exceeded excessively for very small velocities 681 !-- (u,v --> 0). 661 !-- Richardson numbers must remain restricted to a realistic value range. It is exceeded 662 !-- excessively for very small velocities (u,v --> 0). 682 663 WHERE ( ri1d < -5.0_wp ) ri1d = -5.0_wp 683 664 WHERE ( ri1d > 1.0_wp ) ri1d = 1.0_wp … … 691 672 ! 692 673 !-- Stable stratification 693 us1d = kappa * uv_total / ( 694 LOG( zu(nzb+1) / z01d ) + 5.0_wp * ri1d(nzb+1) *&695 ( zu(nzb+1) - z01d ) / zu(nzb+1)&674 us1d = kappa * uv_total / ( LOG( zu(nzb+1) / z01d ) & 675 + 5.0_wp * ri1d(nzb+1) * ( zu(nzb+1) - z01d ) & 676 / zu(nzb+1) & 696 677 ) 697 678 ELSE … … 699 680 !-- Unstable stratification 700 681 a = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) ) ) 701 b = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / & 702 zu(nzb+1) * z01d ) ) 703 us1d = kappa * uv_total / ( & 704 LOG( (1.0_wp+b) / (1.0_wp-b) * (1.0_wp-a) / & 705 (1.0_wp+a) ) + & 706 2.0_wp * ( ATAN( b ) - ATAN( a ) ) & 682 b = 1.0_wp / SQRT( SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / zu(nzb+1) * z01d ) ) 683 us1d = kappa * uv_total / ( LOG( (1.0_wp+b) / (1.0_wp-b) * (1.0_wp-a) / & 684 (1.0_wp+a) ) + & 685 2.0_wp * ( ATAN( b ) - ATAN( a ) ) & 707 686 ) 708 687 ENDIF … … 714 693 715 694 ! 716 !-- Boundary condition for the turbulent kinetic energy and 717 !-- dissipation rate at the topof the constant-flux layer.718 !-- Additional Neumann condition de/dz = 0 at nzb is set to ensure 719 !-- compatibility withthe 3D model.695 !-- Boundary condition for the turbulent kinetic energy and dissipation rate at the top 696 !-- of the constant-flux layer. 697 !-- Additional Neumann condition de/dz = 0 at nzb is set to ensure compatibility with 698 !-- the 3D model. 720 699 IF ( ibc_e_b == 2 ) THEN 721 700 e1d(nzb+1) = ( us1d / c_0 )**2 … … 734 713 ! 735 714 !-- Stable stratification 736 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &737 ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * ri1d(nzb+1) *&738 ( zu(nzb+1) - z0h1d ) / zu(nzb+1)&739 )715 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / & 716 ( LOG( zu(nzb+1) / z0h1d ) + 5.0_wp * ri1d(nzb+1) * & 717 ( zu(nzb+1) - z0h1d ) / zu(nzb+1) & 718 ) 740 719 ELSE 741 720 ! 742 721 !-- Unstable stratification 743 722 a = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) ) 744 b = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / & 745 zu(nzb+1) * z0h1d ) 746 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / & 747 LOG( (a-1.0_wp) / (a+1.0_wp) * & 748 (b+1.0_wp) / (b-1.0_wp) ) 723 b = SQRT( 1.0_wp - 16.0_wp * ri1d(nzb+1) / zu(nzb+1) * z0h1d ) 724 qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / & 725 LOG( (a-1.0_wp) / (a+1.0_wp) * (b+1.0_wp) / (b-1.0_wp) ) 749 726 ENDIF 750 727 ELSE … … 755 732 756 733 ! 757 !-- Compute the diabatic mixing length. The unstable stratification 758 !-- must not be considered for l1d (km1d) as it is already considered 759 !-- in the dissipation of TKE via l1d_diss. Otherwise, km1d would be 760 !-- too large. 734 !-- Compute the diabatic mixing length. The unstable stratification must not be considered 735 !-- for l1d (km1d) as it is already considered in the dissipation of TKE via l1d_diss. 736 !-- Otherwise, km1d would be too large. 761 737 IF ( dissipation_1d /= 'prognostic' ) THEN 762 738 IF ( mixing_length_1d == 'blackadar' ) THEN … … 767 743 ELSE 768 744 l1d(k) = l1d_init(k) 769 l1d_diss(k) = l1d_init(k) * & 770 SQRT( 1.0_wp - 16.0_wp * ri1d(k) ) 745 l1d_diss(k) = l1d_init(k) * SQRT( 1.0_wp - 16.0_wp * ri1d(k) ) 771 746 ENDIF 772 747 ENDDO … … 775 750 dpt_dz = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k) 776 751 IF ( dpt_dz > 0.0_wp ) THEN 777 l_stable = 0.76_wp * SQRT( e1d(k) ) &778 / SQRT( g / pt_init(k) * dpt_dz ) + 1E-5_wp752 l_stable = 0.76_wp * SQRT( e1d(k) ) & 753 / SQRT( g / pt_init(k) * dpt_dz ) + 1E-5_wp 779 754 ELSE 780 755 l_stable = l1d_init(k) … … 786 761 ELSE 787 762 DO k = nzb+1, nzt 788 l1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) & 789 / ( diss1d(k) + 1.0E-30_wp ) 763 l1d(k) = c_0**3 * e1d(k) * SQRT( e1d(k) ) / ( diss1d(k) + 1.0E-30_wp ) 790 764 ENDDO 791 765 ENDIF 792 766 793 767 ! 794 !-- Compute the diffusion coefficients for momentum via the 795 !-- corresponding Prandtl-layer relationship and according to 796 !-- Prandtl-Kolmogorov, respectively 768 !-- Compute the diffusion coefficients for momentum via the corresponding Prandtl-layer 769 !-- relationship and according to Prandtl-Kolmogorov, respectively 797 770 IF ( constant_flux_layer ) THEN 798 771 IF ( ri1d(nzb+1) >= 0.0_wp ) THEN 799 km1d(nzb+1) = us1d * kappa * zu(nzb+1) / &772 km1d(nzb+1) = us1d * kappa * zu(nzb+1) / & 800 773 ( 1.0_wp + 5.0_wp * ri1d(nzb+1) ) 801 774 ELSE 802 km1d(nzb+1) = us1d * kappa * zu(nzb+1) * &775 km1d(nzb+1) = us1d * kappa * zu(nzb+1) * & 803 776 ( 1.0_wp - 16.0_wp * ri1d(nzb+1) )**0.25_wp 804 777 ENDIF … … 823 796 824 797 ! 825 !-- Compute the diffusion coefficient for heat via the relationship 826 !-- kh = phim / phih * km 798 !-- Compute the diffusion coefficient for heat via the relationship kh = phim / phih * km 827 799 DO k = nzb+1, nzt 828 800 IF ( ri1d(k) >= 0.0_wp ) THEN … … 865 837 ENDDO ! time loop 866 838 ! 867 !-- Set intermediate_timestep_count back to zero. This is required e.g. for 868 !-- initial calls ofcalc_mean_profile.839 !-- Set intermediate_timestep_count back to zero. This is required e.g. for initial calls of 840 !-- calc_mean_profile. 869 841 intermediate_timestep_count = 0 870 842 … … 872 844 873 845 874 !------------------------------------------------------------------------------ !846 !--------------------------------------------------------------------------------------------------! 875 847 ! Description: 876 848 ! ------------ 877 849 !> Compute and print out quantities for run control of the 1D model. 878 !------------------------------------------------------------------------------ !850 !--------------------------------------------------------------------------------------------------! 879 851 880 852 SUBROUTINE run_control_1d … … 922 894 alpha = alpha / ( 2.0_wp * pi ) * 360.0_wp 923 895 924 WRITE ( 15, 101 ) current_timestep_number_1d, simulated_time_chr, &925 dt_1d, umax, vmax, us1d,alpha, energy896 WRITE ( 15, 101 ) current_timestep_number_1d, simulated_time_chr, dt_1d, umax, vmax, us1d, & 897 alpha, energy 926 898 ! 927 899 !-- Write buffer contents to disc immediately … … 932 904 ! 933 905 !-- formats 934 100 FORMAT (///'1D run control output:'/ &935 &'------------------------------'//&936 &'ITER. HH:MM:SS DT UMAX VMAX U* ALPHA ENERG.'/&937 &'-------------------------------------------------------------')906 100 FORMAT (///'1D run control output:'/ & 907 '------------------------------'// & 908 'ITER. HH:MM:SS DT UMAX VMAX U* ALPHA ENERG.'/ & 909 '-------------------------------------------------------------') 938 910 101 FORMAT (I7,1X,A9,1X,F6.2,2X,F6.2,1X,F6.2,1X,F6.3,2X,F5.1,2X,F7.2) 939 911 … … 943 915 944 916 945 !------------------------------------------------------------------------------ !917 !--------------------------------------------------------------------------------------------------! 946 918 ! Description: 947 919 ! ------------ 948 920 !> Compute the time step w.r.t. the diffusion criterion 949 !------------------------------------------------------------------------------ !921 !--------------------------------------------------------------------------------------------------! 950 922 951 923 SUBROUTINE timestep_1d … … 965 937 966 938 ! 967 !-- Compute the currently feasible time step according to the diffusion 968 !-- criterion. At nzb+1 the halfgrid length is used.939 !-- Compute the currently feasible time step according to the diffusion criterion. At nzb+1 the half 940 !-- grid length is used. 969 941 fac = 0.125 970 942 dt_diff = dt_max_1d … … 985 957 stop_dt_1d = .TRUE. 986 958 987 WRITE( message_string, * ) 'timestep has exceeded the lower limit&', &988 ' dt_1d = ',dt_1d,'s simulation stopped!'959 WRITE( message_string, * ) 'timestep has exceeded the lower limit&', 'dt_1d = ',dt_1d, & 960 ' s simulation stopped!' 989 961 CALL message( 'timestep_1d', 'PA0192', 1, 2, 0, 6, 0 ) 990 962 … … 995 967 996 968 997 !------------------------------------------------------------------------------ !969 !--------------------------------------------------------------------------------------------------! 998 970 ! Description: 999 971 ! ------------ 1000 972 !> List output of profiles from the 1D-model 1001 !------------------------------------------------------------------------------ !973 !--------------------------------------------------------------------------------------------------! 1002 974 1003 975 SUBROUTINE print_1d_model … … 1029 1001 WRITE ( 17, 101 ) 1030 1002 DO k = nzt+1, nzb, -1 1031 WRITE ( 17, 103) k, zu(k), u1d(k), v1d(k), pt_init(k), e1d(k), &1032 ri1d(k), km1d(k),kh1d(k), l1d(k), diss1d(k)1003 WRITE ( 17, 103) k, zu(k), u1d(k), v1d(k), pt_init(k), e1d(k), ri1d(k), km1d(k), & 1004 kh1d(k), l1d(k), diss1d(k) 1033 1005 ENDDO 1034 1006 WRITE ( 17, 101 )
Note: See TracChangeset
for help on using the changeset viewer.
