- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r8552 r9019 22 22 !! seaice_asm_inc : Apply the seaice increment 23 23 !!---------------------------------------------------------------------- 24 USE wrk_nemo ! Memory Allocation25 USE par_oce 26 USE dom_oce 27 USE domvvl 28 USE oce ! Dynamics and active tracers defined in memory29 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients30 USE eosbn2 ! Equation of state - in situ and potential density31 USE zpshde ! Partial step : Horizontal Derivative32 USE iom ! Library to read input files33 USE asmpar ! Parameters for the assmilation interface34 USE c1d ! 1D initialization35 USE in_out_manager ! I/O manager 36 USE lib_mpp ! MPP library37 # if defined key_lim238 USE ice_2 ! LIM239 #endif 40 USE sbc_oce ! Surface boundary condition variables.41 USE diaobs, ONLY: calc_date ! Compute the calendar date on a given step24 USE oce ! Dynamics and active tracers defined in memory 25 USE par_oce ! Ocean space and time domain variables 26 USE dom_oce ! Ocean space and time domain 27 USE domvvl ! domain: variable volume level 28 USE ldfdyn ! lateral diffusion: eddy viscosity coefficients 29 USE eosbn2 ! Equation of state - in situ and potential density 30 USE zpshde ! Partial step : Horizontal Derivative 31 USE asmpar ! Parameters for the assmilation interface 32 USE c1d ! 1D initialization 33 USE sbc_oce ! Surface boundary condition variables. 34 USE diaobs , ONLY : calc_date ! Compute the calendar date on a given step 35 #if defined key_lim3 36 USE ice , ONLY : hm_i, at_i, at_i_b 37 #endif 38 ! 39 USE in_out_manager ! I/O manager 40 USE iom ! Library to read input files 41 USE lib_mpp ! MPP library 42 42 43 43 IMPLICIT NONE … … 127 127 REAL(wp) :: zdate_inc ! Time axis in increments file 128 128 ! 129 REAL(wp), POINTER, DIMENSION(:,:) ::hdiv ! 2D workspace129 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zhdiv ! 2D workspace 130 130 !! 131 131 NAMELIST/nam_asminc/ ln_bkgwri, & … … 173 173 ENDIF 174 174 175 nitbkg_r = nitbkg + nit000 - 1 ! Background time referenced to nit000 176 nitdin_r = nitdin + nit000 - 1 ! Background time for DI referenced to nit000 177 nitiaustr_r = nitiaustr + nit000 - 1 ! Start of IAU interval referenced to nit000 178 nitiaufin_r = nitiaufin + nit000 - 1 ! End of IAU interval referenced to nit000 179 180 iiauper = nitiaufin_r - nitiaustr_r + 1 ! IAU interval length 181 icycper = nitend - nit000 + 1 ! Cycle interval length 182 183 ! Date of final time step 184 CALL calc_date( nitend, ditend_date ) 185 186 ! Background time for Jb referenced to ndate0 187 CALL calc_date( nitbkg_r, ditbkg_date ) 188 189 ! Background time for DI referenced to ndate0 190 CALL calc_date( nitdin_r, ditdin_date ) 191 192 ! IAU start time referenced to ndate0 193 CALL calc_date( nitiaustr_r, ditiaustr_date ) 194 195 ! IAU end time referenced to ndate0 196 CALL calc_date( nitiaufin_r, ditiaufin_date ) 175 nitbkg_r = nitbkg + nit000 - 1 ! Background time referenced to nit000 176 nitdin_r = nitdin + nit000 - 1 ! Background time for DI referenced to nit000 177 nitiaustr_r = nitiaustr + nit000 - 1 ! Start of IAU interval referenced to nit000 178 nitiaufin_r = nitiaufin + nit000 - 1 ! End of IAU interval referenced to nit000 179 180 iiauper = nitiaufin_r - nitiaustr_r + 1 ! IAU interval length 181 icycper = nitend - nit000 + 1 ! Cycle interval length 182 183 CALL calc_date( nitend , ditend_date ) ! Date of final time step 184 CALL calc_date( nitbkg_r , ditbkg_date ) ! Background time for Jb referenced to ndate0 185 CALL calc_date( nitdin_r , ditdin_date ) ! Background time for DI referenced to ndate0 186 CALL calc_date( nitiaustr_r, ditiaustr_date ) ! IAU start time referenced to ndate0 187 CALL calc_date( nitiaufin_r, ditiaufin_date ) ! IAU end time referenced to ndate0 197 188 198 189 IF(lwp) THEN … … 266 257 ALLOCATE( wgtiau( icycper ) ) 267 258 268 wgtiau(:) = 0. 0259 wgtiau(:) = 0._wp 269 260 270 261 IF ( niaufn == 0 ) THEN … … 339 330 ALLOCATE( ssh_bkginc(jpi,jpj) ) 340 331 ALLOCATE( seaice_bkginc(jpi,jpj)) 332 t_bkginc (:,:,:) = 0._wp 333 s_bkginc (:,:,:) = 0._wp 334 u_bkginc (:,:,:) = 0._wp 335 v_bkginc (:,:,:) = 0._wp 336 ssh_bkginc (:,:) = 0._wp 337 seaice_bkginc(:,:) = 0._wp 341 338 #if defined key_asminc 342 339 ALLOCATE( ssh_iau(jpi,jpj) ) 340 ssh_iau (:,:) = 0._wp 343 341 #endif 344 342 #if defined key_cice && defined key_asminc 345 ALLOCATE( ndaice_da(jpi,jpj) ) 346 #endif 347 t_bkginc(:,:,:) = 0.0 348 s_bkginc(:,:,:) = 0.0 349 u_bkginc(:,:,:) = 0.0 350 v_bkginc(:,:,:) = 0.0 351 ssh_bkginc(:,:) = 0.0 352 seaice_bkginc(:,:) = 0.0 353 #if defined key_asminc 354 ssh_iau(:,:) = 0.0 355 #endif 356 #if defined key_cice && defined key_asminc 357 ndaice_da(:,:) = 0.0 343 ALLOCATE( ndaice_da(jpi,jpj) ) 344 ndaice_da (:,:) = 0._wp 358 345 #endif 359 346 IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN … … 441 428 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 442 429 ! 443 CALL wrk_alloc( jpi,jpj, hdiv)430 ALLOCATE( zhdiv(jpi,jpj) ) 444 431 ! 445 432 DO jt = 1, nn_divdmp 446 433 ! 447 DO jk = 1, jpkm1 ! hdiv = e1e1 * div448 hdiv(:,:) = 0._wp434 DO jk = 1, jpkm1 ! zhdiv = e1e1 * div 435 zhdiv(:,:) = 0._wp 449 436 DO jj = 2, jpjm1 450 437 DO ji = fs_2, fs_jpim1 ! vector opt. 451 hdiv(ji,jj) = ( e2u(ji ,jj) * e3u_n(ji ,jj,jk) * u_bkginc(ji ,jj,jk) &452 & - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk) &453 & + e1v(ji,jj ) * e3v_n(ji,jj ,jk) * v_bkginc(ji,jj ,jk) &454 & - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk) ) / e3t_n(ji,jj,jk)438 zhdiv(ji,jj) = ( e2u(ji ,jj) * e3u_n(ji ,jj,jk) * u_bkginc(ji ,jj,jk) & 439 & - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk) & 440 & + e1v(ji,jj ) * e3v_n(ji,jj ,jk) * v_bkginc(ji,jj ,jk) & 441 & - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk) ) / e3t_n(ji,jj,jk) 455 442 END DO 456 443 END DO 457 CALL lbc_lnk( hdiv, 'T', 1. ) ! lateral boundary cond. (no sign change)444 CALL lbc_lnk( zhdiv, 'T', 1. ) ! lateral boundary cond. (no sign change) 458 445 ! 459 446 DO jj = 2, jpjm1 460 447 DO ji = fs_2, fs_jpim1 ! vector opt. 461 448 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) & 462 & + 0.2_wp * ( hdiv(ji+1,jj) -hdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk)449 & + 0.2_wp * ( zhdiv(ji+1,jj) - zhdiv(ji ,jj) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 463 450 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) & 464 & + 0.2_wp * ( hdiv(ji,jj+1) -hdiv(ji,jj ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk)451 & + 0.2_wp * ( zhdiv(ji,jj+1) - zhdiv(ji,jj ) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 465 452 END DO 466 453 END DO … … 469 456 END DO 470 457 ! 471 CALL wrk_dealloc( jpi,jpj,hdiv )458 DEALLOCATE( zhdiv ) 472 459 ! 473 460 ENDIF … … 815 802 INTEGER :: it 816 803 REAL(wp) :: zincwgt ! IAU weight for current time step 817 #if defined key_lim 2804 #if defined key_lim3 818 805 REAL(wp), DIMENSION(jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc ! LIM 819 806 REAL(wp) :: zhicifmin = 0.5_wp ! ice minimum depth in metres … … 837 824 ENDIF 838 825 ! 839 ! Sea-ice : LIM-3 case (to add) 840 ! 841 #if defined key_lim2 842 ! Sea-ice : LIM-2 case 843 zofrld (:,:) = frld(:,:) 844 zohicif(:,:) = hicif(:,:) 845 ! 846 frld = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 847 pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 848 fr_i(:,:) = 1.0_wp - frld(:,:) ! adjust ice fraction 849 ! 850 zseaicendg(:,:) = zofrld(:,:) - frld(:,:) ! find out actual sea ice nudge applied 826 ! Sea-ice : LIM-3 case 827 ! 828 #if defined key_lim3 829 zofrld (:,:) = 1._wp - at_i(:,:) 830 zohicif(:,:) = hm_i(:,:) 831 ! 832 at_i (:,:) = 1. - MIN( MAX( 1.-at_i (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 833 at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 834 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 835 ! 836 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 851 837 ! 852 838 ! Nudge sea ice depth to bring it up to a required minimum depth 853 WHERE( zseaicendg(:,:) > 0.0_wp .AND. h icif(:,:) < zhicifmin )854 zhicifinc(:,:) = (zhicifmin - h icif(:,:)) * zincwgt839 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 840 zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt 855 841 ELSEWHERE 856 842 zhicifinc(:,:) = 0.0_wp … … 858 844 ! 859 845 ! nudge ice depth 860 hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 861 phicif(:,:) = phicif(:,:) + zhicifinc(:,:) 846 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 862 847 ! 863 848 ! seaice salinity balancing (to add) … … 888 873 neuler = 0 ! Force Euler forward step 889 874 ! 890 ! Sea-ice : LIM-3 case (to add) 891 ! 892 #if defined key_lim2 893 ! Sea-ice : LIM-2 case. 894 zofrld(:,:)=frld(:,:) 895 zohicif(:,:)=hicif(:,:) 875 ! Sea-ice : LIM-3 case 876 ! 877 #if defined key_lim3 878 zofrld (:,:) = 1._wp - at_i(:,:) 879 zohicif(:,:) = hm_i(:,:) 896 880 ! 897 881 ! Initialize the now fields the background + increment 898 frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 899 pfrld(:,:) = frld(:,:) 900 fr_i (:,:) = 1.0_wp - frld(:,:) ! adjust ice fraction 901 zseaicendg(:,:) = zofrld(:,:) - frld(:,:) ! find out actual sea ice nudge applied 882 at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 883 at_i_b(:,:) = at_i(:,:) 884 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 885 ! 886 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 902 887 ! 903 888 ! Nudge sea ice depth to bring it up to a required minimum depth 904 WHERE( zseaicendg(:,:) > 0.0_wp .AND. h icif(:,:) < zhicifmin )905 zhicifinc(:,:) = (zhicifmin - h icif(:,:)) * zincwgt889 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 890 zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt 906 891 ELSEWHERE 907 zhicifinc(:,:) = 0. _wp892 zhicifinc(:,:) = 0.0_wp 908 893 END WHERE 909 894 ! 910 895 ! nudge ice depth 911 hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 912 phicif(:,:) = phicif(:,:) 896 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 913 897 ! 914 898 ! seaice salinity balancing (to add) … … 932 916 ENDIF 933 917 934 !#if defined defined key_lim 2|| defined key_cice918 !#if defined defined key_lim3 || defined key_cice 935 919 ! 936 920 ! IF (ln_seaicebal ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
