!-------------------------------------- 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 out_tracer - calculate and output tracer fields
*
#include "model_macros_f.h"
*
subroutine out_tracer (F_wlnph,F_trkey0,F_trkey1,minx,maxx,miny,maxy, 1,6
% F_nk, F_levtyp_S,F_rf,F_indo,F_nko,F_set)
*
implicit none
*
character*1 F_levtyp_S
integer F_nk,minx,maxx,miny,maxy,F_nko,F_indo(*),F_set
integer F_trkey0(*),F_trkey1(*)
real F_wlnph(minx:maxx,miny:maxy,F_nk), F_rf(F_nko)
*
*author
* Lee V. - rpn May 2004
*
*revision
* v3_20 - Lee V. - initial MPI version (from bloctr v3_12)
* v3_30 - Lee V. - option to clip tracers with Out3_cliph_L
*
*object
* output all the tracer fields
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_dostep I - array containing indices corresponding to the
* timestep sets that requires output at this time step.
* F_dostep_max I - size of F_dostep array
*
*
*implicits
#include "glb_ld.cdk"
#include "lun.cdk"
#include "out3.cdk"
#include "out.cdk"
#include "outd.cdk"
#include "geomg.cdk"
#include "tr3d.cdk"
*
*
**
integer vmmget
external vmmget
integer i,j,k, ii,idx, pnerr
integer i0,in,j0,jn
logical outvar_L
*
*
real prprlvl(F_nko)
real w4(minx:maxx,miny:maxy,F_nko)
real t4(minx:maxx,miny:maxy,F_nk)
real tr
pointer (patr, tr(LDIST_SHAPE,*))
*
*_______________________________________________________________________
*
i0 = 1
in = l_ni
j0 = 1
jn = l_nj
*
if (F_levtyp_S .eq. 'M') then
*_______________________________________________________________________
*
* 1.0A Output of tracer variables on ETA levels
*_______________________________________________________________________
*
do ii=1,Outd_var_max(F_set)
outvar_L=.false.
if (Outd_var_S(ii,F_set)(3:4).eq.'T0') then
do idx=1,Tr3d_ntr
if ( Outd_var_S(ii,F_set)(1:2).eq.Tr3d_name_S(idx) ) then
pnerr = vmmget(F_trkey0(idx),patr,tr)
outvar_L = .true.
endif
enddo
else if (Outd_var_S(ii,F_set)(3:4).eq.'T1') then
do idx=1,Tr3d_ntr
if ( Outd_var_S(ii,F_set)(1:2).eq.Tr3d_name_S(idx) ) then
pnerr = vmmget(F_trkey1(idx),patr,tr)
outvar_L = .true.
endif
enddo
endif
if (outvar_L) then
if (Out3_cliph_L) then
do k=1,F_nk
do j=1,l_nj
do i=1,l_ni
t4(i,j,k) = amax1(tr(i,j,k), 0. )
enddo
enddo
enddo
call ecris_fst2(t4,l_minx,l_maxx,l_miny,l_maxy,Geomg_hyb,
$ Outd_var_S(ii,F_set),1.0,0.0,Out_kind,F_nk, F_indo, F_nko,
$ Outd_nbit(ii,F_set) )
else
call ecris_fst2(tr,l_minx,l_maxx,l_miny,l_maxy,Geomg_hyb,
$ Outd_var_S(ii,F_set),1.0,0.0,Out_kind,F_nk, F_indo, F_nko,
$ Outd_nbit(ii,F_set) )
endif
endif
enddo
else
*_______________________________________________________________________
*
* 1.0B Output of tracer variables on PRESSURE levels
*_______________________________________________________________________
*
do i = 1, F_nko
prprlvl(i) = F_rf(i) * 100.0
enddo
do ii=1,Outd_var_max(F_set)
outvar_L=.false.
if (Outd_var_S(ii,F_set)(3:4).eq.'T0') then
do idx=1,Tr3d_ntr
if ( Outd_var_S(ii,F_set)(1:2).eq.Tr3d_name_S(idx) ) then
pnerr = vmmget(F_trkey0(idx),patr,tr)
outvar_L=.true.
endif
enddo
else if (Outd_var_S(ii,F_set)(3:4).eq.'T1') then
do idx=1,Tr3d_ntr
if ( Outd_var_S(ii,F_set)(1:2).eq.Tr3d_name_S(idx) ) then
pnerr = vmmget(F_trkey1(idx),patr,tr)
outvar_L=.true.
endif
enddo
endif
if (outvar_L) then
call verder (t4,tr,F_wlnph,2.0,2.0,
$ l_minx,l_maxx,l_miny,l_maxy,G_nk,i0,in,j0,jn)
call prgen( w4, tr, t4, F_wlnph, prprlvl,F_nko,
% Out3_cubzt_L, l_minx,l_maxx,l_miny,l_maxy, G_nk)
if (Outd_filtpass(ii,F_set).gt.0)
$ call filter(w4,Outd_filtpass(ii,F_set),
$ Outd_filtcoef(ii,F_set),'G', .false.,
$ l_minx,l_maxx,l_miny,l_maxy, F_nko)
if (Out3_cliph_L) then
do k=1,F_nk
do j=1,l_nj
do i=1,l_ni
w4(i,j,k) = amax1(w4(i,j,k), 0. )
enddo
enddo
enddo
endif
call ecris_fst2(w4,l_minx,l_maxx,l_miny,l_maxy,F_rf,
$ Outd_var_S(ii,F_set),1.0,0.0,Out_kind,F_nko,
$ F_indo, F_nko, Outd_nbit(ii,F_set) )
endif
enddo
endif
* ___________________________________________________________________
*
return
end