|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 !############################################################## 00002 SUBROUTINE PACK_GRID_GAUSS(KMASK_SIZE,KMASK,KGRID_PAR1,PGRID_PAR1,KGRID_PAR2,OPACK,PGRID_PAR2) 00003 !############################################################## 00004 ! 00005 !!**** *PACK_GRID_GAUSS* packs the grid definition vector 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! AUTHOR 00017 !! ------ 00018 !! 00019 !! V. Masson Meteo-France 00020 !! 00021 !! MODIFICATION 00022 !! ------------ 00023 !! 00024 !! Original 03/2004 00025 !! (B. Decharme) 2008 pack mesh area 00026 !---------------------------------------------------------------------------- 00027 ! 00028 !* 0. DECLARATION 00029 ! ----------- 00030 ! 00031 USE MODI_PACK_SAME_RANK 00032 USE MODE_GRIDTYPE_GAUSS 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 INTEGER :: INLATI ! number of pseudo-latitudes 00055 REAL :: ZLAPO ! latitude of the rotated pole (deg) 00056 REAL :: ZLOPO ! longitude of the rotated pole (deg) 00057 REAL :: ZCODIL ! stretching factor (must be greater than or equal to 1) 00058 INTEGER, DIMENSION(:), ALLOCATABLE :: INLOPA ! number of pseudo-longitudes on each 00059 ! pseudo-latitude circle 00060 REAL, DIMENSION(:), ALLOCATABLE :: ZLAT1 ! latitude of all grid points 00061 REAL, DIMENSION(:), ALLOCATABLE :: ZLON1 ! longitude of all grid points 00062 REAL, DIMENSION(:), ALLOCATABLE :: ZLAT2 ! latitude of subset of grid points 00063 REAL, DIMENSION(:), ALLOCATABLE :: ZLON2 ! longitude of subset of grid points 00064 REAL, DIMENSION(:), ALLOCATABLE :: ZLAT_XY1 ! pseudo-latitude of all grid points 00065 REAL, DIMENSION(:), ALLOCATABLE :: ZLON_XY1 ! pseudo-longitude of all grid points 00066 REAL, DIMENSION(:), ALLOCATABLE :: ZLAT_XY2 ! pseudo-latitude of subset of grid points 00067 REAL, DIMENSION(:), ALLOCATABLE :: ZLON_XY2 ! pseudo-longitude of subset of grid points 00068 REAL, DIMENSION(:), ALLOCATABLE :: ZMESH_SIZE1! 00069 REAL, DIMENSION(:), ALLOCATABLE :: ZMESH_SIZE2! 00070 INTEGER :: IL ! total number of points 00071 00072 REAL, DIMENSION(:), POINTER :: ZGRID_PAR2 ! parameters of output grid 00073 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00074 !---------------------------------------------------------------------------- 00075 ! 00076 !* 1. Computes grid parameters 00077 ! ------------------------ 00078 ! 00079 IF (LHOOK) CALL DR_HOOK('PACK_GRID_GAUSS',0,ZHOOK_HANDLE) 00080 CALL GET_GRIDTYPE_GAUSS(PGRID_PAR1,INLATI,KL=IL) 00081 ! 00082 ALLOCATE(INLOPA(INLATI)) 00083 ALLOCATE(ZLAT_XY1(IL)) 00084 ALLOCATE(ZLON_XY1(IL)) 00085 ALLOCATE(ZLAT1(IL)) 00086 ALLOCATE(ZLON1(IL)) 00087 ALLOCATE(ZMESH_SIZE1(IL)) 00088 ! 00089 CALL GET_GRIDTYPE_GAUSS(PGRID_PAR1,INLATI,ZLAPO,ZLOPO,ZCODIL,INLOPA(:), & 00090 IL,ZLAT1,ZLON1,ZLAT_XY1,ZLON_XY1,ZMESH_SIZE1) 00091 ! 00092 !---------------------------------------------------------------------------- 00093 ! 00094 !* 2. Packs latitude and longitude arrays 00095 ! ----------------------------------- 00096 ! 00097 ! 00098 ALLOCATE(ZLAT_XY2(KMASK_SIZE)) 00099 ALLOCATE(ZLON_XY2(KMASK_SIZE)) 00100 ALLOCATE(ZLAT2(KMASK_SIZE)) 00101 ALLOCATE(ZLON2(KMASK_SIZE)) 00102 ALLOCATE(ZMESH_SIZE2(KMASK_SIZE)) 00103 ! 00104 CALL PACK_SAME_RANK(KMASK,ZLAT_XY1,ZLAT_XY2) 00105 CALL PACK_SAME_RANK(KMASK,ZLON_XY1,ZLON_XY2) 00106 CALL PACK_SAME_RANK(KMASK,ZLAT1,ZLAT2) 00107 CALL PACK_SAME_RANK(KMASK,ZLON1,ZLON2) 00108 CALL PACK_SAME_RANK(KMASK,ZMESH_SIZE1,ZMESH_SIZE2) 00109 ! 00110 DEALLOCATE(ZLAT_XY1) 00111 DEALLOCATE(ZLON_XY1) 00112 DEALLOCATE(ZLAT1) 00113 DEALLOCATE(ZLON1) 00114 DEALLOCATE(ZMESH_SIZE1) 00115 ! 00116 !---------------------------------------------------------------------------- 00117 ! 00118 !* 3. Stores data in new grid vector 00119 ! ------------------------------ 00120 ! 00121 CALL PUT_GRIDTYPE_GAUSS(ZGRID_PAR2,INLATI,ZLAPO,ZLOPO,ZCODIL,INLOPA(:), & 00122 KMASK_SIZE,ZLAT2,ZLON2,ZLAT_XY2,ZLON_XY2,ZMESH_SIZE2) 00123 ! 00124 DEALLOCATE(ZLAT_XY2) 00125 DEALLOCATE(ZLON_XY2) 00126 DEALLOCATE(ZLAT2) 00127 DEALLOCATE(ZLON2) 00128 DEALLOCATE(ZMESH_SIZE2) 00129 !---------------------------------------------------------------------------- 00130 ! 00131 IF (OPACK) THEN 00132 PGRID_PAR2(:) = ZGRID_PAR2(:) 00133 ELSE 00134 KGRID_PAR2 = SIZE(ZGRID_PAR2(:)) 00135 END IF 00136 ! 00137 DEALLOCATE(ZGRID_PAR2) 00138 DEALLOCATE(INLOPA) 00139 IF (LHOOK) CALL DR_HOOK('PACK_GRID_GAUSS',1,ZHOOK_HANDLE) 00140 !------------------------------------------------------------------------------- 00141 ! 00142 END SUBROUTINE PACK_GRID_GAUSS
1.8.0
