<p><b>fanglin.yang@noaa.gov</b> 2012-05-10 17:36:12 -0600 (Thu, 10 May 2012)</p><p>reorganize structure 05-10-2012<br>
</p><hr noshade><pre><font color="gray">Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/GFS_Initialize.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/GFS_Initialize.f 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/GFS_Initialize.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,1129 +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 cmp_comm , only : Coupler_id
-
-
- IMPLICIT none
-
- CONTAINS
-
-!=============================================================================================
-!fy SUBROUTINE GFS_Initialize(gcGFS, gis, clock, rc)
- SUBROUTINE GFS_Initialize(me,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) :: 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
-
-!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
- if(latg.lt.1) latg=880 !total latitudinal points, not really used
-
-!---------------
-
-!
- 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)
-
-!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(LONR,LATS_NODE_R)=xlon_mpas(i)
- XLAT(LONR,LATS_NODE_R)=xlat_mpas(i)
- enddo
- enddo
-!----for MPAS
-
-!fy????????????????????????????????? needed
-!fy 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)
-!fy CALL countperf(1,18,0.)
-!fy 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.)
-!
- END SUBROUTINE GFS_Initialize
-!
- END MODULE GFS_Initialize_module
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/GFS_InternalState.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/GFS_InternalState.f 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/GFS_InternalState.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,322 +0,0 @@
-!
-! !MODULE: GFS_InternalState_module --- Internal state definition of the
-! ESMF gridded component of the GFS system.
-!
-! !DESCRIPTION: GFS_InternalState_module --- Define the GFS internal state used to
-! create the ESMF internal state.
-!---------------------------------------------------------------------------
-! !REVISION HISTORY:
-!
-! November 2004 Weiyu Yang Initial code.
-! May 2005 Weiyu Yang for the updated GFS version.
-! February 2006 Shrinivas Moorthi updated for the new version of GFS
-! September2006 Weiyu Yang For the ensemble run couple version.
-! April 2009 Shrinivas Moorthi merge GEFS and generalized GFS versions
-! May 2012 Fanglin Yang simplified for use in MAPS without ESMF
-!
-! !INTERFACE:
-!
- MODULE GFS_InternalState_module
-
-!!USES:
-!------
-!fy USE ESMF_Mod
-USE NameList_ESMFMod, ONLY: nam_gfs_Namelist
-
- USE MACHINE, ONLY: kind_rad, kind_phys, kind_io4, kind_evod
- USE layout1
- USE gg_def
- USE vert_def
- USE sig_io
- USE date_def
- USE namelist_def
- USE namelist_soilveg
- USE mpi_def
-!!!!!! USE semi_lag_def
- USE coordinate_def ! hmhj
- USE tracer_const ! hmhj
-!fy USE matrix_sig_def
- use module_ras , only : nrcmax
- use ozne_def
- use d3d_def
- use Sfc_Flx_ESMFMod
- use Nst_Var_ESMFMod
-
- IMPLICIT none
-
- TYPE GFS_InternalState
-
-!fy TYPE(nam_gfs_NameList) :: nam_gfs
-!fy TYPE(ESMF_State_Namelist) :: ESMF_Sta_List
-
- TYPE(Sfc_Var_Data) :: sfc_fld
- TYPE(Flx_Var_Data) :: flx_fld
- TYPE(Nst_Var_Data) :: nst_fld
-
- INTEGER :: me, mm1, nodes
- INTEGER :: lonr_s, latr_s, lnt2_s
- INTEGER :: lnt2, grid4_i1(2)
- integer :: grib_inp
- INTEGER :: npe_single_member
-
- REAL(KIND = kind_io4), DIMENSION(:, :), POINTER :: &
- z_im, ps_im, vor_im, div_im, temp_im, q_im, oz_im, scld_im, &
- z_ex, ps_ex, vor_ex, div_ex, temp_ex, q_ex, oz_ex, scld_ex
-
- REAL(KIND = kind_evod), DIMENSION(:, :), POINTER :: trieo_ls_im
- REAL(KIND = kind_evod), DIMENSION(:, :), POINTER :: write_work8
- REAL(KIND = kind_evod), DIMENSION(:, :), POINTER :: write_work8_ini
-
-!
-! idate1_im and idate1_ex: (1) --- bfhour (integer), (2) - (5) --- idate.
-!-------------------------------------------------------------------------
-!
- INTEGER, DIMENSION(:, :), POINTER :: idate1_im, idate1_ex
-
- REAL(KIND = kind_io4), DIMENSION(:, :), POINTER :: &
- orography_im, t_skin_im, snow_depth_im, &
- deep_soil_t_im, roughness_im, conv_cloud_cover_im, &
- conv_cloud_base_im, conv_cloud_top_im, albedo_visible_scattered_im,&
- albedo_visible_beam_im, albedo_nearIR_scattered_im, albedo_nearIR_beam_im, &
- sea_level_ice_mask_im, vegetation_cover_im, canopy_water_im, &
- m10_wind_fraction_im, vegetation_type_im, soil_type_im, &
- zeneith_angle_facsf_im, zeneith_angle_facwf_im, uustar_im, &
- ffmm_im, ffhh_im, sea_ice_thickness_im, &
- sea_ice_concentration_im, tprcp_im, srflag_im, &
- actual_snow_depth_im, vegetation_cover_min_im, vegetation_cover_max_im, &
- slope_type_im, snow_albedo_max_im, &
-
-! MOdified by Weiyu (DHOU, 04/04/2008).
-!-------------------
- soil_t_im1, soil_t_im2, soil_t_im3, soil_mois_im1, soil_mois_im2, soil_mois_im3, &
- liquid_soil_moisture_im1, liquid_soil_moisture_im2, liquid_soil_moisture_im3, &
-
- orography_ex, t_skin_ex, snow_depth_ex, &
- deep_soil_t_ex, roughness_ex, conv_cloud_cover_ex, &
- conv_cloud_base_ex, conv_cloud_top_ex, albedo_visible_scattered_ex,&
- albedo_visible_beam_ex, albedo_nearIR_scattered_ex, albedo_nearIR_beam_ex, &
- sea_level_ice_mask_ex, vegetation_cover_ex, canopy_water_ex, &
- m10_wind_fraction_ex, vegetation_type_ex, soil_type_ex, &
- zeneith_angle_facsf_ex, zeneith_angle_facwf_ex, uustar_ex, &
- ffmm_ex, ffhh_ex, sea_ice_thickness_ex, &
- sea_ice_concentration_ex, tprcp_ex, srflag_ex, &
- actual_snow_depth_ex, vegetation_cover_min_ex, vegetation_cover_max_ex, &
- slope_type_ex, snow_albedo_max_ex
-
- REAL(KIND = kind_io4), DIMENSION(:, :, :), POINTER :: &
- soil_mois_im, soil_t_im, soil_mois_ex, soil_t_ex, &
- liquid_soil_moisture_im, liquid_soil_moisture_ex
-
-! To represent the trie_ls and trio_ls in the ESMF states, add levh. Weiyu.
-!--------------------------------------------------------------------------
-
-! INTEGER ntrac,nxpt,nypt,jintmx,jcap,levs,levh,lonf,lonr,latg,latr
- INTEGER ntrac,jcapg,jcap,levs,levh,lonf,lonr,latg,latr
- INTEGER ntoz, ntcw, ncld, lsoil, nmtvr, num_p3d, num_p2d,levr
-
- CHARACTER(16) :: CFHOUR1
-
- INTEGER :: KDT
- REAL :: DELTIM
-
-! For creating the ESMF interface state with the GFS
-! internal parallel structure. Weiyu.
-!---------------------------------------------------
- INTEGER :: TRIEO_TOTAL_SIZE
- INTEGER, ALLOCATABLE, DIMENSION(:) :: TRIE_LS_SIZE, TRIO_LS_SIZE
- INTEGER, ALLOCATABLE, DIMENSION(:) :: TRIEO_LS_SIZE
- INTEGER, ALLOCATABLE, DIMENSION(:) :: LS_MAX_NODE_GLOBAL
- INTEGER, ALLOCATABLE, DIMENSION(:, :) :: LS_NODE_GLOBAL
-
-! For flexible choose the time interval of the tendency time difference.
-!-----------------------------------------------------------------------
- INTEGER :: advanceCount_SetUp
-
-!fy CHARACTER(ESMF_MAXSTR) :: TRIEO_STATE_NAME
-!fy CHARACTER(ESMF_MAXSTR) :: TRIEO_STINI_NAME
-
- INTEGER ,ALLOCATABLE :: LONSPERLAT (:)
- INTEGER ,ALLOCATABLE :: lonsperlar (:)
- INTEGER ,ALLOCATABLE :: LS_NODE (:)
- INTEGER ,ALLOCATABLE :: LS_NODES (:, :)
- INTEGER ,ALLOCATABLE :: MAX_LS_NODES (:)
-
- INTEGER ,ALLOCATABLE :: LATS_NODES_A (:)
- INTEGER ,ALLOCATABLE :: GLOBAL_LATS_A (:)
-! INTEGER ,ALLOCATABLE :: LATS_NODES_EXT (:)
-! INTEGER ,ALLOCATABLE :: GLOBAL_LATS_EXT(:)
-
- INTEGER ,ALLOCATABLE :: LATS_NODES_R (:)
- INTEGER ,ALLOCATABLE :: GLOBAL_LATS_R (:)
-
- real(kind=kind_phys) ,allocatable :: fscav(:)
-
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: EPSE (:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: EPSO (:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: EPSEDN(:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: EPSODN(:)
-
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: SNNP1EV(:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: SNNP1OD(:)
-
- INTEGER ,ALLOCATABLE :: NDEXEV(:)
- INTEGER ,ALLOCATABLE :: NDEXOD(:)
-
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNEV_A(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNOD_A(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PDDEV_A(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PDDOD_A(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNEW_A(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNOW_A(:,:)
-
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNEV_R(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNOD_R(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PDDEV_R(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PDDOD_R(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNEW_R(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PLNOW_R(:,:)
-
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: TRIE_LS(:,:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: TRIO_LS(:,:,:)
-
-! For Ensemble forecast requirement, add two more arrays to save the
-! initial conditions. Weiyu.
-!------------------------------------------------------------------
- REAL(KIND=KIND_EVOD) , POINTER :: TRIE_LS_INI(:,:,:)
- REAL(KIND=KIND_EVOD) , POINTER :: TRIO_LS_INI(:,:,:)
-
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: SYN_LS_A(:,:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: DYN_LS_A(:,:,:)
-
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: SYN_GR_A_1(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: SYN_GR_A_2(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: DYN_GR_A_1(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: DYN_GR_A_2(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: ANL_GR_A_1(:,:)
- REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: ANL_GR_A_2(:,:)
-
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: XLON(:,:),XLAT(:,:)
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: COSZDG(:,:)
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: sfalb(:,:)
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: HPRIME(:,:,:)
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: SWH(:,:,:),HLW(:,:,:)
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: FLUXR(:,:,:)
-!!
-
-! REAL(KIND=KIND_RAD) ,ALLOCATABLE :: phy_f3d(:,:,:,:,:)
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: phy_f3d(:,:,:,:)
- REAL(KIND=KIND_RAD) ,ALLOCATABLE :: phy_f2d(:,:,:)
-
-!JFE REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: LBASIY(:,:,:)
-!JFE REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PHI(:)
-!JFE REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: DPHI(:)
-!JFE REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: DLAM(:),LAMEXT(:,:),LAM(:,:)
-!JFE REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: LAMMP(:,:,:)
-!JFE REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: PHIMP(:,:,:)
-!JFE REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: SIGMP(:,:,:)
-!!
-! FOR OZONE PRODUCTION AND DISTRUCTION RATES:(INPUT THROU FIXIO_R)
- INTEGER LEV,LEVMAX
-!!$$$ PARAMETER (LATS18=18, LEV46=46)
-!!$$$ REAL POZ(LEV46),PHOUR
-!!$$$ REAL OZPRDIN(LATS18,LEV46,36) !OZON PRODUCTION RATE
-!!$$$ REAL OZDISIN(LATS18,LEV46,36) !OZON DISTUCTION RATE
- real phour
- INTEGER :: KFHOUR
- real, allocatable :: poz(:),ozplin(:,:,:,:)
-! FOR OZONE INTERPOLATION:
- INTEGER,ALLOCATABLE:: JINDX1(:),JINDX2(:)
-!
- REAL (KIND=KIND_PHYS) PDRYINI
- REAL,ALLOCATABLE:: DDY(:)
- REAL(KIND=KIND_EVOD) SLAG,SDEC,CDEC
-!!
-!JFE INTEGER,ALLOCATABLE :: LATSINPE(:)
-!JFE INTEGER,ALLOCATABLE :: LATLOCAL(:,:)
-
- INTEGER INIT,JCOUNT,JPT,NODE
- INTEGER IBMSIGN
- INTEGER LON_DIM,ILAT
-
- real(kind=kind_evod) colat1
-!!
- REAL(KIND=KIND_EVOD) RONE
- REAL(KIND=KIND_EVOD) RLONS_LAT
- REAL(KIND=KIND_EVOD) SCALE_IBM
-
- INTEGER P_GZ,P_ZEM,P_DIM,P_TEM,P_RM,P_QM
- INTEGER P_ZE,P_DI,P_TE,P_RQ,P_Q,P_DLAM,P_DPHI,P_ULN,P_VLN
- INTEGER P_W,P_X,P_Y,P_RT,P_ZQ
-!C OLD COMMON /COMFSPEC/
-!!$$$ PARAMETER(P_GZ = 0*LEVS+0*LEVH+1, ! GZE/O(LNTE/OD,2),
-!!$$$ X P_ZEM = 0*LEVS+0*LEVH+2, ! ZEME/O(LNTE/OD,2,LEVS),
-!!$$$ X P_DIM = 1*LEVS+0*LEVH+2, ! DIME/O(LNTE/OD,2,LEVS),
-!!$$$ X P_TEM = 2*LEVS+0*LEVH+2, ! TEME/O(LNTE/OD,2,LEVS),
-!!$$$ X P_RM = 3*LEVS+0*LEVH+2, ! RME/O(LNTE/OD,2,LEVH),
-!!$$$ X P_QM = 3*LEVS+1*LEVH+2, ! QME/O(LNTE/OD,2),
-!!$$$ X P_ZE = 3*LEVS+1*LEVH+3, ! ZEE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_DI = 4*LEVS+1*LEVH+3, ! DIE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_TE = 5*LEVS+1*LEVH+3, ! TEE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_RQ = 6*LEVS+1*LEVH+3, ! RQE/O(LNTE/OD,2,LEVH),
-!!$$$ X P_Q = 6*LEVS+2*LEVH+3, ! QE/O(LNTE/OD,2),
-!!$$$ X P_DLAM= 6*LEVS+2*LEVH+4, ! DPDLAME/O(LNTE/OD,2),
-!!$$$ X P_DPHI= 6*LEVS+2*LEVH+5, ! DPDPHIE/O(LNTE/OD,2),
-!!$$$ X P_ULN = 6*LEVS+2*LEVH+6, ! ULNE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_VLN = 7*LEVS+2*LEVH+6, ! VLNE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_W = 8*LEVS+2*LEVH+6, ! WE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_X = 9*LEVS+2*LEVH+6, ! XE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_Y =10*LEVS+2*LEVH+6, ! YE/O(LNTE/OD,2,LEVS),
-!!$$$ X P_RT =11*LEVS+2*LEVH+6, ! RTE/O(LNTE/OD,2,LEVH),
-!!$$$ X P_ZQ =11*LEVS+3*LEVH+6) ! ZQE/O(LNTE/OD,2)
-
- INTEGER LOTS,LOTD,LOTA
-
-!!$$$ PARAMETER ( LOTS = 5*LEVS+1*LEVH+3 )
-!!$$$ PARAMETER ( LOTD = 6*LEVS+2*LEVH+0 )
-!!$$$ PARAMETER ( LOTA = 3*LEVS+1*LEVH+1 )
-
- INTEGER IBRAD,IFGES,IHOUR,INI,J,JDT,KSOUT,MAXSTP
- INTEGER mdt,idt,timetot,timer,time0
- INTEGER MODS,N1,N2,N3,N4,NDGF,NDGI,NFILES,NFLPS
- INTEGER n1hyb, n2hyb
- INTEGER NGES,NGPKEN,NITER,NNMOD,NRADF,NRADR
- INTEGER NSFCF,NSFCI,NSFCS,NSIGI,NSIGS,NSTEP
-! INTEGER NZNLF,NZNLI,NZNLS,ID,IRET,NSOUT
- INTEGER NZNLF,NZNLI,NZNLS,ID,IRET,NSOUT,kdt_switch
-
- INTEGER IERR,IPRINT,K,L,LOCL,N
- INTEGER LAN,LAT
-
- REAL(KIND=KIND_EVOD) CHOUR
- REAL(KIND=KIND_EVOD) zhour
- LOGICAL LSOUT
- LOGICAL SPS
-!DHOU 05/28/2008, add SPS for applying stochastic or not
- INTEGER HOUTASPS
-!DHOU 09/08/2008, add HOUTASPS for time (iintegration hour) of output after SPS
-
- REAL(KIND=KIND_EVOD),ALLOCATABLE :: TEE1(:)
-
-!JFE REAL(KIND=KIND_EVOD) PHIBS,DPHIBR
-
-!!$$$ INTEGER INDLSEV,JBASEV
-!!$$$ INTEGER INDLSOD,JBASOD
-
-
- INTEGER ikey,nrank_all,kcolor
-
- REAL(KIND=KIND_EVOD) CONS0P5,CONS1200,CONS3600 !CONSTANT
- REAL(KIND=KIND_EVOD) CONS0 !CONSTANT
-
- LOGICAL LSLAG
-
- END TYPE GFS_InternalState
-
-! This state is supported by C pointer not F90 pointer, thus
-! need this wrap.
-!-----------------------------------------------------------
- TYPE GFS_wrap
- TYPE (GFS_InternalState), POINTER :: gis
- END TYPE GFS_wrap
-
- END MODULE GFS_InternalState_module
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.ibm
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.ibm 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.ibm 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,671 +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
-
-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
-
-ESMFLIB = /nwprod/lib
-LDFLAGS = -lessl_r -lmass -qsmp=noauto ${ESMFLIB}/libesmf_3_1_0rp2.a $(PGSZ)
-LIBS = -lC -L /nwprod/lib/ -l w3_d -l bacio_4 -lsp_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 \
- GFS_Initialize.o
-
-
-
-OBJS = \
- gcycle.o\
- compns.o\
- fix_fields.o\
- dotstep.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 \
- gloopr.o \
- gloopb.o \
- grrad.o
-
-#
-#gloopb.o
-#gbphys_adv_hyb_gc.o
-#gbphys_adv_hyb_gc_h-new.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
-
-#omegtes.o \
-#omegtes_gc.o \
-#omegas.o \
-#hyb2sig.o \
-#hyb2press.o \
-#hyb2press_gc.o \
-#sig2press.o
-
-
-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 \
-#cmp.comm.o \
-#tiles.o
-
-SRC = $(OBJS0:.o=.f) $(OBJ_MOD:.o=.f) $(OBJS:.o=.f) $(OBJS_RAD:.o=.f) $(OBJS_PHY:.o=.f) $(OBJS_IO:.o=.f) $(OBJS_CC:.o=.f)
-#
-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/physics_gfs/Makefile.jet
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.jet 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/Makefile.jet 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,678 +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_0rp2
- 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_0rp2 -threads
-##LIBS = -lstdc++ -limf -lm -lrt -ldl -threads -L$(LIBDIR) -lsp_d -lw3lib-2.0_d -lbacio_4 -lesmf_3_1_0rp2 -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_0rp2 -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 \
- 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
Added: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/atm.comm.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/atm.comm.f (rev 0)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/atm.comm.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -0,0 +1,1223 @@
+ 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
+
+ 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
+
+ CALL ATM_ANNOUNCE(
+ >'ATM_TILES_INIT: global_lats_r, lonsperlar assigned',2)
+ if (VerbLev.ge.2) then
+ print*,'AM: ATM_TILES_INIT',component_master_rank_local,
+ > ' ipt_lats_node_r=',ipt_lats_node_r,' latd=',latd
+ print*,'AM: ATM_TILES_INIT',component_master_rank_local,
+ > ' global_lats_r: ',global_lats_r
+ print*,'AM: ATM_TILES_INIT',component_master_rank_local,
+ > ' lonsperlar: ',lonsperlar
+ end if
+
+ 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/physics_gfs/dotstep.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/dotstep.f 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/dotstep.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,226 +0,0 @@
-!--This subroutine is modified based on NCEP/GFS dotstep_tracers.f
-! for running MPAS with GFS physics.
-!
-!=========================================================================
- SUBROUTINE do_tstep_gfs(sfc_mpas,air_mpas,dt_mpas,
- & kdt_mpas,fhour_mpas,idate_mpas,levs_mpas,
- & ncell_mpas,nsfc_mpas,nair_mpas,xlat_mpas,
- & 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,levh,levs,
- & lonr,lsoil,nfxr,nmtvr,
- & ntoz,ntrac,ncld,num_p2d,num_p3d
- use layout1 , only : lats_node_r,me
- 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
-!!
-!! real(kind_phys), parameter :: pi=3.1415926535897931
- integer :: IERR,I,J,K,L,LOCL,N
- real*8 :: dt_warm, tem1, tem2
- integer ifirst
- data ifirst /1/
- save ifirst
-
-!-----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) :: sfc_mpas(nsfc_mpas,ncell_mpas)
- real(kind=kind_phys) :: air_mpas(nair_mpas,ncell_mpas,levs_mpas)
-
-! --mp_pi : model interface level pressure in centibar
-! --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--------
-
-!****************************************************************************
-
-!--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(node0_mpas,fhour_mpas,levs_mpas,ncell_mpas,
- & xlon_mpas,xlat_mpas,lats_node_r,dt_mpas,nlunit_mpas,
- & gfs_namelist_mpas)
-
- nodes=nodes_mpas
- me=node0_mpas
- 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
- ifirst=0
- endif
-
- allocate ( mp_pi(lonr,levp1,lats_node_r) )
- allocate ( mp_pl(lonr,levs,lats_node_r) )
- allocate ( mp_u(lonr,levs,lats_node_r) )
- allocate ( mp_v(lonr,levs,lats_node_r) )
- allocate ( mp_t(lonr,levs,lats_node_r) )
- allocate ( mp_w(lonr,levs,lats_node_r) )
- allocate ( mp_q(lonr,levs,lats_node_r) )
- allocate ( mp_tr(lonr,levs,ntrac-1,lats_node_r) )
-
-
- kdt=kdt_mpas
- fhour=fhour_mpas
- phour=fhour_mpas
-!------------------------------------------------------------
-
-!! if(.not. adiab) then
-!! if (nscyc > 0 .and. mod(kdt,nscyc) == 1) then
-!! CALL gcycle(me,LATS_NODE_R,LONSPERLAR,global_lats_r,
-!! & ipt_lats_node_r,idate,fhour,fhcyc,
-!! & XLON ,XLAT , sfc_fld, ialb)
-!! endif
-!
-!! if (num_p3d == 3) then ! Ferrier Microphysics initialization
-!! call init_micro(deltim,lonr,levs,num_p3d,lats_node_r,
-!! & phy_f3d(1,1,1,1), fhour, me)
-!! endif
-!! endif
-!
-
- if (nst_fcst > 1) then ! update TSEA
- if (Coupler_id < 0 .or. .not. mom4ice) then ! Standalone mode
- do j = 1, lats_node_r
- do i = 1, lonr
- if (sfc_fld%slmsk(i,j) == 0 ) then
- dt_warm = (nst_fld%xt(i,j)+nst_fld%xt(i,j))
- & / nst_fld%xz(i,j)
- sfc_fld%TSEA(i,j) = nst_fld%tref(i,j)
- & + dt_warm - nst_fld%dt_cool(i,j)
- & - sfc_fld%oro(i,j)*rlapse
- endif
- enddo
- enddo
- else ! Coupled to MOM4 OM
- tem1 = 0.5 / omz1
- do j = 1, lats_node_r
- do i = 1, lonr
- if (sfc_fld%slmsk(i,j) == 0 ) then
- tem2 = 1.0 / nst_fld%xz(i,j)
- sfc_fld%tsea(i,j) = sfc_fld%tsea(i,j)
- & + sfc_fld%oro(i,j)*rlapse
- dt_warm = (nst_fld%xt(i,j)+nst_fld%xt(i,j)) * tem2
-
- if ( nst_fld%xz(i,j) > omz1) then
- nst_fld%tref(i,j) = sfc_fld%tsea(i,j)
- & - (1.0-0.5*omz1*tem2) * dt_warm
- & + nst_fld%z_c(i,j)*nst_fld%dt_cool(i,j)*tem1
- else
- nst_fld%tref(i,j) = sfc_fld%tsea(i,j)
- & - (nst_fld%xz(i,j)*dt_warm
- & - nst_fld%z_c(i,j)*nst_fld%dt_cool(i,j))*tem1
- endif
- sfc_fld%TSEA(i,j) = nst_fld%tref(i,j)
- & + dt_warm - nst_fld%dt_cool(i,j)
- & - sfc_fld%oro(i,j)*rlapse
- endif
- enddo
- enddo
- endif
- endif
-
- if (lsswr .or. lslwr) then ! Radiation Call!
- if(.not. adiab) then
- call gloopr
-!---input
- & (phour,kdt,lonsperlar,global_lats_r,xlon,xlat,
- & sfc_fld%slmsk,sfc_fld%sheleg,
- & sfc_fld%zorl, sfc_fld%tsea,
- & sfc_fld%alvsf, sfc_fld%alnsf, sfc_fld%alvwf,
- & sfc_fld%alnwf, sfc_fld%facsf, sfc_fld%facwf,
- & sfc_fld%cv, sfc_fld%cvt, sfc_fld%cvb, sfc_fld%FICE,
- & sfc_fld%tisfc, sfc_fld%sncovr, sfc_fld%snoalb,
- & hprime,phy_f3d,
- & mp_pi,mp_pl,mp_t,mp_q,mp_w,mp_tr,
-!--in and out
- & fluxr,
-!--output
- & swh,hlw,
- & coszdg, flx_fld%coszen, flx_fld%sfcnsw,
- & flx_fld%sfcdlw, flx_fld%tsflw,
- & flx_fld%sfcdsw, sfalb, flx_fld%sfcemis,
- & slag,sdec,cdec)
- endif
- endif !sswr .or. lslwr
-
-
- if(.not. adiab) then
- call gloopb
- & (phour,kdt,deltim,lonsperlar,global_lats_r,
- & lsout,fscav,xlon,xlat,
- & sfc_fld, flx_fld, nst_fld, sfalb,
- & swh,hlw,hprime,slag,sdec,cdec,
- & ozplin,jindx1,jindx2,ddy,
- & phy_f3d, phy_f2d,
- & mp_pi,mp_pl,mp_t,mp_q,mp_u,
- & mp_v,mp_w,mp_tr)
- endif
-
-!
- IF (mod(kdt,nszer) == 0 .and. lsout) THEN
- call flx_init(flx_fld,ierr)
- zhour = fhour
- FLUXR = 0.
-!
- if (ldiag3d .or. lggfs3d) then
- call d3d_zero(ldiag3d,lggfs3d)
- if (fhour >= fhgoc3d) lggfs3d = .false.
- endif
- ENDIF
-!
-
- deallocate (mp_pi,mp_pl,mp_t,mp_u,mp_v,mp_w)
- deallocate (mp_q,mp_tr)
-
- RETURN
- END
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gfsmisc_def.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gfsmisc_def.f 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gfsmisc_def.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -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_rad), 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/physics_gfs/gloopb.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopb.f 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopb.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,696 +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
- real ozplout(levozp,lats_node_r,pl_coeff)
-!Moor 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
-!
-!
-!----------------------
- 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
- call ozinterpol(me,lats_node_r,lats_node_r,idate,fhour,
- & jindx1,jindx2,ozplin,ozplout,ddy)
-
-!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.
-
-!$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,gtv,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.e0-5*prsi(j,k))**con_rocp
- enddo
- enddo
- do k=1,levs
- do j=1,njeff
- jtem = lon-1+j
- vvel(j,k) = mp_w(jtem,k,lan) *1000.0 !from cb/s to pa/s
- prsl(j,k) = mp_pl(jtem,k,lan) *1000.0 !from cb to pa
- prslk(j,k) = (1.0e-5*prsl(j,k))**con_rocp
- ugrd(j,k) = mp_u(jtem,k,lan)
- vgrd(j,k) = mp_v(jtem,k,lan)
- gt(j,k) = mp_t(jtem,k,lan)
- gr(j,k,1) = mp_q(jtem,k,lan)
- do n=1,ntrac-1
- gr(j,k,n+1) = mp_tr(jtem,k,n,lan)
- enddo
- 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,lat)
- coslat_v(i) = coslat_r2(lon,lat)
- 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,ngptc
-!Moorthi ozplout_v(i,k,j) = ozplout(lon+i-1,k,j,lan)
- 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
- & )
-!!
-!!
- prsi = prsi * 0.001 ! Convert from Pa to kPa
-
-!---prepare output
- do k=1,levs+1
- do j=1,njeff
- jtem = lon-1+j
- mp_pi(jtem,k,lan)=0.001*prsi(j,k) !convert from pa to cb
- enddo
- enddo
- do k=1,levs
- do j=1,njeff
- jtem = lon-1+j
- mp_w(jtem,k,lan) = 0.001*vvel(j,k) !from pa/s to cb/s
- mp_pl(jtem,k,lan) = 0.001*prsl(j,k) !convert from pa to cb
- mp_u(jtem,k,lan) = ugrd(j,k)
- mp_v(jtem,k,lan) = vgrd(j,k)
- mp_t(jtem,k,lan) = gt(j,k)
- mp_q(jtem,k,lan) = gr(j,k,1) !specific humidity
- do n=1,ntrac-1
- mp_tr(jtem,k,n,lan) = gr(j,k,n+1)
- enddo
- enddo
- enddo
-
- do k=1,lsoil
- do i=1,njeff
- item = lon + i - 1
- 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/physics_gfs/gloopr.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopr.f 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/gloopr.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,522 +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
-!!
-!!
- 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)
-
- 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.
-!
-! print *,' calling astronomy'
- 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 &
- & )
-! print *,' returned from astro'
-
-!
-!===> *** ... 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
-!--------------------
- do lan=1,lats_node_r
- lat = global_lats_r(ipt_lats_node_r-1+j)
- lons_lat = lonsperlar(lan)
-
-
-!!
-!$omp parallel do schedule(dynamic,1) private(lon,i,j,k)
-!$omp+private(vvel,gt,gr,gr1)
-!$omp+private(cldcov_v,fluxr_v,f_ice,f_rain,r_rime)
-!$omp+private(prslk,prsl,prsik,prsi,flgmin_v,hlw_v,swh_v)
-!$omp+private(njeff,n,item,jtem,ks,work1,work2)
-!$omp+private(icsdsw,icsdlw)
-!$omp+private(lprnt,ipt)
-
- 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/physics_gfs/makefile.sh_ibm
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/makefile.sh_ibm 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/makefile.sh_ibm 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,25 +0,0 @@
-#!/bin/ksh
-set -x
-sorc_dir=$(pwd)
-exec_dir=$(pwd)
-#mkdir -p $exec_dir
-#
-# Select Shallow convection option
-#
-#make_dir=/ptmp/$(logname)/sorc/f2011/$(basename $sorc_dir)
-#mkdir -p $make_dir
-#cd $make_dir
-#cd $make_dir || exit 99
-#[ $? -ne 0 ] && exit 8
-#
-# rm $make_dir/*.o
-# rm $make_dir/*.mod
-#
-#tar -cf- -C$sorc_dir .|tar -xf-
-#
-# export EXEC="$exec_dir/global_fcst"
-#
- export F77=mpxlf95_r
- export F90=mpxlf95_r
-#
- make -f Makefile.ibm
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/makefile.sh_jet
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/makefile.sh_jet 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/makefile.sh_jet 2012-05-10 23:36:12 UTC (rev 1894)
@@ -1,27 +0,0 @@
-#!/bin/ksh
-set -x
-sorc_dir=$(pwd)
-exec_dir=$(pwd)
-#mkdir -p $exec_dir
-#
-# Select Shallow convection option
-#
-#make_dir=/mnt/pan2/projects/gnmip/$LOGNAME/ptmp/sorc/$(basename $sorc_dir)
-#mkdir -p $make_dir
-#cd $make_dir
-#cd $make_dir || exit 99
-#[ $? -ne 0 ] && exit 8
-#
-# rm $make_dir/*.o
-# rm $make_dir/*.mod
-#
-#tar -cf- -C$sorc_dir .|tar -xf-
-#
-# export EXEC="$exec_dir/global_fcst"
-#
- export F77=mpif90
- export F90=mpif90
- export FCC=mpicc
- export CFLAGS=LINUX
-#
- make -f Makefile.jet
Deleted: branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/radiation_astronomy.f
===================================================================
--- branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/radiation_astronomy.f 2012-05-10 21:25:08 UTC (rev 1893)
+++ branches/atmos_physics_gfs/src/core_atmos_physics_gfs/physics_gfs/radiation_astronomy.f 2012-05-10 23:36:12 UTC (rev 1894)
@@ -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>