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

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

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

revision 1.8 by mlosch, Thu Dec 14 08:17:15 2006 UTC revision 1.9 by dimitri, Thu Dec 14 22:15:27 2006 UTC
# Line 32  C     in an ifdef because it won't go th Line 32  C     in an ifdef because it won't go th
32  C     currently sure what TAF would do with this.  C     currently sure what TAF would do with this.
33        COMMON /EXF_IOPTR/ glPtr        COMMON /EXF_IOPTR/ glPtr
34        REAL*4, POINTER :: glPtr(:,:)        REAL*4, POINTER :: glPtr(:,:)
35          COMMON /EXF_IOPTR8/ glPtr8
36          REAL*8, POINTER :: glPtr8(:,:)
37  #endif  #endif
38    
39  C subroutine variables  C subroutine variables
40        character*(*) infile        character*(*) infile
41        integer       filePrec, irecord, nx_in, ny_in        integer       filePrec, irecord, nx_in, ny_in
42        real*4        arrayin(-1:nx_in+2 ,      -1:ny_in+2)        real*4        arrayin( -1:nx_in+2 , -1:ny_in+2 )
43        integer       mythid        integer       mythid
44    
45  C Functions  C Functions
# Line 54  C local variables Line 56  C local variables
56        integer  i, j, k, l, js, bi, bj, sp, interp_unit        integer  i, j, k, l, js, bi, bj, sp, interp_unit
57  #ifdef EXF_IREAD_USE_GLOBAL_POINTER  #ifdef EXF_IREAD_USE_GLOBAL_POINTER
58        real*4, target ::   global(nx_in,ny_in)        real*4, target ::   global(nx_in,ny_in)
59          real*8, target ::   global8(nx_in,ny_in)
60  #else  #else
61        real*4   global(nx_in,ny_in)        real*4   global(nx_in,ny_in)
62          real*8   global8(nx_in,ny_in)
63  #endif  #endif
64    
65        _BARRIER        _BARRIER
# Line 69  C     case of nThreads > 1. Stop if it i Line 73  C     case of nThreads > 1. Stop if it i
73       &'EXF_INTERP_READ: nThreads > 1 needs EXF_IREAD_USE_GLOBAL_POINTER'       &'EXF_INTERP_READ: nThreads > 1 needs EXF_IREAD_USE_GLOBAL_POINTER'
74        ENDIF        ENDIF
75  #endif  #endif
 C check input arguments  
       IF ( .NOT. (filePrec .EQ. 32) )  
      &     STOP 'stop in exf_interp.F: value of filePrec not allowed'  
76    
77  C read in input data  C read in input data
78  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
# Line 87  C master thread of process 0, only, open Line 88  C master thread of process 0, only, open
88           length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )           length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )
89           open(interp_unit,file=infile,status='old',access='direct',           open(interp_unit,file=infile,status='old',access='direct',
90       &        recl=length_of_rec)       &        recl=length_of_rec)
91           read(interp_unit,rec=irecord)           IF ( filePrec .EQ. 32 ) THEN
92       &        ((global(i,j),i=1,nx_in),j=1,ny_in)              read(interp_unit,rec=irecord)
93         &           ((global(i,j),i=1,nx_in),j=1,ny_in)
94    #ifdef _BYTESWAPIO
95                call MDS_BYTESWAPR4(nx_in*ny_in,global)
96    #endif /* _BYTESWAPIO */
97             ELSE
98                read(interp_unit,rec=irecord)
99         &           ((global8(i,j),i=1,nx_in),j=1,ny_in)
100    #ifdef _BYTESWAPIO
101                call MDS_BYTESWAPR8(nx_in*ny_in,global8)
102    #endif /* _BYTESWAPIO */
103             ENDIF
104           close(interp_unit)           close(interp_unit)
105          ENDIF          ENDIF
106    
107  C broadcast to all processes  C broadcast to all processes
108          call MPI_BCAST(global,nx_in*ny_in,MPI_REAL,          IF ( filePrec .EQ. 32 ) THEN
109       &       0,MPI_COMM_MODEL,ierr)             call MPI_BCAST(global,nx_in*ny_in,MPI_REAL,
110         &          0,MPI_COMM_MODEL,ierr)
111            ELSE
112               call MPI_BCAST(global8,nx_in*ny_in,MPI_DOUBLE_PRECISION,
113         &          0,MPI_COMM_MODEL,ierr)
114            ENDIF
115         else         else
116  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
117    
# Line 102  C broadcast to all processes Line 119  C broadcast to all processes
119          length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )          length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )
120          open(interp_unit,file=infile,status='old',access='direct',          open(interp_unit,file=infile,status='old',access='direct',
121       &       recl=length_of_rec)       &       recl=length_of_rec)
122          read(interp_unit,rec=irecord) global          IF ( filePrec .EQ. 32 ) THEN
123               read(interp_unit,rec=irecord) global
124    #ifdef _BYTESWAPIO
125               call MDS_BYTESWAPR4(nx_in*ny_in,global)
126    #endif /* _BYTESWAPIO */
127            ELSE
128               read(interp_unit,rec=irecord) global8
129    #ifdef _BYTESWAPIO
130               call MDS_BYTESWAPR8(nx_in*ny_in,global8)
131    #endif /* _BYTESWAPIO */
132            ENDIF
133          close(interp_unit)          close(interp_unit)
134    
135  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
136         endif         endif
137  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
138  #ifdef EXF_IREAD_USE_GLOBAL_POINTER  #ifdef EXF_IREAD_USE_GLOBAL_POINTER
139         glPtr => global         IF ( filePrec .EQ. 32 ) THEN
140              glPtr => global
141           ELSE
142              glPtr8 => global8
143           ENDIF
144  #endif  #endif
145        _END_MASTER( myThid )        _END_MASTER( myThid )
146        _BARRIER        _BARRIER
147    
148  #ifdef EXF_IREAD_USE_GLOBAL_POINTER  #ifdef EXF_IREAD_USE_GLOBAL_POINTER
149         do j=1,ny_in        IF ( filePrec .EQ. 32 ) THEN
150          do i=1,nx_in           do j=1,ny_in
151           arrayin(i,j)=glPtr(i,j)              do i=1,nx_in
152          enddo                 arrayin(i,j)=glPtr(i,j)
153         enddo              enddo
154             enddo
155          ELSE
156             do j=1,ny_in
157                do i=1,nx_in
158                   arrayin(i,j)=glPtr8(i,j)
159                enddo
160             enddo
161          ENDIF
162  #else  #else
163         do j=1,ny_in        IF ( filePrec .EQ. 32 ) THEN
164          do i=1,nx_in           do j=1,ny_in
165           arrayin(i,j)=global(i,j)              do i=1,nx_in
166          enddo                 arrayin(i,j)=global(i,j)
167         enddo              enddo
168             enddo
169          ELSE
170             do j=1,ny_in
171                do i=1,nx_in
172                   arrayin(i,j)=global8(i,j)
173                enddo
174             enddo
175          ENDIF
176  #endif  #endif
177    
 #ifdef _BYTESWAPIO  
        call MDS_BYTESWAPR4((nx_in+4)*(ny_in+4), arrayin )  
 #endif /* _BYTESWAPIO */  
   
178        RETURN        RETURN
179        END        END
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22