/[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.15 - (hide annotations) (download)
Tue Aug 24 02:49:57 2010 UTC (13 years, 9 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint62k, checkpoint62j, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62x
Changes since 1.14: +14 -2 lines 
New input files convention: prof_depth replaces depth.
Change in profiles_init_fixed.F ensures backward compatibility.
1 gforget 1.15 C $Header: /u/gcmpack/MITgcm/pkg/profiles/profiles_init_fixed.F,v 1.14 2009/08/03 14:25:50 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 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     if (profilesfile_equi_type.EQ.1) then
493 jmc 1.14
494     write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)')
495 heimbach 1.1 & profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc'
496     write(adfnameequinc(1:80),'(3a,i3.3,a,i3.3,a)') 'ad',
497     & profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc'
498    
499     inquire( file=fnameequinc, exist=exst )
500     if (.NOT.exst) then
501 gforget 1.5 call profiles_init_ncfile(num_file,
502     & fiddata(num_file,bi,bj),fnameequinc,
503     & fidforward(num_file,bi,bj),ProfNo(num_file,bi,bj),
504     & ProfDepthNo(num_file,bi,bj),
505     & bi,bj,myThid)
506     call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
507     & adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj),
508     & ProfDepthNo(num_file,bi,bj),bi,bj, myThid)
509 heimbach 1.1 else
510 gforget 1.5 err = NF_OPEN(fnameequinc,NF_WRITE,fidforward(num_file,bi,bj))
511     err = NF_OPEN(adfnameequinc,NF_WRITE,fidadjoint(num_file,bi,bj))
512 heimbach 1.1 endif
513    
514     else
515    
516     write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)')
517 jmc 1.10 & profilesfile(1:IL),'.',iG,'.',jG,'.equi.data'
518 heimbach 1.1 write(adfnameequinc(1:80),'(3a,i3.3,a,i3.3,a)') 'ad',
519 jmc 1.10 & profilesfile(1:IL),'.',iG,'.',jG,'.equi.data'
520 heimbach 1.1
521     inquire( file=fnameequinc, exist=exst )
522     if (.NOT.exst) then
523 gforget 1.5 call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
524     & fnameequinc,fidforward(num_file,bi,bj),
525     & ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
526     & bi,bj,myThid)
527     call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
528     & adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj),
529     & ProfDepthNo(num_file,bi,bj),bi,bj, myThid)
530 heimbach 1.1 else
531 gforget 1.5 call MDSFINDUNIT( fidforward(num_file,bi,bj) , mythid )
532 jmc 1.14 open( fidforward(num_file,bi,bj),file=fnameequinc,
533 heimbach 1.1 & form ='unformatted',status='unknown', access='direct',
534 gforget 1.5 & recl= (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
535     call MDSFINDUNIT( fidadjoint(num_file,bi,bj) , mythid )
536     open( fidadjoint(num_file,bi,bj),file=adfnameequinc,
537 heimbach 1.1 & form ='unformatted',status='unknown', access='direct',
538 gforget 1.5 & recl= (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
539 heimbach 1.1 endif
540    
541     endif
542    
543     endif
544    
545    
546     C===========================================================
547     else
548 gforget 1.5 ProfNo(num_file,bi,bj)=0
549 gforget 1.7 do k=1,NVARMAX
550 gforget 1.5 prof_num_var_cur(num_file,k,bi,bj)=0
551     vec_quantities(num_file,k,bi,bj)=.FALSE.
552 heimbach 1.1 enddo
553 gforget 1.5 prof_num_var_tot(num_file,bi,bj)=0
554 heimbach 1.1 do k=1,NOBSGLOB
555 gforget 1.5 prof_time(num_file,k,bi,bj)=-999
556     prof_lon(num_file,k,bi,bj)=-999
557     prof_lat(num_file,k,bi,bj)=-999
558     prof_ind_glob(num_file,k,bi,bj)=-999
559 gforget 1.11 #ifdef ALLOW_PROFILES_GENERICGRID
560     do q = 1,NUM_INTERP_POINTS
561     prof_interp_i(num_file,k,q,bi,bj) = -999
562     prof_interp_j(num_file,k,q,bi,bj) = -999
563     prof_interp_weights(num_file,k,q,bi,bj) = -999
564     enddo
565     prof_interp_xC11(num_file,k,bi,bj)=-999
566     prof_interp_yC11(num_file,k,bi,bj)=-999
567     prof_interp_xCNINJ(num_file,k,bi,bj)=-999
568     prof_interp_yCNINJ(num_file,k,bi,bj)=-999
569 jmc 1.14 #endif
570 heimbach 1.1 enddo
571    
572     endif !if (IL.NE.0) then
573     enddo ! do num_file=1,NFILESPROFMAX
574 gforget 1.11
575     C===========================================================
576     C error cases:
577 heimbach 1.1 C===========================================================
578    
579 gforget 1.11 #ifdef ALLOW_PROFILES_GENERICGRID
580    
581     c1) you want to provide interpolation information
582    
583     if ( stopGenericGrid.EQ.2.) then
584     iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
585     jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
586     cgf XC grid
587     call MDSFINDUNIT( fid , mythid )
588     write(fnameequinc(1:80),'(a,i3.3,a,i3.3,a,i4.4,a,i4.4,a)')
589     & 'profilesXCincl1PointOverlap.',iG,'.',jG,'.',sNx,'.',sNy,'.data'
590     k=MDS_RECLEN(64,(sNx+2)*(sNy+2),mythid)
591     WRITE(standardMessageUnit,'(A,/,2A)')
592     & 'PROFILES_INIT_FIXED: creating grid from profiles; file:',
593     & fnameequinc
594 jmc 1.14 open( fid, file= fnameequinc, form ='unformatted',
595 gforget 1.11 & status='unknown',access='direct', recl= k)
596     DO m=0,sNy+1
597     DO l=0,sNx+1
598     xy_buffer_r8(l,m)=xC(l,m,bi,bj)
599     ENDDO
600     ENDDO
601     #ifdef _BYTESWAPIO
602     call MDS_BYTESWAPR8((sNx+2)*(sNy+2),xy_buffer_r8)
603     #endif
604     write(fid,rec=1) xy_buffer_r8
605     close(fid)
606     cgf YC grid
607     call MDSFINDUNIT( fid , mythid )
608     write(fnameequinc(1:80),'(a,i3.3,a,i3.3,a,i4.4,a,i4.4,a)')
609     & 'profilesYCincl1PointOverlap.',iG,'.',jG,'.',sNx,'.',sNy,'.data'
610     k=MDS_RECLEN(64,(sNx+2)*(sNy+2),mythid)
611     WRITE(standardMessageUnit,'(A,/,A)')
612     & 'PROFILES_INIT_FIXED: creating grid from profiles; file:',
613     & fnameequinc
614 jmc 1.14 open( fid, file= fnameequinc, form ='unformatted',
615 gforget 1.11 & status='unknown', access='direct', recl= k)
616     DO m=0,sNy+1
617     DO l=0,sNx+1
618     xy_buffer_r8(l,m)=yC(l,m,bi,bj)
619     ENDDO
620     ENDDO
621     #ifdef _BYTESWAPIO
622     call MDS_BYTESWAPR8((sNx+2)*(sNy+2),xy_buffer_r8)
623     #endif
624     write(fid,rec=1) xy_buffer_r8
625     close(fid)
626     WRITE(errorMessageUnit,'(A,/,2A,/A,/,A,/,A)')
627     & 'ERROR in PROFILES_INIT_FIXED : ',
628 jmc 1.14 & 'when using ALLOW_PROFILES_GENERICGRID ',
629     & 'you have to provide interpolation coeffs etc. ',
630 gforget 1.11 & 'and THIS DEMANDS A PRE-PROCESSING OF ECCO NC FILES. ',
631     & '=> see MITGCM_contrib/gael for convenient matlab scripts ',
632     & 'that use profiles*incl1PointOverlap*data model outputs. '
633    
634     endif
635    
636     #endif
637    
638 gforget 1.5 ENDDO
639     ENDDO
640    
641 gforget 1.11 _END_MASTER( mythid )
642     _BARRIER
643    
644     c2) stop after other kind of errors
645 jmc 1.13 _GLOBAL_SUM_RL( stopProfiles , myThid )
646 gforget 1.11 if ( stopProfiles.GE.1.) then
647     STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
648     endif
649     #ifdef ALLOW_PROFILES_GENERICGRID
650 jmc 1.13 _GLOBAL_SUM_RL( stopGenericGrid , myThid )
651 gforget 1.11 if ( stopGenericGrid.GE.1.) then
652     STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
653     endif
654     #endif
655    
656 heimbach 1.1 #endif
657    
658 jmc 1.14 RETURN
659 heimbach 1.1 END
  ViewVC Help
Powered by ViewVC 1.1.22