File: C:\NOAA\NEMS_11731\src\chem\gocart\src\GMAO_Shared\Chem_Base\merge_crst.F90

1     !
2     !  Merge 2 Chem_Bundles. Quick and dirty.
3     !
4      
5          program merge_crst
6     
7          use Chem_RegistryMod
8          use Chem_BundleMod
9     
10          character(len=255) :: in_file(2), in_reg(2), out_file 
11          integer :: ier
12     
13          type(Chem_Registry) :: reg_in(2), reg_out
14          type(Chem_Registry) :: reg
15          type(Chem_Bundle)   :: w_in(2), w_out
16     
17          integer :: k,nhms,nymd,nymd2,nhms2,im,jm,km
18          integer :: i, j, i_in, i_out, j_in, j_out
19     
20     !    Take Aerosols and global CO from CRAVE run
21     !    ------------------------------------------
22          in_file(1) = '/output/dao_ops/GEOS-4_CRAVE/a_flk_04C/rs/Y2006/M02/a_flk_04C.rst.chem.20060221_15z.bin'
23     
24          in_reg(1) = '/output/dao_ops/GEOS-4_CRAVE/a_flk_04C/run/Chem_Registry.rc'
25     
26     !    Take O3 from Eric's file
27     !    ------------------------
28          in_file(2) = '/nobackup1/enielsen/fvchem/INTEX2006/c55/recycle/c55.c_rst.20060101'
29          in_reg(2) = '/nobackup1/enielsen/fvchem/INTEX2006/c55/run/Chem_Registry.rc'
30     
31     !    Output file to create
32          out_file = '/nobackup1/dasilva/rs4intex/20060221_15/a_flk_04C.c_rst'
33     
34     !    Create registries
35     !    -----------------
36          reg_in(1)  = Chem_RegistryCreate ( ier, rcfile = in_reg(1) )
37          call Chem_RegistryPrint(reg_in(1))
38          reg_in(2)  = Chem_RegistryCreate ( ier, rcfile = in_reg(2) )
39          call Chem_RegistryPrint(reg_in(2))
40          reg_out = Chem_RegistryCreate ( ier, rcfile = 'Chem_Registry.rc' )
41          call Chem_RegistryPrint(reg_out)
42          if ( ier /= 0 ) then
43             print *,'oops, error'
44             call exit(1)
45          end if
46     
47     !    Read in source bundles
48     !    ------------------------
49          call Chem_BundleRead ( trim(in_file(1)), nymd, nhms, w_in(1), ier, &
50                                 chemReg = reg_in(1) )
51          print *, 'Read first bundle at on ', nymd, nhms
52          call Chem_BundleRead ( trim(in_file(2)), nymd2, nhms2, w_in(2), ier, &
53                                 chemReg = reg_in(2) )
54          print *, 'nymd, nhms = ', nymd2, nhms2
55     
56     !    Fill in the static portion of the outgoing chem bundle
57     !    ------------------------------------------------------
58          im = w_in(1)%grid%im
59          jm = w_in(1)%grid%jm
60          km = w_in(1)%grid%km
61          call Chem_BundleCreate ( reg_out, im, jm, km, &
62                                   w_out, ier )
63          call Chem_RegistryPrint(w_out%reg)
64     
65     !    Most things come from the CRAVE run
66     !    -----------------------------------
67          w_out%delp = w_in(1)%delp
68          w_out%rh = w_in(1)%rh
69          w_out%qa = w_in(1)%qa
70          w_out%grid = w_in(1)%grid
71     
72          w_out% q = 0.0  ! start with a clean slate
73     
74     !    H2O
75     !    ---
76          i_in  = reg_in(1)%i_H2O; j_in  = reg_in(1)%j_H2O;
77          i_out = reg_out%i_H2O;   j_out =   reg_out%j_H2O;
78          w_out%q(:,:,:,i_out:j_out) = w_in(1)%q(:,:,:,i_in:j_in)
79     
80     !    DU
81     !    ---
82          i_in  = reg_in(1)%i_DU; j_in  = reg_in(1)%j_DU;
83          i_out = reg_out%i_DU;   j_out =   reg_out%j_DU;
84          w_out%q(:,:,:,i_out:j_out) = w_in(1)%q(:,:,:,i_in:j_in)
85     
86     !    SS
87     !    ---
88          i_in  = reg_in(1)%i_SS; j_in  = reg_in(1)%j_SS;
89          i_out = reg_out%i_SS;   j_out =   reg_out%j_SS;
90          w_out%q(:,:,:,i_out:j_out) = w_in(1)%q(:,:,:,i_in:j_in)
91     
92     !    BC
93     !    ---
94          i_in  = reg_in(1)%i_BC; j_in  = reg_in(1)%j_BC;
95          i_out = reg_out%i_BC;   j_out =   reg_out%j_BC;
96          w_out%q(:,:,:,i_out:j_out) = w_in(1)%q(:,:,:,i_in:j_in)
97     
98     !    OC
99     !    ---
100          i_in  = reg_in(1)%i_OC; j_in  = reg_in(1)%j_OC;
101          i_out = reg_out%i_OC;   j_out =   reg_out%j_OC;
102          w_out%q(:,:,:,i_out:j_out) = w_in(1)%q(:,:,:,i_in:j_in)
103     
104     !    SU
105     !    ---
106          i_in  = reg_in(1)%i_SU; j_in  = reg_in(1)%j_SU;
107          i_out = reg_out%i_SU;   j_out =   reg_out%j_SU;
108          w_out%q(:,:,:,i_out:j_out) = w_in(1)%q(:,:,:,i_in:j_in)
109     
110     !    Get O3 from Eric
111     !    ----------------
112          i_in  = reg_in(2)%i_O3; j_in  = reg_in(2)%j_O3;
113          i_out = reg_out%i_O3;   j_out =   reg_out%j_O3;
114          w_out%q(:,:,:,i_out:j_out) = w_in(2)%q(:,:,:,i_in:j_in)
115     
116     !    CO from Eric
117     !    ------------
118          i_in  = reg_in(2)%i_CO; j_in  = reg_in(2)%j_CO;
119          i_out = reg_out%i_CO;   j_out =   reg_out%j_CO;
120          w_out%q(:,:,:,i_out:j_out) = w_in(2)%q(:,:,:,i_in:j_in)
121     
122     
123     !    Write output file with date from Ops
124     !    ------------------------------------
125          call Chem_BundleWrite ( trim(out_file), nymd, nhms, 0, w_out, ier )
126     
127          print *, 'all done'
128     
129          end program merge_crst
130     
131     
132