C COPIED FROM from_europa/from_from_marge_042909/bcond_25_yr.f
C October 6, 2014

C Writes boundary condtions for active variables only.  Writes only one number
C since all active variables have the same number of boundary faces.
C Goes with code in Mar_01_06.  March 15, 2006

C PIP activated May 4, 2006

C Four sediment variables added June 26, 2006

C This program is designed for all variables including water quality
C and ISS, Clay, Silt, Sand, fine clay (ORGS)

C Reads RIVER and OCEAN in different order.  A temporary fix to facilitate
C input of ocean silica and zooplankton.  These are on the way to elmination.

C Start by turning silica and zooplankton off.  We will eliminate them 
C entirely later.  I think all I have to do today is comment out the write
C statements  11/10/14

C Write boundary conditions for G3 organic particles.  Take the time to clean up
C silica and zooplankton.  02/10/15


      REAL TEMP(600,36),SALT(600,36),TSS(600,36),CYAN(600,36),
     $DIAT(600,36),GREEN(600,36),DOC(600,36),LPOC(600,36),RPOC(600,36),
     $NH4(600,36),NO3(600,36),DON(600,36),LPON(600,36),RPON(600,36),
     $PO4(600,36),DOP(600,36),LPOP(600,36),RPOP(600,36),COD(600,36),     
     $DO(600,36),PIP(600,36),SAND(600,36),SILT(600,36),CLAY(600,36),
     $ORGS(600,36),G3OC(600,36),G3ON(600,36),G3OP(600,36)   
      
      REAL DAY(36) 
          
      REAL TEMPIN(36),SALTIN(36),CHLIN(36),DOCIN(36),POCIN(36),     
     $NH4IN(36),NO3IN(36),DONIN(36),PONIN(36),PO4IN(36),DOPIN(36),     
     $PPIN(36),DOIN(36),FCYAN(36),FDIAT(36),TSSIN(36) 
     
      REAL LZERO 
      REAL DUMMY(600)   
      INTEGER OFACE(600), IFLAG(600), ERFLAG      
      CHARACTER*72 DSNOUT,TITLE(2)      
      CHARACTER*8 PARM(36)
      CHARACTER*5 RIVER 
      CHARACTER*1 INLINE     
      DATA PARM /'TEMP    ','SALT    ',' ISS    ','CYAN    ',
     $           'DIAT    ','GREN    ',
     $           'ZOO1    ','ZOO2    ','LDOC    ','RDOC    ',
     $           'LPOC    ','RPOC    ',' NH4    ',' NO3    ',
     $           'UREA    ','LDON    ','RDON    ',
     $           'LPON    ','RPON    ',' PO4    ','LDOP    ',
     $           'RDOP    ','LPOP    ','RPOP    ',
     $           ' PIP    ',' COD    ','  DO    ',' PBS    ',
     $           'DSIL    ',
     $           'G3OC    ','G3ON    ','G3OP    ','CLAY    ',
     $           'SILT    ','SAND    ','ORGS    '/

      DATA CODIN /0.0/, LZERO /0.0/ 
                  
      OPEN (11,FILE='bcond_prep.npt',STATUS='OLD')
      
C ASSIGN ZERO VALUES TO INACTIVE STATE VARIABLES

      DO I=1,600
        DUMMY(I) = 0.0
      END DO

C READ TITLE LINES      
      DO I=1,2        
        READ(11,1) TITLE(I)      
      END DO
1     FORMAT(A72)

C READ NAME OF OUTPUT DATA SET      
      READ(11,1) DSNOUT      
      OPEN(12,FILE=DSNOUT,STATUS='UNKNOWN')
      
C READ NUMBER OF TIMES    
      READ(11,*) NTIME

C READ TIME INTERVAL
      READ(11,*) TINT

C READ EXPECTED NUMBER OF BOUNDARIES
      READ(11,*) NEXPB

C SET FLAGS TO BE SURE ALL FACES ARE READ ONCE
      DO I=1,600
        IFLAG(I)=0
      END DO
      ERFLAG=0
      
C COMPUTE DATES FOR BOUNDARIES      
      DO I=1,NTIME        
        DAY(I)=TINT*FLOAT(I-1)      
      END DO
      
C START SUMMING NUMBER OF BOUNDARY CONDITIONS      
      NBCND=0
      
C READ AND ASSIGN BOUNDARY CONDITIONS UNTIL A -999 IS ENCOUNTERED 
 20   READ(11,11) RIVER  
 11   FORMAT(1X,A5)
 
C READ NUMBER OF FACES ASSIGNED TO THIS BOUNDARY CONDITON      
      READ(11,*) NFACE      
      WRITE(*,*) RIVER, NFACE
      IF (NFACE.GT.-999) THEN        
        NBCND=NBCND+NFACE
        
C READ ORDER OF FACE IN BOUNDARY CONDITION FILE         
        READ(11,*) (OFACE(I),I=1,NFACE)

C SET FLAGS TO INDICATE BOUNDARY HAS BEEN READ
        DO I=1,NFACE
          J=OFACE(I)
          IFLAG(J)=IFLAG(J)+1
        END DO
        
