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

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

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

Revision 1.2 - (hide annotations) (download)
Thu Apr 27 12:49:02 2006 UTC (18 years, 1 month 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 heimbach 1.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 heimbach 1.2 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
16 heimbach 1.1 # 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 heimbach 1.2 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
29 heimbach 1.1
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