<p><b>laura@ucar.edu</b> 2011-10-26 14:30:55 -0600 (Wed, 26 Oct 2011)</p><p>general updates needed to run real case initialization (case 7)<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_init_nhyd_atmos/Makefile
===================================================================
--- branches/atmos_physics/src/core_init_nhyd_atmos/Makefile 2011-10-26 20:28:58 UTC (rev 1144)
+++ branches/atmos_physics/src/core_init_nhyd_atmos/Makefile 2011-10-26 20:30:55 UTC (rev 1145)
@@ -8,14 +8,18 @@
module_bitarray.o \
module_queue.o \
module_hinterp.o \
- read_geogrid.o
+ read_geogrid.o \
+ module_physics_date_time.o \
+ module_physics_initialize_real.o \
+ module_physics_utilities.o
all: core_hyd
core_hyd: $(OBJS)
ar -ru libdycore.a $(OBJS)
-module_test_cases.o: module_advection.o module_read_met.o read_geogrid.o module_llxy.o module_hinterp.o
+module_test_cases.o: module_advection.o module_read_met.o read_geogrid.o module_llxy.o module_hinterp.o \
+ module_physics_initialize_real.o
module_hinterp.o: module_queue.o module_bitarray.o
@@ -29,6 +33,13 @@
module_mpas_core.o: module_advection.o module_test_cases.o
+module_physics_initialize_real.o: \
+ module_hinterp.o \
+ module_llxy.o \
+ module_read_met.o \
+ module_physics_date_time.o \
+ module_physics_utilities.o
+
clean:
$(RM) *.o *.mod *.f90 libdycore.a
Modified: branches/atmos_physics/src/core_init_nhyd_atmos/Registry
===================================================================
--- branches/atmos_physics/src/core_init_nhyd_atmos/Registry 2011-10-26 20:28:58 UTC (rev 1144)
+++ branches/atmos_physics/src/core_init_nhyd_atmos/Registry 2011-10-26 20:30:55 UTC (rev 1145)
@@ -8,10 +8,12 @@
namelist integer nhyd_model config_theta_adv_order 2
namelist real nhyd_model config_coef_3rd_order 1.0
namelist integer dimensions config_nvertlevels 26
+namelist integer dimensions config_nsoillevels 4
namelist integer dimensions config_nfglevels 27
-namelist integer dimensions config_nsoil_levels 4
+namelist integer dimensions config_nfgsoillevels 4
namelist character data_sources config_geog_data_path /data3/mp/wrfhelp/WPS_GEOG/
namelist character data_sources config_met_prefix FILE
+namelist character data_sources config_sst_prefix FILE
namelist integer data_sources config_fg_interval 21600
namelist real vertical_grid config_ztop 24000.0
namelist integer vertical_grid config_nsmterrain 2
@@ -19,6 +21,9 @@
namelist logical preproc_stages config_static_interp true
namelist logical preproc_stages config_vertical_grid true
namelist logical preproc_stages config_met_interp true
+namelist logical preproc_stages config_physics_init false
+namelist logical preproc_stages config_input_sst false
+namelist logical preproc_stages config_frac_seaice false
namelist character io config_input_name grid.nc
namelist character io config_sfc_update_name sfc_update.nc
namelist character io config_output_name output.nc
@@ -29,6 +34,7 @@
namelist logical restart config_do_restart false
namelist real restart config_restart_time 172800.0
+
#
# dim type name_in_file name_in_code
#
@@ -44,8 +50,9 @@
dim TWENTYONE 21
dim R3 3
dim nVertLevels namelist:config_nvertlevels
-dim nSoilLevels namelist:config_nsoil_levels
+dim nSoilLevels namelist:config_nsoillevels
dim nFGLevels namelist:config_nfglevels
+dim nFGSoilLevels namelist:config_nfgsoillevels
dim nVertLevelsP1 nVertLevels+1
dim nMonths 12
@@ -119,6 +126,7 @@
var persistent integer isltyp ( nCells ) 0 io soilcat_top mesh - -
var persistent integer soilcat_bot ( nCells ) 0 io soilcat_bot mesh - -
var persistent real snoalb ( nCells ) 0 io snoalb mesh - -
+var persistent real soiltemp ( nCells ) 0 io soiltemp mesh - -
var persistent real greenfrac ( nMonths nCells ) 0 io greenfrac mesh - -
var persistent real shdmin ( nCells ) 0 io shdmin mesh - -
var persistent real shdmax ( nCells ) 0 io shdmax mesh - -
@@ -151,26 +159,37 @@
var persistent real p_fg ( nFGLevels nCells Time ) 1 - p fg - -
var persistent real z_fg ( nFGLevels nCells Time ) 1 - z fg - -
var persistent real rh_fg ( nFGLevels nCells Time ) 1 - rh fg - -
-var persistent real soilz_fg ( nCells Time ) 1 - soilz fg - -
+var persistent real soilz_fg ( nCells Time ) 1 io soilz fg - -
var persistent real psfc_fg ( nCells Time ) 1 - psfc fg - -
var persistent real pmsl_fg ( nCells Time ) 1 - pmsl fg - -
# Horizontally interpolated from first-guess data
+var persistent real dz_fg ( nFGSoilLevels nCells Time ) 1 io dz_fg fg - -
+var persistent real dzs_fg ( nFGSoilLevels nCells Time ) 1 io dzs_fg fg - -
+var persistent real zs_fg ( nFGSoilLevels nCells Time ) 1 io zs_fg fg - -
+var persistent real st_fg ( nFGSoilLevels nCells Time ) 1 io st_fg fg - -
+var persistent real sm_fg ( nFGSoilLevels nCells Time ) 1 io sm_fg fg - -
+
+# Horizontally interpolated from first-guess data
# and should be read in by model
-var persistent real dz ( nSoilLevels nCells Time ) 1 o dz fg - -
-var persistent real dzs ( nSoilLevels nCells Time ) 1 o dzs fg - -
-var persistent real sh2o ( nSoilLevels nCells Time ) 1 o sh2o fg - -
-var persistent real smois ( nSoilLevels nCells Time ) 1 o smois fg - -
-var persistent real tslb ( nSoilLevels nCells Time ) 1 o tslb fg - -
-var persistent real tmn ( nCells Time ) 1 o tmn fg - -
-var persistent real skintemp ( nCells Time ) 1 o skintemp fg - -
-var persistent real sst ( nCells Time ) 1 so sst fg - -
-var persistent real snow ( nCells Time ) 1 o snow fg - -
-var persistent real snowc ( nCells Time ) 1 o snowc fg - -
-var persistent real xice ( nCells Time ) 1 o xice fg - -
-var persistent real seaice ( nCells Time ) 1 o seaice fg - -
+var persistent real dz ( nSoilLevels nCells Time ) 1 io dz fg - -
+var persistent real dzs ( nSoilLevels nCells Time ) 1 io dzs fg - -
+var persistent real zs ( nSoilLevels nCells Time ) 1 io zs fg - -
+var persistent real sh2o ( nSoilLevels nCells Time ) 1 io sh2o fg - -
+var persistent real smois ( nSoilLevels nCells Time ) 1 io smois fg - -
+var persistent real tslb ( nSoilLevels nCells Time ) 1 io tslb fg - -
+var persistent real tmn ( nCells Time ) 1 io tmn fg - -
+var persistent real skintemp ( nCells Time ) 1 io skintemp fg - -
+var persistent real sst ( nCells Time ) 1 iso sst fg - -
+var persistent real snow ( nCells Time ) 1 io snow fg - -
+var persistent real snowc ( nCells Time ) 1 io snowc fg - -
+var persistent real snowh ( nCells Time ) 1 io snowh fg - -
+var persistent real xice ( nCells Time ) 1 iso xice fg - -
+var persistent real seaice ( nCells Time ) 1 io seaice fg - -
var persistent real gfs_z ( nVertLevels nCells Time ) 1 - gfs_z fg - -
-var persistent real vegfra ( nCells Time ) 1 io vegfra mesh - -
+var persistent real vegfra ( nCells Time ) 1 io vegfra fg - -
+var persistent real sfc_albbck ( nCells Time ) 1 io sfc_albbck fg - -
+var persistent real xland ( nCells Time ) 1 io xland fg - -
# Prognostic variables: read from input, saved in restart, and written to output
var persistent real u ( nVertLevels nEdges Time ) 2 o u state - -
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-10-26 20:28:58 UTC (rev 1144)
+++ branches/atmos_physics/src/core_init_nhyd_atmos/module_test_cases.F 2011-10-26 20:30:55 UTC (rev 1145)
@@ -8,7 +8,9 @@
use sort
use mpas_timekeeping
+ use module_physics_initialize_real
+
contains
@@ -94,6 +96,9 @@
do while (associated(block_ptr))
call nhyd_test_case_gfs(domain % dminfo, block_ptr % mesh, block_ptr % fg, block_ptr % state % time_levs(1) % state, &
block_ptr % diag, config_test_case, block_ptr % parinfo)
+ if(config_physics_init) &
+ call physics_initialize_real(block_ptr % mesh, block_ptr % fg)
+
do i=2,nTimeLevs
call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
end do
@@ -1169,7 +1174,7 @@
call dmpar_bcast_real(dminfo, pibtop)
ptopb = p0*pibtop**(1./rcp)
- write(6,*) 'ptopb = ',.01*ptopb
+ write(0,*) 'ptopb = ',.01*ptopb
do i=1, grid % nCells
pb(nz1,i) = pibtop+.5*dzw(nz1)*gravity*(1.+qvb(nz1))/(cp*tb(nz1,i)*zz(nz1,i))
@@ -1840,7 +1845,7 @@
write(0,*) ' *** sounding for the simulation ***'
write(0,*) ' z theta pres qv rho_m u rr'
do k=1,nz1
- write(6,'(8(f14.9,2x))') .5*(zgrid(k,1)+zgrid(k+1,1))/1000., &
+ write(0,'(8(f14.9,2x))') .5*(zgrid(k,1)+zgrid(k+1,1))/1000., &
t(k,1)/(1.+1.61*scalars(index_qv,k,1)), &
.01*p0*p(k,1)**(1./rcp), &
1000.*scalars(index_qv,k,1), &
@@ -2083,6 +2088,7 @@
real (kind=4), allocatable, dimension(:,:,:) :: rarray ! NB: this should be a single-precision real array
real (kind=RKIND), allocatable, dimension(:,:) :: rslab, maskslab
real (kind=RKIND), allocatable, dimension(:,:) :: maxsnowalb
+ real (kind=RKIND), allocatable, dimension(:,:) :: soiltemp_1deg
real (kind=RKIND), allocatable, dimension(:,:,:) :: vegfra
integer, dimension(:), pointer :: mask_array
integer, dimension(grid % nEdges), target :: edge_mask
@@ -2213,10 +2219,10 @@
!
! Interpolate HGT
!
- nx = 126
- ny = 126
-! nx = 1206
-! ny = 1206
+! nx = 126
+! ny = 126
+ nx = 1206
+ ny = 1206
nzz = 1
isigned = 1
endian = 0
@@ -2227,14 +2233,14 @@
nhs(:) = 0
grid % ter % array(:) = 0.0
-! do jTileStart=1,20401,ny-6
- do jTileStart=1,961,ny-6
+ do jTileStart=1,20401,ny-6
+! do jTileStart=1,961,ny-6
jTileEnd = jTileStart + ny - 1 - 6
-! do iTileStart=1,42001,nx-6
- do iTileStart=1,2041,nx-6
+ do iTileStart=1,42001,nx-6
+! do iTileStart=1,2041,nx-6
iTileEnd = iTileStart + nx - 1 - 6
-! write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'topo_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
- write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'topo_10m/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'topo_30s/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
+! write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'topo_10m/',iTileStart,'-',iTileEnd,'.',jTileStart,'-',jTileEnd
write(0,*) trim(fname)
call read_geogrid(fname, len_trim(fname), &
@@ -2246,10 +2252,10 @@
iPoint = 1
do j=4,ny-3
do i=4,nx-3
-! lat_pt = -89.99583 + (jTileStart + j - 5) * 0.0083333333
-! lon_pt = -179.99583 + (iTileStart + i - 5) * 0.0083333333
- lat_pt = -89.91667 + (jTileStart + j - 5) * 0.166667
- lon_pt = -179.91667 + (iTileStart + i - 5) * 0.166667
+ lat_pt = -89.99583 + (jTileStart + j - 5) * 0.0083333333
+ lon_pt = -179.99583 + (iTileStart + i - 5) * 0.0083333333
+! lat_pt = -89.91667 + (jTileStart + j - 5) * 0.166667
+! lon_pt = -179.91667 + (iTileStart + i - 5) * 0.166667
lat_pt = lat_pt * pii / 180.0
lon_pt = lon_pt * pii / 180.0
@@ -2500,6 +2506,81 @@
!
+ ! Interpolate SOILTEMP:
+ !
+ nx = 186
+ ny = 186
+ nzz = 1
+ isigned = 0
+ endian = 0
+ wordsize = 2
+ scalefactor = 0.01
+ allocate(rarray(nx,ny,nzz))
+ allocate(soiltemp_1deg(360,180))
+ grid % soiltemp % array(:) = 0.0
+
+ call map_set(PROJ_LATLON, proj, &
+ latinc = 1.0, &
+ loninc = 1.0, &
+ knowni = 1.0, &
+ knownj = 1.0, &
+ lat1 = -89.5, &
+ lon1 = -179.5)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'soiltemp_1deg/',1,'-',180,'.',1,'-',180
+write(0,*) trim(fname)
+ call read_geogrid(fname, len_trim(fname), &
+ rarray, &
+ nx, ny, nzz, &
+ isigned, endian, scalefactor, wordsize, istatus)
+write(0,*) istatus
+write(0,*) 'min/max = ',minval(rarray(:,:,:)),maxval(rarray(:,:,:))
+ soiltemp_1deg(1:180,1:180) = rarray(4:183,4:183,1)
+
+ write(fname,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(config_geog_data_path)//'soiltemp_1deg/',181,'-',360,'.',1,'-',180
+write(0,*) trim(fname)
+ call read_geogrid(fname, len_trim(fname), &
+ rarray, &
+ nx, ny, nzz, &
+ isigned, endian, scalefactor, wordsize, istatus)
+write(0,*) istatus
+write(0,*) 'min/max = ',minval(rarray(:,:,:)),maxval(rarray(:,:,:))
+ soiltemp_1deg(181:360,1:180) = rarray(4:183,4:183,1)
+
+ interp_list(1) = FOUR_POINT
+ interp_list(2) = W_AVERAGE4
+ interp_list(3) = W_AVERAGE16
+ interp_list(4) = SEARCH
+ interp_list(5) = 0
+
+ do iCell=1,grid%nCells
+
+ if (grid % landmask % array(iCell) == 1) then
+ lat = grid % latCell % array(iCell)*DEG_PER_RAD
+ lon = grid % lonCell % array(iCell)*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)
+ else if (x >= 360.5) then
+ lon = lon - 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ end if
+if (y < 1.0) y = 1.0
+if (y > 179.0) y = 179.0
+! grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, -1.e30, interp_list, 1)
+ grid % soiltemp % array(iCell) = interp_sequence(x, y, 1, soiltemp_1deg, 1, 360, 1, 180, 1, 1, 0., interp_list, 1)
+ else
+ grid % soiltemp % array(iCell) = 0.0
+ end if
+
+ end do
+
+ deallocate(rarray)
+ deallocate(soiltemp_1deg)
+
+
+ !
! Interpolate SNOALB
!
nx = 186
@@ -2588,7 +2669,7 @@
scalefactor = 1.0
allocate(rarray(nx,ny,nzz))
allocate(vegfra(2500,1250,12))
- grid % vegfra % array(:) = 0.0
+! grid % vegfra % array(:) = 0.0
grid % greenfrac % array(:,:) = 0.0
call map_set(PROJ_LATLON, proj, &
@@ -2644,12 +2725,6 @@
end do
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!TO-DO: The vegfra field should be interpolated in time from the greenfrac field
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- grid % vegfra % array(:) = grid % greenfrac % array(1,:)
-
deallocate(rarray)
deallocate(vegfra)
@@ -2838,7 +2913,7 @@
end do
hm = maxval(ter(:))
- write(6,*) "max ter = ", hm
+ write(0,*) "max ter = ", hm
! Metrics for hybrid coordinate and vertical stretching
@@ -2888,7 +2963,7 @@
end if
do k=1,nz
- write(6,*) k,zw(k), ah(k)
+ write(0,*) k,zw(k), ah(k)
end do
do k=1,nz1
@@ -2970,7 +3045,7 @@
! dzmina = minval(hs(:)-hx(k-1,:))
dzmina = minval(zw(k)+ah(k)*hs(:)-zw(k-1)-ah(k-1)*hx(k-1,:))
- ! write(6,*) ' k,i, dzmina, dzmin, zw(k)-zw(k-1) ', k,i, dzmina, dzmin, zw(k)-zw(k-1)
+ ! write(0,*) ' k,i, dzmina, dzmin, zw(k)-zw(k-1) ', k,i, dzmina, dzmin, zw(k)-zw(k-1)
if (dzmina >= dzmin*(zw(k)-zw(k-1))) then
hx(k,:)=hs(:)
dzminf = dzmina
@@ -2978,7 +3053,7 @@
exit
end if
end do
- write(6,*) k,i,sm,dzminf/(zw(k)-zw(k-1)),dzmina/(zw(k)-zw(k-1))
+ write(0,*) k,i,sm,dzminf/(zw(k)-zw(k-1)),dzmina/(zw(k)-zw(k-1))
end do
do k=kz,nz
@@ -2988,7 +3063,7 @@
do k=2,nz1
dzmina = minval(zw(k)+ah(k)*hx(k,:)-zw(k-1)-ah(k-1)*hx(k-1,:))
- write(6,*) k,dzmina/(zw(k)-zw(k-1))
+ write(0,*) k,dzmina/(zw(k)-zw(k-1))
end do
end if
@@ -3170,10 +3245,12 @@
index(field % field, 'SM010040') /= 0 .or. &
index(field % field, 'SM040100') /= 0 .or. &
index(field % field, 'SM100200') /= 0 .or. &
+ index(field % field, 'SM010200') /= 0 .or. &
index(field % field, 'ST000010') /= 0 .or. &
index(field % field, 'ST010040') /= 0 .or. &
index(field % field, 'ST040100') /= 0 .or. &
index(field % field, 'ST100200') /= 0 .or. &
+ index(field % field, 'ST010200') /= 0 .or. &
index(field % field, 'PRES') /= 0 .or. &
index(field % field, 'SNOW') /= 0 .or. &
index(field % field, 'SEAICE') /= 0 .or. &
@@ -3183,10 +3260,12 @@
index(field % field, 'SM010040') /= 0 .or. &
index(field % field, 'SM040100') /= 0 .or. &
index(field % field, 'SM100200') /= 0 .or. &
+ index(field % field, 'SM010200') /= 0 .or. &
index(field % field, 'ST000010') /= 0 .or. &
index(field % field, 'ST010040') /= 0 .or. &
index(field % field, 'ST040100') /= 0 .or. &
index(field % field, 'ST100200') /= 0 .or. &
+ index(field % field, 'ST010200') /= 0 .or. &
index(field % field, 'SNOW') /= 0 .or. &
index(field % field, 'SEAICE') /= 0 .or. &
index(field % field, 'SKINTEMP') /= 0) then
@@ -3314,9 +3393,32 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % smois % array
+ destField2d => fg % sm_fg % array
k = 1
ndims = 2
+ fg % dzs_fg % array(k,:) = 10.
+ fg % zs_fg % array(k,:) = 10.
+ else if (index(field % field, 'SM010200') /= 0) then
+write(0,*) 'Interpolating SM010200'
+
+ interp_list(1) = SIXTEEN_POINT
+ interp_list(2) = FOUR_POINT
+ interp_list(3) = W_AVERAGE4
+ interp_list(4) = SEARCH
+ interp_list(5) = 0
+
+ maskval = 0.0
+ masked = 0
+ fillval = 1.0
+
+ nInterpPoints = grid % nCells
+ latPoints => grid % latCell % array
+ lonPoints => grid % lonCell % array
+ destField2d => fg % sm_fg % array
+ k = 2
+ ndims = 2
+ fg % dzs_fg % array(k,:) = 200.-10.
+ fg % zs_fg % array(k,:) = 200.
else if (index(field % field, 'SM010040') /= 0) then
write(0,*) 'Interpolating SM010040'
@@ -3333,9 +3435,11 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % smois % array
+ destField2d => fg % sm_fg % array
k = 2
ndims = 2
+ fg % dzs_fg % array(k,:) = 40.-10.
+ fg % zs_fg % array(k,:) = 40.
else if (index(field % field, 'SM040100') /= 0) then
write(0,*) 'Interpolating SM040100'
@@ -3352,9 +3456,11 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % smois % array
+ destField2d => fg % sm_fg % array
k = 3
ndims = 2
+ fg % dzs_fg % array(k,:) = 100.-40.
+ fg % zs_fg % array(k,:) = 100.
else if (index(field % field, 'SM100200') /= 0) then
write(0,*) 'Interpolating SM100200'
@@ -3371,9 +3477,11 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % smois % array
+ destField2d => fg % sm_fg % array
k = 4
ndims = 2
+ fg % dzs_fg % array(k,:) = 200.-100.
+ fg % zs_fg % array(k,:) = 200.
else if (index(field % field, 'ST000010') /= 0) then
write(0,*) 'Interpolating ST000010'
@@ -3390,9 +3498,32 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % tslb % array
+ destField2d => fg % st_fg % array
k = 1
ndims = 2
+ fg % dzs_fg % array(k,:) = 10.
+ fg % zs_fg % array(k,:) = 10.
+ else if (index(field % field, 'ST010200') /= 0) then
+write(0,*) 'Interpolating ST010200'
+
+ interp_list(1) = SIXTEEN_POINT
+ interp_list(2) = FOUR_POINT
+ interp_list(3) = W_AVERAGE4
+ interp_list(4) = SEARCH
+ interp_list(5) = 0
+
+ maskval = 0.0
+ masked = 0
+ fillval = 285.0
+
+ nInterpPoints = grid % nCells
+ latPoints => grid % latCell % array
+ lonPoints => grid % lonCell % array
+ destField2d => fg % st_fg % array
+ k = 2
+ ndims = 2
+ fg % dzs_fg % array(k,:) = 200.-10.
+ fg % zs_fg % array(k,:) = 200.
else if (index(field % field, 'ST010040') /= 0) then
write(0,*) 'Interpolating ST010040'
@@ -3409,9 +3540,11 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % tslb % array
+ destField2d => fg % st_fg % array
k = 2
ndims = 2
+ fg % dzs_fg % array(k,:) = 40.-10.
+ fg % zs_fg % array(k,:) = 40.
else if (index(field % field, 'ST040100') /= 0) then
write(0,*) 'Interpolating ST040100'
@@ -3428,9 +3561,11 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % tslb % array
+ destField2d => fg % st_fg % array
k = 3
ndims = 2
+ fg % dzs_fg % array(k,:) = 100.-40.
+ fg % zs_fg % array(k,:) = 100.
else if (index(field % field, 'ST100200') /= 0) then
write(0,*) 'Interpolating ST100200'
@@ -3447,9 +3582,11 @@
nInterpPoints = grid % nCells
latPoints => grid % latCell % array
lonPoints => grid % lonCell % array
- destField2d => fg % tslb % array
+ destField2d => fg % st_fg % array
k = 4
ndims = 2
+ fg % dzs_fg % array(k,:) = 200.-100.
+ fg % zs_fg % array(k,:) = 200.
else if (index(field % field, 'SNOW') /= 0) then
write(0,*) 'Interpolating SNOW'
@@ -3556,25 +3693,21 @@
fg % snowc % array(:) = 0.0
where (fg % snow % array > 0.0) fg % snowc % array = 1.0
- ! Set TMN based on TSLB
- do iCell=1,grid%nCells
- fg % tmn % array(iCell) = fg % tslb % array(4,iCell)
- end do
-
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!MGD CHECK
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
do iCell=1,grid%nCells
if (grid % landmask % array(iCell) == 1) then
- if (fg % tslb % array(1,iCell) <= 0.0) write(0,*) 'Bad tslb ', 1, iCell
- if (fg % tslb % array(2,iCell) <= 0.0) write(0,*) 'Bad tslb ', 2, iCell
- if (fg % tslb % array(3,iCell) <= 0.0) write(0,*) 'Bad tslb ', 3, iCell
- if (fg % tslb % array(4,iCell) <= 0.0) write(0,*) 'Bad tslb ', 4, iCell
- if (fg % smois % array(1,iCell) <= 0.0) write(0,*) 'Bad smois ', 1, iCell
- if (fg % smois % array(2,iCell) <= 0.0) write(0,*) 'Bad smois ', 2, iCell
- if (fg % smois % array(3,iCell) <= 0.0) write(0,*) 'Bad smois ', 3, iCell
- if (fg % smois % array(4,iCell) <= 0.0) write(0,*) 'Bad smois ', 4, iCell
+ do k = 1, config_nfgsoillevels
+ if (fg % st_fg % array(k,iCell) <= 0.0) write(0,*) 'Bad st_fg ', k, iCell
+ enddo
+
+ do k = 1, config_nfgsoillevels
+ if (fg % sm_fg % array(k,iCell) <= 0.0) write(0,*) 'Bad sm_fg ', k, iCell
+ enddo
+ !LDF end.
+
end if
end do
write(0,*) 'Done with soil consistency check'
@@ -3680,17 +3813,20 @@
!
! For now, hard-wire soil layer depths and thicknesses
!
- fg % dzs % array(1,:) = 0.10
- fg % dzs % array(2,:) = 0.30
- fg % dzs % array(3,:) = 0.60
- fg % dzs % array(4,:) = 1.00
- fg % dz % array(1,:) = 0.05
- fg % dz % array(2,:) = 0.25
- fg % dz % array(3,:) = 0.70
- fg % dz % array(4,:) = 1.50
+ !LDF begin:
+ !fg % dzs % array(1,:) = 0.10
+ !fg % dzs % array(2,:) = 0.30
+ !fg % dzs % array(3,:) = 0.60
+ !fg % dzs % array(4,:) = 1.00
+ !fg % dz % array(1,:) = 0.05
+ !fg % dz % array(2,:) = 0.25
+ !fg % dz % array(3,:) = 0.70
+ !fg % dz % array(4,:) = 1.50
+ !LDF end.
+
!
! Compute normal wind component and store in fg%u
!
@@ -4118,6 +4254,57 @@
exit
end if
+ if (index(field % field, 'SEAICE') /= 0) then
+
+ ! Interpolation routines use real(kind=RKIND), so copy from default real array
+ allocate(slab_r8(field % nx, field % ny))
+ do j=1,field % ny
+ do i=1,field % nx
+ slab_r8(i,j) = field % slab(i,j)
+ end do
+ end do
+
+ !
+ ! Set up map projection
+ !
+ call map_init(proj)
+
+ if (field % iproj == PROJ_LATLON) then
+ call map_set(PROJ_LATLON, proj, &
+ latinc = real(field % deltalat), &
+ loninc = real(field % deltalon), &
+ knowni = 1.0, &
+ knownj = 1.0, &
+ lat1 = real(field % startlat), &
+ lon1 = real(field % startlon))
+ end if
+
+ ! Interpolate SEAICE/SKINTEMP field to each MPAS grid cell
+ do iCell=1,grid % nCells
+ lat = grid % latCell % array(iCell) * DEG_PER_RAD
+ lon = grid % lonCell % array(iCell) * DEG_PER_RAD
+ call latlon_to_ij(proj, lat, lon, x, y)
+ if (y < 0.5) then
+ y = 1.0
+ else if (y >= real(field%ny)+0.5) then
+ y = real(field % ny)
+ end if
+ if (x < 0.5) then
+ lon = lon + 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ else if (x >= real(field%nx)+0.5) then
+ lon = lon - 360.0
+ call latlon_to_ij(proj, lat, lon, x, y)
+ end if
+ fg % xice % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30, interp_list, 1)
+
+ end do
+
+ deallocate(slab_r8)
+ deallocate(field % slab)
+ exit
+ end if
+
deallocate(field % slab)
call read_next_met_field(field, istatus)
end do
</font>
</pre>