!-------------------------------------- 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 SERGDIM2(INPUNIT,MSTAT,MSURF,MPROF,NIG, 1,3
$ NK_HYBM,NK_HYBT,NCOEF,ERREUR)
#include "impnone.cdk"
INTEGER INPUNIT,MSTAT,MSURF,MPROF
LOGICAL ERREUR
*
*Author
* M. Lepine (Mar 87)
*
*Revision
* 001 B. Reid (June 89) - Zonal diagnostics
* 002 B. Bilodeau (November 89)
* Modification of call to SERALOC for the SEF model
* 003 N. Brunet (May91)
* New version of thermodynamic functions
* and file of constants
* 004 B. Bilodeau (September 1991)- Adaptation to UNIX
* 005 G. Pellerin (April 1992) Adaptation to PASTEMP
* and cleanup of the code (no reference do zonal diag.)
* 006 B. Bilodeau (Feb 1997) - Add PTOIT, ETATOIT and IG
* 007 B. Bilodeau (July 1998) - IBM32 to IEEE conversion
* 008 B. Bilodeau (Sept 1999) - Call to serallc2
* 009 K. Winger (Apr 2006) - Adapt to time series version 2.00
* (12 characters etiket, real*8 heure, some variables
* and version signature added)
*
*Object
* to obtain the dimensions of different fields of common
* time-series variables and allocate the space dynamically
* as required
*
*Arguments
*
* - Input -
* INPUNIT unit number attached to file to read
*
* - Output -
* MSTAT maximum number of stations contained in a file
* MSURF maximum number of surfaces contained in a file
* MPROF maximum number of profiles contained in a file
* ERREUR .TRUE. to indicate reading file error (on INPUNIT)
* .FALSE. to indicate no error on reading file INPUNIT
*
*
*IMPLICITS
*
#include "sercmdk.cdk"
*
*MODULE
EXTERNAL SERALLC2
*
**
*
REAL SCRAP0,SCRAP7,SCRAP12,SCRAP13
INTEGER NK,NIG,NK_HYBM,NK_HYBT,NCOEF
INTEGER NSTT,NSRF,NPRF,MSTT,MSRF,MPRF,L,M,K
INTEGER SCRAP,SCRAP2,SCRAP5
INTEGER SCRAP8,SCRAP9,SCRAP10,SCRAP11
INTEGER SCRAP14,SCRAP15,SCRAP16,SCRAP26
CHARACTER SCRAPC1*4, SCRAPC2*4, SCRAPC3*12
CHARACTER(len=STN_STRING_LENGTH) SCRAPC4
LOGICAL SCRAPE1, SCRAPE2
INTEGER IERR, SERDIM, DIMSERS, DIMSERP
REAL SERSFC, SERPROF
POINTER (ISERS,SERSFC(1)), (ISERP,SERPROF(1))
REAL SCRAP20,SCRAP21,SCRAP22,SCRAP23,SCRAP24
REAL SCRAP25
REAL*8 SCRAPD1,SCRAPD2,SCRAPD3,SCRAPD4,SCRAPD5,SCRAPD6
*
ERREUR = .FALSE.
REWIND INPUNIT
*
READ ( INPUNIT , END=2 ) SCRAP0, NSTT,
X (SCRAPC4,SCRAP,SCRAP2,L=1,NSTT),
Y NSRF,(SCRAPC1,M=1,NSRF),
Z NPRF,(SCRAPC2,M=1,NPRF),
T (SCRAP5,K=1,14),SCRAPC3,NK,
U NIG,(SCRAP16,K=1,NIG),SCRAP20,
V SCRAP21,SCRAP22,SCRAPE1,
W SCRAPE2,SCRAP14,SCRAP15,NK_HYBM,
X (SCRAP23,SCRAPD1,SCRAPD2,M=1,NK_HYBM),
Y NK_HYBT,
Z (SCRAP24,SCRAPD3,SCRAPD4,M=1,NK_HYBT),
A NCOEF,(SCRAP25,M=1,NCOEF),
B SCRAPD5,SCRAPD6,SCRAP26
READ ( INPUNIT ,END = 2) SCRAP
READ ( INPUNIT , END=2 ) SCRAP0, MSTT,
X (SCRAPC4,SCRAP,SCRAP2,L=1,MSTT),
Y MSRF,(SCRAPC1,M=1,MSRF),
Z MPRF,(SCRAPC2,M=1,MPRF),
T (SCRAP5,K=1,14),SCRAPC3,NK,
U NIG,(SCRAP16,K=1,NIG),SCRAP20,
V SCRAP21,SCRAP22,SCRAPE1,
W SCRAPE2,SCRAP14,SCRAP15,NK_HYBM,
X (SCRAP23,SCRAPD1,SCRAPD2,M=1,NK_HYBM),
Y NK_HYBT,
Z (SCRAP24,SCRAPD3,SCRAPD4,M=1,NK_HYBT),
A NCOEF,(SCRAP25,M=1,NCOEF),
B SCRAPD5,SCRAPD6,SCRAP26
*
IF (MSTT .LE. 0) GOTO 2
MSTAT = MAX(NSTT,MSTT)
MSURF = MAX(NSRF,MSRF)
MPROF = MAX(NPRF,MPRF)
*
PRINT *,' SERGDIM...MSTAT=',MSTAT,' MSURF=',MSURF,
% ' MPROF=',MPROF,' NK=',NK
*
dimsers = serdim (mstat,msurf,1)
dimserp = serdim (mstat,mprof,nk)
call hpalloc (isers, max(1,dimsers), ierr,1)
call hpalloc (iserp, max(1,dimserp), ierr,1)
call serallc2 (sersfc,serprof,1,1,nk)
*
RETURN
*
2 CONTINUE
*
ERREUR = .TRUE.
* SI ERREUR SUR SERIES, RENDRE ESPACE SERIES NUL POUR SERALLC
MSTAT=0
MSURF=0
MPROF=0
NK = 0
*
PRINT *,' SERGDIM...MSTAT=',MSTAT,' MSURF=',MSURF,
% ' MPROF=',MPROF,' NK=',NK
*
RETURN
END