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