/[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.10 by jmc, Mon Feb 19 22:44:05 2007 UTC revision 1.11 by gforget, Fri Jun 15 05:04:01 2007 UTC
# Line 7  C     o================================= Line 7  C     o=================================
7  C     | subroutine profiles_init_fixed                           |  C     | subroutine profiles_init_fixed                           |
8  C     | o initialization for netcdf profiles data                |  C     | o initialization for netcdf profiles data                |
9  C     | started: Gael Forget 15-March-2006                       |  C     | started: Gael Forget 15-March-2006                       |
10    C     | extended: Gael Forget 14-June-2007                       |
11  C     o==========================================================o  C     o==========================================================o
12    
13        SUBROUTINE profiles_init_fixed( myThid )        SUBROUTINE profiles_init_fixed( myThid )
# Line 28  C ==================== Global Variables Line 29  C ==================== Global Variables
29  #endif  #endif
30  C ==================== Routine Variables ==========================  C ==================== Routine Variables ==========================
31    
32        integer k,l,m,bi,bj,iG,jG, myThid,num_file,length_for_tile        integer k,l,m,q,bi,bj,iG,jG, myThid,num_file,length_for_tile
33          _RL stopProfiles
34        integer fid, dimid, varid1, varid1a, varid1b        integer fid, dimid, varid1, varid1a, varid1b
35        integer varid2,varid3        integer varid2,varid3
36        _RL tmpyymmdd(1000),tmphhmmss(1000),diffsecs        _RL tmpyymmdd(1000),tmphhmmss(1000),diffsecs
# Line 42  C ==================== Routine Variables Line 44  C ==================== Routine Variables
44    
45  #ifdef ALLOW_PROFILES  #ifdef ALLOW_PROFILES
46    
47    #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  c     == external functions ==  c     == external functions ==
61        integer ILNBLNK        integer ILNBLNK
62          integer MDS_RECLEN
63        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
64    
65  c--   == end of interface ==  c--   == end of interface ==
66    
67        DO bi = myBxLo(myThid), myBxHi(myThid)        stopProfiles=0. _d 0
68        DO bj = myByLo(myThid), myByHi(myThid)  #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    
76        profiles_curfile_buff(bi,bj)=0        profiles_curfile_buff(bi,bj)=0
77    
# Line 62  c--   == end of interface == Line 84  c--   == end of interface ==
84        enddo        enddo
85        enddo        enddo
86    
 c remplacer par une boucle ensuite :  
87        do num_file=1,NFILESPROFMAX        do num_file=1,NFILESPROFMAX
88    
89        IL  = ILNBLNK( profilesfiles(num_file) )        IL  = ILNBLNK( profilesfiles(num_file) )
# Line 85  c remplacer par une boucle ensuite : Line 106  c remplacer par une boucle ensuite :
106        if (IL.NE.0) then        if (IL.NE.0) then
107    
108  C===========================================================  C===========================================================
109  c open data files and read the position vectors  c open data files and read information
110  C===========================================================  C===========================================================
111    
112        write(fnamedatanc(1:80),'(2a)') profilesfile(1:IL),'.nc'        write(fnamedatanc(1:80),'(2a)') profilesfile(1:IL),'.nc'
# Line 96  C======================================= Line 117  C=======================================
117        err = NF_OPEN(fnamedatanc, 0, fiddata(num_file,bi,bj))        err = NF_OPEN(fnamedatanc, 0, fiddata(num_file,bi,bj))
118    
119  c1)  read the number of profiles :  c1)  read the number of profiles :
 cgf      err = NF_OPEN(filename, 0, fid)  
