pkg/autodiff/adread_adwrite.F


#include "CPP_OPTIONS.h"

c     ==================================================================
c
c     ad_read_write.F: routines to handle the I/O of the TAMC generated
c                      code. All files are direct access files.
c     Routines:
c
c     o  adread  - Read  data from file.
c     o  adwrite - Write data to   file.
c
c
c     The following input veriables are used throughout in the argument
c     lists:
c
c     name   -  character 
c                 On entry, name is the extended tape name.
c     len    -  integer 
c                 On entry, len is the number of characters in name.
c     tid    -  integer 
c                 On entry, tid identifies the tape.
c     vid    -  integer
c                 On entry, vid identifies the variable to be stored on
c                 the tape.
c     var    -  real array of dimension length 
c                 On entry, var contains the values to be stored.
c                           var must not be changed.
c     size   -  integer 
c                 On entry, size is the size in bytes of the type of
c                           variable var.
c     length -  integer 
c                 On entry, length is the dimension of the variable
c                           stored on the tape.
c     irec   -  integer 
c                 On entry, irec is the record number to be written.
c     mythid -  integer
c                 On entry, mythid is the number of the thread or
c                           instance of the program.
c     myiter -  integer
c                 On entry, myiter is the current iteration step during
c                           the integration.
c
c     For further details on this see the TAMC Users Manual, Appendix B,
c     User defined Storage Subroutines.
c
c     TAMC does not provide the two leading arguments mythid and myiter
c     when compiling the MITgcmUV code. Instead the is a sed script avail-
c     able that does change the TAMC-generated adjoint code.
c
c     Only the master thread is allowed to write data and only gobal
c     model arrays are allowed to be written be the subsequent routines.
c     Tiled data are to be stored in common blocks. This implies that at
c     least a two level checkpointing for the adjoint code has to be
c     available.
c
c     ==================================================================


      subroutine adread(
     I                   mythid,
     I                   name,
     I                   len,
     I                   tid,
     I                   vid,
     O                   var,
     I                   size,
     I                   length,
     I                   irec
     &                 )

c     ==================================================================
c     SUBROUTINE adread
c     ==================================================================
c
c     o Read direct access file.
c
c     A call to this routine implies an open-read-close sequence
c     since it uses the MITgcmUV i/o routine MDSREADVECTOR. Only
c     the master thread reads the data. Otherwise each thread would
c     read from file.
c
c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
c
c     changed: Christian Eckert eckert@mit.edu 15-Feb-2000
c
c              - Restructured the code in order to create a package
c                for the MITgcmUV.
c
c     changed: Patrick Heimbach heimbach@mit.edu 27-May-2000
c
c              - changed subroutine parameter list: skipped myiter
c
c     ==================================================================
c     SUBROUTINE adread
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "ctrl.h"

c     == routine arguments ==

      integer mythid
      character*(*) name
      integer len
      integer tid
      integer vid
      integer size
      integer length
      integer irec
      _RL     var(length)

c     == local variables ==

      character*(7) itername
      character*(80) fname
      integer il
      integer bx,by

c     == functions ==

      integer  ilnblnk
      external ilnblnk

c     == end of interface ==

      write(fname(1:80),'(a)') ' '
      write(itername,'(a,i4.4)') '.it',optimcycle

      il = ilnblnk( name )

      write(fname(1:il+7),'(a,a)') name(1:il),itername

      _BEGIN_MASTER( mythid )
        by = myByLo(myThid)
        bx = myBxLo(myThid)
        call mdsreadvector( fname, size*8, 'RL', 
     &                      length, var, bx, by, irec, mythid )
      _END_MASTER( mythid )

c     Everyone must wait for the read operation to be completed.
      _BARRIER

      return
      end


      subroutine adwrite(
     I                    mythid,
     I                    name,
     I                    len,
     I                    tid,
     I                    vid,
     I                    var,
     I                    size,
     I                    length,
     I                    irec
     &                  )

