/[MITgcm]/MITgcm/pkg/ctrl/ctrl_pack.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_pack.F

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

revision 1.18 by heimbach, Mon Feb 28 17:29:38 2005 UTC revision 1.27 by heimbach, Fri May 12 13:35:37 2006 UTC
# Line 112  c--   Assign file names. Line 112  c--   Assign file names.
112        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
113        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
114        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
115          call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
116          call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
117          call ctrl_set_fname(xx_swdown_file, fname_swdown, mythid)
118        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
119        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
120        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
# Line 129  c--   Assign file names. Line 132  c--   Assign file names.
132        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
133        call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)        call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
134        call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)        call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
135          call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
136          call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
137          call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
138          call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
139          call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
140    
141  c  c--   Only the master thread will do I/O.
 c--     Only the master thread will do I/O.  
142        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
143    
144        if ( first ) then        if ( first ) then
# Line 202  C     place holder of obsolete variable Line 209  C     place holder of obsolete variable
209  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
210            ivartype = 1            ivartype = 1
211            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
212            write(weighttype(1:80),'(a)') "wtheta"            write(weighttype(1:80),'(a)') "wthetaLev"
213            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
214       &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_theta(ictrlgrad), "maskCtrlC",
215       &         weighttype, wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
216  #endif  #endif
217    
218  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
219            ivartype = 2            ivartype = 2
220            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
221            write(weighttype(1:80),'(a)') "wsalt"            write(weighttype(1:80),'(a)') "wsaltLev"
222            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
223       &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_salt(ictrlgrad), "maskCtrlC",
224       &         weighttype, wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
225  #endif  #endif
226    
227  #if (defined (ALLOW_HFLUX_CONTROL) || \  #if (defined (ALLOW_HFLUX_CONTROL) || defined (ALLOW_HFLUX0_CONTROL))
      defined (ALLOW_HFLUX0_CONTROL))  
228            ivartype = 3            ivartype = 3
229            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
230            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
231            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
232       &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",
233       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
234  #endif  #endif
235    
236  #if (defined (ALLOW_SFLUX_CONTROL) || \  #if (defined (ALLOW_SFLUX_CONTROL) || defined (ALLOW_SFLUX0_CONTROL))
      defined (ALLOW_SFLUX0_CONTROL))  
237            ivartype = 4            ivartype = 4
238            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
239            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
240            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
241       &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",
242       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
243  #endif  #endif
244    
245  #if (defined (ALLOW_USTRESS_CONTROL) || \  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
      defined (ALLOW_TAUU0_CONTROL))  
246            ivartype = 5            ivartype = 5
247            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
248            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
249            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
250       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
251       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
252  #endif  #endif
253    
254  #if (defined (ALLOW_VSTRESS_CONTROL) || \  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
      defined (ALLOW_TAUV0_CONTROL))  
