!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%SUBROUTINE SERGDIM(INPUNIT,MSTAT,MSURF,MPROF,ERREUR) 1,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 * *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*8 LOGICAL SCRAPE1, SCRAPE2 INTEGER IERR, SERDIM, DIMSERS, DIMSERP REAL SERS, SERP POINTER (ISERS,SERS(1)), (ISERP,SERP(1)) * ERREUR = .FALSE. 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),SCRAPC3,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),SCRAPC3,NK,(SCRAP7,K=1,NK), U SCRAP8,SCRAP9,(SCRAP10,K=1,4), V SCRAP11, SCRAP12, SCRAP13, SCRAPE1, W SCRAPE2 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