!-------------------------------------- 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 --------------------------------------
copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
***function set_dcst - initializes geophysical constants
*
logical function set_dcst ( val, liste, nbre, unout )
implicit none
*
integer nbre,unout
character * (*) liste(nbre)
real val(nbre)
*
*author
* M. Desgagne July 2005
*
integer i, ier, flag(nbre)
real rdval
*
* ---------------------------------------------------------------
*
if (unout.gt.0) write (6,1000)
*
flag = 0
*
call constnt (rdval,ier,liste,0)
rdval = 0.4
call constnt (rdval,ier,'KARMAN',3)
do i=1,nbre
call constnt (val(i),flag(i),liste(i),0)
end do
*
set_dcst = .true.
*
do i=1,nbre
if (flag(i).eq.1) then
if (unout.gt.0) write (unout,1005) liste(i),val(i)
else
if (unout.gt.0) write (unout,1006) liste(i)
set_dcst = .false.
endif
end do
*
100 format (1x,52('*'))
102 format (1x,'*',4x,A,5x,'*')
103 format (1x,'*',4x,A,F4.2,A,11x,'*')
1000 format (
+ /,'INITIALIZATION OF PHYSICAL CONSTANTS: (S/R SET_DCST)',
+ /,'======================================================')
1005 format (1x,"THE VALUE OF",1x,a10,2x,"=",1x,e15.6)
1006 format (" WARNING ==> THE CONSTANT ",a10," DOES NOT EXIST.")
*
* ---------------------------------------------------------------
*
return
end