|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE INTERPOL_QUADRA(PDAT,PNDAT,PVAL1,PVAL2,PVAL3,POUT) 00003 ! ############################################################# 00004 ! 00005 !!**** *INTERPOL_QUADRA* Quadractic interpolation between 3 month, especially 00006 !! relevant to conserv the SST (or other) monthly mean value. 00007 !! 00008 !! 00009 !! PURPOSE 00010 !! ------- 00011 !! 00012 !! METHOD 00013 !! ------ 00014 !! 00015 !! EXTERNAL 00016 !! -------- 00017 !! 00018 !! IMPLICIT ARGUMENTS 00019 !! ------------------ 00020 !! 00021 !! 00022 !! REFERENCE 00023 !! --------- 00024 !! 00025 !! AUTHOR 00026 !! ------ 00027 !! 00028 !! B. Decharme Meteo-France 00029 !! 00030 !! MODIFICATION 00031 !! ------------ 00032 !! 00033 !! Original 08/2009 00034 !! 18-11-2010 by F. Chauvin : bugfix for temporal interpolation coeff. 00035 !! 00036 !---------------------------------------------------------------------------- 00037 ! 00038 !* 0. DECLARATION 00039 ! ----------- 00040 ! 00041 ! 00042 ! 00043 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00044 USE PARKIND1 ,ONLY : JPRB 00045 ! 00046 IMPLICIT NONE 00047 ! 00048 !* 0.1 Declaration of arguments 00049 ! ------------------------ 00050 ! 00051 REAL, INTENT(IN) :: PDAT ! Present date in the current month 00052 REAL, INTENT(IN) :: PNDAT ! Number of date in the current month 00053 REAL, DIMENSION(:), INTENT(IN) :: PVAL1 ! Value of the precedent month 00054 REAL, DIMENSION(:), INTENT(IN) :: PVAL2 ! Value of the current month 00055 REAL, DIMENSION(:), INTENT(IN) :: PVAL3 ! Value of the next month 00056 REAL, DIMENSION(:), INTENT(OUT) :: POUT ! Interpolated value 00057 ! 00058 ! 00059 !* 0.2 Declaration of other local variables 00060 ! ------------------------------------ 00061 ! 00062 REAL, DIMENSION(:), ALLOCATABLE :: ZMID1 ! Mid point between t-1 and t 00063 REAL, DIMENSION(:), ALLOCATABLE :: ZMID2 ! Mid point between t+1 and t 00064 REAL, DIMENSION(:), ALLOCATABLE :: ZA ! Interpolation coef 00065 REAL, DIMENSION(:), ALLOCATABLE :: ZB ! Interpolation coef 00066 REAL, DIMENSION(:), ALLOCATABLE :: ZC ! Interpolation coef 00067 ! 00068 REAL :: ZSCARRE ! Quadratic coef 00069 REAL :: ZSUM ! Quadratic coef 00070 ! 00071 INTEGER :: JDAT, INDAT 00072 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00073 ! 00074 !---------------------------------------------------------------------------- 00075 ! 00076 !* 0. Allocation 00077 ! ---------- 00078 ! 00079 IF (LHOOK) CALL DR_HOOK('INTERPOL_QUADRA',0,ZHOOK_HANDLE) 00080 ALLOCATE(ZMID1(SIZE(PVAL1))) 00081 ALLOCATE(ZMID2(SIZE(PVAL1))) 00082 ALLOCATE(ZA(SIZE(PVAL1))) 00083 ALLOCATE(ZB(SIZE(PVAL1))) 00084 ALLOCATE(ZC(SIZE(PVAL1))) 00085 ! 00086 !* 1. Initialization 00087 ! -------------- 00088 ! 00089 ZSCARRE = 0.0 00090 ZSUM = 0.0 00091 ! 00092 INDAT = INT(PNDAT) 00093 ! 00094 DO JDAT=1,INDAT 00095 ZSCARRE = ZSCARRE + REAL(JDAT*JDAT) 00096 ZSUM = ZSUM + REAL(JDAT) 00097 ENDDO 00098 ! 00099 !* 2. Mid points 00100 ! ---------- 00101 ! 00102 ZMID1(:) = 0.5 * (PVAL2(:)+PVAL1(:)) 00103 ZMID2(:) = 0.5 * (PVAL2(:)+PVAL3(:)) 00104 ! 00105 ! 00106 !* 3. Coef calculation 00107 ! ---------------- 00108 ! 00109 ZA(:) = ((PVAL2(:)-ZMID1(:))*PNDAT - (ZMID2(:)-ZMID1(:))*(ZSUM-PNDAT)/PNDAT) & 00110 / ((ZSCARRE-PNDAT)-(ZSUM-PNDAT)*(PNDAT+2.0)) 00111 ! 00112 ZB(:) = ((ZMID2(:)-ZMID1(:)) - (PNDAT*(PNDAT+2.0) * ZA(:))) / PNDAT 00113 ! 00114 ZC(:) = ZMID1(:) - ZA(:) - ZB(:) 00115 ! 00116 !* 3. Final calculation 00117 ! ----------------- 00118 ! 00119 POUT(:) = ZA(:) * PDAT**2 + ZB(:) * PDAT + ZC(:) 00120 ! 00121 !* 4. End 00122 ! --- 00123 ! 00124 DEALLOCATE(ZMID1) 00125 DEALLOCATE(ZMID2) 00126 DEALLOCATE(ZA) 00127 DEALLOCATE(ZB) 00128 DEALLOCATE(ZC) 00129 IF (LHOOK) CALL DR_HOOK('INTERPOL_QUADRA',1,ZHOOK_HANDLE) 00130 ! 00131 !------------------------------------------------------------------------------- 00132 ! 00133 END SUBROUTINE INTERPOL_QUADRA
1.8.0
