d2fdz2.F 1.14 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
      MODULE m_d2fdz2
      CONTAINS

      SUBROUTINE d2fdz2(jmtd,jri,rmsh,dx,f,fac,d2f)

      IMPLICIT NONE

      REAL difcub
      EXTERNAL difcub
      
      REAL, INTENT(INOUT) :: d2f(jmtd)
      REAL, INTENT(IN)    :: fac(jmtd)
      REAL, INTENT(IN)    :: f(jmtd)
      REAL, INTENT(IN)    :: rmsh(jmtd)
      REAL, INTENT(IN)    :: dx

      INTEGER, INTENT(IN) :: jri
      INTEGER, INTENT(IN) :: jmtd

      REAL, ALLOCATABLE :: fr(:),dfr(:)
      INTEGER :: i

      allocate( dfr(jri),fr(jri) )
      DO i=1,jri
       fr(i) = f(i)*fac(i)
      ENDDO

      dfr(1) = difcub( rmsh(1),fr(1),rmsh(1) )
      DO i = 2, jri-2
         dfr(i) = difcub( rmsh(i-1),fr(i-1),rmsh(i) )
      ENDDO
      dfr(jri-1) = difcub( rmsh(jri-3),fr(jri-3),rmsh(jri-1) )
      dfr(jri) = difcub( rmsh(jri-3),fr(jri-3),rmsh(jri) )


      d2f(1) = difcub( rmsh(1),dfr(1),rmsh(1) )
      DO i = 2, jri-2
         d2f(i) = difcub( rmsh(i-1),dfr(i-1),rmsh(i) )
      ENDDO
      d2f(jri-1) = difcub( rmsh(jri-3),dfr(jri-3),rmsh(jri-1) )
      d2f(jri) = difcub( rmsh(jri-3),dfr(jri-3),rmsh(jri) )


      deallocate( dfr,fr )

      END SUBROUTINE d2fdz2
      END MODULE m_d2fdz2