- Timestamp:
- 2016-04-20T11:33:10+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 8 edited
-
fldread.F90 (modified) (4 diffs)
-
sbcblk_core.F90 (modified) (1 diff)
-
sbccpl.F90 (modified) (4 diffs)
-
sbcfwb.F90 (modified) (2 diffs)
-
sbcisf.F90 (modified) (10 diffs)
-
sbcmod.F90 (modified) (1 diff)
-
sbcrnf.F90 (modified) (1 diff)
-
updtide.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r6486 r6487 32 32 PUBLIC fld_map ! routine called by tides_init 33 33 PUBLIC fld_read, fld_fill ! called by sbc... modules 34 PUBLIC fld_clopn 34 35 35 36 TYPE, PUBLIC :: FLD_N !: Namelist field informations … … 815 816 imonth = kmonth 816 817 iday = kday 818 IF ( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the week 819 isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 ) 820 llprevmth = isec_week > nsec_month ! longer time since beginning of the week than the month 821 llprevyr = llprevmth .AND. nmonth == 1 822 iyear = nyear - COUNT((/llprevyr /)) 823 imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /)) 824 iday = nday + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday) 825 ENDIF 817 826 ELSE ! use current day values 818 827 IF ( sdjf%cltype(1:4) == 'week' ) THEN ! find the day of the beginning of the week … … 1281 1290 CHARACTER(LEN=*) , INTENT(in ) :: lsmfile ! land sea mask file name 1282 1291 !! 1283 REAL(wp),DIMENSION(:,:,:),ALLOCATABLE :: ztmp_fly_dta ,zfieldo! temporary array of values on input grid1292 REAL(wp),DIMENSION(:,:,:),ALLOCATABLE :: ztmp_fly_dta ! temporary array of values on input grid 1284 1293 INTEGER, DIMENSION(3) :: rec1,recn ! temporary arrays for start and length 1285 1294 INTEGER, DIMENSION(3) :: rec1_lsm,recn_lsm ! temporary arrays for start and length in case of seaoverland … … 1347 1356 1348 1357 1349 itmpi= SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1)1350 itmpj= SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2)1358 itmpi=jpi2_lsm-jpi1_lsm+1 1359 itmpj=jpj2_lsm-jpj1_lsm+1 1351 1360 itmpz=kk 1352 1361 ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz)) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6486 r6487 403 403 CALL iom_put( "qsr_oce" , qsr ) ! output downward solar heat over the ocean 404 404 CALL iom_put( "qt_oce" , qns+qsr ) ! output total downward heat over the ocean 405 tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! output total precipitation [kg/m2/s] 406 sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac ! output solid precipitation [kg/m2/s] 407 CALL iom_put( 'snowpre', sprecip * 86400. ) ! Snow 408 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation 405 409 ENDIF 406 410 ! -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6486 r6487 1029 1029 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1030 1030 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1031 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1031 1032 CALL iom_put( 'ssu_m', ssu_m ) 1032 1033 ENDIF … … 1034 1035 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1035 1036 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1037 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1036 1038 CALL iom_put( 'ssv_m', ssv_m ) 1037 1039 ENDIF … … 1743 1745 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1744 1746 ELSEWHERE 1745 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)1747 ztmp3(:,:,1) = rt0 1746 1748 END WHERE 1747 1749 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) … … 1774 1776 ! ! ------------------------- ! 1775 1777 IF( ssnd(jps_albice)%laction ) THEN ! ice 1776 SELECT CASE( sn_snd_alb%cldes ) 1777 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1778 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1779 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1778 SELECT CASE( sn_snd_alb%cldes ) 1779 CASE( 'ice' ) 1780 SELECT CASE( sn_snd_alb%clcat ) 1781 CASE( 'yes' ) 1782 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1783 CASE( 'no' ) 1784 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1785 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 1786 ELSEWHERE 1787 ztmp1(:,:) = albedo_oce_mix(:,:) 1788 END WHERE 1789 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 1790 END SELECT 1791 CASE( 'weighted ice' ) ; 1792 SELECT CASE( sn_snd_alb%clcat ) 1793 CASE( 'yes' ) 1794 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1795 CASE( 'no' ) 1796 WHERE( fr_i (:,:) > 0. ) 1797 ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 1798 ELSEWHERE 1799 ztmp1(:,:) = 0. 1800 END WHERE 1801 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 1802 END SELECT 1803 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1780 1804 END SELECT 1781 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1782 ENDIF 1805 1806 SELECT CASE( sn_snd_alb%clcat ) 1807 CASE( 'yes' ) 1808 CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode 1809 CASE( 'no' ) 1810 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1811 END SELECT 1812 ENDIF 1813 1783 1814 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1784 1815 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r6486 r6487 108 108 ! 109 109 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 110 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf * fwfisf(:,:) -snwice_fmass(:,:) ) ) / area ! sum over the global domain110 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area ! sum over the global domain 111 111 zcoef = z_fwf * rcp 112 112 emp(:,:) = emp(:,:) - z_fwf * tmask(:,:,1) … … 162 162 zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 163 163 ! ! fwf global mean (excluding ocean to ice/snow exchanges) 164 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + rdivisf *fwfisf(:,:) - snwice_fmass(:,:) ) ) / area164 z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 165 165 ! 166 166 IF( z_fwf < 0._wp ) THEN ! spread out over >0 erp area to increase evaporation -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r6486 r6487 53 53 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: risfLeff !:effective length (Leff) BG03 nn_isf==2 54 54 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 55 #if defined key_agrif56 ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base58 !: (first wet level and last level include in the tbl)59 #else60 55 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base 61 #endif62 56 63 57 … … 92 86 REAL(wp) :: rmin 93 87 REAL(wp) :: zhk 94 CHARACTER(len=256) :: cfisf, cvarzisf, cvarhisf ! name for isf file 88 REAL(wp) :: zt_frz, zpress 89 CHARACTER(len=256) :: cfisf , cvarzisf, cvarhisf ! name for isf file 95 90 CHARACTER(LEN=256) :: cnameis ! name of iceshelf file 96 91 CHARACTER (LEN=32) :: cvarLeff ! variable name for efficient Length scale … … 176 171 DO jj = 1, jpj 177 172 jk = 2 178 DO WHILE ( jk .LE. mbkt(ji,jj) .AND. fsdepw(ji,jj,jk) < rzisf_tbl(ji,jj) ) ; jk = jk + 1 ; END DO173 DO WHILE ( jk .LE. mbkt(ji,jj) .AND. gdepw_0(ji,jj,jk) < rzisf_tbl(ji,jj) ) ; jk = jk + 1 ; END DO 179 174 misfkt(ji,jj) = jk-1 180 175 END DO … … 194 189 END IF 195 190 191 ! save initial top boundary layer thickness 196 192 rhisf_tbl_0(:,:) = rhisf_tbl(:,:) 193 194 END IF 195 196 ! ! ---------------------------------------- ! 197 IF( kt /= nit000 ) THEN ! Swap of forcing fields ! 198 ! ! ---------------------------------------- ! 199 fwfisf_b (:,: ) = fwfisf (:,: ) ! Swap the ocean forcing fields except at nit000 200 risf_tsc_b(:,:,:) = risf_tsc(:,:,:) ! where before fields are set at the end of the routine 201 ! 202 ENDIF 203 204 IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 197 205 198 206 ! compute bottom level of isf tbl and thickness of tbl below the ice shelf … … 205 213 206 214 ! determine the deepest level influenced by the boundary layer 207 ! test on tmask useless ?????208 215 DO jk = ikt, mbkt(ji,jj) 209 216 IF ( (SUM(fse3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk … … 217 224 END DO 218 225 END DO 219 220 END IF221 222 ! ! ---------------------------------------- !223 IF( kt /= nit000 ) THEN ! Swap of forcing fields !224 ! ! ---------------------------------------- !225 fwfisf_b (:,: ) = fwfisf (:,: ) ! Swap the ocean forcing fields except at nit000226 risf_tsc_b(:,:,:) = risf_tsc(:,:,:) ! where before fields are set at the end of the routine227 !228 ENDIF229 230 IF( MOD( kt-1, nn_fsbc) == 0 ) THEN231 232 226 233 227 ! compute salf and heat flux … … 270 264 END IF 271 265 ! compute tsc due to isf 272 ! WARNING water add at temp = 0C, correction term is added in trasbc, maybe better here but need a 3D variable). 273 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp ! 266 ! WARNING water add at temp = 0C, correction term is added, maybe better here but need a 3D variable). 267 ! zpress = grav*rau0*fsdept(ji,jj,jk)*1.e-04 268 zt_frz = -1.9 !eos_fzp( tsn(ji,jj,jk,jp_sal), zpress ) 269 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - rdivisf * fwfisf(:,:) * zt_frz * r1_rau0 ! 274 270 275 271 ! salt effect already take into account in vertical advection 276 272 risf_tsc(:,:,jp_sal) = (1.0_wp-rdivisf) * fwfisf(:,:) * stbl(:,:) * r1_rau0 277 273 274 ! output 275 IF( iom_use('qisf' ) ) CALL iom_put('qisf' , qisf) 276 IF( iom_use('fwfisf') ) CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce ) 277 278 ! if apply only on the trend and not as a volume flux (rdivisf = 0), fwfisf have to be set to 0 now 279 fwfisf(:,:) = rdivisf * fwfisf(:,:) 280 278 281 ! lbclnk 279 282 CALL lbc_lnk(risf_tsc(:,:,jp_tem),'T',1.) … … 295 298 ENDIF 296 299 ! 297 ! output298 CALL iom_put('qisf' , qisf)299 IF( iom_use('fwfisf') ) CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )300 300 END IF 301 301 … … 472 472 473 473 nit = nit + 1 474 IF (nit .GE. 100) THEN 475 !WRITE(numout,*) "sbcisf : too many iteration ... ", zhtflx, zhtflx_b,zgammat, rn_gammat0, rn_tfri2, nn_gammablk, ji,jj 476 !WRITE(numout,*) "sbcisf : too many iteration ... ", (zhtflx - zhtflx_b)/zhtflx 477 CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 478 END IF 474 IF (nit .GE. 100) CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 475 479 476 ! save gammat and compute zhtflx_b 480 477 zgammat2d(ji,jj)=zgammat … … 794 791 ! test on tmask useless ????? 795 792 DO jk = ikt, mbkt(ji,jj) 796 !IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk793 IF ( (SUM(fse3t(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 797 794 END DO 798 795 rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(fse3t(ji,jj,ikt:ikb))) ! limit the tbl to water thickness. -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6486 r6487 179 179 180 180 ! ! Checks: 181 IF( nn_isf .EQ. 0 ) THEN ! no specific treatment in vicinity ofice shelf181 IF( nn_isf .EQ. 0 ) THEN ! variable initialisation if no ice shelf 182 182 IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 183 fwfisf (:,:) = 0.0_wp 184 fwfisf_b(:,:) = 0.0_wp 183 fwfisf (:,:) = 0.0_wp ; fwfisf_b (:,:) = 0.0_wp 184 risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp 185 rdivisf = 0.0_wp 185 186 END IF 186 187 IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa ) fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r6486 r6487 126 126 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 127 127 ! 128 ! Runoff reduction only associated to the ORCA2_LIM configuration129 ! when reading the NetCDF file runoff_1m_nomask.nc130 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl ) THEN131 WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )132 sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)133 END WHERE134 ENDIF135 !136 128 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 137 129 ! -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
r6486 r6487 31 31 CONTAINS 32 32 33 SUBROUTINE upd_tide( kt, kit, kbaro, koffset )33 SUBROUTINE upd_tide( kt, kit, time_offset ) 34 34 !!---------------------------------------------------------------------- 35 35 !! *** ROUTINE upd_tide *** … … 42 42 !!---------------------------------------------------------------------- 43 43 INTEGER, INTENT(in) :: kt ! ocean time-step index 44 INTEGER, INTENT(in), OPTIONAL :: kit ! external mode sub-time-step index (lk_dynspg_ts=T only)45 INTEGER, INTENT(in), OPTIONAL :: kbaro ! number of sub-time-step (lk_dynspg_ts=T only)46 INTEGER, INTENT(in), OPTIONAL :: koffset ! time offset in number47 ! of sub-time-steps (lk_dynspg_ts=T only)44 INTEGER, INTENT(in), OPTIONAL :: kit ! external mode sub-time-step index (lk_dynspg_ts=T) 45 INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in number 46 ! of internal steps (lk_dynspg_ts=F) 47 ! of external steps (lk_dynspg_ts=T) 48 48 ! 49 49 INTEGER :: joffset ! local integer … … 57 57 ! 58 58 joffset = 0 59 IF( PRESENT( koffset ) ) joffset = koffset59 IF( PRESENT( time_offset ) ) joffset = time_offset 60 60 ! 61 IF( PRESENT( kit ) .AND. PRESENT( kbaro )) THEN62 zt = zt + ( kit + 0.5_wp * ( joffset - 1 ) ) * rdt / REAL( kbaro, wp )61 IF( PRESENT( kit ) ) THEN 62 zt = zt + ( kit + joffset - 1 ) * rdt / REAL( nn_baro, wp ) 63 63 ELSE 64 64 zt = zt + joffset * rdt … … 74 74 IF( ln_tide_ramp ) THEN ! linear increase if asked 75 75 zt = ( kt - nit000 ) * rdt 76 IF( PRESENT( kit ) .AND. PRESENT( kbaro ) ) zt = zt + kit * rdt / REAL( kbaro, wp )76 IF( PRESENT( kit ) ) zt = zt + ( kit + joffset -1) * rdt / REAL( nn_baro, wp ) 77 77 zramp = MIN( MAX( zt / (rdttideramp*rday) , 0._wp ) , 1._wp ) 78 78 pot_astro(:,:) = zramp * pot_astro(:,:) … … 86 86 !!---------------------------------------------------------------------- 87 87 CONTAINS 88 SUBROUTINE upd_tide( kt, kit, kbaro, koffset )! Empty routine88 SUBROUTINE upd_tide( kt, kit, time_offset ) ! Empty routine 89 89 INTEGER, INTENT(in) :: kt ! integer arg, dummy routine 90 90 INTEGER, INTENT(in), OPTIONAL :: kit ! optional arg, dummy routine 91 INTEGER, INTENT(in), OPTIONAL :: kbaro ! optional arg, dummy routine 92 INTEGER, INTENT(in), OPTIONAL :: koffset ! optional arg, dummy routine 91 INTEGER, INTENT(in), OPTIONAL :: time_offset ! optional arg, dummy routine 93 92 WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt 94 93 END SUBROUTINE upd_tide
Note: See TracChangeset
for help on using the changeset viewer.
