|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################## 00002 SUBROUTINE PACK_GRID_LONLATVAL(KMASK_SIZE,KMASK,KGRID_PAR1,PGRID_PAR1,KGRID_PAR2,OPACK,PGRID_PAR2) 00003 ! ############################################################## 00004 ! 00005 !!**** *PACK_GRID_IGN* packs the grid definition vector 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! AUTHOR 00017 !! ------ 00018 !! 00019 !! E. Martin Meteo-France 00020 !! 00021 !! MODIFICATION 00022 !! ------------ 00023 !! 00024 !! Original 10/2007 00025 !! 00026 !---------------------------------------------------------------------------- 00027 ! 00028 !* 0. DECLARATION 00029 ! ----------- 00030 ! 00031 USE MODI_PACK_SAME_RANK 00032 USE MODE_GRIDTYPE_LONLATVAL 00033 ! 00034 ! 00035 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00036 USE PARKIND1 ,ONLY : JPRB 00037 ! 00038 IMPLICIT NONE 00039 ! 00040 !* 0.1 Declaration of arguments 00041 ! ------------------------ 00042 ! 00043 INTEGER, INTENT(IN) :: KMASK_SIZE ! size of mask 00044 INTEGER, DIMENSION(KMASK_SIZE), INTENT(IN) :: KMASK ! mask used 00045 INTEGER, INTENT(IN) :: KGRID_PAR1 ! size of input grid vector 00046 REAL, DIMENSION(KGRID_PAR1), INTENT(IN) :: PGRID_PAR1 ! parameters of input grid 00047 INTEGER, INTENT(INOUT) :: KGRID_PAR2 ! size of output grid vector 00048 LOGICAL, INTENT(IN) :: OPACK ! flag to pack the grid vector 00049 REAL, DIMENSION(KGRID_PAR2), INTENT(OUT) :: PGRID_PAR2 ! parameters of output grid 00050 ! 00051 !* 0.2 Declaration of other local variables 00052 ! ------------------------------------ 00053 ! 00054 REAL, DIMENSION(:), ALLOCATABLE :: ZX1 ! X conformal coordinate of grid mesh 00055 REAL, DIMENSION(:), ALLOCATABLE :: ZY1 ! Y conformal coordinate of grid mesh 00056 REAL, DIMENSION(:), ALLOCATABLE :: ZDX1 ! X grid mesh size 00057 REAL, DIMENSION(:), ALLOCATABLE :: ZDY1 ! Y grid mesh size 00058 REAL, DIMENSION(:), ALLOCATABLE :: ZX2 ! X conformal coordinate of grid mesh 00059 REAL, DIMENSION(:), ALLOCATABLE :: ZY2 ! Y conformal coordinate of grid mesh 00060 REAL, DIMENSION(:), ALLOCATABLE :: ZDX2 ! X grid mesh size 00061 REAL, DIMENSION(:), ALLOCATABLE :: ZDY2 ! Y grid mesh size 00062 00063 INTEGER :: IL1 ! number of points of input grid 00064 REAL, DIMENSION(:), POINTER :: ZGRID_PAR2 ! parameters of output grid 00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00066 !---------------------------------------------------------------------------- 00067 ! 00068 !* 2. Computes grid parameters 00069 ! ------------------------ 00070 ! 00071 IF (LHOOK) CALL DR_HOOK('PACK_GRID_LONLATVAL',0,ZHOOK_HANDLE) 00072 CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR1,KL=IL1) 00073 ! 00074 ALLOCATE(ZX1 (IL1)) 00075 ALLOCATE(ZY1 (IL1)) 00076 ALLOCATE(ZDX1(IL1)) 00077 ALLOCATE(ZDY1(IL1)) 00078 ! 00079 CALL GET_GRIDTYPE_LONLATVAL(PGRID_PAR1,PX=ZX1,PY=ZY1,PDX=ZDX1,PDY=ZDY1) 00080 ! 00081 ALLOCATE(ZX2 (KMASK_SIZE)) 00082 ALLOCATE(ZY2 (KMASK_SIZE)) 00083 ALLOCATE(ZDX2(KMASK_SIZE)) 00084 ALLOCATE(ZDY2(KMASK_SIZE)) 00085 ! 00086 CALL PACK_SAME_RANK(KMASK,ZX1 ,ZX2 ) 00087 CALL PACK_SAME_RANK(KMASK,ZY1 ,ZY2 ) 00088 CALL PACK_SAME_RANK(KMASK,ZDX1,ZDX2) 00089 CALL PACK_SAME_RANK(KMASK,ZDY1,ZDY2) 00090 ! 00091 DEALLOCATE(ZX1 ) 00092 DEALLOCATE(ZY1 ) 00093 DEALLOCATE(ZDX1) 00094 DEALLOCATE(ZDY1) 00095 ! 00096 CALL PUT_GRIDTYPE_LONLATVAL(ZGRID_PAR2,ZX2,ZY2,ZDX2,ZDY2) 00097 ! 00098 IF (OPACK) THEN 00099 PGRID_PAR2(:) = ZGRID_PAR2(:) 00100 ELSE 00101 KGRID_PAR2 = SIZE(ZGRID_PAR2(:)) 00102 END IF 00103 ! 00104 DEALLOCATE(ZGRID_PAR2) 00105 DEALLOCATE(ZX2 ) 00106 DEALLOCATE(ZY2 ) 00107 DEALLOCATE(ZDX2) 00108 DEALLOCATE(ZDY2) 00109 IF (LHOOK) CALL DR_HOOK('PACK_GRID_LONLATVAL',1,ZHOOK_HANDLE) 00110 !------------------------------------------------------------------------------- 00111 ! 00112 END SUBROUTINE PACK_GRID_LONLATVAL
1.8.0
