|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################## 00002 SUBROUTINE PACK_GRID_IGN(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 !! 07/2011 add maximum domain dimension for output (B. Decharme) 00026 !---------------------------------------------------------------------------- 00027 ! 00028 !* 0. DECLARATION 00029 ! ----------- 00030 ! 00031 USE MODI_GET_XYALL_IGN 00032 USE MODI_PACK_SAME_RANK 00033 USE MODE_GRIDTYPE_IGN 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 INTEGER :: ILAMBERT ! Lambert type 00055 REAL, DIMENSION(:), ALLOCATABLE :: ZX1 ! X conformal coordinate of grid mesh 00056 REAL, DIMENSION(:), ALLOCATABLE :: ZY1 ! Y conformal coordinate of grid mesh 00057 REAL, DIMENSION(:), ALLOCATABLE :: ZDX1 ! X grid mesh size 00058 REAL, DIMENSION(:), ALLOCATABLE :: ZDY1 ! Y grid mesh size 00059 REAL, DIMENSION(:), ALLOCATABLE :: ZX2 ! X conformal coordinate of grid mesh 00060 REAL, DIMENSION(:), ALLOCATABLE :: ZY2 ! Y conformal coordinate of grid mesh 00061 REAL, DIMENSION(:), ALLOCATABLE :: ZDX2 ! X grid mesh size 00062 REAL, DIMENSION(:), ALLOCATABLE :: ZDY2 ! Y grid mesh size 00063 ! 00064 REAL, DIMENSION(:), ALLOCATABLE :: ZXALL ! maximum domain X coordinate of grid mesh 00065 REAL, DIMENSION(:), ALLOCATABLE :: ZYALL ! maximum domain Y coordinate of grid mesh 00066 INTEGER :: IDIMX ! maximum domain length in X 00067 INTEGER :: IDIMY ! maximum domain length in Y 00068 ! 00069 INTEGER :: IL1 ! number of points of input grid 00070 REAL, DIMENSION(:), POINTER :: ZGRID_PAR2 ! parameters of output grid 00071 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00072 !---------------------------------------------------------------------------- 00073 ! 00074 !* 2. Computes grid parameters 00075 ! ------------------------ 00076 ! 00077 IF (LHOOK) CALL DR_HOOK('PACK_GRID_IGN',0,ZHOOK_HANDLE) 00078 CALL GET_GRIDTYPE_IGN(PGRID_PAR1,KLAMBERT=ILAMBERT,KL=IL1) 00079 ! 00080 ALLOCATE(ZX1 (IL1)) 00081 ALLOCATE(ZY1 (IL1)) 00082 ALLOCATE(ZDX1(IL1)) 00083 ALLOCATE(ZDY1(IL1)) 00084 ! 00085 CALL GET_GRIDTYPE_IGN(PGRID_PAR1,PX=ZX1,PY=ZY1,PDX=ZDX1,PDY=ZDY1) 00086 ! 00087 ALLOCATE(ZX2 (KMASK_SIZE)) 00088 ALLOCATE(ZY2 (KMASK_SIZE)) 00089 ALLOCATE(ZDX2(KMASK_SIZE)) 00090 ALLOCATE(ZDY2(KMASK_SIZE)) 00091 ALLOCATE(ZXALL(KMASK_SIZE*3)) 00092 ALLOCATE(ZYALL(KMASK_SIZE*3)) 00093 ! 00094 CALL PACK_SAME_RANK(KMASK,ZX1 ,ZX2 ) 00095 CALL PACK_SAME_RANK(KMASK,ZY1 ,ZY2 ) 00096 CALL PACK_SAME_RANK(KMASK,ZDX1,ZDX2) 00097 CALL PACK_SAME_RANK(KMASK,ZDY1,ZDY2) 00098 ! 00099 DEALLOCATE(ZX1 ) 00100 DEALLOCATE(ZY1 ) 00101 DEALLOCATE(ZDX1) 00102 DEALLOCATE(ZDY1) 00103 ! 00104 CALL GET_XYALL_IGN(ZX2,ZY2,ZDX2,ZDY2,ZXALL,ZYALL,IDIMX,IDIMY) 00105 ! 00106 CALL PUT_GRIDTYPE_IGN(ZGRID_PAR2,ILAMBERT,ZX2,ZY2,ZDX2,ZDY2, & 00107 IDIMX,IDIMY,ZXALL(1:IDIMX),ZYALL(1:IDIMY)) 00108 ! 00109 DEALLOCATE(ZXALL) 00110 DEALLOCATE(ZYALL) 00111 ! 00112 IF (OPACK) THEN 00113 PGRID_PAR2(:) = ZGRID_PAR2(:) 00114 ELSE 00115 KGRID_PAR2 = SIZE(ZGRID_PAR2(:)) 00116 END IF 00117 ! 00118 DEALLOCATE(ZGRID_PAR2) 00119 DEALLOCATE(ZX2 ) 00120 DEALLOCATE(ZY2 ) 00121 DEALLOCATE(ZDX2) 00122 DEALLOCATE(ZDY2) 00123 IF (LHOOK) CALL DR_HOOK('PACK_GRID_IGN',1,ZHOOK_HANDLE) 00124 !------------------------------------------------------------------------------- 00125 ! 00126 END SUBROUTINE PACK_GRID_IGN
1.8.0
