/[MITgcm]/MITgcm/pkg/autodiff/active_file_control_slice.F
ViewVC logotype

Diff of /MITgcm/pkg/autodiff/active_file_control_slice.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by heimbach, Sun Mar 25 22:33:53 2001 UTC revision 1.3 by heimbach, Fri Dec 14 17:39:21 2001 UTC
# Line 1  Line 1 
1    
2  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
3    
4  c     ==================================================================  c     ==================================================================
5  c  c
6  c     active_file_control.F: Routines to handle the i/o of active vari-  c     active_file_control.F: Routines to handle the i/o of active vari-
7  c                            ables for the adjoint calculations. All  c                            ables for the adjoint calculations. All
8  c                            files are direct access files.  c                            files are direct access files.
9  c  c
10  c     Routines:  c     Routines:
11  c  c
12  c     o  active_read_xz_rl      - Basic routine to handle active read  c     o  active_read_xz_rl      - Basic routine to handle active read
13  c                                 operations.  c                                 operations.
14  c     o  active_write_xz_rl     - Basic routine to handle active write  c     o  active_write_xz_rl     - Basic routine to handle active write
15  c                                 operations.  c                                 operations.
16  c     o  active_read_yz_rl      - Basic routine to handle active read  c     o  active_read_yz_rl      - Basic routine to handle active read
17  c                                 operations.  c                                 operations.
18  c     o  active_write_yz_rl     - Basic routine to handle active write  c     o  active_write_yz_rl     - Basic routine to handle active write
19  c                                 operations.  c                                 operations.
20  c  c
21  c     ==================================================================  c     ==================================================================
22    
23    
24        subroutine active_read_xz_rl(        subroutine active_read_xz_rl(
25       I                           active_var_file,       I                           active_var_file,
26       O                           active_var,       O                           active_var,
27       I                           globalfile,       I                           globalfile,
28       I                           lAdInit,       I                           lAdInit,
29       I                           irec,       I                           irec,
30       I                           mynr,       I                           mynr,
31       I                           theSimulationMode,       I                           theSimulationMode,
32       I                           myOptimIter,       I                           myOptimIter,
33       I                           mythid       I                           mythid
34       &                         )       &                         )
35    
36  c     ==================================================================  c     ==================================================================
37  c     SUBROUTINE active_read_xz_rl  c     SUBROUTINE active_read_xz_rl
38  c     ==================================================================  c     ==================================================================
39  c  c
40  c     o Read an active variable from file.  c     o Read an active variable from file.
41  c  c
42  c     The variable *globalfile* can be used as a switch, which allows  c     The variable *globalfile* can be used as a switch, which allows
43  c     to read from a global file. The adjoint files are, however, always  c     to read from a global file. The adjoint files are, however, always
44  c     treated as tiled files.  c     treated as tiled files.
45  c  c
46  c     started: heimbach@mit.edu 05-Mar-2001  c     started: heimbach@mit.edu 05-Mar-2001
47  c  c
48  c     ==================================================================  c     ==================================================================
49  c     SUBROUTINE active_read_xz_rl  c     SUBROUTINE active_read_xz_rl
50  c     ==================================================================  c     ==================================================================
51    
52        implicit none        implicit none
53    
54  c     == global variables ==  c     == global variables ==
55    
56  #include "EEPARAMS.h"  #include "EEPARAMS.h"
57  #include "SIZE.h"  #include "SIZE.h"
58  #include "PARAMS.h"  #include "PARAMS.h"
59    
60  c     == routine arguments ==  c     == routine arguments ==
61    
62        character*(*) active_var_file        character*(*) active_var_file
63    
64        logical  globalfile        logical  globalfile
65        logical  lAdInit        logical  lAdInit
66        integer  irec        integer  irec
67        integer  mynr        integer  mynr
68        integer  theSimulationMode        integer  theSimulationMode
69        integer  myOptimIter        integer  myOptimIter
70        integer  mythid        integer  mythid
71        _RL     active_var(1-olx:snx+olx,mynr,nsx,nsy)        _RL     active_var(1-olx:snx+olx,mynr,nsx,nsy)
72    
73  c     == local variables ==  c     == local variables ==
74    
75        character*(2)  adpref        character*(2)  adpref
76        character*(80) adfname        character*(80) adfname
77    
78        integer bi,bj        integer bi,bj
79        integer i,j,k        integer i,j,k
80        integer oldprec        integer oldprec
81        integer prec        integer prec
82        integer il        integer il
83        integer ilnblnk        integer ilnblnk
84    
85        logical writeglobalfile        logical writeglobalfile
86    
87        _RL  active_data_t(1-olx:snx+olx,nsx,nsy)        _RL  active_data_t(1-olx:snx+olx,nsx,nsy)
88    
89  c     == functions ==  c     == functions ==
90    
91        external ilnblnk        external ilnblnk
92    
93  c     == end of interface ==  c     == end of interface ==
94    
95  c     force 64-bit io  c     force 64-bit io
96        oldPrec        = readBinaryPrec        oldPrec        = readBinaryPrec
97        readBinaryPrec = precFloat64        readBinaryPrec = precFloat64
98        prec           = precFloat64        prec           = precFloat64
99    
100        write(adfname(1:80),'(80a)') ' '        write(adfname(1:80),'(80a)') ' '
101        adpref = 'ad'        adpref = 'ad'
102        il = ilnblnk( active_var_file )        il = ilnblnk( active_var_file )
103    
104        write(adfname(1:2),'(a)') adpref        write(adfname(1:2),'(a)') adpref
105        write(adfname(3:il+2),'(a)') active_var_file(1:il)        write(adfname(3:il+2),'(a)') active_var_file(1:il)
106    
107  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
108  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
109  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
110    
111        if (theSimulationMode .eq. FORWARD_SIMULATION) then        if (theSimulationMode .eq. FORWARD_SIMULATION) then
112    
113          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
114    
115  c       Read the active variable from file.  c       Read the active variable from file.
116    
117          call mdsreadfieldxz(          call mdsreadfieldxz(
118       &                     active_var_file,       &                     active_var_file,
119       &                     prec,       &                     prec,
120       &                     'RL',       &                     'RL',
121       &                     mynr,             &                     mynr,      
122       &                     active_var,       &                     active_var,
123       &                     irec,       &                     irec,
124       &                     mythid )       &                     mythid )
125    
126          if (lAdInit) then          if (lAdInit) then
127  c         Initialise the corresponding adjoint variable on the  c         Initialise the corresponding adjoint variable on the
128  c         adjoint variable's file. These files are tiled.  c         adjoint variable's file. These files are tiled.
129    
130            writeglobalfile = .false.            writeglobalfile = .false.
131            do bj = 1,nsy            do bj = 1,nsy
132               do bi = 1,nsx               do bi = 1,nsx
133                  do i = 1,snx                  do i = 1,snx
134                     active_data_t(i,bi,bj)= 0. _d 0                     active_data_t(i,bi,bj)= 0. _d 0
135                  enddo                  enddo
136               enddo               enddo
137            enddo            enddo
138    
139            do k = 1,mynr            do k = 1,mynr
140               call mdswritefieldxz(               call mdswritefieldxz(
141       &                           adfname,       &                           adfname,
142       &                           prec,       &                           prec,
143       &                           globalfile,       &                           globalfile,
144       &                           'RL',       &                           'RL',
145       &                           1,       &                           1,
146       &                           active_data_t,       &                           active_data_t,
147       &                           (irec-1)*mynr+k,       &                           (irec-1)*mynr+k,
148       &                           myOptimIter,       &                           myOptimIter,
149       &                           mythid )       &                           mythid )
150            enddo            enddo
151          endif          endif
152    
153          _END_MASTER( mythid )          _END_MASTER( mythid )
154    
155        endif        endif
156    
157  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
158  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
159  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
160    
161        if (theSimulationMode .eq. REVERSE_SIMULATION) then        if (theSimulationMode .eq. REVERSE_SIMULATION) then
162    
163          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
164    
165          writeglobalfile = .false.          writeglobalfile = .false.
166          do k=1,mynr          do k=1,mynr
167  c             Read data from file layer by layer.  c             Read data from file layer by layer.
168             call mdsreadfieldxz(             call mdsreadfieldxz(
169       &                        active_var_file,       &                        active_var_file,
170       &                        prec,       &                        prec,
171       &                        'RL',       &                        'RL',
172       &                        1,       &                        1,
173       &                        active_data_t,       &                        active_data_t,
174       &                        (irec-1)*mynr+k,       &                        (irec-1)*mynr+k,
175       &                        mythid )       &                        mythid )
176    
177  c             Add active_var from appropriate location to data.  c             Add active_var from appropriate location to data.
178             do bj = 1,nsy             do bj = 1,nsy
179                do bi = 1,nsx                do bi = 1,nsx
180                   do i = 1,snx                   do i = 1,snx
181                      active_data_t(i,bi,bj) = active_data_t(i,bi,bj) +                      active_data_t(i,bi,bj) = active_data_t(i,bi,bj) +
182       &                   active_var(i,k,bi,bj)       &                   active_var(i,k,bi,bj)
183                   enddo                   enddo
184                enddo                enddo
185             enddo             enddo
186    
187  c             Store the result on disk.  c             Store the result on disk.
188             call mdswritefieldxz(             call mdswritefieldxz(
189       &                         active_var_file,       &                         active_var_file,
190       &                         prec,       &                         prec,
191       &                         writeglobalfile,       &                         writeglobalfile,
192       &                         'RL',       &                         'RL',
193       &                         1,       &                         1,
194       &                         active_data_t,       &                         active_data_t,
195       &                         (irec-1)*mynr+k,       &                         (irec-1)*mynr+k,
196       &                         myOptimIter,       &                         myOptimIter,
197       &                         mythid )       &                         mythid )
198          enddo          enddo
199    
200    
201  c       Set active_var to zero.  c       Set active_var to zero.
202          do k=1,mynr          do k=1,mynr
203             do bj = 1,nsy             do bj = 1,nsy
204                do bi = 1,nsx                do bi = 1,nsx
205                   do i = 1,snx                   do i = 1,snx
206                      active_var(i,k,bi,bj) = 0. _d 0                      active_var(i,k,bi,bj) = 0. _d 0
207                   enddo                   enddo
208                enddo                enddo
209             enddo             enddo
210          enddo          enddo
211    
212          _END_MASTER( mythid )          _END_MASTER( mythid )
213        endif        endif
214    
215  c     Reset default io precision.  c     Reset default io precision.
216        readBinaryPrec = oldPrec        readBinaryPrec = oldPrec
217    
218        _BARRIER        _BARRIER
219    
220        return        return
221        end        end
222    
223  c     ==================================================================  c     ==================================================================
224    
225        subroutine active_write_xz_rl(        subroutine active_write_xz_rl(
226       I                            active_var_file,       I                            active_var_file,
227       I                            active_var,       I                            active_var,
228       I                            globalfile,       I                            globalfile,
229       I                            irec,       I                            irec,
230       I                            mynr,       I                            mynr,
231       I                            theSimulationMode,       I                            theSimulationMode,
232       I                            myOptimIter,       I                            myOptimIter,
233       I                            mythid       I                            mythid
234       &                          )       &                          )
235    
236  c     ==================================================================  c     ==================================================================
237  c     SUBROUTINE active_write_xz_rl  c     SUBROUTINE active_write_xz_rl
238  c     ==================================================================  c     ==================================================================
239  c  c
240  c     o Write an active variable to a file.  c     o Write an active variable to a file.
241  c  c
242  c     started: heimbach@mit.edu 05-Mar-2001  c     started: heimbach@mit.edu 05-Mar-2001
243  c  c
244  c     ==================================================================  c     ==================================================================
245  c     SUBROUTINE active_write_xz_rl  c     SUBROUTINE active_write_xz_rl
246  c     ==================================================================  c     ==================================================================
247    
248        implicit none        implicit none
249    
250  c     == global variables ==  c     == global variables ==
251    
252  #include "EEPARAMS.h"  #include "EEPARAMS.h"
253  #include "SIZE.h"  #include "SIZE.h"
254  #include "PARAMS.h"  #include "PARAMS.h"
255    
256  c     == routine arguments ==  c     == routine arguments ==
257    
258        character*(*) active_var_file        character*(*) active_var_file
259    
260        integer  mynr        integer  mynr
261        logical  globalfile        logical  globalfile
262        integer  irec        integer  irec
263        integer  theSimulationMode        integer  theSimulationMode
264        integer  myOptimIter        integer  myOptimIter
265        integer  mythid        integer  mythid
266        _RL     active_var(1-olx:snx+olx,mynr,nsx,nsy)        _RL     active_var(1-olx:snx+olx,mynr,nsx,nsy)
267    
268  c     == local variables ==  c     == local variables ==
269    
270        integer  i,j,k        integer  i,j,k
271        integer  bi,bj        integer  bi,bj
272        _RL  active_data_t(1-olx:snx+olx,nsx,nsy)        _RL  active_data_t(1-olx:snx+olx,nsx,nsy)
273        integer  oldprec        integer  oldprec
274        integer  prec        integer  prec
275    
276  c     == end of interface ==  c     == end of interface ==
277    
278  c     force 64-bit io  c     force 64-bit io
279        oldPrec        = readBinaryPrec        oldPrec        = readBinaryPrec
280        readBinaryPrec = precFloat64        readBinaryPrec = precFloat64
281        prec           = precFloat64        prec           = precFloat64
282    
283  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
284  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
285  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
286    
287        if (theSimulationMode .eq. FORWARD_SIMULATION) then        if (theSimulationMode .eq. FORWARD_SIMULATION) then
288    
289          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
290    
291            call mdswritefieldxz(            call mdswritefieldxz(
292       &                        active_var_file,       &                        active_var_file,
293       &                        prec,       &                        prec,
294       &                        globalfile,       &                        globalfile,
295       &                        'RL',       &                        'RL',
296       &                        mynr,       &                        mynr,
297       &                        active_var,       &                        active_var,
298       &                        irec,       &                        irec,
299       &                        myOptimIter,       &                        myOptimIter,
300       &                        mythid )       &                        mythid )
301    
302          _END_MASTER( mythid )          _END_MASTER( mythid )
303    
304        endif        endif
305    
306  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
307  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
308  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
309    
310        if (theSimulationMode .eq. REVERSE_SIMULATION) then        if (theSimulationMode .eq. REVERSE_SIMULATION) then
311    
312          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
313    
314              do k=1,mynr              do k=1,mynr
315  c             Read data from file layer by layer.  c             Read data from file layer by layer.
316                call mdsreadfieldxz(                call mdsreadfieldxz(
317       &                           active_var_file,       &                           active_var_file,
318       &                           prec,       &                           prec,
319       &                           'RL',       &                           'RL',
320       &                            1,       &                            1,
321       &                            active_data_t,       &                            active_data_t,
322       &                            (irec-1)*mynr+k,       &                            (irec-1)*mynr+k,
323       &                            mythid )       &                            mythid )
324    
325  c             Add active_var from appropriate location to data.  c             Add active_var from appropriate location to data.
326                do bj = 1,nsy                do bj = 1,nsy
327                   do bi = 1,nsx                   do bi = 1,nsx
328                      do i = 1,snx                      do i = 1,snx
329                         active_var(i,k,bi,bj) =                         active_var(i,k,bi,bj) =
330       &                      active_var(i,k,bi,bj) +       &                      active_var(i,k,bi,bj) +
331       &                      active_data_t(i,bi,bj)       &                      active_data_t(i,bi,bj)
332                         active_data_t(i,bi,bj) = 0. _d 0                         active_data_t(i,bi,bj) = 0. _d 0
333                      enddo                      enddo
334                   enddo                   enddo
335                enddo                enddo
336                call mdswritefieldxz(                call mdswritefieldxz(
337       &                            active_var_file,       &                            active_var_file,
338       &                            prec,       &                            prec,
339       &                            globalfile,       &                            globalfile,
340       &                            'RL',       &                            'RL',
341       &                            1,       &                            1,
342       &                            active_data_t,       &                            active_data_t,
343       &                            (irec-1)*mynr+k,       &                            (irec-1)*mynr+k,
344       &                            myOptimIter,       &                            myOptimIter,
345       &                            mythid )       &                            mythid )
346          enddo          enddo
347    
348          _END_MASTER( mythid )          _END_MASTER( mythid )
349    
350        endif        endif
351    
352  c     Reset default io precision.  c     Reset default io precision.
353        readBinaryPrec = oldPrec        readBinaryPrec = oldPrec
354    
355        _BARRIER        _BARRIER
356    
357        return        return
358        end        end
359    
360  c     ==================================================================  c     ==================================================================
361    
362        subroutine active_read_yz_rl(        subroutine active_read_yz_rl(
363       I                           active_var_file,       I                           active_var_file,
364       O                           active_var,       O                           active_var,
365       I                           globalfile,       I                           globalfile,
366       I                           lAdInit,       I                           lAdInit,
367       I                           irec,       I                           irec,
368       I                           mynr,       I                           mynr,
369       I                           theSimulationMode,       I                           theSimulationMode,
370       I                           myOptimIter,       I                           myOptimIter,
371       I                           mythid       I                           mythid
372       &                         )       &                         )
373    
374  c     ==================================================================  c     ==================================================================
375  c     SUBROUTINE active_read_yz_rl  c     SUBROUTINE active_read_yz_rl
376  c     ==================================================================  c     ==================================================================
377  c  c
378  c     o Read an active variable from file.  c     o Read an active variable from file.
379  c  c
380  c     The variable *globalfile* can be used as a switch, which allows  c     The variable *globalfile* can be used as a switch, which allows
381  c     to read from a global file. The adjoint files are, however, always  c     to read from a global file. The adjoint files are, however, always
382  c     treated as tiled files.  c     treated as tiled files.
383  c  c
384  c     started: heimbach@mit.edu 05-Mar-2001  c     started: heimbach@mit.edu 05-Mar-2001
385  c  c
386  c     ==================================================================  c     ==================================================================
387  c     SUBROUTINE active_read_yz_rl  c     SUBROUTINE active_read_yz_rl
388  c     ==================================================================  c     ==================================================================
389    
390        implicit none        implicit none
391    
392  c     == global variables ==  c     == global variables ==
393    
394  #include "EEPARAMS.h"  #include "EEPARAMS.h"
395  #include "SIZE.h"  #include "SIZE.h"
396  #include "PARAMS.h"  #include "PARAMS.h"
397    
398  c     == routine arguments ==  c     == routine arguments ==
399    
400        character*(*) active_var_file        character*(*) active_var_file
401    
402        logical  globalfile        logical  globalfile
403        logical  lAdInit        logical  lAdInit
404        integer  irec        integer  irec
405        integer  mynr        integer  mynr
406        integer  theSimulationMode        integer  theSimulationMode
407        integer  myOptimIter        integer  myOptimIter
408        integer  mythid        integer  mythid
409        _RL     active_var(1-oly:sny+oly,mynr,nsx,nsy)        _RL     active_var(1-oly:sny+oly,mynr,nsx,nsy)
410    
411  c     == local variables ==  c     == local variables ==
412    
413        character*(2)  adpref        character*(2)  adpref
414        character*(80) adfname        character*(80) adfname
415    
416        integer bi,bj        integer bi,bj
417        integer i,j,k        integer i,j,k
418        integer oldprec        integer oldprec
419        integer prec        integer prec
420        integer il        integer il
421        integer ilnblnk        integer ilnblnk
422    
423        logical writeglobalfile        logical writeglobalfile
424    
425        _RL  active_data_t(1-oly:sny+oly,nsx,nsy)        _RL  active_data_t(1-oly:sny+oly,nsx,nsy)
426    
427  c     == functions ==  c     == functions ==
428    
429        external ilnblnk        external ilnblnk
430    
431  c     == end of interface ==  c     == end of interface ==
432    
433  c     force 64-bit io  c     force 64-bit io
434        oldPrec        = readBinaryPrec        oldPrec        = readBinaryPrec
435        readBinaryPrec = precFloat64        readBinaryPrec = precFloat64
436        prec           = precFloat64        prec           = precFloat64
437    
438        write(adfname(1:80),'(80a)') ' '        write(adfname(1:80),'(80a)') ' '
439        adpref = 'ad'        adpref = 'ad'
440        il = ilnblnk( active_var_file )        il = ilnblnk( active_var_file )
441    
442        write(adfname(1:2),'(a)') adpref        write(adfname(1:2),'(a)') adpref
443        write(adfname(3:il+2),'(a)') active_var_file(1:il)        write(adfname(3:il+2),'(a)') active_var_file(1:il)
444    
445  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
446  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
447  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
448    
449        if (theSimulationMode .eq. FORWARD_SIMULATION) then        if (theSimulationMode .eq. FORWARD_SIMULATION) then
450    
451          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
452    
453  c       Read the active variable from file.  c       Read the active variable from file.
454    
455          call mdsreadfieldyz(          call mdsreadfieldyz(
456       &                     active_var_file,       &                     active_var_file,
457       &                     prec,       &                     prec,
458       &                     'RL',       &                     'RL',
459       &                     mynr,             &                     mynr,      
460       &                     active_var,       &                     active_var,
461       &                     irec,       &                     irec,
462       &                     mythid )       &                     mythid )
463    
464          if (lAdInit) then          if (lAdInit) then
465  c         Initialise the corresponding adjoint variable on the  c         Initialise the corresponding adjoint variable on the
466  c         adjoint variable's file. These files are tiled.  c         adjoint variable's file. These files are tiled.
467    
468            writeglobalfile = .false.            writeglobalfile = .false.
469            do bj = 1,nsy            do bj = 1,nsy
470               do bi = 1,nsx               do bi = 1,nsx
471                  do j = 1,sny                  do j = 1,sny
472                     active_data_t(j,bi,bj)= 0. _d 0                     active_data_t(j,bi,bj)= 0. _d 0
473                  enddo                  enddo
474               enddo               enddo
475            enddo            enddo
476    
477            do k = 1,mynr            do k = 1,mynr
478               call mdswritefieldyz(               call mdswritefieldyz(
479       &                           adfname,       &                           adfname,
480       &                           prec,       &                           prec,
481       &                           globalfile,       &                           globalfile,
482       &                           'RL',       &                           'RL',
483       &                           1,       &                           1,
484       &                           active_data_t,       &                           active_data_t,
485       &                           (irec-1)*mynr+k,       &                           (irec-1)*mynr+k,
486       &                           myOptimIter,       &                           myOptimIter,
487       &                           mythid )       &                           mythid )
488            enddo            enddo
489          endif          endif
490    
491          _END_MASTER( mythid )          _END_MASTER( mythid )
492    
493        endif        endif
494    
495  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
496  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
497  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
498    
499        if (theSimulationMode .eq. REVERSE_SIMULATION) then        if (theSimulationMode .eq. REVERSE_SIMULATION) then
500    
501          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
502    
503          writeglobalfile = .false.          writeglobalfile = .false.
504          do k=1,mynr          do k=1,mynr
505  c             Read data from file layer by layer.  c             Read data from file layer by layer.
506             call mdsreadfieldyz(             call mdsreadfieldyz(
507       &                        active_var_file,       &                        active_var_file,
508       &                        prec,       &                        prec,
509       &                        'RL',       &                        'RL',
510       &                        1,       &                        1,
511       &                        active_data_t,       &                        active_data_t,
512       &                        (irec-1)*mynr+k,       &                        (irec-1)*mynr+k,
513       &                        mythid )       &                        mythid )
514    
515  c             Add active_var from appropriate location to data.  c             Add active_var from appropriate location to data.
516             do bj = 1,nsy             do bj = 1,nsy
517                do bi = 1,nsx                do bi = 1,nsx
518                   do j = 1,sny                   do j = 1,sny
519                      active_data_t(j,bi,bj) = active_data_t(j,bi,bj) +                      active_data_t(j,bi,bj) = active_data_t(j,bi,bj) +
520       &                   active_var(j,k,bi,bj)       &                   active_var(j,k,bi,bj)
521                   enddo                   enddo
522                enddo                enddo
523             enddo             enddo
524    
525  c             Store the result on disk.  c             Store the result on disk.
526             call mdswritefieldyz(             call mdswritefieldyz(
527       &                         active_var_file,       &                         active_var_file,
528       &                         prec,       &                         prec,
529       &                         writeglobalfile,       &                         writeglobalfile,
530       &                         'RL',       &                         'RL',
531       &                         1,       &                         1,
532       &                         active_data_t,       &                         active_data_t,
533       &                         (irec-1)*mynr+k,       &                         (irec-1)*mynr+k,
534       &                         myOptimIter,       &                         myOptimIter,
535       &                         mythid )       &                         mythid )
536          enddo          enddo
537    
538    
539  c       Set active_var to zero.  c       Set active_var to zero.
540          do k=1,mynr          do k=1,mynr
541             do bj = 1,nsy             do bj = 1,nsy
542                do bi = 1,nsx                do bi = 1,nsx
543                   do j = 1,sny                   do j = 1,sny
544                      active_var(j,k,bi,bj) = 0. _d 0                      active_var(j,k,bi,bj) = 0. _d 0
545                   enddo                   enddo
546                enddo                enddo
547             enddo             enddo
548          enddo          enddo
549    
550          _END_MASTER( mythid )          _END_MASTER( mythid )
551        endif        endif
552    
553  c     Reset default io precision.  c     Reset default io precision.
554        readBinaryPrec = oldPrec        readBinaryPrec = oldPrec
555    
556        _BARRIER        _BARRIER
557    
558        return        return
559        end        end
560    
561  c     ==================================================================  c     ==================================================================
562    
563        subroutine active_write_yz_rl(        subroutine active_write_yz_rl(
564       I                            active_var_file,       I                            active_var_file,
565       I                            active_var,       I                            active_var,
566       I                            globalfile,       I                            globalfile,
567       I                            irec,       I                            irec,
568       I                            mynr,       I                            mynr,
569       I                            theSimulationMode,       I                            theSimulationMode,
570       I                            myOptimIter,       I                            myOptimIter,
571       I                            mythid       I                            mythid
572       &                          )       &                          )
573    
574  c     ==================================================================  c     ==================================================================
575  c     SUBROUTINE active_write_yz_rl  c     SUBROUTINE active_write_yz_rl
576  c     ==================================================================  c     ==================================================================
577  c  c
578  c     o Write an active variable to a file.  c     o Write an active variable to a file.
579  c  c
580  c     started: heimbach@mit.edu 05-Mar-2001  c     started: heimbach@mit.edu 05-Mar-2001
581  c  c
582  c     ==================================================================  c     ==================================================================
583  c     SUBROUTINE active_write_yz_rl  c     SUBROUTINE active_write_yz_rl
584  c     ==================================================================  c     ==================================================================
585    
586        implicit none        implicit none
587    
588  c     == global variables ==  c     == global variables ==
589    
590  #include "EEPARAMS.h"  #include "EEPARAMS.h"
591  #include "SIZE.h"  #include "SIZE.h"
592  #include "PARAMS.h"  #include "PARAMS.h"
593    
594  c     == routine arguments ==  c     == routine arguments ==
595    
596        character*(*) active_var_file        character*(*) active_var_file
597    
598        integer  mynr        integer  mynr
599        logical  globalfile        logical  globalfile
600        integer  irec        integer  irec
601        integer  theSimulationMode        integer  theSimulationMode
602        integer  myOptimIter        integer  myOptimIter
603        integer  mythid        integer  mythid
604        _RL     active_var(1-oly:sny+oly,mynr,nsx,nsy)        _RL     active_var(1-oly:sny+oly,mynr,nsx,nsy)
605    
606  c     == local variables ==  c     == local variables ==
607    
608        integer  i,j,k        integer  i,j,k
609        integer  bi,bj        integer  bi,bj
610        _RL  active_data_t(1-oly:sny+oly,nsx,nsy)        _RL  active_data_t(1-oly:sny+oly,nsx,nsy)
611        integer  oldprec        integer  oldprec
612        integer  prec        integer  prec
613    
614  c     == end of interface ==  c     == end of interface ==
615    
616  c     force 64-bit io  c     force 64-bit io
617        oldPrec        = readBinaryPrec        oldPrec        = readBinaryPrec
618        readBinaryPrec = precFloat64        readBinaryPrec = precFloat64
619        prec           = precFloat64        prec           = precFloat64
620    
621  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
622  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
623  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
624    
625        if (theSimulationMode .eq. FORWARD_SIMULATION) then        if (theSimulationMode .eq. FORWARD_SIMULATION) then
626    
627          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
628    
629            call mdswritefieldyz(            call mdswritefieldyz(
630       &                        active_var_file,       &                        active_var_file,
631       &                        prec,       &                        prec,
632       &                        globalfile,       &                        globalfile,
633       &                        'RL',       &                        'RL',
634       &                        mynr,       &                        mynr,
635       &                        active_var,       &                        active_var,
636       &                        irec,       &                        irec,
637       &                        myOptimIter,       &                        myOptimIter,
638       &                        mythid )       &                        mythid )
639    
640          _END_MASTER( mythid )          _END_MASTER( mythid )
641    
642        endif        endif
643    
644  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
645  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
646  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
647    
648        if (theSimulationMode .eq. REVERSE_SIMULATION) then        if (theSimulationMode .eq. REVERSE_SIMULATION) then
649    
650          _BEGIN_MASTER( mythid )          _BEGIN_MASTER( mythid )
651    
652              do k=1,mynr              do k=1,mynr
653  c             Read data from file layer by layer.  c             Read data from file layer by layer.
654                call mdsreadfieldyz(                call mdsreadfieldyz(
655       &                           active_var_file,       &                           active_var_file,
656       &                           prec,       &                           prec,
657       &                           'RL',       &                           'RL',
658       &                            1,       &                            1,
659       &                            active_data_t,       &                            active_data_t,
660       &                            (irec-1)*mynr+k,       &                            (irec-1)*mynr+k,
661       &                            mythid )       &                            mythid )
662    
663  c             Add active_var from appropriate location to data.  c             Add active_var from appropriate location to data.
664                do bj = 1,nsy                do bj = 1,nsy
665                   do bi = 1,nsx                   do bi = 1,nsx
666                      do j = 1,sny                      do j = 1,sny
667                         active_var(j,k,bi,bj) =                         active_var(j,k,bi,bj) =
668       &                      active_var(j,k,bi,bj) +       &                      active_var(j,k,bi,bj) +
669       &                      active_data_t(j,bi,bj)       &                      active_data_t(j,bi,bj)
670                         active_data_t(j,bi,bj) = 0. _d 0                         active_data_t(j,bi,bj) = 0. _d 0
671                      enddo                      enddo
672                   enddo                   enddo
673                enddo                enddo
674                call mdswritefieldyz(                call mdswritefieldyz(
675       &                            active_var_file,       &                            active_var_file,
676       &                            prec,       &                            prec,
677       &                            globalfile,       &                            globalfile,
678       &                            'RL',       &                            'RL',
679       &                            1,       &                            1,
680       &                            active_data_t,       &                            active_data_t,
681       &                            (irec-1)*mynr+k,       &                            (irec-1)*mynr+k,
682       &                            myOptimIter,       &                            myOptimIter,
683       &                            mythid )       &                            mythid )
684          enddo          enddo
685    
686          _END_MASTER( mythid )          _END_MASTER( mythid )
687    
688        endif        endif
689    
690  c     Reset default io precision.  c     Reset default io precision.
691        readBinaryPrec = oldPrec        readBinaryPrec = oldPrec
692    
693        _BARRIER        _BARRIER
694    
695        return        return
696        end        end
697    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.22