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