pkg/mdsio/mdsio_read_whalos.F

C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.4 2010/12/23 18:05:00 jmc 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                   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
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 length2d, length3d, 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 ==

      length2d=sNxWh*procNyWh
      length3d=length2d*nr

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
        IF ( iAmDoingIO ) THEN
          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
            IF (filePrec .EQ. precFloat32) THEN
              READ(dUnit,rec=irec2d) fld2d_globuff_r4
            ELSE
              READ(dUnit,rec=irec2d) fld2d_globuff_r8
            ENDIF
          ENDIF
        ENDIF
        _BARRIER

        IF (filePrec .EQ. precFloat32) THEN
          IF ( locSingleCpuIO ) then
            CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
     &                              fld2d_procbuff_r4,myThid)
            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
            CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
     &                              fld2d_procbuff_r8,myThid)
            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.5	C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.4 2010/12/23 18:05:00 jmc 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.1	I mythid
19			& )
20
21			C !DESCRIPTION: \bv
22			c ==================================================================
23			c SUBROUTINE mds_read_whalos
24			c ==================================================================
25	jmc	1.3	c o Read file that includes halos. The main purpose is for
26	gforget	1.1	c adjoint related "tape I/O". The secondary purpose is debugging.
27			c ==================================================================
28			c SUBROUTINE mds_read_whalos
29			c ==================================================================
30			C \ev
31
32			C !USES:
33			implicit none
34
35			c == global variables ==
36			#include "EEPARAMS.h"
37			#include "SIZE.h"
38			#include "PARAMS.h"
39			#ifdef ALLOW_WHIO
40			#include "MDSIO_BUFF_WH.h"
41			#endif
42
43			C !INPUT/OUTPUT PARAMETERS:
44			c == routine arguments ==
45			c fName - extended tape fName.
46			c len - number of characters in fName.
47			c filePrec - number of bits per word in file (32 or 64).
48			c fid - file unit (its use is not implemented yet).
49			C n2d - size of the fldRL third dimension.
50			c fldRL - array to read.
51			c irec - record number to be written.
52			c mythid - number of the thread or instance of the program.
53
54			integer mythid
55			character() fName
56			integer len
57			integer fid
58			integer filePrec
59			integer n2d
60			integer irec
61			_RL fldRL(1-Olx:sNx+Olx,1-Oly:sNy+Oly,n2d,nSx,nSy)
62	gforget	1.5	logical locSingleCPUIO
63	gforget	1.1	CEOP
64
65			#ifdef ALLOW_WHIO
66			C !LOCAL VARIABLES:
67			c == local variables ==
68
69			C sNxWh :: x tile size with halo included
70			C sNyWh :: y tile size with halo included
71			C pocNyWh :: processor sum of sNyWh
72			C gloNyWh :: global sum of sNyWh
73			INTEGER sNxWh
74			INTEGER sNyWh
75			INTEGER procNyWh
76			INTEGER gloNyWh
77			PARAMETER ( sNxWh = sNx+2*Olx )
78			PARAMETER ( sNyWh = sNy+2*Oly )
79			PARAMETER ( procNyWh = sNyWhnSynSx )
80			PARAMETER ( gloNyWh = procNyWhnPynPx )
81	jmc	1.3
82	gforget	1.1	character*(MAX_LEN_FNAM) pfName
83			character*(MAX_LEN_MBUF) msgBuf
84	gforget	1.5	integer IL
85	gforget	1.1	integer bx,by
86	jmc	1.3
87	gforget	1.1	integer length2d, length3d, length_of_rec
88			integer i2d, i3d
89			integer i,j,k,bi,bj,ii
90			integer dUnit, irec2d
91			LOGICAL iAmDoingIO
92
93			_RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)
94
95			c == functions ==
96			INTEGER ILNBLNK
97			INTEGER MDS_RECLEN
98			EXTERNAL ILNBLNK
99			EXTERNAL MDS_RECLEN
100
101			c == end of interface ==
102
103	jmc	1.3	length2d=sNxWh*procNyWh
104	gforget	1.1	length3d=length2d*nr
105
106	gforget	1.5	C Only do I/O if I am the master thread (and mpi process 0 IF locSingleCpuIO):
107			iAmDoingIO = .FALSE.
108			IF ( .NOT.locSingleCpuIO .OR. myProcId.EQ.0 ) THEN
109			_BEGIN_MASTER( myThid )
110			iAmDoingIO = .TRUE.
111			_END_MASTER( myThid )
112			ENDIF
113
114	gforget	1.1	IF ( iAmDoingIO ) THEN
115			c get the unit and open file
116			IL = ILNBLNK( fName )
117	gforget	1.5	IF ( .NOT.locSingleCpuIO ) THEN
118			WRITE(pfName,'(2A,I3.3,A)') fName(1:IL),'.',myProcId,'.data'
119	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
120			ELSE
121	gforget	1.5	WRITE(pfName,'(2A)') fName(1:IL),'.data'
122	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
123			ENDIF
124	gforget	1.5	IF (fid.EQ.0) THEN
125			CALL MDSFINDUNIT( dUnit, myThid )
126			OPEN( dUnit, file=pfName, status='old',
127	gforget	1.1	& access='direct', recl=length_of_rec )
128	gforget	1.5	ELSE
129			dUnit=fid
130			ENDIF
131	gforget	1.1	ENDIF
132
133
134			do i2d=1,n2d
135
136			_BARRIER
137			IF ( iAmDoingIO ) THEN
138	gforget	1.5	irec2d=i2d+n2d*(irec-1)
139			IF ( .NOT.locSingleCpuIO ) then
140	gforget	1.1	IF (filePrec .EQ. precFloat32) THEN
141			READ(dUnit,rec=irec2d) fld2d_procbuff_r4
142			ELSE
143			READ(dUnit,rec=irec2d) fld2d_procbuff_r8
144			ENDIF
145	jmc	1.3	ELSE
146	gforget	1.1	IF (filePrec .EQ. precFloat32) THEN
147			READ(dUnit,rec=irec2d) fld2d_globuff_r4
148			ELSE
149			READ(dUnit,rec=irec2d) fld2d_globuff_r8
150	jmc	1.3	ENDIF
151			ENDIF
152	gforget	1.1	ENDIF
153			_BARRIER
154
155			IF (filePrec .EQ. precFloat32) THEN
156	gforget	1.5	IF ( locSingleCpuIO ) then
157	jmc	1.3	CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
158	gforget	1.1	& fld2d_procbuff_r4,myThid)
159			CALL BAR2( myThid )
160			ENDIF
161	jmc	1.4	CALL MDS_PASS_R4toRL( fld2d_procbuff_r4, fldRL,
162			& OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
163	gforget	1.1	ELSE
164	gforget	1.5	IF ( locSingleCpuIO ) then
165	jmc	1.3	CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
166	gforget	1.1	& fld2d_procbuff_r8,myThid)
167			CALL BAR2( myThid )
168			ENDIF
169	jmc	1.4	CALL MDS_PASS_R8toRL( fld2d_procbuff_r8, fldRL,
170			& OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
171	gforget	1.1	ENDIF
172
173			enddo
174	jmc	1.3
175	gforget	1.5	IF ( iAmDoingIO.AND.(fid.EQ.0) ) THEN
176	gforget	1.1	CLOSE( dUnit )
177			ENDIF
178
179			#endif
180
181			return
182			end