pkg/ecco/cost_driftw.F

C $Header:  $
C $Name:  $

#include "COST_CPPOPTIONS.h"


      subroutine cost_driftw(
     I                       myiter,
     I                       mytime,
     I                       mythid
     &                     )

c     ==================================================================
c     SUBROUTINE cost_Driftw
c     ==================================================================
c
c     o Evaluate cost function contribution of the w difference
c       between the first and the last year.
c
c     started: from cost_drift
c
c     Armin Koehl  akoehl@ucsd.edu  26-Feb-2002
c
c     ==================================================================
c     SUBROUTINE cost_Driftw
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "DYNVARS.h"

#include "cal.h"
#include "ecco_cost.h"
#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"

c     == routine arguments ==

      integer myiter
      _RL     mytime
      integer mythid

c     == local variables ==

      _RS        one_rs
      parameter( one_rs = 1. )

      integer bi,bj
      integer i,j,k
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer irec
      integer ilw
      integer nf, nl

      _RL fctilew
      _RL fcthread_wdrift

      character*(80) fnamew

      logical doglobalread
      logical ladinit

      character*(MAX_LEN_MBUF) msgbuf

c     == external functions ==

      integer  ilnblnk
      external ilnblnk

c     == end of interface ==

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)
      jmin = 1
      jmax = sny
      imin = 1
      imax = snx

c--   Read tiled data.
      doglobalread = .false.
      ladinit      = .false.

#ifdef ALLOW_DRIFTW_COST_CONTRIBUTION

      if (optimcycle .ge. 0) then
        ilw = ilnblnk( wbarfile )
        write(fnamew(1:80),'(2a,i10.10)')
     &    wbarfile(1:ilw),'.',optimcycle
      endif

      if (nmonsrec.lt.12) then
        print*
        print*,' cost_Driftw: assimilation period smaller'
        print*,'             than 1 year, no drift computed.'
        print*
        stop   '  ... stopped in cost_Driftw.'
      endif

      fcthread_wdrift = 0. _d 0

      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                wfmean(i,j,k,bi,bj) = 0.0
                wlmean(i,j,k,bi,bj) = 0.0
              enddo
            enddo
          enddo
        enddo
      enddo

      nf = 0
      nl = 0

c--   Loop over records.
      do irec = 1,12

c--     Read time averages and the monthly mean data.
        call active_read_xyz( fnamew, wbar, irec,
     &                        doglobalread, ladinit,
     &                        optimcycle, mythid,
     &                        xx_wbar_mean_dummy )

        nf = nf + 1
        do bj = jtlo,jthi
          do bi = itlo,ithi
            do k = 1,nr
              do j = jmin,jmax
                do i = imin,imax
                  wfmean(i,j,k,bi,bj) = wfmean(i,j,k,bi,bj) +
     &                  wbar(i,j,k,bi,bj)
                enddo
              enddo
            enddo
          enddo
        enddo

      enddo

      do irec = nmonsrec-12+1, nmonsrec

c--     Read time averages and the monthly mean data.
        call active_read_xyz( fnamew, wbar, irec,
     &                        doglobalread, ladinit,
     &                        optimcycle, mythid,
     &                        xx_wbar_mean_dummy )

        nl = nl + 1

        do bj = jtlo,jthi
          do bi = itlo,ithi
            do k = 1,nr
              do j = jmin,jmax
                do i = imin,imax
                  wlmean(i,j,k,bi,bj) = wlmean(i,j,k,bi,bj) +
     &                  wbar(i,j,k,bi,bj)
                enddo
              enddo
            enddo
          enddo
        enddo

      enddo


      do bj = jtlo,jthi
        do bi = itlo,ithi

c--       Loop over the model layers
          fctilew = 0. _d 0

          do k = 1,nr

