pkg/mdsio/mdsio_read_whalos.F

C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.5 2011/01/19 23:20:24 gforget Exp $
C $fName:  $

#include "MDSIO_OPTIONS.h"

CBOP
C     !ROUTINE: mds_read_whalos
C     !INTERFACE:
      subroutine mds_read_whalos(
     I                   fName,
     I                   len,
     I                   filePrec,
     I                   fid,
     I                   n2d,
     O                   fldRL,
     I                   irec,
     I                   locSingleCPUIO,
     I                   locBufferIO,
     I                   mythid
     &                 )

C     !DESCRIPTION: \bv
c     ==================================================================
c     SUBROUTINE mds_read_whalos
c     ==================================================================
c     o Read file that includes halos. The main purpose is for
c       adjoint related "tape I/O". The secondary purpose is debugging.
c     ==================================================================
c     SUBROUTINE mds_read_whalos
c     ==================================================================
C     \ev

C     !USES:
      implicit none

c     == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#ifdef ALLOW_WHIO
#include "MDSIO_BUFF_WH.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
c     == routine arguments ==
c     fName     -  extended tape fName.
c     len       -  number of characters in fName.
c     filePrec  -  number of bits per word in file (32 or 64).
c     fid       -  file unit (its use is not implemented yet).
C     n2d       -  size of the fldRL third dimension.
c     fldRL     -  array to read.
c     irec      -  record number to be written.
c     mythid    -  number of the thread or instance of the program.

      integer mythid
      character*(*) fName
      integer len
      integer fid
      integer filePrec
      integer n2d
      integer irec
      _RL     fldRL(1-Olx:sNx+Olx,1-Oly:sNy+Oly,n2d,nSx,nSy)
      logical locSingleCPUIO, locBufferIO
CEOP

#ifdef ALLOW_WHIO
C     !LOCAL VARIABLES:
c     == local variables ==

C     sNxWh :: x tile size with halo included
C     sNyWh :: y tile size with halo included
C     pocNyWh :: processor sum of sNyWh
C     gloNyWh :: global sum of sNyWh
      INTEGER sNxWh
      INTEGER sNyWh
      INTEGER procNyWh
      INTEGER gloNyWh
      PARAMETER ( sNxWh = sNx+2*Olx )
      PARAMETER ( sNyWh = sNy+2*Oly )
      PARAMETER ( procNyWh = sNyWh*nSy*nSx )
      PARAMETER ( gloNyWh = procNyWh*nPy*nPx )

      character*(MAX_LEN_FNAM) pfName
      character*(MAX_LEN_MBUF) msgBuf
      integer IL
      integer bx,by

      integer lengthBuff, length_of_rec
      integer i2d, i3d
      integer i,j,k,bi,bj,ii
      integer dUnit, irec2d
      LOGICAL iAmDoingIO

      _RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)

c     == functions ==
      INTEGER  ILNBLNK
      INTEGER  MDS_RECLEN
      EXTERNAL ILNBLNK
      EXTERNAL MDS_RECLEN

c     == end of interface ==

#ifdef ALLOW_WHIO_3D
      writeWh=.FALSE.
#endif

      IF ( .NOT.locSingleCpuIO ) then
        lengthBuff=sNxWh*procNyWh
      ELSE
        lengthBuff=sNxWh*gloNyWh
      ENDIF
      
C Only do I/O if I am the master thread (and mpi process 0 IF locSingleCpuIO):
      iAmDoingIO = .FALSE.
      IF ( .NOT.locSingleCpuIO .OR. myProcId.EQ.0 ) THEN
        _BEGIN_MASTER( myThid )
        iAmDoingIO = .TRUE.
        _END_MASTER( myThid )
      ENDIF      

      IF ( iAmDoingIO ) THEN
c get the unit and open file
      IL  = ILNBLNK( fName )
      IF ( .NOT.locSingleCpuIO ) THEN
        WRITE(pfName,'(2A,I3.3,A)') fName(1:IL),'.',myProcId,'.data'
        length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
      ELSE
        WRITE(pfName,'(2A)') fName(1:IL),'.data'
        length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
      ENDIF
      IF (fid.EQ.0) THEN
        CALL MDSFINDUNIT( dUnit, myThid )
        OPEN( dUnit, file=pfName, status='old',
     &         access='direct', recl=length_of_rec )
      ELSE
        dUnit=fid
      ENDIF  
      ENDIF


      do i2d=1,n2d

        _BARRIER
#ifdef ALLOW_WHIO_3D
        IF ( iAmDoingIO.AND.locBufferIO.AND.(fid.NE.0) ) THEN
c reset counter if needed
          IF (jWh.EQ.nWh) jWh=0
c increment counter
          jWh=jWh+1
c determine current file record
          irec2d=i2d+n2d*(irec-1)
          iWh=(irec2d-1)/nWh+1
