<p><b>laura@ucar.edu</b> 2011-04-05 12:16:44 -0600 (Tue, 05 Apr 2011)</p><p>updated modules<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_physics_init.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_init.F 2011-04-05 18:12:19 UTC (rev 777)
+++ branches/atmos_physics/src/core_physics/module_physics_init.F 2011-04-05 18:16:44 UTC (rev 778)
@@ -40,6 +40,10 @@
!---------------------------------------------------------------------------------------------
write(0,*) '--- enter subroutine physics_init:'
+!initialization of east-north directions to convert u-tendencies from cell centers to cell
+!edges:
+ call init_dirs_forphys(mesh)
+
!initialization of global surface properties. set here for now, but may be moved when time
!manager is implemented:
call landuse_init_forMPAS(dminfo,mesh,diag_physics,sfc_physics,sfc_input)
@@ -72,5 +76,58 @@
end subroutine physics_init
!=============================================================================================
+ subroutine init_dirs_forphys(mesh)
+!=============================================================================================
+
+!inout arguments:
+!----------------
+ type(mesh_type),intent(in):: mesh
+
+!local variables:
+ integer:: iCell
+ real(kind=RKIND),dimension(:),pointer:: latCell,lonCell
+ real(kind=RKIND),dimension(:,:),pointer:: east,north
+
+!---------------------------------------------------------------------------------------------
+
+ latCell => mesh % latCell % array
+ lonCell => mesh % lonCell % array
+ east => mesh % east % array
+ north => mesh % north % array
+
+!Compute unit vectors in east and north directions for each cell:
+ do iCell = 1, mesh % nCells
+
+ east(1,iCell) = -sin(lonCell(iCell))
+ east(2,iCell) = cos(lonCell(iCell))
+ east(3,iCell) = 0.0
+ call r3_normalize(east(1,iCell), east(2,iCell), east(3,iCell))
+
+ north(1,iCell) = -cos(lonCell(iCell))*sin(latCell(iCell))
+ north(2,iCell) = -sin(lonCell(iCell))*sin(latCell(iCell))
+ north(3,iCell) = cos(latCell(iCell))
+ call r3_normalize(north(1,iCell), north(2,iCell), north(3,iCell))
+
+ end do
+
+ end subroutine init_dirs_forphys
+
+!=============================================================================================
+ subroutine r3_normalize(ax, ay, az)
+!=============================================================================================
+!normalizes the vector (ax, ay, az)
+
+ real (kind=RKIND), intent(inout) :: ax, ay, az
+ real (kind=RKIND) :: mi
+
+!---------------------------------------------------------------------------------------------
+
+ mi = 1.0 / sqrt(ax**2 + ay**2 + az**2)
+ ax = ax * mi
+ ay = ay * mi
+ az = az * mi
+
+ end subroutine r3_normalize
+!=============================================================================================
end module module_physics_init
!=============================================================================================
Modified: branches/atmos_physics/src/core_physics/module_physics_landuse.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_landuse.F 2011-04-05 18:12:19 UTC (rev 777)
+++ branches/atmos_physics/src/core_physics/module_physics_landuse.F 2011-04-05 18:16:44 UTC (rev 778)
@@ -65,12 +65,14 @@
integer:: ierr,istat
integer:: ic,is,isice,isn,iswater,lucats,lumatch,luseas
integer:: iCell,nCells
+ integer,dimension(:),pointer:: ivgtyp
+ integer,dimension(:),pointer:: landmask
real(kind=RKIND):: li
real(kind=RKIND),dimension(max_cats,max_seas):: albd,slmo,sfem,sfz0,therin,scfx,sfhc
real(kind=RKIND),dimension(:),pointer:: latCell
- real(kind=RKIND),dimension(:),pointer:: lu_index,snoalb,snowc,xice
+ real(kind=RKIND),dimension(:),pointer:: snoalb,snowc,xice
real(kind=RKIND),dimension(:),pointer:: albbck,embck,xicem,xland,z0
real(kind=RKIND),dimension(:),pointer:: mavail,sfc_albedo,sfc_emiss,thc,znt
@@ -81,7 +83,9 @@
nCells = mesh % nCells
latCell => mesh % latCell % array
- lu_index => sfc_input % lu_index % array
+ landmask => sfc_input % landmask % array
+
+ ivgtyp => sfc_input % ivgtyp % array
snoalb => sfc_input % snoalb % array
snowc => sfc_input % snowc % array
xice => sfc_input % xice % array
@@ -194,7 +198,8 @@
if(julday.lt.0.05 .or. julday.gt.288) isn=2
if(latCell(iCell) .lt. 0.) isn=3-isn
- is = nint(lu_index(iCell))
+! is = nint(ivgtyp(iCell))
+ is = ivgtyp(iCell)
!set no data points to water:
if(is.eq.0) is = iswater
@@ -215,7 +220,13 @@
embck(iCell) = sfem(is,isn)
sfc_emiss(iCell) = embck(iCell)
- if(is .ne. iswater) then
+!02-11-2011:
+! if(is .ne. iswater) then
+! xland(iCell) = 1.0
+! else
+! xland(iCell) = 2.0
+! endif
+ if(landmask(icell) == 1) then
xland(iCell) = 1.0
else
xland(iCell) = 2.0
Modified: branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F 2011-04-05 18:12:19 UTC (rev 777)
+++ branches/atmos_physics/src/core_physics/module_physics_lsm_noahinit.F 2011-04-05 18:16:44 UTC (rev 778)
@@ -75,15 +75,15 @@
nCells = mesh % nCells
nSoilLevels = mesh % nSoilLevels
- sh2o => diag_physics % sh2o % array
- smois => diag_physics % smois % array
- snow => diag_physics % snow % array
snowh => diag_physics % snowh % array
- tslb => diag_physics % tslb % array
isltyp => sfc_input % isltyp % array
ivgtyp => sfc_input % ivgtyp % array
+ sh2o => sfc_input % sh2o % array
+ smois => sfc_input % smois % array
+ tslb => sfc_input % tslb % array
snoalb => sfc_input % snoalb % array
+ snow => sfc_input % snow % array
!reads the NOAH LSM tables:
call physics_message( 'initialize NOAH LSM tables' )
@@ -115,7 +115,7 @@
do ns = 1, nSoilLevels
! ----------------------------------------------------------------------
!SH2O <= SMOIS for T < 273.149K (-0.001C)
- if(tslb(iCell,ns) < 273.149) then
+ if(tslb(ns,iCell) < 273.149) then
! ----------------------------------------------------------------------
! first guess following explicit solution for Flerchinger Eqn from Koren
! et al, JGR, 1999, Eqn 17 (KCOUNT=0 in FUNCTION FRH2O).
Modified: branches/atmos_physics/src/core_physics/module_physics_rrtmg_lwinit.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_rrtmg_lwinit.F 2011-04-05 18:12:19 UTC (rev 777)
+++ branches/atmos_physics/src/core_physics/module_physics_rrtmg_lwinit.F 2011-04-05 18:16:44 UTC (rev 778)
@@ -179,6 +179,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, selfrefo, forrefo
@@ -257,6 +258,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo
@@ -372,6 +374,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, selfrefo, forrefo
@@ -460,6 +463,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo
@@ -565,6 +569,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, kao_mo3, ccl4o, selfrefo, forrefo
@@ -645,6 +650,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, selfrefo, forrefo
@@ -747,6 +753,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, selfrefo, forrefo
@@ -854,6 +861,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, kao_mn2o, &
kbo_mn2o, kao_mo3, cfc12o, cfc22adjo, selfrefo, forrefo
@@ -963,6 +971,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, selfrefo, forrefo
@@ -1040,6 +1049,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo
@@ -1130,6 +1140,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, kao_mo2, kbo_mo2, selfrefo, forrefo
@@ -1200,6 +1211,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, kao, selfrefo, forrefo
@@ -1287,6 +1299,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kao_mco2, kao_mco, kbo_mo3, selfrefo, forrefo
@@ -1370,6 +1383,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo
@@ -1450,6 +1464,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, kao, kao_mn2, selfrefo, forrefo
@@ -1530,6 +1545,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo
Modified: branches/atmos_physics/src/core_physics/module_physics_rrtmg_swinit.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_rrtmg_swinit.F 2011-04-05 18:12:19 UTC (rev 777)
+++ branches/atmos_physics/src/core_physics/module_physics_rrtmg_swinit.F 2011-04-05 18:16:44 UTC (rev 778)
@@ -176,9 +176,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
-! write(0,*)
-! write(0,*) '--- enter subroutine sw_kgb16:'
-! write(0,*) '--- rrtmg_unit= ', rrtmg_unit
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat1, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -260,6 +258,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -342,6 +341,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -423,6 +423,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -506,6 +507,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, layreffr, absch4o, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -587,6 +589,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -668,6 +671,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -739,6 +743,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
raylo, givfac, layreffr, kao, selfrefo, forrefo, sfluxrefo
@@ -823,6 +828,7 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
raylao, raylbo, strrat, layreffr, abso3ao, abso3bo, kao, kbo, selfrefo, &
forrefo, sfluxrefo
@@ -887,6 +893,7 @@
! in mb). The fourth index, IG, goes from 1 to 16, and indicates
! which g-interval the absorption coefficients are for.
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
raylo, layreffr, abso3ao, abso3bo, kao, sfluxrefo
@@ -925,6 +932,7 @@
! Array raylo contains the Rayleigh extinction coefficient at all v for this band.
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
raylo, sfluxrefo
@@ -993,6 +1001,7 @@
! pressure levels in mb). The third index, IG, goes from 1 to 16,
! and tells us which g-interval the absorption coefficients are for.
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
raylo, scalekur, layreffr, kao, kbo, sfluxrefo
@@ -1060,6 +1069,7 @@
! pressure levels in mb). The third index, IG, goes from 1 to 16,
! and tells us which g-interval the absorption coefficients are for.
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat, layreffr, kao, kbo, sfluxrefo
@@ -1146,6 +1156,8 @@
! write(0,*)
! write(0,*) '--- enter subroutine sw_kgb29:'
! write(0,*) '--- rrtmg_unit= ', rrtmg_unit
+
+ istat = 0
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, layreffr, absh2oo, absco2o, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -1166,11 +1178,6 @@
DM_BCAST_MACRO(forrefo)
DM_BCAST_MACRO(sfluxrefo)
-! write(0,*) rayl
-! write(0,*) kbo
-! write(0,*) sfluxrefo
-! write(0,*) '--- end subroutine sw_kgb29:'
-
end subroutine sw_kgb29
!=============================================================================================
</font>
</pre>