Changeset 12252 for NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Timestamp:
- 2019-12-14T14:57:23+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 1 deleted
- 20 edited
-
ICE/icedyn_adv.F90 (modified) (1 diff)
-
ICE/icedyn_adv_pra.F90 (modified) (6 diffs)
-
ICE/icedyn_adv_umx.F90 (modified) (5 diffs)
-
OCE/BDY/bdyini.F90 (modified) (1 diff)
-
OCE/BDY/bdyvol.F90 (modified) (1 diff)
-
OCE/DIA/diatmb.F90 (deleted)
-
OCE/DIA/diawri.F90 (modified) (2 diffs)
-
OCE/DYN/divhor.F90 (modified) (1 diff)
-
OCE/DYN/dynspg_ts.F90 (modified) (5 diffs)
-
OCE/IOM/iom.F90 (modified) (1 diff)
-
OCE/LDF/ldfdyn.F90 (modified) (1 diff)
-
OCE/LDF/ldfslp.F90 (modified) (3 diffs)
-
OCE/SBC/cpl_oasis3.F90 (modified) (2 diffs)
-
OCE/SBC/sbc_oce.F90 (modified) (1 diff)
-
OCE/SBC/sbccpl.F90 (modified) (16 diffs)
-
OCE/SBC/sbcrnf.F90 (modified) (2 diffs)
-
OCE/nemogcm.F90 (modified) (2 diffs)
-
TOP/PISCES/P4Z/p4zmeso.F90 (modified) (3 diffs)
-
TOP/PISCES/P4Z/p4zmicro.F90 (modified) (2 diffs)
-
TOP/trcini.F90 (modified) (2 diffs)
-
TOP/trcstp.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_adv.F90
r11960 r12252 88 88 CASE( np_advPRA ) ! PRATHER scheme ! 89 89 ! !-----------------------! 90 CALL ice_dyn_adv_pra( kt, u_ice, v_ice, &90 CALL ice_dyn_adv_pra( kt, u_ice, v_ice, h_i, h_s, h_ip, & 91 91 & ato_i, v_i, v_s, sv_i, oa_i, a_i, a_ip, v_ip, e_s, e_i ) 92 92 END SELECT -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_adv_pra.F90
r11812 r12252 54 54 CONTAINS 55 55 56 SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice, &56 SUBROUTINE ice_dyn_adv_pra( kt, pu_ice, pv_ice, ph_i, ph_s, ph_ip, & 57 57 & pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 58 58 !!---------------------------------------------------------------------- … … 70 70 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pu_ice ! ice i-velocity 71 71 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pv_ice ! ice j-velocity 72 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: ph_i ! ice thickness 73 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: ph_s ! snw thickness 74 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: ph_ip ! ice pond thickness 72 75 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: pato_i ! open water area 73 76 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i ! ice volume … … 87 90 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 88 91 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx 92 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 89 93 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zarea 90 94 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z0ice, z0snw, z0ai, z0smi, z0oi … … 95 99 ! 96 100 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_pra: Prather advection scheme' 101 ! 102 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 103 DO jl = 1, jpl 104 DO jj = 2, jpjm1 105 DO ji = fs_2, fs_jpim1 106 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 107 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & 108 & ph_ip(ji+1,jj+1,jl), ph_ip(ji-1,jj-1,jl), & 109 & ph_ip(ji+1,jj-1,jl), ph_ip(ji-1,jj+1,jl) ) 110 zhi_max (ji,jj,jl) = MAX( epsi20, ph_i (ji,jj,jl), ph_i (ji+1,jj ,jl), ph_i (ji ,jj+1,jl), & 111 & ph_i (ji-1,jj ,jl), ph_i (ji ,jj-1,jl), & 112 & ph_i (ji+1,jj+1,jl), ph_i (ji-1,jj-1,jl), & 113 & ph_i (ji+1,jj-1,jl), ph_i (ji-1,jj+1,jl) ) 114 zhs_max (ji,jj,jl) = MAX( epsi20, ph_s (ji,jj,jl), ph_s (ji+1,jj ,jl), ph_s (ji ,jj+1,jl), & 115 & ph_s (ji-1,jj ,jl), ph_s (ji ,jj-1,jl), & 116 & ph_s (ji+1,jj+1,jl), ph_s (ji-1,jj-1,jl), & 117 & ph_s (ji+1,jj-1,jl), ph_s (ji-1,jj+1,jl) ) 118 END DO 119 END DO 120 END DO 121 CALL lbc_lnk_multi( 'icedyn_adv_pra', zhi_max, 'T', 1., zhs_max, 'T', 1., zhip_max, 'T', 1. ) 97 122 ! 98 123 ! --- If ice drift is too fast, use subtime steps for advection (CFL test for stability) --- ! … … 239 264 ! (because advected fields are not perfectly bounded and tiny negative values can occur, e.g. -1.e-20) 240 265 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 266 ! 267 ! --- Make sure ice thickness is not too big --- ! 268 ! (because ice thickness can be too large where ice concentration is very small) 269 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 241 270 ! 242 271 ! --- Ensure snow load is not too big --- ! … … 588 617 ! 589 618 END SUBROUTINE adv_y 619 620 621 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 622 !!------------------------------------------------------------------- 623 !! *** ROUTINE Hbig *** 624 !! 625 !! ** Purpose : Thickness correction in case advection scheme creates 626 !! abnormally tick ice or snow 627 !! 628 !! ** Method : 1- check whether ice thickness is larger than the surrounding 9-points 629 !! (before advection) and reduce it by adapting ice concentration 630 !! 2- check whether snow thickness is larger than the surrounding 9-points 631 !! (before advection) and reduce it by sending the excess in the ocean 632 !! 633 !! ** input : Max thickness of the surrounding 9-points 634 !!------------------------------------------------------------------- 635 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 636 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max ! max ice thick from surrounding 9-pts 637 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip 638 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 639 ! 640 INTEGER :: ji, jj, jl ! dummy loop indices 641 REAL(wp) :: z1_dt, zhip, zhi, zhs, zfra 642 !!------------------------------------------------------------------- 643 ! 644 z1_dt = 1._wp / pdt 645 ! 646 DO jl = 1, jpl 647 648 DO jj = 1, jpj 649 DO ji = 1, jpi 650 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 651 ! 652 ! ! -- check h_ip -- ! 653 ! if h_ip is larger than the surrounding 9 pts => reduce h_ip and increase a_ip 654 IF( ln_pnd_H12 .AND. pv_ip(ji,jj,jl) > 0._wp ) THEN 655 zhip = pv_ip(ji,jj,jl) / MAX( epsi20, pa_ip(ji,jj,jl) ) 656 IF( zhip > phip_max(ji,jj,jl) .AND. pa_ip(ji,jj,jl) < 0.15 ) THEN 657 pa_ip(ji,jj,jl) = pv_ip(ji,jj,jl) / phip_max(ji,jj,jl) 658 ENDIF 659 ENDIF 660 ! 661 ! ! -- check h_i -- ! 662 ! if h_i is larger than the surrounding 9 pts => reduce h_i and increase a_i 663 zhi = pv_i(ji,jj,jl) / pa_i(ji,jj,jl) 664 IF( zhi > phi_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 665 pa_i(ji,jj,jl) = pv_i(ji,jj,jl) / MIN( phi_max(ji,jj,jl), hi_max(jpl) ) !-- bound h_i to hi_max (99 m) 666 ENDIF 667 ! 668 ! ! -- check h_s -- ! 669 ! if h_s is larger than the surrounding 9 pts => put the snow excess in the ocean 670 zhs = pv_s(ji,jj,jl) / pa_i(ji,jj,jl) 671 IF( pv_s(ji,jj,jl) > 0._wp .AND. zhs > phs_max(ji,jj,jl) .AND. pa_i(ji,jj,jl) < 0.15 ) THEN 672 zfra = phs_max(ji,jj,jl) / MAX( zhs, epsi20 ) 673 ! 674 wfx_res(ji,jj) = wfx_res(ji,jj) + ( pv_s(ji,jj,jl) - pa_i(ji,jj,jl) * phs_max(ji,jj,jl) ) * rhos * z1_dt 675 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 676 ! 677 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 678 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 679 ENDIF 680 ! 681 ENDIF 682 END DO 683 END DO 684 END DO 685 ! 686 END SUBROUTINE Hbig 590 687 591 688 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icedyn_adv_umx.F90
r11627 r12252 352 352 CALL ice_var_zapneg( zdt, pato_i, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 353 353 ! 354 ! Make sure ice thickness is not too big 355 ! (because ice thickness can be too large where ice concentration is very small) 356 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, psv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i ) 357 354 ! --- Make sure ice thickness is not too big --- ! 355 ! (because ice thickness can be too large where ice concentration is very small) 356 CALL Hbig( zdt, zhi_max, zhs_max, zhip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 357 ! 358 ! --- Ensure snow load is not too big --- ! 359 CALL Hsnow( zdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 360 ! 358 361 END DO 359 362 ! … … 1514 1517 1515 1518 1516 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, p sv_i, poa_i, pa_i, pa_ip, pv_ip, pe_s, pe_i)1519 SUBROUTINE Hbig( pdt, phi_max, phs_max, phip_max, pv_i, pv_s, pa_i, pa_ip, pv_ip, pe_s ) 1517 1520 !!------------------------------------------------------------------- 1518 1521 !! *** ROUTINE Hbig *** … … 1525 1528 !! 2- check whether snow thickness is larger than the surrounding 9-points 1526 1529 !! (before advection) and reduce it by sending the excess in the ocean 1527 !! 3- check whether snow load deplets the snow-ice interface below sea level$1528 !! and reduce it by sending the excess in the ocean1529 !! 4- correct pond concentration to avoid a_ip > a_i1530 1530 !! 1531 1531 !! ** input : Max thickness of the surrounding 9-points … … 1533 1533 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 1534 1534 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: phi_max, phs_max, phip_max ! max ice thick from surrounding 9-pts 1535 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, p sv_i, poa_i, pa_i, pa_ip, pv_ip1535 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip, pv_ip 1536 1536 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 1537 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_i 1538 ! 1539 INTEGER :: ji, jj, jk, jl ! dummy loop indices 1540 REAL(wp) :: z1_dt, zhip, zhi, zhs, zvs_excess, zfra 1541 REAL(wp), DIMENSION(jpi,jpj) :: zswitch 1537 ! 1538 INTEGER :: ji, jj, jl ! dummy loop indices 1539 REAL(wp) :: z1_dt, zhip, zhi, zhs, zfra 1542 1540 !!------------------------------------------------------------------- 1543 1541 ! … … 1578 1576 pv_s(ji,jj,jl) = pa_i(ji,jj,jl) * phs_max(ji,jj,jl) 1579 1577 ENDIF 1578 ! 1579 ENDIF 1580 END DO 1581 END DO 1582 END DO 1583 ! 1584 END SUBROUTINE Hbig 1585 1586 1587 SUBROUTINE Hsnow( pdt, pv_i, pv_s, pa_i, pa_ip, pe_s ) 1588 !!------------------------------------------------------------------- 1589 !! *** ROUTINE Hsnow *** 1590 !! 1591 !! ** Purpose : 1- Check snow load after advection 1592 !! 2- Correct pond concentration to avoid a_ip > a_i 1593 !! 1594 !! ** Method : If snow load makes snow-ice interface to deplet below the ocean surface 1595 !! then put the snow excess in the ocean 1596 !! 1597 !! ** Notes : This correction is crucial because of the call to routine icecor afterwards 1598 !! which imposes a mini of ice thick. (rn_himin). This imposed mini can artificially 1599 !! make the snow very thick (if concentration decreases drastically) 1600 !! This behavior has been seen in Ultimate-Macho and supposedly it can also be true for Prather 1601 !!------------------------------------------------------------------- 1602 REAL(wp) , INTENT(in ) :: pdt ! tracer time-step 1603 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: pv_i, pv_s, pa_i, pa_ip 1604 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pe_s 1605 ! 1606 INTEGER :: ji, jj, jl ! dummy loop indices 1607 REAL(wp) :: z1_dt, zvs_excess, zfra 1608 !!------------------------------------------------------------------- 1609 ! 1610 z1_dt = 1._wp / pdt 1611 ! 1612 ! -- check snow load -- ! 1613 DO jl = 1, jpl 1614 DO jj = 1, jpj 1615 DO ji = 1, jpi 1616 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1580 1617 ! 1581 ! ! -- check snow load -- !1582 ! if snow load makes snow-ice interface to deplet below the ocean surface => put the snow excess in the ocean1583 ! this correction is crucial because of the call to routine icecor afterwards which imposes a mini of ice thick. (rn_himin)1584 ! this imposed mini can artificially make the snow very thick (if concentration decreases drastically)1585 1618 zvs_excess = MAX( 0._wp, pv_s(ji,jj,jl) - pv_i(ji,jj,jl) * (rau0-rhoi) * r1_rhos ) 1586 IF( zvs_excess > 0._wp ) THEN 1619 ! 1620 IF( zvs_excess > 0._wp ) THEN ! snow-ice interface deplets below the ocean surface 1621 ! put snow excess in the ocean 1587 1622 zfra = ( pv_s(ji,jj,jl) - zvs_excess ) / MAX( pv_s(ji,jj,jl), epsi20 ) 1588 1623 wfx_res(ji,jj) = wfx_res(ji,jj) + zvs_excess * rhos * z1_dt 1589 1624 hfx_res(ji,jj) = hfx_res(ji,jj) - SUM( pe_s(ji,jj,1:nlay_s,jl) ) * ( 1._wp - zfra ) * z1_dt ! W.m-2 <0 1590 ! 1625 ! correct snow volume and heat content 1591 1626 pe_s(ji,jj,1:nlay_s,jl) = pe_s(ji,jj,1:nlay_s,jl) * zfra 1592 1627 pv_s(ji,jj,jl) = pv_s(ji,jj,jl) - zvs_excess 1593 1628 ENDIF 1594 1629 ! 1595 1630 ENDIF 1596 1631 END DO 1597 1632 END DO 1598 END DO 1599 ! !-- correct pond concentration to avoid a_ip > a_i 1633 END DO 1634 ! 1635 !-- correct pond concentration to avoid a_ip > a_i -- ! 1600 1636 WHERE( pa_ip(:,:,:) > pa_i(:,:,:) ) pa_ip(:,:,:) = pa_i(:,:,:) 1601 1637 ! 1602 !1603 END SUBROUTINE Hbig 1604 1638 END SUBROUTINE Hsnow 1639 1640 1605 1641 #else 1606 1642 !!---------------------------------------------------------------------- -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdyini.F90
r12205 r12252 395 395 jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy)) 396 396 ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy), nbrdta(jpbdta, jpbgrd, nb_bdy) ) 397 397 nbrdta(:,:,:) = 0 ! initialize nbrdta as it may not be completely defined for each bdy 398 398 399 ! Calculate global boundary index arrays or read in from file 399 400 !------------------------------------------------------------ -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdyvol.F90
r12150 r12252 143 143 ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 144 144 ! ------------------------------------------------------ 145 IF( MOD( kt, nn_write) == 0 .AND. ( kc == 1 ) ) THEN145 IF( MOD( kt, MAX(nn_write,1) ) == 0 .AND. ( kc == 1 ) ) THEN 146 146 ! 147 147 ! compute residual transport across boundary -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diawri.F90
r12182 r12252 49 49 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 50 50 USE in_out_manager ! I/O manager 51 USE diatmb ! Top,middle,bottom output52 51 USE dia25h ! 25h Mean output 53 52 USE iom ! … … 399 398 CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2) 400 399 ! 401 402 IF (ln_diatmb) CALL dia_tmb( Kmm ) ! tmb values 403 400 404 401 IF (ln_dia25h) CALL dia_25h( kt, Kmm ) ! 25h averaging 405 402 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/divhor.F90
r12150 r12252 73 73 IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 74 74 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 75 hdiv(:,:,:) = 0._wp ! initialize hdiv for the halos at the first time step 75 76 ENDIF 76 77 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DYN/dynspg_ts.F90
r12250 r12252 46 46 USE tide_mod ! 47 47 USE sbcwave ! surface wave 48 USE diatmb ! Top,middle,bottom output49 48 #if defined key_agrif 50 49 USE agrif_oce_interp ! agrif … … 61 60 USE iom ! IOM library 62 61 USE restart ! only for lrst_oce 63 USE diatmb ! Top,middle,bottom output64 62 65 63 USE iom ! to remove … … 154 152 REAL(wp) :: r1_2dt_b, z1_hu, z1_hv ! local scalars 155 153 REAL(wp) :: za0, za1, za2, za3 ! - - 156 REAL(wp) :: z mdi, zztmp, zldg ! - -154 REAL(wp) :: zztmp, zldg ! - - 157 155 REAL(wp) :: zhu_bck, zhv_bck, zhdiv ! - - 158 156 REAL(wp) :: zun_save, zvn_save ! - - … … 178 176 ! !* Allocate temporary arrays 179 177 IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj)) 180 !181 zmdi=1.e+20 ! missing data indicator for masking182 178 ! 183 179 zwdramp = r_rn_wdmin1 ! simplest ramp … … 835 831 IF( ln_wd_dl ) DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 836 832 ! 837 IF( ln_diatmb ) THEN 838 CALL iom_put( "baro_u" , puu_b(:,:,Kmm)*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) ) ! Barotropic U Velocity 839 CALL iom_put( "baro_v" , pvv_b(:,:,Kmm)*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) ) ! Barotropic V Velocity 840 ENDIF 833 CALL iom_put( "baro_u" , puu_b(:,:,Kmm) ) ! Barotropic U Velocity 834 CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) ) ! Barotropic V Velocity 841 835 ! 842 836 END SUBROUTINE dyn_spg_ts -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90
r12205 r12252 837 837 CHARACTER(LEN=100) :: clinfo ! info character 838 838 !--------------------------------------------------------------------- 839 ! 840 IF( iom_open_init == 0 ) RETURN ! avoid to use iom_file(jf)%nfid that us not yet initialized 839 841 ! 840 842 clinfo = ' iom_close ~~~ ' -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldfdyn.F90
r11960 r12252 416 416 ! 417 417 zcmsmag = (rn_csmc/rpi)**2 ! (C_smag/pi)^2 418 zstabf_lo = rn_minfac * rn_minfac / ( 2._wp * 4._wp * zcmsmag )! lower limit stability factor scaling418 zstabf_lo = rn_minfac * rn_minfac / ( 2._wp * 12._wp * 12._wp * zcmsmag ) ! lower limit stability factor scaling 419 419 zstabf_up = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rdt ) ! upper limit stability factor scaling 420 420 IF( ln_dynldf_blp ) zstabf_lo = ( 16._wp / 9._wp ) * zstabf_lo ! provide |U|L^3/12 lower limit instead -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldfslp.F90
r12236 r12252 209 209 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/e3u(ji,jj,jk,Kmm)* ABS( zau ) ) 210 210 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/e3v(ji,jj,jk,Kmm)* ABS( zav ) ) 211 ! ! Fred Dupont: add a correction for bottom partial steps: 212 ! ! max slope = 1/2 * e3 / e1 213 IF (ln_zps .AND. jk==mbku(ji,jj)) & 214 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , - 2._wp * e1u(ji,jj) / e3u(ji,jj,jk,Kmm)* ABS( zau ) ) 215 IF (ln_zps .AND. jk==mbkv(ji,jj)) & 216 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , - 2._wp * e2v(ji,jj) / e3v(ji,jj,jk,Kmm)* ABS( zav ) ) 211 217 ! ! uslp and vslp output in zwz and zww, resp. 212 218 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) … … 405 411 REAL(wp) :: zbeta0, ze3_e1, ze3_e2 406 412 REAL(wp), DIMENSION(jpi,jpj) :: z1_mlbw 407 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalbet408 413 REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 409 414 REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) :: zti_mlb, ztj_mlb ! for Griffies operator only … … 461 466 zdks = 0._wp 462 467 ENDIF 463 zdzrho_raw = ( - rab_b(ji,jj,jk +kp,jp_tem) * zdkt &464 & + rab_b(ji,jj,jk +kp,jp_sal) * zdks &468 zdzrho_raw = ( - rab_b(ji,jj,jk ,jp_tem) * zdkt & 469 & + rab_b(ji,jj,jk ,jp_sal) * zdks & 465 470 & ) / e3w(ji,jj,jk+kp,Kmm) 466 471 zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw ) ! force zdzrho >= repsln -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/cpl_oasis3.F90
r12236 r12252 306 306 ! End of definition phase 307 307 !------------------------------------------------------------------ 308 308 ! 309 #if defined key_agrif 310 IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN 311 #endif 309 312 CALL oasis_enddef(nerror) 310 313 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 314 #if defined key_agrif 315 ENDIF 316 #endif 311 317 ! 312 318 IF( ltmp_wapatch ) THEN … … 357 363 WRITE(numout,*) 'oasis_put: kstep ', kstep 358 364 WRITE(numout,*) 'oasis_put: info ', kinfo 359 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata( :,:,jc))360 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata( :,:,jc))361 WRITE(numout,*) ' - Sum value is ', SUM(pdata( :,:,jc))365 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(nldi:nlei,nldj:nlej,jc)) 366 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(nldi:nlei,nldj:nlej,jc)) 367 WRITE(numout,*) ' - Sum value is ', SUM(pdata(nldi:nlei,nldj:nlej,jc)) 362 368 WRITE(numout,*) '****************' 363 369 ENDIF -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbc_oce.F90
r12199 r12252 107 107 !! Ocean Surface Boundary Condition fields 108 108 !!---------------------------------------------------------------------- 109 INTEGER , PUBLIC :: ncpl_qsr_freq !: qsr coupling frequency per days from atmosphere109 INTEGER , PUBLIC :: ncpl_qsr_freq = 0 !: qsr coupling frequency per days from atmosphere (used by top) 110 110 ! 111 111 !! !! now ! before !! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90
r12193 r12252 571 571 IF( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = nn_cats_cpl 572 572 573 #if defined key_si3 574 IF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN 575 IF( .NOT.srcv(jpr_ts_ice)%laction ) & 576 & CALL ctl_stop( 'sbc_cpl_init: srcv(jpr_ts_ice)%laction should be set to true when ln_cndflx=T' ) 577 ENDIF 578 #endif 573 579 ! ! ------------------------- ! 574 580 ! ! Wave breaking ! … … 860 866 ELSE IF( sn_snd_crt%clvgrd /= 'T' ) THEN 861 867 CALL ctl_stop( 'sn_snd_crt%clvgrd must be equal to T' ) 862 ssnd(jps_ocx1:jps_ivz1)%clgrid = 'T' ! all oce and ice components on the same unique grid863 868 ENDIF 864 869 ssnd(jps_ocx1:jps_ivz1)%laction = .TRUE. ! default: all are send … … 1038 1043 ENDIF 1039 1044 xcplmask(:,:,0) = 1. - SUM( xcplmask(:,:,1:nn_cplmodel), dim = 3 ) 1040 !1041 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' )1042 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) &1043 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )1044 IF( ln_dm2dc .AND. ln_cpl ) ncpl_qsr_freq = 86400 / ncpl_qsr_freq1045 1045 ! 1046 1046 END SUBROUTINE sbc_cpl_init … … 1109 1109 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1110 1110 !!---------------------------------------------------------------------- 1111 ! 1112 IF( kt == nit000 ) THEN 1113 ! cannot be done in the init phase when we use agrif as cpl_freq requires that oasis_enddef is done 1114 ncpl_qsr_freq = cpl_freq( 'O_QsrOce' ) + cpl_freq( 'O_QsrMix' ) + cpl_freq( 'I_QsrOce' ) + cpl_freq( 'I_QsrMix' ) 1115 IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 ) & 1116 & CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 1117 ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1118 ENDIF 1111 1119 ! 1112 1120 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1242 1250 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1243 1251 ! 1244 ! ! ================== !1245 ! ! ice skin temp. !1246 ! ! ================== !1247 #if defined key_si31248 ! needed by Met Office1249 IF( srcv(jpr_ts_ice)%laction ) THEN1250 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; tsfc_ice(:,:,:) = 0.01251 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; tsfc_ice(:,:,:) = -60.1252 ELSEWHERE ; tsfc_ice(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:)1253 END WHERE1254 ENDIF1255 #endif1256 1252 ! ! ========================= ! 1257 1253 ! ! Mean Sea Level Pressure ! (taum) … … 1633 1629 !! sprecip solid precipitation over the ocean 1634 1630 !!---------------------------------------------------------------------- 1635 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1]1636 ! !! ! optional arguments, used only in 'mixed oce-ice' case1637 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo1638 REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius]1639 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]1640 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m]1641 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m]1631 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1632 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling 1633 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1634 REAL(wp), INTENT(in) , DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1635 REAL(wp), INTENT(inout), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] => inout for Met-Office 1636 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1637 REAL(wp), INTENT(in) , DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1642 1638 ! 1643 1639 INTEGER :: ji, jj, jl ! dummy loop index … … 1646 1642 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1647 1643 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1648 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i1644 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 1649 1645 !!---------------------------------------------------------------------- 1650 1646 ! … … 1814 1810 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1815 1811 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1816 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1817 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1818 & + pist(:,:,1) * picefr(:,:) ) ) 1812 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1813 DO jl = 1, jpl 1814 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1815 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1816 & + pist(:,:,jl) * picefr(:,:) ) ) 1817 END DO 1818 ELSE 1819 DO jl = 1, jpl 1820 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1821 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1822 & + pist(:,:,jl) * picefr(:,:) ) ) 1823 END DO 1824 ENDIF 1819 1825 END SELECT 1820 1826 ! … … 1930 1936 END DO 1931 1937 ENDIF 1932 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1)1933 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)1934 1938 CASE( 'oce and ice' ) 1935 1939 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) … … 1951 1955 ! Create solar heat flux over ice using incoming solar heat flux and albedos 1952 1956 ! ( see OASIS3 user guide, 5th edition, p39 ) 1953 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1954 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1955 & + palbi (:,:,1) * picefr(:,:) ) ) 1957 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1958 DO jl = 1, jpl 1959 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:,jl) * ( 1.- palbi(:,:,jl) ) & 1960 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1961 & + palbi (:,:,jl) * picefr(:,:) ) ) 1962 END DO 1963 ELSE 1964 DO jl = 1, jpl 1965 zqsr_ice(:,:,jl) = frcv(jpr_qsrmix)%z3(:,:, 1) * ( 1.- palbi(:,:,jl) ) & 1966 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1967 & + palbi (:,:,jl) * picefr(:,:) ) ) 1968 END DO 1969 ENDIF 1956 1970 CASE( 'none' ) ! Not available as for now: needs additional coding 1957 1971 ! ! since fields received, here zqsr_tot, are not defined with none option … … 2013 2027 ! ! ========================= ! 2014 2028 CASE ('coupled') 2015 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2016 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2029 IF( ln_mixcpl ) THEN 2030 DO jl=1,jpl 2031 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2032 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2033 ENDDO 2034 ELSE 2035 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2036 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2037 ENDIF 2017 2038 END SELECT 2018 !2019 2039 ! ! ========================= ! 2020 2040 ! ! Transmitted Qsr ! [W/m2] … … 2023 2043 ! 2024 2044 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2025 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter(Grenfell Maykut 77)2045 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm (Grenfell Maykut 77) 2026 2046 ! 2027 qtr_ice_top(:,:,:) = ztri * qsr_ice(:,:,:) 2028 WHERE( phs(:,:,:) >= 0.0_wp ) qtr_ice_top(:,:,:) = 0._wp ! snow fully opaque 2029 WHERE( phi(:,:,:) <= 0.1_wp ) qtr_ice_top(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 2047 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2048 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2049 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2050 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2051 ELSEWHERE ! zero when hs>0 2052 zqtr_ice_top(:,:,:) = 0._wp 2053 END WHERE 2030 2054 ! 2031 2055 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! … … 2033 2057 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2034 2058 ! for now just assume zero (fully opaque ice) 2035 qtr_ice_top(:,:,:) = 0._wp 2059 zqtr_ice_top(:,:,:) = 0._wp 2060 ! 2061 ENDIF 2062 ! 2063 IF( ln_mixcpl ) THEN 2064 DO jl=1,jpl 2065 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2066 ENDDO 2067 ELSE 2068 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2069 ENDIF 2070 ! ! ================== ! 2071 ! ! ice skin temp. ! 2072 ! ! ================== ! 2073 ! needed by Met Office 2074 IF( srcv(jpr_ts_ice)%laction ) THEN 2075 WHERE ( frcv(jpr_ts_ice)%z3(:,:,:) > 0.0 ) ; ztsu(:,:,:) = 0. + rt0 2076 ELSEWHERE( frcv(jpr_ts_ice)%z3(:,:,:) < -60. ) ; ztsu(:,:,:) = -60. + rt0 2077 ELSEWHERE ; ztsu(:,:,:) = frcv(jpr_ts_ice)%z3(:,:,:) + rt0 2078 END WHERE 2079 ! 2080 IF( ln_mixcpl ) THEN 2081 DO jl=1,jpl 2082 pist(:,:,jl) = pist(:,:,jl) * xcplmask(:,:,0) + ztsu(:,:,jl) * zmsk(:,:) 2083 ENDDO 2084 ELSE 2085 pist(:,:,:) = ztsu(:,:,:) 2086 ENDIF 2036 2087 ! 2037 2088 ENDIF … … 2197 2248 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 2198 2249 END SELECT 2199 IF( ssnd(jps_fice)%laction )CALL cpl_snd( jps_fice, isec, ztmp3, info )2250 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2200 2251 ENDIF 2201 2252 … … 2257 2308 ! ! Ice melt ponds ! 2258 2309 ! ! ------------------------- ! 2259 ! needed by Met Office 2310 ! needed by Met Office: 1) fraction of ponded ice 2) local/actual pond depth 2260 2311 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2261 2312 SELECT CASE( sn_snd_mpnd%cldes) … … 2263 2314 SELECT CASE( sn_snd_mpnd%clcat ) 2264 2315 CASE( 'yes' ) 2265 ztmp3(:,:,1:jpl) = a_ip (:,:,1:jpl)2266 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl)2316 ztmp3(:,:,1:jpl) = a_ip_frac(:,:,1:jpl) 2317 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2267 2318 CASE( 'no' ) 2268 2319 ztmp3(:,:,:) = 0.0 2269 2320 ztmp4(:,:,:) = 0.0 2270 2321 DO jl=1,jpl 2271 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip (:,:,jpl)2272 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl)2322 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2323 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2273 2324 ENDDO 2274 2325 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcrnf.F90
r12193 r12252 366 366 IF( h_rnf(ji,jj) > 0._wp ) THEN 367 367 jk = 2 368 DO WHILE ( jk /=mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1368 DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 369 369 END DO 370 370 nk_rnf(ji,jj) = jk … … 423 423 IF( zrnfcl(ji,jj,1) > 0._wp ) THEN 424 424 jk = 2 425 DO WHILE ( jk /=mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1425 DO WHILE ( jk < mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 426 426 END DO 427 427 nk_rnf(ji,jj) = jk -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/nemogcm.F90
r12236 r12252 73 73 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 74 74 USE crsini ! initialise grid coarsening utility 75 USE diatmb ! Top,middle,bottom output76 75 USE dia25h ! 25h mean output 77 76 USE diadetide ! Weights computation for daily detiding of model diagnostics … … 497 496 CALL trd_init( Nnn ) ! Mixed-layer/Vorticity/Integral constraints trends 498 497 CALL dia_obs_init( Nnn ) ! Initialize observational data 499 CALL dia_tmb_init ! TMB outputs500 498 CALL dia_25h_init( Nbb ) ! 25h mean outputs 501 499 CALL dia_detide_init ! Weights computation for daily detiding of model diagnostics -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zmeso.F90
r12236 r12252 72 72 REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 73 73 REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 74 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing2, zfezoo2, zz2ligprod 74 75 CHARACTER (len=25) :: charout 75 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo276 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zz2ligprod77 76 !!--------------------------------------------------------------------- 78 77 ! 79 78 IF( ln_timing ) CALL timing_start('p4z_meso') 80 !81 zgrazing(:,:,:) = 0._wp82 zfezoo2 (:,:,:) = 0._wp83 !84 IF (ln_ligand) THEN85 ALLOCATE( zz2ligprod(jpi,jpj,jpk) )86 zz2ligprod(:,:,:) = 0._wp87 ENDIF88 79 ! 89 80 DO jk = 1, jpkm1 … … 163 154 164 155 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 165 zgrazing (ji,jj,jk) = zgraztotc156 zgrazing2(ji,jj,jk) = zgraztotc 166 157 167 158 ! Mesozooplankton efficiency … … 234 225 ! 235 226 IF( lk_iomput .AND. knt == nrdttrc ) THEN 236 ALLOCATE( zw3d(jpi,jpj,jpk) ) 237 IF( iom_use( "GRAZ2" ) ) THEN 238 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 239 CALL iom_put( "GRAZ2", zw3d ) 227 zgrazing2(:,:,jpk) = 0._wp 228 zfezoo2 (:,:,jpk) = 0._wp 229 CALL iom_put( "GRAZ2" , zgrazing2(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Total grazing of phyto by zooplankton 230 CALL iom_put( "PCAL" , prodcal (:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Calcite production 231 CALL iom_put( "FEZOO2", zfezoo2 (:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 232 IF( ln_ligand ) THEN 233 zz2ligprod(:,:,jpk) = 0._wp 234 CALL iom_put( "LPRODZ2", zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 240 235 ENDIF 241 IF( iom_use( "PCAL" ) ) THEN242 zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Calcite production243 CALL iom_put( "PCAL", zw3d )244 ENDIF245 IF( iom_use( "FEZOO2" ) ) THEN246 zw3d(:,:,:) = zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) !247 CALL iom_put( "FEZOO2", zw3d )248 ENDIF249 IF( iom_use( "LPRODZ2" ) .AND. ln_ligand ) THEN250 zw3d(:,:,:) = zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)251 CALL iom_put( "LPRODZ2" , zw3d )252 ENDIF253 DEALLOCATE( zw3d )254 236 ENDIF 255 !256 IF (ln_ligand) DEALLOCATE( zz2ligprod )257 237 ! 258 238 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zmicro.F90
r12236 r12252 70 70 REAL(wp) :: zgrazp, zgrazm, zgrazsd 71 71 REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 72 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo 73 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d, zzligprod 72 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod 74 73 CHARACTER (len=25) :: charout 75 74 !!--------------------------------------------------------------------- 76 75 ! 77 76 IF( ln_timing ) CALL timing_start('p4z_micro') 78 !79 IF (ln_ligand) THEN80 ALLOCATE( zzligprod(jpi,jpj,jpk) )81 zzligprod(:,:,:) = 0._wp82 ENDIF83 77 ! 84 78 DO jk = 1, jpkm1 … … 187 181 END DO 188 182 ! 189 IF( lk_iomput ) THEN 190 IF( knt == nrdttrc ) THEN 191 ALLOCATE( zw3d(jpi,jpj,jpk) ) 192 IF( iom_use( "GRAZ1" ) ) THEN 193 zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ! Total grazing of phyto by zooplankton 194 CALL iom_put( "GRAZ1", zw3d ) 195 ENDIF 196 IF( iom_use( "FEZOO" ) ) THEN 197 zw3d(:,:,:) = zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ! 198 CALL iom_put( "FEZOO", zw3d ) 199 ENDIF 200 IF( iom_use( "LPRODZ" ) .AND. ln_ligand ) THEN 201 zw3d(:,:,:) = zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) 202 CALL iom_put( "LPRODZ" , zw3d ) 203 ENDIF 204 DEALLOCATE( zw3d ) 183 IF( lk_iomput .AND. knt == nrdttrc ) THEN 184 zgrazing(:,:,jpk) = 0._wp 185 zfezoo (:,:,jpk) = 0._wp 186 CALL iom_put( "GRAZ1", zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) ! Total grazing of phyto by zooplankton 187 CALL iom_put( "FEZOO", zfezoo (:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 188 IF( ln_ligand ) THEN 189 zzligprod(:,:,jpk) = 0._wp 190 CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) ) 205 191 ENDIF 206 192 ENDIF 207 !208 IF (ln_ligand) DEALLOCATE( zzligprod )209 193 ! 210 194 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/trcini.F90
r12236 r12252 58 58 IF(lwp) WRITE(numout,*) '~~~~~~~~' 59 59 ! 60 CALL trc_ini_ctl ! control61 60 CALL trc_nam ! read passive tracers namelists 62 61 CALL top_alloc() ! allocate TOP arrays … … 84 83 ! 85 84 END SUBROUTINE trc_init 86 87 88 SUBROUTINE trc_ini_ctl89 !!----------------------------------------------------------------------90 !! *** ROUTINE trc_ini_ctl ***91 !! ** Purpose : Control + ocean volume92 !!----------------------------------------------------------------------93 INTEGER :: jk ! dummy loop indices94 !95 ! Define logical parameter ton control dirunal cycle in TOP96 l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )97 l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline98 IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &99 & 'Computation of a daily mean shortwave for some biogeochemical models ' )100 !101 END SUBROUTINE trc_ini_ctl102 85 103 86 -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/trcstp.F90
r12236 r12252 72 72 ll_trcstat = ( sn_cfctl%l_trcstat ) .AND. & 73 73 & ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) ) 74 75 IF( kt == nittrc000 ) CALL trc_stp_ctl ! control 74 76 IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer 75 77 ! … … 131 133 ! 132 134 END SUBROUTINE trc_stp 135 136 137 SUBROUTINE trc_stp_ctl 138 !!---------------------------------------------------------------------- 139 !! *** ROUTINE trc_stp_ctl *** 140 !! ** Purpose : Control + ocean volume 141 !!---------------------------------------------------------------------- 142 ! 143 ! Define logical parameter ton control dirunal cycle in TOP 144 l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 145 l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline 146 IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', & 147 & 'Computation of a daily mean shortwave for some biogeochemical models ' ) 148 ! 149 END SUBROUTINE trc_stp_ctl 150 133 151 134 152 SUBROUTINE trc_mean_qsr( kt )
Note: See TracChangeset
for help on using the changeset viewer.
