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