preqt2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\preqt2.f
00002 !
00049                      SUBROUTINE PREQT2
00050 !                    *****************
00051 !
00052      &( TETA  , NPLAN , BDISPB, BDSSPB, NBD , INDI )
00053 !
00054 !***********************************************************************
00055 ! TOMAWAC   V6P1                                   23/06/2011
00056 !***********************************************************************
00057 !
00058 !
00059 !
00060 !
00061 !
00062 !
00063 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00064 !| BDISPB         |-->| LOWER DIRECTIONAL BOUNDARY OF THE SPB MODEL
00065 !|                |   | (TRIADS INTERACTION)
00066 !| BDSSPB         |-->| UPPER DIRECTIONAL BOUNDARY OF THE SPB MODEL
00067 !|                |   | (TRIADS INTERACTION)
00068 !| INDI           |<--| CONFIGURATION INDEX
00069 !| NBD            |<--| NUMBER OF CONFIGURATIONS
00070 !| NPLAN          |-->| NOMBRE DE DIRECTIONS DE DISCRETISATION
00071 !| TETA           |-->| DISCRETIZED DIRECTIONS
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !
00074       IMPLICIT NONE
00075 !
00076 !.....VARIABLES IN ARGUMENT
00077 !     """"""""""""""""""""
00078       INTEGER           NPLAN
00079       DOUBLE PRECISION  BDISPB , BDSSPB
00080       DOUBLE PRECISION  TETA(NPLAN)
00081 !
00082 !.....LOCAL VARIABLES
00083 !     """""""""""""""""
00084       INTEGER           IPL
00085       DOUBLE PRECISION  AP2 , EPS , DTETA
00086 !
00087       INTEGER           NBPL , NBPU, NBD, NB1
00088       INTEGER           INDI(NPLAN)
00089 !
00090 !     """"""""""""""""""""""""""""""""""""""""""""""""""""""""""
00091 !
00092       DTETA = TETA(2)-TETA(1)
00093       EPS  = 1.D-5
00094       IF(BDSSPB.GE.BDISPB) THEN
00095         AP2  = (BDISPB-TETA(1))/DTETA
00096         NBPL = IDINT(AP2)
00097         AP2  = AP2 - DBLE(NBPL)
00098         IF(AP2.GT.EPS) THEN
00099           NBPL = NBPL + 2
00100         ELSE
00101           NBPL = NBPL + 1
00102         ENDIF
00103         AP2  = (BDSSPB-TETA(1))/DTETA
00104         NBPU = IDINT(AP2) + 1
00105         NBD=NBPU-NBPL+1
00106 !        ALLOCATE(INDI(1:NBD))
00107         DO IPL=1,NBD
00108           INDI(IPL)=NBPL+IPL-1
00109         END DO
00110       ELSE
00111         AP2  = (BDSSPB-TETA(1))/DTETA
00112         NBPU = IDINT(AP2) + 1
00113         AP2  = (BDISPB-TETA(1))/DTETA
00114         NBPL = IDINT(AP2)
00115         AP2  = AP2 - DBLE(NBPL)
00116         IF(AP2.GT.EPS) THEN
00117           NBPL = NBPL + 2
00118         ELSE
00119           NBPL = NBPL + 1
00120         ENDIF
00121         IF(NBPL.GT.NPLAN) THEN
00122           NBPL = 1
00123           INDI(1) = 1
00124           NBD  = NBPU - NBPL + 1
00125 !          ALLOCATE(INDI(1:NBD))
00126           DO IPL = 2,NBD
00127             INDI(IPL)=IPL
00128           END DO
00129         ELSE
00130           NB1 = NPLAN - NBPL + 1
00131           NBD = NB1 + NBPU
00132 !         ALLOCATE(INDI(1:NBD))
00133           DO IPL = 1,NB1
00134             INDI(IPL)=NBPL+IPL-1
00135           END DO
00136           DO IPL = 1,NBPU
00137             INDI(IPL+NB1)=IPL
00138           END DO
00139         ENDIF
00140       ENDIF
00141 !
00142       RETURN
00143       END

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