SUBROUTINE PHYTOPLANKTON(index_id,i_id,iint_id) !========================================================================== ! This routine computes source and sink terms of phytoplankton in 1D === ! without vertical mixing === !========================================================================== ! Define global data. USE MOD_1D USE MOD_NUTRIENT USE MOD_PHYTOPLANKTON USE MOD_ZOOPLANKTON USE MOD_DETRITUS USE MOD_BACTERIA USE MOD_DOM IMPLICIT NONE INTEGER :: I,K,J,I1,I2 REAL(SPP) :: TEMPP, TRANS, TATANUL, IRRAD, IRRAD1 REAL(SPP) :: SINKK(10),RATIO(10),RATIOT,SMALL integer :: index_id,i_id,iint_id !======================================================================= ! BEGINNING EXECUTABLE !======================================================================= SMALL = 1.E-30 DO K=1,KBVM1 !vertical !************** PAR-PHYTOPLANKTON PRODUCTION ************************** TEMPP=T_BIO(K) TATANUL=1.0E-10 !Total attanuation TATANUL=TATANUL+ATANU_W*DELTA_D(K) !Water attanuation TRANS=0.0_SPP DO J=1,NNP TRANS=TRANS+BIO_P(K,J)*CHL2C(J) !Total chlorophyll END DO IF(TRANS.GT.0.0) TATANUL=TATANUL+TRANS*ATANU_C*DELTA_D(K) TRANS=0.0_SPP DO J=1,NND TRANS=TRANS+BIO_D(K,J) !Total detritus END DO IF(TRANS.GT.0.0) TATANUL=TATANUL+TRANS*ATANU_D*DELTA_D(K) ! Detrital attanuation IRRAD1=IRRAD0*EXP(-TATANUL) ! Irradiance at the layer bottom IRRAD=(IRRAD0-IRRAD1)/TATANUL ! Average irradiance DO J=1,NNP UTR(J)=EXP(-A_TP(J)*ABS(TEMPP-T_OPTP(J))) ! Temperature forcing on phyto ! UTR(J)=A_TP(J)**((TEMPP-T_OPTP(J))/10.) SELECT CASE (TRIM(L_FUNCTION)) ! Light function choice CASE('EXP_LIGHT') ! Exponential (Frank et al. ,86) ! ULR(J)=EXP(TATANUL*DEPTH_Z(K)) ULR(J)=EXP(ATANU_W*DEPTH_Z(K)) CASE('SL62_LIGHT') ! Exponential (Steele, 62) ULR(J)=IRRAD/I_OPT(J)*EXP(1-IRRAD/I_OPT(J)) CASE('MM_LIGHT') ! Michaealis (Baly 35) ULR(J)=ALPHAP(J)*IRRAD/(K_LIGHT(J)+ALPHAP(J)*IRRAD) CASE('LB_LIGHT') ! Michaelis (Bannister, 79) ULR(J)=ALPHAP(J)*IRRAD/((K_LIGHT(J))**N_P(J) & +(ALPHAP(J)*IRRAD)**BETAP(J))**(1/N_P(J)) CASE('V65_LIGHT') ! Michaelis (Vollenweider 65) ULR(J)=ALPHAP(J)*IRRAD/(SQRT(I_OPT(J)**2+(ALPHAP(J)*IRRAD)**2) & *(1+(BETAP(J)*IRRAD/I_OPT(J))**2)**(N_P(J)/2)) CASE('PE78_LIGHT') ! Michaelis (Peeters & Eiler, 78) ULR(J)=IRRAD/I_OPT(J)*(2+ALPHAP(J))/(1+ALPHAP(J)*IRRAD/I_OPT(J) & +(IRRAD/I_OPT(J))**2) CASE('WNS74_LIGHT') ! Exponentail (Webb, 1978) ULR(J)=1-EXP(-ALPHAP(J)*IRRAD/(UMAX(J)+SMALL)) CASE('PGH80_LIGHT') ! Exponential (Platt et al., 80) ULR(J)=(1-EXP(-ALPHAP(J)*IRRAD/(UMAX(J)+SMALL))) & *EXP(-BETAP(J)*IRRAD/(UMAX(J)+SMALL)) CASE('SH92_LIGHT') ! Exponential (STEEL & Henderson, 1992) ULR(J)=(1-EXP(-ALPHAP(J)*IRRAD)*EXP(-BETAP(J)*IRRAD)) CASE('JI_LIGHT') ! Exponential (Platt et al., 80) ULR(J)=(1-EXP(-ALPHAP(J)*IRRAD))*EXP(-BETAP(J)*IRRAD) CASE('JP76_LIGHT') ! Tangent (Jessy & Platt, 76) ULR(J)=TANH(ALPHAP(J)*IRRAD/(UMAX(J)+SMALL)) CASE('BWDC99_LIGHT') ! Tangent (Bissett et al., 99) ULR(J)=TANH(ALPHAP(J)*(IRRAD-I_OPT(J))/(UMAX(J)+SMALL)) & *EXP(BETAP(J)*(I_OPT(J)-IRRAD)) END SELECT !************* NUTRIENT-PHYTOPLANKTON GORWTH *************** UNRMIN(J)=1.0_SPP DO I1=1,NNN UNR(J,I1)=FVNN(K,I1)/(FVNN(K,I1)+KSN(I1,J)) END DO IF (.NOT. NO3_ON) THEN DO I1=1,NNN IF(N2CP(I1,J).GT.0.) UNRMIN(J)=MIN(UNRMIN(J),UNR(J,I1)) END DO ELSE UNR(J,2)=FVNN(K,2)/(FVNN(K,2)+KSN(2,J)) & ! NO3 must be nutrient 2 *KSN(J,1)/(FVNN(K,1)+KSN(1,J)) ! Parker NH4 inhibition UNR(J,NNN+1)=UNR(J,1)+UNR(J,2) ! Total nitrogen factor DO I1=3,NNN IF(N2CP(I1,J).GT.0.) UNRMIN(J)=MIN(UNRMIN(J),UNR(J,I1)) END DO UNRMIN(J)=MIN(UNRMIN(J),UNR(J,NNN+1)) ! Combined NH4 and NO3 END IF U_P(K,J)=UMAX(J)*UTR(J)*(ALPHA_U(J)*ULR(J)*UNRMIN(J) & +(1-ALPHA_U(J))*MIN(ULR(J),UNRMIN(J))) & *BIO_P(K,J)*CHL2C(J) !Chl concentration !JQIJQI ! if(index_id == 1 .and. mod(iint_id,30) == 0)then ! if(i_id == 153)write(101,'(2i6,i3,9e12.5)') iint_id,i_id,k,u_p(k,j),utr(j),ulr(j),unrmin(j),bio_p(k,j),irrad,TATANUL,irrad0,irrad1 ! if(i_id == 5681)write(102,'(2i6,i3,9e12.5)') iint_id,i_id,k,u_p(k,j),utr(j),ulr(j),unrmin(j),bio_p(k,j),irrad,TATANUL,irrad0,irrad1 ! if(i_id == 10244)write(103,'(2i6,i3,9e12.5)') iint_id,i_id,k,u_p(k,j),utr(j),ulr(j),unrmin(j),bio_p(k,j),irrad,TATANUL,irrad0,irrad1 ! end if DO I1=1,NNN UPTAKE_PN(K,I1,J)=U_P(K,J)*N2CP(I1,J) !Nutrient uptake END DO IF (NO3_ON) THEN if(unr(j,nnn+1).ne.0) then UPTAKE_PN(K,1,J)=U_P(K,J)*N2CP(1,J)*UNR(J,1)/UNR(J,NNN+1) !NH4 UPTAKE_PN(K,2,J)=U_P(K,J)*N2CP(1,J)*UNR(J,2)/UNR(J,NNN+1) !NO3 else uptake_pn(k,1,j)=0. uptake_pn(k,2,j)=0. endif END IF !*************** SINK TERMS **************** P_DOM(K,J)=DPDOM(J)*FVP(K,J) !DOM EXUDATION P_D(K,J)=UTR(J)*MPD(J)*FVP(K,J)**M_P(J) P_N(K,J)=R_P(J)*FVP(K,J)*EXP(RP_T*TEMPP) !Phyto respiration with T forcing ! RATIOT=FVP(K,J)/((P_DOM(K,J)+P_D(K,J)+P_N(K,J))*T_STEP+1.E-30) ! IF(RATIOT.LT.1.) THEN ! P_DOM(K,J)=0.0 ! P_D(K,J)=0.0 ! P_N(K,J)=0.0 ! END IF ! FVP(K,J)=FVP(K,J)-(P_DOM(K,J)+P_D(K,J)+P_N(K,J))*T_STEP ENDDO !************** CHECK NUTRIENT AVAILABILITY *********** ! RATIOT=1.0 ! SINKK=0. ! RATIO=1.0 ! DO I1=1,NNN ! DO I2=1,NNP ! SINKK(I1)=SINKK(I1)+UPTAKE_PN(K,I1,I2) ! END DO ! SINKK(I1)=SINKK(I1)*T_STEP ! END DO ! DO I1=1,NNN ! IF (SINKK(I1).GT.FVNN(K,I1).AND.SINKK(I1).GT.0.0) THEN ! RATIO(I1)=FVNN(K,I1)/(SINKK(I1)+1.E-30) ! RATIOT=MIN(RATIOT,RATIO(I1)) ! END IF ! END DO ! IF (RATIOT .LT. 1.0) THEN ! DO I2=1,NNP ! U_P(K,I2)=U_P(K,I2)*RATIOT ! DO I1=1,NNN ! UPTAKE_PN(K,I1,I2)=UPTAKE_PN(K,I1,I2)*RATIOT ! END DO ! END DO ! END IF !**************** LIGHT-CONTROLLED NITRIFICATION ************* IF (NO3_ON) THEN IF (IRRAD0.GT.0.) THEN TRANS=L_NH4N-IRRAD1 IF (TRANS > 0.) THEN NH4_NO3(K)=R_AN*TRANS*FVNN(K,1)/L_NH4N ELSE NH4_NO3(K)=0. END IF ELSE NH4_NO3(K)=R_AN*FVNN(K,1) END IF END IF IRRAD0=IRRAD1 !For next level ENDDO !******************* CELLS SINKING *********** DO I1=1,NNP ! WSNK_P(1,I1)=(-0.5)*W_P(I1)*(FVP(1,I1)+FVP(2,I1))/DELTA_D(1) WSNK_P(1,I1)=(-1)*W_P(I1)*(FVP(1,I1))/DELTA_D(1) ! WSNK_P(KBVM1,I1)=W_P(I1)*(FVP(KBV-2,I1)-FVP(KBVM1,I1))/DELTA_D(KBVM1) !Sink out WSNK_P(KBVM1,I1)=W_P(I1)*(FVP(KBV-2,I1))/DELTA_D(KBVM1) !No sink out END DO DO K=2,KBV-2 DO I1=1,NNP ! WSNK_P(K,I1)=W_P(I1)*0.5*(FVP(K-1,I1)-FVP(K+1,I1))/DELTA_D(K) WSNK_P(K,I1)=W_P(I1)*(FVP(K-1,I1)-FVP(K,I1))/DELTA_D(K) END DO END DO !************** PHYTOPLANKTON SOURCES AND SINKS ************** DO K=1,KBVM1 DO J=1,NNP BIO_P(K,J)=BIO_P(K,J)+((1-D_DOM(J))*U_P(K,J)+WSNK_P(K,J) & !Growth & Sinking -P_DOM(K,J)-P_D(K,J)-P_N(K,J))*T_STEP !Exudaiton, mortality, respiration DO I2=1,NNZ BIO_P(K,J)=BIO_P(K,J)-G_P(K,J,I2)*T_STEP !GRAZING LOSSES END DO END DO END DO RETURN END SUBROUTINE PHYTOPLANKTON