/[MITgcm]/MITgcm/pkg/admtlm/admtlm_bypassad.F
ViewVC logotype

Contents of /MITgcm/pkg/admtlm/admtlm_bypassad.F

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


Revision 1.4 - (show annotations) (download)
Sun Aug 12 18:29:25 2012 UTC (11 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63r, checkpoint63s, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.3: +2 -2 lines
new option-file for this package, included in all *.F files

1 C $Header: /u/gcmpack/MITgcm/pkg/admtlm/admtlm_bypassad.F,v 1.3 2007/10/08 23:45:51 jmc Exp $
2 C $Name: $
3
4 #include "ADMTLM_OPTIONS.h"
5
6 subroutine admtlm_bypassad( myThid )
7 C /==========================================================\
8 C | subroutine admtlm_bypassad |
9 C | o This routine assigns final T,S to cost function |
10 C \==========================================================/
11 implicit none
12
13 C == Global variables ===
14 #include "SIZE.h"
15 #include "EEPARAMS.h"
16 #include "PARAMS.h"
17 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
18 # include "ctrl.h"
19 # include "ctrl_dummy.h"
20 # include "optim.h"
21 # include "adcost.h"
22 # include "g_cost.h"
23 # include "adcommon.h"
24 #endif
25
26 C ======== Routine arguments ======================
27 C myThid - Thread number for this instance of the routine.
28 integer myThid
29
30 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
31
32 C ========= Local variables =========================
33 integer i, j, k
34 integer bi, bj
35 integer imin, imax
36 integer jmin, jmax
37 integer itlo, ithi
38 integer jtlo, jthi
39 integer il
40
41 logical ladinit
42 logical doglobalread
43 logical equal
44 double precision fac
45 character*(80) fnamegeneric
46
47 C ==============================================
48 C declare external procedures and functions
49 C ==============================================
50 integer ilnblnk
51 external ilnblnk
52
53 C ===================================================
54
55 jtlo = mybylo(mythid)
56 jthi = mybyhi(mythid)
57 itlo = mybxlo(mythid)
58 ithi = mybxhi(mythid)
59 jmin = 1
60 jmax = sny
61 imin = 1
62 imax = snx
63 doglobalread = .false.
64 ladinit = .false.
65 equal = .true.
66 if (equal) then
67 fac = 1.d0
68 else
69 fac = 0.d0
70 endif
71
72 DO bj = jtlo, jthi
73 DO bi = itlo, ithi
74 DO j = jmin, jmax
75 DO i = imin, imax
76 DO k=1,Nr
77 adtheta(i,j,k,bi,bj) =
78 & g_objf_state_final(i,j,bi,bj,k)
79 adsalt(i,j,k,bi,bj) =
80 & g_objf_state_final(i,j,bi,bj,1*Nr+k)
81 aduvel(i,j,k,bi,bj) =
82 & g_objf_state_final(i,j,bi,bj,2*Nr+k)
83 advvel(i,j,k,bi,bj) =
84 & g_objf_state_final(i,j,bi,bj,3*Nr+k)
85 END DO
86 adetan(i,j,bi,bj) =
87 & g_objf_state_final(i,j,bi,bj,4*Nr+1)
88 END DO
89 END DO
90 END DO
91 END DO
92
93 c---------------------------------------------------------------------
94
95 do bj = jtlo, jthi
96 do bi = itlo, ithi
97 do j = jmin, jmax
98 do i = imin, imax
99 tmpfld2d(i,j,bi,bj) = tmpfld2d(i,j,bi,bj)
100 & + adetan(i,j,bi,bj)
101 end do
102 end do
103 end do
104 end do
105 il = ilnblnk(xx_etan_file)
106 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
107 & xx_etan_file(1:il),'.',optimcycle
108 call adactive_read_xy_loc( fnamegeneric,1,doglobalread,ladinit,
109 & optimcycle,mythid,tmpfld2d )
110 c--
111 do bj = jtlo, jthi
112 do bi = itlo, ithi
113 do k = 1, nr
114 do j = jmin, jmax
115 do i = imin, imax
116 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
117 & + advvel(i,j,k,bi,bj)
118 end do
119 end do
120 end do
121 end do
122 end do
123 il = ilnblnk(xx_vvel_file)
124 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
125 & xx_vvel_file(1:il),'.',optimcycle
126 call adactive_read_xyz( fnamegeneric,1,doglobalread,ladinit,
127 & optimcycle,mythid,tmpfld3d )
128 c--
129 do bj = jtlo, jthi
130 do bi = itlo, ithi
131 do k = 1, nr
132 do j = jmin, jmax
133 do i = imin, imax
134 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
135 & + aduvel(i,j,k,bi,bj)
136 end do
137 end do
138 end do
139 end do
140 end do
141 il = ilnblnk(xx_uvel_file)
142 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
143 & xx_uvel_file(1:il),'.',optimcycle
144 call adactive_read_xyz( fnamegeneric,1,doglobalread,ladinit,
145 & optimcycle,mythid,tmpfld3d )
146 c--
147 do bj = jtlo, jthi
148 do bi = itlo, ithi
149 do k = 1, nr
150 do j = jmin, jmax
151 do i = imin, imax
152 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
153 & + adsalt(i,j,k,bi,bj)*fac
154 end do
155 end do
156 end do
157 end do
158 end do
159 il = ilnblnk(xx_salt_file)
160 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
161 & xx_salt_file(1:il),'.',optimcycle
162 call adactive_read_xyz_loc( fnamegeneric,1,doglobalread,ladinit,
163 & optimcycle,mythid,tmpfld3d )
164 c--
165 do bj = jtlo, jthi
166 do bi = itlo, ithi
167 do k = 1, nr
168 do j = jmin, jmax
169 do i = imin, imax
170 tmpfld3d(i,j,k,bi,bj) = tmpfld3d(i,j,k,bi,bj)
171 & + adtheta(i,j,k,bi,bj)*fac
172 end do
173 end do
174 end do
175 end do
176 end do
177 il = ilnblnk(xx_theta_file)
178 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
179 & xx_theta_file(1:il),'.',optimcycle
180 call adactive_read_xyz_loc( fnamegeneric,1,doglobalread,ladinit,
181 & optimcycle,mythid,tmpfld3d )
182
183 #endif
184
185 end

  ViewVC Help
Powered by ViewVC 1.1.22