| [2336] | 1 | SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv ) |
|---|
| [524] | 2 | ! |
|---|
| [2336] | 3 | !------------------------------------------------------------------------------- |
|---|
| 4 | ! Authors: P. Le Van , Fr. Hourdin. |
|---|
| 5 | !------------------------------------------------------------------------------- |
|---|
| 6 | ! Purpose: Compute mass flux at s levels. |
|---|
| 7 | IMPLICIT NONE |
|---|
| 8 | include "dimensions.h" |
|---|
| 9 | include "paramet.h" |
|---|
| 10 | include "comgeom.h" |
|---|
| 11 | !=============================================================================== |
|---|
| 12 | ! Arguments: |
|---|
| 13 | REAL, INTENT(IN) :: massebx(ip1jmp1,llm) |
|---|
| 14 | REAL, INTENT(IN) :: masseby(ip1jm ,llm) |
|---|
| 15 | REAL, INTENT(IN) :: vcont (ip1jm ,llm) |
|---|
| 16 | REAL, INTENT(IN) :: ucont (ip1jmp1,llm) |
|---|
| 17 | REAL, INTENT(OUT) :: pbaru (ip1jmp1,llm) |
|---|
| 18 | REAL, INTENT(OUT) :: pbarv (ip1jm ,llm) |
|---|
| 19 | !=============================================================================== |
|---|
| 20 | ! Method used: A 2 equations system is solved. |
|---|
| 21 | ! * 1st one describes divergence computation at pole point nr. i (i=1 to im): |
|---|
| 22 | ! (0.5*(pbaru(i)-pbaru(i-1))-pbarv(i))/aire(i) = - SUM(pbarv(n))/aire pole |
|---|
| 23 | ! * 2nd one specifies that mean mass flux at pole is equal to 0: |
|---|
| 24 | ! SUM(pbaru(n)*local_area(n))=0 |
|---|
| 25 | ! This way, we determine additive constant common to pbary elements representing |
|---|
| 26 | ! pbaru(0,j,l) in divergence computation equation for point i=1. (i=1 to im) |
|---|
| 27 | !=============================================================================== |
|---|
| 28 | ! Local variables: |
|---|
| 29 | REAL :: sairen, saireun, ctn, ctn0, apbarun(iip1) |
|---|
| 30 | REAL :: saires, saireus, cts, cts0, apbarus(iip1) |
|---|
| 31 | INTEGER :: l, i |
|---|
| 32 | !=============================================================================== |
|---|
| 33 | DO l=1,llm |
|---|
| 34 | pbaru(iip2:ip1jm,l)=massebx(iip2:ip1jm,l)*ucont(iip2:ip1jm,l) |
|---|
| 35 | pbarv( 1:ip1jm,l)=masseby( 1:ip1jm,l)*vcont( 1:ip1jm,l) |
|---|
| 36 | END DO |
|---|
| [524] | 37 | |
|---|
| [2336] | 38 | !--- NORTH POLE |
|---|
| 39 | sairen =SUM(aire (1:iim)) |
|---|
| 40 | saireun=SUM(aireu(1:iim)) |
|---|
| 41 | DO l = 1,llm |
|---|
| 42 | ctn=SUM(pbarv(1:iim,l))/sairen |
|---|
| 43 | pbaru(1,l)= pbarv(1,l)-ctn*aire(1) |
|---|
| 44 | DO i=2,iim |
|---|
| 45 | pbaru(i,l)=pbaru(i-1,l)+pbarv(i,l)-ctn*aire(i) |
|---|
| 46 | END DO |
|---|
| 47 | DO i=1,iim |
|---|
| 48 | apbarun(i)=aireu(i)*pbaru(i,l) |
|---|
| 49 | END DO |
|---|
| 50 | ctn0 = -SUM(apbarun(1:iim))/saireun |
|---|
| 51 | DO i = 1,iim |
|---|
| 52 | pbaru(i,l)=2.*(pbaru(i,l)+ctn0) |
|---|
| 53 | END DO |
|---|
| 54 | pbaru(iip1,l)=pbaru(1,l) |
|---|
| 55 | END DO |
|---|
| [524] | 56 | |
|---|
| [2336] | 57 | !--- SOUTH POLE |
|---|
| 58 | saires =SUM(aire (ip1jm+1:ip1jmp1-1)) |
|---|
| 59 | saireus=SUM(aireu(ip1jm+1:ip1jmp1-1)) |
|---|
| 60 | DO l = 1,llm |
|---|
| 61 | cts=SUM(pbarv(ip1jmi1+1:ip1jm-1,l))/saires |
|---|
| 62 | pbaru(1+ip1jm,l)=-pbarv(1+ip1jmi1,l)+cts*aire(1+ip1jm) |
|---|
| 63 | DO i=2,iim |
|---|
| 64 | pbaru(i+ip1jm,l)=pbaru(i-1+ip1jm,l)-pbarv(i+ip1jmi1,l)+cts*aire(i+ip1jm) |
|---|
| 65 | END DO |
|---|
| 66 | DO i=1,iim |
|---|
| 67 | apbarus(i)=aireu(i+ip1jm)*pbaru(i+ip1jm,l) |
|---|
| 68 | END DO |
|---|
| 69 | cts0 = -SUM(apbarus(1:iim))/saireus |
|---|
| 70 | DO i = 1,iim |
|---|
| 71 | pbaru(i+ip1jm,l)=2.*(pbaru(i+ip1jm,l)+cts0) |
|---|
| 72 | END DO |
|---|
| 73 | pbaru(ip1jmp1,l)=pbaru(1+ip1jm,l) |
|---|
| 74 | END DO |
|---|
| [524] | 75 | |
|---|
| [2336] | 76 | END SUBROUTINE flumass |
|---|
