!-------------------------------------- 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 CALGZ - CALCUL PROFILS DE GZ SUR NIVEAUX MODELES
*
SUBROUTINE CALGZ(PX,VT,GZ,PTOPO,NISIG,NJSIG,NLSIG,LEVS) 3,2
*
IMPLICIT NONE
*COMDECK MAXPARM
*
INTEGER ITEMS,ITEMS3,ITEMS4,ITEMS6,MAXIDTP,MAXLEV
INTEGER ITEMS2,NMAJ,NWSECT,MAXREGI,MAXREP,MAXNEIG,MAXCPU,MAXSIG
INTEGER MAXPRED,MAXSTN,NPM
PARAMETER (ITEMS=5, ITEMS4=4, ITEMS6=6, ITEMS2=2,ITEMS3=3)
PARAMETER (MAXLEV=16, NMAJ=32, NWSECT=512, MAXREGI=17)
PARAMETER (MAXREP=40, MAXNEIG=1001, MAXCPU=4)
PARAMETER (MAXPRED=1501,MAXSTN=50000,MAXIDTP=47)
*
*
INTEGER NISIG,NJSIG,NLSIG
INTEGER LEVS(NLSIG)
REAL*8 PX(NISIG*NJSIG,NLSIG),GZ(NISIG*NJSIG,NLSIG)
REAL*8 VT(NISIG*NJSIG,NLSIG)
REAL*8 PTOPO(NISIG*NJSIG)
CHARACTER *8 CETKANL
CHARACTER *1 CGTYP
*
*AUTHOR - J. MORNEAU
*
* Revision
* S. Pellerin *ARMA/SMC
* . Introduction of automatic arrays to avoid limit of 50
* levels
* S. Pellerin, ARMA, August 2008
* . Optimization, introduction of MATAPATST2 and VTAPST2
*LANGUAGE - FORTRAN
*
*LIBRAIRIES
* - RPN SOURCE RCS /users/dor/arma/ccc/oi3d (pollux)
* - OBJET LB /home/3rarm/arma/ccc/oilib/liboa64multi_r6.2.a (sx3r)
* - ABSOLUS REP /home/3rarm/arma/ccc/oilib/abs_liboa64multi_r6.2 (sx3r)
* - OBJET LB /data/rpn02/ccc/ao_lib/liboa64_r6.2.a (sx3)
* - ABSOLUS REP /data/rpn02/ccc/ao_lib/abs_liboa64_r6.2 (sx3)
CHARACTER *(*) VERSION
PARAMETER ( VERSION = 'OASRT10N' )
*
*ARGUMENTS-
* E - PX - "ANALYSED" PRESSURE ON MODEL LEVELS
* E - NISIG,
* E - NJSIG - RESOLUTION OF THE MODEL FIELDS GRID
* E - NLSIG - NUMBER OF MODEL LEVELS
* E - LEVS - MODEL LEVELS IN STANDARD FILES IP1 FORMAT
* E - PTOPO - Topography
*
*MODULES -
EXTERNAL MATAPATST,VTAPST
**
*------------------------------------------------------------------------
*
INTEGER I,N,NP
REAL*8 MGOVRR
REAL*8 ALPHA,S(NISIG*NJSIG,NLSIG),PR(NISIG*NJSIG,NLSIG)
REAL*8 VMA(NISIG*NJSIG,NLSIG),VMB(NISIG*NJSIG,NLSIG),VMC(NISIG
& *NJSIG,NLSIG)
REAL*8 VMD(NISIG*NJSIG,NLSIG),VME(NISIG*NJSIG,NLSIG),VMF(NISIG
& *NJSIG,NLSIG)
REAL*8 PCON
REAL*8 GRAV, RGAS
PARAMETER (GRAV=9.80616, RGAS=287.04)
REAL*8 T0
DATA T0 /273.16/
*
MGOVRR = -1.*GRAV/RGAS
PCON = 1.0/(10.0*MGOVRR)
NP = NISIG*NJSIG
*
*_____ATTENTION: LEVS(I) INCREASES WITH I
*
*_____CALCUL DE GZ AVEC LA ROUTINE VTAPST
*
ALPHA = -1.
DO N=1,NP
DO I=1,NLSIG
PR(N,I) = VT(N,I) + T0
S(N,I) = PX(N,I)*100.0
ENDDO
GZ(N,NLSIG) = PTOPO(N)
enddo
*
CALL MATAPATST2
(S,ALPHA,NP,NLSIG,VMA,VMB,VMC,VMD,VME,VMF)
CALL VTAPST2
(GZ,PR,PCON,NLSIG,NP,VMA,VMB,VMC)
RETURN
END