pres.f90

FDS为火灾动力学模拟软件源代码,该软件为开源项目,代码语言主要为FORTRAN,可在WINDOWS和LINUX下编译运行,详细说明可参考http://fire.nist.gov/fds/官方网址

!
                  SELECT CASE(IOR)
!
                     CASE( 1) 
                        DA      = DY(JJ)*DZ(KK)
                        DUDTO = -OM%FVX(M2%IBAR,JJO,KKO) - M2%RDXN(IBAR)*(OM%H(M2%IBP1,JJO,KKO)-OM%H(M2%IBAR,JJO,KKO))
                        DUDT  = - FVX(0,JJ,KK)-RDXN(0)*(H(1,JJ,KK)-H(0,JJ,KK))
                        IF (PREDICTOR) THEN
                           U_NEXT_O = OM%U(M2%IBAR,JJO,KKO) + DT*DUDTO
                           U_NEXT   =    U(0,JJ,KK)         + DT*DUDT
                        ELSE
                           U_NEXT_O = 0.5_EB*(OM% U(M2%IBAR,JJO,KKO) +  M2%US(M2%IBAR,JJO,KKO) + DT*DUDTO)
                           U_NEXT   = 0.5_EB*(    U(0,JJ,KK)         + US(0,JJ,KK)         + DT*DUDT)
                        ENDIF
                        BXS(JJ,KK) = D_FAC*RDT*(U_NEXT-U_NEXT_O)
                        FVX_AVG = 0.5_EB*(OM%FVX(M2%IBAR,JJO,KKO)+FVX(0,JJ,KK))
                        DHDX_S = DHDX_S + DA* (  FVX_AVG-FVX(0,JJ,KK) + (B(N)-B(NO))*RDXN(0) &
                              - (H(1,JJ,KK)-H(0,JJ,KK))*RDXN(0) - BXS(JJ,KK))
                        AREA_XS = AREA_XS + DA
                     CASE(-1)
                        DA      = DY(JJ)*DZ(KK)
                        DUDTO = -OM%FVX(0,JJO,KKO) - M2%RDXN(0)*(OM%H(1,JJO,KKO)-OM%H(0,JJO,KKO))
                        DUDT  = - FVX(IBAR,JJ,KK) - RDXN(IBAR)*(H(IBP1,JJ,KK)-H(IBAR,JJ,KK))
                        IF (PREDICTOR) THEN
                           U_NEXT_O = OM%U(0,JJO,KKO)  + DT*DUDTO
                           U_NEXT   =    U(IBAR,JJ,KK) + DT*DUDT
                        ELSE
                           U_NEXT_O = 0.5_EB*(OM% U(0,JJO,KKO)  +  M2%US(0,JJO,KKO)  + DT*DUDTO)
                           U_NEXT   = 0.5_EB*(    U(IBAR,JJ,KK) +        US(IBAR,JJ,KK) + DT*DUDT)
                        ENDIF
                        BXF(JJ,KK) = D_FAC*RDT*(U_NEXT-U_NEXT_O)
                        FVX_AVG = 0.5_EB*(OM%FVX(0,JJO,KKO)+FVX(IBAR,JJ,KK))
                        DHDX_F = DHDX_F + DA* (  FVX_AVG-FVX(IBAR,JJ,KK) + (B(NO)-B(N))*RDXN(IBAR) &
                              - (H(IBP1,JJ,KK)-H(IBAR,JJ,KK))*RDXN(IBAR) - BXF(JJ,KK) )
                        AREA_XF = AREA_XF + DA
