!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%%SUBROUTINE DIFUVD8 (SE, STAGE, S, NK, KA) 1 #include "impnone.cdk"
INTEGER NK, KA REAL SE(NK), S(NK), STAKA(KA-1,6), STAWS(NK-1,6) LOGICAL STAGE * INTEGER K, I LOGICAL INIT DATA INIT /.TRUE./ SAVE INIT * *Author * R. Benoit (Mar 89) * *Object * to calculate the centered sigma levels * *Arguments * * - Output - * SE sigma levels for ('E') * * - Input - * STAGE .TRUE. for 'E' (staggered) level intervals * S sigma levels * NK vertical dimension * KA level to extract * ** * 1000 CONTINUE * IF (STAGE) THEN * DO 1 K=1,KA-1 1 SE(K)=(S(K)+S(K+1))/2 DO 4 K=KA,NK 4 SE(K)=1 ELSE * DO 2 K=1,NK 2 SE(K)=S(K) ENDIF * IF (INIT) THEN * PRINT *,' S/R DIFUVD5...STAGE= ',STAGE PRINT '(3A10/(I10,2F10.6))' , 'K','S(K)','SE(K)', % (K,S(K),SE(K),K=1,NK) PRINT *,' KA=',KA,' NK=',NK IF (KA.LT.NK) PRINT *,' ' IF (KA.LT.NK) PRINT *,' ***************************' IF (KA.LT.NK) PRINT *,' * ANEMOMETRE 5M INACTIF *' IF (KA.LT.NK) PRINT *,' ***************************' IF (KA.LT.NK) PRINT *,' ' PRINT *,' RAPPORT DE CENTRAGE DU NIVEAU KA' PRINT *,' (1-S(KA))/(1-S(KA-1))=',(1-S(KA))/(1-S(KA-1)) INIT = .FALSE. ENDIF * RETURN * ENTRY DIFUVD5 (SE, STAKA, STAGE, S, STAWS, NK, KA) * *Author * R. Benoit (Mar 89) * *Object * ENTRY DIFUVD5 of DIFUVD8 * to calculate the centered sigma levels, SE * *Arguments * * - Output - * SE sigma levels for ('E') * STAKA contains the matrix of stabilization for WETCON * * - Input - * STAGE .TRUE. for 'E' (staggered) level intervals * S sigma levels * STAWS matrix of stabilization for WETCON * NK vertical dimension * KA level to extract * ** * DO 3 I=1,6 DO 3 K=1, KA-1 3 STAKA (K,I) = STAWS (K,I) GO TO 1000 * END