/[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.2 - (show annotations) (download)
Thu Apr 27 12:49:02 2006 UTC (18 years ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59h, checkpoint59, checkpoint58f_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58m_post
Changes since 1.1: +2 -2 lines
o crucial fix to properly initialise ARPACK using field RESID
  (Laure Zanna)
o added code to output NCONV eigenvectors to evxx_...
  (suppress vector I/O for now)

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

  ViewVC Help
Powered by ViewVC 1.1.22