<p><b>fanglin.yang@noaa.gov</b> 2012-10-22 12:32:56 -0600 (Mon, 22 Oct 2012)</p><p>refresh<br>
</p><hr noshade><pre><font color="gray">Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/GFS_Initialize.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/GFS_Initialize.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/GFS_Initialize.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,1138 +0,0 @@
-
-! !MODULE: GFS_Initialize_module --- Initialize module of the ESMF
-! gridded component of the GFS system.
-!
-! !DESCRIPTION: GFS gridded component initialize module.
-!
-! !REVISION HISTORY:
-!
-! November 2004 Weiyu Yang Initial code.
-! January 2006 S. Moorthi Update to the new GFS version
-! August 2006 H. Juang Add option to run generalized coordinates
-! December 2006 S. Moorthi GFSIO included
-! February 2008 Weiyu Yang Modified for the ESMF 3.1.0 version, fixed bug for runDuration.
-! Oct 18 2010 S. Moorthi Added fscav initialization
-! March 8 2011 H. Juang Add option to run NDSL, which is the
-! non-iterating dimensionally-splitted semi-
-! Lagrangian advection for entire dynamics
-! May 2012 Fanglin Yang Simplified for use in MPAS without ESMF
-!
-!
-! !INTERFACE:
-!
- MODULE GFS_Initialize_module
-
-!
-!!USES:
-!
-!fy USE GFS_GetCf_ESMFMod
-!fy USE MACHINE, ONLY : kind_io4, kind_phys
-!fy USE namelist_def, ONLY : ndsl, nst_fcst
-!fy use gfsio_module , only : gfsio_init
-!fy use module_ras , only : nrcmax, fix_ncld_hr
-
- use machine
- use resol_def
- use layout1
- use vert_def
- use date_def
- use gg_def
- use coordinate_def
- use namelist_def
- use mpi_def
- use ozne_def
- use Sfc_Flx_ESMFMod
- use Nst_Var_ESMFMod
- use d3d_def
- use gfsmisc_def
- use tracer_const
-! use cmp_comm , only : Coupler_id
-
-
- IMPLICIT none
-
- CONTAINS
-
-!=============================================================================================
-!fy SUBROUTINE GFS_Initialize(gcGFS, gis, clock, rc)
- SUBROUTINE GFS_Initialize(fhour,levs_mpas,ncell,xlon_mpas,xlat_mpas, &
- lats_node_r,dt_mpas,nlunit,gfs_namelist)
-!=============================================================================================
-
-! integer(kind=kind_io4), intent(in) :: me !me=0 is master task
-! integer(kind=kind_io4), intent(in) :: nodes !computer node of current task
- integer(kind=kind_io4), intent(in) :: levs_mpas !MPAS vertical layers
- integer(kind=kind_io4), intent(in) :: ncell !MPAS number of cells for each task
- integer(kind=kind_io4), intent(in) :: nlunit !unit to read gfs_namelist
- integer, intent(in) :: lats_node_r !latitude points, 1 for MPAS
- real(kind=kind_phys), intent(in) :: dt_mpas !MPAS timestep in seconds
- real(kind=kind_phys), intent(in) :: fhour !MPAS forecast time
- real(kind=kind_phys), intent(in) :: xlon_mpas(ncell) !MPAS cell longitude
- real(kind=kind_phys), intent(in) :: xlat_mpas(ncell) !MPAS cell latitude
- character (len=*), intent(in) :: gfs_namelist
-
- TYPE(Sfc_Var_Data) :: sfc_fld
- TYPE(Flx_Var_Data) :: flx_fld
- TYPE(Nst_Var_Data) :: nst_fld
-
-! This subroutine set up the internal state variables,
-! allocate internal state arrays for initializing the GFS system.
-!----------------------------------------------------------------
-
-!fy TYPE(ESMF_VM) :: vm_local ! ESMF virtual machine
-!fy TYPE(ESMF_GridComp), INTENT(inout) :: gcGFS
-!fy TYPE(GFS_InternalState), POINTER, INTENT(inout) :: gis
-!fy TYPE(ESMF_Clock), INTENT(inout) :: clock
-! INTEGER, INTENT(out) :: rc
-!fy INTEGER, DIMENSION(mpi_status_size) :: status
-
-!fy TYPE(ESMF_TimeInterval) :: timeStep
-!fy TYPE(ESMF_TimeInterval) :: runDuration
-!fy TYPE(ESMF_Time) :: startTime
-!fy TYPE(ESMF_Time) :: stopTime
-!fy TYPE(ESMF_Time) :: currTime
-!fy INTEGER :: timeStep_sec
-!fy INTEGER :: runDuration_hour
- INTEGER :: ifhmax
-!fy INTEGER :: rc1 = ESMF_SUCCESS
- INTEGER :: ierr, jerr
- INTEGER :: yyc, mmc, ddc, hhc, minsc
-!
-!DHOU 01/11/2008, added these two variables
-!INTEGER :: lvlw, npe_single_member
-!fy INTEGER :: npe_single_member
-
- INTEGER :: l, ilat, locl, ikey, nrank_all, nfluxes
- INTEGER :: i,j,k
- real (kind=kind_io4) blatc4
- real (kind=kind_io4), allocatable :: pl_lat4(:), pl_pres4(:), pl_time4(:)
-
-! Set up parameters of MPI communications.
-! Use ESMF utility to get PE identification and total number of PEs.
-!-------------------------------------------------------------------
-!fy me = gis%me
-!fy NODES = gis%nodes
-!fy nlunit = gis%nam_gfs%nlunit
- icolor = 2
- print*,"in GFS_Initialize: me,nodes,icolor ",me,nodes,icolor
-
-!fy npe_single_member = gis%npe_single_member
-!fy print *,' npe_single_member=',npe_single_member
-!fy CALL COMPNS(gis%DELTIM,gis%IRET, &
-!fy! gis%ntrac, gis%nxpt, gis%nypt, gis%jintmx, gis%jcap, &
-!fy gis%ntrac, gis%jcapg, gis%jcap, &
-!fy gis%levs, gis%levr, gis%lonf, gis%lonr, gis%latg, gis%latr,&
-!fy gis%ntoz, gis%ntcw, gis%ncld, gis%lsoil, gis%nmtvr, &
-!fy gis%num_p3d, gis%num_p2d, me, gis%nam_gfs%nlunit, gis%nam_gfs%gfs_namelist)
-
- CALL COMPNS(DELTIM,IRET, &
- ntrac, jcapg, jcap, &
- levs, levr, lonf, lonr, latg, latr, &
- ntoz, ntcw, ncld, lsoil, nmtvr, &
- num_p3d, num_p2d, me, nlunit, gfs_namelist)
-
-!---------------
-!--for MPAS use ncell points for each task
- if(lonr.ne.ncell) lonr=ncell
- if(ngptc.gt.lonr) ngptc=lonr
- if(levs_mpas.ne.levs) levs=levs_mpas
- latr=1 !lat dimention is not used for MPAS cells
- deltim=dt_mpas
- ipt_lats_node_r=1
- latg=1 !total latitudinal points, not really used
- lonf=lonr
-
-!---------------
-
-!
- CALL set_soilveg(me,nlunit)
-!fy call set_tracer_const(gis%ntrac,me,nlunit)
- call set_tracer_const(ntrac,me,nlunit)
-!
-
-!fy ntrac = gis%ntrac
-!fy! nxpt = gis%nxpt
-!fy! nypt = gis%nypt
-!fy! jintmx = gis%jintmx
-!fy jcapg = gis%jcapg
-!fy jcap = gis%jcap
-!fy levs = gis%levs
-!fy levr = gis%levr
-!fy lonf = gis%lonf
-!fy lonr = gis%lonr
-!fy latg = gis%latg
-!fy latr = gis%latr
-!fy ntoz = gis%ntoz
-!fy ntcw = gis%ntcw
-!fy ncld = gis%ncld
-!fy lsoil = gis%lsoil
-!fy nmtvr = gis%nmtvr
-!fy num_p3d = gis%num_p3d
-!fy num_p2d = gis%num_p2d
-!fy if (gis%nam_gfs%Total_Member <= 1) then
-!fy ens_nam=' '
-!fy else
-!fy write(ens_nam,'("_",I2.2)') gis%nam_gfs%Member_Id
-!fy endif
-!
-! ivssfc = 200501
- ivssfc = 200509
- ivssfc_restart = 200509
- if (ivssfc .gt. ivssfc_restart) ivssfc_restart = ivssfc
- ivsnst = 200907
- ivsupa = 0
- if (levs .gt. 99) ivsupa = 200509
-!
- levh = ntrac*levs
-!fy gis%levh = levh ! Added by Weiyu
-! latgd = latg+ 2*jintmx
- latgd = latg
- jcap1 = jcap+1
- jcap2 = jcap+2
- latg2 = latg/2
- latr2 = latr/2
- levm1 = levs-1
- levp1 = levs+1
-!jfe parameter ( lonfx = lonf+2 )
-! lonfx = lonf + 1 + 2*nxpt+1
- lonrx = lonr+2
- lnt = jcap2*jcap1/2
- lnuv = jcap2*jcap1
- lnt2 = 2*lnt
- lnt22 = 2*lnt+1
- lnte = (jcap2/2)*((jcap2/2)+1)-1
- lnto = (jcap2/2)*((jcap2/2)+1)-(jcap2/2)
- lnted = lnte
- lntod = lnto
-
-! ngrids_sfcc = 32+LSOIL*3
-! ngrids_sfcc = 29+LSOIL*3 ! No CV, CVB, CVT!
- ngrids_sfcc = 32+LSOIL*3 ! No CV, CVB, CVT! includes T2M, Q2M, TISFC
-!*RADFLX*
-!* ngrids_flx = 66+30 ! additional fields (most related to land surface)
-! ngrids_flx = 66+43 ! additional fields (land surface + rad flux)
-
-!hchuang code change
-! soilw0_10cm, TMP2m, USTAR, HPBLsfc, U10m, V10m, SFCRsfc, ORO
-! array names : gsoil, gtmp2m, gustar, gpblh, gu10m, gv10m, gzorl, goro
-
- if (climate) then
- ngrids_flx = 66+36+8 ! additional 8 gocart avg output fields
- else
- ngrids_flx = 66+43+8 ! additional 8 gocart avg output fields
- endif
-
- if (nst_fcst > 0) then ! For NST model
-! ngrids_nst = 19 ! oceanic fields (for diurnal warming and sub-layer)
- nr_nst = 10 ! oceanic fields: for diurnal warming model run
- nf_nst = 9 ! oceanic fields: for GSI analysis
- ngrids_nst = nr_nst + nf_nst ! oceanic fields (for diurnal warming and sub-layer)
- else
- ngrids_nst = 0
- endif
-
-!*RADFLX*
-!* nfxr = 27
- nfxr = 33
- ngrids_gg = 2+LEVS*(4+ntrac)
-
-!
- if (ntrac-ncld-1 > 0) then
-!fy allocate ( gis%fscav(ntrac-ncld-1), stat = ierr )
-!fy gis%fscav = 0.0
- allocate ( fscav(ntrac-ncld-1), stat = ierr )
- fscav = 0.0
- endif
-
-!fy gis%lnt2 = lnt2
- lnt2 = lnt2
-
-!fy allocate(lat1s_a(0:jcap))
-!fy allocate(lat1s_r(0:jcap))
-
-!fy allocate(colrad_a(latg2))
-!fy allocate(wgt_a(latg2))
-!fy allocate(wgtcs_a(latg2))
-!fy allocate(rcs2_a(latg2))
-!fy allocate(sinlat_a(latg2))
-
- allocate(colrad_r(latr))
- allocate(wgt_r(latr2))
- allocate(wgtcs_r(latr2))
- allocate(rcs2_r(latr2))
- allocate(sinlat_r(latr))
- allocate(coslat_r(latr))
-
-!---for MPAS
- allocate(sinlat_r2(lonr,latr))
- allocate(coslat_r2(lonr,latr))
-!---for MPAS
-
-!fy allocate(am(levs,levs))
-!fy allocate(bm(levs,levs))
-!fy allocate(cm(levs,levs))
-!fy allocate(dm(levs,levs,jcap1))
- allocate(tor(levs))
- allocate(si(levp1))
- allocate(sik(levp1))
- allocate(sl(levs))
- allocate(slk(levs))
- allocate(del(levs))
- allocate(rdel2(levs))
- allocate(ci(levp1))
- allocate(cl(levs))
- allocate(tov(levs))
- allocate(sv(levs))
-
- allocate(AK5(LEVP1))
- allocate(BK5(LEVP1))
- allocate(CK5(LEVP1)) ! hmhj
- allocate(THREF(LEVP1)) ! hmhj
- allocate(CK(LEVS))
- allocate(DBK(LEVS))
- allocate(bkl(LEVS))
-!fy allocate(AMHYB(LEVS,LEVS))
-!fy allocate(BMHYB(LEVS,LEVS))
-!fy allocate(SVHYB(LEVS))
-!fy allocate(tor_hyb(LEVS))
-!fy allocate(D_HYB_m(levs,levs,jcap1))
-!fy allocate(dm205_hyb(jcap1,levs,levs))
-
-!sela added for semilag grid computations
-!fy allocate(AM_slg(LEVS,LEVS))
-!fy allocate(BM_slg(LEVS,LEVS))
-!fy allocate(SV_slg(LEVS))
-!fy allocate(tor_slg(LEVS))
-!fy allocate(sv_ecm(LEVS))
-!fy allocate(D_slg_m(levs,levs,jcap1))
-
-!sela added for semilag grid computations
-!fy allocate(yecm(LEVS,LEVS))
-!fy allocate(tecm(LEVS,LEVS))
-!fy allocate(y_ecm(LEVS,LEVS))
-!fy allocate(t_ecm(LEVS,LEVS))
-!sela added for semilag grid computations
-
- allocate(spdmax(levs))
-
-!fy allocate(buff_mult(lonr,latr,ngrids_sfcc+ngrids_nst))
-!fy if (gfsio_out) then
-!fy allocate(buff_multg(lonr*latr,ngrids_gg))
-!fy endif
-
-!fy allocate(tor_sig(levs), d_m(levs,levs,jcap1), &
-!fy dm205(jcap1,levs,levs))
-!fy dm205=555555555.
-!fy d_m =444444444.
-!
-
-!fy allocate(z(lnt2))
-!fy allocate(z_r(lnt2))
-!
- nfluxes = 153
-!fy allocate(fmm(lonr*latr,nfluxes),lbmm(lonr*latr,nfluxes))
-!fy allocate(ibufm(50,nfluxes),rbufm(50,nfluxes))
-
-!
-!fy allocate(gis%LONSPERLAT(latg))
-!fy allocate(gis%lonsperlar(latr))
- allocate(lonsperlar(latr))
-
-!fy if ( .not. ndsl ) then
-!***********************************************************************
-!fy if (redgg_a) then
-!fy
-!fy if (lingg_a) then
-!fy call set_lonsgg_redgg_lin(gis%lonsperlat,latg,me)
-!fy else
-!fy call set_lonsgg_redgg_quad(gis%lonsperlat,latg,me)
-!fy endif
-!fy
-!fy else ! next, for full grid.
-!fy
-!fy if (lingg_a) then
-!fy call set_lonsgg_fullgg_lin(gis%lonsperlat,latg,me)
-!fy else
-!fy call set_lonsgg_fullgg_quad(gis%lonsperlat,latg,me)
-!fy endif
-!fy
-!fy endif
-!***********************************************************************
-!fy if (redgg_b) then
-!fy if (lingg_b) then
-!fy call set_lonsgg_redgg_lin(gis%lonsperlar,latr,me)
-!fy else
-!fy call set_lonsgg_redgg_quad(gis%lonsperlar,latr,me)
-!fy endif
-!fy else ! next, for full loopb and r grids.
-!fy if (lingg_b) then
-!fy call set_lonsgg_fullgg_lin(gis%lonsperlar,latr,me)
-!fy else
-!fy call set_lonsgg_fullgg_quad(gis%lonsperlar,latr,me)
-!fy endif
-!fy endif
-!***********************************************************************
-!fy else
-!fy if (num_reduce == 0) then
-!fy gis%lonsperlat = lonf
-!fy gis%lonsperlar = lonr
-!fy else
-!fy call set_lonsgg(gis%lonsperlat,gis%lonsperlar,num_reduce,me)
-!fy endif
-!fy endif
-
- lonsperlar = lonr !for MPAS
-!***********************************************************************
-!
- if (ras) then
- if (fix_ncld_hr) then
-! nrcm = min(nrcmax, levs-1) * (gis%deltim/1200) + 0.50001
-!fy nrcm = min(nrcmax, levs-1) * (gis%deltim/1200) + 0.10001
- nrcm = min(nrcmax, levs-1) * (deltim/1200) + 0.10001
-! nrcm = min(nrcmax, levs-1) * min(1.0,gis%deltim/360) + 0.1
- else
- nrcm = min(nrcmax, levs-1)
- endif
-! nrcm = max(nrcmax, nint((nrcmax*gis%deltim)/600.0))
- else
- nrcm = 1
- endif
-!
-! if (.not. adiab) then
- if (ntoz .le. 0) then ! Diagnostic ozone
- rewind (kozc)
- read (kozc,end=101) latsozc, levozc, timeozc, blatc4
- 101 if (levozc .lt. 10 .or. levozc .gt. 100) then
- rewind (kozc)
- levozc = 17
- latsozc = 18
- blatc = -85.0
- else
- blatc = blatc4
- endif
- latsozp = 2
- levozp = 1
- timeoz = 1
- pl_coeff = 0
- else ! Prognostic Ozone
- rewind (kozpl)
- read (kozpl) pl_coeff, latsozp, levozp, timeoz
- allocate (pl_lat(latsozp), pl_pres(levozp),pl_time(timeoz+1))
- allocate (pl_lat4(latsozp), pl_pres4(levozp),pl_time4(timeoz+1))
- rewind (kozpl)
- read (kozpl) pl_coeff, latsozp, levozp, timeoz, pl_lat4, pl_pres4, &
- pl_time4
- pl_pres(:) = pl_pres4(:)
- pl_lat(:) = pl_lat4(:)
- pl_time(:) = pl_time4(:)
- latsozc = 2
- blatc = 0.0
- endif
- dphiozc = -(blatc+blatc)/(latsozc-1)
-!
- if (me .eq. 0) then
- print *,' latsozp=',latsozp,' levozp=',levozp,' timeoz=',timeoz
- print *,' latsozc=',latsozc,' levozc=',levozc,' timeozc=', &
- timeozc, 'dphiozc=',dphiozc
- print *,' pl_lat=',pl_lat
- print *,' pl_pres=',pl_pres
- print *,' pl_time=',pl_time
- endif
-! pl_pres(:) = log(0.1*pl_pres(:)) ! Natural log of pres in cbars
- pl_pres(:) = log(100.0*pl_pres(:)) ! Natural log of pres in Pa
-!
-!fy allocate(gis%OZPLIN(LATSOZP,LEVOZP,pl_coeff,timeoz)) !OZONE P-L coeffcients
- allocate(OZPLIN(LATSOZP,LEVOZP,pl_coeff,timeoz)) !OZONE P-L coeffcients
-! endif
-!
-!
- P_GZ = 0*LEVS+0*LEVH+1 ! GZE/O(LNTE/OD,2),
- P_ZEM = 0*LEVS+0*LEVH+2 ! ZEME/O(LNTE/OD,2,LEVS),
- P_DIM = 1*LEVS+0*LEVH+2 ! DIME/O(LNTE/OD,2,LEVS),
- P_TEM = 2*LEVS+0*LEVH+2 ! TEME/O(LNTE/OD,2,LEVS),
- P_QM = 3*LEVS+0*LEVH+2 ! QME/O(LNTE/OD,2),
- P_ZE = 3*LEVS+0*LEVH+3 ! ZEE/O(LNTE/OD,2,LEVS),
- P_DI = 4*LEVS+0*LEVH+3 ! DIE/O(LNTE/OD,2,LEVS),
- P_TE = 5*LEVS+0*LEVH+3 ! TEE/O(LNTE/OD,2,LEVS),
- P_Q = 6*LEVS+0*LEVH+3 ! QE/O(LNTE/OD,2),
- P_DLAM= 6*LEVS+0*LEVH+4 ! DPDLAME/O(LNTE/OD,2),
- P_DPHI= 6*LEVS+0*LEVH+5 ! DPDPHIE/O(LNTE/OD,2),
- P_ULN = 6*LEVS+0*LEVH+6 ! ULNE/O(LNTE/OD,2,LEVS),
- P_VLN = 7*LEVS+0*LEVH+6 ! VLNE/O(LNTE/OD,2,LEVS),
- P_W = 8*LEVS+0*LEVH+6 ! WE/O(LNTE/OD,2,LEVS),
- P_X = 9*LEVS+0*LEVH+6 ! XE/O(LNTE/OD,2,LEVS),
- P_Y =10*LEVS+0*LEVH+6 ! YE/O(LNTE/OD,2,LEVS),
- P_ZQ =11*LEVS+0*LEVH+6 ! ZQE/O(LNTE/OD,2)
- P_RT =11*LEVS+0*LEVH+7 ! RTE/O(LNTE/OD,2,LEVH),
- P_RM =11*LEVS+1*LEVH+7 ! RME/O(LNTE/OD,2,LEVH),
- P_RQ =11*LEVS+2*LEVH+7 ! RQE/O(LNTE/OD,2,LEVH),
-!
-!**********************Current operational as of May 2009***********
-! P_GZ = 0*LEVS+0*LEVH+1 ! GZE/O(LNTE/OD,2),
-! P_ZEM = 0*LEVS+0*LEVH+2 ! ZEME/O(LNTE/OD,2,LEVS),
-! P_DIM = 1*LEVS+0*LEVH+2 ! DIME/O(LNTE/OD,2,LEVS),
-! P_TEM = 2*LEVS+0*LEVH+2 ! TEME/O(LNTE/OD,2,LEVS),
-! P_RM = 3*LEVS+0*LEVH+2 ! RME/O(LNTE/OD,2,LEVH),
-! P_QM = 3*LEVS+1*LEVH+2 ! QME/O(LNTE/OD,2),
-! P_ZE = 3*LEVS+1*LEVH+3 ! ZEE/O(LNTE/OD,2,LEVS),
-! P_DI = 4*LEVS+1*LEVH+3 ! DIE/O(LNTE/OD,2,LEVS),
-! P_TE = 5*LEVS+1*LEVH+3 ! TEE/O(LNTE/OD,2,LEVS),
-! P_RQ = 6*LEVS+1*LEVH+3 ! RQE/O(LNTE/OD,2,LEVH),
-! P_Q = 6*LEVS+2*LEVH+3 ! QE/O(LNTE/OD,2),
-! P_DLAM= 6*LEVS+2*LEVH+4 ! DPDLAME/O(LNTE/OD,2),
-! P_DPHI= 6*LEVS+2*LEVH+5 ! DPDPHIE/O(LNTE/OD,2),
-! P_ULN = 6*LEVS+2*LEVH+6 ! ULNE/O(LNTE/OD,2,LEVS),
-! P_VLN = 7*LEVS+2*LEVH+6 ! VLNE/O(LNTE/OD,2,LEVS),
-! P_W = 8*LEVS+2*LEVH+6 ! WE/O(LNTE/OD,2,LEVS),
-! P_X = 9*LEVS+2*LEVH+6 ! XE/O(LNTE/OD,2,LEVS),
-! P_Y =10*LEVS+2*LEVH+6 ! YE/O(LNTE/OD,2,LEVS),
-! P_RT =11*LEVS+2*LEVH+6 ! RTE/O(LNTE/OD,2,LEVH),
-! P_ZQ =11*LEVS+3*LEVH+6 ! ZQE/O(LNTE/OD,2)
-!**********************Current operational as of May 2009***********
-!C
- LOTS = 5*LEVS+1*LEVH+3
- LOTD = 6*LEVS+2*LEVH+0
- LOTA = 3*LEVS+1*LEVH+1
-!
- kwq = 0*levs+0*levh+1 ! qe/o_ls
- kwte = 0*levs+0*levh+2 ! tee/o_ls
- kwdz = 1*levs+0*levh+2 ! die/o_ls zee/o_ls
- kwrq = 3*levs+0*levh+2 ! rqe/o_ls
-
-!
-!fy gis%P_GZ = 0*LEVS+0*LEVH+1 ! GZE/O(LNTE/OD,2),
-!fy gis%P_ZEM = 0*LEVS+0*LEVH+2 ! ZEME/O(LNTE/OD,2,LEVS),
-!fy gis%P_DIM = 1*LEVS+0*LEVH+2 ! DIME/O(LNTE/OD,2,LEVS),
-!fy gis%P_TEM = 2*LEVS+0*LEVH+2 ! TEME/O(LNTE/OD,2,LEVS),
-!fy gis%P_RM = 3*LEVS+0*LEVH+2 ! RME/O(LNTE/OD,2,LEVH),
-!fy gis%P_QM = 3*LEVS+1*LEVH+2 ! QME/O(LNTE/OD,2),
-!fy gis%P_ZE = 3*LEVS+1*LEVH+3 ! ZEE/O(LNTE/OD,2,LEVS),
-!fy gis%P_DI = 4*LEVS+1*LEVH+3 ! DIE/O(LNTE/OD,2,LEVS),
-!fy gis%P_TE = 5*LEVS+1*LEVH+3 ! TEE/O(LNTE/OD,2,LEVS),
-!fy gis%P_RQ = 6*LEVS+1*LEVH+3 ! RQE/O(LNTE/OD,2,LEVH),
-!fy gis%P_Q = 6*LEVS+2*LEVH+3 ! QE/O(LNTE/OD,2),
-!fy gis%P_DLAM= 6*LEVS+2*LEVH+4 ! DPDLAME/O(LNTE/OD,2),
-!fy gis%P_DPHI= 6*LEVS+2*LEVH+5 ! DPDPHIE/O(LNTE/OD,2),
-!fy gis%P_ULN = 6*LEVS+2*LEVH+6 ! ULNE/O(LNTE/OD,2,LEVS),
-!fy gis%P_VLN = 7*LEVS+2*LEVH+6 ! VLNE/O(LNTE/OD,2,LEVS),
-!fy gis%P_W = 8*LEVS+2*LEVH+6 ! WE/O(LNTE/OD,2,LEVS),
-!fy gis%P_X = 9*LEVS+2*LEVH+6 ! XE/O(LNTE/OD,2,LEVS),
-!fy gis%P_Y =10*LEVS+2*LEVH+6 ! YE/O(LNTE/OD,2,LEVS),
-!fy gis%P_RT =11*LEVS+2*LEVH+6 ! RTE/O(LNTE/OD,2,LEVH),
-!fy gis%P_ZQ =11*LEVS+3*LEVH+6 ! ZQE/O(LNTE/OD,2)
-!C
-!fy gis%LOTS = 5*LEVS+1*LEVH+3
-!fy gis%LOTD = 6*LEVS+2*LEVH+0
-!fy gis%LOTA = 3*LEVS+1*LEVH+1
-!C
-!fy allocate(gis%TEE1(LEVS))
-
-! gis%LSLAG=.FALSE. ! IF FALSE EULERIAN SCHEME =.true. for semilag
-
-!
-!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
-!!
-!! Create IO communicator and comp communicator
-!!
-!sela LIOPE=.FALSE.
-!! LIOPE=.TRUE.
- IF (me == 0) write(*,*) 'IO OPTION ,LIOPE :',LIOPE
-!
-!fy CALL ESMF_VMGetCurrent(vm_local, rc = ierr)
-!fy CALL ESMF_VMGet(vm_local, mpiCommunicator = MPI_COMM_ALL, &
-!fy peCount = nodes, rc = ierr)
-!
-!fy CALL MPI_COMM_DUP(MPI_COMM_ALL, MPI_COMM_ALL_DUP, ierr)
-!fy CALL MPI_Barrier (MPI_COMM_ALL_DUP, ierr)
-
-!fy IF (NODES == 1) THEN
-!fy LIOPE=.FALSE.
-!fy write(*,*) 'IO OPTION RESET:,LIOPE :',LIOPE
-!fy ENDIF
-!fy IF (LIOPE) THEN
-!fy CALL MPI_COMM_RANK(MPI_COMM_ALL_DUP,nrank_all,ierr)
-!fy icolor = 1
-!fy ikey = 1
-!fy nodes_comp = nodes-1
-!fy if (nrank_all == nodes-1) then
-!! IO server
-!fy write(*,*) 'IO server task'
-!fy icolor = 2
-!fy gis%kcolor = MPI_UNDEFINED
-!fy CALL MPI_COMM_SPLIT(MPI_COMM_ALL_DUP,icolor,ikey,MC_IO,ierr)
-!fy CALL MPI_COMM_SPLIT(MPI_COMM_ALL_DUP,gis%kcolor,ikey,MC_COMP,ierr)
-!fy else
-!fy icolor = MPI_UNDEFINED
-!fy gis%kcolor = 1
-!fy CALL MPI_COMM_SPLIT(MPI_COMM_ALL_DUP,gis%kcolor,ikey,MC_COMP,ierr)
-!fy CALL MPI_COMM_SPLIT(MPI_COMM_ALL_DUP,icolor,ikey,MC_IO,ierr)
-!fy CALL MPI_COMM_SIZE(MC_COMP,NODES,IERR)
-!fy endif
-!fy ELSE
-!fy icolor = 2
-!fy MC_COMP = MPI_COMM_ALL_DUP
-!fy nodes_comp = nodes
-!fy ENDIF
-!!
-!C
-!fy CALL f_hpminit(ME,"EVOD") !jjt hpm stuff
-!C
-!fy CALL f_hpmstart(25,"GET_LS_GFTLONS")
-!C
-!fy if(me.eq.0) then
-!fy call w3tagb('gsm ',0000,0000,0000,'np23 ')
-!fy endif
-!!
-!fy CALL synchro
-!fy CALL init_countperf(latg)
-!
-!fy if (me.eq.0) then
-!fy PRINT 100, JCAP,LEVS
-!fy100 FORMAT (' SMF ',I3,I3,' CREATED AUGUST 2000 EV OD RI ')
-!fy PRINT*,'NUMBER OF THREADS IS ',NUM_PARTHDS()
-!fy if (liope) then
-!fy PRINT*,'NUMBER OF MPI PROCS IS ',NODES
-!fy PRINT*,'NUMBER OF MPI IO PROCS IS 1 (nodes)'
-!fy else
-!fy PRINT*,'NUMBER OF MPI PROCS IS ',NODES
-!fy endif
-!fy endif
-!C
-!fy gis%CONS0 = 0.0D0
-!fy gis%CONS0P5 = 0.5D0
-!fy gis%CONS1200 = 1200.D0
-!fy gis%CONS3600 = 3600.D0
- CONS0 = 0.0D0
- CONS0P5 = 0.5D0
- CONS1200 = 1200.D0
- CONS3600 = 3600.D0
-!C
-!fy if (liope) then
-!fy if (icolor.eq.2) then
-!fy LS_DIM = JCAP1
-!fy else
-!fy LS_DIM = (JCAP1-1)/NODES+1
-!fy endif
-!fy else
-!fy LS_DIM = (JCAP1-1)/NODES+1
-!fy endif
-!!
-!C
-!CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
-!C
-!C
-! For creating the ESMF interface state with the GFS
-! internal parallel structure. Weiyu.
-!---------------------------------------------------
-!fy ALLOCATE(gis%TRIE_LS_SIZE (npe_single_member))
-!fy ALLOCATE(gis%TRIO_LS_SIZE (npe_single_member))
-!fy ALLOCATE(gis%TRIEO_LS_SIZE (npe_single_member))
-!fy ALLOCATE(gis%LS_MAX_NODE_GLOBAL(npe_single_member))
-!fy ALLOCATE(gis%LS_NODE_GLOBAL (LS_DIM*3, npe_single_member))
-!---------------------------------------------------
-
-!fy ALLOCATE ( gis%LS_NODE (LS_DIM*3) )
-!fy ALLOCATE ( gis%LS_NODES(LS_DIM,NODES) )
-!fy ALLOCATE ( gis%MAX_LS_NODES(NODES) )
-!C
-!fy ALLOCATE ( gis%LATS_NODES_A(NODES) )
-!fy ALLOCATE ( gis%GLOBAL_LATS_A(LATG) )
-!C
-!fy ALLOCATE ( gis%LATS_NODES_R(NODES) )
-!fy ALLOCATE ( gis%GLOBAL_LATS_R(LATR) )
- ALLOCATE ( GLOBAL_LATS_R(LATR) )
-!C
-! ALLOCATE ( gis%LATS_NODES_EXT(NODES) )
-! ALLOCATE ( gis%GLOBAL_LATS_EXT(LATG+2*JINTMX+2*NYPT*(NODES-1)) )
-!C
-!C
-!fy gis%IPRINT = 0
- IPRINT = 0
-! gis%LATS_NODES_EXT = 0
-
-! For creating the ESMF interface state with the GFS
-! internal parallel structure. Weiyu.
-!---------------------------------------------------
-!fy gis%LS_NODE_GLOBAL = 0
-!fy gis%LS_MAX_NODE_GLOBAL = 0
-!fy gis%TRIEO_TOTAL_SIZE = 0
-
-!fy DO i = 1, npe_single_member
-!fy CALL GET_LS_NODE(i-1, gis%LS_NODE_GLOBAL(1, i), &
-!fy gis%LS_MAX_NODE_GLOBAL(i), gis%IPRINT)
-!fy gis%TRIE_LS_SIZE(i) = 0
-!fy gis%TRIO_LS_SIZE(i) = 0
-!fy DO LOCL = 1, gis%LS_MAX_NODE_GLOBAL(i)
-!fy gis%LS_NODE_GLOBAL(LOCL+ LS_DIM, i) = gis%TRIE_LS_SIZE(i)
-!fy gis%LS_NODE_GLOBAL(LOCL+ 2*LS_DIM, i) = gis%TRIO_LS_SIZE(i)
-!fy
-!fy L = gis%LS_NODE_GLOBAL(LOCL, i)
-!fy
-!fy gis%TRIE_LS_SIZE(i) = gis%TRIE_LS_SIZE(i) + (JCAP+3-L)/2
-!fy gis%TRIO_LS_SIZE(i) = gis%TRIO_LS_SIZE(i) + (JCAP+2-L)/2
-!fy END DO
-!fy gis%TRIEO_LS_SIZE(i) = gis%TRIE_LS_SIZE(i) + gis%TRIO_LS_SIZE(i) + 3
-!fy gis%TRIEO_TOTAL_SIZE = gis%TRIEO_TOTAL_SIZE + gis%TRIEO_LS_SIZE(i)
-!fy END DO
-
-!fy DO i = 1, 3*LS_DIM
-!fy gis%LS_NODE(i) = gis%LS_NODE_GLOBAL(i, me+1)
-!fy END DO
-
-!fy LS_MAX_NODE = gis%LS_MAX_NODE_GLOBAL(me+1)
-!fy LEN_TRIE_LS = gis%TRIE_LS_SIZE (me+1)
-!fy LEN_TRIO_LS = gis%TRIO_LS_SIZE (me+1)
-!fy IF(LIOPE) THEN
-!fy IF(me == 0) CALL mpi_send(gis%TRIE_LS_SIZE, &
-!fy npe_single_member, &
-!fy mpi_integer, &
-!fy npe_single_member-1, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy ierr)
-!fy IF(me == npe_single_member-1) &
-!fy CALL mpi_recv(gis%TRIE_LS_SIZE, &
-!fy npe_single_member, &
-!fy mpi_integer, &
-!fy 0, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy status, &
-!fy ierr)
-!fy IF(me == 0) CALL mpi_send(gis%TRIO_LS_SIZE, &
-!fy npe_single_member, &
-!fy mpi_integer, &
-!fy npe_single_member-1, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy ierr)
-!fy IF(me == npe_single_member-1) &
-!fy CALL mpi_recv(gis%TRIO_LS_SIZE, &
-!fy npe_single_member, &
-!fy mpi_integer, &
-!fy 0, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy status, &
-!fy ierr)
-!fy IF(me == 0) CALL mpi_send(gis%TRIEO_LS_SIZE, &
-!fy npe_single_member, &
-!fy mpi_integer, &
-!fy npe_single_member-1, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy ierr)
-!fy IF(me == npe_single_member-1) &
-!fy CALL mpi_recv(gis%TRIEO_LS_SIZE, &
-!fy npe_single_member, &
-!fy mpi_integer, &
-!fy 0, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy status, &
-!fy ierr)
-!fy IF(me == 0) CALL mpi_send(gis%TRIEO_TOTAL_SIZE,&
-!fy 1, &
-!fy mpi_integer, &
-!fy npe_single_member-1, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy ierr)
-!fy IF(me == npe_single_member-1) &
-!fy CALL mpi_recv(gis%TRIEO_TOTAL_SIZE,&
-!fy 1, &
-!fy mpi_integer, &
-!fy 0, &
-!fy 900, &
-!fy MPI_COMM_ALL_DUP, &
-!fy status, &
-!fy ierr)
-!fy END IF
-!-----------------------------------------------------------
-
-!! CALL GET_LS_NODE( ME, gis%LS_NODE, LS_MAX_NODE, gis%IPRINT )
-!C
-!C
-!! LEN_TRIE_LS=0
-!! LEN_TRIO_LS=0
-!! DO LOCL=1,LS_MAX_NODE
-!! gis%LS_NODE(LOCL+ LS_DIM)=LEN_TRIE_LS
-!! gis%LS_NODE(LOCL+2*LS_DIM)=LEN_TRIO_LS
-!! L=gis%LS_NODE(LOCL)
-!! LEN_TRIE_LS=LEN_TRIE_LS+(JCAP+3-L)/2
-!! LEN_TRIO_LS=LEN_TRIO_LS+(JCAP+2-L)/2
-!! ENDDO
-!C
-!C
-!fy ALLOCATE ( gis%EPSE (LEN_TRIE_LS) )
-!fy ALLOCATE ( gis%EPSO (LEN_TRIO_LS) )
-!fy ALLOCATE ( gis%EPSEDN(LEN_TRIE_LS) )
-!fy ALLOCATE ( gis%EPSODN(LEN_TRIO_LS) )
-!C
-!fy ALLOCATE ( gis%SNNP1EV(LEN_TRIE_LS) )
-!fy ALLOCATE ( gis%SNNP1OD(LEN_TRIO_LS) )
-!C
-!fy ALLOCATE ( gis%NDEXEV(LEN_TRIE_LS) )
-!fy ALLOCATE ( gis%NDEXOD(LEN_TRIO_LS) )
-!C
-!fy ALLOCATE ( gis%PLNEV_A(LEN_TRIE_LS,LATG2) )
-!fy ALLOCATE ( gis%PLNOD_A(LEN_TRIO_LS,LATG2) )
-!fy ALLOCATE ( gis%PDDEV_A(LEN_TRIE_LS,LATG2) )
-!fy ALLOCATE ( gis%PDDOD_A(LEN_TRIO_LS,LATG2) )
-!fy ALLOCATE ( gis%PLNEW_A(LEN_TRIE_LS,LATG2) )
-!fy ALLOCATE ( gis%PLNOW_A(LEN_TRIO_LS,LATG2) )
-!C
-!fy ALLOCATE ( gis%PLNEV_R(LEN_TRIE_LS,LATR2) )
-!fy ALLOCATE ( gis%PLNOD_R(LEN_TRIO_LS,LATR2) )
-!fy ALLOCATE ( gis%PDDEV_R(LEN_TRIE_LS,LATR2) )
-!fy ALLOCATE ( gis%PDDOD_R(LEN_TRIO_LS,LATR2) )
-!fy ALLOCATE ( gis%PLNEW_R(LEN_TRIE_LS,LATR2) )
-!fy ALLOCATE ( gis%PLNOW_R(LEN_TRIO_LS,LATR2) )
-!C
-!fy gis%MAXSTP=36
- MAXSTP=36
-
-!fy IF(ME.EQ.0) PRINT*,'FROM COMPNS : IRET=',gis%IRET,' NSOUT=',NSOUT, &
-!fy ' NSSWR=',NSSWR,' NSLWR=',NSLWR,' NSZER=',NSZER,' NSRES=',NSRES, &
-!fy ' NSDFI=',NSDFI,' NSCYC=',NSCYC,' RAS=',RAS
-!fy IF(gis%IRET.NE.0) THEN
-!fy IF(ME.EQ.0) PRINT *,' INCOMPATIBLE NAMELIST - ABORTED IN MAIN'
-!fy CALL MPI_QUIT(13)
-!fy ENDIF
-
- IF(ME.EQ.0) PRINT*,'FROM COMPNS : IRET=',IRET,' NSOUT=',NSOUT, &
- ' NSSWR=',NSSWR,' NSLWR=',NSLWR,' NSZER=',NSZER,' NSRES=',NSRES, &
- ' NSDFI=',NSDFI,' NSCYC=',NSCYC,' RAS=',RAS
- IF(IRET.NE.0) THEN
- IF(ME.EQ.0) PRINT *,' INCOMPATIBLE NAMELIST - ABORTED IN MAIN'
- CALL MPI_QUIT(13)
- ENDIF
-!!
-! IF PREDICTED OZON IS DESIRED SET JO3=2
- JO3 = 2 !USING PREDICTED OZONE IN RADIATION.
-!C
-!! gis%LATS_NODES_EXT = 0
-
-!fy CALL GETCON(gis%NGES,gis%NRADR,gis%NRADF,gis%NNMOD, &
-!fy gis%N3,gis%N4,gis%NFLPS,gis%NSIGI,gis%NSIGS,gis%NSFCI, &
-!fy gis%NZNLI,gis%NSFCF,gis%NZNLF,gis%NSFCS,gis%NZNLS, &
-!fy gis%NDGI,gis%NDGF,gis%NGPKEN, &
-!fy gis%MODS,gis%NITER,gis%INI,gis%NSTEP,gis%NFILES, &
-!fy gis%KSOUT,gis%IFGES,gis%IBRAD, &
-!fy gis%LS_NODE,gis%LS_NODES,gis%MAX_LS_NODES, &
-!fy gis%LATS_NODES_A,gis%GLOBAL_LATS_A, &
-!fy gis%LONSPERLAT, &
-!fy gis%LATS_NODES_R,gis%GLOBAL_LATS_R, &
-!fy gis%LONSPERLAR, &
-!fy gis%EPSE,gis%EPSO,gis%EPSEDN,gis%EPSODN, &
-!fy gis%SNNP1EV,gis%SNNP1OD,gis%NDEXEV,gis%NDEXOD, &
-!fy gis%PLNEV_A,gis%PLNOD_A,gis%PDDEV_A,gis%PDDOD_A, &
-!fy gis%PLNEW_A,gis%PLNOW_A, &
-!fy gis%PLNEV_R,gis%PLNOD_R,gis%PDDEV_R,gis%PDDOD_R, &
-!fy gis%PLNEW_R,gis%PLNOW_R,gis%colat1)
-!!
-!fy call sfcvar_aldata(lonr,lats_node_r,lsoil,gis%sfc_fld,ierr)
-!fy call flxvar_aldata(lonr,lats_node_r,gis%flx_fld,ierr)
- call sfcvar_aldata(lonr,lats_node_r,lsoil,sfc_fld,ierr)
- call flxvar_aldata(lonr,lats_node_r,flx_fld,ierr)
-
-!li added 05/31/2007 (for oceanic component)
-! Modified by Moorthi
-!fy call nstvar_aldata(lonr,lats_node_r,gis%nam_gfs%nst_fld,ierr)
- call nstvar_aldata(lonr,lats_node_r,nst_fld,ierr)
-
-!fy ALLOCATE ( gis%XLON(LONR,LATS_NODE_R))
-!fy ALLOCATE ( gis%XLAT(LONR,LATS_NODE_R))
-!fy ALLOCATE ( gis%COSZDG(LONR,LATS_NODE_R))
-!fy ALLOCATE ( gis%SFALB(LONR,LATS_NODE_R))
-!fy ALLOCATE ( gis%HPRIME(LONR,NMTVR,LATS_NODE_R))
-!fy ALLOCATE ( gis%FLUXR(LONR,nfxr,LATS_NODE_R))
-
- ALLOCATE ( XLON(LONR,LATS_NODE_R))
- ALLOCATE ( XLAT(LONR,LATS_NODE_R))
- ALLOCATE ( COSZDG(LONR,LATS_NODE_R))
- ALLOCATE ( SFALB(LONR,LATS_NODE_R))
- ALLOCATE ( HPRIME(LONR,NMTVR,LATS_NODE_R))
- ALLOCATE ( FLUXR(LONR,nfxr,LATS_NODE_R))
-
-! gis%NBLCK = LONR/NGPTC + 1
-!fy ALLOCATE ( gis%SWH(LONR,LEVS,LATS_NODE_R))
-!fy ALLOCATE ( gis%HLW(LONR,LEVS,LATS_NODE_R))
-!fy ALLOCATE (gis%JINDX1(LATS_NODE_R),gis%JINDX2(LATS_NODE_R))
-!fy ALLOCATE (gis%DDY(LATS_NODE_R))
-!fy allocate (gis%phy_f3d(LONR,LEVS,num_p3d,lats_node_r))
-!fy allocate (gis%phy_f2d(lonr,num_p2d,lats_node_r))
-!
- ALLOCATE ( SWH(LONR,LEVS,LATS_NODE_R))
- ALLOCATE ( HLW(LONR,LEVS,LATS_NODE_R))
- ALLOCATE (JINDX1(LATS_NODE_R),JINDX2(LATS_NODE_R))
- ALLOCATE (DDY(LATS_NODE_R))
- allocate (phy_f3d(LONR,LEVS,num_p3d,lats_node_r))
- allocate (phy_f2d(lonr,num_p2d,lats_node_r))
-!
- call d3d_init(lonr,lats_node_r,levs,pl_coeff,ldiag3d,lggfs3d)
-
-! if (ldiag3d) then
-! call d3d_init(ngptc,gis%nblck,lonr,lats_node_r,levs,pl_coeff)
-! else
-! call d3d_init(1,gis%nblck,1,lats_node_r,1,pl_coeff) ! Needs allocation
-! endif
-!fy if (gfsio_out .or. gfsio_in) then
-!fy call gfsio_init(ierr)
-!fy endif
-
-!fy if (icolor /= 2 .or. .not. liope) then
-!fy if (num_p3d > 0) gis%phy_f3d = 0.0
-!fy if (num_p2d > 0) gis%phy_f2d = 0.0
-!fy endif
- if (num_p3d > 0) phy_f3d = 0.0
- if (num_p2d > 0) phy_f2d = 0.0
-!!
-!fy CALL countperf(0,18,0.)
-!!
-! Modified by Weiyu.
-!-------------------
-!fy if (.NOT.LIOPE.or.icolor.ne.2) then
-!!
-!fy CALL countperf(0,15,0.)
-!fy ALLOCATE ( gis%TRIE_LS(LEN_TRIE_LS,2,11*LEVS+3*LEVH+6) )
-!fy ALLOCATE ( gis%TRIO_LS(LEN_TRIO_LS,2,11*LEVS+3*LEVH+6) )
-
-! For Ensemble forecast requirement, add two more arrays to save to
-! initial conditions. Weiyu.
-!------------------------------------------------------------------
-!fy ALLOCATE ( gis%TRIE_LS_INI(LEN_TRIE_LS,2,11*LEVS+3*LEVH+6) )
-!fy ALLOCATE ( gis%TRIO_LS_INI(LEN_TRIO_LS,2,11*LEVS+3*LEVH+6) )
-
-!C
-!fy ALLOCATE ( gis%SYN_LS_A(4*LS_DIM,gis%LOTS,LATG2) )
-!fy ALLOCATE ( gis%DYN_LS_A(4*LS_DIM,gis%LOTD,LATG2) )
-!C
-!fy endif !(.NOT.LIOPE.or.icolor.ne.2)
-!!
-!fy if (me == 0) then
-!fy PRINT*, ' LATS_DIM_A=', LATS_DIM_A, ' LATS_NODE_A=', LATS_NODE_A
-!fy PRINT*, ' LATS_DIM_R=', LATS_DIM_R, ' LATS_NODE_R=', LATS_NODE_R
-!fy endif
-!
- ILAT=LATS_NODE_A
-
-! IF (gis%LSLAG) THEN
-! ILAT=LATS_NODE_EXT
-! ELSE
-! ILAT=LATS_NODE_A
-! ENDIF
-!fy CALL countperf(1,15,0.)
-!!
-!C......................................................................
-!C
-!fy CALL countperf(0,15,0.)
-!fy CALL f_hpmstop(25)
-!C
-! WRITE(*,*) 'NUMBER OF LATITUDES EXT. :',LATS_NODE_EXT, &
-! LATS_DIM_EXT,LATS_NODE_A
-!!
-!JFE ALLOCATE (LATLOCAL(LATGD,0:NODES-1))
-!JFE ALLOCATE (LBASIY(4,2,LATS_NODE_EXT))
-!JFE ALLOCATE (PHI(LATS_NODE_EXT))
-!JFE ALLOCATE (DPHI(LATS_NODE_EXT))
-!JFE ALLOCATE (DLAM(LATS_NODE_EXT))
-!JFE ALLOCATE (LAMEXT(LONFX,LATS_NODE_EXT))
-!JFE ALLOCATE (LAM(LONFX,LATS_NODE_A+1))
-!JFE ALLOCATE (LAMMP(LONF,LEVS,LATS_NODE_A))
-!JFE ALLOCATE (SIGMP(LONF,LEVS,LATS_NODE_A))
-!JFE ALLOCATE (PHIMP(LONF,LEVS,LATS_NODE_A))
-!!
-!JFE ALLOCATE (LATSINPE(LATS_NODE_A))
-!JFE JPT=0
-!JFE DO NODE=1,NODES
-!JFE IF ( LATS_NODES_A(NODE) .GT. 0 .AND.ME+1.EQ.NODE) THEN
-!JFE DO JCOUNT=1,LATS_NODES_A(NODE)
-!JFE LATSINPE(JCOUNT)=GLOBAL_LATS_A(JPT+JCOUNT)
-!JFE ENDDO
-!JFE ENDIF
-!JFE JPT=JPT+LATS_NODES_A(NODE)
-!JFE ENDDO
-!!
-!JFE IF (LSLAG) THEN
-!JFE CALL SULAG(LAM,DLAM,LAMEXT,LATLOCAL,PHI,DPHI,DPHIBR,PHIBS,
-!JFE & LBASIY,LAMMP,PHIMP,SIGMP,gis%LONSPERLAT,
-!JFE & IPRINT,LATSINPE)
-!JFE ENDIF
-!C
-!fy CALL countperf(1,15,0.)
-!!
-!fy print *,' sig_ini=',gis%nam_gfs%sig_ini,' sig_ini2=',gis%nam_gfs%sig_ini2 &
-!fy ,' sfc_ini=',gis%nam_gfs%sfc_ini
-!fy print *,' nst_ini=',gis%nam_gfs%nst_ini
-!fy CALL countperf(0,18,0.)
-!fy gis%pdryini = 0.0
- pdryini = 0.0
-!fy CALL spect_fields(gis%n1, gis%n2, &
-!fy gis%PDRYINI, gis%TRIE_LS, gis%TRIO_LS, &
-!fy gis%LS_NODE, gis%LS_NODES, gis%MAX_LS_NODES, &
-!fy gis%SNNP1EV, gis%SNNP1OD, gis%phy_f3d, gis%phy_f2d, &
-!fy gis%global_lats_r, gis%lonsperlar, &
-!fy gis%epse, gis%epso, gis%plnev_r, gis%plnod_r, &
-!fy gis%plnew_r, gis%plnow_r, gis%lats_nodes_r,&
-!fy gis%nam_gfs%sig_ini, gis%nam_gfs%sig_ini2)
-!!
-
-!----added for MPAS
- LONSPERLAR=ncell !MAPS
- GLOBAL_LATS_R=1 !MPAS
- do j=1,LATS_NODE_R
- do i=1,ncell
- XLON(i,LATS_NODE_R)=xlon_mpas(i)
- XLAT(i,LATS_NODE_R)=xlat_mpas(i)
- enddo
- enddo
-!----for MPAS
-
- if(.not.adiab)then
-!fy CALL fix_fields(gis%LONSPERLAR,gis%GLOBAL_LATS_R, &
-!fy gis%XLON,gis%XLAT,gis%sfc_fld,gis%nst_fld, &
-!fy gis%HPRIME,gis%JINDX1,gis%JINDX2,gis%DDY, &
-!fy gis%OZPLIN,gis%nam_gfs%sfc_ini,gis%nam_gfs%nst_ini)
-
- print*, "read fix_field ozone"
- CALL fix_fields(OZPLIN)
-! CALL countperf(1,18,0.)
- endif
-
-
-! if ( me == 72 ) then
-! do j = 1, lats_node_r
-! do i = 1, lonr
-! if ( gis%dt_warm(i,j) > 0.8 ) then
-! write(*,'(a,11F11.2)') 'Initial nstr : ', &
-! gis%ifd(i,j),gis%time_old(i,j),gis%time_ins(i,j),gis%I_Sw(i,j), &
-! gis%I_Q(i,j),gis%I_Qrain(i,j),gis%I_M(i,j),gis%I_Tau(i,j), &
-! gis%I_Sw_Zw(i,j),gis%I_Q_Ts(i,j),gis%I_M_Ts(i,j)
-! write(*,'(a,9F10.5)') 'Initial nstf : ', &
-! gis%Tref(i,j),gis%dt_cool(i,j),gis%z_c(i,j),gis%dt_warm(i,j),gis%z_w(i,j), &
-! gis%c_0(i,j),gis%c_d(i,j),gis%w_0(i,j),gis%w_d(i,j)
-! endif
-! enddo
-! enddo
-! endif
-
-
-!
-! Apply the diurnal warming & sub-layer cooling (TSEA: foundation/reference temperature)
-!
-
-! if ( .not. tr_analysis ) then
-! gis%nst_fld%Tref(:,:) = gis%sfc_fld%TSEA(:,:) ! necessary only when Tr analysis unavailable
-! endif
-
-! if ( nst_fcst > 0 ) then
-! do j = 1, lats_node_r
-! do i = 1, lonr
-! if ( gis%sfc_fld%SLMSK(i,j) == 0.0 ) then
-! gis%sfc_fld%TSEA(i,j) = gis%nst_fld%Tref(i,j) &
-! + gis%nst_fld%dt_warm(i,j) - gis%nst_fld%dt_cool(i,j)
-! endif
-! enddo
-! enddo
-! endif
-
-
-!!
-!fy tov = 0.0
-!fy if (.not. (hybrid.or.gen_coord_hybrid) ) then ! hmhj
-!fy call setsig(si,ci,del,sl,cl,rdel2,tov,me)
-!fy am = -8888888.
-!fy bm = -7777777.
-!fy call amhmtm(del,sv,am)
-!fy CALL BMDI_sig(ci,bm)
-!fy endif
-!C
-!fy CALL f_hpmstart(26,"STEP1")
-!C
-!!
-!fy CALL countperf(1,18,0.)
-!!
-!fy CALL countperf(0,15,0.)
-
-! Modified by Weiyu Yang to fix the bug related to the "runDuration".
-!--------------------------------------------------------------------
-!fy CALL ESMF_ClockGet(clock, timeStep = timeStep, &
-!fy startTime = startTime, &
-!fy currTime = currTime, &
-!fy rc = rc1)
-
-!fy runDuration_hour = NINT(FHMAX) - NINT(FHINI)
-!fy CALL ESMF_TimeIntervalSet(runDuration, h = runDuration_hour, rc = rc1)
-
-! print *,' runduration_hour=',runduration_hour,' rc1=',rc1
-!
-!Moor ifhmax = NINT(gis%nam_gfs%FHMAX)
-!fy ifhmax = NINT(FHMAX)
-!fy IF(runDuration_hour <= 0 .OR. &
-!fy ifhmax /= 0 .AND. &
-!fy ifhmax <= gis%kfhour + runDuration_hour) THEN
-!Moor gis%nam_gfs%FHMAX = MAX(gis%nam_gfs%FHMAX, REAL(gis%kfhour))
-! ,, ifhmax = NINT(gis%nam_gfs%FHMAX)
-!fy ifhmax = NINT(FHMAX)
-! ,, runDuration_hour = ifhmax - gis%kfhour
-!fy runDuration_hour = NINT(FHMAX) - NINT(FHINI)
-!fy CALL ESMF_TimeIntervalSet(runDuration, h = runDuration_hour, rc = rc1)
-! print *,' runduration_hour=',runduration_hour,' rc1=',rc1
-!fy END IF
-!fy if (runDuration_hour < 0) then
-!fy print *,' FHINI=',FHINI, ' > FHMAX=',FHMAX,' JOB ABORTED'
-!fy call mpi_quit(444)
-!fy endif
-! stopTime = startTime + runDuration
-!fy stopTime = currTime + runDuration
-
-!fy CALL ESMF_ClockSet(clock, stopTime = stopTime, &
-! currTime = currTime, &
-!fy rc = rc1)
-!
-!fy CALL ESMF_TimeIntervalGet(timeStep, s = timeStep_sec, rc = rc1)
-
-!fy if (me == 0) print *,' timestep_sec=',timestep_sec,' rc1=',rc1
-!!
-!fy IF (me.eq.0) THEN
-!fy CALL out_para(REAL(timeStep_sec))
-!fy ENDIF
-!!
-!fy IF (me.eq.0) THEN
-!fy PRINT *,' THE GSM WILL FORECAST ',runDuration_hour,' HOURS', &
-!fy ' FROM HOUR ',gis%kfhour,' TO HOUR ',runDuration_hour+gis%kfhour
-!fy ENDIF
-!
-!
-!CALL ESMF_TimeGet (stopTime, yy = yyc, mm = mmc, dd = ddc, h = hhc, &
-! m = minsc, rc = rc1)
-!PRINT*, ' In Initialize , stopTime=', yyc, mmc, ddc, hhc, minsc
-!
-
-!
-!fy CALL synchro
-!fy CALL countperf(1,15,0.)
-!
-! zero fluxes and diagnostics
-!fy CALL countperf(0,14,0.)
-!
-!fy gis%zhour = fhour
-!fy gis%FLUXR = 0.
- zhour = fhour
- FLUXR = 0.
-!
-!fy call flx_init(gis%flx_fld,ierr)
-! call flx_init(flx_fld,ierr)
-!
- call d3d_zero(ldiag3d,lggfs3d)
-
-! if (ldiag3d) then
-! call d3d_zero
-! endif
-!fy CALL countperf(1,14,0.)
-!
- print*, "---end GFS_Initialize---"
- END SUBROUTINE GFS_Initialize
-!
- END MODULE GFS_Initialize_module
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/Makefile.ibm
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/Makefile.ibm 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/Makefile.ibm 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,679 +0,0 @@
-##FINCS = -I/nwprod/lib/incmod/esmf_3_1_0rp2
-##FINCM = -I/nwprod/lib/incmod/w3_d
-
-ARCH = -qarch=pwr6 -qtune=pwr6 -qcache=auto -qnohot
-PGSZ = -bdatapsize:64K -bstackpsize:64K -btextpsize:4K
-DEBUG = -qcheck
-
-OPTS = -g -qsuffix=cpp=f -O3 -qrealsize=8 -qstrict -qxlf77=leadzero -qmaxmem=-1 -qnolm -qsmp=noauto -qnosave $(ARCH)
-OPTS90 = -qsuffix=cpp=f -O3 -qrealsize=8 -qstrict -qxlf77=leadzero -qmaxmem=-1 -qnolm -qsmp=noauto -qnosave $(ARCH)
-OPTS90A = -qsuffix=cpp=f -O3 -qrealsize=8 -qstrict -qxlf77=leadzero -qmaxmem=-1 -qnolm -qsmp=noauto -qnosave $(ARCH)
- FFLAG90 = $(OPTS90) $(FINCS) $(FINCM) -qfree -NS2048
- FFLAG90A = $(OPTS90A) $(FINCS) -qfree -NS2048
- FFLAGS = $(OPTS) $(TRAPS) -qfixed
- FFLAGX = $(OPTS) $(TRAPS) -qfixed
- FFLAGIO = $(OPTS) $(TRAPS) -qfixed
- FFLAGY = $(OPTS) -qfixed
- FFLAGM = $(OPTS) $(FINCS) $(TRAPS) $(DEBUG) -NS2048 -qfixed
- FFLAGM2 = $(OPTS) $(FINCS) $(FINCM) $(TRAPS) $(DEBUG) -NS2048 -qfixed
- FFLAGM3 = $(OPTS) $(FINCS) $(TRAPS) $(DEBUG) -NS2048 -qfree
- FFLAGSF = -g -O3 -qnosave -qfree=f90 -qcheck
- FFLAGSI = -g -O3 -qnosave -qfree=f90
- FFLAGB = -g -O3 -qnosave -qfixed
-
-LDR = mpxlf95_r -qsmp=noauto
-
-##LDFLAGS = -lessl_r -lmass -qsmp=noauto /nwprod/lib/libesmf_3_1_0rp2.a $(PGSZ)
-LDFLAGS = -qsmp=noauto $(PGSZ)
-##LIBS = -lC -L /nwprod/lib/ -l w3_d -l bacio_4 -lsp_d
-LIBS = -lC -L /nwprod/lib/ -l w3_d
-
-.SUFFIXES: .o .f .F .h
-#
-# *****************************************************************
-#
-#OBJS0 = \
-## NameList_ESMFMod.o \
-# Sfc_Var_ESMFMod.o \
-# Nst_Var_ESMFMod.o
-
-# GFS_ESMFStateAddGetMod.o
-# GFS_Standalone_ESMF_ENS.o
-# GFS_InputFile2ImportState.o
-
-
-OBJ_MOD = machine.o \
- iounitdef.o \
- physcons.o \
- funcphys.o \
- progtm_module.o \
- rascnvv2.o \
- resol_def.o \
- gg_def.o \
- vert_def.o \
- sig_io.o \
- date_def.o \
- layout1.o \
- layout_grid_tracers.o \
- namelist_def.o \
- namelist_soilveg.o \
- coordinate_def.o \
- tracer_const_h-new.o \
- mpi_def.o \
- sfcio_module.o \
- d3d_def.o \
- gfsmisc_def.o \
- nstio_module.o \
- module_nst_parameters.o \
- module_nst_water_prop.o \
- module_nst_model.o \
- calpreciptype.o \
- module_bfmicrophysics.o \
- mersenne_twister.o \
- Sfc_Var_ESMFMod.o \
- Nst_Var_ESMFMod.o \
- NameList_ESMFMod.o
-
-# sigio_module.o \
-# sigio_r_module.o \
-# gfsio_module.o \
-# gfsio_def.o \
-
-
-
-OBJS = \
- GFS_Initialize.o \
- gcycle.o\
- compns.o\
- fix_fields.o\
- dotstep.o \
- lon_lat_para.o\
- driver_gfscolumn.o \
- mpi_quit.o
-
-#wrtout.o\
-
-#OBJS_PORT = \
-#fftpack.o \
-#four2grid.fftpack.o \
-#noblas.o\
-#funcphys_subsx.o\
-
-OBJS_RAD = \
- radlw_param.o \
- radlw_datatb.o \
- radlw_main.o \
- radsw_param.o \
- radsw_datatb.o \
- radsw_main.o \
- radiation_astronomy.o \
- radiation_aerosols.o \
- radiation_gases.o \
- radiation_clouds.o \
- radiation_surface.o \
- grrad.o \
- gloopr.o
-
-#
-#gloopb.o
-#gbphys_adv_hyb_gc.o
-#gbphys_adv_hyb_gc_h-new.o
-OBJS_PHY= \
- ozinterp.o \
- ozphys.o \
- gloopb.o \
- gbphys.o \
- dcyc2.o \
- dcyc2.pre.rad.o \
- set_soilveg.o \
- sfc_drv.o \
- sfc_land.o \
- progt2.o \
- sfc_sice.o \
- sfc_ocean.o \
- sfc_nst.o \
- sfc_diff.o \
- sfc_diag.o \
- sflx.o \
- moninp.o \
- moninp1.o \
- moninq.o \
- moninq1.o \
- tridi2t3.o \
- gwdps.o \
- gwdc.o \
- sascnv.o \
- sascnvn.o \
- cnvc90.o \
- shalcv.o \
- shalcv_opr.o \
- shalcnv.o \
- lrgsclr.o \
- gscond.o \
- precpd.o \
- mstadb.o \
- mstadbtn.o \
- mstcnv.o \
- get_prs.o \
- gsmddrive.o
-
-#omegtes.o \
-#omegtes_gc.o \
-#omegas.o \
-#hyb2sig.o \
-#hyb2press.o \
-#hyb2press_gc.o \
-#sig2press.o
-
-
-OBJS_IO= \
- sfcsub.o
-
-#gribit.o \
-#wrt3d.o \
-#wrt3d_hyb.o \
-#wrtg3d.o \
-#wrtg3d_hyb.o \
-#wrtsfc.o \
-#para_fixio_w.o \
-#para_nstio_w.o \
-#treadeo.io.o \
-#treadeo.gfsio.o \
-#grid_to_spec.o \
-#spect_to_grid.o \
-#spect_tv_enthalpy_ps.o\
-#setsig.o \
-#twriteeo.o \
-#bafrio.o \
-#spect_send.o \
-#spect_write.o
-
-
-OBJS_CC= cmp.comm.o \
- atm.comm.o \
- mpi_more.o \
- tiles.o
-#cmp.comm.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)
-#
-INCS = f_hpm.h mpi_inc.h function2
-
-#
-# *****************************************************************
-#
-all: model-mpi
-
-model-mpi: $(OBJ_MOD) $(OBJS_CC) $(OBJS0) $(OBJS) $(OBJS_PHY) $(OBJS_RAD) $(OBJS_IO)
- $(LDR) $(LDFLAGS) -o $(EXEC) $(OBJ_MOD) $(OBJS_CC) $(OBJS0) $(OBJS) $(OBJS_PHY) $(OBJS_RAD) $(OBJS_IO) $(LIBS)
-
-clean:
- rm -f $(OBJ_MOD) $(OBJS0) $(OBJS) $(OBJS_RAD) $(OBJS_PHY) $(OBJS_IO) *.mod
-
-tar:
- tar -cvf tar.gfs.r4r8 $(SRC) $(INCS) $(COMS) $(OBJS_PORT:.o=.f) lonsper* res* xx* Makefile* ini.* scr.* m*real_?
-
-.F.o:
- $(F77) $(FFLAGS) -c -d $<
- #$(F77) $(FFLAGS) -c -d -WF,-DCLR:${RASV} $<
-.f.o:
- $(F77) $(FFLAGS) -c $<
-
-
-omegas.o: omegas.f
- $(F77) $(FFLAGM) -c omegas.f
-
-#
-# *****************************************************************
-#
-cnvc90.o: cnvc90.f
- $(F77) $(FFLAGM) -c cnvc90.f
-
-calpreciptype.o: calpreciptype.f
- $(F77) $(FFLAGM3) -c calpreciptype.f
-
-dcyc2.o: dcyc2.f
- $(F77) $(FFLAGM) -c dcyc2.f
-
-dcyc2.pre.rad.o: dcyc2.pre.rad.f
- $(F77) $(FFLAGM) -c dcyc2.pre.rad.f
-
-digifilt.o: digifilt.f
- $(F77) $(FFLAGX) -c digifilt.f
-
-funcphys_subsx.o: funcphys_subsx.f
- $(F77) $(FFLAGM) -c funcphys_subsx.f
-
-gbphys_adv_hyb_gc.o: gbphys_adv_hyb_gc.f
- $(F77) $(FFLAGM) -c gbphys_adv_hyb_gc.f
-
-gbphys_adv_hyb_gc_h-new.o: gbphys_adv_hyb_gc_h-new.f
- $(F77) $(FFLAGM) -c gbphys_adv_hyb_gc_h-new.f
-
-#gbphys_call.o: gbphys_call.f
-# $(F77) $(FFLAGM) -c gbphys_call.f
-
-gbphys.o: gbphys.f
- $(F77) $(FFLAGM) -c gbphys.f
-
-get_prs.o: get_prs.f
- $(F77) $(FFLAGM) -c get_prs.f
-
-gscond.o: gscond.f
- $(F77) $(FFLAGM) -c gscond.f
-
-gsmddrive.o: gsmddrive.f
- $(F77) $(FFLAGM) -c gsmddrive.f
-
-reduce_lons_grid_module.o: reduce_lons_grid_module.f
- $(F77) $(FFLAGM) -c reduce_lons_grid_module.f
-
-module_bfmicrophysics.o: module_bfmicrophysics.f
- $(F77) $(FFLAGM) -c module_bfmicrophysics.f
-
-gwdps.o: gwdps.f
- $(F77) $(FFLAGM) -c gwdps.f
-
-gwdc.o: gwdc.f
- $(F77) $(FFLAGM) -c gwdc.f
-
-hyb2press_gc.o: hyb2press_gc.f
- $(F77) $(FFLAGM) -c hyb2press_gc.f
-
-hyb2press.o: hyb2press.f
- $(F77) $(FFLAGM) -c hyb2press.f
-
-hyb2sig.o: hyb2sig.f
- $(F77) $(FFLAGM) -c hyb2sig.f
-
-lrgsclr.o: lrgsclr.f
- $(F77) $(FFLAGM) -c lrgsclr.f
-
-moninp.o: moninp.f
- $(F77) $(FFLAGM) -c moninp.f
-
-moninp1.o: moninp1.f
- $(F77) $(FFLAGM) -c moninp1.f
-
-moninq.o: moninq.f
- $(F77) $(FFLAGM) -c moninq.f
-
-moninq1.o: moninq1.f
- $(F77) $(FFLAGM) -c moninq1.f
-
-mstadb.o: mstadb.f
- $(F77) $(FFLAGM) -c mstadb.f
-
-mstadbtn.o: mstadbtn.f
- $(F77) $(FFLAGM) -c mstadbtn.f
-
-mstcnv.o: mstcnv.f
- $(F77) $(FFLAGM) -c mstcnv.f
-
-omegtes_gc.o: omegtes_gc.f
- $(F77) $(FFLAGM) -c omegtes_gc.f
-
-omegtes.o: omegtes.f
- $(F77) $(FFLAGM) -c omegtes.f
-
-ozinterp.o: ozinterp.f
- $(F77) $(FFLAGM) -c ozinterp.f
-
-ozphys.o: ozphys.f
- $(F77) $(FFLAGM) -c ozphys.f
-
-precpd.o: precpd.f
- $(F77) $(FFLAGM) -c precpd.f
-
-rascnvv2.o: rascnvv2.f
- $(F77) $(FFLAGM) -c rascnvv2.f
-
-sfc_sice.o: sfc_sice.f
- $(F77) $(FFLAGM) -c sfc_sice.f
-
-set_soilveg.o: set_soilveg.f
- $(F77) $(FFLAGM) -c set_soilveg.f
-
-namelist_soilveg.o: namelist_soilveg.f
- $(F77) $(FFLAGM) -c namelist_soilveg.f
-
-sfc_land.o: sfc_land.f
- $(F77) $(FFLAGM) -c sfc_land.f
-
-progt2.o: progt2.f
- $(F77) $(FFLAGM) -c progt2.f
-
-sfc_drv.o: sfc_drv.f
- $(F77) $(FFLAGM) -c sfc_drv.f
-
-sflx.o: sflx.f
- $(F77) $(FFLAGM) -c sflx.f
-
-sfc_ocean.o: sfc_ocean.f
- $(F77) $(FFLAGM) -c sfc_ocean.f
-
-sfc_nst.o: sfc_nst.f
- $(F77) $(FFLAGM) -c sfc_nst.f
-
-sfc_diff.o: sfc_diff.f
- $(F77) $(FFLAGM) -c sfc_diff.f
-
-sfc_diag.o: sfc_diag.f
- $(F77) $(FFLAGM) -c sfc_diag.f
-
-sascnv.o: sascnv.f
- $(F77) $(FFLAGM) -c sascnv.f
-
-sascnvn.o: sascnvn.f
- $(F77) $(FFLAGM) -c sascnvn.f
-
-tridi2t3.o: tridi2t3.f
- $(F77) $(FFLAGM) -c tridi2t3.f
-
-shalcv.o: shalcv.f
- $(F77) $(FFLAGM) -c shalcv.f
-
-shalcv_opr.o: shalcv_opr.f
- $(F77) $(FFLAGM) -c shalcv_opr.f
-
-shalcnv.o: shalcnv.f
- $(F77) $(FFLAGM) -c shalcnv.f
-
-sig2press.o: sig2press.f
- $(F77) $(FFLAGM) -c sig2press.f
-
-# *****************************************************************
-
-radlw_param.o: radlw_param.f
- $(F77) $(FFLAGM) -c radlw_param.f
-
-
-radlw_datatb.o: radlw_datatb.f
- $(F77) $(FFLAGM) -c radlw_datatb.f
-
-
-radlw_main.o: radlw_main.f
- $(F77) $(FFLAGM2) -c radlw_main.f
-
-radsw_param.o: radsw_param.f
- $(F77) $(FFLAGM) -c radsw_param.f
-
-radsw_datatb.o: radsw_datatb.f
- $(F77) $(FFLAGM) -c radsw_datatb.f
-
-radsw_main.o: radsw_main.f
- $(F77) $(FFLAGM2) -c radsw_main.f
-
-radiation_astronomy.o: radiation_astronomy.f
- $(F77) $(FFLAGM) -c radiation_astronomy.f
-
-radiation_aerosols.o: radiation_aerosols.f
- $(F77) $(FFLAGM) -c radiation_aerosols.f
-
-radiation_gases.o: radiation_gases.f
- $(F77) $(FFLAGM) -c radiation_gases.f
-
-radiation_clouds.o: radiation_clouds.f
- $(F77) $(FFLAGM) -c radiation_clouds.f
-
-radiation_surface.o: radiation_surface.f
- $(F77) $(FFLAGM) -c radiation_surface.f
-
-grrad.o: grrad.f
- $(F77) $(FFLAGM) -c grrad.f
-
-progtm_module.o: progtm_module.f
- $(F77) $(FFLAGM) -c progtm_module.f
-
-machine.o: machine.f
- $(F77) $(FFLAGM) -c machine.f
-
-num_parthds.o: num_parthds.f
- $(F77) $(FFLAGM) -c num_parthds.f
-
-kinds.o: GEFS_Cpl_Cal_Sto_Coef.fd/kinds.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/kinds.f90
-
-peuc.o: GEFS_Cpl_Cal_Sto_Coef.fd/peuc.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/peuc.f90
-
-pran.o: GEFS_Cpl_Cal_Sto_Coef.fd/pran.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/pran.f90
-
-prana.o: GEFS_Cpl_Cal_Sto_Coef.fd/prana.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/prana.f90
-
-#
-# *****************************************************************
-#
-physcons.o: physcons.f
- $(F77) $(FFLAG90) -c physcons.f
-
-iounitdef.o: iounitdef.f
- $(F77) $(FFLAG90) -c iounitdef.f
-
-funcphys.o: funcphys.f
- $(F77) $(FFLAG90) -c funcphys.f
-
-sfcio_module.o: sfcio_module.f
- $(F77) $(FFLAGSF) -c sfcio_module.f
-
-sigio_module.o: sigio_module.f
- $(F77) $(FFLAGSI) -c sigio_module.f
-
-gfsio_def.o: gfsio_def.f
- $(F77) $(FFLAGSI) -c gfsio_def.f
-
-gfsio_module.o: gfsio_module.f
- $(F77) $(FFLAGSI) -c gfsio_module.f
-
-sigio_r_module.o: sigio_r_module.f
- $(F77) $(FFLAGSI) -c sigio_r_module.f
-
-bafrio.o: bafrio.f
- $(F77) $(FFLAGB) -c bafrio.f
-
-#
-#sigdas.io.o: sigdas.io.f
-## $(F77) $(FFLAGIO) -c sigdas.io.f
-
-read_fix.o: read_fix.f
- $(F77) $(FFLAGX) -c read_fix.f
-
-softcount.o: softcount.f
- $(F77) $(FFLAGX) -c softcount.f
-
-gloopr.o: gloopr.f
- $(F77) $(FFLAGM2) -c gloopr.f
-
-gloopb.o: gloopb.f
- $(F77) $(FFLAGM2) -c gloopb.f
-
-sfcsub.o: sfcsub.f
- $(F77) $(FFLAGM) -c sfcsub.f
-
-gcycle.o: gcycle.f
- $(F77) $(FFLAGM) -c gcycle.f
-
-getaer.o: getaer.f
- $(F77) $(FFLAGIO) -c getaer.f
-
-wrt3d.o: wrt3d.f
- $(F77) $(FFLAGIO) -c wrt3d.f
-
-gribit.o: gribit.f
- $(F77) $(FFLAGIO) -c gribit.f
-
-wrtsfc.o: wrtsfc.f
- $(F77) $(FFLAGIO) -c wrtsfc.f
-
-para_fixio_w.o: para_fixio_w.f
- $(F77) $(FFLAGIO) -c para_fixio_w.f
-
-para_nstio_w.o: para_nstio_w.f
- $(F77) $(FFLAGIO) -c para_nstio_w.f
-
-#para_fixio_all_w.o: para_fixio_all_w.f
-# $(F77) $(FFLAGIO) -c para_fixio_all_w.f
-
-#para_fixio_iop_w.o: para_fixio_iop_w.f
-# $(F77) $(FFLAGIO) -c para_fixio_iop_w.f
-
-#conrad.o: conrad.f
-# $(F77) $(FFLAGIO) -c conrad.f
-
-#crhtab.o: crhtab.f
-# $(F77) $(FFLAGIO) -c crhtab.f
-
-treadeo.io.o: treadeo.io.f
- $(F77) $(FFLAGIO) -c treadeo.io.f
-
-treadeo.gfsio.o: treadeo.gfsio.f
- $(F77) $(FFLAGIO) -c treadeo.gfsio.f
-
-twriteeo.o: twriteeo.f
- $(F77) $(FFLAGIO) -c twriteeo.f
-
-spect_send.o: spect_send.f
- $(F77) $(FFLAGIO) -c spect_send.f
-
-spect_write.o: spect_write.f
- $(F77) $(FFLAGIO) -c spect_write.f
-
-spect_to_grid.o: spect_to_grid.f
- $(F77) $(FFLAGIO) -c spect_to_grid.f
-
-spect_tv_enthalpy_ps.o: spect_tv_enthalpy_ps.f
- $(F77) $(FFLAGIO) -c spect_tv_enthalpy_ps.f
-
-grid_to_spec.o: grid_to_spec.f
- $(F77) $(FFLAGIO) -c grid_to_spec.f
-
-wrtout.o: wrtout.f
- $(F77) $(FFLAGIO) -c wrtout.f
-
-nstio_module.o: nstio_module.f
- $(F77) $(FFLAG90) -c nstio_module.f
-
-module_nst_parameters.o: module_nst_parameters.f
- $(F77) $(FFLAG90) -c module_nst_parameters.f
-
-module_nst_water_prop.o: module_nst_water_prop.f
- $(F77) $(FFLAG90) -c module_nst_water_prop.f
-
-module_nst_model.o: module_nst_model.f
- $(F77) $(FFLAG90) -c module_nst_model.f
-
-NameList_ESMFMod.o: NameList_ESMFMod.f
- $(F77) $(FFLAG90) -c NameList_ESMFMod.f
-
-Sfc_Var_ESMFMod.o: Sfc_Var_ESMFMod.f
- $(F77) $(FFLAG90) -c Sfc_Var_ESMFMod.f
-
-Nst_Var_ESMFMod.o: Nst_Var_ESMFMod.f
- $(F77) $(FFLAG90) -c Nst_Var_ESMFMod.f
-
-Lib_ESMFStateAddGetMod.o: Lib_ESMFStateAddGetMod.f
- $(F77) $(FFLAG90) -c Lib_ESMFStateAddGetMod.f
-
-#GFS_ESMFStateAddGetMod.o: GFS_ESMFStateAddGetMod.f
-# $(F77) $(FFLAG90) -c GFS_ESMFStateAddGetMod.f
-
-GFS_InternalState_ESMFMod.o: GFS_InternalState_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_InternalState_ESMFMod.f
-
-GFS_ESMFStateMod.o: GFS_ESMFStateMod.f
- $(F77) $(FFLAG90) -c GFS_ESMFStateMod.f
-
-GFS_ErrMsgMod.o: GFS_ErrMsgMod.f
- $(F77) $(FFLAG90) -c GFS_ErrMsgMod.f
-
-GFS_GetCf_ESMFMod.o: GFS_GetCf_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_GetCf_ESMFMod.f
-
-GFS_ESMFMod.o: GFS_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_ESMFMod.f
-
-#GFS_Grid_fnl_ESMFMod.o: GFS_Grid_fnl_ESMFMod.f
- #$(F77) $(FFLAG90A) -c GFS_Grid_fnl_ESMFMod.f
-
-GFS_GridComp_ESMFMod.o: GFS_GridComp_ESMFMod.f
- $(F77) $(FFLAG90A) -c GFS_GridComp_ESMFMod.f
-
-#GFS_Initialize_ESMFMod.o: GFS_Initialize_ESMFMod.f
-# $(F77) $(FFLAG90) -c GFS_Initialize_ESMFMod.f
-
-GFS_Initialize.o: GFS_Initialize.f
- $(F77) $(FFLAG90) -c GFS_Initialize.f
-
-GFS_Run_ESMFMod.o: GFS_Run_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_Run_ESMFMod.f
-
-GFS_Finalize_ESMFMod.o: GFS_Finalize_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_Finalize_ESMFMod.f
-
-GFS_InputFile2ImportState.o: GFS_InputFile2ImportState.f
- $(F77) $(FFLAG90) -c GFS_InputFile2ImportState.f
-
-#GFS_Standalone_ESMF_ENS.o: GFS_Standalone_ESMF_ENS.f
-# $(F77) $(FFLAG90) -c GFS_Standalone_ESMF_ENS.f
-
-GFS_ESMF.o: GFS_ESMF.f
- $(F77) $(FFLAG90) -c GFS_ESMF.f
-
-Grid_ESMFCreate.o: Grid_ESMFCreate.f
- $(F77) $(FFLAG90) -c Grid_ESMFCreate.f
-
-StartTimeGet_ESMF.o: StartTimeGet_ESMF.f
- $(F77) $(FFLAG90) -c StartTimeGet_ESMF.f
-
-Ensemble_sub.o: Ensemble_sub.f
- $(F77) $(FFLAG90) -c Ensemble_sub.f
-
-mpi_more.o: mpi_more.f
- $(F77) $(FFLAGS) -c mpi_more.f
-
-cmp.comm.o: cmp.comm.f
- $(F77) $(FFLAGS) -c cmp.comm.f
-
-atm.comm.o: atm.comm.f
- $(F77) $(FFLAGS) -c atm.comm.f
-
-tiles.o: tiles.f
- $(F77) $(FFLAGS) -c tiles.f
-
-GEFS_Cpl_InternalState_ESMFMod.o: GEFS_Cpl_InternalState_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_Cpl_InternalState_ESMFMod.f
-
-GEFS_CplState_ESMFMod.o: GEFS_CplState_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_CplState_ESMFMod.f
-
-GEFS_Sto_Per_Scheme.o: GEFS_Sto_Per_Scheme.f
- $(F77) $(FFLAG90) -c GEFS_Sto_Per_Scheme.f
-
-GEFS_Cpl_Run_ESMFMod.o: GEFS_Cpl_Run_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_Cpl_Run_ESMFMod.f
-
-GEFS_Cpl_ESMFMod.o: GEFS_Cpl_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_Cpl_ESMFMod.f
-
-GEFS_CplComp_ESMFMod.o: GEFS_CplComp_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_CplComp_ESMFMod.f
-
-GFS_AddParameterToStateMod.o: GFS_AddParameterToStateMod.f
- $(F77) $(FFLAG90) -c GFS_AddParameterToStateMod.f
-
-GEFS_Sto_Per_Scheme_Step1.o: GEFS_Sto_Per_Scheme_Step1.f
- $(F77) $(FFLAG90) -c GEFS_Sto_Per_Scheme_Step1.f
-
-GEFS_Sto_Per_Scheme_Step2.o: GEFS_Sto_Per_Scheme_Step2.f
- $(F77) $(FFLAG90) -c GEFS_Sto_Per_Scheme_Step2.f
-
-GEFS_GetParameterFromStateMod.o: GEFS_GetParameterFromStateMod.f
- $(F77) $(FFLAG90) -c GEFS_GetParameterFromStateMod.f
-
-Cal_Sto_Coef.o: GEFS_Cpl_Cal_Sto_Coef.fd/Cal_Sto_Coef.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/Cal_Sto_Coef.f90
-
-GEFS_bcst_global.o: GEFS_bcst_global.f
- $(F77) $(FFLAG90) -c GEFS_bcst_global.f
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/Makefile.zeus
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/Makefile.zeus 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/Makefile.zeus 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,680 +0,0 @@
-
-EXEC = global_fcst
-F77= mpif90
-F90= mpif90
-LIBDIR=/scratch2/portfolios/NCEPDEV/global/save/Shrinivas.Moorthi/para/lib
-
-#
-# FINCS = -I /scratch2/portfolios/NCEPDEV/global/save/Shrinivas.Moorthi/para/lib/incmod/esmf_3_1_0rp5
-# FINCM = -I /scratch2/portfolios/NCEPDEV/global/save/Shrinivas.Moorthi/para/lib/nwprod/incmod/w3lib-2.0_d
-
- ARCH =
- PGSZ =
-
- OPTS = -O3 -convert big_endian -traceback -r8
- OPTS90 = -O3 -convert big_endian -traceback -r8
- OPTS90A = -O3 -convert big_endian -traceback -r8
-
- FFLAG90 = $(OPTS90) $(FINCS) -free
- FFLAG90A = $(OPTS90A) $(FINCS) -free
- FFLAGS = $(OPTS) $(TRAPS)
- FFLAGX = $(OPTS) $(TRAPS)
- FFLAGIO = $(OPTS) $(TRAPS)
- FFLAGY = $(OPTS)
- FFLAGM = $(OPTS) $(FINCS) $(TRAPS) $(DEBUG)
- FFLAGM2 = $(OPTS) $(FINCS) $(FINCM) $(TRAPS) $(DEBUG)
- FFLAGM3 = $(OPTS) $(FINCS) $(TRAPS) $(DEBUG) -free
- FFLAG_SER = -O3 -convert big_endian -traceback -r8
-
- FFLAGSF = -O3 -convert big_endian -traceback -FR
- FFLAGSI = -O3 -convert big_endian -traceback -FR
- FFLAGB = -O3 -convert big_endian -traceback
-
- LDR = mpif90
-
- LDFLAGS =
-##LIBS = -L$(MKL) -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -lstdc++ -limf -lm -lrt -ldl -L$(LIBDIR) -lsp_d -lw3lib-2.0_d -lbacio_4 -lesmf_3_1_0rp5 -threads
-##LIBS = -lstdc++ -limf -lm -lrt -ldl -threads -L$(LIBDIR) -lsp_d -lw3lib-2.0_d -lbacio_4 -lesmf_3_1_0rp5 -lsfcio_4 -lsigio_4 -L${MPICH}/lib -lmpichcxx -mkl=sequential \
-## -L$(MKL) -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -lguide
-
-#LIBS = -L$(MKL) -lmkl_intel_lp64 -lmkl_core -lmkl_intel_thread -lguide -L$(LIBDIR) -lesmf_3_1_0rp5 -lbacio_4 -lsp_d -lw3lib-2.0_d -lrt -lstdc++
-LIBS = -L$(MKL) -lmkl_intel_lp64 -lmkl_core -lmkl_intel_thread -L$(LIBDIR) -lesmf_3_1_0rp5 -lbacio_4 -lsp_d -lw3lib-2.0_d -lrt -lstdc++
-
-
-.SUFFIXES: .o .f .F .h
-#
-# *****************************************************************
-#
-#OBJS0 = \
-# NameList_ESMFMod.o \
-# Sfc_Var_ESMFMod.o \
-# Nst_Var_ESMFMod.o
-
-OBJ_MOD = machine.o \
- iounitdef.o \
- physcons.o \
- funcphys.o \
- progtm_module.o \
- rascnvv2.o \
- resol_def.o \
- gg_def.o \
- vert_def.o \
- sig_io.o \
- date_def.o \
- layout1.o \
- layout_grid_tracers.o \
- namelist_def.o \
- namelist_soilveg.o \
- coordinate_def.o \
- tracer_const_h-new.o \
- mpi_def.o \
- sfcio_module.o \
- d3d_def.o \
- gfsmisc_def.o \
- nstio_module.o \
- module_nst_parameters.o \
- module_nst_water_prop.o \
- module_nst_model.o \
- calpreciptype.o \
- module_bfmicrophysics.o \
- mersenne_twister.o \
- Sfc_Var_ESMFMod.o \
- Nst_Var_ESMFMod.o \
- NameList_ESMFMod.o \
- GFS_Initialize.o
-
-OBJS = \
- gcycle.o\
- compns.o\
- fix_fields.o\
- dotstep.o \
- driver_gfscolumn.o \
- mpi_quit.o
-
-#OBJS_PORT = \
-# fftpack.o \
-# four2grid.fftpack.o \
-# noblas.o\
-# funcphys_subsx.o\
-
-OBJS_RAD = \
- radlw_param.o \
- radlw_datatb.o \
- radlw_main.o \
- radsw_param.o \
- radsw_datatb.o \
- radsw_main.o \
- radiation_astronomy.o \
- radiation_aerosols.o \
- radiation_gases.o \
- radiation_clouds.o \
- radiation_surface.o \
- grrad.o \
- gloopb.o \
- gloopr.o
-
-#
-# astronomy.o \
-## funcphys_subs.o
-
-
-# gloopb.o \
-OBJS_PHY= \
- ozinterp.o \
- ozphys.o \
- gbphys.o \
- dcyc2.o \
- dcyc2.pre.rad.o \
- set_soilveg.o \
- sfc_drv.o \
- sfc_land.o \
- progt2.o \
- sfc_sice.o \
- sfc_ocean.o \
- sfc_nst.o \
- sfc_diff.o \
- sfc_diag.o \
- sflx.o \
- moninp.o \
- moninp1.o \
- moninq.o \
- moninq1.o \
- tridi2t3.o \
- gwdps.o \
- gwdc.o \
- sascnv.o \
- sascnvn.o \
- cnvc90.o \
- shalcv.o \
- shalcv_opr.o \
- shalcnv.o \
- lrgsclr.o \
- gscond.o \
- precpd.o \
- mstadb.o \
- mstadbtn.o \
- mstcnv.o \
- get_prs.o \
- gsmddrive.o
-
-# gbphys_call.o \
-###funcphys_subsx.o only srt gpxs was called in fix_fields -table not used
-
-OBJS_IO= \
- sfcsub.o
-
-# read_fix.o \
-# gribit.o \
-# wrt3d.o \
-# wrt3d_hyb.o \
-# wrtg3d.o \
-# wrtg3d_hyb.o \
-# wrtsfc.o \
-# para_fixio_w.o \
-# para_nstio_w.o \
-# treadeo.io.o \
-# treadeo.gfsio.o \
-# grid_to_spec.o \
-# spect_to_grid.o \
-# spect_tv_enthalpy_ps.o\
-# setsig.o \
-# twriteeo.o \
-# bafrio.o \
-# spect_send.o \
-# spect_write.o
-
-
-OBJS_CC= cmp.comm.o \
- atm.comm.o
-# mpi_more.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)
-#
-INCS = f_hpm.h mpi_inc.h function2
-
-#
-# *****************************************************************
-#
-all: model-mpi
-
-model-mpi: $(OBJ_MOD) $(OBJS_CC) $(OBJS0) $(OBJS) $(OBJS_PHY) $(OBJS_RAD) $(OBJS_IO)
- $(LDR) -o $(EXEC) $(OBJ_MOD) $(OBJS_CC) $(OBJS0) $(OBJS) $(OBJS_PHY) $(OBJS_RAD) $(OBJS_IO) $(LIBS) $(LDFLAGS)
-
-clean:
- rm -f $(OBJ_MOD) $(OBJS0) $(OBJS) $(OBJS_RAD) $(OBJS_PHY) $(OBJS_IO) *.mod
-
-tar:
- tar -cvf tar.gfs.r4r8 $(SRC) $(INCS) $(COMS) $(OBJS_PORT:.o=.f) lonsper* res* xx* Makefile* ini.* scr.* m*real_?
-
-.F.o:
- $(F77) $(FFLAGS) -c -d $<
- #$(F77) $(FFLAGS) -c -d -WF,-DCLR:${RASV} $<
-.f.o:
- $(F77) $(FFLAGS) -c $<
-
-
-omegas.o: omegas.f
- $(F77) $(FFLAGM) -c omegas.f
-
-#
-# *****************************************************************
-#
-cnvc90.o: cnvc90.f
- $(F77) $(FFLAGM) -c cnvc90.f
-
-calpreciptype.o: calpreciptype.f
- $(F77) $(FFLAGM3) -c calpreciptype.f
-
-dcyc2.o: dcyc2.f
- $(F77) $(FFLAGM) -c dcyc2.f
-
-dcyc2.pre.rad.o: dcyc2.pre.rad.f
- $(F77) $(FFLAGM) -c dcyc2.pre.rad.f
-
-digifilt.o: digifilt.f
- $(F77) $(FFLAGX) -c digifilt.f
-
-funcphys_subsx.o: funcphys_subsx.f
- $(F77) $(FFLAGM) -c funcphys_subsx.f
-
-gbphys_adv_hyb_gc.o: gbphys_adv_hyb_gc.f
- $(F77) $(FFLAGM) -c gbphys_adv_hyb_gc.f
-
-gbphys_adv_hyb_gc_h-new.o: gbphys_adv_hyb_gc_h-new.f
- $(F77) $(FFLAGM) -c gbphys_adv_hyb_gc_h-new.f
-
-#gbphys_call.o: gbphys_call.f
-# $(F77) $(FFLAGM) -c gbphys_call.f
-
-gbphys.o: gbphys.f
- $(F77) $(FFLAGM) -c gbphys.f
-
-get_prs.o: get_prs.f
- $(F77) $(FFLAGM) -c get_prs.f
-
-filtr1eo.o: filtr1eo.f
- $(F77) $(FFLAG_SER) -c filtr1eo.f
-
-filtr2eo.o: filtr2eo.f
- $(F77) $(FFLAG_SER) -c filtr2eo.f
-
-gscond.o: gscond.f
- $(F77) $(FFLAGM) -c gscond.f
-
-gsmddrive.o: gsmddrive.f
- $(F77) $(FFLAGM) -c gsmddrive.f
-
-reduce_lons_grid_module.o: reduce_lons_grid_module.f
- $(F77) $(FFLAGM) -c reduce_lons_grid_module.f
-
-module_bfmicrophysics.o: module_bfmicrophysics.f
- $(F77) $(FFLAGM) -c module_bfmicrophysics.f
-
-gwdps.o: gwdps.f
- $(F77) $(FFLAGM) -c gwdps.f
-
-gwdc.o: gwdc.f
- $(F77) $(FFLAGM) -c gwdc.f
-
-hyb2press_gc.o: hyb2press_gc.f
- $(F77) $(FFLAGM) -c hyb2press_gc.f
-
-hyb2press.o: hyb2press.f
- $(F77) $(FFLAGM) -c hyb2press.f
-
-hyb2sig.o: hyb2sig.f
- $(F77) $(FFLAGM) -c hyb2sig.f
-
-lrgsclr.o: lrgsclr.f
- $(F77) $(FFLAGM) -c lrgsclr.f
-
-moninp.o: moninp.f
- $(F77) $(FFLAGM) -c moninp.f
-
-moninp1.o: moninp1.f
- $(F77) $(FFLAGM) -c moninp1.f
-
-moninq.o: moninq.f
- $(F77) $(FFLAGM) -c moninq.f
-
-moninq1.o: moninq1.f
- $(F77) $(FFLAGM) -c moninq1.f
-
-mstadb.o: mstadb.f
- $(F77) $(FFLAGM) -c mstadb.f
-
-mstadbtn.o: mstadbtn.f
- $(F77) $(FFLAGM) -c mstadbtn.f
-
-mstcnv.o: mstcnv.f
- $(F77) $(FFLAGM) -c mstcnv.f
-
-omegtes_gc.o: omegtes_gc.f
- $(F77) $(FFLAGM) -c omegtes_gc.f
-
-omegtes.o: omegtes.f
- $(F77) $(FFLAGM) -c omegtes.f
-
-ozinterp.o: ozinterp.f
- $(F77) $(FFLAGM) -c ozinterp.f
-
-ozphys.o: ozphys.f
- $(F77) $(FFLAGM) -c ozphys.f
-
-precpd.o: precpd.f
- $(F77) $(FFLAGM) -c precpd.f
-
-rascnvv2.o: rascnvv2.f
- $(F77) $(FFLAGM) -c rascnvv2.f
-
-sfc_sice.o: sfc_sice.f
- $(F77) $(FFLAGM) -c sfc_sice.f
-
-set_soilveg.o: set_soilveg.f
- $(F77) $(FFLAGM) -c set_soilveg.f
-
-namelist_soilveg.o: namelist_soilveg.f
- $(F77) $(FFLAGM) -c namelist_soilveg.f
-
-sfc_land.o: sfc_land.f
- $(F77) $(FFLAGM) -c sfc_land.f
-
-progt2.o: progt2.f
- $(F77) $(FFLAGM) -c progt2.f
-
-sfc_drv.o: sfc_drv.f
- $(F77) $(FFLAGM) -c sfc_drv.f
-
-sflx.o: sflx.f
- $(F77) $(FFLAGM) -c sflx.f
-
-sfc_ocean.o: sfc_ocean.f
- $(F77) $(FFLAGM) -c sfc_ocean.f
-
-sfc_nst.o: sfc_nst.f
- $(F77) $(FFLAGM) -c sfc_nst.f
-
-sfc_diff.o: sfc_diff.f
- $(F77) $(FFLAGM) -c sfc_diff.f
-
-sfc_diag.o: sfc_diag.f
- $(F77) $(FFLAGM) -c sfc_diag.f
-
-sascnv.o: sascnv.f
- $(F77) $(FFLAGM) -c sascnv.f
-
-sascnvn.o: sascnvn.f
- $(F77) $(FFLAGM) -c sascnvn.f
-
-tridi2t3.o: tridi2t3.f
- $(F77) $(FFLAGM) -c tridi2t3.f
-
-shalcv.o: shalcv.f
- $(F77) $(FFLAGM) -c shalcv.f
-
-shalcv_opr.o: shalcv_opr.f
- $(F77) $(FFLAGM) -c shalcv_opr.f
-
-shalcnv.o: shalcnv.f
- $(F77) $(FFLAGM) -c shalcnv.f
-
-sig2press.o: sig2press.f
- $(F77) $(FFLAGM) -c sig2press.f
-
-# *****************************************************************
-
-radlw_param.o: radlw_param.f
- $(F77) $(FFLAGM) -c radlw_param.f
-
-
-radlw_datatb.o: radlw_datatb.f
- $(F77) $(FFLAGM) -c radlw_datatb.f
-
-
-radlw_main.o: radlw_main.f
- $(F77) $(FFLAGM2) -c radlw_main.f
-
-radsw_param.o: radsw_param.f
- $(F77) $(FFLAGM) -c radsw_param.f
-
-radsw_datatb.o: radsw_datatb.f
- $(F77) $(FFLAGM) -c radsw_datatb.f
-
-radsw_main.o: radsw_main.f
- $(F77) $(FFLAGM2) -c radsw_main.f
-
-radiation_astronomy.o: radiation_astronomy.f
- $(F77) $(FFLAGM) -c radiation_astronomy.f
-
-radiation_aerosols.o: radiation_aerosols.f
- $(F77) $(FFLAGM) -c radiation_aerosols.f
-
-radiation_gases.o: radiation_gases.f
- $(F77) $(FFLAGM) -c radiation_gases.f
-
-radiation_clouds.o: radiation_clouds.f
- $(F77) $(FFLAGM) -c radiation_clouds.f
-
-radiation_surface.o: radiation_surface.f
- $(F77) $(FFLAGM) -c radiation_surface.f
-
-grrad.o: grrad.f
- $(F77) $(FFLAGM) -c grrad.f
-
-progtm_module.o: progtm_module.f
- $(F77) $(FFLAGM) -c progtm_module.f
-
-machine.o: machine.f
- $(F77) $(FFLAGM) -c machine.f
-
-num_parthds.o: num_parthds.f
- $(F77) $(FFLAGM) -c num_parthds.f
-
-kinds.o: GEFS_Cpl_Cal_Sto_Coef.fd/kinds.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/kinds.f90
-
-peuc.o: GEFS_Cpl_Cal_Sto_Coef.fd/peuc.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/peuc.f90
-
-pran.o: GEFS_Cpl_Cal_Sto_Coef.fd/pran.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/pran.f90
-
-prana.o: GEFS_Cpl_Cal_Sto_Coef.fd/prana.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/prana.f90
-
-#
-# *****************************************************************
-#
-physcons.o: physcons.f
- $(F77) $(FFLAG90) -c physcons.f
-
-iounitdef.o: iounitdef.f
- $(F77) $(FFLAG90) -c iounitdef.f
-
-funcphys.o: funcphys.f
- $(F77) $(FFLAG90) -c funcphys.f
-
-sfcio_module.o: sfcio_module.f
- $(F77) $(FFLAGSF) -c sfcio_module.f
-
-sigio_module.o: sigio_module.f
- $(F77) $(FFLAGSI) -c sigio_module.f
-
-gfsio_def.o: gfsio_def.f
- $(F77) $(FFLAGSI) -c gfsio_def.f
-
-gfsio_module.o: gfsio_module.f
- $(F77) $(FFLAGSI) -c gfsio_module.f
-
-sigio_r_module.o: sigio_r_module.f
- $(F77) $(FFLAGSI) -c sigio_r_module.f
-
-bafrio.o: bafrio.f
- $(F77) $(FFLAGB) -c bafrio.f
-
-#
-#sigdas.io.o: sigdas.io.f
-## $(F77) $(FFLAGIO) -c sigdas.io.f
-
-read_fix.o: read_fix.f
- $(F77) $(FFLAGX) -c read_fix.f
-
-softcount.o: softcount.f
- $(F77) $(FFLAGX) -c softcount.f
-
-gloopr.o: gloopr.f
- $(F77) $(FFLAG_SER) -c gloopr.f
-
-gloopb.o: gloopb.f
- $(F77) $(FFLAGM2) -c gloopb.f
-
-sfcsub.o: sfcsub.f
- $(F77) $(FFLAG_SER) -c sfcsub.f
-
-gcycle.o: gcycle.f
- $(F77) $(FFLAGM) -c gcycle.f
-
-getaer.o: getaer.f
- $(F77) $(FFLAGIO) -c getaer.f
-
-wrt3d.o: wrt3d.f
- $(F77) $(FFLAGIO) -c wrt3d.f
-
-gribit.o: gribit.f
- $(F77) $(FFLAGIO) -c gribit.f
-
-wrtsfc.o: wrtsfc.f
- $(F77) $(FFLAGIO) -c wrtsfc.f
-
-para_fixio_w.o: para_fixio_w.f
- $(F77) $(FFLAGIO) -c para_fixio_w.f
-
-para_nstio_w.o: para_nstio_w.f
- $(F77) $(FFLAGIO) -c para_nstio_w.f
-
-#para_fixio_all_w.o: para_fixio_all_w.f
-# $(F77) $(FFLAGIO) -c para_fixio_all_w.f
-
-#para_fixio_iop_w.o: para_fixio_iop_w.f
-# $(F77) $(FFLAGIO) -c para_fixio_iop_w.f
-
-#conrad.o: conrad.f
-# $(F77) $(FFLAGIO) -c conrad.f
-
-#crhtab.o: crhtab.f
-# $(F77) $(FFLAGIO) -c crhtab.f
-
-treadeo.io.o: treadeo.io.f
- $(F77) $(FFLAGIO) -c treadeo.io.f
-
-treadeo.gfsio.o: treadeo.gfsio.f
- $(F77) $(FFLAGIO) -c treadeo.gfsio.f
-
-twriteeo.o: twriteeo.f
- $(F77) $(FFLAGIO) -c twriteeo.f
-
-spect_send.o: spect_send.f
- $(F77) $(FFLAGIO) -c spect_send.f
-
-spect_write.o: spect_write.f
- $(F77) $(FFLAGIO) -c spect_write.f
-
-spect_to_grid.o: spect_to_grid.f
- $(F77) $(FFLAGIO) -c spect_to_grid.f
-
-spect_tv_enthalpy_ps.o: spect_tv_enthalpy_ps.f
- $(F77) $(FFLAGIO) -c spect_tv_enthalpy_ps.f
-
-grid_to_spec.o: grid_to_spec.f
- $(F77) $(FFLAGIO) -c grid_to_spec.f
-
-wrtout.o: wrtout.f
- $(F77) $(FFLAGIO) -c wrtout.f
-
-nstio_module.o: nstio_module.f
- $(F77) $(FFLAG90) -c nstio_module.f
-
-module_nst_parameters.o: module_nst_parameters.f
- $(F77) $(FFLAG90) -c module_nst_parameters.f
-
-module_nst_water_prop.o: module_nst_water_prop.f
- $(F77) $(FFLAG90) -c module_nst_water_prop.f
-
-module_nst_model.o: module_nst_model.f
- $(F77) $(FFLAG90) -c module_nst_model.f
-
-NameList_ESMFMod.o: NameList_ESMFMod.f
- $(F77) $(FFLAG90) -c NameList_ESMFMod.f
-
-Sfc_Var_ESMFMod.o: Sfc_Var_ESMFMod.f
- $(F77) $(FFLAG90) -c Sfc_Var_ESMFMod.f
-
-Nst_Var_ESMFMod.o: Nst_Var_ESMFMod.f
- $(F77) $(FFLAG90) -c Nst_Var_ESMFMod.f
-
-Lib_ESMFStateAddGetMod.o: Lib_ESMFStateAddGetMod.f
- $(F77) $(FFLAG90) -c Lib_ESMFStateAddGetMod.f
-
-#GFS_ESMFStateAddGetMod.o: GFS_ESMFStateAddGetMod.f
-# $(F77) $(FFLAG90) -c GFS_ESMFStateAddGetMod.f
-
-GFS_InternalState_ESMFMod.o: GFS_InternalState_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_InternalState_ESMFMod.f
-
-GFS_ESMFStateMod.o: GFS_ESMFStateMod.f
- $(F77) $(FFLAG90) -c GFS_ESMFStateMod.f
-
-GFS_ErrMsgMod.o: GFS_ErrMsgMod.f
- $(F77) $(FFLAG90) -c GFS_ErrMsgMod.f
-
-GFS_GetCf_ESMFMod.o: GFS_GetCf_ESMFMod.f cmp.comm.o atm.comm.o
- $(F77) $(FFLAG90) -c GFS_GetCf_ESMFMod.f
-
-GFS_ESMFMod.o: GFS_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_ESMFMod.f
-
-#GFS_Grid_fnl_ESMFMod.o: GFS_Grid_fnl_ESMFMod.f
- #$(F77) $(FFLAG90A) -c GFS_Grid_fnl_ESMFMod.f
-
-GFS_GridComp_ESMFMod.o: GFS_GridComp_ESMFMod.f
- $(F77) $(FFLAG90A) -c GFS_GridComp_ESMFMod.f
-
-#GFS_Initialize_ESMFMod.o: GFS_Initialize_ESMFMod.f
-# $(F77) $(FFLAG90) -c GFS_Initialize_ESMFMod.f
-GFS_Initialize.o: GFS_Initialize.f
- $(F77) $(FFLAG90) -c GFS_Initialize.f
-
-GFS_Run_ESMFMod.o: GFS_Run_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_Run_ESMFMod.f
-
-GFS_Finalize_ESMFMod.o: GFS_Finalize_ESMFMod.f
- $(F77) $(FFLAG90) -c GFS_Finalize_ESMFMod.f
-
-GFS_InputFile2ImportState.o: GFS_InputFile2ImportState.f
- $(F77) $(FFLAG90) -c GFS_InputFile2ImportState.f
-
-#GFS_Standalone_ESMF_ENS.o: GFS_Standalone_ESMF_ENS.f
-# $(F77) $(FFLAG90) -c GFS_Standalone_ESMF_ENS.f
-
-GFS_ESMF.o: GFS_ESMF.f
- $(F77) $(FFLAG90) -c GFS_ESMF.f
-
-Grid_ESMFCreate.o: Grid_ESMFCreate.f
- $(F77) $(FFLAG90) -c Grid_ESMFCreate.f
-
-StartTimeGet_ESMF.o: StartTimeGet_ESMF.f
- $(F77) $(FFLAG90) -c StartTimeGet_ESMF.f
-
-Ensemble_sub.o: Ensemble_sub.f
- $(F77) $(FFLAG90) -c Ensemble_sub.f
-
-mpi_more.o: mpi_more.f
- $(F77) $(FFLAGS) -c mpi_more.f
-
-cmp.comm.o: cmp.comm.f
- $(F77) $(FFLAGS) -c cmp.comm.f
-
-atm.comm.o: atm.comm.f
- $(F77) $(FFLAGS) -c atm.comm.f
-
-tiles.o: tiles.f
- $(F77) $(FFLAGS) -c tiles.f
-
-#GEFS_Cpl_InternalState_ESMFMod.o: GEFS_Cpl_InternalState_ESMFMod.f
-# $(F77) $(FFLAG90) -c GEFS_Cpl_InternalState_ESMFMod.f
-GEFS_Cpl_InternalState.o: GEFS_Cpl_InternalState.f
- $(F77) $(FFLAG90) -c GEFS_Cpl_InternalState.f
-
-GEFS_CplState_ESMFMod.o: GEFS_CplState_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_CplState_ESMFMod.f
-
-GEFS_Sto_Per_Scheme.o: GEFS_Sto_Per_Scheme.f
- $(F77) $(FFLAG90) -c GEFS_Sto_Per_Scheme.f
-
-GEFS_Cpl_Run_ESMFMod.o: GEFS_Cpl_Run_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_Cpl_Run_ESMFMod.f
-
-GEFS_Cpl_ESMFMod.o: GEFS_Cpl_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_Cpl_ESMFMod.f
-
-GEFS_CplComp_ESMFMod.o: GEFS_CplComp_ESMFMod.f
- $(F77) $(FFLAG90) -c GEFS_CplComp_ESMFMod.f
-
-GFS_AddParameterToStateMod.o: GFS_AddParameterToStateMod.f
- $(F77) $(FFLAG90) -c GFS_AddParameterToStateMod.f
-
-GEFS_Sto_Per_Scheme_Step1.o: GEFS_Sto_Per_Scheme_Step1.f
- $(F77) $(FFLAG90) -c GEFS_Sto_Per_Scheme_Step1.f
-
-GEFS_Sto_Per_Scheme_Step2.o: GEFS_Sto_Per_Scheme_Step2.f
- $(F77) $(FFLAG90) -c GEFS_Sto_Per_Scheme_Step2.f
-
-GEFS_GetParameterFromStateMod.o: GEFS_GetParameterFromStateMod.f
- $(F77) $(FFLAG90) -c GEFS_GetParameterFromStateMod.f
-
-Cal_Sto_Coef.o: GEFS_Cpl_Cal_Sto_Coef.fd/Cal_Sto_Coef.f90
- $(F90) $(FFLAG90) -c GEFS_Cpl_Cal_Sto_Coef.fd/Cal_Sto_Coef.f90
-
-GEFS_bcst_global.o: GEFS_bcst_global.f
- $(F77) $(FFLAG90) -c GEFS_bcst_global.f
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/atm.comm.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/atm.comm.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/atm.comm.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,1226 +0,0 @@
- MODULE constant_cc
-
- USE MACHINE, ONLY: kind_phys
-
- USE physcons
-
- END MODULE constant_cc
-!
-!***********************************************************************
-!
- MODULE ATM_cc
-
- USE CMP_COMM, ONLY:
- > MPI_COMM_Atmos => COMM_local,
- > Coupler_id,
- > component_master_rank_local,
- > process_rank_local,
-! Note: the latter two are only to compare with each
-! other and thus determine if the process is the local
-! master (root) process. (Comparison of
-! component_master_rank_global with process_rank_global
-! would not work because the former is known only to
-! Coupler process and the local master process itself.)
- > component_nprocs,
- > kind_REAL,MPI_kind_REAL,
- > MPI_INTEGER,MPI_STATUS_SIZE,
- > ibuffer
- USE mpi_def, ONLY: COMM_TILES => MC_COMP
- USE layout1, ONLY: TILES_nprocs => nodes_comp
-
- implicit none
-
- integer latg,latr,lonf,lonr
- integer latd
- integer lats_node_r,ipt_lats_node_r
-
- integer N2D
-
- integer, allocatable:: global_lats_r(:),lonsperlar(:)
-
- logical COMP /.false./
-
-!controls:
-! integer nunit_announce_cc /6/, VerbLev /5/
-! integer nunit_announce_cc /6/, VerbLev /2/
- integer nunit_announce_cc /6/, VerbLev /1/
-
- save
-
- END MODULE ATM_cc
-!
-!***********************************************************************
-!
- MODULE SURFACE_cc
-
- USE constant_cc, ONLY:
- > hvap_cc=>con_hvap, ! - this is L, to use in LE
- ! Check: if L in LE must
- ! rather be either evap.
- ! heat or evap.+melt. heat
- > JCAL_cc=>con_JCAL, ! - J in Cal
- > kind_phys_cc=>kind_phys
-
- implicit none
-
- integer, parameter::
- > kind_sfcflux=8,
- > kind_SST=8,
- > kind_SLMSK=8,
- > kind_dt_cc=8, !-->cpl insertion: add model vars precision here <--
- > kind_modelvar=8
-
- integer,allocatable:: ISLM_RG(:,:),ISLM_FG(:,:)
- real (kind=kind_sfcflux),allocatable::
- >DUSFC_cc(:,:),DVSFC_cc(:,:),
- >DTSFC_cc(:,:),DQSFC_cc(:,:),PRECR_cc(:,:),
- >DLWSFC_cc(:,:),ULWSFC_cc(:,:),SWSFC_cc(:,:),
-!-->cpl insertion
- >XMU_cc(:,:),DSW_cc(:,:),DLW_cc(:,:),ffmm_cc(:,:),ffhh_cc(:,:),
- >SNW_cc(:,:),LPREC_cc(:,:),SST_ave(:,:)
-!<--cpl insertion
-
- real (kind=kind_SST),allocatable:: SST_cc(:,:)
-
- real (kind=kind_dt_cc) dt_cc,dto_cc !-->cpl insertion: add dto_cc
-
-!--> cpl insertion: add model vars here:
- real (kind=kind_modelvar),allocatable::
- > T_BOT_cc(:,:),U_BOT_cc(:,:),V_BOT_cc(:,:), Q_BOT_cc(:,:),
- > P_BOT_cc(:,:),P_SURF_cc(:,:),Z_BOT_cc(:,:),T_SFC_cc(:,:)
- &, FICE_SFC_cc(:,:), HICE_SFC_cc(:,:)
-!<-- cpl insertion
-
- logical lssav_cc,lsout_cc,lgetSSTICE_cc,l_df_cc
-!--> cpl insertion
- logical lsout_cc_momice,lsout_cc_momocn
- integer i_dto2dta_cc
-!<-- cpl insertion
- integer i_dtc2dta_cc
-! parameter (i_dtc2dta_cc=3) ! <- ratio of time steps in OM and AM
- real (kind=kind_dt_cc) dta2dtc_cc,dta2dto_cc
-
- real(kind=kind_phys_cc) CONVRAD_cc
- PARAMETER (CONVRAD_cc=JCAL_cc*1.E4/60.) ! - see progtmr.f,
- ! subr. progtm
-
- integer n_do_tstep_cc /0/,kdtmax_cc/0/
-
- character*180 s_cc
-
- integer ISLM_OS_value,ISLM_SI_value,ISLM_L_value
- parameter (ISLM_OS_value=0,
- !<- must be integer open sea value in AM sea/land mask
- > ISLM_L_value=1,
- !<- must be integer land value in AM sea/land mask
- > ISLM_SI_value=2)
- !<- must be integer sea ice value in AM sea/land mask
-
- real SLM_OS_value,unrealistically_low_SST,
- >unrealistically_low_SV,unrealistically_low_SVp
- >,unrealistically_low_SF
- parameter (unrealistically_low_SST=0.01,
- ! <- must be unreal low but >=0., see
- ! subr. O2A --- check!
- > unrealistically_low_SV=-1.E30)
- ! <- must be negative unreal low surface flux
- ! or other surface value to be sent
- ! to Coupler, see Coupler code
- parameter (SLM_OS_value=REAL(ISLM_OS_value),
- ! <- must be real open sea value in AM
- ! sea/land mask array
- > unrealistically_low_SVp=0.99*unrealistically_low_SV,
- > unrealistically_low_SF=unrealistically_low_SV)
- !<- this used to be the name of the value; it
- ! is not used any more but may be referred to
- ! in comments
-
- save
-
- END MODULE SURFACE_cc
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_CMP_START
-
- USE ATM_cc, ONLY: component_nprocs,VerbLev,ibuffer,Coupler_id
-
- implicit none
-
- integer Atmos_id /1/, Atmos_master_rank_local /0/
- character*20 s
-!
-
-! print*,'AM: to call CMP_INIT'
- !<-id of AM as a component of the coupled system
- call CMP_INIT(Atmos_id,1)
- !<-"flexibility level"
-! print*,'AM: back from CMP_INIT'
-! if (Coupler_id.ge.0) VerbLev=min(VerbLev,ibuffer(4))
- if (Coupler_id.ge.0) VerbLev=min(VerbLev,2)
-
- Atmos_master_rank_local=component_nprocs-1
- !<- this redefinition is to meet the
- ! requirement of subr. split2d_r used
- ! in DISASSEMBLE_cc for disassembling
- ! 2D fields. The requirement seems
- ! to be that the input argument
- ! representing a whole grid array be
- ! defined in process of the largest rank
- ! which seems to be considered i/o
- ! process. To use a different value,
- ! e.g. the conventional 0, split2d_r
- ! (or DISASSEMBLE_cc) must be rewritten.
- ! (Strangely, unsplit2d_r does not pose this
- ! requirement and uses a dummy arg. ioproc to
- ! identify the process where the whole grid array
- ! is to be defined. Seemingly.)
-
- Atmos_master_rank_local=0 ! see above for modifications needed
- ! to support this change
-
- call CMP_INTRO(Atmos_master_rank_local)
-
- write(s,'(i2)') VerbLev
- call ATM_ANNOUNCE('back from CMP_INTRO, VerbLev='//s,2)
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_CMP_START1
-
- USE ATM_cc, ONLY: process_rank_local,VerbLev,ibuffer,Coupler_id
-
- implicit none
-
- integer Atmos_id /1/
-!
-
- !<-id of AM as a component of the coupling system
- call CMP_INIT(Atmos_id,1)
- !<-"flexibility level"
-
-! if (Coupler_id.ge.0) VerbLev=min(VerbLev,ibuffer(4))
- if (Coupler_id.ge.0) VerbLev=min(VerbLev,2)
-
-! print*,'AM: back from CMP_INIT, process_rank_local=',
-! > process_rank_local
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_CMP_START2(me)
-
- USE ATM_cc, ONLY: VerbLev
-
- implicit none
-
- integer me
-
- character*20 s
-!
-
- if (me .eq. 0) then
- CALL CMP_INTRO_m
- else
- CALL CMP_INTRO_s
- end if
-
- write(s,'(i2)') VerbLev
- call ATM_ANNOUNCE('back from CMP_INTRO_m, VerbLev='//s,1)
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_TILES_INIT(lonr_dummy,latr_dummy,lonf_dummy,
- >latg_dummy,latd_dummy,ipt_lats_node_r_dummy,
- >global_lats_r_dummy,lonsperlar_dummy)
-
- USE ATM_cc
-
- implicit none
-
- integer lonr_dummy,latr_dummy,lonf_dummy,latg_dummy,latd_dummy
- integer ipt_lats_node_r_dummy
- integer global_lats_r_dummy(latr_dummy),
- > lonsperlar_dummy(latr_dummy)
-
- character*10 s
-!
-
- lonr=lonr_dummy
- latr=latr_dummy
- lonf=lonf_dummy
- latg=latg_dummy
- latd=latd_dummy
- lats_node_r=latd
- ipt_lats_node_r=ipt_lats_node_r_dummy
-
- N2D=lonf*latg
-
- print*,"ATM_TILES_INIT: lonr,latr,lonf,latg,latd"
- print*,lonr,latr,lonf,latg,latd
-
- write(s,'(i5)') lonr
- CALL ATM_ANNOUNCE('ATM_TILES_INIT: lonr='//s,2)
- write(s,'(i5)') latr
- CALL ATM_ANNOUNCE('ATM_TILES_INIT: latr='//s,2)
- write(s,'(i5)') lonf
- CALL ATM_ANNOUNCE('ATM_TILES_INIT: lonf='//s,2)
- write(s,'(i5)') latg
- CALL ATM_ANNOUNCE('ATM_TILES_INIT: latg='//s,2)
- write(s,'(i5)') latd
- CALL ATM_ANNOUNCE('ATM_TILES_INIT: latd='//s,2)
-
- call GLOB_ABORT(abs(lonr-lonf)+abs(latr-latg),
- >'Unexpected: lonr, lonf or latr, latg differ. Aborting',1)
-
- if (.not. allocated(global_lats_r)) allocate(global_lats_r(latr))
- if (.not. allocated(lonsperlar)) allocate(lonsperlar(latr))
- global_lats_r=global_lats_r_dummy
- lonsperlar=lonsperlar_dummy
-
-!fy CALL ATM_ANNOUNCE(
-!fy >'ATM_TILES_INIT: global_lats_r, lonsperlar assigned',2)
-!fy if (VerbLev.ge.2) then
-!fy print*,'AM: ATM_TILES_INIT',component_master_rank_local,
-!fy > ' ipt_lats_node_r=',ipt_lats_node_r,' latd=',latd
-!fy print*,'AM: ATM_TILES_INIT',component_master_rank_local,
-!fy > ' global_lats_r: ',global_lats_r
-!fy print*,'AM: ATM_TILES_INIT',component_master_rank_local,
-!fy > ' lonsperlar: ',lonsperlar
-!fy end if
-!fy
-!fy call INITIALIZE_TILING
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_SURF_INIT
-
- USE ATM_cc, ONLY: lonr,latd,lonf,latg
-
- USE SURFACE_cc
-
- implicit none
-
- integer rc
-C
-
- write(s_cc,'(4i5)') lonr,latd,lonf,latg
- CALL ATM_ANNOUNCE(
- >'ATM_SURF_INIT: lonr,latd,lonf,latg: '//s_cc,2)
-!--> cpl insertion
- if (.not. allocated(T_BOT_cc)) allocate(T_BOT_cc(lonr,latd))
- if (.not. allocated(U_BOT_cc)) allocate(U_BOT_cc(lonr,latd))
- if (.not. allocated(V_BOT_cc)) allocate(V_BOT_cc(lonr,latd))
- if (.not. allocated(Q_BOT_cc)) allocate(Q_BOT_cc(lonr,latd))
- if (.not. allocated(P_BOT_cc)) allocate(P_BOT_cc(lonr,latd))
- if (.not. allocated(Z_BOT_cc)) allocate(Z_BOT_cc(lonr,latd))
- if (.not. allocated(P_SURF_cc)) allocate(P_SURF_cc(lonr,latd))
- if (.not. allocated(T_SFC_cc)) allocate(T_SFC_cc(lonr,latd))
- if (.not. allocated(FICE_SFC_cc)) allocate(FICE_SFC_cc(lonr,latd))
- if (.not. allocated(HICE_SFC_cc)) allocate(HICE_SFC_cc(lonr,latd))
- if (.not. allocated(XMU_cc)) allocate(XMU_cc(lonr,latd))
- if (.not. allocated(DSW_cc)) allocate(DSW_cc(lonr,latd))
- if (.not. allocated(DLW_cc)) allocate(DLW_cc(lonr,latd))
- if (.not. allocated(ffmm_cc)) allocate(ffmm_cc(lonr,latd))
- if (.not. allocated(ffhh_cc)) allocate(ffhh_cc(lonr,latd))
-!
-! allocate(T_BOT_cc(lonr,latd),U_BOT_cc(lonr,latd),
-! > V_BOT_cc (lonr,latd),Q_BOT_cc(lonr,latd),
-! > P_BOT_cc (lonr,latd),P_SURF_cc(lonr,latd),
-! > Z_BOT_cc (lonr,latd),
-! > T_SFC_cc (lonr,latd),
-! > FICE_SFC_cc (lonr,latd),HICE_SFC_cc (lonr,latd),
-! > XMU_cc(lonr,latd),
-! > DSW_cc(lonr,latd), DLW_cc(lonr,latd),
-! > ffmm_cc(lonr,latd), ffhh_cc(lonr,latd) )
-!
- T_BOT_cc=0.
- U_BOT_cc=0.
- V_BOT_cc=0.
- Q_BOT_cc=0.
- P_BOT_cc=0.
- P_SURF_cc=0.
- Z_BOT_cc=0.
- T_SFC_cc=0.
- FICE_SFC_cc=0.
- HICE_SFC_cc=0.
- XMU_cc=0.
- DSW_cc=0.
- DLW_cc=0.
- ffmm_cc=0.
- ffhh_cc=0.
-!<-- cpl insertion
-
- if (.not. allocated(DUSFC_cc)) allocate(DUSFC_cc(lonr,latd))
- if (.not. allocated(DVSFC_cc)) allocate(DVSFC_cc(lonr,latd))
- if (.not. allocated(DTSFC_cc)) allocate(DTSFC_cc(lonr,latd))
- if (.not. allocated(DQSFC_cc)) allocate(DQSFC_cc(lonr,latd))
- if (.not. allocated(PRECR_cc)) allocate(PRECR_cc(lonr,latd))
- if (.not. allocated(SST_cc)) allocate(SST_cc(lonr,latd))
- if (.not. allocated(DLWSFC_cc)) allocate(DLWSFC_cc(lonr,latd))
- if (.not. allocated(ULWSFC_cc)) allocate(ULWSFC_cc(lonr,latd))
- if (.not. allocated(SWSFC_cc)) allocate(SWSFC_cc(lonr,latd))
- if (.not. allocated(SST_ave)) allocate(SST_ave(lonr,latd))
- if (.not. allocated(SNW_cc)) allocate(SNW_cc(lonr,latd))
- if (.not. allocated(LPREC_cc)) allocate(LPREC_cc(lonr,latd))
-!
-! allocate(DUSFC_cc(lonr,latd),DVSFC_cc(lonr,latd),
-! > DTSFC_cc (lonr,latd),DQSFC_cc(lonr,latd),
-! > PRECR_cc(lonr,latd),SST_cc(lonr,latd),
-! > DLWSFC_cc(lonr,latd),ULWSFC_cc(lonr,latd),
-! > SWSFC_cc(lonr,latd) ,SST_ave(lonr,latd),
-! > SNW_cc(lonr,latd), LPREC_cc(lonr,latd) )
-
- DUSFC_cc=0.
- DVSFC_cc=0.
- DTSFC_cc=0.
- DQSFC_cc=0.
- PRECR_cc=0.
- SNW_cc=0.
- LPREC_cc=0.
- DLWSFC_cc=0.
- ULWSFC_cc=0.
- SWSFC_cc=0.
- SST_ave=0.
-
- if (.not. allocated(ISLM_RG)) allocate(ISLM_RG(lonr,latd))
- if (.not. allocated(ISLM_FG)) allocate(ISLM_FG(lonr,latd))
-!
-! allocate(ISLM_RG(lonr,latd),ISLM_FG(lonr,latd))
-
- call ATM_ANNOUNCE('ATM_SURF_INIT: ISLM_RG, ISLM_FG allocated',1)
-
- if (kind_sfcflux.ne.kind_phys_cc) then
- print*,'ATM_SURF_INIT: kind_sfcflux, kind_phys: ',
- > kind_sfcflux, kind_phys_cc
- call GLOB_ABORT(1,'kind_sfcflux.ne.kind_phys_cc, GBPHYS args'//
- > ' must be redeclared and code adjustments made',rc)
- end if
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_RECVdtc(dta)
-
- USE ATM_cc, ONLY:
- > MPI_COMM_Atmos,
- > Coupler_id,
- > component_master_rank_local,
- > kind_REAL,MPI_kind_REAL
-
- USE SURFACE_cc, ONLY:
- >dt_cc,dta2dtc_cc,i_dtc2dta_cc,i_dto2dta_cc,
- >s_cc , dto_cc,dta2dto_cc !--> cpl insertion: add dto_cc, dta2dto_cc
-
- implicit none
-
- real dta
- real (kind=kind_REAL) buf(2)
- integer rc,sizebuf
- character*40 s
-
- call ATM_ANNOUNCE('ATM_RECVdtc: to receive C time step',2)
- buf=0.
- sizebuf=size(buf)
- call CMP_RECV(buf,sizebuf)
- if (Coupler_id.lt.0) then
- dt_cc=0.
- dto_cc=0.
- call ATM_ANNOUNCE(
- > 'ATM_RECVdtc: C time step assigned 0, as it is standalone mode'
- > ,2)
- else
- write(s,'(e20.12,e20.12)') buf(1),buf(2)
- call ATM_ANNOUNCE(
- > 'ATM_RECVdtc: C time step ='//trim(s)//' received',2)
- call MPI_BCAST(buf,2,MPI_kind_REAL,
- > component_master_rank_local,MPI_COMM_Atmos,rc)
- call ATM_ANNOUNCE('ATM_RECVdtc: C time step broadcast',2)
- dt_cc=buf(1)
- dto_cc=buf(2)
- end if
-
- i_dtc2dta_cc = dt_cc/dta + 0.001
- i_dto2dta_cc = dto_cc/dta + 0.001
-
- print *,'AM: dto_cc=',dto_cc,' dta=',dta,' i_dto2dta_cc=',
- & i_dto2dta_cc,' dt_cc=',dt_cc,' i_dtc2dta_cc=',i_dtc2dta_cc
-
- if (i_dtc2dta_cc.eq.0) then
- i_dtc2dta_cc=4
- call ATM_ANNOUNCE('ratio of OM/AM time steps =0, assigned 4 .'//
- > ' This should only occur if it is standalone mode',2)
- else
- write(s_cc,'(i2,i2)') i_dtc2dta_cc,i_dto2dta_cc
-! print *,' s_cc=',s_cc
- call ATM_ANNOUNCE('ratio of OM/AM time steps: '//trim(s_cc),2)
- end if
- dta2dtc_cc=1./i_dtc2dta_cc
- dta2dto_cc=1./i_dto2dta_cc
-
- RETURN
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_SENDGRID(XLON,XLAT)
-
- USE ATM_cc
-
- implicit none
-
- real (kind=kind_REAL) XLON(lonr,latd),XLAT(lonr,latd)
- real (kind=kind_REAL) ALON(lonf),ALAT(latg),
- >x(lonf,latg),y(lonf,latg)
-
- integer buf(2),i,j
-
- logical fg
-
- character*50 s
-
- if (Coupler_id.lt.0) return ! <- standalone mode
-
- buf(1)=lonf
- buf(2)=latg
- call ATM_ANNOUNCE('to send grid dimensions',1)
- call CMP_INTEGER_SEND(buf,2)
- call ATM_ANNOUNCE('grid dimensions sent',1)
-
- call ASSEMBLE_cc(x,XLON)
-
-!-->cpl deletion, mom4, do not need laon, alat
-! if (component_master_rank_local.eq.process_rank_local) then
-!
-!c ALON=x(:,1)
-! ALON=x(:,latg/2) ! assigns closest to equator lat. circle,
-! ! where in reduced grid numb. of longitudes
-! ! is maximal and = that in full grid
-!
-! fg=.true.
-! do j=1,latg
-! do i=1,lonf
-! if (ALON(i).ne.x(i,j)) then
-! fg=.false.
-! write(s,'(2i5,1p2e16.7)') j,i,ALON(i),x(i,j)
-!c call GLOB_ABORT(1,
-! call ATM_ANNOUNCE(
-! > 'ATM_SENDGRID: inhomogeneous longitudes'//s,2)
-! exit
-! end if
-! end do
-! end do
-! if (fg) then
-! call ATM_ANNOUNCE('ATM_SENDGRID: full grid',1)
-! else
-! call ATM_ANNOUNCE('ATM_SENDGRID: reduced grid',1)
-! end if
-!
-! call ATM_ANNOUNCE('to send array of longitudes',1)
-! call CMP_SEND(ALON,lonf)
-! call ATM_ANNOUNCE('array of longitudes sent',1)
-!
-! end if
-!<-- cpl deletion
-
- call ASSEMBLE_cc(x,XLAT)
-
-!-->cpl deletion, mom4, do not need laon, alat
-! if (component_master_rank_local.eq.process_rank_local) then
-!
-! ALAT=x(1,:)
-!
-! do j=1,latg
-! if (ALAT(j).ne.x(2,j)) then
-! write(s,'(i5,1p2e16.7)') j,ALAT(j),x(2,j)
-! call GLOB_ABORT(1,
-! > 'ATM_SENDGRID: inhomogenous latitudes, aborting'//s,1)
-! end if
-! end do
-!
-! call ATM_ANNOUNCE('to send array of latitudes',1)
-! call CMP_SEND(ALAT,latg)
-! call ATM_ANNOUNCE('array of latitudes sent',1)
-!
-! end if
-!<-- cpl deletion
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_SENDSLM(SLMSK)
-!
-! This is to send sea/land mask with 0. on sea (either open sea
-! or sea ice) and 1. on land. For the assumptions about SLMSK
-! argument, see code/comments below
-
- USE ATM_cc
-
- USE SURFACE_cc, ONLY: ISLM_RG,ISLM_FG,kind_SLMSK
-
- implicit none
-
- real (kind=kind_SLMSK) SLMSK(lonr,latd)
-
- real(kind=kind_REAL), dimension(lonr,latd):: SLM1,SLM2,SLM0
- real SLM(lonf,latg)
- integer i,j,lat,lons
- character*80 s
- logical bad_SLM /.false./
-
- if (Coupler_id.lt.0) return ! <- standalone mode
-
- if (VerbLev.ge.2) then
- print*,'ATMSENDSLM entered, lonr,latd,lonf,latg: ',
- > lonr,latd,lonf,latg
- end if
-
- do j=1,latd
- do i=1,lonr
- if (abs(SLMSK(i,j)-2.).lt.1.E-5 ! sea ice
- > .or. abs(SLMSK(i,j)).lt.1.E-5) then ! open sea
- SLM1(i,j)=0.
- else if (abs(SLMSK(i,j)-1.).lt.1.E-5) then ! land
- SLM1(i,j)=1.
- else
- SLM1(i,j)=666.
- end if
- end do
- end do
-
- ISLM_RG=nint(SLM1)
- !<- store reduced grid integer mask array for future
- ! communications; it will only be needed for uninterpred_cc
-
-! print*,'ATMSENDSLM to call uninterpred_cc'
-
- call uninterpred_cc(1,ISLM_RG,SLM1,SLM2)
- ! <- interpolation FROM reduced grid (i.e. with # of
- ! longitudes varying from lat. circle to lat. circle)
- ! to full grid.
-
-! print*,'ATMSENDSLM back from uninterpred_cc'
-
- ! Because 1st arg. iord=1, ISLM_RG values do not matter here, it
- ! is just a dummy input argument with proper type/dimensions.
- ! Reduced grid mask SLM1 is interpolated to full grid mask
- ! SLM2 (both arrays are local (per process)) by taking the
- ! nearest value on the lat. circle. This procedure should be
- ! reversible.
-! Reversibility test:->
-
-! print*,'ATMSENDSLM to call interpred_cc'
-
- call interpred_cc(1,ISLM_FG,SLM2,SLM0)
- !<- same thing: ISLM_FG values don't matter.
- ! And they are undefined here.
-
-! print*,'ATMSENDSLM back from interpred_cc'
-
- do j=1,latd
- lat=global_lats_r(ipt_lats_node_r-1+j)
- lons=lonsperlar(lat)
- do i=1,lons
- if (SLM0(i,j).ne.SLM1(i,j)) then
- write(s,'("SLM: R2F irreversible",2i6,2pe17.9)')
- > i,j,SLM1(i,j),SLM0(i,j)
- bad_SLM=.true.
- exit
- end if
- end do
- end do
-! <-: reversibility test
-
-! print*,'ATMSENDSLM finished reversibility test'
-
-! Value test:->
- do j=1,latd
- do i=1,lonr
- if (SLM2(i,j).ne.0. .and. SLM2(i,j).ne.1.) then
- write(s,'("Bad SLM value",2i6,1pe20.12)') i,j,SLM2(i,j)
- bad_SLM=.true.
- exit
- end if
- end do
- end do
-! <-: value test
-
-! print*,'ATMSENDSLM finished value test'
-
- if (bad_SLM) then
- call GLOB_ABORT(1,'ATM_SENDSLM: '//s,1)
- end if
-
-! print*,'ATMSENDSLM to assign ISLM_FG=nint(SLM2)'
-
-
- ISLM_FG=nint(SLM2)
- !<- store full grid integer mask array for future
- ! communications; it will only be needed for interpred_cc
-
-! print*,'ATMSENDSLM to call ASSEMBLE_cc'
-
-
- call ASSEMBLE_cc(SLM,SLM2)
-
-! print*,'ATMSENDSLM back from ASSEMBLE_cc'
-
-!--> cpl deletion
-!d call CMP_SEND(SLM,N2D)
-!<-- cpl deletion
-
-! print*,'ATMSENDSLM to return'
-
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_GETSSTICE
- >(TSEA,TISFC,FICE,HICE,SHELEG,SLMSK,kdt)
-
- USE ATM_cc, ONLY: kind_REAL,lonr,latd,Coupler_id,N2D,latg,lonf
-
- USE SURFACE_cc, ONLY:
- > lgetSSTICE_cc,kind_SST,kind_SLMSK,ISLM_FG,
- >SST_cc, SLM_OS_value,unrealistically_low_SST,
- >SST_ave,lsout_cc_momocn,dta2dto_cc,i_dto2dta_cc
-
- implicit none
-
- integer kdt
- real (kind=kind_SST),dimension(lonr,latd),intent(inout) :: TSEA,
- > TISFC, FICE, HICE, SHELEG
- real,dimension(:,:),allocatable :: FICE_cc,HICE_cc,
- > HSNO_cc
- real (kind=kind_SLMSK) SLMSK(lonr,latd)
-
- logical RECV
-
- real, PARAMETER:: RLAPSE=0.65E-2
- real, PARAMETER:: CIMIN=0.15, HIMIN=0.10, HIMAX=8.0, TFW=271.2
- real, PARAMETER:: DS=330.0
-
- integer i,j
-!
-
- RECV=lgetSSTICE_cc
-
- allocate(FICE_cc(lonr,latd),HICE_cc(lonr,latd),
- > HSNO_cc(lonr,latd) )
-
-! print *,' AM: in ATM_GETSST RECV=',RECV,' coupler_id=',coupler_id
-
- if (RECV) then
- call ATM_ANNOUNCE('ATM_GETSSTICE: to receive SST',2)
- call ATM_TILES_RECV(SST_cc,fval=unrealistically_low_SST,iord=2)
- call ATM_ANNOUNCE('ATM_GETSSTICE: SST received',2)
-
-!
- call ATM_ANNOUNCE('ATM_GETSSTICE: to receive FICE',2)
- call ATM_TILES_RECV(FICE_cc,iord=2)
- call ATM_ANNOUNCE('ATM_GETSSTICE: FICE received',2)
-
- call ATM_ANNOUNCE('ATM_GETSSTICE: to receive HICE',2)
- call ATM_TILES_RECV(HICE_cc,iord=2)
- call ATM_ANNOUNCE('ATM_GETSSTICE: HICE received',2)
-
- call ATM_ANNOUNCE('ATM_GETSSTICE: to receive HSNO',2)
- call ATM_TILES_RECV(HSNO_cc,iord=2)
- call ATM_ANNOUNCE('ATM_GETSSTICE: HSNO received',2)
-
- end if
-
- if (Coupler_id.lt.0) return ! <- standalone mode
-
- if (RECV .and. kdt > 1) then
-
- SST_ave=SST_ave+SST_cc
- do j=1,latd
- do i=1,lonr
- if (abs(SLMSK(i,j)-SLM_OS_value).lt.0.01) then
- if (FICE_cc(i,j).GE.CIMIN) then
- SLMSK(i,j)=2.0
- FICE(i,j)=FICE_cc(i,j)
- HICE(i,j)=MAX(MIN(HICE_cc(i,j)/FICE_cc(i,j),HIMAX),HIMIN)
- SHELEG(i,j)=HSNO_cc(i,j)*DS
- TISFC(i,j)=(TSEA(i,j)-(1.-FICE_cc(i,j))*TFW)/FICE_cc(i,j)
- end if
- else if (SLMSK(i,j).GT.1.5) then
- if (FICE_cc(i,j).GE.CIMIN) then
- FICE(i,j)=FICE_cc(i,j)
- HICE(i,j)=MAX(MIN(HICE_cc(i,j)/FICE_cc(i,j),HIMAX),HIMIN)
- SHELEG(i,j)=HSNO_cc(i,j)*DS
- TSEA(i,j)=TISFC(i,j)*FICE_cc(i,j)+TFW*(1.-FICE_cc(i,j))
- else
- FICE(i,j)=0.0
- HICE(i,j)=0.0
- SHELEG(i,j)=0.0
- TSEA(i,j)=TFW
- TISFC(i,j)=TFW
- SLMSK(i,j)=0.0
- end if
- else
- FICE(i,j)=0.0
- HICE(i,j)=0.0
- end if
- end do
- end do
-
- endif
-
- if (lsout_cc_momocn) then
- if(kdt > i_dto2dta_cc) then
-! print *,'AM: sst_ave=',sst_ave(1,1),' dta2dto_cc=',dta2dto_cc
- SST_ave=SST_ave*dta2dto_cc
- do j=1,latd
- do i=1,lonr
- if (abs(SLMSK(i,j)-SLM_OS_value).lt.0.01) then
- if (SST_ave(i,j).gt.unrealistically_low_SST)
- & TSEA(i,j) = SST_ave(i,j)
- end if
- end do
- end do
- SST_ave=0.
- else
- SST_ave=0.
- endif
- endif
-
- deallocate(FICE_cc)
- deallocate(HICE_cc)
- deallocate(HSNO_cc)
-
- contains
-
- SUBROUTINE ATM_TILES_RECV(f,fval,iord)
-
- implicit none
- real (kind=kind_REAL) f(lonr,latd)
- real,optional,intent(in) :: fval
- integer,optional,intent(in) :: iord
-
- real (kind=kind_REAL) f1(lonr,latd)
- real (kind=kind_REAL) x(lonf,latg)
- integer kmsk(lonr,latd),i,j,iiord,ik
-!
-
- if (Coupler_id.lt.0) return ! <- standalone mode
-
-! print *,' AM: In ATM_TILES_RECV F=',f(1,1),' lonr=',lonr,latd
-
- call CMP_RECV(x,N2D)
-
-! print *,' AM: After CMP_RECV in ATM_TILES_RECV N2D=',N2D
-! &,' x=',x(1,1)
-
- call DISASSEMBLE_cc(x,f1)
-
- kmsk=ISLM_FG
- ik=0
- if ( present(fval) )then
- do j=1,latd
- do i=1,lonr
- if (f1(i,j).le.fval) kmsk(i,j)=1
- if (f1(i,j).le.fval) ik=ik+1
- end do
- end do
- endif
- if ( present(iord) ) then
- iiord=iord
- else
- iiord=2
- endif
- call interpred_cc(iiord,kmsk,f1,f)
- ! <- interpolation TO reduced grid (i.e. with # of
- ! longitudes varying from lat. circle to lat. circle)
- ! from full grid
-
- END subroutine ATM_TILES_RECV
-
- END subroutine
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_ANNOUNCE(s,DbgLev)
-
- USE ATM_cc, ONLY: nunit_announce_cc,VerbLev
-
- implicit none
-
- character*(*) s
- integer DbgLev
-!
- if (DbgLev.le.VerbLev)
- > CALL CMP_ANNOUNCE(nunit_announce_cc,'AM: '//s)
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_DBG1(KDT,s,DbgLev)
-
- USE ATM_cc, ONLY: nunit_announce_cc,VerbLev
- USE SURFACE_cc
-
- implicit none
-
- integer KDT
- character*(*) s
- integer DbgLev
-!
- if (DbgLev.gt.VerbLev) RETURN
-
-!--> cpl change: write lsout_cc_momice and lsout_cc_momocn <--
- write(s_cc,'("'//trim(s)//
- >': KDT=",i8," lsout_cc_momice=",L1,
- >" lsout_cc_momocn=",L1," lgetSSTICE_cc=",L1)'
- >) KDT,lsout_cc_momice,lsout_cc_momocn,lgetSSTICE_cc
-
- CALL CMP_ANNOUNCE(nunit_announce_cc,'AM: DBG1: '//s_cc)
-
- return
- END
-!
-!***********************************************************************
-!
- SUBROUTINE ATM_DBG2(KDT,PHOUR,ZHOUR,SHOUR,DbgLev)
-
- USE ATM_cc, ONLY: nunit_announce_cc,VerbLev
- USE SURFACE_cc
-
- implicit none
-
- integer KDT
- real PHOUR,ZHOUR,SHOUR
- integer DbgLev
-!
-! print*,'AM: ATM_DBG2 entered'
-
- if (DbgLev.gt.VerbLev) RETURN
-
-! print*,'AM: ATM_DBG2 to do write(s_cc, ...'
-
-!--> cpl change: write lsout_cc_momice and lsout_cc_momocn <--
-!
- write(s_cc,'("do_tstep entry",i6," KDT=",i8,'//
- >'" PHOUR,ZHOUR,SHOUR: ",1p,3e15.7,0p," lsout_cc_momice=",L1,'//
- >'" lsout_cc_momocn=",L1,'//
- >'" lgetSSTICE_cc=",L1)') n_do_tstep_cc,KDT,PHOUR,ZHOUR,SHOUR,
- > lsout_cc_momice,lsout_cc_momocn,lgetSSTICE_cc
-
- CALL CMP_ANNOUNCE(nunit_announce_cc,'AM: DBG2: '//s_cc)
-
- return
- END
-!
-!***********************************************************************
-!
- subroutine ATM_TSTEP_INIT(KDT)
-
- USE namelist_def, ONLY: lssav
- USE SURFACE_cc
-
- implicit none
-
- integer KDT
-!
-
- call ATM_ANNOUNCE('DOTSTEP entered, in ATM_TSTEP_INIT',3)
- n_do_tstep_cc=n_do_tstep_cc+1
- lssav_cc=lssav
- l_df_cc=.not.lssav ! - double-check
-!--> cpl deletion
-!d lsout_cc=(MOD(KDT,i_dtc2dta_cc).eq.0) ! <- still double-check
-!d > .and. .not. l_df_cc
-!<-- cpl deletion
-!--> cpl insertion
- lsout_cc_momice=(MOD(KDT,max(1,i_dtc2dta_cc)).eq.0) ! <- still double-check
- > .and. .not. l_df_cc ! <- instantaneous vars
- lsout_cc_momocn=(MOD(KDT,max(1,i_dto2dta_cc)).eq.0) ! <- still double-check
- > .and. .not. l_df_cc
-!<-- cpl insertion
- lgetSSTICE_cc=MOD(KDT,max(1,i_dtc2dta_cc)).eq.0 !-check!
- > .and. .not. l_df_cc
-
- if (kdt == 1) then
- print *,'in ATM initial,kdt=',kdt,'dtc/dta=', i_dtc2dta_cc,
- > 'dto/dta=',i_dto2dta_cc,'lsout_cc_momice=',
- > lsout_cc_momice,
- > 'lsout_cc_momocn=',lsout_cc_momocn,'lgetSSTICE_cc=',
- & lgetSSTICE_cc,'lssav=',lssav,MOD(KDT,max(1,i_dtc2dta_cc))
- > ,MOD(KDT,max(1,i_dto2dta_cc))
- endif
- return
- end
-!
-!***********************************************************************
-!
- subroutine ATM_SENDFLUXES(SLMSK)
-
- USE ATM_cc, ONLY: lonr,latd
-
- USE SURFACE_cc
-
- implicit none
-
- real (kind=kind_SLMSK) SLMSK(lonr,latd)
- integer i,j
-!
-
-!--> cpl insertion: send model vars first to coupler
- if (lsout_cc_momice) then
- call ATM_ANNOUNCE('to send T_SFC',2)
- call ATM_SENDFLUX(T_SFC_cc)
- call ATM_ANNOUNCE('to send T_BOT',2)
-! print *,'SEND FLUXES, T_BOt(1:10)=',T_BOT_cc(1:10,1)
- call ATM_SENDFLUX(T_BOT_cc)
- call ATM_ANNOUNCE('to send U_BOT',2)
- call ATM_SENDFLUX(U_BOT_cc)
- call ATM_ANNOUNCE('to send V_BOT',2)
- call ATM_SENDFLUX(V_BOT_cc)
- call ATM_ANNOUNCE('to send Q_BOT',2)
- call ATM_SENDFLUX(Q_BOT_cc)
- call ATM_ANNOUNCE('to send P_BOT',2)
- call ATM_SENDFLUX(P_BOT_cc)
- call ATM_ANNOUNCE('to send P_SURF',2)
- call ATM_SENDFLUX(P_SURF_cc)
- call ATM_ANNOUNCE('to send Z_BOT',2)
- call ATM_SENDFLUX(Z_BOT_cc)
- call ATM_ANNOUNCE('to send XMU',2)
- call ATM_SENDFLUX(XMU_cc)
- call ATM_ANNOUNCE('to send DLW',2)
- call ATM_SENDFLUX(DLW_cc)
- call ATM_ANNOUNCE('to send DSW',2)
- call ATM_SENDFLUX(DSW_cc)
- call ATM_ANNOUNCE('to send ffmm',2)
- call ATM_SENDFLUX(ffmm_cc)
- call ATM_ANNOUNCE('to send ffhh',2)
- call ATM_SENDFLUX(ffhh_cc)
- call ATM_ANNOUNCE('end of send variables',2)
-
- call atm_maxmin(lonr,latd,SNW_cc,'in ATM, snw_cc')
-
- SNW_cc(:,:)=SNW_cc(:,:)/dt_cc*1.E3
- call atm_maxmin(lonr,latd,SNW_cc,'in ATM,2 snw_cc')
-
- call ATM_SENDFLUX(SNW_cc)
- call ATM_ANNOUNCE('precip SNW sent',2)
-
- LPREC_cc(:,:)=LPREC_cc(:,:)/dt_cc*1.E3
- call atm_maxmin(lonr,latd,LPREC_cc,'in ATM,2 lprec_cc')
- call ATM_SENDFLUX(LPREC_cc)
- call ATM_ANNOUNCE('liquid precip sent',2)
-
-! Sending original hice and fice
-!
- call ATM_SENDFLUX(FICE_SFC_cc)
- call ATM_ANNOUNCE('to send fice',2)
- call ATM_SENDFLUX(HICE_SFC_cc)
- call ATM_ANNOUNCE('to send hice',2)
-!
-
- T_BOT_cc=0.
- U_BOT_cc=0.
- V_BOT_cc=0.
- Q_BOT_cc=0.
- P_BOT_cc=0.
- P_SURF_cc=0.
- Z_BOT_cc=0.
- T_SFC_cc=0.
- XMU_cc=0.
- DSW_cc=0.
- DLW_cc=0.
- ffmm_cc=0.
- ffhh_cc=0.
- snw_cc=0.
- lprec_cc=0.
- endif
-!<-- cpl insertion
-
- if (lsout_cc_momocn) then
- DUSFC_cc=-DUSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
- DVSFC_cc=-DVSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
- DTSFC_cc=DTSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
- DQSFC_cc=DQSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
- DLWSFC_cc=DLWSFC_cc*dta2dto_cc !-------, *const*ps may be needed
- ULWSFC_cc=ULWSFC_cc*dta2dto_cc !-------, *const*ps may be needed
- SWSFC_cc=-SWSFC_cc*dta2dto_cc !chk units, *const*ps may be needed
- PRECR_cc=PRECR_cc/dto_cc ! assign dt_cc -- OM time step
- ! <- (above, it was "AM" instead of
- ! OM in the commentary - apparently
- ! by mistake or misprint, but it
- ! resulted in actual assignment of
- ! AM time step to dt_cc)
- > *1.E3 ! <- don't know why. See treatment of
- ! GESHEM in wrtsfc.f, wrtsfc_comm.f (7/16/04)
- call ATM_ANNOUNCE('to send fluxes',2)
- call ATM_SENDFLUX(DUSFC_cc,SLMSK=SLMSK)
- call ATM_ANNOUNCE('x-stress sent',2)
- call ATM_SENDFLUX(DVSFC_cc,SLMSK=SLMSK)
- call ATM_ANNOUNCE('y-stress sent',2)
-! DTSFC_cc=DTSFC_cc+DQSFC_cc-DLWSFC_cc+ULWSFC_cc+SWSFC_cc
- DTSFC_cc=DTSFC_cc
- call ATM_SENDFLUX(DTSFC_cc,SLMSK=SLMSK)
- call ATM_ANNOUNCE('Q (net heat flux) sent',2)
-! DQSFC_cc=DQSFC_cc/hvap_cc-PRECR_cc
- DQSFC_cc=DQSFC_cc/hvap_cc
- call ATM_SENDFLUX(DQSFC_cc,SLMSK=SLMSK)
- call ATM_ANNOUNCE('E-P sent',2)
-!
- DLWSFC_cc=DLWSFC_cc-ULWSFC_cc
- call ATM_SENDFLUX(DLWSFC_cc,SLMSK=SLMSK)
- call ATM_ANNOUNCE('net LWR sent',2)
- call ATM_SENDFLUX(SWSFC_cc,SLMSK=SLMSK)
- call ATM_ANNOUNCE('net SWR sent',2)
-!XW call ATM_SENDFLUX(PRECR_cc,SLMSK=SLMSK)
-!XW call ATM_ANNOUNCE('PRECIP sent',2)
-!
- call ATM_ANNOUNCE('fluxes sent',2)
- DUSFC_cc=0.
- DVSFC_cc=0.
- DTSFC_cc=0.
- DQSFC_cc=0.
- PRECR_cc=0.
- DLWSFC_cc=0.
- ULWSFC_cc=0.
- SWSFC_cc=0.
- end if
-
- contains
-!===
- SUBROUTINE ATM_SENDFLUX(f,SLMSK)
-
- USE ATM_cc
-
- USE SURFACE_cc, ONLY: ISLM_RG,
- >kind_sfcflux,kind_SLMSK,SLM_OS_value,
- >unrealistically_low_SV,unrealistically_low_SVp
-
- implicit none
-
- real (kind=kind_sfcflux),intent(in) :: f(lonr,latd)
-!--> cpl deletion
-! real (kind=kind_SLMSK) SLMSK(lonr,latd)
-!<-- cpl deletion
- real (kind=kind_SLMSK),optional,intent(in) :: SLMSK(lonr,latd)
-
- real(kind=kind_REAL), dimension(lonr,latd):: f1,f2
- real (kind=kind_REAL) x(lonf,latg)
- integer kmsk(lonr,latd)
- integer iord /2/
- integer i,j
- character*40 s
-!
-
- if (Coupler_id.lt.0) return ! <- standalone mode
-
- f1(:,:)=f(:,:)
- kmsk=ISLM_RG
-
-! ISLM_RG is local (per process) mask array that is
-! CONSTANT in time. It contains 0 for either open sea (OS) or
-! sea ice (SI) and 1 for land (L). KEEP IN MIND: it's on REDUCED G.
-
-!--> cpl insertion
- if ( present(SLMSK) ) then
-!<-- cpl insertion
- do j=1,latd
- do i=1,lonr
-! if (abs(SLMSK(i,j)-SLM_OS_value).lt.0.01) then
-! ! i.e. if it is OS (open sea) AMGP
- if (abs(SLMSK(i,j)-2.).lt.1.E-5 ! sea ice
- > .or. abs(SLMSK(i,j)).lt.1.E-5) then ! open sea AM
- kmsk(i,j)=0
- else
- kmsk(i,j)=1
- end if
- end do
- end do
-
- endif
-
-! SLMSK is (per-process-) local mask array regularly updated
-! with sea ice data
-
- call uninterpred_cc(iord,kmsk,f1,f2)
- ! <- interpolation FROM reduced grid (i.e. with # of
- ! longitudes varying from lat. circle to lat. circle)
- ! to full grid
-!
-! print *,'in SEND_FLUX, before assemble_cc'
- call ASSEMBLE_cc(x,f2)
-
-! print *,'in SEND_FLUX, testing, x=',x(1:5,1),'f=',f(1:5,1),
-! > 'f1=',f1(1:5,1),'f2=',f2(1:5,1)
- call CMP_SEND(x,N2D)
-
- END subroutine ATM_SENDFLUX
-
- end subroutine
-! ******************************************************************
- subroutine atm_maxmin(xdim,ydim,x,s)
-
- USE ATM_cc
-
- implicit none
-
- integer xdim,ydim,i,j
- real(kind=kind_REAL) x(xdim,ydim),xmax,xmin
- character(*) s
-
- xmax=x(1,1)
- xmin=x(1,1)
- do j=1,ydim
- do i=1,xdim
- if ( xmax .lt. x(i,j) ) xmax=x(i,j)
- if ( xmin .gt. x(i,j) ) xmin=x(i,j)
- enddo
- enddo
-! print *,s//' in atm_maxmin,xdim=',xdim,'ydim=',ydim,
-! > 'xmax=',xmax,'xmin=',xmin
-
- return
- end
-! ******************************************************************
- subroutine atm_maxmin_int(xdim,ydim,x,s)
-
- USE ATM_cc
-
- implicit none
-
- integer xdim,ydim,i,j
- integer x(xdim,ydim),xmax,xmin
- character(*) s
-
- xmax=x(1,1)
- xmin=x(1,1)
- do j=1,ydim
- do i=1,xdim
- if ( xmax .lt. x(i,j) ) xmax=x(i,j)
- if ( xmin .gt. x(i,j) ) xmin=x(i,j)
- enddo
- enddo
- print *,s//' in atm_maxmin,xdim=',xdim,'ydim=',ydim,
- > 'xmax=',xmax,'xmin=',xmin
-
- return
- end
-
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/dotstep.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/dotstep.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/dotstep.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,384 +0,0 @@
-!--This subroutine is modified based on NCEP/GFS dotstep_tracers.f
-! for running MPAS with GFS physics.
-!
-!=========================================================================
- SUBROUTINE do_tstep_gfs(hprim_mpas,
- & flx_mpas,nst_mpas,sfc_mpas,air_mpas,
- & dt_mpas,kdt_mpas,fhour_mpas,idate_mpas,levs_mpas,
- & ncell_mpas,nair_mpas,xlat_mpas,
- & xlon_mpas,nodes_mpas,node0_mpas,nlunit_mpas,
- & gfs_namelist_mpas)
-!=========================================================================
-!!
-#include "f_hpm.h"
- use machine , only : kind_evod,kind_phys,kind_rad
- use resol_def , only : latr,latg,levh,levs,
- & lonr,lonf,lsoil,nfxr,nmtvr,
- & ntoz,ntrac,ncld,num_p2d,num_p3d
- use layout1 , only : lats_node_r,ipt_lats_node_r,
- & me,nodes
- use vert_def , only : am,bm,si,sl,sv,tov
- use date_def , only : fhour,idate,shour,spdmax
- use namelist_def , only : adiab,fhcyc,filta,mom4ice,
- & ldiag3d,lsfwd,lslwr,lsswr,
- & lggfs3d,fhgoc3d,ialb,nst_fcst,
- & ngptc,nscyc,nsres,nszer
-! use mpi_def , only : icolor,kind_mpi,liope,
-! & mc_comp,mpi_r_mpi
- use ozne_def , only : latsozp,levozp,pl_coeff,timeoz
- use Sfc_Flx_ESMFMod
- use Nst_Var_ESMFMod
- use d3d_def
- use gfsmisc_def
- use cmp_comm , only : Coupler_id
-
- use GFS_Initialize_module
-!---------------------------------------------------------------------
-
- IMPLICIT NONE
-!!
- TYPE(Sfc_Var_Data) :: sfc_fld
- TYPE(Flx_Var_Data) :: flx_fld
- TYPE(Nst_Var_Data) :: nst_fld
- TYPE(Sfc_Var_Data) :: sfc_mpas
- TYPE(Flx_Var_Data) :: flx_mpas
- TYPE(Nst_Var_Data) :: nst_mpas
-!!
-!! real(kind_phys), parameter :: pi=3.1415926535897931
-!! integer, parameter :: nmtvr=14
- integer :: IERR,I,J,K,L,LOCL,n,nn
- real*8 :: dt_warm, tem1, tem2
- integer ifirst
- data ifirst /1/
- save ifirst
- logical lprnt
-
-!-----mpas related fileds--------
- integer(kind=kind_io4) :: kdt_mpas,levs_mpas,ncell_mpas,
- & nodes_mpas,node0_mpas,nlunit_mpas,nsfc_mpas,nair_mpas
- integer(kind=kind_io4) :: idate_mpas(4)
- character(len=*) :: gfs_namelist_mpas
-
- 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) :: air_mpas(nair_mpas,ncell_mpas,levs_mpas)
- real(kind=kind_io4) :: hprim_mpas(ncell_mpas,nmtvr)
-
-! --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--------
-
-!****************************************************************************
- lprnt=.false.
- nodes=nodes_mpas
- me=node0_mpas
-
-!---------------
-!--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_mpas(j)
- enddo
- lats_node_r=1 !for MPAS use 1-D block for each task
-
- call GFS_Initialize(fhour_mpas,levs_mpas,ncell_mpas,
- & 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
-
- do j=1,latr
- do i=1,lonr
- sinlat_r2(i,j)=sin(xlat_mpas(i))
- coslat_r2(i,j)=cos(xlat_mpas(i)) !xlat_mpas in radian
- enddo
- enddo
-
- if(lprnt .and. me.eq.0) then
- print*,"idate: ",idate," nmtvr:",nmtvr
- print*,"sinlat_r2: ",sinlat_r2
- print*,"coslat_r2: ",coslat_r2
- endif
-
-
- do j=1,lats_node_r
- do i=1,lonr
- do k=1,nmtvr
- hprime(i,k,j)=hprim_mpas(i,k)
- enddo
- enddo
- enddo
-
-
-!-----allocate air-sea coupling arrays (required by gbphys)
- call ATM_TILES_INIT(lonr,latr,lonf,latg,lats_node_r,
- & ipt_lats_node_r,global_lats_r,lonsperlar)
- CALL ATM_SURF_INIT
- if(lprnt) print*," end of ATM_SURF_INIT"
-
- ifirst=0
- endif
-!---------------
-
- kdt=kdt_mpas
- fhour=fhour_mpas
- phour=fhour_mpas
-
- LSOUT = MOD(KDT,NSOUT) == 0
- LSCCA = MOD(KDT,NSSWR) == 0
- LSSWR = MOD(KDT,NSSWR) == 1
- LSLWR = MOD(KDT,NSLWR) == 1
- if(me.eq.0) then
- print*,"LSOUT,LSCCA,LSSWR,LSLWR",LSOUT,LSCCA,LSSWR,LSLWR
- print*,"nst_fcst",nst_fcst
- endif
-
-!-----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
- mp_pi(i,k,j)= 0.001*air_mpas(1,i,k) !convert pascal to centibar
- enddo
- mp_pi(i,levp1,j)= 0.0 !top of the atmosphere
- do k=1,levs
- 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)= 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
- 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
- sfc_fld=sfc_mpas
-!-----exchange flx and nst state variables between MPAS and GFS
- flx_fld=flx_mpas
- nst_fld=nst_mpas
-
-
-!------------------------------------------------------------
-
-!fy if(.not. adiab) then
-!fy if (nscyc > 0 .and. mod(kdt,nscyc) == 1) then
-!fy CALL gcycle(me,LATS_NODE_R,LONSPERLAR,global_lats_r,
-!fy & ipt_lats_node_r,idate,fhour,fhcyc,
-!fy & XLON ,XLAT , sfc_fld, ialb)
-!fy endif
-!
-!fy if (num_p3d == 3) then ! Ferrier Microphysics initialization
-!fy call init_micro(deltim,lonr,levs,num_p3d,lats_node_r,
-!fy & phy_f3d(1,1,1,1), fhour, me)
-!fy endif
-!fy endif
-!
-
-!fy if (nst_fcst > 1) then ! update TSEA
-!fy if (Coupler_id < 0 .or. .not. mom4ice) then ! Standalone mode
-!fy do j = 1, lats_node_r
-!fy do i = 1, lonr
-!fy if (sfc_fld%slmsk(i,j) == 0 ) then
-!fy dt_warm = (nst_fld%xt(i,j)+nst_fld%xt(i,j))
-!fy & / nst_fld%xz(i,j)
-!fy sfc_fld%TSEA(i,j) = nst_fld%tref(i,j)
-!fy & + dt_warm - nst_fld%dt_cool(i,j)
-!fy & - sfc_fld%oro(i,j)*rlapse
-!fy endif
-!fy enddo
-!fy enddo
-!fy else ! Coupled to MOM4 OM
-!fy tem1 = 0.5 / omz1
-!fy do j = 1, lats_node_r
-!fy do i = 1, lonr
-!fy if (sfc_fld%slmsk(i,j) == 0 ) then
-!fy tem2 = 1.0 / nst_fld%xz(i,j)
-!fy sfc_fld%tsea(i,j) = sfc_fld%tsea(i,j)
-!fy & + sfc_fld%oro(i,j)*rlapse
-!fy dt_warm = (nst_fld%xt(i,j)+nst_fld%xt(i,j)) * tem2
-!fy
-!fy if ( nst_fld%xz(i,j) > omz1) then
-!fy nst_fld%tref(i,j) = sfc_fld%tsea(i,j)
-!fy & - (1.0-0.5*omz1*tem2) * dt_warm
-!fy & + nst_fld%z_c(i,j)*nst_fld%dt_cool(i,j)*tem1
-!fy else
-!fy nst_fld%tref(i,j) = sfc_fld%tsea(i,j)
-!fy & - (nst_fld%xz(i,j)*dt_warm
-!fy & - nst_fld%z_c(i,j)*nst_fld%dt_cool(i,j))*tem1
-!fy endif
-!fy sfc_fld%TSEA(i,j) = nst_fld%tref(i,j)
-!fy & + dt_warm - nst_fld%dt_cool(i,j)
-!fy & - sfc_fld%oro(i,j)*rlapse
-!fy endif
-!fy enddo
-!fy enddo
-!fy endif
-!fy endif
-
- if (lsswr .or. lslwr) then ! Radiation Call!
- if(.not. adiab) then
-
- if(lprnt .and. me.eq.0) then
- print*, "--- call gloopr --- input: "
- print*,"phour,kdt,lonsperlar,global_lats_r,xlon,xlat"
- print*, phour,kdt,lonsperlar,global_lats_r,xlon,xlat
- print*,"sfc_fld%slmsk,sfc_fld%sheleg"
- print*, sfc_fld%slmsk,sfc_fld%sheleg
- print*,"sfc_fld%zorl, sfc_fld%tsea"
- print*, sfc_fld%zorl, sfc_fld%tsea
- print*,"sfc_fld%alvsf, sfc_fld%alnsf, sfc_fld%alvwf"
- print*, sfc_fld%alvsf, sfc_fld%alnsf, sfc_fld%alvwf
- print*,"sfc_fld%alnwf, sfc_fld%facsf, sfc_fld%facwf"
- print*, sfc_fld%alnwf, sfc_fld%facsf, sfc_fld%facwf
- print*,"sfc_fld%cv, sfc_fld%cvt"
- print*, sfc_fld%cv, sfc_fld%cvt
- print*," sfc_fld%cvb, sfc_fld%FICE"
- print*,sfc_fld%cvb, sfc_fld%FICE
- print*,"sfc_fld%tisfc,sfc_fld%sncovr,sfc_fld%snoalb"
- print*,sfc_fld%tisfc,sfc_fld%sncovr,sfc_fld%snoalb
- print*,"hprime", hprime
-! print*,"phy_f3d ", phy_f3d
- print*,"mp_pi ", mp_pi
- print*,"mp_pl ",mp_pl
- print*,"mp_t",mp_t
-! print*,"mp_pi,mp_pl,mp_t,mp_q,mp_w,mp_tr"
-! print*, mp_pi,mp_pl,mp_t,mp_q,mp_w,mp_tr
-! print*,"fluxr"
-! print*, fluxr
- endif
-
- print*,"--calling gloopr--"
- 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)
-
- if(lprnt .and. me.eq.0) then
- print*, "--- gloopr output---"
- print*,"k, swh "
- do k=1,levs
- print*,k,(swh(i,k,1),i=1,ncell_mpas)
- enddo
- print*,"k, hlw "
- do k=1,levs
- print*,k,(hlw(i,k,1),i=1,ncell_mpas)
- enddo
- print*,"coszdg, flx_fld%coszen, flx_fld%sfcnsw"
- print*,coszdg, flx_fld%coszen, flx_fld%sfcnsw
- print*,"flx_fld%sfcdlw, flx_fld%tsflw"
- print*,flx_fld%sfcdlw, flx_fld%tsflw
- print*,"flx_fld%sfcdsw, sfalb, flx_fld%sfcemis"
- print*,flx_fld%sfcdsw, sfalb, flx_fld%sfcemis
- print*,"slag,sdec,cdec: ", slag,sdec,cdec
- endif
-
- endif
- endif !sswr .or. lslwr
-
-
-
- if(.not. adiab) then
- print*,"--calling gloopb--"
- 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
-!
-
-!--------------------------------------------------
-!-----send atmospheric state variables back to driver
- do j=1,lats_node_r
- do i=1,lonr
- do k=1,levs
- 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
-!-----send flx and nst state variables back to driver
- flx_mpas=flx_fld
- nst_mpas=nst_fld
-
-
- deallocate (mp_pi,mp_pl,mp_t,mp_u,mp_v,mp_w)
- deallocate (mp_q,mp_tr)
-
- RETURN
- END
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/driver_gfscolumn.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/driver_gfscolumn.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/driver_gfscolumn.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,513 +0,0 @@
-!--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
- use Nst_Var_ESMFMod
- implicit none
- include 'mpif.h'
-
-!----------------------------------------------------------
-!--gfs initial condition dimensions
-! integer, parameter :: nlat=880, nlon=1760, levs=64 !T574
-! integer, parameter :: nlat=94, nlon=192, levs=64 !T62
- integer, parameter :: levs=64
- integer, parameter :: lsoil=4, nmtvr=14
- integer, parameter :: nsfc=47, nsig=11
-
-!--fields included in GFS analysis siganl. ss2gg iss used to
-!--convert 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_io4), allocatable :: hs(:,:), ps(:,:)
- real(kind=kind_io4), allocatable :: sigini(:,:,:,:)
-
-!--fields included in GFS analysis sfcanl. sfc2gg is used to
-!--convert 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
- real(kind=kind_io4), allocatable :: sfcini(:,:,:)
-!
-!--mountain variance and orientation etc
- real(kind=kind_io4), allocatable :: hprime0(:,:,:)
-!
- real(kind=kind_phys),allocatable :: latgfs(:),longfs(:)
-!-------------------------------------------------------------
-
-!--column model parameters and arrays
-
-! integer, parameter :: ncell=10, nair=9
- integer, parameter :: nair=9
- TYPE(Sfc_Var_Data) :: sfc_mpas
- TYPE(Flx_Var_Data) :: flx_mpas
- TYPE(Nst_Var_Data) :: nst_mpas
-
- integer(kind=kind_io4) :: kdt,nodes,node0,nlunit
- integer(kind=kind_io4) :: idate(4)
- character(len=80) :: gfs_namelist
- real(kind=kind_phys) :: dt, fhour, fhend
-
- real(kind=kind_phys), allocatable :: xlat(:) !in radian
- real(kind=kind_phys), allocatable :: xlon(:) !in radian
- real(kind=kind_phys), allocatable :: air_mpas(:,:,:)
- real(kind=kind_io4), allocatable :: hprim_mpas(:,:)
-
- real(kind=kind_phys) :: pi
- integer :: i,j,k,m,n, ierr, nkdt,irec
- logical :: lprnt
- integer :: numtasks,taskid
-
-!-------------------------------------------------------------
- integer :: iargc
- external :: iargc
- integer :: nargs ! number of command-line arguments
- character*70 :: argument ! space for command-line argument
- integer :: jcap, cdate, ncell ,nlat, nlon
-
- nargs = iargc() ! iargc() - number of argument after .exe
- if (nargs.lt.4) then
- write(*,*)'usage : gfscolumn.exe jcap cdate, ncell, fhend'
- call abort
- endif
- call getarg(1,argument); read(argument,*) jcap
- call getarg(2,argument); read(argument,*) cdate
- call getarg(3,argument); read(argument,*) ncell
- call getarg(4,argument); read(argument,*) fhend !forecast hours
-
- if (jcap.eq.574) then
- nlon=1760; nlat=880
- elseif (jcap.eq.382) then
- nlon=1152; nlat=576
- elseif (jcap.eq.126) then
- nlon=384; nlat=190
- elseif (jcap.eq.62) then
- nlon=192; nlat=94
- else
- write(*,*) "JCAP is not valid. stop"
- call abort
- endif
-
- allocate ( hs(nlon,nlat), ps(nlon,nlat) )
- allocate ( sigini(nlon,nlat,levs,nsig) )
- allocate ( sfcini(nlon,nlat,nsfc) )
- allocate ( hprime0(nlon,nlat,nmtvr) )
- allocate ( latgfs(nlat),longfs(nlon) )
-
- allocate ( xlat(ncell), xlon(ncell) )
- allocate ( air_mpas(nair,ncell,levs) )
- allocate ( hprim_mpas(ncell,nmtvr) )
-
-
-!--GFS initial condition date, 1-hour,2-month,3-day,4-year
- idate(4)=cdate/1000000
- idate(2)=mod(cdate,1000000)/10000
- idate(3)=mod(cdate,10000)/100
- idate(1)=mod(cdate,100)
- print*,"cdate: ",cdate
- print*,"yyyy mm dd hh:",idate(4),idate(2),idate(3),idate(1)
-
-!-------------------------------------------------------------
-
- call MPI_INIT( ierr )
- call MPI_COMM_RANK( MPI_COMM_WORLD, taskid, ierr )
- call MPI_COMM_SIZE( MPI_COMM_WORLD, numtasks, ierr )
- print *, 'task ID= ',taskid, 'numtasks=',numtasks
- if (taskid.eq.0) then
-
- pi=4.0*atan(1.0)
- lprnt=.false.
-
-!-------------------------------------------
-!! read in air and surface initial conditions
- open(11,file="sig_ini",form="unformatted",status="unknown",
- & access="direct",recl=nlat*nlon*4)
- open(12,file="sfc_ini",form="unformatted",status="unknown")
- print*, "open sig_ini and sfc_ini"
-
- irec=1
- read(11,rec=irec) (( hs(i,j),i=1,nlon),j=1,nlat)
- irec=irec+1
- read(11,rec=irec) (( ps(i,j),i=1,nlon),j=1,nlat)
- do n=1,nsig
- do k=1,levs
- irec=irec+1
- read(11,rec=irec) (( sigini(i,j,k,n),i=1,nlon),j=1,nlat)
- enddo
- enddo
- do n=1,nsfc
- read(12) (( sfcini(i,j,n),i=1,nlon),j=1,nlat)
- enddo
-
-!--mountain variance etc
- read(24) hprime0
-
-!! GFS latidue and longitude grids
- open(13,file="nlat_points.txt",
- & form="formatted",status="unknown")
- read(13,'(5f12.6)') (latgfs(j),j=nlat,1,-1)
- do i=1,nlon
- longfs(i)=360.0/nlon*(i-1)
- enddo
-
-! if(lprnt) print*, "latgfs= ",latgfs
-! if(lprnt) print*, "longfs= ",longfs
-!---------------------------------------------
-!! pick selected points from GFS global initial
-!! conditions and pass them to the column model
-
-!-- define and allocate space for sfc_mpas and flx_mpas for column model
- call sfcvar_aldata(ncell,1,lsoil,sfc_mpas,ierr)
- call flxvar_aldata(ncell,1,flx_mpas,ierr)
- call flx_init(flx_mpas,ierr)
-
-!-- define and allocate space for nst_mpas for column model (not used)
- call nstvar_aldata(ncell,1,nst_mpas,ierr)
- call nst_init(nst_mpas,ierr)
-
- do n=1,ncell
- i=min(1.0*nlon,nlon/2+0.5*nlon/ncell*(n-1))
- j=min(1.0*nlat,nlat/4+0.5*nlat/ncell*(n-1))
-
- xlat(n)=latgfs(j)/180*pi
- xlon(n)=longfs(i)/180*pi
- print*, "lat,lon: ",latgfs(j),longfs(i)
-
-!--mountain variance etc
- do k=1,nmtvr
- hprim_mpas(n,k)=hprime0(i,j,k)
- enddo
-
-!--upper air variables
- air_mpas(1,n,1)=ps(i,j) !interface pressure in pasca
- do k=2,levs
- air_mpas(1,n,k)=air_mpas(1,n,k-1) - sigini(i,j,k-1,2)
- enddo
- do k=1,levs
- air_mpas(2,n,k)=sigini(i,j,k,1) !integer-layer pressure in pasca
- air_mpas(3,n,k)=sigini(i,j,k,6) !integer-layer zonal wind in m/s
- air_mpas(4,n,k)=sigini(i,j,k,7) !integer-layer meridional wind in m/s
- air_mpas(5,n,k)=0.0 !integer-layer vertical velocity in pa/s
- air_mpas(6,n,k)=sigini(i,j,k,3) !integer-layer temperature in K
- air_mpas(7,n,k)=sigini(i,j,k,4) !integer-layer specific humidity in kg/kg
- air_mpas(8,n,k)=sigini(i,j,k,10) !integer-layer ozone mixing ratio in kg/kg
- air_mpas(9,n,k)=sigini(i,j,k,11) !integer-layer cloud water mixing ratio in kg/kg
- enddo
-
- if(lprnt) then
- print*, "n,i,j",n,i,j, " xlat,xlon ",xlat(ncell), xlon(ncell)
- print*, "pi: ",(air_mpas(1,n,k),k=1,levs)
- print*, "pl: ",(air_mpas(2,n,k),k=1,levs)
- print*, air_mpas(3,n,1), air_mpas(4,n,1),
- & air_mpas(5,n,1), air_mpas(6,n,1), air_mpas(7,n,1),
- & air_mpas(8,n,1), air_mpas(9,n,1)
- print*, "hprim: ",(hprim_mpas(n,k),k=1,nmtvr)
- endif
-
-!--surface variables
- m=1
- sfc_mpas%tsea (n,1) = sfcini(i,j,1)
- do k=1,lsoil
- m=m+1
- sfc_mpas%smc (n,k,1) = sfcini(i,j,m)
- enddo
- m=m+1
- sfc_mpas%sheleg (n,1) = sfcini(i,j,m)
- do k=1,lsoil
- m=m+1
- sfc_mpas%stc (n,k,1) = sfcini(i,j,m)
- enddo
- m=m+1
- sfc_mpas%tg3 (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%zorl (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%cv (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%cvb (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%cvt (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%alvsf (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%alvwf (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%alnsf (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%alnwf (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%slmsk (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%vfrac (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%canopy (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%f10m (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%vtype (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%stype (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%facsf (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%facwf (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%uustar (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%ffmm (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%ffhh (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%hice (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%fice (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%tprcp (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%srflag (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%snwdph (n,1) = sfcini(i,j,m)
- do k=1,lsoil
- m=m+1
- sfc_mpas%slc (n,k,1) = sfcini(i,j,m)
- enddo
- m=m+1
- sfc_mpas%shdmin (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%shdmax (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%slope (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%snoalb (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%oro (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%t2m (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%q2m (n,1) = sfcini(i,j,m)
- m=m+1
- sfc_mpas%tisfc (n,1) = sfcini(i,j,m)
-
-! print*, "m=",m, " nsfc=",nsfc
- if(m.ne.nsfc) then
- print*, "m != nsfc, exit "
- call abort
- endif
-
- enddo
-!---------------------------------------------
-
-!---------------------------------------------
-!---------------------------------------------
-!! call column model, integration over time
-
- dt=120 !time step in seconds
- nkdt=fhend*3600/dt+1
- nodes=1
- node0=taskid
- nlunit=99 !unit for reading gfs_namelis
- gfs_namelist="gfs_namelist"
-
- do 100 kdt=1,nkdt
- fhour=(kdt-1)*dt/3600.0
-
- print*
- print*, "-------------------------------------"
- print*, "kdt=",kdt, " dt=",dt, " fhour=",fhour
- print*, "-------------------------------------"
-
-
-!--column model output
- call column_wrt(nair,levs,ncell,air_mpas,sfc_mpas,flx_mpas)
-
- call do_tstep_gfs(hprim_mpas,
- & flx_mpas,nst_mpas,sfc_mpas,air_mpas,
- & dt,kdt,fhour,idate,levs,
- & ncell,nair,xlat,
- & xlon,nodes,node0,nlunit,
- & gfs_namelist)
- 100 continue
-
-
- endif
- call MPI_FINALIZE(ierr)
-
-
- deallocate ( hs,ps,sigini,sfcini,hprime0,latgfs,longfs )
- deallocate ( xlat,xlon,air_mpas,hprim_mpas)
- END
-
-
-!-----------------------------------------------------------------------
-!-----------------------------------------------------------------------
-!write column output in real*4 binary format
- subroutine column_wrt(nair,levs,ncell,air_mpas,sfc_mpas,flx_mpas)
-
- use machine, only : kind_phys
- use Sfc_Flx_ESMFMod
-
- IMPLICIT NONE
- TYPE(Sfc_Var_Data) :: sfc_mpas
- TYPE(Flx_Var_Data) :: flx_mpas
-
- integer, parameter :: lsoil=4
- integer :: i,j,k,ncell,nair,levs
- real(kind=kind_phys) :: air_mpas(nair,ncell,levs)
- real*4 :: buff4(ncell)
- logical :: first
- data first /.true./
- save first
-
- if(first) then
- open(191,file="gfscolumn_air.bin",
- & form="unformatted",status="unknown")
- open(192,file="gfscolumn_sfc.bin",
- & form="unformatted",status="unknown")
- open(193,file="gfscolumn_flx.bin",
- & form="unformatted",status="unknown")
- first=.false.
- endif
-
-!--upper air variables
- do j=1,nair
- do k=1,levs
- buff4(:)=air_mpas(j,:,k); write(191) buff4
- enddo
- enddo
-
-
-!--surface variables
- buff4(:)=sfc_mpas%tsea(:,1); write(192)buff4
- do k=1,lsoil
- buff4(:)=sfc_mpas%smc(:,k,1); write(192)buff4
- enddo
- buff4(:)=sfc_mpas%sheleg(:,1); write(192)buff4
- do k=1,lsoil
- buff4(:)=sfc_mpas%stc(:,k,1); write(192)buff4
- enddo
- buff4(:)=sfc_mpas%tg3(:,1); write(192)buff4
- buff4(:)=sfc_mpas%zorl (:,1); write(192)buff4
- buff4(:)=sfc_mpas%cv (:,1); write(192)buff4
- buff4(:)=sfc_mpas%cvb (:,1); write(192)buff4
- buff4(:)=sfc_mpas%cvt (:,1); write(192)buff4
- buff4(:)=sfc_mpas%alvsf (:,1); write(192)buff4
- buff4(:)=sfc_mpas%alvwf (:,1); write(192)buff4
- buff4(:)=sfc_mpas%alnsf (:,1); write(192)buff4
- buff4(:)=sfc_mpas%alnwf (:,1); write(192)buff4
- buff4(:)=sfc_mpas%slmsk (:,1); write(192)buff4
- buff4(:)=sfc_mpas%vfrac (:,1); write(192)buff4
- buff4(:)=sfc_mpas%canopy (:,1); write(192)buff4
- buff4(:)=sfc_mpas%f10m (:,1); write(192)buff4
- buff4(:)=sfc_mpas%vtype (:,1); write(192)buff4
- buff4(:)=sfc_mpas%stype (:,1); write(192)buff4
- buff4(:)=sfc_mpas%facsf (:,1); write(192)buff4
- buff4(:)=sfc_mpas%facwf (:,1); write(192)buff4
- buff4(:)=sfc_mpas%uustar (:,1); write(192)buff4
- buff4(:)=sfc_mpas%ffmm (:,1); write(192)buff4
- buff4(:)=sfc_mpas%ffhh (:,1); write(192)buff4
- buff4(:)=sfc_mpas%hice (:,1); write(192)buff4
- buff4(:)=sfc_mpas%fice (:,1); write(192)buff4
- buff4(:)=sfc_mpas%tprcp (:,1); write(192)buff4
- buff4(:)=sfc_mpas%srflag (:,1); write(192)buff4
- buff4(:)=sfc_mpas%snwdph (:,1); write(192)buff4
- do k=1,lsoil
- buff4(:)=sfc_mpas%slc(:,k,1); write(192)buff4
- enddo
- buff4(:)=sfc_mpas%shdmin (:,1); write(192)buff4
- buff4(:)=sfc_mpas%shdmax (:,1); write(192)buff4
- buff4(:)=sfc_mpas%slope (:,1); write(192)buff4
- buff4(:)=sfc_mpas%snoalb (:,1); write(192)buff4
- buff4(:)=sfc_mpas%oro (:,1); write(192)buff4
- buff4(:)=sfc_mpas%t2m (:,1); write(192)buff4
- buff4(:)=sfc_mpas%q2m (:,1); write(192)buff4
- buff4(:)=sfc_mpas%tisfc (:,1); write(192)buff4
-
-
-!--flux variables
- buff4(:)=flx_mpas%SFCDSW (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%COSZEN (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%PWAT (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%TMPMIN (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%TMPMAX (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SPFHMIN (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SPFHMAX (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DUSFC (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DVSFC (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DTSFC (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DQSFC (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DLWSFC (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%ULWSFC (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%GFLUX (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%RUNOFF (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%EP (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%CLDWRK (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DUGWD (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DVGWD (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%PSMEAN (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%GESHEM (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%BENGSH (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SFCNSW (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SFCDLW (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%TSFLW (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%PSURF (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%U10M (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%V10M (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%HPBL (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%CHH (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%CMM (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%EPI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DLWSFCI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%ULWSFCI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%USWSFCI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DSWSFCI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DTSFCI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%DQSFCI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%GFLUXI (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SRUNOFF (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%T1 (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%Q1 (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%U1 (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%V1 (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%ZLVL (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%EVBSA (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%EVCWA (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%TRANSA (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SBSNOA (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SNOWCA (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SOILM (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SNOHFA (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SMCWLT2 (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%SMCREF2 (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%suntim (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%sfcemis (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%gsoil (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%gtmp2m (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%gustar (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%gpblh (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%gu10m (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%gv10m (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%gzorl (:,1) ;write(193)buff4
- buff4(:)=flx_mpas%goro (:,1) ;write(193)buff4
-
-
- end subroutine column_wrt
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/fix_fields.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/fix_fields.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/fix_fields.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,145 +0,0 @@
-!--modified to only read OZONE
-
- SUBROUTINE fix_fields(OZPLIN)
-!fy & LONSPERLAR,GLOBAL_LATS_R,XLON,XLAT,sfc_fld,
-!fy & nst_fld,HPRIME,JINDX1,JINDX2,DDY,OZPLIN)
-!fy & CREAD,CREAD_NST)
-!!
- use machine , only : kind_rad
- use funcphys
- use module_progtm
- use resol_def
- use namelist_def
- use layout1
- use ozne_def
-!fy use Sfc_Flx_ESMFMod
-!fy use Nst_Var_ESMFMod
- IMPLICIT NONE
-!!
-!fy INTEGER NREAD, NREAD_NST
-!fy TYPE(Sfc_Var_Data) :: sfc_fld
-!fy TYPE(Nst_Var_Data) :: nst_fld
-!fy CHARACTER (len=*) :: CREAD
-!fy CHARACTER (len=*) :: CREAD_NST
-!fy INTEGER JINDX1(LATS_NODE_R),JINDX2(LATS_NODE_R)
-!fy REAL (KIND=KIND_RAD) DDY(LATS_NODE_R)
-!fy REAL (KIND=KIND_RAD) HPRIME(LONR,NMTVR,LATS_NODE_R)
-
- INTEGER IOZONDP
- REAL (kind=kind_rad) OZPLIN(LATSOZP,LEVOZP,pl_coeff,timeoz)
-!fy &, XLON(LONR,LATS_NODE_R)
-!fy &, XLAT(LONR,LATS_NODE_R)
-
-!fy INTEGER GLOBAL_LATS_R(LATR)
-!fy INTEGER LONSPERLAR(LATR)
-!fy real, PARAMETER:: RLAPSE=0.65E-2
-!fy real dt_warm
-!fy integer needoro, i, j
-!!
-!fy call gfuncphys
-!fy if (lsm == 0) then ! For OSU LSM
-!fy CALL GRDDF
-!fy CALL GRDKT
-!fy endif
-!!
- IOZONDP = 0
- if (ntoz .gt. 0) IOZONDP = 1
-
-!fy NREAD = 14
-! CREAD = 'fort.14'
-!fy sfc_fld%ORO = 0.
-!fy NEEDORO = 0
-!fy if(.not.adiab)then
-!fy if (fhini == fhrot) then
-!fy if (me == 0) print *,' call read_sfc CREAD=',cread
-!fy CALL read_sfc(sfc_fld,NEEDORO,NREAD,
-!fy & CREAD,GLOBAL_LATS_R,LONSPERLAR)
-!fy
-!fy if (nst_fcst > 0) then
-!fy if (me == 0) print *,' call read_nst nst_spinup : ',
-!fy & nst_spinup
-!fy nst_fld%slmsk = sfc_fld%slmsk
-!fy if ( nst_spinup ) then
-!fy CALL set_nst(sfc_fld%tsea,nst_fld)
-!fy else
-!fy NREAD_NST = 15
-!fy CALL read_nst(nst_fld,NREAD_NST,CREAD_NST,
-!fy & GLOBAL_LATS_R,LONSPERLAR)
-!fy if ( nst_fcst > 1 ) then
-!fy do j = 1, lats_node_r
-!fy do i = 1, lonr
-!fy if ( sfc_fld%SLMSK(i,j) == 0.0 ) then
-!fy dt_warm = (nst_fld%xt(i,j)+nst_fld%xt(i,j))
-!fy & / nst_fld%xz(i,j)
-!fy sfc_fld%TSEA(i,j) = nst_fld%Tref(i,j)
-!fy & + dt_warm - nst_fld%dt_cool(i,j)
-!fy & - sfc_fld%oro(i,j) * rlapse
-!fy endif
-!fy enddo
-!fy enddo
-!fy
-!fy When AM and NST is not coupled, tsea (in surface file) ==> tref
-!fy
-!fy elseif (nst_fcst == 1) then
-!fy nst_fld%tref = sfc_fld%tsea
-!fy endif
-!fy
-!fy Reset the non-water points, since no mask (sea ice) update for nstanl file
-!fy done at present
-!fy
-!fy call nst_reset_nonwater(sfc_fld%tsea,nst_fld)
-!fy endif ! if ( nst_spinup ) then
-!fy endif ! if ( nst_fcst > 0 ) then
-!fy else
-!fy if (me .eq. 0) print *,' CALL read_sfc_r CREAD=',cread
-!fy CALL read_sfc_r(sfc_fld,NEEDORO,NREAD,
-!fy & CREAD,GLOBAL_LATS_R,LONSPERLAR)
-!fy
-!fy if ( nst_fcst > 0 ) then
-!fy nst_fld%slmsk = sfc_fld%slmsk
-!fy NREAD_NST = 15
-!fy if (me .eq. 0) print *,' call read_nst_r CREAD=',cread_nst
-!fy CALL read_nst_r(nst_fld,NREAD_NST,CREAD_NST,
-!fy & GLOBAL_LATS_R,LONSPERLAR)
-!fy endif
-!fy endif
-!fy endif
-
-!fy NEEDORO=1
-!fy CALL read_mtn_hprim_oz(sfc_fld%SLMSK,HPRIME,NEEDORO,sfc_fld%ORO,
-!fy & IOZONDP,OZPLIN, GLOBAL_LATS_R,LONSPERLAR)
-!
- IF (IOZONDP.EQ.1) CALL READOZ_DISPRD(OZPLIN)
-!fy CALL SETINDXOZ(LATS_NODE_R,LATS_NODE_R,GLOBAL_LATS_R,
-!fy & JINDX1,JINDX2,DDY)
-!
-!fy CALL LONLAT_PARA(GLOBAL_LATS_R,XLON,XLAT,LONSPERLAR)
-!!
- RETURN
- END
-
-
-!------------------------------------
- SUBROUTINE readoz_disprd(ozplin)
-
- use resol_def
- use layout1
- use ozne_def
- implicit none
-!!
- integer n,k,kk,i
- real (kind=kind_phys) ozplin(latsozp,levozp,pl_coeff,timeoz)
- real(kind=kind_io4) tempin(latsozp)
-!
- DO I=1,timeoz
- do n=1,pl_coeff
- DO k=1,levozp
- READ(kozpl) tempin
- ozplin(:,k,n,i) = tempin(:)
- ENDDO
- enddo
- ENDDO
-
- RETURN
- END
-
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/flowchat.txt
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/flowchat.txt 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/flowchat.txt 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,68 +0,0 @@
-#--interface connecting MPAS and GFS phyiscs
-
- SUBROUTINE do_tstep_gfs(maps%sfc,mpas%air,mpas%dt,mpas%kdt,mpas%fhour, &
- & mpas%date,mpas%levs,mpas%ncell,mpas%xlat,mpas%xlon )
-
-
- IF (FIRST .OR. KDT=1) THEN
-!-- define GFS dynamic arrays
- real (kind=kind_phys), allocatable :: gfs_var(:,:,:)
- .............
-
-!-- read in GFS namelist and define model parameters
- call compns(..............)
-
-!-- override GFS grid structure with MPAS grid structure
- LONR=ncell
- lats_node_r=1
- levs=mpas%levs
- do j=1,lats_node_r
- do i=1,LONR
- xlat(i,j)=mpas%xlat(i)
- xlon(i,j)=mpas%xlon(i)
- enddo
-
-!-- allocate GFS arrays
- allocate ( gfs_var(lonr,lats_node_r,levs) )
- ENDIF
-
-!-- pass MPAS data to gfsarray
- gfs_var=mpas_var
-
-!-- call GFS surface cycle to update boundary conditions
-! (can be delayed to a later stage)
- if (nscyc > 0 .and. mod(kdt,nscyc) == 1) then
- CALL gcycle(me,LATS_NODE_R,LONSPERLAR,global_lats_r ...)
- endif
-
-
-!-- call GFS radiaiton gloopr module.
-! gloopr will be modified to remove 1) GFS spectra-to-grid conversion,
-! 2) setups for different vertical coordinates and dynamic cores.
-! gloopr will update aerosol, CO2 and other trace gases concentration
-! will update astronomical parameters
- if (lsswr .or. lslwr) then
- call gloopr (phour,xlon,xlat,coszdg,flx_fld%coszen .....)
- endif !sswr .or. lslwr
-
-
-!-- call GFS physical module gloopb
-! gloopb will be modified to remove 1) GFS spectra-to-grid conversion,
-! 2) setups for different vertical coordinates and dynamic cores,
-! 3) output routines.
-! gloopb will update model state variables using radiaiton and physics
-! tendencies.
- call gloopb (deltim,phour,sfc_fld, flx_fld, SFALB, xlon .....)
-
-
-!-- pass GFS arrays back to MPAS arrays
- mpas_var=gfs_var
-
-
- end module
-
-
-
-
-
- end do_tstep_gfs
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gfsmisc_def.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gfsmisc_def.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gfsmisc_def.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,28 +0,0 @@
- module gfsmisc_def
- use machine
-
- implicit none
- save
-
- logical, parameter :: fix_ncld_hr=.true.
- integer, parameter :: nrcmax=30 ! Maximum number of random clouds per 1200s
- real, parameter :: rlapse=0.65e-2, omz1=10.0
-
- real (kind=kind_ior) :: CONS0, CONS0P5, CONS1200, CONS3600
- real (kind=kind_phys) :: pdryini
- real (kind=kind_evod) :: phour,zhour,deltim
- real (kind=kind_evod) :: slag,sdec,cdec,batah
- integer :: kdt,iret,iprint,MAXSTP
- logical :: lsout
-
- integer, allocatable :: lonsperlar(:),global_lats_r(:)
- integer, allocatable :: jindx1(:),jindx2(:)
- real, allocatable :: ozplin(:,:,:,:) !OZONE PL Coeff
- real (kind=kind_phys), allocatable :: xlat(:,:), xlon(:,:),
- & coszdg(:,:), hprime(:,:,:), fluxr(:,:,:), sfalb(:,:),
- & swh(:,:,:), hlw(:,:,:),
- & sinlat_r2(:,:),coslat_r2(:,:)
- real (kind=kind_phys), allocatable :: phy_f3d(:,:,:,:),
- & phy_f2d(:,:,:), ddy(:), fscav(:)
-
- end module gfsmisc_def
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopb.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopb.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopb.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,700 +0,0 @@
-!--modeified for MPAS, Fanglin Yang, May 2012
-!
- subroutine gloopb
- & (phour,kdt,tstep,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)
-!!
-#include "f_hpm.h"
-!!
- use machine , only : kind_evod,kind_phys,kind_rad
- use resol_def , only : jcap,latr,levs,lonr,
- & lsoil,ncld,nmtvr,nrcm,ntcw,ntoz,
- & ntrac,num_p2d,num_p3d,
- & thermodyn_id,sfcpress_id,nfxr
-
- use layout1 , only : ipt_lats_node_r,
- & lat1s_r,lats_dim_r,
- & lats_node_a,lats_node_r,
- & me,nodes
- 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,ras,
- & hybrid,ldiag3d,lscca,lsfwd,
- & lsm,lssav,lsswr,ncw,ngptc,
- & old_monin,pre_rad,random_clds,
- & sashal,ctei_rm,mom4ice,newsas,
- & ccwf,cnvgwd,lggfs3d,trans_trac,
- & mstrat,cal_pre,nst_fcst,
- & dlqf,moist_adj,cdmbgwd,
- & bkgd_vdif_m, bkgd_vdif_h,
- & bkgd_vdif_s,shal_cnv,
- & psautco, prautco, evpco, wminco
- use module_ras , only : ras_init
- use physcons , only : grav => con_g,
- & 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
-
-!-> 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
-
- 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)
-
-! --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
-!
- 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)
- real(kind=kind_phys) prsik(ngptc,levs+1),phil(ngptc,levs)
-!!
- real (kind=kind_phys) gu(ngptc,levs), gv1(ngptc,levs)
- real (kind=kind_phys) ugrd(ngptc,levs),vgrd(ngptc,levs)
- 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) sumq(ngptc,levs), xcp(ngptc,levs)
-!
- real (kind=kind_phys) dt3dt_v(ngptc,levs,6),
- & dq3dt_v(ngptc,levs,5+pl_coeff),
- & du3dt_v(ngptc,levs,4),
- & dv3dt_v(ngptc,levs,4)
- &, 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_phys) exp,dtphys,dtp,dtf,sumed(2)
- real (kind=kind_evod) tstep
- real (kind=kind_phys) pdryini,sigshc,rk
-!!
- integer id,njeff,lon,kdt
- integer dimg
-
- integer i,ierr,iter,j,k,kap,kar,kat,kau,kav,ksq,jj,kk
- integer kst,kdtphi,kdtlam ! hmhj
- integer l,lan,lat,lmax,locl,ii,lonrbm
-! integer lon_dim,lons_lat,n,node
- integer lons_lat,n,node
- integer nsphys
-!
- real(kind=kind_evod) pwatg(latr),pwatj(lats_node_r),
- & pwatp,ptotg(latr),sumwa,sumto,
- & ptotj(lats_node_r),pcorr,pdryg,
- & solhr,clstp
- real(kind=kind_evod) cons0,cons2 !constant
-
- logical lsout
- logical, parameter :: flipv = .true.
-
-! 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
- real ddy(lats_node_r) !for ozone interpolaton
-!fy real ozplout(levozp,lats_node_r,pl_coeff)
- real ozplout(lonr,levozp,pl_coeff,lats_node_r)
-!!
- real(kind=kind_phys), allocatable :: acv(:,:),acvb(:,:),acvt(:,:)
- save acv,acvb,acvt
-!!
- integer, parameter :: maxran=6000, maxsub=6, maxrs=maxran/maxsub
- type (random_stat) :: stat(maxrs)
- real (kind=kind_phys), allocatable, save :: rannum_tank(:,:,:)
- real (kind=kind_phys) :: rannum(lonr*latr)
- integer iseed, nrc, seed0, kss, ksr, indxr(nrcm), iseedl
- integer nf0,nf1,ind,nt,indod,indev
- real(kind=kind_evod) fd2, wrk(1), wrk2(nrcm)
-
- logical first,ladj
- parameter (ladj=.true.)
- data first/.true./
- save first, seed0
-!!
- integer nlons_v(ngptc)
- real(kind=kind_phys) smc_v(ngptc,lsoil),stc_v(ngptc,lsoil)
- &, slc_v(ngptc,lsoil)
- &, swh_v(ngptc,levs), hlw_v(ngptc,levs)
- &, vvel(ngptc,levs)
- &, hprime_v(ngptc,nmtvr)
- real(kind=kind_phys) phy_f3dv(ngptc,LEVS,num_p3d),
- & phy_f2dv(ngptc,num_p2d)
- &, 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)
-! real (kind=kind_rad) rcs_v(ngptc), rqtk(ngptc)
-!
-!--------------------------------------------------------------------
-
-! real(kind=kind_evod) sinlat_v(lonr),coslat_v(lonr),rcs2_v(lonr)
-! real(kind=kind_phys) dpshc(lonr)
- real (kind=kind_rad) work1, qmin, tem
- 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
- integer :: ipt
- logical :: lprnt
-
- lprnt = .false.
-!
-!
-!----------------------
- if (first) then
-!----------------------
-
- allocate (acv(lonr,lats_node_r))
- allocate (acvb(lonr,lats_node_r))
- allocate (acvt(lonr,lats_node_r))
-!
- seed0 = idate(1) + idate(2) + idate(3) + idate(4)
- call random_setseed(seed0)
- call random_number(wrk)
- seed0 = seed0 + nint(wrk(1)*1000.0)
-!
- if (.not. newsas) then ! random number needed for RAS and old SAS
- if (random_clds) then ! create random number tank
-! -------------------------
- if (.not. allocated(rannum_tank))
- & allocate (rannum_tank(lonr,maxran,lats_node_r))
-! lonrb2 = lonr / 2
- lonrbm = lonr / maxsub
- if (me == 0) write(0,*)' maxran=',maxran,' maxrs=',maxrs,
- & 'maxsub=',maxsub,' lonrbm=',lonrbm
-!$OMP parallel do private(nrc,iseedl,rannum,lat,i,j,k,ii,jj,kk)
- do nrc=1,maxrs
- iseedl = seed0 + nrc - 1
- call random_setseed(iseedl,stat(nrc))
- call random_number(rannum,stat(nrc))
- do j=1,lats_node_r
- lat = global_lats_r(ipt_lats_node_r-1+j)
- jj = (lat-1)*lonr
- do k=1,maxsub
- kk = k - 1
- do i=1,lonr
- ii = kk*lonrbm + i
- if (ii > lonr) ii = ii - lonr
- rannum_tank(i,nrc+kk*maxrs,j) = rannum(ii+jj)
- enddo
- enddo
- enddo
- enddo
- endif
- endif
-!
- if (me .eq. 0) then
- print *,' seed0=',seed0,' idate=',idate,' wrk=',wrk
- if (num_p3d .eq. 3) print *,' USING Ferrier-MICROPHYSICS'
- if (num_p3d .eq. 4) print *,' USING ZHAO-MICROPHYSICS'
- endif
- if (fhour .eq. 0.0) then
- do j=1,lats_node_r
- do i=1,lonr
-! phy_f2d(i,j,num_p2d) = 0.0
- phy_f2d(i,num_p2d,j) = 0.0
- enddo
- enddo
- endif
-
- if (ras) call ras_init(levs, me)
-
- first = .false.
-!----------------------
- endif ! if (first) done
-!----------------------
-!
- dtphys = 3600.
- nsphys = max(int((tstep+tstep)/dtphys+0.9999),1)
- dtp = (tstep+tstep)/nsphys
- dtf = 0.5*dtp
-!
- if(lsfwd) dtf = dtp
-!
- solhr = mod(phour+idate(1),cons_24)
-
-! ************** Ken Campana Stuff ********************************
-!... set switch for saving convective clouds
- if(lscca.and.lsswr) then
- clstp = 1100+min(fhswr,fhour,cons_99) !initialize,accumulate,convert
- elseif(lscca) then
- clstp = 0100+min(fhswr,fhour,cons_99) !accumulate,convert
- elseif(lsswr) then
- clstp = 1100 !initialize,accumulate
- else
- clstp = 0100 !accumulate
- endif
-! ************** Ken Campana Stuff ********************************
-!
-!
- iseed = mod(100.0*sqrt(fhour*3600),cons_1p0d9) + 1 + seed0
-
-
- if (.not. newsas) then ! random number needed for RAS and old SAS
- if (random_clds) then
- call random_setseed(iseed)
- call random_number(wrk2)
- do nrc=1,nrcm
- indxr(nrc) = max(1, min(nint(wrk2(nrc)*maxran)+1,maxran))
- enddo
- endif
- endif
-!
-! doing ozone i/o and latitudinal interpolation to local gauss lats
-! ifozphys=.true.
-
- if (ntoz .gt. 0) then
-!fy call ozinterpol(me,lats_node_r,lats_node_r,idate,fhour,
-!fy & jindx1,jindx2,ozplin,ozplout,ddy)
- call ozintp_pnt(me,lonr,lats_node_r,xlon,xlat,
- & idate,fhour,ozplin,ozplout)
-
-!Moor call ozinterpol(lats_node_r,lats_node_r,idate,fhour,
-! & jindx1,jindx2,ozplin,ozplout,ddy,
-! & global_lats_r,lonsperlar)
- endif
-
-! if (me == 0) write(0,*)' after ozinterpol'
-!!
- 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.
-
- if (lprnt) print*, "me, lat, lons_lat:",me, lat,lons_lat
-
-!$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,gt,gr,vvel)
-!$omp+private(adt,adr,adu,adv,pgr,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)
-
- do lon=1,lons_lat,ngptc
-!!
- njeff = min(ngptc,lons_lat-lon+1)
-!!
-
- 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.0e-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
- enddo
- enddo
-
- 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_r2(lon+i-1,lan)
- coslat_v(i) = coslat_r2(lon+i-1,lan)
- 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
- prsik(i,1) = 0.0 ! forces calculation of geopotential in gbphys
- enddo
- endif
-!
- if (ntoz .gt. 0) then
- do j=1,pl_coeff
- do k=1,levozp
- do i=1,njeff
- ozplout_v(i,k,j) = ozplout(lon+i-1,k,j,lan)
-!fy ozplout_v(i,k,j) = ozplout(k,lan,j)
- enddo
- enddo
- enddo
- endif
- do k=1,lsoil
- do i=1,njeff
- item = lon+i-1
- smc_v(i,k) = sfc_fld%smc(item,k,lan)
- stc_v(i,k) = sfc_fld%stc(item,k,lan)
- slc_v(i,k) = sfc_fld%slc(item,k,lan)
- enddo
- enddo
- do k=1,nmtvr
- do i=1,njeff
- hprime_v(i,k) = hprime(lon+i-1,k,lan)
- enddo
- enddo
-!!
- do j=1,num_p3d
- do k=1,levs
- do i=1,njeff
- phy_f3dv(i,k,j) = phy_f3d(lon+i-1,k,j,lan)
- enddo
- enddo
- enddo
- do j=1,num_p2d
- do i=1,njeff
- phy_f2dv(i,j) = phy_f2d(lon+i-1,j,lan)
- enddo
- enddo
- if (.not. newsas) then
- if (random_clds) then
- do j=1,nrcm
- do i=1,njeff
- rannum_v(i,j) = rannum_tank(lon+i-1,indxr(j),lan)
- enddo
- enddo
- else
- do j=1,nrcm
- do i=1,njeff
- rannum_v(i,j) = 0.6 ! This is useful for debugging
- enddo
- enddo
- endif
- endif
- do k=1,levs
- do i=1,njeff
- item = lon+i-1
- swh_v(i,k) = swh(item,k,lan)
- hlw_v(i,k) = hlw(item,k,lan)
- enddo
- enddo
- if (ldiag3d) then
- do n=1,6
- do k=1,levs
- do i=1,njeff
- dt3dt_v(i,k,n) = dt3dt(lon+i-1,k,n,lan)
- enddo
- enddo
- enddo
- do n=1,4
- do k=1,levs
- do i=1,njeff
- du3dt_v(i,k,n) = du3dt(lon+i-1,k,n,lan)
- dv3dt_v(i,k,n) = dv3dt(lon+i-1,k,n,lan)
- enddo
- enddo
- enddo
- endif
- if (ldiag3d .or. lggfs3d) then
- do n=1,5+pl_coeff
- do k=1,levs
- do i=1,njeff
- dq3dt_v(i,k,n) = dq3dt(lon+i-1,k,n,lan)
- enddo
- enddo
- enddo
- do k=1,levs
- do i=1,njeff
- upd_mf_v(i,k) = upd_mf(lon+i-1,k,lan)
- dwn_mf_v(i,k) = dwn_mf(lon+i-1,k,lan)
- det_mf_v(i,k) = det_mf(lon+i-1,k,lan)
- enddo
- enddo
- endif
- if (lggfs3d) then
- do k=1,levs
- do i=1,njeff
- dkh_v(i,k) = dkh(lon+i-1,k,lan)
- rnp_v(i,k) = rnp(lon+i-1,k,lan)
- enddo
- enddo
- endif
-!
-! write(0,*)' calling gbphys kdt=',kdt,' lon=',lon,' lan=',lan
-! &,' nlons_v=',ntoz,ntcw,nmtvr,lonr,latr,jcap,ras
-! &,' tisfc=',sfc_fld%tisfc(lon,lan)
-! print *,' temp=',for_gr_r_2(lon,kst,lan)
-!
-
- call gbphys &
-! --- inputs:
- & ( njeff,ngptc,levs,lsoil,lsm,ntrac,ncld,ntoz,ntcw, &
- & nmtvr,nrcm,levozp,lonr,latr,jcap,num_p3d,num_p2d, &
- & kdt,lat,me,pl_coeff,nlons_v,ncw,flgmin,crtrh,cdmbgwd, &
- & ccwf,dlqf,ctei_rm,clstp,dtp,dtf,fhour,solhr, &
- & slag,sdec,cdec,sinlat_v,coslat_v,pgr,ugrd,vgrd, &
- & gt,gr,vvel,prsi,prsl,prslk,prsik,phii,phil, &
- & rannum_v,ozplout_v,pl_pres,dpshc, &
- & hprime_v, xlon(lon,lan),xlat(lon,lan), &
- & sfc_fld%slope (lon,lan), sfc_fld%shdmin(lon,lan), &
- & sfc_fld%shdmax(lon,lan), sfc_fld%snoalb(lon,lan), &
- & sfc_fld%tg3 (lon,lan), sfc_fld%slmsk (lon,lan), &
- & sfc_fld%vfrac (lon,lan), sfc_fld%vtype (lon,lan), &
- & sfc_fld%stype (lon,lan), sfc_fld%uustar(lon,lan), &
- & sfc_fld%oro (lon,lan), flx_fld%coszen(lon,lan), &
- & flx_fld%sfcdsw(lon,lan), flx_fld%sfcnsw(lon,lan), &
- & flx_fld%sfcdlw(lon,lan), flx_fld%tsflw (lon,lan), &
- & flx_fld%sfcemis(lon,lan), sfalb(lon,lan), &
- & swh_v, hlw_v, &
- & ras,pre_rad,ldiag3d,lggfs3d,lssav,lssav_cc, &
- & bkgd_vdif_m,bkgd_vdif_h,bkgd_vdif_s,psautco,prautco, evpco, &
- & wminco, &
- & flipv,old_monin,cnvgwd,shal_cnv,sashal,newsas,cal_pre, &
- & mom4ice,mstrat,trans_trac,nst_fcst,moist_adj,fscav, &
- & thermodyn_id, sfcpress_id, gen_coord_hybrid, &
-! --- input/outputs:
- & sfc_fld%hice (lon,lan), sfc_fld%fice (lon,lan), &
- & sfc_fld%tisfc (lon,lan), sfc_fld%tsea (lon,lan), &
- & sfc_fld%tprcp (lon,lan), sfc_fld%cv (lon,lan), &
- & sfc_fld%cvb (lon,lan), sfc_fld%cvt (lon,lan), &
- & sfc_fld%srflag(lon,lan), sfc_fld%snwdph(lon,lan), &
- & sfc_fld%sheleg(lon,lan), sfc_fld%sncovr(lon,lan), &
- & sfc_fld%zorl (lon,lan), sfc_fld%canopy(lon,lan), &
- & sfc_fld%ffmm (lon,lan), sfc_fld%ffhh (lon,lan), &
- & sfc_fld%f10m (lon,lan), flx_fld%srunoff(lon,lan), &
- & flx_fld%evbsa (lon,lan), flx_fld%evcwa (lon,lan), &
- & flx_fld%snohfa(lon,lan), flx_fld%transa(lon,lan), &
- & flx_fld%sbsnoa(lon,lan), flx_fld%snowca(lon,lan), &
- & flx_fld%soilm (lon,lan), flx_fld%tmpmin(lon,lan), &
- & flx_fld%tmpmax(lon,lan), flx_fld%dusfc (lon,lan), &
- & flx_fld%dvsfc (lon,lan), flx_fld%dtsfc (lon,lan), &
- & flx_fld%dqsfc (lon,lan), flx_fld%geshem(lon,lan), &
- & flx_fld%gflux (lon,lan), flx_fld%dlwsfc(lon,lan), &
- & flx_fld%ulwsfc(lon,lan), flx_fld%suntim(lon,lan), &
- & flx_fld%runoff(lon,lan), flx_fld%ep (lon,lan), &
- & flx_fld%cldwrk(lon,lan), flx_fld%dugwd (lon,lan), &
- & flx_fld%dvgwd (lon,lan), flx_fld%psmean(lon,lan), &
- & flx_fld%bengsh(lon,lan), flx_fld%spfhmin(lon,lan), &
- & flx_fld%spfhmax(lon,lan), &
- & dt3dt_v, dq3dt_v, du3dt_v, dv3dt_v, &
- & acv(lon,lan), acvb(lon,lan), acvt(lon,lan), &
- & slc_v, smc_v, stc_v, &
- & upd_mf_v, dwn_mf_v, det_mf_v, dkh_v, rnp_v, &
- & phy_f3dv, phy_f2dv, &
- & DLWSFC_cc(lon,lan), ULWSFC_cc(lon,lan), &
- & DTSFC_cc(lon,lan), SWSFC_cc(lon,lan), &
- & DUSFC_cc(lon,lan), DVSFC_cc(lon,lan), &
- & DQSFC_cc(lon,lan), PRECR_cc(lon,lan), &
-
- & nst_fld%xt(lon,lan), nst_fld%xs(lon,lan), &
- & nst_fld%xu(lon,lan), nst_fld%xv(lon,lan), &
- & nst_fld%xz(lon,lan), nst_fld%zm(lon,lan), &
- & nst_fld%xtts(lon,lan), nst_fld%xzts(lon,lan), &
- & nst_fld%d_conv(lon,lan), nst_fld%ifd(lon,lan), &
- & nst_fld%dt_cool(lon,lan), nst_fld%Qrain(lon,lan), &
-! --- outputs:
- & adt, adr, adu, adv, &
- & sfc_fld%t2m (lon,lan), sfc_fld%q2m (lon,lan), &
- & flx_fld%u10m (lon,lan), flx_fld%v10m (lon,lan), &
- & flx_fld%zlvl (lon,lan), flx_fld%psurf (lon,lan), &
- & flx_fld%hpbl (lon,lan), flx_fld%pwat (lon,lan), &
- & flx_fld%t1 (lon,lan), flx_fld%q1 (lon,lan), &
- & flx_fld%u1 (lon,lan), flx_fld%v1 (lon,lan), &
- & flx_fld%chh (lon,lan), flx_fld%cmm (lon,lan), &
- & flx_fld%dlwsfci(lon,lan), flx_fld%ulwsfci(lon,lan), &
- & flx_fld%dswsfci(lon,lan), flx_fld%uswsfci(lon,lan), &
- & flx_fld%dtsfci(lon,lan), flx_fld%dqsfci(lon,lan), &
- & flx_fld%gfluxi(lon,lan), flx_fld%epi (lon,lan), &
- & flx_fld%smcwlt2(lon,lan), flx_fld%smcref2(lon,lan), &
-!hchuang code change [+3L] 11/12/2007 : add 2D
- & flx_fld%gsoil(lon,lan), flx_fld%gtmp2m(lon,lan), &
- & flx_fld%gustar(lon,lan), flx_fld%gpblh(lon,lan), &
- & flx_fld%gu10m(lon,lan), flx_fld%gv10m(lon,lan), &
- & flx_fld%gzorl(lon,lan), flx_fld%goro(lon,lan), &
-
- & XMU_cc(lon,lan), DLW_cc(lon,lan), DSW_cc(lon,lan), &
- & SNW_cc(lon,lan), LPREC_cc(lon,lan), &
-
- & nst_fld%Tref(lon,lan), nst_fld%z_c(lon,lan), &
- & 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
- & )
-!!
-
-!---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) = adu(j,k)
- mp_v(jtem,k,lan) = adv(j,k)
- mp_t(jtem,k,lan) = adt(j,k)
- mp_q(jtem,k,lan) = adr(j,k,1) !specific humidity
- do n=1,ntrac-1
- mp_tr(jtem,k,n,lan) = adr(j,k,n+1)
- enddo
- enddo
- enddo
-
- do k=1,lsoil
- do i=1,njeff
- item = lon + i - 1
- sfc_fld%smc(item,k,lan) = smc_v(i,k)
- sfc_fld%stc(item,k,lan) = stc_v(i,k)
- sfc_fld%slc(item,k,lan) = slc_v(i,k)
- enddo
- enddo
-!!
- do j=1,num_p3d
- do k=1,levs
- do i=1,njeff
- phy_f3d(lon+i-1,k,j,lan) = phy_f3dv(i,k,j)
- enddo
- enddo
- enddo
- do j=1,num_p2d
- do i=1,njeff
- phy_f2d(lon+i-1,j,lan) = phy_f2dv(i,j)
- enddo
- enddo
-!
- if (ldiag3d) then
- do n=1,6
- do k=1,levs
- do i=1,njeff
- dt3dt(lon+i-1,k,n,lan) = dt3dt_v(i,k,n)
- enddo
- enddo
- enddo
- do n=1,4
- do k=1,levs
- do i=1,njeff
- du3dt(lon+i-1,k,n,lan) = du3dt_v(i,k,n)
- dv3dt(lon+i-1,k,n,lan) = dv3dt_v(i,k,n)
- enddo
- enddo
- enddo
- endif
- if (ldiag3d .or. lggfs3d) then
- do n=1,5+pl_coeff
- do k=1,levs
- do i=1,njeff
- dq3dt(lon+i-1,k,n,lan) = dq3dt_v(i,k,n)
- enddo
- enddo
- enddo
- do k=1,levs
- do i=1,njeff
- upd_mf(lon+i-1,k,lan) = upd_mf_v(i,k)
- dwn_mf(lon+i-1,k,lan) = dwn_mf_v(i,k)
- det_mf(lon+i-1,k,lan) = det_mf_v(i,k)
- enddo
- enddo
- endif
- if (lggfs3d) then
- do k=1,levs
- do i=1,njeff
- dkh(lon+i-1,k,lan) = dkh_v(i,k)
- rnp(lon+i-1,k,lan) = rnp_v(i,k)
- enddo
- enddo
- endif
-!
-!---------------------------
- enddo ! lon loop
-!---------------------------
-!
-!
-! 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 ! lan loop
-!---------------------------
-
- return
- end
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopb.f_debug
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopb.f_debug 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopb.f_debug 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,991 +0,0 @@
-!--modeified for MPAS, Fanglin Yang, May 2012
-!
- subroutine gloopb
- & (phour,kdt,tstep,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)
-!!
-#include "f_hpm.h"
-!!
- use machine , only : kind_evod,kind_phys,kind_rad
- use resol_def , only : jcap,latr,levs,lonr,
- & lsoil,ncld,nmtvr,nrcm,ntcw,ntoz,
- & ntrac,num_p2d,num_p3d,
- & thermodyn_id,sfcpress_id,nfxr
-
- use layout1 , only : ipt_lats_node_r,
- & lat1s_r,lats_dim_r,
- & lats_node_a,lats_node_r,
- & me,nodes
- 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,ras,
- & hybrid,ldiag3d,lscca,lsfwd,
- & lsm,lssav,lsswr,ncw,ngptc,
- & old_monin,pre_rad,random_clds,
- & sashal,ctei_rm,mom4ice,newsas,
- & ccwf,cnvgwd,lggfs3d,trans_trac,
- & mstrat,cal_pre,nst_fcst,
- & dlqf,moist_adj,cdmbgwd,
- & bkgd_vdif_m, bkgd_vdif_h,
- & bkgd_vdif_s,shal_cnv,
- & psautco, prautco, evpco, wminco
- use module_ras , only : ras_init
- use physcons , only : grav => con_g,
- & 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
-
-!-> 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
-
- 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)
-
-! --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
-!
- 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)
- real(kind=kind_phys) prsik(ngptc,levs+1),phil(ngptc,levs)
-!!
- real (kind=kind_phys) gu(ngptc,levs), gv1(ngptc,levs)
- real (kind=kind_phys) ugrd(ngptc,levs),vgrd(ngptc,levs)
- 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) sumq(ngptc,levs), xcp(ngptc,levs)
-!
- real (kind=kind_phys) dt3dt_v(ngptc,levs,6),
- & dq3dt_v(ngptc,levs,5+pl_coeff),
- & du3dt_v(ngptc,levs,4),
- & dv3dt_v(ngptc,levs,4)
- &, 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_phys) exp,dtphys,dtp,dtf,sumed(2)
- real (kind=kind_evod) tstep
- real (kind=kind_phys) pdryini,sigshc,rk
-!!
- integer id,njeff,lon,kdt
- integer dimg
-
- integer i,ierr,iter,j,k,kap,kar,kat,kau,kav,ksq,jj,kk
- integer kst,kdtphi,kdtlam ! hmhj
- integer l,lan,lat,lmax,locl,ii,lonrbm
-! integer lon_dim,lons_lat,n,node
- integer lons_lat,n,node
- integer nsphys
-!
- real(kind=kind_evod) pwatg(latr),pwatj(lats_node_r),
- & pwatp,ptotg(latr),sumwa,sumto,
- & ptotj(lats_node_r),pcorr,pdryg,
- & solhr,clstp
- real(kind=kind_evod) cons0,cons2 !constant
-
- logical lsout
- logical, parameter :: flipv = .true.
-
-! 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
- real ddy(lats_node_r) !for ozone interpolaton
-!fy real ozplout(levozp,lats_node_r,pl_coeff)
- real ozplout(lonr,levozp,pl_coeff,lats_node_r)
-!!
- real(kind=kind_phys), allocatable :: acv(:,:),acvb(:,:),acvt(:,:)
- save acv,acvb,acvt
-!!
- integer, parameter :: maxran=6000, maxsub=6, maxrs=maxran/maxsub
- type (random_stat) :: stat(maxrs)
- real (kind=kind_phys), allocatable, save :: rannum_tank(:,:,:)
- real (kind=kind_phys) :: rannum(lonr*latr)
- integer iseed, nrc, seed0, kss, ksr, indxr(nrcm), iseedl
- integer nf0,nf1,ind,nt,indod,indev
- real(kind=kind_evod) fd2, wrk(1), wrk2(nrcm)
-
- logical first,ladj
- parameter (ladj=.true.)
- data first/.true./
- save first, seed0
-!!
- integer nlons_v(ngptc)
- real(kind=kind_phys) smc_v(ngptc,lsoil),stc_v(ngptc,lsoil)
- &, slc_v(ngptc,lsoil)
- &, swh_v(ngptc,levs), hlw_v(ngptc,levs)
- &, vvel(ngptc,levs)
- &, hprime_v(ngptc,nmtvr)
- real(kind=kind_phys) phy_f3dv(ngptc,LEVS,num_p3d),
- & phy_f2dv(ngptc,num_p2d)
- &, 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)
-! real (kind=kind_rad) rcs_v(ngptc), rqtk(ngptc)
-!
-!--------------------------------------------------------------------
-
-! real(kind=kind_evod) sinlat_v(lonr),coslat_v(lonr),rcs2_v(lonr)
-! real(kind=kind_phys) dpshc(lonr)
- real (kind=kind_rad) work1, qmin, tem
- 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
- integer :: ipt
- logical :: lprnt
-
- lprnt = .true.
-!
-!
-!----------------------
- if (first) then
-!----------------------
-
- allocate (acv(lonr,lats_node_r))
- allocate (acvb(lonr,lats_node_r))
- allocate (acvt(lonr,lats_node_r))
-!
- seed0 = idate(1) + idate(2) + idate(3) + idate(4)
- call random_setseed(seed0)
- call random_number(wrk)
- seed0 = seed0 + nint(wrk(1)*1000.0)
-!
- if (.not. newsas) then ! random number needed for RAS and old SAS
- if (random_clds) then ! create random number tank
-! -------------------------
- if (.not. allocated(rannum_tank))
- & allocate (rannum_tank(lonr,maxran,lats_node_r))
-! lonrb2 = lonr / 2
- lonrbm = lonr / maxsub
- if (me == 0) write(0,*)' maxran=',maxran,' maxrs=',maxrs,
- & 'maxsub=',maxsub,' lonrbm=',lonrbm
-!$OMP parallel do private(nrc,iseedl,rannum,lat,i,j,k,ii,jj,kk)
- do nrc=1,maxrs
- iseedl = seed0 + nrc - 1
- call random_setseed(iseedl,stat(nrc))
- call random_number(rannum,stat(nrc))
- do j=1,lats_node_r
- lat = global_lats_r(ipt_lats_node_r-1+j)
- jj = (lat-1)*lonr
- do k=1,maxsub
- kk = k - 1
- do i=1,lonr
- ii = kk*lonrbm + i
- if (ii > lonr) ii = ii - lonr
- rannum_tank(i,nrc+kk*maxrs,j) = rannum(ii+jj)
- enddo
- enddo
- enddo
- enddo
- endif
- endif
-!
- if (me .eq. 0) then
- print *,' seed0=',seed0,' idate=',idate,' wrk=',wrk
- if (num_p3d .eq. 3) print *,' USING Ferrier-MICROPHYSICS'
- if (num_p3d .eq. 4) print *,' USING ZHAO-MICROPHYSICS'
- endif
- if (fhour .eq. 0.0) then
- do j=1,lats_node_r
- do i=1,lonr
-! phy_f2d(i,j,num_p2d) = 0.0
- phy_f2d(i,num_p2d,j) = 0.0
- enddo
- enddo
- endif
-
- if (ras) call ras_init(levs, me)
-
- first = .false.
-!----------------------
- endif ! if (first) done
-!----------------------
-!
- dtphys = 3600.
- nsphys = max(int((tstep+tstep)/dtphys+0.9999),1)
- dtp = (tstep+tstep)/nsphys
- dtf = 0.5*dtp
-!
- if(lsfwd) dtf = dtp
-!
- solhr = mod(phour+idate(1),cons_24)
-
-! ************** Ken Campana Stuff ********************************
-!... set switch for saving convective clouds
- if(lscca.and.lsswr) then
- clstp = 1100+min(fhswr,fhour,cons_99) !initialize,accumulate,convert
- elseif(lscca) then
- clstp = 0100+min(fhswr,fhour,cons_99) !accumulate,convert
- elseif(lsswr) then
- clstp = 1100 !initialize,accumulate
- else
- clstp = 0100 !accumulate
- endif
-! ************** Ken Campana Stuff ********************************
-!
-!
- iseed = mod(100.0*sqrt(fhour*3600),cons_1p0d9) + 1 + seed0
-
-
- if (.not. newsas) then ! random number needed for RAS and old SAS
- if (random_clds) then
- call random_setseed(iseed)
- call random_number(wrk2)
- do nrc=1,nrcm
- indxr(nrc) = max(1, min(nint(wrk2(nrc)*maxran)+1,maxran))
- enddo
- endif
- endif
-!
-! doing ozone i/o and latitudinal interpolation to local gauss lats
-! ifozphys=.true.
-
- if (ntoz .gt. 0) then
-!fy call ozinterpol(me,lats_node_r,lats_node_r,idate,fhour,
-!fy & jindx1,jindx2,ozplin,ozplout,ddy)
- call ozintp_pnt(me,lonr,lats_node_r,xlon,xlat,
- & idate,fhour,ozplin,ozplout)
-
-!Moor call ozinterpol(lats_node_r,lats_node_r,idate,fhour,
-! & jindx1,jindx2,ozplin,ozplout,ddy,
-! & global_lats_r,lonsperlar)
- endif
-
-! if (me == 0) write(0,*)' after ozinterpol'
-!!
- 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.
-
- if (lprnt) print*, "me, lat, lons_lat:",me, lat,lons_lat
-
-!$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,gt,gr,vvel)
-!$omp+private(adt,adr,adu,adv,pgr,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)
-
- do lon=1,lons_lat,ngptc
-!!
- njeff = min(ngptc,lons_lat-lon+1)
-!!
-! lprnt = .false.
-
- 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.0e-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
- enddo
- enddo
-
- 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_r2(lon+i-1,lan)
- coslat_v(i) = coslat_r2(lon+i-1,lan)
- 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
- prsik(i,1) = 0.0 ! forces calculation of geopotential in gbphys
- enddo
- endif
-!
- if (ntoz .gt. 0) then
- do j=1,pl_coeff
- do k=1,levozp
- do i=1,njeff
- ozplout_v(i,k,j) = ozplout(lon+i-1,k,j,lan)
-!fy ozplout_v(i,k,j) = ozplout(k,lan,j)
- enddo
- enddo
- enddo
- endif
- do k=1,lsoil
- do i=1,njeff
- item = lon+i-1
- smc_v(i,k) = sfc_fld%smc(item,k,lan)
- stc_v(i,k) = sfc_fld%stc(item,k,lan)
- slc_v(i,k) = sfc_fld%slc(item,k,lan)
- enddo
- enddo
- do k=1,nmtvr
- do i=1,njeff
- hprime_v(i,k) = hprime(lon+i-1,k,lan)
- enddo
- enddo
-!!
- do j=1,num_p3d
- do k=1,levs
- do i=1,njeff
- phy_f3dv(i,k,j) = phy_f3d(lon+i-1,k,j,lan)
- enddo
- enddo
- enddo
- do j=1,num_p2d
- do i=1,njeff
- phy_f2dv(i,j) = phy_f2d(lon+i-1,j,lan)
- enddo
- enddo
- if (.not. newsas) then
- if (random_clds) then
- do j=1,nrcm
- do i=1,njeff
- rannum_v(i,j) = rannum_tank(lon+i-1,indxr(j),lan)
- enddo
- enddo
- else
- do j=1,nrcm
- do i=1,njeff
- rannum_v(i,j) = 0.6 ! This is useful for debugging
- enddo
- enddo
- endif
- endif
- do k=1,levs
- do i=1,njeff
- item = lon+i-1
- swh_v(i,k) = swh(item,k,lan)
- hlw_v(i,k) = hlw(item,k,lan)
- enddo
- enddo
- if (ldiag3d) then
- do n=1,6
- do k=1,levs
- do i=1,njeff
- dt3dt_v(i,k,n) = dt3dt(lon+i-1,k,n,lan)
- enddo
- enddo
- enddo
- do n=1,4
- do k=1,levs
- do i=1,njeff
- du3dt_v(i,k,n) = du3dt(lon+i-1,k,n,lan)
- dv3dt_v(i,k,n) = dv3dt(lon+i-1,k,n,lan)
- enddo
- enddo
- enddo
- endif
- if (ldiag3d .or. lggfs3d) then
- do n=1,5+pl_coeff
- do k=1,levs
- do i=1,njeff
- dq3dt_v(i,k,n) = dq3dt(lon+i-1,k,n,lan)
- enddo
- enddo
- enddo
- do k=1,levs
- do i=1,njeff
- upd_mf_v(i,k) = upd_mf(lon+i-1,k,lan)
- dwn_mf_v(i,k) = dwn_mf(lon+i-1,k,lan)
- det_mf_v(i,k) = det_mf(lon+i-1,k,lan)
- enddo
- enddo
- endif
- if (lggfs3d) then
- do k=1,levs
- do i=1,njeff
- dkh_v(i,k) = dkh(lon+i-1,k,lan)
- rnp_v(i,k) = rnp(lon+i-1,k,lan)
- enddo
- enddo
- endif
-!
-! write(0,*)' calling gbphys kdt=',kdt,' lon=',lon,' lan=',lan
-! &,' nlons_v=',ntoz,ntcw,nmtvr,lonr,latr,jcap,ras
-! &,' tisfc=',sfc_fld%tisfc(lon,lan)
-! print *,' temp=',for_gr_r_2(lon,kst,lan)
-!
- if(lprnt) then
- print*," ============ before calling gbphys =============="
- print*," ============ in variables =============="
- print*," lon, lan=", lon,lan
- print*,"njeff,ngptc,levs,lsoil,lsm,ntrac,ncld,ntoz,ntcw, "
- print*, njeff,ngptc,levs,lsoil,lsm,ntrac,ncld,ntoz,ntcw
-
- print*,"nmtvr,nrcm,levozp,lonr,latr,jcap,num_p3d,num_p2d, "
- print*, nmtvr,nrcm,levozp,lonr,latr,jcap,num_p3d,num_p2d
-
- print*,"kdt,lat,me,pl_coeff,nlons_v,ncw,flgmin,crtrh,cdmbgwd,"
- print*, kdt,lat,me,pl_coeff,nlons_v,ncw,flgmin,crtrh,cdmbgwd
-
- print*,"ccwf,dlqf,ctei_rm,clstp,dtp,dtf,fhour,solhr, "
- print*, ccwf,dlqf,ctei_rm,clstp,dtp,dtf,fhour,solhr
-
- print*,"slag,sdec,cdec,sinlat_v,coslat_v ,pgr "
- print*, slag,sdec,cdec,sinlat_v,coslat_v,pgr
-
- print*, " ugrs, vgrs tgrs qgrs "
- do k=1,levs
- print*, ugrd(njeff,k),vgrd(njeff,k),gt(njeff,k)
- enddo
-
- print*, " vvel, prsi,prsl,prslk,"
- do k=1,levs
- print*,vvel(njeff,k),prsi(njeff,k),prsl(njeff,k),prslk(njeff,k)
- enddo
-
- print*, " prsik phii phil"
- do k=1,levs
- print*,prsik(njeff,k),phii(njeff,k),phil(njeff,k)
- enddo
-
-! print*,"rannum_v, ", rannum_v
-! print*,"ozplout_v ", ozplout_v
-
-! print*,"pl_pres,dpshc, "
-! print*,pl_pres,dpshc
-
-! print*,"hprime_v, xlon(njeff,lan),xlat(njeff,lan), "
-! print*, hprime_v, xlon(njeff,lan),xlat(njeff,lan)
-
- print*,"sfc_fld%slope (njeff,lan), sfc_fld%shdmin(njeff,lan),"
- print*, sfc_fld%slope (njeff,lan), sfc_fld%shdmin(njeff,lan)
-
- print*,"sfc_fld%shdmax(njeff,lan), sfc_fld%snoalb(njeff,lan),"
- print*,sfc_fld%shdmax(njeff,lan), sfc_fld%snoalb(njeff,lan)
-
- print*,"sfc_fld%tg3 (njeff,lan), sfc_fld%slmsk (njeff,lan),"
- print*,sfc_fld%tg3 (njeff,lan), sfc_fld%slmsk (njeff,lan)
-
- print*,"sfc_fld%vfrac (njeff,lan), sfc_fld%vtype (njeff,lan),"
- print*,sfc_fld%vfrac (njeff,lan), sfc_fld%vtype (njeff,lan)
-
- print*,"sfc_fld%stype (njeff,lan), sfc_fld%uustar(njeff,lan),"
- print*,sfc_fld%stype (njeff,lan), sfc_fld%uustar(njeff,lan)
-
- print*,"sfc_fld%oro (njeff,lan), flx_fld%coszen(njeff,lan),"
- print*,sfc_fld%oro (njeff,lan), flx_fld%coszen(njeff,lan)
-
- print*,"flx_fld%sfcdsw(njeff,lan), flx_fld%sfcnsw(njeff,lan),"
- print*,flx_fld%sfcdsw(njeff,lan), flx_fld%sfcnsw(njeff,lan)
- print*,"flx_fld%sfcdlw(njeff,lan), flx_fld%tsflw (njeff,lan),"
- print*,flx_fld%sfcdlw(njeff,lan), flx_fld%tsflw (njeff,lan)
-
- print*,"flx_fld%sfcemis(njeff,lan),sfalb(njeff,lan), "
- print*,flx_fld%sfcemis(njeff,lan),sfalb(njeff,lan)
-
-! print*,"swh_v ",swh_v
-! print*,"hlw_v ",hlw_v
-
- print*,"ras,pre_rad,ldiag3d,lggfs3d,lssav,lssav_cc, "
- print*,ras,pre_rad,ldiag3d,lggfs3d,lssav,lssav_cc
-
- print*,"bkgd_vdif_m,bkgd_vdif_h,bkgd_vdif_s,"
- print*,bkgd_vdif_m,bkgd_vdif_h,bkgd_vdif_s
-
- print*,"psautco,prautco, evpco,"
- print*,psautco,prautco, evpco
-
- print*,"wminco, "
- print*,wminco
-
- print*,"flipv,old_monin,cnvgwd,shal_cnv,"
- print*,flipv,old_monin,cnvgwd,shal_cnv
-
- print*,"sashal,newsas,cal_pre,"
- print*,sashal,newsas,cal_pre
-
- print*,"mom4ice,mstrat,trans_trac,nst_fcst,moist_adj,fscav, "
- print*,mom4ice,mstrat,trans_trac,nst_fcst,moist_adj,fscav
-
- print*,"thermodyn_id, sfcpress_id, gen_coord_hybrid, "
- print*,thermodyn_id, sfcpress_id, gen_coord_hybrid
- endif
-
-
- if(lprnt) then
- print*," === inout variables === njeff,lan: ",njeff,lan
-
- print*,"sfc_fld%hice (njeff,lan),sfc_fld%fice (njeff,lan),"
- print*,sfc_fld%hice (njeff,lan),sfc_fld%fice (njeff,lan)
-
- print*,"sfc_fld%tisfc (njeff,lan),sfc_fld%tsea (njeff,lan),"
- print*,sfc_fld%tisfc (njeff,lan),sfc_fld%tsea (njeff,lan)
-
- print*,"sfc_fld%tprcp (njeff,lan),sfc_fld%cv (njeff,lan),"
- print*,sfc_fld%tprcp (njeff,lan),sfc_fld%cv (njeff,lan)
-
- print*,"sfc_fld%cvb (njeff,lan),sfc_fld%cvt (njeff,lan),"
- print*,sfc_fld%cvb (njeff,lan),sfc_fld%cvt (njeff,lan)
-
- print*,"sfc_fld%srflag(njeff,lan),sfc_fld%snwdph(njeff,lan),"
- print*,sfc_fld%srflag(njeff,lan),sfc_fld%snwdph(njeff,lan)
-
- print*,"sfc_fld%sheleg(njeff,lan),sfc_fld%sncovr(njeff,lan),"
- print*,sfc_fld%sheleg(njeff,lan),sfc_fld%sncovr(njeff,lan)
-
- print*,"sfc_fld%zorl (njeff,lan),sfc_fld%canopy(njeff,lan),"
- print*,sfc_fld%zorl (njeff,lan),sfc_fld%canopy(njeff,lan)
-
- print*,"sfc_fld%ffmm (njeff,lan),sfc_fld%ffhh (njeff,lan),"
- print*,sfc_fld%ffmm (njeff,lan),sfc_fld%ffhh (njeff,lan)
-
- print*,"sfc_fld%f10m (njeff,lan),flx_fld%srunoff(njeff,lan),"
- print*,sfc_fld%f10m (njeff,lan),flx_fld%srunoff(njeff,lan)
-
- print*,"flx_fld%evbsa (njeff,lan),flx_fld%evcwa (njeff,lan),"
- print*,flx_fld%evbsa (njeff,lan),flx_fld%evcwa (njeff,lan)
-
- print*,"flx_fld%snohfa(njeff,lan),flx_fld%transa(njeff,lan),"
- print*,flx_fld%snohfa(njeff,lan),flx_fld%transa(njeff,lan)
-
- print*,"flx_fld%sbsnoa(njeff,lan),flx_fld%snowca(njeff,lan),"
- print*,flx_fld%sbsnoa(njeff,lan),flx_fld%snowca(njeff,lan)
-
- print*,"flx_fld%soilm (njeff,lan),flx_fld%tmpmin(njeff,lan),"
- print*,flx_fld%soilm (njeff,lan),flx_fld%tmpmin(njeff,lan)
-
- print*,"flx_fld%tmpmax(njeff,lan),flx_fld%dusfc (njeff,lan),"
- print*,flx_fld%tmpmax(njeff,lan),flx_fld%dusfc (njeff,lan)
-
- print*,"flx_fld%dvsfc (njeff,lan),flx_fld%dtsfc (njeff,lan),"
- print*,flx_fld%dvsfc (njeff,lan),flx_fld%dtsfc (njeff,lan)
-
- print*,"flx_fld%dqsfc (njeff,lan),flx_fld%geshem(njeff,lan),"
- print*,flx_fld%dqsfc (njeff,lan),flx_fld%geshem(njeff,lan)
-
- print*,"flx_fld%gflux (njeff,lan),flx_fld%dlwsfc(njeff,lan),"
- print*,flx_fld%gflux (njeff,lan),flx_fld%dlwsfc(njeff,lan)
-
- print*,"flx_fld%ulwsfc(njeff,lan),flx_fld%suntim(njeff,lan),"
- print*,flx_fld%ulwsfc(njeff,lan),flx_fld%suntim(njeff,lan)
-
- print*,"flx_fld%runoff(njeff,lan),flx_fld%ep (njeff,lan),"
- print*,flx_fld%runoff(njeff,lan),flx_fld%ep (njeff,lan)
-
- print*,"flx_fld%cldwrk(njeff,lan),flx_fld%dugwd (njeff,lan),"
- print*,flx_fld%cldwrk(njeff,lan),flx_fld%dugwd (njeff,lan)
-
- print*,"flx_fld%dvgwd (njeff,lan),flx_fld%psmean(njeff,lan),"
- print*,flx_fld%dvgwd (njeff,lan),flx_fld%psmean(njeff,lan)
-
- print*,"flx_fld%bengsh(njeff,lan),flx_fld%spfhmin(njeff,lan),"
- print*,flx_fld%bengsh(njeff,lan),flx_fld%spfhmin(njeff,lan)
-
- print*,"flx_fld%spfhmax(njeff,lan), "
- print*,flx_fld%spfhmax(njeff,lan)
-
-! print*,"dt3dt_v, dq3dt_v, du3dt_v, dv3dt_v, "
-! print*,dt3dt_v, dq3dt_v, du3dt_v, dv3dt_v
-
- print*,"acv(njeff,lan), acvb(njeff,lan),acvt(njeff,lan), "
- print*,acv(njeff,lan), acvb(njeff,lan), acvt(njeff,lan)
-
- print*,"slc_v, smc_v, stc_v, "
- print*,slc_v, smc_v, stc_v
-
-! print*,"upd_mf_v, dwn_mf_v, det_mf_v, dkh_v, rnp_v, "
-! print*,upd_mf_v, dwn_mf_v, det_mf_v, dkh_v, rnp_v
-
-! print*,"phy_f3dv, phy_f2dv, "
-! print*,phy_f3dv, phy_f2dv
-
- print*,"DLWSFC_cc(njeff,lan), ULWSFC_cc(njeff,lan), "
- print*,DLWSFC_cc(njeff,lan), ULWSFC_cc(njeff,lan)
-
- print*,"DTSFC_cc(njeff,lan), SWSFC_cc(njeff,lan), "
- print*,DTSFC_cc(njeff,lan), SWSFC_cc(njeff,lan)
-
- print*,"DUSFC_cc(njeff,lan), DVSFC_cc(njeff,lan), "
- print*, DUSFC_cc(njeff,lan), DVSFC_cc(njeff,lan)
-
- print*,"DQSFC_cc(njeff,lan), PRECR_cc(njeff,lan), "
- print*, DQSFC_cc(njeff,lan), PRECR_cc(njeff,lan)
-
- print*,"nst_fld%xt(njeff,lan), nst_fld%xs(njeff,lan), "
- print*, nst_fld%xt(njeff,lan), nst_fld%xs(njeff,lan)
-
- print*,"nst_fld%xu(njeff,lan), nst_fld%xv(njeff,lan), "
- print*, nst_fld%xu(njeff,lan), nst_fld%xv(njeff,lan)
-
- print*,"nst_fld%xz(njeff,lan), nst_fld%zm(njeff,lan), "
- print*, nst_fld%xz(njeff,lan), nst_fld%zm(njeff,lan)
-
- print*,"nst_fld%xtts(njeff,lan), nst_fld%xzts(njeff,lan),"
- print*, nst_fld%xtts(njeff,lan), nst_fld%xzts(njeff,lan)
-
- print*,"nst_fld%d_conv(njeff,lan),nst_fld%ifd(njeff,lan)"
- print*, nst_fld%d_conv(njeff,lan),nst_fld%ifd(njeff,lan)
-
- print*,"nst_fld%dt_cool(njeff,lan),nst_fld%Qrain(njeff,lan)"
- print*, nst_fld%dt_cool(njeff,lan),nst_fld%Qrain(njeff,lan)
- endif
-
- call gbphys &
-! --- inputs:
- & ( njeff,ngptc,levs,lsoil,lsm,ntrac,ncld,ntoz,ntcw, &
- & nmtvr,nrcm,levozp,lonr,latr,jcap,num_p3d,num_p2d, &
- & kdt,lat,me,pl_coeff,nlons_v,ncw,flgmin,crtrh,cdmbgwd, &
- & ccwf,dlqf,ctei_rm,clstp,dtp,dtf,fhour,solhr, &
- & slag,sdec,cdec,sinlat_v,coslat_v,pgr,ugrd,vgrd, &
- & gt,gr,vvel,prsi,prsl,prslk,prsik,phii,phil, &
- & rannum_v,ozplout_v,pl_pres,dpshc, &
- & hprime_v, xlon(lon,lan),xlat(lon,lan), &
- & sfc_fld%slope (lon,lan), sfc_fld%shdmin(lon,lan), &
- & sfc_fld%shdmax(lon,lan), sfc_fld%snoalb(lon,lan), &
- & sfc_fld%tg3 (lon,lan), sfc_fld%slmsk (lon,lan), &
- & sfc_fld%vfrac (lon,lan), sfc_fld%vtype (lon,lan), &
- & sfc_fld%stype (lon,lan), sfc_fld%uustar(lon,lan), &
- & sfc_fld%oro (lon,lan), flx_fld%coszen(lon,lan), &
- & flx_fld%sfcdsw(lon,lan), flx_fld%sfcnsw(lon,lan), &
- & flx_fld%sfcdlw(lon,lan), flx_fld%tsflw (lon,lan), &
- & flx_fld%sfcemis(lon,lan), sfalb(lon,lan), &
- & swh_v, hlw_v, &
- & ras,pre_rad,ldiag3d,lggfs3d,lssav,lssav_cc, &
- & bkgd_vdif_m,bkgd_vdif_h,bkgd_vdif_s,psautco,prautco, evpco, &
- & wminco, &
- & flipv,old_monin,cnvgwd,shal_cnv,sashal,newsas,cal_pre, &
- & mom4ice,mstrat,trans_trac,nst_fcst,moist_adj,fscav, &
- & thermodyn_id, sfcpress_id, gen_coord_hybrid, &
-! --- input/outputs:
- & sfc_fld%hice (lon,lan), sfc_fld%fice (lon,lan), &
- & sfc_fld%tisfc (lon,lan), sfc_fld%tsea (lon,lan), &
- & sfc_fld%tprcp (lon,lan), sfc_fld%cv (lon,lan), &
- & sfc_fld%cvb (lon,lan), sfc_fld%cvt (lon,lan), &
- & sfc_fld%srflag(lon,lan), sfc_fld%snwdph(lon,lan), &
- & sfc_fld%sheleg(lon,lan), sfc_fld%sncovr(lon,lan), &
- & sfc_fld%zorl (lon,lan), sfc_fld%canopy(lon,lan), &
- & sfc_fld%ffmm (lon,lan), sfc_fld%ffhh (lon,lan), &
- & sfc_fld%f10m (lon,lan), flx_fld%srunoff(lon,lan), &
- & flx_fld%evbsa (lon,lan), flx_fld%evcwa (lon,lan), &
- & flx_fld%snohfa(lon,lan), flx_fld%transa(lon,lan), &
- & flx_fld%sbsnoa(lon,lan), flx_fld%snowca(lon,lan), &
- & flx_fld%soilm (lon,lan), flx_fld%tmpmin(lon,lan), &
- & flx_fld%tmpmax(lon,lan), flx_fld%dusfc (lon,lan), &
- & flx_fld%dvsfc (lon,lan), flx_fld%dtsfc (lon,lan), &
- & flx_fld%dqsfc (lon,lan), flx_fld%geshem(lon,lan), &
- & flx_fld%gflux (lon,lan), flx_fld%dlwsfc(lon,lan), &
- & flx_fld%ulwsfc(lon,lan), flx_fld%suntim(lon,lan), &
- & flx_fld%runoff(lon,lan), flx_fld%ep (lon,lan), &
- & flx_fld%cldwrk(lon,lan), flx_fld%dugwd (lon,lan), &
- & flx_fld%dvgwd (lon,lan), flx_fld%psmean(lon,lan), &
- & flx_fld%bengsh(lon,lan), flx_fld%spfhmin(lon,lan), &
- & flx_fld%spfhmax(lon,lan), &
- & dt3dt_v, dq3dt_v, du3dt_v, dv3dt_v, &
- & acv(lon,lan), acvb(lon,lan), acvt(lon,lan), &
- & slc_v, smc_v, stc_v, &
- & upd_mf_v, dwn_mf_v, det_mf_v, dkh_v, rnp_v, &
- & phy_f3dv, phy_f2dv, &
- & DLWSFC_cc(lon,lan), ULWSFC_cc(lon,lan), &
- & DTSFC_cc(lon,lan), SWSFC_cc(lon,lan), &
- & DUSFC_cc(lon,lan), DVSFC_cc(lon,lan), &
- & DQSFC_cc(lon,lan), PRECR_cc(lon,lan), &
-
- & nst_fld%xt(lon,lan), nst_fld%xs(lon,lan), &
- & nst_fld%xu(lon,lan), nst_fld%xv(lon,lan), &
- & nst_fld%xz(lon,lan), nst_fld%zm(lon,lan), &
- & nst_fld%xtts(lon,lan), nst_fld%xzts(lon,lan), &
- & nst_fld%d_conv(lon,lan), nst_fld%ifd(lon,lan), &
- & nst_fld%dt_cool(lon,lan), nst_fld%Qrain(lon,lan), &
-! --- outputs:
- & adt, adr, adu, adv, &
- & sfc_fld%t2m (lon,lan), sfc_fld%q2m (lon,lan), &
- & flx_fld%u10m (lon,lan), flx_fld%v10m (lon,lan), &
- & flx_fld%zlvl (lon,lan), flx_fld%psurf (lon,lan), &
- & flx_fld%hpbl (lon,lan), flx_fld%pwat (lon,lan), &
- & flx_fld%t1 (lon,lan), flx_fld%q1 (lon,lan), &
- & flx_fld%u1 (lon,lan), flx_fld%v1 (lon,lan), &
- & flx_fld%chh (lon,lan), flx_fld%cmm (lon,lan), &
- & flx_fld%dlwsfci(lon,lan), flx_fld%ulwsfci(lon,lan), &
- & flx_fld%dswsfci(lon,lan), flx_fld%uswsfci(lon,lan), &
- & flx_fld%dtsfci(lon,lan), flx_fld%dqsfci(lon,lan), &
- & flx_fld%gfluxi(lon,lan), flx_fld%epi (lon,lan), &
- & flx_fld%smcwlt2(lon,lan), flx_fld%smcref2(lon,lan), &
-!hchuang code change [+3L] 11/12/2007 : add 2D
- & flx_fld%gsoil(lon,lan), flx_fld%gtmp2m(lon,lan), &
- & flx_fld%gustar(lon,lan), flx_fld%gpblh(lon,lan), &
- & flx_fld%gu10m(lon,lan), flx_fld%gv10m(lon,lan), &
- & flx_fld%gzorl(lon,lan), flx_fld%goro(lon,lan), &
-
- & XMU_cc(lon,lan), DLW_cc(lon,lan), DSW_cc(lon,lan), &
- & SNW_cc(lon,lan), LPREC_cc(lon,lan), &
-
- & nst_fld%Tref(lon,lan), nst_fld%z_c(lon,lan), &
- & 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
- & )
-!!
-
- if(lprnt) then
- print*," ============ after calling gbphys =============="
- print*," ============ out variables =============="
-
- print*,"adt ",adt
-! print*,"adr ",adr
- print*,"adu ",adu
- print*,"adv ",adv
-
- print*,"sfc_fld%t2m (lon,lan), sfc_fld%q2m (lon,lan),"
- print*,sfc_fld%t2m (lon,lan), sfc_fld%q2m (lon,lan)
-
- print*,"flx_fld%u10m (lon,lan), flx_fld%v10m (lon,lan),"
- print*,flx_fld%u10m (lon,lan), flx_fld%v10m (lon,lan)
-
- print*,"flx_fld%zlvl (lon,lan), flx_fld%psurf (lon,lan),"
- print*,flx_fld%zlvl (lon,lan), flx_fld%psurf (lon,lan)
-
- print*,"flx_fld%hpbl (lon,lan), flx_fld%pwat (lon,lan),"
- print*,flx_fld%hpbl (lon,lan), flx_fld%pwat (lon,lan)
-
- print*,"flx_fld%t1 (lon,lan), flx_fld%q1 (lon,lan),"
- print*,flx_fld%t1 (lon,lan), flx_fld%q1 (lon,lan)
-
- print*,"flx_fld%u1 (lon,lan), flx_fld%v1 (lon,lan),"
- print*,flx_fld%u1 (lon,lan), flx_fld%v1 (lon,lan)
-
- print*,"flx_fld%chh (lon,lan), flx_fld%cmm (lon,lan),"
- print*,flx_fld%chh (lon,lan), flx_fld%cmm (lon,lan)
-
- print*,"flx_fld%dlwsfci(lon,lan), flx_fld%ulwsfci(lon,lan),"
- print*,flx_fld%dlwsfci(lon,lan), flx_fld%ulwsfci(lon,lan)
-
- print*,"flx_fld%dswsfci(lon,lan), flx_fld%uswsfci(lon,lan),"
- print*,flx_fld%dswsfci(lon,lan), flx_fld%uswsfci(lon,lan)
-
- print*,"flx_fld%dtsfci(lon,lan), flx_fld%dqsfci(lon,lan),"
- print*,flx_fld%dtsfci(lon,lan), flx_fld%dqsfci(lon,lan)
-
- print*,"flx_fld%gfluxi(lon,lan), flx_fld%epi (lon,lan),"
- print*,flx_fld%gfluxi(lon,lan), flx_fld%epi (lon,lan)
-
- print*,"flx_fld%smcwlt2(lon,lan), flx_fld%smcref2(lon,lan),"
- print*,flx_fld%smcwlt2(lon,lan), flx_fld%smcref2(lon,lan)
-
- print*," flx_fld%gsoil(lon,lan), flx_fld%gtmp2m(lon,lan),"
- print*, flx_fld%gsoil(lon,lan), flx_fld%gtmp2m(lon,lan)
-
- print*," flx_fld%gustar(lon,lan), flx_fld%gpblh(lon,lan),"
- print*, flx_fld%gustar(lon,lan), flx_fld%gpblh(lon,lan)
-
- print*," flx_fld%gu10m(lon,lan), flx_fld%gv10m(lon,lan),"
- print*, flx_fld%gu10m(lon,lan), flx_fld%gv10m(lon,lan)
-
- print*," flx_fld%gzorl(lon,lan), flx_fld%goro(lon,lan),"
- print*, flx_fld%gzorl(lon,lan), flx_fld%goro(lon,lan)
-
- print*,"XMU_cc(lon,lan), DLW_cc(lon,lan), DSW_cc(lon,lan),"
- print*, XMU_cc(lon,lan), DLW_cc(lon,lan), DSW_cc(lon,lan)
-
- print*,"SNW_cc(lon,lan), LPREC_cc(lon,lan), "
- print*, SNW_cc(lon,lan), LPREC_cc(lon,lan)
-
- print*,"nst_fld%Tref(lon,lan), nst_fld%z_c(lon,lan),"
- print*,nst_fld%Tref(lon,lan), nst_fld%z_c(lon,lan)
-
- print*,"nst_fld%c_0 (lon,lan), nst_fld%c_d(lon,lan),"
- print*,nst_fld%c_0 (lon,lan), nst_fld%c_d(lon,lan)
-
- print*,"nst_fld%w_0 (lon,lan), nst_fld%w_d(lon,lan),"
- print*,nst_fld%w_0 (lon,lan), nst_fld%w_d(lon,lan)
-
- print*,"rqtk ",rqtk
- endif
-
-!---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) = adu(j,k)
- mp_v(jtem,k,lan) = adv(j,k)
- mp_t(jtem,k,lan) = adt(j,k)
- mp_q(jtem,k,lan) = adr(j,k,1) !specific humidity
- do n=1,ntrac-1
- mp_tr(jtem,k,n,lan) = adr(j,k,n+1)
- enddo
- enddo
- enddo
-
- do k=1,lsoil
- do i=1,njeff
- item = lon + i - 1
- sfc_fld%smc(item,k,lan) = smc_v(i,k)
- sfc_fld%stc(item,k,lan) = stc_v(i,k)
- sfc_fld%slc(item,k,lan) = slc_v(i,k)
- enddo
- enddo
-!!
- do j=1,num_p3d
- do k=1,levs
- do i=1,njeff
- phy_f3d(lon+i-1,k,j,lan) = phy_f3dv(i,k,j)
- enddo
- enddo
- enddo
- do j=1,num_p2d
- do i=1,njeff
- phy_f2d(lon+i-1,j,lan) = phy_f2dv(i,j)
- enddo
- enddo
-!
- if (ldiag3d) then
- do n=1,6
- do k=1,levs
- do i=1,njeff
- dt3dt(lon+i-1,k,n,lan) = dt3dt_v(i,k,n)
- enddo
- enddo
- enddo
- do n=1,4
- do k=1,levs
- do i=1,njeff
- du3dt(lon+i-1,k,n,lan) = du3dt_v(i,k,n)
- dv3dt(lon+i-1,k,n,lan) = dv3dt_v(i,k,n)
- enddo
- enddo
- enddo
- endif
- if (ldiag3d .or. lggfs3d) then
- do n=1,5+pl_coeff
- do k=1,levs
- do i=1,njeff
- dq3dt(lon+i-1,k,n,lan) = dq3dt_v(i,k,n)
- enddo
- enddo
- enddo
- do k=1,levs
- do i=1,njeff
- upd_mf(lon+i-1,k,lan) = upd_mf_v(i,k)
- dwn_mf(lon+i-1,k,lan) = dwn_mf_v(i,k)
- det_mf(lon+i-1,k,lan) = det_mf_v(i,k)
- enddo
- enddo
- endif
- if (lggfs3d) then
- do k=1,levs
- do i=1,njeff
- dkh(lon+i-1,k,lan) = dkh_v(i,k)
- rnp(lon+i-1,k,lan) = rnp_v(i,k)
- enddo
- enddo
- endif
-!
-!---------------------------
- enddo ! lon loop
-!---------------------------
-!
-!
-! 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 ! lan loop
-!---------------------------
-
- return
- end
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopr.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopr.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/gloopr.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,529 +0,0 @@
-!---modified from GFS gloopr.f for use in MPAS model
-!---vertical index is from surafce to top.
-!---Fanglin Yang, May 2012
-
- subroutine gloopr
-!---input
- & (phour,kdt,lonsperlar,global_lats_r,xlon,xlat,
- & slmsk,sheleg, zorl, tsea,
- & alvsf, alnsf, alvwf, alnwf, facsf, facwf,
- & cv, cvt, cvb, fice, tisfc, sncovr, snoalb,
- & hprime,phy_f3d,
- & mp_pi,mp_pl,mp_t,mp_q,mp_w,mp_tr,
-!--in and out
- & fluxr,
-!--output
- & swh, hlw, coszdg,
- & coszen, sfcnsw,
- & sfcdlw, tsflw,
- & sfcdsw, sfalb, sfcemis,
- & slag, sdec, cdec)
-!!
-#include "f_hpm.h"
-!
- use machine , only : kind_phys
- use physcons , only : con_rocp
-
- use module_radiation_driver, only : radinit, grrad
- use module_radiation_astronomy,only : astronomy
-!
-!! --- for optional spectral band heating outputs
-!! use module_radsw_parameters, only : NBDSW
-!! use module_radlw_parameters, only : NBDLW
-!
- use resol_def
- use layout1
- use gg_def
- use vert_def
- use gfsmisc_def, only : sinlat_r2, coslat_r2
- use date_def
- use namelist_def
- use d3d_def , only : cldcov
- use mersenne_twister, only : random_setseed, random_index, &
- & random_stat
-!
- implicit none
- include 'mpif.h'
-!
- real (kind=kind_phys), parameter :: QMIN =1.0e-10
-!
-! --- ... inputs:
- integer, intent(in) :: kdt
- integer, intent(in) :: lonsperlar(latr),global_lats_r(latr)
- real (kind=kind_phys), dimension(lonr,lats_node_r), intent(in) :: &
- & xlon, xlat, slmsk, sheleg, zorl, tsea, &
- & alvsf, alnsf, alvwf, alnwf, facsf, facwf, &
- & cv, cvt, cvb, FICE, tisfc, sncovr, snoalb
- real (kind=kind_phys), intent(in) :: &
- & hprime(lonr,nmtvr,lats_node_r), phour, &
- & phy_f3d(lonr,levs,num_p3d,lats_node_r)
-
-! --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) ::
- & 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:
- real (kind=kind_phys), intent(inout) :: &
- & fluxr (LONR,NFXR,LATS_NODE_R)
-
-! --- ... outputs:
- real (kind=kind_phys), intent(out) :: &
- & swh(LONR,LEVS,LATS_NODE_R), &
- & hlw(LONR,LEVS,LATS_NODE_R)
- real (kind=kind_phys),dimension(LONR,LATS_NODE_R), intent(out) :: &
- & coszdg, coszen, sfcnsw, sfcdlw, tsflw, &
- & sfcdsw, sfalb, sfcemis
- real (kind=kind_phys), intent(out) :: slag, sdec, cdec
-
-!! --- ... optional spectral band heating rates
-!! real (kind=kind_phys), optional, intent(out) :: &
-!! & htrswb(NGPTC,LEVS,NBDSW,NBLCK,LATS_NODE_R), &
-!! & htrlwb(NGPTC,LEVS,NBDLW,NBLCK,LATS_NODE_R)
-
-! --- ... locals:
-! --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)
-
- real (kind=kind_phys) :: f_ice(NGPTC,LEVS), f_rain(NGPTC,LEVS), &
- & r_rime(NGPTC,LEVS)
-
- real (kind=kind_phys) :: cldcov_v(NGPTC,LEVS), fluxr_v(NGPTC,NFXR)
- real (kind=kind_phys) :: flgmin_v(ngptc), work1, work2
-
- real (kind=kind_phys) :: rinc(5), dtsw, dtlw, solcon, raddt
-
- real (kind=kind_phys), save :: facoz
-
- integer :: njeff, lon, lan, lat, lons_lat
- integer :: idat(8), jdat(8), DAYS(13), iday, imon, midmon, id
- integer :: lmax
-
-! --- variables used for random number generator (thread safe mode)
- type (random_stat) :: stat
- integer :: numrdm(LONR*LATR*2), ixseed(LONR,LATS_NODE_R,2)
- integer :: ipseed, icsdlw(NGPTC), icsdsw(NGPTC)
- integer, parameter :: ipsdlim = 1.0e8 ! upper limit for random seeds
-
- integer, save :: icwp, k1oz, k2oz, midm, midp, ipsd0
-
-! --- number of days in a month
- data DAYS / 31,28,31,30,31,30,31,31,30,31,30,31,30 /
-
-! --- ... control parameters:
-! (some of the them may be moved into model namelist)
-
-! --- ICTM=yyyy#, controls time sensitive external data (e.g. CO2, solcon, aerosols, etc)
-! integer, parameter :: ICTM = -2 ! same as ICTM=0, but add seasonal cycle from
-! ! climatology. no extrapolation.
-! integer, parameter :: ICTM = -1 ! use user provided external data set for the
-! ! forecast time. no extrapolation.
-! integer, parameter :: ICTM = 0 ! use data at initial cond time, if not
-! ! available, use latest, no extrapolation.
-!! integer, parameter :: ICTM = 1 ! use data at the forecast time, if not
-! ! available, use latest and extrapolation.
-! integer, parameter :: ICTM =yyyy0 ! use yyyy data for the forecast time,
-! ! no further data extrapolation.
-! integer, parameter :: ICTM =yyyy1 ! use yyyy data for the fcst. if needed, do
-! ! extrapolation to match the fcst time.
-
-! --- ISOL controls solar constant data source
-!! integer, parameter :: ISOL = 0 ! use prescribed solar constant
-! integer, parameter :: ISOL = 1 ! use varying solar const with 11-yr cycle
-
-! --- ICO2 controls co2 data source for radiation
-! integer, parameter :: ICO2 = 0 ! prescribed global mean value (old opernl)
-!! integer, parameter :: ICO2 = 1 ! use obs co2 annual mean value only
-! integer, parameter :: ICO2 = 2 ! use obs co2 monthly data with 2-d variation
-
-! --- IALB controls surface albedo for sw radiation
-!! integer, parameter :: IALB = 0 ! use climatology alb, based on sfc type
-! integer, parameter :: IALB = 1 ! use modis derived alb (to be developed)
-
-! --- IEMS controls surface emissivity and sfc air/ground temp for lw radiation
-! ab: 2-digit control flags. a-for sfc temperature; b-for emissivity
-!! integer, parameter :: IEMS = 00 ! same air/ground temp; fixed emis = 1.0
-!! integer, parameter :: IEMS = 01 ! same air/ground temp; varying veg typ based emis
-!! integer, parameter :: IEMS = 10 ! diff air/ground temp; fixed emis = 1.0
-!! integer, parameter :: IEMS = 11 ! diff air/ground temp; varying veg typ based emis
-
-! --- IAER controls aerosols scheme selections
-! Old definition
-! integer, parameter :: IAER = 1 ! opac climatology, without volc forcing
-! integer, parameter :: IAER =11 ! opac climatology, with volcanic forcing
-! integer, parameter :: IAER = 2 ! gocart prognostic, without volc forcing
-! integer, parameter :: IAER =12 ! gocart prognostic, with volcanic forcing
-! New definition in this code IAER = abc (a:volcanic; b:lw; c:sw)
-! b, c values: (0:none; 1:opac; 2:gocart)
-! IAER = 0 --> no aerosol effect at all (volc, sw, lw)
-! = 1 --> only tropospheric sw aerosols, no trop-lw and volc
-! = 10 --> only tropospheric lw aerosols, no trop-sw and volc
-! = 11 --> both trop-sw and trop-lw aerosols, no volc
-! = 100 --> only strato-volc aeros, no trop-sw and trop-lw
-! = 101 --> only sw aeros (trop + volc), no lw aeros
-! = 110 --> only lw aeros (trop + volc), no sw aeros
-! = 111 --> both sw and lw aeros (trop + volc)
-!
-
-! --- IOVR controls cloud overlapping method in radiation:
-! integer, parameter :: IOVR_SW = 0 ! sw: random overlap clouds
-!! integer, parameter :: IOVR_SW = 1 ! sw: max-random overlap clouds
-
-! integer, parameter :: IOVR_LW = 0 ! lw: random overlap clouds
-!! integer, parameter :: IOVR_LW = 1 ! lw: max-random overlap clouds
-
-! --- ISUBC controls sub-column cloud approximation in radiation:
-! integer, parameter :: ISUBC_SW = 0 ! sw: without sub-col clds approx
-! integer, parameter :: ISUBC_SW = 1 ! sw: sub-col clds with prescribed seeds
-! integer, parameter :: ISUBC_SW = 2 ! sw: sub-col clds with random seeds
-
-! integer, parameter :: ISUBC_LW = 0 ! lw: without sub-col clds approx
-! integer, parameter :: ISUBC_LW = 1 ! lw: sub-col clds with prescribed seeds
-! integer, parameter :: ISUBC_LW = 2 ! lw: sub-col clds with random seeds
-
-! --- iflip indicates model vertical index direction:
-! integer, parameter :: IFLIP = 0 ! virtical profile index from top to bottom
- integer, parameter :: IFLIP = 1 ! virtical profile index from bottom to top
-!
-! The following parameters are from gbphys
-!
- real (kind=kind_phys), parameter :: dxmax=-16.118095651, &
- & dxmin=-9.800790154, dxinv=1.0/(dxmax-dxmin)
-
- integer :: kr, kt, kd, kq, ku, kv, ierr, dimg, kx, ky
- integer :: i, j, k, n
- integer :: kdtphi,kdtlam,ks ! hmhj
-
- logical :: change
- logical, save :: first, sas_shal
- data first / .true. /
-!
-! --- for debug test use
- real (kind=kind_phys) :: temlon, temlat, alon, alat
- integer :: ipt
- logical :: lprnt
-
-!===> *** ... begin here
-!
- integer kap,kar,kat,kau,kav,kdrlam
- integer ksd,ksplam,kspphi,ksq,ksr,kst
- integer ksu,ksv,ksz,node,item,jtem
-!!
-!!xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
-!!
-!!
- lprnt=.false.
-
- idat = 0
- idat(1) = idate(4)
- idat(2) = idate(2)
- idat(3) = idate(3)
- idat(5) = idate(1)
- rinc = 0.
- rinc(2) = fhour
- call w3movdat(rinc, idat, jdat)
-!
- if (ntoz .le. 0) then ! Climatological Ozone!
-!
-! if(me .eq. 0) WRITE (6,989) jdat(1),jdat(2),jdat(3),jdat(5)
-! 989 FORMAT(' UPDATING OZONE FOR ', I4,I3,I3,I3)
-!
- IDAY = jdat(3)
- IMON = jdat(2)
- MIDMON = DAYS(IMON)/2 + 1
- CHANGE = FIRST .OR.
- & ( (IDAY .EQ. MIDMON) .AND. (jdat(5).EQ.0) )
-!
- IF (CHANGE) THEN
- IF (IDAY .LT. MIDMON) THEN
- K1OZ = MOD(IMON+10,12) + 1
- MIDM = DAYS(K1OZ)/2 + 1
- K2OZ = IMON
- MIDP = DAYS(K1OZ) + MIDMON
- ELSE
- K1OZ = IMON
- MIDM = MIDMON
- K2OZ = MOD(IMON,12) + 1
- MIDP = DAYS(K2OZ)/2 + 1 + DAYS(K1OZ)
- ENDIF
- ENDIF
-!
- IF (IDAY .LT. MIDMON) THEN
- ID = IDAY + DAYS(K1OZ)
- ELSE
- ID = IDAY
- ENDIF
- FACOZ = real (ID-MIDM) / real (MIDP-MIDM)
- endif
-!
- if (first) then
- sas_shal = sashal .and. (.not. ras)
-!
-!--a reference sigma for radiation initilization, k from surfce to top
- do k = 1, levr+1
- si_loc(k) = mp_pi(1,k,1)/mp_pi(1,1,1)
- enddo
-
-! --- determin prognostic/diagnostic cloud scheme
- icwp = 0
- if (NTCW > 0) icwp = 1
-
-! --- generate initial permutation seed for random number generator
-
- if ( ISUBC_LW==2 .or. ISUBC_SW==2 ) then
- ipsd0 = 17*idate(1) + 43*idate(2) + 37*idate(3) + 23*idate(4)
- if ( me == 0 ) then
- print *,' Radiation sub-cloud initial seed =',ipsd0, &
- & ' idate =',idate
- endif
- endif
-
- first = .false.
-
- endif ! end_if_first
-!
-!===> *** ... radiation initialization
-!
- dtsw = 3600.0 * fhswr
- dtlw = 3600.0 * fhlwr
- raddt = min(dtsw, dtlw)
-
- if(lprnt) print*,"---------begin gloopr radinit -----------"
- call radinit &
-! --- input:
- & ( si_loc, LEVR, IFLIP, idat, jdat, ICTM, ISOL, ICO2, &
- & IAER, IALB, IEMS, ICWP, NUM_P3D, ISUBC_SW, ISUBC_LW, &
- & IOVR_SW, IOVR_LW, me )
-! --- output: ( none )
-
-!
-!===> *** ... astronomy for sw radiation calculation.
-!
- call astronomy &
-! --- inputs:
- & ( lonsperlar, global_lats_r, sinlat_r2, coslat_r2, xlon, &
- & fhswr, jdat, &
- & LONR, LATS_NODE_R, LATR, IPT_LATS_NODE_R, lsswr, me, &
-! --- outputs:
- & solcon, slag, sdec, cdec, coszen, coszdg &
- & )
- if(lprnt) then
- print*,"---------complete gloopr astronomy -----------"
- print*,"--solcon, slag, sdec, cdec, coszen, coszdg :"
- print*,solcon, slag, sdec, cdec, coszen, coszdg
- endif
-
-!
-!===> *** ... generate 2-d random seeds array for sub-grid cloud-radiation
-!
- if ( ISUBC_LW==2 .or. ISUBC_SW==2 ) then
- ipseed = mod(nint(100.0*sqrt(fhour*3600)), ipsdlim) + 1 + ipsd0
-
- call random_setseed &
-! --- inputs:
- & ( ipseed, &
-! --- outputs:
- & stat &
- & )
- call random_index &
-! --- inputs:
- & ( ipsdlim, &
-! --- outputs:
- & numrdm, stat &
- & )
-
- do k = 1, 2
- do j = 1, lats_node_r
- lat = global_lats_r(ipt_lats_node_r-1+j)
- do i = 1, LONR
- lat =xlat(i,j)
- ixseed(i,j,k) = numrdm(i+(lat-1)*LONR+(k-1)*LATR)
- enddo
- enddo
- enddo
- endif
-
-!
-!
-!===> *** ... starting latitude loop
-!--------------------
- if(lprnt) print*,"---------begin gloopr latitude loop ----"
- do lan=1,lats_node_r
- lat = global_lats_r(ipt_lats_node_r-1+lan)
- lons_lat = lonsperlar(lat)
-
-
-!!
-c!$omp parallel do schedule(dynamic,1) private(lon,i,j,k)
-c!$omp+private(vvel,gt,gr,gr1)
-c!$omp+private(cldcov_v,fluxr_v,f_ice,f_rain,r_rime)
-c!$omp+private(prslk,prsl,prsi,flgmin_v,hlw_v,swh_v)
-c!$omp+private(njeff,n,item,jtem,ks,work1,work2)
-c!$omp+private(icsdsw,icsdlw)
-c!$omp+private(lprnt,ipt)
-
- do lon=1,lons_lat,ngptc
-!--------------------
- NJEFF = MIN(ngptc,lons_lat-lon+1)
- 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)
- enddo
- enddo
-!
- if (num_p3d == 3) then
- do k = 1, LEVR
- do j = 1, njeff
- jtem = lon-1+j
- f_ice (j,k) = phy_f3d(jtem,k,1,lan)
- f_rain(j,k) = phy_f3d(jtem,k,2,lan)
- r_rime(j,k) = phy_f3d(jtem,k,3,lan)
- enddo
- enddo
-
- work1=(log(coslat_r2(lon,lat)/(lons_lat*latg))-dxmin)*dxinv
- work1 = max(0.0, min(1.0,work1))
- work2 = flgmin(1)*work1 + flgmin(2)*(1.0-work1)
- do j=1,njeff
-! flgmin_v(j) = work2
- flgmin_v(j) = 0.0
- enddo
- else
- do j=1,njeff
- flgmin_v(j) = 0.0
- enddo
- endif
-
-! *** ... assign random seeds for sw and lw radiations
-
- if ( ISUBC_LW==2 .or. ISUBC_SW==2 ) then
- do j = 1, njeff
- icsdsw(j) = ixseed(lon+j-1,lan,1)
- icsdlw(j) = ixseed(lon+j-1,lan,2)
- enddo
- endif
-!
-! *** ... calling radiation driver
-!
- call grrad &
-! --- inputs:
- & ( 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), &
- & alvsf(lon,lan),alnsf(lon,lan),alvwf(lon,lan), &
- & alnwf(lon,lan),facsf(lon,lan),facwf(lon,lan), &
- & fice(lon,lan),tisfc(lon,lan), &
- & solcon,coszen(lon,lan),coszdg(lon,lan),k1oz,k2oz,facoz, &
- & cv(lon,lan),cvt(lon,lan),cvb(lon,lan), &
- & IOVR_SW,IOVR_LW,f_ice,f_rain,r_rime,flgmin_v, &
- & icsdsw,icsdlw,NUM_P3D,NTCW-1,NCLD,NTOZ-1,NTRAC-1,NFXR, &
- & dtlw,dtsw,lsswr,lslwr,lssav,sas_shal,norad_precip, &
- & crick_proof, ccnorm, &
- & ngptc,njeff,LEVR,IFLIP, me, lprnt,ipt,kdt, &
-! & ngptc,njeff,LEVR,IFLIP, me, lprnt, &
-! --- outputs:
- & swh_v,sfcnsw(lon,lan),sfcdsw(lon,lan), &
- & sfalb(lon,lan), &
- & hlw_v,sfcdlw(lon,lan),tsflw(lon,lan), &
- & sfcemis(lon,lan),cldcov_v, &
-! --- input/output:
- & fluxr_v &
- & )
-!
-!
-! if (lprnt) print *,' returned from grrad for me=',me,' lan=',
-! &lan,' lat=',lat,' kdt=',kdt
-! print *,' end gloopr HLW=',hlw(lon,:,lan),' lan=',lan
-!
-! if (lprnt) print *,' swh_vg=',swh_v(ipt,:)
-!
-!
- if (lssav) then
- if (ldiag3d .or. lggfs3d) then
- do k=1,levr
- do j=1,njeff
- cldcov(lon+j-1,k,lan) = cldcov(lon+j-1,k,lan) &
- & + cldcov_v(j,k) * raddt
- enddo
- enddo
- endif
- endif
- do k=1,nfxr
- do j=1,njeff
- fluxr(lon+j-1,k,lan) = fluxr_v(j,k)
- enddo
- enddo
- if (lslwr) then
- do k=1,levr
- do j=1,njeff
- jtem = lon + j - 1
- hlw(jtem,k,lan) = hlw_v(j,k)
- swh(jtem,k,lan) = swh_v(j,k)
- enddo
- enddo
- if (levr .lt. levs) then
- do k=levr+1,levs
- do j=1,njeff
- jtem = lon + j - 1
- hlw(jtem,k,lan) = hlw_v(j,levr)
- swh(jtem,k,lan) = swh_v(j,levr)
- enddo
- enddo
- endif
- endif
-!
-!!
-! print *,' completed grrad for lan=',lan,' istrt=',istrt
-!--------------------
- enddo !end lon loop
- enddo !end lan loop
-!--------------------
-
- return
- end subroutine gloopr
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/input_list.txt
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/input_list.txt 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/input_list.txt 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,64 +0,0 @@
-INPUT REQUIRED FOR RUNNING NCEP GFS PHYSICS
-
------------------------------
-1. surface variables
------------------------------
-name layers description
-
-tsea 1 skin temperature (K)
-smc 4 soil volumetric water content,(fraction)
-sheleg 1 water equivalent snow depth (mm)
-stc 4 soil temperature (K)
-tg3 1 deep soil temperature (K)
-zorl 1 roughness (cm)
-cv 1 convective cloud cover (fraction, 0-1)
-cvb 1 convective cloud bottom (kPa)
-cvt 1 convective cloud top (kPa)
-alvsf 1 albedo for visible scattered shortwave radiation (0-1)
-alvwf 1 albedo for visible direct beam shortwave radiation (0-1)
-alnsf 1 albedo for near-IR scattered shortwave radiation (0-1)
-alnwf 1 albedo for near-IR beam shortwave radiation (0-1)
-slmsk 1 sea-land-ice mask (0-sea, 1-land, 2-ice)
-vfrac 1 vegetation fraction (0-1)
-canopy 1 canopy water (m)
-f10m 1 stability-related coefficients used for obtaining 10-m winds
-vtype 1 vegetation type (integer 1-13)
-stype 1 soil type (integer 1-9)
-facsf 1 fractional coverage with strong cosz dependen
-facwf 1 fractional coverage with weak cosz dependency
-uustar 1 boundary layer sqrt(CM)*U, U is wind speed at 1st layer
-ffmm 1 stability parameter in PBL for momentum
-ffhh 1 stability parameter in PBL for heat
-hice 1 sea ice thickness (m)
-fice 1 sea ice fraction (0-1)
-tprcp 1 total precipitation (kg/m/s)
-srflag 1 snow/rain flag
-snwdph 1 actual snow depth (mm) over land/sea ice
-slc 4 liquid content soil moisture
-shdmin 1 min fractional coverage of green veg
-shdmax 1 max fractional coverage of green veg
-slope 1 surface slope type for land-surface model
-snoalb 1 max snow albedo over land (for deep snow)
-orog 1 orography (m)
-t2m 1 t2m (K)
-q2m 1 q2m (kg/kg)
-tisfc 1 ice temperature (K)
-
-
-
------------------------------
-1. atmospheric variables
------------------------------
-name layers description
-
-pi levs model interface level pressure in pasca
-pl levs model integer layer pressure in pasca
-u levs model layer zonal wind m/s
-v levs model layer meridional wind m/s
-w levs model layer vertical velocity in pasca/sec
-t levs model layer temperature in K
-q levs model layer specific humidity in gm/gm, ntrace=1
-tr levs model layer tracer (ozne and cloud water) mass mixing ratio
-
-
-
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_ibm
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_ibm 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_ibm 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,25 +0,0 @@
-#!/bin/ksh
-set -x
-sorc_dir=$(pwd)
-sorc_gfs=${sorc_dir}/physics_gfs
-exec_dir=$sorc_dir
-mkdir -p $exec_dir
-#
-make_dir=/ptmp/$LOGNAME/$(basename $sorc_dir)
-mkdir -p $make_dir
-cd $make_dir
-cd $make_dir || exit 99
-[ $? -ne 0 ] && exit 8
-#
- cp -p $sorc_dir/* .
- cp -p $sorc_gfs/* .
-# rm $make_dir/*.o
-# rm $make_dir/*.mod
-
- export EXEC="$exec_dir/gfscolumn.exe"
-
- export F77=mpxlf95_r
- export F90=mpxlf95_r
-#
- make -f Makefile.ibm
-# make -f Makefile.ibm_debug
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_zeus
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_zeus 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/makefile.sh_zeus 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,26 +0,0 @@
-#!/bin/ksh
-set -x
-sorc_dir=$(pwd)
-sorc_gfs=${sorc_dir}/physics_gfs
-exec_dir=$sorc_dir
-mkdir -p $exec_dir
-#
-make_dir=/scratch2/portfolios/NCEPDEV/ptmp/$LOGNAME/$(basename $sorc_dir)
-mkdir -p $make_dir
-cd $make_dir
-cd $make_dir || exit 99
-[ $? -ne 0 ] && exit 8
-#
- cp -p $sorc_dir/* .
- cp -p $sorc_gfs/* .
-# rm $make_dir/*.o
-# rm $make_dir/*.mod
-
- export EXEC="$exec_dir/global_fcst"
-
- export F77=mpif90
- export F90=mpif90
- export FCC=mpicc
- export CFLAGS=LINUX
-#
- make -f Makefile.zeus
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/ozinterp.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/ozinterp.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/ozinterp.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,237 +0,0 @@
- SUBROUTINE setindxoz(latd,nlats,global_lats_r,
- & jindx1,jindx2,ddy)
-!
- USE MACHINE , ONLY : kind_phys
- use resol_def
- use layout1
- use gg_def
- use ozne_def , only : jo3 => latsozp, pl_lat
-!
- implicit none
-!
- integer global_lats_r(latr)
- integer latd,nlats,j,lat,i
- real(kind=kind_phys) pi
- real(kind=kind_phys) GAUL(latd),DDY(latd)
- integer JINDX1(latd),JINDX2(latd)
-
-cyt if(me.eq.0) print*,'begin setindxoz nlats=latd=',nlats,latd
-
- PI=ACOS(-1.)
- DO J=1,nlats
- lat = global_lats_r(ipt_lats_node_r-1+J)
- if (lat.le.latr2) then
- GAUL(J) = 90.0 - colrad_r(lat)*180.0/PI
- else
- GAUL(J) = -(90.0 - colrad_r(lat)*180.0/PI)
- endif
-!cselaif(me.eq.0) print*,'gau(j,1) gau(j,2)',gaul(j,1),gaul(j,2)
- ENDDO
-!
- DO J=1,nlats
- lat = global_lats_r(ipt_lats_node_r-1+J)
- jindx2(j) = jo3 + 1
- do i=1,jo3
- if (gaul(j) .lt. pl_lat(i)) then
- jindx2(j) = i
- exit
- endif
- enddo
- jindx1(j) = max(jindx2(j)-1,1)
- jindx2(j) = min(jindx2(j),jo3)
- if (jindx2(j) .ne. jindx1(j)) then
- DDY(j) = (gaul(j) - pl_lat(jindx1(j)))
- & / (pl_lat(jindx2(j)) - pl_lat(jindx1(j)))
- else
- ddy(j) = 1.0
- endif
-! print *,' j=',j,' gaul=',gaul(j),' jindx12=',jindx1(j),
-! &jindx2(j),' pl_lat=',pl_lat(jindx1(j)),pl_lat(jindx2(j))
-! &,' ddy=',ddy(j)
-!csela if(me.eq.0) print*,'1st ddy(j,1) ddy(j,2),j=',ddy(j,1),ddy(j,2),j
-
- ENDDO
-
-csela do j=1,nlats
-csela if(me.eq.0) print*,'x1(j,1) jindx1(j,2)',jindx1(j,1),jindx1(j,2),j
-csela if(me.eq.0) print*,'x2(j,1) jindx2(j,2)',jindx2(j,1),jindx2(j,2),j
-csela enddo
-csela do j=1,nlats
-csela if(me.eq.0) print*,'ddy(j,1) ddy(j,2)',ddy(j,1),ddy(j,2)
-csela enddo
-cyt if(me.eq.0) print*,'completed setindxoz for nasa prod. and diss'
-
- RETURN
- END
-!
-!**********************************************************************
-!
- SUBROUTINE ozinterpol(me,latd,nlats,IDATE,FHOUR,
- & jindx1,jindx2,ozplin,ozplout,ddy)
-!
- USE MACHINE , ONLY : kind_phys
- use ozne_def
- implicit none
- integer iday,j,j1,j2,l,latd,nc,n1,n2
- real(kind=kind_phys) fhour,tem, tx1, tx2
-!
-
- integer JINDX1(LATD), JINDX2(LATD)
- integer me,idate(4),nlats
- integer IDAT(8),JDAT(8)
-!
- real(kind=kind_phys) ozplin(latsozp,levozp,pl_coeff,timeoz)
- real(kind=kind_phys) DDY(LATD)
- real(kind=kind_phys) ozplout(levozp,LATD,pl_coeff)
- real(kind=kind_phys) RINC(5), rjday
- integer jdow, jdoy, jday
-!
- IDAT=0
- IDAT(1)=IDATE(4)
- IDAT(2)=IDATE(2)
- IDAT(3)=IDATE(3)
- IDAT(5)=IDATE(1)
- RINC=0.
- RINC(2)=FHOUR
- CALL W3MOVDAT(RINC,IDAT,JDAT)
-!
- jdow = 0
- jdoy = 0
- jday = 0
- call w3doxdat(jdat,jdow,jdoy,jday)
- rjday = jdoy + jdat(5) / 24.
- IF (RJDAY .LT. PL_time(1)) RJDAY = RJDAY+365.
-!
- n2 = timeoz + 1
- do j=1,timeoz
- if (rjday .lt. pl_time(j)) then
- n2 = j
- exit
- endif
- enddo
- n1 = n2 - 1
- if (n1 <= 0) n1 = n1 + timeoz
- if (n2 > timeoz) n2 = n2 - timeoz
-
-!
-! if (me .eq. 0) print *,' n1=',n1,' n2=',n2,' rjday=',rjday
-! &,'pl_time=',pl_time(n1),pl_time(n2)
-!
-
- tx1 = (pl_time(n2) - rjday) / (pl_time(n2) - pl_time(n1))
- tx2 = 1.0 - tx1
-!
- do nc=1,pl_coeff
- DO L=1,levozp
- DO J=1,nlats
- J1 = JINDX1(J)
- J2 = JINDX2(J)
- TEM = 1.0 - DDY(J)
- ozplout(L,j,nc) =
- & tx1*(TEM*ozplin(J1,L,nc,n1)+DDY(J)*ozplin(J2,L,nc,n1))
- & + tx2*(TEM*ozplin(J1,L,nc,n2)+DDY(J)*ozplin(J2,L,nc,n2))
- ENDDO
- ENDDO
- enddo
-!
- RETURN
- END
-
-!------------------------------------------------------
-!---interpoltion on unstructured grid array
-!--Fanglin Yang, September 2012
-
- SUBROUTINE ozintp_pnt(me,lonr,lats_node_r,xlon,xlat,
- & idate,fhour,ozplin,ozplout)
-!
- USE MACHINE , ONLY : kind_phys
- use ozne_def
- implicit none
-
-!--inout variables
- integer :: me,lonr,lats_node_r,idate(4)
- real(kind=kind_phys):: fhour
- real(kind=kind_phys):: ozplin(latsozp,levozp,pl_coeff,timeoz)
- real(kind=kind_phys):: xlon(lonr,lats_node_r)
- real(kind=kind_phys):: xlat(lonr,lats_node_r)
- real(kind=kind_phys):: ozplout(lonr,levozp,pl_coeff,lats_node_r)
-!
-!--local variables
- integer :: IDAT(8),JDAT(8)
- integer :: iday,i,j,jo,j1,j2,L,latd,nc,n1,n2
- integer :: jdow, jdoy, jday
- real(kind=kind_phys) RINC(5), rjday
- real(kind=kind_phys) :: ylat,dy2y1,ry2y,ryy1, tx1, tx2
- real(kind=kind_phys) :: pi
-!
- pi=4.0*atan(1.0)
-!
- IDAT=0
- IDAT(1)=IDATE(4)
- IDAT(2)=IDATE(2)
- IDAT(3)=IDATE(3)
- IDAT(5)=IDATE(1)
- RINC=0.
- RINC(2)=FHOUR
- CALL W3MOVDAT(RINC,IDAT,JDAT)
-!
- jdow = 0
- jdoy = 0
- jday = 0
- call w3doxdat(jdat,jdow,jdoy,jday)
- rjday = jdoy + jdat(5) / 24.
- IF (RJDAY .LT. PL_time(1)) RJDAY = RJDAY+365.
-!
- n2 = timeoz + 1
- do j=1,timeoz
- if (rjday .lt. pl_time(j)) then
- n2 = j
- exit
- endif
- enddo
- n1 = n2 - 1
- if (n1 <= 0) n1 = n1 + timeoz
- if (n2 > timeoz) n2 = n2 - timeoz
-
-!
-! if (me .eq. 0) print *,' n1=',n1,' n2=',n2,' rjday=',rjday
-! &,'pl_time=',pl_time(n1),pl_time(n2)
-!
-
- tx1 = (pl_time(n2) - rjday) / (pl_time(n2) - pl_time(n1))
- tx2 = 1.0 - tx1
-!
- do j=1,lats_node_r
- do i=1,lonr !unstructured array
- ylat=xlat(i,j)*180/pi
- do jo=1,latsozp-1 !source data lat points
- if( ylat.ge.pl_lat(jo) .and. ylat.lt.pl_lat(jo+1)) then
- j1=jo
- j2=jo+1
- dy2y1=pl_lat(j2)-pl_lat(j1)
- ry2y=(pl_lat(j2)-ylat)/dy2y1
- ryy1=(ylat-pl_lat(j1))/dy2y1
- else if ( ylat.lt.pl_lat(1) ) then
- j1=1
- j2=1
- ry2y=1.0
- ryy1=0.0
- else if ( ylat.ge.pl_lat(latsozp) ) then
- j1=latsozp
- j2=latsozp
- ry2y=0.0
- ryy1=1.0
- endif
- enddo
- do nc=1,pl_coeff
- do L=1,levozp
- ozplout(i,L,nc,j) =
- & tx1*(ry2y*ozplin(j1,L,nc,n1)+ryy1*ozplin(j2,L,nc,n1))
- & + tx2*(ry2y*ozplin(j1,L,nc,n2)+ryy1*ozplin(j2,L,nc,n2))
- enddo
- enddo
- enddo
- enddo
-!
- RETURN
- END
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/radiation_astronomy.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/radiation_astronomy.f 2012-10-22 17:05:55 UTC (rev 2238)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/radiation_astronomy.f 2012-10-22 18:32:56 UTC (rev 2239)
@@ -1,804 +0,0 @@
-!!!!! ========================================================== !!!!!
-!!!!! 'module_radiation_astronomy' description !!!!!
-!!!!! ========================================================== !!!!!
-! !
-! set up astronomy quantities for solar radiation calculations. !
-! !
-! in module 'module_radiation_astronomy', externally accessable !
-! subroutines are listed below: !
-! !
-! 'solinit' -- read in solar constant !
-! input: !
-! ( ISOL, iyear, iydat, me ) !
-! output: !
-! ( none ) !
-! !
-! 'astronomy' -- get astronomy related quantities !
-! input: !
-! ( lons_lar,glb_lats_r,sinlat,coslat,xlon, !
-!! fhswr,jdate,deltim, !
-! fhswr,jdate, !
-! LON2,LATD,LATR,IPT_LATR, lsswr, me) !
-! output: !
-! ( solcon,slag,sdec,cdec,coszen,coszdg) !
-! !
-! !
-! external modules referenced: !
-! 'module machine' in 'machine.f' !
-! 'module physcons' in 'physcons.f !
-! !
-! program history log: !
-! may-06-1977 --- ray orzol, created at gfdl !
-! jul-07-1989 --- kenneth campana !
-! may-15-1998 --- mark iredell y2k compliance !
-! dec-15-2003 --- yu-tai hou combined compjd and fcstim and !
-! rewrite in fortran 90 compatable form !
-! feb-15-2006 --- yu-tai hou add 11-yr solar constant cycle !
-! mar-19-2009 --- yu-tai hou modified solinit for climate !
-! hindcast situation. !
-! !
-!!!!! ========================================================== !!!!!
-!!!!! end descriptions !!!!!
-!!!!! ========================================================== !!!!!
-
-
-
-!========================================!
- module module_radiation_astronomy !
-!........................................!
-!
- use machine, only : kind_phys
- use physcons, only : con_solr, con_pi
- use module_iounitdef, only : NIRADSF
-!
- implicit none
-!
- private
-
-! --- parameter constants
- real (kind=kind_phys), parameter :: degrad = 180.0/con_pi
- real (kind=kind_phys), parameter :: tpi = 2.0 * con_pi
- real (kind=kind_phys), parameter :: hpi = 0.5 * con_pi
-
-! --- module variables:
- real (kind=kind_phys), public :: solc0
-
- public solinit, astronomy
-
-
-! =================
- contains
-! =================
-
-!-----------------------------------
- subroutine solinit &
-!...................................
-
-! --- inputs:
- & ( ISOL, iyear, iydat, me )
-! --- outputs: ( none )
-
-! =================================================================== !
-! !
-! read in solar constant value for a given year !
-! !
-! inputs: !
-! ISOL - =0: use fixed solar constant in "physcon" !
-! =1: use 11-year cycle solar constant from table !
-! iyear - year of the requested data (for ISOL=1 only) !
-! iydat - usually =iyear. if not, it is for hindcast mode, and it !
-! is usually the init cond time and serves as the upper !
-! limit of data can be used. !
-! me - print message control flag !
-! !
-! outputs: (to module variable) !
-! ( none ) !
-! !
-! module variable: !
-! solc0 - solar constant (w/m**2) 1 !
-! !
-! usage: call solinit !
-! !
-! subprograms called: none !
-! !
-! =================================================================== !
-!
- implicit none
-
-! --- input:
- integer, intent(in) :: ISOL, iyear, iydat, me
-
-! --- output: ( none )
-
-! --- local:
- real (kind=kind_phys):: smean, solc1
- integer :: i, iyr, iyr1, iyr2, jyr
- logical :: file_exist
- character :: cline*60, cfile0*26
-
- data cfile0 / 'solarconstantdata.txt' /
-
-!===> ... begin here
-
- if ( ISOL == 0 ) then
- solc0 = con_solr
-
- if ( me == 0 ) then
- print *,' - Using fixed solar constant =', solc0
- endif
-
- return
- endif
-
-! --- ... check to see if the solar constant data file existed
-
- inquire (file=cfile0, exist=file_exist)
- if ( .not. file_exist ) then
- solc0 = con_solr
-
- if ( me == 0 ) then
- print *,' - Using varying solar constant with 11-year cycle'
- print *,' Requested solar data file "',cfile0, &
- & '" not found!'
- print *,' Using the default solar constant value =',solc0, &
- & ' instead!!'
- endif
- else
- iyr = iyear
-
- open (NIRADSF,file=cfile0,form='formatted',status='old')
- rewind NIRADSF
-
- read (NIRADSF, 24) iyr1, iyr2, smean, cline
- 24 format(i4,2x,i4,f8.2,a60)
-
-! --- ... check if there is a upper year limit put on the data table
-
- if ( iyear /= iydat ) then
- if ( iydat-iyr1 < 11 ) then ! need data range at least 11 years
- ! to perform 11-year cycle approx
- if ( me == 0 ) then
- print *,' - Using varying solar constant with 11-year', &
- & ' cycle'
- print *,' *** the requested year',iyear,' and upper ', &
- & 'limit',iydat,' do not fit the range of data ', &
- & 'table of iyr1, iyr2 =',iyr1,iyr2
- print *,' USE FIXED SOLAR CONSTANT=',con_solr
- endif
-
- solc0 = con_solr
- return
-
- elseif ( iydat < iyr2 ) then
-
-! --- ... because the usage limit put on the historical data table,
-! skip those unused data records at first
-
- i = iyr2
- Lab_dowhile0 : do while ( i > iydat )
-! read (NIRADSF,26) jyr, solc1
-! 26 format(i4,f8.2)
- read (NIRADSF,*) jyr, solc1
- i = i - 1
- enddo Lab_dowhile0
-
- iyr2 = iydat ! next record will serve the upper limit
-
- endif ! end if_iydat_block
- endif ! end if_iyear_block
-
- if ( me == 0 ) then
- print *,' - Using varying solar constant with 11-year cycle'
- print *,' Opened solar constant data file: ',cfile0
-!check print *, iyr1, iyr2, smean, cline
- endif
-
- if ( iyr < iyr1 ) then
- Lab_dowhile1 : do while ( iyr < iyr1 )
- iyr = iyr + 11
- enddo Lab_dowhile1
-
- if ( me == 0 ) then
- print *,' *** Year',iyear,' out of table range!', &
- & iyr1, iyr2
- print *,' Using the 11-cycle year (',iyr,' ) value.'
- endif
- elseif ( iyr > iyr2 ) then
- Lab_dowhile2 : do while ( iyr > iyr2 )
- iyr = iyr - 11
- enddo Lab_dowhile2
-
- if ( me == 0 ) then
- print *,' *** Year',iyear,' out of given table range!', &
- & iyr1, iyr2
- print *,' Using the 11-cycle year (',iyr,' ) value.'
- endif
- endif
-
-! --- ... locate the right record year of data
-
- i = iyr2
- Lab_dowhile3 : do while ( i >= iyr1 )
-! read (NIRADSF,26) jyr, solc1
-! 26 format(i4,f8.2)
- read (NIRADSF,*) jyr, solc1
-
- if ( i == iyr .and. iyr == jyr ) then
- solc0 = smean + solc1
- if (me == 0) then
- print *,' CHECK: Solar constant data for year',iyr, &
- & solc1, solc0
- endif
- exit Lab_dowhile3
- else
-!check if (me == 0) print *,' Skip solar const data for year',i
- i = i - 1
- endif
- enddo Lab_dowhile3
-
- close ( NIRADSF )
- endif ! end if_file_exist_block
-
-!
- return
-!...................................
- end subroutine solinit
-!-----------------------------------
-
-
-!-----------------------------------
- subroutine astronomy &
-!...................................
-
-! --- inputs:
- & ( lons_lar,glb_lats_r,sinlat,coslat,xlon, &
-! & fhswr,jdate,deltim, &
- & fhswr,jdate, &
- & LON2,LATD,LATR,IPT_LATR, lsswr, me, &
-! --- outputs:
- & solcon,slag,sdec,cdec,coszen,coszdg &
- & )
-
-! =================================================================== !
-! !
-! astronomy computes solar parameters at forecast time !
-! !
-! inputs: dimension !
-! lons_lar - num of grid pts on a given lat circle (LATR)!
-! glb_lats_r - index for global latitudes (LATR)!
-! sinlat,coslat - sin and cos of latitude (LON2,LATR)!
-! xlon - longitude in radians (LON2*LATD)!
-! fhswr - sw radiation calling interval in hour !
-! jdate - current forecast date and time (8) !
-! (yr, mon, day, t-zone, hr, min, sec, mil-sec) !
-!! deltim - duration of model integration time step in seconds !
-! LON2,LATD,LATR- dimensions for longitude/latitude directions !
-! IPT_LATR - latitude index location indecator !
-! lsswr - logical control flag for sw radiation call !
-! me - integer control flag for diagnostic print out !
-! !
-! outputs: !
-! solcon - sun-earth distance adjusted solar constant (w/m2) !
-! slag - equation of time in radians !
-! sdec, cdec - sin and cos of the solar declination angle !
-! coszen - avg of cosz for daytime only (LON2,LATD)!
-! coszdg - avg of cosz over entire sw call interval(LON2,LATD)!
-! !
-! !
-! external functions called: iw3jdn !
-! !
-! =================================================================== !
-!
- implicit none
-
-! --- input:
- integer, intent(in) :: LON2, LATD, LATR, IPT_LATR, me
- integer, intent(in) :: lons_lar(:), glb_lats_r(:), jdate(:)
-
- logical, intent(in) :: lsswr
-
- real (kind=kind_phys), intent(in) :: sinlat(:,:), coslat(:,:), &
- & xlon(:,:), fhswr
-! & xlon(:,:), fhswr, deltim
-
-! --- output:
- real (kind=kind_phys), intent(out) :: solcon, slag, sdec, cdec, &
- & coszen(:,:), coszdg(:,:)
-
-! --- locals:
- real (kind=kind_phys), parameter :: f24 = 24.0 ! hours/day
- real (kind=kind_phys), parameter :: f1440 = 1440.0 ! minutes/day
-
- real (kind=kind_phys) :: solhr, fjd, fjd1, dlt, r1, alp, solc
-
- integer :: jd, jd1, iyear, imon, iday, ihr, imin
- integer :: iw3jdn
-
-!===> ... begin here
-
- iyear = jdate(1)
- imon = jdate(2)
- iday = jdate(3)
- ihr = jdate(5)
- imin = jdate(6)
-
-! --- ... calculate forecast julian day and fraction of julian day
-
- jd1 = iw3jdn(iyear,imon,iday)
-
-! --- ... unlike in normal applications, where day starts from 0 hr,
-! in astronomy applications, day stats from noon.
-
- if (ihr < 12) then
- jd1 = jd1 - 1
-! fjd1= 0.5 + float(ihr)/f24 ! use next line if imin > 0
- fjd1= 0.5 + float(ihr)/f24 + float(imin)/f1440
- else
-! fjd1= float(ihr - 12)/f24 ! use next line if imin > 0
- fjd1= float(ihr - 12)/f24 + float(imin)/f1440
- endif
-
- fjd1 = fjd1 + jd1
-
- jd = int(fjd1)
- fjd = fjd1 - jd
-
- if (lsswr) then
-
-! --- ... hour of forecast time
-
- solhr = mod( float(ihr), f24 )
-
- call solar &
-! --- inputs:
- & ( jd,fjd, &
-! --- outputs:
- & r1,dlt,alp,slag,sdec,cdec &
- & )
-
-! if (me == 0) print*,'in astronomy completed sr solar'
-
- call coszmn &
-! --- inputs:
- & ( lons_lar,glb_lats_r,xlon,sinlat,coslat, &
-! & fhswr,deltim,solhr,sdec,cdec,slag, &
- & fhswr,solhr,sdec,cdec,slag, &
- & LON2,LATD,IPT_LATR, &
-! --- outputs:
- & coszen,coszdg &
- & )
-
-! if (me == 0) print*,'in astronomy completed sr coszmn'
-
-! --- ... calculate sun-earth distance adjustment factor appropriate for date
-
- solcon = solc0 / (r1*r1)
-
- endif
-
-! --- ... diagnostic print out
-
- if (me == 0) then
-
- call prtime &
-! --- inputs:
- & ( jd, fjd, dlt, alp, r1, slag, solcon &
-! --- outputs: ( none )
- & )
-
- endif
-
-!
- return
-!...................................
- end subroutine astronomy
-!-----------------------------------
-
-
-!-----------------------------------
- subroutine solar &
-!...................................
-
-! --- inputs:
- & ( jd,fjd, &
-! --- outputs:
- & r1,dlt,alp,slag,sdec,cdec &
- & )
-
-! =================================================================== !
-! !
-! solar computes radius vector, declination and right ascension of !
-! sun, and equation of time. !
-! !
-! inputs: !
-! jd - julian day !
-! fjd - fraction of the julian day !
-! !
-! outputs: !
-! r1 - earth-sun radius vector !
-! dlt - declination of sun in radians !
-! alp - right ascension of sun in radians !
-! slag - equation of time in radians !
-! sdec - sine of declination angle !
-! cdec - cosine of declination angle !
-! !
-! usage: call solar !
-! !
-! external subroutines called: none !
-! !
-! program history log: !
-! mar-xx-1989 --- kenneth campana, patterner after original gfdl !
-! code but no calculation of latitude mean cos !
-! solar zenith angle. !
-! fall -1988 --- hualu pan, updated to limit iterations in newton!
-! method and also ccr reduced to avoid non- !
-! convergence. !
-! dec-15-2003 --- yu-tai hou, updated to make fortran 90 compatable!
-! !
-! =================================================================== !
-!
- implicit none
-
-! --- inputs:
- real (kind=kind_phys), intent(in) :: fjd
- integer, intent(in) :: jd
-
-! --- outputs:
- real (kind=kind_phys), intent(out) :: r1, dlt,alp,slag,sdec,cdec
-
-! --- locals:
- real (kind=kind_phys), parameter :: cyear = 365.25 ! days of year
- real (kind=kind_phys), parameter :: ccr = 1.3e-6 ! iteration limit
- real (kind=kind_phys), parameter :: tpp = 1.55 ! days between epoch and
- ! perihelion passage of 1900
- real (kind=kind_phys), parameter :: svt6 = 78.035 ! days between perihelion passage
- ! and march equinox of 1900
- integer, parameter :: jdor = 2415020 ! jd of epoch which is january
- ! 0, 1900 at 12 hours ut
-
- real (kind=kind_phys) :: dat, t1, year, tyear, ec, angin, ador, &
- & deleqn, sni, tini, er, qq, e1, ep, cd, eq, date, em, &
- & cr, w1, tst, sun
-
- integer :: jdoe, iter
-
-!===> ... begin here
-
-! --- ... computes time in julian centuries after epoch
-
- t1 = float(jd - jdor) / 36525.0
-
-! --- ... computes length of anomalistic and tropical years (minus 365 days)
-
- year = 0.25964134e0 + 0.304e-5 * t1
- tyear= 0.24219879E0 - 0.614e-5 * t1
-
-! --- ... computes orbit eccentricity and angle of earth's inclination from t
-
- ec = 0.01675104e0 - (0.418e-4 + 0.126e-6 * t1) * t1
- angin= 23.452294e0 - (0.0130125e0 + 0.164e-5 * t1) * t1
-
- ador = jdor
- jdoe = ador + (svt6 * cyear) / (year - tyear)
-
-! --- ... deleqn is updated svt6 for current date
-
- deleqn= float(jdoe - jd) * (year - tyear) / cyear
- year = year + 365.0
- sni = sin( angin / degrad )
- tini = 1.0 / tan( angin / degrad )
- er = sqrt( (1.0 + ec) / (1.0 - ec) )
- qq = deleqn * tpi / year
-
-! --- ... determine true anomaly at equinox
-
- e1 = 1.0
- cd = 1.0
- iter = 0
-
- lab_do_1 : do while ( cd > ccr )
-
- ep = e1 - (e1 - ec*sin(e1) - qq) / (1.0 - ec*cos(e1))
- cd = abs(e1 - ep)
- e1 = ep
- iter = iter + 1
-
- if (iter > 10) then
- write(6,*) ' ITERATION COUNT FOR LOOP 32 =', iter
- write(6,*) ' E, EP, CD =', e1, ep, cd
- exit lab_do_1
- endif
-
- enddo lab_do_1
-
- eq = 2.0 * atan( er * tan( 0.5*e1 ) )
-
-! --- ... date is days since last perihelion passage
-
- dat = float(jd - jdor) - tpp + fjd
- date = mod(dat, year)
-
-! --- ... solve orbit equations by newton's method
-
- em = tpi * date / year
- e1 = 1.0
- cr = 1.0
- iter = 0
-
- lab_do_2 : do while ( cr > ccr )
-
- ep = e1 - (e1 - ec*sin(e1) - em) / (1.0 - ec*cos(e1))
- cr = abs(e1 - ep)
- e1 = ep
- iter = iter + 1
-
- if (iter > 10) then
- write(6,*) ' ITERATION COUNT FOR LOOP 31 =', iter
- exit lab_do_2
- endif
-
- enddo lab_do_2
-
- w1 = 2.0 * atan( er * tan( 0.5*e1 ) )
-
- r1 = 1.0 - ec*cos(e1)
-
- sdec = sni * sin(w1 - eq)
- cdec = sqrt( 1.0 - sdec*sdec )
-
- dlt = asin( sdec )
- alp = asin( tan(dlt)*tini )
-
- tst = cos( w1 - eq )
- if (tst < 0.0) alp = con_pi - alp
- if (alp < 0.0) alp = alp + tpi
-
- sun = tpi * (date - deleqn) / year
- if (sun < 0.0) sun = sun + tpi
- slag = sun - alp - 0.03255e0
-
-!
- return
-!...................................
- end subroutine solar
-!-----------------------------------
-
-
-!-----------------------------------
- subroutine coszmn &
-!...................................
-
-! --- inputs:
- & ( lons_lar,glb_lats_r,xlon,sinlat,coslat, &
-! & dtswav,deltim,solhr,sdec,cdec,slag, &
- & dtswav,solhr,sdec,cdec,slag, &
- & NLON2,LATD,IPT_LATR, &
-! --- outputs:
- & coszen,coszdg &
- & )
-
-! =================================================================== !
-! !
-! coszmn computes mean cos solar zenith angle over 'dtswav' hours. !
-! !
-! inputs: !
-! lons_lar - num of grid pts on a given lat circle !
-! glb_lats_r - index for global latitude !
-! xlon - longitude in radians !
-! sinlat,coslat - sin and cos of latitude !
-! dtswav - sw radiation calling interval in hour !
-!! deltim - duration of model integration time step in second !
-! solhr - time after 00z in hours !
-! sdec, cdec - sin and cos of the solar declination angle !
-! slag - equation of time !
-! NLON2,LATD - dimensions for longitude/latitude directions !
-! IPT_LATR - latitude index location indecator !
-! !
-! outputs: !
-! coszen - average of cosz for daytime only in sw call interval
-! coszdg - average of cosz over entire sw call interval !
-! !
-! usage: call comzmn !
-! !
-! external subroutines called: none !
-! !
-! program history log: !
-! 05-28-2004 yu-tai hou - modified for gfs hybrid model !
-! !
-! =================================================================== !
-!
- implicit none
-
-! --- inputs:
- integer, intent(in) :: NLON2, LATD, IPT_LATR
- integer, intent(in) :: lons_lar(:), glb_lats_r(:)
-
- real (kind=kind_phys), intent(in) :: sinlat(:,:), coslat(:,:), &
- & xlon(:,:), dtswav, solhr, sdec, cdec, slag
-! & xlon(:,:), dtswav, deltim, solhr, sdec, cdec, slag
-
-! --- outputs:
- real (kind=kind_phys), intent(out) :: coszen(:,:), coszdg(:,:)
-
-! --- locals:
- real (kind=kind_phys) :: coszn(NLON2), pid12, cns, ss, cc
-
- integer :: istsun(NLON2), nstp, istp, nlon, nlnsp, i, it,j,lat,lon
-
-!===> ... begin here
-
- nlon = NLON2 / 2
-
- nstp = 6 ! number of cosz calc per fcst hour
-! nstp = max(6, min(10, nint(3600.0/deltim) )) ! for better time step sync
- istp = nint( dtswav*nstp ) ! total num of calc in dtswav interval
-
-! pid12 = con_pi / 12.0 ! angle per hour
- pid12 = (2.0 * asin(1.0)) / 12.0
-
- do j = 1, LATD
- lat = glb_lats_r(IPT_LATR-1+j)
- nlnsp = lons_lar(lat)
-
- do i = 1, NLON2
- istsun(i) = 0
- coszen(i,j) = 0.0
- enddo
-
- do i = 1, nlnsp
- do it = 1, istp
- cns = pid12 * (solhr - 12.0 + float(it-1)/float(nstp)) + slag
- ss = sinlat(i,lat) * sdec
- cc = coslat(i,lat) * cdec
-
- coszn(i) = ss + cc * cos(cns + xlon(i,j))
- coszen(i,j) = coszen(i,j) + max(0.0, coszn(i))
- if (coszn(i) > 0.0001) istsun(i) = istsun(i) + 1
- enddo
- enddo
-
-! --- ... compute time averages
-
- do i = 1, NLON2
- coszdg(i,j) = coszen(i,j) / float(istp)
- if (istsun(i) > 0) coszen(i,j) = coszen(i,j) / istsun(i)
- enddo
- enddo
-
-!
- return
-!...................................
- end subroutine coszmn
-!-----------------------------------
-
-
-!-----------------------------------
- subroutine prtime &
-!...................................
-
-! --- inputs:
- & ( jd, fjd, dlt, alp, r1, slag, solc &
-! --- outputs: ( none )
- & )
-
-! =================================================================== !
-! !
-! prtime prints out forecast date, time, and astronomy quantities. !
-! !
-! inputs: !
-! jd - forecast julian day !
-! fjd - forecast fraction of julian day !
-! dlt - declination angle of sun in radians !
-! alp - right ascension of sun in radians !
-! r1 - earth-sun radius vector in meter !
-! slag - equation of time in radians !
-! solc - solar constant in w/m^2 !
-! !
-! outputs: ( none ) !
-! !
-! usage: call prtime !
-! !
-! external subroutines called: w3fs26 !
-! !
-! program history log: !
-! jun-07-1977 --- robert white (gfdl) !
-! jul-07-1989 --- kenneth campana !
-! may-15-1998 --- mark iredell y2k compliance !
-! dec-18-2003 --- yu-tai hou combine cdate and prtime and !
-! rewrite in fortran 90 compatable form !
-! !
-! =================================================================== !
-!
- implicit none
-
-! --- inputs:
- integer, intent(in) :: jd
-
- real (kind=kind_phys), intent(in) :: fjd, dlt, alp, r1, slag, solc
-
-! --- outputs: ( none )
-
-! --- locals:
- real (kind=kind_phys), parameter :: sixty = 60.0
-
- character(LEN=1), parameter :: sign = '-'
- character(LEN=1), parameter :: sigb = ' '
-
- character(LEN=1) :: dsig
- character(LEN=4) :: month(12)
-
- data month / 'JAN.','FEB.','MAR.','APR.','MAY ','JUNE', &
- & 'JULY','AUG.','SEP.','OCT.','NOV ','DEC.' /
-
- integer :: iday, imon, iyear, ihr, ltd, ltm, &
- & ihalp, iyy, jda, mfjd, idaywk, idayyr
- real (kind=kind_phys) :: xmin, dltd, dltm, dlts, halp, ymin, &
- & asec, eqt, eqsec
-
-!===> ... begin here
-
-! --- ... get forecast hour and minute from fraction of julian day
-
- if (fjd >= 0.5) then
- jda = jd + 1
- mfjd= nint( fjd*1440.0 )
- ihr = mfjd / 60 - 12
- xmin= float(mfjd) - (ihr + 12)*sixty
- else
- jda = jd
- mfjd= nint( fjd*1440.0 )
- ihr = mfjd / 60 + 12
- xmin= float(mfjd) - (ihr - 12)*sixty
- endif
-
-! --- ... get forecast year, month, and day from julian day
-
- call w3fs26(jda, iyear,imon,iday, idaywk,idayyr)
-
-! -- ... compute solar parameters
-
- dltd = degrad * dlt
- ltd = dltd
- dltm = sixty * (abs(dltd) - abs(float(ltd)))
- ltm = dltm
- dlts = sixty * (dltm - float(ltm))
-
- if ((dltd < 0.0) .and. (ltd == 0.0)) then
- dsig = sign
- else
- dsig = sigb
- endif
-
- halp = 6.0 * alp / hpi
- ihalp= halp
- ymin = abs(halp - float(ihalp)) * sixty
- iyy = ymin
- asec = (ymin - float(iyy)) * sixty
-
- eqt = 228.55735 * slag
- eqsec= sixty * eqt
-
- print 101, iday, month(imon), iyear, ihr, xmin, jd, fjd
- 101 format('0 FORECAST DATE',9x,i3,a5,i6,' AT',i3,' HRS',f6.2,' MINS'/&
- & ' JULIAN DAY',12x,i8,2x,'PLUS',f11.6)
-
- print 102, r1, halp, ihalp, iyy, asec
- 102 format(' RADIUS VECTOR',9x,f10.7/' RIGHT ASCENSION OF SUN', &
- & f12.7,' HRS, OR',i4,' HRS',i4,' MINS',f6.1,' SECS')
-
- print 103, dltd, dsig, ltd, ltm, dlts, eqt, eqsec, slag, solc
- 103 format(' DECLINATION OF THE SUN',f12.7,' DEGS, OR ',a1,i3, &
- & ' DEGS',i4,' MINS',f6.1,' SECS'/' EQUATION OF TIME',6x, &
- & f12.7,' MINS, OR',f10.2,' SECS, OR',f9.6,' RADIANS'/ &
- & ' SOLAR CONSTANT',8X,F12.7,' (DISTANCE AJUSTED)'//)
-
-!
- return
-!...................................
- end subroutine prtime
-!-----------------------------------
-
-!
-!...........................................!
- end module module_radiation_astronomy !
-!===========================================!
</font>
</pre>