/[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.16 - (hide annotations) (download)
Fri May 20 22:23:53 2011 UTC (12 years, 11 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63, checkpoint62z, checkpoint62y
Changes since 1.15: +12 -8 lines
- introduce profilesDir subdirectory for pkg/profiles IO

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

  ViewVC Help
Powered by ViewVC 1.1.22