/[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.7 by heimbach, Fri Mar 7 02:45:48 2003 UTC revision 1.8 by heimbach, Tue Jun 24 16:07:07 2003 UTC
# Line 1  Line 1 
1    
2  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
3    
 CBOP  
 C     !ROUTINE: ctrl_pack  
 C     !INTERFACE:  
       subroutine ctrl_pack( myiter, mytime, mythid )  
   
 C     !DESCRIPTION: \bv  
 c     *=================================================================  
 c     | SUBROUTINE ctrl_pack  
 c     | Pack the control vector  
 c     | * All control variable and adjoint variable fields are  
 c     |   read from disk.  
 c     | * Wet points are extracted, and elements are  
 c     |   normalized (optional)  
 c     | * A single control vector containing only (normalized  
 c     |   wet points is written to file.  
 c     *=================================================================  
 C     \ev  
4    
5  C     !USES:        subroutine ctrl_pack(
6         I                      myiter,
7         I                      mytime,
8         I                      mythid
9         &                    )
10    
11    c     ==================================================================
12    c     SUBROUTINE ctrl_pack
13    c     ==================================================================
14    c
15    c     o Compress the control vector such that only ocean points are
16    c       written to file.
17    c
18    c     started: Christian Eckert eckert@mit.edu  10-Mar=2000
19    c
20    c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
21    c              - Transferred some filename declarations
22    c                from here to namelist in ctrl_init
23    c  
24    c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000
25    c              - single file name convention with or without
26    c                ALLOW_ECCO_OPTIMIZATION
27    c
28    c              G. Gebbie, added open boundary control packing,
29    c                  gebbie@mit.edu  18 -Mar- 2003
30    c
31    c     ==================================================================
32    c     SUBROUTINE ctrl_pack
33    c     ==================================================================
34    
35        implicit none        implicit none
36    
37  c     == global variables ==  c     == global variables ==
# Line 247  c--       Header information. Line 259  c--       Header information.
259    
260  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
261            ivartype = 1            ivartype = 1
262              write(weighttype(1:80),'(80a)') ' '
263              write(weighttype(1:80),'(a)') "wtheta"
264            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
265       &         cunit, ivartype, adfname_theta, "hFacC",       &         cunit, ivartype, adfname_theta, "hFacC",
266       &         wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
267  #endif  #endif
268    
269  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
270            ivartype = 2            ivartype = 2
271              write(weighttype(1:80),'(80a)') ' '
272              write(weighttype(1:80),'(a)') "wsalt"
273            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
274       &         cunit, ivartype, adfname_salt, "hFacC",       &         cunit, ivartype, adfname_salt, "hFacC",
275       &         wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
276  #endif  #endif
277    
278  #if (defined (ALLOW_HFLUX_CONTROL) || \  #if (defined (ALLOW_HFLUX_CONTROL) || \
# Line 337  c--       Header information. Line 353  c--       Header information.
353    
354  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
355            ivartype = 11            ivartype = 11
356              write(weighttype(1:80),'(80a)') ' '
357              write(weighttype(1:80),'(a)') "wobcsn"
358            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
359       &         cunit, ivartype, adfname_obcsn, "maskobcsn",       &         cunit, ivartype, adfname_obcsn, "maskobcsn",
360       &         wobcsn, lxxadxx, mythid)       &         weighttype, wobcsn, lxxadxx, mythid)
361  #endif  #endif
362    
363  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
364            ivartype = 12            ivartype = 12
365              write(weighttype(1:80),'(80a)') ' '
366              write(weighttype(1:80),'(a)') "wobcss"
367            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
368       &         cunit, ivartype, adfname_obcss, "maskobcss",       &         cunit, ivartype, adfname_obcss, "maskobcss",
369       &         wobcss, lxxadxx, mythid)       &         weighttype, wobcss, lxxadxx, mythid)
370  #endif  #endif
371    
372  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
373            ivartype = 13            ivartype = 13
374              write(weighttype(1:80),'(80a)') ' '
375              write(weighttype(1:80),'(a)') "wobcsw"
376            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
377       &         cunit, ivartype, adfname_obcsw, "maskobcsw",       &         cunit, ivartype, adfname_obcsw, "maskobcsw",
378       &         wobcsw, lxxadxx, mythid)       &         weighttype, wobcsw, lxxadxx, mythid)
379  #endif  #endif
380    
381  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
382            ivartype = 14            ivartype = 14
383              write(weighttype(1:80),'(80a)') ' '
384              write(weighttype(1:80),'(a)') "wobcse"
385            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
386       &         cunit, ivartype, adfname_obcse, "maskobcse",       &         cunit, ivartype, adfname_obcse, "maskobcse",
387       &         wobcse, lxxadxx, mythid)       &         weighttype, wobcse, lxxadxx, mythid)
388  #endif  #endif
389    
390  #ifdef ALLOW_DIFFKR_CONTROL  #ifdef ALLOW_DIFFKR_CONTROL
391            ivartype = 15            ivartype = 15
392              write(weighttype(1:80),'(80a)') ' '
393              write(weighttype(1:80),'(a)') "wdiffkr"
394            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
395       &         cunit, ivartype, adfname_diffkr, "hFacC",       &         cunit, ivartype, adfname_diffkr, "hFacC",
396       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
397  #endif  #endif
398    
399  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
400            ivartype = 16            ivartype = 16
401              write(weighttype(1:80),'(80a)') ' '
402              write(weighttype(1:80),'(a)') "wkapgm"
403            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
404       &         cunit, ivartype, adfname_kapgm, "hFacC",       &         cunit, ivartype, adfname_kapgm, "hFacC",
405       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
406  #endif  #endif
407    
408  #ifdef ALLOW_TR10_CONTROL  #ifdef ALLOW_TR10_CONTROL
409            ivartype = 17            ivartype = 17
410              write(weighttype(1:80),'(80a)') ' '
411              write(weighttype(1:80),'(a)') "wtr1"
412            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
413       &         cunit, ivartype, adfname_tr1, "hFacC",       &         cunit, ivartype, adfname_tr1, "hFacC",
414       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
415  #endif  #endif
416    
417  #ifdef ALLOW_SST0_CONTROL  #ifdef ALLOW_SST0_CONTROL
# Line 404  c--       Header information. Line 434  c--       Header information.
434    
435  #ifdef ALLOW_HFACC_CONTROL  #ifdef ALLOW_HFACC_CONTROL
436            ivartype = 20            ivartype = 20
 #ifdef ALLOW_HFACC3D_CONTROL  
           call ctrl_set_pack_xyz(  
      &         cunit, ivartype, adfname_hfacc, "hFacC",  
      &         wunit, lxxadxx, mythid)  
 #else  
