!-------------------------------------- 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 readgeo - read the geophysical fields from entry program
*
#include "model_macros_f.h"
*
integer function readgeo () 1,3
*
implicit none
*
*author
* Pierre Pellerin - rpn - Oct 2000 (adapted from READPHY v2_11)
*
*revision
* v2_20 - Pellerin P. & Lee V. - initial version
* v2_21 - Deagegne M. - Re-organising local geofld
* v2_21 - Desgagne M. - rpn_comm stooge for MPI
* v3_10 - Lee V. - RPN_bcastc for bcast on MPI_CHARACTER
* v3_30 - Valcke, S. - Read land-sea or coupling mask for coupling
* v3_31 - Desgagne M. - new coupling interface to OASIS
*
*object
** Reads the entire content of bus "geobus" from file "geophy.bin"
*
*arguments
* none
*
*implicits
#include "glb_ld.cdk"
#include "lun.cdk"
#include "grd.cdk"
#include "e_geol.cdk"
#include "e_fu.cdk"
#include "ptopo.cdk"
#include "itf_phy_buses.cdk"
#include "itf_cpl.cdk"
#include "path.cdk"
*
*modules
*
*notes
* The original routine "READPHY" use to read the geophysical fields
* directly into VMM variables. This routine reads the geophysical
* fields into a large "geobus" so that the information is transferred
* to the "entry" bus of the physics. After that, the "geobus" is
* discarded. The former program had an output (BLOCGEO) of VMM
* geophysical variables which is no longer implemented. To obtain
* output of these geophysical fields, we request them from the physics:
*
* VMM xla xlo xmg xmi xfis xmt xgl xal xsd
* OLD 'LAD','LOD','MGD','MGI','MX' ,'MT','GLD','ALD','SDD'
* NEW '2A' ,'3A' ,'6A' , ,'MF' ,'MN','4A' ,'1A' ,'SD'
*
* VMM xhs xtm xts xtmp xz0 xzp xlh xml xvg
* OLD 'HS' ,'TMD','TS' ,'TP' ,'Z0D','ZP','LHD','ML' ,'VGD'
* NEW '5A' ,'TM' ,'9A' ,'9A' ,'2B' ,'2B','LE' , ,'1B'
*
**
character*512 fn
integer i, ierr, err, err_read, nfields, osgeo, offg, il_siz, gid
real, dimension(:), allocatable :: busgeo
data osgeo/33/
*
* ---------------------------------------------------------------
*
readgeo = -1
err = 0
*
if (Ptopo_myproc.eq.0) then
*
fn = trim(Path_input_S)//'/INIT_SFC/geophy.bin'
open (osgeo,file=fn,access='SEQUENTIAL',
$ status='OLD',iostat=err_read,form='UNFORMATTED')
*
if (err_read.ne.0) then
if ((G_lam).and.(.not.C_coupling_L)) then
write (Lun_out,8080) 'geophy.bin'
e_fu_anal = -1 ; e_fu_climat = -1
E_geol_glreg_L = .false.
E_geol_glanl_L = .false.
E_geol_hsreg_L = .false.
E_geol_hscon_L = .false.
E_geol_hsanl_L = .false.
call e_geopini (Grd_ni,Grd_nj,-1)
else
write (Lun_out,8090) 'geophy.bin'
err = -1
goto 999
endif
else
write(Lun_out,9000) 'geophy.bin'
read (osgeo) p_bgeo_top, p_bgeo_siz
read (osgeo) (geonm (i,1),i=1,p_bgeo_top),
$ (geonm (i,2),i=1,p_bgeo_top),
$ (geonm (i,5),i=1,p_bgeo_top)
read (osgeo) (geopar(i,1),i=1,p_bgeo_top),
$ (geopar(i,2),i=1,p_bgeo_top),
$ (geopar(i,3),i=1,p_bgeo_top)
allocate (busgeo (p_bgeo_siz))
read(osgeo) (busgeo(i),i=1,p_bgeo_siz)
close (osgeo)
endif
*
endif
*
999 call gem_stop ('READGEO',err)
*
il_siz = maxgeo*48
call RPN_COMM_bcast (err_read, 1,"MPI_INTEGER" ,0,"grid",ierr)
call RPN_COMM_bcast (p_bgeo_top, 1,"MPI_INTEGER" ,0,"grid",ierr)
call RPN_COMM_bcast (geopar,maxgeo*3,"MPI_INTEGER" ,0,"grid",ierr)
call RPN_COMM_bcastc(geonm, il_siz,"MPI_CHARACTER" ,0,"grid",ierr)
*
* Re-defining GEOBUS structure in terms of local dimensions
*
nfields = 1
geopar(1,2) = l_ni*l_nj*geopar(1,3)
do i=2,p_bgeo_top
geopar(i,1) = geopar(i-1,1)+l_ni*l_nj*geopar(i-1,3)
geopar(i,2) = l_ni*l_nj*geopar(i,3)
nfields = nfields + geopar(i,3)
if (geonm(i,1).eq.'MT') then
geonm(i,2) = 'ME'
geonm(i,5) = 'LINEAR'
endif
end do
p_bgeo_siz = geopar(p_bgeo_top,1) + l_ni*l_nj*geopar(p_bgeo_top,3)
*
* allocation of the local geophysical bus (geofld)
*
allocate (geofld(p_bgeo_siz))
*
* Distributing global geophysical bus (geobus)
*
if (err_read.eq.0) then
call glbdist (busgeo,G_ni,G_nj,geofld,
$ 1,l_ni,1,l_nj,nfields,0,0)
readgeo = 0
else
geofld = 0.
endif
*
if ((Ptopo_myproc.eq.0).and.(err_read.eq.0)) deallocate (busgeo)
*
8080 format (/' FILE ',a,' IS NOT AVAILABLE --CONTINUE--'/)
8090 format (/' FILE ',a,' MUST BE AVAILABLE --ABORT--'/)
9000 format( /,'READING geophysical DATA FILE: ',a,' (S/R READGEO)',
% /,58('='))
*
* ---------------------------------------------------------------
*
return
end