/[MITgcm]/MITgcm/pkg/ecco/ecco_cost_init_fixed.F
ViewVC logotype

Contents of /MITgcm/pkg/ecco/ecco_cost_init_fixed.F

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


Revision 1.15 - (show annotations) (download)
Sat Mar 14 12:12:12 2009 UTC (15 years, 2 months ago) by heimbach
Branch: MAIN
Changes since 1.14: +17 -1 lines
Add an extra check on values of (SSH)TimeMask

1 C $Header: /u/gcmpack/MITgcm/pkg/ecco/ecco_cost_init_fixed.F,v 1.14 2009/03/14 11:53:41 heimbach Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "AD_CONFIG.h"
6 #include "COST_CPPOPTIONS.h"
7
8 subroutine ecco_cost_init_fixed( mythid )
9
10 c ==================================================================
11 c SUBROUTINE ecco_cost_init_fixed
12 c ==================================================================
13 c
14 c o Set contributions to the cost function and the cost function
15 c itself to zero. The cost function and the individual contribu-
16 c tions are defined in the header file "ecco_cost.h".
17 c
18 c started: Christian Eckert eckert@mit.edu 30-Jun-1999
19 c
20 c changed: Christian Eckert eckert@mit.edu 25-Feb-2000
21 c
22 c - Restructured the code in order to create a package
23 c for the MITgcmUV.
24 c
25 c changed: Ralf Giering 18-Jan-2001
26 c
27 c - move namelist reading to cost_readparms.F
28 c
29 c ==================================================================
30 c SUBROUTINE ecco_cost_init_fixed
31 c ==================================================================
32
33 implicit none
34
35 c == global variables ==
36
37 #include "EEPARAMS.h"
38 #include "SIZE.h"
39 #include "GRID.h"
40 #include "PARAMS.h"
41
42 #ifdef ALLOW_CAL
43 #include "cal.h"
44 #endif
45 #include "ecco_cost.h"
46
47 c == routine arguments ==
48
49 integer mythid
50
51 c == local variables ==
52
53 integer tempDate1(4)
54 integer tempDate2(4)
55 integer gwunit
56 integer ilo,ihi
57 integer irec
58 logical exst
59 _RL dummy
60 _RL missingObsFlag
61 PARAMETER ( missingObsFlag = 1. _d 23 )
62
63 c == external functions ==
64
65 integer cal_IntYears
66 external cal_IntYears
67 integer cal_IntMonths
68 external cal_IntMonths
69 integer cal_IntDays
70 external cal_IntDays
71 integer ifnblnk
72 external ifnblnk
73 integer ilnblnk
74 external ilnblnk
75
76 c == end of interface ==
77
78 #ifdef ALLOW_CAL
79
80 c-- The number of monthly and daily averages generated by the
81 c-- current model integration.
82 nyearsrec = cal_IntYears( mythid )
83 nmonsrec = cal_IntMonths( mythid )
84 ndaysrec = cal_IntDays( mythid )
85
86 _BEGIN_MASTER( myThid )
87
88 c-- Get the complete dates of the ...
89 c-- ... TMI data.
90 call cal_FullDate( tmistartdate1, tmistartdate2,
91 & tmistartdate, mythid )
92 c-- ... SST data.
93 call cal_FullDate( sststartdate1, sststartdate2,
94 & sststartdate, mythid )
95 c-- ... SSS data.
96 call cal_FullDate( sssstartdate1, sssstartdate2,
97 & sssstartdate, mythid )
98 c-- ... BP data.
99 call cal_FullDate( bpstartdate1, bpstartdate2,
100 & bpstartdate, mythid )
101 c-- ... T/P data.
102 call cal_FullDate( topexstartdate1, topexstartdate2,
103 & topexstartdate, mythid )
104 c-- ... ERS data.
105 call cal_FullDate( ersstartdate1, ersstartdate2,
106 & ersstartdate, mythid )
107 c-- ... GFO data.
108 call cal_FullDate( gfostartdate1, gfostartdate2,
109 & gfostartdate, mythid )
110 c-- ... SCAT data.
111 call cal_FullDate( scatstartdate1, scatstartdate2,
112 & scatxstartdate, mythid )
113 call cal_FullDate( scatstartdate1, scatstartdate2,
114 & scatystartdate, mythid )
115 c-- ... ARGO data.
116 call cal_FullDate( argotstartdate1, argotstartdate2,
117 & argotstartdate, mythid )
118 call cal_FullDate( argosstartdate1, argotstartdate2,
119 & argosstartdate, mythid )
120
121 _END_MASTER( mythid )
122
123 #endif /* ALLOW_CAL */
124
125 call ecco_check( myThid )
126
127 c-- Get the weights that are to be used for the individual cost
128 c-- function contributions.
129 call ecco_cost_weights( mythid )
130
131 c-- Initialise adjoint of monthly mean files calculated
132 c-- in cost_averagesfields (and their ad...).
133 cph(
134 cph The following init. shoud not be applied if in the middle
135 cph of a divided adjoint run
136 cph)
137 #ifndef ALLOW_TANGENTLINEAR_RUN
138 cph!!! and I think it needs to be seen by TAF
139 cph!!! for repeated TLM runs
140 cph!!!
141 inquire( file='costfinal', exist=exst )
142 if ( .NOT. exst) then
143 call ecco_cost_init_barfiles( mythid )
144 endif
145 #endif
146
147 #ifdef ALLOW_TRANSPORT_COST_CONTRIBUTION
148 do irec = 1, ndaysrec
149 wtransp(irec) = 0. _d 0
150 transpobs(irec) = 0. _d 0
151 enddo
152
153 if ( costTranspDataFile .NE. ' ' ) then
154 _BEGIN_MASTER(myThid)
155 ilo = ifnblnk(costTranspDataFile)
156 ihi = ilnblnk(costTranspDataFile)
157 CALL OPEN_COPY_DATA_FILE(
158 I costTranspDataFile(ilo:ihi),
159 I 'ECCO_COST_INIT_FIXED',
160 O gwunit,
161 I myThid )
162 do irec = 1, ndaysrec
163 c-- read daily transport time series
164 c-- 1st: transport in m/s
165 c-- 2nd: date in YYYYMMDD
166 c-- 3rd: uncertainty in m/s
167 read(gwunit,*) transpobs(irec), dummy, wtransp(irec)
168 c-- convert std.dev. to weight
169 if ( wtransp(irec) .NE. 0. )
170 & wtransp(irec) =1.0/(wtransp(irec)*wtransp(irec))
171 c-- set weight to zero for missing values
172 if ( transpobs(irec) .EQ. missingObsFlag )
173 & wtransp(irec) = 0. _d 0
174 enddo
175 _END_MASTER(myThid)
176 _BARRIER
177 endif
178 #endif /* ALLOW_TRANSPORT_COST_CONTRIBUTION */
179
180 #ifdef ALLOW_SSH_COST_CONTRIBUTION
181
182 c-- Read flags for picking SSH time averages
183 do irec = 1, ndaysrec
184 tpTimeMask(irec) = 1. _d 0
185 ersTimeMask(irec) = 1. _d 0
186 gfoTimeMask(irec) = 1. _d 0
187 enddo
188 c
189 _BEGIN_MASTER(myThid)
190 c
191 #ifdef ALLOW_SSH_TPANOM_COST_CONTRIBUTION
192 if ( tpTimeMaskFile .NE. ' ' ) then
193 ilo = ifnblnk(tpTimeMaskFile)
194 ihi = ilnblnk(tpTimeMaskFile)
195 CALL OPEN_COPY_DATA_FILE(
196 I tpTimeMaskFile(ilo:ihi),
197 I 'cost_ssh tp',
198 O gwunit,
199 I myThid )
200 do irec = 1, ndaysrec
201 read(gwunit,*) tpTimeMask(irec)
202 enddo
203 endif
204 #endif
205 c
206 #ifdef ALLOW_SSH_ERSANOM_COST_CONTRIBUTION
207 if ( ersTimeMaskFile .NE. ' ' ) then
208 ilo = ifnblnk(ersTimeMaskFile)
209 ihi = ilnblnk(ersTimeMaskFile)
210 CALL OPEN_COPY_DATA_FILE(
211 I ersTimeMaskFile(ilo:ihi),
212 I 'cost_ssh ers',
213 O gwunit,
214 I myThid )
215 do irec = 1, ndaysrec
216 read(gwunit,*) ersTimeMask(irec)
217 enddo
218 endif
219 #endif
220 c
221 #ifdef ALLOW_SSH_GFOANOM_COST_CONTRIBUTION
222 if ( gfoTimeMaskFile .NE. ' ' ) then
223 ilo = ifnblnk(gfoTimeMaskFile)
224 ihi = ilnblnk(gfoTimeMaskFile)
225 CALL OPEN_COPY_DATA_FILE(
226 I gfoTimeMaskFile(ilo:ihi),
227 I 'cost_ssh gfo',
228 O gwunit,
229 I myThid )
230 do irec = 1, ndaysrec
231 read(gwunit,*) gfoTimeMask(irec)
232 enddo
233 endif
234 #endif
235 c
236 do irec = 1, ndaysrec
237 if (
238 & ( tpTimeMask(irec).NE.0. .AND. tpTimeMask(irec).NE.1. ) .OR.
239 & ( ersTimeMask(irec).NE.0. .AND. ersTimeMask(irec).NE.1. ) .OR.
240 & ( ersTimeMask(irec).NE.0. .AND. ersTimeMask(irec).NE.1. ) )
241 & then
242 WRITE(msgBuf,'(2A,I)')
243 & 'ecco_cost_init_fixed: (SSH)TimeMask not 0. or 1. ',
244 & 'for irec (=day) ', irec
245 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
246 & SQUEEZE_RIGHT , myThid )
247 CALL PRINT_ERROR( msgBuf , myThid )
248 STOP 'ABNORMAL END: S/R ECCO_COST_INIT_FIXED'
249 endif
250 enddo
251 c
252 _END_MASTER(myThid)
253 _BARRIER
254 #endif
255
256 c-- Summarize the cost function's setup.
257 _BEGIN_MASTER( mythid )
258 call ecco_cost_summary( mythid )
259 _END_MASTER( mythid )
260
261 _BARRIER
262
263 end

  ViewVC Help
Powered by ViewVC 1.1.22