!-------------------------------------- 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 -------------------------------------- ***s/r e_genab2 - Using Laprise & Girard, generates de A and B of the * hybrid coordinate and the analytical derivative of * d(psurf*B)/d(A + psurf*B) *subroutine genab2 ( F_pia, F_pib, F_dpba, 1 $ F_eta, F_ptop, F_coef, F_psurf_8, fnk ) implicit none * integer fnk real F_pia(fnk), F_pib(fnk), F_dpba(fnk), F_eta(fnk), $ F_ptop, F_coef real*8 F_psurf_8 * *author * S. Gravel - rpn - feb 2003 * *revision * v3_03 - Gravel S. - initial MPI version * *object * Using Laprise & Girard, generates de A and B of the hybrid coordinate * see: Laprise & Girard, 1990, J. of Climate, eq. 5.1 * Based on subroutine genab, genab2 also includes the evaluation of the * analytical derivative of psurf*B with respect to Z * ** integer k real pref, psurf, pr1, pr2 * __________________________________________________________________ * * BEWARE * if F_coef is greater than 1., pref is subject to restriction for * stability reasons. * pref = 100.*F_ptop/F_eta(1) ! convert to pascal psurf= 100.*F_psurf_8 ! convert to pascal * pr1 = 1./(1. - F_eta(1)) do k = 1, fnk F_pib(k) = ((F_eta(k) - F_eta(1))*pr1 ) ** F_coef F_pia(k) = pref * ( F_eta(k) - F_pib(k) ) enddo * if (F_coef .gt. 1.0) then do k = 1,fnk pr2 = F_coef*(F_eta(k) - F_eta(1))**(F_coef-1.) F_dpba(k) = psurf*pr2/ $ (pref*(1. - F_eta(1))**F_coef + $ (psurf-pref)*pr2) enddo else do k = 1,fnk F_dpba(k) = psurf/(psurf - pref*F_eta(1)) enddo endif * __________________________________________________________________ * return end