source: trunk/WRF.COMMON/WRFV3/external/io_pnetcdf/testWRFWrite.F90 @ 2762

Last change on this file since 2762 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 7.0 KB
Line 
1program testwrite_john
2  use wrf_data_pnc
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
57print*,'!!!!!!!!!!!!!!!!!!!!!!! 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
Note: See TracBrowser for help on using the repository browser.