!-------------------------------------- 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 set_list - initialization of SETSOR table with output names,pointers
* to VMM keys for dynamic variables
*
#include "model_macros_f.h"
*
subroutine set_list 1,1
*
#include "impnone.cdk"
*
*author
* michel roch - rpn - septembre 1993
*
*revision
* v2_00 - Lee/Desgagne - initial MPI version (from setlist v1_03)
* v2_10 - Lee V. - corrected order of derivkey assignments
* v2_20 - Lee V. - deleted output of "derived" VMM geophysical fields
* v2_30 - Lee V. - eliminated information on whether the variables
* v2_30 are on PHI,U, or V grid. (All on PHI grid except
* v2_30 for some wind variables treated in BLOCUV)
* v2_31 - Lee V. - HU and QC outputs from BLOCTR, not BLOCTHM
* v2_32 - Lee V. - ME, HU output from BLOCTHM, tracer outputs
* v2_32 (TRT0, TRT1) from BLOCTR
* v3_02 - Lee V. - LA, LO, QC output from BLOCTHM
*
*object
*
*arguments
* none
*
*implicits
#include "glb_ld.cdk"
#include "lun.cdk"
#include "dimout.cdk"
#include "setsor.cdk"
#include "init.cdk"
#include "rhsc.cdk"
#include "rstr.cdk"
#include "vt0.cdk"
#include "vth.cdk"
#include "vt1.cdk"
#include "vt2.cdk"
#include "vta.cdk"
#include "vtx.cdk"
#include "tr3d.cdk"
*
*
**
integer i,nbre,k
parameter (nbre = 31)
character*4 derive_S(nbre)
integer derivkey(nbre)
data derive_S /
$ 'UU','VV','UV','WW','WE','GZ','P0','PS','PT','PN',
$ 'DD','QQ','QR','QS','Q3','DS','VT','TT','TD','ES',
$ 'HR','TW','PX','ZZ','HU','ME','MX','LA','LO','QC','TH'/
*
* ---------------------------------------------------------------
*
if (Lun_out.gt.0) write(Lun_out,1000)
*
do i=1,nbre
derivkey(i) = 0
end do
*
Setsor_num=0
do i=1,COMMON_SIZE(vt0)
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)= vt0_n_first(i)
Setsor_key(Setsor_num)= vt0_first(i)
enddo
if (lun_out.gt.0) write(Lun_out,2000) i-1
*
do i=1,COMMON_SIZE(vth)
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)= vth_n_first(i)
Setsor_key(Setsor_num)= vth_first(i)
enddo
if (lun_out.gt.0) write(Lun_out,2100) i-1
*
do i=1,COMMON_SIZE(vt1)
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)= vt1_n_first(i)
Setsor_key(Setsor_num)= vt1_first(i)
enddo
if (lun_out.gt.0) write(Lun_out,2200) i-1
*
if ( Init_balgm_L .and. .not.Rstri_idon_L ) then
do i=1,COMMON_SIZE(vta)
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)= vta_n_first(i)
Setsor_key(Setsor_num)= vta_first(i)
enddo
if (lun_out.gt.0) write(Lun_out,2350) i-1
endif
*
do i=1,COMMON_SIZE(rhsc)
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)= rhsc_n_first(i)
Setsor_key(Setsor_num)= rhsc_first(i)
enddo
if (lun_out.gt.0) write(Lun_out,2400) i-1
*
*
* Initialize with derived variable names, keys,
*
do i=1,nbre
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)= derive_S(i)
Setsor_key(Setsor_num)= derivkey(i)
enddo
if (lun_out.gt.0) write(Lun_out,2940) i-1
*
*
do i=1,COMMON_SIZE(vtx)
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)= vtx_n_first(i)
Setsor_key(Setsor_num)= vtx_first(i)
enddo
if (lun_out.gt.0) write(Lun_out,2950) i-1
*
* Note that the Setsor_key values for Tr3d are not valid for output.
do i=1,Tr3d_ntr
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)=Tr3d_name_S(i)(1:2)//'T0'
Setsor_key(Setsor_num)= i
enddo
if (lun_out.gt.0) write(Lun_out,2960) i-1
*
do i=1,Tr3d_ntr
Setsor_num=Setsor_num+1
Setsor_name_S(Setsor_num)=Tr3d_name_S(i)(1:2)//'T1'
Setsor_key(Setsor_num)= i
enddo
if (lun_out.gt.0) write(Lun_out,2961) i-1
*
if (lun_out.gt.0) then
write(Lun_out,*)
write(Lun_out,2999)
write(Lun_out,3000) Setsor_num
write(Lun_out,2999)
if (Setsor_num.gt.CNMXDYN) then
write(Lun_out,3500)
call gefstop('set_list')
endif
write(Lun_out,3100)(Setsor_name_S(i), i=1,Setsor_num)
endif
*______________________________________________________________________
*
1000 format(/,'INITIALIZATION OF NAMES AND KEYS LISTS FOR ',
$ 'DYNAMIC OUTPUT CONTROL (S/R SET_LIST)',
% /,'======================================================')
2000 format('THERE ARE ',i5,' VARIABLES IN COMDECK VT0')
2100 format('THERE ARE ',i5,' VARIABLES IN COMDECK VTH')
2200 format('THERE ARE ',i5,' VARIABLES IN COMDECK VT1')
2300 format('THERE ARE ',i5,' VARIABLES IN COMDECK VT2')
2350 format('THERE ARE ',i5,' VARIABLES IN COMDECK VTA')
2400 format('THERE ARE ',i5,' VARIABLES IN COMDECK RHSC')
2940 format('THERE ARE ',i5,' VARIABLES IN COMDECK DERI')
2950 format('THERE ARE ',i5,' VARIABLES IN COMDECK VTX')
2960 format('THERE ARE ',i5,' VARIABLES IN COMDECK TR3DT0')
2961 format('THERE ARE ',i5,' VARIABLES IN COMDECK TR3DT1')
2999 format('+--------------------------------------------+')
3000 format('| ',i4,' DYNAMIC VARIABLES AVAILABLE FOR OUTPUT|')
3100 format(8(a8,1x))
3500 format('SET_LIST ERROR: Setsor_num GREATER THAN CNMXDYN')
*
* ---------------------------------------------------------------
*
return
end