- Timestamp:
- 2020-07-30T12:12:41+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90
r13316 r13355 35 35 USE oce, ONLY: & ! active tracer variables 36 36 & tsn 37 USE zdfmxl, ONLY : & ! mixed layer depth 37 USE zdfmxl, ONLY : & ! mixed layer depth 38 38 #if defined key_karaml 39 39 & hmld_kara, & 40 40 & ln_kara, & 41 #endif 42 & hmld, & 41 #endif 42 & hmld, & 43 43 & hmlp, & 44 & hmlpt 44 & hmlpt 45 45 USE asmpar, ONLY: & ! assimilation parameters 46 46 & c_asmbkg, & … … 97 97 98 98 IMPLICIT NONE 99 PRIVATE 99 PRIVATE 100 100 101 101 PUBLIC asm_bgc_check_options ! called by asm_inc_init in asminc.F90 … … 304 304 305 305 ! Allocate and read increments 306 306 307 307 IF ( ln_slchltotinc ) THEN 308 308 ALLOCATE( slchltot_bkginc(jpi,jpj) ) 309 309 CALL asm_bgc_read_incs_2d( knum, 'bckinslchltot', slchltot_bkginc ) 310 310 ENDIF 311 311 312 312 IF ( ln_slchldiainc ) THEN 313 313 ALLOCATE( slchldia_bkginc(jpi,jpj) ) 314 314 CALL asm_bgc_read_incs_2d( knum, 'bckinslchldia', slchldia_bkginc ) 315 315 ENDIF 316 316 317 317 IF ( ln_slchlnoninc ) THEN 318 318 ALLOCATE( slchlnon_bkginc(jpi,jpj) ) 319 319 CALL asm_bgc_read_incs_2d( knum, 'bckinslchlnon', slchlnon_bkginc ) 320 320 ENDIF 321 321 322 322 IF ( ln_schltotinc ) THEN 323 323 ALLOCATE( schltot_bkginc(jpi,jpj) ) 324 324 CALL asm_bgc_read_incs_2d( knum, 'bckinschltot', schltot_bkginc ) 325 325 ENDIF 326 326 327 327 IF ( ln_slphytotinc ) THEN 328 328 ALLOCATE( slphytot_bkginc(jpi,jpj) ) 329 329 CALL asm_bgc_read_incs_2d( knum, 'bckinslphytot', slphytot_bkginc ) 330 330 ENDIF 331 331 332 332 IF ( ln_slphydiainc ) THEN 333 333 ALLOCATE( slphydia_bkginc(jpi,jpj) ) 334 334 CALL asm_bgc_read_incs_2d( knum, 'bckinslphydia', slphydia_bkginc ) 335 335 ENDIF 336 336 337 337 IF ( ln_slphynoninc ) THEN 338 338 ALLOCATE( slphynon_bkginc(jpi,jpj) ) … … 349 349 CALL asm_bgc_read_incs_2d( knum, 'bckinspco2', sfco2_bkginc ) 350 350 ENDIF 351 351 352 352 IF ( ln_plchltotinc ) THEN 353 353 ALLOCATE( plchltot_bkginc(jpi,jpj,jpk) ) 354 354 CALL asm_bgc_read_incs_3d( knum, 'bckinplchltot', plchltot_bkginc ) 355 355 ENDIF 356 356 357 357 IF ( ln_pchltotinc ) THEN 358 358 ALLOCATE( pchltot_bkginc(jpi,jpj,jpk) ) 359 359 CALL asm_bgc_read_incs_3d( knum, 'bckinpchltot', pchltot_bkginc ) 360 360 ENDIF 361 361 362 362 IF ( ln_pno3inc ) THEN 363 363 ALLOCATE( pno3_bkginc(jpi,jpj,jpk) ) 364 364 CALL asm_bgc_read_incs_3d( knum, 'bckinpno3', pno3_bkginc ) 365 365 ENDIF 366 366 367 367 IF ( ln_psi4inc ) THEN 368 368 ALLOCATE( psi4_bkginc(jpi,jpj,jpk) ) 369 369 CALL asm_bgc_read_incs_3d( knum, 'bckinpsi4', psi4_bkginc ) 370 370 ENDIF 371 371 372 372 IF ( ln_pdicinc ) THEN 373 373 ALLOCATE( pdic_bkginc(jpi,jpj,jpk) ) 374 374 CALL asm_bgc_read_incs_3d( knum, 'bckinpdic', pdic_bkginc ) 375 375 ENDIF 376 376 377 377 IF ( ln_palkinc ) THEN 378 378 ALLOCATE( palk_bkginc(jpi,jpj,jpk) ) 379 379 CALL asm_bgc_read_incs_3d( knum, 'bckinpalk', palk_bkginc ) 380 380 ENDIF 381 381 382 382 IF ( ln_pphinc ) THEN 383 383 ALLOCATE( pph_bkginc(jpi,jpj,jpk) ) 384 384 CALL asm_bgc_read_incs_3d( knum, 'bckinpph', pph_bkginc ) 385 385 ENDIF 386 386 387 387 IF ( ln_po2inc ) THEN 388 388 ALLOCATE( po2_bkginc(jpi,jpj,jpk) ) … … 391 391 392 392 ! Allocate balancing increments 393 393 394 394 IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 395 395 & ln_schltotinc .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & … … 402 402 #endif 403 403 ENDIF 404 404 405 405 IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 406 406 #if defined key_top … … 457 457 ! Initialise 458 458 p_incs(:,:) = 0.0 459 459 460 460 ! read from file 461 461 CALL iom_get( knum, jpdom_autoglo, TRIM(cd_bgcname), p_incs(:,:), 1 ) 462 462 463 463 ! Apply the masks 464 464 p_incs(:,:) = p_incs(:,:) * tmask(:,:,1) 465 465 466 466 ! Set missing increments to 0.0 rather than 1e+20 467 467 ! to allow for differences in masks … … 495 495 ! Initialise 496 496 p_incs(:,:,:) = 0.0 497 497 498 498 ! read from file 499 499 CALL iom_get( knum, jpdom_autoglo, TRIM(cd_bgcname), p_incs(:,:,:), 1 ) 500 500 501 501 ! Apply the masks 502 502 p_incs(:,:,:) = p_incs(:,:,:) * tmask(:,:,:) 503 503 504 504 ! Set missing increments to 0.0 rather than 1e+20 505 505 ! to allow for differences in masks … … 558 558 cchl_p_bkg(:,:,:) = 0.0 559 559 #endif 560 560 561 561 !-------------------------------------------------------------------- 562 562 ! Read background variables for phytoplankton assimilation … … 578 578 CALL iom_get( inum, jpdom_autoglo, 'medusa_pds', tracer_bkg(:,:,:,jppds) ) 579 579 #endif 580 580 581 581 IF ( ln_phytobal ) THEN 582 582 … … 628 628 629 629 CALL iom_close( inum ) 630 630 631 631 DO jt = 1, jptra 632 632 tracer_bkg(:,:,:,jt) = tracer_bkg(:,:,:,jt) * tmask(:,:,:) 633 633 END DO 634 634 635 635 ELSE IF ( ln_spco2inc .OR. ln_sfco2inc .OR. ln_pphinc ) THEN 636 636 … … 641 641 642 642 CALL iom_open( c_asmbkg, inum ) 643 643 644 644 #if defined key_hadocc 645 645 CALL iom_get( inum, jpdom_autoglo, 'hadocc_dic', tracer_bkg(:,:,:,jp_had_dic) ) … … 652 652 653 653 CALL iom_close( inum ) 654 654 655 655 DO jt = 1, jptra 656 656 tracer_bkg(:,:,:,jt) = tracer_bkg(:,:,:,jt) * tmask(:,:,:) 657 657 END DO 658 658 mld_max_bkg(:,:) = mld_max_bkg(:,:) * tmask(:,:,1) 659 659 660 660 ENDIF 661 661 #else … … 681 681 !! 682 682 !! ** Action : 683 !! 683 !! 684 684 !! References : 685 685 !! … … 695 695 REAL(wp) :: zdate ! Date 696 696 !!------------------------------------------------------------------------ 697 697 698 698 ! Set things up 699 699 zdate = REAL( ndastp ) … … 706 706 & TRIM( c_asmbal ) // ' at timestep = ', kt 707 707 708 ! Define the output file 708 ! Define the output file 709 709 CALL iom_open( c_asmbal, inum, ldwrt = .TRUE., kiolib = jprstlib) 710 710 … … 812 812 & TRIM( c_asmbal ) // ' at timestep = ', kt 813 813 ENDIF 814 814 815 815 END SUBROUTINE asm_bgc_bal_wri 816 816 … … 893 893 !! ** Action : return non-log increments 894 894 !! 895 !! References : 895 !! References : 896 896 !!------------------------------------------------------------------------ 897 897 !! … … 970 970 !!------------------------------------------------------------------------ 971 971 !! *** ROUTINE phyto2d_asm_inc *** 972 !! 972 !! 973 973 !! ** Purpose : Apply the chlorophyll assimilation increments. 974 974 !! … … 977 977 !! Direct initialization or Incremental Analysis Updating. 978 978 !! 979 !! ** Action : 979 !! ** Action : 980 980 !!------------------------------------------------------------------------ 981 981 INTEGER, INTENT(IN) :: kt ! Current time step … … 1008 1008 REAL(wp), DIMENSION(jpi,jpj,1) :: zphyt_avg_bkg ! Local phyt_avg_bkg 1009 1009 !!------------------------------------------------------------------------ 1010 1010 1011 1011 IF ( kt <= nit000 ) THEN 1012 1012 … … 1014 1014 ! Remember that two sets of non-log increments should not be 1015 1015 ! expected to be in the same ratio as their log equivalents 1016 1016 1017 1017 ! Total chlorophyll 1018 1018 IF ( ln_slchltotinc ) THEN … … 1174 1174 1175 1175 IF(lwp) THEN 1176 WRITE(numout,*) 1176 WRITE(numout,*) 1177 1177 WRITE(numout,*) 'phyto2d_asm_inc : phyto2d IAU at time step = ', & 1178 1178 & kt,' with IAU weight = ', pwgtiau(it) … … 1205 1205 ENDIF 1206 1206 1207 ELSEIF ( ll_asmdin ) THEN 1207 ELSEIF ( ll_asmdin ) THEN 1208 1208 1209 1209 !-------------------------------------------------------------------- 1210 1210 ! Direct Initialization 1211 1211 !-------------------------------------------------------------------- 1212 1212 1213 1213 IF ( kt == nitdin_r ) THEN 1214 1214 … … 1234 1234 END WHERE 1235 1235 #endif 1236 1236 1237 1237 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1238 1238 ! which is called at end of model run … … 1250 1250 !!------------------------------------------------------------------------ 1251 1251 !! *** ROUTINE phyto3d_asm_inc *** 1252 !! 1252 !! 1253 1253 !! ** Purpose : Apply the profile chlorophyll assimilation increments. 1254 1254 !! … … 1256 1256 !! Direct initialization or Incremental Analysis Updating. 1257 1257 !! 1258 !! ** Action : 1258 !! ** Action : 1259 1259 !!------------------------------------------------------------------------ 1260 1260 INTEGER, INTENT(IN) :: kt ! Current time step … … 1340 1340 1341 1341 IF(lwp) THEN 1342 WRITE(numout,*) 1342 WRITE(numout,*) 1343 1343 WRITE(numout,*) 'phyto3d_asm_inc : phyto3d IAU at time step = ', & 1344 1344 & kt,' with IAU weight = ', pwgtiau(it) … … 1371 1371 ENDIF 1372 1372 1373 ELSEIF ( ll_asmdin ) THEN 1373 ELSEIF ( ll_asmdin ) THEN 1374 1374 1375 1375 !-------------------------------------------------------------------- 1376 1376 ! Direct Initialization 1377 1377 !-------------------------------------------------------------------- 1378 1378 1379 1379 IF ( kt == nitdin_r ) THEN 1380 1380 … … 1400 1400 END WHERE 1401 1401 #endif 1402 1402 1403 1403 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1404 1404 ! which is called at end of model run … … 1417 1417 !!------------------------------------------------------------------------ 1418 1418 !! *** ROUTINE pco2_asm_inc *** 1419 !! 1419 !! 1420 1420 !! ** Purpose : Apply the pco2/fco2 assimilation increments. 1421 1421 !! … … 1424 1424 !! Direct initialization or Incremental Analysis Updating. 1425 1425 !! 1426 !! ** Action : 1426 !! ** Action : 1427 1427 !!------------------------------------------------------------------------ 1428 1428 INTEGER, INTENT(IN) :: kt ! Current time step … … 1586 1586 jkmax = jpk-1 1587 1587 DO jk = jpk-1, 1, -1 1588 #if defined key_vvl 1588 1589 IF ( ( zmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 1589 1590 & ( zmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN … … 1591 1592 jkmax = jk 1592 1593 ENDIF 1594 #else 1595 IF ( ( zmld(ji,jj) > gdepw_0(ji,jj,jk) ) .AND. & 1596 & ( zmld(ji,jj) <= gdepw_0(ji,jj,jk+1) ) ) THEN 1597 zmld(ji,jj) = gdepw_0(ji,jj,jk+1) 1598 jkmax = jk 1599 ENDIF 1600 #endif 1593 1601 END DO 1594 1602 ! … … 1617 1625 1618 1626 IF(lwp) THEN 1619 WRITE(numout,*) 1627 WRITE(numout,*) 1620 1628 IF ( ln_spco2inc ) THEN 1621 1629 WRITE(numout,*) 'pco2_asm_inc : pco2 IAU at time step = ', & … … 1654 1662 ENDIF 1655 1663 1656 ELSEIF ( ll_asmdin ) THEN 1664 ELSEIF ( ll_asmdin ) THEN 1657 1665 1658 1666 !-------------------------------------------------------------------- 1659 1667 ! Direct Initialization 1660 1668 !-------------------------------------------------------------------- 1661 1669 1662 1670 IF ( kt == nitdin_r ) THEN 1663 1671 … … 1683 1691 END WHERE 1684 1692 #endif 1685 1693 1686 1694 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1687 1695 ! which is called at end of model run … … 1700 1708 !!------------------------------------------------------------------------ 1701 1709 !! *** ROUTINE ph_asm_inc *** 1702 !! 1710 !! 1703 1711 !! ** Purpose : Apply the pH assimilation increments. 1704 1712 !! … … 1707 1715 !! Direct initialization or Incremental Analysis Updating. 1708 1716 !! 1709 !! ** Action : 1717 !! ** Action : 1710 1718 !!------------------------------------------------------------------------ 1711 1719 INTEGER, INTENT(IN) :: kt ! Current time step … … 1717 1725 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: pt_bkginc ! T increments 1718 1726 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ps_bkginc ! S increments 1719 1727 1720 1728 REAL(wp) :: zsearch = 10.0 ! Increment to DIC/alk in pH calculation 1721 1729 REAL(wp) :: DIC_IN, ALK_IN ! DIC/alk in pH calculation … … 1778 1786 sil_bkg_temp(:,:,:) = tracer_bkg(:,:,:,jpsil) 1779 1787 ENDIF 1780 1788 1781 1789 ! Account for pCO2 balancing if required 1782 1790 IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN … … 1784 1792 alk_bkg_temp(:,:,:) = alk_bkg_temp(:,:,:) + pco2_balinc(:,:,:,jpalk) 1785 1793 ENDIF 1786 1794 1787 1795 ! Loop over grid points and calculate dpH/dDIC and dpH/dAlk 1788 1796 ! This requires three calls to the MOCSY carbonate package … … 1849 1857 ph_balinc(ji,jj,jk,jpdic) = weight * dph_ddic 1850 1858 ph_balinc(ji,jj,jk,jpalk) = weight * dph_dalk 1851 1859 1852 1860 ENDIF 1853 1861 1854 1862 END DO 1855 1863 END DO … … 1857 1865 1858 1866 ENDIF 1859 1867 1860 1868 IF ( ll_asmiau ) THEN 1861 1869 … … 1871 1879 1872 1880 IF(lwp) THEN 1873 WRITE(numout,*) 1881 WRITE(numout,*) 1874 1882 WRITE(numout,*) 'ph_asm_inc : pH IAU at time step = ', & 1875 1883 & kt,' with IAU weight = ', pwgtiau(it) … … 1893 1901 ENDIF 1894 1902 1895 ELSEIF ( ll_asmdin ) THEN 1903 ELSEIF ( ll_asmdin ) THEN 1896 1904 1897 1905 !-------------------------------------------------------------------- 1898 1906 ! Direct Initialization 1899 1907 !-------------------------------------------------------------------- 1900 1908 1901 1909 IF ( kt == nitdin_r ) THEN 1902 1910 … … 1913 1921 trb(:,:,:,jp_msa0:jp_msa1) = trn(:,:,:,jp_msa0:jp_msa1) 1914 1922 END WHERE 1915 1923 1916 1924 ! Do not deallocate arrays - needed by asm_bgc_bal_wri 1917 1925 ! which is called at end of model run … … 1919 1927 ! 1920 1928 ENDIF 1921 #endif 1929 #endif 1922 1930 ! 1923 1931 END SUBROUTINE ph_asm_inc … … 1930 1938 !!---------------------------------------------------------------------- 1931 1939 !! *** ROUTINE dyn_asm_inc *** 1932 !! 1940 !! 1933 1941 !! ** Purpose : Apply generic 3D biogeochemistry assimilation increments. 1934 1942 !! 1935 1943 !! ** Method : Direct initialization or Incremental Analysis Updating. 1936 1944 !! 1937 !! ** Action : 1945 !! ** Action : 1938 1946 !!---------------------------------------------------------------------- 1939 1947 INTEGER, INTENT(IN) :: kt ! Current time step … … 2082 2090 2083 2091 IF(lwp) THEN 2084 WRITE(numout,*) 2092 WRITE(numout,*) 2085 2093 WRITE(numout,*) 'bgc3d_asm_inc : 3D BGC IAU at time step = ', & 2086 2094 & kt,' with IAU weight = ', pwgtiau(it) … … 2170 2178 #endif 2171 2179 ENDIF 2172 2180 2173 2181 IF ( kt == nitiaufin_r ) THEN 2174 2182 IF ( ln_pno3inc ) DEALLOCATE( pno3_bkginc ) … … 2181 2189 ENDIF 2182 2190 2183 ELSEIF ( ll_asmdin ) THEN 2191 ELSEIF ( ll_asmdin ) THEN 2184 2192 2185 2193 !-------------------------------------------------------------------- 2186 2194 ! Direct Initialization 2187 2195 !-------------------------------------------------------------------- 2188 2196 2189 2197 IF ( kt == nitdin_r ) THEN 2190 2198 … … 2278 2286 #endif 2279 2287 ENDIF 2280 2288 2281 2289 IF ( ln_pno3inc ) DEALLOCATE( pno3_bkginc ) 2282 2290 IF ( ln_psi4inc ) DEALLOCATE( psi4_bkginc )
Note: See TracChangeset
for help on using the changeset viewer.
