1
2PROGRAM fexample
3
4  USE MPI
5  USE ISO_C_BINDING
6  USE CGNS
7  IMPLICIT NONE
8
9#ifdef WINNT
10  INCLUDE 'cgnswin_f.h'
11#endif
12
13  INTEGER(cgsize_t) :: nperside, totnodes, totelems
14  PARAMETER (nperside = 50)
15  PARAMETER (totnodes=nperside*nperside*nperside)
16  PARAMETER (totelems=(nperside-1)*(nperside-1)*(nperside-1))
17
18  INTEGER(C_INT) commsize, commrank, mpi_err
19  INTEGER ierr
20  INTEGER F, B, Z, E, S, Fs, Cx, Cy, Cz, A
21  INTEGER(cgsize_t) :: i, j, k, n, nn, ne
22  INTEGER(cgsize_t) :: nnodes, nelems
23  INTEGER(cgsize_t) :: sizes(3), start, END
24  INTEGER(cgsize_t), PARAMETER :: start_1 = 1
25  REAL*4 fx(totnodes), fy(totnodes), fz(totnodes), fd(totelems)
26  INTEGER(cgsize_t) :: ie(8*totelems)
27!
28!---- initialize MPI
29  CALL MPI_INIT(mpi_err)
30  CALL MPI_COMM_SIZE(MPI_COMM_WORLD, commsize, mpi_err)
31  CALL MPI_COMM_RANK(MPI_COMM_WORLD, commrank, mpi_err)
32
33!---- open file and create base and zone
34  sizes(1) = totnodes
35  sizes(2) = totelems
36  sizes(3) = 0
37
38  CALL cgp_open_f('fexample.cgns', CG_MODE_WRITE, F, ierr)
39  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
40  CALL cg_base_write_f(F, 'Base', 3, 3, B, ierr)
41  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
42  CALL cg_zone_write_f(F, B, 'Zone', sizes, Unstructured, Z, ierr)
43  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
44
45!---- print info
46  IF (commrank .EQ. 0) THEN
47     PRINT *, 'writing',totnodes,' coordinates and', totelems, &
48          ' hex elements to fexample.cgns'
49  ENDIF
50
51!---- create data nodes for coordinates
52  CALL cgp_coord_write_f(F, B, Z, RealSingle, 'CoordinateX', Cx, ierr)
53  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
54  CALL cgp_coord_write_f(F, B, Z, RealSingle, 'CoordinateY', Cy, ierr)
55  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
56  CALL cgp_coord_write_f(F, B, Z, RealSingle, 'CoordinateZ', Cz, ierr)
57
58!---- number of nodes and range this process will write
59  nnodes = (totnodes + commsize - 1) / commsize
60  start  = nnodes * commrank + 1
61  end= nnodes * (commrank + 1)
62  IF (end .GT. totnodes) END = totnodes
63
64!---- create the coordinate data for this process
65  nn = 1
66  n  = 1
67  DO k=1,nperside
68     DO j=1,nperside
69        DO i=1,nperside
70           IF (n .GE. start .AND. n .LE. END) THEN
71              fx(nn) = i
72              fy(nn) = j
73              fz(nn) = k
74              nn = nn + 1
75           ENDIF
76           n = n + 1
77        ENDDO
78     ENDDO
79  ENDDO
80
81!---- write the coordinate data in parallel
82  CALL cgp_coord_write_data_f(F, B, Z, Cx, start, END, fx, ierr)
83  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
84  CALL cgp_coord_write_data_f(F, B, Z, Cy, start, END, fy, ierr)
85  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
86  CALL cgp_coord_write_data_f(F, B, Z, Cz, start, END, fz, ierr)
87  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
88
89!---- create data node for elements
90  CALL cgp_section_write_f(F, B, Z, 'Hex', HEXA_8, start_1, totelems, 0, E, ierr)
91  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
92
93!---- number of elements and range this process will write
94  nelems = (totelems + commsize - 1) / commsize
95  start  = nelems * commrank + 1
96  end = nelems * (commrank + 1)
97  IF (end .GT. totelems) END = totelems
98
99!---- create the hex element data for this process
100  nn = 0
101  n  = 1
102  DO k=1,nperside-1
103     DO j=1,nperside-1
104        DO i=1,nperside-1
105           IF (n .GE. start .AND. n .LE. END) THEN
106              ne = i + nperside*((j-1)+nperside*(k-1))
107              ie(nn+1) = ne
108              ie(nn+2) = ne + 1
109              ie(nn+3) = ne + 1 + nperside
110              ie(nn+4) = ne + nperside
111              ne = ne + nperside*nperside
112              ie(nn+5) = ne
113              ie(nn+6) = ne + 1
114              ie(nn+7) = ne + 1 + nperside
115              ie(nn+8) = ne + nperside
116              nn = nn + 8
117           ENDIF
118           n = n + 1
119        ENDDO
120     ENDDO
121  ENDDO
122
123!---- write the element connectivity in parallel
124  CALL cgp_elements_write_data_f(F, B, Z, E, start, END, ie, ierr)
125  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
126
127!---- create a centered solution
128  CALL cg_sol_write_f(F, B, Z, 'Solution', CellCenter, S, ierr)
129  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
130  CALL cgp_field_write_f(F, B, Z, S, RealSingle, 'CellIndex', Fs, ierr)
131  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
132
133!---- create the field data for this process
134  nn = 1
135  DO n=1, totelems
136     IF (n .GE. start .AND. n .LE. END) THEN
137        fd(nn) = n
138        nn = nn + 1
139     ENDIF
140  ENDDO
141
142!---- write the solution field data in parallel
143  CALL cgp_field_write_data_f(F, B, Z, S, Fs, start, END, fd, ierr)
144  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
145
146!---- create user data under the zone and duplicate solution data
147  CALL cg_goto_f(F, B, ierr, 'Zone_t', 1, 'end')
148  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
149  CALL cg_user_data_write_f('User Data', ierr)
150  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
151  CALL cg_gorel_f(F, ierr, 'User Data', 0, 'end')
152  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
153  CALL cgp_array_write_f('CellIndex', RealSingle, 1, totelems, A, ierr)
154  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
155
156!---- write the array data in parallel
157  CALL cgp_array_write_data_f(A, start, END, fd, ierr)
158  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
159!---- close the file and terminate MPI
160  CALL cgp_close_f(F, ierr)
161  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
162  CALL MPI_FINALIZE(mpi_err)
163END PROGRAM fexample
164
165