File: /nfs/home/0/users/jenkins/mfix.git/model/in_binary_512_mod.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: IN_BIN_512                                             C
4     !  Purpose: read in an array in chunks of 512 bytes    (DP WORDS)      C
5     !                                                                      C
6     !  Author: P. Nicoletti                               Date: 03-JAN-92  C
7     !  Reviewer: P. Nicoletti, W. Rogers, M. Syamlal      Date: 24-JAN-92  C
8     !                                                                      C
9     !  Revision Number:                                                    C
10     !  Purpose:                                                            C
11     !  Author:                                            Date: dd-mmm-yy  C
12     !  Reviewer:                                          Date: dd-mmm-yy  C
13     !                                                                      C
14     !  Literature/Document References:                                     C
15     !                                                                      C
16     !  Variables referenced:                                               C
17     !  Variables modified:                                                 C
18     !                                                                      C
19     !  Local variables: NWORDS, L, NSEG, NREM, LC, N1, N2                  C
20     !                                                                      C
21     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
22     !
23     MODULE IN_BINARY_512
24     
25     CONTAINS
26     
27           SUBROUTINE IN_BIN_512(IUNIT, ARRAY, N, NEXT_REC)
28     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
29     !...Switches: -xf
30     !
31     !-----------------------------------------------
32     !   M o d u l e s
33     !-----------------------------------------------
34           USE machine
35           IMPLICIT NONE
36     !-----------------------------------------------
37     !   D u m m y   A r g u m e n t s
38     !-----------------------------------------------
39     !
40     !                      array to write out
41           DOUBLE PRECISION ARRAY(*)
42     !
43     !                      output unit number
44           INTEGER          IUNIT
45     !
46     !                      number of elements in ARRAY
47           INTEGER          N
48     !
49     !                      next record number in direct access output file
50           INTEGER          NEXT_REC
51     !
52     ! local variables
53     !
54     !                      number of words for 512 bytes (nwords * 4 = 512)
55           INTEGER          NWORDS
56     !
57     !                      loop counter
58           INTEGER          L
59     !
60     !                      number of full 512 byte segments need to write N
61     !                      double precision words
62           INTEGER          NSEG
63     !
64     !                      number of double precision words in the partially
65     !                      filled last record
66           INTEGER          NREM
67     !
68     !                      loop counter
69           INTEGER          LC
70     !
71     !                      write out array elements N1 to N2
72           INTEGER          N1 , N2
73     !-----------------------------------------------
74     !
75     !
76           NWORDS = NWORDS_DP
77           IF (N <= NWORDS) THEN
78              READ (IUNIT, REC=NEXT_REC) (ARRAY(L),L=1,N)
79              NEXT_REC = NEXT_REC + 1
80              RETURN
81           ENDIF
82     !
83           NSEG = N/NWORDS
84           NREM = MOD(N,NWORDS)
85           N1 = 1
86           N2 = NWORDS
87     !
88     ! read the full 512 byte segments
89     !
90           DO LC = 1, NSEG
91              READ (IUNIT, REC=NEXT_REC) (ARRAY(L),L=N1,N2)
92              N1 = N1 + NWORDS
93              N2 = N2 + NWORDS
94              NEXT_REC = NEXT_REC + 1
95           END DO
96           IF (NREM /= 0) THEN
97              READ (IUNIT, REC=NEXT_REC) (ARRAY(L),L=N1,N)
98              NEXT_REC = NEXT_REC + 1
99           ENDIF
100     
101           RETURN
102           END SUBROUTINE IN_BIN_512
103     
104           subroutine convert_from_io_dp(arr_io,arr_internal,n)
105     
106           use geometry
107           use indices
108           USE compar
109           USE functions
110     
111           implicit none
112     
113           double precision   arr_io(*) , arr_internal(*)
114           integer            n,i,j,k,ijk,ijk_io
115     
116           do k = 1,kmax2
117              do j = 1,jmax2
118                 do i = 1,imax2
119                    ijk = funijk_gl(i,j,k)
120                    ijk_io = funijk_io(i,j,k)
121                    arr_internal(ijk) = arr_io(ijk_io)
122                 end do
123              end do
124           end do
125     
126           return
127         end subroutine convert_from_io_dp
128     
129           subroutine convert_to_io_dp(arr_internal,arr_io,n)
130     
131           use geometry
132           use indices
133           USE compar
134           USE functions
135     
136           implicit none
137     
138           double precision   arr_io(*) , arr_internal(*)
139           integer            n,i,j,k,ijk,ijk_io
140     
141           do k = 1,kmax2
142              do j = 1,jmax2
143                 do i = 1,imax2
144                    ijk  = funijk_gl(i,j,k)
145                    ijk_io = funijk_io(i,j,k)
146                    arr_io(ijk_io) = arr_internal(ijk)
147                 end do
148              end do
149           end do
150     !
151           return
152         end subroutine convert_to_io_dp
153     
154     END MODULE IN_BINARY_512
155     
156     !// Comments on the modifications for DMP version implementation
157     !// 001 Include header file and common declarations for parallelization
158