<p><b>duda</b> 2011-04-29 18:21:06 -0600 (Fri, 29 Apr 2011)</p><p>BRANCH COMMIT<br>
<br>
If a separate SEAICE_FRACTIONAL file is not found, just assume sea ice has been set <br>
based on other data and continue with initialization, rather than quitting.<br>
<br>
<br>
M src/core_init_nhyd_atmos/module_test_cases.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_init_nhyd_atmos/module_test_cases.F
===================================================================
--- branches/atmos_physics/src/core_init_nhyd_atmos/module_test_cases.F 2011-04-29 23:51:50 UTC (rev 811)
+++ branches/atmos_physics/src/core_init_nhyd_atmos/module_test_cases.F 2011-04-30 00:21:06 UTC (rev 812)
@@ -3520,82 +3520,83 @@
if (istatus /= 0) then
write(0,*) 'Error reading SEAICE_FRACTIONAL data'
- return
end if
- call read_next_met_field(field, istatus)
- do while (istatus == 0)
- if (index(field % field, 'SEAICE') /= 0) then
+ if (istatus == 0) then
+ call read_next_met_field(field, istatus)
+ do while (istatus == 0)
+ if (index(field % field, 'SEAICE') /= 0) then
write(0,*) 'PROCESSING SEAICE'
- !
- ! Set up projection
- !
- call map_init(proj)
+ !
+ ! Set up projection
+ !
+ call map_init(proj)
- if (field % iproj == PROJ_PS) then
- call map_set(PROJ_PS, proj, &
- dx = real(field % dx * 1000.0), &
- truelat1 = real(field % truelat1), &
- stdlon = real(field % xlonc), &
- knowni = real(field % nx / 2.0), &
- knownj = real(field % ny / 2.0), &
- lat1 = real(field % startlat), &
- lon1 = real(field % startlon))
- end if
+ if (field % iproj == PROJ_PS) then
+ call map_set(PROJ_PS, proj, &
+ dx = real(field % dx * 1000.0), &
+ truelat1 = real(field % truelat1), &
+ stdlon = real(field % xlonc), &
+ knowni = real(field % nx / 2.0), &
+ knownj = real(field % ny / 2.0), &
+ lat1 = real(field % startlat), &
+ lon1 = real(field % startlon))
+ end if
- if (index(field % field, 'SEAICE') /= 0) then
- nInterpPoints = grid % nCells
- latPoints => grid % latCell % array
- lonPoints => grid % lonCell % array
- destField1d => fg % xice % array
- ndims = 1
- end if
+ if (index(field % field, 'SEAICE') /= 0) then
+ nInterpPoints = grid % nCells
+ latPoints => grid % latCell % array
+ lonPoints => grid % lonCell % array
+ destField1d => fg % xice % array
+ ndims = 1
+ end if
+
+ interp_list(1) = FOUR_POINT
+ interp_list(2) = W_AVERAGE4
+ interp_list(3) = 0
+
+ masked = 1
+ fillval = 0.0
+ msgval = 1.01
+ mask_array => grid % landmask % array
- interp_list(1) = FOUR_POINT
- interp_list(2) = W_AVERAGE4
- interp_list(3) = 0
- masked = 1
- fillval = 0.0
- msgval = 1.01
- mask_array => grid % landmask % array
-
-
- allocate(rslab(field % nx, field % ny))
- rslab(:,:) = field % slab(:,:)
- do i=1,nInterpPoints
- if (mask_array(i) /= masked) then
- lat = latPoints(i)*DEG_PER_RAD
- lon = lonPoints(i)*DEG_PER_RAD
- call latlon_to_ij(proj, lat, lon, x, y)
- if (x < 0.5) then
- lon = lon + 360.0
+ allocate(rslab(field % nx, field % ny))
+ rslab(:,:) = field % slab(:,:)
+ do i=1,nInterpPoints
+ if (mask_array(i) /= masked) then
+ lat = latPoints(i)*DEG_PER_RAD
+ lon = lonPoints(i)*DEG_PER_RAD
call latlon_to_ij(proj, lat, lon, x, y)
+ if (x < 0.5) then
+ lon = lon + 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ end if
+ if (ndims == 1) then
+ destField1d(i) = interp_sequence(x, y, 1, rslab, 1, field % nx, 1, field % ny, 1, 1, msgval, interp_list, 1)
+ if (destField1d(i) == msgval) destField1d(i) = fillval
+ else if (ndims == 2) then
+ destField2d(k,i) = interp_sequence(x, y, 1, rslab, 1, field % nx, 1, field % ny, 1, 1, msgval, interp_list, 1)
+ if (destField2d(k,i) == msgval) destField2d(k,i) = fillval
+ end if
+ else
+ if (ndims == 1) then
+ destField1d(i) = fillval
+ else if (ndims == 2) then
+ destField2d(k,i) = fillval
+ end if
end if
- if (ndims == 1) then
- destField1d(i) = interp_sequence(x, y, 1, rslab, 1, field % nx, 1, field % ny, 1, 1, msgval, interp_list, 1)
- if (destField1d(i) == msgval) destField1d(i) = fillval
- else if (ndims == 2) then
- destField2d(k,i) = interp_sequence(x, y, 1, rslab, 1, field % nx, 1, field % ny, 1, 1, msgval, interp_list, 1)
- if (destField2d(k,i) == msgval) destField2d(k,i) = fillval
- end if
- else
- if (ndims == 1) then
- destField1d(i) = fillval
- else if (ndims == 2) then
- destField2d(k,i) = fillval
- end if
- end if
- end do
- deallocate(rslab)
+ end do
+ deallocate(rslab)
- end if
-
- deallocate(field % slab)
- call read_next_met_field(field, istatus)
- end do
+ end if
+
+ deallocate(field % slab)
+ call read_next_met_field(field, istatus)
+ end do
+ end if
call read_met_close()
</font>
</pre>