/[MITgcm]/MITgcm_contrib/bling/pkg/bling_light.F
ViewVC logotype

Diff of /MITgcm_contrib/bling/pkg/bling_light.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by mmazloff, Fri May 23 17:33:43 2014 UTC revision 1.2 by mmazloff, Sun Feb 28 21:49:24 2016 UTC
# Line 5  C $Name$ Line 5  C $Name$
5    
6  CBOP  CBOP
7        subroutine BLING_LIGHT(        subroutine BLING_LIGHT(
8       U               irr_eff,       I               mld,
9         U               irr_inst, irr_eff,
10       I               bi, bj, imin, imax, jmin, jmax,       I               bi, bj, imin, imax, jmin, jmax,
11       I               myIter, myTime, myThid )       I               myIter, myTime, myThid )
12        
13  C     =================================================================  C     =================================================================
14  C     | subroutine bling_light  C     | subroutine bling_light
15  C     | o calculate effective light for phytoplankton growth  C     | o calculate effective light for phytoplankton growth
# Line 39  C     irr_mem       :: Phyto irradiance Line 41  C     irr_mem       :: Phyto irradiance
41  #include "BLING_VARS.h"  #include "BLING_VARS.h"
42  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
43  #include "PTRACERS_PARAMS.h"  #include "PTRACERS_PARAMS.h"
44  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF
45  # include "tamc.h"  # include "tamc.h"
46  #endif  #endif
47    
# Line 54  C     myThid        :: thread Id. number Line 56  C     myThid        :: thread Id. number
56        INTEGER myThid        INTEGER myThid
57        INTEGER myIter        INTEGER myIter
58        _RL     myTime        _RL     myTime
59    C     === Input ===
60          _RL mld       (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61  C     === Output ===  C     === Output ===
62    C      irr_inst     :: instantaneous light
63  C      irr_eff      :: effective light for photosynthesis  C      irr_eff      :: effective light for photosynthesis
64          _RL irr_inst  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
65        _RL irr_eff   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL irr_eff   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
66    
67  C     === Local variables ===  C     === Local variables ===
# Line 68  C     === Local variables === Line 74  C     === Local variables ===
74  #ifdef ML_MEAN_LIGHT        #ifdef ML_MEAN_LIGHT      
75        _RL irr_mix   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL irr_mix   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
76        _RL SumMLIrr        _RL SumMLIrr
77        _RL SumMLDepth        _RL tmp_ML
       _RL dens_surf (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL dens_z    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL delta_dens(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
78  #endif  #endif
79  #ifndef READ_PAR  #ifndef READ_PAR
80  #ifndef USE_QSW  #ifndef USE_QSW
# Line 81  C     === Local variables === Line 84  C     === Local variables ===
84         integer i,j,k         integer i,j,k
85  CEOP  CEOP
86    
87  #ifdef ML_MEAN_LIGHT         DO k=1,Nr
 c ---------------------------------------------------------------------  
 c  Mixed layer depth  
   
 c  Surface density  
       CALL FIND_RHO_2D(  
      I     1-OLx, sNx+OLx, 1-OLy, sNy+OLy, 1,  
      I     theta(1-OLx,1-OLy,1,bi,bj), salt(1-OLx,1-OLy,1,bi,bj),  
      O     dens_surf,  
      I     1, bi, bj, myThid )  
   
       DO k=1,Nr  
         DO j=jmin,jmax  
           DO i=imin,imax  
              if (k.eq.1) then  
               delta_dens(i,j,1) = 0. _d 0  
              else  
               delta_dens(i,j,k) = 9999. _d 0  
              endif  
           ENDDO  
         ENDDO  
       ENDDO  
   
       DO k = 2,Nr  
   
 c  Potential density  
          CALL FIND_RHO_2D(  
      I        1-OLx, sNx+OLx, 1-OLy, sNy+OLy, 1,  
      I        theta(1-OLx,1-OLy,k,bi,bj), salt(1-OLx,1-OLy,k,bi,bj),  
      O        dens_z,  
      I        k, bi, bj, myThid )  
   
88          DO j=jmin,jmax          DO j=jmin,jmax
89            DO i=imin,imax            DO i=imin,imax
90             IF (hFacC(i,j,k,bi,bj) .gt. 0. _d 0) THEN                irr_eff(i,j,k)        = 0. _d 0
               delta_dens(i,j,k) = dens_z(i,j)-dens_surf(i,j)  
            ENDIF  
91            ENDDO            ENDDO
92          ENDDO          ENDDO
93        ENDDO         ENDDO
 #endif  
94    
95  c ---------------------------------------------------------------------  c ---------------------------------------------------------------------
96  c  Surface insolation  c  Surface insolation
# Line 166  C     (makes latitude independent of gri Line 135  C     (makes latitude independent of gri
135            IF (cosz.LE.5. _d -3) cosz= 5. _d -3            IF (cosz.LE.5. _d -3) cosz= 5. _d -3
136            frac = dayhrs/PI                           !fraction of daylight in day            frac = dayhrs/PI                           !fraction of daylight in day
137  C daily average photosynthetically active solar radiation just below surface  C daily average photosynthetically active solar radiation just below surface
138            fluxi = solar*(1. _d 0-albedo)*cosz*frac*parfrac           fluxi = solar*(1. _d 0-albedo)*cosz*frac*parfrac
139    
140  C convert to sfac  C convert to sfac
141            sfac(j) = MAX(1. _d -5,fluxi)            sfac(j) = MAX(1. _d -5,fluxi)
# Line 184  C$TAF LOOP = parallel Line 153  C$TAF LOOP = parallel
153                
154  c  Photosynthetically-available radiations (PAR)  c  Photosynthetically-available radiations (PAR)
155  #ifdef USE_EXFQSW  #ifdef USE_EXFQSW
156          irr_surf(i,j) = max(0. _d 0,          irr_surf(i,j) = max(epsln,
157       &                 -parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj))       &                 -parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj))
158  #else  #else
159          irr_surf(i,j) = sfac(j)          irr_surf(i,j) = sfac(j)
160  #endif  #endif
161          IF ( .NOT. QSW_underice ) THEN  cav        IF ( .NOT. QSW_underice ) THEN
162  c  if using Qsw but not seaice/thsice or coupled, then  c  if using Qsw but not seaice/thsice or coupled, then
163  c  ice fraction needs to be taken into account  c  ice fraction needs to be taken into account
164           irr_surf(i,j) = irr_surf(i,j)*(1. _d 0 - FIce(i,j,bi,bj))  cav         irr_surf(i,j) = irr_surf(i,j)*(1. _d 0 - FIce(i,j,bi,bj))
165          ENDIF  cav        ENDIF
166    
167  #ifdef ML_MEAN_LIGHT  #ifdef ML_MEAN_LIGHT
168          SumMLIrr   = 0. _d 0          SumMLIrr   = 0. _d 0
169          SumMLDepth = 0. _d 0          tmp_ML     = 0. _d 0
170  #endif  #endif
171    
172  c C$TAF init ml_stuff = static, Nr  c C$TAF init ml_stuff = static, Nr
# Line 209  c C$TAF STORE SumMLDepth = ml_stuff Line 178  c C$TAF STORE SumMLDepth = ml_stuff
178           IF (k.eq.1) THEN           IF (k.eq.1) THEN
179  c  Light attenuation in middle of top layer  c  Light attenuation in middle of top layer
180            atten = k0*drF(1)/2. _d 0*hFacC(i,j,1,bi,bj)            atten = k0*drF(1)/2. _d 0*hFacC(i,j,1,bi,bj)
181            irr_inst(i,j,1,bi,bj) = irr_surf(i,j)*exp(-atten)            irr_inst(i,j,1) = irr_surf(i,j)*exp(-atten)
182           ELSE           ELSE
183  c  Attenuation from one more layer  c  Attenuation from one more layer
184            atten = k0*drF(k)/2. _d 0*hFacC(i,j,k,bi,bj)            atten = k0*drF(k)/2. _d 0*hFacC(i,j,k,bi,bj)
185       &           + k0*drF(k-1)/2. _d 0*hFacC(i,j,k-1,bi,bj)       &           + k0*drF(k-1)/2. _d 0*hFacC(i,j,k-1,bi,bj)
186            irr_inst(i,j,k,bi,bj) =            irr_inst(i,j,k) =
187       &           irr_inst(i,j,k-1,bi,bj)*exp(-atten)       &           irr_inst(i,j,k-1)*exp(-atten)
188           ENDIF           ENDIF
189    
190  #ifdef ML_MEAN_LIGHT  #ifdef ML_MEAN_LIGHT
191  c  Mean irradiance in the mixed layer  c  Mean irradiance in the mixed layer
192           IF (delta_dens(i,j,k) .LT. 0.03 _d 0) then           IF ((-rf(k+1) .le. mld(i,j)).and.
193            SumMLIrr = SumMLIrr+drF(k)*irr_inst(i,j,k,bi,bj)       &               (-rf(k+1).lt.200. _d 0)) THEN
194            SumMLDepth = SumMLDepth+drF(k)            SumMLIrr = SumMLIrr+drF(k)*irr_inst(i,j,k)
195            irr_mix(i,j) = SumMLIrr/SumMLDepth            tmp_ML = tmp_ML + drF(k)
196              irr_mix(i,j) = SumMLIrr/tmp_ML
197           ENDIF           ENDIF
198  #endif  #endif
199    
# Line 233  c  Mean irradiance in the mixed layer Line 203  c  Mean irradiance in the mixed layer
203         ENDDO         ENDDO
204        ENDDO        ENDDO
205    
206  c ---------------------------------------------------------------------  
 C  Phytoplankton photoadaptation to local light level  
207        DO k=1,Nr        DO k=1,Nr
208         DO j=jmin,jmax         DO j=jmin,jmax
209          DO i=imin,imax            DO i=imin,imax  
210    
211            irr_eff(i,j,k) = irr_inst(i,j,k,bi,bj)           IF (hFacC(i,j,k,bi,bj) .gt. 0. _d 0) THEN
212    
213              irr_eff(i,j,k) = irr_inst(i,j,k)
214  #ifdef ML_MEAN_LIGHT  #ifdef ML_MEAN_LIGHT
215  c  Inside mixed layer, effective light is set to mean mixed layer light  c  Inside mixed layer, effective light is set to mean mixed layer light
216            IF (delta_dens(i,j,k) .LT. 0.03 _d 0) THEN           IF ((-rf(k+1) .le. mld(i,j)).and.
217         &               (-rf(k+1).lt.200. _d 0)) THEN
218             irr_eff(i,j,k) = irr_mix(i,j)             irr_eff(i,j,k) = irr_mix(i,j)
219            ENDIF            ENDIF
220  #endif  #endif
221    
222            irr_mem(i,j,k,bi,bj) = irr_mem(i,j,k,bi,bj) +           ENDIF
      &           (irr_eff(i,j,k) - irr_mem(i,j,k,bi,bj))*  
      &           min( 1. _d 0, gamma_irr_mem*PTRACERS_dTLev(k) )  
223    
224          ENDDO          ENDDO
225         ENDDO         ENDDO
226        ENDDO        ENDDO
227        
228    #ifdef ALLOW_DIAGNOSTICS
229          IF ( useDiagnostics ) THEN
230            CALL DIAGNOSTICS_FILL(Qsw,'BLGQSW  ',0,1,1,bi,bj,myThid)
231            CALL DIAGNOSTICS_FILL(irr_inst,'BLGIRRIS',0,Nr,2,bi,bj,myThid)
232          ENDIF
233    #endif
234    
235        RETURN        RETURN
236        END        END
237          
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22