C READ FACTORS NEEDED TO TRANSFORM OBSERVATIONS INTO MODEL VARIABLES
C FORST ALGAL-RELATED PARAMETERS
        READ(11,2) INLINE
 2      FORMAT(A1)
        READ(11,*) ANC,APC,CCHL1,CCHL2,CCHL3
C THEN REACTIVE FRACTIONS OF ORGANIC PARTICLES
        READ(11,2) INLINE
        READ(11,*) FLPOC,FLPON,FLPOP,FRPOC,FRPON,FRPOP
C THEN INORGANIC PARTICLE FRACTIONS
        READ(11,2) INLINE
        READ(11,*) PIP2PP,FCLAY,FSILT,FSAND

C READ NTIME BOUNDARY CONDITIONS        
          READ(11,*) (TEMPIN(I),I=1,NTIME)
	  READ(11,*) (SALTIN(I),I=1,NTIME)
	  READ(11,*) (TSSIN(I),I=1,NTIME)
	  READ(11,*) (CHLIN(I),I=1,NTIME)
	  READ(11,*) (FCYAN(I),I=1,NTIME)
          READ(11,*) (FDIAT(I),I=1,NTIME)
	  READ(11,*) (DOCIN(I),I=1,NTIME)
	  READ(11,*) (POCIN(I),I=1,NTIME)     
          READ(11,*) (NH4IN(I),I=1,NTIME)
	  READ(11,*) (NO3IN(I),I=1,NTIME)
	  READ(11,*) (DONIN(I),I=1,NTIME)
	  READ(11,*) (PONIN(I),I=1,NTIME)
	  READ(11,*) (PO4IN(I),I=1,NTIME)
	  READ(11,*) (DOPIN(I),I=1,NTIME)     
          READ(11,*) (PPIN(I),I=1,NTIME)
	  READ(11,*) (DOIN(I),I=1,NTIME)

C TRANSFORM VARIABLES AND ASSIGN TO FACES        
        DO I=1,NTIME 
          DO J=1,NFACE            
            K=OFACE(J)            
            TEMP(K,I)=TEMPIN(I)            
            SALT(K,I)=SALTIN(I)                       
            TSS(K,I)=MAX(0.,TSSIN(I)-2.5*POCIN(I))
	    CLAY(K,I)=TSS(K,I)*FCLAY
	    SILT(K,I)=TSS(K,I)*FSILT
	    SAND(K,I)=TSS(K,I)*FSAND
	    ORGS(K,I)=TSS(K,I)*(1.-FCLAY-FSILT-FSAND)
            CYAN(K,I)=CHLIN(I)*FCYAN(I)*CCHL1/1000.           
            DIAT(K,I)=CHLIN(I)*FDIAT(I)*CCHL2/1000.            
            GREEN(K,I)=CHLIN(I)*(1.-FCYAN(I)-FDIAT(I))*CCHL3/1000.
	    ALGCAR=CYAN(K,I)+DIAT(K,I)+GREEN(K,I)
            DOC(K,I)=DOCIN(I)            
            LPOC(K,I)=FLPOC*(POCIN(I)-ALGCAR)            
            RPOC(K,I)=FRPOC*(POCIN(I)-ALGCAR)  
            G3OC(K,I)=(1.-FLPOC-FRPOC)*(POCIN(I)-ALGCAR)          
            LPOC(K,I)=MAX(0.,LPOC(K,I))            
            RPOC(K,I)=MAX(0.,RPOC(K,I))            
            G3OC(K,I)=MAX(0.,G3OC(K,I))     
            NH4(K,I)=NH4IN(I)           
            NO3(K,I)=NO3IN(I)            
            DON(K,I)=DONIN(I)           
            LPON(K,I)=FLPON*(PONIN(I)-ANC*ALGCAR)            
            RPON(K,I)=FRPON*(PONIN(I)-ANC*ALGCAR)     
            G3ON(K,I)=(1.-FLPON-FRPON)*(PONIN(I)-ANC*ALGCAR)      
            LPON(K,I)=MAX(0.,LPON(K,I))           
            RPON(K,I)=MAX(0.,RPON(K,I))    
            G3ON(K,I)=MAX(0.,G3ON(K,I))        
            PO4(K,I)=PO4IN(I)
            DOP(K,I)=MAX(0.0,DOPIN(I))
	    PIP(K,I)=PIP2PP*(PPIN(I)-APC*ALGCAR)            
            LPOP(K,I)=(1.-PIP2PP)*FLPOP*(PPIN(I)-APC*ALGCAR)            
            RPOP(K,I)=(1.-PIP2PP)*FRPOP*(PPIN(I)-APC*ALGCAR)
            G3OP(K,I)=(1.-PIP2PP)*(1.-FLPOP-FRPOP)*(PPIN(I)-APC*ALGCAR)
	    PIP(K,I)=MAX(0.,PIP(K,I))            
            LPOP(K,I)=MAX(0.,LPOP(K,I))            
            RPOP(K,I)=MAX(0.,RPOP(K,I))    
            G3OP(K,I)=MAX(0.,G3OP(K,I))        
            COD(K,I)=CODIN            
            DO(K,I)=DOIN(I)
          END DO        
        END DO        
        GO TO 20      
      END IF
      
