!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- ! *DECKSUBROUTINE FEVOP ( PB, PA, PDS, PAA, PGAM, KN ) 1,4 #if defined (DOC) * ***s/r FEVOP: Sets the finite-element vertical structure operator * required by the variational analysis scheme and * compatible with the SEF model. * * Author : L. Fillion RPN/AES - Jun 93 * (based on Temperton's NEWVER for SEF model) * * Revision: L. Fillion ARMA/AES - Jan 97 * . NSIGLEV changed for NFLEV * * JM Belanger CMDA/SMC Sep 2000 * . 32 bits conversion * * Arguments * o PB : MATRIX REPRESENTING THE VERTICAL STRUCTURE OPERATOR * i PA : WORK ARRAY * i PDS : SIGMA INCREMENTS IN THE VERTICAL * i PAA : WORK ARRAY * i PGAM : ADIABATIC EXPONENT * i KN : DIMENSION OF MATRICES #endif IMPLICIT NONE *implicits #include "comdim.cdk"
#include "comode.cdk"
C INTEGER KN REAL*8 PA(KN,KN), PB(KN,KN), PDS(KN) REAL*8 PAA(KN,3), PGAM C INTEGER JL, JK REAL*8 ZSAUV *modules EXTERNAL MATOZ, MATPBSS, TRITOF, PROJEF * ** C C* 1. TERM -D ( S/GAM D( )/DS)/DS C --------------------------- C 100 CONTINUE CALL MATOZ
( PA, NFLEV, NFLEV, KN ) CALL MATPBSS
( PAA(1,1), PAA(1,2), PAA(1,3), PGAM, + 1.0D0, 1.0D0-ALPHA, NFLEV ) ZSAUV = PAA(1,1) PAA(KN,2) = PAA(KN,2) + PAA(KN,3) PAA(1,1) = 0.0 PAA(KN,3) = 0.0 DO 10 JL = 1, 3 DO 10 JK = 1, KN 10 PAA(JK,JL) = -PAA(JK,JL) CALL TRITOF
( PA, PAA, KN, KN, KN ) C C UPPER BOUNDARY CONDITION C ------------------------ PA(1,KN) = -ZSAUV C C* 2. PROJECTOR C --------- C 200 CONTINUE CALL PROJEF
( PB, PDS ) C C RETURN END