/[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.6 - (hide annotations) (download)
Fri Jul 14 22:12:23 2006 UTC (17 years, 10 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint58n_post, checkpoint58q_post, checkpoint58o_post, checkpoint58p_post, checkpoint58m_post
Changes since 1.5: +23 -3 lines
adding ptracer and ssh

1 gforget 1.5 C $Header: /u/gcmpack/MITgcm/pkg/profiles/profiles_init_fixed.F,v 1.4 2006/05/06 15:14:01 heimbach Exp $
2 heimbach 1.3 C $Name: $
3    
4     #include "PROFILES_OPTIONS.h"
5 heimbach 1.1
6     C o==========================================================o
7     C | subroutine profiles_init_fixed |
8     C | o initialization for netcdf profiles data |
9     C | started: Gael Forget 15-March-2006 |
10     C o==========================================================o
11    
12     SUBROUTINE profiles_init_fixed( myThid )
13    
14     implicit none
15    
16     C ==================== Global Variables ===========================
17     #include "SIZE.h"
18     #include "EEPARAMS.h"
19     #include "PARAMS.h"
20     #include "GRID.h"
21     #include "DYNVARS.h"
22 heimbach 1.4 #ifdef ALLOW_CAL
23 heimbach 1.1 #include "cal.h"
24 heimbach 1.4 #endif
25 heimbach 1.3 #ifdef ALLOW_PROFILES
26 heimbach 1.1 # include "profiles.h"
27     # include "netcdf.inc"
28     #endif
29     C ==================== Routine Variables ==========================
30    
31     integer k,l,m,bi,bj,iG,jG, myThid,num_file,length_for_tile
32     integer fid, dimid, varid1, varid1a, varid1b
33     integer varid2,varid3
34     _RL tmpyymmdd(1000),tmphhmmss(1000),diffsecs
35     integer tmpdate(4),tmpdiff(4)
36     _RL tmp_lon, tmp_lon2(1000), tmp_lat2(1000)
37     integer vec_start(2), vec_count(2), profno_div1000, kk
38     character*(80) profilesfile, fnamedatanc
39     character*(80) fnameequinc, adfnameequinc
40     integer IL, err
41     logical exst
42    
43 heimbach 1.4 #ifdef ALLOW_PROFILES
44 heimbach 1.1
45     c == external functions ==
46     integer ILNBLNK
47    
48     c-- == end of interface ==
49    
50 gforget 1.5 DO bi = myBxLo(myThid), myBxHi(myThid)
51     DO bj = myByLo(myThid), myByHi(myThid)
52    
53     profiles_curfile_buff(bi,bj)=0
54 heimbach 1.1
55     do m=1,NLEVELMAX
56     do l=1,1000
57 gforget 1.6 do k=1,6
58 gforget 1.5 profiles_data_buff(m,l,k,bi,bj)=0
59     profiles_weight_buff(m,l,k,bi,bj)=0
60 heimbach 1.1 enddo
61     enddo
62     enddo
63    
64     c remplacer par une boucle ensuite :
65     do num_file=1,NFILESPROFMAX
66    
67     IL = ILNBLNK( profilesfiles(num_file) )
68     if (IL.NE.0) then
69 gforget 1.5 write(profilesfile(1:80),'(1a)')
70     & profilesfiles(num_file)(1:IL)
71 heimbach 1.1 else
72     write(profilesfile(1:80),'(1a)') ' '
73     endif
74    
75     IL = ILNBLNK( profilesfile )
76     if (IL.NE.0) then
77    
78     C===========================================================
79     c open data files and read the position vectors
80     C===========================================================
81    
82     write(fnamedatanc(1:80),'(2a)') profilesfile(1:IL),'.nc'
83 gforget 1.5 err = NF_OPEN(fnamedatanc, 0, fiddata(num_file,bi,bj))
84 heimbach 1.1
85     c1) read the number of profiles :
86     cgf err = NF_OPEN(filename, 0, fid)
87 gforget 1.5 fid=fiddata(num_file,bi,bj)
88 heimbach 1.1 err = NF_INQ_DIMID(fid,'iPROF', dimid )
89 gforget 1.5 err = NF_INQ_DIMLEN(fid, dimid, ProfNo(num_file,bi,bj) )
90 heimbach 1.1 err = NF_INQ_DIMID(fid,'iDEPTH', dimid )
91     if (err.NE.NF_NOERR) then
92     err = NF_INQ_DIMID(fid,'Z', dimid )
93     endif
94 gforget 1.5 err = NF_INQ_DIMLEN(fid, dimid, ProfDepthNo(num_file,bi,bj) )
95     print*,"fid num_file ProfNo ProfDepthNo(num_file,bi,bj)",
96     &fid,num_file,ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj)
97 heimbach 1.1
98     c2) read the dates and positions :
99     err = NF_INQ_VARID(fid,'depth', varid1a )
100 gforget 1.5 do k=1,ProfDepthNo(num_file,bi,bj)
101 heimbach 1.1 err = NF_GET_VAR1_DOUBLE(fid,varid1a,k,
102 gforget 1.5 & prof_depth(num_file,k,bi,bj))
103 heimbach 1.1 enddo
104    
105     err = NF_INQ_VARID(fid,'prof_YYYYMMDD', varid1a )
106     err = NF_INQ_VARID(fid,'prof_HHMMSS', varid1b )
107     err = NF_INQ_VARID(fid,'prof_lon', varid2 )
108     err = NF_INQ_VARID(fid,'prof_lat', varid3 )
109    
110 gforget 1.5 c DO bi = myBxLo(myThid), myBxHi(myThid)
111     c DO bj = myByLo(myThid), myByHi(myThid)
112 heimbach 1.1
113     do k=1,NOBSGLOB
114 gforget 1.5 prof_time(num_file,k,bi,bj)=-999
115     prof_lon(num_file,k,bi,bj)=-999
116     prof_lat(num_file,k,bi,bj)=-999
117     prof_ind_glob(num_file,k,bi,bj)=-999
118 heimbach 1.1 enddo
119    
120    
121     length_for_tile=0
122 gforget 1.5 profno_div1000=max(0,int(ProfNo(num_file,bi,bj)/1000))
123 heimbach 1.1
124 gforget 1.2 do kk=1,profno_div1000+1
125 heimbach 1.1
126 gforget 1.5 if (min(ProfNo(num_file,bi,bj), 1000*kk).GE.
127 heimbach 1.1 & 1+1000*(kk-1)) then
128    
129     vec_start(1)=1
130     vec_start(2)=1+1000*(kk-1)
131     vec_count(1)=1
132 gforget 1.5 vec_count(2)=min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
133 heimbach 1.1
134     if ( (vec_count(2).LE.0).OR.(vec_count(2).GT.1000).OR.
135     & (vec_start(2).LE.0).OR.
136 gforget 1.5 & (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file,bi,bj)) )
137 heimbach 1.1 & then
138     print*,"stop 1",vec_start, vec_count
139     stop
140     endif
141    
142     err = NF_GET_VARA_DOUBLE(fid,varid1a,vec_start(2),
143     & vec_count(2), tmpyymmdd)
144     err = NF_GET_VARA_DOUBLE(fid,varid1b,vec_start(2),
145     & vec_count(2), tmphhmmss)
146     err = NF_GET_VARA_DOUBLE(fid,varid2,vec_start(2),
147     & vec_count(2), tmp_lon2)
148     err = NF_GET_VARA_DOUBLE(fid,varid3,vec_start(2),
149     & vec_count(2), tmp_lat2)
150    
151     if (err.NE.NF_NOERR) then
152     print*,"stop 2",vec_start(2),vec_count(2),
153 gforget 1.5 & kk,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
154 heimbach 1.1 stop
155     endif
156    
157 gforget 1.5 do k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
158 heimbach 1.1
159     call cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)),
160 gforget 1.5 & tmpdate,bi,bj,mythid )
161 heimbach 1.1 call cal_TimePassed( modelstartdate,tmpdate,tmpdiff,mythid )
162     call cal_ToSeconds (tmpdiff,diffsecs,mythid)
163     diffsecs=diffsecs+nIter0*deltaTclock
164    
165 gforget 1.2 if (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) then
166     tmp_lon=xC(sNx+1,1,bi,bj)+360
167 heimbach 1.1 else
168 gforget 1.2 tmp_lon=xC(sNx+1,1,bi,bj)
169 heimbach 1.1 endif
170     if ((xC(1,1,bi,bj).LE.tmp_lon2(k)).AND.
171 gforget 1.2 & (tmp_lon.GT.tmp_lon2(k)).AND.
172     & (yC(1,1,bi,bj).LE.tmp_lat2(k)).AND.
173     & (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))
174     & ) then
175     length_for_tile=length_for_tile+1
176 gforget 1.5 prof_time(num_file,length_for_tile,bi,bj)=diffsecs
177     prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k)
178     prof_lat(num_file,length_for_tile,bi,bj)=tmp_lat2(k)
179     prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1)
180 gforget 1.2 if (length_for_tile.GT.NOBSGLOB) then
181     print*,"too much profiles: need to increase NOBSGLOB,"
182     print*," or split the data file (less memory cost)"
183     stop
184     endif
185     elseif (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) then
186     if ((xC(1,1,bi,bj).LE.tmp_lon2(k)+360).AND.
187     & (tmp_lon.GT.tmp_lon2(k)+360).AND.
188 heimbach 1.1 & (yC(1,1,bi,bj).LE.tmp_lat2(k)).AND.
189     & (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))
190 gforget 1.2 & ) then
191     length_for_tile=length_for_tile+1
192 gforget 1.5 prof_time(num_file,length_for_tile,bi,bj)=diffsecs
193     prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k)+360
194     prof_lat(num_file,length_for_tile,bi,bj)=tmp_lat2(k)
195     prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1)
196 gforget 1.2 if (length_for_tile.GT.NOBSGLOB) then
197 heimbach 1.1 print*,"too much profiles: need to increase NOBSGLOB,"
198     print*," or split the data file (less memory cost)"
199     stop
200 gforget 1.2 endif
201     endif
202 heimbach 1.1 endif
203     enddo
204     endif
205     enddo
206    
207 gforget 1.5 ProfNo(num_file,bi,bj)=length_for_tile
208     print*,"fid dimid ProfNo(num_file,bi,bj)",fid, dimid,
209     & num_file, ProfNo(num_file,bi,bj)
210 heimbach 1.1
211 gforget 1.6 do k=1,6
212 gforget 1.5 prof_num_var_cur(num_file,k,bi,bj)=0
213 heimbach 1.1 enddo
214 gforget 1.5 prof_num_var_tot(num_file,bi,bj)=0
215 heimbach 1.1
216     c3) detect available data types
217     err = NF_INQ_VARID(fid,'prof_T', varid1 )
218     if (err.EQ.NF_NOERR) then
219 gforget 1.5 vec_quantities(num_file,1,bi,bj)=.TRUE.
220     prof_num_var_tot(num_file,bi,bj)=
221     & prof_num_var_tot(num_file,bi,bj)+1
222     prof_num_var_cur(num_file,1,bi,bj)=
223     & prof_num_var_tot(num_file,bi,bj)
224 heimbach 1.1 else
225 gforget 1.5 vec_quantities(num_file,1,bi,bj)=.FALSE.
226 heimbach 1.1 endif
227     err = NF_INQ_VARID(fid,'prof_S', varid1 )
228     if (err.EQ.NF_NOERR) then
229 gforget 1.5 vec_quantities(num_file,2,bi,bj)=.TRUE.
230     prof_num_var_tot(num_file,bi,bj)=
231     & prof_num_var_tot(num_file,bi,bj)+1
232     prof_num_var_cur(num_file,2,bi,bj)=
233     & prof_num_var_tot(num_file,bi,bj)
234 heimbach 1.1 else
235 gforget 1.5 vec_quantities(num_file,2,bi,bj)=.FALSE.
236 heimbach 1.1 endif
237     err = NF_INQ_VARID(fid,'prof_U', varid1 )
238     if (err.EQ.NF_NOERR) then
239 gforget 1.5 vec_quantities(num_file,3,bi,bj)=.TRUE.
240     prof_num_var_tot(num_file,bi,bj)=
241     & prof_num_var_tot(num_file,bi,bj)+1
242     prof_num_var_cur(num_file,3,bi,bj)=
243     & prof_num_var_tot(num_file,bi,bj)
244 heimbach 1.1 else
245 gforget 1.5 vec_quantities(num_file,3,bi,bj)=.FALSE.
246 heimbach 1.1 endif
247     err = NF_INQ_VARID(fid,'prof_V', varid1 )
248     if (err.EQ.NF_NOERR) then
249 gforget 1.5 vec_quantities(num_file,4,bi,bj)=.TRUE.
250     prof_num_var_tot(num_file,bi,bj)=
251     & prof_num_var_tot(num_file,bi,bj)+1
252     prof_num_var_cur(num_file,4,bi,bj)=
253     & prof_num_var_tot(num_file,bi,bj)
254 heimbach 1.1 else
255 gforget 1.5 vec_quantities(num_file,4,bi,bj)=.FALSE.
256 heimbach 1.1 endif
257 gforget 1.6 err = NF_INQ_VARID(fid,'prof_ptr', varid1 )
258     if (err.EQ.NF_NOERR) then
259     vec_quantities(num_file,5,bi,bj)=.TRUE.
260     prof_num_var_tot(num_file,bi,bj)=
261     & prof_num_var_tot(num_file,bi,bj)+1
262     prof_num_var_cur(num_file,5,bi,bj)=
263     & prof_num_var_tot(num_file,bi,bj)
264     else
265     vec_quantities(num_file,5,bi,bj)=.FALSE.
266     endif
267     err = NF_INQ_VARID(fid,'prof_ssh', varid1 )
268     if (err.EQ.NF_NOERR) then
269     vec_quantities(num_file,6,bi,bj)=.TRUE.
270     prof_num_var_tot(num_file,bi,bj)=
271     & prof_num_var_tot(num_file,bi,bj)+1
272     prof_num_var_cur(num_file,6,bi,bj)=
273     & prof_num_var_tot(num_file,bi,bj)
274     else
275     vec_quantities(num_file,6,bi,bj)=.FALSE.
276     endif
277 heimbach 1.1
278    
279     C===========================================================
280     c create files for model counterparts to observations
281     C===========================================================
282    
283 gforget 1.5 if (ProfNo(num_file,bi,bj).GT.0) then
284 heimbach 1.1 iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
285     jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
286    
287     if (profilesfile_equi_type.EQ.1) then
288    
289     write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)')
290     & profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc'
291     write(adfnameequinc(1:80),'(3a,i3.3,a,i3.3,a)') 'ad',
292     & profilesfile(1:IL),'.',iG,'.',jG,'.equi.nc'
293    
294     inquire( file=fnameequinc, exist=exst )
295     if (.NOT.exst) then
296 gforget 1.5 call profiles_init_ncfile(num_file,
297     & fiddata(num_file,bi,bj),fnameequinc,
298     & fidforward(num_file,bi,bj),ProfNo(num_file,bi,bj),
299     & ProfDepthNo(num_file,bi,bj),
300     & bi,bj,myThid)
301     call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
302     & adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj),
303     & ProfDepthNo(num_file,bi,bj),bi,bj, myThid)
304 heimbach 1.1 else
305 gforget 1.5 err = NF_OPEN(fnameequinc,NF_WRITE,fidforward(num_file,bi,bj))
306     err = NF_OPEN(adfnameequinc,NF_WRITE,fidadjoint(num_file,bi,bj))
307 heimbach 1.1 endif
308    
309     else
310    
311     write(fnameequinc(1:80),'(2a,i3.3,a,i3.3,a)')
312     & profilesfile(1:IL),'.',iG,'.',jG,'.equi.bin'
313     write(adfnameequinc(1:80),'(3a,i3.3,a,i3.3,a)') 'ad',
314     & profilesfile(1:IL),'.',iG,'.',jG,'.equi.bin'
315    
316     inquire( file=fnameequinc, exist=exst )
317     if (.NOT.exst) then
318 gforget 1.5 call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
319     & fnameequinc,fidforward(num_file,bi,bj),
320     & ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
321     & bi,bj,myThid)
322     call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
323     & adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj),
324     & ProfDepthNo(num_file,bi,bj),bi,bj, myThid)
325 heimbach 1.1 else
326 gforget 1.5 call MDSFINDUNIT( fidforward(num_file,bi,bj) , mythid )
327     open( fidforward(num_file,bi,bj),file=fnameequinc,
328 heimbach 1.1 & form ='unformatted',status='unknown', access='direct',
329 gforget 1.5 & recl= (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
330     call MDSFINDUNIT( fidadjoint(num_file,bi,bj) , mythid )
331     open( fidadjoint(num_file,bi,bj),file=adfnameequinc,
332 heimbach 1.1 & form ='unformatted',status='unknown', access='direct',
333 gforget 1.5 & recl= (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
334 heimbach 1.1 endif
335    
336     endif
337    
338     endif
339    
340 gforget 1.5 c ENDDO
341     c ENDDO
342 heimbach 1.1
343    
344     C===========================================================
345     else
346 gforget 1.5 ProfNo(num_file,bi,bj)=0
347 gforget 1.6 do k=1,6
348 gforget 1.5 prof_num_var_cur(num_file,k,bi,bj)=0
349     vec_quantities(num_file,k,bi,bj)=.FALSE.
350 heimbach 1.1 enddo
351 gforget 1.5 prof_num_var_tot(num_file,bi,bj)=0
352 heimbach 1.1 do k=1,NOBSGLOB
353 gforget 1.5 prof_time(num_file,k,bi,bj)=-999
354     prof_lon(num_file,k,bi,bj)=-999
355     prof_lat(num_file,k,bi,bj)=-999
356     prof_ind_glob(num_file,k,bi,bj)=-999
357 heimbach 1.1 enddo
358    
359     endif !if (IL.NE.0) then
360     enddo ! do num_file=1,NFILESPROFMAX
361     C===========================================================
362    
363 gforget 1.5 ENDDO
364     ENDDO
365    
366 heimbach 1.1 #endif
367    
368     END
369    

  ViewVC Help
Powered by ViewVC 1.1.22