<HTML> <BODY BGCOLOR=#bbeeee LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE><a name='1'>
<font color=#447700>!REAL:MODEL_LAYER:INITIALIZATION<a name='2'></font>
<a name='3'>
<font color=#447700>! This MODULE holds the routines which are used to perform various initializations<a name='4'></font>
<font color=#447700>! for the individual domains, specifically for the Eulerian, mass-based coordinate.<a name='5'></font>
<a name='6'>
<font color=#447700>!-----------------------------------------------------------------------<a name='7'></font>
<a name='8'>
<A NAME='MODULE_INITIALIZE'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#MODULE_INITIALIZE' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A><a name='9'>
<font color=#993300>MODULE </font><font color=#cc0000>module_initialize</font> <A href='../../call_to/MODULE_INITIALIZE.html' TARGET='index'>7</A><a name='10'>
<a name='11'>
USE <A href='../../html_code/share/module_bc.F.html#MODULE_BC'>module_bc</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_BC_15"><a name='12'>
USE <A href='../../html_code/frame/module_configure.F.html#MODULE_CONFIGURE'>module_configure</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_CONFIGURE_22"><a name='13'>
USE <A href='../../html_code/frame/module_domain.F.html#MODULE_DOMAIN'>module_domain</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_DOMAIN_20"><a name='14'>
USE <A href='../../html_code/share/module_io_domain.F.html#MODULE_IO_DOMAIN'>module_io_domain</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_IO_DOMAIN_8"><a name='15'>
USE <A href='../../html_code/share/module_model_constants.F.html#MODULE_MODEL_CONSTANTS'>module_model_constants</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_MODEL_CONSTANTS_21"><a name='16'>
USE module_state_description<a name='17'>
USE <A href='../../html_code/frame/module_timing.F.html#MODULE_TIMING'>module_timing</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_TIMING_10"><a name='18'>
USE <A href='../../html_code/share/module_soil_pre.F.html#MODULE_SOIL_PRE'>module_soil_pre</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_SOIL_PRE_2"><a name='19'>
#ifdef DM_PARALLEL<a name='20'>
USE <A href='../../html_code/frame/module_dm_stubs.F.html#MODULE_DM'>module_dm</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#module_initialize_real.F' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_DM_17"><a name='21'>
#endif<a name='22'>
<a name='23'>
<a name='24'>
CONTAINS<a name='25'>
<a name='26'>
<font color=#447700>!-------------------------------------------------------------------<a name='27'></font>
<a name='28'>
<A NAME='INIT_DOMAIN'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='29'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>init_domain</font> ( grid ) <A href='../../call_to/INIT_DOMAIN.html' TARGET='index'>3</A>,<A href='../../call_from/INIT_DOMAIN.html' TARGET='index'>25</A><a name='30'>
<a name='31'>
IMPLICIT NONE<a name='32'>
<a name='33'>
<font color=#447700>! Input space and data. No gridded meteorological data has been stored, though.<a name='34'></font>
<a name='35'>
<font color=#447700>! TYPE (domain), POINTER :: grid <a name='36'></font>
TYPE (domain) :: grid <a name='37'>
<a name='38'>
<font color=#447700>! Local data.<a name='39'></font>
<a name='40'>
INTEGER :: dyn_opt <a name='41'>
INTEGER :: idum1, idum2<a name='42'>
<a name='43'>
#ifdef DEREF_KLUDGE<a name='44'>
<font color=#447700>! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm<a name='45'></font>
INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33<a name='46'>
INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x<a name='47'>
INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y<a name='48'>
#endif<a name='49'>
<a name='50'>
#include "<A href='../../html_code/include/deref_kludge.h.html'>deref_kludge.h</A>"<A NAME="deref_kludge.h_1"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='51'>
<a name='52'>
CALL nl_get_dyn_opt ( head_grid%id, dyn_opt )<a name='53'>
<a name='54'>
CALL <A href='../../html_code/frame/module_configure.F.html#SET_SCALAR_INDICES_FROM_CONFIG'>set_scalar_indices_from_config</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="SET_SCALAR_INDICES_FROM_CONFIG_8"> ( head_grid%id , idum1, idum2 )<a name='55'>
<a name='56'>
IF ( dyn_opt .eq. 1 &<a name='57'>
.or. dyn_opt .eq. 2 &<a name='58'>
.or. dyn_opt .eq. 3 &<a name='59'>
) THEN<a name='60'>
CALL <A href='../../html_code/frame/module_wrf_error.F.html#WRF_ERROR_FATAL'>wrf_error_fatal</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="WRF_ERROR_FATAL_51"> ( "no RK version within dyn_nmm, dyn_opt wrong in namelist, wrf_error_fataling" )<a name='61'>
<a name='62'>
ELSEIF ( dyn_opt .eq. 4 ) THEN<a name='63'>
<a name='64'>
CALL <A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM'>init_domain_nmm</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="INIT_DOMAIN_NMM_1"> (grid, &<a name='65'>
<font color=#447700>!<a name='66'></font>
#include <<A href='../../html_code/include/nmm_actual_args.inc.html'>nmm_actual_args.inc</A>><A NAME="nmm_actual_args.inc_2"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='67'>
<font color=#447700>!<a name='68'></font>
)<a name='69'>
<a name='70'>
ELSE<a name='71'>
WRITE(0,*)' init_domain: unknown or unimplemented dyn_opt = ',dyn_opt<a name='72'>
CALL <A href='../../html_code/frame/module_wrf_error.F.html#WRF_ERROR_FATAL'>wrf_error_fatal</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="WRF_ERROR_FATAL_52"> ( "ERROR-dyn_opt-wrong-in-namelist" )<a name='73'>
ENDIF<a name='74'>
<a name='75'>
END SUBROUTINE init_domain<a name='76'>
<a name='77'>
<font color=#447700>!-------------------------------------------------------------------<a name='78'></font>
<font color=#447700>!---------------------------------------------------------------------<a name='79'></font>
<A NAME='INIT_DOMAIN_NMM'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='80'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>init_domain_nmm</font> ( grid, & <A href='../../call_to/INIT_DOMAIN_NMM.html' TARGET='index'>1</A>,<A href='../../call_from/INIT_DOMAIN_NMM.html' TARGET='index'>9</A><a name='81'>
<font color=#447700>!<a name='82'></font>
# include <<A href='../../html_code/include/nmm_dummy_args.inc.html'>nmm_dummy_args.inc</A>><A NAME="nmm_dummy_args.inc_3"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='83'>
<font color=#447700>!<a name='84'></font>
)<a name='85'>
<a name='86'>
USE <A href='../../html_code/share/module_optional_si_input.F.html#MODULE_OPTIONAL_SI_INPUT'>module_optional_si_input</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODULE_OPTIONAL_SI_INPUT_2"><a name='87'>
IMPLICIT NONE<a name='88'>
<a name='89'>
<font color=#447700>! Input space and data. No gridded meteorological data has been stored, though.<a name='90'></font>
<a name='91'>
<font color=#447700>! TYPE (domain), POINTER :: grid<a name='92'></font>
TYPE (domain) :: grid<a name='93'>
<a name='94'>
# include <<A href='../../html_code/include/nmm_dummy_decl.inc.html'>nmm_dummy_decl.inc</A>><A NAME="nmm_dummy_decl.inc_4"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='95'>
<a name='96'>
TYPE (grid_config_rec_type) :: config_flags<a name='97'>
<a name='98'>
<font color=#447700>! Local domain indices and counters.<a name='99'></font>
<a name='100'>
INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat<a name='101'>
<a name='102'>
INTEGER :: &<a name='103'>
ids, ide, jds, jde, kds, kde, &<a name='104'>
ims, ime, jms, jme, kms, kme, &<a name='105'>
its, ite, jts, jte, kts, kte, &<a name='106'>
i, j, k, NNXP, NNYP, ICOUNT<a name='107'>
<a name='108'>
<font color=#447700>! Local data<a name='109'></font>
<a name='110'>
CHARACTER(LEN=19):: start_date<a name='111'>
<a name='112'>
CHARACTER (LEN=132) :: message<a name='113'>
<a name='114'>
INTEGER :: error<a name='115'>
REAL :: p_surf, p_level<a name='116'>
REAL :: cof1, cof2<a name='117'>
REAL :: qvf , qvf1 , qvf2 , pd_surf<a name='118'>
REAL :: p00 , t00 , a<a name='119'>
REAL :: hold_znw, rmin,rmax<a name='120'>
<a name='121'>
LOGICAL :: stretch_grid, dry_sounding, debug, log_flag_sst<a name='122'>
LOGICAL :: wrf_dm_on_monitor<a name='123'>
<a name='124'>
REAL, ALLOCATABLE,DIMENSION(:,:):: ADUM2D,SNOWC,HT,TG_ALT<a name='125'>
<a name='126'>
INTEGER, ALLOCATABLE, DIMENSION(:):: KHL2,KVL2,KHH2,KVH2, &<a name='127'>
KHLA,KHHA,KVLA,KVHA<a name='128'>
<a name='129'>
<font color=#447700>! INTEGER, ALLOCATABLE, DIMENSION(:,:):: LU_INDEX<a name='130'></font>
<a name='131'>
REAL, ALLOCATABLE, DIMENSION(:):: DXJ,WPDARJ,CPGFUJ,CURVJ, &<a name='132'>
FCPJ,FDIVJ,EMJ,EMTJ,FADJ, &<a name='133'>
HDACJ,DDMPUJ,DDMPVJ<a name='134'>
<a name='135'>
REAL:: TPH0D,TLM0D<a name='136'>
REAL:: TPH0,WB,SB,DLM,DPH,TDLM,TDPH<a name='137'>
REAL:: WBI,SBI,EBI,ANBI,STPH0,CTPH0<a name='138'>
REAL:: TSPH,DTAD,DTCF<a name='139'>
REAL:: ACDT,CDDAMP,TPH,DXP,TLM,FP<a name='140'>
REAL:: CTPH,STPH<a name='141'>
REAL:: WBD,SBD<a name='142'>
REAL:: RSNOW,SNOFAC<a name='143'>
REAL, PARAMETER:: SALP=2.60<a name='144'>
REAL, PARAMETER:: SNUP=0.040<a name='145'>
REAL:: SMCSUM,STCSUM,SEAICESUM,FISX<a name='146'>
REAL:: TERM1,APH<a name='147'>
<a name='148'>
<a name='149'>
<a name='150'>
INTEGER:: KHH,KVH,JAM,JA, IHL, IHH, L<a name='151'>
INTEGER:: II,JJ,ISRCH,ISUM,ival,jval,ITER<a name='152'>
<a name='153'>
REAL, PARAMETER:: DTR=0.01745329<a name='154'>
REAL, PARAMETER:: W_NMM=0.08<a name='155'>
<font color=#447700>!0904 REAL, PARAMETER:: COAC=0.2<a name='156'></font>
REAL, PARAMETER:: COAC=0.75<a name='157'>
REAL, PARAMETER:: CODAMP=6.4<a name='158'>
REAL, PARAMETER:: TWOM=.00014584<a name='159'>
REAL, PARAMETER:: CP=1004.6<a name='160'>
REAL, PARAMETER:: DFC=1.0<a name='161'>
REAL, PARAMETER:: DDFC=1.0<a name='162'>
REAL, PARAMETER:: ROI=916.6<a name='163'>
REAL, PARAMETER:: R=287.04<a name='164'>
REAL, PARAMETER:: CI=2060.0<a name='165'>
REAL, PARAMETER:: ROS=1500.<a name='166'>
REAL, PARAMETER:: CS=1339.2<a name='167'>
REAL, PARAMETER:: DS=0.050<a name='168'>
REAL, PARAMETER:: AKS=.0000005<a name='169'>
REAL, PARAMETER:: DZG=2.85<a name='170'>
REAL, PARAMETER:: DI=.1000<a name='171'>
REAL, PARAMETER:: AKI=0.000001075<a name='172'>
REAL, PARAMETER:: DZI=2.0<a name='173'>
REAL, PARAMETER:: THL=210.<a name='174'>
REAL, PARAMETER:: PLQ=70000.<a name='175'>
REAL, PARAMETER:: ERAD=6371200.<a name='176'>
REAL, PARAMETER:: TG0=258.16<a name='177'>
REAL, PARAMETER:: TGA=30.0<a name='178'>
<a name='179'>
<a name='180'>
#ifdef DEREF_KLUDGE<a name='181'>
<font color=#447700>! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm<a name='182'></font>
INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33<a name='183'>
INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x<a name='184'>
INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y<a name='185'>
#endif<a name='186'>
<a name='187'>
#include "<A href='../../html_code/include/deref_kludge.h.html'>deref_kludge.h</A>"<A NAME="deref_kludge.h_5"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='188'>
<a name='189'>
if (ALLOCATED(ADUM2D)) DEALLOCATE(ADUM2D)<a name='190'>
if (ALLOCATED(TG_ALT)) DEALLOCATE(TG_ALT)<a name='191'>
<a name='192'>
#define COPY_IN<a name='193'>
#include <<A href='../../html_code/include/nmm_scalar_derefs.inc.html'>nmm_scalar_derefs.inc</A>><A NAME="nmm_scalar_derefs.inc_6"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='194'>
#ifdef DM_PARALLEL<a name='195'>
# include <<A href='../../html_code/include/nmm_data_calls.inc.html'>nmm_data_calls.inc</A>><A NAME="nmm_data_calls.inc_7"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='196'>
#endif<a name='197'>
<a name='198'>
SELECT CASE ( model_data_order )<a name='199'>
CASE ( DATA_ORDER_ZXY )<a name='200'>
kds = grid%sd31 ; kde = grid%ed31 ;<a name='201'>
ids = grid%sd32 ; ide = grid%ed32 ;<a name='202'>
jds = grid%sd33 ; jde = grid%ed33 ;<a name='203'>
<a name='204'>
kms = grid%sm31 ; kme = grid%em31 ;<a name='205'>
ims = grid%sm32 ; ime = grid%em32 ;<a name='206'>
jms = grid%sm33 ; jme = grid%em33 ;<a name='207'>
<a name='208'>
kts = grid%sp31 ; kte = grid%ep31 ; <font color=#447700>! tile is entire patch<a name='209'></font>
its = grid%sp32 ; ite = grid%ep32 ; <font color=#447700>! tile is entire patch<a name='210'></font>
jts = grid%sp33 ; jte = grid%ep33 ; <font color=#447700>! tile is entire patch<a name='211'></font>
<a name='212'>
CASE ( DATA_ORDER_XYZ )<a name='213'>
ids = grid%sd31 ; ide = grid%ed31 ;<a name='214'>
jds = grid%sd32 ; jde = grid%ed32 ;<a name='215'>
kds = grid%sd33 ; kde = grid%ed33 ;<a name='216'>
<a name='217'>
ims = grid%sm31 ; ime = grid%em31 ;<a name='218'>
jms = grid%sm32 ; jme = grid%em32 ;<a name='219'>
kms = grid%sm33 ; kme = grid%em33 ;<a name='220'>
<a name='221'>
its = grid%sp31 ; ite = grid%ep31 ; <font color=#447700>! tile is entire patch<a name='222'></font>
jts = grid%sp32 ; jte = grid%ep32 ; <font color=#447700>! tile is entire patch<a name='223'></font>
kts = grid%sp33 ; kte = grid%ep33 ; <font color=#447700>! tile is entire patch<a name='224'></font>
<a name='225'>
CASE ( DATA_ORDER_XZY )<a name='226'>
ids = grid%sd31 ; ide = grid%ed31 ;<a name='227'>
kds = grid%sd32 ; kde = grid%ed32 ;<a name='228'>
jds = grid%sd33 ; jde = grid%ed33 ;<a name='229'>
<a name='230'>
ims = grid%sm31 ; ime = grid%em31 ;<a name='231'>
kms = grid%sm32 ; kme = grid%em32 ;<a name='232'>
jms = grid%sm33 ; jme = grid%em33 ;<a name='233'>
<a name='234'>
its = grid%sp31 ; ite = grid%ep31 ; <font color=#447700>! tile is entire patch<a name='235'></font>
kts = grid%sp32 ; kte = grid%ep32 ; <font color=#447700>! tile is entire patch<a name='236'></font>
jts = grid%sp33 ; jte = grid%ep33 ; <font color=#447700>! tile is entire patch<a name='237'></font>
<a name='238'>
END SELECT<a name='239'>
<a name='240'>
<a name='241'>
grid%DT=float(grid%TIME_STEP)<a name='242'>
<a name='243'>
<a name='244'>
<a name='245'>
<font color=#447700>! NNXP=IDE-1<a name='246'></font>
<font color=#447700>! NNYP=JDE-1<a name='247'></font>
<a name='248'>
NNXP=min(ITE,IDE-1)<a name='249'>
NNYP=min(JTE,JDE-1)<a name='250'>
<a name='251'>
write(0,*) 'nnxp,nnyp: ', nnxp,nnyp<a name='252'>
write(0,*) 'IDE, JDE: ', IDE,JDE<a name='253'>
<a name='254'>
JAM=6+2*(JDE-JDS-10)<a name='255'>
<a name='256'>
ALLOCATE(ADUM2D(grid%sm31:grid%em31,grid%sm33:grid%em33))<a name='257'>
ALLOCATE(KHL2(JTS:NNYP),KVL2(JTS:NNYP),KHH2(JTS:NNYP),KVH2(JTS:NNYP))<a name='258'>
ALLOCATE(DXJ(JTS:NNYP),WPDARJ(JTS:NNYP),CPGFUJ(JTS:NNYP),CURVJ(JTS:NNYP))<a name='259'>
ALLOCATE(FCPJ(JTS:NNYP),FDIVJ(JTS:NNYP),&<a name='260'>
FADJ(JTS:NNYP))<a name='261'>
ALLOCATE(HDACJ(JTS:NNYP),DDMPUJ(JTS:NNYP),DDMPVJ(JTS:NNYP))<a name='262'>
ALLOCATE(KHLA(JAM),KHHA(JAM))<a name='263'>
ALLOCATE(KVLA(JAM),KVHA(JAM))<a name='264'>
<a name='265'>
<a name='266'>
CALL <A href='../../html_code/frame/module_configure.F.html#MODEL_TO_GRID_CONFIG_REC'>model_to_grid_config_rec</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="MODEL_TO_GRID_CONFIG_REC_10"> ( grid%id , model_config_rec , config_flags )<a name='267'>
<a name='268'>
write(0,*) 'cen_lat: ', config_flags%cen_lat<a name='269'>
write(0,*) 'cen_lon: ', config_flags%cen_lon<a name='270'>
<font color=#447700>! write(0,*) 'truelat?: ', config_flags%moad_stand_lats(1)<a name='271'></font>
write(0,*) 'dx: ', config_flags%dx<a name='272'>
write(0,*) 'dy: ', config_flags%dy<a name='273'>
write(0,*) 'config_flags%start_year: ', config_flags%start_year<a name='274'>
write(0,*) 'config_flags%start_month: ', config_flags%start_month<a name='275'>
write(0,*) 'config_flags%start_day: ', config_flags%start_day<a name='276'>
write(0,*) 'config_flags%start_hour: ', config_flags%start_hour<a name='277'>
<a name='278'>
<a name='279'>
write(start_date,435) config_flags%start_year, config_flags%start_month, &<a name='280'>
config_flags%start_day, config_flags%start_hour<a name='281'>
435 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':00:00')<a name='282'>
<a name='283'>
dlmd=config_flags%dx<a name='284'>
dphd=config_flags%dy<a name='285'>
<a name='286'>
<font color=#447700>! tph0d=global_meta%moad_known_lat<a name='287'></font>
<font color=#447700>! tlm0d=global_meta%moad_known_lon<a name='288'></font>
<a name='289'>
tph0d=config_flags%cen_lat<a name='290'>
tlm0d=config_flags%cen_lon<a name='291'>
<a name='292'>
ival=ite-15<a name='293'>
jval=jte-15<a name='294'>
<a name='295'>
<font color=#447700>!==========================================================================<a name='296'></font>
<a name='297'>
<font color=#447700>!!<a name='298'></font>
<a name='299'>
<font color=#447700>! Check to see if the boundary conditions are set <a name='300'></font>
<font color=#447700>! properly in the namelist file.<a name='301'></font>
<font color=#447700>! This checks for sufficiency and redundancy.<a name='302'></font>
<a name='303'>
CALL <A href='../../html_code/share/module_bc.F.html#BOUNDARY_CONDITION_CHECK'>boundary_condition_check</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="BOUNDARY_CONDITION_CHECK_9">( config_flags, bdyzone, error, grid%id )<a name='304'>
<a name='305'>
<font color=#447700>! Some sort of "this is the first time" initialization. Who knows.<a name='306'></font>
<a name='307'>
grid%itimestep=0<a name='308'>
<a name='309'>
<font color=#447700>! Pull in the info in the namelist to compare it to the input data.<a name='310'></font>
<a name='311'>
grid%real_data_init_type = model_config_rec%real_data_init_type<a name='312'>
<a name='313'>
<font color=#447700>! DO j = jts, MIN(jte,jde-1)<a name='314'></font>
<font color=#447700>! DO k = kts, kde-1<a name='315'></font>
<font color=#447700>! DO i = its, MIN(ite,ide-1)<a name='316'></font>
<font color=#447700>! HTM(I,K,J)=1.<a name='317'></font>
<font color=#447700>! VTM(I,K,J)=1.<a name='318'></font>
<font color=#447700>! ENDDO<a name='319'></font>
<font color=#447700>! ENDDO<a name='320'></font>
<font color=#447700>! ENDDO<a name='321'></font>
<a name='322'>
<a name='323'>
<font color=#447700>!!! WEASD has "snow water equivalent" in mm<a name='324'></font>
<a name='325'>
DO j = jts, MIN(jte,jde-1)<a name='326'>
DO i = its, MIN(ite,ide-1)<a name='327'>
<a name='328'>
IF(SM(I,J).GT.0.9) THEN<a name='329'>
<a name='330'>
IF (XICE(I,J) .gt. 0) then<a name='331'>
SI(I,J)=1.0<a name='332'>
ENDIF<a name='333'>
<a name='334'>
<font color=#447700>! SEA<a name='335'></font>
EPSR(I,J)=.97<a name='336'>
GFFC(I,J)=0.<a name='337'>
ALBEDO(I,J)=.06<a name='338'>
ALBASE(I,J)=.06<a name='339'>
IF(SI (I,J).GT.0. ) THEN<a name='340'>
<font color=#447700>! SEA-ICE<a name='341'></font>
SM(I,J)=0.<a name='342'>
SI(I,J)=0.<a name='343'>
SICE(I,J)=1.<a name='344'>
GFFC(I,J)=0. <font color=#447700>! just leave zero as irrelevant<a name='345'></font>
ALBEDO(I,J)=.60<a name='346'>
ALBASE(I,J)=.60<a name='347'>
ENDIF<a name='348'>
ELSE<a name='349'>
<a name='350'>
SI(I,J)=5.0*WEASD(I,J)/1000.<a name='351'>
<font color=#447700>! LAND<a name='352'></font>
EPSR(I,J)=1.0<a name='353'>
GFFC(I,J)=0.0 <font color=#447700>! just leave zero as irrelevant<a name='354'></font>
SICE(I,J)=0.<a name='355'>
SNO(I,J)=SI(I,J)*.20<a name='356'>
ENDIF<a name='357'>
ENDDO<a name='358'>
ENDDO<a name='359'>
<a name='360'>
<font color=#447700>! DETERMINE ALBEDO OVER LAND<a name='361'></font>
DO j = jts, MIN(jte,jde-1)<a name='362'>
DO i = its, MIN(ite,ide-1)<a name='363'>
IF(SM(I,J).LT.0.9.AND.SICE(I,J).LT.0.9) THEN<a name='364'>
<font color=#447700>! SNOWFREE ALBEDO<a name='365'></font>
IF ( (SNO(I,J) .EQ. 0.0) .OR. &<a name='366'>
(ALBASE(I,J) .GE. MXSNAL(I,J) ) ) THEN<a name='367'>
ALBEDO(I,J) = ALBASE(I,J)<a name='368'>
ELSE<a name='369'>
<font color=#447700>! MODIFY ALBEDO IF SNOWCOVER:<a name='370'></font>
<font color=#447700>! BELOW SNOWDEPTH THRESHOLD...<a name='371'></font>
IF (SNO(I,J) .LT. SNUP) THEN<a name='372'>
RSNOW = SNO(I,J)/SNUP<a name='373'>
SNOFAC = 1. - ( EXP(-SALP*RSNOW) - RSNOW*EXP(-SALP))<a name='374'>
<font color=#447700>! ABOVE SNOWDEPTH THRESHOLD...<a name='375'></font>
ELSE<a name='376'>
SNOFAC = 1.0<a name='377'>
ENDIF<a name='378'>
<font color=#447700>! CALCULATE ALBEDO ACCOUNTING FOR SNOWDEPTH AND VGFRCK<a name='379'></font>
ALBEDO(I,J) = ALBASE(I,J) &<a name='380'>
+ (1.0-VEGFRA(I,J))*SNOFAC*(MXSNAL(I,J)-ALBASE(I,J))<a name='381'>
ENDIF<a name='382'>
END IF<a name='383'>
SI(I,J)=5.0*WEASD(I,J)<a name='384'>
SNO(I,J)=WEASD(I,J)<a name='385'>
ENDDO<a name='386'>
ENDDO<a name='387'>
<a name='388'>
<font color=#447700>!new seaice stuff<a name='389'></font>
<a name='390'>
<font color=#447700>! write(0,*) 'skip seaice'<a name='391'></font>
<font color=#447700>! goto 979<a name='392'></font>
<a name='393'>
DO j = jts, MIN(jte,jde-1)<a name='394'>
IHE(J)=MOD(J+1,2)<a name='395'>
IHW(J)=IHE(J)-1<a name='396'>
ENDDO<a name='397'>
<a name='398'>
DO ITER=1,10 <a name='399'>
<a name='400'>
DO j = jts+1, MIN(jte,jde-1)-1<a name='401'>
DO i = its+1, MIN(ite,ide-1)-1<a name='402'>
<a name='403'>
<font color=#447700>! any sea ice around point in question?<a name='404'></font>
<a name='405'>
IF (SM(I,J) .eq. 1) THEN<a name='406'>
<a name='407'>
SEAICESUM=SICE(I+IHE(J),J+1)+SICE(I+IHW(J),J+1)+ &<a name='408'>
SICE(I+IHE(J),J-1)+SICE(I+IHW(J),J-1)<a name='409'>
<a name='410'>
IF (SEAICESUM .ge. 1. .and. SEAICESUM .lt. 3.) THEN<a name='411'>
<a name='412'>
IF ((SICE(I+IHE(J),J+1).eq.0 .and. SM(I+IHE(J),J+1).eq.0) .OR. &<a name='413'>
(SICE(I+IHW(J),J+1).eq.0 .and. SM(I+IHW(J),J+1).eq.0) .OR. &<a name='414'>
(SICE(I+IHE(J),J-1).eq.0 .and. SM(I+IHE(J),J-1).eq.0) .OR. &<a name='415'>
(SICE(I+IHW(J),J-1).eq.0 .and. SM(I+IHW(J),J-1).eq.0)) THEN <a name='416'>
<a name='417'>
<font color=#447700>! HAVE SEA ICE AND A SURROUNDING LAND POINT - CONVERT TO SEA ICE<a name='418'></font>
<a name='419'>
write(0,*) 'MAKING SEA ICE AT I,J: ', I,J, 'on iter: ', iter<a name='420'>
SICE(I,J)=1.0<a name='421'>
SM(I,J)=0.<a name='422'>
<a name='423'>
ENDIF<a name='424'>
<a name='425'>
ELSEIF (SEAICESUM .ge. 3) THEN<a name='426'>
<a name='427'>
<font color=#447700>! WATER POINT SURROUNDED BY ICE - CONVERT TO SEA ICE<a name='428'></font>
<a name='429'>
write(0,*) 'MAKING SEA ICE(2) AT I,J: ', I,J, 'on iter: ', iter<a name='430'>
SICE(I,J)=1.0<a name='431'>
SM(I,J)=0.<a name='432'>
<a name='433'>
ENDIF<a name='434'>
<a name='435'>
ENDIF<a name='436'>
<a name='437'>
ENDDO<a name='438'>
ENDDO<a name='439'>
<a name='440'>
ENDDO<a name='441'>
<a name='442'>
<a name='443'>
<a name='444'>
979 continue<a name='445'>
<a name='446'>
<a name='447'>
<font color=#447700>!new new seaice stuff<a name='448'></font>
<a name='449'>
<font color=#447700>! this block meant to guarantee land/sea agreement between SM and landmask<a name='450'></font>
<a name='451'>
DO j = jts, MIN(jte,jde-1)<a name='452'>
DO i = its, MIN(ite,ide-1)<a name='453'>
<a name='454'>
if (SM(I,J) .gt. 0.5) then<a name='455'>
landmask(I,J)=0.0<a name='456'>
elseif (SM(I,J) .eq. 0 .and. SICE(I,J) .eq. 1) then<a name='457'>
landmask(I,J)=0.0<a name='458'>
elseif (SM(I,J) .lt. 0.5 .and. SICE(I,J) .eq. 0) then<a name='459'>
landmask(I,J)=1.0<a name='460'>
else<a name='461'>
write(0,*) 'missed point in landmask definition ' , I,J<a name='462'>
landmask(I,J)=0.0<a name='463'>
endif<a name='464'>
<a name='465'>
ENDDO<a name='466'>
ENDDO<a name='467'>
<a name='468'>
<font color=#447700>! For sf_surface_physics = 1, we want to use close to a 10 cm value<a name='469'></font>
<font color=#447700>! for the bottom level of the soil temps.<a name='470'></font>
<a name='471'>
IF ( ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .AND. &<a name='472'>
( flag_st000010 .EQ. 1 ) ) THEN<a name='473'>
DO j = jts , MIN(jde-1,jte)<a name='474'>
DO i = its , MIN(ide-1,ite)<a name='475'>
soiltb(i,j) = st000010(i,j)<a name='476'>
END DO<a name='477'>
END DO<a name='478'>
<font color=#447700>! ELSE IF ( ( model_config_rec%sf_surface_physics(grid%id) .EQ. 1 ) .AND. &<a name='479'></font>
<font color=#447700>! ( flag_soilt020 .EQ. 1 ) ) THEN<a name='480'></font>
<font color=#447700>! DO j = jts , MIN(jde-1,jte)<a name='481'></font>
<font color=#447700>! DO i = its , MIN(ide-1,ite)<a name='482'></font>
<font color=#447700>! soiltb(i,j) = soilt020(i,j)<a name='483'></font>
<font color=#447700>! END DO<a name='484'></font>
<font color=#447700>! END DO<a name='485'></font>
END IF<a name='486'>
<font color=#447700>! write(0,*)' init_domain_nmm flag_toposoil=',flag_toposoil<a name='487'></font>
<a name='488'>
<a name='489'>
<font color=#447700>! Adjust the various soil temperature values depending on the difference in<a name='490'></font>
<font color=#447700>! in elevation between the current model's elevation and the incoming data's<a name='491'></font>
<font color=#447700>! orography.<a name='492'></font>
<a name='493'>
write(0,*) 'flag_toposoil= ', flag_toposoil<a name='494'>
<a name='495'>
IF ( ( flag_toposoil .EQ. 1 ) ) THEN <a name='496'>
<a name='497'>
ALLOCATE(HT(ims:ime,jms:jme))<a name='498'>
<a name='499'>
DO J=jms,jme<a name='500'>
DO I=ims,ime<a name='501'>
HT(I,J)=FIS(I,J)/9.81<a name='502'>
END DO<a name='503'>
END DO<a name='504'>
<a name='505'>
<font color=#447700>! if (maxval(toposoil) .gt. 100.) then<a name='506'></font>
<a name='507'>
<font color=#447700>! being avoided. Something to revisit eventually.<a name='508'></font>
<font color=#447700>!<a name='509'></font>
<font color=#447700>!1219 might be simply a matter of including TOPOSOIL <a name='510'></font>
<font color=#447700>!<a name='511'></font>
<font color=#447700>! CODE NOT TESTED AT NCEP USING THIS FUNCTIONALITY, <a name='512'></font>
<font color=#447700>! SO TO BE SAFE WILL AVOID FOR RETRO RUNS.<a name='513'></font>
<a name='514'>
<font color=#447700>! write(0,*) 'calling adjust_soil_temp_new'<a name='515'></font>
<font color=#447700>! CALL adjust_soil_temp_new ( soiltb , 2 , &<a name='516'></font>
<font color=#447700>! nmm_tsk , ht , toposoil , landmask, flag_toposoil , &<a name='517'></font>
<font color=#447700>! st000010 , st010040 , st040100 , st100200 , st010200 , &<a name='518'></font>
<font color=#447700>! flag_st000010 , flag_st010040 , flag_st040100 , &<a name='519'></font>
<font color=#447700>! flag_st100200 , flag_st010200 , &<a name='520'></font>
<font color=#447700>! soilt000 , soilt005 , soilt020 , soilt040 , &<a name='521'></font>
<font color=#447700>! soilt160 , soilt300 , &<a name='522'></font>
<font color=#447700>! flag_soilt000 , flag_soilt005 , flag_soilt020 , &<a name='523'></font>
<font color=#447700>! flag_soilt040 , flag_soilt160 , flag_soilt300 , &<a name='524'></font>
<font color=#447700>! ids , ide , jds , jde , kds , kde , &<a name='525'></font>
<font color=#447700>! ims , ime , jms , jme , kms , kme , &<a name='526'></font>
<font color=#447700>! its , ite , jts , jte , kts , kte )<a name='527'></font>
<font color=#447700>! endif<a name='528'></font>
<a name='529'>
END IF<a name='530'>
<a name='531'>
<font color=#447700>! Process the LSM data.<a name='532'></font>
<a name='533'>
IF ( grid%real_data_init_type .EQ. 1 ) THEN<a name='534'>
<a name='535'>
num_veg_cat = SIZE ( landusef , DIM=2 )<a name='536'>
num_soil_top_cat = SIZE ( soilctop , DIM=2 )<a name='537'>
num_soil_bot_cat = SIZE ( soilcbot , DIM=2 )<a name='538'>
<a name='539'>
<a name='540'>
<a name='541'>
<font color=#447700>! sm (1=water, 0=land)<a name='542'></font>
<font color=#447700>! landmask(0=water, 1=land)<a name='543'></font>
<a name='544'>
<a name='545'>
<a name='546'>
CALL <A href='../../html_code/share/module_soil_pre.F.html#PROCESS_PERCENT_CAT_NEW'>process_percent_cat_new</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="PROCESS_PERCENT_CAT_NEW_2"> ( landmask , &<a name='547'>
landusef , soilctop , soilcbot , &<a name='548'>
isltyp , ivgtyp , &<a name='549'>
num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &<a name='550'>
ids , ide , jds , jde , kds , kde , &<a name='551'>
ims , ime , jms , jme , kms , kme , &<a name='552'>
its , ite , jts , jte , kts , kte , &<a name='553'>
model_config_rec%iswater(grid%id) )<a name='554'>
<a name='555'>
<a name='556'>
DO j = jts, MIN(jde-1,jte)<a name='557'>
DO i = its, MIN(ide-1,ite)<a name='558'>
<a name='559'>
IF (SICE(I,J) .eq. 0) THEN<a name='560'>
<a name='561'>
if (landmask(I,J) .gt. 0.5 .and. sm(I,J) .eq. 1.0) then<a name='562'>
write(0,*) 'land mask and SM both > 0.5: ', &<a name='563'>
I,J,landmask(I,J),sm(I,J)<a name='564'>
<a name='565'>
SM(I,J)=0.<a name='566'>
<a name='567'>
elseif (landmask(I,J) .lt. 0.5 .and. sm(I,J) .eq. 0.0) then<a name='568'>
write(0,*) 'land mask and SM both < 0.5: ', &<a name='569'>
I,J, landmask(I,J),sm(I,J)<a name='570'>
<a name='571'>
SM(I,J)=1.<a name='572'>
<a name='573'>
endif<a name='574'>
<a name='575'>
ELSE<a name='576'>
<a name='577'>
if (landmask(I,J) .gt. 0.5 .and. SM(I,J)+SICE(I,J) .eq. 1) then<a name='578'>
write(0,*) 'landmask says LAND, SM/SICE say SEAICE: ', I,J<a name='579'>
endif<a name='580'>
<a name='581'>
ENDIF<a name='582'>
<a name='583'>
ENDDO<a name='584'>
ENDDO<a name='585'>
<a name='586'>
DO j = jts, MIN(jde-1,jte)<a name='587'>
DO i = its, MIN(ide-1,ite)<a name='588'>
<a name='589'>
if (SICE(I,J) .eq. 1.0) then<a name='590'>
<font color=#447700>!!!! change vegtyp and sltyp to fit seaice (desireable??)<a name='591'></font>
ISLTYP(I,J)=16<a name='592'>
IVGTYP(I,J)=24<a name='593'>
endif<a name='594'>
<a name='595'>
ENDDO<a name='596'>
ENDDO<a name='597'>
<a name='598'>
<a name='599'>
<font color=#447700>! MOVE HERE<a name='600'></font>
<a name='601'>
write(0,*) 'flag_sst before define is: ', flag_sst<a name='602'>
<font color=#447700>! write(0,*)' init_domain_nmm flag_sst=',flag_sst<a name='603'></font>
FLAG_SST=1<a name='604'>
<a name='605'>
DO j = jts, MIN(jde-1,jte)<a name='606'>
DO i = its, MIN(ide-1,ite)<a name='607'>
<a name='608'>
if (SM(I,J) .lt. 0.5) then<a name='609'>
SST(I,J)=0.<a name='610'>
endif<a name='611'>
<a name='612'>
if (SM(I,J) .gt. 0.5) then<a name='613'>
if (SST(I,J) .eq. 0) then<a name='614'>
SST(I,J)=NMM_TSK(I,J)<a name='615'>
endif<a name='616'>
NMM_TSK(I,J)=0.<a name='617'>
endif<a name='618'>
<a name='619'>
<a name='620'>
if ( (NMM_TSK(I,J)+SST(I,J)) .lt. 200. .or. &<a name='621'>
(NMM_TSK(I,J)+SST(I,J)) .gt. 350. ) then<a name='622'>
write(0,*) 'TSK, SST trouble at : ', I,J<a name='623'>
write(0,*) 'SM= ', SM(I,J)<a name='624'>
write(0,*) 'NMM_TSK(I,J), SST(I,J): ', NMM_TSK(I,J), SST(I,J)<a name='625'>
endif<a name='626'>
<a name='627'>
ENDDO<a name='628'>
ENDDO<a name='629'>
<a name='630'>
write(0,*) 'SM'<a name='631'>
do J=min(jde-1,jte),jts,-(jte-jts)/15<a name='632'>
write(0,635) (sm(i,J),I=its,ite,(ite-its)/10)<a name='633'>
enddo<a name='634'>
<a name='635'>
<font color=#447700>! write(0,*) 'SST/NMM_TSK'<a name='636'></font>
<font color=#447700>! do J=min(jde-1,jte),jts,-(jte-jts)/15<a name='637'></font>
<font color=#447700>! write(0,635) (SST(I,J)+NMM_TSK(I,J),I=ITS,min(ide-1,ite),(ite-its)/10)<a name='638'></font>
<font color=#447700>! enddo<a name='639'></font>
<a name='640'>
635 format(20(f5.1,1x))<a name='641'>
<a name='642'>
<a name='643'>
DO j = jts, MIN(jde-1,jte)<a name='644'>
DO i = its, MIN(ide-1,ite)<a name='645'>
IF ( ( landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) ) THEN<a name='646'>
soiltb(i,j) = sst(i,j)<a name='647'>
<font color=#447700>!curious ELSE IF ( landmask(i,j) .LT. 0.5 ) THEN<a name='648'></font>
ELSE IF ( landmask(i,j) .GT. 0.5 ) THEN<a name='649'>
soiltb(i,j) = nmm_tsk(i,j)<a name='650'>
END IF<a name='651'>
END DO<a name='652'>
END DO<a name='653'>
<a name='654'>
<font color=#447700>! END IF<a name='655'></font>
<a name='656'>
<a name='657'>
<a name='658'>
<font color=#447700>! END MOVE HERE<a name='659'></font>
<a name='660'>
<a name='661'>
<font color=#447700>! Land use categories, dominant soil and vegetation types (if available).<a name='662'></font>
<a name='663'>
<font color=#447700>! allocate(lu_index(ims:ime,jms:jme))<a name='664'></font>
<a name='665'>
DO j = jts, MIN(jde-1,jte)<a name='666'>
DO i = its, MIN(ide-1,ite)<a name='667'>
lu_index(i,j) = ivgtyp(i,j)<a name='668'>
END DO<a name='669'>
END DO<a name='670'>
<a name='671'>
END IF<a name='672'>
<a name='673'>
<a name='674'>
if (flag_sst .eq. 1) log_flag_sst=.true.<a name='675'>
if (flag_sst .eq. 0) log_flag_sst=.false.<a name='676'>
<a name='677'>
<font color=#447700>! write(0,*) 'st_levels_input: ', st_levels_input<a name='678'></font>
<font color=#447700>! write(0,*) 'num_st_levels_input: ', num_st_levels_input<a name='679'></font>
<a name='680'>
<a name='681'>
write(0,*) 'maxval st_input(1): ', maxval(st_input(:,1,:))<a name='682'>
write(0,*) 'maxval st_input(2): ', maxval(st_input(:,2,:))<a name='683'>
write(0,*) 'maxval st_input(3): ', maxval(st_input(:,3,:))<a name='684'>
write(0,*) 'maxval st_input(4): ', maxval(st_input(:,4,:))<a name='685'>
<a name='686'>
<font color=#447700>!!!!!!!!!!!!!!!!!!!!!!!!!<a name='687'></font>
<font color=#447700>!!!!!!!!!!!!!!!!!!!!!!!!!<a name='688'></font>
<a name='689'>
ALLOCATE(TG_ALT(grid%sm31:grid%em31,grid%sm33:grid%em33))<a name='690'>
<a name='691'>
<a name='692'>
TPH0=TPH0D*DTR<a name='693'>
<font color=#447700>! WBD=-((nnxp-1)*DLMD)<a name='694'></font>
WBD=-(((ide-1)-1)*DLMD)<a name='695'>
WB= WBD*DTR<a name='696'>
<font color=#447700>! SBD=-((nnyp/2)*DPHD)<a name='697'></font>
SBD=-(((jde-1)/2)*DPHD)<a name='698'>
SB= SBD*DTR<a name='699'>
DLM=DLMD*DTR<a name='700'>
DPH=DPHD*DTR<a name='701'>
TDLM=DLM+DLM<a name='702'>
TDPH=DPH+DPH<a name='703'>
WBI=WB+TDLM<a name='704'>
SBI=SB+TDPH<a name='705'>
<font color=#447700>! EBI=WB+(nnxp-2)*TDLM<a name='706'></font>
EBI=WB+(ide-2)*TDLM<a name='707'>
ANBI=SB+(jde-2)*DPH<a name='708'>
STPH0=SIN(TPH0)<a name='709'>
CTPH0=COS(TPH0)<a name='710'>
TSPH=3600./GRID%DT<a name='711'>
DO J=JTS,min(JTE,JDE-1)<a name='712'>
TLM=WB-TDLM+MOD(J,2)*DLM <font color=#447700>!For velocity points on the E grid<a name='713'></font>
TPH=SB+float(J-1)*DPH<a name='714'>
STPH=SIN(TPH)<a name='715'>
CTPH=COS(TPH)<a name='716'>
DO I=ITS,MIN(ITE,IDE-1)<a name='717'>
<a name='718'>
if (I .eq. ITS) THEN<a name='719'>
TLM=TLM+TDLM*ITS<a name='720'>
else<a name='721'>
TLM=TLM+TDLM<a name='722'>
endif<a name='723'>
<a name='724'>
TERM1=(STPH0*CTPH*COS(TLM)+CTPH0*STPH)<a name='725'>
FP=TWOM*(TERM1)<a name='726'>
F(I,J)=0.5*GRID%DT*FP<a name='727'>
ENDDO<a name='728'>
ENDDO<a name='729'>
DO J=JTS,min(JTE,JDE-1)<a name='730'>
TLM=WB-TDLM+MOD(J+1,2)*DLM <font color=#447700>!For mass points on the E grid<a name='731'></font>
TPH=SB+float(J-1)*DPH<a name='732'>
STPH=SIN(TPH)<a name='733'>
CTPH=COS(TPH)<a name='734'>
DO I=ITS,MIN(ITE,IDE-1)<a name='735'>
<a name='736'>
if (I .eq. ITS) THEN<a name='737'>
TLM=TLM+TDLM*ITS<a name='738'>
else<a name='739'>
TLM=TLM+TDLM<a name='740'>
endif<a name='741'>
<a name='742'>
TERM1=(STPH0*CTPH*COS(TLM)+CTPH0*STPH)<a name='743'>
APH=ASIN(TERM1)<a name='744'>
TG_ALT(I,J)=TG0+TGA*COS(APH)-FIS(I,J)/3333.<a name='745'>
ENDDO<a name='746'>
ENDDO<a name='747'>
<a name='748'>
<a name='749'>
<a name='750'>
DO j = jts, MIN(jde-1,jte)<a name='751'>
DO i = its, MIN(ide-1,ite)<a name='752'>
<font color=#447700>! IF ( ( landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) .AND. &<a name='753'></font>
<font color=#447700>! SICE(I,J) .eq. 0. ) THEN<a name='754'></font>
<font color=#447700>! TG(i,j) = sst(i,j)<a name='755'></font>
<font color=#447700>! ELSEIF (SICE(I,J) .eq. 1) THEN<a name='756'></font>
<font color=#447700>! TG(i,j) = 271.16<a name='757'></font>
<font color=#447700>! END IF<a name='758'></font>
<a name='759'>
if (TG(I,J) .lt. 200.) then <font color=#447700>! only use default TG_ALT definition if<a name='760'></font>
<font color=#447700>! not getting TGROUND from SI<a name='761'></font>
TG(I,J)=TG_ALT(I,J)<a name='762'>
endif<a name='763'>
<a name='764'>
if (TG(I,J) .lt. 200. .or. TG(I,J) .gt. 320.) then<a name='765'>
write(message,*) 'problematic TG point at : ', I,J<a name='766'>
CALL <A href='../../html_code/frame/module_wrf_error.F.html#WRF_MESSAGE'>wrf_message</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="WRF_MESSAGE_11">( message )<a name='767'>
endif<a name='768'>
<a name='769'>
adum2d(i,j)=nmm_tsk(I,J)+sst(I,J)<a name='770'>
<a name='771'>
END DO<a name='772'>
END DO<a name='773'>
<a name='774'>
DEALLOCATE(TG_ALT)<a name='775'>
<a name='776'>
CALL <A href='../../html_code/share/module_soil_pre.F.html#PROCESS_SOIL_REAL'>process_soil_real</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="PROCESS_SOIL_REAL_2"> ( adum2d, TG , &<a name='777'>
landmask, sst, &<a name='778'>
st_input, sm_input, sw_input, &<a name='779'>
st_levels_input , sm_levels_input , &<a name='780'>
sw_levels_input , &<a name='781'>
sldpth , dzsoil , stc , smc , sh2o, &<a name='782'>
flag_sst , flag_soilt000, flag_soilm000, &<a name='783'>
ids , ide , jds , jde , kds , kde , &<a name='784'>
ims , ime , jms , jme , kms , kme , &<a name='785'>
its , ite , jts , jte , kts , kte , &<a name='786'>
model_config_rec%sf_surface_physics(grid%id) , &<a name='787'>
model_config_rec%num_soil_layers , &<a name='788'>
model_config_rec%real_data_init_type , &<a name='789'>
num_st_levels_input , num_sm_levels_input , &<a name='790'>
num_sw_levels_input , &<a name='791'>
num_st_levels_alloc , num_sm_levels_alloc , &<a name='792'>
num_sw_levels_alloc )<a name='793'>
write(0,*)' its=',its,' ite=',ite,' jts=',jts,' jte=',jte<a name='794'>
write(0,*)' ide=',ide,' jde=',jde<a name='795'>
<a name='796'>
<font color=#447700>!!! zero out NMM_TSK at water points again<a name='797'></font>
<a name='798'>
DO j = jts, MIN(jde-1,jte)<a name='799'>
DO i = its, MIN(ide-1,ite)<a name='800'>
if (SM(I,J) .gt. 0.5) then<a name='801'>
NMM_TSK(I,J)=0.<a name='802'>
endif<a name='803'>
END DO<a name='804'>
END DO<a name='805'>
<a name='806'>
<a name='807'>
<font color=#447700>!! check on STC<a name='808'></font>
<a name='809'>
DO j = jts, MIN(jde-1,jte)<a name='810'>
DO i = its, MIN(ide-1,ite)<a name='811'>
<a name='812'>
IF (SICE(I,J) .eq. 1.0) then<a name='813'>
DO L = 1, grid%num_soil_layers<a name='814'>
STC(I,L,J)=271.16 <font color=#447700>! TG value used by Eta/NMM<a name='815'></font>
END DO<a name='816'>
END IF<a name='817'>
<a name='818'>
END DO<a name='819'>
END DO<a name='820'>
<a name='821'>
write(0,*) 'STC(1)'<a name='822'>
do J=min(jde-1,jte),jts,-(jte-jts)/15<a name='823'>
write(0,635) (stc(I,1,J),I=its,ite,(ite-its)/12)<a name='824'>
enddo<a name='825'>
<a name='826'>
<a name='827'>
ICOUNT=0<a name='828'>
DO j = jts, MIN(jde-1,jte)<a name='829'>
DO i= ITS, MIN(IDE-1,ITE)<a name='830'>
IF (STC(I,1,J) .lt. 200. .and. SM(I,J) .eq. 0) then<a name='831'>
write(0,*) 'troublesome STC...I,J,STC,SM,SICE,SMC: ',& <a name='832'>
I,J,STC(I,1,J),SM(I,J),SICE(I,J),SMC(I,1,J)<a name='833'>
ICOUNT=ICOUNT+1<a name='834'>
if (ICOUNT .eq. 100) then<a name='835'>
call <A href='../../html_code/frame/module_wrf_error.F.html#WRF_ERROR_FATAL'>wrf_error_fatal</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="WRF_ERROR_FATAL_53">("bad STC data...quit before gets worse")<a name='836'>
endif<a name='837'>
endif<a name='838'>
<a name='839'>
ENDDO<a name='840'>
ENDDO<a name='841'>
<a name='842'>
<font color=#447700>!hardwire soil stuff for time being<a name='843'></font>
<a name='844'>
RTDPTH=0.<a name='845'>
RTDPTH(1)=0.1<a name='846'>
RTDPTH(2)=0.3<a name='847'>
RTDPTH(3)=0.6<a name='848'>
<a name='849'>
SLDPTH=0.<a name='850'>
SLDPTH(1)=0.1<a name='851'>
SLDPTH(2)=0.3<a name='852'>
SLDPTH(3)=0.6<a name='853'>
SLDPTH(4)=1.0<a name='854'>
<a name='855'>
write(0,*) 'SLDPTH: ', SLDPTH(1:4)<a name='856'>
write(0,*) 'RTDPTH: ', RTDPTH(1:4)<a name='857'>
<a name='858'>
<font color=#447700>!!! main body of nmm_specific starts here<a name='859'></font>
<a name='860'>
<font color=#447700>!<a name='861'></font>
<font color=#447700>! Gopal's doing's : LMH and LMV should be flipped for start_domain_nmm.F<a name='862'></font>
<font color=#447700>! this is consistent with Tom's version<a name='863'></font>
<font color=#447700>!<a name='864'></font>
<a name='865'>
do J=jts,min(jte,jde-1)<a name='866'>
do I=its,min(ite,ide-1)<a name='867'>
LMH(I,J)= kme-1 <font color=#447700>!1<a name='868'></font>
LMV(I,J)= kme-1 <font color=#447700>!1<a name='869'></font>
RES(I,J)=1.<a name='870'>
enddo<a name='871'>
enddo<a name='872'>
<a name='873'>
<a name='874'>
<a name='875'>
<font color=#447700>!! HBM2<a name='876'></font>
<a name='877'>
HBM2=0.<a name='878'>
<a name='879'>
do J=jts,min(jte,jde-1)<a name='880'>
do I=its,min(ite,ide-1)<a name='881'>
<a name='882'>
<a name='883'>
IF ( (J .ge. 3 .and. J .le. (jde-1)-2) .AND. &<a name='884'>
(I .ge. 2 .and. I .le. (ide-1)-2+mod(J,2)) ) THEN<a name='885'>
HBM2(I,J)=1.<a name='886'>
ENDIF<a name='887'>
enddo<a name='888'>
enddo<a name='889'>
<a name='890'>
<a name='891'>
636 format(60(f2.0))<a name='892'>
<a name='893'>
<a name='894'>
<font color=#447700>!! HBM3<a name='895'></font>
HBM3=0.<a name='896'>
<a name='897'>
<a name='898'>
<font color=#447700>!! LOOP OVER LOCAL DIMENSIONS<a name='899'></font>
<a name='900'>
do J=jts,min(jte,jde-1)<a name='901'>
IHWG(J)=mod(J+1,2)-1<a name='902'>
IF (J .ge. 4 .and. J .le. (jde-1)-3) THEN<a name='903'>
IHL=(ids+1)-IHWG(J)<a name='904'>
IHH=(ide-1)-2<a name='905'>
do I=its,min(ite,ide-1)<a name='906'>
IF (I .ge. IHL .and. I .le. IHH) HBM3(I,J)=1.<a name='907'>
enddo<a name='908'>
ENDIF<a name='909'>
enddo<a name='910'>
<a name='911'>
<a name='912'>
<font color=#447700>!! VBM2<a name='913'></font>
<a name='914'>
VBM2=0.<a name='915'>
<a name='916'>
do J=jts,min(jte,jde-1)<a name='917'>
do I=its,min(ite,ide-1)<a name='918'>
<a name='919'>
IF ( (J .ge. 3 .and. J .le. (jde-1)-2) .AND. &<a name='920'>
(I .ge. 2 .and. I .le. (ide-1)-1-mod(J,2)) ) THEN<a name='921'>
<a name='922'>
VBM2(I,J)=1.<a name='923'>
<a name='924'>
ENDIF<a name='925'>
<a name='926'>
enddo<a name='927'>
enddo<a name='928'>
<a name='929'>
<font color=#447700>!! VBM3<a name='930'></font>
<a name='931'>
VBM3=0.<a name='932'>
<a name='933'>
do J=jts,min(jte,jde-1)<a name='934'>
do I=its,min(ite,ide-1)<a name='935'>
<a name='936'>
IF ( (J .ge. 4 .and. J .le. (jde-1)-3) .AND. &<a name='937'>
(I .ge. 3-mod(J,2) .and. I .le. (ide-1)-2) ) THEN<a name='938'>
<a name='939'>
VBM3(I,J)=1.<a name='940'>
<a name='941'>
ENDIF<a name='942'>
<a name='943'>
enddo<a name='944'>
enddo<a name='945'>
<a name='946'>
<font color=#447700>! DTAD=1 in const.f of intrst code<a name='947'></font>
DTAD=1.0<a name='948'>
<a name='949'>
<font color=#447700>! IDTCF=DTCF, IDTCF=4<a name='950'></font>
DTCF=4.0 <font color=#447700>! used?<a name='951'></font>
<a name='952'>
DY_NMM=ERAD*DPH<a name='953'>
CPGFV=-GRID%DT/(48.*DY_NMM)<a name='954'>
EN= GRID%DT/( 4.*DY_NMM)*DTAD<a name='955'>
ENT=GRID%DT/(16.*DY_NMM)*DTAD<a name='956'>
<a name='957'>
<a name='958'>
DO J=jts,nnyp<a name='959'>
KHL2(J)=(IDE-1)*(J-1)-(J-1)/2+2<a name='960'>
KVL2(J)=(IDE-1)*(J-1)-J/2+2<a name='961'>
KHH2(J)=(IDE-1)*J-J/2-1<a name='962'>
KVH2(J)=(IDE-1)*J-(J+1)/2-1<a name='963'>
ENDDO<a name='964'>
<a name='965'>
TPH=SB-DPH<a name='966'>
<a name='967'>
<font color=#447700>! DO J=jts,NNYP<a name='968'></font>
DO J=jts,min(jte,jde-1)<a name='969'>
<font color=#447700>! DO J=jds,jde-1<a name='970'></font>
TPH=SB+float(J-1)*DPH<a name='971'>
DXP=ERAD*DLM*COS(TPH)<a name='972'>
DXJ(J)=DXP<a name='973'>
WPDARJ(J)=-W_NMM * &<a name='974'>
((ERAD*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY_NMM**2)/ &<a name='975'>
(GRID%DT*32.*DXP*DY_NMM)<a name='976'>
<a name='977'>
CPGFUJ(J)=-GRID%DT/(48.*DXP)<a name='978'>
CURVJ(J)=.5*GRID%DT*TAN(TPH)/ERAD<a name='979'>
FCPJ(J)=GRID%DT/(CP*192.*DXP*DY_NMM)<a name='980'>
FDIVJ(J)=1./(12.*DXP*DY_NMM)<a name='981'>
<font color=#447700>! EMJ(J)= GRID%DT/( 4.*DXP)*DTAD<a name='982'></font>
<font color=#447700>! EMTJ(J)=GRID%DT/(16.*DXP)*DTAD<a name='983'></font>
FADJ(J)=-GRID%DT/(48.*DXP*DY_NMM)*DTAD<a name='984'>
ACDT=GRID%DT*SQRT((ERAD*DLM*AMIN1(COS(ANBI),COS(SBI)))**2+DY_NMM**2)<a name='985'>
CDDAMP=CODAMP*ACDT<a name='986'>
HDACJ(J)=COAC*ACDT/(4.*DXP*DY_NMM)<a name='987'>
DDMPUJ(J)=CDDAMP/DXP<a name='988'>
DDMPVJ(J)=CDDAMP/DY_NMM<a name='989'>
ENDDO<a name='990'>
<a name='991'>
<font color=#447700>!!! wrf_dm_on_monitor block was here, but was causing problems for unknown reasons<a name='992'></font>
<a name='993'>
<a name='994'>
DO J=JTS,min(JTE,JDE-1)<a name='995'>
TLM=WB-TDLM+MOD(J,2)*DLM<a name='996'>
TPH=SB+float(J-1)*DPH<a name='997'>
STPH=SIN(TPH)<a name='998'>
CTPH=COS(TPH)<a name='999'>
DO I=ITS,MIN(ITE,IDE-1)<a name='1000'>
<a name='1001'>
if (I .eq. ITS) THEN<a name='1002'>
TLM=TLM+TDLM*ITS<a name='1003'>
else<a name='1004'>
TLM=TLM+TDLM<a name='1005'>
endif<a name='1006'>
<a name='1007'>
FP=TWOM*(CTPH0*STPH+STPH0*CTPH*COS(TLM))<a name='1008'>
F(I,J)=0.5*GRID%DT*FP<a name='1009'>
<a name='1010'>
ENDDO<a name='1011'>
ENDDO<a name='1012'>
<a name='1013'>
<font color=#447700>! --------------DERIVED VERTICAL GRID CONSTANTS--------------------------<a name='1014'></font>
<a name='1015'>
EF4T=.5*GRID%DT/CP<a name='1016'>
F4Q = -GRID%DT*DTAD<a name='1017'>
F4D =-.5*GRID%DT*DTAD<a name='1018'>
<a name='1019'>
<font color=#447700>! DO L=KDS,KDE<a name='1020'></font>
DO L=KDS,KDE-1<a name='1021'>
RDETA(L)=1./DETA(L)<a name='1022'>
F4Q2(L)=-.25*GRID%DT*DTAD/DETA(L)<a name='1023'>
ENDDO<a name='1024'>
<a name='1025'>
<a name='1026'>
<font color=#447700>! shouldnt need to be done globally, right?<a name='1027'></font>
DO J=JTS,min(JTE,JDE-1)<a name='1028'>
DO I=ITS,min(ITE,IDE-1)<a name='1029'>
DX_NMM(I,J)=DXJ(J)<a name='1030'>
WPDAR(I,J)=WPDARJ(J)*HBM2(I,J)<a name='1031'>
CPGFU(I,J)=CPGFUJ(J)*VBM2(I,J)<a name='1032'>
CURV(I,J)=CURVJ(J)*VBM2(I,J)<a name='1033'>
FCP(I,J)=FCPJ(J)*HBM2(I,J)<a name='1034'>
FDIV(I,J)=FDIVJ(J)*HBM2(I,J)<a name='1035'>
FAD(I,J)=FADJ(J)<a name='1036'>
<font color=#447700>! if (mod(I,5) .eq. 0 .and. mod(J,5) .eq. 0) then<a name='1037'></font>
<font color=#447700>! write(0,*) 'I,J,FADJ,FAD(I,J): ', I,J,FADJ(J),FAD(I,J)<a name='1038'></font>
<font color=#447700>! endif<a name='1039'></font>
HDACV(I,J)=HDACJ(J)*VBM2(I,J)<a name='1040'>
HDAC(I,J)=HDACJ(J)*1.25*HBM2(I,J)<a name='1041'>
ENDDO<a name='1042'>
ENDDO<a name='1043'>
<a name='1044'>
<a name='1045'>
<a name='1046'>
<font color=#447700>! DO J=3,(JDE-1)-2<a name='1047'></font>
DO J=JTS, MIN(JDE-1,JTE)<a name='1048'>
<a name='1049'>
IF (J.LE.5.OR.J.GE.(JDE-1)-4) THEN<a name='1050'>
<a name='1051'>
KHH=(IDE-1)-2+MOD(J,2) <font color=#447700>! KHH is global...loop over I that have<a name='1052'></font>
DO I=ITS,MIN(IDE-1,ITE)<a name='1053'>
IF (I .ge. 2 .and. I .le. KHH) THEN<a name='1054'>
HDAC(I,J)=HDAC(I,J)* DFC<a name='1055'>
ENDIF<a name='1056'>
ENDDO<a name='1057'>
<a name='1058'>
ELSE<a name='1059'>
<a name='1060'>
KHH=2+MOD(J,2)<a name='1061'>
DO I=ITS,MIN(IDE-1,ITE)<a name='1062'>
IF (I .ge. 2 .and. I .le. KHH) THEN<a name='1063'>
HDAC(I,J)=HDAC(I,J)* DFC<a name='1064'>
ENDIF<a name='1065'>
ENDDO<a name='1066'>
<a name='1067'>
KHH=(IDE-1)-2+MOD(J,2)<a name='1068'>
<a name='1069'>
<font color=#447700>! DO I=(IDE-1)-2,KHH<a name='1070'></font>
DO I=ITS,MIN(IDE-1,ITE)<a name='1071'>
IF (I .ge. (IDE-1)-2 .and. I .le. KHH) THEN<a name='1072'>
HDAC(I,J)=HDAC(I,J)* DFC<a name='1073'>
ENDIF<a name='1074'>
ENDDO<a name='1075'>
ENDIF<a name='1076'>
ENDDO<a name='1077'>
<a name='1078'>
<a name='1079'>
DO J=JTS,min(JTE,JDE-1)<a name='1080'>
DO I=ITS,min(ITE,IDE-1)<a name='1081'>
DDMPU(I,J)=DDMPUJ(J)*VBM2(I,J)<a name='1082'>
DDMPV(I,J)=DDMPVJ(J)*VBM2(I,J)<a name='1083'>
HDACV(I,J)=HDACV(I,J)*VBM2(I,J)<a name='1084'>
ENDDO<a name='1085'>
ENDDO<a name='1086'>
<font color=#447700>! --------------INCREASING DIFFUSION ALONG THE BOUNDARIES----------------<a name='1087'></font>
<a name='1088'>
<font color=#447700>! DO J=3,JDE-1-2<a name='1089'></font>
<a name='1090'>
DO J=JTS,MIN(JDE-1,JTE)<a name='1091'>
IF (J.LE.5.OR.J.GE.JDE-1-4) THEN<a name='1092'>
KVH=(IDE-1)-1-MOD(J,2)<a name='1093'>
DO I=ITS,min(IDE-1,ITE)<a name='1094'>
IF (I .ge. 2 .and. I .le. KVH) THEN<a name='1095'>
DDMPU(I,J)=DDMPU(I,J)*DDFC<a name='1096'>
DDMPV(I,J)=DDMPV(I,J)*DDFC<a name='1097'>
HDACV(I,J)=HDACV(I,J)* DFC<a name='1098'>
ENDIF<a name='1099'>
ENDDO<a name='1100'>
ELSE<a name='1101'>
KVH=3-MOD(J,2)<a name='1102'>
DO I=ITS,min(IDE-1,ITE)<a name='1103'>
IF (I .ge. 2 .and. I .le. KVH) THEN<a name='1104'>
DDMPU(I,J)=DDMPU(I,J)*DDFC<a name='1105'>
DDMPV(I,J)=DDMPV(I,J)*DDFC<a name='1106'>
HDACV(I,J)=HDACV(I,J)* DFC<a name='1107'>
ENDIF<a name='1108'>
ENDDO<a name='1109'>
KVH=(IDE-1)-1-MOD(J,2)<a name='1110'>
DO I=ITS,min(IDE-1,ITE)<a name='1111'>
IF (I .ge. IDE-1-2 .and. I .le. KVH) THEN<a name='1112'>
DDMPU(I,J)=DDMPU(I,J)*DDFC<a name='1113'>
DDMPV(I,J)=DDMPV(I,J)*DDFC<a name='1114'>
HDACV(I,J)=HDACV(I,J)* DFC<a name='1115'>
ENDIF<a name='1116'>
ENDDO<a name='1117'>
ENDIF<a name='1118'>
ENDDO<a name='1119'>
<a name='1120'>
write(0,*) ' grid%num_soil_layers = ', grid%num_soil_layers<a name='1121'>
<a name='1122'>
write(0,*) 'STC(1)'<a name='1123'>
do J=min(jde-1,jte),jts,-(jte-jts)/15<a name='1124'>
write(0,635) (stc(I,1,J),I=its,min(ite,ide-1),(ite-its)/12)<a name='1125'>
enddo<a name='1126'>
<a name='1127'>
write(0,*) 'SMC(1)'<a name='1128'>
do J=min(jde-1,jte),jts,-(jte-jts)/15<a name='1129'>
write(0,635) (smc(I,1,J),I=its,min(ite,ide-1),(ite-its)/12)<a name='1130'>
enddo<a name='1131'>
<a name='1132'>
<font color=#447700>! write(0,*) 'SM'<a name='1133'></font>
<font color=#447700>! do J=min(jde-1,jte),jts,-(jte-jts)/15<a name='1134'></font>
<font color=#447700>! write(0,635) (smc(I,1,J),I=its,min(ite,ide-1),(ite-its)/12)<a name='1135'></font>
<font color=#447700>! enddo<a name='1136'></font>
<a name='1137'>
DO j = jts, MIN(jde-1,jte)<a name='1138'>
DO i= ITS, MIN(IDE-1,ITE)<a name='1139'>
<a name='1140'>
if (SM(I,J) .eq. 0 .and. SMC(I,1,J) .gt. 0.5 .and. SICE(I,J) .eq. 0) then<a name='1141'>
write(0,*) 'wet on land point: ', I,J,SMC(I,1,J),SICE(I,J)<a name='1142'>
endif<a name='1143'>
<a name='1144'>
enddo<a name='1145'>
enddo<a name='1146'>
<a name='1147'>
<a name='1148'>
<font color=#447700>!!!! MOVE MONITOR BLOCK HERE<a name='1149'></font>
<a name='1150'>
<font color=#447700>!!! compute EMT, EM on global domain, and only on task 0.<a name='1151'></font>
<a name='1152'>
IF (wrf_dm_on_monitor()) THEN <font color=#447700>!!!! NECESSARY TO LIMIT THIS TO TASK ZERO?<a name='1153'></font>
<a name='1154'>
ALLOCATE(EMJ(JDS:JDE-1),EMTJ(JDS:JDE-1))<a name='1155'>
<a name='1156'>
<font color=#447700>! write(0,*) 'FIGURING OUT EMJ, EMTJ ', JDS, JDE-1<a name='1157'></font>
DO J=JDS,JDE-1<a name='1158'>
TPH=SB+float(J-1)*DPH<a name='1159'>
DXP=ERAD*DLM*COS(TPH)<a name='1160'>
EMJ(J)= GRID%DT/( 4.*DXP)*DTAD<a name='1161'>
EMTJ(J)=GRID%DT/(16.*DXP)*DTAD<a name='1162'>
<font color=#447700>! write(0,*) 'J, EMTJ(J): ', J, EMTJ(J)<a name='1163'></font>
ENDDO<a name='1164'>
<a name='1165'>
JA=0<a name='1166'>
DO 161 J=3,5<a name='1167'>
JA=JA+1<a name='1168'>
KHLA(JA)=2<a name='1169'>
KHHA(JA)=(IDE-1)-1-MOD(J+1,2)<a name='1170'>
161 EMT(JA)=EMTJ(J)<a name='1171'>
DO 162 J=(JDE-1)-4,(JDE-1)-2<a name='1172'>
JA=JA+1<a name='1173'>
KHLA(JA)=2<a name='1174'>
KHHA(JA)=(IDE-1)-1-MOD(J+1,2)<a name='1175'>
162 EMT(JA)=EMTJ(J)<a name='1176'>
DO 163 J=6,(JDE-1)-5<a name='1177'>
JA=JA+1<a name='1178'>
KHLA(JA)=2<a name='1179'>
KHHA(JA)=2+MOD(J,2)<a name='1180'>
163 EMT(JA)=EMTJ(J)<a name='1181'>
DO 164 J=6,(JDE-1)-5<a name='1182'>
JA=JA+1<a name='1183'>
KHLA(JA)=(IDE-1)-2<a name='1184'>
KHHA(JA)=(IDE-1)-1-MOD(J+1,2)<a name='1185'>
164 EMT(JA)=EMTJ(J)<a name='1186'>
<a name='1187'>
<font color=#447700>! --------------SPREADING OF UPSTREAM VELOCITY-POINT ADVECTION FACTOR----<a name='1188'></font>
<a name='1189'>
JA=0<a name='1190'>
DO 171 J=3,5<a name='1191'>
JA=JA+1<a name='1192'>
KVLA(JA)=2<a name='1193'>
KVHA(JA)=(IDE-1)-1-MOD(J,2)<a name='1194'>
171 EM(JA)=EMJ(J)<a name='1195'>
DO 172 J=(JDE-1)-4,(JDE-1)-2<a name='1196'>
JA=JA+1<a name='1197'>
KVLA(JA)=2<a name='1198'>
KVHA(JA)=(IDE-1)-1-MOD(J,2)<a name='1199'>
172 EM(JA)=EMJ(J)<a name='1200'>
DO 173 J=6,(JDE-1)-5<a name='1201'>
JA=JA+1<a name='1202'>
KVLA(JA)=2<a name='1203'>
KVHA(JA)=2+MOD(J+1,2)<a name='1204'>
173 EM(JA)=EMJ(J)<a name='1205'>
DO 174 J=6,(JDE-1)-5<a name='1206'>
JA=JA+1<a name='1207'>
KVLA(JA)=(IDE-1)-2<a name='1208'>
KVHA(JA)=(IDE-1)-1-MOD(J,2)<a name='1209'>
174 EM(JA)=EMJ(J)<a name='1210'>
<a name='1211'>
696 continue<a name='1212'>
ENDIF <font color=#447700>! wrf_dm_on_monitor<a name='1213'></font>
<a name='1214'>
<a name='1215'>
call <A href='../../html_code/dyn_nmm/module_initialize_real.F.html#NMM_SH2O'>NMM_SH2O</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="NMM_SH2O_1">(IMS,IME,JMS,JME,ITS,NNXP,JTS,NNYP,4,ISLTYP, &<a name='1216'>
SM,SICE,STC,SMC,SH2O)<a name='1217'>
<a name='1218'>
<font color=#447700>!! must be a better place to put this, but will eliminate "phantom"<a name='1219'></font>
<font color=#447700>!! wind points here (no wind point on eastern boundary of odd numbered rows)<a name='1220'></font>
<a name='1221'>
if ( abs(IDE-1-ITE) .eq. 1 ) THEN <font color=#447700>! along eastern boundary<a name='1222'></font>
write(0,*) 'zero phantom winds'<a name='1223'>
do K=1,KDE-1<a name='1224'>
<font color=#447700>! do J=JTS,JDE-1,2<a name='1225'></font>
DO J=JDS,JDE-1,2<a name='1226'>
if (J .ge. JTS .and. J .le. JTE) THEN<a name='1227'>
u(IDE-1,K,J)=0.<a name='1228'>
v(IDE-1,K,J)=0.<a name='1229'>
endif<a name='1230'>
enddo<a name='1231'>
enddo<a name='1232'>
endif<a name='1233'>
<a name='1234'>
969 continue<a name='1235'>
<a name='1236'>
<font color=#447700>! write(0,*) 'NMM_TSK leaving init_domain_nmm'<a name='1237'></font>
<font color=#447700>! do J=min(jte,jde-1),jts,-(jte-jts)/15<a name='1238'></font>
<font color=#447700>! write(0,635) (NMM_TSK(I,J),I=its,min(ide-1,ite),(ite-its)/12)<a name='1239'></font>
<font color=#447700>! enddo<a name='1240'></font>
<a name='1241'>
DO j = jms, jme<a name='1242'>
DO i = ims, ime<a name='1243'>
<a name='1244'>
fisx=max(fis(i,j),0.)<a name='1245'>
Z0(I,J) =SM(I,J)*Z0SEA+(1.-SM(I,J))* &<a name='1246'>
& (Z0(I,J)*Z0MAX+FISx *FCM+Z0LAND)<a name='1247'>
<a name='1248'>
ENDDO<a name='1249'>
ENDDO<a name='1250'>
<a name='1251'>
write(0,*) 'Z0 over memory, leaving module_initialize_real'<a name='1252'>
do J=JME,JMS,-(JME-JMS)/20<a name='1253'>
write(0,635) (Z0(I,J),I=IMS,IME,(IME-IMS)/14)<a name='1254'>
enddo<a name='1255'>
<a name='1256'>
<a name='1257'>
<a name='1258'>
write(0,*) 'leaving init_domain_nmm'<a name='1259'>
<font color=#447700>!<a name='1260'></font>
<font color=#447700>! Gopal's doing's : following lines moved to namelist_input4 in Registry <a name='1261'></font>
<font color=#447700>!<a name='1262'></font>
<font color=#447700>! write(0,*) 'hardwire'<a name='1263'></font>
<font color=#447700>! sigma=.true.<a name='1264'></font>
<font color=#447700>! grid%IDTAD=2 <a name='1265'></font>
<font color=#447700>! grid%NSOIL=4<a name='1266'></font>
<font color=#447700>! grid%NPHS=4<a name='1267'></font>
<font color=#447700>! grid%NCNVC=4<a name='1268'></font>
write(message,*)'STUFF MOVED TO REGISTRY:',grid%IDTAD, &<a name='1269'>
& grid%NSOIL,grid%NRADL,grid%NRADS,grid%NPHS,grid%NCNVC,grid%sigma<a name='1270'>
CALL <A href='../../html_code/frame/module_wrf_error.F.html#WRF_MESSAGE'>wrf_message</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="WRF_MESSAGE_12">( TRIM(message) )<a name='1271'>
<font color=#447700>!==================================================================================<a name='1272'></font>
<a name='1273'>
#define COPY_OUT<a name='1274'>
#include <<A href='../../html_code/include/nmm_scalar_derefs.inc.html'>nmm_scalar_derefs.inc</A>><A NAME="nmm_scalar_derefs.inc_8"><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_DOMAIN_NMM' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><a name='1275'>
RETURN<a name='1276'>
<a name='1277'>
END SUBROUTINE init_domain_nmm<a name='1278'>
<a name='1279'>
<font color=#447700>!--------------------------------------------------------------------<a name='1280'></font>
<A NAME='NMM_SH2O'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#NMM_SH2O' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='1281'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>NMM_SH2O</font>(IMS,IME,JMS,JME,ISTART,IM,JSTART,JM,& <A href='../../call_to/NMM_SH2O.html' TARGET='index'>1</A>,<A href='../../call_from/NMM_SH2O.html' TARGET='index'>1</A><a name='1282'>
NSOIL,ISLTPK, &<a name='1283'>
SM,SICE,STC,SMC,SH2O)<a name='1284'>
<a name='1285'>
<font color=#447700>!! INTEGER, PARAMETER:: NSOTYP=9<a name='1286'></font>
<font color=#447700>! INTEGER, PARAMETER:: NSOTYP=16<a name='1287'></font>
INTEGER, PARAMETER:: NSOTYP=19 <font color=#447700>!!!!!!!!MAYBE???<a name='1288'></font>
<a name='1289'>
REAL :: PSIS(NSOTYP),BETA(NSOTYP),SMCMAX(NSOTYP)<a name='1290'>
REAL :: STC(IMS:IME,NSOIL,JMS:JME), &<a name='1291'>
SMC(IMS:IME,NSOIL,JMS:JME)<a name='1292'>
REAL :: SH2O(IMS:IME,NSOIL,JMS:JME),SICE(IMS:IME,JMS:JME),&<a name='1293'>
SM(IMS:IME,JMS:JME)<a name='1294'>
REAL :: HLICE,GRAV,T0,BLIM<a name='1295'>
INTEGER :: ISLTPK(IMS:IME,JMS:JME)<a name='1296'>
<a name='1297'>
<font color=#447700>! Constants used in cold start SH2O initialization<a name='1298'></font>
DATA HLICE/3.335E5/,GRAV/9.81/,T0/273.15/<a name='1299'>
DATA BLIM/5.5/<a name='1300'>
<font color=#447700>! DATA PSIS /0.04,0.62,0.47,0.14,0.10,0.26,0.14,0.36,0.04/<a name='1301'></font>
<font color=#447700>! DATA BETA /4.26,8.72,11.55,4.74,10.73,8.17,6.77,5.25,4.26/<a name='1302'></font>
<font color=#447700>! DATA SMCMAX /0.421,0.464,0.468,0.434,0.406, &<a name='1303'></font>
<font color=#447700>! 0.465,0.404,0.439,0.421/<a name='1304'></font>
<a name='1305'>
<a name='1306'>
<font color=#447700>!!! NOT SURE...PSIS=SATPSI, BETA=BB??<a name='1307'></font>
<a name='1308'>
DATA PSIS /0.069, 0.036, 0.141, 0.759, 0.759, 0.355, &<a name='1309'>
0.135, 0.617, 0.263, 0.098, 0.324, 0.468, &<a name='1310'>
0.355, 0.000, 0.069, 0.036, 0.468, 0.069, 0.069 /<a name='1311'>
<a name='1312'>
DATA BETA/2.79, 4.26, 4.74, 5.33, 5.33, 5.25, &<a name='1313'>
6.66, 8.72, 8.17, 10.73, 10.39, 11.55, &<a name='1314'>
5.25, 0.00, 2.79, 4.26, 11.55, 2.79, 2.79 /<a name='1315'>
<a name='1316'>
DATA SMCMAX/0.339, 0.421, 0.434, 0.476, 0.476, 0.439, &<a name='1317'>
0.404, 0.464, 0.465, 0.406, 0.468, 0.468, &<a name='1318'>
0.439, 1.000, 0.200, 0.421, 0.468, 0.200, 0.339/<a name='1319'>
<a name='1320'>
write(0,*) 'define SH2O over IM,JM: ', IM,JM<a name='1321'>
DO K=1,NSOIL<a name='1322'>
DO J=JSTART,JM<a name='1323'>
DO I=ISTART,IM<a name='1324'>
if(i==169.and.j==111.and.k==1)then<a name='1325'>
write(0,*)' enter NMM_SH2O k=',k,' smc=',smc(i,k,j),' sh2o=',sh2o(i,k,j)<a name='1326'>
endif<a name='1327'>
<font color=#447700>!tst<a name='1328'></font>
IF (SMC(I,K,J) .gt. SMCMAX(ISLTPK(I,J))) then<a name='1329'>
<font color=#447700>! if (K .eq. 1) then<a name='1330'></font>
<font color=#447700>! write(0,*) 'I,J,reducing SMC from ' ,I,J,SMC(I,K,J), 'to ', SMCMAX(ISLTPK(I,J))<a name='1331'></font>
<font color=#447700>! endif<a name='1332'></font>
SMC(I,K,J)=SMCMAX(ISLTPK(I,J))<a name='1333'>
ENDIF<a name='1334'>
<font color=#447700>!tst<a name='1335'></font>
<a name='1336'>
if(i==056.and.j==265.and.k==1)then<a name='1337'>
write(0,*)' NMM_SH2O point 2 k=',k,' smc=',smc(i,k,j),' sh2o=',sh2o(i,k,j)<a name='1338'>
endif<a name='1339'>
IF ( (SM(I,J) .lt. 0.5) .and. (SICE(I,J) .lt. 0.5) ) THEN<a name='1340'>
<a name='1341'>
IF (ISLTPK(I,J) .gt. 19) THEN<a name='1342'>
WRITE(6,*) 'FORCING ISLTPK at : ', I,J<a name='1343'>
ISLTPK(I,J)=9<a name='1344'>
ELSEIF (ISLTPK(I,J) .le. 0) then<a name='1345'>
WRITE(6,*) 'FORCING ISLTPK at : ', I,J<a name='1346'>
ISLTPK(I,J)=1<a name='1347'>
ENDIF<a name='1348'>
<a name='1349'>
<a name='1350'>
<font color=#447700>! cold start: determine liquid soil water content (SH2O)<a name='1351'></font>
<font color=#447700>! SH2O <= SMC for T < 273.149K (-0.001C)<a name='1352'></font>
<a name='1353'>
IF (STC(I,K,J) .LT. 273.149) THEN<a name='1354'>
<a name='1355'>
<font color=#447700>! first guess following explicit solution for Flerchinger Eqn from Koren<a name='1356'></font>
<font color=#447700>! et al, JGR, 1999, Eqn 17 (KCOUNT=0 in FUNCTION FRH2O).<a name='1357'></font>
<a name='1358'>
BX = BETA(ISLTPK(I,J))<a name='1359'>
IF ( BETA(ISLTPK(I,J)) .GT. BLIM ) BX = BLIM<a name='1360'>
<a name='1361'>
if ( GRAV*(-PSIS(ISLTPK(I,J))) .eq. 0 ) then<a name='1362'>
write(0,*) 'TROUBLE'<a name='1363'>
write(0,*) 'I,J: ', i,J<a name='1364'>
write(0,*) 'grav, isltpk, psis(isltpk): ', grav,isltpk(I,J),&<a name='1365'>
psis(isltpk(I,J))<a name='1366'>
endif<a name='1367'>
<a name='1368'>
if (BX .eq. 0 .or. STC(I,K,J) .eq. 0) then<a name='1369'>
write(0,*) 'I,J,BX, STC: ', I,J,BX,STC(I,K,J)<a name='1370'>
endif<a name='1371'>
FK = (((HLICE/(GRAV*(-PSIS(ISLTPK(I,J)))))* &<a name='1372'>
((STC(I,K,J)-T0)/STC(I,K,J)))** &<a name='1373'>
(-1/BX))*SMCMAX(ISLTPK(I,J))<a name='1374'>
IF (FK .LT. 0.02) FK = 0.02<a name='1375'>
SH2O(I,K,J) = MIN ( FK, SMC(I,K,J) )<a name='1376'>
<font color=#447700>! ----------------------------------------------------------------------<a name='1377'></font>
<font color=#447700>! now use iterative solution for liquid soil water content using<a name='1378'></font>
<font color=#447700>! FUNCTION FRH2O (from the Eta "NOAH" land-surface model) with the<a name='1379'></font>
<font color=#447700>! initial guess for SH2O from above explicit first guess.<a name='1380'></font>
<a name='1381'>
SH2O(I,K,J)=<A href='../../html_code/dyn_nmm/module_initialize_real.F.html#FRH2O_INIT'>FRH2O_init</A><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#NMM_SH2O' TARGET='bottom_target'><IMG SRC="../../gif/cyan.gif" border=0></a><A NAME="FRH2O_INIT_1">(STC(I,K,J),SMC(I,K,J),SH2O(I,K,J), &<a name='1382'>
SMCMAX(ISLTPK(I,J)),BETA(ISLTPK(I,J)), &<a name='1383'>
PSIS(ISLTPK(I,J)))<a name='1384'>
<a name='1385'>
ELSE <font color=#447700>! above freezing<a name='1386'></font>
SH2O(I,K,J)=SMC(I,K,J)<a name='1387'>
ENDIF<a name='1388'>
<a name='1389'>
<a name='1390'>
ELSE <font color=#447700>! water point<a name='1391'></font>
SH2O(I,K,J)=SMC(I,K,J)<a name='1392'>
<a name='1393'>
ENDIF <font color=#447700>! test on land/ice/sea<a name='1394'></font>
if (SH2O(I,K,J) .gt. SMCMAX(ISLTPK(I,J))) then<a name='1395'>
write(0,*) 'SH2O > THAN SMCMAX ', I,J,SH2O(I,K,J),SMCMAX(ISLTPK(I,J)),SMC(I,K,J)<a name='1396'>
endif<a name='1397'>
<a name='1398'>
if(i==169.and.j==111.and.k==1)then<a name='1399'>
write(0,*)' exit NMM_SH2O k=',k,' smc=',smc(i,k,j),' sh2o=',sh2o(i,k,j)<a name='1400'>
endif<a name='1401'>
<a name='1402'>
ENDDO<a name='1403'>
ENDDO<a name='1404'>
ENDDO<a name='1405'>
<a name='1406'>
END SUBROUTINE NMM_SH2O<a name='1407'>
<a name='1408'>
<font color=#447700>!-------------------------------------------------------------------<a name='1409'></font>
<a name='1410'>
<A NAME='ZERO2D'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#ZERO2D' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='1411'>
<font color=#993300>subroutine </font><font color=#cc0000>zero2d</font>(adum2d,nnxp,nnyp)<a name='1412'>
<a name='1413'>
integer I,J,NNXP,NNYP<a name='1414'>
real adum2d(nnxp,nnyp)<a name='1415'>
<a name='1416'>
do J=1,nnyp<a name='1417'>
do I=1,nnxp<a name='1418'>
adum2d(I,J)=0.<a name='1419'>
enddo<a name='1420'>
enddo<a name='1421'>
<a name='1422'>
end subroutine zero2d<a name='1423'>
<a name='1424'>
<a name='1425'>
<font color=#447700>!-------------------------------------------------------------------<a name='1426'></font>
<A NAME='FRH2O_INIT'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#FRH2O_INIT' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A><a name='1427'>
<font color=#993300>FUNCTION </font><font color=#cc0000>FRH2O_init</font>(TKELV,SMC,SH2O,SMCMAX,B,PSIS) <A href='../../call_to/FRH2O_INIT.html' TARGET='index'>1</A><a name='1428'>
<a name='1429'>
IMPLICIT NONE<a name='1430'>
<a name='1431'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1432'></font>
<font color=#447700>! PURPOSE: CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT<a name='1433'></font>
<font color=#447700>! IF TEMPERATURE IS BELOW 273.15K (T0). REQUIRES NEWTON-TYPE ITERATION<a name='1434'></font>
<font color=#447700>! TO SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF<a name='1435'></font>
<font color=#447700>! KOREN ET AL. (1999, JGR, VOL 104(D16), 19569-19585).<a name='1436'></font>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1437'></font>
<font color=#447700>!<a name='1438'></font>
<font color=#447700>! New version (JUNE 2001): much faster and more accurate newton iteration<a name='1439'></font>
<font color=#447700>! achieved by first taking log of eqn cited above -- less than 4<a name='1440'></font>
<font color=#447700>! (typically 1 or 2) iterations achieves convergence. Also, explicit<a name='1441'></font>
<font color=#447700>! 1-step solution option for special case of parameter Ck=0, which reduces<a name='1442'></font>
<font color=#447700>! the original implicit equation to a simpler explicit form, known as the<a name='1443'></font>
<font color=#447700>! ""Flerchinger Eqn". Improved handling of solution in the limit of<a name='1444'></font>
<font color=#447700>! freezing point temperature T0.<a name='1445'></font>
<font color=#447700>!<a name='1446'></font>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1447'></font>
<font color=#447700>!<a name='1448'></font>
<font color=#447700>! INPUT:<a name='1449'></font>
<font color=#447700>!<a name='1450'></font>
<font color=#447700>! TKELV.........Temperature (Kelvin)<a name='1451'></font>
<font color=#447700>! SMC...........Total soil moisture content (volumetric)<a name='1452'></font>
<font color=#447700>! SH2O..........Liquid soil moisture content (volumetric)<a name='1453'></font>
<font color=#447700>! SMCMAX........Saturation soil moisture content (from REDPRM)<a name='1454'></font>
<font color=#447700>! B.............Soil type "B" parameter (from REDPRM)<a name='1455'></font>
<font color=#447700>! PSIS..........Saturated soil matric potential (from REDPRM)<a name='1456'></font>
<font color=#447700>!<a name='1457'></font>
<font color=#447700>! OUTPUT:<a name='1458'></font>
<font color=#447700>! FRH2O.........supercooled liquid water content.<a name='1459'></font>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1460'></font>
<a name='1461'>
REAL B<a name='1462'>
REAL BLIM<a name='1463'>
REAL BX<a name='1464'>
REAL CK<a name='1465'>
REAL DENOM<a name='1466'>
REAL DF<a name='1467'>
REAL DH2O<a name='1468'>
REAL DICE<a name='1469'>
REAL DSWL<a name='1470'>
REAL ERROR<a name='1471'>
REAL FK<a name='1472'>
REAL FRH2O_init<a name='1473'>
REAL GS<a name='1474'>
REAL HLICE<a name='1475'>
REAL PSIS<a name='1476'>
REAL SH2O<a name='1477'>
REAL SMC<a name='1478'>
REAL SMCMAX<a name='1479'>
REAL SWL<a name='1480'>
REAL SWLK<a name='1481'>
REAL TKELV<a name='1482'>
REAL T0<a name='1483'>
<a name='1484'>
INTEGER NLOG<a name='1485'>
INTEGER KCOUNT<a name='1486'>
PARAMETER (CK=8.0)<a name='1487'>
<font color=#447700>! PARAMETER (CK=0.0)<a name='1488'></font>
PARAMETER (BLIM=5.5)<a name='1489'>
<font color=#447700>! PARAMETER (BLIM=7.0)<a name='1490'></font>
PARAMETER (ERROR=0.005)<a name='1491'>
<a name='1492'>
PARAMETER (HLICE=3.335E5)<a name='1493'>
PARAMETER (GS = 9.81)<a name='1494'>
PARAMETER (DICE=920.0)<a name='1495'>
PARAMETER (DH2O=1000.0)<a name='1496'>
PARAMETER (T0=273.15)<a name='1497'>
<a name='1498'>
<font color=#447700>! ### LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM) ####<a name='1499'></font>
<font color=#447700>! ### SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT ####<a name='1500'></font>
<font color=#447700>! ### IS NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES ####<a name='1501'></font>
<font color=#447700>! ################################################################<a name='1502'></font>
<font color=#447700>!<a name='1503'></font>
BX = B<a name='1504'>
IF ( B .GT. BLIM ) BX = BLIM<a name='1505'>
<font color=#447700>! ------------------------------------------------------------------<a name='1506'></font>
<a name='1507'>
<font color=#447700>! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG.<a name='1508'></font>
NLOG=0<a name='1509'>
KCOUNT=0<a name='1510'>
<a name='1511'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1512'></font>
<font color=#447700>! C IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (T0), SH2O = SMC<a name='1513'></font>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1514'></font>
<a name='1515'>
<a name='1516'>
IF (TKELV .GT. (T0 - 1.E-3)) THEN<a name='1517'>
<a name='1518'>
FRH2O_init=SMC<a name='1519'>
<a name='1520'>
ELSE<a name='1521'>
<a name='1522'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1523'></font>
IF (CK .NE. 0.0) THEN<a name='1524'>
<a name='1525'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1526'></font>
<font color=#447700>! CCCCCCCCC OPTION 1: ITERATED SOLUTION FOR NONZERO CK CCCCCCCCCCC<a name='1527'></font>
<font color=#447700>! CCCCCCCCCCCC IN KOREN ET AL, JGR, 1999, EQN 17 CCCCCCCCCCCCCCCCC<a name='1528'></font>
<a name='1529'>
<font color=#447700>! INITIAL GUESS FOR SWL (frozen content)<a name='1530'></font>
SWL = SMC-SH2O<a name='1531'>
<font color=#447700>! KEEP WITHIN BOUNDS.<a name='1532'></font>
IF (SWL .GT. (SMC-0.02)) SWL=SMC-0.02<a name='1533'>
IF(SWL .LT. 0.) SWL=0.<a name='1534'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1535'></font>
<font color=#447700>! C START OF ITERATIONS<a name='1536'></font>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1537'></font>
DO WHILE (NLOG .LT. 10 .AND. KCOUNT .EQ. 0)<a name='1538'>
NLOG = NLOG+1<a name='1539'>
DF = ALOG(( PSIS*GS/HLICE ) * ( ( 1.+CK*SWL )**2. ) * &<a name='1540'>
( SMCMAX/(SMC-SWL) )**BX) - ALOG(-(TKELV-T0)/TKELV)<a name='1541'>
DENOM = 2. * CK / ( 1.+CK*SWL ) + BX / ( SMC - SWL )<a name='1542'>
SWLK = SWL - DF/DENOM<a name='1543'>
<font color=#447700>! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION.<a name='1544'></font>
IF (SWLK .GT. (SMC-0.02)) SWLK = SMC - 0.02<a name='1545'>
IF(SWLK .LT. 0.) SWLK = 0.<a name='1546'>
<font color=#447700>! MATHEMATICAL SOLUTION BOUNDS APPLIED.<a name='1547'></font>
DSWL=ABS(SWLK-SWL)<a name='1548'>
SWL=SWLK<a name='1549'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1550'></font>
<font color=#447700>! CC IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.)<a name='1551'></font>
<font color=#447700>! CC WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED.<a name='1552'></font>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1553'></font>
IF ( DSWL .LE. ERROR ) THEN<a name='1554'>
KCOUNT=KCOUNT+1<a name='1555'>
END IF<a name='1556'>
END DO<a name='1557'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1558'></font>
<font color=#447700>! C END OF ITERATIONS<a name='1559'></font>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1560'></font>
<font color=#447700>! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION.<a name='1561'></font>
FRH2O_init = SMC - SWL<a name='1562'>
<a name='1563'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCC END OPTION 1 CCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1564'></font>
<a name='1565'>
ENDIF<a name='1566'>
<a name='1567'>
IF (KCOUNT .EQ. 0) THEN<a name='1568'>
<font color=#447700>! Print*,'Flerchinger used in NEW version. Iterations=',NLOG<a name='1569'></font>
<a name='1570'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1571'></font>
<font color=#447700>! CCCCC OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0 CCCCCCCC<a name='1572'></font>
<font color=#447700>! CCCCCCCCCCCCC IN KOREN ET AL., JGR, 1999, EQN 17 CCCCCCCCCCCCCCC<a name='1573'></font>
<a name='1574'>
FK=(((HLICE/(GS*(-PSIS)))*((TKELV-T0)/TKELV))**(-1/BX))*SMCMAX<a name='1575'>
<font color=#447700>! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION<a name='1576'></font>
IF (FK .LT. 0.02) FK = 0.02<a name='1577'>
FRH2O_init = MIN ( FK, SMC )<a name='1578'>
<a name='1579'>
<font color=#447700>! CCCCCCCCCCCCCCCCCCCCCCCCC END OPTION 2 CCCCCCCCCCCCCCCCCCCCCCCCCC<a name='1580'></font>
<a name='1581'>
ENDIF<a name='1582'>
<a name='1583'>
ENDIF<a name='1584'>
<a name='1585'>
RETURN<a name='1586'>
<a name='1587'>
END FUNCTION FRH2O_init<a name='1588'>
<a name='1589'>
<a name='1590'>
<font color=#447700>!--------------------------------------------------------------------<a name='1591'></font>
<a name='1592'>
<A NAME='CONST_MODULE_INITIALIZE'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#CONST_MODULE_INITIALIZE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='1593'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>const_module_initialize</font> ( p00 , t00 , a ) <A href='../../call_to/CONST_MODULE_INITIALIZE.html' TARGET='index'>2</A>,<A href='../../call_from/CONST_MODULE_INITIALIZE.html' TARGET='index'>1</A><a name='1594'>
IMPLICIT NONE<a name='1595'>
REAL , PARAMETER :: sea_level_pressure_base = 100000.<a name='1596'>
REAL , PARAMETER :: sea_level_temperature_base = 290.<a name='1597'>
REAL , PARAMETER :: temp_diff_1000_to_300_mb = 50.<a name='1598'>
REAL , INTENT(OUT) :: p00 , t00 , a<a name='1599'>
p00 = sea_level_pressure_base<a name='1600'>
t00 = sea_level_temperature_base<a name='1601'>
a = temp_diff_1000_to_300_mb<a name='1602'>
END SUBROUTINE const_module_initialize<a name='1603'>
<a name='1604'>
<font color=#447700>!---------------------------------------------------------------------<a name='1605'></font>
<a name='1606'>
<A NAME='INIT_MODULE_INITIALIZE'><A href='../../html_code/dyn_nmm/module_initialize_real.F.html#INIT_MODULE_INITIALIZE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A><a name='1607'>
<font color=#993300>SUBROUTINE </font><font color=#cc0000>init_module_initialize</font>,<A href='../../call_from/INIT_MODULE_INITIALIZE.html' TARGET='index'>8</A><a name='1608'>
END SUBROUTINE init_module_initialize<a name='1609'>
<a name='1610'>
<font color=#447700>!---------------------------------------------------------------------<a name='1611'></font>
<a name='1612'>
END MODULE module_initialize<a name='1613'>
</pre></body></html>