<p><b>fanglin.yang@noaa.gov</b> 2012-05-11 18:02:02 -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-11 22:26:19 UTC (rev 1903)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/dotstep.f 2012-05-12 00:02:02 UTC (rev 1904)
@@ -4,7 +4,7 @@
!=========================================================================
SUBROUTINE do_tstep_gfs(sfc_mpas,air_mpas,dt_mpas,
& kdt_mpas,fhour_mpas,idate_mpas,levs_mpas,
- & ncell_mpas,nsfc_mpas,nair_mpas,xlat_mpas,
+ & ncell_mpas,nair_mpas,xlat_mpas,
& xlon_mpas,nodes_mpas,node0_mpas,nlunit_mpas,
& gfs_namelist_mpas)
!=========================================================================
@@ -38,6 +38,7 @@
TYPE(Sfc_Var_Data) :: sfc_fld
TYPE(Flx_Var_Data) :: flx_fld
TYPE(Nst_Var_Data) :: nst_fld
+ TYPE(Sfc_Var_Data) :: sfc_mpas
!!
!! real(kind_phys), parameter :: pi=3.1415926535897931
integer :: IERR,I,J,K,L,LOCL,n,nn
@@ -55,7 +56,6 @@
real(kind=kind_phys) :: dt_mpas,fhour_mpas
real(kind=kind_phys) :: xlat_mpas(ncell_mpas)
real(kind=kind_phys) :: xlon_mpas(ncell_mpas)
- real(kind=kind_phys) :: sfc_mpas(nsfc_mpas,ncell_mpas)
real(kind=kind_phys) :: air_mpas(nair_mpas,ncell_mpas,levs_mpas)
! --mp_pi : model interface level pressure in centibar
@@ -121,13 +121,13 @@
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)
+ mp_pi(i,k,j)= 0.001*air_mpas(1,i,k) !convert pascal to centibar
enddo
do k=1,levs
- mp_pl(i,k,j)= air_mpas(2,i,k)
+ mp_pl(i,k,j)= 0.001*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_w(i,k,j)= 0.001*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
@@ -139,97 +139,9 @@
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
+ sfc_fld=sfc_mpas
+
!------------------------------------------------------------
!! if(.not. adiab) then
@@ -337,6 +249,32 @@
ENDIF
!
+!--------------------------------------------------
+!-----send atmospheric state variables back to driver
+ do j=1,lats_node_r
+ do i=1,lonr
+ do k=1,levs+1
+ air_mpas(1,i,k)=1000.0*mp_pi(i,k,j)
+ enddo
+ do k=1,levs
+ air_mpas(2,i,k)=1000.0*mp_pl(i,k,j)
+ air_mpas(3,i,k)=mp_u(i,k,j)
+ air_mpas(4,i,k)=mp_v(i,k,j)
+ air_mpas(5,i,k)=1000.0*mp_w(i,k,j)
+ air_mpas(6,i,k)=mp_t(i,k,j)
+ air_mpas(7,i,k)=mp_q(i,k,j)
+ do n=1,ntrac-1
+ nn=n+7
+ air_mpas(nn,i,k) = mp_tr(i,k,n,j)
+ enddo
+ enddo
+ enddo
+ enddo
+
+!-----send surface state variables back to driver
+ sfc_mpas=sfc_fld
+
+
deallocate (mp_pi,mp_pl,mp_t,mp_u,mp_v,mp_w)
deallocate (mp_q,mp_tr)
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/mpas_def.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/mpas_def.f 2012-05-11 22:26:19 UTC (rev 1903)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/mpas_def.f 2012-05-12 00:02:02 UTC (rev 1904)
@@ -1,28 +0,0 @@
-!--defines MPAS input variables for using NCEP GFS physics
-!
- module mpas_def
- use machine , only : kind_phys, kind_io4
- implicit none
-
- integer(kind=kind_io4) :: kdt_mpas,levs_mpas,ncell_mpas,
- & nodes_mpas,nodes0_mpas,nlunit_mpas,nsfc_mpas,nair_mpas
- integer :: date_mpas(4)
- real(kind=kind_phys) :: dt_mpas,fhour_mpas
- character (len=80) :: gfs_namelist_mpas
-
- real(kind=kind_phys),allocatable:: xlat_mpas(:)
- real(kind=kind_phys),allocatable:: xlon_mpas(:)
- real(kind=kind_phys),allocatable:: sfc_mpas(:,:)
- real(kind=kind_phys),allocatable:: air_mpas(:,:,:)
-
- contains
-
- subroutine mpas_aldat(ncell,levs,nsfc,nair)
- implicit none
- integer, intent(in) :: levs,ncell,nsfc,nair
-
- allocate( xlat_mpas(ncell), xlon_mpas(ncell) )
- allocate( sfc_mpas(nsfc,ncell), air_mpas(nair,ncell,levs) )
- end subroutine mpas_aldat
-
- end module mpas_def
</font>
</pre>