/[MITgcm]/MITgcm_contrib/darwin2/pkg/monod/monod_forcing.F
ViewVC logotype

Diff of /MITgcm_contrib/darwin2/pkg/monod/monod_forcing.F

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

revision 1.7 by stephd, Fri Jun 29 20:41:59 2012 UTC revision 1.12 by jahn, Fri Aug 24 19:45:36 2012 UTC
# Line 21  C======================================= Line 21  C=======================================
21  #include "PARAMS.h"  #include "PARAMS.h"
22  #include "GRID.h"  #include "GRID.h"
23  #include "DYNVARS.h"  #include "DYNVARS.h"
24  #ifdef USE_QSW  c for Qsw and/or surfaceForcingT
25    c choice which field to take pCO2 from for pCO2limit
26    c this assumes we use Ttendency from offline
27  #include "FFIELDS.h"  #include "FFIELDS.h"
 #endif  
28  #ifdef ALLOW_LONGSTEP  #ifdef ALLOW_LONGSTEP
29  #include "LONGSTEP.h"  #include "LONGSTEP.h"
30  #endif  #endif
# Line 43  c ANNA include wavebands_params.h Line 44  c ANNA include wavebands_params.h
44  #include "WAVEBANDS_PARAMS.h"  #include "WAVEBANDS_PARAMS.h"
45  #endif  #endif
46    
 c choice which field to take pCO2 from for pCO2limit  
 c this assumes we use Ttendency from offline  
 #include "FFIELDS.h"  
   
