Line data Source code
1 : module const_init
2 :
3 : ! Initialize constituents to default values
4 :
5 : use shr_kind_mod, only: r8 => shr_kind_r8, max_chars=>shr_kind_cl
6 : use spmd_utils, only: masterproc
7 : use cam_abortutils, only: endrun
8 : use cam_logfile, only: iulog
9 :
10 : implicit none
11 : private
12 : save
13 :
14 : public :: cnst_init_default
15 :
16 : interface cnst_init_default
17 : module procedure cnst_init_default_col
18 : module procedure cnst_init_default_cblock
19 : end interface cnst_init_default
20 :
21 : !==============================================================================
22 : CONTAINS
23 : !==============================================================================
24 :
25 0 : subroutine cnst_init_default_col(m_cnst, latvals, lonvals, q, mask, &
26 0 : verbose, notfound, z)
27 : use constituents, only: cnst_name, cnst_read_iv
28 : use aoa_tracers, only: aoa_tracers_implements_cnst, aoa_tracers_init_cnst
29 : use carma_intr, only: carma_implements_cnst, carma_init_cnst
30 : use chemistry, only: chem_implements_cnst, chem_init_cnst
31 : use clubb_intr, only: clubb_implements_cnst, clubb_init_cnst
32 : use co2_cycle, only: co2_implements_cnst, co2_init_cnst
33 : use microp_driver, only: microp_driver_implements_cnst, microp_driver_init_cnst
34 : use rk_stratiform, only: rk_stratiform_implements_cnst, rk_stratiform_init_cnst
35 : use tracers, only: tracers_implements_cnst, tracers_init_cnst
36 : use unicon_cam, only: unicon_implements_cnst, unicon_init_cnst
37 :
38 : !-----------------------------------------------------------------------
39 : !
40 : ! Purpose: initialize named tracer mixing ratio field
41 : ! This subroutine should be called ONLY at the beginning of an initial run
42 : !
43 : !-----------------------------------------------------------------------
44 :
45 : ! Dummy arguments
46 : integer, intent(in) :: m_cnst ! Constant index
47 : real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol)
48 : real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol)
49 : real(r8), intent(out) :: q(:,:) ! mixing ratio (ncol, plev)
50 : logical, optional, intent(in) :: mask(:) ! Only initialize where .true.
51 : logical, optional, intent(in) :: verbose ! For internal use
52 : logical, optional, intent(in) :: notfound ! Turn off initial dataset warn
53 : real(r8),optional, intent(in) :: z(:,:) ! height of full pressure level
54 : ! Local variables
55 0 : logical, allocatable :: mask_use(:)
56 : character(len=max_chars) :: name
57 : logical :: verbose_use
58 : logical :: notfound_use
59 :
60 0 : name = cnst_name(m_cnst)
61 :
62 0 : allocate(mask_use(size(latvals)))
63 0 : if (present(mask)) then
64 0 : if (size(mask_use) /= size(mask)) then
65 0 : call endrun('cnst_init_default: input, mask, is wrong size')
66 : end if
67 0 : mask_use = mask
68 : else
69 0 : mask_use = .true.
70 : end if
71 :
72 0 : if (present(verbose)) then
73 0 : verbose_use = verbose
74 : else
75 : verbose_use = .true.
76 : end if
77 :
78 : ! default is to assume the constituent was not found on the initial file
79 : ! before calling this routine. But it is also possible that the constituent
80 : ! was added with the "readiv=.false." option
81 0 : if (present(notfound)) then
82 0 : notfound_use = notfound
83 : else
84 : notfound_use = .true.
85 : end if
86 :
87 0 : q = 0.0_r8 ! Make sure we start fresh (insurance)
88 :
89 0 : if (masterproc .and. verbose_use .and. notfound_use) then
90 0 : if (cnst_read_iv(m_cnst)) then
91 0 : write(iulog, *) 'Field ',trim(trim(name)),' not found on initial dataset'
92 : else
93 0 : write(iulog, *) 'Field ',trim(trim(name)),' not read from initial dataset'
94 : end if
95 : end if
96 :
97 0 : if (aoa_tracers_implements_cnst(trim(name))) then
98 0 : call aoa_tracers_init_cnst(trim(name), latvals, lonvals, mask_use, q)
99 0 : if(masterproc .and. verbose_use) then
100 0 : write(iulog,*) ' ', trim(name), ' initialized by "aoa_tracers_init_cnst"'
101 : end if
102 0 : else if (carma_implements_cnst(trim(name))) then
103 0 : call carma_init_cnst(trim(name), latvals, lonvals, mask_use, q)
104 0 : if(masterproc .and. verbose_use) then
105 0 : write(iulog,*) ' ', trim(name), ' initialized by "carma_init_cnst"'
106 : end if
107 0 : else if (chem_implements_cnst(trim(name))) then
108 0 : call chem_init_cnst(trim(name), latvals, lonvals, mask_use, q)
109 0 : if(masterproc .and. verbose_use) then
110 0 : write(iulog,*) ' ', trim(name), ' initialized by "chem_init_cnst"'
111 : end if
112 0 : else if (clubb_implements_cnst(trim(name))) then
113 0 : call clubb_init_cnst(trim(name), latvals, lonvals, mask_use, q)
114 0 : if(masterproc .and. verbose_use) then
115 0 : write(iulog,*) ' ', trim(name), ' initialized by "clubb_init_cnst"'
116 : end if
117 0 : else if (co2_implements_cnst(trim(name))) then
118 0 : call co2_init_cnst(trim(name), latvals, lonvals, mask_use, q)
119 0 : if(masterproc .and. verbose_use) then
120 0 : write(iulog,*) ' ', trim(name), ' initialized by "co2_init_cnst"'
121 : end if
122 0 : else if (microp_driver_implements_cnst(trim(name))) then
123 0 : call microp_driver_init_cnst(trim(name), latvals, lonvals, mask_use, q)
124 0 : if(masterproc .and. verbose_use) then
125 0 : write(iulog,*) ' ', trim(name), ' initialized by "microp_driver_init_cnst"'
126 : end if
127 0 : else if (rk_stratiform_implements_cnst(trim(name))) then
128 0 : call rk_stratiform_init_cnst(trim(name), latvals, lonvals, mask_use, q)
129 0 : if(masterproc .and. verbose_use) then
130 0 : write(iulog,*) ' ', trim(name), ' initialized by "rk_stratiform_init_cnst"'
131 : end if
132 0 : else if (tracers_implements_cnst(trim(name))) then
133 0 : call tracers_init_cnst(trim(name), latvals, lonvals, mask_use, q, z=z)
134 0 : if(masterproc .and. verbose_use) then
135 0 : write(iulog,*) ' ', trim(name), ' initialized by "tracers_init_cnst"'
136 : end if
137 0 : else if (unicon_implements_cnst(trim(name))) then
138 0 : call unicon_init_cnst(trim(name), latvals, lonvals, mask_use, q)
139 0 : if(masterproc .and. verbose_use) then
140 0 : write(iulog,*) ' ', trim(name), ' initialized by "unicon_init_cnst"'
141 : end if
142 : else
143 0 : if(masterproc .and. verbose_use) then
144 0 : write(iulog,*) ' ', trim(name), ' set to minimum value'
145 : end if
146 : ! Q already set to zero
147 : end if
148 :
149 0 : end subroutine cnst_init_default_col
150 :
151 0 : subroutine cnst_init_default_cblock(m_cnst, latvals, lonvals, q, mask)
152 :
153 : !-----------------------------------------------------------------------
154 : !
155 : ! Purpose: initialize named tracer mixing ratio field
156 : ! This subroutine should be called ONLY at the beginning of an initial run
157 : !
158 : !-----------------------------------------------------------------------
159 :
160 : ! Dummy arguments
161 : integer, intent(in) :: m_cnst ! Constant index
162 : real(r8), intent(in) :: latvals(:) ! lat in degrees (ncol*blk)
163 : real(r8), intent(in) :: lonvals(:) ! lon in degrees (ncol*blk)
164 : real(r8), intent(out) :: q(:,:,:) ! mix ratio (ncol, plev, blk)
165 : logical, optional, intent(in) :: mask(:) ! Only initialize where .true.
166 :
167 : ! Local variables
168 0 : real(r8), allocatable :: latblk(:)
169 : integer :: i, bbeg, bend
170 : integer :: size1, size2, size3
171 : integer :: nblks, blksize
172 : logical :: verbose
173 :
174 0 : verbose = .true.
175 0 : size1 = size(q, 1)
176 0 : size2 = size(q, 2)
177 0 : size3 = size(q, 3)
178 0 : if ((size(latvals) == size1*size3) .and. (size(lonvals) == size1*size3)) then
179 : ! Case: unstructured with blocks in 3rd dim
180 0 : nblks = size3
181 : blksize = size1
182 : bend = 0
183 0 : do i = 1, nblks
184 0 : bbeg = bend + 1
185 0 : bend = bbeg + blksize - 1
186 0 : if (present(mask)) then
187 0 : if (size(mask) /= size(latvals)) then
188 0 : call endrun('cnst_init_default_cblock: incorrect mask size')
189 : end if
190 0 : call cnst_init_default(m_cnst, latvals(bbeg:bend), lonvals(bbeg:bend), q(:,:,i), mask=mask(bbeg:bend), verbose=verbose)
191 : else
192 0 : call cnst_init_default(m_cnst, latvals(bbeg:bend), lonvals(bbeg:bend), q(:,:,i), verbose=verbose)
193 : end if
194 0 : verbose = .false.
195 : end do
196 0 : else if ((size(latvals) == size2) .and. (size(lonvals) == size1)) then
197 : ! Case: lon,lat,lev
198 0 : if (present(mask)) then
199 0 : call endrun('cnst_init_default_cblock: mask not supported for lon/lat')
200 : else
201 0 : nblks = size2
202 0 : allocate(latblk(size1))
203 0 : do i = 1, nblks
204 0 : latblk(:) = latvals(i)
205 0 : call cnst_init_default(m_cnst, latblk, lonvals, q(:,i,:), verbose=verbose)
206 0 : verbose = .false.
207 : end do
208 0 : deallocate(latblk)
209 : end if
210 0 : else if ((size(latvals) == size3) .and. (size(lonvals) == size1)) then
211 : ! Case: lon,lev,lat
212 0 : if (present(mask)) then
213 0 : call endrun('cnst_init_default_cblock: mask not supported for lon/lat')
214 : else
215 0 : nblks = size3
216 0 : allocate(latblk(size1))
217 0 : do i = 1, nblks
218 0 : latblk(:) = latvals(i)
219 0 : call cnst_init_default(m_cnst, latblk, lonvals, q(:,:,i), verbose=verbose)
220 0 : verbose = .false.
221 : end do
222 0 : deallocate(latblk)
223 : end if
224 : else
225 0 : call endrun('cnst_init_default_cblock: Unknown q layout')
226 : end if
227 :
228 0 : end subroutine cnst_init_default_cblock
229 :
230 : end module const_init
|
