/[MITgcm]/MITgcm/verification/bottom_ctrl_5x5/code_ad/cost_test.F
ViewVC logotype

Contents of /MITgcm/verification/bottom_ctrl_5x5/code_ad/cost_test.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Sun Aug 12 01:32:50 2012 UTC (7 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63r, checkpoint63s, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.2: +18 -21 lines
- includes COST_OPTIONS.h (previously CPP_OPTIONS.h) like in pkg/ctrl version
- improve argument list description

1 C $Header: /u/gcmpack/MITgcm/verification/bottom_ctrl_5x5/code_ad/cost_test.F,v 1.2 2007/10/09 02:36:41 jmc Exp $
2 C $Name: $
3
4 #include "COST_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 | Notes
13 C *==========================================================*
14 IMPLICIT NONE
15
16 C == Global variables ===
17 #include "SIZE.h"
18 #include "EEPARAMS.h"
19 #include "PARAMS.h"
20 #include "DYNVARS.h"
21 #include "GRID.h"
22
23 #include "cost.h"
24
25 C == Routine arguments ==
26 C myThid - Thread number for this instance of the routine.
27 integer myThid
28
29 #ifdef ALLOW_COST_TEST
30 C == Local variables
31 integer bi, bj
32 integer i, j, k
33 integer ig, jg
34 integer itlo,ithi
35 integer jtlo,jthi
36 _RL vol_trans
37 C-- index values at which the transport is to be calculated
38 INTEGER iysecmin, iysecmax, ixsec
39 PARAMETER (ixsec = 4, iysecmin = 3, iysecmax = 3)
40
41 jtlo = mybylo(mythid)
42 jthi = mybyhi(mythid)
43 itlo = mybxlo(mythid)
44 ithi = mybxhi(mythid)
45
46 DO bj=jtlo,jthi
47 DO bi=itlo,ithi
48 vol_trans = 0.
49 DO J=1,sNy
50 jg = myYGlobalLo-1+(bj-1)*sNy+J
51 IF ( jg .ge. iysecmin .and. jg .le. iysecmax ) THEN
52 DO I=1,sNx
53 ig = myXGlobalLo-1+(bi-1)*sNx+I
54 IF ( ig .eq. ixsec ) THEN
55 DO K=1,Nr
56 IF ( maskW(I,J,K,BI,BJ) .NE. 0. ) THEN
57 vol_trans = vol_trans
58 & + uVel(I,J,K,BI,BJ)
59 & *_hFacW(I,J,K,BI,BJ)
60 & *dyG(I,J,BI,BJ)*drF(K)
61 ENDIF
62 ENDDO
63 ENDIF
64 ENDDO
65 ENDIF
66 ENDDO
67 objf_test(bi,bj) = vol_trans*1.0e-06
68 END DO
69 END DO
70 CML objf_test(1,1) = vVel(3,3,1,1,1)* _hFacS(3,3,1,1,1)
71 Cml iLocOut = 6
72 Cml jLocOut = 35
73 Cml kLocOut = 1
74 Cml
75 Cmlce some reference temperature
76 Cml thetaRef = 24.0 _d 0
77 Cml
78 CmlC-- Calculate cost function on tile of this instance
79 Cml do bj = jtlo,jthi
80 Cml do bi = itlo,ithi
81 Cml do j=1,sNy
82 Cml jg = myYGlobalLo-1+(bj-1)*sNy+j
83 Cml do i=1,sNx
84 Cml ig = myXGlobalLo-1+(bi-1)*sNx+i
85 Cml
86 Cml if ((ig .eq. iLocOut) .and. (jg .eq. jLocOut)) then
87 Cml write(*,'(a,3(x,i4),a,4(x,i4))')
88 Cml & 'COST ',ig,jg,kLocOut,' TILE ',i,j,bi,bj
89 Cml objf_test(bi,bj) = theta(i,j,kLocOut,bi,bj)
90 Cml endif
91 Cml
92 Cml enddo
93 Cml enddo
94 Cml enddo
95 Cml enddo
96
97 #endif /* ALLOW_COST_TEST */
98
99 RETURN
100 END

  ViewVC Help
Powered by ViewVC 1.1.22