| 1 | ! -*- Mode: f90 -*- |
|---|
| 2 | MODULE mod_wripoly |
|---|
| 3 | CONTAINS |
|---|
| 4 | SUBROUTINE wripoly |
|---|
| 5 | !> |
|---|
| 6 | !! Write polygones of ocean and atmosphere on a restricted area in two files, |
|---|
| 7 | !! for a later use for test of the method to find common surfaces between two polygones. |
|---|
| 8 | !! |
|---|
| 9 | USE declare |
|---|
| 10 | USE modeles |
|---|
| 11 | USE mod_proj |
|---|
| 12 | IMPLICIT NONE |
|---|
| 13 | !! |
|---|
| 14 | INTEGER (kind=il) :: jo, ja, jn, nn, kp, kerr(9) |
|---|
| 15 | REAL (kind=rd) :: xl, xu, yl, yu, plon0, plat0 |
|---|
| 16 | REAL (kind=rd), DIMENSION (9) :: px, py |
|---|
| 17 | !! |
|---|
| 18 | !! bounds of area |
|---|
| 19 | xl = 0.0_rl ; xu = 20.0_rl ; yl = 60.0_rl ; yu = 80.0_rl |
|---|
| 20 | !! Pole of projection |
|---|
| 21 | plon0 = 0.5 * ( xl + xu ) ; plat0 = 0.5 * ( yl + yu) |
|---|
| 22 | !! Type of projection |
|---|
| 23 | kp = 2 |
|---|
| 24 | !! |
|---|
| 25 | !! Atmosphere |
|---|
| 26 | OPEN ( unit = 36, file = 'poly.atm', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' ) |
|---|
| 27 | ! |
|---|
| 28 | nn = 0 |
|---|
| 29 | DO ja = 1, jpan |
|---|
| 30 | IF ( MINVAL ( xa_ed (ja,:)) .LE. xu .AND. MAXVAL ( xa_ed(ja,:)) .GE. xl & |
|---|
| 31 | & .AND. MINVAL ( ya_ed (ja,:)) .LE. yu .AND. MAXVAL ( ya_ed(ja,:)) .GE. yl ) THEN |
|---|
| 32 | DO jn = 1, jpae |
|---|
| 33 | CALL proj ( xa_ed(ja,jn), ya_ed(ja,jn), plon0, plat0, px(jn), py(jn), kp, kerr(jn) ) |
|---|
| 34 | END DO |
|---|
| 35 | IF ( SUM(kerr) == 0 ) THEN |
|---|
| 36 | WRITE ( unit = 36, fmt = '(16F9.4)' ) ( (/ px(jn), py(jn) /), jn = 1, jpae-1 ) |
|---|
| 37 | nn = nn + 1 |
|---|
| 38 | END IF |
|---|
| 39 | END IF |
|---|
| 40 | END DO |
|---|
| 41 | CLOSE ( unit = 36) |
|---|
| 42 | !! |
|---|
| 43 | !! Ocean |
|---|
| 44 | OPEN ( unit = 36, file = 'poly.oce', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' ) |
|---|
| 45 | ! |
|---|
| 46 | nn = 0 |
|---|
| 47 | DO jo = 1, jpon |
|---|
| 48 | IF ( MINVAL ( xo_ed (jo,:)) .LE. xu .AND. MAXVAL ( xo_ed(jo,:)) .GE. xl & |
|---|
| 49 | & .AND. MINVAL ( yo_ed (jo,:)) .LE. yu .AND. MAXVAL ( yo_ed(jo,:)) .GE. yl ) THEN |
|---|
| 50 | DO jn = 1, jpoe |
|---|
| 51 | CALL proj ( xo_ed(jo,jn), yo_ed(jo,jn), plon0, plat0, px(jn), py(jn), kp, kerr(jn) ) |
|---|
| 52 | END DO |
|---|
| 53 | IF ( SUM(kerr) == 0 ) THEN |
|---|
| 54 | WRITE ( unit = 36, fmt = '(16F9.4)' ) ( (/ px(jn), py(jn) /), jn = 1, jpae-1 ) |
|---|
| 55 | nn = nn + 1 |
|---|
| 56 | END IF |
|---|
| 57 | END IF |
|---|
| 58 | END DO |
|---|
| 59 | CLOSE ( unit = 36) |
|---|
| 60 | !! |
|---|
| 61 | RETURN |
|---|
| 62 | !! |
|---|
| 63 | END SUBROUTINE wripoly |
|---|
| 64 | END MODULE mod_wripoly |
|---|
