Juan 18/01/2016 : correction bornes budget sans JPVEXT
authorGaelle Tanguy <gaelle.tanguy@meteo.fr>
Mon, 18 Jan 2016 09:16:23 +0000 (09:16 +0000)
committerPhilippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Thu, 19 May 2016 14:44:49 +0000 (16:44 +0200)
src/MNH/cart_compress.f90

index 81e0a35..1461c92 100644 (file)
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! masdev4_7 BUG2 2007/06/29 16:52:14
-!-----------------------------------------------------------------
-!#########################
- MODULE MODI_CART_COMPRESS
-!#########################
-!
-INTERFACE
-!
-FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
-!
-USE MODD_BUDGET
-!
-REAL, DIMENSION(:,:,:), INTENT(IN)       :: PVARS     ! Source
-REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
-!
-END FUNCTION CART_COMPRESS
-!
-END INTERFACE
-!
-END MODULE MODI_CART_COMPRESS
-!     ###############################################
-      FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS) 
-!     ###############################################
-!
-!!****  *CART_COMPRESS* - function to compress the Source in CART case. 
-!!                           
-!!
-!!    PURPOSE
-!!    -------
-!       This function compresses or not the Source XVARS of the VARiable
-!     VAR whose budget is analysed. This compression is controlled by 3 
-!     logical switches for the budget in I,J and K directions (LBU_ICP,
-!     LBU_JCP, LBU_KCP), in the budget box described by the lowest and
-!     highest values of the I,J and K indices.  
-!
-!!**  METHOD
-!!    ------
-!!      The source PVARS is first transfered in a local array whose 
-!!    dimensions correspond to the budget box. Then compressions
-!!    are or aren't achieved depending on the logical switches.
-!!
-!!    EXTERNAL
-!!    --------
-!!       NONE
-!!
-!!    IMPLICIT ARGUMENTS
-!!    ------------------
-!!       Module MODD_BUDGET
-!!           LBU_ICP   : switch for compression in I direction
-!!           LBU_JCP   : switch for compression in J direction
-!!           LBU_KCP   : switch for compression in K direction
-!!           NBUIL     : lowest I indice value of the budget box
-!!           NBUJL     : lowest J indice value of the budget box
-!!           NBUKL     : lowest K indice value of the budget box
-!!           NBUIH     : highest I indice value of the budget box
-!!           NBUJH     : highest J indice value of the budget box
-!!           NBUKH     : highest K indice value of the budget box
-!!           NBUIMAX   : dimension along I of the budget tabular
-!!           NBUJMAX   : dimension along J of the budget tabular
-!!           NBUKMAX   : dimension along K of the budget tabular
-!!          
-!!
-!!
-!!    REFERENCE
-!!    ---------
-!!      Book2 of MESO-NH documentation (function CART_COMPRESS)
-!!
-!!
-!!    AUTHOR
-!!    ------
-!!     J. Nicolau       * Meteo France *
-!!
-!!    MODIFICATIONS
-!!    -------------
-!!      Original             27/02/95
-!!      JP Pinty & J Escobar 12/10/98 Enable vectorization and remove 
-!!                                     SUM functions
-!!      V. Ducrocq           4/06/99  //
-!!
-!-------------------------------------------------------------------------------
-!
-!*       0.    DECLARATIONS
-!              ------------
-!
-USE MODD_BUDGET
-!
-!
-IMPLICIT NONE
-!  
-!  
-!*       0.1   Declarations of arguments and result :
-!
-REAL, DIMENSION(:,:,:), INTENT(IN)       :: PVARS     ! Source 
-REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
-!
-!*       0.2   Declarations of local variables :
-! 
-! 
-REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZVARS ! 3D Work 
-                                                                     ! array
-REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUKH-NBUKL+1) :: ZWORKIK ! 2D Work array
-REAL, DIMENSION (NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZWORKJK ! 2D Work array
-REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1) :: ZWORKIJ ! 2D Work array
-! 
-INTEGER                                          :: JJ,JK   ! loop indexes 
-! 
-!
-!-------------------------------------------------------------------------------
-!
-!*      1.     SOURCE TRANSFERT IN A LOCAL ARRAY 
-!              ---------------------------------
-!JUAN
-IF (SIZE (PCOMPRESS) .EQ. 0 ) RETURN
-!JUAN
-!
-ZVARS(1:NBUSIH-NBUSIL+1,1:NBUSJH-NBUSJL+1,1:NBUKH-NBUKL+1) = &
-            PVARS(NBUSIL:NBUSIH,NBUSJL:NBUSJH,NBUKL:NBUKH)
-!
-!-------------------------------------------------------------------------------
-!
-!*       2.     COMPRESSIONS IN I,J AND K DIRECTIONS
-!              ------------------------------------
-!                                 
-!
-IF (LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
-  PCOMPRESS(1,1,1)=SUM(ZVARS)
-!
-ELSE IF (LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
-  ZWORKJK(:,:)    =SUM(ZVARS,1)
-  PCOMPRESS(1,1,:)=SUM(ZWORKJK,1)
-!
-ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
-  ZWORKIJ(:,:)=0.0
-  DO JK = 1,NBUKH-NBUKL+1
-    ZWORKIJ(:,:) = ZWORKIJ(:,:) + ZVARS(:,:,JK)
-  END DO
-  PCOMPRESS(1,:,1)=SUM(ZWORKIJ,1)
-!
-ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
-  ZWORKIK(:,:)=0.0
-  DO JJ = 1,NBUSJH-NBUSJL+1
-    ZWORKIK(:,:) = ZWORKIK(:,:) + ZVARS(:,JJ,:)
-  END DO
-  PCOMPRESS(:,1,1)=SUM(ZWORKIK,2)
-!
-ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND..NOT.LBU_KCP) THEN 
-  PCOMPRESS(1,:,:)=SUM(ZVARS,1)
-!
-ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
-  PCOMPRESS(:,1,:)=SUM(ZVARS,2)
-!
-ELSE IF (.NOT.LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
-  PCOMPRESS(:,:,1)=SUM(ZVARS,3)
-!
-ELSE  
-  PCOMPRESS=ZVARS
-!
-END IF
-!
-!
-END FUNCTION CART_COMPRESS                           
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier\r
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence\r
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!MNH_LIC for details. version 1.\r
+!-----------------------------------------------------------------\r
+!--------------- special set of characters for RCS information\r
+!-----------------------------------------------------------------\r
+! $Source$ $Revision$\r
+! masdev4_7 BUG2 2007/06/29 16:52:14\r
+!-----------------------------------------------------------------\r
+!#########################\r
+ MODULE MODI_CART_COMPRESS\r
+!#########################\r
+!\r
+INTERFACE\r
+!\r
+FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)\r
+!\r
+USE MODD_BUDGET\r
+!\r
+REAL, DIMENSION(:,:,:), INTENT(IN)       :: PVARS     ! Source\r
+REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result\r
+!\r
+END FUNCTION CART_COMPRESS\r
+!\r
+END INTERFACE\r
+!\r
+END MODULE MODI_CART_COMPRESS\r
+!     ###############################################\r
+      FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS) \r
+!     ###############################################\r
+!\r
+!!****  *CART_COMPRESS* - function to compress the Source in CART case. \r
+!!                           \r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!       This function compresses or not the Source XVARS of the VARiable\r
+!     VAR whose budget is analysed. This compression is controlled by 3 \r
+!     logical switches for the budget in I,J and K directions (LBU_ICP,\r
+!     LBU_JCP, LBU_KCP), in the budget box described by the lowest and\r
+!     highest values of the I,J and K indices.  \r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!      The source PVARS is first transfered in a local array whose \r
+!!    dimensions correspond to the budget box. Then compressions\r
+!!    are or aren't achieved depending on the logical switches.\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!       NONE\r
+!!\r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------\r
+!!       Module MODD_BUDGET\r
+!!           LBU_ICP   : switch for compression in I direction\r
+!!           LBU_JCP   : switch for compression in J direction\r
+!!           LBU_KCP   : switch for compression in K direction\r
+!!           NBUIL     : lowest I indice value of the budget box\r
+!!           NBUJL     : lowest J indice value of the budget box\r
+!!           NBUKL     : lowest K indice value of the budget box\r
+!!           NBUIH     : highest I indice value of the budget box\r
+!!           NBUJH     : highest J indice value of the budget box\r
+!!           NBUKH     : highest K indice value of the budget box\r
+!!           NBUIMAX   : dimension along I of the budget tabular\r
+!!           NBUJMAX   : dimension along J of the budget tabular\r
+!!           NBUKMAX   : dimension along K of the budget tabular\r
+!!          \r
+!!\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      Book2 of MESO-NH documentation (function CART_COMPRESS)\r
+!!\r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     J. Nicolau       * Meteo France *\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original             27/02/95\r
+!!      JP Pinty & J Escobar 12/10/98 Enable vectorization and remove \r
+!!                                     SUM functions\r
+!!      V. Ducrocq           4/06/99  //\r
+!!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!              ------------\r
+!\r
+USE MODD_BUDGET\r
+USE MODD_PARAMETERS , ONLY : JPVEXT\r
+!\r
+!\r
+IMPLICIT NONE\r
+!  \r
+!  \r
+!*       0.1   Declarations of arguments and result :\r
+!\r
+REAL, DIMENSION(:,:,:), INTENT(IN)       :: PVARS     ! Source \r
+REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result\r
+!\r
+!*       0.2   Declarations of local variables :\r
+! \r
+! \r
+REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZVARS ! 3D Work \r
+                                                                     ! array\r
+REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUKH-NBUKL+1) :: ZWORKIK ! 2D Work array\r
+REAL, DIMENSION (NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZWORKJK ! 2D Work array\r
+REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1) :: ZWORKIJ ! 2D Work array\r
+! \r
+INTEGER                                          :: JJ,JK   ! loop indexes \r
+! \r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*      1.     SOURCE TRANSFERT IN A LOCAL ARRAY \r
+!              ---------------------------------\r
+!JUAN\r
+IF (SIZE (PCOMPRESS) .EQ. 0 ) RETURN\r
+!JUAN\r
+!\r
+ZVARS(1:NBUSIH-NBUSIL+1,1:NBUSJH-NBUSJL+1,1:NBUKH-NBUKL+1) = &\r
+            PVARS(NBUSIL:NBUSIH,NBUSJL:NBUSJH,NBUKL+JPVEXT:NBUKH+JPVEXT)\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       2.     COMPRESSIONS IN I,J AND K DIRECTIONS\r
+!              ------------------------------------\r
+!                                 \r
+!\r
+IF (LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN\r
+  PCOMPRESS(1,1,1)=SUM(ZVARS)\r
+!\r
+ELSE IF (LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN\r
+  ZWORKJK(:,:)    =SUM(ZVARS,1)\r
+  PCOMPRESS(1,1,:)=SUM(ZWORKJK,1)\r
+!\r
+ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN\r
+  ZWORKIJ(:,:)=0.0\r
+  DO JK = 1,NBUKH-NBUKL+1\r
+    ZWORKIJ(:,:) = ZWORKIJ(:,:) + ZVARS(:,:,JK)\r
+  END DO\r
+  PCOMPRESS(1,:,1)=SUM(ZWORKIJ,1)\r
+!\r
+ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN\r
+  ZWORKIK(:,:)=0.0\r
+  DO JJ = 1,NBUSJH-NBUSJL+1\r
+    ZWORKIK(:,:) = ZWORKIK(:,:) + ZVARS(:,JJ,:)\r
+  END DO\r
+  PCOMPRESS(:,1,1)=SUM(ZWORKIK,2)\r
+!\r
+ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND..NOT.LBU_KCP) THEN \r
+  PCOMPRESS(1,:,:)=SUM(ZVARS,1)\r
+!\r
+ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN\r
+  PCOMPRESS(:,1,:)=SUM(ZVARS,2)\r
+!\r
+ELSE IF (.NOT.LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN\r
+  PCOMPRESS(:,:,1)=SUM(ZVARS,3)\r
+!\r
+ELSE  \r
+  PCOMPRESS=ZVARS\r
+!\r
+END IF\r
+!\r
+!\r
+END FUNCTION CART_COMPRESS                           \r