|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ################################################ 00002 SUBROUTINE INTERPOL_FIELD2D(HPROGRAM,KLUOUT,KCODE,PFIELD,HFIELD,PDEF,KNPTS) 00003 ! ################################################ 00004 ! 00005 !!**** *INTERPOL_FIELD* initializes coordinate system for spline interpolation 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !! The points are all on only one grid (defined with the coordinates 00011 !! of all the points). The code to apply for each point is: 00012 !! 00013 !! KCODE>0 : data point (with field valid for interpolation) 00014 !! KCODE=-1: point to ignore 00015 !! KCODE=0 : point to interpolate 00016 !! 00017 !! 00018 !! 00019 !! AUTHOR 00020 !! ------ 00021 !! 00022 !! V. Masson Meteo-France 00023 !! 00024 !! MODIFICATION 00025 !! ------------ 00026 !! 00027 !! Original 01/2004 00028 !! Modification 00029 !---------------------------------------------------------------------------- 00030 ! 00031 !* 0. DECLARATION 00032 ! ----------- 00033 ! 00034 USE MODD_SURF_PAR, ONLY : XUNDEF 00035 USE MODD_SURF_ATM_n, ONLY : NDIM_FULL, NSIZE_FULL 00036 USE MODD_SURF_ATM_GRID_n, ONLY : CGRID 00037 USE MODI_GET_GRID_COORD 00038 USE MODI_INTERPOL_NPTS 00039 USE MODI_SUM_ON_ALL_PROCS 00040 ! 00041 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00042 USE PARKIND1 ,ONLY : JPRB 00043 ! 00044 IMPLICIT NONE 00045 ! 00046 !* 0.1 Declaration of arguments 00047 ! ------------------------ 00048 ! 00049 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! host program 00050 INTEGER, INTENT(IN) :: KLUOUT ! output listing 00051 INTEGER,DIMENSION(:), INTENT(INOUT) :: KCODE ! code for each point 00052 ! >0 point used for interpolation 00053 ! 0 point to interpolate 00054 ! -1 point not used 00055 ! -2 point not used 00056 ! ! -3 if spline is no computed 00057 ! ! for this point 00058 REAL, DIMENSION(:,:),INTENT(INOUT) :: PFIELD ! pgd field on grid mesh. 00059 CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! name of the field for prints 00060 REAL,DIMENSION(:),OPTIONAL, INTENT(IN):: PDEF ! default value if not enough data 00061 INTEGER, OPTIONAL, INTENT(IN) :: KNPTS ! number of points to interpolate with 00062 00063 ! 00064 !* 0.2 Declaration of local variables 00065 ! ------------------------------ 00066 ! 00067 REAL, DIMENSION(SIZE(KCODE)) :: ZX ! coordinate used for 00068 REAL, DIMENSION(SIZE(KCODE)) :: ZY ! splines interpolation 00069 REAL, DIMENSION(SIZE(PFIELD,2)):: ZDEF ! default value for field 00070 INTEGER :: INPTS ! number of points to interpolate with 00071 00072 ! 00073 INTEGER :: JLOOP ! loop counter 00074 ! 00075 INTEGER :: IERR1 ! number of points interpolated 00076 INTEGER :: IERR2 ! number of points not interpolated in the end 00077 ! 00078 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00079 !------------------------------------------------------------------------------- 00080 ! 00081 IF (LHOOK) CALL DR_HOOK('INTERPOL_FIELD:INTERPOL_FIELD2D',0,ZHOOK_HANDLE) 00082 ! 00083 INPTS = 3 00084 IF (PRESENT(KNPTS)) INPTS = KNPTS 00085 ! 00086 ZDEF = XUNDEF 00087 IF (PRESENT(PDEF)) ZDEF = PDEF 00088 ! 00089 !* 2. Miscellaneous Initializations 00090 ! ----------------------------- 00091 ! 00092 CALL GET_GRID_COORD(KLUOUT,PX=ZX,PY=ZY) 00093 ! 00094 !------------------------------------------------------------------------------- 00095 ! 00096 !* 5. Interpolation with 3 nearest points 00097 ! ----------------------------------- 00098 ! 00099 CALL INTERPOL_NPTS(HPROGRAM,KLUOUT,INPTS,KCODE,ZX,ZY,PFIELD) 00100 ! 00101 !------------------------------------------------------------------------------- 00102 ! 00103 !* 6. Final check 00104 ! ----------- 00105 ! 00106 IERR1 = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,KCODE(:)==0) 00107 IERR2 = SUM_ON_ALL_PROCS(HPROGRAM,CGRID,KCODE(:)==-4) 00108 ! 00109 IF (IERR1>0 .OR. IERR2>0) THEN 00110 ! 00111 WRITE(KLUOUT,*) ' ' 00112 WRITE(KLUOUT,*) ' Interpolation of field : ',HFIELD 00113 WRITE(KLUOUT,*) ' ----------------------' 00114 WRITE(KLUOUT,*) ' ' 00115 WRITE(KLUOUT,*) ' Number of points interpolated with ',INPTS,' nearest points: ', & 00116 IERR1 00117 ! 00118 ! 00119 IF (IERR2>0) THEN 00120 WRITE(KLUOUT,*) ' Number of points that could not be interpolated : ', & 00121 IERR2 00122 IF (PRESENT(PDEF)) THEN 00123 DO JLOOP=1,SIZE(PFIELD,2) 00124 WHERE(KCODE(:)==-4) 00125 PFIELD(:,JLOOP)=PDEF(JLOOP) 00126 END WHERE 00127 WRITE(KLUOUT,*) ' For these points, the default value (',PDEF(JLOOP),') is set.' 00128 END DO 00129 ELSE 00130 WRITE(KLUOUT,*) ' Please provide data with better resolution' 00131 WRITE(KLUOUT,*) ' Or define a higher halo value ' 00132 CALL ABOR1_SFX('Some points lack data and are too far away from other points') 00133 END IF 00134 END IF 00135 ! 00136 END IF 00137 ! 00138 IF (LHOOK) CALL DR_HOOK('INTERPOL_FIELD:INTERPOL_FIELD2D',1,ZHOOK_HANDLE) 00139 !------------------------------------------------------------------------------- 00140 ! 00141 END SUBROUTINE INTERPOL_FIELD2D
1.8.0