!
                     CASE( 2)
                        DA      = DX(II)*DZ(KK)
                        DVDTO = -OM%FVY(IIO,M2%JBAR,KKO) - M2%RDYN(JBAR)*(OM%H(IIO,M2%JBP1,KKO)-OM%H(IIO,M2%JBAR,KKO))
                        DVDT  = - FVY(II,0,KK)-RDYN(0)*(H(II,1,KK)-H(II,0,KK))
                        IF (PREDICTOR) THEN
                           V_NEXT_O = OM%V(IIO,M2%JBAR,KKO) + DT*DVDTO
                           V_NEXT   =    V(II,0,KK)         + DT*DVDT
                        ELSE
                           V_NEXT_O = 0.5_EB*(OM% V(IIO,M2%JBAR,KKO) + M2%VS(IIO,M2%JBAR,KKO) + DT*DVDTO)
                           V_NEXT   = 0.5_EB*(    V(II,0,KK)         + VS(II,0,KK)         + DT*DVDT)
                        ENDIF
                        BYS(II,KK) = D_FAC*RDT*(V_NEXT-V_NEXT_O)
                        FVY_AVG = 0.5_EB*(OM%FVY(IIO,M2%JBAR,KKO)+FVY(II,0,KK))
                        DHDY_S = DHDY_S + DA* (  FVY_AVG-FVY(II,0,KK) + (B(N)-B(NO))*RDYN(0) &
                              - (H(II,1,KK)-H(II,0,KK))*RDYN(0) - BYS(II,KK) )
                        AREA_YS = AREA_YS + DA
                     CASE(-2)
                        DA      = DX(II)*DZ(KK)
                        DVDTO = -OM%FVY(IIO,0,KKO) - M2%RDYN(0)*(OM%H(IIO,1,KKO)-OM%H(IIO,0,KKO))
                        DVDT  = - FVY(II,JBAR,KK)-RDYN(JBAR)*(H(II,JBP1,KK)-H(II,JBAR,KK))
                        IF (PREDICTOR) THEN
                           V_NEXT_O = OM%V(IIO,0,KKO)  + DT*DVDTO
                           V_NEXT   =    V(II,JBAR,KK) + DT*DVDT
                        ELSE
                           V_NEXT_O = 0.5_EB*(OM% V(IIO,0,KKO)  + M2%VS(IIO,0,KKO)  + DT*DVDTO)
                           V_NEXT   = 0.5_EB*(    V(II,JBAR,KK) + VS(II,JBAR,KK) + DT*DVDT)
                        ENDIF
                        BYF(II,KK) = D_FAC*RDT*(V_NEXT-V_NEXT_O)
                        FVY_AVG = 0.5_EB*(OM%FVY(IIO,0,KKO)+FVY(II,JBAR,KK))
                        DHDY_F = DHDY_F + DA* (  FVY_AVG-FVY(II,JBAR,KK) + (B(NO)-B(N))*RDYN(JBAR) &
                              - (H(II,JBP1,KK)-H(II,JBAR,KK))*RDYN(JBAR) - BYF(II,KK) )
                        AREA_YF = AREA_YF + DA
!
                     CASE( 3)
                        DA      = DX(II)*DY(JJ)
                        DWDTO = -OM%FVZ(IIO,JJO,M2%KBAR)- M2%RDZN(KBAR)*(OM%H(IIO,JJO,M2%KBP1)-OM%H(IIO,JJO,M2%KBAR))
                        DWDT  = - FVZ(II,JJ,0)-RDZN(0)*(H(II,JJ,1)-H(II,JJ,0))
                        IF (PREDICTOR) THEN
                           W_NEXT_O = OM%W(IIO,JJO,M2%KBAR) + DT*DWDTO
                           W_NEXT   =    W(II,JJ,0)         + DT*DWDT
                        ELSE
                           W_NEXT_O = 0.5_EB*(OM% W(IIO,JJO,M2%KBAR) + M2%WS(IIO,JJO,M2%KBAR) + DT*DWDTO)
                           W_NEXT   = 0.5_EB*(    W(II,JJ,0)         + WS(II,JJ,0)         + DT*DWDT)
                        ENDIF
                        BZS(II,JJ) = D_FAC*RDT*(W_NEXT-W_NEXT_O)
                        FVZ_AVG = 0.5_EB*(OM%FVZ(IIO,JJO,M2%KBAR)+FVZ(II,JJ,0))
                        DHDZ_S = DHDZ_S + DA* (  FVZ_AVG-FVZ(II,JJ,0) + (B(N)-B(NO))*RDZN(0) &
                              - (H(II,JJ,1)-H(II,JJ,0))*RDZN(0) -BZS(II,JJ) )
                        AREA_ZS = AREA_ZS + DA
                     CASE(-3)
                        DA      = DX(II)*DY(JJ)
                        DWDTO = - OM%FVZ(IIO,JJO,0) - M2%RDZN(0)*(OM%H(IIO,JJO,1)-OM%H(IIO,JJO,0))
                        DWDT  = - FVZ(II,JJ,KBAR) - RDZN(KBAR)*(H(II,JJ,KBP1)-H(II,JJ,KBAR))
                        IF (PREDICTOR) THEN
                           W_NEXT_O = OM%W(IIO,JJO,0)  + DT*DWDTO
                           W_NEXT   =    W(II,JJ,KBAR) + DT*DWDT
                        ELSE
                           W_NEXT_O = 0.5_EB*(OM% W(IIO,JJO,0)  + M2%WS(IIO,JJO,0)  + DT*DWDTO)
                           W_NEXT   = 0.5_EB*(    W(II,JJ,KBAR) + WS(II,JJ,KBAR) + DT*DWDT)
                        ENDIF
                        BZF(II,JJ) = D_FAC*RDT*(W_NEXT-W_NEXT_O)
                        FVZ_AVG = 0.5_EB*(OM%FVZ(IIO,JJO,0)+FVZ(II,JJ,KBAR))
                        DHDZ_F = DHDZ_F + DA* (  FVZ_AVG-FVZ(II,JJ,KBAR) + (B(NO)-B(N))*RDZN(KBAR) &
                              - (H(II,JJ,KBP1)-H(II,JJ,KBAR))*RDZN(KBAR) -BZF(II,JJ) )
                        AREA_ZF = AREA_ZF + DA
