/[MITgcm]/MITgcm/pkg/grdchk/grdchk_getadxx.F
ViewVC logotype

Diff of /MITgcm/pkg/grdchk/grdchk_getadxx.F

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

revision 1.1 by heimbach, Fri Jul 13 13:08:17 2001 UTC revision 1.2 by heimbach, Fri Jul 13 14:50:46 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    
3    #include "CTRL_CPPOPTIONS.h"
4    
5    
6          subroutine grdchk_getadxx(
7         I                       icvrec,
8         I                       itile,
9         I                       jtile,
10         I                       layer,
11         I                       itilepos,
12         I                       jtilepos,
13         I                       xx_comp,
14         I                       mythid
15         &                     )
16    
17    c     ==================================================================
18    c     SUBROUTINE grdchk_getadxx
19    c     ==================================================================
20    c
21    c     o Set component a component of the control vector; xx(loc)
22    c
23    c     started: Christian Eckert eckert@mit.edu 08-Mar-2000
24    c     continued: heimbach@mit.edu: 13-Jun-2001
25    c
26    c     ==================================================================
27    c     SUBROUTINE grdchk_getadxx
28    c     ==================================================================
29    
30          implicit none
31    
32    c     == global variables ==
33    
34    #include "EEPARAMS.h"
35    #include "SIZE.h"
36    #include "ctrl.h"
37    #include "optim.h"
38    #include "grdchk.h"
39    
40    c     == routine arguments ==
41    
42          integer icvrec
43          integer jtile
44          integer itile
45          integer layer
46          integer itilepos
47          integer jtilepos
48          _RL     xx_comp
49          integer mythid
50    
51    #ifdef ALLOW_GRADIENT_CHECK
52    c     == local variables ==
53    
54          integer il
55          integer dumiter
56          _RL     dumtime
57          _RL     dummy
58    
59          logical doglobalread
60          logical ladinit
61    
62          character*(80) fname
63    
64    c--   == external ==
65    
66          integer  ilnblnk
67          external ilnblnk
68    
69    c--   == end of interface ==
70    
71          doglobalread = .false.
72          ladinit      = .false.
73          dumiter      = 0
74          dumtime      = 0. _d 0
75    
76          if      ( grdchkvarindex .eq. 1 ) then
77    #ifdef ALLOW_THETA0_CONTROL
78             il=ilnblnk( xx_theta_file )
79             write(fname(1:80),'(80a)') ' '
80             write(fname(1:80),'(3a,i10.10)')
81         &        yadmark, xx_theta_file(1:il),'.',optimcycle
82    
83             call active_read_xyz( fname, tmpfld3d, 1,
84         &                         doglobalread, ladinit, optimcycle,
85         &                         mythid, dummy)
86    
87             xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
88    
89    #endif /* ALLOW_THETA0_CONTROL */
90    
91    #ifdef ALLOW_SALT0_CONTROL
92          else if ( grdchkvarindex .eq. 2 ) then
93             il=ilnblnk( xx_salt_file )
94             write(fname(1:80),'(80a)') ' '
95             write(fname(1:80),'(3a,i10.10)')
96         &        yadmark, xx_salt_file(1:il),'.',optimcycle
97            
98             call active_read_xyz( fname, tmpfld3d, 1,
99         &                         doglobalread, ladinit, optimcycle,
100         &                         mythid, dummy)
101    
102             xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
103    
104    #endif /* ALLOW_SALT0_CONTROL */
105    
106    #ifdef ALLOW_HFLUX_CONTROL
107          else if ( grdchkvarindex .eq. 3 ) then
108             il=ilnblnk( xx_hflux_file )
109             write(fname(1:80),'(80a)') ' '
110             write(fname(1:80),'(3a,i10.10)')
111         &        yadmark, xx_hflux_file(1:il),'.',optimcycle
112    
113             call active_read_xy( fname, tmpfld2d, icvrec,
114         &                        doglobalread, ladinit, optimcycle,
115         &                        mythid, dummy)
116    
117             xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
118    
119    #endif /* ALLOW_HFLUX_CONTROL */
120    
121    #ifdef ALLOW_SFLUX_CONTROL
122          else if ( grdchkvarindex .eq. 4 ) then
123             il=ilnblnk( xx_sflux_file )
124             write(fname(1:80),'(80a)') ' '
125             write(fname(1:80),'(3a,i10.10)')
126         &        yadmark, xx_sflux_file(1:il),'.',optimcycle
127    
128             call active_read_xy( fname, tmpfld2d, icvrec,
129         &                        doglobalread, ladinit, optimcycle,
130         &                        mythid, dummy)
131    
132             xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
133    
134    #endif /* ALLOW_SFLUX_CONTROL */
135    
136    #ifdef ALLOW_USTRESS_CONTROL
137          else if ( grdchkvarindex .eq. 5 ) then
138             il=ilnblnk( xx_tauu_file )
139             write(fname(1:80),'(80a)') ' '
140             write(fname(1:80),'(3a,i10.10)')
141         &        yadmark, xx_tauu_file(1:il),'.',optimcycle
142    
143             call active_read_xy( fname, tmpfld2d, icvrec,
144         &                        doglobalread, ladinit, optimcycle,
145         &                        mythid, dummy)
146    
147             xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
148    
149    #endif /* ALLOW_USTRESS_CONTROL */
150    
151    #ifdef ALLOW_VSTRESS_CONTROL
152          else if ( grdchkvarindex .eq. 6 ) then
153             il=ilnblnk( xx_tauv_file )
154             write(fname(1:80),'(80a)') ' '
155             write(fname(1:80),'(3a,i10.10)')
156         &        yadmark, xx_tauv_file(1:il),'.',optimcycle
157    
158             call active_read_xy( fname, tmpfld2d, icvrec,
159         &                        doglobalread, ladinit, optimcycle,
160         &                        mythid, dummy)
161    
162             xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
163    
164    #endif /* ALLOW_VSTRESS_CONTROL */
165    
166    #ifdef ALLOW_TR10_CONTROL
167          else if ( grdchkvarindex .eq. 17 ) then
168             il=ilnblnk( xx_tr1_file )
169             write(fname(1:80),'(80a)') ' '
170             write(fname(1:80),'(3a,i10.10)')
171         &        yadmark, xx_tr1_file(1:il),'.',optimcycle
172            
173             call active_read_xyz( fname, tmpfld3d, 1,
174         &                         doglobalread, ladinit, optimcycle,
175         &                         mythid, dummy)
176    
177             xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
178    
179    #endif /* ALLOW_TR10_CONTROL */
180    
181    #ifdef ALLOW_SST0_CONTROL
182          else if ( grdchkvarindex .eq. 18 ) then
183             il=ilnblnk( xx_sst_file )
184             write(fname(1:80),'(80a)') ' '
185             write(fname(1:80),'(3a,i10.10)')
186         &        yadmark, xx_sst_file(1:il),'.',optimcycle
187    
188             call active_read_xy( fname, tmpfld2d, icvrec,
189         &                        doglobalread, ladinit, optimcycle,
190         &                        mythid, dummy)
191    
192             xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
193    
194    #endif /* ALLOW_SST0_CONTROL */
195    
196    #ifdef ALLOW_SSS0_CONTROL
197          else if ( grdchkvarindex .eq. 19 ) then
198             il=ilnblnk( xx_sss_file )
199             write(fname(1:80),'(80a)') ' '
200             write(fname(1:80),'(3a,i10.10)')
201         &        yadmark, xx_sss_file(1:il),'.',optimcycle
202    
203             call active_read_xy( fname, tmpfld2d, icvrec,
204         &                        doglobalread, ladinit, optimcycle,
205         &                        mythid, dummy)
206    
207             xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
208    
209    #endif /* ALLOW_SSS0_CONTROL */
210    
211          else
212    ce      --> this index does not exist yet.
213          endif
214    
215    #endif /* ALLOW_GRADIENT_CHECK */
216    
217          end
218    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22