wrf_ext_write_field.F
References to this file elsewhere.
1 !WRF:MEDIATION:IO
2 SUBROUTINE wrf_ext_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm,IOComm, &
3 DomainDesc, &
4 bdy_mask , &
5 dryrun , &
6 MemoryOrder, &
7 Stagger, &
8 Dimname1, Dimname2, Dimname3 , &
9 Desc, Units, &
10 debug_message , &
11 ds1, de1, ds2, de2, ds3, de3, &
12 ms1, me1, ms2, me2, ms3, me3, &
13 ps1, pe1, ps2, pe2, ps3, pe3, Status )
14 USE module_io
15 USE module_wrf_error
16 USE module_state_description
17 USE module_timing
18 IMPLICIT NONE
19
20 INTEGER itrace
21 integer :: DataHandle
22 character*(*) :: DateStr
23 character*(*) :: Var
24 integer :: Field(*)
25 integer :: FieldType
26 integer :: Comm
27 integer :: IOComm
28 integer :: DomainDesc
29 logical :: dryrun
30 character*(*) :: MemoryOrder
31 logical, dimension(4) :: bdy_mask
32 character*(*) :: Stagger
33 character*(*) :: Dimname1, Dimname2, Dimname3
34 character*(*) :: Desc, Units
35 character*(*) :: debug_message
36
37 INTEGER , INTENT(IN ) :: ds1, de1, ds2, de2, ds3, de3, &
38 ms1, me1, ms2, me2, ms3, me3, &
39 ps1, pe1, ps2, pe2, ps3, pe3
40
41
42 INTEGER , DIMENSION(3) :: domain_start , domain_end
43 INTEGER , DIMENSION(3) :: memory_start , memory_end
44 INTEGER , DIMENSION(3) :: patch_start , patch_end
45 CHARACTER*80 , DIMENSION(3) :: dimnames
46
47 integer ,intent(inout) :: Status
48 LOGICAL for_out, horiz_stagger
49 INTEGER Hndl, io_form
50 LOGICAL, EXTERNAL :: has_char
51 INTEGER, EXTERNAL :: use_package
52
53 IF ( wrf_at_debug_level( 500 ) ) THEN
54 call start_timing
55 ENDIF
56 domain_start(1) = ds1 ; domain_end(1) = de1 ;
57 patch_start(1) = ps1 ; patch_end(1) = pe1 ;
58 memory_start(1) = ms1 ; memory_end(1) = me1 ;
59 domain_start(2) = ds2 ; domain_end(2) = de2 ;
60 patch_start(2) = ps2 ; patch_end(2) = pe2 ;
61 memory_start(2) = ms2 ; memory_end(2) = me2 ;
62 domain_start(3) = ds3 ; domain_end(3) = de3 ;
63 patch_start(3) = ps3 ; patch_end(3) = pe3 ;
64 memory_start(3) = ms3 ; memory_end(3) = me3 ;
65
66 dimnames(1) = Dimname1
67 dimnames(2) = Dimname2
68 dimnames(3) = Dimname3
69
70 CALL debug_io_wrf ( debug_message,DateStr, &
71 domain_start,domain_end,patch_start,patch_end, &
72 memory_start,memory_end )
73 Status = 1
74 if ( de1 - ds1 < 0 ) return
75 if ( de2 - ds2 < 0 ) return
76 if ( de3 - ds3 < 0 ) return
77 if ( pe1 - ps1 < 0 ) return
78 if ( pe2 - ps2 < 0 ) return
79 if ( pe3 - ps3 < 0 ) return
80 if ( me1 - ms1 < 0 ) return
81 if ( me2 - ms2 < 0 ) return
82 if ( me3 - ms3 < 0 ) return
83 Status = 0
84
85
86 CALL wrf_write_field ( &
87 DataHandle & ! DataHandle
88 ,DateStr & ! DateStr
89 ,Var & ! Data Name
90 ,Field & ! Field
91 ,FieldType & ! FieldType
92 ,Comm & ! Comm
93 ,IOComm & ! IOComm
94 ,DomainDesc & ! DomainDesc
95 ,bdy_mask & ! bdy_mask
96 ,MemoryOrder & ! MemoryOrder
97 ,Stagger & ! JMMODS 010620
98 ,dimnames & ! JMMODS 001109
99 ,domain_start & ! DomainStart
100 ,domain_end & ! DomainEnd
101 ,memory_start & ! MemoryStart
102 ,memory_end & ! MemoryEnd
103 ,patch_start & ! PatchStart
104 ,patch_end & ! PatchEnd
105 ,Status )
106
107 CALL get_handle ( Hndl, io_form , for_out, DataHandle )
108
109 IF ( ( dryrun .AND. ( use_package(io_form) .EQ. IO_NETCDF .OR. &
110 use_package(io_form) .EQ. IO_PNETCDF ) ) .OR. &
111 ( use_package(io_form) .EQ. IO_PHDF5 ) ) THEN
112
113 CALL wrf_put_var_ti_char( &
114 DataHandle & ! DataHandle
115 ,"description" & ! Element
116 ,Var & ! Data Name
117 ,Desc & ! Data
118 ,Status )
119 CALL wrf_put_var_ti_char( &
120 DataHandle & ! DataHandle
121 ,"units" & ! Element
122 ,Var & ! Data Name
123 ,Units & ! Data
124 ,Status )
125 CALL wrf_put_var_ti_char( &
126 DataHandle & ! DataHandle
127 ,"stagger" & ! Element
128 ,Var & ! Data Name
129 ,Stagger & ! Data
130 ,Status )
131 #if (EM_CORE == 1)
132 ! TBH: Added "coordinates" metadata for GIS folks in RAL. It is a step
133 ! TBH: towards CF. This change was requested by Jennifer Boehnert based
134 ! TBH: upon a suggestion from Nawajish Noman.
135 ! TBH: TODO: This code depends upon longitude and latitude arrays being
136 ! TBH: named "XLONG", "XLAT", "XLONG_U", "XLAT_U", "XLONG_V", and
137 ! TBH: "XLAT_V" for EM_CORE. We need a more general way to handle
138 ! TBH: this, possibly via the Registry.
139 ! TBH: TODO: Leave this on all the time or make it namelist-selectable?
140 ! TBH: TODO: Use dimnames(*) == south_north || west_east instead of
141 ! TBH: MemoryOrder and Stagger? It would also work for both ARW
142 ! TBH: and NMM and be easier to handle via Registry...
143 ! IF ( ( ( MemoryOrder(1:2) == 'XY' ) .OR. &
144 ! ( MemoryOrder(1:3) == 'XZY' ) ) .AND. &
145 ! ( Var(1:5) /= 'XLONG' ) .AND. &
146 ! ( Var(1:4) /= 'XLAT' ) ) THEN
147 ! JM used trim instead, to avoid spurious errors when bounds checking on
148 IF ( ( ( TRIM(MemoryOrder) == 'XY' ) .OR. &
149 ( TRIM(MemoryOrder) == 'XZY' ) ) .AND. &
150 ( TRIM(Var) /= 'XLONG' ) .AND. &
151 ( TRIM(Var) /= 'XLAT' ) ) THEN
152 horiz_stagger = .FALSE.
153 IF ( LEN_TRIM(Stagger) == 1 ) THEN
154 IF ( has_char( Stagger, 'x' ) ) THEN
155 horiz_stagger = .TRUE.
156 CALL wrf_put_var_ti_char( &
157 DataHandle & ! DataHandle
158 ,"coordinates" & ! Element
159 ,Var & ! Data Name
160 ,"XLONG_U XLAT_U" & ! Data
161 ,Status )
162 ELSE IF ( has_char( Stagger, 'y' ) ) THEN
163 horiz_stagger = .TRUE.
164 CALL wrf_put_var_ti_char( &
165 DataHandle & ! DataHandle
166 ,"coordinates" & ! Element
167 ,Var & ! Data Name
168 ,"XLONG_V XLAT_V" & ! Data
169 ,Status )
170 ENDIF
171 ENDIF
172 IF ( .NOT. horiz_stagger ) THEN
173 CALL wrf_put_var_ti_char( &
174 DataHandle & ! DataHandle
175 ,"coordinates" & ! Element
176 ,Var & ! Data Name
177 ,"XLONG XLAT" & ! Data
178 ,Status )
179 ENDIF
180 ENDIF
181 #endif
182 ENDIF
183
184 IF ( wrf_at_debug_level(300) ) THEN
185 WRITE(wrf_err_message,*) debug_message,' Status = ',Status
186 CALL wrf_message ( TRIM(wrf_err_message) )
187 ENDIF
188
189 IF ( wrf_at_debug_level( 500 ) ) THEN
190 CALL end_timing('wrf_ext_write_field')
191 ENDIF
192
193 END SUBROUTINE wrf_ext_write_field