!-------------------------------------- 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 indata - Read and process the input data at
* beginning of integration
*
#include "model_macros_f.h"
*
subroutine indata 9,18
*
implicit none
*
*author
* Michel Roch - rpn - apr 1994
*
*revision
* v2_00 - Desgagne M. - initial MPI version (from indata v1_03)
* v2_10 - Tanguay M. - introduce partition of preprocessing when 4D-Var
* v2_20 - Pellerin P. - read geophysical fields depending on schemes
* v2_20 - Lee V. - eliminated p_slicgeo, output of geophysical fields
* v2_20 - will be from the entry or permanent physics bus
* v2_30 - Desgagne M. - entry vertical interpolator in gemdm
* v2_31 - Tanguay M. - adapt for vertical hybrid coordinate
* v3_02 - Buehner M. - leave winds as images for 4dvar or SV jobs
* v3_03 - Tanguay M. - Adjoint Lam configuration
* v3_11 - Gravel S. - Adapt for theoretical cases and varying topo
* v3_11 - Tanguay M. - Abort when V4dg_conf.ne.0 and Vtopo_L
* v3_30 - Desgagne M. - re-organize code to eliminate v4d controls
* v3_30 - Lee V. - new LAM I/O interface
* v3_31 - Lee V. - adaptation to new scripts, give more info on GEO
* v3_31 - Tanguay M. - Mix PILOT and ANAL mountains when BCS/3DF
*
*object
*
*arguments
* none
*
*implicits
#include "acid.cdk"
#include "schm.cdk"
#include "glb_ld.cdk"
#include "filename.cdk"
#include "bmf.cdk"
#include "out3.cdk"
#include "ind.cdk"
#include "p_geof.cdk"
#include "vt1.cdk"
#include "vtx.cdk"
#include "theo.cdk"
#include "vtopo.cdk"
#include "lctl.cdk"
#include "lun.cdk"
#include "modconst.cdk"
#include "itf_phy_buses.cdk"
#include "path.cdk"
*
integer vmmlod,vmmget,vmmuld,nav_3df,newdate,readgeo
external vmmlod,vmmget,vmmuld,nav_3df,newdate,readgeo
*
character*16, dimension (:,:), allocatable :: listgeonm
character*256 fn
integer key1(35),nvar,err,unf,errop,ungeo,dat,k,
$ err_geo,skipcode
*
* ---------------------------------------------------------------
*
if (Lun_out.gt.0) write (Lun_out,1000)
*
call v4d_indata1(Vtopo_L)
*
key1( 1) = VMM_KEY( fit1)
key1( 2) = VMM_KEY( ut1)
key1( 3) = VMM_KEY( vt1)
key1( 4) = VMM_KEY( tt1)
key1( 5) = VMM_KEY( qt1)
key1 (6) = VMM_KEY(fipt1)
key1 (7) = VMM_KEY( st1)
key1 (8) = VMM_KEY(pipt1)
key1 (9) = VMM_KEY( tpt1)
key1(10) = VMM_KEY(tplt1)
key1(11) = VMM_KEY( gptx)
key1(12) = VMM_KEY(psdt1)
key1(13) = VMM_KEY( tdt1)
key1(14) = VMM_KEY( topo)
key1(15) = VMM_KEY( topu)
key1(16) = VMM_KEY( topv)
key1(17) = VMM_KEY( topa)
key1(18) = VMM_KEY( toua)
key1(19) = VMM_KEY( tova)
nvar = 19
*
if (Vtopo_L) then
key1(nvar+1) = VMM_KEY(dtopo)
nvar=nvar+1
endif
if (.not. Schm_hydro_L) then
key1(nvar+1) = VMM_KEY(wt1)
key1(nvar+2) = VMM_KEY(mut1)
key1(nvar+3) = VMM_KEY(multx)
key1(nvar+4) = VMM_KEY(qpt1)
nvar = nvar+4
endif
*
err = vmmlod(key1,nvar)
*
err = VMM_GET_VAR( fit1)
err = VMM_GET_VAR( ut1)
err = VMM_GET_VAR( vt1)
err = VMM_GET_VAR( tt1)
err = VMM_GET_VAR( qt1)
err = VMM_GET_VAR(fipt1)
err = VMM_GET_VAR( st1)
err = VMM_GET_VAR(pipt1)
err = VMM_GET_VAR( tpt1)
err = VMM_GET_VAR(tplt1)
err = VMM_GET_VAR( gptx)
err = VMM_GET_VAR(psdt1)
err = VMM_GET_VAR( tdt1)
err = VMM_GET_VAR( topo)
err = VMM_GET_VAR( topu)
err = VMM_GET_VAR( topv)
err = VMM_GET_VAR( topa)
err = VMM_GET_VAR( toua)
err = VMM_GET_VAR( tova)
*
* Equivalencing Ind_u to ut1
*
Ind_fi_ = fit1_
Ind_u_ = ut1_
Ind_v_ = vt1_
Ind_t_ = tt1_
Ind_q_ = qt1_
Ind_fip_ = fipt1_
Ind_s_ = st1_
Ind_pip_ = pipt1_
Ind_tp_ = tpt1_
Ind_tpl_ = tplt1_
Ind_gp_ = gptx_
Ind_psd_ = psdt1_
Ind_td_ = tdt1_
Ind_topo_= topo_
Ind_topu_= topu_
Ind_topv_= topv_
Ind_topa_= topa_
Ind_toua_= toua_
Ind_tova_= tova_
*
if (.not. Schm_hydro_L) then
err = VMM_GET_VAR( wt1)
err = VMM_GET_VAR( mut1)
err = VMM_GET_VAR(multx)
err = VMM_GET_VAR(qpt1)
Ind_w_ = wt1_
Ind_mu_ = mut1_
Ind_mul_ = multx_
Ind_qp_ = qpt1_
endif
if ( Vtopo_L) then
err = VMM_GET_VAR( dtopo)
Ind_dtopo_= dtopo_
endif
*
skipcode=0
call v4d_indata2(skipcode)
if (skipcode.eq.1) goto 9999
*
Path_ind_S=trim(Path_input_S)//'/INIT_3D'
*
err_geo = readgeo()
allocate (listgeonm(2,p_bgeo_top))
listgeonm(1,:) = geonm(:,1)
listgeonm(2,:) = 'NIL'
if (err_geo.eq.0) listgeonm(2,:) = 'OK'
*
if (G_lam) then
prefgeo = '!@#$%^&*'
ungeo = 91
fn = trim(Path_work_S)//'/geophy_fileprefix_for_LAM'
open ( ungeo, FILE=fn, status='OLD', iostat=err )
if (err.eq.0) then
read (ungeo, '(a)', end = 9120) prefgeo
9120 close(ungeo)
endif
if (prefgeo.ne.'!@#$%^&*') then
call geodata (G_ni,G_nj,listgeonm)
else
if (Lun_debug_L) write (Lun_out,1002)trim(prefgeo)
endif
endif
*
errop = -1
if (G_lam) then
unf = 76
fn = trim(Path_ind_S)//'/3df_filemap.txt'
open (unf,file=fn,access='SEQUENTIAL',status='OLD',
$ iostat=errop,form='FORMATTED')
endif
*
if ( errop.eq.0 ) then
err = nav_3df (unf,1.2,1.0d0)
call gem_stop ('nav_3df',err)
if (Acid_test_L) then
call acid_3df_dynp (G_ni,G_nj,unf)
else
call casc_3df_dynp (G_ni,G_nj,unf,listgeonm)
endif
else
call datp2f ( dat, Mod_runstrt_S )
err = newdate ( dat, bmf_time1, bmf_time2, -3 )
*
if ( Schm_theoc_L ) then
call theo_3D ! canonical cases - generate initial data
else
call readdyn ()
endif
*
call v4d_indata3()
call set_dync ()
call predat ()
endif
*
if (Lun_out.gt.0) write (Lun_out,1001)
*
do k=1,P_bgeo_top
if ((geonm(k,1).eq.'MT').or.(geonm(k,1).eq.'MF'))
$ call glbstat1(geofld(geopar(k,1)),geonm(k,1)(1:8),"geop",
$ 1,l_ni,1,l_nj,geopar(k,3), 1,G_ni,1,G_nj,1,geopar(k,3))
end do
*
if ( Schm_phyms_L ) then
err=0
do k=1,P_bgeo_top
if ((geonm(k,1).ne.'MT').and.(geonm(k,1).ne.'MF')) then
if (listgeonm(2,k).ne.'NIL') then
call glbstat1(geofld(geopar(k,1)),geonm(k,1)(1:8),"geop",
$ 1,l_ni,1,l_nj,geopar(k,3), 1,G_ni,1,G_nj,1,geopar(k,3))
endif
endif
end do
do k=1,P_bgeo_top
if (listgeonm(2,k).eq.'NIL') then
err=-1
if (Lun_out.gt.0)
$ write(Lun_out,*) listgeonm(1,k),listgeonm(2,k)
endif
end do
call gem_stop('indata',err)
endif
*
9999 if (G_lam) call nest_init ()
*
* ---------------------------------------------------------------
*
1000 format(/,'TREATING INITIAL CONDITIONS (S/R INDATA)',/,41('='))
1001 format(/,'GLOBAL STAT OF GEOPHYSICAL FIELDS',/,33('='))
1002 format(/,' FILE ',A,'_gfilemap.txt IS NOT AVAILABLE --CONTINUE--',/,/)
*
return
end