SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/conserv_global

Go to the documentation of this file.
00001       SUBROUTINE CONSERV_GLOBAL_MASS(ILUOUT,PZDG,PZDG_OLD,PFIELD,PFIELD_OLD)
00002 !!
00003 !!****  *CONSERV_GLOBAL_MASS* - routine to conserve global 3D mass (LAND USE case)
00004 !!
00005 !!    PURPOSE
00006 !!    -------
00007 !!
00008 !!    METHOD
00009 !!    ------ 
00010 !!
00011 !!    EXTERNAL
00012 !!    --------
00013 !!
00014 !!    IMPLICIT ARGUMENTS
00015 !!    ------------------
00016 !!
00017 !!    REFERENCE
00018 !!    ---------
00019 !!
00020 !!    AUTHOR
00021 !!    ------
00022 !!
00023 !!    R. Alkama        Meteo-France
00024 !!
00025 !!    MODIFICATION
00026 !!    ------------
00027 !!    Original    07/2011
00028 !!
00029 !!
00030 !!*    0.     DECLARATION
00031 !            -----------
00032 !
00033 USE MODD_SURF_PAR,        ONLY : XUNDEF
00034 USE MODD_ISBA_GRID_n,     ONLY : XMESH_SIZE  
00035 USE MODD_SURF_ATM_n,      ONLY : XNATURE
00036 USE MODD_SURF_ATM_n,      ONLY : NSIZE_FULL
00037 USE MODD_ISBA_n,          ONLY : XPATCH_OLD, XPATCH
00038 !
00039 USE MODI_PACK_SAME_RANK
00040 USE MODI_GET_SURF_MASK_n
00041 !
00042 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00043 USE PARKIND1  ,ONLY : JPRB
00044 !
00045 IMPLICIT NONE
00046 !
00047 !*    0.1    Declaration of arguments
00048 !            ------------------------
00049 !
00050 INTEGER,                        INTENT(IN   ) :: ILUOUT
00051 REAL, DIMENSION(:,:,:),         INTENT(IN   ) :: PFIELD_OLD,PZDG,PZDG_OLD
00052 REAL, DIMENSION(:,:,:),         INTENT(INOUT) :: PFIELD
00053 !
00054 !*    0.2    Declaration of local variables
00055 !            ------------------------------
00056 !
00057 REAL,    DIMENSION(SIZE(PFIELD,1)) :: ZFIELD,ZFIELD_OLD, ZFRAC_NAT
00058 INTEGER, DIMENSION(SIZE(XNATURE))  :: IMASK  ! mask for packing from complete field to nature field
00059 INTEGER                            :: INI, IPATCH, IFULL, ILEV
00060 INTEGER                            :: JLEV, JPATCH, JJ  ! loop counter 
00061 REAL                               :: ZRATIO_TOT, ZWORK1,ZWORK2
00062 !
00063 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00064 !
00065 !-------------------------------------------------------------------------------
00066 !
00067 IF (LHOOK) CALL DR_HOOK('CONSERV_GLOBAL_MASS',0,ZHOOK_HANDLE)
00068 !
00069 INI   = SIZE(PFIELD,1)
00070 ILEV  = SIZE(PFIELD,2)
00071 IPATCH = SIZE(PFIELD,3)
00072 IFULL = SIZE(XNATURE )
00073 !
00074 ZFRAC_NAT = 1.
00075  CALL GET_SURF_MASK_n('NATURE',IFULL,IMASK,NSIZE_FULL,ILUOUT)
00076  CALL PACK_SAME_RANK(IMASK,XNATURE,ZFRAC_NAT)  
00077 ZFRAC_NAT(:)=ZFRAC_NAT(:)*XMESH_SIZE(:)
00078 !
00079 ZFIELD(:)    =0.0
00080 ZFIELD_OLD(:)=0.0
00081 DO JPATCH=1,IPATCH
00082   DO JLEV=1,ILEV
00083      DO JJ=1,INI
00084         ZFIELD(JJ)    = ZFIELD(JJ)     + PFIELD(JJ,JLEV,JPATCH)*PZDG(JJ,JLEV,JPATCH)*XPATCH(JJ,JPATCH)
00085         ZFIELD_OLD(JJ)= ZFIELD_OLD(JJ) + PFIELD_OLD(JJ,JLEV,JPATCH)*PZDG_OLD(JJ,JLEV,JPATCH)*XPATCH_OLD(JJ,JPATCH)
00086      ENDDO
00087   ENDDO
00088 ENDDO
00089 !
00090 ZWORK1=0.0
00091 ZWORK2=0.0
00092 ZRATIO_TOT = 1.0
00093 !
00094 DO JJ=1,INI
00095    ZWORK1=ZWORK1+ZFIELD    (JJ)*ZFRAC_NAT(JJ)
00096    ZWORK2=ZWORK1+ZFIELD_OLD(JJ)*ZFRAC_NAT(JJ)
00097 ENDDO
00098 !
00099 IF(ZWORK2/= 0.)THEN
00100    ZRATIO_TOT = ZWORK1/ZWORK2
00101 ENDIF
00102 !
00103 WHERE(PFIELD(:,:,:)/=XUNDEF) PFIELD(:,:,:)= PFIELD(:,:,:) * ZRATIO_TOT
00104 !
00105 !-------------------------------------------------------------------------------
00106 !
00107 IF (LHOOK) CALL DR_HOOK('CONSERV_GLOBAL_MASS',1,ZHOOK_HANDLE)
00108 !
00109 !-------------------------------------------------------------------------------
00110 !
00111 END SUBROUTINE CONSERV_GLOBAL_MASS