Ignore:
Timestamp:
Mar 28, 2016, 5:27:51 PM (9 years ago)
Author:
emillour
Message:

All models: More updates to make planetary codes (+Earth) setups converge.

  • in dyn3d_common:
  • convmas.F => convmas.F90
  • enercin.F => enercin.F90
  • flumass.F => flumass.F90
  • massbar.F => massbar.F90
  • tourpot.F => tourpot.F90
  • vitvert.F => vitvert.F90
  • in misc:
  • move "q_sat" from "dyn3d_common" to "misc" (in Earth model, it is also called by the physics)
  • move "write_field" from "dyn3d_common" to "misc"(may be called from physics or dynamics and depends on neither).
  • in phy_common:
  • move "write_field_phy" here since it may be called from any physics package)
  • add module "regular_lonlat_mod" to store global information on lon-lat grid
  • in dynlonlat_phylonlat/phy*:
  • turn "iniphysiq.F90" into module "iniphysiq_mod.F90" (and of course adapt gcm.F[90] and 1D models accordingly)

EM

File:
1 moved

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/dyn3d_common/flumass.F90

    r1520 r1523  
     1SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
    12!
    2 ! $Header$
    3 !
    4       SUBROUTINE flumass (massebx,masseby, vcont, ucont, pbaru, pbarv )
     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
    537
    6       IMPLICIT NONE
     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
    756
    8 c=======================================================================
    9 c
    10 c   Auteurs:  P. Le Van, F. Hourdin  .
    11 c   -------
    12 c
    13 c   Objet:
    14 c   ------
    15 c
    16 c *********************************************************************
    17 c     .... calcul du flux de masse  aux niveaux s ......
    18 c *********************************************************************
    19 c   massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
    20 c       pbaru  et pbarv            sont des argum.de sortie pour le s-pg .
    21 c
    22 c=======================================================================
     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
    2375
    24 
    25 #include "dimensions.h"
    26 #include "paramet.h"
    27 #include "comgeom.h"
    28 
    29       REAL massebx( ip1jmp1,llm ),masseby( ip1jm,llm ) ,
    30      * vcont( ip1jm,llm ),ucont( ip1jmp1,llm ),pbaru( ip1jmp1,llm ),
    31      * pbarv( ip1jm,llm )
    32 
    33       REAL apbarun( iip1 ),apbarus( iip1 )
    34 
    35       REAL sairen,saireun,saires,saireus,ctn,cts,ctn0,cts0
    36       INTEGER  l,ij,i
    37 
    38       REAL       SSUM
    39 
    40 
    41       DO  5 l = 1,llm
    42 
    43       DO  1 ij = iip2,ip1jm
    44       pbaru( ij,l ) = massebx( ij,l ) * ucont( ij,l )
    45    1  CONTINUE
    46 
    47       DO 3 ij = 1,ip1jm
    48       pbarv( ij,l ) = masseby( ij,l ) * vcont( ij,l )
    49    3  CONTINUE
    50 
    51    5  CONTINUE
    52 
    53 c    ................................................................
    54 c     calcul de la composante du flux de masse en x aux poles .......
    55 c    ................................................................
    56 c     par la resolution d'1 systeme de 2 equations .
    57 
    58 c     la premiere equat.decrivant le calcul de la divergence en 1 point i
    59 c     du pole,ce calcul etant itere de i=1 a i=im .
    60 c                 c.a.d   ,
    61 c     ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i)   =
    62 c                                           - somme de ( pbarv(n) )/aire pole
    63 
    64 c     l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
    65 c     c.a.d    somme de pbaru(n)*aire locale(n) = 0.
    66 
    67 c     on en revient ainsi a determiner la constante additive commune aux pbaru
    68 c     qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
    69 c     i=1 .
    70 c     i variant de 1 a im
    71 c     n variant de 1 a im
    72 
    73       sairen = SSUM( iim,  aire(   1     ), 1 )
    74       saireun= SSUM( iim, aireu(   1     ), 1 )
    75       saires = SSUM( iim,  aire( ip1jm+1 ), 1 )
    76       saireus= SSUM( iim, aireu( ip1jm+1 ), 1 )
    77 
    78       DO 20 l = 1,llm
    79 
    80       ctn =  SSUM( iim, pbarv(    1     ,l),  1 )/ sairen
    81       cts =  SSUM( iim, pbarv(ip1jmi1+ 1,l),  1 )/ saires
    82 
    83       pbaru(    1   ,l )=   pbarv(    1     ,l ) - ctn * aire(    1    )
    84       pbaru( ip1jm+1,l )= - pbarv( ip1jmi1+1,l ) + cts * aire( ip1jm+1 )
    85 
    86       DO 11 i = 2,iim
    87       pbaru(    i    ,l ) = pbaru(   i - 1   ,l )    +
    88      *                      pbarv(    i      ,l ) - ctn * aire(   i    )
    89 
    90       pbaru( i+ ip1jm,l ) = pbaru( i+ ip1jm-1,l )    -
    91      *                      pbarv( i+ ip1jmi1,l ) + cts * aire(i+ ip1jm)
    92   11  CONTINUE
    93       DO 12 i = 1,iim
    94       apbarun(i) = aireu(    i   ) * pbaru(   i    , l)
    95       apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
    96   12  CONTINUE
    97       ctn0 = -SSUM( iim,apbarun,1 )/saireun
    98       cts0 = -SSUM( iim,apbarus,1 )/saireus
    99       DO 14 i = 1,iim
    100       pbaru(   i    , l) = 2. * ( pbaru(   i    , l) + ctn0 )
    101       pbaru(i+ ip1jm, l) = 2. * ( pbaru(i +ip1jm, l) + cts0 )
    102   14  CONTINUE
    103 
    104       pbaru(   iip1 ,l ) = pbaru(    1    ,l )
    105       pbaru( ip1jmp1,l ) = pbaru( ip1jm +1,l )
    106   20  CONTINUE
    107 
    108       RETURN
    109       END
     76END SUBROUTINE flumass
Note: See TracChangeset for help on using the changeset viewer.