pkg/cost/cost_test.F

C $Header: /u/gcmpack/models/MITgcmUV/pkg/cost/cost_test.F,v 1.1 2001/03/25 22:33:54 heimbach Exp $

#include "CPP_OPTIONS.h"

      subroutine cost_test( myThid )
C     /==========================================================\
C     | subroutine cost_test                                     |
C     | o this routine computes the cost function for the tiles  |
C     |   of this processor                                      |
C     |==========================================================|
C     |                                                          |
C     | Notes                                                    |
C     | =====                                                    |
C     \==========================================================/
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "GRID.h"

#include "cost.h"

C     == Routine arguments ==
C     myThid - Thread number for this instance of the routine.
      integer bi, bj
      integer myThid

#ifdef ALLOW_COST_TEST
C     == Local variables
      _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL thetaRef

      integer i, j, k
      integer ig, jg
      integer itlo,ithi
      integer jtlo,jthi

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)

      iLocOut =  6
      jLocOut =  35
      kLocOut =  1

ce    some reference temperature
      thetaRef = 24.0D0

C--   Calculate mask for tracer cells  (0 => land, 1 => water)
      k=1

      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j=1,sNy
            do i=1,sNx
              maskC(i,j) = 1.
              if (_hFacC(i,j,k,bi,bj) .eq. 0.) maskC(i,j)=0.
            end do
          end do
        end do
      end do

C--   Calculate cost function on tile of this instance
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j=1,sNy
          jg = myYGlobalLo-1+(bj-1)*sNy+j
            do i=1,sNx
            ig = myXGlobalLo-1+(bi-1)*sNx+i

            if ((ig .eq. iLocOut) .and. (jg .eq. jLocOut)) then
               write(*,'(a,3(x,i4),a,4(x,i4))')
     &              'COST    ',ig,jg,kLocOut,' TILE ',i,j,bi,bj
               objf_test(bi,bj) = theta(i,j,kLocOut,bi,bj)
            endif

            end do
          end do
        end do
      end do

#endif

      END
1	heimbach	1.2	C $Header: /u/gcmpack/models/MITgcmUV/pkg/cost/cost_test.F,v 1.1 2001/03/25 22:33:54 heimbach Exp $
2	heimbach	1.1
3			#include "CPP_OPTIONS.h"
4
5			subroutine cost_test( myThid )
6			C /==========================================================\
7			C \| subroutine cost_test \|
8			C \| o this routine computes the cost function for the tiles \|
9			C \| of this processor \|
10			C \|==========================================================\|
11			C \| \|
12			C \| Notes \|
13			C \| ===== \|
14			C \==========================================================/
15			IMPLICIT NONE
16
17			C == Global variables ===
18			#include "SIZE.h"
19			#include "EEPARAMS.h"
20			#include "PARAMS.h"
21			#include "DYNVARS.h"
22			#include "GRID.h"
23
24			#include "cost.h"
25
26			C == Routine arguments ==
27			C myThid - Thread number for this instance of the routine.
28			integer bi, bj
29			integer myThid
30
31			#ifdef ALLOW_COST_TEST
32			C == Local variables
33			_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
34			_RL thetaRef
35
36			integer i, j, k
37			integer ig, jg
38			integer itlo,ithi
39			integer jtlo,jthi
40
41			jtlo = mybylo(mythid)
42			jthi = mybyhi(mythid)
43			itlo = mybxlo(mythid)
44			ithi = mybxhi(mythid)
45
46			iLocOut = 6
47			jLocOut = 35
48			kLocOut = 1
49
50			ce some reference temperature
51			thetaRef = 24.0D0
52
53			C-- Calculate mask for tracer cells (0 => land, 1 => water)
54			k=1
55
56			do bj = jtlo,jthi
57			do bi = itlo,ithi
58			do j=1,sNy
59			do i=1,sNx
60			maskC(i,j) = 1.
61			if (_hFacC(i,j,k,bi,bj) .eq. 0.) maskC(i,j)=0.
62			end do
63			end do
64			end do
65			end do
66
67			C-- Calculate cost function on tile of this instance
68			do bj = jtlo,jthi
69			do bi = itlo,ithi
70			do j=1,sNy
71			jg = myYGlobalLo-1+(bj-1)*sNy+j
72			do i=1,sNx
73			ig = myXGlobalLo-1+(bi-1)*sNx+i
74
75			if ((ig .eq. iLocOut) .and. (jg .eq. jLocOut)) then
76	heimbach	1.2	write(*,'(a,3(x,i4),a,4(x,i4))')
77			& 'COST ',ig,jg,kLocOut,' TILE ',i,j,bi,bj
78	heimbach	1.1	objf_test(bi,bj) = theta(i,j,kLocOut,bi,bj)
79			endif
80
81			end do
82			end do
83			end do
84			end do
85
86			#endif
87
88			END