New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15603 for branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step.F90 – NEMO

Ignore:
Timestamp:
2021-12-16T10:39:55+01:00 (2 years ago)
Author:
mattmartin
Message:

Updated NEMO branch for coupled NWP at GO6 to include stochastic model perturbations.
For more info see ticket: https://code.metoffice.gov.uk/trac/nwpscience/ticket/1125.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/step.F90

    r14987 r15603  
    110110      IF( lk_tide    )   CALL sbc_tide( kstp ) 
    111111      IF( lk_bdy     )  THEN 
    112          IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib  
     112         IF( ln_apr_dyn) CALL sbc_apr( kstp )   ! bdy_dta needs ssh_ib 
    113113                         CALL bdy_dta ( kstp, time_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    114114      ENDIF 
     
    119119      END DO 
    120120 
     121      IF( ln_stopack )   CALL stopack_pert( kstp ) 
    121122                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    122123                                                      ! clem: moved here for bdy ice purpose 
     124 
    123125      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    124126      ! Update stochastic parameters and random T/S fluctuations 
    125127      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    126        IF( ln_sto_eos ) CALL sto_par( kstp )          ! Stochastic parameters 
    127        IF( ln_sto_eos ) CALL sto_pts( tsn  )          ! Random T/S fluctuations 
     128 
     129      IF( ln_sto_eos )                 CALL sto_par( kstp )   ! Stochastic parameters 
     130      IF( ln_sto_eos )                 CALL sto_pts( tsn  )   ! Random T/S fluctuations 
     131      IF( ln_stopack .AND. ln_skeb  )  CALL skeb_comp( kstp ) ! Stochastic Energy Backscatter 
    128132 
    129133      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    149153      ENDIF 
    150154      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths 
    151          DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
     155#if defined key_traldf_c2d || key_traldf_c3d 
     156         IF ( ln_stopack .AND. ( nn_spp_arnf > 0 ) ) THEN 
     157              rn_avt_rnf0 = rn_avt_rnf 
     158              CALL spp_gen( kstp, rn_avt_rnf0,nn_spp_arnf,rn_arnf_sd,jk_spp_arnf ) 
     159         ENDIF 
     160#else 
     161         IF ( ln_stopack .AND. ( nn_spp_arnf > 0 ) ) & 
     162            & CALL ctl_stop( 'stp: parameter perturbation will only work with '// & 
     163                             'key_traldf_c2d or key_traldf_c3d') 
     164#endif 
     165         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf0(:,:) * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
    152166      ENDIF 
    153167      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
     
    163177      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
    164178      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' ) 
     179      IF( lrst_oce .AND. ln_stopack)   CALL stopack_rst( kstp, 'WRITE' ) 
    165180      ! 
    166181      !  LATERAL  PHYSICS 
     
    195210      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    196211                         CALL ssh_nxt       ( kstp )  ! after ssh (includes call to div_cur) 
    197       IF( lk_vvl     )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors  
    198                          CALL wzv           ( kstp )  ! now cross-level velocity  
    199  
    200       IF( lk_dynspg_ts ) THEN  
     212      IF( lk_vvl     )   CALL dom_vvl_sf_nxt( kstp )  ! after vertical scale factors 
     213                         CALL wzv           ( kstp )  ! now cross-level velocity 
     214 
     215      IF( lk_dynspg_ts ) THEN 
    201216          ! In case the time splitting case, update almost all momentum trends here: 
    202217          ! Note that the computation of vertical velocity above, hence "after" sea level 
    203218          ! is necessary to compute momentum advection for the rhs of barotropic loop: 
     219            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
    204220                            CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
    205221            IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
     
    214230                                  va(:,:,:) = 0.e0 
    215231          IF(  lk_asminc .AND. ln_asmiau .AND. & 
    216              & ln_dyninc       )  CALL dyn_asm_inc  ( kstp )   ! apply dynamics assimilation increment 
    217           IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! subtract Neptune velocities (simplified) 
    218           IF( lk_bdy           )  CALL bdy_dyn3d_dmp( kstp )   ! bdy damping trends 
    219                                   CALL dyn_adv      ( kstp )   ! advection (vector or flux form) 
    220                                   CALL dyn_vor      ( kstp )   ! vorticity term including Coriolis 
    221                                   CALL dyn_ldf      ( kstp )   ! lateral mixing 
    222           IF( ln_neptsimp )       CALL dyn_nept_cor ( kstp )   ! add Neptune velocities (simplified) 
     232             & ln_dyninc       )  CALL dyn_asm_inc   ( kstp )   ! apply dynamics assimilation increment 
     233          IF( ln_stopack .AND. ln_sppt_dyn ) & 
     234             &                    CALL dyn_sppt_apply( kstp, 0 ) 
     235          IF( ln_neptsimp )       CALL dyn_nept_cor  ( kstp )   ! subtract Neptune velocities (simplified) 
     236          IF( lk_bdy           )  CALL bdy_dyn3d_dmp ( kstp )   ! bdy damping trends 
     237                                  CALL dyn_adv       ( kstp )   ! advection (vector or flux form) 
     238                                  CALL dyn_vor       ( kstp )   ! vorticity term including Coriolis 
     239                                  CALL dyn_ldf       ( kstp )   ! lateral mixing 
     240          IF( ln_neptsimp )       CALL dyn_nept_cor  ( kstp )   ! add Neptune velocities (simplified) 
    223241#if defined key_agrif 
    224242          IF(.NOT. Agrif_Root())  CALL Agrif_Sponge_dyn        ! momentum sponge 
     
    232250                                  CALL div_cur( kstp )         ! Horizontal divergence & Relative vorticity (2nd call in time-split case) 
    233251          IF( lk_vvl     )        CALL dom_vvl_sf_nxt( kstp, kcall=2 )  ! after vertical scale factors (update depth average component) 
    234                                   CALL wzv           ( kstp )  ! now cross-level velocity  
     252                                  CALL wzv           ( kstp )  ! now cross-level velocity 
    235253      ENDIF 
    236254 
     
    262280                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero 
    263281 
    264       IF(  lk_asminc .AND. ln_asmiau .AND. & 
    265          & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
     282      IF( ln_stopack .AND. ln_sppt_tra ) & 
     283         &                   CALL tra_sppt_apply ( kstp, 0 ) 
     284      IF( lk_asminc .AND. ln_asmiau .AND. & 
     285        & ln_trainc      )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
    266286                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    267287      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
     
    280300      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    281301#endif 
     302      IF( ln_stopack .AND. ln_sppt_tra ) & 
     303         &                   CALL tra_sppt_apply ( kstp, 1 ) 
    282304                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields 
    283305 
     
    285307         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    286308                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     309         IF( ln_stopack .AND. ln_sppt_tra ) & 
     310            &                CALL tra_sppt_apply ( kstp, 2 ) 
    287311                             CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation 
    288312            IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
     
    300324               &             CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
    301325               &                                           rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
    302          IF( ln_zps .AND.       ln_isfcav)                                   &  
     326         IF( ln_zps .AND.       ln_isfcav)                                   & 
    303327               &             CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
    304328               &                                           rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
     
    308332                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    309333         IF( ln_bias )       CALL dyn_bias( kstp ) 
     334         IF( ln_stopack .AND. ln_sppt_tra )   THEN 
     335                                CALL tra_sppt_apply ( kstp, 2 ) 
     336                                CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation 
     337                                IF( ln_zps .AND. .NOT. ln_isfcav)                & 
     338                                & CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
     339                                &                   rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
     340                                IF( ln_zps .AND.       ln_isfcav)                                   & 
     341                                & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
     342                                &                   rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
     343                                &                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
     344         ENDIF 
    310345      ENDIF 
    311346 
     
    318353                               ua(:,:,:) = ua_sv(:,:,:) 
    319354                               va(:,:,:) = va_sv(:,:,:) 
    320                                                              ! Revert now divergence and rotational to previously computed ones  
     355                                                             ! Revert now divergence and rotational to previously computed ones 
    321356                                                             !(needed because of the time swap in div_cur, at the beginning of each time step) 
    322357                               hdivn(:,:,:) = hdivb(:,:,:) 
    323                                rotn(:,:,:)  = rotb(:,:,:)  
     358                               rotn(:,:,:)  = rotb(:,:,:) 
    324359 
    325360                               CALL dyn_bfr( kstp )         ! bottom friction 
     361            IF( ln_stopack .AND. ln_sppt_dyn ) & 
     362               &               CALL dyn_sppt_apply ( kstp, 1 ) 
    326363                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    327364      ELSE 
     
    331368        IF(  lk_asminc .AND. ln_asmiau .AND. & 
    332369           & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
     370        IF( ln_stopack .AND. ln_sppt_dyn ) & 
     371           &                   CALL dyn_sppt_apply ( kstp, 0 ) 
    333372        IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields 
    334373        IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified) 
     
    343382                               CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure 
    344383                               CALL dyn_bfr( kstp )         ! bottom friction 
     384            IF( ln_stopack .AND. ln_sppt_dyn ) & 
     385               &               CALL dyn_sppt_apply ( kstp, 1 ) 
    345386                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    346387                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
    347388      ENDIF 
    348389                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step 
     390            IF( ln_stopack .AND. ln_sppt_dyn ) & 
     391               &               CALL dyn_sppt_apply ( kstp, 2 ) 
     392            IF( ln_stopack .AND. ln_skeb ) & 
     393               &               CALL skeb_apply ( kstp ) 
    349394 
    350395                               CALL ssh_swp( kstp )         ! swap of sea surface height 
     
    352397      ! 
    353398 
    354       ! Moved bias _wrt to before rst_write as used restart parameters for nn_stocklist option that are changed by rst_wrt    
     399      ! Moved bias write to before rst_write 
    355400      IF( lrst_bias )          CALL bias_wrt     ( kstp ) 
    356  
     401       
    357402      IF( lrst_oce         )   CALL rst_write( kstp )       ! write output ocean restart file 
    358403      IF( ln_sto_eos       )   CALL sto_rst_write( kstp )   ! write restart file for stochastic parameters 
     
    361406      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    362407      ! AGRIF 
    363       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    364                                CALL Agrif_Integrate_ChildGrids( stp )   
     408      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     409                               CALL Agrif_Integrate_ChildGrids( stp ) 
    365410 
    366411      IF ( Agrif_NbStepint().EQ.0 ) THEN 
     
    393438      ! 
    394439#if defined key_iomput 
    395       IF( kstp == nitend .OR. indic < 0 ) THEN  
     440      IF( kstp == nitend .OR. indic < 0 ) THEN 
    396441                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
    397          IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !  
     442         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 
    398443      ENDIF 
    399444#endif 
    400445      ! 
    401446      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset 
    402       !      
     447      ! 
    403448      ! 
    404449   END SUBROUTINE stp 
Note: See TracChangeset for help on using the changeset viewer.