/[MITgcm]/MITgcm/pkg/profiles/profiles_init_fixed.F
ViewVC logotype

Annotation of /MITgcm/pkg/profiles/profiles_init_fixed.F

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

Revision 1.14 - (hide annotations) (download)
Mon Aug 3 14:25:50 2009 UTC (14 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62i, checkpoint62h, checkpoint61v, checkpoint61w, checkpoint61u, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.13: +34 -34 lines 
fix number of arguments in cal_FullDate call.
1 jmc 1.14 C $Header: /u/gcmpack/MITgcm/pkg/profiles/profiles_init_fixed.F,v 1.13 2009/04/28 18:18:29 jmc 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     integer IL, err
43     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     err = NF_INQ_VARID(fid,'depth', varid1a )
137 gforget 1.5 do k=1,ProfDepthNo(num_file,bi,bj)
138 heimbach 1.1 err = NF_GET_VAR1_DOUBLE(fid,varid1a,k,
139 gforget 1.5 & prof_depth(num_file,k,bi,bj))
140 heimbach 1.1 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 gforget 1.11 if (err.NE.NF_NOERR) then
148 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4,/,A)')
149     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
150 gforget 1.11 & '.nc file is not in the ECCO format'
151     stopProfiles=1. _d 0
152     endif
153    
154     #ifdef ALLOW_PROFILES_GENERICGRID
155 jmc 1.14 c3) read interpolattion information (grid points, coeffs, etc.)
156 gforget 1.11 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 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4,/,A)')
165     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
166 gforget 1.11 & 'no interpolation information found in .nc file'
167     stopGenericGrid=2. _d 0
168     endif
169     #endif
170    
171 heimbach 1.1
172 gforget 1.11 c4) default values
173 heimbach 1.1 do k=1,NOBSGLOB
174 gforget 1.5 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 gforget 1.11 #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 heimbach 1.1 enddo
190    
191    
192 gforget 1.11 c5) main loop: look for profiles in this tile
193 heimbach 1.1 length_for_tile=0
194 gforget 1.5 profno_div1000=max(0,int(ProfNo(num_file,bi,bj)/1000))
195 heimbach 1.1
196 gforget 1.2 do kk=1,profno_div1000+1
197 heimbach 1.1
198 gforget 1.5 if (min(ProfNo(num_file,bi,bj), 1000*kk).GE.
199 heimbach 1.1 & 1+1000*(kk-1)) then
200    
201 gforget 1.11 c5.1) read a chunk
202 heimbach 1.1 vec_start(1)=1
203     vec_start(2)=1+1000*(kk-1)
204     vec_count(1)=1
205 gforget 1.5 vec_count(2)=min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
206 heimbach 1.1
207     if ( (vec_count(2).LE.0).OR.(vec_count(2).GT.1000).OR.
208     & (vec_start(2).LE.0).OR.
209 jmc 1.14 & (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file,bi,bj)) )
210 heimbach 1.1 & then
211 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4)')
212     & 'ERROR in PROFILES_INIT_FIXED: #1', num_file
213 gforget 1.11 stopProfiles=1. _d 0
214 heimbach 1.1 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 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4)')
227     & 'ERROR in PROFILES_INIT_FIXED: #2', num_file
228 jmc 1.14 stopProfiles=1. _d 0
229     endif
230 heimbach 1.1
231 gforget 1.11 #ifdef ALLOW_PROFILES_GENERICGRID
232 jmc 1.14 err = NF_GET_VARA_DOUBLE(fid,varid_intp1,vec_start(2),
233 gforget 1.11 & vec_count(2), tmp_xC11)
234 jmc 1.14 err = NF_GET_VARA_DOUBLE(fid,varid_intp2,vec_start(2),
235 gforget 1.11 & vec_count(2), tmp_yC11)
236     err = NF_GET_VARA_DOUBLE(fid,varid_intp11,vec_start(2),
237     & vec_count(2), tmp_xCNINJ)
238 jmc 1.14 err = NF_GET_VARA_DOUBLE(fid,varid_intp22,vec_start(2),
239 gforget 1.11 & 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 jmc 1.14 err = NF_GET_VARA_DOUBLE(fid,varid_intp3,vec_start2,
246 gforget 1.11 & vec_count2, tmp_weights(1,q))
247 jmc 1.14 err = NF_GET_VARA_DOUBLE(fid,varid_intp4,vec_start2,
248 gforget 1.11 & vec_count2, tmp_i(1,q))
249 jmc 1.14 err = NF_GET_VARA_DOUBLE(fid,varid_intp5,vec_start2,
250 gforget 1.11 & vec_count2, tmp_j(1,q))
251     enddo
252     #endif
253    
254     c5.2) loop through this chunk
255 gforget 1.5 do k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
256 heimbach 1.1
257 gforget 1.11 if ( stopProfiles .EQ. 0.) then
258    
259 heimbach 1.1 call cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)),
260 jmc 1.14 & tmpdate,mythid )
261 heimbach 1.1 call cal_TimePassed( modelstartdate,tmpdate,tmpdiff,mythid )
262     call cal_ToSeconds (tmpdiff,diffsecs,mythid)
263     diffsecs=diffsecs+nIter0*deltaTclock
264    
265 gforget 1.11 #ifndef ALLOW_PROFILES_GENERICGRID
266 gforget 1.2 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 heimbach 1.1 else
269 gforget 1.2 tmp_lon=xC(sNx+1,1,bi,bj)
270 heimbach 1.1 endif
271     if ((xC(1,1,bi,bj).LE.tmp_lon2(k)).AND.
272 gforget 1.2 & (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 gforget 1.5 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 gforget 1.11 if (length_for_tile.EQ.NOBSGLOB) then
282 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4/,3A)')
283     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
284 gforget 1.11 & '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 gforget 1.2 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 heimbach 1.1 & (yC(1,1,bi,bj).LE.tmp_lat2(k)).AND.
293     & (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))
294 gforget 1.2 & ) then
295     length_for_tile=length_for_tile+1
296 gforget 1.5 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 gforget 1.11 if (length_for_tile.EQ.NOBSGLOB) then
301 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4/,3A)')
302     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
303 gforget 1.11 & '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 gforget 1.2 endif
308     endif
309 heimbach 1.1 endif
310 gforget 1.11 #else
311     if (stopGenericGrid.EQ.0.) then
312    
313     if ( ( abs( tmp_xC11(k) - xC(1,1,bi,bj) ).LT.0.0001 ) .AND.
314 jmc 1.14 & ( abs( tmp_yC11(k) - yC(1,1,bi,bj) ).LT.0.0001 ) .AND.
315 gforget 1.11 & ( 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 jmc 1.14 c more test of the inputs: is the offline-computed
334 gforget 1.11 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 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4/,A)')
338     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
339 gforget 1.11 & '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 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4/,A,/,A,/,2I4,3f5.2)')
348     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
349 gforget 1.11 & '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 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4/,A,/,2I4,f5.2)')
357     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
358 gforget 1.11 & '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 heimbach 1.12 WRITE(errorMessageUnit,'(A,X,I4.4/,A,/,I4,f5.2)')
367     & 'ERROR in PROFILES_INIT_FIXED: ', num_file,
368 gforget 1.11 & '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 heimbach 1.1 enddo
388     endif
389     enddo
390    
391 jmc 1.14
392 gforget 1.5 ProfNo(num_file,bi,bj)=length_for_tile
393 gforget 1.11
394     write(msgbuf,'(a,i3,i3,i3,i5)')
395     & 'fid dimid ProfNo',fid, dimid,
396 gforget 1.5 & num_file, ProfNo(num_file,bi,bj)
397 gforget 1.11 call print_message(
398     & msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid)
399    
400    
401     c6) available variablesin the data set
402 heimbach 1.1
403 gforget 1.7 do k=1,NVARMAX
404 gforget 1.5 prof_num_var_cur(num_file,k,bi,bj)=0
405 heimbach 1.1 enddo
406 gforget 1.5 prof_num_var_tot(num_file,bi,bj)=0
407 heimbach 1.1
408     err = NF_INQ_VARID(fid,'prof_T', varid1 )
409     if (err.EQ.NF_NOERR) then
410 gforget 1.5 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 heimbach 1.1 else
416 gforget 1.5 vec_quantities(num_file,1,bi,bj)=.FALSE.
417 heimbach 1.1 endif
418     err = NF_INQ_VARID(fid,'prof_S', varid1 )
419     if (err.EQ.NF_NOERR) then
420 gforget 1.5 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 heimbach 1.1 else
426 gforget 1.5 vec_quantities(num_file,2,bi,bj)=.FALSE.
427 heimbach 1.1 endif
428 gforget 1.11 #ifndef ALLOW_PROFILES_GENERICGRID
429 heimbach 1.1 err = NF_INQ_VARID(fid,'prof_U', varid1 )
430     if (err.EQ.NF_NOERR) then
431 gforget 1.5 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 heimbach 1.1 else
437 gforget 1.5 vec_quantities(num_file,3,bi,bj)=.FALSE.
438 heimbach 1.1 endif
439     err = NF_INQ_VARID(fid,'prof_V', varid1 )
440     if (err.EQ.NF_NOERR) then
441 gforget 1.5 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 heimbach 1.1 else
447 gforget 1.5 vec_quantities(num_file,4,bi,bj)=.FALSE.
448 heimbach 1.1 endif
449 gforget 1.11 #endif
450 gforget 1.6 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 heimbach 1.1
471    
472     C===========================================================
473     c create files for model counterparts to observations
474     C===========================================================
475    
476 jmc 1.14 if (ProfNo(num_file,bi,bj).GT.0) then
477 heimbach 1.1 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 jmc 1.14
482     write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)')
483 heimbach 1.1 & 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 gforget 1.5 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 heimbach 1.1 else
498 gforget 1.5 err = NF_OPEN(fnameequinc,NF_WRITE,fidforward(num_file,bi,bj))
499     err = NF_OPEN(adfnameequinc,NF_WRITE,fidadjoint(num_file,bi,bj))
500 heimbach 1.1 endif
501    
502     else
503    
504     write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)')
505 jmc 1.10 & profilesfile(1:IL),'.',iG,'.',jG,'.equi.data'
506 heimbach 1.1 write(adfnameequinc(1:80),'(3a,i3.3,a,i3.3,a)') 'ad',
507 jmc 1.10 & profilesfile(1:IL),'.',iG,'.',jG,'.equi.data'
508 heimbach 1.1
509     inquire( file=fnameequinc, exist=exst )
510     if (.NOT.exst) then
511 gforget 1.5 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 heimbach 1.1 else
519 gforget 1.5 call MDSFINDUNIT( fidforward(num_file,bi,bj) , mythid )
520 jmc 1.14 open( fidforward(num_file,bi,bj),file=fnameequinc,
521 heimbach 1.1 & form ='unformatted',status='unknown', access='direct',
522 gforget 1.5 & 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 heimbach 1.1 & form ='unformatted',status='unknown', access='direct',
526 gforget 1.5 & recl= (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
527 heimbach 1.1 endif
528    
529     endif
530    
531     endif
532    
533    
534     C===========================================================
535     else
536 gforget 1.5 ProfNo(num_file,bi,bj)=0
537 gforget 1.7 do k=1,NVARMAX
538 gforget 1.5 prof_num_var_cur(num_file,k,bi,bj)=0
539     vec_quantities(num_file,k,bi,bj)=.FALSE.
540 heimbach 1.1 enddo
541 gforget 1.5 prof_num_var_tot(num_file,bi,bj)=0
542 heimbach 1.1 do k=1,NOBSGLOB
543 gforget 1.5 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 gforget 1.11 #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 jmc 1.14 #endif
558 heimbach 1.1 enddo
559    
560     endif !if (IL.NE.0) then
561     enddo ! do num_file=1,NFILESPROFMAX
562 gforget 1.11
563     C===========================================================
564     C error cases:
565 heimbach 1.1 C===========================================================
566    
567 gforget 1.11 #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 jmc 1.14 open( fid, file= fnameequinc, form ='unformatted',
583 gforget 1.11 & 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 jmc 1.14 open( fid, file= fnameequinc, form ='unformatted',
603 gforget 1.11 & 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 jmc 1.14 & 'when using ALLOW_PROFILES_GENERICGRID ',
617     & 'you have to provide interpolation coeffs etc. ',
618 gforget 1.11 & '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 gforget 1.5 ENDDO
627     ENDDO
628    
629 gforget 1.11 _END_MASTER( mythid )
630     _BARRIER
631    
632     c2) stop after other kind of errors
633 jmc 1.13 _GLOBAL_SUM_RL( stopProfiles , myThid )
634 gforget 1.11 if ( stopProfiles.GE.1.) then
635     STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
636     endif
637     #ifdef ALLOW_PROFILES_GENERICGRID
638 jmc 1.13 _GLOBAL_SUM_RL( stopGenericGrid , myThid )
639 gforget 1.11 if ( stopGenericGrid.GE.1.) then
640     STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
641     endif
642     #endif
643    
644 heimbach 1.1 #endif
645    
646 jmc 1.14 RETURN
647 heimbach 1.1 END
  ViewVC Help
Powered by ViewVC 1.1.22