/[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.9 by jahn, Mon Jul 30 15:21:51 2012 UTC revision 1.16 by jahn, Fri Dec 27 17:29:00 2013 UTC
# Line 92  c ANNA define variables for wavebands Line 92  c ANNA define variables for wavebands
92         _RL PARw_k(tlam,Nr)         _RL PARw_k(tlam,Nr)
93         _RL PARwup(tlam)         _RL PARwup(tlam)
94         _RL acdom_k(Nr,tlam)         _RL acdom_k(Nr,tlam)
95           _RL Ek_nll(npmax,tlam)
96           _RL EkoverE_nll(npmax,tlam)
97  #ifdef DAR_RADTRANS  #ifdef DAR_RADTRANS
98         integer iday,iyr,imon,isec,lp,wd,mydate(4)         integer iday,iyr,imon,isec,lp,wd,mydate(4)
99         _RL Edwsf(tlam),Eswsf(tlam)         _RL Edwsf(tlam),Eswsf(tlam)
100         _RL Edz(tlam,Nr),Esz(tlam,Nr),Euz(tlam,Nr),Eutop(tlam,Nr)         _RL Edz(tlam,Nr),Esz(tlam,Nr),Euz(tlam,Nr)
101           _RL Estop(tlam,Nr),Eutop(tlam,Nr)
102         _RL tirrq(nr)         _RL tirrq(nr)
103         _RL tirrwq(tlam,nr)         _RL tirrwq(tlam,nr)
104         _RL c1(tlam,nr), c2(tlam,nr)         _RL amp1(tlam,nr), amp2(tlam,nr)
105         _RL solz         _RL solz
106         _RL rmud         _RL rmud
107         _RL actot,bctot,bbctot         _RL actot,bctot,bbctot
108         _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)
109         _RL bt_k(Nr,tlam), bb_k(Nr,tlam)         _RL bt_k(Nr,tlam), bb_k(Nr,tlam)
110           _RL discEs, discEu
111           INTEGER idiscEs,jdiscEs,kdiscEs,ldiscEs
112           INTEGER idiscEu,jdiscEu,kdiscEu,ldiscEu
113  #else  #else
114         _RL PARwdn(tlam)         _RL PARwdn(tlam)
115  #endif  #endif
# Line 127  C      always need for diagnostics Line 133  C      always need for diagnostics
133  #ifdef GEIDER  #ifdef GEIDER
134        _RL phychl(npmax)        _RL phychl(npmax)
135        _RL phychl_k(npmax,Nr)        _RL phychl_k(npmax,Nr)
136          _RL Ekl(npmax)
137          _RL EkoverEl(npmax)
138          _RL chl2cl(npmax)
139  #ifdef DYNAMIC_CHL  #ifdef DYNAMIC_CHL
140        _RL dphychl(npmax)        _RL dphychl(npmax)
141        _RL chlup(npmax)        _RL chlup(npmax)
142          _RL accliml(npmax)
143  #endif  #endif
144  #endif  #endif
145  #ifdef ALLOW_CDOM  #ifdef ALLOW_CDOM
# Line 330  COJ Line 340  COJ
340          enddo          enddo
341         ENDDO         ENDDO
342         ENDDO         ENDDO
343    
344    #ifdef DAR_RADTRANS
345           idiscEs = 0
346           jdiscEs = 0
347           kdiscEs = 0
348           ldiscEs = 0
349           idiscEu = 0
350           jdiscEu = 0
351           kdiscEu = 0
352           ldiscEu = 0
353           discEs = 0.
354           discEu = 0.
355    #endif
356  c  c
357  c bio-chemical time loop  c bio-chemical time loop
358  c--------------------------------------------------  c--------------------------------------------------
# Line 482  c ------------ GET INCIDENT NON-SPECTRAL Line 505  c ------------ GET INCIDENT NON-SPECTRAL
505    
506  #else /* not USE_QSW */  #else /* not USE_QSW */
507    
508           lite = sfac(j)*maskC(i,j,1,bi,bj)/86400*1 _d 6  C        convert W/m2 to uEin/s/m2
509             lite = sfac(j)*parconv*maskC(i,j,1,bi,bj)
510    
511  #endif /* not USE_QSW */  #endif /* not USE_QSW */
512  #endif /* not READ_PAR */  #endif /* not READ_PAR */
# Line 625  c           add water and CDOM Line 649  c           add water and CDOM
649              bt_k(k,ilam) = bw(ilam) + bctot + bpart_k(k,ilam)              bt_k(k,ilam) = bw(ilam) + bctot + bpart_k(k,ilam)
650              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)
651              bb_k(k,ilam) = MAX(darwin_bbmin, bb_k(k,ilam))              bb_k(k,ilam) = MAX(darwin_bbmin, bb_k(k,ilam))
652    c           initialize output variables
653                Edz(ilam,k) = 0.0
654                Esz(ilam,k) = 0.0
655                Euz(ilam,k) = 0.0
656                Estop(ilam,k) = 0.0
657                Eutop(ilam,k) = 0.0
658                amp1(ilam,k) = 0.0
659                amp2(ilam,k) = 0.0
660            ENDDO            ENDDO
661           ENDDO           ENDDO
662    
663  #ifdef DAR_RADTRANS_ITERATIVE           IF (darwin_radtrans_niter.GE.0) THEN
664           call MONOD_RADTRANS_ITER(             call MONOD_RADTRANS_ITER(
665       I                dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,       I                dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
666       I                darwin_radtrans_kmax,darwin_radtrans_niter,       I                darwin_radtrans_kmax,darwin_radtrans_niter,
667       O                Edz,Esz,Euz,Eutop,       O                Edz,Esz,Euz,Eutop,
668       O                tirrq,tirrwq,       O                tirrq,tirrwq,
669       O                c1,c2,       O                amp1,amp2,
670       I                myThid)       I                myThid)
671  #else           ELSEIF (darwin_radtrans_niter.EQ.-1) THEN
672  c dzlocal ?????  c dzlocal ?????
673           call MONOD_RADTRANS(             call MONOD_RADTRANS(
674       I                drF,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,       I                drF,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
675       O                Edz,Esz,Euz,Eutop,       O                Edz,Esz,Euz,Eutop,
676       O                tirrq,tirrwq,       O                tirrq,tirrwq,
677       I                myThid)       I                myThid)
678             ELSE
679               call MONOD_RADTRANS_DIRECT(
680         I                dz_k,rmud,Edwsf,Eswsf,a_k,bt_k,bb_k,
681         I                darwin_radtrans_kmax,
682         O                Edz,Esz,Euz,Estop,Eutop,
683         O                tirrq,tirrwq,
684         O                amp1,amp2,
685         I                myThid)
686    #ifdef DAR_CHECK_IRR_CONT
687               IF( dz_k(1) .GT. 0.0 )THEN
688               DO ilam = 1,tlam
689               IF(Eswsf(ilam).GE.darwin_radmodThresh .OR.
690         &        Edwsf(ilam).GE.darwin_radmodThresh ) THEN
691                IF(ABS(Estop(ilam,1)-Eswsf(ilam)) .GT. discEs )THEN
692                  discEs = ABS(Estop(ilam,1)-Eswsf(ilam))
693                  idiscEs = i
694                  jdiscEs = j
695                  kdiscEs = 1
696                  ldiscEs = ilam
697                ENDIF
698                DO k=1,darwin_radtrans_kmax-1
699                 IF(ABS(Estop(ilam,k+1)-Esz(ilam,k)) .GT. discEs)THEN
700                  discEs = ABS(Estop(ilam,k+1)-Esz(ilam,k))
701                  idiscEs = i
702                  jdiscEs = j
703                  kdiscEs = k+1
704                  ldiscEs = ilam
705                 ENDIF
706                 IF(ABS(Eutop(ilam,k+1)-Euz(ilam,k)) .GT. discEu)THEN
707                  discEu = ABS(Eutop(ilam,k+1)-Euz(ilam,k))
708                  idiscEu = i
709                  jdiscEu = j
710                  kdiscEu = k+1
711                  ldiscEu = ilam
712                 ENDIF
713                ENDDO
714               ENDIF
715               ENDDO
716               ENDIF
717  #endif  #endif
718             ENDIF
719  c  c
720  c uses chl from prev timestep (as wavebands does)  c uses chl from prev timestep (as wavebands does)
721  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 820  c taking from igsm dic run - fed through Line 892  c taking from igsm dic run - fed through
892  c               pCO2local=surfaceForcingT(i,j,bi,bj)  c               pCO2local=surfaceForcingT(i,j,bi,bj)
893  c or from darwin carbon module  c or from darwin carbon module
894  #ifdef ALLOW_CARBON  #ifdef ALLOW_CARBON
895    #ifdef pH_3D
896                   pCO2local=pCO2(i,j,k,bi,bj)
897    #else
898                 pCO2local=pCO2(i,j,bi,bj)                 pCO2local=pCO2(i,j,bi,bj)
899    #endif
900  #else  #else
901                 pCO2local=280. _d -6                 pCO2local=280. _d -6
902  #endif  #endif
# Line 899  c set other arguments to zero Line 975  c set other arguments to zero
975                  NfixPl(np)=0. _d 0                  NfixPl(np)=0. _d 0
976  #endif  #endif
977  #endif  #endif
978    #ifdef DAR_DIAG_PARW
979                    chl2cl(np)=0. _d 0
980    #endif
981    #ifdef DAR_DIAG_EK
982                    Ekl(np)=0. _d 0
983                    EkoverEl(np)=0. _d 0
984                    do ilam=1,tlam
985                      Ek_nll(np,ilam)=0. _d 0
986                      EkoverE_nll(np,ilam)=0. _d 0
987                    enddo
988    #endif
989               enddo               enddo
990    
991    
# Line 968  c ANNA pass extra variables if WAVEBANDS Line 1055  c ANNA pass extra variables if WAVEBANDS
1055  #endif  #endif
1056  #ifdef GEIDER  #ifdef GEIDER
1057       O                       phychl,       O                       phychl,
1058    #ifdef DAR_DIAG_EK
1059         I                       Ekl, EkoverEl,
1060    #endif
1061    #ifdef DAR_DIAG_PARW
1062         I                       chl2cl,
1063    #endif
1064  #ifdef DYNAMIC_CHL  #ifdef DYNAMIC_CHL
1065       I                       dphychl,       I                       dphychl,
1066       I                       chlup,       I                       chlup,
1067    #ifdef DAR_DIAG_EK
1068         O                       accliml,
1069    #endif
1070  #endif  #endif
1071  #ifdef ALLOW_CDOM  #ifdef ALLOW_CDOM
1072       O                       dcdoml,       O                       dcdoml,
# Line 978  c ANNA pass extra variables if WAVEBANDS Line 1074  c ANNA pass extra variables if WAVEBANDS
1074  #endif  #endif
1075  #ifdef WAVEBANDS  #ifdef WAVEBANDS
1076       I                       PARw_k(1,k),       I                       PARw_k(1,k),
1077    #ifdef DAR_DIAG_EK
1078         I                       Ek_nll, EkoverE_nll,
1079    #endif
1080  #endif  #endif
1081  #endif  #endif
1082  #ifdef ALLOW_PAR_DAY  #ifdef ALLOW_PAR_DAY
# Line 1316  c    &                       deltaTclock Line 1415  c    &                       deltaTclock
1415       &                           phychl(np)*dtplankton       &                           phychl(np)*dtplankton
1416               enddo               enddo
1417  #endif  #endif
1418    #ifdef DAR_DIAG_PARW
1419                do ilam=1,tlam
1420                   PARwave(i,j,k,bi,bj,ilam)=PARwave(i,j,k,bi,bj,ilam)+
1421         &                           PARw_k(ilam,k)*dtplankton
1422                enddo
1423                do np=1,npmax
1424                  chl2cave(i,j,k,bi,bj,np)=chl2cave(i,j,k,bi,bj,np)+
1425         &                          chl2cl(np)*dtplankton
1426                enddo
1427    #endif
1428  #ifdef DAR_DIAG_ACDOM  #ifdef DAR_DIAG_ACDOM
1429  c            print*,'acdom',k,acdom_k(k,darwin_diag_acdom_ilam)  c            print*,'acdom',k,acdom_k(k,darwin_diag_acdom_ilam)
1430               aCDOMave(i,j,k,bi,bj)=aCDOMave(i,j,k,bi,bj)+               aCDOMave(i,j,k,bi,bj)=aCDOMave(i,j,k,bi,bj)+
# Line 1337  Coj            no Eu at surface (yet) Line 1446  Coj            no Eu at surface (yet)
1446                 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)+
1447       &                                 Euz(ilam,k-1)*dtplankton       &                                 Euz(ilam,k-1)*dtplankton
1448                endif                endif
1449                  Estave(i,j,k,bi,bj,ilam)=Estave(i,j,k,bi,bj,ilam)+
1450         &                                 Estop(ilam,k)*dtplankton
1451                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)+
1452       &                                 Eutop(ilam,k)*dtplankton       &                                 Eutop(ilam,k)*dtplankton
1453               enddo               enddo
1454  #endif  #endif
1455  #ifdef DAR_DIAG_IRR_AMPS  #ifdef DAR_DIAG_IRR_AMPS
1456               do ilam = 1,tlam               do ilam = 1,tlam
1457                 c1ave(i,j,k,bi,bj,ilam)=c1ave(i,j,k,bi,bj,ilam)+                 amp1ave(i,j,k,bi,bj,ilam)=amp1ave(i,j,k,bi,bj,ilam)+
1458       &                                 c1(ilam,k)*dtplankton       &                                 amp1(ilam,k)*dtplankton
1459                 c2ave(i,j,k,bi,bj,ilam)=c2ave(i,j,k,bi,bj,ilam)+                 amp2ave(i,j,k,bi,bj,ilam)=amp2ave(i,j,k,bi,bj,ilam)+
1460       &                                 c2(ilam,k)*dtplankton       &                                 amp2(ilam,k)*dtplankton
1461               enddo               enddo
1462  #endif  #endif
1463  #ifdef DAR_DIAG_ABSORP  #ifdef DAR_DIAG_ABSORP
# Line 1379  Coj            no Eu at surface (yet) Line 1490  Coj            no Eu at surface (yet)
1490       &                                 rmud*dtplankton       &                                 rmud*dtplankton
1491               endif               endif
1492  #endif  #endif
1493    #ifdef DAR_DIAG_EK
1494                do np=1,npmax
1495                 Ekave(i,j,k,bi,bj,np)=Ekave(i,j,k,bi,bj,np)+
1496         &                        Ekl(np)*dtplankton
1497                 EkoverEave(i,j,k,bi,bj,np)=EkoverEave(i,j,k,bi,bj,np)+
1498         &                        EkoverEl(np)*dtplankton
1499                 acclimave(i,j,k,bi,bj,np)=acclimave(i,j,k,bi,bj,np)+
1500         &                        accliml(np)*dtplankton
1501                 do ilam=1,tlam
1502                    Ek_nlave(i,j,k,bi,bj,np,ilam)=
1503         &                        Ek_nlave(i,j,k,bi,bj,np,ilam)+
1504         &                        Ek_nll(np,ilam)*dtplankton
1505                    EkoverE_nlave(i,j,k,bi,bj,np,ilam)=
1506         &                        EkoverE_nlave(i,j,k,bi,bj,np,ilam)+
1507         &                        EkoverE_nll(np,ilam)*dtplankton
1508                 enddo
1509                enddo
1510    #endif
1511  #ifdef DAR_DIAG_RSTAR  #ifdef DAR_DIAG_RSTAR
1512               do np=1,npmax               do np=1,npmax
1513                 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 1424  Coj            no Eu at surface (yet) Line 1553  Coj            no Eu at surface (yet)
1553       &                              FluxCO2(i,j,bi,bj)*dtplankton       &                              FluxCO2(i,j,bi,bj)*dtplankton
1554                SUROave(i,j,bi,bj)   =SUROave(i,j,bi,bj)+                SUROave(i,j,bi,bj)   =SUROave(i,j,bi,bj)+
1555       &                              flxO2(i,j)*dtplankton       &                              flxO2(i,j)*dtplankton
1556                 endif
1557    #ifdef pH_3D
1558                  pCO2ave(i,j,k,bi,bj)   =pCO2ave(i,j,k,bi,bj)+
1559         &                              pCO2(i,j,k,bi,bj)*dtplankton
1560                  pHave(i,j,k,bi,bj)     =pHave(i,j,k,bi,bj)+
1561         &                              pH(i,j,k,bi,bj)*dtplankton
1562    #else
1563                 if (k.eq.1) then
1564                pCO2ave(i,j,bi,bj)   =pCO2ave(i,j,bi,bj)+                pCO2ave(i,j,bi,bj)   =pCO2ave(i,j,bi,bj)+
1565       &                              pCO2(i,j,bi,bj)*dtplankton       &                              pCO2(i,j,bi,bj)*dtplankton
1566                pHave(i,j,bi,bj)     =pHave(i,j,bi,bj)+                pHave(i,j,bi,bj)     =pHave(i,j,bi,bj)+
1567       &                              pH(i,j,bi,bj)*dtplankton       &                              pH(i,j,bi,bj)*dtplankton
1568               endif               endif
1569  #endif  #endif
1570    #endif
1571            endif              endif  
1572  c end if hFac>0  c end if hFac>0
1573    
# Line 1484  C       reset the other slot for averagi Line 1622  C       reset the other slot for averagi
1622  C itistime  C itistime
1623  #endif  #endif
1624    
1625    #ifdef DAR_CHECK_IRR_CONT
1626           i = myXGlobalLo-1+(bi-1)*sNx+idiscEs
1627           j = myYGlobalLo-1+(bj-1)*sNy+jdiscEs
1628           write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Es disc',
1629         &                                   i,j,kdiscEs,ldiscEs,discEs
1630           i = myXGlobalLo-1+(bi-1)*sNx+idiscEu
1631           j = myYGlobalLo-1+(bj-1)*sNy+jdiscEu
1632           write(6,'(I4.4,X,A,4(X,I4),1PE24.16)')myProcId,'max Eu disc',
1633         &                                   i,j,kdiscEu,ldiscEu,discEu
1634    #endif
1635    
1636  COJ fill diagnostics  COJ fill diagnostics
1637  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
1638         IF ( useDiagnostics ) THEN         IF ( useDiagnostics ) THEN
# Line 1563  c ANNA end TAVE Line 1712  c ANNA end TAVE
1712       &                         0,1,2,bi,bj,myThid )       &                         0,1,2,bi,bj,myThid )
1713          CALL DIAGNOSTICS_FILL( flxO2(1-Olx,1-Oly), 'DICOFLX ',          CALL DIAGNOSTICS_FILL( flxO2(1-Olx,1-Oly), 'DICOFLX ',
1714       &                         0,1,2,bi,bj,myThid )       &                         0,1,2,bi,bj,myThid )
1715    #ifdef pH_3D
1716            CALL DIAGNOSTICS_FILL( pCO2(1-Olx,1-Oly,1,bi,bj), 'DICPCO2 ',
1717         &                         0,Nr,2,bi,bj,myThid )
1718            CALL DIAGNOSTICS_FILL( pH(1-Olx,1-Oly,1,bi,bj), 'DICPHAV ',
1719         &                         0,Nr,2,bi,bj,myThid )
1720    #else
1721          CALL DIAGNOSTICS_FILL( pCO2(1-Olx,1-Oly,bi,bj), 'DICPCO2 ',          CALL DIAGNOSTICS_FILL( pCO2(1-Olx,1-Oly,bi,bj), 'DICPCO2 ',
1722       &                         0,1,2,bi,bj,myThid )       &                         0,1,2,bi,bj,myThid )
1723          CALL DIAGNOSTICS_FILL( pH(1-Olx,1-Oly,bi,bj), 'DICPHAV ',          CALL DIAGNOSTICS_FILL( pH(1-Olx,1-Oly,bi,bj), 'DICPHAV ',
1724       &                         0,1,2,bi,bj,myThid )       &                         0,1,2,bi,bj,myThid )
1725    #endif
1726  #endif /* ALLOW_CARBON */  #endif /* ALLOW_CARBON */
1727         ENDIF         ENDIF
1728  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
# Line 1579  c determine iron partitioning  - solve f Line 1735  c determine iron partitioning  - solve f
1735  c  c
1736  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
1737  c save averages  c save averages
1738         do k=1,nR           dar_timeave(bi,bj) = dar_timeave(bi,bj) + dtplankton
          dar_timeave(bi,bj,k)=dar_timeave(bi,bj,k)  
      &                         +dtplankton  
1739  #ifdef ALLOW_CARBON  #ifdef ALLOW_CARBON
1740           dic_timeave(bi,bj,k)=dic_timeave(bi,bj,k)           dic_timeave(bi,bj) = dic_timeave(bi,bj) + dtplankton
      &                         +dtplankton  
1741  #endif  #endif
        enddo  
1742  #endif  #endif
1743  c  c
1744  c -----------------------------------------------------  c -----------------------------------------------------
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22