47    
48  C     === Global variables ===  C     === Global variables ===
49  c tracers  c tracers
# Line 98  c ANNA define variables for wavebands Line 95  c ANNA define variables for wavebands
95  #ifdef DAR_RADTRANS  #ifdef DAR_RADTRANS
96         integer iday,iyr,imon,isec,lp,wd,mydate(4)         integer iday,iyr,imon,isec,lp,wd,mydate(4)
97         _RL Edwsf(tlam),Eswsf(tlam)         _RL Edwsf(tlam),Eswsf(tlam)
98         _RL Edz(tlam,Nr),Esz(tlam,Nr),Euz(tlam,Nr),Eutop(tlam,Nr)         _RL Edz(tlam,Nr),Esz(tlam,Nr),Euz(tlam,Nr)
99           _RL Estop(tlam,Nr),Eutop(tlam,Nr)
100         _RL tirrq(nr)         _RL tirrq(nr)
101         _RL tirrwq(tlam,nr)         _RL tirrwq(tlam,nr)
102           _RL amp1(tlam,nr), amp2(tlam,nr)
103         _RL solz         _RL solz
104         _RL rmud         _RL rmud
105         _RL actot,bctot,bbctot         _RL actot,bctot,bbctot
106         _RL apart_k(Nr,tlam),bpart_k(Nr,tlam),bbpart_k(Nr,tlam)         _RL apart_k(Nr,tlam),bpart_k(Nr,tlam),bbpart_k(Nr,tlam)
107         _RL bt_k(Nr,tlam), bb_k(Nr,tlam)         _RL bt_k(Nr,tlam), bb_k(Nr,tlam)
108           _RL discEs, discEu
109           INTEGER idiscEs,jdiscEs,kdiscEs,ldiscEs
110           INTEGER idiscEu,jdiscEu,kdiscEu,ldiscEu
111  #else  #else
112         _RL PARwdn(tlam)         _RL PARwdn(tlam)
113  #endif  #endif
# Line 332  COJ Line 334  COJ
334          enddo          enddo
335         ENDDO         ENDDO
336         ENDDO         ENDDO
337    
338    #ifdef DAR_RADTRANS
339           idiscEs = 0
340           jdiscEs = 0
341           kdiscEs = 0
342           ldiscEs = 0
343           idiscEu = 0
344           jdiscEu = 0
345           kdiscEu = 0
346           ldiscEu = 0
347           discEs = 0.
348           discEu = 0.
349    #endif
350  c  c
351  c bio-chemical time loop  c bio-chemical time loop
352  c--------------------------------------------------  c--------------------------------------------------
# Line 627  c           add water and CDOM Line 642  c           add water and CDOM
642              bt_k(k,ilam) = bw(ilam) + bctot + bpart_k(k,ilam)              bt_k(k,ilam) = bw(ilam) + bctot + bpart_k(k,ilam)
643              bb_k(k,ilam) = darwin_bbw*bw(ilam)+bbctot+bbpart_k(k,ilam)              bb_k(k,ilam) = darwin_bbw*bw(ilam)+bbctot+bbpart_k(k,ilam)
644              bb_k(k,ilam) = MAX(darwin_bbmin, bb_k(k,ilam))              bb_k(k,ilam) = MAX(darwin_bbmin, bb_k(k,ilam))
645    c           initialize output variables
646                Edz(ilam,k) = 0.0
647                Esz(ilam,k) = 0.0
648                Euz(ilam,k) = 0.0
649                Estop(ilam,k) = 0.0
650                Eutop(ilam,k) = 0.0
651                amp1(ilam,k) = 0.0
652                amp2(ilam,k) = 0.0
653            ENDDO            ENDDO
654           ENDDO           ENDDO
655    
656  #ifdef DAR_RADTRANS_ITERATIVE           IF (darwin_radtrans_niter.GE.0) THEN
657           call MONOD_RADTRANS_ITER(             call MONOD_RADTRANS_ITER(
658       I                dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,       I                dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
659       I                darwin_radtrans_kmax,darwin_radtrans_niter,       I                darwin_radtrans_kmax,darwin_radtrans_niter,
660       O                Edz,Esz,Euz,Eutop,       O                Edz,Esz,Euz,Eutop,
661       O                tirrq,tirrwq,       O                tirrq,tirrwq,
662         O                amp1,amp2,
663       I                myThid)       I                myThid)
664  #else           ELSEIF (darwin_radtrans_niter.EQ.-1) THEN
665  c dzlocal ?????  c dzlocal ?????
666           call MONOD_RADTRANS(             call MONOD_RADTRANS(
667       I                drF,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,       I                drF,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
668       O                Edz,Esz,Euz,Eutop,       O                Edz,Esz,Euz,Eutop,
669       O                tirrq,tirrwq,       O                tirrq,tirrwq,
670       I                myThid)       I                myThid)
671             ELSE
672               call MONOD_RADTRANS_DIRECT(
673         I                dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
674         I                darwin_radtrans_kmax,
675         O                Edz,Esz,Euz,Estop,Eutop,
676         O                tirrq,tirrwq,
677         O                amp1,amp2,
678         I                myThid)
679    #ifdef DAR_CHECK_IRR_CONT
680               IF( dz_k(1) .GT. 0.0 )THEN
681               DO ilam = 1,tlam
682               IF(Eswsf(ilam).GE.darwin_radmodThresh .OR.
683         &        Edwsf(ilam).GE.darwin_radmodThresh ) THEN
684                IF(ABS(Estop(ilam,1)-Eswsf(ilam)) .GT. discEs )THEN
685                  discEs = ABS(Estop(ilam,1)-Eswsf(ilam))
686                  idiscEs = i
687                  jdiscEs = j
688                  kdiscEs = 1
689                  ldiscEs = ilam
690                ENDIF
691                DO k=1,darwin_radtrans_kmax-1
692                 IF(ABS(Estop(ilam,k+1)-Esz(ilam,k)) .GT. discEs)THEN
693                  discEs = ABS(Estop(ilam,k+1)-Esz(ilam,k))
694                  idiscEs = i
695                  jdiscEs = j
696                  kdiscEs = k+1
697                  ldiscEs = ilam
698                 ENDIF
699                 IF(ABS(Eutop(ilam,k+1)-Euz(ilam,k)) .GT. discEu)THEN
700                  discEu = ABS(Eutop(ilam,k+1)-Euz(ilam,k))
701                  idiscEu = i
702                  jdiscEu = j
703                  kdiscEu = k+1
704                  ldiscEu = ilam
705                 ENDIF
706                ENDDO
707               ENDIF
708               ENDDO
709               ENDIF
710  #endif  #endif
711             ENDIF
712  c  c
713  c uses chl from prev timestep (as wavebands does)  c uses chl from prev timestep (as wavebands does)
714  c keep like this in case need to consider upwelling irradiance as affecting the grid box above  c keep like this in case need to consider upwelling irradiance as affecting the grid box above
# Line 1338  Coj            no Eu at surface (yet) Line 1402  Coj            no Eu at surface (yet)
1402                 Euave(i,j,k,bi,bj,ilam)=Euave(i,j,k,bi,bj,ilam)+                 Euave(i,j,k,bi,bj,ilam)=Euave(i,j,k,bi,bj,ilam)+
1403       &                                 Euz(ilam,k-1)*dtplankton       &                                 Euz(ilam,k-1)*dtplankton
1404                endif                endif
1405                  Estave(i,j,k,bi,bj,ilam)=Estave(i,j,k,bi,bj,ilam)+
1406         &                                 Estop(ilam,k)*dtplankton
1407                Eutave(i,j,k,bi,bj,ilam)=Eutave(i,j,k,bi,bj,ilam)+                Eutave(i,j,k,bi,bj,ilam)=Eutave(i,j,k,bi,bj,ilam)+
1408       &                                 Eutop(ilam,k)*dtplankton       &                                 Eutop(ilam,k)*dtplankton
1409               enddo               enddo
1410  #endif  #endif
1411    #ifdef DAR_DIAG_IRR_AMPS
1412                 do ilam = 1,tlam
1413                   amp1ave(i,j,k,bi,bj,ilam)=amp1ave(i,j,k,bi,bj,ilam)+
1414         &                                 amp1(ilam,k)*dtplankton
1415                   amp2ave(i,j,k,bi,bj,ilam)=amp2ave(i,j,k,bi,bj,ilam)+
1416         &                                 amp2(ilam,k)*dtplankton
1417                 enddo
1418    #endif
1419  #ifdef DAR_DIAG_ABSORP  #ifdef DAR_DIAG_ABSORP
1420               do ilam = 1,tlam               do ilam = 1,tlam
1421                 aave(i,j,k,bi,bj,ilam)=aave(i,j,k,bi,bj,ilam)+                 aave(i,j,k,bi,bj,ilam)=aave(i,j,k,bi,bj,ilam)+
# Line 1366  Coj            no Eu at surface (yet) Line 1440  Coj            no Eu at surface (yet)
1440       &                                 bbpart_k(k,ilam)*dtplankton       &                                 bbpart_k(k,ilam)*dtplankton
1441               enddo               enddo
1442  #endif  #endif
1443    #ifdef DAR_RADTRANS
1444                 if (k.eq.1) then
1445                   rmudave(i,j,bi,bj)=rmudave(i,j,bi,bj)+
1446         &                                 rmud*dtplankton
1447                 endif
1448    #endif
1449  #ifdef DAR_DIAG_RSTAR  #ifdef DAR_DIAG_RSTAR
1450               do np=1,npmax               do np=1,npmax
1451                 Rstarave(i,j,k,bi,bj,np)=Rstarave(i,j,k,bi,bj,np)+                 Rstarave(i,j,k,bi,bj,np)=Rstarave(i,j,k,bi,bj,np)+
# Line 1471  C       reset the other slot for averagi Line 1551  C       reset the other slot for averagi
1551  C itistime  C itistime
1552  #endif  #endif
1553    
1554    #ifdef DAR_CHECK_IRR_CONT
1555           i = myXGlobalLo-1+(bi-1)*sNx+idiscEs
1556           j = myYGlobalLo-1+(bj-1)*sNy+jdiscEs
1557           write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Es disc',
1558         &                                   i,j,kdiscEs,ldiscEs,discEs
1559           i = myXGlobalLo-1+(bi-1)*sNx+idiscEu
1560           j = myYGlobalLo-1+(bj-1)*sNy+jdiscEu
1561           write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Eu disc',
1562         &                                   i,j,kdiscEu,ldiscEu,discEu
1563    #endif
1564    
1565  COJ fill diagnostics  COJ fill diagnostics
1566  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
1567         IF ( useDiagnostics ) THEN         IF ( useDiagnostics ) THEN
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22