!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%% ***S/P SERSETC - INITIALISER LES CHAINES DE CARACTERE POUR LES SERIES TEMP.SUBROUTINE SERSETC (NOM,VALEUR,N,IER) 4 #include "impnone.cdk"
INTEGER N,IER CHARACTER *(*) NOM CHARACTER *8 VALEUR(N) * *Author * B. Bilodeau - Adaptation to UNIX (August 1992) * *Revision * 001 B. Bilodeau and G. Pellerin (Feb 94) - * No more reference to the zonal diagnostics package *Object * to initialize the character strings for time-series * *Arguments * * - Input - * NOM variable name to be initialized * VALEUR array containing the value to initialize the variable * N number of values to initialize * * - Output - * IER error code: * IER > 0, no error and code returns N * IER < 0, N is larger than the dimension of the variable * and code returns the maximum dimension of the variable * * *IMPLICITES * #include "sercmdk.cdk"
* * ** INTEGER I * IF (NOM .EQ. 'SURFACE') THEN NSURF = MIN(N,MXSRF) IF (NSURF.GT.NVAR) THEN WRITE(6,'(A)') 'TOO MANY SURFACE VARIABLES FOR TIME-SERIES' WRITE(6,1000) 'MAXIMUM : ',NVAR, ' REQUESTED : ',NSURF 1000 FORMAT(1X,A12,I4,A12,I4) CALL QQEXIT(1) ENDIF DO 10 I=1,NSURF SURFACE(I,1) (1:2) = VALEUR(I) (1:2) 10 CONTINUE IER = SIGN(MIN(N,MXSRF),MXSRF-N) * ELSE IF (NOM .EQ. 'PROFILS') THEN NPROF = MIN(N,MXPRF) IF (NPROF.GT.NVAR) THEN WRITE(6,'(A)') 'TOO MANY PROFILE VARIABLES FOR TIME-SERIES' WRITE(6,1000) 'MAXIMUM : ',NVAR, ' REQUESTED : ',NPROF CALL QQEXIT(1) ENDIF DO 20 I=1,NPROF PROFILS(I,1) (1:2) = VALEUR(I) (1:2) 20 CONTINUE IER = SIGN(MIN(N,MXPRF),MXPRF-N) * * ENDIF * RETURN * ***S/P SERGETC - OBTENIR LES VALEURS D'UNE VARIABLE DES SERIES TEMP. * ENTRY SERGETC(NOM,VALEUR,N,IER) * *Author * B. Bilodeau - Adaptation to UNIX (August 1992) * *Object * ENTRY SERGETC of SERSETC * to get the values for a time-series variable * *Arguments * * - Input - * NOM variable name to be initialized * VALEUR array containing the value to initialize the variable * N number of values to initialize * * - Output - * IER error code: * IER > 0, no error and code returns N * IER < 0, N is larger than the dimension of the variable * and code returns the maximum dimension of the variable * ** * * * INITIALISER IER ET VALEUR POUR DETECTER OPTION * INEXISTANTE QUI SERAIT DEMANDEE IER = 0 VALEUR (1) = ' ' * IF (NOM .EQ. 'SURFACE') THEN DO 50 I=1,NSURF VALEUR(I) (1:2) = SURFACE(I,1) (1:2) 50 CONTINUE IER = SIGN(NSURF,N-NSURF) * ELSE IF (NOM .EQ. 'PROFILS') THEN DO 60 I=1,NPROF VALEUR(I) (1:2) = PROFILS(I,1) (1:2) 60 CONTINUE IER = SIGN(NPROF,N-NPROF) * ENDIF * RETURN END