<p><b>fanglin.yang@noaa.gov</b> 2012-05-10 00:06:21 -0600 (Thu, 10 May 2012)</p><p>9may2012 night update<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.ibm
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.ibm 2012-05-10 01:07:10 UTC (rev 1885)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.ibm 2012-05-10 06:06:21 UTC (rev 1886)
@@ -103,6 +103,7 @@
radiation_clouds.o \
radiation_surface.o \
gloopr.o \
+ gloopb.o \
grrad.o
#
@@ -180,10 +181,10 @@
#spect_write.o
-OBJS_CC= cmp.comm.o
+OBJS_CC= cmp.comm.o \
+ atm.comm.o
#mpi_more.o \
#cmp.comm.o \
-#atm.comm.o \
#tiles.o
SRC = $(OBJS0:.o=.f) $(OBJ_MOD:.o=.f) $(OBJS:.o=.f) $(OBJS_RAD:.o=.f) $(OBJS_PHY:.o=.f) $(OBJS_IO:.o=.f) $(OBJS_CC:.o=.f)
Modified: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.jet
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.jet 2012-05-10 01:07:10 UTC (rev 1885)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.jet 2012-05-10 06:06:21 UTC (rev 1886)
@@ -108,6 +108,7 @@
radiation_clouds.o \
radiation_surface.o \
grrad.o \
+ gloopb.o \
gloopr.o
#
@@ -181,10 +182,9 @@
# spect_write.o
-OBJS_CC= \
- cmp.comm.o
+OBJS_CC= cmp.comm.o \
+ atm.comm.o
# mpi_more.o \
-# atm.comm.o \
# tiles.o
SRC = $(OBJS0:.o=.f) $(OBJ_MOD:.o=.f) $(OBJS:.o=.f) $(OBJS_RAD:.o=.f) $(OBJS_PHY:.o=.f) $(OBJS_IO:.o=.f) $(OBJS_CC:.o=.f)
Modified: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/dotstep.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/dotstep.f 2012-05-10 01:07:10 UTC (rev 1885)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/dotstep.f 2012-05-10 06:06:21 UTC (rev 1886)
@@ -58,17 +58,17 @@
real(kind=kind_phys) :: sfc_mpas(nsfc_mpas,ncell_mpas)
real(kind=kind_phys) :: air_mpas(nair_mpas,ncell_mpas,levs_mpas)
-! --prsi : model interface level pressure in centibar
-! --prsl : model integer layer pressure in centibar
-! --gu : model layer zonal wind m/s
-! --gv : model layer meridional wind m/s
-! --vvel : model layer vertical velocity in centibar/sec
-! --gt : model layer temperature in K
-! --gr : model layer specific humidity in gm/gm
-! --gtrace: model layer tracer (ozne and cloud water) mass mixing ratio
- real (kind=kind_phys), allocatable :: prsi(:,:,:), prsl(:,:,:),
- & gu(:,:,:),gv(:,:,:),vvel(:,:,:),
- & gt(:,:,:),gr(:,:,:), gtrace(:,:,:,:)
+! --mp_pi : model interface level pressure in centibar
+! --mp_pl : model integer layer pressure in centibar
+! --mp_u : model layer zonal wind m/s
+! --mp_v : model layer meridional wind m/s
+! --mp_w : model layer vertical velocity in centibar/sec
+! --mp_t : model layer temperature in K
+! --mp_q : model layer specific humidity in gm/gm
+! --mp_tr : model layer tracer (ozne and cloud water) mass mixing ratio
+ real (kind=kind_phys), allocatable :: mp_pi(:,:,:), mp_pl(:,:,:),
+ & mp_u(:,:,:),mp_v(:,:,:),mp_w(:,:,:),
+ & mp_t(:,:,:),mp_q(:,:,:), mp_tr(:,:,:,:)
!-----mpas related fileds--------
!****************************************************************************
@@ -96,19 +96,19 @@
coslat_r2(i,j)=cos(xlat_mpas(i)) !xlat_mpas in radian
enddo
enddo
-
- allocate ( prsi(lonr,levp1,lats_node_r) )
- allocate ( prsl(lonr,levs,lats_node_r) )
- allocate ( gu(lonr,levs,lats_node_r) )
- allocate ( gv(lonr,levs,lats_node_r) )
- allocate ( gt(lonr,levs,lats_node_r) )
- allocate ( vvel(lonr,levs,lats_node_r) )
- allocate ( gr(lonr,levs,lats_node_r) )
- allocate ( gtrace(lonr,levs,ntrac-1,lats_node_r) )
-
ifirst=0
endif
+ 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_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) )
+
+
kdt=kdt_mpas
fhour=fhour_mpas
phour=fhour_mpas
@@ -181,7 +181,7 @@
& sfc_fld%cv, sfc_fld%cvt, sfc_fld%cvb, sfc_fld%FICE,
& sfc_fld%tisfc, sfc_fld%sncovr, sfc_fld%snoalb,
& hprime,phy_f3d,
- & prsi,prsl,gt,gr,gtrace,vvel,
+ & mp_pi,mp_pl,mp_t,mp_q,mp_w,mp_tr,
!--in and out
& fluxr,
!--output
@@ -201,7 +201,9 @@
& sfc_fld, flx_fld, nst_fld, sfalb,
& swh,hlw,hprime,slag,sdec,cdec,
& ozplin,jindx1,jindx2,ddy,
- & phy_f3d, phy_f2d)
+ & phy_f3d, phy_f2d,
+ & mp_pi,mp_pl,mp_t,mp_q,mp_u,
+ & mp_v,mp_w,mp_tr)
endif
!
@@ -217,5 +219,8 @@
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/physics_gfs/gloopb.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopb.f 2012-05-10 01:07:10 UTC (rev 1885)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopb.f 2012-05-10 06:06:21 UTC (rev 1886)
@@ -6,7 +6,9 @@
& sfc_fld, flx_fld, nst_fld, sfalb,
& swh,hlw,hprime,slag,sdec,cdec,
& ozplin,jindx1,jindx2,ddy,
- & phy_f3d, phy_f2d)
+ & phy_f3d, phy_f2d,
+ & mp_pi,mp_pl,mp_t,mp_q,mp_u,
+ & mp_v,mp_w,mp_tr)
!!
#include "f_hpm.h"
!!
@@ -23,11 +25,10 @@
use gg_def , only : coslat_r,rcs2_r,sinlat_r,wgt_r
use date_def , only : fhour,idate
use namelist_def , only : crtrh,fhswr,flgmin,
- & gen_coord_hybrid,gg_tracers,
+ & gen_coord_hybrid,ras,
& hybrid,ldiag3d,lscca,lsfwd,
& lsm,lssav,lsswr,ncw,ngptc,
& old_monin,pre_rad,random_clds,
- & ras,shuff_lats_r,
& sashal,ctei_rm,mom4ice,newsas,
& ccwf,cnvgwd,lggfs3d,trans_trac,
& mstrat,cal_pre,nst_fcst,
@@ -35,40 +36,78 @@
& bkgd_vdif_m, bkgd_vdif_h,
& bkgd_vdif_s,shal_cnv,
& psautco, prautco, evpco, wminco
- use coordinate_def , only : vertcoord_id
use module_ras , only : ras_init
use physcons , only : grav => con_g,
- & rerth => con_rerth, ! hmhj
- & fv => con_fvirt, ! mjr
- & rvrdm1 => con_FVirt,
- & rd => con_rd
+ & rerth => con_rerth,
+ & fv => con_fvirt,
+ & rvrdm1 => con_FVirt,
+ & rd => con_rd,
+ & con_rocp
use ozne_def , only : latsozp,levozp,
& pl_coeff,pl_pres,timeoz
+ use gfsmisc_def, only : sinlat_r2, coslat_r2
use Sfc_Flx_ESMFMod
use Nst_Var_ESMFMod
use mersenne_twister
use d3d_def
use tracer_const
-!
- include 'mpif.h'
+
+!-> Coupling insertion
+ USE SURFACE_cc
+!<- Coupling insertion
+
+!-------------------------------------------------------
+!-------------------------------------------------------
implicit none
+ include 'mpif.h'
!
+!---input and output variables
TYPE(Sfc_Var_Data) :: sfc_fld
TYPE(Flx_Var_Data) :: flx_fld
TYPE(Nst_Var_Data) :: nst_fld
-!
- real(kind=kind_phys), PARAMETER :: RLAPSE=0.65E-2
- real(kind=kind_evod), parameter :: cons_0=0.0, cons_24=24.0
- &, cons_99=99.0, cons_1p0d9=1.0E9
+ integer global_lats_r(latr)
+ integer lonsperlar(latr)
+ real (kind=kind_rad) slag,sdec,cdec,phour
+ real (kind=kind_rad) xlon(lonr,lats_node_r)
+ real (kind=kind_rad) xlat(lonr,lats_node_r)
+ real (kind=kind_rad) coszdg(lonr,lats_node_r),
+ & hprime(lonr,nmtvr,lats_node_r),
+! & fluxr(lonr,nfxr,lats_node_r),
+ & sfalb(lonr,lats_node_r)
+ real (kind=kind_rad) swh(lonr,levs,lats_node_r)
+ real (kind=kind_rad) hlw(lonr,levs,lats_node_r)
+!!
+ real (kind=kind_phys)
+ & phy_f3d(lonr,levs,num_p3d,lats_node_r),
+ & phy_f2d(lonr,num_p2d,lats_node_r), fscav(ntrac-ncld-1)
-!$$$ integer n1rac, n2rac,nlons_v(ngptc)
-!$$$ parameter (n1rac=ntrac-ntshft-1, n2rac=n1rac+1)
+! --mp_pi : model interface level pressure in centibar
+! --mp_pl : model integer layer pressure in centibar
+! --mp_u : model layer zonal wind in m/s
+! --mp_v : model layer meridional wind in m/s
+! --mp_w : model layer vertical velocity in centibar/sec
+! --mp_t : model layer temperature in K
+! --mp_q : model layer specific humidity in gm/gm
+! --mp_tr : model layer tracer (ozne and cloud water) mass mixing ratio
+ real (kind=kind_phys) ::
+ & mp_pi(lonr,levs+1,lats_node_r) ,
+ & mp_pl(lonr,levs,lats_node_r) ,
+ & mp_t(lonr,levs,lats_node_r) ,
+ & mp_q(lonr,levs,lats_node_r) ,
+ & mp_u(lonr,levs,lats_node_r) ,
+ & mp_v(lonr,levs,lats_node_r) ,
+ & mp_w(lonr,levs,lats_node_r) ,
+ & mp_tr(lonr,levs,ntrac-1,lats_node_r)
+
+ real(kind=kind_evod) gq_save(lonr,lats_dim_r)
+
+
+!----local variables
+ real(kind=kind_evod), parameter :: cons_24=24.0
+ &, cons_99=99.0, cons_1p0d9=1.0E9
!
-! integer id,njeff,istrt,lon,kdt
- integer id,njeff, lon,kdt
-!!
real(kind=kind_phys) prsl(ngptc,levs)
real(kind=kind_phys) prslk(ngptc,levs),dpshc(ngptc)
real(kind=kind_phys) prsi(ngptc,levs+1),phii(ngptc,levs+1)
@@ -76,14 +115,11 @@
!!
real (kind=kind_phys) gu(ngptc,levs), gv1(ngptc,levs)
real (kind=kind_phys) ugrd(ngptc,levs),vgrd(ngptc,levs)
- real (kind=kind_phys) gphi(ngptc), glam(ngptc)
real (kind=kind_phys) gq(ngptc), gt(ngptc,levs), pgr(ngptc)
real (kind=kind_phys) gr(ngptc,levs,ntrac)
real (kind=kind_phys) gd(ngptc,levs)
real (kind=kind_phys) adt(ngptc,levs), adr(ngptc,levs,ntrac)
real (kind=kind_phys) adu(ngptc,levs), adv(ngptc,levs)
- real (kind=kind_phys) gtv(ngptc,levs) ! hmhj
- real (kind=kind_phys) gtvx(ngptc,levs), gtvy(ngptc,levs) ! hmhj
real (kind=kind_phys) sumq(ngptc,levs), xcp(ngptc,levs)
!
real (kind=kind_phys) dt3dt_v(ngptc,levs,6),
@@ -93,35 +129,17 @@
&, upd_mf_v(ngptc,levs), dwn_mf_v(ngptc,levs)
&, det_mf_v(ngptc,levs)
&, dkh_v(ngptc,LEVS), rnp_v(ngptc,levs)
-!!
- real(kind=kind_evod) gq_save(lonr,lats_dim_r)
-!!
- real (kind=kind_rad) slag,sdec,cdec,phour
- real (kind=kind_rad) xlon(lonr,lats_node_r)
- real (kind=kind_rad) xlat(lonr,lats_node_r)
- real (kind=kind_rad) coszdg(lonr,lats_node_r),
- & hprime(lonr,nmtvr,lats_node_r),
-! & fluxr(lonr,nfxr,lats_node_r),
- & sfalb(lonr,lats_node_r)
- real (kind=kind_rad) swh(lonr,levs,lats_node_r)
- real (kind=kind_rad) hlw(lonr,levs,lats_node_r)
-!!
- real (kind=kind_phys)
- & phy_f3d(lonr,levs,num_p3d,lats_node_r),
- & phy_f2d(lonr,num_p2d,lats_node_r), fscav(ntrac-ncld-1)
!
-!
real (kind=kind_phys) exp,dtphys,dtp,dtf,sumed(2)
real (kind=kind_evod) tstep
real (kind=kind_phys) pdryini,sigshc,rk
!!
- integer global_lats_r(latr)
- integer lonsperlar(latr)
+ integer id,njeff,lon,kdt
integer dimg
-cc
+
integer i,ierr,iter,j,k,kap,kar,kat,kau,kav,ksq,jj,kk
integer kst,kdtphi,kdtlam ! hmhj
- integer l,lan,lan0,lat,lmax,locl,ii,lonrbm
+ integer l,lan,lat,lmax,locl,ii,lonrbm
! integer lon_dim,lons_lat,n,node
integer lons_lat,n,node
integer nsphys
@@ -130,23 +148,11 @@
& pwatp,ptotg(latr),sumwa,sumto,
& ptotj(lats_node_r),pcorr,pdryg,
& solhr,clstp
-cc
- integer ipt_ls ! hmhj
- real(kind=kind_evod) reall ! hmhj
-
- real(kind=kind_evod) typical_pgr
-c
-cc
- integer indlsev,jbasev,n0
- integer indlsod,jbasod
-cc
- include 'function2'
-cc
real(kind=kind_evod) cons0,cons2 !constant
-cc
+
logical lsout
logical, parameter :: flipv = .true.
-cc
+
! for nasa/nrl ozone production and distruction rates:(input through fixio)
real ozplin(latsozp,levozp,pl_coeff,timeoz)
integer jindx1(lats_node_r),jindx2(lats_node_r)!for ozone interpolaton
@@ -157,8 +163,6 @@
real(kind=kind_phys), allocatable :: acv(:,:),acvb(:,:),acvt(:,:)
save acv,acvb,acvt
!!
-! integer, parameter :: maxran=5000
-! integer, parameter :: maxran=3000
integer, parameter :: maxran=6000, maxsub=6, maxrs=maxran/maxsub
type (random_stat) :: stat(maxrs)
real (kind=kind_phys), allocatable, save :: rannum_tank(:,:,:)
@@ -170,7 +174,6 @@
logical first,ladj
parameter (ladj=.true.)
data first/.true./
-! save krsize, first, nrnd,seed0
save first, seed0
!!
integer nlons_v(ngptc)
@@ -184,11 +187,10 @@
&, rannum_v(ngptc,nrcm)
real(kind=kind_phys) sinlat_v(ngptc),coslat_v(ngptc)
&, ozplout_v(ngptc,levozp,pl_coeff)
- real (kind=kind_rad) rqtk(ngptc), rcs2_lan, rcs_lan
-! real (kind=kind_rad) rcs_v(ngptc), rqtk(ngptc), rcs2_lan
+ real (kind=kind_rad) rqtk(ngptc)
+! real (kind=kind_rad) rcs_v(ngptc), rqtk(ngptc)
!
!--------------------------------------------------------------------
-! print *,' in gloopb vertcoord_id =',vertcoord_id
! real(kind=kind_evod) sinlat_v(lonr),coslat_v(lonr),rcs2_v(lonr)
! real(kind=kind_phys) dpshc(lonr)
@@ -196,7 +198,6 @@
parameter (qmin=1.0e-10)
integer ksd,ksplam,kspphi
integer ksu,ksv,ksz,item,jtem,ktem,ltem,mtem
-
!
! --- for debug test use
real (kind=kind_phys) :: temlon, temlat, alon, alat
@@ -204,7 +205,6 @@
logical :: lprnt
!
!
-!
!----------------------
if (first) then
!----------------------
@@ -322,89 +322,61 @@
pwatg = 0.
ptotg = 0.
-
do lan=1,lats_node_r
lat = global_lats_r(ipt_lats_node_r-1+lan)
lons_lat = lonsperlar(lat)
pwatp = 0.
- rcs2_lan = rcs2_r(min(lat,latr-lat+1))
- rcs_lan = sqrt(rcs2_lan)
!$omp parallel do schedule(dynamic,1) private(lon)
!$omp+private(sumq,xcp,hprime_v,swh_v,hlw_v,stc_v,smc_v,slc_v)
!$omp+private(nlons_v,sinlat_v,coslat_v,ozplout_v,rannum_v)
!$omp+private(prslk,prsl,prsik,prsi,phil,phii,dpshc,work1,tem)
-!$omp+private(gu,gv1,gd,gq,gphi,glam,gt,gtv,gr,vvel,gtvx,gtvy)
+!$omp+private(gu,gv1,gd,gq,gt,gtv,gr,vvel)
!$omp+private(adt,adr,adu,adv,pgr,ugrd,vgrd,rqtk)
-!!$omp+private(adt,adr,adu,adv,pgr,rcs_v,ugrd,vgrd,rqtk)
!$omp+private(phy_f3dv,phy_f2dv)
!$omp+private(dt3dt_v,dq3dt_v,du3dt_v,dv3dt_v,upd_mf_v,dwn_mf_v)
!$omp+private(det_mf_v,dkh_v,rnp_v)
!$omp+private(njeff,item,jtem,ktem,i,j,k,n,kss)
-!!!$omp+private(temlon,temlat,lprnt,ipt)
+
do lon=1,lons_lat,ngptc
!!
njeff = min(ngptc,lons_lat-lon+1)
!!
! lprnt = .false.
-!
--------------------------------
-!---from MPAS
- do k = 1, LEVS
- do j = 1, njeff
- jtem = lon-1+j
- gu (j,k) =
- gv1(j,k) =
- gd (j,k) =
- gt (j,k) = gtv(j,k) / (1.0 + fv*max(gr(j,k,1),qmin))
- enddo
+ do k=1,levs+1
+ do j=1,njeff
+ jtem = lon-1+j
+ prsi(j,k) = mp_pi(jtem,k,lan) *1000.0 !from cb to Pa
+ prsik(j,k) = (1.e0-5*prsi(j,k))**con_rocp
+ enddo
+ enddo
+ do k=1,levs
+ do j=1,njeff
+ jtem = lon-1+j
+ vvel(j,k) = mp_w(jtem,k,lan) *1000.0 !from cb/s to pa/s
+ prsl(j,k) = mp_pl(jtem,k,lan) *1000.0 !from cb to pa
+ prslk(j,k) = (1.0e-5*prsl(j,k))**con_rocp
+ ugrd(j,k) = mp_u(jtem,k,lan)
+ vgrd(j,k) = mp_v(jtem,k,lan)
+ gt(j,k) = mp_t(jtem,k,lan)
+ gr(j,k,1) = mp_q(jtem,k,lan)
+ do n=1,ntrac-1
+ gr(j,k,n+1) = mp_tr(jtem,k,n,lan)
enddo
-!
- do i=1,njeff
- item = lon+i-1
- gq(i) = for_gr_r_2(item,ksq,lan)
- gphi(i) = for_gr_r_2(item,kspphi,lan)
- glam(i) = for_gr_r_2(item,ksplam,lan)
- enddo
-! Tracers
- do n=1,ntrac
- do k=1,levs
- item = KSR-1+k+(n-1)*levs
- do j=1,njeff
- gr(j,k,n) = for_gr_r_2(lon-1+j,item,lan)
- enddo
- enddo
- enddo
--------------------------------
+ enddo
+ enddo
-!
-!
- do i=1,njeff
- phil(i,levs) = 0.0 ! forces calculation of geopotential in gbphys
- pgr(i) = gq(i) * 1000.0 ! Convert from kPa to Pa for physics
- prsi(i,1) = pgr(i)
+ do i=1,njeff
+ phil(i,levs) = 0.0 ! forces calculation of geopotential in gbphys
+ pgr(i) = prsi(i,1)
dpshc(i) = 0.3 * prsi(i,1)
-!
nlons_v(i) = lons_lat
- sinlat_v(i) = sinlat_r(lat)
- coslat_v(i) = coslat_r(lat)
-! rcs_v(i) = sqrt(rcs2_lan)
-! rcs_v(i) = sqrt(rcs2_r(min(lat,latr-lat+1)))
+ sinlat_v(i) = sinlat_r2(lon,lat)
+ coslat_v(i) = coslat_r2(lon,lat)
enddo
- do k=1,levs
- do i=1,njeff
- ugrd(i,k) = gu(i,k) * rcs_lan
- vgrd(i,k) = gv1(i,k) * rcs_lan
-! ugrd(i,k) = gu(i,k) * rcs_v(i)
-! vgrd(i,k) = gv1(i,k) * rcs_v(i)
- prsl(i,k) = prsl(i,k) * 1000.0
- prsi(i,k+1) = prsi(i,k+1) * 1000.0
- vvel(i,k) = vvel(i,k) * 1000.0 ! Convert from Cb/s to Pa/s
- enddo
- enddo
-!??????????????????
+!
if (gen_coord_hybrid .and. thermodyn_id == 3) then
do i=1,ngptc
prslk(i,1) = 0.0 ! forces calculation of geopotential in gbphys
@@ -610,11 +582,33 @@
& nst_fld%c_0 (lon,lan), nst_fld%c_d(lon,lan), &
& nst_fld%w_0 (lon,lan), nst_fld%w_d(lon,lan), &
& rqtk &! rqtkD
-! & bak_gr_r_2(lon,kap,lan), &! rqtkD
& )
!!
!!
prsi = prsi * 0.001 ! Convert from Pa to kPa
+
+!---prepare output
+ do k=1,levs+1
+ do j=1,njeff
+ jtem = lon-1+j
+ mp_pi(jtem,k,lan)=0.001*prsi(j,k) !convert from pa to cb
+ enddo
+ enddo
+ do k=1,levs
+ do j=1,njeff
+ jtem = lon-1+j
+ mp_w(jtem,k,lan) = 0.001*vvel(j,k) !from pa/s to cb/s
+ mp_pl(jtem,k,lan) = 0.001*prsl(j,k) !convert from pa to cb
+ mp_u(jtem,k,lan) = ugrd(j,k)
+ mp_v(jtem,k,lan) = vgrd(j,k)
+ mp_t(jtem,k,lan) = gt(j,k)
+ mp_q(jtem,k,lan) = gr(j,k,1) !specific humidity
+ do n=1,ntrac-1
+ mp_tr(jtem,k,n,lan) = gr(j,k,n+1)
+ enddo
+ enddo
+ enddo
+
do k=1,lsoil
do i=1,njeff
item = lon + i - 1
@@ -684,43 +678,19 @@
!---------------------------
!
!
- ptotj(lan) = 0.
- do j=1,lons_lat
- ptotj(lan) = ptotj(lan) + gq_save(j,lan)
- pwatp = pwatp + flx_fld%pwat(j,lan)
+! ptotj(lan) = 0.
+! do j=1,lons_lat
+! ptotj(lan) = ptotj(lan) + gq_save(j,lan)
+! pwatp = pwatp + flx_fld%pwat(j,lan)
! print *,' kdt=',kdt,' pwatp=',pwatp,' pwat=',flx_fld%pwat(j,lan)
! &,' j=',j
- enddo
- pwatj(lan) = pwatp*grav/(2.*lonsperlar(lat)*1.e3)
- ptotj(lan) = ptotj(lan)/(2.*lonsperlar(lat))
+! enddo
+! pwatj(lan) = pwatp*grav/(2.*lonsperlar(lat)*1.e3)
+! ptotj(lan) = ptotj(lan)/(2.*lonsperlar(lat))
!---------------------------
enddo ! lan loop
!---------------------------
-!!
-!
-!!?????????????????????????????????????????????????
- call excha(lats_nodes_r,global_lats_r,ptotj,pwatj,ptotg,pwatg)
- sumwa = 0.
- sumto = 0.
- do lat=1,latr
- sumto = sumto + wgt_r(min(lat,latr-lat+1))*ptotg(lat)
- sumwa = sumwa + wgt_r(min(lat,latr-lat+1))*pwatg(lat)
-! print *,' kdt=',kdt,' lat=',lat,' sumwa=',sumwa,' sumto=',sumto,
-! &' ptotg=',ptotg(lat),' pwatg=',pwatg(lat)
- enddo
-cjfe
-cjfe write(70+me,*) sumto,sumwa,kdt
- pdryg = sumto - sumwa
-!!
- if(pdryini == 0.) pdryini = pdryg
- if( gen_coord_hybrid ) then ! hmhj
- pcorr = (pdryini-pdryg) * sqrt(2.) ! hmhj
- else ! hmhj
- pcorr = (pdryini-pdryg) / sumto * sqrt(2.)
- endif ! hmhj
-!!?????????????????????????????????????????????????
-
return
end
Modified: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopr.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopr.f 2012-05-10 01:07:10 UTC (rev 1885)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopr.f 2012-05-10 06:06:21 UTC (rev 1886)
@@ -9,7 +9,7 @@
& alvsf, alnsf, alvwf, alnwf, facsf, facwf,
& cv, cvt, cvb, fice, tisfc, sncovr, snoalb,
& hprime,phy_f3d,
- & prsi,prsl,gt,gr,gr1,vvel,
+ & mp_pi,mp_pl,mp_t,mp_q,mp_w,mp_tr,
!--in and out
& fluxr,
!--output
@@ -57,16 +57,19 @@
& hprime(lonr,nmtvr,lats_node_r), phour, &
& phy_f3d(lonr,levs,num_p3d,lats_node_r)
-! --prsi : model level pressure in centipar
-! --prsl : model layer mean pressure in centibar
-! --gt : model layer mean temperature in k
-! --gr : layer specific humidity in gm/gm
-! --gr1 : layer tracer (ozne and cloud water) mass mixing ratio
-! --vvel : layer mean vertical velocity in centibar/sec
+! --mp_pi : model interface level pressure in centibar
+! --mp_pl : model integer layer pressure in centibar
+! --mp_w : model layer vertical velocity in centibar/sec
+! --mp_t : model layer temperature in K
+! --mp_q : model layer specific humidity in gm/gm
+! --mp_tr : model layer tracer (ozne and cloud water) mass mixing ratio
real (kind=kind_phys), intent(in) ::
- & prsi(lonr,levp1,lats_node_r),prsl(lonr,levs,lats_node_r), &
- & gt(lonr,levs,lats_node_r),gr(lonr,levs,lats_node_r), &
- & gr1(lonr,levs,ntrac-1,lats_node_r),vvel(lonr,levs,lats_node_r)
+ & mp_pi(lonr,levp1,lats_node_r) ,
+ & mp_pl(lonr,levs,lats_node_r) ,
+ & mp_t(lonr,levs,lats_node_r) ,
+ & mp_w(lonr,levs,lats_node_r) ,
+ & mp_q(lonr,levs,lats_node_r) ,
+ & mp_tr(lonr,levs,ntrac-1,lats_node_r)
!
! --- ... input and output:
@@ -88,7 +91,17 @@
!! & htrlwb(NGPTC,LEVS,NBDLW,NBLCK,LATS_NODE_R)
! --- ... locals:
- real(kind=kind_phys) :: prslk(lonr,levs,lats_node_r)
+! --prsi : model level pressure in centipar
+! --prsl : model layer mean pressure in centibar
+! --gt : model layer mean temperature in k
+! --gr : layer specific humidity in gm/gm
+! --gr1 : layer tracer (ozne and cloud water) mass mixing ratio
+! --vvel : layer mean vertical velocity in centibar/sec
+ real (kind=kind_phys) :: prsi(NGPTC,levp1),prsl(NGPTC,levs), &
+ & prslk(NGPTC,levs),gt(NGPTC,levs), &
+ & gr(NGPTC,levs),vvel(NGPTC,levs), &
+ & gr1(NGPTC,levs,ntrac-1)
+
real(kind=kind_phys) :: hlw_v(NGPTC,LEVS), swh_v(NGPTC,LEVS)
real (kind=kind_phys) :: si_loc(LEVR+1)
@@ -268,7 +281,7 @@
!
!--a reference sigma for radiation initilization, k from surfce to top
do k = 1, levr+1
- si_loc(k) = prsi(1,k,1)/prsi(1,1,1)
+ si_loc(k) = mp_pi(1,k,1)/mp_pi(1,1,1)
enddo
! --- determin prognostic/diagnostic cloud scheme
@@ -354,19 +367,12 @@
lat = global_lats_r(ipt_lats_node_r-1+j)
lons_lat = lonsperlar(lan)
-! --- vertical structure variable prslk
-! and minimum water vapor mixing ratio
- do k=1,levr
- do i=1,lons_lat
- prslk(i,k,lan) = (0.01*prsl(i,k,lan))**con_rocp
-!! gr(i,k,lan) = max(qmin,gr(i,k,lan))
- enddo
- enddo
!!
!$omp parallel do schedule(dynamic,1) private(lon,i,j,k)
+!$omp+private(vvel,gt,gr,gr1)
!$omp+private(cldcov_v,fluxr_v,f_ice,f_rain,r_rime)
-!$omp+private(flgmin_v,hlw_v,swh_v)
+!$omp+private(prslk,prsl,prsik,prsi,flgmin_v,hlw_v,swh_v)
!$omp+private(njeff,n,item,jtem,ks,work1,work2)
!$omp+private(icsdsw,icsdlw)
!$omp+private(lprnt,ipt)
@@ -377,6 +383,26 @@
lprnt = .false.
ipt=lon !diagnostic printout point
!
+ do k=1,levr+1
+ do j=1,njeff
+ jtem = lon-1+j
+ prsi(j,k)=mp_pi(jtem,k,lan)
+ enddo
+ enddo
+ do k=1,levr
+ do j=1,njeff
+ jtem = lon-1+j
+ prsl(j,k)=mp_pl(jtem,k,lan)
+ gt(j,k)=mp_t(jtem,k,lan)
+ gr(j,k)=mp_q(jtem,k,lan)
+ vvel(j,k)=mp_w(jtem,k,lan)
+ prslk(j,k) = (0.01*prsl(j,k))**con_rocp
+ do n=1,ntrac-1
+ gr1(j,k,n)=mp_tr(jtem,k,n,lan)
+ enddo
+ enddo
+ enddo
+
do k=1,nfxr
do j=1,njeff
fluxr_v(j,k) = fluxr(lon+j-1,k,lan)
@@ -419,9 +445,7 @@
!
call grrad &
! --- inputs:
- & ( prsi(lon,1,lan),prsl(lon,1,lan),prslk(lon,1,lan), &
- & gt(lon,1,lan),gr(lon,1,lan),gr1(lon,1,lan,1), &
- & vvel(lon,1,lan),slmsk(lon,lan), &
+ & ( prsi,prsl,prslk,gt,gr,gr1,vvel,slmsk(lon,lan), &
& xlon(lon,lan),xlat(lon,lan),tsea(lon,lan), &
& sheleg(lon,lan),sncovr(lon,lan),snoalb(lon,lan), &
& zorl(lon,lan),hprime(lon,1,lan), &
</font>
</pre>