!-------------------------------------- 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 tracers - Initializes list of tracers
*
#include "model_macros_f.h"
*
subroutine tracers () 1,1
implicit none
*
*author
* Michel Desgagne - Sept 2001
*
*revision
* v2_31 - Desgagne M. - initial version
* v3_21 - Lee V. - remove Tr2d
* v3_30 - Desgagne M. - memory calculation for tracers
*
*object
*
*arguments
* Tr3d_name_S acquires the list of tracers from itf_phy_inikey
* In this subroutine, it will acquire what is introduced from
* Tr3d_username_S (constructed from the entry routine)
* ie: QC can be filled with either QC or QCT1 or QCT0 from the
* given analysis (accessed by E_tr3dname_S of gement nml)
* but this is converted via BMF/BCS/3DF as QC
* Tracers requested under auto cascade requires only the first
* 2 letters
*
*implicits
#include "lun.cdk"
#include "tr3d.cdk"
#include "itf_phy_busind.cdk"
#include "mem.cdk"
#include "schm.cdk"
*
logical hu_L
integer i,k,memvmm,longueur
external longueur
character*4 username_S(MAXTR3D)
**
* __________________________________________________________________
*
do 10 i=1,Tr3d_userntr
*
* Is user tracers already in Tr3d stack?
do k=1,tr3d_ntr
if (Tr3d_name_S(k).eq.Tr3d_username_S(i)) then
Tr3d_sval(k) = Tr3d_usersval(i)
goto 10
endif
end do
*
* Otherwise add user tracer to Tr3d stack
tr3d_ntr = tr3d_ntr + 1
Tr3d_name_S(tr3d_ntr) = Tr3d_username_S(i)
Tr3d_sval (tr3d_ntr) = Tr3d_usersval (i)
10 continue
*
* Special case of HU Tr3d tracer (must always be present)
*
hu_L = .false.
hucond = -1
do k=1,tr3d_ntr
if (Tr3d_name_S(k).eq.'HU') then
hu_L = .true.
hucond = k
endif
end do
if (.not.hu_L) then
tr3d_ntr = tr3d_ntr + 1
Tr3d_name_S(tr3d_ntr) = 'HU'
Tr3d_sval(tr3d_ntr) = 0.
hucond = tr3d_ntr
endif
*
if (Lun_out.gt.0) then
write (Lun_out,1001) 'TRACERS (3D storage):'
do i=1,tr3d_ntr
write (Lun_out,1002) Tr3d_name_S(i),Tr3d_sval(i),i
end do
endif
*
if (.not.Schm_phyms_L) Mem_minmem=Mem_minmem-24
memvmm = Mem_minmem + 4*max((tr3d_ntr-5),0)
if (Mem_mx3db.lt.memvmm) then
if (Lun_out.gt.0) write (Lun_out,1003) Mem_mx3db,memvmm
call gem_stop('tracers',-1)
endif
*
1001 format (/a)
1002 format (2x,a4,d12.7,i4)
1003 format (/' ##### Mem_mx3db NOT large enough #####'/
$ 'Current value for Mem_mx3db is: ',i5,/
$ 'Must be set manually in &gem_cfgs to Mem_mx3db=',i5)
*
* __________________________________________________________________
*
return
end