pkg/ecco/cost_theta0.F

C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_theta0.F,v 1.15 2014/10/18 18:15:45 gforget Exp $
C $Name:  $

#include "ECCO_OPTIONS.h"


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

c     ==================================================================
c     SUBROUTINE cost_zonstress
c     ==================================================================
c
c     o Calculate the zonal wind stress contribution to the cost function.
c
c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
c
c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
c
c              - Restructured the code in order to create a package
c                for the MITgcmUV.
c
c     ==================================================================
c     SUBROUTINE cost_zonstress
c     ==================================================================

      implicit none

c     == global variables ==

#ifdef ALLOW_THETA0_COST_CONTRIBUTION
#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"

#include "ecco_cost.h"
#include "CTRL_SIZE.h"
#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"
#endif

c     == routine arguments ==

      integer myiter
      _RL     mytime
      integer mythid

#ifdef ALLOW_THETA0_COST_CONTRIBUTION
c     == local variables ==

      integer bi,bj
      integer i,j,k
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer nrec
      integer irec
      integer ilfld

      _RL fctile
      _RL tmpx
      _RL lengthscale

      logical doglobalread
      logical ladinit

      character*(80) fnamefld

      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

      lengthscale = 1. _d 0

c--   Read state record from global file.
      doglobalread = .false.
      ladinit      = .false.

      irec = 1

      if (optimcycle .ge. 0) then
        ilfld = ilnblnk( xx_theta_file )
        write(fnamefld(1:80),'(2a,i10.10)')
     &       xx_theta_file(1:ilfld),'.',optimcycle
      endif

      call active_read_xyz(
     &     fnamefld, tmpfld3d, irec, doglobalread,
     &     ladinit, optimcycle, mythid, xx_theta_dummy )

c--     Loop over this thread tiles.
        do bj = jtlo,jthi
          do bi = itlo,ithi

c--         Determine the weights to be used.

            fctile = 0. _d 0
            do k = 1,nr
             do j = jmin,jmax
              do i = imin,imax
                if (_hFacC(i,j,k,bi,bj) .ne. 0.) then
                  tmpx = tmpfld3d(i,j,k,bi,bj)
                IF ( .NOT.ctrlSmoothCorrel3D ) THEN
                  if ( ABS(R_low(i,j,bi,bj)) .LT. 100. )
     &              tmpx = tmpx*ABS(R_low(i,j,bi,bj))/100.
                  fctile = fctile
     &                 + wthetaLev(i,j,k,bi,bj)*cosphi(i,j,bi,bj)
     &                 *tmpx*tmpx
                ELSE !IF ( .NOT.ctrlSmoothCorrel3D ) THEN
                  fctile = fctile + tmpx*tmpx
                ENDIF !IF ( .NOT.ctrlSmoothCorrel3D ) THEN
                  if ( wthetaLev(i,j,k,bi,bj)*cosphi(i,j,bi,bj).ne.0. )
     &                 num_temp0(bi,bj) = num_temp0(bi,bj) + 1. _d 0
                endif
              enddo
             enddo
            enddo

            objf_temp0(bi,bj) = objf_temp0(bi,bj) + fctile

          enddo
        enddo

        IF ( .NOT.ctrlSmoothCorrel3D ) THEN
#ifdef ALLOW_SMOOTH_IC_COST_CONTRIBUTION

      call active_read_xyz(
     &     fnamefld, tmpfld3d, irec, doglobalread,
     &     ladinit, optimcycle, mythid, xx_theta_dummy )

        _EXCH_XYZ_RL(tmpfld3d, mythid)

c--     Loop over this thread tiles.
        do bj = jtlo,jthi
          do bi = itlo,ithi

            fctile = 0. _d 0
            do k = 1,nr
             do j = jmin,jmax
              do i = imin,imax
                if (_hFacC(i,j,k,bi,bj) .ne. 0.) then
                  tmpx =
     &              ( tmpfld3d(i+2,j,k,bi,bj)-tmpfld3d(i+1,j,k,bi,bj) )
     &                *maskW(i+1,j,k,bi,bj)*maskW(i+2,j,k,bi,bj)
     &            + ( tmpfld3d(i+1,j,k,bi,bj)-tmpfld3d(i,j,k,bi,bj) )
     &                *maskW(i+1,j,k,bi,bj)
     &            + ( tmpfld3d(i,j+2,k,bi,bj)-tmpfld3d(i,j+1,k,bi,bj) )
     &                *maskS(i,j+1,k,bi,bj)*maskS(i,j+2,k,bi,bj)
     &            + ( tmpfld3d(i,j+1,k,bi,bj)-tmpfld3d(i,j,k,bi,bj) )
     &                *maskS(i,j+1,k,bi,bj)
                  if ( ABS(R_low(i,j,bi,bj)) .LT. 100. )
     &              tmpx = tmpx*ABS(R_low(i,j,bi,bj))/100.
                  fctile = fctile
     &               + wthetaLev(i,j,k,bi,bj)*cosphi(i,j,bi,bj)
     *                 *0.0161*lengthscale/4.0
     &                 *tmpx*tmpx
                endif
              enddo
             enddo
            enddo

            objf_temp0smoo(bi,bj) = objf_temp0smoo(bi,bj) + fctile

          enddo
        enddo
