!-------------------------------------- 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_modmg - Modification of land-water mask
*
subroutine e_modmg 1,2
implicit none
*
*Author
* andre methot - cmc - may 1994
*
*revision
* v3_30 - Desgagne M. - renamed comdecks for new PHYSICS interface
*
*arguments
* none
*
*implicit
#include "e_grids.cdk"
#include "e_geol.cdk"
* comdecks used also in GEMPP
#include "model_macros_f.h"
#include "dcst.cdk"
#include "itf_phy_buses.cdk"
#include "geobus.cdk"
**
*
logical pltrouv
integer pnboit
parameter(pnboit=23)
integer i,j,k,offj
real prlat(pnboit,2), prlon(pnboit,2), prseuil, prmg, prcon
real w1(nifi*njfi),w2(nifi*njfi),wml(nifi*njfi)
*
* The height are geopotential heights.
* pnboit - # of lat-long boxes required to identify lakes.
*
* The boxes are covering the following regions:
*
* - The GREAT LAKES AREA
* - The great plains from lat 40 nord up to GREAT SLAVE LAKE
* - The vicinity of GREAT BEAR LAKE
* - The NOUVEAU-QUEBEC region
* - The LAC ST-JEAN region
* - The GOOSE BAY region
* - The EURASIA
* - The baffin island
* - The LAKE CHAMPLAIN region.
* - The western sections of UNGAVA BAY.
* - The FLORIDA STATE.
* - The SOUTERN USA area.
* - The KEAWATIN DISTRICT.
* - The TROUT LAKE region.
* - The area south-west of HUDSON BAY.
* - The area EAST of JAMES-BAY.
* - FLORIDA STATE Nu. 2
* - North of Churchill.
* - Natashquan
* - British Colombia (3 boxes)
*
* NOTE: The longitude increases westward.
*
DATA prlat/40.0, 40.0, 64.0, 51.0, 48.0, 52.0, 35.0,
+ 64.0, 43.0, 58.0, 26.5, 35.0, 64.0, 51.0,
+ 31.0, 55.0, 51.0, 27.5, 61.6, 50.3, 49.5,
+ 49.0, 47.0,
+ 51.0, 64.0, 68.0, 58.0, 51.0, 54.5, 60.0,
+ 68.0, 46.5, 61.5, 27.5, 40.0, 66.8, 55.0,
+ 35.0, 56.6, 54.5, 29.3, 63.2, 52.0, 64.0,
+ 49.5, 49.0/
*
DATA prlon/264.0,238.5,225.0,284.0,285.0,297.0,045.0,
+ 288.0,285.0,283.0,278.0,239.5,244.0,264.0,
+ 247.0,264.0,281.5,277.5,264.0,297.0,233.6,
+ 235.0,236.0,
+ 285.0,264.0,244.0,297.0,290.0,301.5,115.0,
+ 291.0,289.0,288.0,279.5,282.0,270.0,275.0,
+ 278.0,271.0,284.0,278.7,266.0,300.0,238.5,
+ 238.5,238.5/
*
* ------------------------------------------------------------
*
write(6,600)
*
* allocate space in memory for input field
*
* ------- set threshold height for sea-water-----
*
prseuil = 10000.
*
* ------ First step --------
* Look for water point higher than prseuil
* and assign them fresh-water flags.
*
prcon = 180./Dcst_pi_8
do i= 1,nifi*njfi
wml(i)=3.
prmg=nint(geobus(mg+i-1)+(1.-geobus(mg+i-1))*geobus(glsea+i-1))
if ((prmg.lt.0.5).and.(geobus(mt+i-1).le.prseuil)) wml(i)=1.
if ((prmg.lt.0.5).and.(geobus(mt+i-1).gt.prseuil)) wml(i)=2.
w1(i) = geobus(la+i-1) * prcon
w2(i) = geobus(lo+i-1) * prcon
if ( w2(i) .lt. 0 ) w2(i)= 360. + w2(i)
end do
*
* ----- Second step -----
* Look for water points inside lat-long boxes
* and assign them fresh-water flags.
*
do i=1,nifi*njfi
if ( wml(i).lt. 1.5 ) then
do k=1,pnboit
if ( w1(i) .ge. prlat(k,1) .and.
+ w1(i) .le. prlat(k,2) .and.
+ w2(i) .ge. prlon(k,1) .and.
+ w2(i) .le. prlon(k,2) ) wml(i) = 2.
end do
endif
end do
*
do i=1,nifi*njfi
w1(i)=0.0
w2(i)=0.0
enddo
do j=1,njfi
offj=nifi*(j-1)
do i=1,nifi
*
if ( wml(offj+i) .lt. 1.5 ) then
if ( geobus(fis+offj+i-1) .gt. E_geol_hsea ) then
*
* search for a land point in the neighbourhood
* and modify current grid point if a land point is found.
*
call e_findmod (.true., .false., .true., E_geol_poin,
$ i, j, geobus(mg), geobus(al), geobus(glsea),
$ geobus(hs), geobus(snodp), geobus(vegindx), geobus(z0),
$ geobus(lhtg), w1, nifi, njfi, nifi, njfi, pltrouv)
if ( .not. pltrouv )
$ call e_findmod (.true., .false., .true., E_geol_poin,
$ i, j, geobus(mg), geobus(al), geobus(glsea),
$ geobus(hs), geobus(snodp), geobus(vegindx), geobus(z0),
$ geobus(lhtg), w2, nifi, njfi, nifi, njfi, pltrouv)
*
endif
endif
enddo
enddo
*
600 format(/,' MODIFICATION OF LAND/SEA MASK FIELD (S/R E_MODMG)')
*
* ------------------------------------------------------------
*
return
end