/[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.8 - (show annotations) (download)
Thu Dec 14 08:17:15 2006 UTC (17 years, 6 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint58s_post
Changes since 1.7: +4 -1 lines
o put back the stop statement. It is still needed (unfortunately)

1 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_interp_read.F,v 1.7 2006/12/13 18:37:21 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 #endif
36
37 C subroutine variables
38 character*(*) infile
39 integer filePrec, irecord, nx_in, ny_in
40 real*4 arrayin(-1:nx_in+2 , -1:ny_in+2)
41 integer mythid
42
43 C Functions
44 integer MDS_RECLEN
45
46 C local variables
47 integer ierr, length_of_rec
48 real*8 ne_fac,nw_fac,se_fac,sw_fac
49 integer e_ind(snx,sny),w_ind(snx,sny)
50 integer n_ind(snx,sny),s_ind(snx,sny)
51 real*8 px_ind(4), py_ind(4), ew_val(4)
52 external lagran
53 real*8 lagran
54 integer i, j, k, l, js, bi, bj, sp, interp_unit
55 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
56 real*4, target :: global(nx_in,ny_in)
57 #else
58 real*4 global(nx_in,ny_in)
59 #endif
60
61 _BARRIER
62 _BEGIN_MASTER( myThid )
63
64 #ifndef EXF_IREAD_USE_GLOBAL_POINTER
65 C The CPP symbol EXF_IREAD_USE_GLOBAL_POINTER must be defined for the
66 C case of nThreads > 1. Stop if it isnt.
67 IF ( nThreads .GT. 1 ) THEN
68 STOP
69 &'EXF_INTERP_READ: nThreads > 1 needs EXF_IREAD_USE_GLOBAL_POINTER'
70 ENDIF
71 #endif
72 C check input arguments
73 IF ( .NOT. (filePrec .EQ. 32) )
74 & STOP 'stop in exf_interp.F: value of filePrec not allowed'
75
76 C read in input data
77 #ifdef ALLOW_USE_MPI
78 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
79 if (.FALSE.) then
80 #else
81 if (useSingleCPUIO) then
82 #endif
83
84 C master thread of process 0, only, opens a global file
85 IF( mpiMyId .EQ. 0 ) THEN
86 call mdsfindunit( interp_unit, mythid)
87 length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )
88 open(interp_unit,file=infile,status='old',access='direct',
89 & recl=length_of_rec)
90 read(interp_unit,rec=irecord)
91 & ((global(i,j),i=1,nx_in),j=1,ny_in)
92 close(interp_unit)
93 ENDIF
94
95 C broadcast to all processes
96 call MPI_BCAST(global,nx_in*ny_in,MPI_REAL,
97 & 0,MPI_COMM_MODEL,ierr)
98 else
99 #endif /* ALLOW_USE_MPI */
100
101 call mdsfindunit( interp_unit, mythid)
102 length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )
103 open(interp_unit,file=infile,status='old',access='direct',
104 & recl=length_of_rec)
105 read(interp_unit,rec=irecord) global
106 close(interp_unit)
107
108 #ifdef ALLOW_USE_MPI
109 endif
110 #endif /* ALLOW_USE_MPI */
111 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
112 glPtr => global
113 #endif
114 _END_MASTER( myThid )
115 _BARRIER
116 #ifdef EXF_IREAD_USE_GLOBAL_POINTER
117 do j=1,ny_in
118 do i=1,nx_in
119 arrayin(i,j)=glPtr(i,j)
120 enddo
121 enddo
122 #else
123 do j=1,ny_in
124 do i=1,nx_in
125 arrayin(i,j)=global(i,j)
126 enddo
127 enddo
128 #endif
129
130 #ifdef _BYTESWAPIO
131 call MDS_BYTESWAPR4((nx_in+4)*(ny_in+4), arrayin )
132 #endif /* _BYTESWAPIO */
133
134 RETURN
135 END

  ViewVC Help
Powered by ViewVC 1.1.22