pkg/darwin/darwin_light_radtrans.F

8fbfd1f382 Oliv*0001 #include "DARWIN_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: DARWIN_LIGHT_RADTRANS
                0005 C !INTERFACE: ==========================================================
                0006       SUBROUTINE DARWIN_LIGHT_RADTRANS(
                0007      O                         PAR,
                0008      I                         solTime,
                0009      I                         bi, bj, iMin, iMax, jMin, jMax,
                0010      I                         myTime, myIter, myThid )
                0011
                0012 C !DESCRIPTION:
                0013
                0014 C !USES: ===============================================================
                0015       IMPLICIT NONE
                0016 #include "SIZE.h"
                0017 #include "GRID.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
                0020 C#include "DYNVARS.h"
                0021 #include "FFIELDS.h"
                0022 #include "PTRACERS_SIZE.h"
                0023 #include "PTRACERS_FIELDS.h"
                0024 #ifdef ALLOW_RADTRANS
                0025 #include "RADTRANS_SIZE.h"
                0026 #include "RADTRANS_PARAMS.h"
                0027 #endif
                0028 #include "DARWIN_SIZE.h"
                0029 #include "DARWIN_INDICES.h"
                0030 #include "DARWIN_EXF_FIELDS.h"
                0031 #include "DARWIN_RADTRANS.h"
                0032 #include "DARWIN_PARAMS.h"
                0033 #include "DARWIN_TRAITS.h"
                0034 #include "DARWIN_FIELDS.h"
                0035
                0036 C !INPUT PARAMETERS: ===================================================
                0037 C  myTime :: time at end of (sub)timestep
                0038 C  myThid :: thread number
                0039       _RL solTime
                0040       _RL myTime
                0041       INTEGER bi, bj, iMin, iMax, jMin, jMax, myIter, myThid
                0042
                0043 C !OUTPUT PARAMETERS: ==================================================
                0044       _RL PAR(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0045 CEOP
                0046
                0047 #ifdef ALLOW_DARWIN
                0048 #ifdef ALLOW_RADTRANS
                0049
                0050 C!LOCAL VARIABLES: ====================================================
                0051 C  i,j                  :: loop indices
                0052 C  k                    :: vertical level
                0053       LOGICAL  DIAGNOSTICS_IS_ON
                0054       EXTERNAL DIAGNOSTICS_IS_ON
                0055       CHARACTER*8 diagname
                0056       INTEGER i,j,k,l,jp
                0057       _RL part
                0058       _RL aCDOM(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0059       _RL phychl(nPhoto)
                0060       _RL plankcar(nPlank)
                0061 #ifdef DARWIN_ALLOW_CDOM
                0062       _RL CDOM
                0063 #else
                0064       _RL actotref, atotref
                0065 #endif
                0066       _RL E0F(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr+1, nlam)
                0067       _RL PARF(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr+1, nlam)
                0068       _RL actot
                0069       _RL bctot
                0070       _RL bbctot
                0071 C
                0072       _RL aprt
                0073       _RL btprt
                0074       _RL bbprt
                0075
                0076       _RL a3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0077       _RL bt3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0078       _RL bb3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0079 #ifdef ALLOW_DIAGNOSTICS
                0080 #ifdef DARWIN_DIAG_IOP
                0081       _RL aplk3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0082       _RL btplk3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0083       _RL bbplk3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0084       _RL aprt3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0085       _RL btprt3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0086       _RL bbprt3d(1-OLx:sNx+OLx, 1-OLy:sNy+OLy, Nr, nlam)
                0087 #endif
                0088 #endif
                0089
                0090 C ======================================================================
                0091       DO j=jMin,jMax
                0092        DO i=iMin,iMax
                0093         DO k=1,Nr
                0094
086a45f245 Oliv*0095          part = MAX(Ptracer(i,j,k,bi,bj,iPOP), 0 _d 0)
                0096          part = part + (darwin_RPOC/120 _d 0)
8fbfd1f382 Oliv*0097          DO jp=1,nPhoto
                0098 #ifdef DARWIN_ALLOW_CHLQUOTA
086a45f245 Oliv*0099           phychl(jp)=MAX(Ptracer(i,j,k,bi,bj,iChl+jp-1),0 _d 0)
8fbfd1f382 Oliv*0100 #else
086a45f245 Oliv*0101           phychl(jp)=MAX(chlPrev(i,j,k,bi,bj,jp), 0 _d 0)
8fbfd1f382 Oliv*0102 #endif
                0103          ENDDO
                0104          DO jp=1,nPlank
086a45f245 Oliv*0105           plankcar(jp)=MAX(Ptracer(i,j,k,bi,bj,ic+jp-1),0 _d 0)
8fbfd1f382 Oliv*0106          ENDDO
                0107
                0108 #ifdef DARWIN_ALLOW_CDOM
                0109 c use cdom-like tracer
086a45f245 Oliv*0110          CDOM = MAX(Ptracer(i,j,k,bi,bj,iCDOM), 0 _d 0)
e1251af904 Oliv*0111          CDOM = CDOM + darwin_rCDOM
8fbfd1f382 Oliv*0112          DO l = 1,nlam
                0113           aCDOM(i,j,k,l) = CDOMcoeff*CDOM*exCDOM(l)
                0114          ENDDO
                0115 #else
                0116          actotref = 0.0 _d 0
                0117          atotref = 0.0 _d 0
                0118          DO jp = 1,nPhoto
                0119 c         nb. n,k swapped from WG
                0120           actotref = actotref +
                0121      &          phychl(jp)*aphy_chl(jp,laCDOM)
                0122          ENDDO
                0123          atotref = aw(laCDOM) + actotref
                0124          DO l = 1,nlam
                0125           aCDOM(i,j,k,l) = darwin_aCDOM_fac*atotref*exCDOM(l)
                0126          ENDDO
                0127 #endif
                0128
                0129          DO l = 1,nlam
                0130 c         absorption by phyto
                0131           actot = 0.0
                0132           bctot = 0.0
                0133           bbctot = 0.0
                0134           DO jp = 1, nPhoto
                0135            actot  = actot  + phychl(jp)*aphy_chl(jp,l)
                0136 #ifdef DARWIN_SCATTER_CHL
                0137            bctot  = bctot  + phychl(jp)*bphy_mgC(jp,l)
                0138            bbctot = bbctot + phychl(jp)*bbphy_mgC(jp,l)
478b92544c Oliv*0139 #endif
                0140           ENDDO
                0141           DO jp = 1, nPlank
                0142            actot  = actot  + plankcar(jp)*aphy_mgC(jp,l)*12
                0143 #ifndef DARWIN_SCATTER_CHL
8fbfd1f382 Oliv*0144 c          convert mmol C to mg C
                0145            bctot  = bctot  + plankcar(jp)*bphy_mgC(jp,l)*12
                0146            bbctot = bbctot + plankcar(jp)*bbphy_mgC(jp,l)*12
                0147 #endif
                0148           ENDDO
                0149 c         add water, CDOM and particles
                0150           aprt =  part*apart_P(l)
                0151           btprt = part*bpart_P(l)
                0152           bbprt = part*bbpart_P(l)
                0153           a3d(i,j,k,l) = aw(l) + aCDOM(i,j,k,l) + actot  + aprt
                0154           bt3d(i,j,k,l) = bw(l)                 + bctot  + btprt
                0155           bb3d(i,j,k,l) = darwin_bbw*bw(l)         + bbctot + bbprt
                0156           bb3d(i,j,k,l) = MAX(darwin_bbmin, bb3d(i,j,k,l))
                0157 #ifdef ALLOW_DIAGNOSTICS
                0158 #ifdef DARWIN_DIAG_IOP
                0159           aplk3d(i,j,k,l) = actot
                0160           btplk3d(i,j,k,l) = bctot
                0161           bbplk3d(i,j,k,l) = bbctot
                0162           aprt3d(i,j,k,l) = aprt
                0163           btprt3d(i,j,k,l) = btprt
                0164           bbprt3d(i,j,k,l) = bbprt
                0165 #endif
                0166 #endif
                0167          ENDDO
                0168
                0169 C       k
                0170         ENDDO
                0171
                0172 C      i,j
                0173        ENDDO
                0174       ENDDO
                0175 C ======================================================================
                0176
                0177       CALL RADTRANS_CALC(
                0178      I                   a3d, bt3d, bb3d,
                0179      O                   E0F,
                0180      I                   bi, bj, iMin, iMax, jMin, jMax,
                0181      I                   myTime, myIter, myThid)
                0182
                0183       DO l=1,nlam
                0184        DO k=1,Nr+1
                0185         DO j=jMin,jMax
                0186          DO i=iMin,iMax
                0187           PARF(i,j,k,l) = E0F(i,j,k,l)*RT_WtouEins(l)
                0188          ENDDO
                0189         ENDDO
                0190        ENDDO
                0191        DO k=1,Nr
                0192         DO j=jMin,jMax
                0193          DO i=iMin,iMax
                0194           PAR(i,j,k,l) = SQRT(PARF(i,j,k,l)*PARF(i,j,k+1,l))
                0195          ENDDO
                0196         ENDDO
                0197        ENDDO
                0198       ENDDO
                0199
                0200 C ======================================================================
                0201
                0202 #ifdef ALLOW_DIAGNOSTICS
                0203       IF (useDIAGNOSTICS .AND. myIter .GE.0) THEN
                0204       DO l = 1, nlam
                0205        WRITE(diagname, '(A,I3.3)') 'PARF', l
                0206        CALL DIAGNOSTICS_FILL(PARF(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0207      &       bi,bj,myThid)
                0208 #ifdef DARWIN_DIAG_IOP
                0209        WRITE(diagname, '(A,I3.3)') 'a', l
                0210        CALL DIAGNOSTICS_FILL(a3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0211      &       bi,bj,myThid)
                0212        WRITE(diagname, '(A,I3.3)') 'bt', l
                0213        CALL DIAGNOSTICS_FILL(bt3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0214      &       bi,bj,myThid)
                0215        WRITE(diagname, '(A,I3.3)') 'bb', l
                0216        CALL DIAGNOSTICS_FILL(bb3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0217      &       bi,bj,myThid)
                0218        WRITE(diagname, '(A,I3.3)') 'aplk', l
                0219        CALL DIAGNOSTICS_FILL(aplk3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0220      &     bi,bj,myThid)
                0221        WRITE(diagname, '(A,I3.3)') 'btplk', l
                0222        CALL DIAGNOSTICS_FILL(btplk3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0223      &     bi,bj,myThid)
                0224        WRITE(diagname, '(A,I3.3)') 'bbplk', l
                0225        CALL DIAGNOSTICS_FILL(bbplk3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0226      &     bi,bj,myThid)
                0227        WRITE(diagname, '(A,I3.3)') 'aprt', l
                0228        CALL DIAGNOSTICS_FILL(aprt3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0229      &     bi,bj,myThid)
                0230        WRITE(diagname, '(A,I3.3)') 'btprt', l
                0231        CALL DIAGNOSTICS_FILL(btprt3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0232      &     bi,bj,myThid)
                0233        WRITE(diagname, '(A,I3.3)') 'bbprt', l
                0234        CALL DIAGNOSTICS_FILL(bbprt3d(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0235      &     bi,bj,myThid)
                0236 #endif
                0237        WRITE(diagname, '(A,I3.3)') 'aCDOM', l
                0238        CALL DIAGNOSTICS_FILL(aCDOM(1-OLx,1-OLy,1,l),diagname,0,Nr,2,
                0239      &     bi,bj,myThid)
                0240       ENDDO
                0241        IF (DIAGNOSTICS_IS_ON('PARF    ', myThid)) THEN
                0242         DO l=2,nlam
                0243          DO k=1,Nr
                0244           DO j=jMin,jMax
                0245            DO i= iMin,iMax
                0246             PARF(i,j,k,1) = PARF(i,j,k,1) + PARF(i,j,k,l)
                0247            ENDDO
                0248           ENDDO
                0249          ENDDO
                0250         ENDDO
                0251         WRITE(diagname, '(A)') 'PARF'
                0252         CALL DIAGNOSTICS_FILL(PARF,diagname,0,Nr,2,bi,bj,myThid)
                0253        ENDIF
                0254 C PAR is done in darwin_forcing
                0255       ENDIF
                0256 #endif
                0257
                0258 #endif /* ALLOW_RADTRANS */
                0259 #endif /* ALLOW_DARWIN */
                0260
                0261       RETURN
                0262       END