alloc2.f

油田化学驱模拟的经典 fortran源代码

C
       SUBROUTINE ALLOC_BIO
C
       USE MODULE1
C
       INTEGER ID
       NBL=NX*NY*NZ
       NNOB=NBC+1-NBS+1+1
C
       ALLOCATE(CB(NBL,NBC+1,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(BIOMIN(NBL,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(BIOCUM(N),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(AKA(NMET+1),AKS(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(AKN(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(BRMAX(NMET+1),BRMAXB(NMET+1),CBIOMN(NBS+1)
     *  ,COLMAS(NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(BSIHB(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(COLNUM(NBS+1),COLSA(NBS+1),ENDOG(NBS+1),ENDOGB(NBS+1)
     *  ,FEA(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(FN(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(FP(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(RCOL(NBS+1),TCOL(NBS+1),VCOL(NBS+1)
     *  ,YXS(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(ICSUB(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(IDMET(NBC+1,NBC+1,NBC+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(NCOMPS(NMET+1),NIHB(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(NNUT(NMET+1),NPROD(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(IMSUB(NMET+1),IMEA(NMET+1),IMBS(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(IHB(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(IPR(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(INUT(NMET+1,NNOB),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(BMTC(NBC+1),SC(NBC+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(AKR(NBS+1),FRC(NMET+1),FRP(NMET+1)
     *   ,REDI(NBS+1),TC(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(ICOMET(NMET+1),IGROW(NMET+1),IRCT(NMET+1)
     *   ,IRLIM(NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(DENBIO(NBC+1),CBI(NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(RED(NBL,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(REDB(NBL,NBS+1,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
C--
       ALLOCATE(ADSBIO(NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(DCF(NBC+1),DCBF(NBC+1,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(SUBBAR(NMET+1),EABAR(NMET+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(CF(NBC+1),CBF(NBC+1,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(DREDF(NBS+1),DREDBF(NBS+1,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
       ALLOCATE(REDF(NBS+1),REDBF(NBS+1,NBS+1),STAT=ID)
       IF(ID/= 0) STOP " *****NOT ENOUGH MEMORY**** "
C
       CB(1:NBL,1:NBC+1,1:NBS+1)=0.0
      
       BIOMIN(1:NBL,1:NBS+1)=0.0
      
       BIOCUM(1:N)=0.0
      
       AKA(1:NMET+1)=0.0;AKS(1:NMET+1)=0.0
      
       AKN(1:NMET+1,1:NNOB)=0.0
      
       BRMAX(1:NMET+1)=0.0;BRMAXB(1:NMET+1)=0.0;CBIOMN(1:NBS+1)=0.0
     *  ;COLMAS(1:NBS+1)=0.0
      
       BSIHB(1:NMET+1,1:NNOB)=0.0
      
       COLNUM(1:NBS+1)=0.0;COLSA(1:NBS+1)=0.0

       ENDOG(1:NBS+1)=0.0;ENDOGB(1:NBS+1)=0.0
     *  ;FEA(1:NMET+1)=0.0
      
       FN(1:NMET+1,1:NNOB)=0.0
      
       FP(1:NMET+1,1:NNOB)=0.0
      
       RCOL(1:NBS+1)=0.0;TCOL(1:NBS+1)=0.0
     *  ;VCOL(1:NBS+1)=0.0;YXS(1:NMET+1)=0.0
      
       ICSUB(1:NMET+1,1:NNOB)=0
      
       IDMET(1:NBC+1,1:NBC+1,1:NBC+1)=0
      
       NCOMPS(1:NMET+1)=0;NIHB(1:NMET+1)=0
      
       NNUT(1:NMET+1)=0;NPROD(1:NMET+1)=0
      
       IMSUB(1:NMET+1)=0;IMEA(1:NMET+1)=0;IMBS(1:NMET+1)=0
      
       IHB(1:NMET+1,1:NNOB)=0
      
       IPR(1:NMET+1,1:NNOB)=0
      
       INUT(1:NMET+1,1:NNOB)=0
      
       BMTC(1:NBC+1)=0.0;SC(1:NBC+1)=0.0
      
       AKR(1:NBS+1)=0.0;FRC(1:NMET+1)=0.0;FRP(1:NMET+1)=0.0

       REDI(1:NBS+1)=0.0;TC(1:NMET+1)=0.0
      
       ICOMET(1:NMET+1)=0;IGROW(1:NMET+1)=0;IRCT(1:NMET+1)=0
     *  ;IRLIM(1:NBS+1)=0
      
       DENBIO(1:NBC+1)=0.0;CBI(1:NBS+1)=0.0
      
       RED(1:NBL,1:NBS+1)=0.0
      
       REDB(1:NBL,1:NBS+1,1:NBS+1)=0.0
      
       ADSBIO(1:NBS+1)=0.0
      
       DCF(1:NBC+1)=0.0;DCBF(1:NBC+1,1:NBS+1)=0.0
      
       SUBBAR(1:NMET+1)=0.0;EABAR(1:NMET+1)=0.0
      
       CF(1:NBC+1)=0.0;CBF(1:NBC+1,1:NBS+1)=0.0
      
       DREDF(1:NBS+1)=0.0;DREDBF(1:NBS+1,1:NBS+1)=0.0
      
       REDF(1:NBS+1)=0.0;REDBF(1:NBS+1,1:NBS+1)=0.0
      
       RETURN
       END