/[MITgcm]/MITgcm/pkg/mdsio/mdsio_read_whalos.F
ViewVC logotype

Diff of /MITgcm/pkg/mdsio/mdsio_read_whalos.F

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

revision 1.1 by gforget, Fri Sep 24 18:39:35 2010 UTC revision 1.6 by gforget, Fri Jan 21 22:02:33 2011 UTC
# Line 14  C     !INTERFACE: Line 14  C     !INTERFACE:
14       I                   n2d,       I                   n2d,
15       O                   fldRL,       O                   fldRL,
16       I                   irec,       I                   irec,
17         I                   locSingleCPUIO,
18         I                   locBufferIO,
19       I                   mythid       I                   mythid
20       &                 )       &                 )
21    
# Line 21  C     !DESCRIPTION: \bv Line 23  C     !DESCRIPTION: \bv
23  c     ==================================================================  c     ==================================================================
24  c     SUBROUTINE mds_read_whalos  c     SUBROUTINE mds_read_whalos
25  c     ==================================================================  c     ==================================================================
26  c     o Read file that includes halos. The main purpose is for  c     o Read file that includes halos. The main purpose is for
27  c       adjoint related "tape I/O". The secondary purpose is debugging.  c       adjoint related "tape I/O". The secondary purpose is debugging.
28  c     ==================================================================  c     ==================================================================
29  c     SUBROUTINE mds_read_whalos  c     SUBROUTINE mds_read_whalos
# Line 56  c     mythid    -  number of the thread Line 58  c     mythid    -  number of the thread
58        integer fid        integer fid
59        integer filePrec        integer filePrec
60        integer n2d        integer n2d
       integer length  
61        integer irec        integer irec
62        _RL     fldRL(1-Olx:sNx+Olx,1-Oly:sNy+Oly,n2d,nSx,nSy)        _RL     fldRL(1-Olx:sNx+Olx,1-Oly:sNy+Oly,n2d,nSx,nSy)
63          logical locSingleCPUIO, locBufferIO
64  CEOP  CEOP
65    
66  #ifdef ALLOW_WHIO  #ifdef ALLOW_WHIO
# Line 77  C     gloNyWh :: global sum of sNyWh Line 79  C     gloNyWh :: global sum of sNyWh
79        PARAMETER ( sNyWh = sNy+2*Oly )        PARAMETER ( sNyWh = sNy+2*Oly )
80        PARAMETER ( procNyWh = sNyWh*nSy*nSx )        PARAMETER ( procNyWh = sNyWh*nSy*nSx )
81        PARAMETER ( gloNyWh = procNyWh*nPy*nPx )        PARAMETER ( gloNyWh = procNyWh*nPy*nPx )
82          
83        character*(MAX_LEN_FNAM) pfName        character*(MAX_LEN_FNAM) pfName
84        character*(MAX_LEN_MBUF) msgBuf        character*(MAX_LEN_MBUF) msgBuf
85        integer IL,pIL        integer IL
86        integer bx,by        integer bx,by
87          
88        integer length2d, length3d, length_of_rec        integer lengthBuff, length_of_rec
89        integer i2d, i3d        integer i2d, i3d
90        integer i,j,k,bi,bj,ii        integer i,j,k,bi,bj,ii
91        integer dUnit, irec2d        integer dUnit, irec2d
92        LOGICAL iAmDoingIO        LOGICAL iAmDoingIO
93    
94        _RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)        _RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)
 c global buffers  
       Real*4 fld2d_globuff_r4(sNxWh,gloNyWh)  
       Real*8 fld2d_globuff_r8(sNxWh,gloNyWh)  
 c The corresponding proc buffers are in common blocks  
 c  (in MDSIO_BUFF_WH.h) which is needed for multi-threads.  
 c Eventually we could want to also put global buffers in common  
 c  blocks in .h (to save memory) but local is fine for now.  
95    
96  c     == functions ==  c     == functions ==
97        INTEGER  ILNBLNK        INTEGER  ILNBLNK
98        INTEGER  MDS_RECLEN        INTEGER  MDS_RECLEN
       LOGICAL  MASTER_CPU_IO  
