1 |
C $Header: /u/gcmpack/MITgcm/pkg/profiles/profiles_init_fixed.F,v 1.13 2009/04/28 18:18:29 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "PROFILES_OPTIONS.h" |
5 |
|
6 |
C *==========================================================* |
7 |
C | subroutine profiles_init_fixed |
8 |
C | o initialization for netcdf profiles data |
9 |
C | started: Gael Forget 15-March-2006 |
10 |
C | extended: Gael Forget 14-June-2007 |
11 |
C *==========================================================* |
12 |
|
13 |
SUBROUTINE profiles_init_fixed( myThid ) |
14 |
|
15 |
implicit none |
16 |
|
17 |
C ==================== Global Variables =========================== |
18 |
#include "SIZE.h" |
19 |
#include "EEPARAMS.h" |
20 |
#include "PARAMS.h" |
21 |
#include "GRID.h" |
22 |
#include "DYNVARS.h" |
23 |
#ifdef ALLOW_CAL |
24 |
#include "cal.h" |
25 |
#endif |
26 |
#ifdef ALLOW_PROFILES |
27 |
# include "profiles.h" |
28 |
# include "netcdf.inc" |
29 |
#endif |
30 |
C ==================== Routine Variables ========================== |
31 |
|
32 |
integer k,l,m,q,bi,bj,iG,jG, myThid,num_file,length_for_tile |
33 |
_RL stopProfiles |
34 |
integer fid, dimid, varid1, varid1a, varid1b |
35 |
integer varid2,varid3 |
36 |
_RL tmpyymmdd(1000),tmphhmmss(1000),diffsecs |
37 |
integer tmpdate(4),tmpdiff(4) |
38 |
_RL tmp_lon, tmp_lon2(1000), tmp_lat2(1000) |
39 |
integer vec_start(2), vec_count(2), profno_div1000, kk |
40 |
character*(80) profilesfile, fnamedatanc |
41 |
character*(80) fnameequinc, adfnameequinc |
42 |
integer IL, err |
43 |
logical exst |
44 |
|
45 |
#ifdef ALLOW_PROFILES |
46 |
|
47 |
#ifdef ALLOW_PROFILES_GENERICGRID |
48 |
integer varid_intp1, varid_intp2, varid_intp11 , varid_intp22 |
49 |
integer varid_intp3, varid_intp4, varid_intp5 |
50 |
_RL tmp_i(1000,NUM_INTERP_POINTS) |
51 |
_RL tmp_j(1000,NUM_INTERP_POINTS) |
52 |
_RL tmp_weights(1000,NUM_INTERP_POINTS),tmp_sum_weights |
53 |
_RL tmp_xC11(1000),tmp_yC11(1000) |
54 |
_RL tmp_xCNINJ(1000),tmp_yCNINJ(1000) |
55 |
_RL stopGenericGrid |
56 |
Real*8 xy_buffer_r8(0:sNx+1,0:sNy+1) |
57 |
integer vec_start2(2), vec_count2(2) |
58 |
#endif |
59 |
|
60 |
c == external functions == |
61 |
integer ILNBLNK |
62 |
integer MDS_RECLEN |
63 |
character*(max_len_mbuf) msgbuf |
64 |
|
65 |
c-- == end of interface == |
66 |
|
67 |
stopProfiles=0. _d 0 |
68 |
#ifdef ALLOW_PROFILES_GENERICGRID |
69 |
stopGenericGrid=0. _d 0 |
70 |
#endif |
71 |
|
72 |
_BEGIN_MASTER( mythid ) |
73 |
DO bj=1,nSy |
74 |
DO bi=1,nSx |
75 |
|
76 |
profiles_curfile_buff(bi,bj)=0 |
77 |
|
78 |
do m=1,NLEVELMAX |
79 |
do l=1,1000 |
80 |
do k=1,NVARMAX |
81 |
profiles_data_buff(m,l,k,bi,bj)=0 |
82 |
profiles_weight_buff(m,l,k,bi,bj)=0 |
83 |
enddo |
84 |
enddo |
85 |
enddo |
86 |
|
87 |
do num_file=1,NFILESPROFMAX |
88 |
|
89 |
IL = ILNBLNK( profilesfiles(num_file) ) |
90 |
if (IL.NE.0) then |
91 |
write(profilesfile(1:80),'(1a)') |
92 |
& profilesfiles(num_file)(1:IL) |
93 |
write(msgbuf,'(a,X,i3,X,a)') |
94 |
& 'Profiles num_file is ', num_file, profilesfile(1:80) |
95 |
call print_message( |
96 |
& msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid) |
97 |
else |
98 |
write(profilesfile(1:80),'(1a)') ' ' |
99 |
write(msgbuf,'(a,X,i3,X,a)') |
100 |
& 'Profiles num_file is ', num_file, ' empty ' |
101 |
call print_message( |
102 |
& msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid) |
103 |
endif |
104 |
|
105 |
IL = ILNBLNK( profilesfile ) |
106 |
if (IL.NE.0) then |
107 |
|
108 |
C=========================================================== |
109 |
c open data files and read information |
110 |
C=========================================================== |
111 |
|
112 |
write(fnamedatanc(1:80),'(2a)') profilesfile(1:IL),'.nc' |
113 |
write(msgbuf,'(a,X,i3,X,a)') |
114 |
& 'Opening num_file ', num_file, fnamedatanc(1:80) |
115 |
call print_message( |
116 |
& msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid) |
117 |
err = NF_OPEN(fnamedatanc, 0, fiddata(num_file,bi,bj)) |
118 |
|
119 |
c1) read the number of profiles : |
120 |
fid=fiddata(num_file,bi,bj) |
121 |
err = NF_INQ_DIMID(fid,'iPROF', dimid ) |
122 |
err = NF_INQ_DIMLEN(fid, dimid, ProfNo(num_file,bi,bj) ) |
123 |
err = NF_INQ_DIMID(fid,'iDEPTH', dimid ) |
124 |
if (err.NE.NF_NOERR) then |
125 |
err = NF_INQ_DIMID(fid,'Z', dimid ) |
126 |
endif |
127 |
err = NF_INQ_DIMLEN(fid, dimid, ProfDepthNo(num_file,bi,bj) ) |
128 |
write(msgbuf,'(a,X,4i9)') |
129 |
& ' fid, num_file, ProfNo, ProfDepthNo ', |
130 |
& fid, num_file, ProfNo(num_file,bi,bj), |
131 |
& ProfDepthNo(num_file,bi,bj) |
132 |
call print_message( |
133 |
& msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid) |
134 |
|
135 |
c2) read the dates and positions : |
136 |
err = NF_INQ_VARID(fid,'depth', varid1a ) |
137 |
do k=1,ProfDepthNo(num_file,bi,bj) |
138 |
err = NF_GET_VAR1_DOUBLE(fid,varid1a,k, |
139 |
& prof_depth(num_file,k,bi,bj)) |
140 |
enddo |
141 |
|
142 |
err = NF_INQ_VARID(fid,'prof_YYYYMMDD', varid1a ) |
143 |
err = NF_INQ_VARID(fid,'prof_HHMMSS', varid1b ) |
144 |
err = NF_INQ_VARID(fid,'prof_lon', varid2 ) |
145 |
err = NF_INQ_VARID(fid,'prof_lat', varid3 ) |
146 |
|
147 |
if (err.NE.NF_NOERR) then |
148 |
WRITE(errorMessageUnit,'(A,X,I4.4,/,A)') |
149 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
150 |
& '.nc file is not in the ECCO format' |
151 |
stopProfiles=1. _d 0 |
152 |
endif |
153 |
|
154 |
#ifdef ALLOW_PROFILES_GENERICGRID |
155 |
c3) read interpolattion information (grid points, coeffs, etc.) |
156 |
err = NF_INQ_VARID(fid,'prof_interp_XC11',varid_intp1) |
157 |
err = NF_INQ_VARID(fid,'prof_interp_YC11',varid_intp2) |
158 |
err = NF_INQ_VARID(fid,'prof_interp_XCNINJ',varid_intp11) |
159 |
err = NF_INQ_VARID(fid,'prof_interp_YCNINJ',varid_intp22) |
160 |
err = NF_INQ_VARID(fid,'prof_interp_weights',varid_intp3) |
161 |
err = NF_INQ_VARID(fid,'prof_interp_i',varid_intp4) |
162 |
err = NF_INQ_VARID(fid,'prof_interp_j',varid_intp5) |
163 |
if (err.NE.NF_NOERR) then |
164 |
WRITE(errorMessageUnit,'(A,X,I4.4,/,A)') |
165 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
166 |
& 'no interpolation information found in .nc file' |
167 |
stopGenericGrid=2. _d 0 |
168 |
endif |
169 |
#endif |
170 |
|
171 |
|
172 |
c4) default values |
173 |
do k=1,NOBSGLOB |
174 |
prof_time(num_file,k,bi,bj)=-999 |
175 |
prof_lon(num_file,k,bi,bj)=-999 |
176 |
prof_lat(num_file,k,bi,bj)=-999 |
177 |
prof_ind_glob(num_file,k,bi,bj)=-999 |
178 |
#ifdef ALLOW_PROFILES_GENERICGRID |
179 |
do q = 1,NUM_INTERP_POINTS |
180 |
prof_interp_i(num_file,k,q,bi,bj) = -999 |
181 |
prof_interp_j(num_file,k,q,bi,bj) = -999 |
182 |
prof_interp_weights(num_file,k,q,bi,bj) = -999 |
183 |
enddo |
184 |
prof_interp_xC11(num_file,k,bi,bj)=-999 |
185 |
prof_interp_yC11(num_file,k,bi,bj)=-999 |
186 |
prof_interp_xCNINJ(num_file,k,bi,bj)=-999 |
187 |
prof_interp_yCNINJ(num_file,k,bi,bj)=-999 |
188 |
#endif |
189 |
enddo |
190 |
|
191 |
|
192 |
c5) main loop: look for profiles in this tile |
193 |
length_for_tile=0 |
194 |
profno_div1000=max(0,int(ProfNo(num_file,bi,bj)/1000)) |
195 |
|
196 |
do kk=1,profno_div1000+1 |
197 |
|
198 |
if (min(ProfNo(num_file,bi,bj), 1000*kk).GE. |
199 |
& 1+1000*(kk-1)) then |
200 |
|
201 |
c5.1) read a chunk |
202 |
vec_start(1)=1 |
203 |
vec_start(2)=1+1000*(kk-1) |
204 |
vec_count(1)=1 |
205 |
vec_count(2)=min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1)) |
206 |
|
207 |
if ( (vec_count(2).LE.0).OR.(vec_count(2).GT.1000).OR. |
208 |
& (vec_start(2).LE.0).OR. |
209 |
& (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file,bi,bj)) ) |
210 |
& then |
211 |
WRITE(errorMessageUnit,'(A,X,I4.4)') |
212 |
& 'ERROR in PROFILES_INIT_FIXED: #1', num_file |
213 |
stopProfiles=1. _d 0 |
214 |
endif |
215 |
|
216 |
err = NF_GET_VARA_DOUBLE(fid,varid1a,vec_start(2), |
217 |
& vec_count(2), tmpyymmdd) |
218 |
err = NF_GET_VARA_DOUBLE(fid,varid1b,vec_start(2), |
219 |
& vec_count(2), tmphhmmss) |
220 |
err = NF_GET_VARA_DOUBLE(fid,varid2,vec_start(2), |
221 |
& vec_count(2), tmp_lon2) |
222 |
err = NF_GET_VARA_DOUBLE(fid,varid3,vec_start(2), |
223 |
& vec_count(2), tmp_lat2) |
224 |
|
225 |
if (err.NE.NF_NOERR) then |
226 |
WRITE(errorMessageUnit,'(A,X,I4.4)') |
227 |
& 'ERROR in PROFILES_INIT_FIXED: #2', num_file |
228 |
stopProfiles=1. _d 0 |
229 |
endif |
230 |
|
231 |
#ifdef ALLOW_PROFILES_GENERICGRID |
232 |
err = NF_GET_VARA_DOUBLE(fid,varid_intp1,vec_start(2), |
233 |
& vec_count(2), tmp_xC11) |
234 |
err = NF_GET_VARA_DOUBLE(fid,varid_intp2,vec_start(2), |
235 |
& vec_count(2), tmp_yC11) |
236 |
err = NF_GET_VARA_DOUBLE(fid,varid_intp11,vec_start(2), |
237 |
& vec_count(2), tmp_xCNINJ) |
238 |
err = NF_GET_VARA_DOUBLE(fid,varid_intp22,vec_start(2), |
239 |
& vec_count(2), tmp_yCNINJ) |
240 |
do q=1,NUM_INTERP_POINTS |
241 |
vec_start2(1)=q |
242 |
vec_start2(2)=1+1000*(kk-1) |
243 |
vec_count2(1)=1 |
244 |
vec_count2(2)=min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1)) |
245 |
err = NF_GET_VARA_DOUBLE(fid,varid_intp3,vec_start2, |
246 |
& vec_count2, tmp_weights(1,q)) |
247 |
err = NF_GET_VARA_DOUBLE(fid,varid_intp4,vec_start2, |
248 |
& vec_count2, tmp_i(1,q)) |
249 |
err = NF_GET_VARA_DOUBLE(fid,varid_intp5,vec_start2, |
250 |
& vec_count2, tmp_j(1,q)) |
251 |
enddo |
252 |
#endif |
253 |
|
254 |
c5.2) loop through this chunk |
255 |
do k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1)) |
256 |
|
257 |
if ( stopProfiles .EQ. 0.) then |
258 |
|
259 |
call cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)), |
260 |
& tmpdate,mythid ) |
261 |
call cal_TimePassed( modelstartdate,tmpdate,tmpdiff,mythid ) |
262 |
call cal_ToSeconds (tmpdiff,diffsecs,mythid) |
263 |
diffsecs=diffsecs+nIter0*deltaTclock |
264 |
|
265 |
#ifndef ALLOW_PROFILES_GENERICGRID |
266 |
if (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) then |
267 |
tmp_lon=xC(sNx+1,1,bi,bj)+360 |
268 |
else |
269 |
tmp_lon=xC(sNx+1,1,bi,bj) |
270 |
endif |
271 |
if ((xC(1,1,bi,bj).LE.tmp_lon2(k)).AND. |
272 |
& (tmp_lon.GT.tmp_lon2(k)).AND. |
273 |
& (yC(1,1,bi,bj).LE.tmp_lat2(k)).AND. |
274 |
& (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k)) |
275 |
& ) then |
276 |
length_for_tile=length_for_tile+1 |
277 |
prof_time(num_file,length_for_tile,bi,bj)=diffsecs |
278 |
prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k) |
279 |
prof_lat(num_file,length_for_tile,bi,bj)=tmp_lat2(k) |
280 |
prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1) |
281 |
if (length_for_tile.EQ.NOBSGLOB) then |
282 |
WRITE(errorMessageUnit,'(A,X,I4.4/,3A)') |
283 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
284 |
& 'Max number of profiles reached for this tile.', |
285 |
& 'You want to increase NOBSGLOB', |
286 |
& 'or split the data file (less memory cost)' |
287 |
stopProfiles=1. _d 0 |
288 |
endif |
289 |
elseif (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) then |
290 |
if ((xC(1,1,bi,bj).LE.tmp_lon2(k)+360).AND. |
291 |
& (tmp_lon.GT.tmp_lon2(k)+360).AND. |
292 |
& (yC(1,1,bi,bj).LE.tmp_lat2(k)).AND. |
293 |
& (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k)) |
294 |
& ) then |
295 |
length_for_tile=length_for_tile+1 |
296 |
prof_time(num_file,length_for_tile,bi,bj)=diffsecs |
297 |
prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k)+360 |
298 |
prof_lat(num_file,length_for_tile,bi,bj)=tmp_lat2(k) |
299 |
prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1) |
300 |
if (length_for_tile.EQ.NOBSGLOB) then |
301 |
WRITE(errorMessageUnit,'(A,X,I4.4/,3A)') |
302 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
303 |
& 'Max number of profiles reached for this tile. ', |
304 |
& 'You want to increase NOBSGLOB ', |
305 |
& 'or split the data file (less memory cost). ' |
306 |
stopProfiles=1. _d 0 |
307 |
endif |
308 |
endif |
309 |
endif |
310 |
#else |
311 |
if (stopGenericGrid.EQ.0.) then |
312 |
|
313 |
if ( ( abs( tmp_xC11(k) - xC(1,1,bi,bj) ).LT.0.0001 ) .AND. |
314 |
& ( abs( tmp_yC11(k) - yC(1,1,bi,bj) ).LT.0.0001 ) .AND. |
315 |
& ( abs( tmp_xCNINJ(k) - xC(sNx,sNy,bi,bj) ).LT.0.0001 ) .AND. |
316 |
& ( abs( tmp_yCNINJ(k) - yC(sNx,sNy,bi,bj) ).LT.0.0001 ) ) then |
317 |
|
318 |
length_for_tile=length_for_tile+1 |
319 |
prof_time(num_file,length_for_tile,bi,bj)=diffsecs |
320 |
prof_interp_xC11(num_file,length_for_tile,bi,bj)=tmp_xC11(k) |
321 |
prof_interp_yC11(num_file,length_for_tile,bi,bj)=tmp_yC11(k) |
322 |
prof_interp_xCNINJ(num_file,length_for_tile,bi,bj)=tmp_xCNINJ(k) |
323 |
prof_interp_yCNINJ(num_file,length_for_tile,bi,bj)=tmp_yCNINJ(k) |
324 |
tmp_sum_weights=0. _d 0 |
325 |
do q = 1,NUM_INTERP_POINTS |
326 |
prof_interp_weights(num_file,length_for_tile,q,bi,bj) |
327 |
& =tmp_weights(k,q) |
328 |
prof_interp_i(num_file,length_for_tile,q,bi,bj) |
329 |
& =tmp_i(k,q) |
330 |
prof_interp_j(num_file,length_for_tile,q,bi,bj) |
331 |
& =tmp_j(k,q) |
332 |
tmp_sum_weights=tmp_sum_weights+tmp_weights(k,q) |
333 |
c more test of the inputs: is the offline-computed |
334 |
c interpolation information consistent (self and with grid) |
335 |
if ( (tmp_i(k,q).LT.0).OR.(tmp_j(k,q).LT.0) |
336 |
& .OR.(tmp_i(k,q).GT.sNx+1).OR.(tmp_j(k,q).GT.sNy+1) ) then |
337 |
WRITE(errorMessageUnit,'(A,X,I4.4/,A)') |
338 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
339 |
& 'You have out of tile+1PointOverlap interpolation points. ' |
340 |
stopGenericGrid=1. _d 0 |
341 |
endif |
342 |
if ( tmp_weights(k,q) .NE. 0. ) then |
343 |
if ( ((tmp_i(k,q).EQ.0).AND.(tmp_j(k,q).EQ.0)) |
344 |
& .OR.((tmp_i(k,q).EQ.sNx+1).AND.(tmp_j(k,q).EQ.sNy+1)) |
345 |
& .OR.((tmp_i(k,q).EQ.0).AND.(tmp_j(k,q).EQ.sNy+1)) |
346 |
& .OR.((tmp_i(k,q).EQ.sNx+1).AND.(tmp_j(k,q).EQ.0)) ) then |
347 |
WRITE(errorMessageUnit,'(A,X,I4.4/,A,/,A,/,2I4,3f5.2)') |
348 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
349 |
& 'You are using overlap corner values in interpolation. ', |
350 |
& 'Sure that you trust these? If so: comment these 3 lines. ', |
351 |
& k,q,tmp_i(k,q),tmp_j(k,q),tmp_weights(k,q) |
352 |
stopGenericGrid=1. _d 0 |
353 |
endif |
354 |
endif |
355 |
if ( (tmp_weights(k,q).LT.0).OR.(tmp_weights(k,q).GT.1) ) then |
356 |
WRITE(errorMessageUnit,'(A,X,I4.4/,A,/,2I4,f5.2)') |
357 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
358 |
& 'You have excessive interpolation coefficients. ', |
359 |
& k,q,tmp_weights(k,q) |
360 |
stopGenericGrid=1. _d 0 |
361 |
endif |
362 |
|
363 |
enddo |
364 |
|
365 |
if ( abs(tmp_sum_weights -1. ) .GT. 0.0001 ) then |
366 |
WRITE(errorMessageUnit,'(A,X,I4.4/,A,/,I4,f5.2)') |
367 |
& 'ERROR in PROFILES_INIT_FIXED: ', num_file, |
368 |
& 'Interpolation coefficients do not sum to one. ', |
369 |
& k,tmp_sum_weights |
370 |
stopGenericGrid=1. _d 0 |
371 |
endif |
372 |
|
373 |
prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1) |
374 |
if (length_for_tile.EQ.NOBSGLOB) then |
375 |
WRITE(errorMessageUnit,'(A,/,3A)') |
376 |
& 'ERROR in PROFILES_INIT_FIXED: ', |
377 |
& 'Max number of profiles reached for this tile. ', |
378 |
& 'You want to increase NOBSGLOB ', |
379 |
& 'or split the data file (less memory cost). ' |
380 |
stopProfiles=1. _d 0 |
381 |
endif |
382 |
|
383 |
endif |
384 |
endif |
385 |
#endif |
386 |
endif |
387 |
enddo |
388 |
endif |
389 |
enddo |
390 |
|
391 |
|
392 |
ProfNo(num_file,bi,bj)=length_for_tile |
393 |
|
394 |
write(msgbuf,'(a,i3,i3,i3,i5)') |
395 |
& 'fid dimid ProfNo',fid, dimid, |
396 |
& num_file, ProfNo(num_file,bi,bj) |
397 |
call print_message( |
398 |
& msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid) |
399 |
|
400 |
|
401 |
c6) available variablesin the data set |
402 |
|
403 |
do k=1,NVARMAX |
404 |
prof_num_var_cur(num_file,k,bi,bj)=0 |
405 |
enddo |
406 |
prof_num_var_tot(num_file,bi,bj)=0 |
407 |
|
408 |
err = NF_INQ_VARID(fid,'prof_T', varid1 ) |
409 |
if (err.EQ.NF_NOERR) then |
410 |
vec_quantities(num_file,1,bi,bj)=.TRUE. |
411 |
prof_num_var_tot(num_file,bi,bj)= |
412 |
& prof_num_var_tot(num_file,bi,bj)+1 |
413 |
prof_num_var_cur(num_file,1,bi,bj)= |
414 |
& prof_num_var_tot(num_file,bi,bj) |
415 |
else |
416 |
vec_quantities(num_file,1,bi,bj)=.FALSE. |
417 |
endif |
418 |
err = NF_INQ_VARID(fid,'prof_S', varid1 ) |
419 |
if (err.EQ.NF_NOERR) then |
420 |
vec_quantities(num_file,2,bi,bj)=.TRUE. |
421 |
prof_num_var_tot(num_file,bi,bj)= |
422 |
& prof_num_var_tot(num_file,bi,bj)+1 |
423 |
prof_num_var_cur(num_file,2,bi,bj)= |
424 |
& prof_num_var_tot(num_file,bi,bj) |
425 |
else |
426 |
vec_quantities(num_file,2,bi,bj)=.FALSE. |
427 |
endif |
428 |
#ifndef ALLOW_PROFILES_GENERICGRID |
429 |
err = NF_INQ_VARID(fid,'prof_U', varid1 ) |
430 |
if (err.EQ.NF_NOERR) then |
431 |
vec_quantities(num_file,3,bi,bj)=.TRUE. |
432 |
prof_num_var_tot(num_file,bi,bj)= |
433 |
& prof_num_var_tot(num_file,bi,bj)+1 |
434 |
prof_num_var_cur(num_file,3,bi,bj)= |
435 |
& prof_num_var_tot(num_file,bi,bj) |
436 |
else |
437 |
vec_quantities(num_file,3,bi,bj)=.FALSE. |
438 |
endif |
439 |
err = NF_INQ_VARID(fid,'prof_V', varid1 ) |
440 |
if (err.EQ.NF_NOERR) then |
441 |
vec_quantities(num_file,4,bi,bj)=.TRUE. |
442 |
prof_num_var_tot(num_file,bi,bj)= |
443 |
& prof_num_var_tot(num_file,bi,bj)+1 |
444 |
prof_num_var_cur(num_file,4,bi,bj)= |
445 |
& prof_num_var_tot(num_file,bi,bj) |
446 |
else |
447 |
vec_quantities(num_file,4,bi,bj)=.FALSE. |
448 |
endif |
449 |
#endif |
450 |
err = NF_INQ_VARID(fid,'prof_ptr', varid1 ) |
451 |
if (err.EQ.NF_NOERR) then |
452 |
vec_quantities(num_file,5,bi,bj)=.TRUE. |
453 |
prof_num_var_tot(num_file,bi,bj)= |
454 |
& prof_num_var_tot(num_file,bi,bj)+1 |
455 |
prof_num_var_cur(num_file,5,bi,bj)= |
456 |
& prof_num_var_tot(num_file,bi,bj) |
457 |
else |
458 |
vec_quantities(num_file,5,bi,bj)=.FALSE. |
459 |
endif |
460 |
err = NF_INQ_VARID(fid,'prof_ssh', varid1 ) |
461 |
if (err.EQ.NF_NOERR) then |
462 |
vec_quantities(num_file,6,bi,bj)=.TRUE. |
463 |
prof_num_var_tot(num_file,bi,bj)= |
464 |
& prof_num_var_tot(num_file,bi,bj)+1 |
465 |
prof_num_var_cur(num_file,6,bi,bj)= |
466 |
& prof_num_var_tot(num_file,bi,bj) |
467 |
else |
468 |
vec_quantities(num_file,6,bi,bj)=.FALSE. |
469 |
endif |
470 |
|
471 |
|
472 |
C=========================================================== |
473 |
c create files for model counterparts to observations |
474 |
C=========================================================== |
475 |
|
476 |
if (ProfNo(num_file,bi,bj).GT.0) then |
477 |
iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles |
478 |
jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles |
479 |
|
480 |
if (profilesfile_equi_type.EQ.1) then |
481 |
|
482 |
write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)') |
483 |
& profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc' |
484 |
write(adfnameequinc(1:80),'(3a,i3.3,a,i3.3,a)') 'ad', |
485 |
& profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc' |
486 |
|
487 |
inquire( file=fnameequinc, exist=exst ) |
488 |
if (.NOT.exst) then |
489 |
call profiles_init_ncfile(num_file, |
490 |
& fiddata(num_file,bi,bj),fnameequinc, |
491 |
& fidforward(num_file,bi,bj),ProfNo(num_file,bi,bj), |
492 |
& ProfDepthNo(num_file,bi,bj), |
493 |
& bi,bj,myThid) |
494 |
call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj), |
495 |
& adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj), |
496 |
& ProfDepthNo(num_file,bi,bj),bi,bj, myThid) |
497 |
else |
498 |
err = NF_OPEN(fnameequinc,NF_WRITE,fidforward(num_file,bi,bj)) |
499 |
err = NF_OPEN(adfnameequinc,NF_WRITE,fidadjoint(num_file,bi,bj)) |
500 |
endif |
501 |
|
502 |
else |
503 |
|
504 |
write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)') |
505 |
& profilesfile(1:IL),'.',iG,'.',jG,'.equi.data' |
506 |
write(adfnameequinc(1:80),'(3a,i3.3,a,i3.3,a)') 'ad', |
507 |
& profilesfile(1:IL),'.',iG,'.',jG,'.equi.data' |
508 |
|
509 |
inquire( file=fnameequinc, exist=exst ) |
510 |
if (.NOT.exst) then |
511 |
call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj), |
512 |
& fnameequinc,fidforward(num_file,bi,bj), |
513 |
& ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj), |
514 |
& bi,bj,myThid) |
515 |
call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj), |
516 |
& adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj), |
517 |
& ProfDepthNo(num_file,bi,bj),bi,bj, myThid) |
518 |
else |
519 |
call MDSFINDUNIT( fidforward(num_file,bi,bj) , mythid ) |
520 |
open( fidforward(num_file,bi,bj),file=fnameequinc, |
521 |
& form ='unformatted',status='unknown', access='direct', |
522 |
& recl= (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 ) |
523 |
call MDSFINDUNIT( fidadjoint(num_file,bi,bj) , mythid ) |
524 |
open( fidadjoint(num_file,bi,bj),file=adfnameequinc, |
525 |
& form ='unformatted',status='unknown', access='direct', |
526 |
& recl= (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 ) |
527 |
endif |
528 |
|
529 |
endif |
530 |
|
531 |
endif |
532 |
|
533 |
|
534 |
C=========================================================== |
535 |
else |
536 |
ProfNo(num_file,bi,bj)=0 |
537 |
do k=1,NVARMAX |
538 |
prof_num_var_cur(num_file,k,bi,bj)=0 |
539 |
vec_quantities(num_file,k,bi,bj)=.FALSE. |
540 |
enddo |
541 |
prof_num_var_tot(num_file,bi,bj)=0 |
542 |
do k=1,NOBSGLOB |
543 |
prof_time(num_file,k,bi,bj)=-999 |
544 |
prof_lon(num_file,k,bi,bj)=-999 |
545 |
prof_lat(num_file,k,bi,bj)=-999 |
546 |
prof_ind_glob(num_file,k,bi,bj)=-999 |
547 |
#ifdef ALLOW_PROFILES_GENERICGRID |
548 |
do q = 1,NUM_INTERP_POINTS |
549 |
prof_interp_i(num_file,k,q,bi,bj) = -999 |
550 |
prof_interp_j(num_file,k,q,bi,bj) = -999 |
551 |
prof_interp_weights(num_file,k,q,bi,bj) = -999 |
552 |
enddo |
553 |
prof_interp_xC11(num_file,k,bi,bj)=-999 |
554 |
prof_interp_yC11(num_file,k,bi,bj)=-999 |
555 |
prof_interp_xCNINJ(num_file,k,bi,bj)=-999 |
556 |
prof_interp_yCNINJ(num_file,k,bi,bj)=-999 |
557 |
#endif |
558 |
enddo |
559 |
|
560 |
endif !if (IL.NE.0) then |
561 |
enddo ! do num_file=1,NFILESPROFMAX |
562 |
|
563 |
C=========================================================== |
564 |
C error cases: |
565 |
C=========================================================== |
566 |
|
567 |
#ifdef ALLOW_PROFILES_GENERICGRID |
568 |
|
569 |
c1) you want to provide interpolation information |
570 |
|
571 |
if ( stopGenericGrid.EQ.2.) then |
572 |
iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles |
573 |
jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles |
574 |
cgf XC grid |
575 |
call MDSFINDUNIT( fid , mythid ) |
576 |
write(fnameequinc(1:80),'(a,i3.3,a,i3.3,a,i4.4,a,i4.4,a)') |
577 |
& 'profilesXCincl1PointOverlap.',iG,'.',jG,'.',sNx,'.',sNy,'.data' |
578 |
k=MDS_RECLEN(64,(sNx+2)*(sNy+2),mythid) |
579 |
WRITE(standardMessageUnit,'(A,/,2A)') |
580 |
& 'PROFILES_INIT_FIXED: creating grid from profiles; file:', |
581 |
& fnameequinc |
582 |
open( fid, file= fnameequinc, form ='unformatted', |
583 |
& status='unknown',access='direct', recl= k) |
584 |
DO m=0,sNy+1 |
585 |
DO l=0,sNx+1 |
586 |
xy_buffer_r8(l,m)=xC(l,m,bi,bj) |
587 |
ENDDO |
588 |
ENDDO |
589 |
#ifdef _BYTESWAPIO |
590 |
call MDS_BYTESWAPR8((sNx+2)*(sNy+2),xy_buffer_r8) |
591 |
#endif |
592 |
write(fid,rec=1) xy_buffer_r8 |
593 |
close(fid) |
594 |
cgf YC grid |
595 |
call MDSFINDUNIT( fid , mythid ) |
596 |
write(fnameequinc(1:80),'(a,i3.3,a,i3.3,a,i4.4,a,i4.4,a)') |
597 |
& 'profilesYCincl1PointOverlap.',iG,'.',jG,'.',sNx,'.',sNy,'.data' |
598 |
k=MDS_RECLEN(64,(sNx+2)*(sNy+2),mythid) |
599 |
WRITE(standardMessageUnit,'(A,/,A)') |
600 |
& 'PROFILES_INIT_FIXED: creating grid from profiles; file:', |
601 |
& fnameequinc |
602 |
open( fid, file= fnameequinc, form ='unformatted', |
603 |
& status='unknown', access='direct', recl= k) |
604 |
DO m=0,sNy+1 |
605 |
DO l=0,sNx+1 |
606 |
xy_buffer_r8(l,m)=yC(l,m,bi,bj) |
607 |
ENDDO |
608 |
ENDDO |
609 |
#ifdef _BYTESWAPIO |
610 |
call MDS_BYTESWAPR8((sNx+2)*(sNy+2),xy_buffer_r8) |
611 |
#endif |
612 |
write(fid,rec=1) xy_buffer_r8 |
613 |
close(fid) |
614 |
WRITE(errorMessageUnit,'(A,/,2A,/A,/,A,/,A)') |
615 |
& 'ERROR in PROFILES_INIT_FIXED : ', |
616 |
& 'when using ALLOW_PROFILES_GENERICGRID ', |
617 |
& 'you have to provide interpolation coeffs etc. ', |
618 |
& 'and THIS DEMANDS A PRE-PROCESSING OF ECCO NC FILES. ', |
619 |
& '=> see MITGCM_contrib/gael for convenient matlab scripts ', |
620 |
& 'that use profiles*incl1PointOverlap*data model outputs. ' |
621 |
|
622 |
endif |
623 |
|
624 |
#endif |
625 |
|
626 |
ENDDO |
627 |
ENDDO |
628 |
|
629 |
_END_MASTER( mythid ) |
630 |
_BARRIER |
631 |
|
632 |
c2) stop after other kind of errors |
633 |
_GLOBAL_SUM_RL( stopProfiles , myThid ) |
634 |
if ( stopProfiles.GE.1.) then |
635 |
STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED' |
636 |
endif |
637 |
#ifdef ALLOW_PROFILES_GENERICGRID |
638 |
_GLOBAL_SUM_RL( stopGenericGrid , myThid ) |
639 |
if ( stopGenericGrid.GE.1.) then |
640 |
STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED' |
641 |
endif |
642 |
#endif |
643 |
|
644 |
#endif |
645 |
|
646 |
RETURN |
647 |
END |