#endif
        ENDIF !IF ( .NOT.ctrlSmoothCorrel3D ) THEN

#endif

      return
      end


1	gforget	1.16	C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_theta0.F,v 1.15 2014/10/18 18:15:45 gforget Exp $
2	jmc	1.9	C $Name: $
3	heimbach	1.1
4	jmc	1.13	#include "ECCO_OPTIONS.h"
5	heimbach	1.1
6
7			subroutine cost_theta0(
8			I myiter,
9			I mytime,
10			I mythid
11			& )
12
13			c ==================================================================
14			c SUBROUTINE cost_zonstress
15			c ==================================================================
16			c
17			c o Calculate the zonal wind stress contribution to the cost function.
18			c
19			c started: Christian Eckert eckert@mit.edu 30-Jun-1999
20			c
21			c changed: Christian Eckert eckert@mit.edu 25-Feb-2000
22			c
23			c - Restructured the code in order to create a package
24			c for the MITgcmUV.
25			c
26			c ==================================================================
27			c SUBROUTINE cost_zonstress
28			c ==================================================================
29
30			implicit none
31
32			c == global variables ==
33
34	gforget	1.15	#ifdef ALLOW_THETA0_COST_CONTRIBUTION
35	heimbach	1.1	#include "EEPARAMS.h"
36			#include "SIZE.h"
37			#include "GRID.h"
38
39			#include "ecco_cost.h"
40	heimbach	1.12	#include "CTRL_SIZE.h"
41	heimbach	1.1	#include "ctrl.h"
42			#include "ctrl_dummy.h"
43			#include "optim.h"
44	gforget	1.15	#endif
45	heimbach	1.1
46			c == routine arguments ==
47
48			integer myiter
49			_RL mytime
50			integer mythid
51
52	gforget	1.15	#ifdef ALLOW_THETA0_COST_CONTRIBUTION
53	heimbach	1.1	c == local variables ==
54
55			integer bi,bj
56			integer i,j,k
57			integer itlo,ithi
58			integer jtlo,jthi
59			integer jmin,jmax
60			integer imin,imax
61			integer nrec
62			integer irec
63			integer ilfld
64
65			_RL fctile
66			_RL tmpx
67	heimbach	1.5	_RL lengthscale
68	heimbach	1.1
69			logical doglobalread
70			logical ladinit
71
72			character*(80) fnamefld
73
74			character*(MAX_LEN_MBUF) msgbuf
75
76			c == external functions ==
77
78			integer ilnblnk
79			external ilnblnk
80
81			c == end of interface ==
82
83			jtlo = mybylo(mythid)
84			jthi = mybyhi(mythid)
85			itlo = mybxlo(mythid)
86			ithi = mybxhi(mythid)
87			jmin = 1
88			jmax = sny
89			imin = 1
90			imax = snx
91
92	heimbach	1.5	lengthscale = 1. _d 0
93
94	heimbach	1.1	c-- Read state record from global file.
95			doglobalread = .false.
96			ladinit = .false.
97	jmc	1.9
98	heimbach	1.1	irec = 1
99
100			if (optimcycle .ge. 0) then
101			ilfld = ilnblnk( xx_theta_file )
102	jmc	1.9	write(fnamefld(1:80),'(2a,i10.10)')
103	heimbach	1.1	& xx_theta_file(1:ilfld),'.',optimcycle
104			endif
105
106	jmc	1.9	call active_read_xyz(
107	heimbach	1.5	& fnamefld, tmpfld3d, irec, doglobalread,
108			& ladinit, optimcycle, mythid, xx_theta_dummy )
109	heimbach	1.1
110	jmc	1.11	c-- Loop over this thread tiles.
111	heimbach	1.1	do bj = jtlo,jthi
112			do bi = itlo,ithi
113
114			c-- Determine the weights to be used.
115	jmc	1.9
116	heimbach	1.1	fctile = 0. _d 0
117			do k = 1,nr
118	heimbach	1.6	do j = jmin,jmax
119	heimbach	1.1	do i = imin,imax
120			if (_hFacC(i,j,k,bi,bj) .ne. 0.) then
121			tmpx = tmpfld3d(i,j,k,bi,bj)
122	gforget	1.14	IF ( .NOT.ctrlSmoothCorrel3D ) THEN
123	gforget	1.8	if ( ABS(R_low(i,j,bi,bj)) .LT. 100. )
124	heimbach	1.4	& tmpx = tmpx*ABS(R_low(i,j,bi,bj))/100.
125	heimbach	1.1	fctile = fctile
126	heimbach	1.4	& + wthetaLev(i,j,k,bi,bj)*cosphi(i,j,bi,bj)
127	heimbach	1.1	& tmpxtmpx
128	gforget	1.14	ELSE !IF ( .NOT.ctrlSmoothCorrel3D ) THEN
129	gforget	1.8	fctile = fctile + tmpx*tmpx
130	gforget	1.14	ENDIF !IF ( .NOT.ctrlSmoothCorrel3D ) THEN
131	heimbach	1.4	if ( wthetaLev(i,j,k,bi,bj)*cosphi(i,j,bi,bj).ne.0. )
132	heimbach	1.3	& num_temp0(bi,bj) = num_temp0(bi,bj) + 1. _d 0
133	heimbach	1.1	endif
134			enddo
135	heimbach	1.6	enddo
136	heimbach	1.1	enddo
137
138			objf_temp0(bi,bj) = objf_temp0(bi,bj) + fctile
139
140			enddo
141			enddo
142
143	gforget	1.14	IF ( .NOT.ctrlSmoothCorrel3D ) THEN
144	heimbach	1.5	#ifdef ALLOW_SMOOTH_IC_COST_CONTRIBUTION
145
146	jmc	1.9	call active_read_xyz(
147	heimbach	1.5	& fnamefld, tmpfld3d, irec, doglobalread,
148			& ladinit, optimcycle, mythid, xx_theta_dummy )
149
150	jmc	1.10	_EXCH_XYZ_RL(tmpfld3d, mythid)
151	heimbach	1.5
152	jmc	1.11	c-- Loop over this thread tiles.
153	heimbach	1.5	do bj = jtlo,jthi
154			do bi = itlo,ithi
155
156			fctile = 0. _d 0
157			do k = 1,nr
158	heimbach	1.6	do j = jmin,jmax
159	heimbach	1.5	do i = imin,imax
160			if (_hFacC(i,j,k,bi,bj) .ne. 0.) then
161	jmc	1.9	tmpx =
162	heimbach	1.5	& ( tmpfld3d(i+2,j,k,bi,bj)-tmpfld3d(i+1,j,k,bi,bj) )
163			& maskW(i+1,j,k,bi,bj)maskW(i+2,j,k,bi,bj)
164			& + ( tmpfld3d(i+1,j,k,bi,bj)-tmpfld3d(i,j,k,bi,bj) )
165			& *maskW(i+1,j,k,bi,bj)
166			& + ( tmpfld3d(i,j+2,k,bi,bj)-tmpfld3d(i,j+1,k,bi,bj) )
167			& maskS(i,j+1,k,bi,bj)maskS(i,j+2,k,bi,bj)
168			& + ( tmpfld3d(i,j+1,k,bi,bj)-tmpfld3d(i,j,k,bi,bj) )
169			& *maskS(i,j+1,k,bi,bj)
170	gforget	1.8	if ( ABS(R_low(i,j,bi,bj)) .LT. 100. )
171	heimbach	1.5	& tmpx = tmpx*ABS(R_low(i,j,bi,bj))/100.
172			fctile = fctile
173			& + wthetaLev(i,j,k,bi,bj)*cosphi(i,j,bi,bj)
174			* 0.0161lengthscale/4.0
175			& tmpxtmpx
176			endif
177			enddo
178	heimbach	1.6	enddo
179	heimbach	1.5	enddo
180
181	heimbach	1.6	objf_temp0smoo(bi,bj) = objf_temp0smoo(bi,bj) + fctile
182	heimbach	1.5
183			enddo
184			enddo
185	heimbach	1.1	#endif
186	gforget	1.14	ENDIF !IF ( .NOT.ctrlSmoothCorrel3D ) THEN
187	heimbach	1.1
188			#endif
189
190			return
191			end
192	jmc	1.9
193