!-------------------------------------- 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_geopfld
*
#include "model_macros_f.h"
*
subroutine e_geopfld 1,9
implicit none
*
*author M. Desgagne
*
*revision
* v2_21 - M. Desgagne - initial version
* v3_00 - Desgagne & Lee - Lam configuration
* v3_02 - Dugas B. - convip for topography
* v3_11 - M. Desgagne - remove call to phy_30900
* v3_21 - Lee V. - output status for geophy.bin
* v3_30 - Desgagne M. - modifications for new physics interface
*
#include "e_topo.cdk"
#include "itf_phy_buses.cdk"
#include "geobus.cdk"
#include "e_fu.cdk"
#include "e_grids.cdk"
#include "e_cdate.cdk"
#include "hgc.cdk"
#include "e_schm.cdk"
#include "pilot.cdk"
#include "modconst.cdk"
#include "filename.cdk"
#include "path.cdk"
**
logical e_intgeo
integer fnom,fstouv,fstfrm,fclos,e_pilotf
external fnom,fstouv,fstfrm,fclos,e_pilotf,e_intgeo
logical status
integer i,j,n,err,dum0,dum1,dum2,dum3,dum4,datestp
*
*----------------------------------------------------------------------
*
call prsdate (dum0,month,day,dum1,dum2,dum3,dum4,Mod_runstrt_S)
n = nifi*njfi
*
e_fu_climat = 0
e_fu_geophy = 0
if (fnom (e_fu_climat,trim(Path_input_S)//'/CLIMATO','RND+OLD',0).lt.0) stop
if (fstouv(e_fu_climat,'RND').lt.0) stop
if (fnom (e_fu_geophy,trim(Path_input_S)//'/GEOPHY','RND+OLD',0).lt.0) stop
if (fstouv(e_fu_geophy,'RND').lt.0) stop
*
if (LAM) then
ipilf = 1
call datp2f ( datestp, Mod_runstrt_S )
err = e_pilotf (datestp,'UU',' ',' ',-1,-1,-1)
if (err.lt.0) err = e_pilotf (datestp,'UT1',' ',' ',-1,-1,-1)
else
e_fu_anal = 0
if (fnom (e_fu_anal ,trim(Path_input_S)//'/ANALYSIS','RND+OLD',0).lt.0) stop
if (fstouv(e_fu_anal ,'RND').lt.0) stop
endif
*
write (6,1001) e_fu_anal,e_fu_climat,e_fu_geophy
if (e_fu_anal.le.0) stop
*
p_bgeo_top=0
call e_geopini (nifi,njfi,6)
allocate (geobus(p_bgeo_siz))
geobus = 0.
*
datev = -1
*
if (e_Schm_offline_L) then
allocate (a_pr_m(n),i_pr_m(n),a_ir_m(n),
$ i_ir_m(n),a_so_m(n),i_so_m(n))
i_pr_m=-2. ; i_ir_m=-2. ; i_so_m=-2.
a_pr_m=-2. ; a_ir_m=-2. ; a_so_m=-2.
endif
*
do i=1,n
geobus(mt +i-1) = topo (i)
geobus(fis+i-1) = topof (i)
enddo
*
status = .false.
if ( e_intgeo () ) then
call e_pregeo
call e_wrgeop
status = .true.
endif
*
err = fstfrm (e_fu_anal)
err = fstfrm (e_fu_climat)
err = fstfrm (e_fu_geophy)
err = fclos (e_fu_anal)
err = fclos (e_fu_climat)
err = fclos (e_fu_geophy)
*
if (.not. status) then
write(6,1002)
stop
endif
*
call gemtim3 (6)
*
1001 format (/' Analysis file is unit: ',i4/
$ ' Climatology file is unit: ',i4/
$ ' Geophysical file is unit: ',i4)
1002 format(/60('*'),/
%'* WARNING-WARNING-WARNING!!!! Missing geophysical fields. ',/
%'* File GEOPHY.bin NOT produced' ,/
%'* consider these 2 options:' ,/
%'* 1) run geophy_2000.Abs on your analysis and ' ,/
%'* re-run Um_runent.sh' ,/
%'* 2) re-run Um_runent.sh with Pil_sfc2d_L=.false. and' ,/
%'* run the model without physics parameterication' ,/
% 60('*')/)
*
*----------------------------------------------------------------------
*
return
end