!-------------------------------------- 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 rdradf -- Perform the actual reading and organization of
* the data in the ozone and radiation files
*
subroutine rdradf (cible,iun,isfst,n,ozotable,status) 1
#include "impnone.cdk"
*
logical isfst, ozotable
integer iun,n,status
real cible (n)
*
*Author
* M. Desgagne (Oct 1998)
*
*Object
* Reads and organizes the data in cible according to
* flag ozotable: .true. ===> for the ozone data
* .false. ===> for the radiation table
*
*Arguments
* - Output -
* cible reception adresss for the data to be read
* - Input -
* iun fortran unit
* isfst logical flag to indicate if read is performed in a FST file
* n dimension of cible
* ozotable logical flag to indicate ozone (.t.) or radiation table (.f.)
* - Output -
* status exit status for the routine (=0 if OK, =-1 otherwise)
*
*
#include "radpnt.cdk"
#include "radparam.cdk"
*
character*4 dum1
integer i,ilir,inbr,mi,mj,mk,m,lemois
integer fstrwd,fstinf,fstluk,fstlir
*
*-----------------------------------------------------------------
*
status = -1
*
if (ozotable) then
*
if (isfst) then
*
ilir = fstrwd( iun )
ilir = fstinf (iun,mi,mj,mk,-1,' ',-1,-1,1,' ',' ')
if ((mi*mj.eq.n/12).and.(ilir.ge.0)) then
do m=1,12
ilir = fstinf (iun,mi,mj,mk,-1,' ',-1,-1,m,' ',' ')
ilir = fstluk (cible((m-1)*mi*mj+1), ilir, mi, mj, mk)
end do
status = 0
endif
*
else
*
rewind (iun)
read (iun,end=300) dum1,lemois,mi,mj
if (mi*mj.eq.n/12) then
rewind (iun)
do m=1,12
read (iun,end=300) dum1,lemois,mi,mj
read (iun,end=300) (cible((m-1)*mi*mj+i),i=1,mi*mj)
end do
status = 0
endif
*
endif
*
300 continue
*
else
*
if (isfst) then
*
ilir = fstinf (iun,mi,mj,mk,-1,' ',-1,-1,-1,'C','G1')
*
if ((mi.eq.mxx.and.mj.eq.ntt) .and. (ilir.ge.0)) then
*
inbr=fstlir(cible(g1), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','G1')
inbr=fstlir(cible(g2), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','G2')
inbr=fstlir(cible(g3), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','G3')
inbr=fstlir(cible(th2o),iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','2O')
inbr=fstlir(cible(tro3),iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','T3')
inbr=fstlir(cible(yg3), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','Y3')
inbr=fstlir(cible(bcn), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','BN')
inbr=fstlir(cible(dbcn),iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','DN')
inbr=fstlir(cible(bo3), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','B3')
inbr=fstlir(cible(dbo3),iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','D3')
inbr=fstlir(cible(to3), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','3O')
inbr=fstlir(cible(uu), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','2U')
inbr=fstlir(cible(tt), iun,mi,mj,mk,-1,' ',-1,-1,-1,' ','2T')
status = 0
*
else
print *,'******************************************'
print *,'Lecture incorrecte des tables de radiation'
print *,'dans le sous-programme litblrad2 '
print *,'******************************************'
endif
*
else
*
rewind (iun)
read (iun,end=400) cible
status = 0
*
endif
*
400 continue
*
endif
*-----------------------------------------------------------------
*
return
end