source: palm/trunk/UTIL/read_palm_netcdf_data.f90 @ 2696

Last change on this file since 2696 was 2696, checked in by kanani, 6 years ago

Merge of branch palm4u into trunk

  • Property svn:keywords set to Id
File size: 7.2 KB
RevLine 
[6]1 PROGRAM read_palm_netcdf_data
2
[2696]3!------------------------------------------------------------------------------!
4! This file is part of the PALM model system.
[1046]5!
[2696]6! PALM is free software: you can redistribute it and/or modify it under the
7! terms of the GNU General Public License as published by the Free Software
8! Foundation, either version 3 of the License, or (at your option) any later
9! version.
[1046]10!
11! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
12! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14!
15! You should have received a copy of the GNU General Public License along with
16! PALM. If not, see <http://www.gnu.org/licenses/>.
17!
[2696]18! Copyright 1997-2017  Leibniz Universitaet Hannover
19!------------------------------------------------------------------------------!
[1046]20!
21! Current revisions:
22! -----------------
23!
24! Former revisions:
25! -----------------
26! $Id: read_palm_netcdf_data.f90 2696 2017-12-14 17:12:51Z kanani $
27!
[1047]28! 1046 2012-11-09 14:38:45Z maronga
29! code put under GPL (PALM 3.9)
30!
[1046]31! Description:
32! ------------                     
[6]33! This is an example program for reading PALM 2d/3d NetCDF datasets
34!
35! The user has to add his own code for further storing and analyzing of
36! these data!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
37!
38! The NetCDF include file and library has to be given with the respective
39! compiler options. Please find out the respective paths on your system and
40! set them appropriately.
41!
42! Here are some examples how this routine should be compiled:
43!
44! decalpha:
45!    f95 -fast -r8 -I/usr/local/netcdf-3.5.1/include
46!    -L/usr/local/netcdf-3.5.1/lib -lnetcdf
47! IBM-Regatta:
48!    xlf95 -qrealsize=8 -q64 -qmaxmem=-1 -Q
49!    -I /aws/dataformats/netcdf-3.6.0-p1/64-32/include
50!    -L/aws/dataformats/netcdf-3.6.0-p1/64-32/lib -lnetcdf -O3
51! IBM-Regatta KISTI:
52!    xlf95 -qrealsize=8 -q64 -qmaxmem=-1 -Q
53!    -I /applic/netcdf64/src/f90
54!    -L/applic/lib/NETCDF64 -lnetcdf -O3
55! IBM-Regatta Yonsei (gfdl5):
56!    xlf95 -qrealsize=8 -q64 -qmaxmem=-1 -Q
57!    -I /usr1/users/raasch/pub/netcdf-3.6.0-p1/include
58!    -L/usr1/users/raasch/pub/netcdf-3.6.0-p1/lib -lnetcdf -O3
59! IMUK:
60!    ifort read_palm...f90 -o read_palm...x
61!    -I /muksoft/packages/netcdf/linux/include -axW -r8 -nbs
62!    -Vaxlib -L /muksoft/packages/netcdf/linux/lib -lnetcdf
63! NEC-SX6:
64!    sxf90 read_palm...f90 -o read_palm...x
65!    -I /pool/SX-6/netcdf/netcdf-3.6.0-p1/include  -C hopt -Wf '-A idbl4'
66!    -L/pool/SX-6/netcdf/netcdf-3.6.0-p1/lib -lnetcdf
67!------------------------------------------------------------------------------!
68
69    USE netcdf
70
71    IMPLICIT NONE
72
73!
74!-- Local variables
75    CHARACTER (LEN=10)   ::  dimname(4), var_name
76    CHARACTER (LEN=40)   ::  filename
77
78    CHARACTER (LEN=2000) ::  title, var_list
79
80    INTEGER ::  i, j, k, nc_stat, pos, time_step
81
82    INTEGER ::  current_level, current_var, id_set, id_var_time, num_var
83
84    INTEGER, DIMENSION(4) ::  id_dims, id_dims_loc, levels
85
86    INTEGER, DIMENSION(1000) ::  id_var
87
88    REAL ::  time(1)
89
90    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  data_array
91
92
93    PRINT*, '*** Please type NetCDF filename to be read:'
94    READ*, filename
95
96    nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set )
97    IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 1 )
98
99!
100!-- Get the run description header and output
101    title = ' '
102    nc_stat = NF90_GET_ATT( id_set, NF90_GLOBAL, 'title', title )
103    IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 2 )
104    WRITE (*,'(/A/A)')  '*** file created by:', TRIM( title )
105
106!
107!-- Get the list of variables (order of variables corresponds with the
108!-- order of data on the binary file)
109    var_list = ' '    ! GET_ATT does not assign trailing blanks
110    nc_stat = NF90_GET_ATT( id_set, NF90_GLOBAL, 'VAR_LIST', var_list )
111    IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 3 )
112
113!
114!-- Inquire id of the time coordinate variable
115    nc_stat = NF90_INQ_VARID( id_set, 'time', id_var_time )
116    IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 4 )
117
118!
119!-- Count number of variables; there is one more semicolon in the
120!-- string than variable names
121    num_var = -1
122    DO  i = 1, LEN( var_list )
123       IF ( var_list(i:i) == ';' )  num_var = num_var + 1
124    ENDDO
125    WRITE (*,'(/A,I3,A/)')  '*** file contains ', num_var, ' variable(s)'
126
127
128    pos = INDEX( var_list, ';' )
129!
130!-- Loop over all variables
131    DO  i = 1, num_var
132
133!
134!--    Extract variable name from list
135       var_list = var_list(pos+1:)
136       pos = INDEX( var_list, ';' )
137       var_name = var_list(1:pos-1)
138
139!
140!--    Get variable ID from name
141       nc_stat = NF90_INQ_VARID( id_set, TRIM( var_name ), id_var(i) )
142       IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 5 )
143
144!
145!--    Inquire the dimension IDs
146       nc_stat = NF90_INQUIRE_VARIABLE( id_set, id_var(i), &
147                                        dimids = id_dims_loc )
148       IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 6 )
149       id_dims = id_dims_loc
150
151!
152!--    Get number of x/y/z/time levels(gridpoints) for that variable
153       DO  j = 1, 4
154          nc_stat = NF90_INQUIRE_DIMENSION( id_set, id_dims(j),&
155                                            dimname(j), levels(j) )
156          IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 7 )
157       ENDDO
158
159       WRITE (*,100)  '*** reading variable "', TRIM(var_name),         &
160                      '", dimensioned as', TRIM(var_name), levels(1)-1, &
161                      levels(2)-1, levels(3)-1
162100    FORMAT (A,A,A/4X,A,'(0:',I4,',0:',I4,',0:',I4,')   (x/y/z)'/)
163
164!
165!--    Allocate the data array to be read
166       ALLOCATE( data_array(0:levels(1)-1,0:levels(2)-1,0:levels(3)-1) )
167
168!
169!--    Read the data from file for each timestep
170       DO  j = 1, levels(4)
171
172!
173!--        Get the time of the current timelevel and output
174           nc_stat = NF90_GET_VAR( id_set, id_var_time, time, start = (/ j /), &
175                                   count = (/ 1 /) )
176
177           IF ( nc_stat /= NF90_NOERR )  CALL handle_netcdf_error( 7+i )
178
179           WRITE (*,'(A,I3,A,F8.1,A)')  '    reading timelevel ', i, &
180                                        '    time = ', time(1), ' s'     
181
182           nc_stat = NF90_GET_VAR( id_set, id_var(i),                    &
183                                   data_array, start = (/ 1, 1, 1, j /), &
184                             count = (/ levels(1), levels(2), levels(3), 1 /) )
185
186           IF ( nc_stat /= NF90_NOERR )  &
187                                       CALL handle_netcdf_error( 7+levels(4)+i )
188!
189!--        ADD YOUR OWN CODE FOR FURTHER STORING OF THESE DATA HERE
190!--        --------------------------------------------------------
191
192
193       ENDDO
194
195       WRITE (*,'(/)')
196
197       DEALLOCATE( data_array )
198
199    ENDDO
200
201
202
203 CONTAINS
204
205
206    SUBROUTINE handle_netcdf_error( errno )
207!
208!--    Prints out a text message corresponding to the current NetCDF status
209
210       IMPLICIT NONE
211
212       INTEGER, INTENT(IN) ::  errno
213
214       IF ( nc_stat /= NF90_NOERR )  THEN
215          WRITE (*,'(A,1X,I3/4X,A)')                                           &
216                                   '+++ read_palm_netcdf_data  error handle:', &
217                                   errno, TRIM( nf90_strerror( nc_stat ) )
218          STOP
219       ENDIF
220
221    END SUBROUTINE handle_netcdf_error
222
223
224 END PROGRAM read_palm_netcdf_data
225
226
227
Note: See TracBrowser for help on using the repository browser.