!-------------------------------------- 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 SERGDIM(INPUNIT,MSTAT,MSURF,MPROF,ERREUR),3
#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
*
*
*MODULE
EXTERNAL SERALLC2
*
**
*
REAL SCRAP0
INTEGER NK
INTEGER NSTT,NSRF,NPRF,MSTT,MSRF,MPRF,L,M,K
INTEGER SCRAP,SCRAP2,SCRAP5,SCRAP7
INTEGER SCRAP8,SCRAP9,SCRAP10,SCRAP11,SCRAP12,SCRAP13
CHARACTER SCRAPC1*4, SCRAPC2*4, SCRAPC3*12, SCRAPC3OLD*8
LOGICAL SCRAPE1, SCRAPE2
INTEGER IERR, SERDIM, DIMSERS, DIMSERP
REAL SERS, SERP
POINTER (ISERS,SERS(1)), (ISERP,SERP(1))
REAL SCRAP20,SCRAP21,SCRAP22
CHARACTER *8 TS_VERSION_SIG
INTEGER TS_VERSION
*
ERREUR = .FALSE.
REWIND INPUNIT
*
READ ( INPUNIT ) TS_VERSION_SIG
*
TS_VERSION = 100
if ( TS_VERSION_SIG(1:5) .EQ. "TSER_" )
+ READ( TS_VERSION_SIG,'(5X,I3)')
+ TS_VERSION
WRITE(6,*) 'TS_VERSION=',TS_VERSION
*
if ( TS_VERSION .GE. 200 ) then
*
* READ VERSION >= 2.00, I.E.
* WITH HY VARIABLES, HOURS IN REAL*8 AND ETIKET WITH 12 CHARACTERS
*
READ ( INPUNIT , END=2 ) SCRAP0, NSTT,
X (SCRAP,SCRAP2,L=1,NSTT),
Y NSRF,(SCRAPC1,M=1,NSRF),
Z NPRF,(SCRAPC2,M=1,NPRF),
T (SCRAP5,K=1,14),SCRAPC3,NK,(SCRAP7,K=1,NK),
U SCRAP8,SCRAP9,(SCRAP10,K=1,4),
V SCRAP20,SCRAP21,SCRAP22,
W SCRAP11, SCRAP12, SCRAP13, SCRAPE1,
X SCRAPE2
READ ( INPUNIT ,END = 2) SCRAP
C READ ( INPUNIT ,END = 2) SCRAP
READ ( INPUNIT ,END = 2) TS_VERSION_SIG
READ ( INPUNIT , END=2 ) SCRAP0, MSTT,
X (SCRAP,SCRAP2,L=1,MSTT),
Y MSRF,(SCRAPC1,M=1,MSRF),
Z MPRF,(SCRAPC2,M=1,MPRF),
T (SCRAP5,K=1,14),SCRAPC3,NK,(SCRAP7,K=1,NK),
U SCRAP8,SCRAP9,(SCRAP10,K=1,4),
V SCRAP20,SCRAP21,SCRAP22,
W SCRAP11, SCRAP12, SCRAP13, SCRAPE1,
X SCRAPE2
*
ELSE
*
* READ VERSION 1.00
*
REWIND INPUNIT
READ ( INPUNIT , END=2 ) SCRAP0, NSTT,
X (SCRAP,SCRAP2,L=1,NSTT),
Y NSRF,(SCRAPC1,M=1,NSRF),
Z NPRF,(SCRAPC2,M=1,NPRF),
T (SCRAP5,K=1,14),SCRAPC3OLD,NK,(SCRAP7,K=1,NK),
U SCRAP8,SCRAP9,(SCRAP10,K=1,4),
V SCRAP11, SCRAP12, SCRAP13, SCRAPE1,
W SCRAPE2
READ ( INPUNIT ,END = 2) SCRAP
C READ ( INPUNIT ,END = 2) SCRAP
READ ( INPUNIT , END=2 ) SCRAP0, MSTT,
X (SCRAP,SCRAP2,L=1,MSTT),
Y MSRF,(SCRAPC1,M=1,MSRF),
Z MPRF,(SCRAPC2,M=1,MPRF),
T (SCRAP5,K=1,14),SCRAPC3OLD,NK,(SCRAP7,K=1,NK),
U SCRAP8,SCRAP9,(SCRAP10,K=1,4),
V SCRAP11, SCRAP12, SCRAP13, SCRAPE1,
W SCRAPE2
*
END IF
*
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 (sers,serp,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