/[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.3 - (hide annotations) (download)
Mon Oct 8 23:45:51 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63p, checkpoint63q, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59k, checkpoint59j, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.2: +16 -14 lines 
add missing cvs $Header:$ or $Name:$
1 jmc 1.3 C $Header: $
2     C $Name: $
3 heimbach 1.1
4     #include "CPP_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 heimbach 1.2 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
18 heimbach 1.1 # 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 heimbach 1.2 #if (defined (ALLOW_ADMTLM) && defined (ALLOW_BYPASSAD))
31 heimbach 1.1
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 jmc 1.3 doglobalread = .false.
64     ladinit = .false.
65     equal = .true.
66 heimbach 1.1 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 jmc 1.3 adtheta(i,j,k,bi,bj) =
78 heimbach 1.1 & g_objf_state_final(i,j,bi,bj,k)
79 jmc 1.3 adsalt(i,j,k,bi,bj) =
80 heimbach 1.1 & g_objf_state_final(i,j,bi,bj,1*Nr+k)
81 jmc 1.3 aduvel(i,j,k,bi,bj) =
82 heimbach 1.1 & g_objf_state_final(i,j,bi,bj,2*Nr+k)
83 jmc 1.3 advvel(i,j,k,bi,bj) =
84 heimbach 1.1 & g_objf_state_final(i,j,bi,bj,3*Nr+k)
85     END DO
86 jmc 1.3 adetan(i,j,bi,bj) =
87 heimbach 1.1 & 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 jmc 1.3 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
107 heimbach 1.1 & 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 jmc 1.3 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
125 heimbach 1.1 & 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 jmc 1.3 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
143 heimbach 1.1 & 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 jmc 1.3 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
161 heimbach 1.1 & 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 jmc 1.3 write(unit=fnamegeneric(1:80),fmt='(2a,i10.10)')
179 heimbach 1.1 & xx_theta_file(1:il),'.',optimcycle
180     call adactive_read_xyz_loc( fnamegeneric,1,doglobalread,ladinit,
181     & optimcycle,mythid,tmpfld3d )
182    
183     #endif
184 jmc 1.3
185 heimbach 1.1 end
  ViewVC Help
Powered by ViewVC 1.1.22