1PROGRAM pcgns_ftest
2
3  USE mpi
4  USE ISO_C_BINDING
5  USE CGNS
6  IMPLICIT NONE
7
8#ifdef WINNT
9  INCLUDE 'cgnswin_f.h'
10#endif
11
12
13  INTEGER(cgsize_t), PARAMETER :: totcnt = 40320 * 10
14
15  INTEGER(cgsize_t) npp
16  INTEGER(C_INT) commsize, commrank, mpi_err
17  INTEGER i, nb, nz, nerrs
18  INTEGER ierr, F, B, Z, E, S
19  INTEGER Cx, Cy, Cz, Fx, Fy, Fz, Ax, Ay, Az
20  INTEGER(cgsize_t) sizes(3), start, END, n, j
21  INTEGER(cgsize_t), PARAMETER :: start_1 = 1
22  REAL*8 ts, te, tt, dsize
23  REAL*8 dx(totcnt), dy(totcnt), dz(totcnt)
24  INTEGER(cgsize_t), ALLOCATABLE, DIMENSION(:) :: ie
25  CHARACTER*32 name
26  CHARACTER*11 piomode(2)
27  INTEGER :: istat
28  INTEGER :: precision
29
30  DATA piomode /'independent','collective'/
31
32  CALL MPI_INIT(mpi_err)
33  CALL MPI_COMM_SIZE(MPI_COMM_WORLD,commsize,mpi_err)
34  CALL MPI_COMM_RANK(MPI_COMM_WORLD,commrank,mpi_err)
35
36  IF (commsize .GT. 8) THEN
37     IF (commrank .EQ. 0) &
38          PRINT *, 'number of processes must be 8 or less'
39     CALL cgp_error_exit_f
40     STOP
41  ENDIF
42
43  ALLOCATE(ie(1:4*totcnt), STAT = istat)
44  IF (istat.NE.0)THEN
45     PRINT*, '*FAILED* allocation of ie'
46     CALL cgp_error_exit_f()
47  ENDIF
48
49  npp = totcnt / commsize
50  start = commrank * npp + 1
51  end = start + npp - 1
52
53  j = 0
54  DO n=1,npp
55     dx(n) = start + n - 1
56     dy(n) = commrank + 1
57     dz(n) = n
58     DO i=1,4
59        j = j + 1
60        ie(j) = start + n - 1
61     ENDDO
62  ENDDO
63  sizes(1) = totcnt
64  sizes(2) = totcnt
65  sizes(3) = 0
66
67  dsize = (9.0 * totcnt * 8.0 + 4.0 * totcnt * 4.0) / (1024.0 * 1024.0)
68
69  IF (commrank .EQ. 0) THEN
70     PRINT *,'number processes       =', commsize
71     PRINT *,'array size per process =', npp
72     PRINT *,'total array size       =', totcnt
73     PRINT *,'total Mb for all data  =', dsize
74  ENDIF
75
76! default is MPI_COMM_WORLD, but can set another communicator with this
77!     call cgp_mpi_comm_f(MPI_COMM_WORLD,ierr)
78
79  CALL cgp_open_f('pcgns_ftest.cgns',CG_MODE_WRITE,F,ierr)
80  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
81
82  DO nb=1,2
83     WRITE(name,'(a4,i2)') 'Base',nb
84     CALL cg_base_write_f(F,name,3,3,B,ierr)
85     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
86     CALL cgp_pio_mode_f(INT(nb-1,C_INT), ierr)
87     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
88
89     DO nz=1,2
90        WRITE(name,'(a4,i2)') 'Zone',nz
91        CALL cg_zone_write_f(F,B,name,sizes,Unstructured,Z,ierr)
92        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
93        CALL cgp_coord_write_f(F,B,Z,RealDouble,'CoordinateX',Cx,ierr)
94        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
95        CALL cgp_coord_write_f(F,B,Z,RealDouble,'CoordinateY',Cy,ierr)
96        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
97        CALL cgp_coord_write_f(F,B,Z,RealDouble,'CoordinateZ',Cz,ierr)
98        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
99        CALL cgp_section_write_f(F,B,Z,'Tets',TETRA_4,start_1,totcnt,0,E,ierr)
100        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
101        CALL cg_sol_write_f(F,B,Z,'Solution',Vertex,S,ierr)
102        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
103        CALL cgp_field_write_f(F,B,Z,S,RealDouble,'MomentumX',Fx,ierr)
104        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
105        CALL cgp_field_write_f(F,B,Z,S,RealDouble,'MomentumY',Fy,ierr)
106        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
107        CALL cgp_field_write_f(F,B,Z,S,RealDouble,'MomentumZ',Fz,ierr)
108        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
109        CALL cg_goto_f(F,B,ierr,name,0,'end')
110        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
111        CALL cg_user_data_write_f('User Data',ierr)
112        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
113        CALL cg_gorel_f(F,ierr,'User Data',0,'end')
114        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
115        CALL cgp_array_write_f('ArrayX',RealDouble,1,totcnt,Ax,ierr)
116        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
117        CALL cgp_array_write_f('ArrayY',RealDouble,1,totcnt,Ay,ierr)
118        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
119        CALL cgp_array_write_f('ArrayZ',RealDouble,1,totcnt,Az,ierr)
120        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
121        CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
122        ts = MPI_WTIME()
123
124        CALL cgp_coord_write_data_f(F,B,Z,Cx,start,END,dx,ierr)
125        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
126        CALL cgp_coord_write_data_f(F,B,Z,Cy,start,END,dy,ierr)
127        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
128        CALL cgp_coord_write_data_f(F,B,Z,Cz,start,END,dz,ierr)
129        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
130        CALL cgp_elements_write_data_f(F,B,Z,E,start,END,ie,ierr)
131        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
132        CALL cgp_field_write_data_f(F,B,Z,S,Fx,start,END,dx,ierr)
133        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
134        CALL cgp_field_write_data_f(F,B,Z,S,Fy,start,END,dy,ierr)
135        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
136        CALL cgp_field_write_data_f(F,B,Z,S,Fz,start,END,dz,ierr)
137        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
138        CALL cg_goto_f(F,B,ierr,'Zone_t',Z,'UserDefinedData_t',1,'end')
139        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
140        CALL cgp_array_write_data_f(Ax,start,END,dx,ierr)
141        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
142        CALL cgp_array_write_data_f(Ay,start,END,dy,ierr)
143        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
144        CALL cgp_array_write_data_f(Az,start,END,dz,ierr)
145        IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
146
147        CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
148        te = MPI_WTIME()
149        tt = te - ts;
150        IF (commrank .EQ. 0) THEN
151           PRINT *,'write:',tt,' secs,', dsize/tt, ' Mb/sec (', &
152                piomode(nb),')'
153        ENDIF
154     ENDDO
155  ENDDO
156  CALL cgp_close_f(F,ierr)
157  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
158  CALL cgp_open_f('pcgns_ftest.cgns',CG_MODE_READ,F,ierr)
159  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
160
161  CALL cg_precision_f(F, PRECISION, ierr)
162  PRINT*,'PPP',PRECISION
163
164  Z = 1
165  S = 1
166  E = 1
167  DO B=1,2
168     CALL cgp_pio_mode_f(INT(B-1,C_INT),ierr)
169     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
170
171     CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
172     ts = MPI_WTIME()
173
174     CALL cgp_coord_read_data_f(F,B,Z,1,start,END,dx,ierr)
175     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
176     CALL cgp_coord_read_data_f(F,B,Z,2,start,END,dy,ierr)
177     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
178     CALL cgp_coord_read_data_f(F,B,Z,3,start,END,dz,ierr)
179     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
180     CALL cgp_elements_read_data_f(F,B,Z,E,start,END,ie,ierr)
181     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
182
183     CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
184     te = MPI_WTIME()
185     tt = te - ts
186
187     nerrs = 0
188     j = 0
189     DO n=1,npp
190        IF (dx(n) .NE. (start+n-1)) nerrs = nerrs + 1
191        IF (dy(n) .NE. (commrank+1)) nerrs = nerrs + 1
192        IF (dz(n) .NE. n) nerrs = nerrs + 1
193        DO i=1,4
194           j = j + 1
195         !  IF (ie(j) .NE. (start+n-1)) nerrs = nerrs + 1
196        ENDDO
197     ENDDO
198
199     CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
200     ts = MPI_WTIME()
201
202     CALL cgp_field_read_data_f(F,B,Z,S,1,start,END,dx,ierr)
203     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
204     CALL cgp_field_read_data_f(F,B,Z,S,2,start,END,dy,ierr)
205     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
206     CALL cgp_field_read_data_f(F,B,Z,S,3,start,END,dz,ierr)
207     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
208
209     CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
210     te = MPI_WTIME()
211     tt = tt + te - ts
212
213     DO n=1,npp
214        IF (dx(n) .NE. (start+n-1)) nerrs = nerrs + 1
215        IF (dy(n) .NE. (commrank+1)) nerrs = nerrs + 1
216        IF (dz(n) .NE. n) nerrs = nerrs + 1
217     ENDDO
218
219     CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
220     ts = MPI_WTIME()
221     CALL cg_goto_f(F,B,ierr,'Zone_t',Z,'UserDefinedData_t',1,'end')
222     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
223     CALL cgp_array_read_data_f(1,start,END,dx,ierr)
224     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
225     CALL cgp_array_read_data_f(2,start,END,dy,ierr)
226     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
227     CALL cgp_array_read_data_f(3,start,END,dz,ierr)
228     IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
229
230     CALL MPI_BARRIER(MPI_COMM_WORLD, mpi_err)
231     te = MPI_WTIME()
232     tt = tt + te - ts
233
234     DO n=1,npp
235        IF (dx(n) .NE. (start+n-1)) nerrs = nerrs + 1
236        IF (dy(n) .NE. (commrank+1)) nerrs = nerrs + 1
237        IF (dz(n) .NE. n) nerrs = nerrs + 1
238     ENDDO
239
240     IF (commrank .EQ. 0) THEN
241        PRINT *,'read :',tt,' secs,',dsize/tt,' Mb/sec (', &
242             piomode(B),') errors =',nerrs
243     ENDIF
244  ENDDO
245
246  CALL cgp_close_f(F,ierr)
247  IF (ierr .NE. CG_OK) CALL cgp_error_exit_f
248
249  CALL MPI_FINALIZE(mpi_err)
250END PROGRAM pcgns_ftest
251
252