/[MITgcm]/MITgcm/pkg/dic/bio_export.F
ViewVC logotype

Diff of /MITgcm/pkg/dic/bio_export.F

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

revision 1.26 by jmc, Sun Apr 11 22:03:53 2010 UTC revision 1.27 by mlosch, Fri Jul 30 15:02:43 2010 UTC
# Line 51  C  bioac               :: biological pro Line 51  C  bioac               :: biological pro
51  C                         between export and dissolved pool)  C                         between export and dissolved pool)
52        _RL bioac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR)        _RL bioac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nR)
53    
54  #ifdef ALLOW_PTRACERS  #if (defined ALLOW_PTRACERS && defined DIC_BIOTIC)
 #ifdef DIC_BIOTIC  
55    
56  C !LOCAL VARIABLES: ====================================================  C !LOCAL VARIABLES: ====================================================
57  C  i,j,k                  :: loop indices  C  i,j,k                  :: loop indices
58         INTEGER I,J,k         INTEGER I,J,k
59        _RL sfac(1-OLy:sNy+OLy)        _RL sfac    (1-OLy:sNy+OLy)
60        _RL lit, atten        _RL lit     (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61          _RL atten
62        _RL nutlimit        _RL nutlimit
63        _RL tmppo4        _RL tmppo4
64  #ifdef ALLOW_FE  #ifdef ALLOW_FE      
65        _RL tmpfe        _RL tmpfe
66  #endif  #endif
67  #ifdef AD_SAFE  #ifdef AD_SAFE
68        _RL thx, thy, theps        _RL thx, thy, theps, thaux
69  #endif  #endif
70  CEOP  CEOP
71    
72    
73  #ifndef READ_PAR  #ifndef READ_PAR
74  #ifndef USE_QSW  #ifndef USE_QSW
75          CALL INSOL(myTime,sfac,bi,bj,myThid)        CALL INSOL(myTime,sfac,bi,bj,myThid)
76  #endif  #endif
77  #endif  #endif
78          DO j=jmin,jmax        DO j=jmin,jmax
79           DO i=imin,imax         DO i=imin,imax
80  cph: following init assumes nlev=nr  cph: following init assumes nlev=nr
81  cph: set in dic_init_fixed.F (ALLOW_AUTODIFF)  cph: set in dic_init_fixed.F (ALLOW_AUTODIFF)
82  C$TAF INIT bio_export = static, nr  C$TAF INIT bio_export = static, nr
83  C FORTRAN-77 dynamic memory uses adstore adresto  C FORTRAN-77 dynamic memory uses adstore adresto
84  CRG C$TAF INIT bio_export = memory  CRG C$TAF INIT bio_export = memory
85  #ifdef READ_PAR  #ifdef READ_PAR
86             lit=PAR(i,j,bi,bj)          lit(i,j)=PAR(i,j,bi,bj)
87  #elif (defined USE_QSW)  #elif (defined USE_QSW)
88             lit=-parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj)          lit(i,j)=-parfrac*Qsw(i,j,bi,bj)*maskC(i,j,1,bi,bj)
89  #else  #else
90             lit=sfac(j)          lit(i,j)=sfac(j)
91  #endif  #endif
92    
93             IF ( .NOT. QSW_underice ) THEN          IF ( .NOT. QSW_underice ) THEN
94  c if using Qsw but not seaice/thsice or coupled, then  c if using Qsw but not seaice/thsice or coupled, then
95  c ice fraction needs to be taken into account  c ice fraction needs to be taken into account
96                lit=lit*(1. _d 0 - FIce(i,j,bi,bj))           lit(i,j)=lit(i,j)*(1. _d 0 - FIce(i,j,bi,bj))
97             ENDIF          ENDIF
98           ENDDO
99          ENDDO
100  c  c
101             DO k=1,nlev        DO k=1,nlev
102  C$TAF STORE lit = bio_export         DO j=jmin,jmax
103               atten=(k0*drF(k)*hFacC(i,j,k,bi,bj)*.5 _d 0)          DO i=imin,imax
104               if (k.gt.1) atten=atten+(k0*drF(k-1)  C$TAF STORE lit(i,j) = bio_export
105             atten=(k0*drF(k)*hFacC(i,j,k,bi,bj)*.5 _d 0)
106             if (k.gt.1) atten=atten+(k0*drF(k-1)
107       &                         *hFacC(i,j,k-1,bi,bj)*.5 _d 0)       &                         *hFacC(i,j,k-1,bi,bj)*.5 _d 0)
108               lit=lit*exp(-atten)           lit(i,j)=lit(i,j)*exp(-atten)
109               IF (lit.LT.0. _d 0.OR.lit.GT.350. _d 0) THEN  #ifndef TARGET_NEC_SX
110                   print*,'QQ lit', lit  C     this statement breaks vectorization and causes a dramatic
111               ENDIF  C     performance drop on vector computers
112             IF (lit(i,j).LT.0. _d 0.OR.lit(i,j).GT.350. _d 0) THEN
113              print*,'QQ lit',i,j,lit(i,j)
114             ENDIF
115    #endif
116    
117  #ifdef DIC_NO_NEG  #ifdef DIC_NO_NEG
118               tmppo4=max(0. _d 0, PTR_PO4(i,j,k))           tmppo4=max(0. _d 0, PTR_PO4(i,j,k))
119               lit=max(0. _d 0,lit)           lit(i,j)=max(0. _d 0,lit(i,j))
120  #else  #else
121               tmppo4=PTR_PO4(i,j,k)           tmppo4=PTR_PO4(i,j,k)
122  #endif  #endif
123    
124  #ifdef ALLOW_FE  #ifdef ALLOW_FE
125  #ifdef DIC_NO_NEG  #ifdef DIC_NO_NEG
126               tmpfe=max(0. _d 0,PTR_FE(i,j,k))           tmpfe=max(0. _d 0,PTR_FE(i,j,k))
127  #else  #else
128               tmpfe=PTR_FE(i,j,k)           tmpfe=PTR_FE(i,j,k)
129  #endif  #endif
130  #ifdef AD_SAFE  #ifdef AD_SAFE
131               thx = tmppo4/(tmppo4+KPO4)           thx = tmppo4/(tmppo4+KPO4)
132               thy = tmpfe/(tmpfe+KFE)           thy = tmpfe/(tmpfe+KFE)
133  c            thx = PTR_PO4(i,j,k)/(PTR_PO4(i,j,k)+KPO4)  c        thx = PTR_PO4(i,j,k)/(PTR_PO4(i,j,k)+KPO4)
134  c            thy = PTR_FE(i,j,k)/(PTR_FE(i,j,k)+KFE)  c        thy = PTR_FE(i,j,k)/(PTR_FE(i,j,k)+KFE)
135               theps = 1. _d -6  c        theps = 1. _d -6
136               nutlimit= ( 1. _d 0 - tanh((thx-thy)/theps) ) * thx/2. _d 0  c        thaux = tanh( (thx-thy)/theps )
137       &                +( 1. _d 0 + tanh((thx-thy)/theps) ) * thy/2. _d 0           thaux = tanh( (thx-thy)*1. _d 6 )
138             nutlimit= ( 1. _d 0 - thaux ) * thx * 0.5 _d 0
139         &        +    ( 1. _d 0 + thaux ) * thy * 0.5 _d 0
140  #else  #else
141               nutlimit=   min(tmppo4/(tmppo4+KPO4),           nutlimit=min( tmppo4/(tmppo4+KPO4),tmpfe/(tmpfe+KFE) )
      &                        tmpfe/(tmpfe+KFE) )  
142  #endif  #endif
143  #else  #else
144               nutlimit=    tmppo4/(tmppo4+KPO4)           nutlimit=     tmppo4/(tmppo4+KPO4)
145  #endif  #endif
146    
147               bioac(i,j,k)=alpha(i,j,bi,bj)*           bioac(i,j,k)=alpha(i,j,bi,bj)*
148       &                    lit/(lit+lit0)*maskC(i,j,k,bi,bj)*       &        lit(i,j)/(lit(i,j)+lit0)*maskC(i,j,k,bi,bj)*
149       &                    nutlimit       &        nutlimit
             ENDDO  
           ENDDO  
150          ENDDO          ENDDO
151           ENDDO
152          ENDDO
153  c  c
154  #endif  #endif /* definded ALLOW_PTRACERS && defined DIC_BIOTIC */
155  #endif        RETURN
156         RETURN        END
        END  
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22