99        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
100        EXTERNAL MDS_RECLEN        EXTERNAL MDS_RECLEN
       EXTERNAL MASTER_CPU_IO  
101    
102  c     == end of interface ==  c     == end of interface ==
103    
104        length2d=sNxWh*procNyWh  #ifdef ALLOW_WHIO_3D
105        length3d=length2d*nr        writeWh=.FALSE.
106    #endif
107    
108          IF ( .NOT.locSingleCpuIO ) then
109            lengthBuff=sNxWh*procNyWh
110          ELSE
111            lengthBuff=sNxWh*gloNyWh
112          ENDIF
113          
114    C Only do I/O if I am the master thread (and mpi process 0 IF locSingleCpuIO):
115          iAmDoingIO = .FALSE.
116          IF ( .NOT.locSingleCpuIO .OR. myProcId.EQ.0 ) THEN
117            _BEGIN_MASTER( myThid )
118            iAmDoingIO = .TRUE.
119            _END_MASTER( myThid )
120          ENDIF      
121    
 C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO):  
       iAmDoingIO = MASTER_CPU_IO(myThid)  
122        IF ( iAmDoingIO ) THEN        IF ( iAmDoingIO ) THEN
123  c get the unit and open file  c get the unit and open file
       CALL MDSFINDUNIT( dUnit, myThid )  
124        IL  = ILNBLNK( fName )        IL  = ILNBLNK( fName )
125        pIL = ILNBLNK( mdsioLocalDir )        IF ( .NOT.locSingleCpuIO ) THEN
126        IF ( pIL.EQ.0 ) THEN          WRITE(pfName,'(2A,I3.3,A)') fName(1:IL),'.',myProcId,'.data'
         pfName = fName  
       ELSE  
        WRITE(pfName,'(2A)') mdsioLocalDir(1:pIL), fName(1:IL)  
       ENDIF  
       pIL=ILNBLNK( pfName )  
       IF ( .NOT.useSingleCpuIO ) THEN  
         WRITE(pfName,'(2A,I3.3,A)') pfName(1:pIL),'.',myProcId,'.data'  
