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