/[MITgcm]/MITgcm/pkg/exf/exf_interp_read.F
ViewVC logotype

Contents of /MITgcm/pkg/exf/exf_interp_read.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.10 - (show annotations) (download)
Mon Apr 9 23:57:50 2007 UTC (17 years, 1 month ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint59a, checkpoint59, checkpoint58y_post
Changes since 1.9: +3 -5 lines
Replace implied read loop with whole array syntax.
Supposed to be faster according to Art Lazanoff.

1 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_interp_read.F,v 1.9 2006/12/14 22:15:27 dimitri Exp $
2 C $Name: $
3
4 #include "EXF_OPTIONS.h"
5
6 SUBROUTINE exf_interp_read(
7 I infile, filePrec,
8 O arrayin,
9 I irecord, nx_in, ny_in, mythid)
10
11 implicit none
12
13 C infile = name of the input file (direct access binary)
14 C filePrec = file precicision (currently not used, assumes real*4)
15 C arrout = output arrays (different for each processor)
16 C irecord = record number in global file
17 C nx_in, ny_in = input x-grid and y-grid size
18 C mythid = thread id
19
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #ifdef ALLOW_USE_MPI
23 # include "EESUPPORT.h"
24 #endif /* ALLOW_USE_MPI */
25 #include "PARAMS.h"
26
27 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
28 C When using threads the address of the local automatic array
29 C "global" is not visible to the other threads. So we create
30 C a pointer to share that address here. This is presently
31 C in an ifdef because it won't go through g77 and I'm not
32 C currently sure what TAF would do with this.
33 COMMON /EXF_IOPTR/ glPtr
34 REAL*4, POINTER :: glPtr(:,:)
35 COMMON /EXF_IOPTR8/ glPtr8
36 REAL*8, POINTER :: glPtr8(:,:)
37 #endif
38
39 C subroutine variables
40 character*(*) infile
41 integer filePrec, irecord, nx_in, ny_in
42 real*4 arrayin( -1:nx_in+2 , -1:ny_in+2 )
43 integer mythid
44
45 C Functions
46 integer MDS_RECLEN
47
48 C local variables
49 integer ierr, length_of_rec
50 real*8 ne_fac,nw_fac,se_fac,sw_fac
51 integer e_ind(snx,sny),w_ind(snx,sny)
52 integer n_ind(snx,sny),s_ind(snx,sny)
53 real*8 px_ind(4), py_ind(4), ew_val(4)
54 external lagran
55 real*8 lagran
56 integer i, j, k, l, js, bi, bj, sp, interp_unit
57 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
58 real*4, target :: global(nx_in,ny_in)
59 real*8, target :: global8(nx_in,ny_in)
60 #else
61 real*4 global(nx_in,ny_in)
62 real*8 global8(nx_in,ny_in)
63 #endif
64
65 _BARRIER
66 _BEGIN_MASTER( myThid )
67
68 #ifndef EXF_IREAD_USE_GLOBAL_POINTER
69 C The CPP symbol EXF_IREAD_USE_GLOBAL_POINTER must be defined for the
70 C case of nThreads > 1. Stop if it isnt.
71 IF ( nThreads .GT. 1 ) THEN
72 STOP
73 &'EXF_INTERP_READ: nThreads > 1 needs EXF_IREAD_USE_GLOBAL_POINTER'
74 ENDIF
75 #endif
76
77 C read in input data
78 #ifdef ALLOW_USE_MPI
79 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
80 if (.FALSE.) then
81 #else
82 if (useSingleCPUIO) then
83 #endif
84
85 C master thread of process 0, only, opens a global file
86 IF( mpiMyId .EQ. 0 ) THEN
87 call mdsfindunit( interp_unit, mythid)
88 length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )
89 open(interp_unit,file=infile,status='old',access='direct',
90 & recl=length_of_rec)
91 IF ( filePrec .EQ. 32 ) THEN
92 read(interp_unit,rec=irecord) global
93 #ifdef _BYTESWAPIO
94 call MDS_BYTESWAPR4(nx_in*ny_in,global)
95 #endif /* _BYTESWAPIO */
96 ELSE
97 read(interp_unit,rec=irecord) global8
98 #ifdef _BYTESWAPIO
99 call MDS_BYTESWAPR8(nx_in*ny_in,global8)
100 #endif /* _BYTESWAPIO */
101 ENDIF
102 close(interp_unit)
103 ENDIF
104
105 C broadcast to all processes
106 IF ( filePrec .EQ. 32 ) THEN
107 call MPI_BCAST(global,nx_in*ny_in,MPI_REAL,
108 & 0,MPI_COMM_MODEL,ierr)
109 ELSE
110 call MPI_BCAST(global8,nx_in*ny_in,MPI_DOUBLE_PRECISION,
111 & 0,MPI_COMM_MODEL,ierr)
112 ENDIF
113 else
114 #endif /* ALLOW_USE_MPI */
115
116 call mdsfindunit( interp_unit, mythid)
117 length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )
118 open(interp_unit,file=infile,status='old',access='direct',
119 & recl=length_of_rec)
120 IF ( filePrec .EQ. 32 ) THEN
121 read(interp_unit,rec=irecord) global
122 #ifdef _BYTESWAPIO
123 call MDS_BYTESWAPR4(nx_in*ny_in,global)
124 #endif /* _BYTESWAPIO */
125 ELSE
126 read(interp_unit,rec=irecord) global8
127 #ifdef _BYTESWAPIO
128 call MDS_BYTESWAPR8(nx_in*ny_in,global8)
129 #endif /* _BYTESWAPIO */
130 ENDIF
131 close(interp_unit)
132
133 #ifdef ALLOW_USE_MPI
134 endif
135 #endif /* ALLOW_USE_MPI */
136 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
137 IF ( filePrec .EQ. 32 ) THEN
138 glPtr => global
139 ELSE
140 glPtr8 => global8
141 ENDIF
142 #endif
143 _END_MASTER( myThid )
144 _BARRIER
145
146 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
147 IF ( filePrec .EQ. 32 ) THEN
148 do j=1,ny_in
149 do i=1,nx_in
150 arrayin(i,j)=glPtr(i,j)
151 enddo
152 enddo
153 ELSE
154 do j=1,ny_in
155 do i=1,nx_in
156 arrayin(i,j)=glPtr8(i,j)
157 enddo
158 enddo
159 ENDIF
160 #else
161 IF ( filePrec .EQ. 32 ) THEN
162 do j=1,ny_in
163 do i=1,nx_in
164 arrayin(i,j)=global(i,j)
165 enddo
166 enddo
167 ELSE
168 do j=1,ny_in
169 do i=1,nx_in
170 arrayin(i,j)=global8(i,j)
171 enddo
172 enddo
173 ENDIF
174 #endif
175
176 RETURN
177 END

  ViewVC Help
Powered by ViewVC 1.1.22