/[MITgcm]/MITgcm/pkg/ctrl/ctrl_map_ini.F
ViewVC logotype

Annotation of /MITgcm/pkg/ctrl/ctrl_map_ini.F

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


Revision 1.10 - (hide annotations) (download)
Fri Jun 27 01:54:20 2003 UTC (22 years ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint51b_post, checkpoint51c_post
Changes since 1.9: +22 -5 lines
extend cost, ctr, to deal with ALLOW_PTRACERS

1 heimbach 1.10 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.9 2003/06/24 16:07:06 heimbach Exp $
2 heimbach 1.1
3     #include "CTRL_CPPOPTIONS.h"
4 heimbach 1.10 #ifdef ALLOW_PTRACERS
5     # include "PTRACERS_OPTIONS.h"
6     #endif
7 heimbach 1.1
8 heimbach 1.5 CBOP
9     C !ROUTINE: ctrl_map_ini
10     C !INTERFACE:
11     subroutine ctrl_map_ini( mythid )
12    
13     C !DESCRIPTION: \bv
14     c *=================================================================
15     c | SUBROUTINE ctrl_map_ini
16     c | Add the temperature, salinity, and diffusivity parts of the
17     c | control vector to the model state and update the tile halos.
18     c | The control vector is defined in the header file "ctrl.h".
19     c *=================================================================
20     C \ev
21 heimbach 1.1
22 heimbach 1.5 C !USES:
23 heimbach 1.1 implicit none
24    
25     c == global variables ==
26 heimbach 1.6 #include "SIZE.h"
27 heimbach 1.1 #include "EEPARAMS.h"
28 heimbach 1.6 #include "PARAMS.h"
29 heimbach 1.1 #include "DYNVARS.h"
30 heimbach 1.6 #include "GRID.h"
31 heimbach 1.10 #ifdef ALLOW_PASSIVE_TRACER
32     # include "TR1.h"
33     #endif
34     #ifdef ALLOW_PTRACERS
35     # include "PTRACERS.h"
36     #endif
37    
38 heimbach 1.1 #include "ctrl.h"
39     #include "ctrl_dummy.h"
40 heimbach 1.2 #include "optim.h"
41 heimbach 1.1
42 heimbach 1.5 C !INPUT/OUTPUT PARAMETERS:
43 heimbach 1.1 c == routine arguments ==
44     integer mythid
45    
46 heimbach 1.5 C !LOCAL VARIABLES:
47 heimbach 1.1 c == local variables ==
48    
49     integer bi,bj
50     integer i,j,k
51     integer itlo,ithi
52     integer jtlo,jthi
53     integer jmin,jmax
54     integer imin,imax
55     integer il
56    
57     logical equal
58     logical doglobalread
59     logical ladinit
60    
61     character*( 80) fnametheta
62     character*( 80) fnamesalt
63 heimbach 1.2 character*( 80) fnametr1
64 heimbach 1.3 character*( 80) fnamediffkr
65     character*( 80) fnamekapgm
66 heimbach 1.6 character*( 80) fnameefluxy
67     character*( 80) fnameefluxp
68 heimbach 1.7 character*( 80) fnamebottomdrag
69 heimbach 1.1
70 heimbach 1.5 _RL fac
71    
72 heimbach 1.1 c == external ==
73     integer ilnblnk
74     external ilnblnk
75    
76     c == end of interface ==
77 heimbach 1.5 CEOP
78 heimbach 1.1
79     jtlo = mybylo(mythid)
80     jthi = mybyhi(mythid)
81     itlo = mybxlo(mythid)
82     ithi = mybxhi(mythid)
83 heimbach 1.8 jmin = 1
84     jmax = sny
85     imin = 1
86     imax = snx
87 heimbach 1.1
88     doglobalread = .false.
89     ladinit = .false.
90    
91     equal = .true.
92    
93     if ( equal ) then
94     fac = 1. _d 0
95     else
96     fac = 0. _d 0
97     endif
98    
99     #ifdef ALLOW_THETA0_CONTROL
100     c-- Temperature field.
101     il=ilnblnk( xx_theta_file )
102     write(fnametheta(1:80),'(2a,i10.10)')
103     & xx_theta_file(1:il),'.',optimcycle
104     call active_read_xyz( fnametheta, tmpfld3d, 1,
105     & doglobalread, ladinit, optimcycle,
106     & mythid, xx_theta_dummy )
107    
108     do bj = jtlo,jthi
109     do bi = itlo,ithi
110     do k = 1,nr
111     do j = jmin,jmax
112     do i = imin,imax
113     theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
114     & fac*tmpfld3d(i,j,k,bi,bj)
115 heimbach 1.9 if(theta(i,j,k,bi,bj).lt.-2.0)
116     & theta(i,j,k,bi,bj)= -2.0
117 heimbach 1.1 enddo
118     enddo
119     enddo
120     enddo
121     enddo
122     #endif
123    
124     #ifdef ALLOW_SALT0_CONTROL
125     c-- Temperature field.
126     il=ilnblnk( xx_salt_file )
127     write(fnamesalt(1:80),'(2a,i10.10)')
128     & xx_salt_file(1:il),'.',optimcycle
129     call active_read_xyz( fnamesalt, tmpfld3d, 1,
130     & doglobalread, ladinit, optimcycle,
131     & mythid, xx_salt_dummy )
132    
133     do bj = jtlo,jthi
134     do bi = itlo,ithi
135     do k = 1,nr
136     do j = jmin,jmax
137     do i = imin,imax
138     salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
139     & fac*tmpfld3d(i,j,k,bi,bj)
140     enddo
141     enddo
142     enddo
143     enddo
144     enddo
145     #endif
146    
147 heimbach 1.2 #ifdef ALLOW_TR10_CONTROL
148     c-- Temperature field.
149     il=ilnblnk( xx_tr1_file )
150     write(fnametr1(1:80),'(2a,i10.10)')
151     & xx_tr1_file(1:il),'.',optimcycle
152     call active_read_xyz( fnametr1, tmpfld3d, 1,
153     & doglobalread, ladinit, optimcycle,
154     & mythid, xx_tr1_dummy )
155    
156     do bj = jtlo,jthi
157     do bi = itlo,ithi
158     do k = 1,nr
159     do j = jmin,jmax
160     do i = imin,imax
161 heimbach 1.10 #if (defined (ALLOW_PASSIVE_TRACER))
162 heimbach 1.2 tr1(i,j,k,bi,bj) = tr1(i,j,k,bi,bj) +
163     & fac*tmpfld3d(i,j,k,bi,bj)
164 heimbach 1.10 #elif (defined (ALLOW_PTRACERS))
165     IF ( NUMBER_OF_PTRACERS .GT. 1 ) STOP
166     & 'ALLOW_TR10_CONTROL with ALLOW_PTRACERS implemented for 1 tracer'
167     ptracer(i,j,k,bi,bj,1) = ptracer(i,j,k,bi,bj,1) +
168     & fac*tmpfld3d(i,j,k,bi,bj)
169     #endif
170 heimbach 1.2 enddo
171     enddo
172     enddo
173     enddo
174     enddo
175     #endif
176    
177 heimbach 1.3 #ifdef ALLOW_DIFFKR_CONTROL
178     c-- diffkr.
179     il=ilnblnk( xx_diffkr_file )
180     write(fnamediffkr(1:80),'(2a,i10.10)')
181     & xx_diffkr_file(1:il),'.',optimcycle
182     call active_read_xyz( fnamediffkr, tmpfld3d, 1,
183     & doglobalread, ladinit, optimcycle,
184     & mythid, xx_diffkr_dummy )
185     do bj = jtlo,jthi
186     do bi = itlo,ithi
187     do k = 1,nr
188     do j = jmin,jmax
189     do i = imin,imax
190     diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
191     & tmpfld3d(i,j,k,bi,bj)
192     enddo
193     enddo
194     enddo
195     enddo
196     enddo
197     #endif
198    
199     #ifdef ALLOW_KAPGM_CONTROL
200     c-- kapgm.
201     il=ilnblnk( xx_kapgm_file )
202     write(fnamekapgm(1:80),'(2a,i10.10)')
203     & xx_kapgm_file(1:il),'.',optimcycle
204     call active_read_xyz( fnamekapgm, tmpfld3d, 1,
205     & doglobalread, ladinit, optimcycle,
206     & mythid, xx_kapgm_dummy )
207     do bj = jtlo,jthi
208     do bi = itlo,ithi
209     do k = 1,nr
210     do j = jmin,jmax
211     do i = imin,imax
212     kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
213     & tmpfld3d(i,j,k,bi,bj)
214     enddo
215     enddo
216     enddo
217     enddo
218     enddo
219     #endif
220    
221 heimbach 1.6 #ifdef ALLOW_EFLUXY0_CONTROL
222     c-- y-component EP-flux field.
223     il=ilnblnk( xx_efluxy_file )
224     write(fnameefluxy(1:80),'(2a,i10.10)')
225     & xx_efluxy_file(1:il),'.',optimcycle
226     call active_read_xyz( fnameefluxy, tmpfld3d, 1,
227     & doglobalread, ladinit, optimcycle,
228     & mythid, xx_efluxy_dummy )
229    
230     do bj = jtlo,jthi
231     do bi = itlo,ithi
232     do k = 1,nr
233     do j = jmin,jmax
234     do i = imin,imax
235     EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
236     & - fac*tmpfld3d(i,j,k,bi,bj)
237     & *maskS(i,j,k,bi,bj)
238     cph EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
239     cph & - rSphere*cosFacU(J,bi,bj)
240     cph & *fac*tmpfld3d(i,j,k,bi,bj)
241     enddo
242     enddo
243     enddo
244     enddo
245     enddo
246     #endif
247    
248     #ifdef ALLOW_EFLUXP0_CONTROL
249     c-- p-component EP-flux field.
250     il=ilnblnk( xx_efluxp_file )
251     write(fnameefluxp(1:80),'(2a,i10.10)')
252     & xx_efluxp_file(1:il),'.',optimcycle
253     call active_read_xyz( fnameefluxp, tmpfld3d, 1,
254     & doglobalread, ladinit, optimcycle,
255     & mythid, xx_efluxp_dummy )
256    
257     do bj = jtlo,jthi
258     do bi = itlo,ithi
259     do k = 1,nr
260     do j = jmin,jmax
261     do i = imin,imax
262     EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
263     & + fCori(i,j,bi,bj)
264     & *fac*tmpfld3d(i,j,k,bi,bj)
265     & *hFacV(i,j,k,bi,bj)
266     cph EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
267     cph & + fCori(i,j,bi,bj)
268     cph & *rSphere*cosFacU(J,bi,bj)
269     cph & *fac*tmpfld3d(i,j,k,bi,bj)
270     enddo
271     enddo
272     enddo
273     enddo
274     enddo
275     #endif
276    
277 heimbach 1.7 #ifdef ALLOW_BOTTOMDRAG_CONTROL
278     c-- bottom drag
279     il=ilnblnk( xx_bottomdrag_file )
280     write(fnamebottomdrag(1:80),'(2a,i10.10)')
281     & xx_bottomdrag_file(1:il),'.',optimcycle
282     call active_read_xy ( fnamebottomdrag, tmpfld2d, 1,
283     & doglobalread, ladinit, optimcycle,
284     & mythid, xx_bottomdrag_dummy )
285     do bj = jtlo,jthi
286     do bi = itlo,ithi
287     do j = jmin,jmax
288     do i = imin,imax
289     bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
290     & + tmpfld2d(i,j,bi,bj)
291     enddo
292     enddo
293     enddo
294     enddo
295     #endif
296    
297 heimbach 1.1
298     c-- Update the tile edges.
299    
300     #ifdef ALLOW_THETA0_CONTROL
301     _EXCH_XYZ_R8( theta, mythid )
302     #endif
303     #ifdef ALLOW_SALT0_CONTROL
304     _EXCH_XYZ_R8( salt, mythid )
305 heimbach 1.2 #endif
306     #ifdef ALLOW_TR10_CONTROL
307 heimbach 1.10 # if (defined (ALLOW_PASSIVE_TRACER))
308 heimbach 1.3 _EXCH_XYZ_R8( tr1, mythid )
309 heimbach 1.10 # elif (defined (ALLOW_PTRACERS))
310     _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid)
311     # endif
312 heimbach 1.1 #endif
313 heimbach 1.3 #ifdef ALLOW_DIFFKR_CONTROL
314     _EXCH_XYZ_R8( diffkr, mythid)
315     #endif
316     #ifdef ALLOW_KAPGM_CONTROL
317     _EXCH_XYZ_R8( kapgm, mythid)
318 heimbach 1.6 #endif
319     #ifdef ALLOW_EFLUXY0_CONTROL
320     _EXCH_XYZ_R8( EfluxY, mythid )
321     #endif
322     #ifdef ALLOW_EFLUXP0_CONTROL
323     _EXCH_XYZ_R8( EfluxP, mythid )
324 heimbach 1.7 #endif
325     #ifdef ALLOW_BOTTOMDRAG_CONTROL
326     _EXCH_XY_R8( bottomdragfld, mythid )
327 heimbach 1.3 #endif
328    
329 heimbach 1.1
330     return
331     end
332    

  ViewVC Help
Powered by ViewVC 1.1.22