c     ==================================================================
c     SUBROUTINE adwrite
c     ==================================================================
c
c     o Write to direct access file.
c
c     A call to this routine implies an open-read-close sequence
c     since it uses the MITgcmUV i/o routine MDSREADVECTOR. Only
c     the master thread writes the data. Otherwise each thread would
c     write to file. This would result in an excessive waste of
c     disk space.
c
c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
c
c     changed: Christian Eckert eckert@mit.edu 15-Feb-2000
c
c              - Restructured the code in order to create a package
c                for the MITgcmUV.
c
c     changed: Patrick Heimbach heimbach@mit.edu 27-May-2000
c
c              - changed subroutine parameter list: skipped myiter
c
c     ==================================================================
c     SUBROUTINE adwrite
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "ctrl.h"

c     == routine arguments ==

      integer mythid
      character*(*) name
      integer len
      integer tid
      integer vid
      integer size
      integer length
      integer irec
      _RL     var(length)

c     == local variables ==

      character*(7) itername
      character*(80) fname
      integer il
      integer bx,by
      logical globalfile

c     == functions ==

      integer ilnblnk
      external ilnblnk

c     == end of interface ==

      globalfile = .false.
      il         = ilnblnk( name )
      write(fname(1:80),'(a)') ' '

      write(itername,'(a,i4.4)') '.it',optimcycle

      write(fname(1:il+7),'(a,a)') name(1:il),itername

      _BEGIN_MASTER( mythid )
        by = myByLo(myThid)
        bx = myBxLo(myThid)
        call mdswritevector( fname, size*8, globalfile, 'RL', 
     &                       length, var, bx, by, irec, 0, mythid )
      _END_MASTER( mythid )

c     Everyone must wait for the write operation to be completed.
      _BARRIER

      return
      end