120        fid=fiddata(num_file,bi,bj)        fid=fiddata(num_file,bi,bj)
121        err = NF_INQ_DIMID(fid,'iPROF', dimid )        err = NF_INQ_DIMID(fid,'iPROF', dimid )
122        err = NF_INQ_DIMLEN(fid, dimid, ProfNo(num_file,bi,bj) )        err = NF_INQ_DIMLEN(fid, dimid, ProfNo(num_file,bi,bj) )
# Line 124  c2) read the dates and positions : Line 144  c2) read the dates and positions :
144        err = NF_INQ_VARID(fid,'prof_lon', varid2 )        err = NF_INQ_VARID(fid,'prof_lon', varid2 )
145        err = NF_INQ_VARID(fid,'prof_lat', varid3 )        err = NF_INQ_VARID(fid,'prof_lat', varid3 )
146    
147  c      DO bi = myBxLo(myThid), myBxHi(myThid)        if (err.NE.NF_NOERR) then
148  c      DO bj = myByLo(myThid), myByHi(myThid)              WRITE(errorMessageUnit,'(A,/,A)')
149         & 'ERROR in PROFILES_INIT_FIXED: ',
150         & '.nc file is not in the ECCO format'
151          stopProfiles=1. _d 0
152          endif
153    
154    #ifdef ALLOW_PROFILES_GENERICGRID
155    c3) read interpolattion information (grid points, coeffs, etc.)
156               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                WRITE(errorMessageUnit,'(A,/,A)')
165         & 'ERROR in PROFILES_INIT_FIXED: ',
166         & 'no interpolation information found in .nc file'
167          stopGenericGrid=2. _d 0
168          endif
169    #endif
170    
171    
172    c4) default values
173        do k=1,NOBSGLOB        do k=1,NOBSGLOB
174        prof_time(num_file,k,bi,bj)=-999        prof_time(num_file,k,bi,bj)=-999
175        prof_lon(num_file,k,bi,bj)=-999        prof_lon(num_file,k,bi,bj)=-999
176        prof_lat(num_file,k,bi,bj)=-999        prof_lat(num_file,k,bi,bj)=-999
177        prof_ind_glob(num_file,k,bi,bj)=-999        prof_ind_glob(num_file,k,bi,bj)=-999
178    #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        enddo        enddo
190    
191    
192    c5) main loop: look for profiles in this tile
193        length_for_tile=0        length_for_tile=0
194        profno_div1000=max(0,int(ProfNo(num_file,bi,bj)/1000))        profno_div1000=max(0,int(ProfNo(num_file,bi,bj)/1000))
195    
# Line 143  c      DO bj = myByLo(myThid), myByHi(my Line 198  c      DO bj = myByLo(myThid), myByHi(my
198        if (min(ProfNo(num_file,bi,bj), 1000*kk).GE.        if (min(ProfNo(num_file,bi,bj), 1000*kk).GE.
199       &  1+1000*(kk-1)) then       &  1+1000*(kk-1)) then
200    
201    c5.1) read a chunk
202        vec_start(1)=1        vec_start(1)=1
203        vec_start(2)=1+1000*(kk-1)        vec_start(2)=1+1000*(kk-1)
204        vec_count(1)=1        vec_count(1)=1
# Line 152  c      DO bj = myByLo(myThid), myByHi(my Line 208  c      DO bj = myByLo(myThid), myByHi(my
208       & (vec_start(2).LE.0).OR.       & (vec_start(2).LE.0).OR.
209       & (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file,bi,bj)) )       & (vec_count(2)+vec_start(2)-1.GT.ProfNo(num_file,bi,bj)) )
210       & then       & then
211        print*,"stop 1",vec_start, vec_count              WRITE(errorMessageUnit,'(A)')
212        stop       & 'ERROR in PROFILES_INIT_FIXED: 1'
213          stopProfiles=1. _d 0
214        endif        endif
215    
216        err = NF_GET_VARA_DOUBLE(fid,varid1a,vec_start(2),        err = NF_GET_VARA_DOUBLE(fid,varid1a,vec_start(2),
# Line 166  c      DO bj = myByLo(myThid), myByHi(my Line 223  c      DO bj = myByLo(myThid), myByHi(my
223       & vec_count(2), tmp_lat2)       & vec_count(2), tmp_lat2)
224    
225        if (err.NE.NF_NOERR) then        if (err.NE.NF_NOERR) then
226        print*,"stop 2",vec_start(2),vec_count(2),              WRITE(errorMessageUnit,'(A)')
227       & kk,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))       & 'ERROR in PROFILES_INIT_FIXED: 2'
228        stop        stopProfiles=1. _d 0
229        endif        endif
230    
231    #ifdef ALLOW_PROFILES_GENERICGRID
232          err = NF_GET_VARA_DOUBLE(fid,varid_intp1,vec_start(2),
233         & vec_count(2), tmp_xC11)
234          err = NF_GET_VARA_DOUBLE(fid,varid_intp2,vec_start(2),
235         & vec_count(2), tmp_yC11)
236          err = NF_GET_VARA_DOUBLE(fid,varid_intp11,vec_start(2),
237         & vec_count(2), tmp_xCNINJ)
238          err = NF_GET_VARA_DOUBLE(fid,varid_intp22,vec_start(2),
239         & 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            err = NF_GET_VARA_DOUBLE(fid,varid_intp3,vec_start2,
246         &  vec_count2, tmp_weights(1,q))
247            err = NF_GET_VARA_DOUBLE(fid,varid_intp4,vec_start2,    
248         &  vec_count2, tmp_i(1,q))
249            err = NF_GET_VARA_DOUBLE(fid,varid_intp5,vec_start2,    
250         &  vec_count2, tmp_j(1,q))
251          enddo
252    #endif
253    
254    c5.2) loop through this chunk
255        do k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))        do k=1,min(1000,ProfNo(num_file,bi,bj)-1000*(kk-1))
256    
257          if ( stopProfiles .EQ. 0.) then
258    
259        call cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)),        call cal_FullDate( int(tmpyymmdd(k)),int(tmphhmmss(k)),
260       & tmpdate,bi,bj,mythid )       & tmpdate,bi,bj,mythid )
261        call cal_TimePassed( modelstartdate,tmpdate,tmpdiff,mythid )        call cal_TimePassed( modelstartdate,tmpdate,tmpdiff,mythid )
262        call cal_ToSeconds (tmpdiff,diffsecs,mythid)        call cal_ToSeconds (tmpdiff,diffsecs,mythid)
263        diffsecs=diffsecs+nIter0*deltaTclock        diffsecs=diffsecs+nIter0*deltaTclock
264    
265    #ifndef ALLOW_PROFILES_GENERICGRID
266         if (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) then         if (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) then
267          tmp_lon=xC(sNx+1,1,bi,bj)+360          tmp_lon=xC(sNx+1,1,bi,bj)+360
268         else         else
# Line 194  c      DO bj = myByLo(myThid), myByHi(my Line 278  c      DO bj = myByLo(myThid), myByHi(my
278          prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k)          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)          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)          prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1)
281          if (length_for_tile.GT.NOBSGLOB) then          if (length_for_tile.EQ.NOBSGLOB) then
282        print*,"too much profiles: need to increase NOBSGLOB,"              WRITE(errorMessageUnit,'(A,/,3A)')
283        print*,"   or split the data file (less memory cost)"       & 'ERROR in PROFILES_INIT_FIXED: ',
284        stop       & '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          endif          endif
289         elseif (xC(sNx+1,1,bi,bj).LT.xC(1,1,bi,bj)) then         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.          if ((xC(1,1,bi,bj).LE.tmp_lon2(k)+360).AND.
# Line 210  c      DO bj = myByLo(myThid), myByHi(my Line 297  c      DO bj = myByLo(myThid), myByHi(my
297           prof_lon(num_file,length_for_tile,bi,bj)=tmp_lon2(k)+360           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)           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)           prof_ind_glob(num_file,length_for_tile,bi,bj)=k+1000*(kk-1)
300           if (length_for_tile.GT.NOBSGLOB) then           if (length_for_tile.EQ.NOBSGLOB) then
301        print*,"too much profiles: need to increase NOBSGLOB,"              WRITE(errorMessageUnit,'(A,/,3A)')
302        print*,"   or split the data file (less memory cost)"       & 'ERROR in PROFILES_INIT_FIXED: ',
303        stop       & '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           endif           endif
308          endif          endif
309         endif         endif
310    #else
311           if (stopGenericGrid.EQ.0.) then
312    
313           if ( ( abs( tmp_xC11(k) - xC(1,1,bi,bj) ).LT.0.0001 ) .AND.
314         & ( abs( tmp_yC11(k) - yC(1,1,bi,bj) ).LT.0.0001 ) .AND.
315         & ( 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    c more test of the inputs: is the offline-computed
334    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                WRITE(errorMessageUnit,'(A,/,A)')
338         & 'ERROR in PROFILES_INIT_FIXED: ',
339         & '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                WRITE(errorMessageUnit,'(A,/,A,/,A,/,2I4,3f5.2)')
348         & 'ERROR in PROFILES_INIT_FIXED: ',
349         & '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                WRITE(errorMessageUnit,'(A,/,A,/,2I4,f5.2)')
357         & 'ERROR in PROFILES_INIT_FIXED: ',
358         & '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                WRITE(errorMessageUnit,'(A,/,A,/,I4,f5.2)')
367         & 'ERROR in PROFILES_INIT_FIXED: ',
368         & '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        enddo        enddo
388        endif        endif
389        enddo        enddo
390    
391    
392        ProfNo(num_file,bi,bj)=length_for_tile        ProfNo(num_file,bi,bj)=length_for_tile
393        print*,"fid dimid ProfNo(num_file,bi,bj)",fid, dimid,  
394          write(msgbuf,'(a,i3,i3,i3,i5)')
395         &   'fid dimid ProfNo',fid, dimid,
396       & num_file, ProfNo(num_file,bi,bj)       & num_file, ProfNo(num_file,bi,bj)
397          call print_message(
398         &   msgbuf, standardmessageunit, SQUEEZE_RIGHT , mythid)
399    
400    
401    c6) available variablesin the data set
402    
403        do k=1,NVARMAX        do k=1,NVARMAX
404        prof_num_var_cur(num_file,k,bi,bj)=0        prof_num_var_cur(num_file,k,bi,bj)=0
405        enddo        enddo
406        prof_num_var_tot(num_file,bi,bj)=0        prof_num_var_tot(num_file,bi,bj)=0
407    
 c3) detect available data types  
