!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%% ***S/P SERSET - INITIALISER UNE DES VARIABLES DES SERIES TEMPORELLES *SUBROUTINE SERSET (NOM,VALEUR,N,IER) 11 #include "impnone.cdk"
* CHARACTER *(*) NOM INTEGER N,IER INTEGER VALEUR(N) * *Author * M. Lepine - RFE model code revision project (Feb 87) * *Revision * 001 B. Reid (June 89) -Zonal diagnostics * 002 B. Bilodeau (December 89) -Update KOUNT * -Initialization of NPTRNCH * 003 B. Bilodeau (July 1991)- Adaptation to UNIX * 004 B. Bilodeau (August 1992) - Add S/R SERSETC * 005 B. Bilodeau and G. Pellerin (Feb 94) - * No more reference to the zonal diagnostics package * 006 N. Ek (Mar 95) - arbitrary interval of output of time series. * 007 B. Bilodeau (Jan 96) - remove KA and create s/r SERSETM for KAM * 008 B. Dugas (Apr 96) - Add option NSTAT * *Object * to initialize a time-series variable * *Arguments * * - Input - * NOM name of the variable to initialize * VALEUR table containing the values for initializing the variable * N number of values of initialize * * - Output - * IER >0, no error, returned code is N * <0, error because N is greater than the dimension of the * variable. Returned code is maximum dimension for variable * *Notes * This routine contains ENTRY SERGET routine. It gets the * values for the variable. * * *IMPLICITES * #include "sercmdk.cdk"
* *MODULES EXTERNAL MOVLEV * ** INTEGER I * IF (NOM .EQ. 'ISTAT') THEN CALL MOVLEV(VALEUR,IJSTAT,MIN(N,MXSTT)) NSTAT = MIN(N,MXSTT) DO 10 I = 1,NSTAT IJSTAT(I,2) = IJSTAT(I,1) + (JSTAT(I) - 1) * NINJNK(1) 10 CONTINUE IER = SIGN(MIN(N,MXSTT),MXSTT-N) * ELSE IF (NOM .EQ. 'JSTAT') THEN CALL MOVLEV(VALEUR,JSTAT,MIN(N,MXSTT)) NSTAT = MIN(N,MXSTT) DO 20 I = 1,NSTAT IJSTAT(I,2) = IJSTAT(I,1) + (JSTAT(I) - 1) * NINJNK(1) 20 CONTINUE IER = SIGN(MIN(N,MXSTT),MXSTT-N) ELSE IF (NOM .EQ. 'STATION') THEN CALL MOVLEV(VALEUR,station,MIN(N,MXSTT)) NSTAT = MIN(N,MXSTT) IER = SIGN(MIN(N,MXSTT),MXSTT-N) * ELSE IF (NOM .EQ. 'ISTAT_G') THEN CALL MOVLEV(VALEUR,ISTAT_G,MIN(N,MXSTT)) NSTAT_G = MIN(N,MXSTT) IER = SIGN(MIN(N,MXSTT),MXSTT-N) * ELSE IF (NOM .EQ. 'JSTAT_G') THEN CALL MOVLEV(VALEUR,JSTAT_G,MIN(N,MXSTT)) NSTAT_G = MIN(N,MXSTT) IER = SIGN(MIN(N,MXSTT),MXSTT-N) * ELSE IF (NOM .EQ. 'HEURE') THEN CALL MOVLEV(VALEUR,HEURE,1) IER = SIGN(MIN(N,1),1-N) * ELSE IF (NOM .EQ. 'NOUTSER') THEN NOUTSER = VALEUR(1) IER = SIGN(MIN(N,1),1-N) * ELSE IF (NOM .EQ. 'SERINT') THEN CALL MOVLEV(VALEUR,SERINT,1) IER = SIGN(MIN(N,1),1-N) * ELSE IF (NOM .EQ. 'KOUNT') THEN CALL MOVLEV(VALEUR,KOUNT,1) IER = SIGN(MIN(N,1),1-N) * ELSE IF (NOM .EQ. 'NSTAT') THEN IF (NSTAT .GT. 0 .AND. + VALEUR(1) .GT. 0 .AND. + VALEUR(1) .NE. NSTAT) THEN PRINT *,' NSTAT deja defini =',NSTAT PRINT *,' Nouvelle valeur =',VALEUR(1),' non utilise...' CALL QQEXIT( 1 ) ELSE CALL MOVLEV(VALEUR,NSTAT,1) IER = SIGN(MIN(N,1),1-N) ENDIF * ENDIF * RETURN * ***S/P SERGET - OBTENIR LES VALEURS D'UNE VARIABLE DES SERIES TEMPOREL * ENTRY SERGET(NOM,VALEUR,N,IER) * *Author * M. Lepine - RFE model code revision project (Feb 87) * *Object(SERSET) * to get values for the time-series variable * *Arguments * * - Input - * NOM name of the variable to initialize * VALEUR table containing the values for initializing the variable * N number of values of initialize * * - Output - * IER >0, no error, returned code is N * <0, error because N is greater than the dimension of the * variable. Returned code is maximum dimension for variable * * ** * * * METTRE IER ET VALEUR A ZERO PAR DEFAUT * (POUR DETECTER OPTION INEXISTANTE * QUI SERAIT DEMANDEE) IER = 0 VALEUR (1) = 0 * IF (NOM .EQ. 'ISTAT') THEN CALL MOVLEV(IJSTAT,VALEUR,MIN(N,MXSTT)) IER = SIGN(NSTAT,N-NSTAT) * ELSE IF (NOM .EQ. 'JSTAT') THEN CALL MOVLEV(JSTAT,VALEUR,MIN(N,MXSTT)) IER = SIGN(NSTAT,N-NSTAT) * ELSE IF (NOM .EQ. 'NINJNK') THEN CALL MOVLEV(NINJNK,VALEUR,MIN(N,3)) IER = SIGN(3,N-3) * ELSE IF (NOM .EQ. 'HEURE') THEN CALL MOVLEV(HEURE,VALEUR,1) IER = SIGN(1,N-1) * ELSE IF (NOM .EQ. 'NOUTSER') THEN VALEUR(1) = NOUTSER IER = SIGN(1,N-1) * ELSE IF (NOM .EQ. 'NSTAT') THEN VALEUR(1) = NSTAT IER = SIGN(1,N-1) * ENDIF * RETURN END