c read new chunk if needed
          IF (jWh.EQ.1) THEN
            IF ( .NOT.locSingleCpuIO ) then
              IF (filePrec .EQ. precFloat32) THEN
                READ(dUnit,rec=iWh) fld3d_procbuff_r4
              ELSE
                READ(dUnit,rec=iWh) fld3d_procbuff_r8
              ENDIF
            ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
              IF (filePrec .EQ. precFloat32) THEN
                READ(dUnit,rec=iWh) fld3d_globuff_r4
              ELSE
                READ(dUnit,rec=iWh) fld3d_globuff_r8
              ENDIF
#  endif
            ENDIF
          ENDIF
c copy
          DO i=1,lengthBuff
            j=(jWh-1)*lengthBuff+i
            IF ( .NOT.locSingleCpuIO ) then
              IF (filePrec .EQ. precFloat32) THEN
                fld2d_procbuff_r4(i)=fld3d_procbuff_r4(j)
              ELSE
                fld2d_procbuff_r8(i)=fld3d_procbuff_r8(j)
              ENDIF
            ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
              IF (filePrec .EQ. precFloat32) THEN
                fld2d_globuff_r4(i)=fld3d_globuff_r4(j)
              ELSE
                fld2d_globuff_r8(i)=fld3d_globuff_r8(j)
              ENDIF
#  endif
            ENDIF
          ENDDO

        ELSEIF ( iAmDoingIO ) THEN
#else
        IF ( iAmDoingIO ) THEN
#endif
          irec2d=i2d+n2d*(irec-1)
          IF ( .NOT.locSingleCpuIO ) then
            IF (filePrec .EQ. precFloat32) THEN
              READ(dUnit,rec=irec2d) fld2d_procbuff_r4
            ELSE
              READ(dUnit,rec=irec2d) fld2d_procbuff_r8
            ENDIF
          ELSE
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            IF (filePrec .EQ. precFloat32) THEN
              READ(dUnit,rec=irec2d) fld2d_globuff_r4
            ELSE
              READ(dUnit,rec=irec2d) fld2d_globuff_r8
            ENDIF
#  endif
          ENDIF
        ENDIF
        _BARRIER

        IF (filePrec .EQ. precFloat32) THEN
          IF ( locSingleCpuIO ) then
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
     &                              fld2d_procbuff_r4,myThid)
#  endif
            CALL BAR2( myThid )
          ENDIF
          CALL MDS_PASS_R4toRL( fld2d_procbuff_r4, fldRL,
     &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
        ELSE
          IF ( locSingleCpuIO ) then
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
     &                              fld2d_procbuff_r8,myThid)