127          length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )          length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
128        ELSE        ELSE
129          WRITE(pfName,'(2A)') pfName(1:pIL),'.data'          WRITE(pfName,'(2A)') fName(1:IL),'.data'
130          length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)          length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
131        ENDIF        ENDIF
132        OPEN( dUnit, file=pfName, status='old',        IF (fid.EQ.0) THEN
133            CALL MDSFINDUNIT( dUnit, myThid )
134            OPEN( dUnit, file=pfName, status='old',
135       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
136          ELSE
137            dUnit=fid
138          ENDIF  
139        ENDIF        ENDIF
140    
141    
142        do i2d=1,n2d        do i2d=1,n2d
143    
144          _BARRIER          _BARRIER
145    #ifdef ALLOW_WHIO_3D
146            IF ( iAmDoingIO.AND.locBufferIO.AND.(fid.NE.0) ) THEN
147    c reset counter if needed
148              IF (jWh.EQ.nWh) jWh=0
149    c increment counter
150              jWh=jWh+1
151    c determine current file record
152              irec2d=i2d+n2d*(irec-1)
153              iWh=(irec2d-1)/nWh+1
154    c read new chunk if needed
155              IF (jWh.EQ.1) THEN
156                IF ( .NOT.locSingleCpuIO ) then
157                  IF (filePrec .EQ. precFloat32) THEN
158                    READ(dUnit,rec=iWh) fld3d_procbuff_r4
159                  ELSE
160                    READ(dUnit,rec=iWh) fld3d_procbuff_r8
161                  ENDIF
162                ELSE
163    #  ifdef INCLUDE_WHIO_GLOBUFF_3D
164                  IF (filePrec .EQ. precFloat32) THEN
165                    READ(dUnit,rec=iWh) fld3d_globuff_r4
166                  ELSE
167                    READ(dUnit,rec=iWh) fld3d_globuff_r8
168                  ENDIF
169    #  endif
170                ENDIF
171              ENDIF
172    c copy
173              DO i=1,lengthBuff
174                j=(jWh-1)*lengthBuff+i
175                IF ( .NOT.locSingleCpuIO ) then
176                  IF (filePrec .EQ. precFloat32) THEN
177                    fld2d_procbuff_r4(i)=fld3d_procbuff_r4(j)
178                  ELSE
179                    fld2d_procbuff_r8(i)=fld3d_procbuff_r8(j)
180                  ENDIF
181                ELSE
182    #  ifdef INCLUDE_WHIO_GLOBUFF_3D
183                  IF (filePrec .EQ. precFloat32) THEN
184                    fld2d_globuff_r4(i)=fld3d_globuff_r4(j)
185                  ELSE
186                    fld2d_globuff_r8(i)=fld3d_globuff_r8(j)
187                  ENDIF
188    #  endif
189                ENDIF
190              ENDDO
191    
192            ELSEIF ( iAmDoingIO ) THEN
193    #else
194          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
195          irec2d=i2d+n2d*(irec-1)  #endif
196            IF ( .NOT.useSingleCpuIO ) then            irec2d=i2d+n2d*(irec-1)
197              IF ( .NOT.locSingleCpuIO ) then
198              IF (filePrec .EQ. precFloat32) THEN              IF (filePrec .EQ. precFloat32) THEN
199                READ(dUnit,rec=irec2d) fld2d_procbuff_r4                READ(dUnit,rec=irec2d) fld2d_procbuff_r4
200              ELSE              ELSE
201                READ(dUnit,rec=irec2d) fld2d_procbuff_r8                READ(dUnit,rec=irec2d) fld2d_procbuff_r8
202              ENDIF              ENDIF
203            ELSE                      ELSE
204    #  ifndef EXCLUDE_WHIO_GLOBUFF_2D
205              IF (filePrec .EQ. precFloat32) THEN              IF (filePrec .EQ. precFloat32) THEN
206                READ(dUnit,rec=irec2d) fld2d_globuff_r4                READ(dUnit,rec=irec2d) fld2d_globuff_r4
207              ELSE              ELSE
208                READ(dUnit,rec=irec2d) fld2d_globuff_r8                READ(dUnit,rec=irec2d) fld2d_globuff_r8
209              ENDIF                        ENDIF
210            ENDIF            #  endif
211              ENDIF
212          ENDIF          ENDIF
213          _BARRIER          _BARRIER
214    
215          IF (filePrec .EQ. precFloat32) THEN          IF (filePrec .EQ. precFloat32) THEN
216            IF ( useSingleCpuIO ) then            IF ( locSingleCpuIO ) then
217              CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,  #  ifndef EXCLUDE_WHIO_GLOBUFF_2D
218                CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
219       &                              fld2d_procbuff_r4,myThid)       &                              fld2d_procbuff_r4,myThid)
220    #  endif
221              CALL BAR2( myThid )              CALL BAR2( myThid )
222            ENDIF            ENDIF
223            CALL MDS_PASS_WH_R4toRL( fld2d_procbuff_r4, fldRL,            CALL MDS_PASS_R4toRL( fld2d_procbuff_r4, fldRL,
224       &                    1, i2d, n2d, 0, 0, .TRUE., myThid )       &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
225          ELSE          ELSE
226            IF ( useSingleCpuIO ) then            IF ( locSingleCpuIO ) then
227              CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,  #  ifndef EXCLUDE_WHIO_GLOBUFF_2D
228                CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
229       &                              fld2d_procbuff_r8,myThid)       &                              fld2d_procbuff_r8,myThid)
230    #  endif
231              CALL BAR2( myThid )              CALL BAR2( myThid )
232            ENDIF            ENDIF
233            CALL MDS_PASS_WH_R8toRL( fld2d_procbuff_r8, fldRL,            CALL MDS_PASS_R8toRL( fld2d_procbuff_r8, fldRL,
234       &                    1, i2d, n2d, 0, 0, .TRUE., myThid )       &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
235          ENDIF          ENDIF
236    
237        enddo        enddo
238          
239         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO.AND.(fid.EQ.0) ) THEN
240           CLOSE( dUnit )           CLOSE( dUnit )
241         ENDIF         ENDIF
242    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22