[1677] | 1 | SUBROUTINE pcssph (px, py, psgr, kngx, kngy) |
---|
| 2 | C**** |
---|
| 3 | C ***************************** |
---|
| 4 | C * OASIS ROUTINE - LEVEL T * |
---|
| 5 | C * ------------- ------- * |
---|
| 6 | C ***************************** |
---|
| 7 | C |
---|
| 8 | C**** *pcssph* - Arithmetic routine |
---|
| 9 | C |
---|
| 10 | C Purpose: |
---|
| 11 | C ------- |
---|
| 12 | C Calculate surface element for a spheric and periodic grid. |
---|
| 13 | C The coordinates are in degrees, there are no pole points. |
---|
| 14 | C |
---|
| 15 | C** Interface: |
---|
| 16 | C --------- |
---|
| 17 | C *CALL* *pcssph(px, py, psgr, kngx, kngy)* |
---|
| 18 | C |
---|
| 19 | C Input: |
---|
| 20 | C ----- |
---|
| 21 | C px : grid longitudes (real 2D) |
---|
| 22 | C py : grid latitudes (real 2D) |
---|
| 23 | C kngx : number of longitudes |
---|
| 24 | C kngy : number of latitudes |
---|
| 25 | C |
---|
| 26 | C Output: |
---|
| 27 | C ------ |
---|
| 28 | C psgr : grid surface elements (real 2D) |
---|
| 29 | C |
---|
| 30 | C |
---|
| 31 | C Workspace: |
---|
| 32 | C --------- |
---|
| 33 | C None |
---|
| 34 | C |
---|
| 35 | C External: |
---|
| 36 | C -------- |
---|
| 37 | C None |
---|
| 38 | C |
---|
| 39 | C References: |
---|
| 40 | C ---------- |
---|
| 41 | C O. Thual, Simple ocean-atmosphere interpolation. |
---|
| 42 | C Part A: The method, EPICOA 0629 (1992) |
---|
| 43 | C Part B: Software implementation, EPICOA 0630 (1992) |
---|
| 44 | C See also OASIS manual (1995) |
---|
| 45 | C |
---|
| 46 | C History: |
---|
| 47 | C ------- |
---|
| 48 | C Version Programmer Date Description |
---|
| 49 | C ------- ---------- ---- ----------- |
---|
| 50 | C 1.1 O. Thual 93/04/15 created |
---|
| 51 | C 2.0 L. Terray 95/10/01 modified: new structure |
---|
| 52 | C |
---|
| 53 | C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
| 54 | C |
---|
| 55 | C* ---------------------------- Include files --------------------------- |
---|
| 56 | C |
---|
| 57 | USE mod_kinds_oasis |
---|
| 58 | USE mod_unit |
---|
| 59 | C |
---|
| 60 | C* ---------------------------- Argument declarations ------------------- |
---|
| 61 | C |
---|
| 62 | REAL (kind=ip_realwp_p) px(kngx,kngy), py(kngx,kngy) |
---|
| 63 | REAL (kind=ip_realwp_p) psgr(kngx,kngy) |
---|
| 64 | C |
---|
| 65 | C* ---------------------------- Poema verses ---------------------------- |
---|
| 66 | C |
---|
| 67 | C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
| 68 | C |
---|
| 69 | C* 1. Degres to radians conversion factor |
---|
| 70 | C ----------------------------------- |
---|
| 71 | C |
---|
| 72 | zconv = 1.74532925199432957692e-2 |
---|
| 73 | C |
---|
| 74 | C |
---|
| 75 | C* 2. Surfaces |
---|
| 76 | C -------- |
---|
| 77 | C |
---|
| 78 | DO 210 j2 = 1, kngy |
---|
| 79 | DO 220 j1 = 1, kngx |
---|
| 80 | C |
---|
| 81 | C* Left or right periodicity |
---|
| 82 | C |
---|
| 83 | IF (J1 .EQ. 1) THEN |
---|
| 84 | zx1 = px(kngx,j2) - 360. |
---|
| 85 | zx2 = px(2,j2) |
---|
| 86 | ELSE IF (j1 .EQ. kngx) THEN |
---|
| 87 | zx1 = px(kngx-1,j2) |
---|
| 88 | zx2 = px(1,j2) + 360. |
---|
| 89 | ELSE |
---|
| 90 | zx1 = px(j1-1,j2) |
---|
| 91 | zx2 = px(j1+1,j2) |
---|
| 92 | ENDIF |
---|
| 93 | C |
---|
| 94 | C* Bottom or top treatment |
---|
| 95 | C |
---|
| 96 | IF (j2 .EQ. 1) THEN |
---|
| 97 | zy1 = -90. |
---|
| 98 | zy2 = .5 * (py(j1,j2) + py(j1,j2+1)) |
---|
| 99 | ELSE IF (j2 .EQ. kngy) THEN |
---|
| 100 | zy1 = .5 * (py(j1,j2) + py(j1,j2-1)) |
---|
| 101 | zy2 = 90. |
---|
| 102 | ELSE |
---|
| 103 | zy1 = .5 * (py(j1,j2) + py(j1,j2-1)) |
---|
| 104 | zy2 = .5 * (py(j1,j2) + py(j1,j2+1)) |
---|
| 105 | ENDIF |
---|
| 106 | C |
---|
| 107 | C* Conversion to radians |
---|
| 108 | C |
---|
| 109 | zfi1 = zx1 * zconv |
---|
| 110 | zfi2 = zx2 * zconv |
---|
| 111 | zth1 = zy1 * zconv |
---|
| 112 | zth2 = zy2 * zconv |
---|
| 113 | C |
---|
| 114 | C* Calculate grid square surface |
---|
| 115 | C |
---|
| 116 | zfac = sin(zth2) - sin(zth1) |
---|
| 117 | psgr(j1,j2) = abs(.5 * (zfi2-zfi1) * zfac) |
---|
| 118 | 220 continue |
---|
| 119 | 210 CONTINUE |
---|
| 120 | C |
---|
| 121 | C* End of routine |
---|
| 122 | C |
---|
| 123 | RETURN |
---|
| 124 | END |
---|
| 125 | |
---|
| 126 | |
---|
| 127 | |
---|
| 128 | |
---|
| 129 | |
---|
| 130 | |
---|
| 131 | |
---|