<p><b>fanglin.yang@noaa.gov</b> 2012-05-21 14:07:29 -0600 (Mon, 21 May 2012)</p><p>update<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/driver_gfscolumn.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/driver_gfscolumn.f (rev 0)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/driver_gfscolumn.f 2012-05-21 20:07:29 UTC (rev 1924)
@@ -0,0 +1,353 @@
+!--This driver prepares atmospheric and surface initial conditions and
+! runs NCEP/GFS physics at selected points as single column models.
+! May 2012, Fanglin Yang
+!
+!===============================
+ PROGRAM driver_gfscolumn
+!===============================
+
+ use machine
+ use Sfc_Flx_ESMFMod
+!-------------------------------------
+
+ implicit none
+
+!--number of cells used for test
+ integer, parameter :: ncell=10
+
+!--gfs initial condition dimensions
+ integer, parameter :: nlat=880, nlon=1760, levs=64
+ integer, parameter :: lsoil=4
+ integer, parameter :: nsfc=47, ntrace=3, nair=6+ntrace
+
+ TYPE(Sfc_Var_Data) :: sfc_mpas
+!--fields included in GFS analysis sfcanl. sfc2gg is used to
+!--converts spectral coefficients to gaussian grid.
+! tsea smc(4) sheleg stc(4) tg3 zorl
+! cv cvb cvt alvsf alvwf alnsf
+! alnwf slmsk vfrac canopy f10m vtype
+! stype facsf facwf uustar ffmm ffhh
+! hice fice tprcp srflag snwdph slc(4)
+! shdmin shdmax slope snoalb oro t2m
+! q2m tisfc
+
+!--fields included in GFS analysis siganl. ss2gg s used to
+!--converts spectral coefficients to gaussian grid.
+! HS 1 99 surface orography (m)
+! PS 1 99 surface pressure (Pa)
+! P 64 99 pressure (Pa)
+! DP 64 99 delta pressure (Pa)
+! T 64 99 temperature (K)
+! Q 64 99 specific humidity (kg/kg)
+! RH 64 99 relative humidity (%)
+! U 64 99 zonal wind (m/s)
+! V 64 99 meridional wind (m/s)
+! DIV 64 99 divergence (m/s**2)
+! VOR 64 99 vorticity (m/s**2)
+! Q2 64 99 tracer 2, ozone (kg/kg)
+! Q3 64 99 tracer 3, cloud water (kg/kg)
+ real(kind=kind_phys) :: hs(nlat,nlon)
+ real(kind=kind_phys) :: ps(nlat,nlon)
+ real(kind=kind_phys) :: p(nlat,nlon,levs)
+ real(kind=kind_phys) :: dp(nlat,nlon,levs)
+ real(kind=kind_phys) :: t(nlat,nlon,levs)
+ real(kind=kind_phys) :: q(nlat,nlon,levs)
+ real(kind=kind_phys) :: rh(nlat,nlon,levs)
+ real(kind=kind_phys) :: u(nlat,nlon,levs)
+ real(kind=kind_phys) :: v(nlat,nlon,levs)
+ real(kind=kind_phys) :: div(nlat,nlon,levs)
+ real(kind=kind_phys) :: vor(nlat,nlon,levs)
+ real(kind=kind_phys) :: q2(nlat,nlon,levs)
+ real(kind=kind_phys) :: q3(nlat,nlon,levs)
+
+ integer(kind=kind_io4) :: kdt,ncell,nodes,node0,nlunit
+ integer(kind=kind_io4) :: idate(4)
+ character(len=80) :: gfs_namelist
+
+ real(kind=kind_phys) :: dt,fhour
+ real(kind=kind_phys) :: xlat(ncell)
+ real(kind=kind_phys) :: xlon(ncell)
+ integer ierr
+!****************************************************************************
+
+
+!! define and allocate space for sfc_map, only 1 latitude
+ call sfcvar_aldata(ncell,1,lsoil,sfc_mpas,ierr)
+
+
+
+
+
+
+
+
+
+!--at initial time to allocate GFS-related model arrays,
+!--to read in GFS namelist file and set up running parameters,
+!--and to read in most static boundary conditions.
+ if(ifirst > 0) then
+
+!--GFS initial condition date, 1-hour,2-month,3-day,4-year
+ do j=1,4
+ idate(j)=idate(j)
+ enddo
+ lats_node_r=1 !for MPAS use 1-D block for each task
+
+ call GFS_Initialize(node0,fhour,levs,ncell,
+ & xlon,xlat,lats_node_r,dt,nlunit,
+ & gfs_namelist)
+
+ if(levs.ne.levs .or. lonr.ne.ncell) then
+ print*, "levs.ne.levs or lonr.ne.ncell, quit"
+ call abort
+ endif
+
+ nodes=nodes
+ me=node0
+ do j=1,latr
+ do i=1,lonr
+ sinlat_r2(i,j)=sin(xlat(i))
+ coslat_r2(i,j)=cos(xlat(i)) !xlat in radian
+ enddo
+ enddo
+ ifirst=0
+ endif
+
+ kdt=kdt
+ fhour=fhour
+ phour=fhour
+
+!-----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_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(1,i,k)
+ enddo
+ do k=1,levs
+ mp_pl(i,k,j)= air(2,i,k)
+ mp_u(i,k,j)= air(3,i,k)
+ mp_v(i,k,j)= air(4,i,k)
+ mp_w(i,k,j)= air(5,i,k)
+ mp_t(i,k,j)= air(6,i,k)
+ mp_q(i,k,j)= air(7,i,k)
+ do n=1,ntrac-1
+ nn=n+7
+ mp_tr(i,k,n,j)= air(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(i,nn)
+ do k=1,lsoil
+ nn=nn+1
+ sfc_fld%smc (i,j,k) = sfc(i,nn)
+ enddo
+ nn=nn+1
+ sfc_fld%sheleg (i,j) = sfc(i,nn)
+ do k=1,lsoil
+ nn=nn+1
+ sfc_fld%stc (i,j,k) = sfc(i,nn)
+ enddo
+ nn=nn+1
+ sfc_fld%tg3 (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%zorl (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%cv (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%cvb (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%cvt (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%alvsf (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%alvwf (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%alnsf (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%alnwf (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%slmsk (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%vfrac (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%canopy (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%f10m (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%vtype (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%stype (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%facsf (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%facwf (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%uustar (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%ffmm (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%ffhh (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%hice (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%fice (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%tprcp (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%srflag (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%snwdph (i,j) = sfc(i,nn)
+ do k=1,lsoil
+ nn=nn+1
+ sfc_fld%slc (i,j,k) = sfc(i,nn)
+ enddo
+ nn=nn+1
+ sfc_fld%shdmin (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%shdmax (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%slope (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%snoalb (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%oro (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%t2m (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%q2m (i,j) = sfc(i,nn)
+ nn=nn+1
+ sfc_fld%tisfc (i,j) = sfc(i,nn)
+ enddo
+ enddo
+ if (nn.ne.nsfc) then
+ print*, "GFS and MPAS surface vraibles do not match, quit"
+ call abort
+ endif
+
+!------------------------------------------------------------
+
+!! if(.not. adiab) then
+!! if (nscyc > 0 .and. mod(kdt,nscyc) == 1) then
+!! CALL gcycle(me,LATS_NODE_R,LONSPERLAR,global_lats_r,
+!! & ipt_lats_node_r,idate,fhour,fhcyc,
+!! & XLON ,XLAT , sfc_fld, ialb)
+!! endif
+!
+!! if (num_p3d == 3) then ! Ferrier Microphysics initialization
+!! call init_micro(deltim,lonr,levs,num_p3d,lats_node_r,
+!! & phy_f3d(1,1,1,1), fhour, me)
+!! endif
+!! endif
+!
+
+ if (nst_fcst > 1) then ! update TSEA
+ if (Coupler_id < 0 .or. .not. mom4ice) then ! Standalone mode
+ do j = 1, lats_node_r
+ do i = 1, lonr
+ if (sfc_fld%slmsk(i,j) == 0 ) then
+ dt_warm = (nst_fld%xt(i,j)+nst_fld%xt(i,j))
+ & / nst_fld%xz(i,j)
+ sfc_fld%TSEA(i,j) = nst_fld%tref(i,j)
+ & + dt_warm - nst_fld%dt_cool(i,j)
+ & - sfc_fld%oro(i,j)*rlapse
+ endif
+ enddo
+ enddo
+ else ! Coupled to MOM4 OM
+ tem1 = 0.5 / omz1
+ do j = 1, lats_node_r
+ do i = 1, lonr
+ if (sfc_fld%slmsk(i,j) == 0 ) then
+ tem2 = 1.0 / nst_fld%xz(i,j)
+ sfc_fld%tsea(i,j) = sfc_fld%tsea(i,j)
+ & + sfc_fld%oro(i,j)*rlapse
+ dt_warm = (nst_fld%xt(i,j)+nst_fld%xt(i,j)) * tem2
+
+ if ( nst_fld%xz(i,j) > omz1) then
+ nst_fld%tref(i,j) = sfc_fld%tsea(i,j)
+ & - (1.0-0.5*omz1*tem2) * dt_warm
+ & + nst_fld%z_c(i,j)*nst_fld%dt_cool(i,j)*tem1
+ else
+ nst_fld%tref(i,j) = sfc_fld%tsea(i,j)
+ & - (nst_fld%xz(i,j)*dt_warm
+ & - nst_fld%z_c(i,j)*nst_fld%dt_cool(i,j))*tem1
+ endif
+ sfc_fld%TSEA(i,j) = nst_fld%tref(i,j)
+ & + dt_warm - nst_fld%dt_cool(i,j)
+ & - sfc_fld%oro(i,j)*rlapse
+ endif
+ enddo
+ enddo
+ endif
+ endif
+
+ if (lsswr .or. lslwr) then ! Radiation Call!
+ if(.not. adiab) then
+ call gloopr
+!---input
+ & (phour,kdt,lonsperlar,global_lats_r,xlon,xlat,
+ & sfc_fld%slmsk,sfc_fld%sheleg,
+ & sfc_fld%zorl, sfc_fld%tsea,
+ & sfc_fld%alvsf, sfc_fld%alnsf, sfc_fld%alvwf,
+ & sfc_fld%alnwf, sfc_fld%facsf, sfc_fld%facwf,
+ & sfc_fld%cv, sfc_fld%cvt, sfc_fld%cvb, sfc_fld%FICE,
+ & sfc_fld%tisfc, sfc_fld%sncovr, sfc_fld%snoalb,
+ & hprime,phy_f3d,
+ & mp_pi,mp_pl,mp_t,mp_q,mp_w,mp_tr,
+!--in and out
+ & fluxr,
+!--output
+ & swh,hlw,
+ & coszdg, flx_fld%coszen, flx_fld%sfcnsw,
+ & flx_fld%sfcdlw, flx_fld%tsflw,
+ & flx_fld%sfcdsw, sfalb, flx_fld%sfcemis,
+ & slag,sdec,cdec)
+ endif
+ endif !sswr .or. lslwr
+
+
+ if(.not. adiab) then
+ call gloopb
+ & (phour,kdt,deltim,lonsperlar,global_lats_r,
+ & lsout,fscav,xlon,xlat,
+ & sfc_fld, flx_fld, nst_fld, sfalb,
+ & swh,hlw,hprime,slag,sdec,cdec,
+ & ozplin,jindx1,jindx2,ddy,
+ & phy_f3d, phy_f2d,
+ & mp_pi,mp_pl,mp_t,mp_q,mp_u,
+ & mp_v,mp_w,mp_tr)
+ endif
+
+!
+ IF (mod(kdt,nszer) == 0 .and. lsout) THEN
+ call flx_init(flx_fld,ierr)
+ zhour = fhour
+ FLUXR = 0.
+!
+ if (ldiag3d .or. lggfs3d) then
+ call d3d_zero(ldiag3d,lggfs3d)
+ if (fhour >= fhgoc3d) lggfs3d = .false.
+ endif
+ ENDIF
+!
+
+ deallocate (mp_pi,mp_pl,mp_t,mp_u,mp_v,mp_w)
+ deallocate (mp_q,mp_tr)
+
+ RETURN
+ END
Modified: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_jet
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_jet 2012-05-21 18:35:52 UTC (rev 1923)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_jet 2012-05-21 20:07:29 UTC (rev 1924)
@@ -13,8 +13,8 @@
#
cp -p $sorc_dir/* .
cp -p $sorc_gfs/* .
- rm $make_dir/*.o
- rm $make_dir/*.mod
+# rm $make_dir/*.o
+# rm $make_dir/*.mod
export EXEC="$exec_dir/global_fcst"
</font>
</pre>