/[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.2 by cnh, Tue Nov 8 15:53:41 2005 UTC revision 1.5 by jmc, Thu Aug 31 20:57:47 2006 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "EXF_OPTIONS.h"  #include "EXF_OPTIONS.h"
 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  
 C Flux Coupler using                       C  
 C Bilinear interpolation of forcing fields C  
 C                                          C  
 C B. Cheng (12/2002)                       C  
 C                                          C  
 C added Bicubic (bnc 1/2003)               C  
 C                                          C  
 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC  
5    
6         SUBROUTINE exf_interp_read(         SUBROUTINE exf_interp_read(
7       I   infile,       I   infile, filePrec,
      I   filePrec,  
8       O   arrayin,       O   arrayin,
9       I   irecord, xG, yG,       I   irecord, nx_in, ny_in, mythid)
      I   lon_0, lon_inc,  
      I   lat_0, lat_inc,  
      I   nx_in, ny_in, method, mythid)  
10    
11        implicit none        implicit none
12    
# Line 24  C     infile       = name of the input f Line 14  C     infile       = name of the input f
14  C     filePrec     = file precicision (currently not used, assumes real*4)  C     filePrec     = file precicision (currently not used, assumes real*4)
15  C     arrout       = output arrays (different for each processor)  C     arrout       = output arrays (different for each processor)
16  C     irecord      = record number in global file  C     irecord      = record number in global file
 C     xG,yG        = coordinates for output grid  
 C     lon_0, lat_0 = lon and lat of sw corner of global input grid  
 C     lon_inc      = scalar x-grid increment  
 C     lat_inc      = vector y-grid increments  
17  C     nx_in, ny_in = input x-grid and y-grid size  C     nx_in, ny_in = input x-grid and y-grid size
 C     method       = 1 for bilinear 2 for bicubic  
18  C     mythid       = thread id  C     mythid       = thread id
 C  
19    
20  #include "SIZE.h"  #include "SIZE.h"
21  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 40  C Line 24  C
24  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
25  #include "PARAMS.h"  #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  C subroutine variables
38        character*(*) infile        character*(*) infile
39        integer       filePrec, irecord, nx_in, ny_in        integer       filePrec, irecord, nx_in, ny_in
40        real*4        arrayin(-1:nx_in+2 ,      -1:ny_in+2)        real*4        arrayin(-1:nx_in+2 ,      -1:ny_in+2)
41        _RS           xG      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        integer       mythid
       _RS           yG      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
       _RL           lon_0, lon_inc  
       _RL           lat_0, lat_inc(ny_in-1)  
       integer       method, mythid  
42    
43  C Functions  C Functions
44        integer MDS_RECLEN        integer MDS_RECLEN
# Line 62  C local variables Line 52  C local variables
52        external lagran        external lagran
53        real*8   lagran        real*8   lagran
54        integer  i, j, k, l, js, bi, bj, sp, interp_unit        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)        real*4   global(nx_in,ny_in)
59    #endif
60    
61  C     _BEGIN_MASTER( myThid )        _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  C check input arguments
73         if ( .NOT. (filePrec .EQ. 32) )         if ( .NOT. (filePrec .EQ. 32) )
74       &     stop 'stop in exf_interp.F: value of filePrec not allowed'       &     stop 'stop in exf_interp.F: value of filePrec not allowed'
75    
76  C read in input data  C read in input data
77  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
78         if (useSingleCPUIO) then  C      if (useSingleCPUIO) then
79           if (.FALSE.) then
80    
81  C master thread of process 0, only, opens a global file  C master thread of process 0, only, opens a global file
82          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
# Line 88  C master thread of process 0, only, open Line 92  C master thread of process 0, only, open
92  C broadcast to all processes  C broadcast to all processes
93          call MPI_BCAST(global,nx_in*ny_in,MPI_REAL,          call MPI_BCAST(global,nx_in*ny_in,MPI_REAL,
94       &       0,MPI_COMM_MODEL,ierr)       &       0,MPI_COMM_MODEL,ierr)
         do j=1,ny_in  
          do i=1,nx_in  
           arrayin(i,j)=global(i,j)  
          enddo  
         enddo  
   
95         else         else
96  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
97    
# Line 101  C broadcast to all processes Line 99  C broadcast to all processes
99          length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )          length_of_rec=MDS_RECLEN( filePrec, nx_in*ny_in, mythid )
100          open(interp_unit,file=infile,status='old',access='direct',          open(interp_unit,file=infile,status='old',access='direct',
101       &       recl=length_of_rec)       &       recl=length_of_rec)
102          read(interp_unit,rec=irecord)          read(interp_unit,rec=irecord) global
      &       ((arrayin(i,j),i=1,nx_in),j=1,ny_in)  
103          close(interp_unit)          close(interp_unit)
104    
105  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
106         endif         endif
107  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
108    #ifdef EXF_IREAD_USE_GLOBAL_POINTER
109           glPtr => global
110    #endif
111          _END_MASTER( myThid )
112          _BARRIER
113    #ifdef EXF_IREAD_USE_GLOBAL_POINTER
114           do j=1,ny_in
115            do i=1,nx_in
116             arrayin(i,j)=glPtr(i,j)
117            enddo
118           enddo
119    #else
120           do j=1,ny_in
121            do i=1,nx_in
122             arrayin(i,j)=global(i,j)
123            enddo
124           enddo
125    #endif
126    
127  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
128         call MDS_BYTESWAPR4((nx_in+4)*(ny_in+4), arrayin )         call MDS_BYTESWAPR4((nx_in+4)*(ny_in+4), arrayin )
129  #endif /* _BYTESWAPIO */  #endif /* _BYTESWAPIO */
130    
131  C     _END_MASTER( myThid )        RETURN
   
132        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22