1      program cgzconn
2
3#include "cgnstypes_f.h"
4#ifdef WINNT
5      include 'cgnswin_f.h'
6#endif
7      include 'cgnslib_f.h'
8
9      cgsize_t ierr, cgfile, cgbase, cgzone, cgcoord
10      cgsize_t cgz1, cgz2, cgconn, nzconn, nconn, n1to1
11      cgsize_t i, j, k, n, size(9), dim
12      cgsize_t ptrange(6), ptlist(125), transform(3)
13      cgsize_t loc, type, ptype, npts, dztype, dptype, ddtype, dnpts
14      real*4 x(125), y(125), z(125), exp(5)
15      character*32 zname, dname, cname
16
17c open and write base
18      dim = 3
19      call cg_open_f('cgzconn.cgns', CG_MODE_WRITE, cgfile, ierr)
20      if (ierr .ne. CG_OK) call cg_error_exit_f
21      call cg_base_write_f(cgfile, 'Base', dim, dim, cgbase, ierr)
22      if (ierr .ne. CG_OK) call cg_error_exit_f
23
24c create some bogus data
25      do n=1,3
26        size(n)   = 5
27        size(n+3) = 4
28        size(n+6) = 0
29      enddo
30      n = 0
31      do k=1,5
32        do j=1,5
33          do i=1,5
34            n = n + 1
35            x(n) = i
36            y(n) = j
37            z(n) = k
38          enddo
39        enddo
40      enddo
41      do n=1,3
42        ptrange(n) = 1
43        ptrange(n+3) = 5
44        transform(n) = n
45      enddo
46      ptrange(4) = 1
47      n = 0
48      do j=1,5
49        do i=1,5
50          n = n + 1
51          ptlist(n) = i
52          n = n + 1
53          ptlist(n) = j
54          n = n + 1
55          ptlist(n) = 1
56        enddo
57      enddo
58      do n=1,5
59        exp(n) = 0
60      enddo
61      exp(2) = 1
62
63c loop over zones
64      do n=1,2
65        if (n .eq. 1) then
66          zname = 'Zone1'
67          dname = 'Zone2'
68        else
69          zname = 'Zone2'
70          dname = 'Zone1'
71        endif
72c write zone
73        call cg_zone_write_f(cgfile, cgbase, zname, size,
74     &                       Structured, cgzone, ierr)
75        if (ierr .ne. CG_OK) call cg_error_exit_f
76        call cg_goto_f(cgfile, cgbase, ierr, 'Zone_t', cgzone, 'end')
77        if (ierr .ne. CG_OK) call cg_error_exit_f
78        call cg_dataclass_write_f(NormalizedByDimensional, ierr)
79        if (ierr .ne. CG_OK) call cg_error_exit_f
80c write coordinates
81        call cg_coord_write_f(cgfile, cgbase, cgzone, RealSingle,
82     &                        'CoordinateX', x, cgcoord, ierr)
83        if (ierr .ne. CG_OK) call cg_error_exit_f
84        call cg_gopath_f(cgfile, 'GridCoordinates/CoordinateX', ierr)
85        if (ierr .ne. CG_OK) call cg_error_exit_f
86        call cg_exponents_write_f(RealSingle, exp, ierr)
87        if (ierr .ne. CG_OK) call cg_error_exit_f
88
89        call cg_coord_write_f(cgfile, cgbase, cgzone, RealSingle,
90     &                        'CoordinateY', y, cgcoord, ierr)
91        if (ierr .ne. CG_OK) call cg_error_exit_f
92        call cg_gopath_f(cgfile, '../CoordinateY', ierr)
93        if (ierr .ne. CG_OK) call cg_error_exit_f
94        call cg_exponents_write_f(RealSingle, exp, ierr)
95        if (ierr .ne. CG_OK) call cg_error_exit_f
96
97        call cg_coord_write_f(cgfile, cgbase, cgzone, RealSingle,
98     &                        'CoordinateZ', z, cgcoord, ierr)
99        if (ierr .ne. CG_OK) call cg_error_exit_f
100        call cg_gopath_f(cgfile, '../CoordinateZ', ierr)
101        if (ierr .ne. CG_OK) call cg_error_exit_f
102        call cg_exponents_write_f(RealSingle, exp, ierr)
103        if (ierr .ne. CG_OK) call cg_error_exit_f
104
105c write first ZoneGridConnectivity - will be active
106        call cg_zconn_write_f(cgfile, cgbase, cgzone,
107     &                        'ZoneConnectivity1', cgz1, ierr)
108        if (ierr .ne. CG_OK) call cg_error_exit_f
109
110c write second ZoneGridConnectivity - will be active
111        call cg_zconn_write_f(cgfile, cgbase, cgzone,
112     &                        'ZoneConnectivity2', cgz2, ierr)
113        if (ierr .ne. CG_OK) call cg_error_exit_f
114c write general connectivity
115        npts = 2
116        dnpts = 25
117        call cg_conn_write_f(cgfile, cgbase, cgzone, 'conn', Vertex,
118     &                       Abutting1to1, PointRange, npts, ptrange,
119     &                       dname, Structured, PointListDonor,
120     &                       Integer, dnpts, ptlist, cgconn, ierr)
121        if (ierr .ne. CG_OK) call cg_error_exit_f
122c set it back to previous ZoneGridConnectivity and write 1to1
123        call cg_zconn_set_f(cgfile, cgbase, cgzone, cgz1, ierr)
124        if (ierr .ne. CG_OK) call cg_error_exit_f
125        call cg_1to1_write_f(cgfile, cgbase, cgzone, '1to1', dname,
126     &                       ptrange, ptrange, transform, cgconn, ierr)
127        if (ierr .ne. CG_OK) call cg_error_exit_f
128      enddo
129
130c close the file and reopen in read mode
131      call cg_close_f(cgfile, ierr)
132      if (ierr .ne. CG_OK) call cg_error_exit_f
133
134      call cg_open_f('cgzconn.cgns', CG_MODE_READ, cgfile, ierr)
135      if (ierr .ne. CG_OK) call cg_error_exit_f
136      cgbase = 1
137      cgz1 = 1
138      cgz2 = 2
139      cgconn = 1
140      do cgzone=1,2
141        call cg_nzconns_f(cgfile, cgbase, cgzone, nzconn, ierr)
142        if (ierr .ne. CG_OK) call cg_error_exit_f
143        if (nzconn .ne. 2) then
144          print *,'nzconn != 2'
145          stop
146        endif
147c read should make ZoneGridConnectivity active
148        call cg_zconn_read_f(cgfile, cgbase, cgzone, cgz2, zname, ierr)
149        if (ierr .ne. CG_OK) call cg_error_exit_f
150        if (zname .ne. 'ZoneConnectivity2') then
151          print *,'expecting Zoneconnectivity2 - got',zname
152          stop
153        endif
154        call cg_nconns_f(cgfile, cgbase, cgzone, nconn, ierr);
155        if (ierr .ne. CG_OK) call cg_error_exit_f
156        call cg_n1to1_f(cgfile, cgbase, cgzone, n1to1, ierr);
157        if (ierr .ne. CG_OK) call cg_error_exit_f
158        if (nconn .ne. 1 .or. n1to1 .ne. 0) then
159          print *,'expecting nconn=1,n1to1=0 - got',nconn,n1to1
160          stop
161        endif
162        call cg_conn_info_f(cgfile, cgbase, cgzone, cgconn, cname,
163     &                      loc, type, ptype, npts, dname, dztype,
164     &                      dptype, ddtype, dnpts, ierr)
165        if (ierr .ne. CG_OK) call cg_error_exit_f
166        if (cname .ne. 'conn' .or. loc .ne. Vertex .or.
167     &      type .ne. Abutting1to1 .or. ptype .ne. PointRange .or.
168     &      npts .ne. 2 .or. dztype .ne. Structured .or.
169     &      dptype .ne. PointListDonor .or. dnpts .ne. 25) then
170          print *,'invalid conn data'
171          stop
172        endif
173
174c read should make ZoneGridConnectivity active
175        call cg_zconn_read_f(cgfile, cgbase, cgzone, cgz1, zname, ierr)
176        if (ierr .ne. CG_OK) call cg_error_exit_f
177        if (zname .ne. 'ZoneConnectivity1') then
178          print *,'expecting Zoneconnectivity1 - got',zname
179          stop
180        endif
181        call cg_nconns_f(cgfile, cgbase, cgzone, nconn, ierr);
182        if (ierr .ne. CG_OK) call cg_error_exit_f
183        call cg_n1to1_f(cgfile, cgbase, cgzone, n1to1, ierr);
184        if (ierr .ne. CG_OK) call cg_error_exit_f
185        if (nconn .ne. 0 .or. n1to1 .ne. 1) then
186          print *,'expecting nconn=0,n1to1=1 - got',nconn,n1to1
187          stop
188        endif
189        call cg_1to1_read_f(cgfile, cgbase, cgzone, cgconn, cname,
190     &                      dname, ptrange, ptrange, transform, ierr)
191        if (ierr .ne. CG_OK) call cg_error_exit_f
192        if (cname .ne. '1to1') then
193          print *,'invalid 1to1 data'
194          stop
195        endif
196      enddo
197
198      call cg_close_f(cgfile, ierr)
199      if (ierr .ne. CG_OK) call cg_error_exit_f
200
201      end
202