SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TOPD/diag_isba_to

Go to the documentation of this file.
00001 !-----------------------------------------------------------------
00002 !     ############################
00003       SUBROUTINE DIAG_ISBA_TO_ROUT(PVARC,PVARCP,PVARROUT)
00004 !     ############################
00005 !
00006 !!****  *DIAG_ISBA_TO_ROUT*  
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !     
00011 !!**  METHOD
00012 !!    ------
00013 !
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    none
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------ 
00021 !!
00022 !!    
00023 !!    
00024 !!
00025 !!      
00026 !!    REFERENCE
00027 !!    ---------
00028 !!
00029 !!    
00030 !!      
00031 !!    AUTHOR
00032 !!    ------
00033 !!
00034 !!      K. Chancibault  * Meteo-France *
00035 !!
00036 !!    MODIFICATIONS
00037 !!    -------------
00038 !!
00039 !!      Original   10/11/2006
00040 !-------------------------------------------------------------------------------
00041 !
00042 !*       0.     DECLARATIONS
00043 !               ------------
00044 !
00045 USE MODD_SURF_ATM_GRID_n, ONLY: XMESH_SIZE
00046 USE MODD_SURF_PAR,        ONLY: XUNDEF
00047 USE MODD_CSTS,            ONLY: XRHOLW
00048 USE MODD_TOPODYN, ONLY : XTOPD_STEP
00049 !
00050 USE MODI_ABOR1_SFX
00051 !
00052 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00053 USE PARKIND1  ,ONLY : JPRB
00054 !
00055 IMPLICIT NONE
00056 !
00057 !*      0.1    declarations of arguments
00058 !
00059 !
00060 REAL,DIMENSION(:),INTENT(IN)        :: PVARC       ! Current time step cumulated diagnostic from SurfEx
00061 REAL,DIMENSION(:),INTENT(IN)        :: PVARCP      ! Previous time step cumulated diagnostic from SurfEx 
00062 REAL,DIMENSION(:),INTENT(OUT)       :: PVARROUT    ! Not cumulated diagnostic (m3/s)
00063 !
00064 !*      0.2    declarations of local variables
00065 !
00066 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00067 !-------------------------------------------------------------------------------
00068 IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_TO_ROUT',0,ZHOOK_HANDLE)
00069 !
00070 !*       0.     Initialization:
00071 !               ---------------
00072 PVARROUT=XUNDEF
00073 !
00074 IF ( SIZE(PVARC,1)==SIZE(PVARCP,1) ) THEN
00075   !
00076   WHERE ( PVARC/=XUNDEF )
00077     PVARROUT = PVARC - PVARCP
00078     PVARROUT = PVARROUT / XTOPD_STEP
00079     PVARROUT = PVARROUT * XMESH_SIZE / XRHOLW
00080   ENDWHERE
00081   !
00082 ELSE 
00083   !
00084   WRITE(*,*) 'Pb with diagnostic to rout'
00085   CALL ABOR1_SFX("DIAG_ISBA_TO_ROUT: PB WITH DIAGNOSTIC TO ROUT ")
00086   !
00087 ENDIF
00088 !
00089 WHERE (PVARROUT<0.) PVARROUT = 0.
00090 !
00091 IF (LHOOK) CALL DR_HOOK('DIAG_ISBA_TO_ROUT',1,ZHOOK_HANDLE)
00092 !
00093 END SUBROUTINE DIAG_ISBA_TO_ROUT