pkg/autodiff/autodiff_whtapeio_sync.F

C $Header: /u/gcmpack/MITgcm/pkg/autodiff/autodiff_whtapeio_sync.F,v 1.10 2015/03/23 21:06:13 gforget Exp $
C $Name:  $

#include "AUTODIFF_OPTIONS.h"
#include "MDSIO_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif

      subroutine autodiff_whtapeio_sync( myLev, myStep, myThid )
      IMPLICIT NONE
C     /==========================================================\
C     | SUBROUTINE autodiff_whtapeio_sync                             |
C     |==========================================================|
C     == Global variables ===

#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "ctrl.h"
#ifndef ALLOW_OPENAD
# include "AUTODIFF.h"
#endif
#ifdef ALLOW_WHIO_3D
# include "tamc.h"
# include "MDSIO_BUFF_WH.h"
#endif

C     == Routine arguments ==
C     myThid - Thread number for this instance of the routine.
      integer myThid
      integer myLev
      integer myStep

#ifdef ALLOW_AUTODIFF_WHTAPEIO

      character*(MAX_LEN_FNAM) fName
      integer filePrec, IL, length_of_rec
      LOGICAL iAmDoingIO

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 )
      logical  exst
#ifdef ALLOW_WHIO_3D
      character*(max_len_mbuf) msgBuf
      integer ioUnit
#endif

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

      IF ( .NOT.useAUTODIFF ) THEN
        RETURN
      ENDIF

      IF ( tapeConcatIO ) THEN

      IF ( doSinglePrecTapelev ) THEN
       filePrec = 32
      ELSE
       filePrec = 64
      ENDIF

C Only do I/O if I am the master thread (and mpi process 0 IF tapeSingleCpuIO):
      iAmDoingIO = .FALSE.
      IF ( .NOT.tapeSingleCpuIO .OR. myProcId.EQ.0 ) THEN
        _BEGIN_MASTER( myThid )
        iAmDoingIO = .TRUE.
        _END_MASTER( myThid )
      ENDIF

      IF ( iAmDoingIO ) THEN
        IL = ilnblnk( adTapeDir )
        IF ( .NOT.tapeSingleCpuIO ) THEN
          WRITE(fName,'(2A,I1.1,A,I3.3,A)')
     &         adTapeDir(1:IL),'tapes',myLev,'.',myProcId,'.data'
          length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh,myThid )
        ELSE
          WRITE(fName,'(2A,I1.1,A)')
     &         adTapeDir(1:IL),'tapes',myLev,'.data'
          length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
        ENDIF
      ENDIF
#ifdef ALLOW_WHIO_3D
      length_of_rec=length_of_rec*nWh
#endif

      tapeFileUnit=tapeFileUnitS(myLev)
      tapeFileCounter=0

      IF ( iAmDoingIO.AND.(myStep.EQ.0).AND.
     &    (myLev.GT.0).AND.(tapeFileUnit.EQ.0) ) THEN
        inquire( file=fName, exist=exst )
#ifdef AUTODIFF_USE_MDSFINDUNITS
        CALL MDSFINDUNIT( tapeFileUnit, myThid )
#else
        CALL AUTODIFF_FINDUNIT( tapeFileUnit, myThid )
#endif
        OPEN( tapeFileUnit, file=fName, status='unknown',
     &         access='direct', recl=length_of_rec )
        tapeFileUnitS(myLev)=tapeFileUnit
#if (defined (ALLOW_INIT_WHTAPEIO) && defined (ALLOW_WHIO_3D))
c exst needs to have been tested before opening the file
        IF (.NOT.exst) then
          iWh=tapeMaxCounter*MAX(nchklev_2,nchklev_3)/nWh+1
          write(msgBuf,'(a,i1,a,i3)') 'whio : create lev ',
     &          myLev,' rec ',iWh
          ioUnit=standardMessageUnit
          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
          IF ( .NOT.tapeSingleCpuIO ) then
            IF (filePrec .EQ. precFloat32) THEN
              WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r4
            ELSE
              WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r8
            ENDIF
          ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
            IF (filePrec .EQ. precFloat32) THEN
              WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r4
            ELSE
              WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r8
            ENDIF
#  endif
          ENDIF
          iWh=0
      ENDIF
#endif
      ENDIF

