!-------------------------------------- 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 initial_ad - ADJ of initial_tl
*
#include "model_macros_f.h"
*
subroutine initial_ad (F_rstrt_L) 1,4
*
implicit none
*
logical F_rstrt_L
*
*author
* M Tanguay - rpn - july 2003
*
*revision
* v3_11 - Tanguay M. - initial MPI version
*
*object
*
*arguments
* Name I/O Description
*----------------------------------------------------------------
* F_rstrt_L O TRUE if a restart is required
*----------------------------------------------------------------
*
*implicits
#include "glb_ld.cdk"
#include "cstv.cdk"
#include "dcst.cdk"
#include "init.cdk"
#include "lctl.cdk"
#include "lun.cdk"
#include "step.cdk"
#include "rstr.cdk"
#include "schm.cdk"
*
integer n, pndfnph, pnerr
real prn, promegc, prsum, prwin1, prwin2
*
* ---------------------------------------------------------------
*
if ( mod(Init_dfnp,2) .ne. 1 ) then
if (Lun_out.gt.0) write(Lun_out,2010) Init_dfnp
call gem_stop('INITIAL_AD',-1)
endif
*
if (Lun_out.gt.0) write(Lun_out,2020) Init_dfnp
*
* ----------------
* START TRAJECTORY
* ----------------
*
pndfnph = (Init_dfnp - 1) / 2
call hpalloc(Init_dfco_, pndfnph+1, pnerr,1)
promegc = (2.0 * Dcst_pi_8) / Init_dfpl_8
prwin1 = Dcst_pi_8 / real(pndfnph + 1)
*
*********************************************************************
*
Init_dfco(0) = promegc * Cstv_dt_8 / Dcst_pi_8
prsum = Init_dfco(0)
*
*********************************************************************
*
do n=1,pndfnph
prwin2 = 1.0
prn = real(n)
*
if ( Init_dfwin_L ) then
prwin2 = prn * prwin1
prwin2 = sin(prwin2) / prwin2
endif
*
Init_dfco(n) = prwin2 *dsin(prn * promegc * Cstv_dt_8) /
$ (prn * Dcst_pi_8)
prsum = prsum + 2.0 * Init_dfco(n)
end do
*
if (Lun_out.gt.0) write(Lun_out,2030)
if (Lun_out.gt.0)
$ write(Lun_out,*) (Init_dfco(n),n=0,pndfnph), prsum
*
*********************************************************************
*
do n=0,pndfnph
Init_dfco(n) = Init_dfco(n) / prsum
end do
*
prsum = Init_dfco(0)
do n=1,pndfnph
prsum = prsum + 2.0 * Init_dfco(n)
end do
*
if (Lun_out.gt.0) write(Lun_out,2040)
if (Lun_out.gt.0)
$ write(Lun_out,*) (Init_dfco(n),n=0,pndfnph), prsum
*
*********************************************************************
*
* --------------
* END TRAJECTORY
* --------------
*
if (Lctl_step.eq.Init_dfnp-1) then
call ta2t1tx_ad()
Rstri_idon_L = .false.
if (Lun_out.gt.0) write(Lun_out,1010) Lctl_step
if (Lun_out.gt.0) write(Lun_out,1020) Lctl_step
endif
*
call gem_run_ad (.true., F_rstrt_L)
*
if (Lun_out.gt.0) write(Lun_out,1000)
*
if ( .not. Rstri_rstn_L ) call digflt_ad()
*
1000 format(/,'ADJ of DIGITAL FILTER INITIALIZATION: (S/R INITIAL_AD)',
+ /,'============================================')
1010 format(/,'ADJ of INITIALIZATION COMPLETED (S/R INITIAL_AD)',
+ /,'LAST TIMESTEP COMPLETED RESET TO:', I5,' ',
+ /,'============================================')
1020 format(/,'THE TIMESTEP ',i5,' IS COMPLETED',/)
2010 format(/,'PROBLEM: THE VARIABLE Init_dfnp = ',i4,' IS EVEN',
%/,'==============================================')
2020 format(/,'PREPARATION OF DIGITAL FILTER PARAMETERS',
%/,'AND COEFFICIENTS (S/R INITIAL_AD) ',
%/,'========================================',/,'Init_dfnp = ',i4)
2030 format(/,'Digital filter coefficients and sum',
%/,'before normalization ')
2040 format(/,'Digital filter coefficients and sum',
%/,'after normalization ')
*
* ---------------------------------------------------------------
*
return
end