!
                  END SELECT
               ENDIF IF_INTERPOLATED_BOUNDARY
!
!
               NON_INTERPOLATED: IF (BOUNDARY_TYPE(IW)==SOLID_BOUNDARY .OR. BOUNDARY_TYPE(IW)==OPEN_BOUNDARY) THEN
!
                  SELECT CASE(IOR)
!
                     CASE(-1)
                        DA      = DY(JJ)*DZ(KK)
                        AREA_XF = AREA_XF + DA
                        SELECT CASE (BOUNDARY_TYPE(IW))
                           CASE (SOLID_BOUNDARY)
                              DUDT = -FVX(IBAR,JJ,KK) - RDXN(IBAR)*(H(IBP1,JJ,KK)-H(IBAR,JJ,KK))
                              AREA_XF_CLOSED = AREA_XF_CLOSED + DA
                              BXF(JJ,KK) = DUDT - DUWDT(IW)
                           CASE (OPEN_BOUNDARY) 
                              B_OTHER = -B(N) + H(IBP1,JJ,KK)+H(IBAR,JJ,KK)
                              DHDX_F = DHDX_F + DA* (  (B_OTHER-B(N))*RDXN(IBAR) - (H(IBP1,JJ,KK)-H(IBAR,JJ,KK))*RDXN(IBAR))
                        END SELECT
!
                     CASE( 1)
                        DA      = DY(JJ)*DZ(KK)
                        AREA_XS = AREA_XS + DA
                        SELECT CASE (BOUNDARY_TYPE(IW))
                           CASE (SOLID_BOUNDARY)
                              DUDT = -FVX(0,JJ,KK) - RDXN(0)*(H(1,JJ,KK)-H(0,JJ,KK))
                              AREA_XS_CLOSED = AREA_XS_CLOSED + DA
                           BXS(JJ,KK) = DUDT + DUWDT(IW)
                           CASE (OPEN_BOUNDARY) 
                              B_OTHER = -B(N) + H(0,JJ,KK)+H(1,JJ,KK)
                              DHDX_S = DHDX_S + DA* (  (B(N)-B_OTHER)*RDXN(0) - (H(1,JJ,KK)-H(0,JJ,KK))*RDXN(0) )
                        END SELECT
!
                     CASE(-2)
                        DA      = DX(II)*DZ(KK)
                        AREA_YF = AREA_YF + DA
                        SELECT CASE (BOUNDARY_TYPE(IW))
                           CASE (SOLID_BOUNDARY)
                              DVDT = -FVY(II,JBAR,KK) - RDYN(JBAR)*(H(II,JBP1,KK)-H(II,JBAR,KK))
                              AREA_YF_CLOSED = AREA_YF_CLOSED + DA
                              BYF(II,KK) = DVDT - DUWDT(IW)
                           CASE (OPEN_BOUNDARY)
                              B_OTHER = -B(N) + H(II,JBP1,KK)+H(II,JBAR,KK)
                              DHDY_F = DHDY_F + DA* (  (B_OTHER-B(N))*RDYN(JBAR) - (H(II,JBP1,KK)-H(II,JBAR,KK))*RDYN(JBAR))
                           END SELECT
