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

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

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


Revision 1.2 - (show annotations) (download)
Fri Jul 13 13:40:17 2001 UTC (22 years, 10 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint40pre3, checkpoint40pre2, checkpoint40pre4, checkpoint40pre5
Changes since 1.1: +1 -0 lines
o Added prototype routines to handle optimization
o Extended control vector to add passive tracer

1
2 #include "CTRL_CPPOPTIONS.h"
3
4 SUBROUTINE CTRL_MAP_FORCING(myThid)
5 C /==========================================================\
6 C | SUBROUTINE CTRL_MAP_FORCING |
7 C |==========================================================|
8 C \==========================================================/
9 IMPLICIT NONE
10
11 C == Global variables ===
12 #include "SIZE.h"
13 #include "EEPARAMS.h"
14 #include "PARAMS.h"
15 #include "FFIELDS.h"
16 #include "GRID.h"
17
18 #include "ctrl.h"
19 #include "ctrl_dummy.h"
20 #include "optim.h"
21
22 C == Routine arguments ==
23 C myThid - Thread number for this instance of the routine.
24 INTEGER myThid
25
26 C == Local variables ==
27 integer bi,bj
28 integer i,j,k
29 integer itlo,ithi
30 integer jtlo,jthi
31 integer jmin,jmax
32 integer imin,imax
33 integer il
34
35 logical equal
36 logical doglobalread
37 logical ladinit
38
39 character*( 80) fnametauu
40 character*( 80) fnametauv
41 character*( 80) fnamesflux
42 character*( 80) fnamehflux
43 character*( 80) fnamesss
44 character*( 80) fnamesst
45 character*( 80) fnamediffkr
46 character*( 80) fnamekapgm
47
48 c == external ==
49
50 integer ilnblnk
51 external ilnblnk
52
53 c == end of interface ==
54
55 jtlo = mybylo(mythid)
56 jthi = mybyhi(mythid)
57 itlo = mybxlo(mythid)
58 ithi = mybxhi(mythid)
59 jmin = 1-oly
60 jmax = sny+oly
61 imin = 1-olx
62 imax = snx+olx
63
64 doglobalread = .false.
65 ladinit = .false.
66
67 #ifdef ALLOW_TAUU0_CONTROL
68 c-- tauu0.
69 il=ilnblnk( xx_tauu_file )
70 write(fnametauu(1:80),'(2a,i10.10)')
71 & xx_tauu_file(1:il),'.',optimcycle
72 call active_read_xy ( fnametauu, tmpfld2d, 1,
73 & doglobalread, ladinit, optimcycle,
74 & mythid, xx_tauu_dummy )
75 do bj = jtlo,jthi
76 do bi = itlo,ithi
77 do j = jmin,jmax
78 do i = imin,imax
79 fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
80 enddo
81 enddo
82 enddo
83 enddo
84 #endif
85
86 #ifdef ALLOW_TAUV0_CONTROL
87 c-- tauv0.
88 il=ilnblnk( xx_tauv_file )
89 write(fnametauv(1:80),'(2a,i10.10)')
90 & xx_tauv_file(1:il),'.',optimcycle
91 call active_read_xy ( fnametauv, tmpfld2d, 1,
92 & doglobalread, ladinit, optimcycle,
93 & mythid, xx_tauv_dummy )
94 do bj = jtlo,jthi
95 do bi = itlo,ithi
96 do j = jmin,jmax
97 do i = imin,imax
98 fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
99 enddo
100 enddo
101 enddo
102 enddo
103 #endif
104
105 #ifdef ALLOW_SFLUX0_CONTROL
106 c-- sflux0.
107 il=ilnblnk( xx_sflux_file )
108 write(fnamesflux(1:80),'(2a,i10.10)')
109 & xx_sflux_file(1:il),'.',optimcycle
110 call active_read_xy ( fnamesflux, tmpfld2d, 1,
111 & doglobalread, ladinit, optimcycle,
112 & mythid, xx_sflux_dummy )
113 do bj = jtlo,jthi
114 do bi = itlo,ithi
115 do j = jmin,jmax
116 do i = imin,imax
117 empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
118 enddo
119 enddo
120 enddo
121 enddo
122 #endif
123
124 #ifdef ALLOW_HFLUX0_CONTROL
125 c-- hflux0.
126 il=ilnblnk( xx_hflux_file )
127 write(fnamehflux(1:80),'(2a,i10.10)')
128 & xx_hflux_file(1:il),'.',optimcycle
129 call active_read_xy ( fnamehflux, tmpfld2d, 1,
130 & doglobalread, ladinit, optimcycle,
131 & mythid, xx_hflux_dummy )
132 do bj = jtlo,jthi
133 do bi = itlo,ithi
134 do j = jmin,jmax
135 do i = imin,imax
136 qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
137 enddo
138 enddo
139 enddo
140 enddo
141 #endif
142
143 #ifdef ALLOW_SSS0_CONTROL
144 c-- sss0.
145 il=ilnblnk( xx_sss_file )
146 write(fnamesss(1:80),'(2a,i10.10)')
147 & xx_sss_file(1:il),'.',optimcycle
148 call active_read_xy ( fnamesss, tmpfld2d, 1,
149 & doglobalread, ladinit, optimcycle,
150 & mythid, xx_sss_dummy )
151 do bj = jtlo,jthi
152 do bi = itlo,ithi
153 do j = jmin,jmax
154 do i = imin,imax
155 sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
156 enddo
157 enddo
158 enddo
159 enddo
160 #endif
161
162 #ifdef ALLOW_SST0_CONTROL
163 c-- sst0.
164 il=ilnblnk( xx_sst_file )
165 write(fnamesst(1:80),'(2a,i10.10)')
166 & xx_sst_file(1:il),'.',optimcycle
167 call active_read_xy ( fnamesst, tmpfld2d, 1,
168 & doglobalread, ladinit, optimcycle,
169 & mythid, xx_sst_dummy )
170 do bj = jtlo,jthi
171 do bi = itlo,ithi
172 do j = jmin,jmax
173 do i = imin,imax
174 sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
175 enddo
176 enddo
177 enddo
178 enddo
179 #endif
180
181 #ifdef ALLOW_DIFFKR_CONTROL
182 c-- diffkr.
183 il=ilnblnk( xx_diffkr_file )
184 write(fnamediffkr(1:80),'(2a,i10.10)')
185 & xx_diffkr_file(1:il),'.',optimcycle
186 call active_read_xyz( fnamediffkr, tmpfld3d, 1,
187 & doglobalread, ladinit, optimcycle,
188 & mythid, xx_diffkr_dummy )
189 do bj = jtlo,jthi
190 do bi = itlo,ithi
191 do k = 1,nr
192 do j = jmin,jmax
193 do i = imin,imax
194 diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
195 & tmpfld3d(i,j,k,bi,bj)
196 enddo
197 enddo
198 enddo
199 enddo
200 enddo
201 #endif
202
203 #ifdef ALLOW_KAPGM_CONTROL
204 c-- kapgm.
205 il=ilnblnk( xx_kapgm_file )
206 write(fnamekapgm(1:80),'(2a,i10.10)')
207 & xx_kapgm_file(1:il),'.',optimcycle
208 call active_read_xyz( fnamekapgm, tmpfld3d, 1,
209 & doglobalread, ladinit, optimcycle,
210 & mythid, xx_kapgm_dummy )
211 do bj = jtlo,jthi
212 do bi = itlo,ithi
213 do k = 1,nr
214 do j = jmin,jmax
215 do i = imin,imax
216 kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
217 & tmpfld3d(i,j,k,bi,bj)
218 enddo
219 enddo
220 enddo
221 enddo
222 enddo
223 #endif
224
225 END

  ViewVC Help
Powered by ViewVC 1.1.22