f1f1f1.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE f1f1f1
!                       *****************
!
     &(f1sf,nf1,iq_om1)
!
!***********************************************************************
! TOMAWAC   V6P3                                   15/06/2011
!***********************************************************************
!
!brief   SUBROUTINE CALLED BY PRENL3
!+         COMPUTES VALUES OF RATIO F1/F AS FUNCTION OF THE IQ_OM1
!+         INDICATOR
!
!history  E. GAGNAIRE-RENOU
!+        04/2011
!+        V6P1
!+   CREATED
!
!history  G.MATTAROLO (EDF - LNHE)
!+        15/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!history  E. GAGNAIRE-RENOU
!+        12/03/2013
!+        V6P3
!+   Better formatted: WRITE(LU,*), etc.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| F1SF           |-->|
!| IQ_OM1         |-->| SETTING FOR INTEGRATION ON OMEGA1
!| NF1            |-->|
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      USE interface_tomawac, ex_f1f1f1 => f1f1f1
      IMPLICIT NONE
!
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,          INTENT(IN)    :: IQ_OM1
      INTEGER,          INTENT(INOUT) :: NF1
      DOUBLE PRECISION, INTENT(INOUT) :: F1SF(*)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I,M
      DOUBLE PRECISION RAISON
!
!-----------------------------------------------------------------------
!
      IF(iq_om1.EQ.1) THEN
        IF(nf1.NE.14) THEN
          WRITE(lu,*) 'PROGRAM STOP IN F1F1F1 : WRONG VALUE FOR NF1'
          WRITE(lu,*) 'IQ_OM1 = ',iq_om1,'   AND NF1 = ',nf1
          CALL plante(1)
          stop
        ENDIF
        f1sf( 1)=0.30d0
        f1sf( 2)=0.40d0
        f1sf( 3)=0.50d0
        f1sf( 4)=0.60d0
        f1sf( 5)=0.70d0
        f1sf( 6)=0.80d0
        f1sf( 7)=0.90d0
        f1sf( 8)=1.00d0
        f1sf( 9)=1.11d0
        f1sf(10)=1.25d0
        f1sf(11)=1.42d0
        f1sf(12)=1.67d0
        f1sf(13)=2.00d0
        f1sf(14)=2.50d0
        f1sf(15)=3.30d0
      ELSEIF(iq_om1.EQ.2) THEN
        IF (nf1.NE.26) THEN
          WRITE(lu,*) 'PROGRAM STOP IN F1F1F1 : WRONG VALUE FOR NF1'
          WRITE(lu,*) 'IQ_OM1 = ',iq_om1,'   AND NF1 = ',nf1
          CALL plante(1)
          stop
        ENDIF
        f1sf( 1)=0.32d0
        f1sf( 2)=0.35d0
        f1sf( 3)=0.39d0
        f1sf( 4)=0.44d0
        f1sf( 5)=0.50d0
        f1sf( 6)=0.56d0
        f1sf( 7)=0.63d0
        f1sf( 8)=0.70d0
        f1sf( 9)=0.78d0
        f1sf(10)=0.86d0
        f1sf(11)=0.92d0
        f1sf(12)=0.97d0
        f1sf(13)=1.00d0
        f1sf(14)=1.03d0
        f1sf(15)=1.08d0
        f1sf(16)=1.13d0
        f1sf(17)=1.20d0
        f1sf(18)=1.28d0
        f1sf(19)=1.37d0
        f1sf(20)=1.48d0
        f1sf(21)=1.50d0
        f1sf(22)=1.65d0
        f1sf(23)=1.85d0
        f1sf(24)=2.10d0
        f1sf(25)=2.40d0
        f1sf(26)=2.70d0
        f1sf(27)=3.20d0
      ELSEIF(iq_om1.EQ.3) THEN
        IF(nf1.NE.11) THEN
          WRITE(lu,*) 'PROGRAM STOP IN F1F1F1 : WRONG VALUE FOR NF1'
          WRITE(lu,*) 'IQ_OM1 = ',iq_om1,'   AND NF1 = ',nf1
          CALL plante(1)
          stop
        ENDIF
        f1sf( 1)=0.30d0
        f1sf( 2)=0.48d0
        f1sf( 3)=0.64d0
        f1sf( 4)=0.78d0
        f1sf( 5)=0.90d0
        f1sf( 6)=1.00d0
        f1sf( 7)=1.12d0
        f1sf( 8)=1.28d0
        f1sf( 9)=1.50d0
        f1sf(10)=1.80d0
        f1sf(11)=2.40d0
        f1sf(12)=3.40d0
      ELSEIF(iq_om1.EQ.4) THEN
        IF(nf1.NE.40) THEN
          WRITE(lu,*) 'PROGRAM STOP IN F1F1F1 : WRONG VALUE FOR NF1'
          WRITE(lu,*) 'IQ_OM1 = ',iq_om1,'   AND NF1 = ',nf1
          CALL plante(1)
          stop
        ENDIF
        nf1=20
        m=10
        raison=9.d0**(1.d0/dble(nf1))
        f1sf(m+1)=1.0d0/3.0d0
        nf1=2*m+nf1
        DO i=m+2,nf1+1
          f1sf(i)=f1sf(i-1)*raison
        ENDDO
        DO i=m,1,-1
          f1sf(i)=f1sf(i+1)/raison
        ENDDO
      ELSEIF(iq_om1.EQ.5) THEN
        raison=9.d0**(1.d0/dble(nf1))
        f1sf(1)=1.d0/3.d0
        DO i=2,nf1+1
          f1sf(i)=f1sf(i-1)*raison
        ENDDO
      ELSEIF(iq_om1.EQ.6) THEN
        raison=(3.d0-1.d0/3.d0)/dble(nf1)
        f1sf(1)=1.d0/3.d0
        DO i=2,nf1+1
          f1sf(i)=f1sf(i-1)+raison
        ENDDO
      ELSEIF(iq_om1.EQ.7) THEN
        IF(nf1.NE.20) THEN
          WRITE(lu,*) 'PROGRAM STOP IN F1F1F1 : WRONG VALUE FOR NF1'
          WRITE(lu,*) 'IQ_OM1 = ',iq_om1,'   AND NF1 = ',nf1
          CALL plante(1)
          stop
        ENDIF
        f1sf( 1)=1.d0/3.d0
        f1sf( 2)=0.40d0
        f1sf( 3)=0.46d0
        f1sf( 4)=0.52d0
        f1sf( 5)=0.60d0
        f1sf( 6)=0.70d0
        f1sf( 7)=0.79d0
        f1sf( 8)=0.86d0
        f1sf( 9)=0.92d0
        f1sf(10)=0.97d0
        f1sf(11)=1.00d0
        f1sf(12)=1.04d0
        f1sf(13)=1.10d0
        f1sf(14)=1.18d0
        f1sf(15)=1.28d0
        f1sf(16)=1.42d0
        f1sf(17)=1.60d0
        f1sf(18)=1.84d0
        f1sf(19)=2.14d0
        f1sf(20)=2.52d0
        f1sf(21)=3.00d0
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END