!
                     CASE( 2)
                        DA      = DX(II)*DZ(KK)
                        AREA_YS = AREA_YS + DA
                        SELECT CASE (BOUNDARY_TYPE(IW))
                           CASE (SOLID_BOUNDARY)
                              DVDT = -FVY(II,0,KK) - RDYN(0)*(H(II,1,KK)-H(II,0,KK))
                              AREA_YS_CLOSED = AREA_YS_CLOSED + DA
                              BYS(II,KK) = DVDT + DUWDT(IW)
                           CASE (OPEN_BOUNDARY)
                              B_OTHER = -B(N) + H(II,0,KK)+H(II,1,KK)
                              DHDY_S = DHDY_S + DA* (  (B(N)-B_OTHER)*RDYN(0) - (H(II,1,KK)-H(II,0,KK))*RDYN(0) )
                           END SELECT
!
                     CASE(-3)
                        DA      = DX(II)*DY(JJ)
                        AREA_ZF = AREA_ZF + DA
                        SELECT CASE (BOUNDARY_TYPE(IW))
                           CASE (SOLID_BOUNDARY)
                              DWDT = -FVZ(II,JJ,KBAR) - RDZN(KBAR)*(H(II,JJ,KBP1)-H(II,JJ,KBAR))
                              AREA_ZF_CLOSED = AREA_ZF_CLOSED + DA
                              BZF(II,JJ) = DWDT - DUWDT(IW)
                           CASE (OPEN_BOUNDARY) 
                              B_OTHER = -B(N) + H(II,JJ,KBP1)+H(II,JJ,KBAR)
                              DHDZ_F = DHDZ_F + DA* (  (B_OTHER-B(N))*RDZN(KBAR) - (H(II,JJ,KBP1)-H(II,JJ,KBAR))*RDZN(KBAR))
                           END SELECT
!
                     CASE( 3)
                        DA      = DX(II)*DY(JJ)
                        AREA_ZS = AREA_ZS + DA
                        SELECT CASE (BOUNDARY_TYPE(IW))
                           CASE (SOLID_BOUNDARY)
                              DWDT  = -FVZ(II,JJ,0) - RDZN(0)*(H(II,JJ,1)-H(II,JJ,0))
                              AREA_ZS_CLOSED = AREA_ZS_CLOSED + DA
                              BZS(II,JJ) = DWDT + DUWDT(IW)
                           CASE (OPEN_BOUNDARY) 
                              B_OTHER = -B(N) + H(II,JJ,0)+H(II,JJ,1)
                              DHDZ_S = DHDZ_S + DA* (  (B(N)-B_OTHER)*RDZN(0) - (H(II,JJ,1)-H(II,JJ,0))*RDZN(0) )
                           END SELECT
!
                  END SELECT
               ENDIF NON_INTERPOLATED
!
            ENDDO WALL_CELL_LOOP
!
            AREA_XS = AREA_XS - AREA_XS_CLOSED
            AREA_XF = AREA_XF - AREA_XF_CLOSED
            AREA_YS = AREA_YS - AREA_YS_CLOSED
            AREA_YF = AREA_YF - AREA_YF_CLOSED
            AREA_ZS = AREA_ZS - AREA_ZS_CLOSED
            AREA_ZF = AREA_ZF - AREA_ZF_CLOSED
            !
            IF (AREA_XS==0._EB) AREA_XS=1._EB
            IF (AREA_XF==0._EB) AREA_XF=1._EB
            IF (AREA_YS==0._EB) AREA_YS=1._EB
            IF (AREA_YF==0._EB) AREA_YF=1._EB
            IF (AREA_ZS==0._EB) AREA_ZS=1._EB
            IF (AREA_ZF==0._EB) AREA_ZF=1._EB
!
            BC_LOOP: DO IW=1,NEWC
!
               II  = IJKW(1,IW)
               JJ  = IJKW(2,IW)
               KK  = IJKW(3,IW)
               IOR = IJKW(4,IW)
               IF (IOR/=IOR_PATCH) CYCLE BC_LOOP
               IF (II<II_LOW .OR. II>II_HIGH) CYCLE BC_LOOP
               IF (JJ<JJ_LOW .OR. JJ>JJ_HIGH) CYCLE BC_LOOP
               IF (KK<KK_LOW .OR. KK>KK_HIGH) CYCLE BC_LOOP
!
               BOUNDARY_SELECT: IF (BOUNDARY_TYPE(IW)==SOLID_BOUNDARY) THEN
