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

Go to the documentation of this file.
00001 !-----------------------------------------------------------------
00002 !     #######################
00003       SUBROUTINE MAKE_MASK_ISBA_TO_TOPD(KI)
00004 !     #######################
00005 !
00006 !!****  *MAKE_MASK_ISBA_TO_TOPD*  
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !
00011 !     Create a mask for each Surfex mesh and each catchment. 
00012 !         
00013 !     
00014 !!**  METHOD
00015 !!    ------
00016 !
00017 !!    EXTERNAL
00018 !!    --------
00019 !!
00020 !!    none
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------ 
00024 !!                          
00025 !!    REFERENCE
00026 !!    ---------
00027      
00028 !!    AUTHOR
00029 !!    ------
00030 !!
00031 !!      K. Chancibault  * CNRM * 
00032 !!
00033 !!    MODIFICATIONS
00034 !!    -------------
00035 !!
00036 !!      Original   16/03/2005
00037 !!                 11/2011 : Loops simplified (Vincendon)
00038 !-------------------------------------------------------------------------------
00039 !
00040 !*       0.     DECLARATIONS
00041 !               ------------
00042 !
00043 USE MODD_TOPODYN,       ONLY : NNCAT, NNMC
00044 USE MODD_COUPLING_TOPD, ONLY : NMASKT, NMASKI, NNPIX
00045 USE MODD_SURF_PAR,        ONLY : NUNDEF
00046 !
00047 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00048 USE PARKIND1  ,ONLY : JPRB
00049 !
00050 IMPLICIT NONE
00051 !
00052 !*      0.1    declarations of arguments
00053 !
00054 INTEGER, INTENT(IN) :: KI    ! Grid dimensions
00055 !
00056 !*      0.2    declarations of local variables
00057 !
00058 INTEGER, DIMENSION(KI)  :: INBPIX_IN_MESH ! number of pixel in each ISBA mesh
00059 INTEGER                 :: JCAT, JPIX, INUMPIX
00060 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00061 !-------------------------------------------------------------------------------
00062 IF (LHOOK) CALL DR_HOOK('MAKE_MASK_ISBA_TO_TOPD',0,ZHOOK_HANDLE)
00063 !
00064 INUMPIX=MAXVAL(NNPIX)
00065 !
00066 ALLOCATE(NMASKI(KI,NNCAT,INUMPIX))
00067 NMASKI(:,:,:) = NUNDEF
00068 !
00069 INBPIX_IN_MESH(:) = 0
00070 !
00071 DO JCAT = 1,NNCAT
00072   !
00073   DO JPIX = 1,NNMC(JCAT)
00074     !si le point du bassin versant est dans une maille isba
00075     IF ((NMASKT(JCAT,JPIX)/=0).AND.(NMASKT(JCAT,JPIX)/=NUNDEF)) THEN
00076       !indice du point du bassin versant dans la maille isba
00077       INBPIX_IN_MESH(NMASKT(JCAT,JPIX)) = INBPIX_IN_MESH(NMASKT(JCAT,JPIX)) + 1
00078       ! nmaski associe à la maille isba, au bassin versant et au numéro du point 
00079       ! du bassin versant dans la maille isba, l'indice du point dans le bassin
00080       ! versant
00081       NMASKI(NMASKT(JCAT,JPIX),JCAT,INBPIX_IN_MESH(NMASKT(JCAT,JPIX))) = JPIX
00082     ENDIF
00083     !
00084   ENDDO
00085   !
00086 ENDDO
00087 ! write(*,*) 'NMASKT min et max',MINVAL(NMASKT(1,:)),MAXVAL(NMASKT(1,:))
00088 ! write(*,*) 'NMASKT min et max',MINVAL(NMASKT(2,:)),MAXVAL(NMASKT(2,:))
00089 ! write(*,*) 'NMASKT min et max',MINVAL(NMASKT(3,:)),MAXVAL(NMASKT(3,:))
00090 ! write(*,*) 'NMASKT min et max',MINVAL(NMASKT(4,:)),MAXVAL(NMASKT(4,:))
00091 ! write(*,*) 'NMASKI 3132 min et max',MINVAL(NMASKI(MINVAL(NMASKT(1,:)),1,:)),MAXVAL(NMASKI(MINVAL(NMASKT(1,:)),1,:))
00092 ! write(*,*) 'NMASKI 6662 min et max',MINVAL(NMASKI(MAXVAL(NMASKT(1,:)),1,:)),MAXVAL(NMASKI(MAXVAL(NMASKT(1,:)),1,:))
00093 ! stop
00094 !
00095 IF (LHOOK) CALL DR_HOOK('MAKE_MASK_ISBA_TO_TOPD',1,ZHOOK_HANDLE)
00096 !
00097 END SUBROUTINE MAKE_MASK_ISBA_TO_TOPD
00098 
00099 
00100 
00101 
00102 
00103 
00104