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

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

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

revision 1.4 by heimbach, Sat May 6 15:14:01 2006 UTC revision 1.5 by gforget, Fri Jul 14 20:19:36 2006 UTC
# Line 47  c     == external functions == Line 47  c     == external functions ==
47    
48  c--   == end of interface ==  c--   == end of interface ==
49    
50        prof_names(1)='prof_T'        DO bi = myBxLo(myThid), myBxHi(myThid)
51        prof_names(2)='prof_S'        DO bj = myByLo(myThid), myByHi(myThid)
52        prof_names(3)='prof_U'  
53        prof_names(4)='prof_V'        profiles_curfile_buff(bi,bj)=0
       prof_namesmask(1)='prof_Tmask'  
       prof_namesmask(2)='prof_Smask'  
       prof_namesmask(3)='prof_Umask'  
       prof_namesmask(4)='prof_Vmask'  
       prof_namesweight(1)='prof_Tweight'  
       prof_namesweight(2)='prof_Sweight'  
       prof_namesweight(3)='prof_Uweight'  
       prof_namesweight(4)='prof_Vweight'  
       profiles_curfile_buff=0  
       profilesfile_equi_type=2  
54    
55        do m=1,NLEVELMAX        do m=1,NLEVELMAX
56        do l=1,1000        do l=1,1000
57        do k=1,4        do k=1,4
58        profiles_data_buff(m,l,k)=0        profiles_data_buff(m,l,k,bi,bj)=0
59        profiles_weight_buff(m,l,k)=0        profiles_weight_buff(m,l,k,bi,bj)=0
60        enddo        enddo
61        enddo        enddo
62        enddo        enddo
# Line 76  c remplacer par une boucle ensuite : Line 66  c remplacer par une boucle ensuite :
66    
67        IL  = ILNBLNK( profilesfiles(num_file) )        IL  = ILNBLNK( profilesfiles(num_file) )
68        if (IL.NE.0) then        if (IL.NE.0) then
69        write(profilesfile(1:80),'(1a)') profilesfiles(num_file)(1:IL)        write(profilesfile(1:80),'(1a)')
70         & profilesfiles(num_file)(1:IL)
71        else        else
72        write(profilesfile(1:80),'(1a)') ' '        write(profilesfile(1:80),'(1a)') ' '
73        endif        endif
# Line 89  c open data files and read the position Line 80  c open data files and read the position
80  C===========================================================  C===========================================================
81    
82        write(fnamedatanc(1:80),'(2a)') profilesfile(1:IL),'.nc'        write(fnamedatanc(1:80),'(2a)') profilesfile(1:IL),'.nc'
83        err = NF_OPEN(fnamedatanc, 0, fiddata(num_file))        err = NF_OPEN(fnamedatanc, 0, fiddata(num_file,bi,bj))
84    
85  c1)  read the number of profiles :  c1)  read the number of profiles :
86  cgf      err = NF_OPEN(filename, 0, fid)  cgf      err = NF_OPEN(filename, 0, fid)
87        fid=fiddata(num_file)        fid=fiddata(num_file,bi,bj)
88        err = NF_INQ_DIMID(fid,'iPROF', dimid )        err = NF_INQ_DIMID(fid,'iPROF', dimid )
89        err = NF_INQ_DIMLEN(fid, dimid, ProfNo(num_file) )        err = NF_INQ_DIMLEN(fid, dimid, ProfNo(num_file,bi,bj) )
90        err = NF_INQ_DIMID(fid,'iDEPTH', dimid )        err = NF_INQ_DIMID(fid,'iDEPTH', dimid )
91        if (err.NE.NF_NOERR) then        if (err.NE.NF_NOERR) then
92        err = NF_INQ_DIMID(fid,'Z', dimid )        err = NF_INQ_DIMID(fid,'Z', dimid )
93        endif        endif
94        err = NF_INQ_DIMLEN(fid, dimid, ProfDepthNo(num_file) )        err = NF_INQ_DIMLEN(fid, dimid, ProfDepthNo(num_file,bi,bj) )
95        print*,"fid num_file ProfNo(num_file) ProfDepthNo(num_file)",        print*,"fid num_file ProfNo ProfDepthNo(num_file,bi,bj)",
96       &fid,num_file,ProfNo(num_file),ProfDepthNo(num_file)       &fid,num_file,ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj)
97    
98  c2) read the dates and positions :  c2) read the dates and positions :
99        err = NF_INQ_VARID(fid,'depth', varid1a )        err = NF_INQ_VARID(fid,'depth', varid1a )
100        do k=1,ProfDepthNo(num_file)        do k=1,ProfDepthNo(num_file,bi,bj)
101        err = NF_GET_VAR1_DOUBLE(fid,varid1a,k,        err = NF_GET_VAR1_DOUBLE(fid,varid1a,k,
102       & prof_depth(num_file,k))       & prof_depth(num_file,k,bi,bj))
103        enddo        enddo
104    
105        err = NF_INQ_VARID(fid,'prof_YYYYMMDD', varid1a )        err = NF_INQ_VARID(fid,'prof_YYYYMMDD', varid1a )
# Line 116  c2) read the dates and positions : Line 107  c2) read the dates and positions :
107        err = NF_INQ_VARID(fid,'prof_lon', varid2 )        err = NF_INQ_VARID(fid,'prof_lon', varid2 )
108        err = NF_INQ_VARID(fid,'prof_lat', varid3 )        err = NF_INQ_VARID(fid,'prof_lat', varid3 )
109    
110        DO bi = myBxLo(myThid), myBxHi(myThid)  c      DO bi = myBxLo(myThid), myBxHi(myThid)
111        DO bj = myByLo(myThid), myByHi(myThid)  c      DO bj = myByLo(myThid), myByHi(myThid)
112    
113        do k=1,NOBSGLOB        do k=1,NOBSGLOB
114        prof_time(num_file,k)=-999        prof_time(num_file,k,bi,bj)=-999
115        prof_lon(num_file,k)=-999        prof_lon(num_file,k,bi,bj)=-999
116        prof_lat(num_file,k)=-999        prof_lat(num_file,k,bi,bj)=-999
117        prof_ind_glob(num_file,k)=-999        prof_ind_glob(num_file,k,bi,bj)=-999
118        enddo        enddo
119    
120    
121        length_for_tile=0        length_for_tile=0
122        profno_div1000=max(0,int(profno(num_file)/1000))        profno_div1000=max(0,int(ProfNo(num_file,bi,bj)/1000))
123    
124        do kk=1,profno_div1000+1        do kk=1,profno_div1000+1
125    
126        if (min(ProfNo(num_file), 1000*kk).GE.        if (min(ProfNo(num_file,bi,bj), 1000*kk).GE.
127       &  1+1000*(kk-1)) then       &  1+1000*(kk-1)) then
128    
129        vec_start(1)=1        vec_start(1)=1
130        vec_start(2)=1+1000*(kk-1)        vec_start(2)=1+1000*(kk-1)
131        vec_count(1)=1        vec_count(1)=1
132        vec_count(2)=min(1000,ProfNo(num_file)-1000*(kk-1))        vec_count(2)=min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
133    
134        if ( (vec_count(2).LE.0).OR.(vec_count(2).GT.1000).OR.        if ( (vec_count(2).LE.0).OR.(vec_count(2).GT.1000).OR.
135       & (vec_start(2).LE.0).OR.       & (vec_start(2).LE.0).OR.
136       & (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file)) )       & (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file,bi,bj)) )
137       & then       & then
138        print*,"stop 1",vec_start, vec_count        print*,"stop 1",vec_start, vec_count
139        stop        stop
# Line 159  c2) read the dates and positions : Line 150  c2) read the dates and positions :
150    
151        if (err.NE.NF_NOERR) then        if (err.NE.NF_NOERR) then
152        print*,"stop 2",vec_start(2),vec_count(2),        print*,"stop 2",vec_start(2),vec_count(2),
153       & kk,min(1000,ProfNo(num_file)-1000*(kk-1))       & kk,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
154        stop        stop
155        endif        endif
156    
157        do k=1,min(1000,ProfNo(num_file)-1000*(kk-1))        do k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
158    
159        call cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)),        call cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)),
160       & tmpdate,mythid )       & tmpdate,bi,bj,mythid )
161        call cal_TimePassed( modelstartdate,tmpdate,tmpdiff,mythid )        call cal_TimePassed( modelstartdate,tmpdate,tmpdiff,mythid )
162        call cal_ToSeconds (tmpdiff,diffsecs,mythid)        call cal_ToSeconds (tmpdiff,diffsecs,mythid)
163        diffsecs=diffsecs+nIter0*deltaTclock        diffsecs=diffsecs+nIter0*deltaTclock
# Line 182  c2) read the dates and positions : Line 173  c2) read the dates and positions :
173       & (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))       & (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))
174       & ) then       & ) then
175          length_for_tile=length_for_tile+1          length_for_tile=length_for_tile+1
176          prof_time(num_file,length_for_tile)=diffsecs          prof_time(num_file,length_for_tile,bi,bj)=diffsecs
177          prof_lon(num_file,length_for_tile)=tmp_lon2(k)          prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k)
178          prof_lat(num_file,length_for_tile)=tmp_lat2(k)          prof_lat(num_file,length_for_tile,bi,bj)=tmp_lat2(k)
179          prof_ind_glob(num_file,length_for_tile)=k+1000*(kk-1)          prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1)
180          if (length_for_tile.GT.NOBSGLOB) then          if (length_for_tile.GT.NOBSGLOB) then
181        print*,"too much profiles: need to increase NOBSGLOB,"        print*,"too much profiles: need to increase NOBSGLOB,"
182        print*,"   or split the data file (less memory cost)"        print*,"   or split the data file (less memory cost)"
# Line 198  c2) read the dates and positions : Line 189  c2) read the dates and positions :
189       &  (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))       &  (yC(1,sNy+1,bi,bj).GT.tmp_lat2(k))
190       &  ) then       &  ) then
191           length_for_tile=length_for_tile+1           length_for_tile=length_for_tile+1
192           prof_time(num_file,length_for_tile)=diffsecs           prof_time(num_file,length_for_tile,bi,bj)=diffsecs
193           prof_lon(num_file,length_for_tile)=tmp_lon2(k)+360           prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k)+360
194           prof_lat(num_file,length_for_tile)=tmp_lat2(k)           prof_lat(num_file,length_for_tile,bi,bj)=tmp_lat2(k)
195           prof_ind_glob(num_file,length_for_tile)=k+1000*(kk-1)           prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1)
196           if (length_for_tile.GT.NOBSGLOB) then           if (length_for_tile.GT.NOBSGLOB) then
197        print*,"too much profiles: need to increase NOBSGLOB,"        print*,"too much profiles: need to increase NOBSGLOB,"
198        print*,"   or split the data file (less memory cost)"        print*,"   or split the data file (less memory cost)"
# Line 213  c2) read the dates and positions : Line 204  c2) read the dates and positions :
204        endif        endif
205        enddo        enddo
206    
207        ProfNo(num_file)=length_for_tile        ProfNo(num_file,bi,bj)=length_for_tile
208        print*,"fid dimid ProfNo(num_file)",fid, dimid,        print*,"fid dimid ProfNo(num_file,bi,bj)",fid, dimid,
209       & num_file, ProfNo(num_file)       & num_file, ProfNo(num_file,bi,bj)
210    
211        do k=1,4        do k=1,4
212        prof_num_var_cur(num_file,k)=0        prof_num_var_cur(num_file,k,bi,bj)=0
213        enddo        enddo
214        prof_num_var_tot(num_file)=0        prof_num_var_tot(num_file,bi,bj)=0
215    
216  c3) detect available data types  c3) detect available data types
217        err = NF_INQ_VARID(fid,'prof_T', varid1 )        err = NF_INQ_VARID(fid,'prof_T', varid1 )
218        if (err.EQ.NF_NOERR) then        if (err.EQ.NF_NOERR) then
219        vec_quantities(num_file,1)=.TRUE.        vec_quantities(num_file,1,bi,bj)=.TRUE.
220        prof_num_var_tot(num_file)=prof_num_var_tot(num_file)+1        prof_num_var_tot(num_file,bi,bj)=
221        prof_num_var_cur(num_file,1)=prof_num_var_tot(num_file)       & 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        else        else
225        vec_quantities(num_file,1)=.FALSE.        vec_quantities(num_file,1,bi,bj)=.FALSE.
226        endif        endif
227        err = NF_INQ_VARID(fid,'prof_S', varid1 )        err = NF_INQ_VARID(fid,'prof_S', varid1 )
228        if (err.EQ.NF_NOERR) then        if (err.EQ.NF_NOERR) then
229        vec_quantities(num_file,2)=.TRUE.        vec_quantities(num_file,2,bi,bj)=.TRUE.
230        prof_num_var_tot(num_file)=prof_num_var_tot(num_file)+1        prof_num_var_tot(num_file,bi,bj)=
231        prof_num_var_cur(num_file,2)=prof_num_var_tot(num_file)       & 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        else        else
235        vec_quantities(num_file,2)=.FALSE.        vec_quantities(num_file,2,bi,bj)=.FALSE.
236        endif        endif
237        err = NF_INQ_VARID(fid,'prof_U', varid1 )        err = NF_INQ_VARID(fid,'prof_U', varid1 )
238        if (err.EQ.NF_NOERR) then        if (err.EQ.NF_NOERR) then
239        vec_quantities(num_file,3)=.TRUE.        vec_quantities(num_file,3,bi,bj)=.TRUE.
240        prof_num_var_tot(num_file)=prof_num_var_tot(num_file)+1        prof_num_var_tot(num_file,bi,bj)=
241        prof_num_var_cur(num_file,3)=prof_num_var_tot(num_file)       & 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        else        else
245        vec_quantities(num_file,3)=.FALSE.        vec_quantities(num_file,3,bi,bj)=.FALSE.
246        endif        endif
247        err = NF_INQ_VARID(fid,'prof_V', varid1 )        err = NF_INQ_VARID(fid,'prof_V', varid1 )
248        if (err.EQ.NF_NOERR) then        if (err.EQ.NF_NOERR) then
249        vec_quantities(num_file,4)=.TRUE.        vec_quantities(num_file,4,bi,bj)=.TRUE.
250        prof_num_var_tot(num_file)=prof_num_var_tot(num_file)+1        prof_num_var_tot(num_file,bi,bj)=
251        prof_num_var_cur(num_file,4)=prof_num_var_tot(num_file)       & 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        else        else
255        vec_quantities(num_file,4)=.FALSE.        vec_quantities(num_file,4,bi,bj)=.FALSE.
256        endif        endif
257    
258    
# Line 261  C======================================= Line 260  C=======================================
260  c create files for model counterparts to observations  c create files for model counterparts to observations
261  C===========================================================  C===========================================================
262    
263             if (profno(num_file).GT.0) then               if (ProfNo(num_file,bi,bj).GT.0) then  
264           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
265           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
266    
# Line 274  C======================================= Line 273  C=======================================
273    
274        inquire( file=fnameequinc, exist=exst )        inquire( file=fnameequinc, exist=exst )
275        if (.NOT.exst) then        if (.NOT.exst) then
276        call profiles_init_ncfile(num_file,fiddata(num_file),fnameequinc,        call profiles_init_ncfile(num_file,
277       & fidforward(num_file),profno(num_file),profdepthno(num_file),       & fiddata(num_file,bi,bj),fnameequinc,
278       & myThid)       & fidforward(num_file,bi,bj),ProfNo(num_file,bi,bj),
279        call profiles_init_ncfile(num_file,fiddata(num_file),       & ProfDepthNo(num_file,bi,bj),
280       & adfnameequinc, fidadjoint(num_file),profno(num_file),       & bi,bj,myThid)
281       & profdepthno(num_file), myThid)        call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
282         & adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj),
283         & ProfDepthNo(num_file,bi,bj),bi,bj, myThid)
284        else        else
285        err = NF_OPEN(fnameequinc , NF_WRITE , fidforward(num_file) )        err = NF_OPEN(fnameequinc,NF_WRITE,fidforward(num_file,bi,bj))
286        err = NF_OPEN(adfnameequinc , NF_WRITE , fidadjoint(num_file) )        err = NF_OPEN(adfnameequinc,NF_WRITE,fidadjoint(num_file,bi,bj))
287        endif        endif
288    
289        else        else
# Line 294  C======================================= Line 295  C=======================================
295    
296        inquire( file=fnameequinc, exist=exst )        inquire( file=fnameequinc, exist=exst )
297        if (.NOT.exst) then        if (.NOT.exst) then
298        call profiles_init_ncfile(num_file,fiddata(num_file),fnameequinc,        call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
299       & fidforward(num_file),profno(num_file),profdepthno(num_file),       & fnameequinc,fidforward(num_file,bi,bj),
300       & myThid)       & ProfNo(num_file,bi,bj),ProfDepthNo(num_file,bi,bj),
301        call profiles_init_ncfile(num_file,fiddata(num_file),       & bi,bj,myThid)
302       & adfnameequinc, fidadjoint(num_file),profno(num_file),        call profiles_init_ncfile(num_file,fiddata(num_file,bi,bj),
303       & profdepthno(num_file), myThid)       & adfnameequinc, fidadjoint(num_file,bi,bj),ProfNo(num_file,bi,bj),
304         & ProfDepthNo(num_file,bi,bj),bi,bj, myThid)
305        else        else
306         call MDSFINDUNIT( fidforward(num_file) , mythid )         call MDSFINDUNIT( fidforward(num_file,bi,bj) , mythid )
307         open( fidforward(num_file),file=fnameequinc,         open( fidforward(num_file,bi,bj),file=fnameequinc,
308       & form ='unformatted',status='unknown', access='direct',       & form ='unformatted',status='unknown', access='direct',
309       & recl=  (profdepthno(num_file)+1)*WORDLENGTH*2 )       & recl=  (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
310         call MDSFINDUNIT( fidadjoint(num_file) , mythid )         call MDSFINDUNIT( fidadjoint(num_file,bi,bj) , mythid )
311         open( fidadjoint(num_file),file=adfnameequinc,         open( fidadjoint(num_file,bi,bj),file=adfnameequinc,
312       & form ='unformatted',status='unknown', access='direct',       & form ='unformatted',status='unknown', access='direct',
313       & recl=  (profdepthno(num_file)+1)*WORDLENGTH*2 )       & recl=  (ProfDepthNo(num_file,bi,bj)+1)*WORDLENGTH*2 )
314        endif        endif
315    
316        endif        endif
317    
318             endif             endif
319    
320        ENDDO  c      ENDDO
321        ENDDO  c      ENDDO
322    
323    
324  C===========================================================  C===========================================================
325        else        else
326        ProfNo(num_file)=0        ProfNo(num_file,bi,bj)=0
327        do k=1,4        do k=1,4
328        prof_num_var_cur(num_file,k)=0        prof_num_var_cur(num_file,k,bi,bj)=0
329        vec_quantities(num_file,k)=.FALSE.        vec_quantities(num_file,k,bi,bj)=.FALSE.
330        enddo        enddo
331        prof_num_var_tot(num_file)=0        prof_num_var_tot(num_file,bi,bj)=0
332        do k=1,NOBSGLOB        do k=1,NOBSGLOB
333        prof_time(num_file,k)=-999        prof_time(num_file,k,bi,bj)=-999
334        prof_lon(num_file,k)=-999        prof_lon(num_file,k,bi,bj)=-999
335        prof_lat(num_file,k)=-999        prof_lat(num_file,k,bi,bj)=-999
336        prof_ind_glob(num_file,k)=-999        prof_ind_glob(num_file,k,bi,bj)=-999
337        enddo        enddo
338    
339        endif !if (IL.NE.0) then        endif !if (IL.NE.0) then
340        enddo !      do num_file=1,NFILESPROFMAX        enddo !      do num_file=1,NFILESPROFMAX
341  C===========================================================  C===========================================================
342    
343          ENDDO
344          ENDDO
345    
346  #endif  #endif
347    
348        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22