cs_adj_advdiff/code_ad/cost_test.F

C $Header: /u/gcmpack/MITgcm_contrib/heimbach/cs_adj_advdiff/code_ad/cost_test.F,v 1.4 2006/11/20 03:43:47 heimbach Exp $

#include "PACKAGES_CONFIG.h"
#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
      _RL sumcost(nSx,nSy)

      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)

      if ( useCubedSphereExchange) then
         iLocOut =  3 
         jLocOut =  2
         kLocOut =  1
      else
         iLocOut =  80
         jLocOut =  30
         kLocOut =  1
      endif

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

          sumcost(bi,bj) = 0.

          do j=1,sNy
          jg = myYGlobalLo-1+(bj-1)*sNy+j
            do i=1,sNx
            ig = myXGlobalLo-1+(bi-1)*sNx+i

cph            if ( ig .GE. (iLocOut-3) .AND. ig .LE. (iLocOut+3) .AND.
cph     &           jg .GE. (jLocOut-3) .AND. jg .LE. (jLocOut+3) ) then
            if ( ig .GE. 1 .AND. ig .LE. 16 .AND.
     &           jg .GE. 1 .AND. jg .LE. 16 ) then

               write(*,'(a,3(x,i4),a,4(x,i4))')
     &              'COST    ',ig,jg,kLocOut,' TILE ',i,j,bi,bj

               objf_test(bi,bj) = objf_test(bi,bj) +
     &              theta(i,j,kLocOut,bi,bj)*hFacC(i,j,kLocOut,bi,bj)

               sumcost(bi,bj) = sumcost(bi,bj)+hFacC(i,j,kLocOut,bi,bj)
cph(
               print *, 'ph-cost ', ig, jg, kLocOut,
     &              theta(i,j,kLocOut,bi,bj)
cph)
            endif

            end do
          end do

          if ( sumcost(bi,bj) .NE. 0. ) then
              objf_test(bi,bj) = objf_test(bi,bj)/sumcost(bi,bj)
              print *, 'ph-cost ', bi,bj, objf_test(bi,bj)
           endif

        end do
      end do

#endif

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