transf.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\transf.f
00002 !
00064                      SUBROUTINE TRANSF
00065 !                    *****************
00066 !
00067      &( FA    , FR    , FREQ  , DFREQ , COSTET, SINTET, UC    , VC    ,
00068      &  XK    , KNEW  , NEWF  , NEWF1 , TAUX1 , TAUX2 , NPOIN2, NPLAN ,
00069      &  NF    , RAISF , LT    , GRADEB, GRAPRD)
00070 !
00071 !***********************************************************************
00072 ! TOMAWAC   V6P1                                   28/06/2011
00073 !***********************************************************************
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00081 !| COSTET         |-->| COSINE OF TETA ANGLE
00082 !| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
00083 !| FA             |<--| DIRECTIONAL SPECTRUM IN ABSOLUTE FREQUENCIES
00084 !| FR             |-->| DIRECTIONAL SPECTRUM IN RELATIVE FREQUENCIES
00085 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00086 !| GRADEB         |-->| N.OF FIRST ITERATION FOR GRAPHICS PRINTOUTS
00087 !| GRAPRD         |-->| PERIOD FOR GRAPHIC PRINTOUTS
00088 !| KNEW           |<->| WORK TABLE
00089 !| LT             |-->| NUMBER OF THE TIME STEP CURRENTLY SOLVED
00090 !| NEWF           |<->| WORK TABLE
00091 !| NEWF1          |<->| WORK TABLE
00092 !| NF             |-->| NUMBER OF FREQUENCIES
00093 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00094 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00095 !| RAISF          |-->| RAISON FREQUENTIELLE
00096 !| SINTET         |-->| SINE OF TETA ANGLE
00097 !| TAUX1          |<->| WORK TABLE
00098 !| TAUX2          |<->| WORK TABLE
00099 !| UC             |-->| CURRENT VELOCITY ALONG X AT THE MESH POINTS
00100 !| VC             |-->| CURRENT VELOCITY ALONG Y AT THE MESH POINTS
00101 !| XK             |-->| DISCRETIZED WAVE NUMBER
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       USE DECLARATIONS_TOMAWAC, ONLY : USDPI
00105 !
00106       IMPLICIT NONE
00107 !
00108 !.....VARIABLES IN ARGUMENT
00109 !     """"""""""""""""""""
00110       INTEGER          NPOIN2, NPLAN , NF    , LT    , GRADEB, GRAPRD
00111       INTEGER          KNEW(NPOIN2)  , NEWF(NPOIN2)  , NEWF1(NPOIN2)
00112       DOUBLE PRECISION RAISF
00113       DOUBLE PRECISION FA(NPOIN2,NPLAN,NF),FR(NPOIN2,NPLAN,NF)
00114       DOUBLE PRECISION FREQ(NF),DFREQ(NF),COSTET(NPLAN),SINTET(NPLAN)
00115       DOUBLE PRECISION UC(NPOIN2),VC(NPOIN2),TAUX1(NPOIN2),TAUX2(NPOIN2)
00116       DOUBLE PRECISION XK(NPOIN2,NF)
00117 !
00118 !.....LOCAL VARIABLES
00119 !     """""""""""""""""
00120       INTEGER          IP    , JP    , JF    , NEWM  , NEWM1 , KH
00121       DOUBLE PRECISION F0    , UK    , AUXI , Y(1) , Z
00122       DOUBLE PRECISION FNEW  , UNSLRF
00123       LOGICAL          IMP
00124 !
00125 !-----------------------------------------------------------------------
00126 !     CHANGES ONLY THE END DATES
00127 !-----------------------------------------------------------------------
00128 !
00129       IMP=.FALSE.
00130       IF(LT.GE.GRADEB.AND.MOD(LT-GRADEB,GRAPRD).EQ.0) IMP=.TRUE.
00131       IF(.NOT.IMP) RETURN
00132 !
00133 !-----------------------------------------------------------------------
00134 !
00135       F0=FREQ(1)
00136       UNSLRF=1.D0/LOG(RAISF)
00137 !
00138       CALL OV('X=C     ',FA,Y,Y,0.D0,NPOIN2*NPLAN*NF)
00139 !
00140       DO JF=1,NF
00141 !
00142         DO JP=1,NPLAN
00143 !
00144           DO IP=1,NPOIN2
00145 !
00146 !           ---------------------------------------------------------
00147 !           COMPUTES THE DIFFERENCE BETWEEN ABSOLUTE AND RELATIVE FREQUENCIES
00148 !                                            -> ->
00149 !                 Z = FREQ_ABS - FREQ_REL = (K .U)/(2.PI)
00150 !           THE SPECTRUM IS PROJECTED ONTO THE ABSOLUTE FREQUENCIES
00151 !           ONLY IF THE RELATIVE VARIATION Z/FREQ_REL IS SIGNIFICANT
00152 !           ---------------------------------------------------------
00153             UK=SINTET(JP)*UC(IP)+COSTET(JP)*VC(IP)
00154 !
00155             Z=UK*XK(IP,JF)*USDPI
00156 !
00157             IF(ABS(Z)/FREQ(JF).LT.1.D-3) THEN
00158               KNEW (IP)=JP
00159               NEWF (IP)=JF
00160               NEWF1(IP)=-1
00161               TAUX1(IP)=FR(IP,JP,JF)
00162               TAUX2(IP)=0.D0
00163             ELSE
00164 !
00165 !             -------------------------------------------------------
00166 !             COMPUTES FNEW AND KNEW
00167 !             -------------------------------------------------------
00168 !
00169               FNEW = FREQ(JF)+Z
00170               IF(FNEW.GT.0.D0) THEN
00171                 KNEW(IP)=JP
00172               ELSE
00173                 KNEW(IP)=1+MOD(JP+NPLAN/2-1,NPLAN)
00174                 FNEW=0.D0
00175               ENDIF
00176 !
00177 !             -------------------------------------------------------
00178 !             COMPUTES NEWF: INDEX OF THE DISCRETISED FREQUENCY
00179 !             IMMEDIATELY LOWER THAN FNEW
00180 !             -------------------------------------------------------
00181 !
00182               IF(FNEW.LT.F0/RAISF) THEN
00183                 NEWF(IP)=-1
00184               ELSE
00185                 NEWF(IP)=INT(1.D0+LOG(FNEW/F0)*UNSLRF)
00186               ENDIF
00187 !
00188 !             -------------------------------------------------------
00189 !             COMPUTES THE COEFFICIENTS AND INDICES FOR THE PROJECTION
00190 !             -------------------------------------------------------
00191 !
00192               IF((NEWF(IP).LT.NF).AND.(NEWF(IP).GE.1)) THEN
00193                 NEWF1(IP)=NEWF(IP)+1
00194                 AUXI=FR(IP,JP,JF)*DFREQ(JF)
00195      &               /(FREQ(NEWF1(IP))-FREQ(NEWF(IP)))
00196                 TAUX1(IP)=AUXI*(FREQ(NEWF1(IP))-FNEW)/DFREQ(NEWF(IP))
00197                 TAUX2(IP)=AUXI*(FNEW-FREQ(NEWF(IP)))/DFREQ(NEWF1(IP))
00198               ELSEIF (NEWF(IP).EQ.0) THEN
00199                 AUXI=FR(IP,JP,JF)*DFREQ(JF)/(F0*(1.D0-1.D0/RAISF))
00200                 TAUX2(IP)=AUXI*(FNEW-F0/RAISF)/DFREQ(1)
00201                 NEWF (IP)=-1
00202                 NEWF1(IP)= 1
00203               ELSEIF (NEWF(IP).EQ.NF) THEN
00204                 AUXI=FR(IP,JP,JF)*DFREQ(JF)/(FREQ(NF)*(RAISF-1.D0))
00205                 TAUX1(IP)=AUXI*(FREQ(NF)*RAISF-FNEW)/DFREQ(NF)
00206                 NEWF1(IP)=-1
00207               ELSE
00208                 NEWF (IP)=-1
00209                 NEWF1(IP)=-1
00210               ENDIF
00211 !
00212             ENDIF
00213 !
00214           ENDDO
00215 !
00216 !
00217 !         -------------------------------------------------------
00218 !         PROJECTS THE SPECTRUM
00219 !         -------------------------------------------------------
00220 !
00221           DO IP=1,NPOIN2
00222             NEWM =NEWF (IP)
00223             NEWM1=NEWF1(IP)
00224             KH=KNEW(IP)
00225             IF(NEWM .NE.-1) FA(IP,KH,NEWM )=FA(IP,KH,NEWM )+TAUX1(IP)
00226             IF(NEWM1.NE.-1) FA(IP,KH,NEWM1)=FA(IP,KH,NEWM1)+TAUX2(IP)
00227           ENDDO
00228 !
00229         ENDDO
00230 !
00231       ENDDO
00232 !
00233       RETURN
00234       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0