!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
***s/r e_pregeo- prepare the geophysical fields
*
#include "model_macros_f.h"
*
subroutine e_pregeo 1,3
implicit none
*
*author
* Andre Methot
*
*revision
* v3_20 - Roch/Bilodeau - change units of snodp
* v3_30 - Desgagne M. - renamed comdecks for new PHYSICS interface
*
*object
*
*arguments
* none
*
*implicits
integer l_ni,l_nj
parameter(l_ni=1,l_nj=1)
#include "e_grids.cdk"
#include "e_geol.cdk"
#include "itf_phy_config.cdk"
#include "itf_phy_buses.cdk"
#include "geobus.cdk"
#include "dcst.cdk"
#include "hgc.cdk"
**
integer gdll
external gdll
integer i,j,offj,n,err
real deg2rad
*
* ---------------------------------------------------------------
*
write(6,9000)
n=nifi*njfi
*
err = gdll (dstf_gid,geobus(la),geobus(lo))
*
deg2rad = acos(-1.0)/180.
*
do i=1,n
geobus(la + i-1) = geobus(la+i-1) * deg2rad
geobus(lo + i-1) = geobus(lo+i-1) * deg2rad
geobus(glsea + i-1) = max(min(geobus(glsea+i-1),1.0),0.0)
geobus(mg + i-1) = max(min(geobus(mg +i-1),1.0),0.0)
geobus(ga + i-1) = max(min(geobus(ga +i-1),1.0),0.0)
end do
if (geobus(twater).lt.150.) then
do i=1,n
geobus(twater +i -1) = geobus(twater +i -1) + dcst_tcdk_8
end do
endif
if (geobus(i0).lt.150.) then
do i=1,n
geobus(i0 +i -1) = geobus(i0 +i -1) + dcst_tcdk_8
end do
endif
if (geobus(i0+n).lt.150.) then
do i=1,n
geobus(i0 + n +i -1) = geobus(i0 + n +i -1) + dcst_tcdk_8
end do
endif
if (geobus(gmice).lt.150.) then
do i=1,n
geobus(gmice +i -1) = geobus( gmice+i -1) + dcst_tcdk_8
end do
endif
if (geobus(gmice+n).lt.150.) then
do i=1,n
geobus(gmice + n +i -1) = geobus( gmice+ n+i -1) + dcst_tcdk_8
end do
endif
if (geobus(gmice+ 2*n).lt.150.) then
do i=1,n
geobus(gmice + 2*n +i -1) = geobus( gmice+ 2*n +i -1) + dcst_tcdk_8
end do
endif
if (geobus(gice).lt.150.) then
do i=1,n
geobus(gice+i -1) = geobus(gice+i -1) + dcst_tcdk_8
end do
endif
if (geobus(gice+n).lt.150.) then
do i=1,n
geobus(gice + n +i -1) = geobus(gice+ n +i -1) +dcst_tcdk_8
end do
endif
if (glseac.gt.0) then
do i=1,n
geobus(glseac+i-1)=max(min(geobus(glseac+i-1),1.0),0.0)
end do
endif
if (snodp.gt.0) then
do i=1,n
geobus(snodp+i-1) = 0.01 * geobus(snodp+i-1)
end do
endif
*
if ( E_geol_glreg_L ) call e_modgl ()
*
if ( P_pbl_schsl_s.eq. 'FCREST' ) then
call e_modhs ()
call e_modmg ()
endif
*
if ( E_geol_z0cst.lt.0.) then
do i=1,n
geobus(z0+i-1) = exp ( geobus(z0+i-1) )
end do
else
print*, 'zo constant: ',E_geol_z0cst
do i=1,n
geobus(z0+i-1) = E_geol_z0cst
end do
endif
*
write(6, 9999)
*
9000 format(/,'BEGIN PROCESSING GEOPHYSICAL FIELDS (S/R E_PREGEO)',
+ /,'=================================================')
*
9999 format(/,'END PROCESSING GEOPHYSICAL FIELDS (S/R E_PREGEO)',
+ /,'==================================================')
*
* ---------------------------------------------------------------
*
return
end