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

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

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


Revision 1.27 - (show annotations) (download)
Mon Nov 5 18:56:37 2007 UTC (17 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59m, checkpoint59l, checkpoint59k, checkpoint59j
Changes since 1.26: +3 -2 lines
split PTRACERS.h in 2 header files: PTRACERS_FIELDS.h & PTRACERS_PARAMS.h

1 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.26 2007/10/30 20:19:13 heimbach Exp $
2 C $Name: $
3
4 #include "CTRL_CPPOPTIONS.h"
5
6 CBOP
7 C !ROUTINE: ctrl_map_ini
8 C !INTERFACE:
9 subroutine ctrl_map_ini( mythid )
10
11 C !DESCRIPTION: \bv
12 c *=================================================================
13 c | SUBROUTINE ctrl_map_ini
14 c | Add the temperature, salinity, and diffusivity parts of the
15 c | control vector to the model state and update the tile halos.
16 c | The control vector is defined in the header file "ctrl.h".
17 c *=================================================================
18 C \ev
19
20 C !USES:
21 implicit none
22
23 c == global variables ==
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "GRID.h"
28 #include "DYNVARS.h"
29 #include "FFIELDS.h"
30 #include "ctrl.h"
31 #include "ctrl_dummy.h"
32 #include "optim.h"
33 #ifdef ALLOW_PTRACERS
34 # include "PTRACERS_SIZE.h"
35 c#include "PTRACERS_PARAMS.h"
36 # include "PTRACERS_FIELDS.h"
37 #endif
38 #ifdef ALLOW_ECCO
39 # include "ecco_cost.h"
40 #endif
41
42 C !INPUT/OUTPUT PARAMETERS:
43 c == routine arguments ==
44 integer mythid
45
46 C !LOCAL VARIABLES:
47 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) fnamegeneric
62
63 _RL fac
64 _RL tmptest
65
66 c == external ==
67 integer ilnblnk
68 external ilnblnk
69
70 c == end of interface ==
71 CEOP
72
73 jtlo = mybylo(mythid)
74 jthi = mybyhi(mythid)
75 itlo = mybxlo(mythid)
76 ithi = mybxhi(mythid)
77 jmin = 1
78 jmax = sny
79 imin = 1
80 imax = snx
81
82 doglobalread = .false.
83 ladinit = .false.
84
85 equal = .true.
86
87 if ( equal ) then
88 fac = 1. _d 0
89 else
90 fac = 0. _d 0
91 endif
92
93 #ifdef ALLOW_THETA0_CONTROL
94 c-- Temperature field.
95 il=ilnblnk( xx_theta_file )
96 write(fnamegeneric(1:80),'(2a,i10.10)')
97 & xx_theta_file(1:il),'.',optimcycle
98 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
99 & doglobalread, ladinit, optimcycle,
100 & mythid, xx_theta_dummy )
101
102 do bj = jtlo,jthi
103 do bi = itlo,ithi
104 do k = 1,nr
105 do j = jmin,jmax
106 do i = imin,imax
107 #ifdef ALLOW_ECCO
108 IF (abs(tmpfld3d(i,j,k,bi,bj)).gt.
109 $ 2.0/sqrt(wtheta(k,bi,bj)))
110 $ tmpfld3d(i,j,k,bi,bj)=
111 $ sign(2.0/sqrt(wtheta(k,bi,bj)),tmpfld3d(i,j,k,bi,bj))
112 #endif
113 #ifdef ALLOW_AUTODIFF_OPENAD
114 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
115 & fac*xx_theta(i,j,k,bi,bj) +
116 & fac*tmpfld3d(i,j,k,bi,bj)
117 #else
118 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
119 & fac*tmpfld3d(i,j,k,bi,bj)
120 #endif
121 #ifndef DISABLE_CTRL_THETA_LIMIT
122 if(theta(i,j,k,bi,bj).lt.-2.0)
123 & theta(i,j,k,bi,bj)= -2.0
124 #endif
125 enddo
126 enddo
127 enddo
128 enddo
129 enddo
130
131 #endif
132
133 #ifdef ALLOW_SALT0_CONTROL
134 c-- Temperature field.
135 il=ilnblnk( xx_salt_file )
136 write(fnamegeneric(1:80),'(2a,i10.10)')
137 & xx_salt_file(1:il),'.',optimcycle
138 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
139 & doglobalread, ladinit, optimcycle,
140 & mythid, xx_salt_dummy )
141
142 do bj = jtlo,jthi
143 do bi = itlo,ithi
144 do k = 1,nr
145 do j = jmin,jmax
146 do i = imin,imax
147 #ifdef ALLOW_ECCO
148 IF (abs(tmpfld3d(i,j,k,bi,bj)).gt.
149 $ 2.0/sqrt(wsalt(k,bi,bj)))
150 $ tmpfld3d(i,j,k,bi,bj)=
151 $ sign(2.0/sqrt(wsalt(k,bi,bj)),tmpfld3d(i,j,k,bi,bj))
152 #endif
153 #ifdef ALLOW_AUTODIFF_OPENAD
154 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
155 & fac*xx_salt(i,j,k,bi,bj) +
156 & fac*tmpfld3d(i,j,k,bi,bj)
157 #else
158 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
159 & fac*tmpfld3d(i,j,k,bi,bj)
160 #endif
161
162 enddo
163 enddo
164 enddo
165 enddo
166 enddO
167 #endif
168
169 #ifdef ALLOW_TR10_CONTROL
170 #ifdef ALLOW_PTRACERS
171 c-- Temperature field.
172 il=ilnblnk( xx_tr1_file )
173 write(fnamegeneric(1:80),'(2a,i10.10)')
174 & xx_tr1_file(1:il),'.',optimcycle
175 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
176 & doglobalread, ladinit, optimcycle,
177 & mythid, xx_tr1_dummy )
178
179 do bj = jtlo,jthi
180 do bi = itlo,ithi
181 do k = 1,nr
182 do j = jmin,jmax
183 do i = imin,imax
184 ptracer(i,j,k,bi,bj,1) = ptracer(i,j,k,bi,bj,1) +
185 & fac*tmpfld3d(i,j,k,bi,bj)
186 enddo
187 enddo
188 enddo
189 enddo
190 enddo
191 #endif
192 #endif
193
194 #ifdef ALLOW_SST0_CONTROL
195 c-- sst0.
196 il=ilnblnk( xx_sst_file )
197 write(fnamegeneric(1:80),'(2a,i10.10)')
198 & xx_sst_file(1:il),'.',optimcycle
199 call active_read_xy ( fnamegeneric, tmpfld2d, 1,
200 & doglobalread, ladinit, optimcycle,
201 & mythid, xx_sst_dummy )
202 do bj = jtlo,jthi
203 do bi = itlo,ithi
204 do j = jmin,jmax
205 do i = imin,imax
206 cph sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
207 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
208 & + tmpfld2d(i,j,bi,bj)
209 enddo
210 enddo
211 enddo
212 enddo
213 #endif
214
215 #ifdef ALLOW_SSS0_CONTROL
216 c-- sss0.
217 il=ilnblnk( xx_sss_file )
218 write(fnamegeneric(1:80),'(2a,i10.10)')
219 & xx_sss_file(1:il),'.',optimcycle
220 call active_read_xy ( fnamegeneric, tmpfld2d, 1,
221 & doglobalread, ladinit, optimcycle,
222 & mythid, xx_sss_dummy )
223 do bj = jtlo,jthi
224 do bi = itlo,ithi
225 do j = jmin,jmax
226 do i = imin,imax
227 cph sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
228 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
229 & + tmpfld2d(i,j,bi,bj)
230 enddo
231 enddo
232 enddo
233 enddo
234 #endif
235
236 #ifdef ALLOW_DIFFKR_CONTROL
237 c-- diffkr.
238 il=ilnblnk( xx_diffkr_file )
239 write(fnamegeneric(1:80),'(2a,i10.10)')
240 & xx_diffkr_file(1:il),'.',optimcycle
241 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
242 & doglobalread, ladinit, optimcycle,
243 & mythid, xx_diffkr_dummy )
244 do bj = jtlo,jthi
245 do bi = itlo,ithi
246 do k = 1,nr
247 do j = jmin,jmax
248 do i = imin,imax
249 diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
250 & tmpfld3d(i,j,k,bi,bj)
251 enddo
252 enddo
253 enddo
254 enddo
255 enddo
256 #endif
257
258 #ifdef ALLOW_KAPGM_CONTROL
259 c-- kapgm.
260 il=ilnblnk( xx_kapgm_file )
261 write(fnamegeneric(1:80),'(2a,i10.10)')
262 & xx_kapgm_file(1:il),'.',optimcycle
263 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
264 & doglobalread, ladinit, optimcycle,
265 & mythid, xx_kapgm_dummy )
266 do bj = jtlo,jthi
267 do bi = itlo,ithi
268 do k = 1,nr
269 do j = jmin,jmax
270 do i = imin,imax
271 kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
272 & tmpfld3d(i,j,k,bi,bj)
273 enddo
274 enddo
275 enddo
276 enddo
277 enddo
278 #endif
279
280 #ifdef ALLOW_EFLUXY0_CONTROL
281 c-- y-component EP-flux field.
282 il=ilnblnk( xx_efluxy_file )
283 write(fnamegeneric(1:80),'(2a,i10.10)')
284 & xx_efluxy_file(1:il),'.',optimcycle
285 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
286 & doglobalread, ladinit, optimcycle,
287 & mythid, xx_efluxy_dummy )
288
289 do bj = jtlo,jthi
290 do bi = itlo,ithi
291 do k = 1,nr
292 do j = jmin,jmax
293 do i = imin,imax
294 EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
295 & - fac*tmpfld3d(i,j,k,bi,bj)
296 & *maskS(i,j,k,bi,bj)
297 cph EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
298 cph & - rSphere*cosFacU(J,bi,bj)
299 cph & *fac*tmpfld3d(i,j,k,bi,bj)
300 enddo
301 enddo
302 enddo
303 enddo
304 enddo
305 #endif
306
307 #ifdef ALLOW_EFLUXP0_CONTROL
308 c-- p-component EP-flux field.
309 il=ilnblnk( xx_efluxp_file )
310 write(fnamegeneric(1:80),'(2a,i10.10)')
311 & xx_efluxp_file(1:il),'.',optimcycle
312 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
313 & doglobalread, ladinit, optimcycle,
314 & mythid, xx_efluxp_dummy )
315
316 do bj = jtlo,jthi
317 do bi = itlo,ithi
318 do k = 1,nr
319 do j = jmin,jmax
320 do i = imin,imax
321 EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
322 & + fCori(i,j,bi,bj)
323 & *fac*tmpfld3d(i,j,k,bi,bj)
324 & *hFacV(i,j,k,bi,bj)
325 cph EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
326 cph & + fCori(i,j,bi,bj)
327 cph & *rSphere*cosFacU(J,bi,bj)
328 cph & *fac*tmpfld3d(i,j,k,bi,bj)
329 enddo
330 enddo
331 enddo
332 enddo
333 enddo
334 #endif
335
336 #ifdef ALLOW_BOTTOMDRAG_CONTROL
337 c-- bottom drag
338 il=ilnblnk( xx_bottomdrag_file )
339 write(fnamegeneric(1:80),'(2a,i10.10)')
340 & xx_bottomdrag_file(1:il),'.',optimcycle
341 call active_read_xy ( fnamegeneric, tmpfld2d, 1,
342 & doglobalread, ladinit, optimcycle,
343 & mythid, xx_bottomdrag_dummy )
344 do bj = jtlo,jthi
345 do bi = itlo,ithi
346 do j = jmin,jmax
347 do i = imin,imax
348 bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
349 & + tmpfld2d(i,j,bi,bj)
350 enddo
351 enddo
352 enddo
353 enddo
354 #endif
355
356 #ifdef ALLOW_EDTAUX_CONTROL
357 c-- zonal eddy stress : edtaux
358 il=ilnblnk( xx_edtaux_file )
359 write(fnamegeneric(1:80),'(2a,i10.10)')
360 & xx_edtaux_file(1:il),'.',optimcycle
361 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
362 & doglobalread, ladinit, optimcycle,
363 & mythid, xx_edtaux_dummy )
364 do bj = jtlo,jthi
365 do bi = itlo,ithi
366 do k = 1,nr
367 do j = jmin,jmax
368 do i = imin,imax
369 eddyTauX(i,j,k,bi,bj) = eddyTauX(i,j,k,bi,bj) +
370 & fCori(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj)
371 enddo
372 enddo
373 enddo
374 enddo
375 enddo
376 #endif
377
378 #ifdef ALLOW_EDTAUY_CONTROL
379 c-- meridional eddy stress : edtauy
380 il=ilnblnk( xx_edtauy_file )
381 write(fnamegeneric(1:80),'(2a,i10.10)')
382 & xx_edtauy_file(1:il),'.',optimcycle
383 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
384 & doglobalread, ladinit, optimcycle,
385 & mythid, xx_edtauy_dummy )
386 do bj = jtlo,jthi
387 do bi = itlo,ithi
388 do k = 1,nr
389 do j = jmin,jmax
390 do i = imin,imax
391 eddyTauY(i,j,k,bi,bj) = eddyTauY(i,j,k,bi,bj) +
392 & fCoriG(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj)
393 enddo
394 enddo
395 enddo
396 enddo
397 enddo
398 #endif
399
400 #ifdef ALLOW_UVEL0_CONTROL
401 c-- initial zonal velocity
402 il=ilnblnk( xx_uvel_file )
403 write(fnamegeneric(1:80),'(2a,i10.10)')
404 & xx_uvel_file(1:il),'.',optimcycle
405 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
406 & doglobalread, ladinit, optimcycle,
407 & mythid, xx_uvel_dummy )
408 do bj = jtlo,jthi
409 do bi = itlo,ithi
410 do k = 1,nr
411 do j = jmin,jmax
412 do i = imin,imax
413 #ifdef ALLOW_AUTODIFF_OPENAD
414 uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
415 & fac*xx_uvel(i,j,k,bi,bj)
416 #else
417 uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
418 & fac*tmpfld3d(i,j,k,bi,bj)
419 #endif
420 enddo
421 enddo
422 enddo
423 enddo
424 enddo
425 #endif
426
427 #ifdef ALLOW_VVEL0_CONTROL
428 c-- initial merid. velocity
429 il=ilnblnk( xx_vvel_file )
430 write(fnamegeneric(1:80),'(2a,i10.10)')
431 & xx_vvel_file(1:il),'.',optimcycle
432 call active_read_xyz( fnamegeneric, tmpfld3d, 1,
433 & doglobalread, ladinit, optimcycle,
434 & mythid, xx_vvel_dummy )
435 do bj = jtlo,jthi
436 do bi = itlo,ithi
437 do k = 1,nr
438 do j = jmin,jmax
439 do i = imin,imax
440 #ifdef ALLOW_AUTODIFF_OPENAD
441 vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
442 & fac*xx_vvel(i,j,k,bi,bj)
443 #else
444 vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
445 & fac*tmpfld3d(i,j,k,bi,bj)
446 #endif
447 enddo
448 enddo
449 enddo
450 enddo
451 enddo
452 #endif
453
454 #ifdef ALLOW_ETAN0_CONTROL
455 c-- initial Eta.
456 il=ilnblnk( xx_etan_file )
457 write(fnamegeneric(1:80),'(2a,i10.10)')
458 & xx_etan_file(1:il),'.',optimcycle
459 call active_read_xy ( fnamegeneric, tmpfld2d, 1,
460 & doglobalread, ladinit, optimcycle,
461 & mythid, xx_etan_dummy )
462 do bj = jtlo,jthi
463 do bi = itlo,ithi
464 do j = jmin,jmax
465 do i = imin,imax
466 #ifdef ALLOW_AUTODIFF_OPENAD
467 etaN(i,j,bi,bj) = etaN(i,j,bi,bj) +
468 & fac*xx_etan(i,j,bi,bj)
469 #else
470 etaN(i,j,bi,bj) = etaN(i,j,bi,bj) +
471 & fac*tmpfld2d(i,j,bi,bj)
472 #endif
473 enddo
474 enddo
475 enddo
476 enddo
477 #endif
478
479 #ifdef ALLOW_RELAXSST_CONTROL
480 c-- SST relaxation coefficient.
481 il=ilnblnk( xx_relaxsst_file )
482 write(fnamegeneric(1:80),'(2a,i10.10)')
483 & xx_relaxsst_file(1:il),'.',optimcycle
484 call active_read_xy ( fnamegeneric, tmpfld2d, 1,
485 & doglobalread, ladinit, optimcycle,
486 & mythid, xx_relaxsst_dummy )
487 do bj = jtlo,jthi
488 do bi = itlo,ithi
489 do j = jmin,jmax
490 do i = imin,imax
491 lambdaThetaClimRelax(i,j,bi,bj) =
492 & lambdaThetaClimRelax(i,j,bi,bj)
493 & + tmpfld2d(i,j,bi,bj)
494 enddo
495 enddo
496 enddo
497 enddo
498 #endif
499
500 #ifdef ALLOW_RELAXSSS_CONTROL
501 c-- SSS relaxation coefficient.
502 il=ilnblnk( xx_relaxsss_file )
503 write(fnamegeneric(1:80),'(2a,i10.10)')
504 & xx_relaxsss_file(1:il),'.',optimcycle
505 call active_read_xy ( fnamegeneric, tmpfld2d, 1,
506 & doglobalread, ladinit, optimcycle,
507 & mythid, xx_relaxsss_dummy )
508 do bj = jtlo,jthi
509 do bi = itlo,ithi
510 do j = jmin,jmax
511 do i = imin,imax
512 lambdaSaltClimRelax(i,j,bi,bj) =
513 & lambdaSaltClimRelax(i,j,bi,bj)
514 & + tmpfld2d(i,j,bi,bj)
515 enddo
516 enddo
517 enddo
518 enddo
519 #endif
520
521 #ifdef ALLOW_SEAICE
522 call seaice_ctrl_map_ini( mythid )
523 #endif
524
525 c-- Update the tile edges.
526
527 #if (defined (ALLOW_THETA0_CONTROL) || defined (ALLOW_SST0_CONTROL))
528 _EXCH_XYZ_R8( theta, mythid )
529 #endif
530 #if (defined (ALLOW_SALT0_CONTROL) || defined (ALLOW_SSS0_CONTROL))
531 _EXCH_XYZ_R8( salt, mythid )
532 #endif
533 #ifdef ALLOW_TR10_CONTROL
534 #ifdef ALLOW_PTRACERS
535 _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid)
536 #endif
537 #endif
538 #ifdef ALLOW_DIFFKR_CONTROL
539 _EXCH_XYZ_R8( diffkr, mythid)
540 #endif
541 #ifdef ALLOW_KAPGM_CONTROL
542 _EXCH_XYZ_R8( kapgm, mythid)
543 #endif
544 #ifdef ALLOW_EFLUXY0_CONTROL
545 _EXCH_XYZ_R8( EfluxY, mythid )
546 #endif
547 #ifdef ALLOW_EFLUXP0_CONTROL
548 _EXCH_XYZ_R8( EfluxP, mythid )
549 #endif
550 #ifdef ALLOW_BOTTOMDRAG_CONTROL
551 _EXCH_XY_R8( bottomdragfld, mythid )
552 #endif
553
554 #if (defined (ALLOW_EDTAUX_CONTROL) && defined (ALLOW_EDTAUY_CONTROL))
555 CALL EXCH_UV_XYZ_RS(eddyTauX,eddyTauY,.TRUE.,myThid)
556 #elif (defined (ALLOW_EDTAUX_CONTROL) || defined (ALLOW_EDTAUY_CONTROL))
557 STOP 'ctrl_map_forcing: need BOTH ALLOW_EDTAU[X,Y]_CONTROL'
558 #endif
559
560 #ifdef ALLOW_UVEL0_CONTROL
561 _EXCH_XYZ_R8( uVel, mythid)
562 #endif
563
564 #ifdef ALLOW_VVEL0_CONTROL
565 _EXCH_XYZ_R8( vVel, mythid)
566 #endif
567
568 #ifdef ALLOW_ETAN0_CONTROL
569 _EXCH_XY_R8( etaN, mythid )
570 #endif
571
572 #ifdef ALLOW_RELAXSST_CONTROL
573 _EXCH_XY_R4( lambdaThetaClimRelax, mythid )
574 #endif
575
576 #ifdef ALLOW_RELAXSSS_CONTROL
577 _EXCH_XY_R4( lambdaThetaClimRelax, mythid )
578 #endif
579
580 return
581 end
582

  ViewVC Help
Powered by ViewVC 1.1.22