1	heimbach	1.1
2			#include "CPP_OPTIONS.h"
3
4			c ==================================================================
5			c
6			c ad_read_write.F: routines to handle the I/O of the TAMC generated
7			c code. All files are direct access files.
8			c Routines:
9			c
10			c o adread - Read data from file.
11			c o adwrite - Write data to file.
12			c
13			c
14			c The following input veriables are used throughout in the argument
15			c lists:
16			c
17			c name - character
18			c On entry, name is the extended tape name.
19			c len - integer
20			c On entry, len is the number of characters in name.
21			c tid - integer
22			c On entry, tid identifies the tape.
23			c vid - integer
24			c On entry, vid identifies the variable to be stored on
25			c the tape.
26			c var - real array of dimension length
27			c On entry, var contains the values to be stored.
28			c var must not be changed.
29			c size - integer
30			c On entry, size is the size in bytes of the type of
31			c variable var.
32			c length - integer
33			c On entry, length is the dimension of the variable
34			c stored on the tape.
35			c irec - integer
36			c On entry, irec is the record number to be written.
37			c mythid - integer
38			c On entry, mythid is the number of the thread or
39			c instance of the program.
40			c myiter - integer
41			c On entry, myiter is the current iteration step during
42			c the integration.
43			c
44			c For further details on this see the TAMC Users Manual, Appendix B,
45			c User defined Storage Subroutines.
46			c
47			c TAMC does not provide the two leading arguments mythid and myiter
48			c when compiling the MITgcmUV code. Instead the is a sed script avail-
49			c able that does change the TAMC-generated adjoint code.
50			c
51			c Only the master thread is allowed to write data and only gobal
52			c model arrays are allowed to be written be the subsequent routines.
53			c Tiled data are to be stored in common blocks. This implies that at
54			c least a two level checkpointing for the adjoint code has to be
55			c available.
56			c
57			c ==================================================================
58
59
60			subroutine adread(
61			I mythid,
62			I name,
63			I len,
64			I tid,
65			I vid,
66			O var,
67			I size,
68			I length,
69			I irec
70			& )
71
72			c ==================================================================
73			c SUBROUTINE adread
74			c ==================================================================
75			c
76			c o Read direct access file.
77			c
78			c A call to this routine implies an open-read-close sequence
79			c since it uses the MITgcmUV i/o routine MDSREADVECTOR. Only
80			c the master thread reads the data. Otherwise each thread would
81			c read from file.
82			c
83			c started: Christian Eckert eckert@mit.edu 30-Jun-1999
84			c
85			c changed: Christian Eckert eckert@mit.edu 15-Feb-2000
86			c
87			c - Restructured the code in order to create a package
88			c for the MITgcmUV.
89			c
90			c changed: Patrick Heimbach heimbach@mit.edu 27-May-2000
91			c
92			c - changed subroutine parameter list: skipped myiter
93			c
94			c ==================================================================
95			c SUBROUTINE adread
96			c ==================================================================
97
98			implicit none
99
100			c == global variables ==
101
102			#include "EEPARAMS.h"
103			#include "SIZE.h"
104			#include "ctrl.h"
105
106			c == routine arguments ==
107
108			integer mythid
109			character() name
110			integer len
111			integer tid
112			integer vid
113			integer size
114			integer length
115			integer irec
116			_RL var(length)
117
118			c == local variables ==
119
120			character*(7) itername
121			character*(80) fname
122			integer il
123			integer bx,by
124
125			c == functions ==
126
127			integer ilnblnk
128			external ilnblnk
129
130			c == end of interface ==
131
132			write(fname(1:80),'(a)') ' '
133			write(itername,'(a,i4.4)') '.it',optimcycle
134
135			il = ilnblnk( name )
136
137			write(fname(1:il+7),'(a,a)') name(1:il),itername
138
139			_BEGIN_MASTER( mythid )
140			by = myByLo(myThid)
141			bx = myBxLo(myThid)
142			call mdsreadvector( fname, size*8, 'RL',
143			& length, var, bx, by, irec, mythid )
144			_END_MASTER( mythid )
145
146			c Everyone must wait for the read operation to be completed.
147			_BARRIER
148
149			return
150			end
151
152
153			subroutine adwrite(
154			I mythid,
155			I name,
156			I len,
157			I tid,
158			I vid,
159			I var,
160			I size,
161			I length,
162			I irec
163			& )
164
165			c ==================================================================
166			c SUBROUTINE adwrite
167			c ==================================================================
168			c
169			c o Write to direct access file.
170			c
171			c A call to this routine implies an open-read-close sequence
172			c since it uses the MITgcmUV i/o routine MDSREADVECTOR. Only
173			c the master thread writes the data. Otherwise each thread would
174			c write to file. This would result in an excessive waste of
175			c disk space.
176			c
177			c started: Christian Eckert eckert@mit.edu 30-Jun-1999
178			c
179			c changed: Christian Eckert eckert@mit.edu 15-Feb-2000
180			c
181			c - Restructured the code in order to create a package
182			c for the MITgcmUV.
183			c
184			c changed: Patrick Heimbach heimbach@mit.edu 27-May-2000
185			c
186			c - changed subroutine parameter list: skipped myiter
187			c
188			c ==================================================================
189			c SUBROUTINE adwrite
190			c ==================================================================
191
192			implicit none
193
194			c == global variables ==
195
196			#include "EEPARAMS.h"
197			#include "SIZE.h"
198			#include "ctrl.h"
199
200			c == routine arguments ==
201
202			integer mythid
203			character() name
204			integer len
205			integer tid
206			integer vid
207			integer size
208			integer length
209			integer irec
210			_RL var(length)
211
212			c == local variables ==
213
214			character*(7) itername
215			character*(80) fname
216			integer il
217			integer bx,by
218			logical globalfile
219
220			c == functions ==
221
222			integer ilnblnk
223			external ilnblnk
224
225			c == end of interface ==
226
227			globalfile = .false.
228			il = ilnblnk( name )
229			write(fname(1:80),'(a)') ' '
230
231			write(itername,'(a,i4.4)') '.it',optimcycle
232
233			write(fname(1:il+7),'(a,a)') name(1:il),itername
234
235			_BEGIN_MASTER( mythid )
236			by = myByLo(myThid)
237			bx = myBxLo(myThid)
238			call mdswritevector( fname, size*8, globalfile, 'RL',
239			& length, var, bx, by, irec, 0, mythid )
240			_END_MASTER( mythid )
241
242			c Everyone must wait for the write operation to be completed.
243			_BARRIER
244
245			return
246			end