*=*=*=*= exner_new.html =*=*=*=*
SUBROUTINE exner_new(ngrid,pext,filtpks,pks,pksf) c IMPLICIT NONE c Auteurs : P.Le Van, F. Hourdin c c----------------------------------------------------------------------- c Calcule la fonction d'Exner pks = pnat ** kappa et eventuellement c pks filtre , si filtpks = . true. c----------------------------------------------------------------------- c declarations: c ------------- #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comgeom.h" #include "serre.h" c ............. Arguments ..................... c INTEGER ngrid REAL pext(ngrid),pks(ngrid),pksf(ngrid) LOGICAL filtpks c c c ........... Variables locales ...................... INTEGER ig REAL pksairen( iim ), pksaires( iim ), pkspoln, pkspols REAL SSUM EXTERNAL filtreg, SSUM c----------------------------------------------------------------------- DO 3 ig = 1,ngrid pks( ig ) = ( pext( ig )/ aire( ig ) ) ** kappa 3 CONTINUE c ..... P. Le Van ( ajout le 17/04/96 ) ....... c ..... Calcul de la valeur moyenne de pks aux poles ........ c IF( alphax.NE.0. ) THEN DO 4 ig = 1, iim pksairen( ig ) = pks( ig ) * aire( ig ) pksaires( ig ) = pks( ig+ ip1jm ) * aire( ig + ip1jm ) 4 CONTINUE pkspoln = SSUM( iim,pksairen,1 ) / apoln pkspols = SSUM( iim,pksaires,1 ) / apols DO 5 ig = 1, iip1 pks( ig ) = pkspoln pks( ig+ ip1jm ) = pkspols 5 CONTINUE ENDIF DO ig = 1, ngrid pksf( ig ) = pks ( ig ) ENDDO c IF ( filtpks ) THEN CALL filtreg ( pksf, jjp1, 1, 2, 1, .TRUE., 1 ) ENDIF RETURN END