source: trunk/procs/macros/make_energetics.pro @ 163

Last change on this file since 163 was 163, checked in by pinsard, 15 years ago

going on modify unformal header to idldoc 2. header syntax

File size: 15.7 KB
Line 
1;+
2;
3; make energetics computations
4;
5; @version
6; $Id$
7;
8;-
9;
10FUNCTION make_energetics, file_name, ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2, ALL_DATA = all_data, ZMTYP = zmtyp
11
12@common
13@com_eg
14IF debug_w THEN print, ' '
15IF debug_w THEN print, ' ENTER make_energetics...'
16IF debug_w THEN print, 'cmd_wrk.grid =',  cmd_wrk.grid
17CASE cmd_wrk.grid OF
18   'T': source_model = 'opa'
19   'T#': source_model = 'opa#'
20   'T05': source_model = 'opa'
21   'T05#': source_model = 'opa#'
22   ELSE: source_model = 'ipcc'
23ENDCASE
24
25;; full vertical domain
26;; imposes vert_type = '0' in plt_def
27vert_switch = 0
28IF debug_w THEN BEGIN
29   print, 'base_file_name:', base_file_name
30   print, 'file_name:', file_name
31ENDIF
32;
33; Read T, S, U, V, W, taux, tauy
34;
35   print, '    Data size to read (M)= ', nxt*nyt*jpt*(5*nzt + 2)*1.e-6
36
37CASE source_model OF
38   'opa': BEGIN
39      tn = nc_read(file_name,'votemper', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
40      sn = nc_read(file_name,'vosaline', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
41      IF data_domain EQ 'pacific' THEN BEGIN
42         file_namu = strmid(file_name, 0, strlen(file_name)-8)+'U_pac.nc'
43         file_namv = strmid(file_name, 0, strlen(file_name)-8)+'V_pac.nc'
44         file_namw = strmid(file_name, 0, strlen(file_name)-8)+'W_pac.nc'
45      ENDIF ELSE BEGIN
46         file_namu = strmid(file_name, 0, strlen(file_name)-4)+'U.nc'
47         file_namv = strmid(file_name, 0, strlen(file_name)-4)+'V.nc'
48         file_namw = strmid(file_name, 0, strlen(file_name)-4)+'W.nc'
49      ENDELSE     
50      un = nc_read(file_namu,'vozocrtx', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
51      vn = nc_read(file_namv,'vomecrty', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
52      wn = nc_read(file_namw,'vovecrtz', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
53      tauxn = nc_read(file_namu,'sozotaux', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
54      tauyn = nc_read(file_namv,'sometauy', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
55      var_temp = 'votemper'
56      file_temp = file_name
57   END
58   'opa#': BEGIN
59      tn = nc_read(file_name,'votemper', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
60      IF data_domain EQ 'pacific' THEN BEGIN
61         file_nams = strmid(file_name, 0, strlen(file_name)-17)+'T_pac_vosaline.nc'
62         file_namu = strmid(file_name, 0, strlen(file_name)-17)+'U_pac_vozocrtx.nc'
63         file_namv = strmid(file_name, 0, strlen(file_name)-17)+'V_pac_vomecrty.nc'
64         file_namw = strmid(file_name, 0, strlen(file_name)-17)+'W_pac_vovecrtz.nc'
65         file_namsu = strmid(file_name, 0, strlen(file_name)-17)+'U_pac_sozotaux.nc'
66         file_namsv = strmid(file_name, 0, strlen(file_name)-17)+'V_pac_sometauy.nc'
67      ENDIF ELSE BEGIN
68         file_nams = strmid(file_name, 0, strlen(file_name)-13)+'T_vosaline.nc'
69         file_namu = strmid(file_name, 0, strlen(file_name)-13)+'U_vozocrtx.nc'
70         file_namv = strmid(file_name, 0, strlen(file_name)-13)+'V_vomecrty.nc'
71         file_namw = strmid(file_name, 0, strlen(file_name)-13)+'W_vovecrtz.nc'
72         file_namsu = strmid(file_name, 0, strlen(file_name)-13)+'U_sozotaux.nc'
73         file_namsv = strmid(file_name, 0, strlen(file_name)-13)+'V_sometauy.nc'
74      ENDELSE     
75      sn = nc_read(file_nams,'vosaline', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
76      un = nc_read(file_namu,'vozocrtx', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
77      vn = nc_read(file_namv,'vomecrty', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
78      wn = nc_read(file_namw,'vovecrtz', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
79      tauxn = nc_read(file_namsu,'sozotaux', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
80      tauyn = nc_read(file_namsv,'sometauy', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
81      var_temp = 'votemper'
82      file_temp = file_name
83      source_model = 'opa'
84   END
85   'ipcc': BEGIN
86      base_file_name_grd = base_file_name+base_suffix
87      tn = nc_read(base_file_name_grd+'_thetao.nc','thetao', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
88      sn = nc_read(base_file_name_grd+'_so.nc','so', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
89      un = nc_read(base_file_name_grd+'_uo.nc','uo', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
90      vn = nc_read(base_file_name_grd+'_vo.nc','vo', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
91      wn = nc_read(base_file_name_grd+'_wo.nc','wo', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
92      tauxn = nc_read(base_file_name_grd+'_tauu.nc','tauu', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
93      tauyn = nc_read(base_file_name_grd+'_tauv.nc','tauv', ncdf_db, BOXZOOM = boxzoom, TIME_1 = time_1,  TIME_2 =  time_2)
94      var_temp = 'thetao'
95      file_temp = base_file_name_grd+'_thetao.nc'
96   END
97ENDCASE
98
99t_unit = tn.units
100
101; assign and free memory
102
103   t = tn.data & tn = 0
104   s = sn.data & sn = 0
105   u = un.data & un = 0
106   v = vn.data & vn = 0
107   w = wn.data & wn = 0
108   tx = tauxn.data & tauxn = 0
109   ty = tauyn.data & tauyn = 0
110
111   rg = 9.81
112
113   print, '     read ok'
114
115; rearrange data depending on source
116
117CASE source_model OF
118   'opa': BEGIN 
119      ; build mask
120      IF valmask EQ 0. THEN BEGIN
121         tmaskr = abs(s) gt 1.e-6
122         valmask = 1.e20
123         idxw = where (tmaskr EQ 0)
124         IF idxw[0] NE -1 THEN w(idxw) = valmask
125         idxt = where (tmaskr EQ 0)
126         IF idxt[0] NE -1 THEN t (idxt) = 0.
127         IF idxt[0] NE -1 THEN s (idxt) = 0.
128         tmaskr = 0 ; free memory
129      ENDIF ELSE BEGIN
130         idxt = where (t EQ valmask)
131         IF idxt(0) NE -1 THEN t (idxt) = 0.
132         IF idxt(0) NE -1 THEN s (idxt) = 0.
133      ENDELSE
134
135      ; transform W fields onto T grid
136      maskw = w LT valmask/10.
137      w_T = 0.5*( w*maskw + shift(w, 0, 0, -1, 0)*shift(maskw, 0, 0, -1, 0) )
138      w_T(*, *, (size(w))(3)-1, *) = w_T(*, *, (size(w))(3)-2, *)
139      w = 0
140      maskw = 0  ; free memory
141     
142   END
143   'ipcc': BEGIN
144      idx_t = where (t GT valmask/10)
145      ; special case CCCMA
146      IF strpos(cmd_wrk.exp, 'CCCMA') NE -1 THEN BEGIN
147         ; transform W fields onto T grid
148         maskw = w LT valmask/10.
149         w_T = 0.5*( w*maskw + shift(w, 0, 0, -1, 0)*shift(maskw, 0, 0, -1, 0) )
150         w_T(*, *, (size(w))(3)-1, *) = w_T(*, *, (size(w))(3)-2, *)
151         w = 0
152         w_T(idx_t) = valmask
153         maskw = 0 ; free memory
154      ENDIF ELSE w_T = w
155     
156      idx_2d = where (u(*, *, 0, 0) GT valmask/10.)
157      IF idx_2d(0) NE -1 THEN tx(idx_2d) = valmask
158      idx_2d = where (v(*, *, 0, 0) GT valmask/10.)
159      IF idx_2d(0) NE -1 THEN ty(idx_2d) = valmask
160      idx = where (t LT valmask/10.)
161      IF t_unit NE "C" THEN BEGIN
162         IF idx(0) NE -1 THEN t(idx) = t(idx)-273.15
163      ENDIF
164      idx1 = n_elements(idx_t)
165      idx_w = where (w_T GT valmask/10)
166      idx2 = n_elements(idx_w)
167      IF idx1 NE idx2 THEN BEGIN
168         print, ' *** WARNING wo and thetao do not have same masks !',  idx1,  idx2, min(idx_t -idx_w), max(idx_t- idx_w)
169         print, ' *** Setting wo to zero on all masked points'
170         w_T(idx_w) = 0.
171      ENDIF ELSE print, '       check these are 0 (W,T): ', min(idx_t -idx_w), max(idx_t- idx_w)
172      w = 0 & idx = 0 & idx_t = 0 & idx_w = 0 ; free memory
173      idxt=where(t GT valmask/10.)
174      idxs=where(s GT valmask/10.)
175      IF source_model EQ 'ipcc' THEN print, '       check these are 0 (T,S): ', min(idxt -idxs), max(idxt-idxs)
176      IF idxt[0] NE -1 THEN t(idxt)=0.
177      IF idxs[0] NE -1 THEN s(idxs)=0.
178      idxs = 0                  ; free memory
179
180   END
181ENDCASE
182     
183
184; compute potential density rho
185
186   print, '     compute rho...'
187
188   
189   sr=sqrt(abs(s))
190   r1=((((6.536332E-9*t-1.120083E-6)*t+1.001685E-4)*t $
191        -9.095290E-3)*t+6.793952E-2)*t+999.842594
192   r2=(((5.3875E-9*t-8.2467E-7)*t+7.6438E-5)*t-4.0899E-3)*t+8.24493E-1
193   r3=(-1.6546E-6*t+1.0227E-4)*t-5.72466E-3
194   rhop = ( ( 4.8314E-4*s + r3*sr +r2)*s +r1) 
195   print, '      rhop min/max', min(rhop), max(rhop)
196   IF idxt[0] NE -1 THEN rhop(idxt) = valmask
197   sr = 0 & r1 = 0 &  r2 = 0 &  r3 = 0 & t = 0 & s = 0 ; free memory
198
199; compute mean profiles on T grid
200
201   vargrid = 'T'
202   IF valmask NE 0 THEN BEGIN
203      rho_s = grossemoyenne(rhop, 'xyt', boite = zbox, NaN = valmask)
204   ENDIF ELSE rho_s = grossemoyenne(rhop, 'xyt', boite = zbox)
205
206   rho_s4d = replicate(1, nxt*nyt)#rho_s
207   rho_s4d = reform(rho_s4d[*]#replicate(1, jpt), nxt, nyt, nzt, jpt, /overwrite)
208
209
210; compute mean stability = d(rho_s)/dz (on W grid)
211
212   rho_diff = (rho_s-shift(rho_s,-1))/shift(e3w, -1)
213   rho_diff = shift(temporary(rho_diff), 1)
214   rho_diff(0) = 0.
215
216; transform onto T grid
217
218   rho_diff_T = 0.5*(rho_diff+shift(rho_diff, -1))
219   rho_diff_T((size(rho_diff))(1)-1) = rho_diff((size(rho_diff))(1)-2)
220
221   stab_inv = ABS(1./rho_diff_T)
222
223   rho_diff_T = 0 ; free memory
224
225; remove first 2 levels (MXL too unstable)
226
227   stab_inv[0:1] = 0.
228
229; test: remove only top level
230
231;   stab_inv[0:0] = 0.
232
233; compute [(rho-rho_s)**2]/stability
234
235   stab_inv = replicate(1, nxt*nyt)#stab_inv
236   stab_inv = reform(stab_inv[*]#replicate(1, jpt), nxt, nyt, nzt, jpt, /overwrite)
237
238   int_val2 = ((rhop-rho_s4d)^2)*stab_inv
239   IF idxt[0] NE -1 THEN int_val2(idxt) = 0.
240
241   print, '     compute APE...'
242
243   ape = 0.5*rg*grossemoyenne(int_val2, 'xyz', /integration)
244
245   int_val2 = 0 ; free memory
246
247   ape_wr = ape
248   ape = ape*1.e-18
249;
250; compute buoyancy forcing bfx = int[(rho-rho_s).w]dxdydz
251;
252   print, '     compute BF...'
253
254   int_val = (rhop-rho_s4d)*(w_T)
255   IF idxt[0] NE -1 THEN int_val(idxt) = 0.
256
257; remove first 2 levels (MXL too unstable)
258   int_val[*, *, 0:1, *] = 0.
259
260   bfx = rg*grossemoyenne(int_val, 'xyz', /integration)
261
262   int_val = 0 ; free memory
263
264   bfx_wr = bfx
265   bfx_b = bfx
266   bfx = bfx*1.e-11
267
268; compute wind work = int(tau.um)dx.dy where um=u(over 30 m)
269
270   print, '     compute WW...'
271
272   umean=grossemoyenne(u,'z',boite=[0,30])
273   vmean=grossemoyenne(v,'z',boite=[0,30])
274;   umean=grossemoyenne(u,'z',boite=[0,10])
275;   vmean=grossemoyenne(v,'z',boite=[0,10])
276
277   idx = where(tx GT valmask/10.)
278   idy = where(ty GT valmask/10.)
279   idxu = where(umean GT valmask/10.)
280   idyv = where(vmean GT valmask/10.)
281
282   IF idx[0] NE -1 THEN tx(idx) = 0.
283   IF idy[0] NE -1 THEN ty(idy) = 0.
284   IF idxu[0] NE -1 THEN umean(idxu) = 0.
285   IF idyv[0] NE -1 THEN vmean(idyv) = 0.
286
287   dot_prodx = tx*umean
288   dot_prody = ty*vmean
289
290   wwx = grossemoyenne(dot_prodx, 'xy', /integration)
291   wwy = grossemoyenne(dot_prody, 'xy', /integration)
292   ww = wwx + wwy
293
294   ww_wr = ww
295   ww_b = ww
296   ww = ww*1.e-11
297   wwx = wwx*1.e-11
298   wwy = wwy*1.e-11
299
300; compute forcing efficiency: stddev(B)/stddev(W)
301
302   bfx_1mm = trends(bfx_b, 412, 't')
303   bfx_sc = mean_sc
304   ww_1mm = trends(ww_b, 412, 't')
305   ww_sc = mean_sc
306   efficiency = sqrt((moment(bfx_1mm))[1])/sqrt((moment(ww_1mm))[1])
307   efficiency_sc = sqrt((moment(bfx_sc[0:11]))[1])/sqrt((moment(ww_sc[0:11]))[1])
308
309; plotting stuff
310
311   ps = 0
312
313   red =   [0, 255,   0,   0, 0, 255]
314   green = [0,   0, 255,   0, 0,   0]
315   blue =  [0,   0,   0, 255, 0, 255]
316   red = [0, red, red, red, red, red, red, red ]
317   green = [0, green, green, green, green, green, green, green]
318   blue = [0, blue, blue, blue, blue, blue, blue, blue ]
319   tvlct, red, green, blue
320
321   IF cmd_wrk.out EQ 'ps' THEN ps = 1
322
323   IF ps EQ 1 THEN openps
324
325   pltt, ape, 't',  petit = [2, 4, 1],  landscape = 1, /rempli, /BASICMARGES,  title = 'APE (full) '+cmd_wrk.exp, window=3
326   pltt, ww, 't',  petit = [2, 4, 2],  min = -2, max = 5, /noerase, /rempli, /BASICMARGES,  title = 'Wind work (full) '+cmd_wrk.exp, window=3
327   pltt, bfx, 't',  petit = [2, 4, 8],  min = -2, max = 5, color = 4, /noerase, /rempli, /BASICMARGES,  title = 'B (full)', window=3
328
329   ape_1mm = trends(ape, 412, 't')
330   pltt, ape_1mm, 't',  petit = [2, 4, 3],  /noerase, /rempli, /BASICMARGES,  title = 'APE (inter)', window=3
331   jpt_b = jpt
332   jpt = 24
333   pltt, mean_sc[0:23], 't',  petit = [2, 4, 5],  /noerase, /rempli, /BASICMARGES,  title = 'APE (seasonal cycle x 2)', window=3
334
335   jpt = jpt_b
336
337   ww_1mm = trends(ww, 412, 't')
338   tmp = mean_sc
339   wwx_1mm = trends(wwx, 412, 't')
340
341   pltt, ww_1mm, 't',  petit = [2, 4, 4], color = 2, /noerase, /rempli, /BASICMARGES,  title = 'Interannual W (red) B (blue) [efficiency = '+string(strcompress(efficiency))+']', window=3
342   pltt, bfx_1mm*1.e-11, 't',  petit = [2, 4, 4],  /ov1d, color = 4, thick = 2, /noerase, /rempli, /BASICMARGES, window=3
343
344   jpt_b = jpt
345   jpt = 24
346   pltt, tmp[0:23], 't',  petit = [2, 4, 6],  min = -1,  max = 3.5,  /noerase, /rempli, /BASICMARGES,  title = 'Seasonal Cycle x 2 (W total: black, B: blue, Wx/y: red/green)', window=3
347   pltt, mean_sc[0:23], 't',  petit = [2, 4, 6], /ov1d, color = 2, thick = 2, /noerase, /rempli, /BASICMARGES, window=3
348   wwy_1mm = trends(wwy, 412, 't')
349   pltt, mean_sc[0:23], 't',  petit = [2, 4, 6], /ov1d, color = 3, thick = 2, /noerase, /rempli, /BASICMARGES, window=3
350   pltt, bfx_sc[0:23]*1.e-11, 't',  petit = [2, 4, 6], /ov1d, color = 4, thick = 1, /noerase, /rempli, /BASICMARGES
351   jpt = jpt_b
352
353; compute and plot sst in nino 3   
354
355   maxdepth = 10
356   IF gdept(0) GT maxdepth THEN maxdepth = gdept(0)
357
358   ;domdef, [210., 280., -5., 5., 0., maxdepth]
359   bte = [210., 280., -5., 5., 0., maxdepth]
360   tn = nc_read(file_temp,var_temp, ncdf_db, BOXZOOM = bte, TIME_1 = time_1,  TIME_2 =  time_2)
361   st = tn.data
362   sst = grossemoyenne(st, 'xyz')
363   sst_wr = sst
364   sst = trends(sst, 412, 't')
365
366   pltt, sst, 't',  petit = [2, 4, 7],  /noerase, /rempli, /BASICMARGES,  title = 'Nino3 SSTA'
367
368   correlation = C_CORRELATE(ape, sst, [0])
369
370   IF ps EQ 1 THEN BEGIN
371      closeps
372      printps
373   ENDIF
374
375; write to ascii file
376
377   get_lun, nuldat
378   filename = cmd_wrk.exp+'_'+cmd_wrk.date1+'_'+cmd_wrk.spec+'_'+cmd_wrk.plt+'_sst.asc'
379   openw, nuldat, asciidir+filename
380   print,  '     -> writing nino 3 sst data to ',  asciidir+filename & print,  ' '
381   printf, nuldat, sst_wr, format = '(f8.3)'
382   free_lun, nuldat & close, nuldat
383
384   get_lun, nuldat
385   filename = cmd_wrk.exp+'_'+cmd_wrk.date1+'_'+cmd_wrk.spec+'_'+cmd_wrk.plt+'_ape.asc'
386   openw, nuldat, asciidir+filename
387   print,  '     -> writing ape data to ',  asciidir+filename & print,  ' '
388   printf, nuldat, ape_wr, format = '(g10.4)'
389   free_lun, nuldat & close, nuldat
390
391   get_lun, nuldat
392   filename = cmd_wrk.exp+'_'+cmd_wrk.date1+'_'+cmd_wrk.spec+'_'+cmd_wrk.plt+'_ww.asc'
393   openw, nuldat, asciidir+filename
394   print,  '     -> writing ww data to ',  asciidir+filename & print,  ' '
395   print,  '         min/max of ww, ww_1mm = ', min(ww),  max(ww), min(ww_1mm),  max(ww_1mm)
396   printf, nuldat, ww_wr, format = '(g10.4)'
397   free_lun, nuldat & close, nuldat
398
399   get_lun, nuldat
400   filename = cmd_wrk.exp+'_'+cmd_wrk.date1+'_'+cmd_wrk.spec+'_'+cmd_wrk.plt+'_bf.asc'
401   openw, nuldat, asciidir+filename
402   print,  '     -> writing bf data to ',  asciidir+filename & print,  ' '
403   print,  '         min/max of bfx, bfx_1mm= ', min(bfx),  max(bfx), min(bfx_1mm),  max(bfx_1mm)
404   printf, nuldat, bfx_wr, format = '(g10.4)'
405   free_lun, nuldat & close, nuldat
406
407; check that d(APE)/dt ~ ww
408   
409   dapedt = (ape-shift(ape, 1))/(86400.*30.)
410;   pltt, dapedt-(ww*1.e11),'t',petit=[1,2,1],/rempli,/portrait         
411;   pltt, dapedt/(ww*1.e11),'t',petit=[1,2,2],/rempli,/portrait,/noerase
412   print, ' d(APE)/dt / wind work correlation', C_CORRELATE(dapedt, ww, [0])
413   print, ' APE/nino3 sst correlation=', correlation
414   print, ' B/W efficiency (interannual) = ', efficiency
415   print, ' B/W efficiency (SC) = ', efficiency_sc
416
417;   stop
418
419   field = {name: '', data: rhop, legend: '', units: '', origin: '', direc: '', dim: 0}
420   
421   field.origin = tn.origin
422   field.dim = tn.dim - 1
423
424   field.direc = 'xyzt'
425
426   return, field
427END
Note: See TracBrowser for help on using the repository browser.