408        err = NF_INQ_VARID(fid,'prof_T', varid1 )        err = NF_INQ_VARID(fid,'prof_T', varid1 )
409        if (err.EQ.NF_NOERR) then        if (err.EQ.NF_NOERR) then
410        vec_quantities(num_file,1,bi,bj)=.TRUE.        vec_quantities(num_file,1,bi,bj)=.TRUE.
# Line 251  c3) detect available data types Line 425  c3) detect available data types
425        else        else
426        vec_quantities(num_file,2,bi,bj)=.FALSE.        vec_quantities(num_file,2,bi,bj)=.FALSE.
427        endif        endif
428    #ifndef ALLOW_PROFILES_GENERICGRID
429        err = NF_INQ_VARID(fid,'prof_U', varid1 )        err = NF_INQ_VARID(fid,'prof_U', varid1 )
430        if (err.EQ.NF_NOERR) then        if (err.EQ.NF_NOERR) then
431        vec_quantities(num_file,3,bi,bj)=.TRUE.        vec_quantities(num_file,3,bi,bj)=.TRUE.
# Line 271  c3) detect available data types Line 446  c3) detect available data types
446        else        else
447        vec_quantities(num_file,4,bi,bj)=.FALSE.        vec_quantities(num_file,4,bi,bj)=.FALSE.
448        endif        endif
449    #endif
450        err = NF_INQ_VARID(fid,'prof_ptr', varid1 )        err = NF_INQ_VARID(fid,'prof_ptr', varid1 )
451        if (err.EQ.NF_NOERR) then        if (err.EQ.NF_NOERR) then
452        vec_quantities(num_file,5,bi,bj)=.TRUE.        vec_quantities(num_file,5,bi,bj)=.TRUE.
# Line 354  C======================================= Line 530  C=======================================
530    
531             endif             endif
532    
 c      ENDDO  
 c      ENDDO  
   
