- Timestamp:
- 2020-06-10T13:13:39+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_1d_bugfixes/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90
r10302 r13088 33 33 USE oce, ONLY: & ! active tracer variables 34 34 & tsn 35 USE zdfmxl, ONLY : & ! mixed layer depth 35 USE zdfmxl, ONLY : & ! mixed layer depth 36 36 #if defined key_karaml 37 37 & hmld_kara, & 38 38 & ln_kara, & 39 #endif 40 & hmld, & 39 #endif 40 & hmld, & 41 41 & hmlp, & 42 & hmlpt 42 & hmlpt 43 43 USE asmpar, ONLY: & ! assimilation parameters 44 44 & c_asmbkg, & … … 89 89 90 90 IMPLICIT NONE 91 PRIVATE 91 PRIVATE 92 92 93 93 PUBLIC asm_bgc_check_options ! called by asm_inc_init in asminc.F90 … … 290 290 291 291 ! Allocate and read increments 292 292 293 293 IF ( ln_slchltotinc ) THEN 294 294 ALLOCATE( slchltot_bkginc(jpi,jpj) ) 295 295 CALL asm_bgc_read_incs_2d( knum, 'bckinslchltot', slchltot_bkginc ) 296 296 ENDIF 297 297 298 298 IF ( ln_slchldiainc ) THEN 299 299 ALLOCATE( slchldia_bkginc(jpi,jpj) ) 300 300 CALL asm_bgc_read_incs_2d( knum, 'bckinslchldia', slchldia_bkginc ) 301 301 ENDIF 302 302 303 303 IF ( ln_slchlnoninc ) THEN 304 304 ALLOCATE( slchlnon_bkginc(jpi,jpj) ) 305 305 CALL asm_bgc_read_incs_2d( knum, 'bckinslchlnon', slchlnon_bkginc ) 306 306 ENDIF 307 307 308 308 IF ( ln_schltotinc ) THEN 309 309 ALLOCATE( schltot_bkginc(jpi,jpj) ) 310 310 CALL asm_bgc_read_incs_2d( knum, 'bckinschltot', schltot_bkginc ) 311 311 ENDIF 312 312 313 313 IF ( ln_slphytotinc ) THEN 314 314 ALLOCATE( slphytot_bkginc(jpi,jpj) ) 315 315 CALL asm_bgc_read_incs_2d( knum, 'bckinslphytot', slphytot_bkginc ) 316 316 ENDIF 317 317 318 318 IF ( ln_slphydiainc ) THEN 319 319 ALLOCATE( slphydia_bkginc(jpi,jpj) ) 320 320 CALL asm_bgc_read_incs_2d( knum, 'bckinslphydia', slphydia_bkginc ) 321 321 ENDIF 322 322 323 323 IF ( ln_slphynoninc ) THEN 324 324 ALLOCATE( slphynon_bkginc(jpi,jpj) ) … … 335 335 CALL asm_bgc_read_incs_2d( knum, 'bckinspco2', sfco2_bkginc ) 336 336 ENDIF 337 337 338 338 IF ( ln_plchltotinc ) THEN 339 339 ALLOCATE( plchltot_bkginc(jpi,jpj,jpk) ) 340 340 CALL asm_bgc_read_incs_3d( knum, 'bckinplchltot', plchltot_bkginc ) 341 341 ENDIF 342 342 343 343 IF ( ln_pchltotinc ) THEN 344 344 ALLOCATE( pchltot_bkginc(jpi,jpj,jpk) ) 345 345 CALL asm_bgc_read_incs_3d( knum, 'bckinpchltot', pchltot_bkginc ) 346 346 ENDIF 347 347 348 348 IF ( ln_pno3inc ) THEN 349 349 ALLOCATE( pno3_bkginc(jpi,jpj,jpk) ) 350 350 CALL asm_bgc_read_incs_3d( knum, 'bckinpno3', pno3_bkginc ) 351 351 ENDIF 352 352 353 353 IF ( ln_psi4inc ) THEN 354 354 ALLOCATE( psi4_bkginc(jpi,jpj,jpk) ) 355 355 CALL asm_bgc_read_incs_3d( knum, 'bckinpsi4', psi4_bkginc ) 356 356 ENDIF 357 357 358 358 IF ( ln_pdicinc ) THEN 359 359 ALLOCATE( pdic_bkginc(jpi,jpj,jpk) ) 360 360 CALL asm_bgc_read_incs_3d( knum, 'bckinpdic', pdic_bkginc ) 361 361 ENDIF 362 362 363 363 IF ( ln_palkinc ) THEN 364 364 ALLOCATE( palk_bkginc(jpi,jpj,jpk) ) 365 365 CALL asm_bgc_read_incs_3d( knum, 'bckinpalk', palk_bkginc ) 366 366 ENDIF 367 367 368 368 IF ( ln_pphinc ) THEN 369 369 ALLOCATE( pph_bkginc(jpi,jpj,jpk) ) 370 370 CALL asm_bgc_read_incs_3d( knum, 'bckinpph', pph_bkginc ) 371 371 ENDIF 372 372 373 373 IF ( ln_po2inc ) THEN 374 374 ALLOCATE( po2_bkginc(jpi,jpj,jpk) ) … … 377 377 378 378 ! Allocate balancing increments 379 379 380 380 IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 381 381 & ln_schltotinc .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & … … 388 388 #endif 389 389 ENDIF 390 390 391 391 IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 392 392 #if defined key_top … … 443 443 ! Initialise 444 444 p_incs(:,:) = 0.0 445 445 446 446 ! read from file 447 447 CALL iom_get( knum, jpdom_autoglo, TRIM(cd_bgcname), p_incs(:,:), 1 ) 448 448 449 449 ! Apply the masks 450 450 p_incs(:,:) = p_incs(:,:) * tmask(:,:,1) 451 451 452 452 ! Set missing increments to 0.0 rather than 1e+20 453 453 ! to allow for differences in masks … … 481 481 ! Initialise 482 482 p_incs(:,:,:) = 0.0 483 483 484 484 ! read from file 485 485 CALL iom_get( knum, jpdom_autoglo, TRIM(cd_bgcname), p_incs(:,:,:), 1 ) 486 486 487 487 ! Apply the masks 488 488 p_incs(:,:,:) = p_incs(:,:,:) * tmask(:,:,:) 489 489 490 490 ! Set missing increments to 0.0 rather than 1e+20 491 491 ! to allow for differences in masks … … 538 538 cchl_p_bkg(:,:,:) = 0.0 539 539 #endif 540 540 541 541 !-------------------------------------------------------------------- 542 542 ! Read background variables for phytoplankton assimilation … … 558 558 CALL iom_get( inum, jpdom_autoglo, 'medusa_pds', tracer_bkg(:,:,:,jppds) ) 559 559 #endif 560 560 561 561 IF ( ln_phytobal ) THEN 562 562 … … 602 602 603 603 CALL iom_close( inum ) 604 604 605 605 DO jt = 1, jptra 606 606 tracer_bkg(:,:,:,jt) = tracer_bkg(:,:,:,jt) * tmask(:,:,:) 607 607 END DO 608 608 609 609 ELSE IF ( ln_spco2inc .OR. ln_sfco2inc .OR. ln_pphinc ) THEN 610 610 … … 615 615 616 616 CALL iom_open( c_asmbkg, inum ) 617 617 618 618 #if defined key_hadocc 619 619 CALL iom_get( inum, jpdom_autoglo, 'hadocc_dic', tracer_bkg(:,:,:,jp_had_dic) ) … … 626 626 627 627 CALL iom_close( inum ) 628 628 629 629 DO jt = 1, jptra 630 630 tracer_bkg(:,:,:,jt) = tracer_bkg(:,:,:,jt) * tmask(:,:,:) 631 631 END DO 632 632 mld_max_bkg(:,:) = mld_max_bkg(:,:) * tmask(:,:,1) 633 633 634 634 ENDIF 635 635 #else … … 655 655 !! 656 656 !! ** Action : 657 !! 657 !! 658 658 !! References : 659 659 !! … … 669 669 REAL(wp) :: zdate ! Date 670 670 !!------------------------------------------------------------------------ 671 671 672 672 ! Set things up 673 673 zdate = REAL( ndastp ) … … 680 680 & TRIM( c_asmbal ) // ' at timestep = ', kt 681 681 682 ! Define the output file 682 ! Define the output file 683 683 CALL iom_open( c_asmbal, inum, ldwrt = .TRUE., kiolib = jprstlib) 684 684 … … 767 767 & TRIM( c_asmbal ) // ' at timestep = ', kt 768 768 ENDIF 769 769 770 770 END SUBROUTINE asm_bgc_bal_wri 771 771 … … 847 847 !! ** Action : return non-log increments 848 848 !! 849 !! References : 849 !! References : 850 850 !!------------------------------------------------------------------------ 851 851 !! … … 879 879 !!------------------------------------------------------------------------ 880 880 !! *** ROUTINE phyto2d_asm_inc *** 881 !! 881 !! 882 882 !! ** Purpose : Apply the chlorophyll assimilation increments. 883 883 !! … … 886 886 !! Direct initialization or Incremental Analysis Updating. 887 887 !! 888 !! ** Action : 888 !! ** Action : 889 889 !!------------------------------------------------------------------------ 890 890 INTEGER, INTENT(IN) :: kt ! Current time step … … 914 914 #endif 915 915 !!------------------------------------------------------------------------ 916 916 917 917 IF ( kt <= nit000 ) THEN 918 918 … … 920 920 ! Remember that two sets of non-log increments should not be 921 921 ! expected to be in the same ratio as their log equivalents 922 922 923 923 ! Total chlorophyll 924 924 IF ( ln_slchltotinc ) THEN … … 1074 1074 1075 1075 IF(lwp) THEN 1076 WRITE(numout,*) 1076 WRITE(numout,*) 1077 1077 WRITE(numout,*) 'phyto2d_asm_inc : phyto2d IAU at time step = ', & 1078 1078 & kt,' with IAU weight = ', pwgtiau(it) … … 1105 1105 ENDIF 1106 1106 1107 ELSEIF ( ll_asmdin ) THEN 1107 ELSEIF ( ll_asmdin ) THEN 1108 1108 1109 1109 !-------------------------------------------------------------------- 1110 1110 ! Direct Initialization 1111 1111 !-------------------------------------------------------------------- 1112 1112 1113 1113 IF ( kt == nitdin_r ) THEN 1114 1114 … … 1134 1134 END WHERE 1135 1135 #endif 1136 1136 1137 1137 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1138 1138 ! which is called at end of model run … … 1150 1150 !!------------------------------------------------------------------------ 1151 1151 !! *** ROUTINE phyto3d_asm_inc *** 1152 !! 1152 !! 1153 1153 !! ** Purpose : Apply the profile chlorophyll assimilation increments. 1154 1154 !! … … 1156 1156 !! Direct initialization or Incremental Analysis Updating. 1157 1157 !! 1158 !! ** Action : 1158 !! ** Action : 1159 1159 !!------------------------------------------------------------------------ 1160 1160 INTEGER, INTENT(IN) :: kt ! Current time step … … 1261 1261 1262 1262 IF(lwp) THEN 1263 WRITE(numout,*) 1263 WRITE(numout,*) 1264 1264 WRITE(numout,*) 'phyto3d_asm_inc : phyto3d IAU at time step = ', & 1265 1265 & kt,' with IAU weight = ', pwgtiau(it) … … 1292 1292 ENDIF 1293 1293 1294 ELSEIF ( ll_asmdin ) THEN 1294 ELSEIF ( ll_asmdin ) THEN 1295 1295 1296 1296 !-------------------------------------------------------------------- 1297 1297 ! Direct Initialization 1298 1298 !-------------------------------------------------------------------- 1299 1299 1300 1300 IF ( kt == nitdin_r ) THEN 1301 1301 … … 1321 1321 END WHERE 1322 1322 #endif 1323 1323 1324 1324 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1325 1325 ! which is called at end of model run … … 1338 1338 !!------------------------------------------------------------------------ 1339 1339 !! *** ROUTINE pco2_asm_inc *** 1340 !! 1340 !! 1341 1341 !! ** Purpose : Apply the pco2/fco2 assimilation increments. 1342 1342 !! … … 1345 1345 !! Direct initialization or Incremental Analysis Updating. 1346 1346 !! 1347 !! ** Action : 1347 !! ** Action : 1348 1348 !!------------------------------------------------------------------------ 1349 1349 INTEGER, INTENT(IN) :: kt ! Current time step … … 1495 1495 jkmax = jpk-1 1496 1496 DO jk = jpk-1, 1, -1 1497 #if defined key_vvl 1497 1498 IF ( ( zmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 1498 1499 & ( zmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN … … 1500 1501 jkmax = jk 1501 1502 ENDIF 1503 #else 1504 IF ( ( zmld(ji,jj) > gdepw_0(ji,jj,jk) ) .AND. & 1505 & ( zmld(ji,jj) <= gdepw_0(ji,jj,jk+1) ) ) THEN 1506 zmld(ji,jj) = gdepw_0(ji,jj,jk+1) 1507 jkmax = jk 1508 ENDIF 1509 #endif 1502 1510 END DO 1503 1511 ! … … 1526 1534 1527 1535 IF(lwp) THEN 1528 WRITE(numout,*) 1536 WRITE(numout,*) 1529 1537 IF ( ln_spco2inc ) THEN 1530 1538 WRITE(numout,*) 'pco2_asm_inc : pco2 IAU at time step = ', & … … 1563 1571 ENDIF 1564 1572 1565 ELSEIF ( ll_asmdin ) THEN 1573 ELSEIF ( ll_asmdin ) THEN 1566 1574 1567 1575 !-------------------------------------------------------------------- 1568 1576 ! Direct Initialization 1569 1577 !-------------------------------------------------------------------- 1570 1578 1571 1579 IF ( kt == nitdin_r ) THEN 1572 1580 … … 1592 1600 END WHERE 1593 1601 #endif 1594 1602 1595 1603 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1596 1604 ! which is called at end of model run … … 1609 1617 !!------------------------------------------------------------------------ 1610 1618 !! *** ROUTINE ph_asm_inc *** 1611 !! 1619 !! 1612 1620 !! ** Purpose : Apply the pH assimilation increments. 1613 1621 !! … … 1616 1624 !! Direct initialization or Incremental Analysis Updating. 1617 1625 !! 1618 !! ** Action : 1626 !! ** Action : 1619 1627 !!------------------------------------------------------------------------ 1620 1628 INTEGER, INTENT(IN) :: kt ! Current time step … … 1626 1634 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: pt_bkginc ! T increments 1627 1635 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ps_bkginc ! S increments 1628 1636 1629 1637 REAL(wp) :: zsearch = 10.0 ! Increment to DIC/alk in pH calculation 1630 1638 REAL(wp) :: DIC_IN, ALK_IN ! DIC/alk in pH calculation … … 1679 1687 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) 1680 1688 ENDIF 1681 1689 1682 1690 ! Account for pCO2 balancing if required 1683 1691 IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN … … 1685 1693 alk_bkg_temp(:,:,:) = alk_bkg_temp(:,:,:) + pco2_balinc(:,:,:,jpalk) 1686 1694 ENDIF 1687 1695 1688 1696 ! Loop over grid points and calculate dpH/dDIC and dpH/dAlk 1689 1697 ! This requires three calls to the MOCSY carbonate package … … 1750 1758 ph_balinc(ji,jj,jk,jpdic) = weight * dph_ddic 1751 1759 ph_balinc(ji,jj,jk,jpalk) = weight * dph_dalk 1752 1760 1753 1761 ENDIF 1754 1762 1755 1763 END DO 1756 1764 END DO … … 1758 1766 1759 1767 ENDIF 1760 1768 1761 1769 IF ( ll_asmiau ) THEN 1762 1770 … … 1772 1780 1773 1781 IF(lwp) THEN 1774 WRITE(numout,*) 1782 WRITE(numout,*) 1775 1783 WRITE(numout,*) 'ph_asm_inc : pH IAU at time step = ', & 1776 1784 & kt,' with IAU weight = ', pwgtiau(it) … … 1794 1802 ENDIF 1795 1803 1796 ELSEIF ( ll_asmdin ) THEN 1804 ELSEIF ( ll_asmdin ) THEN 1797 1805 1798 1806 !-------------------------------------------------------------------- 1799 1807 ! Direct Initialization 1800 1808 !-------------------------------------------------------------------- 1801 1809 1802 1810 IF ( kt == nitdin_r ) THEN 1803 1811 … … 1814 1822 trb(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) 1815 1823 END WHERE 1816 1824 1817 1825 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1818 1826 ! which is called at end of model run … … 1820 1828 ! 1821 1829 ENDIF 1822 #endif 1830 #endif 1823 1831 ! 1824 1832 END SUBROUTINE ph_asm_inc … … 1831 1839 !!---------------------------------------------------------------------- 1832 1840 !! *** ROUTINE dyn_asm_inc *** 1833 !! 1841 !! 1834 1842 !! ** Purpose : Apply generic 3D biogeochemistry assimilation increments. 1835 1843 !! 1836 1844 !! ** Method : Direct initialization or Incremental Analysis Updating. 1837 1845 !! 1838 !! ** Action : 1846 !! ** Action : 1839 1847 !!---------------------------------------------------------------------- 1840 1848 INTEGER, INTENT(IN) :: kt ! Current time step … … 1983 1991 1984 1992 IF(lwp) THEN 1985 WRITE(numout,*) 1993 WRITE(numout,*) 1986 1994 WRITE(numout,*) 'bgc3d_asm_inc : 3D BGC IAU at time step = ', & 1987 1995 & kt,' with IAU weight = ', pwgtiau(it) … … 2071 2079 #endif 2072 2080 ENDIF 2073 2081 2074 2082 IF ( kt == nitiaufin_r ) THEN 2075 2083 IF ( ln_pno3inc ) DEALLOCATE( pno3_bkginc ) … … 2082 2090 ENDIF 2083 2091 2084 ELSEIF ( ll_asmdin ) THEN 2092 ELSEIF ( ll_asmdin ) THEN 2085 2093 2086 2094 !-------------------------------------------------------------------- 2087 2095 ! Direct Initialization 2088 2096 !-------------------------------------------------------------------- 2089 2097 2090 2098 IF ( kt == nitdin_r ) THEN 2091 2099 … … 2179 2187 #endif 2180 2188 ENDIF 2181 2189 2182 2190 IF ( ln_pno3inc ) DEALLOCATE( pno3_bkginc ) 2183 2191 IF ( ln_psi4inc ) DEALLOCATE( psi4_bkginc )
Note: See TracChangeset
for help on using the changeset viewer.
