pkg/dic/bio_export.F

6d54cf9ca1 Ed H*0001 #include "DIC_OPTIONS.h"
daab022f42 Step*0002
08536d17ba Step*0003 CBOP
                0004 C !ROUTINE: BIO_EXPORT
                0005
                0006 C !INTERFACE: ==========================================================
951926fb9b Jean*0007       SUBROUTINE BIO_EXPORT( PTR_PO4 ,
daab022f42 Step*0008 #ifdef ALLOW_FE
951926fb9b Jean*0009      I           PTR_FE,
                0010 #endif
2bebba7fe3 Jona*0011      O           bioac,
9e77a98ea8 Jean*0012      I           bi,bj,iMin,iMax,jMin,jMax,
2e3e8c330d Jona*0013      I           myTime, myIter, myThid )
daab022f42 Step*0014
08536d17ba Step*0015 c !DESCRIPTION:
951926fb9b Jean*0016 C  Calculate biological activity and export
daab022f42 Step*0017
08536d17ba Step*0018 C !USES: ===============================================================
                0019       IMPLICIT NONE
daab022f42 Step*0020 #include "SIZE.h"
                0021 #include "DYNVARS.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
                0024 #include "GRID.h"
2ef8966791 Davi*0025 #include "DIC_VARS.h"
41f09ed70a Step*0026 #ifdef USE_QSW
e393d3c4a7 Step*0027 #include "FFIELDS.h"
                0028 #endif
daab022f42 Step*0029
08536d17ba Step*0030 C !INPUT PARAMETERS: ===================================================
                0031 C  PTR_PO4              :: phosphate tracer field
                0032 C  PTR_FE               :: iron tracer field
2e3e8c330d Jona*0033 C  myTime               :: current time
                0034 C  myIter               :: current timestep
                0035 C  myThid               :: thread number
daab022f42 Step*0036       _RL  PTR_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0037 #ifdef ALLOW_FE
                0038       _RL  PTR_FE(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0039 #endif
9e77a98ea8 Jean*0040       INTEGER iMin, iMax, jMin, jMax, bi, bj
2e3e8c330d Jona*0041       _RL myTime
                0042       INTEGER myIter
                0043       INTEGER myThid
08536d17ba Step*0044
                0045 C !OUTPUT PARAMETERS: ==================================================
                0046 C  bioac               :: biological productivity (will be split
                0047 C                         between export and dissolved pool)
9f5240b52a Jean*0048       _RL bioac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
08536d17ba Step*0049
7d9a1b3f07 Mart*0050 #if (defined ALLOW_PTRACERS && defined DIC_BIOTIC)
08536d17ba Step*0051
                0052 C !LOCAL VARIABLES: ====================================================
                0053 C  i,j,k                  :: loop indices
9e77a98ea8 Jean*0054        INTEGER i,j,k
2a2b7d0c36 Mart*0055 #if !defined READ_PAR && !defined USE_QSW
                0056       _RL sfac    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0057 #endif
7d9a1b3f07 Mart*0058       _RL lit     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
9e77a98ea8 Jean*0059       _RL kall, atten
720e9330bd Step*0060       _RL nutlimit
c845fbfeae Jean*0061       _RL tmppo4
9e77a98ea8 Jean*0062 #ifdef ALLOW_FE
c845fbfeae Jean*0063       _RL tmpfe
                0064 #endif
2e3e8c330d Jona*0065 #ifdef DIC_AD_SAFE
9f5240b52a Jean*0066       _RL thx, thy, thaux
720e9330bd Step*0067 #endif
08536d17ba Step*0068 CEOP
720e9330bd Step*0069
2a2b7d0c36 Mart*0070 #if !defined READ_PAR && !defined USE_QSW
                0071       CALL GCHEM_INSOLATION(
                0072      O     sfac,
                0073      I     iMin, iMax, jMin, jMax, bi, bj,
                0074      I     myTime, myIter, myThid)
e393d3c4a7 Step*0075 #endif
acd5268a40 Patr*0076 cph: following init assumes nlev=nr
                0077 cph: set in dic_init_fixed.F (ALLOW_AUTODIFF)
849e90aaf4 Mart*0078 C$TAF INIT bio_export = static, nsx*nsy*nr
29ad036528 Step*0079 C FORTRAN-77 dynamic memory uses adstore adresto
                0080 CRG C$TAF INIT bio_export = memory
9e77a98ea8 Jean*0081       DO j=jMin,jMax
                0082        DO i=iMin,iMax
9b8a71f139 Step*0083 #ifdef READ_PAR
7d9a1b3f07 Mart*0084         lit(i,j)=PAR(i,j,bi,bj)
27da8868b6 Davi*0085 #elif (defined USE_QSW)
7d9a1b3f07 Mart*0086         lit(i,j)=-parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj)
e393d3c4a7 Step*0087 #else
2a2b7d0c36 Mart*0088         lit(i,j)=MAX(1. _d -5,sfac(i,j)*parfrac)
9b8a71f139 Step*0089 #endif
2a2b7d0c36 Mart*0090        ENDDO
                0091       ENDDO
                0092       IF ( .NOT. QSW_underice ) THEN
                0093        DO j=jMin,jMax
                0094         DO i=iMin,iMax
