field_routines.F90
References to this file elsewhere.
1 !*------------------------------------------------------------------------------
2 !* Standard Disclaimer
3 !*
4 !* Forecast Systems Laboratory
5 !* NOAA/OAR/ERL/FSL
6 !* 325 Broadway
7 !* Boulder, CO 80303
8 !*
9 !* AVIATION DIVISION
10 !* ADVANCED COMPUTING BRANCH
11 !* SMS/NNT Version: 2.0.0
12 !*
13 !* This software and its documentation are in the public domain and
14 !* are furnished "as is". The United States government, its
15 !* instrumentalities, officers, employees, and agents make no
16 !* warranty, express or implied, as to the usefulness of the software
17 !* and documentation for any purpose. They assume no
18 !* responsibility (1) for the use of the software and documentation;
19 !* or (2) to provide technical support to users.
20 !*
21 !* Permission to use, copy, modify, and distribute this software is
22 !* hereby granted, provided that this disclaimer notice appears in
23 !* all copies. All modifications to this software must be clearly
24 !* documented, and are solely the responsibility of the agent making
25 !* the modification. If significant modifications or enhancements
26 !* are made to this software, the SMS Development team
27 !* (sms-info@fsl.noaa.gov) should be notified.
28 !*
29 !*----------------------------------------------------------------------------
30 !*
31 !* WRF NetCDF I/O
32 ! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov
33 !* Date: October 6, 2000
34 !*
35 !*----------------------------------------------------------------------------
36 subroutine ext_ncd_RealFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
37 use wrf_data
38 use ext_ncd_support_routines
39 implicit none
40 include 'wrf_status_codes.h'
41 include 'netcdf.inc'
42 character (*) ,intent(in) :: IO
43 integer ,intent(in) :: NCID
44 integer ,intent(in) :: VarID
45 integer ,dimension(NVarDims),intent(in) :: VStart
46 integer ,dimension(NVarDims),intent(in) :: VCount
47 real, dimension(*) ,intent(inout) :: Data
48 integer ,intent(out) :: Status
49 integer :: stat
50
51 if(IO == 'write') then
52 stat = NF_PUT_VARA_REAL(NCID,VarID,VStart,VCount,Data)
53 else
54 stat = NF_GET_VARA_REAL(NCID,VarID,VStart,VCount,Data)
55 endif
56 call netcdf_err(stat,Status)
57 if(Status /= WRF_NO_ERR) then
58 write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
59 call wrf_debug ( WARN , msg)
60 endif
61 return
62 end subroutine ext_ncd_RealFieldIO
63
64 subroutine ext_ncd_DoubleFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
65 use wrf_data
66 use ext_ncd_support_routines
67 implicit none
68 include 'wrf_status_codes.h'
69 include 'netcdf.inc'
70 character (*) ,intent(in) :: IO
71 integer ,intent(in) :: NCID
72 integer ,intent(in) :: VarID
73 integer ,dimension(NVarDims),intent(in) :: VStart
74 integer ,dimension(NVarDims),intent(in) :: VCount
75 real*8 ,intent(inout) :: Data
76 integer ,intent(out) :: Status
77 integer :: stat
78
79 if(IO == 'write') then
80 stat = NF_PUT_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data)
81 else
82 stat = NF_GET_VARA_DOUBLE(NCID,VarID,VStart,VCount,Data)
83 endif
84 call netcdf_err(stat,Status)
85 if(Status /= WRF_NO_ERR) then
86 write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
87 call wrf_debug ( WARN , msg)
88 endif
89 return
90 end subroutine ext_ncd_DoubleFieldIO
91
92 subroutine ext_ncd_IntFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
93 use wrf_data
94 use ext_ncd_support_routines
95 implicit none
96 include 'wrf_status_codes.h'
97 include 'netcdf.inc'
98 character (*) ,intent(in) :: IO
99 integer ,intent(in) :: NCID
100 integer ,intent(in) :: VarID
101 integer ,dimension(NVarDims),intent(in) :: VStart
102 integer ,dimension(NVarDims),intent(in) :: VCount
103 integer ,intent(inout) :: Data
104 integer ,intent(out) :: Status
105 integer :: stat
106
107 if(IO == 'write') then
108 stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Data)
109 else
110 stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Data)
111 endif
112 call netcdf_err(stat,Status)
113 if(Status /= WRF_NO_ERR) then
114 write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
115 call wrf_debug ( WARN , msg)
116 endif
117 return
118 end subroutine ext_ncd_IntFieldIO
119
120 subroutine ext_ncd_LogicalFieldIO(IO,NCID,VarID,VStart,VCount,Data,Status)
121 use wrf_data
122 use ext_ncd_support_routines
123 implicit none
124 include 'wrf_status_codes.h'
125 include 'netcdf.inc'
126 character (*) ,intent(in) :: IO
127 integer ,intent(in) :: NCID
128 integer ,intent(in) :: VarID
129 integer,dimension(NVarDims) ,intent(in) :: VStart
130 integer,dimension(NVarDims) ,intent(in) :: VCount
131 logical,dimension(VCount(1),VCount(2),VCount(3)),intent(inout) :: Data
132 integer ,intent(out) :: Status
133 integer,dimension(:,:,:),allocatable :: Buffer
134 integer :: stat
135 integer :: i,j,k
136
137 allocate(Buffer(VCount(1),VCount(2),VCount(3)), STAT=stat)
138 if(stat/= 0) then
139 Status = WRF_ERR_FATAL_ALLOCATION_ERROR
140 write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
141 call wrf_debug ( FATAL , msg)
142 return
143 endif
144 if(IO == 'write') then
145 do k=1,VCount(3)
146 do j=1,VCount(2)
147 do i=1,VCount(1)
148 if(data(i,j,k)) then
149 Buffer(i,j,k)=1
150 else
151 Buffer(i,j,k)=0
152 endif
153 enddo
154 enddo
155 enddo
156 stat = NF_PUT_VARA_INT(NCID,VarID,VStart,VCount,Buffer)
157 else
158 stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Buffer)
159 Data = Buffer == 1
160 endif
161 call netcdf_err(stat,Status)
162 if(Status /= WRF_NO_ERR) then
163 write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
164 call wrf_debug ( WARN , msg)
165 return
166 endif
167 deallocate(Buffer, STAT=stat)
168 if(stat/= 0) then
169 Status = WRF_ERR_FATAL_DEALLOCATION_ERR
170 write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
171 call wrf_debug ( FATAL , msg)
172 return
173 endif
174 return
175 end subroutine ext_ncd_LogicalFieldIO