!WRF:MODEL_LAYER:INITIALIZATION ! ! This MODULE holds the routines which are used to perform model start-up operations ! for the individual domains. This is the stage after inputting wrfinput and before ! calling 'integrate'. ! This MODULE CONTAINS the following routines: MODULE module_physics_init ! USE module_io_domain USE module_state_description USE module_model_constants ! USE module_timing USE module_configure #ifdef DM_PARALLEL USE module_dm #endif CONTAINS !================================================================= SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & p_top, TSK,RADT,BLDT,CUDT,MPDT, & RTHCUTEN, RQVCUTEN, RQRCUTEN, & RQCCUTEN, RQSCUTEN, RQICUTEN, & RUBLTEN,RVBLTEN,RTHBLTEN, & RQVBLTEN,RQCBLTEN,RQIBLTEN, & RTHRATEN,RTHRATENLW,RTHRATENSW, & STEPBL,STEPRA,STEPCU, & W0AVG, RAINNC, RAINC, RAINCV, RAINNCV, & NCA,swrad_scat, & CLDEFI,LOWLYR, & MASS_FLUX, & RTHFTEN, RQVFTEN, & CLDFRA,CLDFRA_OLD,GLW,GSW,EMISS,EMBCK, & !EMBCK new LU_INDEX, & landuse_ISICE, landuse_LUCATS, & landuse_LUSEAS, landuse_ISN, & lu_state, & XLAT,XLONG,ALBEDO,ALBBCK,GMT,JULYR,JULDAY,& levsiz, n_ozmixm, n_aerosolc, paerlev, & TMN,XLAND,ZNT,Z0,UST,MOL,PBLH,TKE_MYJ, & EXCH_H,THC,SNOWC,MAVAIL,HFX,QFX,RAINBL, & TSLB,ZS,DZS,num_soil_layers,warm_rain, & adv_moist_cond, & APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & APR_CAPMA,APR_CAPME,APR_CAPMI, & XICE,XICEM,VEGFRA,SNOW,CANWAT,SMSTAV, & SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,& ACSNOM,IVGTYP,ISLTYP, SFCEVP, SMOIS, & SH2O, SNOWH, SMFR3D, & ! temporary DX,DY,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & mp_restart_state,tbpvs_state,tbpvs0_state,& allowed_to_read, moved, start_of_simulation,& ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & ozmixm,pin, & ! Optional m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& ! Optional RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & ! Optional RQVNDGDTEN,RMUNDGDTEN, & ! Optional FGDT,STEPFG, & ! Optional cugd_tten,cugd_ttens,cugd_qvten, & ! Optional cugd_qvtens,cugd_qcten, & ! Optional ! num_roof_layers,num_wall_layers, & !Optional urban ! num_road_layers, & !Optional urban DZR, DZB, DZG, & !Optional urban TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D, & !Optional urban QC_URB2D, XXXR_URB2D,XXXB_URB2D, & !Optional urban XXXG_URB2D, XXXC_URB2D, & !Optional urban TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D, & !Optional urban TS_URB2D, FRC_URB2D, UTYPE_URB2D, & !Optional urban TML,T0ML,HML,H0ML,HUML,HVML, & !Optional oml itimestep & !Optional obs fdda #if ( EM_CORE == 1 ) ,fdob & !Optional obs fdda #endif ) !----------------------------------------------------------------- USE module_domain USE module_wrf_error IMPLICIT NONE !----------------------------------------------------------------- TYPE (grid_config_rec_type) :: config_flags INTEGER , INTENT(IN) :: id LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond ! LOGICAL , INTENT (IN) :: FNDSOILW, FNDSNOWH LOGICAL, PARAMETER :: FNDSOILW=.true., FNDSNOWH=.true. INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte INTEGER , INTENT(IN) :: num_soil_layers LOGICAL, INTENT(IN) :: start_of_simulation REAL, INTENT(IN) :: DT, p_top, DX, DY LOGICAL, INTENT(IN) :: restart REAL, INTENT(IN) :: RADT,BLDT,CUDT,MPDT REAL, INTENT(IN) :: swrad_scat REAL, DIMENSION( kms:kme ) , INTENT(IN) :: zfull, zhalf REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK, XLAT, XLONG INTEGER, INTENT(IN ) :: levsiz, n_ozmixm INTEGER, INTENT(IN ) :: paerlev, n_aerosolc REAL, DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, & INTENT(INOUT) :: OZMIXM REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: PIN REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1,m_ps_2 REAL, DIMENSION(paerlev), OPTIONAL,INTENT(INOUT) :: m_hybi REAL, DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, & INTENT(INOUT) :: aerosolc_1, aerosolc_2 REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),& INTENT(INOUT) :: SMOIS, SH2O,TSLB REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), INTENT(OUT) :: SMFR3D REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: SNOW, & SNOWC, & SNOWH, & CANWAT, & SMSTAV, & SMSTOT, & SFCRUNOFF, & UDRUNOFF, & SFCEVP, & GRDFLX, & ACSNOW, & XICE, & XICEM, & VEGFRA, & ACSNOM INTEGER, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: IVGTYP, & ISLTYP ! rad REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RTHRATEN, RTHRATENLW, RTHRATENSW, CLDFRA REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: & CLDFRA_OLD REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: & GSW,ALBEDO,ALBBCK,GLW,EMISS,EMBCK !EMBCK new REAL, INTENT(IN) :: GMT INTEGER , INTENT(OUT) :: STEPRA, STEPBL, STEPCU INTEGER , INTENT(IN) :: JULYR, JULDAY ! cps REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RTHCUTEN, RQVCUTEN, RQRCUTEN, RQCCUTEN, RQSCUTEN, & RQICUTEN REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: MASS_FLUX, & APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & APR_CAPMA,APR_CAPME,APR_CAPMI REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RTHFTEN, RQVFTEN REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: & RAINNC, RAINC, RAINCV, RAINNCV REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: CLDEFI, NCA INTEGER, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: LOWLYR !pbl ! soil layer REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: ZS,DZS REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,RQIBLTEN,EXCH_H,TKE_MYJ REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: & cugd_tten,cugd_ttens,cugd_qvten, & cugd_qvtens,cugd_qcten REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: & XLAND,ZNT,Z0,UST,MOL,LU_INDEX, & PBLH,THC,MAVAIL,HFX,QFX,RAINBL INTEGER , INTENT(INOUT) :: landuse_ISICE, landuse_LUCATS INTEGER , INTENT(INOUT) :: landuse_LUSEAS, landuse_ISN REAL , INTENT(INOUT) , DIMENSION( : ) :: lu_state REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN !mp REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY REAL, DIMENSION(:), INTENT(INOUT) :: mp_restart_state,tbpvs_state,tbpvs0_state LOGICAL, INTENT(IN) :: allowed_to_read, moved ! ocean mixed layer REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & TML,T0ML,HML,H0ML,HUML,HVML !fdda REAL, OPTIONAL, INTENT(IN) :: FGDT INTEGER , OPTIONAL, INTENT(OUT) :: STEPFG REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: & RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN, RQVNDGDTEN REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(OUT) :: & RMUNDGDTEN !URBAN ! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !urban ! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB !urban ! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG !urban REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR !urban REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB !urban REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !urban ! REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D !urban ! REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D !urban ! REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D !urban REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D !urban REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D !urban REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban !obs fdda INTEGER, OPTIONAL, INTENT(IN) :: itimestep #if ( EM_CORE == 1 ) TYPE(fdob_type), OPTIONAL, INTENT(INOUT) :: fdob #endif ! Local data REAL :: ALBLND,ZZLND,ZZWTR,THINLD,XMAVA,CEN_LAT,pptop REAL, DIMENSION( kms:kme ) :: sfull, shalf REAL :: obs_twindo_cg, obs_twindo CHARACTER*4 :: MMINLU_loc CHARACTER*80 :: message INTEGER :: ISWATER INTEGER :: ucmcall INTEGER :: omlcall REAL :: oml_hml0 LOGICAL :: usemonalb INTEGER :: i, j, k, itf, jtf integer myproc !----------------------------------------------------------------- ucmcall=config_flags%ucmcall usemonalb=config_flags%usemonalb #if ( EM_CORE == 1 ) obs_twindo_cg=model_config_rec%obs_twindo(1) obs_twindo=config_flags%obs_twindo oml_hml0=config_flags%oml_hml0 omlcall=config_flags%omlcall #endif !-- should be from the namelist sfull = 0. shalf = 0. CALL wrf_debug(100,'top of phy_init') WRITE(wrf_err_message,*) 'phy_init: start_of_simulation = ',start_of_simulation CALL wrf_debug ( 100, TRIM(wrf_err_message) ) itf=min0(ite,ide-1) jtf=min0(jte,jde-1) ZZLND=0.1 ZZWTR=0.0001 THINLD=0.04 ALBLND=0.2 XMAVA=0.3 #if (NMM_CORE == 1) if (.not.usemonalb) CALL wrf_error_fatal('usemonalb should always be true for NMM') #endif CALL nl_get_cen_lat(id,cen_lat) CALL wrf_debug(100,'calling nl_get_iswater, nl_get_mminlu_loc') CALL nl_get_iswater(id,iswater) CALL nl_get_mminlu( 1, mminlu_loc ) CALL wrf_debug(100,'after nl_get_iswater, nl_get_mminlu_loc') IF(.not.restart)THEN !-- initialize common variables IF ( .NOT. moved ) THEN DO j=jts,jtf DO i=its,itf XLAND(i,j)=1. GSW(i,j)=0. GLW(i,j)=0. UST(i,j)=0. MOL(i,j)=0.0 PBLH(i,j)=0.0 HFX(i,j)=0. QFX(i,j)=0. RAINBL(i,j)=0. RAINNCV(i,j)=0. ACSNOW(i,j)=0. DO k=kms,kme !wig, 17-May-2006: Added for idealized chem. runs EXCH_H(i,k,j) = 0. END DO ENDDO ENDDO ENDIF ! DO j=jts,jtf DO i=its,itf IF(XLAND(i,j) .LT. 1.5)THEN IF(mminlu_loc .EQ. ' ') ALBBCK(i,j)=ALBLND EMBCK(i,j)=0.85 ALBEDO(i,j)=ALBBCK(i,j) EMISS(i,j)=EMBCK(i,j) THC(i,j)=THINLD ZNT(i,j)=ZZLND #if ! ( NMM_CORE == 1 ) Z0(i,j)=ZZLND #endif MAVAIL(i,j)=XMAVA ELSE IF(mminlu_loc .EQ. ' ') ALBBCK(i,j)=0.08 ALBEDO(i,j)=ALBBCK(i,j) EMBCK(i,j)=0.98 EMISS(i,j)=EMBCK(i,j) THC(i,j)=THINLD ZNT(i,j)=ZZWTR #if ! ( NMM_CORE == 1 ) Z0(i,j)=ZZWTR #endif MAVAIL(i,j)=1.0 ENDIF ENDDO ENDDO CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to landuse_init' ) IF(mminlu_loc .ne. ' ')THEN !-- initialize surface properties CALL landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss, embck, & znt, Z0, thc, xland, xice, xicem, julday, cen_lat, iswater, mminlu_loc, & landuse_ISICE, landuse_LUCATS, & landuse_LUSEAS, landuse_ISN, & lu_state, & allowed_to_read , usemonalb , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF ENDIF !-- convert zfull and zhalf to sigma values for ra_init (Eta CO2 needs these) !-- zfull/zhalf may be either zeta or eta !-- what is done here depends on coordinate (check this code if adding new coordinates) CALL z2sigma(zfull,zhalf,sfull,shalf,p_top,pptop,config_flags, & allowed_to_read, & kds,kde,kms,kme,kts,kte) !-- initialize physics !-- ra: radiation !-- bl: pbl !-- cu: cumulus !-- mp: microphysics CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to ra_init' ) CALL ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, & RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, & levsiz,XLAT,n_ozmixm, & cldfra_old, & ! Optional ozmixm,pin, & ! Optional m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional paerlev,n_aerosolc, & sfull,shalf,pptop,swrad_scat, & config_flags,restart, & allowed_to_read, start_of_simulation, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to bl_init' ) CALL bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, & config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, & num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, & SNOW,SNOWC, CANWAT,SMSTAV, & SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, & IVGTYP,ISLTYP,SMOIS,SMFR3D,MAVAIL, & SNOWH,SH2O,FNDSOILW, FNDSNOWH, & #if (NMM_CORE == 1) Z0,XLAND,XICE, & #else ZNT,XLAND,XICE, & #endif SFCEVP,GRDFLX, & allowed_to_read , & start_of_simulation , & DZR, DZB, DZG, & !Optional urban TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D, & !Optional urban TS_URB2D, FRC_URB2D, UTYPE_URB2D, UCMCALL, & !Optional urban ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & oml_hml0, omlcall, & !Optional oml TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' ) CALL cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, & RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, & RAINCV,W0AVG,config_flags,restart, & CLDEFI,LOWLYR,MASS_FLUX, & RTHFTEN, RQVFTEN, & APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & APR_CAPMA,APR_CAPME,APR_CAPMI, & cugd_tten,cugd_ttens,cugd_qvten, & cugd_qvtens,cugd_qcten, & allowed_to_read, start_of_simulation, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to mp_init' ) CALL mp_init(RAINNC,config_flags,restart,warm_rain, & adv_moist_cond, & MPDT, DT, DX, DY, LOWLYR, & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & mp_restart_state,tbpvs_state,tbpvs0_state, & allowed_to_read, start_of_simulation, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) write(message,*)'STEPRA,STEPCU,STEPBL',STEPRA,STEPCU,STEPBL CALL wrf_message( message ) #if ( EM_CORE == 1 ) CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fg_init' ) CALL fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, & RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & config_flags,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fdob_init' ) CALL fdob_init(model_config_rec%obs_nudge_opt, & model_config_rec%max_dom, & id, & model_config_rec%parent_id, & model_config_rec%obs_idynin, & model_config_rec%obs_dtramp, & model_config_rec%fdda_end, & config_flags%restart, & obs_twindo_cg, obs_twindo, & itimestep, & config_flags%cen_lat, & config_flags%cen_lon, & config_flags%stand_lon, & config_flags%truelat1, & config_flags%truelat2, & config_flags%map_proj, & xlat, & xlong, & model_config_rec%s_sn(1), & model_config_rec%e_sn(1), & model_config_rec%s_we(1), & model_config_rec%e_we(1), & fdob, & model_config_rec%obs_ipf_init, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) #endif END SUBROUTINE phy_init !===================================================================== SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss, embck, & znt,Z0,thc,xland, xice, xicem, julday, cen_lat, iswater, mminlu, & ISICE, LUCATS, LUSEAS, ISN, & lu_state, & allowed_to_read , usemonalb , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) USE module_wrf_error IMPLICIT NONE !--------------------------------------------------------------------- INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte INTEGER , INTENT(IN) :: iswater, julday REAL , INTENT(IN) :: cen_lat CHARACTER*4, INTENT(IN) :: mminlu LOGICAL, INTENT(IN) :: allowed_to_read , usemonalb REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: lu_index, snowc, xice REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT ) :: albedo, albbck, mavail, emiss, & embck, & znt, Z0, thc, xland, xicem INTEGER , INTENT(INOUT) :: ISICE, LUCATS, LUSEAS, ISN REAL , INTENT(INOUT) , DIMENSION( : ) :: lu_state !--------------------------------------------------------------------- ! Local CHARACTER*4 LUTYPE CHARACTER*80 :: message INTEGER :: landuse_unit, LS, LC, LI, LUN, NSN INTEGER :: i, j, itf, jtf, is, cats, seas, curs INTEGER , PARAMETER :: OPEN_OK = 0 INTEGER :: ierr INTEGER , PARAMETER :: max_cats = 100 , max_seas = 12 REAL , DIMENSION( max_cats, max_seas ) :: ALBD, SLMO, SFEM, SFZ0, THERIN, SFHC REAL , DIMENSION( max_cats ) :: SCFX ! save these fields in case nest moves or has to be reinitialized ! and this routine is called with allowed_to_read set to false ! note that by saving these, we're locking in the same landuse for ! the duration of a run; possible implications for long climate runs LOGICAL :: found_lu, end_of_file LOGICAL, EXTERNAL :: wrf_dm_on_monitor !--------------------------------------------------------------------- CALL wrf_debug( 100 , 'top of landuse_init' ) NSN=-1 ! set this to suppress uninitalized data messages from tools ! recover LU variables from state IF ( 6*(max_cats*max_seas)+1*max_cats .GT. 7501 ) THEN WRITE(message,*)'landuse_init: lu_state overflow. Make Registry dimspec p > ',6*(max_cats*max_seas)+1*max_cats ENDIF curs = 1 DO cats = 1, max_cats SCFX(cats) = lu_state(curs) ; curs = curs + 1 DO seas = 1, max_seas ALBD(cats,seas) = lu_state(curs) ; curs = curs + 1 SLMO(cats,seas) = lu_state(curs) ; curs = curs + 1 SFEM(cats,seas) = lu_state(curs) ; curs = curs + 1 SFZ0(cats,seas) = lu_state(curs) ; curs = curs + 1 SFHC(cats,seas) = lu_state(curs) ; curs = curs + 1 THERIN(cats,seas) = lu_state(curs) ; curs = curs + 1 ENDDO ENDDO ! Determine season (summer=1, winter=2) ISN=1 IF(JULDAY.LT.105.OR.JULDAY.GT.288)ISN=2 IF(CEN_LAT.LT.0.0)ISN=3-ISN FOUND_LU = .TRUE. IF ( allowed_to_read ) THEN landuse_unit = 29 IF ( wrf_dm_on_monitor() ) THEN OPEN(landuse_unit, FILE='LANDUSE.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr) IF ( ierr .NE. OPEN_OK ) THEN WRITE(message,FMT='(A)') & 'module_physics_init.F: LANDUSE_INIT: open failure for LANDUSE.TBL' CALL wrf_error_fatal ( message ) END IF ENDIF ! Read info from file LANDUSE.TBL IF(MMINLU.EQ.'OLD ')THEN ! ISWATER=7 ISICE=11 ELSE IF(MMINLU.EQ.'USGS')THEN ! ISWATER=16 ISICE=24 ELSE IF(MMINLU.EQ.'SiB ')THEN ! ISWATER=15 ISICE=16 ELSE IF(MMINLU.EQ.'LW12')THEN ! ISWATER=15 ISICE=3 ENDIF PRINT *, 'INPUT LANDUSE = ',MMINLU FOUND_LU = .FALSE. end_of_file = .FALSE. !!! BEGINNING OF 1999 LOOP 1999 CONTINUE IF ( wrf_dm_on_monitor() ) THEN READ (landuse_unit,2000,END=2002)LUTYPE GOTO 2003 2002 CONTINUE CALL wrf_message( 'INPUT FILE FOR LANDUSE REACHED END OF FILE' ) end_of_file = .TRUE. 2003 CONTINUE IF ( .NOT. end_of_file ) READ (landuse_unit,*)LUCATS,LUSEAS FOUND_LU = LUTYPE.EQ.MMINLU ENDIF CALL wrf_dm_bcast_bytes (end_of_file, LWORDSIZE ) IF ( .NOT. end_of_file ) THEN CALL wrf_dm_bcast_string(lutype, 4) CALL wrf_dm_bcast_bytes (lucats, IWORDSIZE ) CALL wrf_dm_bcast_bytes (luseas, IWORDSIZE ) CALL wrf_dm_bcast_bytes (found_lu, LWORDSIZE ) 2000 FORMAT (A4) IF(FOUND_LU)THEN LUN=LUCATS NSN=LUSEAS PRINT *, 'LANDUSE TYPE = ',LUTYPE,' FOUND', & LUCATS,' CATEGORIES',LUSEAS,' SEASONS', & ' WATER CATEGORY = ',ISWATER, & ' SNOW CATEGORY = ',ISICE ENDIF DO ls=1,luseas if ( wrf_dm_on_monitor() ) then READ (landuse_unit,*) endif DO LC=1,LUCATS IF(found_lu)THEN IF ( wrf_dm_on_monitor() ) THEN READ (landuse_unit,*)LI,ALBD(LC,LS),SLMO(LC,LS),SFEM(LC,LS), & SFZ0(LC,LS),THERIN(LC,LS),SCFX(LC),SFHC(LC,LS) ENDIF CALL wrf_dm_bcast_bytes (LI, IWORDSIZE ) IF(LC.NE.LI)CALL wrf_error_fatal ( 'module_start: MISSING LANDUSE UNIT ' ) ELSE IF ( wrf_dm_on_monitor() ) THEN READ (landuse_unit,*) ENDIF ENDIF ENDDO ENDDO IF(NSN.EQ.1.AND.FOUND_LU) THEN ISN = 1 END IF CALL wrf_dm_bcast_bytes (albd, max_cats * max_seas * RWORDSIZE ) CALL wrf_dm_bcast_bytes (slmo, max_cats * max_seas * RWORDSIZE ) CALL wrf_dm_bcast_bytes (sfem, max_cats * max_seas * RWORDSIZE ) CALL wrf_dm_bcast_bytes (sfz0, max_cats * max_seas * RWORDSIZE ) CALL wrf_dm_bcast_bytes (therin, max_cats * max_seas * RWORDSIZE ) CALL wrf_dm_bcast_bytes (sfhc, max_cats * max_seas * RWORDSIZE ) CALL wrf_dm_bcast_bytes (scfx, max_cats * RWORDSIZE ) ENDIF IF(.NOT. found_lu .AND. .NOT. end_of_file ) GOTO 1999 !!! END OF 1999 LOOP IF(.NOT. found_lu .OR. end_of_file )THEN CALL wrf_message ( 'LANDUSE IN INPUT FILE DOES NOT MATCH LUTABLE: TABLE NOT USED' ) ENDIF ENDIF ! allowed_to_read IF(FOUND_LU)THEN ! Set arrays according to lu_index itf = min0(ite, ide-1) jtf = min0(jte, jde-1) IF(usemonalb)CALL wrf_message ( 'Climatological albedo is used instead of table values' ) DO j = jts, jtf DO i = its, itf IS=nint(lu_index(i,j)) ! only do this check on read-in data IF(IS.LT.0.OR.IS.GT.LUN.AND.allowed_to_read)THEN WRITE ( wrf_err_message , * ) 'ERROR: LANDUSE OUTSIDE RANGE =',IS,' AT ',I,J,' LUN= ',LUN CALL wrf_error_fatal ( TRIM ( wrf_err_message ) ) ENDIF ! SET NO-DATA POINTS (IS=0) TO WATER IF(IS.EQ.0)THEN IS=ISWATER ENDIF IF(.NOT.usemonalb)ALBBCK(I,J)=ALBD(IS,ISN)/100. ALBEDO(I,J)=ALBBCK(I,J) IF(SNOWC(I,J) .GT. 0.5)ALBEDO(I,J)=ALBBCK(I,J)*(1.+SCFX(IS)) THC(I,J)=THERIN(IS,ISN)/100. Z0(I,J)=SFZ0(IS,ISN)/100. ZNT(I,J)=Z0(I,J) EMBCK(I,J)=SFEM(IS,ISN) EMISS(I,J)=EMBCK(I,J) MAVAIL(I,J)=SLMO(IS,ISN) IF(IS.NE.ISWATER)THEN XLAND(I,J)=1.0 ELSE XLAND(I,J)=2.0 ENDIF ! SET SEA-ICE POINTS TO LAND WITH ICE/SNOW SURFACE PROPERTIES XICEM(I,J)=XICE(I,J) IF(XICE(I,J).GT.0.5)THEN XLAND(I,J)=1.0 ALBBCK(I,J)=ALBD(ISICE,ISN)/100. ALBEDO(I,J)=ALBBCK(I,J) THC(I,J)=THERIN(ISICE,ISN)/100. Z0(I,J)=SFZ0(ISICE,ISN)/100. ZNT(I,J)=Z0(I,J) EMBCK(I,J)=SFEM(ISICE,ISN) EMISS(I,J)=EMBCK(I,J) MAVAIL(I,J)=SLMO(ISICE,ISN) ENDIF ENDDO ENDDO ENDIF if ( wrf_dm_on_monitor() .and. allowed_to_read ) then CLOSE (landuse_unit) endif CALL wrf_debug( 100 , 'returning from of landuse_init' ) ! restore LU variables from state curs = 1 DO cats = 1, max_cats lu_state(curs) = SCFX(cats) ; curs = curs + 1 DO seas = 1, max_seas lu_state(curs) = ALBD(cats,seas) ; curs = curs + 1 lu_state(curs) = SLMO(cats,seas) ; curs = curs + 1 lu_state(curs) = SFEM(cats,seas) ; curs = curs + 1 lu_state(curs) = SFZ0(cats,seas) ; curs = curs + 1 lu_state(curs) = SFHC(cats,seas) ; curs = curs + 1 lu_state(curs) = THERIN(cats,seas) ; curs = curs + 1 ENDDO ENDDO RETURN END SUBROUTINE landuse_init !===================================================================== SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, & RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, & levsiz,XLAT,n_ozmixm, & cldfra_old, & ! Optional ozmixm,pin, & ! Optional m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional paerlev,n_aerosolc, & sfull,shalf,pptop,swrad_scat, & config_flags,restart, & allowed_to_read, start_of_simulation, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !--------------------------------------------------------------------- USE module_ra_rrtm USE module_ra_cam USE module_ra_sw USE module_ra_gsfcsw USE module_ra_gfdleta USE module_ra_hs USE module_domain !--------------------------------------------------------------------- IMPLICIT NONE !--------------------------------------------------------------------- INTEGER, INTENT(IN) :: id TYPE (grid_config_rec_type) :: config_flags LOGICAL , INTENT(IN) :: restart LOGICAL, INTENT(IN) :: allowed_to_read INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte INTEGER , INTENT(IN) :: JULDAY,JULYR REAL , INTENT(IN) :: DT, RADT, cen_lat, GMT, pptop, & swrad_scat LOGICAL, INTENT(IN) :: start_of_simulation INTEGER, INTENT(IN ) :: levsiz, n_ozmixm INTEGER, INTENT(IN ) :: paerlev, n_aerosolc REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAT REAL, DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, & INTENT(INOUT) :: OZMIXM REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1,m_ps_2 REAL, DIMENSION(paerlev), OPTIONAL, INTENT(INOUT) :: m_hybi REAL, DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, & INTENT(INOUT) :: aerosolc_1, aerosolc_2 REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: PIN INTEGER , INTENT(INOUT) :: STEPRA INTEGER :: isn REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RTHRATEN, & RTHRATENLW, & RTHRATENSW, & CLDFRA REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: & CLDFRA_OLD REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS LOGICAL :: etalw = .false. LOGICAL :: camlw = .false. LOGICAL :: etamp = .false. integer :: month,iday INTEGER :: i, j, k, itf, jtf, ktf !--------------------------------------------------------------------- jtf=min0(jte,jde-1) ktf=min0(kte,kde-1) itf=min0(ite,ide-1) !--------------------------------------------------------------------- !-- calculate radiation time step STEPRA = nint(RADT*60./DT) STEPRA = max(STEPRA,1) !-- initialization IF(start_of_simulation)THEN DO j=jts,jtf DO k=kts,ktf DO i=its,itf RTHRATEN(i,k,j)=0. RTHRATENLW(i,k,j)=0. RTHRATENSW(i,k,j)=0. CLDFRA(i,k,j)=0. ENDDO ENDDO ENDDO if( present(cldfra_old) ) then DO j=jts,jtf DO k=kts,ktf DO i=its,itf cldfra_old(i,k,j) = 0. ENDDO ENDDO ENDDO end if ENDIF !-- find out which microphysics option is used first mp_select: SELECT CASE(config_flags%mp_physics) CASE (ETAMPNEW) etamp = .true. END SELECT mp_select !-- chose long wave radiation scheme lwrad_select: SELECT CASE(config_flags%ra_lw_physics) CASE (RRTMSCHEME) CALL rrtminit( & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (CAMLWSCHEME) #ifdef MAC_KLUDGE CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) #endif IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. & PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND. & PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1) & .AND. PRESENT(AEROSOLC_2)) THEN CALL camradinit( & R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & ozmixm,pin,levsiz,XLAT,n_ozmixm, & m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& paerlev, n_aerosolc, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ELSE CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' ) ENDIF camlw = .true. CASE (GFDLLWSCHEME) CALL nl_get_start_month(id,month) CALL nl_get_start_day(id,iday) CALL gfdletainit(emiss,sfull,shalf,pptop, & julyr,month,iday,gmt, & config_flags,allowed_to_read, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) etalw = .true. CASE (HELDSUAREZ) CALL hsinit(RTHRATEN,restart, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT END SELECT lwrad_select !-- initialize short wave radiation scheme swrad_select: SELECT CASE(config_flags%ra_sw_physics) CASE (SWRADSCHEME) CALL swinit( & swrad_scat, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (CAMSWSCHEME) #ifdef MAC_KLUDGE CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) #endif IF(.not.camlw)THEN CALL camradinit( & R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & ozmixm,pin,levsiz,XLAT,n_ozmixm, & m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& paerlev, n_aerosolc, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE (GSFCSWSCHEME) CALL gsfc_swinit(cen_lat, allowed_to_read ) CASE (GFDLSWSCHEME) IF(.not.etalw)THEN CALL nl_get_start_month(id,month) CALL nl_get_start_day(id,iday) CALL gfdletainit(emiss,sfull,shalf,pptop, & julyr,month,iday,gmt, & config_flags,allowed_to_read, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF CASE DEFAULT END SELECT swrad_select END SUBROUTINE ra_init SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, & config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, & num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, & SNOW,SNOWC, CANWAT,SMSTAV, & SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, & IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail, & SNOWH,SH2O,FNDSOILW, FNDSNOWH, & #if ( NMM_CORE == 1 ) Z0,XLAND,XICE, & #else ZNT,XLAND,XICE, & #endif SFCEVP,GRDFLX, & allowed_to_read, & start_of_simulation, & ! num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban DZR, DZB, DZG, & !Optional urban TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, & !Optional urban TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL, & !Optional urban ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & oml_hml0, omlcall, & !Optional oml TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml !-------------------------------------------------------------------- USE module_sf_sfclay USE module_sf_slab USE module_sf_pxsfclay USE module_bl_ysu USE module_bl_mrf USE module_bl_gfs USE module_bl_acm USE module_sf_myjsfc USE module_sf_noahdrv USE module_sf_urban USE module_sf_ruclsm USE module_sf_pxlsm USE module_bl_myjpbl #if (NMM_CORE == 1) USE module_sf_lsm_nmm #endif !-------------------------------------------------------------------- IMPLICIT NONE !-------------------------------------------------------------------- TYPE (grid_config_rec_type) :: config_flags LOGICAL , INTENT(IN) :: restart LOGICAL, INTENT(IN) :: FNDSOILW, FNDSNOWH INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte INTEGER , INTENT(IN) :: num_soil_layers INTEGER , INTENT(IN) :: UCMCALL REAL , INTENT(IN) :: DT, BLDT INTEGER , INTENT(INOUT) :: STEPBL REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), & INTENT(OUT) :: SMFR3D REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),& INTENT(INOUT) :: SMOIS,SH2O,TSLB REAL, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: SNOW, & SNOWH, & SNOWC, & CANWAT, & MAVAIL, & SMSTAV, & SMSTOT, & SFCRUNOFF, & UDRUNOFF, & ACSNOW, & VEGFRA, & ACSNOM, & SFCEVP, & GRDFLX, & UST, & #if ( NMM_CORE == 1 ) Z0, & #else ZNT, & #endif XLAND, & XICE INTEGER, DIMENSION( ims:ime, jms:jme ) , & INTENT(INOUT) :: IVGTYP, & ISLTYP, & LOWLYR REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: ZS,DZS REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RUBLTEN, & RVBLTEN, & EXCH_H, & RTHBLTEN, & RQVBLTEN, & RQCBLTEN, & RQIBLTEN, & TKE_MYJ REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN LOGICAL, INTENT(IN) :: allowed_to_read INTEGER :: isn, isfc !URBAN ! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !Optional urban ! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB !Optional urban ! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG !Optional urban REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR !Optional urban REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB !Optional urban REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban ! REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban ! REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban ! REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban ! Optional OML variables REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & TML,T0ML,HML,H0ML,HUML,HVML INTEGER, OPTIONAL, INTENT(IN) :: omlcall REAL, OPTIONAL, INTENT(IN) :: oml_hml0 LOGICAL, INTENT(IN) :: start_of_simulation !-- calculate pbl time step STEPBL = nint(BLDT*60./DT) STEPBL = max(STEPBL,1) !-- initialize surface layer scheme sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics) CASE (SFCLAYSCHEME) CALL sfclayinit( allowed_to_read ) isfc = 1 CASE (PXSFCSCHEME) CALL pxsfclayinit( allowed_to_read ) isfc = 1 CASE (MYJSFCSCHEME) CALL myjsfcinit(LOWLYR,UST, & #if ( NMM_CORE == 1 ) Z0, & #else ZNT, & #endif XLAND,XICE, & IVGTYP,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) isfc = 2 CASE (GFSSFCSCHEME) CALL myjsfcinit(LOWLYR,UST, & #if ( NMM_CORE == 1 ) Z0, & #else ZNT, & #endif XLAND,XICE, & IVGTYP,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) isfc = 1 CASE DEFAULT END SELECT sfclay_select !-- initialize surface scheme sfc_select: SELECT CASE(config_flags%sf_surface_physics) CASE (SLABSCHEME) CALL slabinit(TSK,TMN, & TSLB,ZS,DZS,num_soil_layers, & allowed_to_read ,start_of_simulation ,& ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & oml_hml0, omlcall, & tml, t0ml, hml, h0ml, huml, hvml ) #if (NMM_CORE == 1) CASE (NMMLSMSCHEME) CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, & SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW, & ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP, & TMN, & num_soil_layers, & allowed_to_read , & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) #endif CASE (LSMSCHEME) CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & FNDSOILW, FNDSNOWH, & num_soil_layers, restart, & allowed_to_read , & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) !URBAN IF(UCMCALL.eq.1) THEN IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN CALL urban_param_init(DZR,DZB,DZG,num_soil_layers & !urban ) ! num_roof_layers,num_wall_layers,road_soil_layers) !urban CALL urban_var_init(TSK,TSLB,TMN,IVGTYP, & !urban ims,ime,jms,jme,num_soil_layers, & !urban ! num_roof_layers,num_wall_layers,num_road_layers, & !urban restart, & !urban XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !urban TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !urban TRL_URB3D,TBL_URB3D,TGL_URB3D, & !urban SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D, & ! urban FRC_URB2D, UTYPE_URB2D) !urban ELSE CALL wrf_error_fatal ( 'arguments not present for calling urban model' ) ENDIF ENDIF CASE (RUCLSMSCHEME) ! if(isfc .ne. 2)CALL wrf_error_fatal & ! ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' ) CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail, & num_soil_layers, restart, & allowed_to_read , & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) CASE (PXLSMSCHEME) CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & FNDSOILW, FNDSNOWH, & num_soil_layers, restart, & allowed_to_read , & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte ) CASE DEFAULT END SELECT sfc_select !-- initialize pbl scheme pbl_select: SELECT CASE(config_flags%bl_pbl_physics) CASE (YSUSCHEME) if(isfc .ne. 1)CALL wrf_error_fatal & ( 'module_physics_init: use sfclay scheme for this pbl option' ) CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & RQCBLTEN,RQIBLTEN,P_QI, & PARAM_FIRST_SCALAR, & restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (MRFSCHEME) if(isfc .ne. 1)CALL wrf_error_fatal & ( 'module_physics_init: use sfclay scheme for this pbl option' ) CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & RQCBLTEN,RQIBLTEN,P_QI, & PARAM_FIRST_SCALAR, & restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (ACMPBLSCHEME) if(isfc .ne. 1)CALL wrf_error_fatal & ( 'module_physics_init: use sfclay scheme for this pbl option' ) CALL acminit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & RQCBLTEN,RQIBLTEN,P_QI, & PARAM_FIRST_SCALAR, & restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (GFSSCHEME) if(isfc .ne. 1)CALL wrf_error_fatal & ( 'module_physics_init: use sfclay scheme for this pbl option' ) CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & RQCBLTEN,RQIBLTEN,P_QI, & PARAM_FIRST_SCALAR, & restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (MYJPBLSCHEME) if(isfc .ne. 2)CALL wrf_error_fatal & ( 'module_physics_init: use myjsfc scheme for this pbl option' ) CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & TKE_MYJ,EXCH_H,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT END SELECT pbl_select END SUBROUTINE bl_init !================================================================== SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, & RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, & RAINCV,W0AVG,config_flags,restart, & CLDEFI,LOWLYR,MASS_FLUX, & RTHFTEN, RQVFTEN, & APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & APR_CAPMA,APR_CAPME,APR_CAPMI, & cugd_tten,cugd_ttens,cugd_qvten, & cugd_qvtens,cugd_qcten, & allowed_to_read, start_of_simulation, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------------ USE module_cu_kf USE module_cu_kfeta USE MODULE_CU_BMJ USE module_cu_gd, ONLY : GDINIT USE module_cu_g3, ONLY : G3INIT USE module_cu_sas !------------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------------ TYPE (grid_config_rec_type) :: config_flags LOGICAL , INTENT(IN) :: restart INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL , INTENT(IN) :: DT, CUDT LOGICAL , INTENT(IN) :: start_of_simulation LOGICAL , INTENT(IN) :: allowed_to_read INTEGER , INTENT(INOUT) :: STEPCU REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: & RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & cugd_tten,cugd_ttens,cugd_qvten, & cugd_qvtens,cugd_qcten REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RTHFTEN, RQVFTEN REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX, & APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & APR_CAPMA,APR_CAPME,APR_CAPMI INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR ! LOCAL VAR INTEGER :: i,j,itf,jtf !-------------------------------------------------------------------- !-- calculate cumulus parameterization time step itf=min0(ite,ide-1) jtf=min0(jte,jde-1) ! STEPCU = nint(CUDT*60./DT) STEPCU = max(STEPCU,1) !-- initialization IF(start_of_simulation)THEN DO j=jts,jtf DO i=its,itf RAINC(i,j)=0. RAINCV(i,j)=0. ENDDO ENDDO ENDIF cps_select: SELECT CASE(config_flags%cu_physics) CASE (KFSCHEME) CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & PARAM_FIRST_SCALAR,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (BMJSCHEME) CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & CLDEFI,LOWLYR,cp,r_d,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (KFETASCHEME) CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & SVP1,SVP2,SVP3,SVPT0, & PARAM_FIRST_SCALAR,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (GDSCHEME) CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & MASS_FLUX,cp,restart, & P_QC,P_QI,PARAM_FIRST_SCALAR, & RTHFTEN, RQVFTEN, & APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & APR_CAPMA,APR_CAPME,APR_CAPMI, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) #if ( EM_CORE == 1 ) CASE (G3SCHEME) CALL g3init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & MASS_FLUX,cp,restart, & P_QC,P_QI,PARAM_FIRST_SCALAR, & RTHFTEN, RQVFTEN, & APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & APR_CAPMA,APR_CAPME,APR_CAPMI, & cugd_tten,cugd_ttens,cugd_qvten, & cugd_qvtens,cugd_qcten, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) #endif CASE (SASSCHEME) CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & restart,P_QC,P_QI,PARAM_FIRST_SCALAR, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT END SELECT cps_select END SUBROUTINE cu_init !================================================================== SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain, & adv_moist_cond, & MPDT, DT, DX, DY, LOWLYR, & ! for eta mp F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & ! for eta mp mp_restart_state,tbpvs_state,tbpvs0_state, & ! eta mp allowed_to_read, start_of_simulation, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !------------------------------------------------------------------ USE module_mp_wsm3 USE module_mp_wsm5 USE module_mp_wsm6 USE module_mp_etanew USE module_mp_thompson USE module_mp_morr_two_moment !------------------------------------------------------------------ IMPLICIT NONE !------------------------------------------------------------------ ! Arguments TYPE (grid_config_rec_type) :: config_flags LOGICAL , INTENT(IN) :: restart LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond REAL , INTENT(IN) :: MPDT, DT, DX, DY LOGICAL , INTENT(IN) :: start_of_simulation INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT) :: LOWLYR REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY REAL , DIMENSION(:) ,INTENT(INOUT) :: mp_restart_state,tbpvs_state,tbpvs0_state LOGICAL , INTENT(IN) :: allowed_to_read ! Local INTEGER :: i, j, itf, jtf warm_rain = .false. adv_moist_cond = .true. itf=min0(ite,ide-1) jtf=min0(jte,jde-1) IF(start_of_simulation)THEN DO j=jts,jtf DO i=its,itf RAINNC(i,j) = 0. ENDDO ENDDO ENDIF mp_select: SELECT CASE(config_flags%mp_physics) CASE (KESSLERSCHEME) warm_rain = .true. CASE (WSM3SCHEME) CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) CASE (WSM5SCHEME) CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) CASE (WSM6SCHEME) CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) CASE (ETAMPNEW) adv_moist_cond = .false. CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart, & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & mp_restart_state,tbpvs_state,tbpvs0_state,& allowed_to_read, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE (THOMPSON) CALL thompson_init CASE (MORR_TWO_MOMENT) CALL morr_two_moment_init CASE DEFAULT END SELECT mp_select END SUBROUTINE mp_init #if ( EM_CORE == 1 ) !========================================================== SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, & RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & config_flags,restart, & allowed_to_read , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !-------------------------------------------------------------------- USE module_fdda_psufddagd !-------------------------------------------------------------------- IMPLICIT NONE !-------------------------------------------------------------------- TYPE (grid_config_rec_type) :: config_flags LOGICAL , INTENT(IN) :: restart INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte REAL , INTENT(IN) :: DT, FGDT INTEGER , INTENT(IN) :: id INTEGER , INTENT(INOUT) :: STEPFG REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & RUNDGDTEN, & RVNDGDTEN, & RTHNDGDTEN, & RQVNDGDTEN REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN LOGICAL, INTENT(IN) :: allowed_to_read !-------------------------------------------------------------------- !-- calculate pbl time step STEPFG = nint(FGDT*60./DT) STEPFG = max(STEPFG,1) !-- initialize fdda scheme fdda_select: SELECT CASE(config_flags%grid_fdda) CASE (PSUFDDAGD) CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,& config_flags%run_hours, & config_flags%if_no_pbl_nudging_uv, & config_flags%if_no_pbl_nudging_t, & config_flags%if_no_pbl_nudging_q, & config_flags%if_zfac_uv, & config_flags%k_zfac_uv, & config_flags%if_zfac_t, & config_flags%k_zfac_t, & config_flags%if_zfac_q, & config_flags%k_zfac_q, & config_flags%guv, & config_flags%gt, config_flags%gq, & config_flags%if_ramping, config_flags%dtramp_min, & config_flags%gfdda_end_h, & restart, allowed_to_read, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) CASE DEFAULT END SELECT fdda_select END SUBROUTINE fg_init !------------------------------------------------------------------- SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid, & idynin, dtramp, fdaend, restart, & obs_twindo_cg, obs_twindo, itimestep, & cen_lat, cen_lon, stand_lon, & true_lat1, true_lat2, map_proj, & xlat, xlong, & s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & fdob, ipf_init, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) !-------------------------------------------------------------------- USE module_domain USE module_fddaobs_rtfdda USE module_llxy !-------------------------------------------------------------------- IMPLICIT NONE !-------------------------------------------------------------------- INTEGER , INTENT(IN) :: maxdom INTEGER , INTENT(IN) :: obs_nudge_opt(maxdom) INTEGER , INTENT(IN) :: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte INTEGER , INTENT(IN) :: inest INTEGER , INTENT(IN) :: parid(maxdom) INTEGER , INTENT(IN) :: idynin ! flag for dynamic initialization REAL , INTENT(IN) :: dtramp ! time period for ramping (idynin) REAL , INTENT(IN) :: fdaend(maxdom) ! nudging end time for domain (min) LOGICAL , INTENT(IN) :: restart REAL , INTENT(IN) :: obs_twindo_cg ! twindo on course grid REAL , INTENT(IN) :: obs_twindo INTEGER , INTENT(IN) :: itimestep REAL , INTENT(IN) :: cen_lat ! domain center latitude REAL , INTENT(IN) :: cen_lon ! domain center longitude REAL , INTENT(IN) :: stand_lon ! domain longitude REAL , INTENT(IN) :: true_lat1 ! domain standard parallel REAL , INTENT(IN) :: true_lat2 ! domain second standard parallel INTEGER , INTENT(IN) :: map_proj ! map projection REAL, DIMENSION( ims:ime, jms:jme ), & INTENT(IN ) :: xlat, xlong ! lat/long locations on mass point grid INTEGER, intent(in) :: s_sn_cg ! starting north-south coarse-grid index INTEGER, intent(in) :: e_sn_cg ! ending north-south coarse-grid index INTEGER, intent(in) :: s_we_cg ! starting west-east coarse-grid index INTEGER, intent(in) :: e_we_cg ! ending west-east coarse-grid index TYPE(fdob_type), INTENT(INOUT) :: fdob INTEGER :: e_sn ! ending north-south grid index LOGICAL :: ipf_init ! print warnings detected at initialzn !-------------------------------------------------------------------- !-- initialize fdda obs-nudging scheme IF ( obs_nudge_opt(inest) .eq. 0 ) RETURN e_sn = jde CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid, & idynin, dtramp, fdaend, restart, & obs_twindo_cg, & obs_twindo, itimestep, & cen_lat, cen_lon, stand_lon, & true_lat1, true_lat2, map_proj, & xlat, xlong, & e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & fdob, ipf_init, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte) END SUBROUTINE fdob_init #endif !-------------------------------------------------------------------- SUBROUTINE z2sigma(zf,zh,sf,sh,p_top,pptop,config_flags, & allowed_to_read , & kds,kde,kms,kme,kts,kte) IMPLICIT NONE ! Arguments INTEGER, INTENT(IN) :: kds,kde,kms,kme,kts,kte REAL , DIMENSION( kms:kme ), INTENT(IN) :: zf,zh REAL , DIMENSION( kms:kme ), INTENT(OUT):: sf,sh REAL , INTENT(IN) :: p_top REAL , INTENT(OUT) :: pptop TYPE (grid_config_rec_type) :: config_flags LOGICAL , INTENT(IN) :: allowed_to_read ! Local REAL R, G, TS, GAMMA, PS, ZTROP, TSTRAT, PTROP, Z, T, P, ZTOP, PTOP INTEGER K IF(zf(kde/2) .GT. 1.0)THEN ! Height levels assumed (zeta coordinate) ! Convert to sigma using standard atmosphere for pressure-height relation ! constants for standard atmosphere definition r=287.05 g=9.80665 ts=288.15 gamma=-6.5/1000. ps=1013.25 ztrop=11000. tstrat=ts+gamma*ztrop ptrop=ps*(tstrat/ts)**(-g/(gamma*r)) do k=kde,kds,-1 ! full levels z=zf(k) if(z.le.ztrop)then t=ts+gamma*z p=ps*(t/ts)**(-g/(gamma*r)) else t=tstrat p=ptrop*exp(-g*(z-ztrop)/(r*tstrat)) endif if(k.eq.kde)then ztop=zf(k) ptop=p endif sf(k)=(p-ptop)/(ps-ptop) ! half levels if(k.ne.kds)then z=0.5*(zf(k)+zf(k-1)) if(z.le.ztrop)then t=ts+gamma*z p=ps*(t/ts)**(-g/(gamma*r)) else t=tstrat p=ptrop*exp(-g*(z-ztrop)/(r*tstrat)) endif sh(k-1)=(p-ptop)/(ps-ptop) endif enddo pptop=ptop/10. ELSE ! Levels are already sigma/eta do k=kde,kds,-1 ! sf(k)=zf(kde-k+kds) ! if(k .ne. kde)sh(k)=zh(kde-1-k+kds) sf(k)=zf(k) if(k .ne. kde)sh(k)=zh(k) enddo pptop=p_top/1000. ENDIF END SUBROUTINE z2sigma END MODULE module_physics_init