437            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
438            write(weighttype(1:80),'(a)') "whfacc"            write(weighttype(1:80),'(a)') "whfacc"
439    # ifdef ALLOW_HFACC3D_CONTROL
440              call ctrl_set_pack_xyz(
441         &         cunit, ivartype, adfname_hfacc, "hFacC",
442         &         weighttype, wunit, lxxadxx, mythid)
443    # else
444            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
445       &         cunit, ivartype, adfname_hfacc, "hFacC", weighttype,       &         cunit, ivartype, adfname_hfacc, "hFacC", weighttype,
446       &         lxxadxx, mythid)       &         lxxadxx, mythid)
447  #endif  # endif
448  #endif  #endif
449    
450  #ifdef ALLOW_EFLUXY0_CONTROL  #ifdef ALLOW_EFLUXY0_CONTROL
451            ivartype = 21            ivartype = 21
452              write(weighttype(1:80),'(80a)') ' '
453              write(weighttype(1:80),'(a)') "wefluxy0"
454            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
455       &         cunit, ivartype, adfname_efluxy, "hFacS",       &         cunit, ivartype, adfname_efluxy, "hFacS",
456       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
457  #endif  #endif
458    
459  #ifdef ALLOW_EFLUXP0_CONTROL  #ifdef ALLOW_EFLUXP0_CONTROL
460            ivartype = 22            ivartype = 22
461              write(weighttype(1:80),'(80a)') ' '
462              write(weighttype(1:80),'(a)') "wefluxp0"
463            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
464       &         cunit, ivartype, adfname_efluxp, "hFacV",       &         cunit, ivartype, adfname_efluxp, "hFacV",
465       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
466  #endif  #endif
467    
468  #ifdef ALLOW_BOTTOMDRAG_CONTROL  #ifdef ALLOW_BOTTOMDRAG_CONTROL
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22