2 SUBROUTINE wrf_ext_write_field_arr(DataHandle,DateStr,Var &
4 ,idx4, idx5, idx6, idx7 &
7 ,FieldType,Comm,IOComm &
13 ,Dimname1, Dimname2, Dimname3 &
16 ,ds1, de1, ds2, de2, ds3, de3 &
17 ,ms1, me1, ms2, me2, ms3, me3 &
18 ,ps1, pe1, ps2, pe2, ps3, pe3, Status )
21 USE module_state_description
25 INTEGER, INTENT(IN) :: idx4, idx5, idx6, idx7
26 INTEGER, INTENT(IN) :: nx4 , nx5 , nx6
27 INTEGER, INTENT(IN) :: TypeSizeInBytes
28 INTEGER ,INTENT(IN ) :: DataHandle
29 CHARACTER*(*) ,INTENT(IN ) :: DateStr
30 CHARACTER*(*) ,INTENT(IN ) :: Var
31 INTEGER ,INTENT(IN ) :: Field(*)
32 INTEGER ,INTENT(IN ) :: FieldType
33 INTEGER ,INTENT(IN ) :: Comm
34 INTEGER ,INTENT(IN ) :: IOComm
35 INTEGER ,INTENT(IN ) :: DomainDesc
36 LOGICAL ,INTENT(IN ) :: dryrun
37 CHARACTER*(*) ,INTENT(IN ) :: MemoryOrder
38 LOGICAL, DIMENSION(4) ,INTENT(IN ) :: bdy_mask
39 CHARACTER*(*) ,INTENT(IN ) :: Stagger
40 CHARACTER*(*) ,INTENT(IN ) :: Dimname1, Dimname2, Dimname3
41 CHARACTER*(*) ,INTENT(IN ) :: Desc, Units
42 CHARACTER*(*) ,INTENT(IN ) :: debug_message
44 INTEGER , INTENT(IN ) :: ds1, de1, ds2, de2, ds3, de3, &
45 ms1, me1, ms2, me2, ms3, me3, &
46 ps1, pe1, ps2, pe2, ps3, pe3
47 INTEGER , INTENT(INOUT) :: Status
49 INTEGER tsfac ! Type size factor
52 tsfac = TypeSizeInBytes / IWORDSIZE
54 IF ( tsfac .LE. 0 ) THEN
55 CALL wrf_message('wrf_ext_write_field_arr')
56 WRITE(mess,*)'Internal error: email this message to wrfhelp@ucar.edu ',TypeSizeInBytes,IWORDSIZE
57 CALL wrf_error_fatal(mess)
60 CALL wrf_ext_write_field( DataHandle,DateStr,Var &
63 +(idx4-1)*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1) &
64 +(idx5-1)*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1) &
65 +(idx6-1)*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1) &
66 +(idx7-1)*nx6*nx5*nx4*(me3-ms3+1)*(me2-ms2+1)*(me1-ms1+1))) &
67 ,FieldType,Comm,IOComm &
73 ,Dimname1, Dimname2, Dimname3 &
76 ,ds1, de1, ds2, de2, ds3, de3 &
77 ,ms1, me1, ms2, me2, ms3, me3 &
78 ,ps1, pe1, ps2, pe2, ps3, pe3, Status )
80 END SUBROUTINE wrf_ext_write_field_arr
83 SUBROUTINE wrf_ext_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, &
89 Dimname1, Dimname2, Dimname3 , &
92 ds1, de1, ds2, de2, ds3, de3, &
93 ms1, me1, ms2, me2, ms3, me3, &
94 ps1, pe1, ps2, pe2, ps3, pe3, Status )
97 USE module_state_description
101 INTEGER ,INTENT(IN ) :: DataHandle
102 CHARACTER*(*) ,INTENT(IN ) :: DateStr
103 CHARACTER*(*) ,INTENT(IN ) :: Var
104 INTEGER ,INTENT(IN ) :: Field(*)
105 INTEGER ,INTENT(IN ) :: FieldType
106 INTEGER ,INTENT(IN ) :: Comm
107 INTEGER ,INTENT(IN ) :: IOComm
108 INTEGER ,INTENT(IN ) :: DomainDesc
109 LOGICAL ,INTENT(IN ) :: dryrun
110 CHARACTER*(*) ,INTENT(IN ) :: MemoryOrder
111 LOGICAL, DIMENSION(4) ,INTENT(IN ) :: bdy_mask
112 CHARACTER*(*) ,INTENT(IN ) :: Stagger
113 CHARACTER*(*) ,INTENT(IN ) :: Dimname1, Dimname2, Dimname3
114 CHARACTER*(*) ,INTENT(IN ) :: Desc, Units
115 CHARACTER*(*) ,INTENT(IN ) :: debug_message
117 INTEGER , INTENT(IN ) :: ds1, de1, ds2, de2, ds3, de3, &
118 ms1, me1, ms2, me2, ms3, me3, &
119 ps1, pe1, ps2, pe2, ps3, pe3
122 INTEGER , DIMENSION(3) :: domain_start , domain_end
123 INTEGER , DIMENSION(3) :: memory_start , memory_end
124 INTEGER , DIMENSION(3) :: patch_start , patch_end
125 CHARACTER*80 , DIMENSION(3) :: dimnames
127 integer ,intent(inout) :: Status
128 LOGICAL for_out, horiz_stagger
129 INTEGER Hndl, io_form
130 LOGICAL, EXTERNAL :: has_char
131 INTEGER, EXTERNAL :: use_package
133 IF ( wrf_at_debug_level( 500 ) ) THEN
136 domain_start(1) = ds1 ; domain_end(1) = de1 ;
137 patch_start(1) = ps1 ; patch_end(1) = pe1 ;
138 memory_start(1) = ms1 ; memory_end(1) = me1 ;
139 domain_start(2) = ds2 ; domain_end(2) = de2 ;
140 patch_start(2) = ps2 ; patch_end(2) = pe2 ;
141 memory_start(2) = ms2 ; memory_end(2) = me2 ;
142 domain_start(3) = ds3 ; domain_end(3) = de3 ;
143 patch_start(3) = ps3 ; patch_end(3) = pe3 ;
144 memory_start(3) = ms3 ; memory_end(3) = me3 ;
146 dimnames(1) = Dimname1
147 dimnames(2) = Dimname2
148 dimnames(3) = Dimname3
150 CALL debug_io_wrf ( debug_message,DateStr, &
151 domain_start,domain_end,patch_start,patch_end, &
152 memory_start,memory_end )
155 if ( de1 - ds1 < 0 ) return
156 if ( de2 - ds2 < 0 ) return
157 if ( de3 - ds3 < 0 ) return
158 if ( pe1 - ps1 < 0 ) return
159 if ( pe2 - ps2 < 0 ) return
160 if ( pe3 - ps3 < 0 ) return
161 if ( me1 - ms1 < 0 ) return
162 if ( me2 - ms2 < 0 ) return
163 if ( me3 - ms3 < 0 ) return
168 CALL wrf_write_field ( &
169 DataHandle & ! DataHandle
173 ,FieldType & ! FieldType
176 ,DomainDesc & ! DomainDesc
177 ,bdy_mask & ! bdy_mask
178 ,MemoryOrder & ! MemoryOrder
179 ,Stagger & ! JMMODS 010620
180 ,dimnames & ! JMMODS 001109
181 ,domain_start & ! DomainStart
182 ,domain_end & ! DomainEnd
183 ,memory_start & ! MemoryStart
184 ,memory_end & ! MemoryEnd
185 ,patch_start & ! PatchStart
186 ,patch_end & ! PatchEnd
189 CALL get_handle ( Hndl, io_form , for_out, DataHandle )
191 IF ( ( dryrun .AND. ( use_package(io_form) .EQ. IO_NETCDF .OR. &
192 use_package(io_form) .EQ. IO_PNETCDF ) ) .OR. &
193 ( use_package(io_form) .EQ. IO_PHDF5 ) ) THEN
195 CALL wrf_put_var_ti_char( &
196 DataHandle & ! DataHandle
197 ,"description" & ! Element
201 CALL wrf_put_var_ti_char( &
202 DataHandle & ! DataHandle
207 CALL wrf_put_var_ti_char( &
208 DataHandle & ! DataHandle
209 ,"stagger" & ! Element
214 ! TBH: Added "coordinates" metadata for GIS folks in RAL. It is a step
215 ! TBH: towards CF. This change was requested by Jennifer Boehnert based
216 ! TBH: upon a suggestion from Nawajish Noman.
217 ! TBH: TODO: This code depends upon longitude and latitude arrays being
218 ! TBH: named "XLONG", "XLAT", "XLONG_U", "XLAT_U", "XLONG_V", and
219 ! TBH: "XLAT_V" for EM_CORE. We need a more general way to handle
220 ! TBH: this, possibly via the Registry.
221 ! TBH: TODO: Leave this on all the time or make it namelist-selectable?
222 ! TBH: TODO: Use dimnames(*) == south_north || west_east instead of
223 ! TBH: MemoryOrder and Stagger? It would also work for both ARW
224 ! TBH: and NMM and be easier to handle via Registry...
225 ! IF ( ( ( MemoryOrder(1:2) == 'XY' ) .OR. &
226 ! ( MemoryOrder(1:3) == 'XZY' ) ) .AND. &
227 ! ( Var(1:5) /= 'XLONG' ) .AND. &
228 ! ( Var(1:4) /= 'XLAT' ) ) THEN
229 ! JM used trim instead, to avoid spurious errors when bounds checking on
230 IF ( ( ( TRIM(MemoryOrder) == 'XY' ) .OR. &
231 ( TRIM(MemoryOrder) == 'XZY' ) .OR. &
232 ( TRIM(MemoryOrder) == 'XYZ' ) ) .AND. &
233 ( TRIM(Var) /= 'XLONG' ) .AND. &
234 ( TRIM(Var) /= 'XLAT' ) ) THEN
235 horiz_stagger = .FALSE.
236 IF ( LEN_TRIM(Stagger) == 1 ) THEN
237 IF ( has_char( Stagger, 'x' ) ) THEN
238 horiz_stagger = .TRUE.
239 CALL wrf_put_var_ti_char( &
240 DataHandle & ! DataHandle
241 ,"coordinates" & ! Element
243 ,"XLONG_U XLAT_U" & ! Data
245 ELSE IF ( has_char( Stagger, 'y' ) ) THEN
246 horiz_stagger = .TRUE.
247 CALL wrf_put_var_ti_char( &
248 DataHandle & ! DataHandle
249 ,"coordinates" & ! Element
251 ,"XLONG_V XLAT_V" & ! Data
255 IF ( .NOT. horiz_stagger ) THEN
256 CALL wrf_put_var_ti_char( &
257 DataHandle & ! DataHandle
258 ,"coordinates" & ! Element
260 ,"XLONG XLAT" & ! Data
267 IF ( wrf_at_debug_level(300) ) THEN
268 WRITE(wrf_err_message,*) debug_message,' Status = ',Status
269 CALL wrf_message ( TRIM(wrf_err_message) )
272 IF ( wrf_at_debug_level( 500 ) ) THEN
273 CALL end_timing('wrf_ext_write_field')
276 END SUBROUTINE wrf_ext_write_field