/[MITgcm]/MITgcm_contrib/heimbach/admtlm_setup/code_ad_metric/cost_test.F
ViewVC logotype

Contents of /MITgcm_contrib/heimbach/admtlm_setup/code_ad_metric/cost_test.F

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


Revision 1.1 - (show annotations) (download)
Fri Nov 4 19:00:29 2005 UTC (19 years, 8 months ago) by heimbach
Branch: MAIN
CVS Tags: HEAD
Adding _ad only setup.

1 C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_test.F,v 1.6 2003/10/10 22:43:28 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 _RL myMetric
35 _RL multAll
36
37 _RL stdDevSST
38 _RL stdDevSSS
39 _RL stdDevtheta
40 _RL stdDevsalt
41 _RL stdDevuvel
42 _RL stdDevvvel
43 _RL stdDevetan
44
45 _RL fcTheta
46 _RL fcSalt
47 _RL fcUvel
48 _RL fcVvel
49 _RL fcEtan
50
51 _RL numTheta
52 _RL numSalt
53 _RL numUvel
54 _RL numVvel
55 _RL numEtan
56
57 integer i, j, k
58 integer ig, jg
59 integer itlo,ithi
60 integer jtlo,jthi
61
62 jtlo = mybylo(mythid)
63 jthi = mybyhi(mythid)
64 itlo = mybxlo(mythid)
65 ithi = mybxhi(mythid)
66
67 myMetric = 0. _d 0
68 stdDevSST = 0.52 _d 0
69 stdDevSSS = 0.134 _d 0
70 c
71 stdDevTheta = 1.
72 stdDevSalt = 1.
73 stdDevUvel = 1.
74 stdDevVvel = 1.
75 stdDevEtan = 1.
76
77 DO bj=myByLo(myThid),myByHi(myThid)
78 DO bi=myBxLo(myThid),myBxHi(myThid)
79 c
80 fcTheta = 0.
81 fcSalt = 0.
82 fcUvel = 0.
83 fcVvel = 0.
84 fcEtan = 0.
85 c
86 numTheta = 0.
87 numSalt = 0.
88 numUvel = 0.
89 numVvel = 0.
90 numEtan = 0.
91 c
92 DO j=1,sNy
93 DO i=1,sNx
94 DO k=1,Nr
95 c
96 fcTheta = fcTheta +
97 & hFacC(i,j,k,bi,bj)
98 & *theta(i,j,k,bi,bj)**2/stdDevTheta**2
99 numTheta = numTheta +
100 & maskC(i,j,k,bi,bj)
101 c
102 fcSalt = fcSalt +
103 & hFacC(i,j,k,bi,bj)
104 & *salt(i,j,k,bi,bj)**2/stdDevSalt**2
105 numSalt = numSalt +
106 & hFacC(i,j,k,bi,bj)
107 c
108 fcUvel = fcUvel +
109 & hFacW(i,j,k,bi,bj)
110 & *uvel(i,j,k,bi,bj)**2/stdDevUvel**2
111 numUvel = numUvel +
112 & hFacW(i,j,k,bi,bj)
113 c
114 fcVvel = fcVvel +
115 & hFacS(i,j,k,bi,bj)
116 & *vvel(i,j,k,bi,bj)**2/stdDevVvel**2
117 numVvel = numVvel +
118 & hFacS(i,j,k,bi,bj)
119 c
120 if ( k .EQ. 1 ) then
121 fcEtan = fcEtan +
122 & hFacC(i,j,k,bi,bj)
123 & *etan(i,j,bi,bj)**2/stdDevEtan**2
124 numEtan = numEtan +
125 & hFacC(i,j,k,bi,bj)
126 endif
127 c
128 END DO
129 END DO
130 END DO
131 c
132 if ( numTheta .NE. 0. )
133 & fcTheta = multTheta*fcTheta/numTheta
134 if ( numSalt .NE. 0. )
135 & fcSalt = multSalt*fcSalt/numSalt
136 if ( numUvel .NE. 0. )
137 & fcUvel = multUvel*fcUvel/numUvel
138 if ( numVvel .NE. 0. )
139 & fcVvel = multVvel*fcVvel/numVvel
140 if ( numEtan .NE. 0. )
141 & fcEtan = multEtan*fcEtan/numEtan
142
143 multAll =
144 & multTheta + multSalt + multUvel + multVvel + multEtan
145
146 if ( multAll .NE. 0. ) then
147 objf_test(bi,bj) = 1./multAll*
148 & ( fcTheta + fcSalt + fcUvel + fcVvel + fcEtan )
149 else
150 objf_test(bi,bj) = 0.
151 endif
152 c
153 END DO
154 END DO
155
156 #endif
157
158 END

  ViewVC Help
Powered by ViewVC 1.1.22