pkg/cost/cost_test.F

C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_test.F,v 1.3 2001/11/20 21:06:48 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
      _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 =  80
      jLocOut =  30
      kLocOut =  1

ce    some reference temperature
      thetaRef = 24.0D0

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

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)
cph(
               print *, 'ph-cost ', ig, jg, kLocOut,
     &              theta(i,j,kLocOut,bi,bj)
cph)
            endif

            end do
          end do
        end do
      end do

#endif

      END
1	C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_test.F,v 1.3 2001/11/20 21:06:48 heimbach Exp $
2
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	_RL thetaRef
34
35	integer i, j, k
36	integer ig, jg
37	integer itlo,ithi
38	integer jtlo,jthi
39
40	jtlo = mybylo(mythid)
41	jthi = mybyhi(mythid)
42	itlo = mybxlo(mythid)
43	ithi = mybxhi(mythid)
44
45	iLocOut = 80
46	jLocOut = 30
47	kLocOut = 1
48
49	ce some reference temperature
50	thetaRef = 24.0D0
51
52	C-- Calculate mask for tracer cells (0 => land, 1 => water)
53	k=1
54
55	C-- Calculate cost function on tile of this instance
56	do bj = jtlo,jthi
57	do bi = itlo,ithi
58	do j=1,sNy
59	jg = myYGlobalLo-1+(bj-1)*sNy+j
60	do i=1,sNx
61	ig = myXGlobalLo-1+(bi-1)*sNx+i
62
63	if ((ig .eq. iLocOut) .and. (jg .eq. jLocOut)) then
64	write(*,'(a,3(x,i4),a,4(x,i4))')
65	& 'COST ',ig,jg,kLocOut,' TILE ',i,j,bi,bj
66	objf_test(bi,bj) = theta(i,j,kLocOut,bi,bj)
67	cph(
68	print *, 'ph-cost ', ig, jg, kLocOut,
69	& theta(i,j,kLocOut,bi,bj)
70	cph)
71	endif
72
73	end do
74	end do
75	end do
76	end do
77
78	#endif
79
80	END