c--         Compute model misfit and cost function term for
c           the vertical velovity field. The error is 1e-4 m/s.
            do j = jmin,jmax
             do i = imin,imax
              if (_hFacC(i,j,k,bi,bj) .ne. 0.) then
                     fctilew = fctilew +
     &                  (2.5e11*cosphi(i,j,bi,bj)*
     &          (wlmean(i,j,k,bi,bj)/nl - wfmean(i,j,k,bi,bj)/nf)*
     &          (wlmean(i,j,k,bi,bj)/nl - wfmean(i,j,k,bi,bj)/nf))
                     if ( cosphi(i,j,bi,bj) .ne. 0. )
     &                 num_wdrift(bi,bj) = num_wdrift(bi,bj) + 1. _d 0
              endif
             enddo
            enddo

          enddo
c--       End of loop over layers.

          fcthread_wdrift    = fcthread_wdrift    + fctilew
          objf_wdrift(bi,bj) = objf_wdrift(bi,bj) + fctilew

#ifdef ECCO_VERBOSE
c--       Print cost function for each tile in each thread.
          write(msgbuf,'(a)') ' '
          call print_message( msgbuf, standardmessageunit,
     &                          SQUEEZE_RIGHT , mythid)
          write(msgbuf,'(a,i8.8,1x,i3.3,1x,i3.3)')
     &        ' cost_Driftw: irec,bi,bj          =  ',irec,bi,bj
          call print_message( msgbuf, standardmessageunit,
     &                          SQUEEZE_RIGHT , mythid)
          write(msgbuf,'(a,d22.15)')
     &        '     cost function (wvel) = ',
     &        fcthread_wdrift
          call print_message( msgbuf, standardmessageunit,
     &                      SQUEEZE_RIGHT , mythid)
          write(msgbuf,'(a)') ' '
          call print_message( msgbuf, standardmessageunit,
     &                          SQUEEZE_RIGHT , mythid)
#endif

        enddo
      enddo

#ifdef ECCO_VERBOSE
c--     Print cost function for all tiles.
        _GLOBAL_SUM_R8( fcthread_wdrift , myThid )
        write(msgbuf,'(a)') ' '
        call print_message( msgbuf, standardmessageunit,
     &                      SQUEEZE_RIGHT , mythid)
        write(msgbuf,'(a,i8.8)')
     &    ' cost_Driftw: irec = ',irec
        call print_message( msgbuf, standardmessageunit,
     &                      SQUEEZE_RIGHT , mythid)
        write(msgbuf,'(a,a,d22.15)')
     &    '  cost function value',
     &    ' (wvel) = ',fcthread_wdrift
        call print_message( msgbuf, standardmessageunit,
     &                      SQUEEZE_RIGHT , mythid)
        write(msgbuf,'(a)') ' '
        call print_message( msgbuf, standardmessageunit,
     &                      SQUEEZE_RIGHT , mythid)
#endif

#endif

      return
      end

