!-------------------------------------- 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 --------------------------------------
!
SUBROUTINE SPINIT 1,2
#if defined (DOC)
*
***s/r SPINIT - Initialize the spectral fields by setting
* . them to correspond to a Haurwitz wave or
* . by reading them from a file
*
*
*Author : P. Gauthier *ARMA/AES June 11, 1992
*Revision:
* P. Gauthier *ARMA/AES May 23, 1993: modifications to initialize also
* . the specific humidity and the surface pressure
*
* S. Pellerin *ARMA/AES Sept 97.
* - Control of the different model state of the 3Dvar
* through COMSTATE, COMSTATEC and COMSTNUM common
* blocks variables (comstate.cdk).
*Arguments
* o : comsp.cdk (array SP(NLA,2,NKSDIM))
*
#endif
IMPLICIT NONE
*implicits
#include "comdim.cdk"
#include "comlun.cdk"
#include "comleg.cdk"
#include "comsp.cdk"
#include "comtemp.cdk"
#include "comstate.cdk"
*
INTEGER ILA, JLEV, IERR
REAL*8 ZPSURFACE
EXTERNAL TRANSFER
C
C* 1. Setting the parameters of the single wave
C . -----------------------------------------
C
100 CONTINUE
ZPSURFACE = 1000.
C
C* . 1.1 Default values
C . --------------
110 CONTINUE
LTEMP = .FALSE.
NJN = 6
NJM = 3
RSCDIV = 1.E-6
RSCVOR = 1.E-6
RSCTT = 20.
RSCQ = 1.
RSCPS = 50.
C
C* . 1.2 Modify them by reading a NAMELIST
C . ---------------------------------
C
120 CONTINUE
C
CALL READNML('NAMTEMP',IERR)
C
C* 2. Set the spectral coefficients
C . -----------------------------
C
200 CONTINUE
C
C* . 2.1 Initialize to zero
C . ------------------
210 CONTINUE
CALL TRANSFER('ZSP0')
C
C* . 2.2 Set the spectral coefficients to correspond to a single wave
C . ------------------------------------------------------------
C
220 CONTINUE
C
WRITE(NULOUT,FMT='(" In SPINIT- fields set to correspond",
S " to a single wave")')
C
ILA = NIND(NJM) + NJN - NJM
DO 221 JLEV = 1, NFLEV
SPTT(ILA,1,JLEV) = RSCTT
SPVOR(ILA,1,JLEV) = RSCVOR
SPDIV(ILA,1,JLEV) = RSCDIV
SPTT(ILA,2,JLEV) = RSCTT
SPVOR(ILA,2,JLEV) = RSCVOR
SPDIV(ILA,2,JLEV) = RSCDIV
WRITE(NULOUT,*)' N =',NJN,' M = ',NJM,' ILA = ',ILA
S ,' SPVOR(ILA,*,JLEV) = ',SPVOR(ILA,1,JLEV)
S ,' SPDIV(ILA,*,JLEV) = ',SPDIV(ILA,1,JLEV)
S ,' SPTT (ILA,*,JLEV) = ',SPTT (ILA,1,JLEV)
221 CONTINUE
C
C* . 2.3 Set the spectral coefficients to correspond to a single wave
C . (treatment of specific humidity and surface pressure)
C . ------------------------------------------------------------
C
230 CONTINUE
C
IF(nsexist(nsq).eq.1) THEN
DO 231 JLEV = 1, NFLEV
SPQ(ILA,1,JLEV) = RSCQ
SPQ(ILA,2,JLEV) = RSCQ
231 CONTINUE
END IF
C
IF(nsexist(nsps).eq.1)THEN
DO 232 JLEV = 1, NFLEV
SPPS( 1,1,1) = ZPSURFACE
SPPS(ILA,1,1) = RSCPS
SPPS(ILA,2,1) = RSCPS
232 CONTINUE
END IF
C
RETURN
END