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