#ifdef ALLOW_WHIO_3D
      _BARRIER
      IF ((myStep.EQ.1).AND.iAmDoingIO.AND.
     &    tapeBufferIO.AND.writeWh) THEN
      if (iWh.LT.1) stop
          write(msgBuf,'(a,i1,a,i3)') 'whio : write lev ',
     &          myLev,' rec ',iWh
          ioUnit=standardMessageUnit
          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
          IF ( .NOT.tapeSingleCpuIO ) then
            IF (filePrec .EQ. precFloat32) THEN
              WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r4
            ELSE
              WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r8
            ENDIF
          ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
            IF (filePrec .EQ. precFloat32) THEN
              WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r4
            ELSE
              WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r8
            ENDIF
#  endif
          ENDIF
      ENDIF
      _BARRIER

      IF (myStep.EQ.0) THEN
        tapeBufferIO=.TRUE.
      ELSE
        tapeBufferIO=.FALSE.
        writeWh=.FALSE.
      ENDIF
      iWh=0
      jWh=0
#endif /* ALLOW_WHIO_3D */

      ENDIF !IF ( tapeConcatIO ) THEN

#endif /* ALLOW_AUTODIFF_WHTAPEIO */

      end
1	gforget	1.11	C $Header: /u/gcmpack/MITgcm/pkg/autodiff/autodiff_whtapeio_sync.F,v 1.10 2015/03/23 21:06:13 gforget Exp $
2	gforget	1.1	C $Name: $
3
4			#include "AUTODIFF_OPTIONS.h"
5	gforget	1.2	#include "MDSIO_OPTIONS.h"
6	jmc	1.9	#ifdef ALLOW_CTRL
7			# include "CTRL_OPTIONS.h"
8			#endif
9	gforget	1.1
10			subroutine autodiff_whtapeio_sync( myLev, myStep, myThid )
11			IMPLICIT NONE
12			C /==========================================================\
13			C \| SUBROUTINE autodiff_whtapeio_sync \|
14			C \|==========================================================\|
15			C == Global variables ===
16
17			#include "SIZE.h"
18			#include "EEPARAMS.h"
19			#include "PARAMS.h"
20			#include "ctrl.h"
21	jmc	1.9	#ifndef ALLOW_OPENAD
22	utke	1.4	# include "AUTODIFF.h"
23			#endif
24	gforget	1.2	#ifdef ALLOW_WHIO_3D
25	utke	1.4	# include "tamc.h"
26	gforget	1.2	# include "MDSIO_BUFF_WH.h"
27			#endif
28	gforget	1.1
29			C == Routine arguments ==
30			C myThid - Thread number for this instance of the routine.
31			integer myThid
32			integer myLev
33			integer myStep
34
35			#ifdef ALLOW_AUTODIFF_WHTAPEIO
36
37			character*(MAX_LEN_FNAM) fName
38			integer filePrec, IL, length_of_rec
39			LOGICAL iAmDoingIO
40
41			C sNxWh :: x tile size with halo included
42			C sNyWh :: y tile size with halo included
43			C pocNyWh :: processor sum of sNyWh
44			C gloNyWh :: global sum of sNyWh
45			INTEGER sNxWh
46			INTEGER sNyWh
47			INTEGER procNyWh
48			INTEGER gloNyWh
49			PARAMETER ( sNxWh = sNx+2*Olx )
50			PARAMETER ( sNyWh = sNy+2*Oly )
51			PARAMETER ( procNyWh = sNyWhnSynSx )
52			PARAMETER ( gloNyWh = procNyWhnPynPx )
53	gforget	1.6	logical exst
54			#ifdef ALLOW_WHIO_3D
55			character*(max_len_mbuf) msgBuf
56			integer ioUnit
57			#endif
58	gforget	1.1
59			c == functions ==
60			INTEGER ILNBLNK
61			INTEGER MDS_RECLEN
62			EXTERNAL ILNBLNK
63			EXTERNAL MDS_RECLEN
64
65	gforget	1.10	IF ( .NOT.useAUTODIFF ) THEN
66			RETURN
67			ENDIF
68
69	gforget	1.1	IF ( tapeConcatIO ) THEN
70
71			IF ( doSinglePrecTapelev ) THEN
72			filePrec = 32
73			ELSE
74			filePrec = 64
75	jmc	1.9	ENDIF
76	gforget	1.1
77			C Only do I/O if I am the master thread (and mpi process 0 IF tapeSingleCpuIO):
78			iAmDoingIO = .FALSE.
79			IF ( .NOT.tapeSingleCpuIO .OR. myProcId.EQ.0 ) THEN
80			_BEGIN_MASTER( myThid )
81			iAmDoingIO = .TRUE.
82			_END_MASTER( myThid )
83	jmc	1.9	ENDIF
84	gforget	1.5
85	gforget	1.1	IF ( iAmDoingIO ) THEN
86	gforget	1.5	IL = ilnblnk( adTapeDir )
87	gforget	1.1	IF ( .NOT.tapeSingleCpuIO ) THEN
88	jmc	1.9	WRITE(fName,'(2A,I1.1,A,I3.3,A)')
89	gforget	1.5	& adTapeDir(1:IL),'tapes',myLev,'.',myProcId,'.data'
90	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh,myThid )
91			ELSE
92	jmc	1.9	WRITE(fName,'(2A,I1.1,A)')
93	gforget	1.5	& adTapeDir(1:IL),'tapes',myLev,'.data'
94	gforget	1.1	length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
95			ENDIF
96			ENDIF
97	gforget	1.2	#ifdef ALLOW_WHIO_3D
98			length_of_rec=length_of_rec*nWh
99			#endif
100	gforget	1.1
101			tapeFileUnit=tapeFileUnitS(myLev)
102			tapeFileCounter=0
103
104			IF ( iAmDoingIO.AND.(myStep.EQ.0).AND.
105			& (myLev.GT.0).AND.(tapeFileUnit.EQ.0) ) THEN
106	gforget	1.6	inquire( file=fName, exist=exst )
107	gforget	1.11	#ifdef AUTODIFF_USE_MDSFINDUNITS
108	gforget	1.8	CALL MDSFINDUNIT( tapeFileUnit, myThid )
109			#else
110	gforget	1.11	CALL AUTODIFF_FINDUNIT( tapeFileUnit, myThid )
111	gforget	1.8	#endif
112	gforget	1.1	OPEN( tapeFileUnit, file=fName, status='unknown',
113			& access='direct', recl=length_of_rec )
114			tapeFileUnitS(myLev)=tapeFileUnit
115	gforget	1.3	#if (defined (ALLOW_INIT_WHTAPEIO) && defined (ALLOW_WHIO_3D))
116	gforget	1.6	c exst needs to have been tested before opening the file
117			IF (.NOT.exst) then
118	gforget	1.3	iWh=tapeMaxCounter*MAX(nchklev_2,nchklev_3)/nWh+1
119	gforget	1.6	write(msgBuf,'(a,i1,a,i3)') 'whio : create lev ',
120			& myLev,' rec ',iWh
121			ioUnit=standardMessageUnit
122			CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
123	gforget	1.3	IF ( .NOT.tapeSingleCpuIO ) then
124			IF (filePrec .EQ. precFloat32) THEN
125			WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r4
126			ELSE
127			WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r8
128	jmc	1.9	ENDIF
129	gforget	1.3	ELSE
130			# ifdef INCLUDE_WHIO_GLOBUFF_3D
131			IF (filePrec .EQ. precFloat32) THEN
132			WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r4
133			ELSE
134			WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r8
135			ENDIF
136	jmc	1.9	# endif
137	gforget	1.3	ENDIF
138			iWh=0
139	gforget	1.6	ENDIF
140	jmc	1.9	#endif
141	gforget	1.1	ENDIF
142
143	gforget	1.2	#ifdef ALLOW_WHIO_3D
144			_BARRIER
145			IF ((myStep.EQ.1).AND.iAmDoingIO.AND.
146			& tapeBufferIO.AND.writeWh) THEN
147			if (iWh.LT.1) stop
148	gforget	1.6	write(msgBuf,'(a,i1,a,i3)') 'whio : write lev ',
149			& myLev,' rec ',iWh
150			ioUnit=standardMessageUnit
151			CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
152	gforget	1.2	IF ( .NOT.tapeSingleCpuIO ) then
153			IF (filePrec .EQ. precFloat32) THEN
154			WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r4
155			ELSE
156			WRITE(tapeFileUnit,rec=iWh) fld3d_procbuff_r8
157			ENDIF
158			ELSE
159			# ifdef INCLUDE_WHIO_GLOBUFF_3D
160			IF (filePrec .EQ. precFloat32) THEN
161			WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r4
162			ELSE
163			WRITE(tapeFileUnit,rec=iWh) fld3d_globuff_r8
164			ENDIF
165			# endif
166			ENDIF
167			ENDIF
168			_BARRIER
169
170			IF (myStep.EQ.0) THEN
171			tapeBufferIO=.TRUE.
172			ELSE
173			tapeBufferIO=.FALSE.
174			writeWh=.FALSE.
175			ENDIF
176			iWh=0
177			jWh=0
178			#endif /* ALLOW_WHIO_3D */
179
180	gforget	1.1	ENDIF !IF ( tapeConcatIO ) THEN
181
182			#endif /* ALLOW_AUTODIFF_WHTAPEIO */
183
184			end