C WRITE OUT TITLE      
      DO I=1,2        
        WRITE(12,1) TITLE(I)      
      END DO
      
C WRITE OUT NUMBER OF BOUNDARY CONDITIONS
      WRITE(12,5) 
 5    FORMAT(/8X,9('     NBC'))
 
C THERE ARE THE SAME NUMBER OF BOUNDARY CONDITIONS FOR EACH ACTIVE VARIABLE      
      WRITE(12,7) NBCND 
 7    FORMAT(8X,9I8)

C CHECK TO SEE IF EXPECTED NUMBER OF FACES WERE READ IN
      IF (NBCND .NE. NEXPB) THEN
        WRITE(12,9) NEXPB, NBCND
        STOP
      END IF
 9    FORMAT(I5,' FACES EXPECTED, ',I5,' READ IN')

CHECK TO SEE IF EACH FACE IS READ EXACTLY ONCE
      DO I=1,NEXPB
        IF (IFLAG(I) .NE. 1) THEN
          WRITE(12,10) I, IFLAG(I)
          ERFLAG=1
        END IF
      END DO
 10   FORMAT(' FACE SEQUENCE ',I5,' READ ',I5,' TIMES')
      IF (ERFLAG .GT. 0) STOP
  
 
C PUT OUT BOUNDARY CONDITIONS      
      WRITE(12,8) 
 8    FORMAT(/8X,'    JDAY',8('   BCOND'))      
      DO J=1,NTIME        
        WRITE(12,6) PARM(1),DAY(J),(TEMP(I,J),I=1,NBCND)        
        WRITE(12,6) PARM(2),DAY(J),(SALT(I,J),I=1,NBCND)                
        WRITE(12,6) PARM(3),DAY(J),(TSS(I,J),I=1,NBCND)                
        WRITE(12,6) PARM(4),DAY(J),(CYAN(I,J),I=1,NBCND)                
        WRITE(12,6) PARM(5),DAY(J),(DIAT(I,J),I=1,NBCND)               
        WRITE(12,6) PARM(6),DAY(J),(GREEN(I,J),I=1,NBCND)               
        WRITE(12,6) PARM(9),DAY(J),(DOC(I,J),I=1,NBCND)  
C	WRITE(12,6) PARM(10),DAY(J),(DUMMY(I),I=1,NBCND)            
        WRITE(12,6) PARM(11),DAY(J),(LPOC(I,J),I=1,NBCND)        
        WRITE(12,6) PARM(12),DAY(J),(RPOC(I,J),I=1,NBCND)        
        WRITE(12,6) PARM(13),DAY(J),(NH4(I,J),I=1,NBCND)        
        WRITE(12,6) PARM(14),DAY(J),(NO3(I,J),I=1,NBCND)        
C	WRITE(12,6) PARM(15),DAY(J),(DUMMY(I),I=1,NBCND)              
        WRITE(12,6) PARM(16),DAY(J),(DON(I,J),I=1,NBCND)             
C	WRITE(12,6) PARM(17),DAY(J),(DUMMY(I),I=1,NBCND)              
        WRITE(12,6) PARM(18),DAY(J),(LPON(I,J),I=1,NBCND)              
        WRITE(12,6) PARM(19),DAY(J),(RPON(I,J),I=1,NBCND)             
        WRITE(12,6) PARM(20),DAY(J),(PO4(I,J),I=1,NBCND)             
        WRITE(12,6) PARM(21),DAY(J),(DOP(I,J),I=1,NBCND)             
C	WRITE(12,6) PARM(22),DAY(J),(DUMMY(I),I=1,NBCND)              
        WRITE(12,6) PARM(23),DAY(J),(LPOP(I,J),I=1,NBCND)             
        WRITE(12,6) PARM(24),DAY(J),(RPOP(I,J),I=1,NBCND)              
 	WRITE(12,6) PARM(25),DAY(J),(PIP(I,J),I=1,NBCND)              
        WRITE(12,6) PARM(26),DAY(J),(COD(I,J),I=1,NBCND)              
        WRITE(12,6) PARM(27),DAY(J),(DO(I,J),I=1,NBCND)               
	WRITE(12,6) PARM(30),DAY(J),(G3OC(I,J),I=1,NBCND)              
	WRITE(12,6) PARM(31),DAY(J),(G3ON(I,J),I=1,NBCND)              
	WRITE(12,6) PARM(32),DAY(J),(G3OP(I,J),I=1,NBCND)              
        WRITE(12,6) PARM(33),DAY(J),(CLAY(I,J),I=1,NBCND)              
        WRITE(12,6) PARM(34),DAY(J),(SILT(I,J),I=1,NBCND)              
        WRITE(12,6) PARM(35),DAY(J),(SAND(I,J),I=1,NBCND)              
	WRITE(12,6) PARM(36),DAY(J),(ORGS(I,J),I=1,NBCND)              
      END DO
 6    FORMAT(A8,F8.2,8F8.3,:/(:16X,8F8.3))
C THAT'S ALL SHE WROTE      

        END


        
