Oasis3 4.0.2
|
00001 SUBROUTINE pmrhal (pr1to2, k1to2, kw1to2, 00002 $ px1, py1, kmsk1, kngx1, kngy1, cdper1, kper1, 00003 $ px2, py2, kmsk2, kngx2, kngy2, cdper2, kper2, 00004 $ kvma1, kvma2, kmskz2, kvmsz2) 00005 C**** 00006 C ***************************** 00007 C * OASIS ROUTINE - LEVEL 3 * 00008 C * ------------- ------- * 00009 C ***************************** 00010 C 00011 C**** *pmrhal* - Calculate weights and adresses for all the target grid 00012 C 00013 C Purpose: 00014 C ------- 00015 C For each point of a target grid 2 give the kw1to2 closest neighbours 00016 C adresses k1to2 in source grid 1 and their weight pr1to2. 00017 C Here, neighbours are those in the mesh overlapped by each target point 00018 C and weights are proportional to the surface mesh intersections. 00019 C 2D grid assumptions are made here. 00020 C 00021 C 00022 C** Interface: 00023 C --------- 00024 C *CALL* *pmrhal(pr1to2, k1to2, kw1to2, 00025 C px1, py1, kmsk1, kngx1, kngy1, cdper1, kper1, 00026 C px2, py2, kmsk2, kngx2, kngy2, cdper2, kper2, 00027 C kvma1, kvma2, kmskz2, kvmsz2)* 00028 C Input: 00029 C ----- 00030 C kw1to2 : maximum number of overlapped neighbors 00031 C px1 : longitudes for source grid (real 2D) 00032 C py1 : latitudes for source grid (real 2D) 00033 C kmsk1 : the mask for source grid (integer 2D) 00034 C kngx1 : number of longitudes for source grid 00035 C kngy1 : number of latitudes for source grid 00036 C cdper1 : source grid periodicity 00037 C kper1 : number of overlapped points for source grid 00038 C px2 : longitudes for target grid (real 2D) 00039 C py2 : latitudes for target grid (real 2D) 00040 C kmsk2 : the mask of target grid (integer 2D) 00041 C kngx2 : number of longitudes for target grid 00042 C kngy2 : number of latitudes for target grid 00043 C cdper2 : target grid periodicity 00044 C kper2 : number of overlapped points for target grid 00045 C kvma1 : the value of the mask for source grid 00046 C kvma2 : the value of the mask for target grid 00047 C kvmsz2 : mask value for array kmskz2 00048 C 00049 C Output: 00050 C ------ 00051 C pr1to2 : weights for Anaism interpolation (real 3D) 00052 C k1to2 : source grid neighbors adresses (integer 3D) 00053 C kmskz2 : number of source grid neighbors (integer 2D) 00054 C 00055 C Workspace: 00056 C --------- 00057 C None 00058 C 00059 C External: 00060 C -------- 00061 C pmesh, pmrho 00062 C 00063 C References: 00064 C ---------- 00065 C O. Thual, Simple ocean-atmosphere interpolation. 00066 C Part A: The method, EPICOA 0629 (1992) 00067 C Part B: Software implementation, EPICOA 0630 (1992) 00068 C See also OASIS manual (1995) 00069 C 00070 C History: 00071 C ------- 00072 C Version Programmer Date Description 00073 C ------- ---------- ---- ----------- 00074 C 1.1 O. Thual 93/04/15 created 00075 C 2.0 L. Terray 95/10/01 modified: new structure 00076 C 2.3 L. Terray 99/09/15 changed periodicity variables 00077 C 00078 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00079 C 00080 C* ---------------------------- Include files --------------------------- 00081 C 00082 USE mod_kinds_oasis 00083 USE mod_unit 00084 C 00085 C* ---------------------------- Argument declarations ------------------- 00086 C 00087 REAL (kind=ip_realwp_p) px1(kngx1,kngy1), py1(kngx1,kngy1) 00088 REAL (kind=ip_realwp_p) px2(kngx2,kngy2), py2(kngx2,kngy2) 00089 REAL (kind=ip_realwp_p) pr1to2(kw1to2,kngx2,kngy2) 00090 INTEGER (kind=ip_intwp_p) kmsk1(kngx1,kngy1), kmsk2(kngx2,kngy2) 00091 INTEGER (kind=ip_intwp_p) k1to2(kw1to2,kngx2,kngy2), 00092 $ kmskz2(kngx2,kngy2) 00093 CHARACTER*8 cdper1, cdper2 00094 C 00095 C* ---------------------------- Poema verses ---------------------------- 00096 C 00097 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00098 C 00099 C* 1. Neighbours determination 00100 C ------------------------ 00101 C 00102 DO 110 jy = 1, kngy2 00103 DO 120 jx = 1, kngx2 00104 C 00105 C* For all target grid points: zero all weights and set adresses to one 00106 C 00107 DO 130 jwg = 1, kw1to2 00108 pr1to2(jwg,jx,jy) = 0. 00109 k1to2(jwg,jx,jy) = 1 00110 130 CONTINUE 00111 C 00112 C* Calculate the surface of all the target grid squares (masked or not) 00113 C 00114 CALL pmesh (jx, jy, px2, py2, kngx2, kngy2, cdper2, kper2, 00115 $ z2xi, z2xs, z2yi, z2ys) 00116 C 00117 C* Calculate the neighbors in the source grid and their weights 00118 C 00119 CALL pmrho (pr1to2(1,jx,jy), k1to2(1,jx,jy), kw1to2, 00120 $ z2xi, z2xs, z2yi, z2ys, 00121 $ px1, py1, kmsk1, kngx1, kngy1, cdper1, kper1, 00122 $ kvma1, kmskz2(jx,jy), kvmsz2) 00123 C 00124 C* For masked points: 00125 C 00126 IF (kmsk2(jx,jy) .EQ. kvma2) THEN 00127 DO 140 jwg = 1, kw1to2 00128 pr1to2(jwg,jx,jy) = 0. 00129 k1to2(jwg,jx,jy) = 1 00130 140 CONTINUE 00131 ENDIF 00132 120 CONTINUE 00133 110 CONTINUE 00134 C 00135 C* End of routine 00136 C 00137 RETURN 00138 END