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