source: palm/trunk/SOURCE/print_1d.f90 @ 1683

Last change on this file since 1683 was 1683, checked in by knoop, 8 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 6.0 KB
Line 
1!> @file print_1d.f90
2!--------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms
6! of the GNU General Public License as published by the Free Software Foundation,
7! either version 3 of the License, or (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with
14! PALM. If not, see <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2014 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------!
18!
19! Current revisions:
20! -----------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: print_1d.f90 1683 2015-10-07 23:57:51Z knoop $
26!
27! 1682 2015-10-07 23:56:08Z knoop
28! Code annotations made doxygen readable
29!
30! 1320 2014-03-20 08:40:49Z raasch
31! ONLY-attribute added to USE-statements,
32! kind-parameters added to all INTEGER and REAL declaration statements,
33! kinds are defined in new module kinds,
34! old module precision_kind is removed,
35! revision history before 2012 removed,
36! comment fields (!:) to be used for variable explanations added to
37! all variable declaration statements
38!
39! 1318 2014-03-17 13:35:16Z raasch
40! barrier argument removed from cpu_log,
41! module interfaces removed
42!
43! 1036 2012-10-22 13:43:42Z raasch
44! code put under GPL (PALM 3.9)
45!
46! RCS Log replace by Id keyword, revision history cleaned up
47!
48! Revision 1.1  1997/09/19 07:45:22  raasch
49! Initial revision
50!
51!
52! Description:
53! ------------
54!> List output of 1D-profiles.
55!------------------------------------------------------------------------------!
56 SUBROUTINE print_1d
57 
58
59    USE arrays_3d,                                                             &
60        ONLY:  zu, zw
61
62    USE control_parameters,                                                    &
63        ONLY:  run_description_header, simulated_time_chr
64
65    USE cpulog,                                                                &
66        ONLY:  cpu_log, log_point
67
68    USE indices,                                                               &
69        ONLY:  nzb, nzt
70
71    USE kinds
72
73    USE pegrid
74
75    USE statistics,                                                            &
76        ONLY:  flow_statistics_called, hom, region, statistic_regions
77
78    IMPLICIT NONE
79
80
81    CHARACTER (LEN=20) ::  period_chr  !<
82
83    INTEGER(iwp) ::  k   !<
84    INTEGER(iwp) ::  sr  !<
85
86
87!
88!-- If required, compute statistics.
89    IF ( .NOT. flow_statistics_called )  CALL flow_statistics
90
91!
92!-- Flow_statistics has its own cpu-time measuring.
93    CALL cpu_log( log_point(18), 'print_1d', 'start' )
94
95    IF ( myid == 0 )  THEN
96!
97!--    Open file for list output of profiles.
98       CALL check_open( 16 )
99
100!
101!--    Prepare header.
102       period_chr = ' no time-average!'
103
104!
105!--    Output for the total domain (and each subregion, if applicable).
106       DO  sr = 0, statistic_regions
107!
108!--       Write header.
109          WRITE ( 16, 112 )
110          WRITE ( 16, 100 )  TRIM( run_description_header ) // '    ' // &
111                             TRIM( region( sr ) ), TRIM( period_chr ), 'uv'
112          WRITE ( 16, 105 )  TRIM( simulated_time_chr )
113!          ELSE
114!             WRITE ( 16, 106 )  TRIM( simulated_time_chr ),           &
115!                                averaging_interval_pr, average_count_pr
116!          ENDIF
117          WRITE ( 16, 111 )
118
119!
120!--       Output of values on the scalar levels.
121          WRITE ( 16, 120 )
122          WRITE ( 16, 111 )
123          DO  k = nzt+1, nzb, -1
124             WRITE ( 16, 121)  k, zu(k), hom(k,1,1,sr),           &
125                               hom(k,1,1,sr) - hom(k,1,5,sr),     &
126                               hom(k,1,2,sr),                     &
127                               hom(k,1,2,sr) - hom(k,1,6,sr),     &
128                               hom(k,1,4,sr),                     &
129                               hom(k,1,4,sr) - hom(k,1,7,sr),     &
130                               hom(k,1,8,sr), hom(k,1,9,sr),      &
131                               hom(k,1,10,sr), hom(k,1,11,sr), zu(k), k
132          ENDDO
133          WRITE ( 16, 111 )
134          WRITE ( 16, 120 )
135          WRITE ( 16, 111 )
136
137!
138!--       Output of values on the w-levels.
139          WRITE ( 16, 112 )
140          WRITE ( 16, 100 )  TRIM( run_description_header ) // '    ' // &
141                             TRIM( region( sr ) ), TRIM( period_chr ), 'w'
142          WRITE ( 16, 105 )  TRIM( simulated_time_chr )
143!          ELSE
144!             WRITE ( 16, 106 )  TRIM( simulated_time_chr ),           &
145!                                averaging_interval_pr, average_count_pr
146!          ENDIF
147          WRITE ( 16, 111 )
148
149          WRITE ( 16, 130 )
150          WRITE ( 16, 111 )
151          DO  k = nzt+1, nzb, -1
152             WRITE ( 16, 131)  k, zw(k), hom(k,1,16,sr),            &
153                               hom(k,1,18,sr), hom(k,1,12,sr), &
154                               hom(k,1,19,sr), hom(k,1,14,sr), &
155                               hom(k,1,20,sr), zw(k), k
156          ENDDO
157          WRITE ( 16, 111 )
158          WRITE ( 16, 130 )
159          WRITE ( 16, 111 )
160
161       ENDDO
162
163    ENDIF
164
165    CALL cpu_log( log_point(18), 'print_1d', 'stop' )
166
167!
168!-- Formats.
169100 FORMAT (1X,A/1X,10('-')/ &
170            ' Horizontally',A,' averaged profiles on the ',A,'-level')
171105 FORMAT (' Time: ',A)
172106 FORMAT (' Time: ',A,18X,'averaged over',F7.1,' s (',I4, &
173            ' Single times)')
174111 FORMAT (1X,131('-'))
175112 FORMAT (/)
176120 FORMAT ('   k     zu      u     du     v     dv     pt    dpt    ', &
177            'e      Km    Kh     l      zu      k')
178121 FORMAT (1X,I4,1X,F7.1,1X,F6.2,1X,F5.2,1X,F6.2,1X,F5.2,2X,F6.2,1X,F5.2, &
179            1X,F6.4,1X,F5.2,1X,F5.2,1X,F6.2,1X,F7.1,2X,I4)
180130 FORMAT ('   k     zw      w''pt''     wpt       w''u''      wu       ', &
181            ' w''v''      wv        zw      k')
182131 FORMAT (1X,I4,1X,F7.1,6(1X,E9.3),1X,F7.1,2X,I4)
183
184
185 END SUBROUTINE print_1d
Note: See TracBrowser for help on using the repository browser.