pkg/mdsio/mdsio_read_whalos.F

C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.7 2011/06/23 22:11:07 jmc Exp $
C $Name:  $

#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
cph(
#ifdef INTEL_COMMITQQ
cph   Fix on Pleiades following model crashes on disk /nobackupnfs2/
cph   reported by Yoshihiro.Nakayama@jpl.nasa.gov
cph forrtl: Device or resource busy
cph forrtl: severe (39): error during read, unit 1001, file
cph   Workaround by NAS engineer Sherry.Chang@nasa.gov
      logical results, commitqq
#endif
cph)


      _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

cph(
cph   NAS Pleiades fix here:
#ifdef INTEL_COMMITQQ
      results = commitqq(dUnit)
#endif
cph)

      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	heimbach	1.8	C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.7 2011/06/23 22:11:07 jmc Exp $
2	jmc	1.7	C $Name: $
3	gforget	1.1
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	heimbach	1.8	cph(
94			#ifdef INTEL_COMMITQQ
95			cph Fix on Pleiades following model crashes on disk /nobackupnfs2/
96			cph reported by Yoshihiro.Nakayama@jpl.nasa.gov
97			cph forrtl: Device or resource busy
98			cph forrtl: severe (39): error during read, unit 1001, file
99			cph Workaround by NAS engineer Sherry.Chang@nasa.gov
100			logical results, commitqq
101			#endif
102			cph)
103
104	gforget	1.1
105			_RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)
106
107			c == functions ==
108			INTEGER ILNBLNK
109			INTEGER MDS_RECLEN
110			EXTERNAL ILNBLNK
111			EXTERNAL MDS_RECLEN
112
113			c == end of interface ==
114
115	gforget	1.6	#ifdef ALLOW_WHIO_3D
116			writeWh=.FALSE.
117			#endif
118	gforget	1.1
119	gforget	1.6	IF ( .NOT.locSingleCpuIO ) then
120			lengthBuff=sNxWh*procNyWh
121			ELSE
122			lengthBuff=sNxWh*gloNyWh
123			ENDIF
124	jmc	1.7
125	gforget	1.5	C Only do I/O if I am the master thread (and mpi process 0 IF locSingleCpuIO):
126			iAmDoingIO = .FALSE.
127			IF ( .NOT.locSingleCpuIO .OR. myProcId.EQ.0 ) THEN
128			_BEGIN_MASTER( myThid )
129			iAmDoingIO = .TRUE.
130			_END_MASTER( myThid )
131	jmc	1.7	ENDIF
132	gforget	1.5
133	gforget	1.1	IF ( iAmDoingIO ) THEN
134			c get the unit and open file
135			IL = ILNBLNK( fName )
136	gforget	1.5	IF ( .NOT.locSingleCpuIO ) THEN
137			WRITE(pfName,'(2A,I3.3,A)') fName(1:IL),'.',myProcId,'.data'
138	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
139			ELSE
140	gforget	1.5	WRITE(pfName,'(2A)') fName(1:IL),'.data'
141	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
142			ENDIF
143	gforget	1.5	IF (fid.EQ.0) THEN
144			CALL MDSFINDUNIT( dUnit, myThid )
145			OPEN( dUnit, file=pfName, status='old',
146	gforget	1.1	& access='direct', recl=length_of_rec )
147	gforget	1.5	ELSE
148			dUnit=fid
149	jmc	1.7	ENDIF
150	gforget	1.1	ENDIF
151
152	heimbach	1.8	cph(
153			cph NAS Pleiades fix here:
154			#ifdef INTEL_COMMITQQ
155			results = commitqq(dUnit)
156			#endif
157			cph)
158	gforget	1.1
159			do i2d=1,n2d
160
161			_BARRIER
162	gforget	1.6	#ifdef ALLOW_WHIO_3D
163			IF ( iAmDoingIO.AND.locBufferIO.AND.(fid.NE.0) ) THEN
164			c reset counter if needed
165			IF (jWh.EQ.nWh) jWh=0
166			c increment counter
167			jWh=jWh+1
168			c determine current file record
169			irec2d=i2d+n2d*(irec-1)
170			iWh=(irec2d-1)/nWh+1
171			c read new chunk if needed
172			IF (jWh.EQ.1) THEN
173			IF ( .NOT.locSingleCpuIO ) then
174			IF (filePrec .EQ. precFloat32) THEN
175			READ(dUnit,rec=iWh) fld3d_procbuff_r4
176			ELSE
177			READ(dUnit,rec=iWh) fld3d_procbuff_r8
178			ENDIF
179			ELSE
180			# ifdef INCLUDE_WHIO_GLOBUFF_3D
181			IF (filePrec .EQ. precFloat32) THEN
182			READ(dUnit,rec=iWh) fld3d_globuff_r4
183			ELSE
184			READ(dUnit,rec=iWh) fld3d_globuff_r8
185			ENDIF
186			# endif
187			ENDIF
188			ENDIF
189			c copy
190			DO i=1,lengthBuff
191			j=(jWh-1)*lengthBuff+i
192			IF ( .NOT.locSingleCpuIO ) then
193			IF (filePrec .EQ. precFloat32) THEN
194			fld2d_procbuff_r4(i)=fld3d_procbuff_r4(j)
195			ELSE
196			fld2d_procbuff_r8(i)=fld3d_procbuff_r8(j)
197			ENDIF
198			ELSE
199			# ifdef INCLUDE_WHIO_GLOBUFF_3D
200			IF (filePrec .EQ. precFloat32) THEN
201			fld2d_globuff_r4(i)=fld3d_globuff_r4(j)
202			ELSE
203			fld2d_globuff_r8(i)=fld3d_globuff_r8(j)
204			ENDIF
205			# endif
206			ENDIF
207			ENDDO
208
209			ELSEIF ( iAmDoingIO ) THEN
210			#else
211	gforget	1.1	IF ( iAmDoingIO ) THEN
212	gforget	1.6	#endif
213	gforget	1.5	irec2d=i2d+n2d*(irec-1)
214			IF ( .NOT.locSingleCpuIO ) then
215	gforget	1.1	IF (filePrec .EQ. precFloat32) THEN
216			READ(dUnit,rec=irec2d) fld2d_procbuff_r4
217			ELSE
218			READ(dUnit,rec=irec2d) fld2d_procbuff_r8
219			ENDIF
220	jmc	1.3	ELSE
221	gforget	1.6	# ifndef EXCLUDE_WHIO_GLOBUFF_2D
222	gforget	1.1	IF (filePrec .EQ. precFloat32) THEN
223			READ(dUnit,rec=irec2d) fld2d_globuff_r4
224			ELSE
225			READ(dUnit,rec=irec2d) fld2d_globuff_r8
226	jmc	1.3	ENDIF
227	gforget	1.6	# endif
228	jmc	1.3	ENDIF
229	gforget	1.1	ENDIF
230			_BARRIER
231
232			IF (filePrec .EQ. precFloat32) THEN
233	gforget	1.5	IF ( locSingleCpuIO ) then
234	gforget	1.6	# ifndef EXCLUDE_WHIO_GLOBUFF_2D
235	jmc	1.3	CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
236	gforget	1.1	& fld2d_procbuff_r4,myThid)
237	gforget	1.6	# endif
238	gforget	1.1	CALL BAR2( myThid )
239			ENDIF
240	jmc	1.4	CALL MDS_PASS_R4toRL( fld2d_procbuff_r4, fldRL,
241			& OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
242	gforget	1.1	ELSE
243	gforget	1.5	IF ( locSingleCpuIO ) then
244	gforget	1.6	# ifndef EXCLUDE_WHIO_GLOBUFF_2D
245	jmc	1.3	CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
246	gforget	1.1	& fld2d_procbuff_r8,myThid)
247	gforget	1.6	# endif
248	gforget	1.1	CALL BAR2( myThid )
249			ENDIF
250	jmc	1.4	CALL MDS_PASS_R8toRL( fld2d_procbuff_r8, fldRL,
251			& OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
252	gforget	1.1	ENDIF
253
254			enddo
255	jmc	1.3
256	gforget	1.5	IF ( iAmDoingIO.AND.(fid.EQ.0) ) THEN
257	gforget	1.1	CLOSE( dUnit )
258			ENDIF
259
260			#endif
261
262	jmc	1.7	RETURN
263			END