Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf_ext_write_field.F @ 1939

Last change on this file since 1939 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 13.5 KB

Line
1	!WRF:MEDIATION:IO
2	SUBROUTINE wrf_ext_write_field_arr(DataHandle,DateStr,Var &
3	,Field &
4	,idx4, idx5, idx6, idx7 &
5	,nx4 , nx5 , nx6 &
6	,TypeSizeInBytes &
7	,FieldType,Comm,IOComm &
8	,DomainDesc &
9	,bdy_mask &
10	,dryrun &
11	,MemoryOrder &
12	,Stagger &
13	,Dimname1, Dimname2, Dimname3 &
14	,Desc, Units &
15	,debug_message &
16	,ds1, de1, ds2, de2, ds3, de3 &
17	,ms1, me1, ms2, me2, ms3, me3 &
18	,ps1, pe1, ps2, pe2, ps3, pe3, Status )
19	USE module_io
20	USE module_wrf_error
21	USE module_state_description
22	USE module_timing
23	IMPLICIT NONE
24
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
43
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
48	! Local
49	INTEGER tsfac ! Type size factor
50	CHARACTER*256 mess
51
52	tsfac = TypeSizeInBytes / IWORDSIZE
53
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)
58	ENDIF
59
60	CALL wrf_ext_write_field( DataHandle,DateStr,Var &
61	,Field(1 &
62	+tsfac*(0 &
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)nx5nx4(me3-ms3+1)(me2-ms2+1)*(me1-ms1+1) &
66	+(idx7-1)nx6nx5nx4(me3-ms3+1)(me2-ms2+1)(me1-ms1+1))) &
67	,FieldType,Comm,IOComm &
68	,DomainDesc &
69	,bdy_mask &
70	,dryrun &
71	,MemoryOrder &
72	,Stagger &
73	,Dimname1, Dimname2, Dimname3 &
74	,Desc, Units &
75	,debug_message &
76	,ds1, de1, ds2, de2, ds3, de3 &
77	,ms1, me1, ms2, me2, ms3, me3 &
78	,ps1, pe1, ps2, pe2, ps3, pe3, Status )
79
80	END SUBROUTINE wrf_ext_write_field_arr
81
82
83	SUBROUTINE wrf_ext_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, &
84	DomainDesc, &
85	bdy_mask , &
86	dryrun , &
87	MemoryOrder, &
88	Stagger, &
89	Dimname1, Dimname2, Dimname3 , &
90	Desc, Units, &
91	debug_message , &
92	ds1, de1, ds2, de2, ds3, de3, &
93	ms1, me1, ms2, me2, ms3, me3, &
94	ps1, pe1, ps2, pe2, ps3, pe3, Status )
95	USE module_io
96	USE module_wrf_error
97	USE module_state_description
98	USE module_timing
99	IMPLICIT NONE
100
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
116
117	INTEGER , INTENT(IN ) :: ds1, de1, ds2, de2, ds3, de3, &
118	ms1, me1, ms2, me2, ms3, me3, &
119	ps1, pe1, ps2, pe2, ps3, pe3
120
121	! Local
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
126
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
132
133	IF ( wrf_at_debug_level( 500 ) ) THEN
134	call start_timing
135	ENDIF
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 ;
145
146	dimnames(1) = Dimname1
147	dimnames(2) = Dimname2
148	dimnames(3) = Dimname3
149
150	CALL debug_io_wrf ( debug_message,DateStr, &
151	domain_start,domain_end,patch_start,patch_end, &
152	memory_start,memory_end )
153	#if 0
154	Status = 1
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
164	#endif
165	Status = 0
166
167
168	CALL wrf_write_field ( &
169	DataHandle & ! DataHandle
170	,DateStr & ! DateStr
171	,Var & ! Data Name
172	,Field & ! Field
173	,FieldType & ! FieldType
174	,Comm & ! Comm
175	,IOComm & ! IOComm
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
187	,Status )
188
189	CALL get_handle ( Hndl, io_form , for_out, DataHandle )
190
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
194
195	CALL wrf_put_var_ti_char( &
196	DataHandle & ! DataHandle
197	,"description" & ! Element
198	,Var & ! Data Name
199	,Desc & ! Data
200	,Status )
201	CALL wrf_put_var_ti_char( &
202	DataHandle & ! DataHandle
203	,"units" & ! Element
204	,Var & ! Data Name
205	,Units & ! Data
206	,Status )
207	CALL wrf_put_var_ti_char( &
208	DataHandle & ! DataHandle
209	,"stagger" & ! Element
210	,Var & ! Data Name
211	,Stagger & ! Data
212	,Status )
213	#if (EM_CORE == 1)
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
242	,Var & ! Data Name
243	,"XLONG_U XLAT_U" & ! Data
244	,Status )
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
250	,Var & ! Data Name
251	,"XLONG_V XLAT_V" & ! Data
252	,Status )
253	ENDIF
254	ENDIF
255	IF ( .NOT. horiz_stagger ) THEN
256	CALL wrf_put_var_ti_char( &
257	DataHandle & ! DataHandle
258	,"coordinates" & ! Element
259	,Var & ! Data Name
260	,"XLONG XLAT" & ! Data
261	,Status )
262	ENDIF
263	ENDIF
264	#endif
265	ENDIF
266
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) )
270	ENDIF
271
272	IF ( wrf_at_debug_level( 500 ) ) THEN
273	CALL end_timing('wrf_ext_write_field')
274	ENDIF
275
276	END SUBROUTINE wrf_ext_write_field

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format