!
                  SELECT CASE(IOR)
                     CASE( 1) 
                        BXS(JJ,KK) = HX(0)   *BXS(JJ,KK)
                     CASE(-1) 
                        BXF(JJ,KK) = HX(IBP1)*BXF(JJ,KK)
                     CASE( 2) 
                        BYS(II,KK) = HY(0)   *BYS(II,KK)
                     CASE(-2) 
                        BYF(II,KK) = HY(JBP1)*BYF(II,KK)
                     CASE( 3) 
                        BZS(II,JJ) = HZ(0)   *BZS(II,JJ)
                     CASE(-3) 
                        BZF(II,JJ) = HZ(KBP1)*BZF(II,JJ)
                  END SELECT
!
               ELSE BOUNDARY_SELECT
!
                  SELECT CASE(IOR)
                     CASE( 1) 
                        BXS(JJ,KK) = HX(0)   *(BXS(JJ,KK)+DHDX_S/AREA_XS)
                     CASE(-1) 
                        BXF(JJ,KK) = HX(IBP1)*(BXF(JJ,KK)+DHDX_F/AREA_XF)
                     CASE( 2) 
                        BYS(II,KK) = HY(0)   *(BYS(II,KK)+DHDY_S/AREA_YS)
                     CASE(-2) 
                        BYF(II,KK) = HY(JBP1)*(BYF(II,KK)+DHDY_F/AREA_YF)
                     CASE( 3) 
                        BZS(II,JJ) = HZ(0)   *(BZS(II,JJ)+DHDZ_S/AREA_ZS)
                     CASE(-3) 
                        BZF(II,JJ) = HZ(KBP1)*(BZF(II,JJ)+DHDZ_F/AREA_ZF)
                  END SELECT
!
               ENDIF BOUNDARY_SELECT
!
            ENDDO BC_LOOP
!
         ENDDO IC_LOOP
      ENDDO JC_LOOP
   ENDDO KC_LOOP
ENDDO ORIENT_LOOP
!
HP   = 0._EB
PRHS = 0._EB
!
IF (.NOT.TWO_D) CALL H3CZSS(BXS,BXF,BYS,BYF,BZS,BZF,ITRN,JTRN, PRHS,POIS_PTB,SAVE2,WORK,HX)
!
IF (TWO_D .AND. .NOT. CYLINDRICAL) CALL H2CZSS(BXS,BXF,BZS,BZF,ITRN,PRHS,POIS_PTB,SAVE2,WORK,HX)
!
IF (ABS(POIS_PTB)>1.E-5_EB) WRITE(0,*) ' POIS_PTB=',POIS_PTB, ' MESH=',NM
!
DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         HP(I,J,K) = PRHS(I,J,K)
      ENDDO
   ENDDO
ENDDO
!
SET_BC_LOOP: DO IW=1,NEWC
   I   = IJKW(1,IW)
   J   = IJKW(2,IW)
   K   = IJKW(3,IW)
   IOR = IJKW(4,IW)
   SELECT CASE(IOR)
      CASE( 1) 
         HP(0,J,K)    = HP(1,J,K)    - DXI  *BXS(J,K)
      CASE(-1) 
         HP(IBP1,J,K) = HP(IBAR,J,K) + DXI  *BXF(J,K)
      CASE( 2) 
         HP(I,0,K)    = HP(I,1,K)    - DETA *BYS(I,K)
      CASE(-2) 
         HP(I,JBP1,K) = HP(I,JBAR,K) + DETA *BYF(I,K)
      CASE( 3) 
         HP(I,J,0)    = HP(I,J,1)    - DZETA*BZS(I,J)
      CASE(-3) 
         HP(I,J,KBP1) = HP(I,J,KBAR) + DZETA*BZF(I,J)
   END SELECT
ENDDO SET_BC_LOOP

END SUBROUTINE COMPUTE_CORRECTION_PRESSURE

SUBROUTINE COMPUTE_C(AA,C,NM)
USE GLOBAL_CONSTANTS, ONLY: NMESHES, OPEN_BOUNDARY

REAL(EB) :: AA(NMESHES,NMESHES),C(NMESHES)
TYPE (MESH_TYPE), POINTER :: M2
TYPE (OMESH_TYPE), POINTER :: OM
INTEGER :: NM,II,JJ,KK,IOR,IIG,JJG,KKG,IIO,JJO,KKO,NOM,IW

CALL POINT_TO_MESH(NM)

