/[MITgcm]/MITgcm/pkg/dic/dic_set_control.F
ViewVC logotype

Contents of /MITgcm/pkg/dic/dic_set_control.F

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


Revision 1.4 - (show annotations) (download)
Thu Oct 15 23:28:43 2009 UTC (14 years, 7 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62d, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.3: +2 -2 lines
Use a version of active_file for which TLM works.

1 C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_set_control.F,v 1.3 2009/10/15 05:23:22 heimbach Exp $
2 C $Name: $
3
4 #include "DIC_OPTIONS.h"
5
6 cphc$taf common DIC_XX adname = addic_xx
7 cphc$taf common DIC_COST_CTRL adname = ADDIC_COST_CTRL
8
9
10 C !INTERFACE: ==========================================================
11 subroutine dic_set_control( myThid )
12
13 C !DESCRIPTION:
14
15 C !USES: ===============================================================
16 implicit none
17
18 C == GLobal variables ==
19 #include "SIZE.h"
20 #include "EEPARAMS.h"
21 #include "PARAMS.h"
22 #ifdef DIC_BIOTIC
23 # include "DIC_VARS.h"
24 # include "DIC_DIAGS.h"
25 # include "DIC_CTRL.h"
26 #endif
27 #ifdef ALLOW_CTRL
28 #include "ctrl.h"
29 #include "ctrl_dummy.h"
30 #include "optim.h"
31 #endif
32 C == Routine arguments ==
33 _RL fac
34 INTEGER myThid
35
36 cph#ifdef DIC_BIOTIC
37 C == Local arguments ==
38 INTEGER bi, bj
39 INTEGER i, j
40 integer il
41 logical doglobalread
42 logical ladinit
43 logical equal
44 character*( 80) fnamegen2d
45 c == external ==
46 integer ilnblnk
47 external ilnblnk
48
49 c == end of interface ==
50 CEOP
51 #ifdef ALLOW_CTRL
52
53 doglobalread = .false.
54 ladinit = .false.
55
56 equal = .true.
57
58 if ( equal ) then
59 fac = 1. _d 0
60 else
61 fac = 0. _d 0
62 endif
63
64 print*,'QQ alpha before', alpha(20,10,1,1)
65
66 #ifdef ALLOW_GEN2D_CONTROL
67 il=ilnblnk( xx_gen2d_file )
68 write(fnamegen2d(1:80),'(2a,i10.10)')
69 & xx_gen2d_file(1:il),'.',optimcycle
70 call active_read_xy( fnamegen2d, tmpfld2d, 1,
71 & doglobalread, ladinit, optimcycle,
72 & mythid, xx_gen2d_dummy )
73
74 DO bj=myByLo(myThid),myByHi(myThid)
75 DO bi=myBxLo(myThid),myBxHi(myThid)
76 do i = 1, sNx
77 do j = 1, sNy
78 alpha (i,j,bi,bj) = alpha(i,j,bi,bj) +
79 & fac*tmpfld2d(i,j,bi,bj)
80 end do
81 end do
82 end do
83 end do
84 cswd -- QQ limits!
85 cph if (alpha(i,j,bi,bj).gt.alphamax) then
86 cph alpha(i,j,bi,bj)=alphamax
87 cph endif
88 cph if (alpha(i,j,bi,bj).lt.alphamin) then
89 cph alpha(i,j,bi,bj)=alphamin
90 cph endif
91 cswd -- QQ limits
92 print*,'QQ - preturb alpha', alpha(20,10,1,1),
93 & tmpfld2d(20,10,1,1)
94 #endif
95
96 #ifdef ALLOW_DIC_CONTROL
97
98 DO bj=myByLo(myThid),myByHi(myThid)
99 DO bi=myBxLo(myThid),myBxHi(myThid)
100 do i = 1, sNx
101 do j = 1, sNy
102 feload(i,j,bi,bj) = feload(i,j,bi,bj)*(1.+xx_dic(1))
103 rain_ratio(i,j,bi,bj) =
104 & rain_ratio(i,j,bi,bj)*(1.+xx_dic(2))
105 end do
106 end do
107 end do
108 end do
109
110 _EXCH_XY_RL( alpha, mythid )
111 _EXCH_XY_RL( rain_ratio, mythid )
112 _EXCH_XY_RL( feload, mythid )
113
114 KScav = KScav * (1.+1.e+6*xx_dic(3))
115 ligand_stab = ligand_stab * (1.+1.e+6*xx_dic(4))
116 ligand_tot = ligand_tot * (1.+1.e+6*xx_dic(5))
117
118 print *,'COST KScav = ', KScav
119 print *,'COST ligand_stab = ', ligand_stab
120 print *,'COST ligand_tot = ', ligand_tot
121
122 #endif
123
124 #endif
125
126 cph#endif /* DIC_BIOTIC */
127
128 end

  ViewVC Help
Powered by ViewVC 1.1.22