!-------------------------------------- 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 - Performs initialisation
*
#include "model_macros_f.h"
*
subroutine initial (F_rstrt_L) 1,4
*
implicit none
*
logical F_rstrt_L
*
*author
* Michel Roch - rpn - june 1993
*
*revision
* v2_00 - Desgagne M. - initial MPI version
* v2_10 - Lee V. - call to p_outphyinit
* v3_30 - Desgagne M. - moved bkup_L to gem_run
* v3_31 - McTaggart-Cowan R.- correction for Vtopo mode in digflt
*
*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 "vtopo.cdk"
#include "step.cdk"
#include "rstr.cdk"
#include "schm.cdk"
*
**
integer vmmlod,vmmget,vmmuld
external vmmlod,vmmget,vmmuld
*
integer n, pndfnph, pnerr, pnlkey1(2), pnfirst, pnlast
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',-1)
endif
*
if (Lun_out.gt.0) write(Lun_out,2020) Init_dfnp
*
*********************************************************************
*
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
*
*********************************************************************
*
if ( .not. Rstri_rstn_L ) call digflt()
*
if (Lun_out.gt.0) write(Lun_out,1000) Lctl_step,Init_dfnp-1
*
call gem_run (.true., F_rstrt_L)
*
if (Lctl_step.eq.Init_dfnp-1) then
Rstri_idon_L = .true.
call ta2t1tx()
Lctl_step = (Init_dfnp-1)/2
if (Vtopo_start >= 0 .and. Lctl_step-Vtopo_start+1 <= Vtopo_ndt) Vtopo_L = .true.
if (Lun_out.gt.0) write(Lun_out,1050) Lctl_step
endif
*
1000 format(/,' =====> DIGITAL FILTER INITIALIZATION SCHEME: ',
$ 'TIMESTEP ',i3,' to TIMESTEP ',i3,/' ',73('='))
1050 format(/,' =====> DIGITAL FILTER INITIALIZATION SCHEME: ',
$ 'COMPLETED',/8x,'LAST TIMESTEP COMPLETED RESET TO:',
$ I5,/' ',55('='))
2010 format(/,'PROBLEM: THE VARIABLE Init_dfnp = ',i4,' IS EVEN',
%/,'==============================================')
2020 format(/,'PREPARATION OF DIGITAL FILTER PARAMETERS',
%/,'AND COEFFICIENTS (S/R INITIAL) ',
%/,'========================================',/,'Init_dfnp = ',i4)
2030 format(/,'Digital filter coefficients and sum',
%/,'before normalization ')
2040 format(/,'Digital filter coefficients and sum',
%/,'after normalization ')
*
* ---------------------------------------------------------------
*
return
end