WALL_LOOP: DO IW=1,NEWC

   NOM = IJKW(9,IW)
   IF (NOM==0) CYCLE WALL_LOOP

   II  = IJKW(1,IW)
   JJ  = IJKW(2,IW)
   KK  = IJKW(3,IW)
   IOR = IJKW(4,IW)
   OM  => OMESH(NOM)
   M2  => MESHES(NOM)
   IIO = IJKW(10,IW)
   JJO = IJKW(11,IW)
   KKO = IJKW(12,IW)

   SELECT CASE(IOR)
      CASE( 1) 
         AA(NM,NM)  = AA(NM,NM)  + 1._EB
         AA(NM,NOM) = AA(NM,NOM) - 1._EB
         C(NM)     = C(NM) - 0.5_EB*(HP(0,JJ,KK)+HP(1,JJ,KK)) + 0.5_EB*(M2%HP(M2%IBAR,JJO,KKO)+ M2%HP(M2%IBP1,JJO,KKO))
      CASE(-1)
         AA(NM,NM)  = AA(NM,NM)  + 1._EB
         AA(NM,NOM) = AA(NM,NOM) - 1._EB
         C(NM)     = C(NM) - 0.5_EB*(HP(IBAR,JJ,KK)+HP(IBP1,JJ,KK)) + 0.5_EB*(M2%HP(0,JJO,KKO)+ M2%HP(1,JJO,KKO))

      CASE( 2)
         AA(NM,NM)  = AA(NM,NM)  + 1._EB
         AA(NM,NOM) = AA(NM,NOM) - 1._EB
         C(NM)     = C(NM) - 0.5_EB*(HP(II,0,KK)+HP(II,1,KK)) + 0.5_EB*(M2%HP(IIO,M2%JBAR,KKO)+ M2%HP(IIO,M2%JBP1,KKO))
      CASE(-2)
         AA(NM,NM)  = AA(NM,NM)  + 1._EB
         AA(NM,NOM) = AA(NM,NOM) - 1._EB
         C(NM)     = C(NM) - 0.5_EB*(HP(II,JBAR,KK)+HP(II,JBP1,KK)) + 0.5_EB*(M2%HP(IIO,0,KKO)+ M2%HP(IIO,1,KKO))

      CASE( 3)
         AA(NM,NM)  = AA(NM,NM)  + 1._EB
         AA(NM,NOM) = AA(NM,NOM) - 1._EB
         C(NM)     = C(NM) - 0.5_EB*(HP(II,JJ,0)+HP(II,JJ,1)) + 0.5_EB*(M2%HP(IIO,JJO,M2%KBAR)+ M2%HP(IIO,JJO,M2%KBP1))
      CASE(-3)
         AA(NM,NM)  = AA(NM,NM)  + 1._EB
         AA(NM,NOM) = AA(NM,NOM) - 1._EB
         C(NM)     = C(NM) - 0.5_EB*(HP(II,JJ,KBAR)+HP(II,JJ,KBP1)) + 0.5_EB*(M2%HP(IIO,JJO,0)+ M2%HP(IIO,JJO,1))

   END SELECT

ENDDO WALL_LOOP

BC_LOOP: DO IW=1,NEWC
   IF (BOUNDARY_TYPE(IW)==OPEN_BOUNDARY) THEN
      II  = IJKW(1,IW)
      JJ  = IJKW(2,IW)
      KK  = IJKW(3,IW)
      IIG = IJKW(6,IW)
      JJG = IJKW(7,IW)
      KKG = IJKW(8,IW)
      AA(NM,:)  = 0._EB
      AA(NM,NM) = 1._EB
      C(NM)    = -0.5_EB*(HP(II,JJ,KK)+HP(IIG,JJG,KKG))
   ENDIF
ENDDO BC_LOOP

END SUBROUTINE COMPUTE_C
 

SUBROUTINE UPDATE_PRESSURE(C,NM)
USE GLOBAL_CONSTANTS, ONLY: NMESHES
 
REAL(EB) :: C(NMESHES)
INTEGER :: NM
 
CALL POINT_TO_MESH(NM)
 
HP = HP + C(NM)
H = H + HP 
 
END SUBROUTINE UPDATE_PRESSURE

SUBROUTINE GET_REV_pres(MODULE_REV,MODULE_DATE)
INTEGER,INTENT(INOUT) :: MODULE_REV
CHARACTER(255),INTENT(INOUT) :: MODULE_DATE

WRITE(MODULE_DATE,'(A)') presrev(INDEX(presrev,':')+1:LEN_TRIM(presrev)-2)
READ (MODULE_DATE,'(I5)') MODULE_REV
WRITE(MODULE_DATE,'(A)') presdate

END SUBROUTINE GET_REV_pres

END MODULE PRES