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).
File:
1 moved

Legend:

Unmodified
Added
Removed
  • 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
Note: See TracChangeset for help on using the changeset viewer.