255            ivartype = 6            ivartype = 6
256            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
257            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
258            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
259       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
260       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
261  #endif  #endif
262    
# Line 262  C     place holder of obsolete variable Line 265  C     place holder of obsolete variable
265            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
266            write(weighttype(1:80),'(a)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
267            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
268       &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",
269       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
270  #endif  #endif
271    
# Line 271  C     place holder of obsolete variable Line 274  C     place holder of obsolete variable
274            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
275            write(weighttype(1:80),'(a)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
276            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
277       &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",
278       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
279  #endif  #endif
280    
# Line 280  C     place holder of obsolete variable Line 283  C     place holder of obsolete variable
283            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
284            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
285            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
286       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
287       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
288  #endif  #endif
289    
# Line 289  C     place holder of obsolete variable Line 292  C     place holder of obsolete variable
292            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
293            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
294            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
295       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
296       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
297  #endif  #endif
298    
# Line 334  C     place holder of obsolete variable Line 337  C     place holder of obsolete variable
337            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
338            write(weighttype(1:80),'(a)') "wdiffkr"            write(weighttype(1:80),'(a)') "wdiffkr"
339            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
340       &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_diffkr(ictrlgrad), "maskCtrlC",
341       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wdiffkr, lxxadxx, mythid)
342  #endif  #endif
343    
344  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
# Line 343  C     place holder of obsolete variable Line 346  C     place holder of obsolete variable
346            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
347            write(weighttype(1:80),'(a)') "wkapgm"            write(weighttype(1:80),'(a)') "wkapgm"
348            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
349       &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_kapgm(ictrlgrad), "maskCtrlC",
350       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wkapgm, lxxadxx, mythid)
351  #endif  #endif
352    
353  #ifdef ALLOW_TR10_CONTROL  #ifdef ALLOW_TR10_CONTROL
# Line 352  C     place holder of obsolete variable Line 355  C     place holder of obsolete variable
355            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
356            write(weighttype(1:80),'(a)') "wtr1"            write(weighttype(1:80),'(a)') "wtr1"
357            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
358       &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_tr1(ictrlgrad), "maskCtrlC",
359       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
360  #endif  #endif
361    
362  #ifdef ALLOW_SST0_CONTROL  #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
363            ivartype = 18            ivartype = 18
364            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
365            write(weighttype(1:80),'(a)') "wsst0"            write(weighttype(1:80),'(a)') "wsst"
366            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
367       &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",
368       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
369  #endif  #endif
370    
371  #ifdef ALLOW_SSS0_CONTROL  #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
372            ivartype = 19            ivartype = 19
373            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
374            write(weighttype(1:80),'(a)') "wsss0"            write(weighttype(1:80),'(a)') "wsss"
375            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
376       &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sss(ictrlgrad), "maskCtrlC",
377       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
378  #endif  #endif
379    
# Line 380  C     place holder of obsolete variable Line 383  C     place holder of obsolete variable
383            write(weighttype(1:80),'(a)') "whfacc"            write(weighttype(1:80),'(a)') "whfacc"
384  # ifdef ALLOW_HFACC3D_CONTROL  # ifdef ALLOW_HFACC3D_CONTROL
385            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
386       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_hfacc(ictrlgrad), "maskCtrlC",
387       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
388  # else  # else
389            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
390       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_hfacc(ictrlgrad), "maskCtrlC",
391       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
392  # endif  # endif
393  #endif  #endif
# Line 394  C     place holder of obsolete variable Line 397  C     place holder of obsolete variable
397            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
398            write(weighttype(1:80),'(a)') "wefluxy0"            write(weighttype(1:80),'(a)') "wefluxy0"
399            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
400       &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",       &         cunit, ivartype, fname_efluxy(ictrlgrad), "maskCtrlS",
401       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
402  #endif  #endif
403    
# Line 403  C     place holder of obsolete variable Line 406  C     place holder of obsolete variable
406            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
407            write(weighttype(1:80),'(a)') "wefluxp0"            write(weighttype(1:80),'(a)') "wefluxp0"
408            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
409       &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",       &         cunit, ivartype, fname_efluxp(ictrlgrad), "maskhFacV",
410       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
411  #endif  #endif
412    
# Line 412  C     place holder of obsolete variable Line 415  C     place holder of obsolete variable
415            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
416            write(weighttype(1:80),'(a)') "wbottomdrag"            write(weighttype(1:80),'(a)') "wbottomdrag"
417            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
418       &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",       &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",
419       &         weighttype, lxxadxx, mythid)       &      weighttype, lxxadxx, mythid)
420  #endif  #endif
421    
422  #ifdef ALLOW_EDTAUX_CONTROL  #ifdef ALLOW_EDTAUX_CONTROL
# Line 421  C     place holder of obsolete variable Line 424  C     place holder of obsolete variable
424            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
425            write(weighttype(1:80),'(a)') "wedtaux"            write(weighttype(1:80),'(a)') "wedtaux"
426            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
427       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskW",       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
428       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wedtaux, lxxadxx, mythid)
429  #endif  #endif
430    
431  #ifdef ALLOW_EDTAUY_CONTROL  #ifdef ALLOW_EDTAUY_CONTROL
# Line 430  C     place holder of obsolete variable Line 433  C     place holder of obsolete variable
433            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
434            write(weighttype(1:80),'(a)') "wedtauy"            write(weighttype(1:80),'(a)') "wedtauy"
435            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
436       &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskS",       &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskCtrlS",
437         &         weighttype, wedtauy, lxxadxx, mythid)
438    #endif
439    
440    #ifdef ALLOW_UVEL0_CONTROL
441              ivartype = 27
442              write(weighttype(1:80),'(80a)') ' '
443              write(weighttype(1:80),'(a)') "wuvel"
444              call ctrl_set_pack_xyz(
445         &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
446       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
447  #endif  #endif
448    
449    #ifdef ALLOW_VVEL0_CONTROL
450              ivartype = 28
451              write(weighttype(1:80),'(80a)') ' '
452              write(weighttype(1:80),'(a)') "wvvel"
453              call ctrl_set_pack_xyz(
454         &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
455         &         weighttype, wunit, lxxadxx, mythid)
456    #endif
457    
458    #ifdef ALLOW_ETAN0_CONTROL
459              ivartype = 29
460              write(weighttype(1:80),'(80a)') ' '
461              write(weighttype(1:80),'(a)') "wetan"
462              call ctrl_set_pack_xy(
463         &         cunit, ivartype, fname_etan(ictrlgrad), "maskCtrlC",
464         &         weighttype, lxxadxx, mythid)
465    #endif
466    
467    #ifdef ALLOW_RELAXSST_CONTROL
468              ivartype = 30
469              write(weighttype(1:80),'(80a)') ' '
470              write(weighttype(1:80),'(a)') "wrelaxsst"
471              call ctrl_set_pack_xy(
472         &         cunit, ivartype, fname_relaxsst(ictrlgrad), "maskCtrlC",
473         &         weighttype, lxxadxx, mythid)
474    #endif
475    
476    #ifdef ALLOW_RELAXSSS_CONTROL
477              ivartype = 31
478              write(weighttype(1:80),'(80a)') ' '
479              write(weighttype(1:80),'(a)') "wrelaxsss"
480              call ctrl_set_pack_xy(
481         &         cunit, ivartype, fname_relaxsss(ictrlgrad), "maskCtrlC",
482         &         weighttype, lxxadxx, mythid)
483    #endif
484    
485    #ifdef ALLOW_PRECIP_CONTROL
486              ivartype = 32
487              write(weighttype(1:80),'(80a)') ' '
488              write(weighttype(1:80),'(a)') "wprecip"
489              call ctrl_set_pack_xy(
490         &         cunit, ivartype, fname_precip(ictrlgrad), "maskCtrlC",
491         &         weighttype, lxxadxx, mythid)
492    #endif
493    
494    #ifdef ALLOW_SWFLUX_CONTROL
495              ivartype = 33
496              write(weighttype(1:80),'(80a)') ' '
497              write(weighttype(1:80),'(a)') "wswflux"
498              call ctrl_set_pack_xy(
499         &         cunit, ivartype, fname_swflux(ictrlgrad), "maskCtrlC",
500         &         weighttype, lxxadxx, mythid)
501    #endif
502    
503    #ifdef ALLOW_SWDOWN_CONTROL
504              ivartype = 34
505              write(weighttype(1:80),'(80a)') ' '
506              write(weighttype(1:80),'(a)') "wswdown"
507              call ctrl_set_pack_xy(
508         &         cunit, ivartype, fname_swdown(ictrlgrad), "maskCtrlC",
509         &         weighttype, lxxadxx, mythid)
510    #endif
511    
512            close ( cunit )            close ( cunit )
513    
Legend:
Removed from v.1.18  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22