27da8868b6 Davi*0095 c if using Qsw but not seaice/thsice or coupled, then
                0096 c ice fraction needs to be taken into account
7d9a1b3f07 Mart*0097          lit(i,j)=lit(i,j)*(1. _d 0 - FIce(i,j,bi,bj))
2a2b7d0c36 Mart*0098         ENDDO
7d9a1b3f07 Mart*0099        ENDDO
2a2b7d0c36 Mart*0100       ENDIF
9e77a98ea8 Jean*0101
                0102       kall = k0
7d9a1b3f07 Mart*0103       DO k=1,nlev
849e90aaf4 Mart*0104 C$TAF STORE lit = bio_export
9e77a98ea8 Jean*0105        DO j=jMin,jMax
                0106         DO i=iMin,iMax
                0107 #ifdef LIGHT_CHL
                0108 c   Add self-shading effects to light attenuation coefficient
                0109          kall = k0+kchl*CHL(i,j,bi,bj)
                0110 #endif
                0111          atten = kall*drF(k)*hFacC(i,j,k,bi,bj)*.5 _d 0
                0112          if (k.gt.1) atten = atten
                0113      &         +( kall*drF(k-1)*hFacC(i,j,k-1,bi,bj)*.5 _d 0 )
7d9a1b3f07 Mart*0114          lit(i,j)=lit(i,j)*exp(-atten)
                0115 #ifndef TARGET_NEC_SX
                0116 C     this statement breaks vectorization and causes a dramatic
                0117 C     performance drop on vector computers
9e77a98ea8 Jean*0118           IF (lit(i,j).LT.0. _d 0.OR.lit(i,j).GT.350. _d 0) THEN
                0119            print*,'QQ lit',i,j,lit(i,j)
                0120           ENDIF
                0121 #endif
f7bc6bf9ae Step*0122 #ifdef DIC_NO_NEG
7d9a1b3f07 Mart*0123          tmppo4=max(0. _d 0, PTR_PO4(i,j,k))
                0124          lit(i,j)=max(0. _d 0,lit(i,j))
f7bc6bf9ae Step*0125 #else
7d9a1b3f07 Mart*0126          tmppo4=PTR_PO4(i,j,k)
f7bc6bf9ae Step*0127 #endif
                0128
daab022f42 Step*0129 #ifdef ALLOW_FE
f7bc6bf9ae Step*0130 #ifdef DIC_NO_NEG
7d9a1b3f07 Mart*0131          tmpfe=max(0. _d 0,PTR_FE(i,j,k))
f7bc6bf9ae Step*0132 #else
7d9a1b3f07 Mart*0133          tmpfe=PTR_FE(i,j,k)
f7bc6bf9ae Step*0134 #endif
2e3e8c330d Jona*0135 #ifdef DIC_AD_SAFE
7d9a1b3f07 Mart*0136          thx = tmppo4/(tmppo4+KPO4)
                0137          thy = tmpfe/(tmpfe+KFE)
                0138 c        thx = PTR_PO4(i,j,k)/(PTR_PO4(i,j,k)+KPO4)
                0139 c        thy = PTR_FE(i,j,k)/(PTR_FE(i,j,k)+KFE)
                0140          thaux = tanh( (thx-thy)*1. _d 6 )
                0141          nutlimit= ( 1. _d 0 - thaux ) * thx * 0.5 _d 0
                0142      &        +    ( 1. _d 0 + thaux ) * thy * 0.5 _d 0
08536d17ba Step*0143 #else
7d9a1b3f07 Mart*0144          nutlimit=min( tmppo4/(tmppo4+KPO4),tmpfe/(tmpfe+KFE) )
daab022f42 Step*0145 #endif
720e9330bd Step*0146 #else
7d9a1b3f07 Mart*0147          nutlimit=     tmppo4/(tmppo4+KPO4)
720e9330bd Step*0148 #endif
                0149
7d9a1b3f07 Mart*0150          bioac(i,j,k)=alpha(i,j,bi,bj)*
                0151      &        lit(i,j)/(lit(i,j)+lit0)*maskC(i,j,k,bi,bj)*
                0152      &        nutlimit
daab022f42 Step*0153         ENDDO
7d9a1b3f07 Mart*0154        ENDDO
                0155       ENDDO
daab022f42 Step*0156 c
7d9a1b3f07 Mart*0157 #endif /* definded ALLOW_PTRACERS && defined DIC_BIOTIC */
                0158       RETURN
                0159       END