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