|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PACK_PGD_SEAFLUX(HPROGRAM,PSEABATHY) 00003 ! ############################################################## 00004 ! 00005 !!**** *PACK_PGD_SEAFLUX* packs SEAFLUX physiographic fields from all surface points to SEAFLUX points 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! METHOD 00011 !! ------ 00012 !! 00013 ! 00014 !! EXTERNAL 00015 !! -------- 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! AUTHOR 00024 !! ------ 00025 !! 00026 !! P. Le Moigne Meteo-France 00027 !! 00028 !! MODIFICATION 00029 !! ------------ 00030 !! 00031 !! Original 09/2007 00032 !! Lebeaupin-B C. 01/2008 : include bathymetry 00033 !! 00034 !---------------------------------------------------------------------------- 00035 ! 00036 !* 0. DECLARATION 00037 ! ----------- 00038 ! 00039 USE MODD_SEAFLUX_n, ONLY : XSST, XSEABATHY 00040 USE MODD_SEAFLUX_GRID_n, ONLY : NDIM, CGRID, XGRID_PAR 00041 ! 00042 USE MODI_PACK_SAME_RANK 00043 ! 00044 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00045 USE PARKIND1 ,ONLY : JPRB 00046 ! 00047 USE MODI_GET_SURF_MASK_n 00048 ! 00049 USE MODI_GET_TYPE_DIM_n 00050 ! 00051 USE MODI_GET_LUOUT 00052 IMPLICIT NONE 00053 ! 00054 !* 0.1 Declaration of arguments 00055 ! ------------------------ 00056 ! 00057 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program 00058 REAL, DIMENSION(:), INTENT(IN) :: PSEABATHY ! bathymetry 00059 ! 00060 !* 0.2 Declaration of local variables 00061 ! ------------------------------ 00062 ! 00063 INTEGER :: ILU ! expected physical size of full surface array 00064 INTEGER :: ILUOUT ! output listing logical unit 00065 INTEGER, DIMENSION(:), POINTER :: IMASK ! mask for packing from complete field to nature field 00066 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00067 ! 00068 !------------------------------------------------------------------------------- 00069 ! 00070 IF (LHOOK) CALL DR_HOOK('PACK_PGD_SEAFLUX',0,ZHOOK_HANDLE) 00071 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00072 ! 00073 !* 1. Number of points and packing 00074 ! ---------------------------- 00075 ! 00076 CALL GET_TYPE_DIM_n('SEA ',NDIM) 00077 ALLOCATE(IMASK(NDIM)) 00078 ILU=0 00079 CALL GET_SURF_MASK_n('SEA ',NDIM,IMASK,ILU,ILUOUT) 00080 ! 00081 ! 00082 !------------------------------------------------------------------------------- 00083 ! 00084 !* 2. Packing of fields 00085 ! ----------------- 00086 ! 00087 ALLOCATE(XSEABATHY(NDIM)) 00088 CALL PACK_SAME_RANK(IMASK,PSEABATHY(:),XSEABATHY(:)) 00089 IF (LHOOK) CALL DR_HOOK('PACK_PGD_SEAFLUX',1,ZHOOK_HANDLE) 00090 ! 00091 !------------------------------------------------------------------------------- 00092 ! 00093 END SUBROUTINE PACK_PGD_SEAFLUX
1.8.0