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

Annotation 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 - (hide annotations) (download)
Sun Aug 12 01:32:50 2012 UTC (11 years, 8 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 jmc 1.3 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 jmc 1.2 C $Name: $
3 heimbach 1.1
4 jmc 1.3 #include "COST_OPTIONS.h"
5 heimbach 1.1
6     subroutine cost_test( myThid )
7 jmc 1.3 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 heimbach 1.1 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 jmc 1.3 integer bi, bj
32 heimbach 1.1 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 jmc 1.3 ENDIF
66 heimbach 1.1 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 jmc 1.3 Cml thetaRef = 24.0 _d 0
77 heimbach 1.1 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 jmc 1.3 Cml enddo
93     Cml enddo
94     Cml enddo
95     Cml enddo
96 heimbach 1.1
97 jmc 1.3 #endif /* ALLOW_COST_TEST */
98 heimbach 1.1
99 jmc 1.3 RETURN
100 heimbach 1.1 END

  ViewVC Help
Powered by ViewVC 1.1.22