testWRFWrite.F90
References to this file elsewhere.
1 program testwrite_john
2 use wrf_data
3 implicit none
4 #include "wrf_status_codes.h"
5 #include <netcdf.inc>
6 character (80) FileName
7 integer Comm
8 character (80) SysDepInfo
9 integer :: DataHandle
10 integer Status
11 integer NCID
12 real data(200)
13 integer idata(200)
14 real*8 ddata(200)
15 logical ldata(200)
16 character (80) cdata
17 integer OutCount
18 integer i,j,k
19
20 integer, parameter :: pad = 3
21 integer, parameter :: jds=1 , jde=6 , &
22 ids=1 , ide=9 , &
23 kds=1 , kde=5
24 integer, parameter :: jms=jds-pad , jme=jde+pad , &
25 ims=ids-pad , ime=ide+pad , &
26 kms=kds , kme=kde
27 integer, parameter :: jps=jds , jpe=jde , &
28 ips=ids , ipe=ide , &
29 kps=kds , kpe=kde
30
31 real u( ims:ime , kms:kme , jms:jme )
32 real v( ims:ime , kms:kme , jms:jme )
33 real rho( ims:ime , kms:kme , jms:jme )
34 real u2( ims:ime , jms:jme )
35 real u1( ims:ime )
36
37 integer int( ims:ime , kms:kme , jms:jme )
38 real*8 r8 ( ims:ime , kms:kme , jms:jme )
39
40 integer Dom
41 character*3 MemOrd
42 character (19) Date
43 character (19) Date2
44 integer , Dimension(3) :: DomS,DomE,MemS,MemE,PatS,PatE
45 integer , Dimension(2) :: Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E
46 integer , Dimension(1) :: Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E
47 print *, 'Testing wrf write'
48 print *, ims,ime , kms,kme , jms,jme
49 Date = '2000-09-18_16:42:01'
50 Date2 = '2000-09-18_16:52:01'
51 call ext_init(Status)
52 print *,'After call ext_init, Status =',Status
53 FileName = 'foo.nc'
54 Comm = 1
55 SysDepInfo = 'sys info'
56
57 print*,'!!!!!!!!!!!!!!!!!!!!!!! ext_open_for_write_begin'
58
59 call ext_open_for_write_begin( FileName, Comm, SysDepInfo, DataHandle, Status)
60 print *, ' ext_open_for_write_begin Status = ',Status,DataHandle
61
62 MemOrd = "XZY"
63
64 DomS(1) = ids
65 DomE(1) = ide
66 DomS(2) = kds
67 DomE(2) = kde
68 DomS(3) = jds
69 DomE(3) = jde
70
71 PatS(1) = ips
72 PatE(1) = ipe
73 PatS(2) = kps
74 PatE(2) = kpe
75 PatS(3) = jps
76 PatE(3) = jpe
77
78 MemS(1) = ims
79 MemE(1) = ime
80 MemS(2) = kms
81 MemE(2) = kme
82 MemS(3) = jms
83 MemE(3) = jme
84
85 Dom2S(1) = ids
86 Dom2S(2) = jds
87 Dom2E(1) = ide
88 Dom2E(2) = jde
89 Mem2S(1) = ims
90 Mem2S(2) = jms
91 Mem2E(1) = ime
92 Mem2E(2) = jme
93 Pat2S(1) = ips
94 Pat2S(2) = jps
95 Pat2E(1) = ipe
96 Pat2E(2) = jpe
97
98 Dom1S = ids
99 Dom1E = ide
100 Mem1S = ims
101 Mem1E = ime
102 Pat1S = ips
103 Pat1E = ipe
104
105 call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
106 print *,' dry run : ext_write_field Status = ',Status
107 call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
108 print *,' dry run : ext_write_field Status = ',Status
109 call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
110 print *,' dry run : ext_write_field Status = ',Status
111 call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
112 print *,' dry run : ext_write_field Status = ',Status
113 call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
114 print *,' dry run : ext_write_field Status = ',Status
115 call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
116 print *,' dry run : ext_write_field Status = ',Status
117 call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
118 print *,' dry run : ext_write_field Status = ',Status
119 call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
120 print *,' dry run : ext_write_field Status = ',Status
121
122 call ext_open_for_write_commit(DataHandle, Status)
123 print *, ' ext_open_for_write_commit Status = ', Status,DataHandle
124
125 do j=jds,jde
126 do k=kds,kde
127 do i=ids,ide
128 u (i,k,j) = 100*i+j+10*k
129 v (i,k,j) = 100*i+j+10*k
130 rho(i,k,j) = 100*i+j+10*k
131 int(i,k,j) = 100*i+j+10*k
132 r8 (i,k,j) = 100*i+j+10*k
133 enddo
134 enddo
135 enddo
136 do j=jds,jde
137 do i=ids,ide
138 u2(i,j) = 10*i+j
139 enddo
140 enddo
141 do i=ids,ide
142 u1(i) = i
143 enddo
144
145 print *,'testWRFWrite u (2,3,4) = ',u(2,3,4)
146 print *,'testWRFWrite v (4,3,2) = ',v(4,3,2)
147 print *,'testWRFWrite rho(3,4,5) = ',rho(3,4,5)
148 print *,'testWRFWrite u2 (6,5) = ',u2(6,5)
149 print *,'testWRFWrite u1 (9) = ',u1(9)
150 print *,'testWRFWrite int(8,5,6) = ',int(8,5,6)
151 print *,'testWRFWrite r8 (7,4,5) = ',r8(7,4,5)
152 call ext_write_field(DataHandle,Date,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
153 print *,' first write: ext_write_field Status = ',Status
154 call ext_write_field(DataHandle,Date,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
155 print *,' first write: ext_write_field Status = ',Status
156 call ext_write_field(DataHandle,Date,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
157 print *,' first write: ext_write_field Status = ',Status
158 call ext_write_field(DataHandle,Date,'u2',u2,WRF_REAL,Comm,Dom,'XY',Dom2S,Dom2E,Mem2S,Mem2E,Pat2S,Pat2E,Status)
159 print *,' first write: ext_write_field Status = ',Status
160 call ext_write_field(DataHandle,Date,'ud2',u,WRF_REAL,Comm,Dom,"XzY",DomS,DomE,MemS,MemE,PatS,PatE,Status)
161 print *,' first write: ext_write_field Status = ',Status
162 call ext_write_field(DataHandle,Date,'u1',u1,WRF_REAL,Comm,Dom,'Z',Dom1S,Dom1E,Mem1S,Mem1E,Pat1S,Pat1E,Status)
163 print *,' first write: ext_write_field Status = ',Status
164 call ext_write_field(DataHandle,Date,'int',int,WRF_INTEGER,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
165 print *,' first write: ext_write_field Status = ',Status
166 call ext_write_field(DataHandle,Date,'double',r8,WRF_DOUBLE,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
167 print *,' dry run : ext_write_field Status = ',Status
168
169 print *,'2nd : testWRFWrite u(3,3,3) = ',u(3,3,3)
170 print *,'2nd : testWRFWrite v(4,4,4) = ',v(4,4,4)
171 print *,'2nd : testWRFWrite rho(3,4,5) = ',rho(3,4,5)
172 call ext_write_field(DataHandle,Date2,'u',u,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
173 print *,' 2nd write : ext_write_field Status = ',Status
174 call ext_write_field(DataHandle,Date2,'v',v,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
175 print *,' 2nd write : ext_write_field Status = ',Status
176 call ext_write_field(DataHandle,Date2,'rho',rho,WRF_REAL,Comm,Dom,MemOrd,DomS,DomE,MemS,MemE,PatS,PatE,Status)
177 print *,' 2nd write : ext_write_field Status = ',Status
178
179 call ext_close( DataHandle, Status)
180 print *, ' After ext_close, Status = ',Status
181 call ext_exit(Status)
182 print *,' End of test program',Status
183 stop
184 end program testwrite_john