pkg/mdsio/mdsio_read_whalos.F

C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.2 2010/09/24 23:21:03 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                   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)
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,pIL
      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
      LOGICAL  MASTER_CPU_IO
      EXTERNAL ILNBLNK
      EXTERNAL MDS_RECLEN
      EXTERNAL MASTER_CPU_IO

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 useSingleCpuIO):
      iAmDoingIO = MASTER_CPU_IO(myThid)
      IF ( iAmDoingIO ) THEN
c get the unit and open file
      CALL MDSFINDUNIT( dUnit, myThid )
      IL  = ILNBLNK( fName )
      pIL = ILNBLNK( mdsioLocalDir )
      IF ( pIL.EQ.0 ) THEN
        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'
        length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
      ELSE
        WRITE(pfName,'(2A)') pfName(1:pIL),'.data'
        length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
      ENDIF
      OPEN( dUnit, file=pfName, status='old',
     &         access='direct', recl=length_of_rec )
      ENDIF


      do i2d=1,n2d

        _BARRIER
        IF ( iAmDoingIO ) THEN
        irec2d=i2d+n2d*(irec-1)
          IF ( .NOT.useSingleCpuIO ) 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 ( useSingleCpuIO ) then
            CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
     &                              fld2d_procbuff_r4,myThid)
            CALL BAR2( myThid )
          ENDIF
          CALL MDS_PASS_WH_R4toRL( fld2d_procbuff_r4, fldRL,
     &                    1, i2d, n2d, 0, 0, .TRUE., myThid )
        ELSE
          IF ( useSingleCpuIO ) then
            CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
     &                              fld2d_procbuff_r8,myThid)
            CALL BAR2( myThid )
          ENDIF
          CALL MDS_PASS_WH_R8toRL( fld2d_procbuff_r8, fldRL,
     &                    1, i2d, n2d, 0, 0, .TRUE., myThid )
        ENDIF

      enddo

       IF ( iAmDoingIO ) THEN
         CLOSE( dUnit )
       ENDIF

#endif

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