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
7d9a1b3f07 Mart*0055       _RL sfac    (1-OLy:sNy+OLy)
                0056       _RL lit     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
9e77a98ea8 Jean*0057       _RL kall, atten
720e9330bd Step*0058       _RL nutlimit
c845fbfeae Jean*0059       _RL tmppo4
9e77a98ea8 Jean*0060 #ifdef ALLOW_FE
c845fbfeae Jean*0061       _RL tmpfe
                0062 #endif
2e3e8c330d Jona*0063 #ifdef DIC_AD_SAFE
9f5240b52a Jean*0064       _RL thx, thy, thaux
720e9330bd Step*0065 #endif
08536d17ba Step*0066 CEOP
720e9330bd Step*0067
9b8a71f139 Step*0068 #ifndef READ_PAR
41f09ed70a Step*0069 #ifndef USE_QSW
7d9a1b3f07 Mart*0070       CALL INSOL(myTime,sfac,bi,bj,myThid)
9b8a71f139 Step*0071 #endif
e393d3c4a7 Step*0072 #endif
acd5268a40 Patr*0073 cph: following init assumes nlev=nr
                0074 cph: set in dic_init_fixed.F (ALLOW_AUTODIFF)
849e90aaf4 Mart*0075 C$TAF INIT bio_export = static, nsx*nsy*nr
29ad036528 Step*0076 C FORTRAN-77 dynamic memory uses adstore adresto
                0077 CRG C$TAF INIT bio_export = memory
9e77a98ea8 Jean*0078       DO j=jMin,jMax
                0079        DO i=iMin,iMax
9b8a71f139 Step*0080 #ifdef READ_PAR
7d9a1b3f07 Mart*0081         lit(i,j)=PAR(i,j,bi,bj)
27da8868b6 Davi*0082 #elif (defined USE_QSW)
7d9a1b3f07 Mart*0083         lit(i,j)=-parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj)
e393d3c4a7 Step*0084 #else
7d9a1b3f07 Mart*0085         lit(i,j)=sfac(j)
9b8a71f139 Step*0086 #endif
7d9a1b3f07 Mart*0087         IF ( .NOT. QSW_underice ) THEN
27da8868b6 Davi*0088 c if using Qsw but not seaice/thsice or coupled, then
                0089 c ice fraction needs to be taken into account
7d9a1b3f07 Mart*0090          lit(i,j)=lit(i,j)*(1. _d 0 - FIce(i,j,bi,bj))
                0091         ENDIF
                0092        ENDDO
                0093       ENDDO
9e77a98ea8 Jean*0094
                0095       kall = k0
7d9a1b3f07 Mart*0096       DO k=1,nlev
849e90aaf4 Mart*0097 C$TAF STORE lit = bio_export
9e77a98ea8 Jean*0098        DO j=jMin,jMax
                0099         DO i=iMin,iMax
                0100 #ifdef LIGHT_CHL
                0101 c   Add self-shading effects to light attenuation coefficient
                0102          kall = k0+kchl*CHL(i,j,bi,bj)
                0103 #endif
                0104          atten = kall*drF(k)*hFacC(i,j,k,bi,bj)*.5 _d 0
                0105          if (k.gt.1) atten = atten
                0106      &         +( kall*drF(k-1)*hFacC(i,j,k-1,bi,bj)*.5 _d 0 )
7d9a1b3f07 Mart*0107          lit(i,j)=lit(i,j)*exp(-atten)
                0108 #ifndef TARGET_NEC_SX
                0109 C     this statement breaks vectorization and causes a dramatic
                0110 C     performance drop on vector computers
9e77a98ea8 Jean*0111           IF (lit(i,j).LT.0. _d 0.OR.lit(i,j).GT.350. _d 0) THEN
                0112            print*,'QQ lit',i,j,lit(i,j)
                0113           ENDIF
                0114 #endif
f7bc6bf9ae Step*0115 #ifdef DIC_NO_NEG
7d9a1b3f07 Mart*0116          tmppo4=max(0. _d 0, PTR_PO4(i,j,k))
                0117          lit(i,j)=max(0. _d 0,lit(i,j))
f7bc6bf9ae Step*0118 #else
7d9a1b3f07 Mart*0119          tmppo4=PTR_PO4(i,j,k)
f7bc6bf9ae Step*0120 #endif
                0121
daab022f42 Step*0122 #ifdef ALLOW_FE
f7bc6bf9ae Step*0123 #ifdef DIC_NO_NEG
7d9a1b3f07 Mart*0124          tmpfe=max(0. _d 0,PTR_FE(i,j,k))
f7bc6bf9ae Step*0125 #else
7d9a1b3f07 Mart*0126          tmpfe=PTR_FE(i,j,k)
f7bc6bf9ae Step*0127 #endif
2e3e8c330d Jona*0128 #ifdef DIC_AD_SAFE
7d9a1b3f07 Mart*0129          thx = tmppo4/(tmppo4+KPO4)
                0130          thy = tmpfe/(tmpfe+KFE)
                0131 c        thx = PTR_PO4(i,j,k)/(PTR_PO4(i,j,k)+KPO4)
                0132 c        thy = PTR_FE(i,j,k)/(PTR_FE(i,j,k)+KFE)
                0133          thaux = tanh( (thx-thy)*1. _d 6 )
                0134          nutlimit= ( 1. _d 0 - thaux ) * thx * 0.5 _d 0
                0135      &        +    ( 1. _d 0 + thaux ) * thy * 0.5 _d 0
08536d17ba Step*0136 #else
7d9a1b3f07 Mart*0137          nutlimit=min( tmppo4/(tmppo4+KPO4),tmpfe/(tmpfe+KFE) )
daab022f42 Step*0138 #endif
720e9330bd Step*0139 #else
7d9a1b3f07 Mart*0140          nutlimit=     tmppo4/(tmppo4+KPO4)
720e9330bd Step*0141 #endif
                0142
7d9a1b3f07 Mart*0143          bioac(i,j,k)=alpha(i,j,bi,bj)*
                0144      &        lit(i,j)/(lit(i,j)+lit0)*maskC(i,j,k,bi,bj)*
                0145      &        nutlimit
daab022f42 Step*0146         ENDDO
7d9a1b3f07 Mart*0147        ENDDO
                0148       ENDDO
daab022f42 Step*0149 c
7d9a1b3f07 Mart*0150 #endif /* definded ALLOW_PTRACERS && defined DIC_BIOTIC */
                0151       RETURN
                0152       END