!-------------------------------------- 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 v4d_rdfld - read one field from a random file
*
#include "model_macros_f.h"
*
integer function v4d_rdfld (F_d,F_un,nis,njs,F_ip1, 13
$ F_ip2,F_ip3,F_typ_S,F_var_S,niw,njw)
*
#include "impnone.cdk"
*
character*(*) F_var_S,F_typ_S
integer F_un, F_ip1, F_ip2, F_ip3
integer nis,njs,niw,njw
real F_d(nis,njs)
*
*author
* Michel Roch - rpn - june 1993
*
*revision
* v3_01 - Morneau J. - Initial MPI version (from rdfld v1_03)
* - read random file
*
*object
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_var_S I name of the field to read
* F_un I Fortran unit number
* F_d O reception array
*----------------------------------------------------------------
*
*implicits
#include "lun.cdk"
*
integer pni,pnj,pnk,i,j,key
real wk(niw,njw)
*modules
integer fstlir
external fstlir
*
**
* ---------------------------------------------------------------
*
v4d_rdfld = -1
key = fstlir(wk(1,1),F_un,pni,pnj,pnk,-1,
$ ' ',F_ip1,F_ip2,F_ip3,F_typ_S,F_var_S)
if (key .lt. 0) then
write (Lun_out,1001)F_var_S,F_ip1,F_ip2
goto 9200
endif
*
if (pni.ne.niw .or. pnj.ne.njw .or. pnk .ne. 1) then
write(Lun_out, 1002) '==> Dimension error reading variable',
+ F_var_S
write(Lun_out, 1002) 'STOP IN S/R V4D_RDFLD '
goto 9200
endif
*
* Scatter
*
do j=1,njs
do i=1,nis
F_d(i,j) = wk(i,j)
end do
end do
*
v4d_rdfld=0
*
1001 format(
+/,'FSTLIR-CANNOT FIND ',a4,' FOR IP1=',i6,' and IP2=',i4)
1002 format (a,a3)
*
* ---------------------------------------------------------------
*
9200 return
end