#  endif
            CALL BAR2( myThid )
          ENDIF
          CALL MDS_PASS_R8toRL( fld2d_procbuff_r8, fldRL,
     &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
        ENDIF

      enddo

       IF ( iAmDoingIO.AND.(fid.EQ.0) ) THEN
         CLOSE( dUnit )
       ENDIF

#endif

      return
      end
1	gforget	1.6	C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.5 2011/01/19 23:20:24 gforget Exp $
2	gforget	1.1	C $fName: $
3
4			#include "MDSIO_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: mds_read_whalos
8			C !INTERFACE:
9			subroutine mds_read_whalos(
10			I fName,
11			I len,
12			I filePrec,
13			I fid,
14			I n2d,
15			O fldRL,
16			I irec,
17	gforget	1.5	I locSingleCPUIO,
18	gforget	1.6	I locBufferIO,
19	gforget	1.1	I mythid
20			& )
21
22			C !DESCRIPTION: \bv
23			c ==================================================================
24			c SUBROUTINE mds_read_whalos
25			c ==================================================================
26	jmc	1.3	c o Read file that includes halos. The main purpose is for
27	gforget	1.1	c adjoint related "tape I/O". The secondary purpose is debugging.
28			c ==================================================================
29			c SUBROUTINE mds_read_whalos
30			c ==================================================================
31			C \ev
32
33			C !USES:
34			implicit none
35
36			c == global variables ==
37			#include "EEPARAMS.h"
38			#include "SIZE.h"
39			#include "PARAMS.h"
40			#ifdef ALLOW_WHIO
41			#include "MDSIO_BUFF_WH.h"
42			#endif
43
44			C !INPUT/OUTPUT PARAMETERS:
45			c == routine arguments ==
46			c fName - extended tape fName.
47			c len - number of characters in fName.
48			c filePrec - number of bits per word in file (32 or 64).
49			c fid - file unit (its use is not implemented yet).
50			C n2d - size of the fldRL third dimension.
51			c fldRL - array to read.
52			c irec - record number to be written.
53			c mythid - number of the thread or instance of the program.
54
55			integer mythid
56			character() fName
57			integer len
58			integer fid
59			integer filePrec
60			integer n2d
61			integer irec
62			_RL fldRL(1-Olx:sNx+Olx,1-Oly:sNy+Oly,n2d,nSx,nSy)
63	gforget	1.6	logical locSingleCPUIO, locBufferIO
64	gforget	1.1	CEOP
65
66			#ifdef ALLOW_WHIO
67			C !LOCAL VARIABLES:
68			c == local variables ==
69
70			C sNxWh :: x tile size with halo included
71			C sNyWh :: y tile size with halo included
72			C pocNyWh :: processor sum of sNyWh
73			C gloNyWh :: global sum of sNyWh
74			INTEGER sNxWh
75			INTEGER sNyWh
76			INTEGER procNyWh
77			INTEGER gloNyWh
78			PARAMETER ( sNxWh = sNx+2*Olx )
79			PARAMETER ( sNyWh = sNy+2*Oly )
80			PARAMETER ( procNyWh = sNyWhnSynSx )
81			PARAMETER ( gloNyWh = procNyWhnPynPx )
82	jmc	1.3
83	gforget	1.1	character*(MAX_LEN_FNAM) pfName
84			character*(MAX_LEN_MBUF) msgBuf
85	gforget	1.5	integer IL
86	gforget	1.1	integer bx,by
87	jmc	1.3
88	gforget	1.6	integer lengthBuff, length_of_rec
89	gforget	1.1	integer i2d, i3d
90			integer i,j,k,bi,bj,ii
91			integer dUnit, irec2d
92			LOGICAL iAmDoingIO
93
94			_RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)
95
96			c == functions ==
97			INTEGER ILNBLNK
98			INTEGER MDS_RECLEN
99			EXTERNAL ILNBLNK
100			EXTERNAL MDS_RECLEN
101
102			c == end of interface ==
103
104	gforget	1.6	#ifdef ALLOW_WHIO_3D
105			writeWh=.FALSE.
106			#endif
107	gforget	1.1
108	gforget	1.6	IF ( .NOT.locSingleCpuIO ) then
109			lengthBuff=sNxWh*procNyWh
110			ELSE
111			lengthBuff=sNxWh*gloNyWh
112			ENDIF
113
114	gforget	1.5	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
122	gforget	1.1	IF ( iAmDoingIO ) THEN
123			c get the unit and open file
124			IL = ILNBLNK( fName )
125	gforget	1.5	IF ( .NOT.locSingleCpuIO ) THEN
126			WRITE(pfName,'(2A,I3.3,A)') fName(1:IL),'.',myProcId,'.data'
127	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
128			ELSE
129	gforget	1.5	WRITE(pfName,'(2A)') fName(1:IL),'.data'
130	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
131			ENDIF
132	gforget	1.5	IF (fid.EQ.0) THEN
133			CALL MDSFINDUNIT( dUnit, myThid )
134			OPEN( dUnit, file=pfName, status='old',
135	gforget	1.1	& access='direct', recl=length_of_rec )
136	gforget	1.5	ELSE
137			dUnit=fid
138			ENDIF
139	gforget	1.1	ENDIF
140
141
142			do i2d=1,n2d
143
144			_BARRIER
145	gforget	1.6	#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	gforget	1.1	IF ( iAmDoingIO ) THEN
195	gforget	1.6	#endif
196	gforget	1.5	irec2d=i2d+n2d*(irec-1)
197			IF ( .NOT.locSingleCpuIO ) then
198	gforget	1.1	IF (filePrec .EQ. precFloat32) THEN
199			READ(dUnit,rec=irec2d) fld2d_procbuff_r4
200			ELSE
201			READ(dUnit,rec=irec2d) fld2d_procbuff_r8
202			ENDIF
203	jmc	1.3	ELSE
204	gforget	1.6	# ifndef EXCLUDE_WHIO_GLOBUFF_2D
205	gforget	1.1	IF (filePrec .EQ. precFloat32) THEN
206			READ(dUnit,rec=irec2d) fld2d_globuff_r4
207			ELSE
208			READ(dUnit,rec=irec2d) fld2d_globuff_r8
209	jmc	1.3	ENDIF
210	gforget	1.6	# endif
211	jmc	1.3	ENDIF
212	gforget	1.1	ENDIF
213			_BARRIER
214
215			IF (filePrec .EQ. precFloat32) THEN
216	gforget	1.5	IF ( locSingleCpuIO ) then
217	gforget	1.6	# ifndef EXCLUDE_WHIO_GLOBUFF_2D
218	jmc	1.3	CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
219	gforget	1.1	& fld2d_procbuff_r4,myThid)
220	gforget	1.6	# endif
221	gforget	1.1	CALL BAR2( myThid )
222			ENDIF
223	jmc	1.4	CALL MDS_PASS_R4toRL( fld2d_procbuff_r4, fldRL,
224			& OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
225	gforget	1.1	ELSE
226	gforget	1.5	IF ( locSingleCpuIO ) then
227	gforget	1.6	# ifndef EXCLUDE_WHIO_GLOBUFF_2D
228	jmc	1.3	CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
229	gforget	1.1	& fld2d_procbuff_r8,myThid)
230	gforget	1.6	# endif
231	gforget	1.1	CALL BAR2( myThid )
232			ENDIF
233	jmc	1.4	CALL MDS_PASS_R8toRL( fld2d_procbuff_r8, fldRL,
234			& OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
235	gforget	1.1	ENDIF
236
237			enddo
238	jmc	1.3
239	gforget	1.5	IF ( iAmDoingIO.AND.(fid.EQ.0) ) THEN
240	gforget	1.1	CLOSE( dUnit )
241			ENDIF
242
243			#endif
244
245			return
246			end