1	jmc	1.5	C $Header: $
2			C $Name: $
3	heimbach	1.1
4			#include "COST_CPPOPTIONS.h"
5
6
7			subroutine cost_driftw(
8			I myiter,
9			I mytime,
10			I mythid
11			& )
12
13			c ==================================================================
14			c SUBROUTINE cost_Driftw
15			c ==================================================================
16			c
17			c o Evaluate cost function contribution of the w difference
18			c between the first and the last year.
19			c
20			c started: from cost_drift
21			c
22			c Armin Koehl akoehl@ucsd.edu 26-Feb-2002
23			c
24			c ==================================================================
25			c SUBROUTINE cost_Driftw
26			c ==================================================================
27
28			implicit none
29
30			c == global variables ==
31
32			#include "EEPARAMS.h"
33			#include "SIZE.h"
34			#include "GRID.h"
35			#include "DYNVARS.h"
36
37			#include "cal.h"
38			#include "ecco_cost.h"
39			#include "ctrl.h"
40			#include "ctrl_dummy.h"
41			#include "optim.h"
42
43			c == routine arguments ==
44
45			integer myiter
46			_RL mytime
47			integer mythid
48
49			c == local variables ==
50
51			_RS one_rs
52			parameter( one_rs = 1. )
53
54			integer bi,bj
55			integer i,j,k
56			integer itlo,ithi
57			integer jtlo,jthi
58			integer jmin,jmax
59			integer imin,imax
60			integer irec
61			integer ilw
62			integer nf, nl
63
64			_RL fctilew
65			_RL fcthread_wdrift
66
67			character*(80) fnamew
68
69			logical doglobalread
70			logical ladinit
71
72			character*(MAX_LEN_MBUF) msgbuf
73
74			c == external functions ==
75
76			integer ilnblnk
77			external ilnblnk
78
79			c == end of interface ==
80
81			jtlo = mybylo(mythid)
82			jthi = mybyhi(mythid)
83			itlo = mybxlo(mythid)
84			ithi = mybxhi(mythid)
85			jmin = 1
86			jmax = sny
87			imin = 1
88			imax = snx
89
90			c-- Read tiled data.
91			doglobalread = .false.
92			ladinit = .false.
93
94			#ifdef ALLOW_DRIFTW_COST_CONTRIBUTION
95
96			if (optimcycle .ge. 0) then
97			ilw = ilnblnk( wbarfile )
98			write(fnamew(1:80),'(2a,i10.10)')
99			& wbarfile(1:ilw),'.',optimcycle
100			endif
101	jmc	1.5
102			if (nmonsrec.lt.12) then
103	heimbach	1.1	print*
104	jmc	1.5	print*,' cost_Driftw: assimilation period smaller'
105	heimbach	1.1	print*,' than 1 year, no drift computed.'
106			print*
107			stop ' ... stopped in cost_Driftw.'
108			endif
109
110			fcthread_wdrift = 0. _d 0
111	jmc	1.5
112	heimbach	1.1	do bj = jtlo,jthi
113			do bi = itlo,ithi
114	jmc	1.5	do k = 1,nr
115	heimbach	1.1	do j = jmin,jmax
116			do i = imin,imax
117			wfmean(i,j,k,bi,bj) = 0.0
118			wlmean(i,j,k,bi,bj) = 0.0
119			enddo
120	jmc	1.5	enddo
121	heimbach	1.1	enddo
122			enddo
123			enddo
124	jmc	1.5
125	heimbach	1.1	nf = 0
126			nl = 0
127
128			c-- Loop over records.
129			do irec = 1,12
130
131			c-- Read time averages and the monthly mean data.
132			call active_read_xyz( fnamew, wbar, irec,
133			& doglobalread, ladinit,
134			& optimcycle, mythid,
135			& xx_wbar_mean_dummy )
136	jmc	1.5
137	heimbach	1.1	nf = nf + 1
138			do bj = jtlo,jthi
139			do bi = itlo,ithi
140	jmc	1.5	do k = 1,nr
141	heimbach	1.1	do j = jmin,jmax
142			do i = imin,imax
143	jmc	1.5	wfmean(i,j,k,bi,bj) = wfmean(i,j,k,bi,bj) +
144	heimbach	1.1	& wbar(i,j,k,bi,bj)
145			enddo
146	jmc	1.5	enddo
147	heimbach	1.1	enddo
148			enddo
149			enddo
150	jmc	1.5
151	heimbach	1.1	enddo
152	jmc	1.5
153	heimbach	1.1	do irec = nmonsrec-12+1, nmonsrec
154
155			c-- Read time averages and the monthly mean data.
156			call active_read_xyz( fnamew, wbar, irec,
157			& doglobalread, ladinit,
158			& optimcycle, mythid,
159			& xx_wbar_mean_dummy )
160	jmc	1.5
161			nl = nl + 1
162
163	heimbach	1.1	do bj = jtlo,jthi
164			do bi = itlo,ithi
165	jmc	1.5	do k = 1,nr
166	heimbach	1.1	do j = jmin,jmax
167			do i = imin,imax
168	jmc	1.5	wlmean(i,j,k,bi,bj) = wlmean(i,j,k,bi,bj) +
169	heimbach	1.1	& wbar(i,j,k,bi,bj)
170			enddo
171	jmc	1.5	enddo
172	heimbach	1.1	enddo
173			enddo
174			enddo
175	jmc	1.5
176	heimbach	1.1	enddo
177	jmc	1.5
178
179	heimbach	1.1	do bj = jtlo,jthi
180			do bi = itlo,ithi
181
182			c-- Loop over the model layers
183			fctilew = 0. _d 0
184	jmc	1.5
185	heimbach	1.1	do k = 1,nr
186
187			c-- Compute model misfit and cost function term for
188			c the vertical velovity field. The error is 1e-4 m/s.
189			do j = jmin,jmax
190	heimbach	1.3	do i = imin,imax
191			if (_hFacC(i,j,k,bi,bj) .ne. 0.) then
192	heimbach	1.1	fctilew = fctilew +
193			& (2.5e11cosphi(i,j,bi,bj)
194			& (wlmean(i,j,k,bi,bj)/nl - wfmean(i,j,k,bi,bj)/nf)*
195			& (wlmean(i,j,k,bi,bj)/nl - wfmean(i,j,k,bi,bj)/nf))
196	heimbach	1.3	if ( cosphi(i,j,bi,bj) .ne. 0. )
197			& num_wdrift(bi,bj) = num_wdrift(bi,bj) + 1. _d 0
198			endif
199			enddo
200	heimbach	1.1	enddo
201
202			enddo
203			c-- End of loop over layers.
204
205			fcthread_wdrift = fcthread_wdrift + fctilew
206			objf_wdrift(bi,bj) = objf_wdrift(bi,bj) + fctilew
207
208			#ifdef ECCO_VERBOSE
209			c-- Print cost function for each tile in each thread.
210			write(msgbuf,'(a)') ' '
211			call print_message( msgbuf, standardmessageunit,
212			& SQUEEZE_RIGHT , mythid)
213			write(msgbuf,'(a,i8.8,1x,i3.3,1x,i3.3)')
214			& ' cost_Driftw: irec,bi,bj = ',irec,bi,bj
215			call print_message( msgbuf, standardmessageunit,
216			& SQUEEZE_RIGHT , mythid)
217			write(msgbuf,'(a,d22.15)')
218			& ' cost function (wvel) = ',
219	heimbach	1.4	& fcthread_wdrift
220	heimbach	1.1	call print_message( msgbuf, standardmessageunit,
221			& SQUEEZE_RIGHT , mythid)
222			write(msgbuf,'(a)') ' '
223			call print_message( msgbuf, standardmessageunit,
224			& SQUEEZE_RIGHT , mythid)
225			#endif
226
227			enddo
228			enddo
229
230			#ifdef ECCO_VERBOSE
231			c-- Print cost function for all tiles.
232	heimbach	1.4	_GLOBAL_SUM_R8( fcthread_wdrift , myThid )
233	heimbach	1.1	write(msgbuf,'(a)') ' '
234			call print_message( msgbuf, standardmessageunit,
235			& SQUEEZE_RIGHT , mythid)
236			write(msgbuf,'(a,i8.8)')
237	heimbach	1.4	& ' cost_Driftw: irec = ',irec
238	heimbach	1.1	call print_message( msgbuf, standardmessageunit,
239			& SQUEEZE_RIGHT , mythid)
240			write(msgbuf,'(a,a,d22.15)')
241			& ' cost function value',
242	heimbach	1.4	& ' (wvel) = ',fcthread_wdrift
243	heimbach	1.1	call print_message( msgbuf, standardmessageunit,
244			& SQUEEZE_RIGHT , mythid)
245			write(msgbuf,'(a)') ' '
246			call print_message( msgbuf, standardmessageunit,
247			& SQUEEZE_RIGHT , mythid)
248			#endif
249
250			#endif
251
252			return
253			end
254