Changeset 2336 for LMDZ5/trunk/libf/dyn3dmem/massbarxy_loc.F90

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:

• LMDZ5/trunk/libf/dyn3dmem/massbarxy_loc.F90 (moved) (moved from LMDZ5/trunk/libf/dyn3dmem/massbarxy_loc.F) (1 diff)

LMDZ5/trunk/libf/dyn3dmem/massbarxy_loc.F90

@@ -1 @@
-      SUBROUTINE massbarxy_loc(  masse, massebxy )
-      USE parallel_lmdz
-      implicit none
-c **********************************************************************
-c
-c  Calcule les moyennes en x et  y de la masse d'air dans chaque maille.
-c **********************************************************************
-c    Auteurs : P. Le Van , Fr. Hourdin  .
-c   ..........
-c
-c  ..  masse          est  un  argum. d'entree  pour le s-pg ...
-c  ..  massebxy       est  un  argum. de sortie pour le s-pg ...
-c     
-c
-c     IMPLICIT NONE
-c
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comgeom.h"
-c
-       REAL  masse( ijb_u:ije_u,llm ), massebxy( ijb_v:ije_v,llm )
-c
-      INTEGER ij,l,ijb,ije
+SUBROUTINE massbarxy_loc(masse,massebxy)
+!
+!-------------------------------------------------------------------------------
+! Authors: P. Le Van , Fr. Hourdin.
+!-------------------------------------------------------------------------------
+! Purpose: Compute air mass mean along X and Y in each cell.
+! See iniconst for more details.
+  USE parallel_lmdz
+  IMPLICIT NONE
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "comgeom.h"
+!===============================================================================
+! Arguments:
+  REAL, INTENT(IN)  :: masse   (ijb_u:ije_u,llm)
+  REAL, INTENT(OUT) :: massebxy(ijb_v:ije_v,llm)
+!===============================================================================
+! Local variables:
+  INTEGER :: ij, l, ijb, ije
+!===============================================================================
+  ijb=ij_begin-iip1
+  ije=ij_end
+  IF(pole_nord) ijb=ijb+iip1
+  IF(pole_sud)  ije=ije-iip1
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)    
+  DO l=1,llm
+    DO ij=ijb,ije-1
+      massebxy(ij,l)=masse(ij     ,l)*alpha2(ij     ) + &
+     +               masse(ij+1   ,l)*alpha3(ij+1   ) + &
+     +               masse(ij+iip1,l)*alpha1(ij+iip1) + &
+     +               masse(ij+iip2,l)*alpha4(ij+iip2)
+    END DO
+    DO ij=ijb+iip1-1,ije+iip1-1,iip1; massebxy(ij,l)=massebxy(ij-iim,l); END DO
+  END DO
+!$OMP END DO NOWAIT
 
-      
-      ijb=ij_begin-iip1
-      ije=ij_end
-      
-      if (pole_nord) ijb=ijb+iip1
-      if (pole_sud)  ije=ije-iip1
+END SUBROUTINE massbarxy_loc
 
-c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)    
-      DO   100    l = 1 , llm
-c
-      DO 5 ij = ijb, ije - 1
-      massebxy( ij,l ) = masse(    ij  ,l ) * alpha2(   ij    )   +
-     +                   masse(   ij+1 ,l ) * alpha3(  ij+1   )   +
-     +                   masse( ij+iip1,l ) * alpha1( ij+iip1 )   +
-     +                   masse( ij+iip2,l ) * alpha4( ij+iip2 )
-   5  CONTINUE
-
-c    ....  correction pour     massebxy( iip1,j )  ........
-
-CDIR$ IVDEP
-
-      DO 7 ij = ijb+iip1-1, ije+iip1-1, iip1
-      massebxy( ij,l ) = massebxy( ij - iim,l )
-   7  CONTINUE
-
-100   CONTINUE
-c$OMP END DO NOWAIT
-c
-      RETURN
-      END