Changeset 9382


Ignore:
Timestamp:
2018-03-07T18:23:18+01:00 (2 years ago)
Author:
dford
Message:

Account for balancing increments, and don't allow any increments to take variables negative.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90

    r9381 r9382  
    896896            ! reset to zero at the start of trc_stp, called after this routine 
    897897#if defined key_medusa && defined key_foam_medusa 
    898             WHERE( phyto2d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    899                &   trn(:,:,:,jp_msa0:jp_msa1) + phyto2d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     898            WHERE( phyto2d_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     899               &   trn(:,:,:,jp_msa0:jp_msa1) + phyto2d_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt > 0.0_wp ) 
    900900               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
    901901                  &                         phyto2d_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt 
     
    904904            END WHERE 
    905905#elif defined key_hadocc 
    906             WHERE( phyto2d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    907                &   trn(:,:,:,jp_had0:jp_had1) + phyto2d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     906            WHERE( phyto2d_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp .OR. & 
     907               &   trn(:,:,:,jp_had0:jp_had1) + phyto2d_balinc(:,:,:,jp_had0:jp_had1) * zincwgt > 0.0_wp ) 
    908908               trn(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) + & 
    909909                  &                         phyto2d_balinc(:,:,:,jp_had0:jp_had1) * zincwgt 
     
    932932               &           ' Background state is taken from model rather than background file' ) 
    933933#if defined key_medusa && defined key_foam_medusa 
    934             WHERE( phyto2d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    935                &   trn(:,:,:,jp_msa0:jp_msa1) + phyto2d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     934            WHERE( phyto2d_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     935               &   trn(:,:,:,jp_msa0:jp_msa1) + phyto2d_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp ) 
    936936               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
    937937                  &                         phyto2d_balinc(:,:,:,jp_msa0:jp_msa1) 
     
    939939            END WHERE 
    940940#elif defined key_hadocc 
    941             WHERE( phyto2d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    942                &   trn(:,:,:,jp_had0:jp_had1) + phyto2d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     941            WHERE( phyto2d_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp .OR. & 
     942               &   trn(:,:,:,jp_had0:jp_had1) + phyto2d_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp ) 
    943943               trn(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) + & 
    944944                  &                         phyto2d_balinc(:,:,:,jp_had0:jp_had1) 
     
    10831083            ! reset to zero at the start of trc_stp, called after this routine 
    10841084#if defined key_medusa && defined key_foam_medusa 
    1085             WHERE( phyto3d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    1086                &   trn(:,:,:,jp_msa0:jp_msa1) + phyto3d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     1085            WHERE( phyto3d_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     1086               &   trn(:,:,:,jp_msa0:jp_msa1) + phyto3d_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt > 0.0_wp ) 
    10871087               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
    10881088                  &                         phyto3d_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt 
     
    10911091            END WHERE 
    10921092#elif defined key_hadocc 
    1093             WHERE( phyto3d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    1094                &   trn(:,:,:,jp_had0:jp_had1) + phyto3d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     1093            WHERE( phyto3d_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp .OR. & 
     1094               &   trn(:,:,:,jp_had0:jp_had1) + phyto3d_balinc(:,:,:,jp_had0:jp_had1) * zincwgt > 0.0_wp ) 
    10951095               trn(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) + & 
    10961096                  &                         phyto3d_balinc(:,:,:,jp_had0:jp_had1) * zincwgt 
     
    11191119               &           ' Background state is taken from model rather than background file' ) 
    11201120#if defined key_medusa && defined key_foam_medusa 
    1121             WHERE( phyto3d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    1122                &   trn(:,:,:,jp_msa0:jp_msa1) + phyto3d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     1121            WHERE( phyto3d_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     1122               &   trn(:,:,:,jp_msa0:jp_msa1) + phyto3d_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp ) 
    11231123               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
    11241124                  &                         phyto3d_balinc(:,:,:,jp_msa0:jp_msa1) 
     
    11261126            END WHERE 
    11271127#elif defined key_hadocc 
    1128             WHERE( phyto3d_balinc(:,:,:,:) > 0.0_wp .OR. & 
    1129                &   trn(:,:,:,jp_had0:jp_had1) + phyto3d_balinc(:,:,:,:) * zincwgt > 0.0_wp ) 
     1128            WHERE( phyto3d_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp .OR. & 
     1129               &   trn(:,:,:,jp_had0:jp_had1) + phyto3d_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp ) 
    11301130               trn(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) + & 
    11311131                  &                         phyto3d_balinc(:,:,:,jp_had0:jp_had1) 
     
    13531353            ! reset to zero at the start of trc_stp, called after this routine 
    13541354#if defined key_medusa && defined key_foam_medusa 
    1355             DO jk = 1, jpkm1 
    1356                trn(:,:,jk,jp_msa0:jp_msa1) = trn(:,:,jk,jp_msa0:jp_msa1) + & 
    1357                   &                          pco2_balinc(:,:,jk,jp_msa0:jp_msa1) * zincwgt 
    1358                trb(:,:,jk,jp_msa0:jp_msa1) = trb(:,:,jk,jp_msa0:jp_msa1) + & 
    1359                   &                          pco2_balinc(:,:,jk,jp_msa0:jp_msa1) * zincwgt 
    1360             END DO 
     1355            WHERE( pco2_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     1356               &   trn(:,:,:,jp_msa0:jp_msa1) + pco2_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt > 0.0_wp ) 
     1357               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
     1358                  &                         pco2_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt 
     1359               trb(:,:,:,jp_msa0:jp_msa1) = trb(:,:,:,jp_msa0:jp_msa1) + & 
     1360                  &                         pco2_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt 
     1361            END WHERE 
    13611362#elif defined key_hadocc 
    1362             DO jk = 1, jpkm1 
    1363                trn(:,:,jk,jp_had0:jp_had1) = trn(:,:,jk,jp_had0:jp_had1) + & 
    1364                   &                          pco2_balinc(:,:,jk,jp_had0:jp_had1) * zincwgt 
    1365                trb(:,:,jk,jp_had0:jp_had1) = trb(:,:,jk,jp_had0:jp_had1) + & 
    1366                   &                          pco2_balinc(:,:,jk,jp_had0:jp_had1) * zincwgt 
    1367             END DO 
     1363            WHERE( pco2_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp .OR. & 
     1364               &   trn(:,:,:,jp_had0:jp_had1) + pco2_balinc(:,:,:,jp_had0:jp_had1) * zincwgt > 0.0_wp ) 
     1365               trn(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) + & 
     1366                  &                         pco2_balinc(:,:,:,jp_had0:jp_had1) * zincwgt 
     1367               trb(:,:,:,jp_had0:jp_had1) = trb(:,:,:,jp_had0:jp_had1) + & 
     1368                  &                         pco2_balinc(:,:,:,jp_had0:jp_had1) * zincwgt 
     1369            END WHERE 
    13681370#endif 
    13691371 
     
    13831385            neuler = 0                    ! Force Euler forward step 
    13841386 
    1385 #if defined key_medusa && defined key_foam_medusa 
    13861387            ! Initialize the now fields with the background + increment 
    13871388            ! Background currently is what the model is initialised with 
    1388             CALL ctl_warn( ' Doing direct initialisation of MEDUSA with pCO2 assimilation', & 
     1389            CALL ctl_warn( ' Doing direct initialisation with pCO2 assimilation', & 
    13891390               &           ' Background state is taken from model rather than background file' ) 
    1390             trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
    1391                &                         pco2_balinc(:,:,:,jp_msa0:jp_msa1) 
    1392             trb(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) 
     1391#if defined key_medusa && defined key_foam_medusa 
     1392            WHERE( pco2_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     1393               &   trn(:,:,:,jp_msa0:jp_msa1) + pco2_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp ) 
     1394               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
     1395                  &                         pco2_balinc(:,:,:,jp_msa0:jp_msa1) 
     1396               trb(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) 
     1397            END WHERE 
    13931398#elif defined key_hadocc 
    1394             ! Initialize the now fields with the background + increment 
    1395             ! Background currently is what the model is initialised with 
    1396             CALL ctl_warn( ' Doing direct initialisation of HadOCC with pCO2 assimilation', & 
    1397                &           ' Background state is taken from model rather than background file' ) 
    1398             trn(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) + & 
    1399                &                         pco2_balinc(:,:,:,jp_had0:jp_had1) 
    1400             trb(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) 
     1399            WHERE( pco2_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp .OR. & 
     1400               &   trn(:,:,:,jp_had0:jp_had1) + pco2_balinc(:,:,:,jp_had0:jp_had1) > 0.0_wp ) 
     1401               trn(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) + & 
     1402                  &                         pco2_balinc(:,:,:,jp_had0:jp_had1) 
     1403               trb(:,:,:,jp_had0:jp_had1) = trn(:,:,:,jp_had0:jp_had1) 
     1404            END WHERE 
    14011405#endif 
    14021406  
     
    15891593            ! Add directly to trn and trb, rather than to tra, because tra gets 
    15901594            ! reset to zero at the start of trc_stp, called after this routine 
    1591             DO jk = 1, jpkm1 
    1592                trn(:,:,jk,jp_msa0:jp_msa1) = trn(:,:,jk,jp_msa0:jp_msa1) + & 
    1593                   &                          ph_balinc(:,:,jk,jp_msa0:jp_msa1) * zincwgt 
    1594                trb(:,:,jk,jp_msa0:jp_msa1) = trb(:,:,jk,jp_msa0:jp_msa1) + & 
    1595                   &                          ph_balinc(:,:,jk,jp_msa0:jp_msa1) * zincwgt 
    1596             END DO 
     1595            WHERE( ph_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     1596               &   trn(:,:,:,jp_msa0:jp_msa1) + ph_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt > 0.0_wp ) 
     1597               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
     1598                  &                         ph_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt 
     1599               trb(:,:,:,jp_msa0:jp_msa1) = trb(:,:,:,jp_msa0:jp_msa1) + & 
     1600                  &                         ph_balinc(:,:,:,jp_msa0:jp_msa1) * zincwgt 
     1601            END WHERE 
    15971602 
    15981603            ! Do not deallocate arrays - needed by asm_bgc_bal_wri 
     
    16151620            CALL ctl_warn( ' Doing direct initialisation of MEDUSA with pH assimilation', & 
    16161621               &           ' Background state is taken from model rather than background file' ) 
    1617             trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
    1618                &                         ph_balinc(:,:,:,jp_msa0:jp_msa1) 
    1619             trb(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) 
     1622            WHERE( ph_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp .OR. & 
     1623               &   trn(:,:,:,jp_msa0:jp_msa1) + ph_balinc(:,:,:,jp_msa0:jp_msa1) > 0.0_wp ) 
     1624               trn(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) + & 
     1625                  &                         ph_balinc(:,:,:,jp_msa0:jp_msa1) 
     1626               trb(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) 
     1627            END WHERE 
    16201628  
    16211629            ! Do not deallocate arrays - needed by asm_bgc_bal_wri 
     
    16541662      !!---------------------------------------------------------------------- 
    16551663 
     1664      IF ( kt <= nit000 ) THEN 
     1665 
     1666         !---------------------------------------------------------------------- 
     1667         ! Remove any other balancing increments 
     1668         !---------------------------------------------------------------------- 
     1669 
     1670         IF ( ln_pno3inc ) THEN 
     1671#if defined key_hadocc 
     1672            it = jp_had_nut 
     1673#elif defined key_medusa && defined key_foam_medusa 
     1674            it = jpdin 
     1675#else 
     1676            CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 
     1677#endif 
     1678            IF ( ln_phytobal ) THEN 
     1679               pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
     1680            ENDIF 
     1681            IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1682               pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
     1683            ENDIF 
     1684            IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 
     1685               pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - pco2_balinc(:,:,:,it) 
     1686            ENDIF 
     1687            IF ( ln_pphinc ) THEN 
     1688               pno3_bkginc(:,:,:) = pno3_bkginc(:,:,:) - ph_balinc(:,:,:,it) 
     1689            ENDIF 
     1690         ENDIF 
     1691 
     1692         IF ( ln_psi4inc ) THEN 
     1693#if defined key_medusa && defined key_foam_medusa 
     1694            it = jpsil 
     1695#else 
     1696            CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 
     1697#endif 
     1698            IF ( ln_phytobal ) THEN 
     1699               psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
     1700            ENDIF 
     1701            IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1702               psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
     1703            ENDIF 
     1704            IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 
     1705               psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - pco2_balinc(:,:,:,it) 
     1706            ENDIF 
     1707            IF ( ln_pphinc ) THEN 
     1708               psi4_bkginc(:,:,:) = psi4_bkginc(:,:,:) - ph_balinc(:,:,:,it) 
     1709            ENDIF 
     1710         ENDIF 
     1711 
     1712         IF ( ln_pdicinc ) THEN 
     1713#if defined key_hadocc 
     1714            it = jp_had_dic 
     1715#elif defined key_medusa && defined key_foam_medusa 
     1716            it = jpdic 
     1717#else 
     1718            CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 
     1719#endif 
     1720            IF ( ln_phytobal ) THEN 
     1721               pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
     1722            ENDIF 
     1723            IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1724               pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
     1725            ENDIF 
     1726            IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 
     1727               pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - pco2_balinc(:,:,:,it) 
     1728            ENDIF 
     1729            IF ( ln_pphinc ) THEN 
     1730               pdic_bkginc(:,:,:) = pdic_bkginc(:,:,:) - ph_balinc(:,:,:,it) 
     1731            ENDIF 
     1732         ENDIF 
     1733 
     1734         IF ( ln_palkinc ) THEN 
     1735#if defined key_hadocc 
     1736            it = jp_had_alk 
     1737#elif defined key_medusa && defined key_foam_medusa 
     1738            it = jpalk 
     1739#else 
     1740            CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 
     1741#endif 
     1742            IF ( ln_phytobal ) THEN 
     1743               palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
     1744            ENDIF 
     1745            IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1746               palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
     1747            ENDIF 
     1748            IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 
     1749               palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - pco2_balinc(:,:,:,it) 
     1750            ENDIF 
     1751            IF ( ln_pphinc ) THEN 
     1752               palk_bkginc(:,:,:) = palk_bkginc(:,:,:) - ph_balinc(:,:,:,it) 
     1753            ENDIF 
     1754         ENDIF 
     1755 
     1756         IF ( ln_po2inc ) THEN 
     1757#if defined key_medusa && defined key_foam_medusa 
     1758            it = jpoxy 
     1759#else 
     1760            CALL ctl_stop ( ' bgc3d_asm_inc: no compatible BGC model defined' ) 
     1761#endif 
     1762            IF ( ln_phytobal ) THEN 
     1763               po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto2d_balinc(:,:,:,it) 
     1764            ENDIF 
     1765            IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1766               po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - phyto3d_balinc(:,:,:,it) 
     1767            ENDIF 
     1768            IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 
     1769               po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - pco2_balinc(:,:,:,it) 
     1770            ENDIF 
     1771            IF ( ln_pphinc ) THEN 
     1772               po2_bkginc(:,:,:) = po2_bkginc(:,:,:) - ph_balinc(:,:,:,it) 
     1773            ENDIF 
     1774         ENDIF 
     1775 
     1776      ENDIF 
     1777 
    16561778      IF ( ll_asmiau ) THEN 
    16571779 
Note: See TracChangeset for help on using the changeset viewer.