533    
534  C===========================================================  C===========================================================
535        else        else
# Line 371  C======================================= Line 544  C=======================================
544        prof_lon(num_file,k,bi,bj)=-999        prof_lon(num_file,k,bi,bj)=-999
545        prof_lat(num_file,k,bi,bj)=-999        prof_lat(num_file,k,bi,bj)=-999
546        prof_ind_glob(num_file,k,bi,bj)=-999        prof_ind_glob(num_file,k,bi,bj)=-999
547    #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    #endif    
558        enddo        enddo
559    
560        endif !if (IL.NE.0) then        endif !if (IL.NE.0) then
561        enddo !      do num_file=1,NFILESPROFMAX        enddo !      do num_file=1,NFILESPROFMAX
562    
563    C===========================================================
564    C error cases:
565  C===========================================================  C===========================================================
566    
567    #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           open( fid, file= fnameequinc, form ='unformatted',
583         &      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           open( fid, file= fnameequinc, form ='unformatted',
603         & 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         & 'when using ALLOW_PROFILES_GENERICGRID ',
617         & 'you have to provide interpolation coeffs etc. ',
618         & '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        ENDDO        ENDDO
627        ENDDO        ENDDO
628    
629          _END_MASTER( mythid )
630          _BARRIER
631    
632    c2) stop after other kind of errors
633          _GLOBAL_SUM_R8( stopProfiles , myThid )
634          if ( stopProfiles.GE.1.) then
635                 STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
636          endif
637    #ifdef ALLOW_PROFILES_GENERICGRID
638          _GLOBAL_SUM_R8( stopGenericGrid , myThid )
639          if ( stopGenericGrid.GE.1.) then
640                 STOP 'ABNORMAL END: S/R PROFILES_INIT_FIXED'
641          endif
642    #endif
643    
644  #endif  #endif
645    
646        END        END
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22