/[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.8 by heimbach, Tue Jul 26 13:10:46 2005 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,mynr,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 k = 1,mynr
135            writeglobalfile = .false.                     do i = 1,snx
136            do bj = 1,nsy                        active_data_t(i,k,bi,bj)= 0. _d 0
137               do bi = 1,nsx                     enddo
138                  do i = 1,snx                  enddo
139                     active_data_t(i,bi,bj)= 0. _d 0               enddo
140                  enddo            enddo
141               enddo  
142            enddo            call mdswritefieldxz(
143         &                           adfname,
144            do k = 1,mynr       &                           prec,
145               call mdswritefieldxz(       &                           globalfile,
146       &                           adfname,       &                           'RL',
147       &                           prec,       &                           mynr,
148       &                           globalfile,       &                           active_data_t,
149       &                           'RL',       &                           irec,
150       &                           1,       &                           myOptimIter,
151       &                           active_data_t,       &                           mythid )
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            call mdsreadfieldxz(
168          _BEGIN_MASTER( mythid )       &                        active_var_file,
169         &                        prec,
170          writeglobalfile = .false.       &                        'RL',
171          do k=1,mynr       &                        mynr,
172  c             Read data from file layer by layer.       &                        active_data_t,
173             call mdsreadfieldxz(       &                        irec,
174       &                        active_var_file,       &                        mythid )
175       &                        prec,  
176       &                        'RL',  c             Add active_var from appropriate location to data.
177       &                        1,          do bj = 1,nsy
178       &                        active_data_t,             do bi = 1,nsx
179       &                        (irec-1)*mynr+k,                do k = 1,mynr
180       &                        mythid )                   do i = 1,snx
181                        active_data_t(i,k,bi,bj) =
182  c             Add active_var from appropriate location to data.       &                   active_data_t(i,k,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)          enddo
188                   enddo          
189                enddo  c             Store the result on disk.
190             enddo          call mdswritefieldxz(
191         &                         active_var_file,
192  c             Store the result on disk.       &                         prec,
193             call mdswritefieldxz(       &                         writeglobalfile,
194       &                         active_var_file,       &                         'RL',
195       &                         prec,       &                         mynr,
196       &                         writeglobalfile,       &                         active_data_t,
197       &                         'RL',       &                         irec,
198       &                         1,       &                         myOptimIter,
199       &                         active_data_t,       &                         mythid )
200       &                         (irec-1)*mynr+k,  
201       &                         myOptimIter,  c       Set active_var to zero.
202       &                         mythid )          do bj = 1,nsy
203          enddo             do bi = 1,nsx
204                  do k=1,mynr
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  #include "ctrl.h"
279        integer  irec  
280        integer  theSimulationMode  c     == routine arguments ==
281        integer  myOptimIter  
282        integer  mythid        character*(*) active_var_file
283        _RL     active_var(1-olx:snx+olx,mynr,nsx,nsy)  
284          integer  mynr
285  C     !LOCAL VARIABLES:        logical  globalfile
286  c     == local variables ==        integer  irec
287        integer  i,j,k        integer  theSimulationMode
288        integer  bi,bj        integer  myOptimIter
289        _RL  active_data_t(1-olx:snx+olx,nsx,nsy)        integer  mythid
290        integer  oldprec        _RL     active_var(1-olx:snx+olx,mynr,nsx,nsy)
291        integer  prec  
292    c     == local variables ==
293  c     == end of interface ==  
294  CEOP        integer  i,j,k
295          integer  bi,bj
296  c     force 64-bit io        _RL  active_data_t(1-olx:snx+olx,mynr,nsx,nsy)
297        oldPrec        = readBinaryPrec        integer  oldprec
298        readBinaryPrec = precFloat64        integer  prec
299        prec           = precFloat64  
300    c     == end of interface ==
301  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<  
302  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  c     force 64-bit io
303  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<        oldPrec        = readBinaryPrec
304          readBinaryPrec = ctrlprec
305        if (theSimulationMode .eq. FORWARD_SIMULATION) then        prec           = ctrlprec
306    
307          _BEGIN_MASTER( mythid )  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
308    c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
309            call mdswritefieldxz(  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
310       &                        active_var_file,  
311       &                        prec,        if (theSimulationMode .eq. FORWARD_SIMULATION) then
312       &                        globalfile,  
313       &                        'RL',          _BEGIN_MASTER( mythid )
314       &                        mynr,  
315       &                        active_var,            call mdswritefieldxz(
316       &                        irec,       &                        active_var_file,
317       &                        myOptimIter,       &                        prec,
318       &                        mythid )       &                        globalfile,
319         &                        'RL',
320          _END_MASTER( mythid )       &                        mynr,
321         &                        active_var,
322        endif       &                        irec,
323         &                        myOptimIter,
324  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<       &                        mythid )
325  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<  
326  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<          _END_MASTER( mythid )
327    
328        if (theSimulationMode .eq. REVERSE_SIMULATION) then        endif
329    
330          _BEGIN_MASTER( mythid )  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
331    c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
332              do k=1,mynr  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
333  c             Read data from file layer by layer.  
334                call mdsreadfieldxz(        if (theSimulationMode .eq. REVERSE_SIMULATION) then
335       &                           active_var_file,  
336       &                           prec,          _BEGIN_MASTER( mythid )
337       &                           'RL',  
338       &                            1,          call mdsreadfieldxz(
339       &                            active_data_t,       &                           active_var_file,
340       &                            (irec-1)*mynr+k,       &                           prec,
341       &                            mythid )       &                           'RL',
342         &                            mynr,
343  c             Add active_var from appropriate location to data.       &                            active_data_t,
344                do bj = 1,nsy       &                            irec,
345                   do bi = 1,nsx       &                            mythid )
346                      do i = 1,snx  
347                         active_var(i,k,bi,bj) =  c             Add active_var from appropriate location to data.
348       &                      active_var(i,k,bi,bj) +          do bj = 1,nsy
349       &                      active_data_t(i,bi,bj)             do bi = 1,nsx
350                         active_data_t(i,bi,bj) = 0. _d 0                do k = 1,nr
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,k,bi,bj)
355       &                            active_var_file,                      active_data_t(i,k,bi,bj) = 0. _d 0
356       &                            prec,                   enddo
357       &                            globalfile,                enddo
358       &                            'RL',             enddo
359       &                            1,          enddo
360       &                            active_data_t,          call mdswritefieldxz(
361       &                            (irec-1)*mynr+k,       &                            active_var_file,
362       &                            myOptimIter,       &                            prec,
363       &                            mythid )       &                            globalfile,
364          enddo       &                            'RL',
365         &                            mynr,
366          _END_MASTER( mythid )       &                            active_data_t,
367         &                            irec,
368        endif       &                            myOptimIter,
369         &                            mythid )
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  #include "ctrl.h"
444        integer prec  
445        integer il  c     == routine arguments ==
446        integer ilnblnk  
447        logical writeglobalfile        character*(*) active_var_file
448        _RL  active_data_t(1-oly:sny+oly,nsx,nsy)  
449          logical  globalfile
450  c     == functions ==        logical  lAdInit
451        external ilnblnk        integer  irec
452          integer  mynr
453  c     == end of interface ==        integer  theSimulationMode
454  CEOP        integer  myOptimIter
455          integer  mythid
456  c     force 64-bit io        _RL     active_var(1-oly:sny+oly,mynr,nsx,nsy)
457        oldPrec        = readBinaryPrec  
458        readBinaryPrec = precFloat64  c     == local variables ==
459        prec           = precFloat64  
460          character*(2)  adpref
461        write(adfname(1:80),'(80a)') ' '        character*(80) adfname
462        adpref = 'ad'  
463        il = ilnblnk( active_var_file )        integer bi,bj
464          integer i,j,k
465        write(adfname(1:2),'(a)') adpref        integer oldprec
466        write(adfname(3:il+2),'(a)') active_var_file(1:il)        integer prec
467          integer il
468  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<        integer ilnblnk
469  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<  
470  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<        logical writeglobalfile
471    
472        if (theSimulationMode .eq. FORWARD_SIMULATION) then        _RL  active_data_t(1-oly:sny+oly,mynr,nsx,nsy)
473    
474          _BEGIN_MASTER( mythid )  c     == functions ==
475    
476  c       Read the active variable from file.        external ilnblnk
477    
478          call mdsreadfieldyz(  c     == end of interface ==
479       &                     active_var_file,  
480       &                     prec,  c     force 64-bit io
481       &                     'RL',        oldPrec        = readBinaryPrec
482       &                     mynr,              readBinaryPrec = ctrlprec
483       &                     active_var,        prec           = ctrlprec
484       &                     irec,  
485       &                     mythid )        write(adfname(1:80),'(80a)') ' '
486          adpref = 'ad'
487          if (lAdInit) then        il = ilnblnk( active_var_file )
488  c         Initialise the corresponding adjoint variable on the  
489  c         adjoint variable's file. These files are tiled.        write(adfname(1:2),'(a)') adpref
490          write(adfname(3:il+2),'(a)') active_var_file(1:il)
491            writeglobalfile = .false.  
492            do bj = 1,nsy  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
493               do bi = 1,nsx  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
494                  do j = 1,sny  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
495                     active_data_t(j,bi,bj)= 0. _d 0  
496                  enddo        if (theSimulationMode .eq. FORWARD_SIMULATION) then
497               enddo  
498            enddo          _BEGIN_MASTER( mythid )
499    
500            do k = 1,mynr  c       Read the active variable from file.
501               call mdswritefieldyz(  
502       &                           adfname,          call mdsreadfieldyz(
503       &                           prec,       &                     active_var_file,
504       &                           globalfile,       &                     prec,
505       &                           'RL',       &                     'RL',
506       &                           1,       &                     mynr,      
507       &                           active_data_t,       &                     active_var,
508       &                           (irec-1)*mynr+k,       &                     irec,
509       &                           myOptimIter,       &                     mythid )
510       &                           mythid )  
511            enddo          if (lAdInit) then
512          endif  c         Initialise the corresponding adjoint variable on the
513    c         adjoint variable's file. These files are tiled.
514          _END_MASTER( mythid )  
515              writeglobalfile = .false.
516        endif            do bj = 1,nsy
517                 do bi = 1,nsx
518  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<                  do k = 1, mynr
519  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<                     do j = 1,sny
520  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<                        active_data_t(j,k,bi,bj)= 0. _d 0
521                       enddo
522        if (theSimulationMode .eq. REVERSE_SIMULATION) then                  enddo
523                 enddo
524          _BEGIN_MASTER( mythid )            enddo
525    
526          writeglobalfile = .false.            call mdswritefieldyz(
527          do k=1,mynr       &                           adfname,
528  c             Read data from file layer by layer.       &                           prec,
529             call mdsreadfieldyz(       &                           globalfile,
530       &                        active_var_file,       &                           'RL',
531       &                        prec,       &                           mynr,
532       &                        'RL',       &                           active_data_t,
533       &                        1,       &                           irec,
534       &                        active_data_t,       &                           myOptimIter,
535       &                        (irec-1)*mynr+k,       &                           mythid )
536       &                        mythid )          endif
537    
538  c             Add active_var from appropriate location to data.          _END_MASTER( mythid )
539             do bj = 1,nsy  
540                do bi = 1,nsx        endif
541                   do j = 1,sny  
542                      active_data_t(j,bi,bj) = active_data_t(j,bi,bj) +  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
543       &                   active_var(j,k,bi,bj)  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
544                   enddo  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
545                enddo  
546             enddo        if (theSimulationMode .eq. REVERSE_SIMULATION) then
547    
548  c             Store the result on disk.          _BEGIN_MASTER( mythid )
549             call mdswritefieldyz(  
550       &                         active_var_file,          writeglobalfile = .false.
551       &                         prec,          call mdsreadfieldyz(
552       &                         writeglobalfile,       &                        active_var_file,
553       &                         'RL',       &                        prec,
554       &                         1,       &                        'RL',
555       &                         active_data_t,       &                        mynr,
556       &                         (irec-1)*mynr+k,       &                        active_data_t,
557       &                         myOptimIter,       &                        irec,
558       &                         mythid )       &                        mythid )
559          enddo  
560    c             Add active_var from appropriate location to data.
561            do bj = 1,nsy
562  c       Set active_var to zero.             do bi = 1,nsx
563          do k=1,mynr                do k = 1,mynr
564             do bj = 1,nsy                   do j = 1,sny
565                do bi = 1,nsx                      active_data_t(j,k,bi,bj) =
566                   do j = 1,sny       &                   active_data_t(j,k,bi,bj) +
567                      active_var(j,k,bi,bj) = 0. _d 0       &                   active_var(j,k,bi,bj)
568                   enddo                   enddo
569                enddo                enddo
570             enddo             enddo
571          enddo          enddo
572            
573          _END_MASTER( mythid )  c             Store the result on disk.
574        endif          call mdswritefieldyz(
575         &                         active_var_file,
576  c     Reset default io precision.       &                         prec,
577        readBinaryPrec = oldPrec       &                         writeglobalfile,
578         &                         'RL',
579        _BARRIER       &                         mynr,
580         &                         active_data_t,
581        return       &                         irec,
582        end       &                         myOptimIter,
583         &                         mythid )
584  c     ==================================================================  
585    c       Set active_var to zero.
586  CBOP          do bj = 1,nsy
587  C     !ROUTINE: active_write_yz_rl             do bi = 1,nsx
588  C     !INTERFACE:                do k=1,mynr
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    #include "ctrl.h"
663          _BEGIN_MASTER( mythid )  
664    c     == routine arguments ==
665            call mdswritefieldyz(  
666       &                        active_var_file,        character*(*) active_var_file
667       &                        prec,  
668       &                        globalfile,        integer  mynr
669       &                        'RL',        logical  globalfile
670       &                        mynr,        integer  irec
671       &                        active_var,        integer  theSimulationMode
672       &                        irec,        integer  myOptimIter
673       &                        myOptimIter,        integer  mythid
674       &                        mythid )        _RL     active_var(1-oly:sny+oly,mynr,nsx,nsy)
675    
676          _END_MASTER( mythid )  c     == local variables ==
677    
678        endif        integer  i,j,k
679          integer  bi,bj
680  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<        _RL  active_data_t(1-oly:sny+oly,mynr,nsx,nsy)
681  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<        integer  oldprec
682  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<        integer  prec
683    
684        if (theSimulationMode .eq. REVERSE_SIMULATION) then  c     == end of interface ==
685    
686          _BEGIN_MASTER( mythid )  c     force 64-bit io
687          oldPrec        = readBinaryPrec
688              do k=1,mynr        readBinaryPrec = ctrlprec
689  c             Read data from file layer by layer.        prec           = ctrlprec
690                call mdsreadfieldyz(  
691       &                           active_var_file,  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
692       &                           prec,  c     >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
693       &                           'RL',  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
694       &                            1,  
695       &                            active_data_t,        if (theSimulationMode .eq. FORWARD_SIMULATION) then
696       &                            (irec-1)*mynr+k,  
697       &                            mythid )          _BEGIN_MASTER( mythid )
698    
699  c             Add active_var from appropriate location to data.            call mdswritefieldyz(
700                do bj = 1,nsy       &                        active_var_file,
701                   do bi = 1,nsx       &                        prec,
702                      do j = 1,sny       &                        globalfile,
703                         active_var(j,k,bi,bj) =       &                        'RL',
704       &                      active_var(j,k,bi,bj) +       &                        mynr,
705       &                      active_data_t(j,bi,bj)       &                        active_var,
706                         active_data_t(j,bi,bj) = 0. _d 0       &                        irec,
707                      enddo       &                        myOptimIter,
708                   enddo       &                        mythid )
709                enddo  
710                call mdswritefieldyz(          _END_MASTER( mythid )
711       &                            active_var_file,  
712       &                            prec,        endif
713       &                            globalfile,  
714       &                            'RL',  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
715       &                            1,  c     >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
716       &                            active_data_t,  c     >>>>>>>>>>>>>>>>>>>             <<<<<<<<<<<<<<<<<<<
717       &                            (irec-1)*mynr+k,  
718       &                            myOptimIter,        if (theSimulationMode .eq. REVERSE_SIMULATION) then
719       &                            mythid )  
720          enddo          _BEGIN_MASTER( mythid )
721    
722          _END_MASTER( mythid )          call mdsreadfieldyz(
723         &                           active_var_file,
724        endif       &                           prec,
725         &                           'RL',
726  c     Reset default io precision.       &                            mynr,
727        readBinaryPrec = oldPrec       &                            active_data_t,
728         &                            irec,
729        _BARRIER       &                            mythid )
730    
731        return  c             Add active_var from appropriate location to data.
732        end          do bj = 1,nsy
733               do bi = 1,nsx
734                  do k = 1, mynr
735                     do j = 1,sny
736                        active_var(j,k,bi,bj) =
737         &                   active_var(j,k,bi,bj) +
738         &                   active_data_t(j,k,bi,bj)
739                        active_data_t(j,k,bi,bj) = 0. _d 0
740                     enddo
741                  enddo
742               enddo
743            enddo
744            call mdswritefieldyz(
745         &                            active_var_file,
746         &                            prec,
747         &                            globalfile,
748         &                            'RL',
749         &                            mynr,
750         &                            active_data_t,
751         &                            irec,
752         &                            myOptimIter,
753         &                            mythid )
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.8
  ViewVC Help
Powered by ViewVC 1.1.22