| 1 | C |
|---|
| 2 | C+ |
|---|
| 3 | C |
|---|
| 4 | C .. _forfilter.f: |
|---|
| 5 | C |
|---|
| 6 | C =========== |
|---|
| 7 | C forfilter.f |
|---|
| 8 | C =========== |
|---|
| 9 | C |
|---|
| 10 | C DESCRIPTION |
|---|
| 11 | C =========== |
|---|
| 12 | C |
|---|
| 13 | C filtre kiser ++ |
|---|
| 14 | C |
|---|
| 15 | C EXAMPLES |
|---|
| 16 | C ======== |
|---|
| 17 | C |
|---|
| 18 | C SEE ALSO |
|---|
| 19 | C ======== |
|---|
| 20 | C |
|---|
| 21 | C :ref:`progfiltrage_simulation.F90` |
|---|
| 22 | C |
|---|
| 23 | C TODO |
|---|
| 24 | C ==== |
|---|
| 25 | C |
|---|
| 26 | C improve comments |
|---|
| 27 | C |
|---|
| 28 | C add IMPLICIT NONE |
|---|
| 29 | C |
|---|
| 30 | C find bibliographical reference |
|---|
| 31 | C |
|---|
| 32 | C f90 module |
|---|
| 33 | C |
|---|
| 34 | C 2 subroutines so 2 ReSt blocks and 2 files .rst |
|---|
| 35 | C |
|---|
| 36 | C EVOLUTIONS |
|---|
| 37 | C ========== |
|---|
| 38 | C |
|---|
| 39 | C $Id$ |
|---|
| 40 | C |
|---|
| 41 | C - fplod 2009-02-10T11:11:33Z aedon.locean-ipsl.upmc.fr (Darwin) |
|---|
| 42 | C |
|---|
| 43 | C * replace FLOAT use by generic function REAL |
|---|
| 44 | C |
|---|
| 45 | C - fplod 2009-02-03T09:21:30Z aedon.locean-ipsl.upmc.fr (Darwin) |
|---|
| 46 | C |
|---|
| 47 | C * creation form SIMUL_IRCAAM/progfiltrage_10_30.f |
|---|
| 48 | C * Comments in ReST |
|---|
| 49 | C |
|---|
| 50 | C- |
|---|
| 51 | C |
|---|
| 52 | SUBROUTINE FILTRE(F,F1,PERIO,N) |
|---|
| 53 | |
|---|
| 54 | IMPLICIT NONE |
|---|
| 55 | |
|---|
| 56 | INTEGER, PARAMETER :: KOR = 4 |
|---|
| 57 | INTEGER, PARAMETER :: JOR = 4 |
|---|
| 58 | INTEGER, PARAMETER :: MOR = 50 |
|---|
| 59 | |
|---|
| 60 | INTEGER, INTENT(IN) :: N |
|---|
| 61 | REAL, INTENT(IN), DIMENSION(N) :: F |
|---|
| 62 | REAL :: W(-mor:mor) |
|---|
| 63 | REAL :: G(-mor:mor) |
|---|
| 64 | REAL, INTENT(OUT) :: F1(N) |
|---|
| 65 | REAL, INTENT(IN) :: PERIO |
|---|
| 66 | |
|---|
| 67 | INTEGER :: I |
|---|
| 68 | INTEGER :: K |
|---|
| 69 | INTEGER :: L1 |
|---|
| 70 | INTEGER :: L2 |
|---|
| 71 | |
|---|
| 72 | REAL :: FC |
|---|
| 73 | REAL :: AT |
|---|
| 74 | REAL :: PI |
|---|
| 75 | |
|---|
| 76 | PI=ACOS(-1.) |
|---|
| 77 | FC=1./PERIO |
|---|
| 78 | CALL KISER(G,MOR) |
|---|
| 79 | DO 1 I=-MOR,MOR |
|---|
| 80 | IF (I.EQ.0) THEN |
|---|
| 81 | W(I)=2.*FC |
|---|
| 82 | ELSE |
|---|
| 83 | W(I)=SIN(2.*PI*FC*REAL(I))/(PI*REAL(I))*G(I) |
|---|
| 84 | ENDIF |
|---|
| 85 | 1 CONTINUE |
|---|
| 86 | |
|---|
| 87 | DO 2 I=1,N |
|---|
| 88 | F1(I)=0. |
|---|
| 89 | AT=0. |
|---|
| 90 | |
|---|
| 91 | IF(I.LE.KOR) THEN |
|---|
| 92 | L1=-KOR |
|---|
| 93 | L2=I-1 |
|---|
| 94 | ENDIF |
|---|
| 95 | |
|---|
| 96 | IF((I.GE.KOR+1).AND.(I.LE.MOR)) THEN |
|---|
| 97 | L1=-I+1 |
|---|
| 98 | L2=I-1 |
|---|
| 99 | ENDIF |
|---|
| 100 | |
|---|
| 101 | IF((I.GE.MOR+1).AND.(I.LE.N-MOR)) THEN |
|---|
| 102 | L1=-MOR |
|---|
| 103 | L2=MOR |
|---|
| 104 | ENDIF |
|---|
| 105 | |
|---|
| 106 | IF((I.GE.N-MOR+1).AND.(I.LE.N-JOR)) THEN |
|---|
| 107 | L1=-N+I |
|---|
| 108 | L2=N-I |
|---|
| 109 | ENDIF |
|---|
| 110 | |
|---|
| 111 | IF(I.GE.N-JOR+1) THEN |
|---|
| 112 | L1=-N+I |
|---|
| 113 | L2=JOR |
|---|
| 114 | ENDIF |
|---|
| 115 | |
|---|
| 116 | DO 3 K=L1,L2 |
|---|
| 117 | F1(I)=F1(I)+W(K)*F(I-K) |
|---|
| 118 | AT=AT+W(K) |
|---|
| 119 | 3 CONTINUE |
|---|
| 120 | F1(I)=F1(I)/AT |
|---|
| 121 | 2 CONTINUE |
|---|
| 122 | |
|---|
| 123 | RETURN |
|---|
| 124 | END |
|---|
| 125 | |
|---|
| 126 | SUBROUTINE KISER(W,MOR) |
|---|
| 127 | C |
|---|
| 128 | IMPLICIT NONE |
|---|
| 129 | |
|---|
| 130 | INTEGER, INTENT(IN) :: MOR |
|---|
| 131 | INTEGER, PARAMETER :: LOR = 100 |
|---|
| 132 | REAL, INTENT(INOUT), DIMENSION(-MOR:MOR) :: W |
|---|
| 133 | REAL CO(-LOR:LOR) |
|---|
| 134 | |
|---|
| 135 | REAL :: A |
|---|
| 136 | REAL :: AS |
|---|
| 137 | REAL :: AS1 |
|---|
| 138 | REAL :: AU |
|---|
| 139 | REAL :: AU1 |
|---|
| 140 | REAL :: ALPHA |
|---|
| 141 | INTEGER :: I |
|---|
| 142 | INTEGER :: K |
|---|
| 143 | INTEGER :: N |
|---|
| 144 | |
|---|
| 145 | A=30. |
|---|
| 146 | |
|---|
| 147 | IF(A.LE.21.) THEN |
|---|
| 148 | ALPHA=0. |
|---|
| 149 | ENDIF |
|---|
| 150 | |
|---|
| 151 | IF((A.LT.50.).AND.(A.GT.21.)) THEN |
|---|
| 152 | ALPHA=0.5842*(A-21.)**0.4+0.07886*(A-21.) |
|---|
| 153 | ENDIF |
|---|
| 154 | |
|---|
| 155 | IF(A.GE.50.) THEN |
|---|
| 156 | ALPHA=0.1102*(A-8.7) |
|---|
| 157 | ENDIF |
|---|
| 158 | |
|---|
| 159 | DO 2 I=-MOR,MOR |
|---|
| 160 | CO(I)=ALPHA*SQRT(1.-(REAL(I)/REAL(MOR))**2) |
|---|
| 161 | |
|---|
| 162 | N=0 |
|---|
| 163 | AS=1. |
|---|
| 164 | AU=1. |
|---|
| 165 | AS1=1. |
|---|
| 166 | AU1=1. |
|---|
| 167 | |
|---|
| 168 | DO 10 K=1,200 |
|---|
| 169 | N=N+1 |
|---|
| 170 | |
|---|
| 171 | AU=AU*((CO(I)/2.)/FLOAT(N))**2 |
|---|
| 172 | AS=AS+AU |
|---|
| 173 | |
|---|
| 174 | AU1=AU1*((ALPHA/2.)/FLOAT(N))**2 |
|---|
| 175 | AS1=AS1+AU1 |
|---|
| 176 | 10 CONTINUE |
|---|
| 177 | W(I)=AS/AS1 |
|---|
| 178 | 2 CONTINUE |
|---|
| 179 | RETURN |
|---|
| 180 | END |
|---|
