<p><b>laura@ucar.edu</b> 2011-04-05 13:12:31 -0600 (Tue, 05 Apr 2011)</p><p>updated to compile with hydrostatic core<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_physics_control.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_control.F 2011-04-05 18:24:18 UTC (rev 781)
+++ branches/atmos_physics/src/core_physics/module_physics_control.F 2011-04-05 19:12:31 UTC (rev 782)
@@ -176,29 +176,12 @@
type(sfc_input_type),intent(inout):: sfc_input
!local variables:
- integer:: k,iCell,iSoil
+ integer:: iCell
- real(kind=RKIND),dimension(:),pointer:: rdzw
- real(kind=RKIND),dimension(:),pointer:: sfc_pressure
- real(kind=RKIND),dimension(:,:),pointer:: rho,qvapor,pressure_b,pressure_p
-
-!temporary:
- integer:: iEdg,ip,maxEdges
-
!---------------------------------------------------------------------------------------------
write(0,*) '--- enter physics_registry_init'
- rdzw => mesh % rdzw % array
- rho => state % rho % array
- qvapor => state % scalars % array(state%index_qv,:,:)
- pressure_p => diag % pressure_p % array
- pressure_b => diag % pressure_base % array
- sfc_pressure => diag % surface_pressure % array
-
-!temporary:
- maxEdges = mesh % maxEdges
-
!initialization of restart variables, if needed:
if(.not. config_do_restart) then
@@ -214,78 +197,8 @@
endif
enddo
-
- ip=min(2519,mesh%nCellsSolve)
- do iEdg = 1, maxEdges
- write(0,*) iEdg, mesh % CellsOnCell % array(iEdg,ip)
- enddo
- write(0,*)
- write(0,101) sfc_input%landmask%array(ip),(sfc_input%landmask%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,101) sfc_input%ivgtyp%array(ip),(sfc_input%ivgtyp%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,101) sfc_input%isltyp%array(ip),(sfc_input%isltyp%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,*)
- write(0,102) sfc_input%shdmin%array(ip),(sfc_input%shdmin%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%shdmax%array(ip),(sfc_input%shdmax%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%snoalb%array(ip),(sfc_input%snoalb%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%snow%array(ip),(sfc_input%snow%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%snowc%array(ip),(sfc_input%snowc%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%skintemp%array(ip),(sfc_input%skintemp%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%sst%array(ip),(sfc_input%sst%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%tmn%array(ip),(sfc_input%tmn%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%vegfra%array(ip),(sfc_input%vegfra%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%xice%array(ip),(sfc_input%xice%array(mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,*)
- write(0,102) sfc_input%dzs%array(1,ip),(sfc_input%dzs%array(1,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%dzs%array(2,ip),(sfc_input%dzs%array(2,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%dzs%array(3,ip),(sfc_input%dzs%array(3,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%dzs%array(4,ip),(sfc_input%dzs%array(4,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,*)
- write(0,102) sfc_input%sh2o%array(1,ip),(sfc_input%sh2o%array(1,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%sh2o%array(2,ip),(sfc_input%sh2o%array(2,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%sh2o%array(3,ip),(sfc_input%sh2o%array(3,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%sh2o%array(4,ip),(sfc_input%sh2o%array(4,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,*)
- write(0,102) sfc_input%smois%array(1,ip),(sfc_input%smois%array(1,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%smois%array(2,ip),(sfc_input%smois%array(2,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%smois%array(3,ip),(sfc_input%smois%array(3,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%smois%array(4,ip),(sfc_input%smois%array(4,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,*)
- write(0,102) sfc_input%tslb%array(1,ip),(sfc_input%tslb%array(1,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%tslb%array(2,ip),(sfc_input%tslb%array(2,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%tslb%array(3,ip),(sfc_input%tslb%array(3,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,102) sfc_input%tslb%array(4,ip),(sfc_input%tslb%array(4,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- write(0,*)
- write(0,*) 'hx:'
- do k = 11,1,-1
- write(0,103)k,mesh%hx%array(k,ip),(mesh%hx%array(k,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- enddo
- write(0,*) 'zgrid:'
- do k = 11,1,-1
- write(0,103)k,mesh%zgrid%array(k,ip),(mesh%zgrid%array(k,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- enddo
- write(0,*) 'rho:'
- do k = 11,1,-1
- write(0,103)k,state%rho%array(k,ip),(state%rho%array(k,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- enddo
- write(0,*) 'theta:'
- do k = 11,1,-1
- write(0,103)k,state%theta%array(k,ip),(state%theta%array(k,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- enddo
- write(0,*) 'qv:'
- do k = 11,1,-1
- write(0,103)k,state%scalars%array(state%index_qv,k,ip), &
- (state%scalars%array(state%index_qv,k,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- enddo
- write(0,*) 'w:'
- do k = 11,1,-1
- write(0,103)k,state%w%array(k,ip),(state%w%array(k,mesh%cellsOnCell%array(iEdg,ip)),iEdg=1,6)
- enddo
endif
- 101 format(10(1x,i5))
- 102 format(10(1x,e15.8))
- 103 format(i2,10(1x,e15.8))
-
write(0,*) '--- exit physics_registry_init'
end subroutine physics_registry_init
Modified: branches/atmos_physics/src/core_physics/module_physics_interface_hyd.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_interface_hyd.F 2011-04-05 18:24:18 UTC (rev 781)
+++ branches/atmos_physics/src/core_physics/module_physics_interface_hyd.F 2011-04-05 19:12:31 UTC (rev 782)
@@ -8,8 +8,10 @@
implicit none
private
- public:: MPAS_to_physics, &
- microphysics_from_MPAS, &
+ public:: allocate_forall_physics, &
+ deallocate_forall_physics, &
+ MPAS_to_physics, &
+ microphysics_from_MPAS, &
microphysics_to_MPAS
!... local variables:
@@ -20,6 +22,113 @@
contains
!=============================================================================================
+ subroutine allocate_forall_physics
+!=============================================================================================
+
+ if(.not.allocated(psfc_p)) allocate(psfc_p(ims:ime,jms:jme) )
+ if(.not.allocated(ptop_p)) allocate(ptop_p(ims:ime,jms:jme) )
+
+ if(.not.allocated(u_p) ) allocate(u_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(v_p) ) allocate(v_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(zz_p) ) allocate(zz_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres_p) ) allocate(pres_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pi_p) ) allocate(pi_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(z_p) ) allocate(z_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(dz_p) ) allocate(dz_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(t_p) ) allocate(t_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(th_p) ) allocate(th_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(al_p) ) allocate(al_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rho_p) ) allocate(rho_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rh_p) ) allocate(rh_p(ims:ime,kms:kme,jms:jme) )
+
+ if(.not.allocated(w_p) ) allocate(w_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres2_p)) allocate(pres2_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(t2_p) ) allocate(t2_p(ims:ime,kms:kme,jms:jme) )
+
+ if(.not.allocated(pres_hyd_p) ) allocate(pres_hyd_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres2_hyd_p)) allocate(pres2_hyd_p(ims:ime,kms:kme,jms:jme) )
+
+ do j = jms,jme
+ do i = ims,ime
+ psfc_p(i,j) = 0.
+ ptop_p(i,j) = 0.
+ enddo
+ enddo
+
+ do j = jms,jme
+ do k = kms,kme
+ do i = ims,ime
+ u_p(i,k,j) = 0.
+ v_p(i,k,j) = 0.
+ w_p(i,k,j) = 0.
+ pres_p(i,k,j) = 0.
+ pi_p(i,k,j) = 0.
+ z_p(i,k,j) = 0.
+ dz_p(i,k,j) = 0.
+ t_p(i,k,j) = 0.
+ th_p(i,k,j) = 0.
+ al_p(i,k,j) = 0.
+ rho_p(i,k,j) = 0.
+ rh_p(i,k,j) = 0.
+
+ w_p(i,k,j) = 0.
+ pres2_p(i,k,j) = 0.
+ t2_p(i,k,j) = 0.
+
+ pres_hyd_p(i,k,j) = 0.
+ pres2_hyd_p(i,k,j) = 0.
+ enddo
+ enddo
+ enddo
+
+!allocate moist species (to be revisited!):
+ if(.not.allocated(qv_p) ) allocate(qv_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qc_p) ) allocate(qc_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qr_p) ) allocate(qr_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qi_p) ) allocate(qi_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qs_p) ) allocate(qs_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qg_p) ) allocate(qg_p(ims:ime,kms:kme,jms:jme) )
+
+ end subroutine allocate_forall_physics
+
+!=============================================================================================
+ subroutine deallocate_forall_physics
+!=============================================================================================
+
+!de-allocation of all physics arrays:
+ if(allocated(psfc_p) ) deallocate(psfc_p )
+ if(allocated(ptop_p) ) deallocate(ptop_p )
+
+ if(allocated(u_p) ) deallocate(u_p )
+ if(allocated(v_p) ) deallocate(v_p )
+ if(allocated(zz_p) ) deallocate(zz_p )
+ if(allocated(pres_p) ) deallocate(pres_p )
+ if(allocated(pi_p) ) deallocate(pi_p )
+ if(allocated(z_p) ) deallocate(z_p )
+ if(allocated(dz_p) ) deallocate(dz_p )
+ if(allocated(t_p) ) deallocate(t_p )
+ if(allocated(th_p) ) deallocate(th_p )
+ if(allocated(al_p) ) deallocate(al_p )
+ if(allocated(rho_p) ) deallocate(rho_p )
+ if(allocated(rh_p) ) deallocate(rh_p )
+
+ if(allocated(w_p) ) deallocate(w_p )
+ if(allocated(pres2_p) ) deallocate(pres2_p )
+ if(allocated(t2_p) ) deallocate(t2_p )
+
+ if(allocated(pres_hyd_p) ) deallocate(pres_hyd_p )
+ if(allocated(pres2_hyd_p)) deallocate(pres2_hyd_p )
+
+ if(allocated(qv_p) ) deallocate(qv_p )
+ if(allocated(qc_p) ) deallocate(qc_p )
+ if(allocated(qr_p) ) deallocate(qr_p )
+ if(allocated(qi_p) ) deallocate(qi_p )
+ if(allocated(qs_p) ) deallocate(qs_p )
+ if(allocated(qg_p) ) deallocate(qg_p )
+
+ end subroutine deallocate_forall_physics
+
+!=============================================================================================
subroutine MPAS_to_physics(state,diag)
!=============================================================================================
Modified: branches/atmos_physics/src/core_physics/physics_wrf/module_sf_noahdrv.F
===================================================================
--- branches/atmos_physics/src/core_physics/physics_wrf/module_sf_noahdrv.F 2011-04-05 18:24:18 UTC (rev 781)
+++ branches/atmos_physics/src/core_physics/physics_wrf/module_sf_noahdrv.F 2011-04-05 19:12:31 UTC (rev 782)
@@ -1355,8 +1355,10 @@
!that it would be cleaner to do this instead of adding a lot of #ifdef statements throughout
!the initialization subroutine.
-#ifndef non_hydrostatic_core
+!#ifndef non_hydrostatic_core
+#if !(defined(non_hydrostatic_core) || defined(hydrostatic_core))
+
SUBROUTINE LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, &
SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, &
ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
</font>
</pre>