!-------------------------------------- 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_modgl - Merges analysis with climatology outside lat-lon box
* delimiting the domain in which the analysis is to be
* used
*
subroutine e_modgl () 1
*
implicit none
*
*author
* Andre methot - cmc - Feb 1996
*
*revision
* v2_20 - P. Pellerin - transfer subroutine to entry program
* v3_30 - Desgagne M. - renamed comdecks for new PHYSICS interface
*
*object
*
*arguments
*
*implicit
#include "e_grids.cdk"
#include "e_geol.cdk"
* comdecks used also in GEMDM
#include "model_macros_f.h"
#include "dcst.cdk"
#include "itf_phy_buses.cdk"
#include "geobus.cdk"
**
integer i, j
real prpoa, prcon, prlat, prlon
*
* ------------------------------------------------------------
*
write(6,600)
*
prcon= 180./Dcst_pi_8
do i=1,nifi*njfi
prlat=geobus(la+i-1)*prcon
prlon=geobus(lo+i-1)*prcon
if ( prlon .lt. 0 ) prlon = 360. + prlon
if ( ( prlat .lt. E_geol_gls ) .or.
% ( prlat .gt. E_geol_gln ) .or.
% ( prlon .lt. E_geol_glw ) .or.
% ( prlon .gt. E_geol_gle ) ) then
* This is outside de lat-lon box
geobus(glsea+i-1) = geobus(glseac+i-1)
else
* This point is inside the lat-lon box
if ( prlat .lt. (E_geol_gls + 2.) ) then
* This point is on the southern edge
prpoa = ( prlat - E_geol_gls ) / 2.
geobus(glsea+i-1) = prpoa*geobus(glsea+i-1) +
% (1.-prpoa)*geobus(glseac+i-1)
else if ( prlat .gt. (E_geol_gln - 2.) ) then
* This point is on the northern edge
prpoa = ( E_geol_gln - prlat ) / 2.
geobus(glsea+i-1) = prpoa*geobus(glsea+i-1) +
% (1.-prpoa)*geobus(glseac+i-1)
endif
if ( prlon .lt. (E_geol_glw + 2.) ) then
* This point is on the western edge
prpoa = ( prlon - E_geol_glw ) / 2.
geobus(glsea+i-1) = prpoa*geobus(glsea+i-1) +
% (1.-prpoa)*geobus(glseac+i-1)
else if ( prlon .gt. (E_geol_gle - 2.) ) then
* This point is on the eastern edge
prpoa = ( E_geol_gle - prlon ) / 2.
geobus(glsea+i-1) = prpoa*geobus(glsea+i-1)+
% (1.-prpoa)*geobus(glseac+i-1)
endif
endif
end do
*
600 format(/,' MODIFICATION OF ICE COVERAGE FIELD (S/R E_MODGL)')
*
* ------------------------------------------------------------
*
return
end