<p><b>fanglin.yang@noaa.gov</b> 2012-05-11 00:45:54 -0600 (Fri, 11 May 2012)</p><p>update<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/dotstep.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/dotstep.f        2012-05-10 23:43:50 UTC (rev 1896)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/dotstep.f        2012-05-11 06:45:54 UTC (rev 1897)
@@ -40,7 +40,7 @@
TYPE(Nst_Var_Data) :: nst_fld
!!
!! real(kind_phys), parameter :: pi=3.1415926535897931
- integer :: IERR,I,J,K,L,LOCL,N
+ integer :: IERR,I,J,K,L,LOCL,n,nn
real*8 :: dt_warm, tem1, tem2
integer ifirst
data ifirst /1/
@@ -88,6 +88,11 @@
& xlon_mpas,xlat_mpas,lats_node_r,dt_mpas,nlunit_mpas,
& gfs_namelist_mpas)
+ if(levs.ne.levs_mpas .or. lonr.ne.ncell_mpas) then
+ print*, "levs.ne.levs_mpas or lonr.ne.ncell_mpas, quit"
+ call abort
+ endif
+
nodes=nodes_mpas
me=node0_mpas
do j=1,latr
@@ -103,16 +108,127 @@
fhour=fhour_mpas
phour=fhour_mpas
-!-----exchange surface and atmosphere state variables between MPAS and GFS
+!-----exchange atmosphere state variables between MPAS and GFS
allocate ( mp_pi(lonr,levp1,lats_node_r) )
allocate ( mp_pl(lonr,levs,lats_node_r) )
allocate ( mp_u(lonr,levs,lats_node_r) )
allocate ( mp_v(lonr,levs,lats_node_r) )
+ allocate ( mp_w(lonr,levs,lats_node_r) )
allocate ( mp_t(lonr,levs,lats_node_r) )
- allocate ( mp_w(lonr,levs,lats_node_r) )
allocate ( mp_q(lonr,levs,lats_node_r) )
allocate ( mp_tr(lonr,levs,ntrac-1,lats_node_r) )
+
+ do j=1,lats_node_r
+ do i=1,lonr
+ do k=1,levs+1
+ mp_pi(i,k,j)= air_mpas(1,i,k)
+ enddo
+ do k=1,levs
+ mp_pl(i,k,j)= air_mpas(2,i,k)
+ mp_u(i,k,j)= air_mpas(3,i,k)
+ mp_v(i,k,j)= air_mpas(4,i,k)
+ mp_w(i,k,j)= air_mpas(5,i,k)
+ mp_t(i,k,j)= air_mpas(6,i,k)
+ mp_q(i,k,j)= air_mpas(7,i,k)
+ do n=1,ntrac-1
+ nn=n+7
+ mp_tr(i,k,n,j)= air_mpas(nn,i,k)
+ enddo
+ enddo
+ enddo
+ enddo
+!-----exchange surface state variables between MPAS and GFS
+ do j=1,lats_node_r
+ do i=1,lonr
+ nn=1
+ sfc_fld%tsea (i,j) = sfc_mpas(i,nn)
+ do k=1,lsoil
+ nn=nn+1
+ sfc_fld%smc (i,j,k) = sfc_mpas(i,nn)
+ enddo
+ nn=nn+1
+ sfc_fld%sheleg (i,j) = sfc_mpas(i,nn)
+ do k=1,lsoil
+ nn=nn+1
+ sfc_fld%stc (i,j,k) = sfc_mpas(i,nn)
+ enddo
+ nn=nn+1
+ sfc_fld%tg3 (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%zorl (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%cv (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%cvb (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%cvt (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%alvsf (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%alvwf (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%alnsf (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%alnwf (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%slmsk (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%vfrac (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%canopy (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%f10m (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%vtype (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%stype (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%facsf (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%facwf (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%uustar (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%ffmm (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%ffhh (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%hice (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%fice (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%tprcp (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%srflag (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%snwdph (i,j) = sfc_mpas(i,nn)
+ do k=1,lsoil
+ nn=nn+1
+ sfc_fld%slc (i,j,k) = sfc_mpas(i,nn)
+ enddo
+ nn=nn+1
+ sfc_fld%shdmin (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%shdmax (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%slope (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%snoalb (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%oro (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%t2m (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%q2m (i,j) = sfc_mpas(i,nn)
+ nn=nn+1
+ sfc_fld%tisfc (i,j) = sfc_mpas(i,nn)
+ enddo
+ enddo
+ if (nn.ne.nsfc_mpas) then
+ print*, "GFS and MPAS surface vraibles do not match, quit"
+ call abort
+ endif
!------------------------------------------------------------
</font>
</pre>