Ignore:
Timestamp:
Jul 31, 2015, 7:22:21 PM (9 years ago)
Author:
dcugnet
Message:
  • Add parallel capability for ce0l.
  • Small bug in grid_noro fixed (smoothed topography was used instead of unsmoothed one for geopotential computation at north pole).
  • Removed average of mass at poles in etat0dyn_netcdf after start_init_dyn => different results in the zoomed grid case.
  • ok_etat0=n and ok_limit=y combination now works fine (if no initial state is needed, but only limit.nc file). This required:
    • to move grid_noro0 and start_init_noro0 subroutines from etat0dyn_netcdf.F90 to limit_netcdf.F90
    • to create init_ssrf_m.F90 file, so that sub-surfaces can be initialized from limit_netcdf.F90 without any etat0*_netcdf routines call).
  • Simplified somehow the corresponding code, in particular: 1) removed obsolete flags "oldice". 2) removed flag "ibar": barycentric interpolation is used everywhere (except in start_init_subsurf, still calling grille_m - to be changed soon). 3) removed useless CPP_PHY precompilation directives, considering the possibility to run ce0l without physics is useless (ce0l is dedicated to Earth physics).
Location:
LMDZ5/trunk/libf/dyn3dmem
Files:
1 deleted
9 moved

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3dmem/convmas1_loc.F90

    r2335 r2336  
    1       SUBROUTINE convmas1_loc (pbaru, pbarv, convm )
    2 c
    3       USE parallel_lmdz
    4       USE mod_filtreg_p
    5       IMPLICIT NONE
     1SUBROUTINE convmas1_loc (pbaru, pbarv, convm)
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , Fr. Hourdin.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute mass flux convergence at p levels.
     7!          Equivalent to convmas_loc if convmas2_loc is called after.
     8  USE parallel_lmdz
     9  USE mod_filtreg_p
     10  IMPLICIT NONE
     11  include "dimensions.h"
     12  include "paramet.h"
     13  include "comgeom.h"
     14  include "logic.h"
     15!===============================================================================
     16! Arguments:
     17  REAL, INTENT(IN)  :: pbaru(ijb_u:ije_u,llm)
     18  REAL, INTENT(IN)  :: pbarv(ijb_v:ije_v,llm)
     19  REAL, TARGET, INTENT(OUT) :: convm(ijb_u:ije_u,llm)
     20!===============================================================================
     21! Method used:   Computation from top to bottom.
     22!   Mass convergence at level llm is equal to zero and is not stored in convm.
     23!===============================================================================
     24! Local variables:
     25  INTEGER :: l, jjb, jje
     26!===============================================================================
    627
    7 c=======================================================================
    8 c
    9 c   Auteurs:  P. Le Van , F. Hourdin  .
    10 c   -------
    11 c
    12 c   Objet:
    13 c   ------
    14 c
    15 c   ********************************************************************
    16 c   .... calcul de la convergence du flux de masse aux niveaux p ...
    17 c   ********************************************************************
    18 c
    19 c
    20 c     pbaru  et  pbarv  sont des arguments d'entree pour le s-pg  ....
    21 c      .....  convm      est  un argument de sortie pour le s-pg  ....
    22 c
    23 c    le calcul se fait de haut en bas,
    24 c    la convergence de masse au niveau p(llm+1) est egale a 0. et
    25 c    n'est pas stockee dans le tableau convm .
    26 c
    27 c
    28 c=======================================================================
    29 c
    30 c   Declarations:
    31 c   -------------
     28!--- Computation of - (d(pbaru)/dx + d(pbarv)/dy )
     29  CALL convflu_loc( pbaru, pbarv, llm, convm )
    3230
    33 #include "dimensions.h"
    34 #include "paramet.h"
    35 #include "comvert.h"
    36 #include "logic.h"
     31!--- Filter
     32  jjb=jj_begin
     33  jje=jj_end+1
     34  IF(pole_sud) jje=jj_end
     35  CALL filtreg_p(convm,jjb_u,jje_u,jjb,jje,jjp1,llm,2,2,.TRUE.,1)
    3736
    38       REAL pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm )
    39       REAL, target :: convm(  ijb_u:ije_u,llm )
    40       INTEGER   l,ij
     37END SUBROUTINE convmas1_loc
    4138
    42       INTEGER ijb,ije,jjb,jje
    43  
    44      
    45 c-----------------------------------------------------------------------
    46 c    ....  calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ......
    47 
    48       CALL  convflu_loc( pbaru, pbarv, llm, convm )
    49 
    50 c-----------------------------------------------------------------------
    51 c   filtrage:
    52 c   ---------
    53        
    54        jjb=jj_begin
    55        jje=jj_end+1
    56        if (pole_sud) jje=jj_end
    57  
    58        CALL filtreg_p( convm, jjb_u,jje_u,jjb, jje, jjp1, llm,
    59      &                 2, 2, .true., 1 )
    60 
    61 c    integration de la convergence de masse de haut  en bas ......
    62 c
    63       RETURN
    64       END

  • LMDZ5/trunk/libf/dyn3dmem/convmas2_loc.F90

    r2335 r2336  
    1       SUBROUTINE convmas2_loc ( convm )
    2 c
    3       USE parallel_lmdz
    4       IMPLICIT NONE
     1SUBROUTINE convmas2_loc (convm)
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , Fr. Hourdin.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute mass flux convergence at p levels.
     7!          Equivalent to convmas_loc if convmas1_loc is called before.
     8  USE parallel_lmdz
     9  IMPLICIT NONE
     10  include "dimensions.h"
     11  include "paramet.h"
     12  include "comgeom.h"
     13  include "logic.h"
     14!===============================================================================
     15! Arguments:
     16  REAL, INTENT(INOUT) :: convm(ijb_u:ije_u,llm)
     17!===============================================================================
     18! Method used:   Computation from top to bottom.
     19!   Mass convergence at level llm is equal to zero and is not stored in convm.
     20!===============================================================================
     21! Local variables:
     22  INTEGER :: l, ijb, ije
     23!===============================================================================
    524
    6 c=======================================================================
    7 c
    8 c   Auteurs:  P. Le Van , F. Hourdin  .
    9 c   -------
    10 c
    11 c   Objet:
    12 c   ------
    13 c
    14 c   ********************************************************************
    15 c   .... calcul de la convergence du flux de masse aux niveaux p ...
    16 c   ********************************************************************
    17 c
    18 c
    19 c     pbaru  et  pbarv  sont des arguments d'entree pour le s-pg  ....
    20 c      .....  convm      est  un argument de sortie pour le s-pg  ....
    21 c
    22 c    le calcul se fait de haut en bas,
    23 c    la convergence de masse au niveau p(llm+1) est egale a 0. et
    24 c    n'est pas stockee dans le tableau convm .
    25 c
    26 c
    27 c=======================================================================
    28 c
    29 c   Declarations:
    30 c   -------------
     25!$OMP MASTER
     26!--- Mass convergence is integrated from top to bottom
     27  ijb=ij_begin
     28  ije=ij_end+iip1
     29  IF(pole_sud) ije=ij_end
     30  DO l=llmm1,1,-1
     31    convm(ijb:ije,l) = convm(ijb:ije,l) + convm(ijb:ije,l+1)
     32  END DO
     33!$OMP END MASTER
    3134
    32 #include "dimensions.h"
    33 #include "paramet.h"
    34 #include "comvert.h"
    35 #include "logic.h"
     35END SUBROUTINE convmas2_loc
    3636
    37       REAL pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm )
    38       REAL :: convm(  ijb_u:ije_u,llm )
    39       INTEGER   l,ij
    40       INTEGER ijb,ije,jjb,jje
    41  
    42 c$OMP MASTER
    43 c    integration de la convergence de masse de haut  en bas ......
    44        ijb=ij_begin
    45        ije=ij_end+iip1
    46        if (pole_sud) ije=ij_end
    47            
    48       DO      l      = llmm1, 1, -1
    49         DO    ij     = ijb, ije
    50          convm(ij,l) = convm(ij,l) + convm(ij,l+1)
    51         ENDDO
    52       ENDDO
    53 c
    54 c$OMP END MASTER
    55       RETURN
    56       END

  • LMDZ5/trunk/libf/dyn3dmem/convmas_loc.F90

    r2335 r2336  
    1       SUBROUTINE convmas_loc (pbaru, pbarv, convm )
    2 c
    3       USE parallel_lmdz
    4       USE mod_filtreg_p
    5       IMPLICIT NONE
     1SUBROUTINE convmas_loc (pbaru, pbarv, convm)
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , Fr. Hourdin.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute mass flux convergence at p levels.
     7  USE parallel_lmdz
     8  USE mod_filtreg_p
     9  IMPLICIT NONE
     10  include "dimensions.h"
     11  include "paramet.h"
     12  include "comgeom.h"
     13  include "logic.h"
     14!===============================================================================
     15! Arguments:
     16  REAL, INTENT(IN)  :: pbaru(ijb_u:ije_u,llm)
     17  REAL, INTENT(IN)  :: pbarv(ijb_v:ije_v,llm)
     18  REAL, INTENT(OUT) :: convm(ijb_u:ije_u,llm)
     19!===============================================================================
     20! Method used:   Computation from top to bottom.
     21!   Mass convergence at level llm is equal to zero and is not stored in convm.
     22!===============================================================================
     23! Local variables:
     24  INTEGER :: l, ijb, ije, jjb, jje
     25!===============================================================================
    626
    7 c=======================================================================
    8 c
    9 c   Auteurs:  P. Le Van , F. Hourdin  .
    10 c   -------
    11 c
    12 c   Objet:
    13 c   ------
    14 c
    15 c   ********************************************************************
    16 c   .... calcul de la convergence du flux de masse aux niveaux p ...
    17 c   ********************************************************************
    18 c
    19 c
    20 c     pbaru  et  pbarv  sont des arguments d'entree pour le s-pg  ....
    21 c      .....  convm      est  un argument de sortie pour le s-pg  ....
    22 c
    23 c    le calcul se fait de haut en bas,
    24 c    la convergence de masse au niveau p(llm+1) est egale a 0. et
    25 c    n'est pas stockee dans le tableau convm .
    26 c
    27 c
    28 c=======================================================================
    29 c
    30 c   Declarations:
    31 c   -------------
     27!--- Computation of - (d(pbaru)/dx + d(pbarv)/dy )
     28  CALL convflu_loc( pbaru, pbarv, llm, convm )
    3229
    33 #include "dimensions.h"
    34 #include "paramet.h"
    35 #include "comvert.h"
    36 #include "logic.h"
     30!--- Filter
     31  jjb=jj_begin
     32  jje=jj_end+1
     33  IF(pole_sud) jje=jj_end
     34  CALL filtreg_p(convm,jjb_u,jje_u,jjb,jje,jjp1,llm,2,2,.TRUE.,1)
    3735
    38       REAL pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm )
    39       REAL, target :: convm(  ijb_u:ije_u,llm )
    40       INTEGER   l,ij
    41 
    42       INTEGER ijb,ije,jjb,jje
    43  
    44      
    45 c-----------------------------------------------------------------------
    46 c    ....  calcul de - (d(pbaru)/dx + d(pbarv)/dy ) ......
    47 
    48       CALL  convflu_loc( pbaru, pbarv, llm, convm )
    49 
    50 c-----------------------------------------------------------------------
    51 c   filtrage:
    52 c   ---------
    53        
    54        jjb=jj_begin
    55        jje=jj_end+1
    56        if (pole_sud) jje=jj_end
    57  
    58        CALL filtreg_p(convm, jjb_u, jje_u,jjb, jje, jjp1, llm,
    59      &                 2, 2, .true., 1 )
    60 
    61 c    integration de la convergence de masse de haut  en bas ......
     36!--- Mass convergence is integrated from top to bottom
    6237!$OMP BARRIER
    6338!$OMP MASTER
    64        ijb=ij_begin
    65        ije=ij_end+iip1
    66        if (pole_sud) ije=ij_end
    67            
    68       DO      l      = llmm1, 1, -1
    69         DO    ij     = ijb, ije
    70          convm(ij,l) = convm(ij,l) + convm(ij,l+1)
    71         ENDDO
    72       ENDDO
    73 c
     39  ijb=ij_begin
     40  ije=ij_end+iip1
     41  IF(pole_sud) ije=ij_end
     42  DO l=llmm1,1,-1
     43    convm(ijb:ije,l) = convm(ijb:ije,l) + convm(ijb:ije,l+1)
     44  END DO
    7445!$OMP END MASTER
    7546!$OMP BARRIER
    76       RETURN
    77       END
     47
     48END SUBROUTINE convmas_loc
     49

  • LMDZ5/trunk/libf/dyn3dmem/enercin_loc.F90

    r2335 r2336  
    1       SUBROUTINE enercin_loc ( vcov, ucov, vcont, ucont, ecin )
    2       USE parallel_lmdz
    3       IMPLICIT NONE
     1SUBROUTINE enercin_loc ( vcov, ucov, vcont, ucont, ecin )
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute kinetic energy at sigma levels.
     7  USE parallel_lmdz
     8  IMPLICIT NONE
     9  include "dimensions.h"
     10  include "paramet.h"
     11  include "comgeom.h"
     12!===============================================================================
     13! Arguments:
     14  REAL, INTENT(IN)  :: vcov    (ijb_v:ije_v,llm)
     15  REAL, INTENT(IN)  :: ucov    (ijb_u:ije_u,llm)
     16  REAL, INTENT(IN)  :: vcont   (ijb_v:ije_v,llm)
     17  REAL, INTENT(IN)  :: ucont   (ijb_u:ije_u,llm)
     18  REAL, INTENT(OUT) :: ecin    (ijb_u:ije_u,llm)
     19!===============================================================================
     20! Notes:
     21!                 . V
     22!                i,j-1
     23!
     24!      alpha4 .       . alpha1
     25!
     26!
     27!        U .      . P     . U
     28!       i-1,j    i,j      i,j
     29!
     30!      alpha3 .       . alpha2
     31!
     32!
     33!                 . V
     34!                i,j
     35!
     36! Kinetic energy at scalar point P(i,j) (excluding poles) is:
     37!       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
     38!              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
     39!              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
     40!              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
     41!===============================================================================
     42! Local variables:
     43  INTEGER :: l, ij, i, ijb, ije
     44  REAL    :: ecinni(iim), ecinsi(iim), ecinpn, ecinps
     45!===============================================================================
     46!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     47  DO l=1,llm
    448
    5 c=======================================================================
    6 c
    7 c   Auteur: P. Le Van
    8 c   -------
    9 c
    10 c   Objet:
    11 c   ------
    12 c
    13 c *********************************************************************
    14 c .. calcul de l'energie cinetique aux niveaux s  ......
    15 c *********************************************************************
    16 c  vcov, vcont, ucov et ucont sont des arguments d'entree pour le s-pg .
    17 c  ecin         est  un  argument de sortie pour le s-pg
    18 c
    19 c=======================================================================
     49    ijb=ij_begin
     50    ije=ij_end+iip1
    2051
    21 #include "dimensions.h"
    22 #include "paramet.h"
    23 #include "comgeom.h"
     52    IF(pole_nord) ijb=ij_begin+iip1
     53    IF(pole_sud)  ije=ij_end-iip1
    2454
    25       REAL vcov( ijb_v:ije_v,llm ),vcont( ijb_v:ije_v,llm )
    26       REAL ucov( ijb_u:ije_u,llm ),ucont( ijb_u:ije_u,llm )
    27       REAL ecin( ijb_u:ije_u,llm )
     55    DO ij = ijb,ije-1
     56      ecin(ij+1,l)=0.5*(ucov(ij    ,l)*ucont(ij    ,l)*alpha3p4(ij +1)          &
     57                      + ucov(ij+1  ,l)*ucont(ij+1  ,l)*alpha1p2(ij +1)          &
     58                      + vcov(ij-iim,l)*vcont(ij-iim,l)*alpha1p4(ij +1)          &
     59                      + vcov(ij+1  ,l)*vcont(ij+1  ,l)*alpha2p3(ij +1) )
     60    END DO
    2861
    29       REAL ecinni( iip1 ),ecinsi( iip1 )
     62    !--- Correction: ecin(1,j,l)= ecin(iip1,j,l)
     63    DO ij=ijb,ije,iip1; ecin(ij,l) = ecin(ij+iim,l); END DO
    3064
    31       REAL ecinpn, ecinps
    32       INTEGER     l,ij,i,ijb,ije
     65    !--- North pole
     66    IF(pole_nord) THEN
     67      ecinni(:) = vcov(1:iim,l)*vcont(1:iim,l)*aire(1:iim)
     68      ecinpn = 0.5*SUM(ecinni)/apoln
     69      ecin(1:iip1,l)=ecinpn
     70    END IF
    3371
    34       EXTERNAL    SSUM
    35       REAL        SSUM
     72    !--- South pole
     73    IF(pole_sud) THEN
     74      DO i=1,iim
     75        ecinsi(i) = vcov(i+ip1jmi1,l)*vcont(i+ip1jmi1,l)*aire(i+ip1jm)
     76      END DO
     77      ecinps = 0.5*SUM(ecinsi)/apols
     78      ecin(1+ip1jm:ip1jmp1,l)=ecinps
     79    END IF
     80  END DO
     81!$OMP END DO NOWAIT
    3682
     83END SUBROUTINE enercin_loc
    3784
    38 
    39 c                 . V
    40 c                i,j-1
    41 
    42 c      alpha4 .       . alpha1
    43 
    44 
    45 c        U .      . P     . U
    46 c       i-1,j    i,j      i,j
    47 
    48 c      alpha3 .       . alpha2
    49 
    50 
    51 c                 . V
    52 c                i,j
    53 
    54 c   
    55 c  L'energie cinetique au point scalaire P(i,j) ,autre que les poles, est :
    56 c       Ecin = 0.5 * U(i-1,j)**2 *( alpha3 + alpha4 )  +
    57 c              0.5 * U(i  ,j)**2 *( alpha1 + alpha2 )  +
    58 c              0.5 * V(i,j-1)**2 *( alpha1 + alpha4 )  +
    59 c              0.5 * V(i,  j)**2 *( alpha2 + alpha3 )
    60 
    61 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    62       DO 5 l = 1,llm
    63      
    64       ijb=ij_begin
    65       ije=ij_end+iip1
    66      
    67       IF (pole_nord) ijb=ij_begin+iip1
    68       IF (pole_sud)  ije=ij_end-iip1
    69      
    70       DO 1  ij = ijb, ije -1
    71       ecin( ij+1, l )  =    0.5  *
    72      * (   ucov( ij   ,l ) * ucont( ij   ,l ) * alpha3p4( ij +1 )   +
    73      *     ucov( ij+1 ,l ) * ucont( ij+1 ,l ) * alpha1p2( ij +1 )   +
    74      *     vcov(ij-iim,l ) * vcont(ij-iim,l ) * alpha1p4( ij +1 )   +
    75      *     vcov( ij+ 1,l ) * vcont( ij+ 1,l ) * alpha2p3( ij +1 )   )
    76    1  CONTINUE
    77 
    78 c    ... correction pour  ecin(1,j,l)  ....
    79 c    ...   ecin(1,j,l)= ecin(iip1,j,l) ...
    80 
    81 CDIR$ IVDEP
    82       DO 2 ij = ijb, ije, iip1
    83       ecin( ij,l ) = ecin( ij + iim, l )
    84    2  CONTINUE
    85 
    86 c     calcul aux poles  .......
    87 
    88       IF (pole_nord) THEN
    89    
    90         DO  i = 1, iim
    91          ecinni(i) = vcov(    i  ,  l) *
    92      *               vcont(    i    ,l) * aire(   i   )
    93         ENDDO
    94 
    95         ecinpn = 0.5 * SSUM( iim,ecinni,1 ) / apoln
    96 
    97         DO ij = 1,iip1
    98           ecin(   ij     , l ) = ecinpn
    99         ENDDO
    100    
    101       ENDIF
    102 
    103       IF (pole_sud) THEN
    104    
    105         DO  i = 1, iim
    106          ecinsi(i) = vcov(i+ip1jmi1,l)*
    107      *               vcont(i+ip1jmi1,l) * aire(i+ip1jm)
    108         ENDDO
    109 
    110         ecinps = 0.5 * SSUM( iim,ecinsi,1 ) / apols
    111 
    112         DO ij = 1,iip1
    113           ecin( ij+ ip1jm, l ) = ecinps
    114         ENDDO
    115    
    116       ENDIF
    117 
    118      
    119    5  CONTINUE
    120 c$OMP END DO NOWAIT
    121       RETURN
    122       END

  • LMDZ5/trunk/libf/dyn3dmem/flumass_loc.F90

    r2335 r2336  
    1       SUBROUTINE flumass_loc(massebx,masseby,vcont,ucont,pbaru,pbarv)
    2       USE parallel_lmdz
    3       IMPLICIT NONE
     1SUBROUTINE flumass_loc(massebx,masseby, vcont, ucont, pbaru, pbarv )
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , Fr. Hourdin.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute mass flux at s levels.
     7  USE parallel_lmdz
     8  IMPLICIT NONE
     9  include "dimensions.h"
     10  include "paramet.h"
     11  include "comgeom.h"
     12!===============================================================================
     13! Arguments:
     14  REAL, INTENT(IN)  :: massebx(ijb_u:ije_u,llm)
     15  REAL, INTENT(IN)  :: masseby(ijb_v:ije_v,llm)
     16  REAL, INTENT(IN)  :: vcont  (ijb_v:ije_v,llm)
     17  REAL, INTENT(IN)  :: ucont  (ijb_u:ije_u,llm)
     18  REAL, INTENT(OUT) :: pbaru  (ijb_u:ije_u,llm)
     19  REAL, INTENT(OUT) :: pbarv  (ijb_v:ije_v,llm)
     20!===============================================================================
     21! Method used:   A 2 equations system is solved.
     22!   * 1st one describes divergence computation at pole point nr. i (i=1 to im):
     23!     (0.5*(pbaru(i)-pbaru(i-1))-pbarv(i))/aire(i) = - SUM(pbarv(n))/aire pole
     24!   * 2nd one specifies that mean mass flux at pole is equal to 0:
     25!     SUM(pbaru(n)*local_area(n))=0
     26! This way, we determine additive constant common to pbary elements representing
     27!   pbaru(0,j,l) in divergence computation equation for point i=1. (i=1 to im)
     28!===============================================================================
     29! Local variables:
     30  REAL    :: sairen, saireun, ctn, ctn0, apbarun(iim)
     31  REAL    :: saires, saireus, cts, cts0, apbarus(iim)
     32  INTEGER :: l, i, ij, ijb, ije
     33!===============================================================================
     34!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     35  DO l=1,llm
    436
    5 c=======================================================================
    6 c
    7 c   Auteurs:  P. Le Van, F. Hourdin  .
    8 c   -------
    9 c
    10 c   Objet:
    11 c   ------
    12 c
    13 c *********************************************************************
    14 c     .... calcul du flux de masse  aux niveaux s ......
    15 c *********************************************************************
    16 c   massebx,masseby,vcont et ucont sont des argum. d'entree pour le s-pg .
    17 c       pbaru  et pbarv            sont des argum.de sortie pour le s-pg .
    18 c
    19 c=======================================================================
     37    ijb=ij_begin
     38    ije=ij_end+iip1
     39    IF(pole_nord) ijb=ij_begin+iip1
     40    IF(pole_sud)  ije=ij_end-iip1
     41    pbaru(ijb:ije,l)=massebx(ijb:ije,l)*ucont(ijb:ije,l)
    2042
     43    ijb=ij_begin-iip1
     44    ije=ij_end+iip1
     45    IF(pole_nord) ijb=ij_begin
     46    IF(pole_sud)  ije=ij_end-iip1
     47    pbarv(ijb:ije,l)=masseby(ijb:ije,l)*vcont(ijb:ije,l)
    2148
    22 #include "dimensions.h"
    23 #include "paramet.h"
    24 #include "comgeom.h"
     49  END DO
     50!$OMP END DO NOWAIT
    2551
    26       REAL massebx( ijb_u:ije_u,llm ),masseby( ijb_v:ije_v,llm ) ,
    27      * vcont( ijb_v:ije_v,llm ),ucont( ijb_u:ije_u,llm ),
    28      * pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm )
     52  !--- North pole
     53  IF(pole_nord) THEN
     54    sairen =SUM(aire (1:iim))
     55    saireun=SUM(aireu(1:iim))
     56!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     57    DO l=1,llm
     58      ctn=SUM(pbarv(1:iim,l))/sairen
     59      pbaru(1,l)= pbarv(1,l)-ctn*aire(1)
     60      DO i=2,iim
     61        pbaru(i,l)=pbaru(i-1,l)+pbarv(i,l)-ctn*aire(i)
     62      END DO
     63      apbarun(:)=aireu(1:iim)*pbaru(1:iim,l)
     64      ctn0 = -SUM(apbarun)/saireun
     65      pbaru(1:iim,l)=2.*(pbaru(1:iim,l)+ctn0)
     66      pbaru(iip1,l)=pbaru(1,l)
     67    END DO
     68!$OMP END DO NOWAIT             
     69  END IF
    2970
    30       REAL apbarun( iip1 ),apbarus( iip1 )
     71  !--- South pole
     72  IF(pole_sud) THEN
     73    saires =SUM(aire (ip1jm+1:ip1jmp1-1))
     74    saireus=SUM(aireu(ip1jm+1:ip1jmp1-1))
     75!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     76    DO l=1,llm
     77      cts=SUM(pbarv(1+ip1jmi1:ip1jm-1,l))/saires
     78      pbaru(1+ip1jm,l)=-pbarv(1+ip1jmi1,l)+cts*aire(1+ip1jm)
     79      DO i=2,iim
     80        pbaru(i+ip1jm,l)=pbaru(i-1+ip1jm,l)-pbarv(i+ip1jmi1,l)+cts*aire(i+ip1jm)
     81      END DO
     82      apbarus(:)=aireu(1+ip1jm:ip1jmp1-1)*pbaru(1+ip1jm:ip1jmp1-1,l)
     83      cts0 = -SUM(apbarus)/saireus
     84      pbaru(1+ip1jm:ip1jmp1-1,l)=2.*(pbaru(1+ip1jm:ip1jmp1-1,l)+cts0)
     85      pbaru(ip1jmp1,l)=pbaru(1+ip1jm,l)
     86    END DO
     87!$OMP END DO NOWAIT         
     88  END IF
    3189
    32       REAL sairen,saireun,saires,saireus,ctn,cts,ctn0,cts0
    33       INTEGER  l,ij,i
    34       INTEGER ijb,ije
    35      
    36       EXTERNAL   SSUM
    37       REAL       SSUM
    38      
    39 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    40       DO  5 l = 1,llm
     90END SUBROUTINE flumass_loc
    4191
    42         ijb=ij_begin
    43         ije=ij_end+iip1
    44      
    45         if (pole_nord) ijb=ij_begin+iip1
    46         if (pole_sud)  ije=ij_end-iip1
    47        
    48         DO  1 ij = ijb,ije
    49           pbaru( ij,l ) = massebx( ij,l ) * ucont( ij,l )
    50    1    CONTINUE
    51 
    52         ijb=ij_begin-iip1
    53         ije=ij_end+iip1
    54      
    55         if (pole_nord) ijb=ij_begin
    56         if (pole_sud)  ije=ij_end-iip1
    57        
    58         DO 3 ij = ijb,ije
    59           pbarv( ij,l ) = masseby( ij,l ) * vcont( ij,l )
    60    3    CONTINUE
    61 
    62    5  CONTINUE
    63 c$OMP END DO NOWAIT
    64 c    ................................................................
    65 c     calcul de la composante du flux de masse en x aux poles .......
    66 c    ................................................................
    67 c     par la resolution d'1 systeme de 2 equations .
    68 
    69 c     la premiere equat.decrivant le calcul de la divergence en 1 point i
    70 c     du pole,ce calcul etant itere de i=1 a i=im .
    71 c                 c.a.d   ,
    72 c     ( ( 0.5*pbaru(i)-0.5*pbaru(i-1) - pbarv(i))/aire(i)   =
    73 c                                           - somme de ( pbarv(n) )/aire pole
    74 
    75 c     l'autre equat.specifiant que la moyenne du flux de masse au pole est =0.
    76 c     c.a.d    somme de pbaru(n)*aire locale(n) = 0.
    77 
    78 c     on en revient ainsi a determiner la constante additive commune aux pbaru
    79 c     qui representait pbaru(0,j,l) dans l'equat.du calcul de la diverg.au pt
    80 c     i=1 .
    81 c     i variant de 1 a im
    82 c     n variant de 1 a im
    83 
    84       IF (pole_nord) THEN
    85      
    86         sairen = SSUM( iim,  aire(   1     ), 1 )
    87         saireun= SSUM( iim, aireu(   1     ), 1 )
    88 
    89 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    90         DO l = 1,llm
    91  
    92           ctn =  SSUM( iim, pbarv(    1     ,l),  1 )/ sairen
    93      
    94           pbaru(1,l)=pbarv(1,l) - ctn * aire(1)
    95        
    96           DO i = 2,iim
    97             pbaru(i,l) = pbaru(i- 1,l )    +
    98      *                   pbarv(i,l) - ctn * aire(i )
    99           ENDDO
    100        
    101           DO i = 1,iim
    102             apbarun(i) = aireu(    i   ) * pbaru(   i    , l)
    103           ENDDO
    104      
    105           ctn0 = -SSUM( iim,apbarun,1 )/saireun
    106        
    107           DO i = 1,iim
    108             pbaru(   i    , l) = 2. * ( pbaru(   i    , l) + ctn0 )
    109           ENDDO
    110        
    111           pbaru(   iip1 ,l ) = pbaru(    1    ,l )
    112        
    113         ENDDO
    114 c$OMP END DO NOWAIT             
    115 
    116       ENDIF
    117 
    118      
    119       IF (pole_sud) THEN
    120  
    121         saires = SSUM( iim,  aire( ip1jm+1 ), 1 )
    122         saireus= SSUM( iim, aireu( ip1jm+1 ), 1 )
    123 
    124 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    125         DO  l = 1,llm
    126  
    127           cts =  SSUM( iim, pbarv(ip1jmi1+ 1,l),  1 )/ saires
    128           pbaru(ip1jm+1,l)= - pbarv(ip1jmi1+1,l) + cts * aire(ip1jm+1)
    129    
    130           DO i = 2,iim
    131             pbaru(i+ ip1jm,l) = pbaru(i+ip1jm-1,l)    -
    132      *                          pbarv(i+ip1jmi1,l)+cts*aire(i+ip1jm)
    133           ENDDO
    134        
    135           DO i = 1,iim
    136             apbarus(i) = aireu(i +ip1jm) * pbaru(i +ip1jm, l)
    137           ENDDO
    138 
    139           cts0 = -SSUM( iim,apbarus,1 )/saireus
    140 
    141           DO i = 1,iim
    142             pbaru(i+ ip1jm, l) = 2. * ( pbaru(i +ip1jm, l) + cts0 )
    143           ENDDO
    144 
    145           pbaru( ip1jmp1,l ) = pbaru( ip1jm +1,l )
    146        
    147         ENDDO
    148 c$OMP END DO NOWAIT         
    149       ENDIF
    150      
    151       RETURN
    152       END

  • LMDZ5/trunk/libf/dyn3dmem/massbar_loc.F90

    r2335 r2336  
    1       SUBROUTINE massbar_loc(  masse, massebx, masseby )
    2      
    3 c
    4 c **********************************************************************
    5 c
    6 c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
    7 c **********************************************************************
    8 c    Auteurs : P. Le Van , Fr. Hourdin  .
    9 c   ..........
    10 c
    11 c  ..  masse                 est  un argum. d'entree  pour le s-pg ...
    12 c  ..  massebx,masseby      sont des argum. de sortie pour le s-pg ...
    13 c     
    14 c
    15       USE parallel_lmdz
    16       IMPLICIT NONE
    17 c
    18 #include "dimensions.h"
    19 #include "paramet.h"
    20 #include "comconst.h"
    21 #include "comgeom.h"
    22 c
    23       REAL    masse( ijb_u:ije_u,llm ), massebx( ijb_u:ije_u,llm )  ,
    24      *      masseby(   ijb_v:ije_v,llm )
    25       INTEGER ij,l,ijb,ije
    26 c
    27 c
    28 c   Methode pour calculer massebx et masseby .
    29 c   ----------------------------------------
    30 c
    31 c    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
    32 c       alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
    33 c       alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
    34 c       alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
    35 c       alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
    36 c
    37 c    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)       
    38 c
    39 c    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
    40 c
    41 c
    42 c
    43 c   alpha4 .         . alpha1    . alpha4
    44 c    (i,j)             (i,j)       (i+1,j)
    45 c
    46 c             P .        U .          . P
    47 c           (i,j)       (i,j)         (i+1,j)
    48 c
    49 c   alpha3 .         . alpha2    .alpha3
    50 c    (i,j)              (i,j)     (i+1,j)
    51 c
    52 c             V .        Z .          . V
    53 c           (i,j)
    54 c
    55 c   alpha4 .         . alpha1    .alpha4
    56 c   (i,j+1)            (i,j+1)   (i+1,j+1)
    57 c
    58 c             P .        U .          . P
    59 c          (i,j+1)                    (i+1,j+1)
    60 c
    61 c
    62 c
    63 c                       On  a :
    64 c
    65 c    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
    66 c                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
    67 c     localise  au point  ... U (i,j) ...
    68 c
    69 c    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
    70 c                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
    71 c     localise  au point  ... V (i,j) ...
    72 c
    73 c
    74 c=======================================================================
    75      
    76      
    77      
    78 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
    79       DO   100    l = 1 , llm
    80 c
    81         ijb=ij_begin
    82         ije=ij_end+iip1
    83         if (pole_sud) ije=ije-iip1
    84        
    85         DO  ij = ijb, ije - 1
    86          massebx(ij,l) =  masse( ij, l) * alpha1p2( ij  )     +
    87      *                   masse(ij+1, l) * alpha3p4(ij+1 )
    88         ENDDO
     1SUBROUTINE massbar_loc(masse,massebx,masseby)
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , Fr. Hourdin.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute air mass mean along X and Y in each cell.
     7! See iniconst for more details.
     8  USE parallel_lmdz
     9  IMPLICIT NONE
     10  include "dimensions.h"
     11  include "paramet.h"
     12  include "comgeom.h"
     13!===============================================================================
     14! Arguments:
     15  REAL, INTENT(IN)  :: masse  (ijb_u:ije_u,llm)
     16  REAL, INTENT(OUT) :: massebx(ijb_u:ije_u,llm)
     17  REAL, INTENT(OUT) :: masseby(ijb_v:ije_v,llm)
     18!-------------------------------------------------------------------------------
     19! Method used. Each scalar point is associated to 4 area coefficients:
     20!    * alpha1(i,j) at point ( i+1/4,j-1/4 )
     21!    * alpha2(i,j) at point ( i+1/4,j+1/4 )
     22!    * alpha3(i,j) at point ( i-1/4,j+1/4 )
     23!    * alpha4(i,j) at point ( i-1/4,j-1/4 )
     24! where alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
     25!
     26!   alpha4 .         . alpha1    . alpha4
     27!    (i,j)             (i,j)       (i+1,j)
     28!
     29!             P .        U .          . P
     30!           (i,j)       (i,j)         (i+1,j)
     31!
     32!   alpha3 .         . alpha2    .alpha3
     33!    (i,j)              (i,j)     (i+1,j)
     34!
     35!             V .        Z .          . V
     36!           (i,j)
     37!
     38!   alpha4 .         . alpha1    .alpha4
     39!   (i,j+1)            (i,j+1)   (i+1,j+1)
     40!
     41!             P .        U .          . P
     42!          (i,j+1)                    (i+1,j+1)
     43!
     44!
     45!    massebx(i,j) = masse(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))   +
     46!                   masse(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
     47!     localized at point  ... U (i,j) ...
     48!
     49!    masseby(i,j) = masse(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )  +
     50!                   masse(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1) 
     51!     localized at point  ... V (i,j) ...
     52!===============================================================================
     53! Local variables:
     54  INTEGER :: ij, l, ijb, ije
     55!===============================================================================
     56!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
     57  DO l=1,llm
     58    ijb=ij_begin
     59    ije=ij_end+iip1
     60    IF(pole_sud) ije=ije-iip1
     61    DO ij=ijb,ije-1
     62      massebx(ij,l)=masse(ij,l)*alpha1p2(ij)+masse(ij+1   ,l)*alpha3p4(ij+1)
     63    END DO
     64    DO ij=ijb+iim,ije+iim,iip1; massebx(ij,l)=massebx(ij-iim,l); END DO
     65    ijb=ij_begin-iip1
     66    ije=ij_end+iip1
     67    IF(pole_nord) ijb=ij_begin
     68    IF(pole_sud) ije=ij_end-iip1
     69    DO ij=ijb,ije
     70      masseby(ij,l)=masse(ij,l)*alpha2p3(ij)+masse(ij+iip1,l)*alpha1p4(ij+iip1)
     71    END DO
     72  END DO
     73!$OMP END DO NOWAIT
    8974
    90 c    .... correction pour massebx( iip1,j) .....
    91 c    ...    massebx(iip1,j)= massebx(1,j) ...
    92 c
    93 CDIR$ IVDEP
     75END SUBROUTINE massbar_loc
    9476
    95        
    96 
    97         DO  ij = ijb+iim, ije+iim, iip1
    98          massebx( ij,l ) = massebx( ij - iim,l )
    99         ENDDO
    100 
    101 
    102      
    103         ijb=ij_begin-iip1
    104         ije=ij_end+iip1
    105         if (pole_nord) ijb=ij_begin
    106         if (pole_sud) ije=ij_end-iip1
    107 
    108          DO  ij = ijb,ije
    109          masseby( ij,l ) = masse(  ij   , l ) * alpha2p3(   ij    )  +
    110      *                     masse(ij+iip1, l ) * alpha1p4( ij+iip1 )
    111          ENDDO
    112 
    113 100   CONTINUE
    114 c$OMP END DO NOWAIT
    115 c
    116       RETURN
    117       END

  • LMDZ5/trunk/libf/dyn3dmem/massbarxy_loc.F90

    r2335 r2336  
    1       SUBROUTINE massbarxy_loc(  masse, massebxy )
    2       USE parallel_lmdz
    3       implicit none
    4 c **********************************************************************
    5 c
    6 c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
    7 c **********************************************************************
    8 c    Auteurs : P. Le Van , Fr. Hourdin  .
    9 c   ..........
    10 c
    11 c  ..  masse          est  un  argum. d'entree  pour le s-pg ...
    12 c  ..  massebxy       est  un  argum. de sortie pour le s-pg ...
    13 c     
    14 c
    15 c     IMPLICIT NONE
    16 c
    17 #include "dimensions.h"
    18 #include "paramet.h"
    19 #include "comconst.h"
    20 #include "comgeom.h"
    21 c
    22        REAL  masse( ijb_u:ije_u,llm ), massebxy( ijb_v:ije_v,llm )
    23 c
    24       INTEGER ij,l,ijb,ije
     1SUBROUTINE massbarxy_loc(masse,massebxy)
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , Fr. Hourdin.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute air mass mean along X and Y in each cell.
     7! See iniconst for more details.
     8  USE parallel_lmdz
     9  IMPLICIT NONE
     10  include "dimensions.h"
     11  include "paramet.h"
     12  include "comconst.h"
     13  include "comgeom.h"
     14!===============================================================================
     15! Arguments:
     16  REAL, INTENT(IN)  :: masse   (ijb_u:ije_u,llm)
     17  REAL, INTENT(OUT) :: massebxy(ijb_v:ije_v,llm)
     18!===============================================================================
     19! Local variables:
     20  INTEGER :: ij, l, ijb, ije
     21!===============================================================================
     22  ijb=ij_begin-iip1
     23  ije=ij_end
     24  IF(pole_nord) ijb=ijb+iip1
     25  IF(pole_sud)  ije=ije-iip1
     26!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     27  DO l=1,llm
     28    DO ij=ijb,ije-1
     29      massebxy(ij,l)=masse(ij     ,l)*alpha2(ij     ) + &
     30     +               masse(ij+1   ,l)*alpha3(ij+1   ) + &
     31     +               masse(ij+iip1,l)*alpha1(ij+iip1) + &
     32     +               masse(ij+iip2,l)*alpha4(ij+iip2)
     33    END DO
     34    DO ij=ijb+iip1-1,ije+iip1-1,iip1; massebxy(ij,l)=massebxy(ij-iim,l); END DO
     35  END DO
     36!$OMP END DO NOWAIT
    2537
    26      
    27       ijb=ij_begin-iip1
    28       ije=ij_end
    29      
    30       if (pole_nord) ijb=ijb+iip1
    31       if (pole_sud)  ije=ije-iip1
     38END SUBROUTINE massbarxy_loc
    3239
    33 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    34       DO   100    l = 1 , llm
    35 c
    36       DO 5 ij = ijb, ije - 1
    37       massebxy( ij,l ) = masse(    ij  ,l ) * alpha2(   ij    )   +
    38      +                   masse(   ij+1 ,l ) * alpha3(  ij+1   )   +
    39      +                   masse( ij+iip1,l ) * alpha1( ij+iip1 )   +
    40      +                   masse( ij+iip2,l ) * alpha4( ij+iip2 )
    41    5  CONTINUE
    42 
    43 c    ....  correction pour     massebxy( iip1,j )  ........
    44 
    45 CDIR$ IVDEP
    46 
    47       DO 7 ij = ijb+iip1-1, ije+iip1-1, iip1
    48       massebxy( ij,l ) = massebxy( ij - iim,l )
    49    7  CONTINUE
    50 
    51 100   CONTINUE
    52 c$OMP END DO NOWAIT
    53 c
    54       RETURN
    55       END

  • LMDZ5/trunk/libf/dyn3dmem/tourpot_loc.F90

    r2335 r2336  
    1       SUBROUTINE tourpot_loc ( vcov, ucov, massebxy, vorpot )
    2       USE parallel_lmdz
    3       USE mod_filtreg_p
    4       IMPLICIT NONE
     1SUBROUTINE tourpot_loc ( vcov, ucov, massebxy, vorpot )
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute potential vorticity.
     7  USE parallel_lmdz
     8  USE mod_filtreg_p
     9  IMPLICIT NONE
     10  include "dimensions.h"
     11  include "paramet.h"
     12  include "comgeom.h"
     13  include "logic.h"
     14!===============================================================================
     15! Arguments:
     16  REAL, INTENT(IN)  :: vcov    (ijb_v:ije_v,llm)
     17  REAL, INTENT(IN)  :: ucov    (ijb_u:ije_u,llm)
     18  REAL, INTENT(IN)  :: massebxy(ijb_v:ije_v,llm)
     19  REAL, INTENT(OUT) :: vorpot  (ijb_v:ije_v,llm)
     20!===============================================================================
     21! Method used:
     22!   vorpot = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) /psbarxy
     23!===============================================================================
     24! Local variables:
     25  INTEGER :: l, ij, ije, ijb, jje, jjb
     26  REAL    :: rot(ijb_v:ije_v,llm)
     27!===============================================================================
    528
    6 c=======================================================================
    7 c
    8 c   Auteur:  P. Le Van
    9 c   -------
    10 c
    11 c   Objet:
    12 c   ------
    13 c
    14 c    *******************************************************************
    15 c    .........      calcul du tourbillon potentiel             .........
    16 c    *******************************************************************
    17 c
    18 c     vcov,ucov,fext et pbarxyfl sont des argum. d'entree pour le s-pg .
    19 c             vorpot            est  un argum.de sortie pour le s-pg .
    20 c
    21 c=======================================================================
     29  ijb=ij_begin-iip1
     30  ije=ij_end
     31  IF(pole_nord) ijb=ij_begin
    2232
    23 #include "dimensions.h"
    24 #include "paramet.h"
    25 #include "comgeom.h"
    26 #include "logic.h"
     33!--- Wind vorticity ; correction: rot(iip1,j,l) = rot(1,j,l)
     34!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     35  DO l=1,llm
     36    IF(pole_sud) ije=ij_end-iip1-1
     37    DO ij=ijb,ije
     38      rot(ij,l)=vcov(ij+1,l)-vcov(ij,l)+ucov(ij+iip1,l)-ucov(ij,l)
     39    END DO
     40    IF(pole_sud) ije=ij_end-iip1
     41    DO ij=ijb+iip1-1,ije,iip1; rot(ij,l)=rot(ij-iim,l); END DO
     42  END DO
     43!$OMP END DO NOWAIT
    2744
    28       REAL  rot( ijb_v:ije_v,llm )
    29       REAL vcov( ijb_v:ije_v,llm ),ucov( ijb_u:ije_u,llm )
    30       REAL massebxy( ijb_v:ije_v,llm ),vorpot( ijb_v:ije_v,llm )
     45!--- Filter
     46  jjb=jj_begin-1
     47  jje=jj_end
     48  IF(pole_nord) jjb=jjb+1
     49  IF(pole_sud)  jje=jje-1
     50  CALL filtreg_p(rot,jjb_v,jje_v,jjb,jje,jjm,llm,2,1,.FALSE.,1)
    3151
    32       INTEGER l, ij ,ije,ijb,jje,jjb
     52!--- Potential vorticity ; correction: rot(iip1,j,l) = rot(1,j,l)
     53!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     54  DO l=1,llm
     55    IF(pole_sud) ije=ij_end-iip1-1
     56    DO ij=ijb,ije
     57      vorpot(ij,l)=(rot(ij,l)+fext(ij))/massebxy(ij,l)
     58    END DO
     59    IF(pole_sud) ije=ij_end-iip1
     60    DO ij=ijb+iip1-1,ije,iip1; vorpot(ij,l)=vorpot(ij-iim,l); END DO
     61  END DO
     62!$OMP END DO NOWAIT
    3363
     64END SUBROUTINE tourpot_loc
    3465
    35       ijb=ij_begin-iip1
    36       ije=ij_end
    37      
    38       if (pole_nord) ijb=ij_begin
    39      
    40      
    41 c  ... vorpot = ( Filtre( d(vcov)/dx - d(ucov)/dy ) + fext ) /psbarxy ..
    42 
    43 
    44 
    45 c    ........  Calcul du rotationnel du vent V  puis filtrage  ........
    46 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    47       DO 5 l = 1,llm
    48 
    49       if (pole_sud)  ije=ij_end-iip1-1
    50       DO 2 ij = ijb, ije
    51       rot( ij,l ) = vcov(ij+1,l)-vcov(ij,l)+ucov(ij+iip1,l)-ucov(ij,l)
    52    2  CONTINUE
    53 
    54 c    ....  correction pour  rot( iip1,j,l )  .....
    55 c    ....     rot(iip1,j,l) = rot(1,j,l)    .....
    56 
    57 CDIR$ IVDEP
    58 
    59       if (pole_sud)  ije=ij_end-iip1
    60      
    61       DO 3 ij = ijb+iip1-1, ije, iip1
    62       rot( ij,l ) = rot( ij -iim, l )
    63    3  CONTINUE
    64 
    65    5  CONTINUE
    66 c$OMP END DO NOWAIT
    67       jjb=jj_begin-1
    68       jje=jj_end
    69      
    70       if (pole_nord) jjb=jjb+1
    71       if (pole_sud)  jje=jje-1
    72       CALL  filtreg_p( rot, jjb_v,jje_v,jjb,jje,jjm, llm,
    73      &                 2, 1, .FALSE., 1 )
    74 
    75 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    76       DO 10 l = 1, llm
    77      
    78       if (pole_sud)  ije=ij_end-iip1-1 
    79      
    80       DO 6 ij = ijb, ije
    81       vorpot( ij,l ) = ( rot(ij,l) + fext(ij) ) / massebxy(ij,l)
    82    6  CONTINUE
    83 
    84 c    ..... correction pour  vorpot( iip1,j,l)  .....
    85 c    ....   vorpot(iip1,j,l)= vorpot(1,j,l) ....
    86 CDIR$ IVDEP
    87       if (pole_sud)  ije=ij_end-iip1
    88       DO 8 ij = ijb+iip1-1, ije, iip1
    89       vorpot( ij,l ) = vorpot( ij -iim,l )
    90    8  CONTINUE
    91 
    92   10  CONTINUE
    93 c$OMP END DO NOWAIT
    94       RETURN
    95       END

  • LMDZ5/trunk/libf/dyn3dmem/vitvert_loc.F90

    r2335 r2336  
    1       SUBROUTINE vitvert_loc ( convm , w )
    2 c
    3       USE parallel_lmdz
    4       IMPLICIT NONE
     1SUBROUTINE vitvert_loc(convm, w)
     2!
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , Fr. Hourdin.
     5!-------------------------------------------------------------------------------
     6! Purpose: Compute vertical speed at sigma levels.
     7  USE parallel_lmdz
     8  IMPLICIT NONE
     9  include "dimensions.h"
     10  include "paramet.h"
     11  include "comvert.h"
     12!===============================================================================
     13! Arguments:
     14  REAL, INTENT(IN)  :: convm(ijb_u:ije_u,llm)
     15  REAL, INTENT(OUT) :: w    (ijb_u:ije_u,llm)
     16!===============================================================================
     17! Notes: Vertical speed is oriented from bottom to top.
     18!   * At ground - level sigma(1):     w(i,j,1) = 0.
     19!   * At top    - level sigma(llm+1): w(i,j,l) = 0. (not stored in w)
     20!===============================================================================
     21! Local variables:
     22  INTEGER :: l, ijb, ije
     23!===============================================================================
     24  ijb=ij_begin
     25  ije=ij_end+iip1
     26  IF(pole_sud) ije=ij_end
     27!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     28  DO l=1,llmm1
     29    w(ijb:ije,l+1)=convm(ijb:ije,l+1)-bp(l+1)*convm(ijb:ije,1)
     30  END DO
     31!$OMP END DO
     32!$OMP MASTER
     33  w(ijb:ije,1)=0.
     34!$OMP END MASTER
     35!$OMP BARRIER
    536
    6 c=======================================================================
    7 c
    8 c   Auteurs:  P. Le Van , F. Hourdin .
    9 c   -------
    10 c
    11 c   Objet:
    12 c   ------
    13 c
    14 c    *******************************************************************
    15 c  .... calcul de la vitesse verticale aux niveaux sigma  ....
    16 c    *******************************************************************
    17 c     convm   est un argument  d'entree pour le s-pg  ......
    18 c       w     est un argument de sortie pour le s-pg  ......
    19 c
    20 c    la vitesse verticale est orientee de  haut en bas .
    21 c    au sol, au niveau sigma(1),   w(i,j,1) = 0.
    22 c    au sommet, au niveau sigma(llm+1) , la vit.verticale est aussi
    23 c    egale a 0. et n'est pas stockee dans le tableau w  .
    24 c
    25 c
    26 c=======================================================================
     37END SUBROUTINE vitvert_loc
    2738
    28 #include "dimensions.h"
    29 #include "paramet.h"
    30 #include "comvert.h"
    31 
    32       REAL w(ijb_u:ije_u,llm),convm(ijb_u:ije_u,llm)
    33       INTEGER   l, ij,ijb,ije
    34 
    35 
    36       ijb=ij_begin
    37       ije=ij_end+iip1
    38      
    39       if (pole_sud) ije=ij_end
    40 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    41       DO 2  l = 1,llmm1
    42 
    43       DO 1 ij = ijb,ije
    44       w( ij, l+1 ) = convm( ij, l+1 ) - bp(l+1) * convm( ij, 1 )
    45    1  CONTINUE
    46 
    47    2  CONTINUE
    48 c$OMP END DO
    49 c$OMP MASTER
    50       DO 5 ij  = ijb,ije
    51       w(ij,1)  = 0.
    52 5     CONTINUE
    53 c$OMP END MASTER
    54 c$OMP BARRIER
    55       RETURN
    56       END
Note: See TracChangeset for help on using the changeset viewer.