Changeset 11442


Ignore:
Timestamp:
2019-08-16T12:32:43+02:00 (14 months ago)
Author:
mattmartin
Message:

Introduction of stochastic physics in NEMO, based on Andrea Storto's code.
For details, see ticket https://code.metoffice.gov.uk/trac/utils/ticket/251.

Location:
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM
Files:
19 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/CONFIG/SHARED/field_def.xml

    r10302 r11442  
    125125         <field id="Age"        long_name="Sea Water Age Since Surface contact" standard_name="sea_water_age_since_surface_contact"  unit="yr" grid_ref="grid_T_3D"   /> 
    126126         <field id="Age_e3t"    long_name="Age * e3t"                                 unit="yr * m"  > Age * e3t </field > 
     127 
     128         <!-- variables available with ln_stopack set to .true. -->          
     129         <field id="sppt_ran" long_name="Random field for SPPT" standard_name="sppt_random_field" unit="0-1"     /> 
     130         <field id="skeb_ran" long_name="Random field for SKEB" standard_name="skeb_random_field" unit="0-1"     /> 
     131         <field id="spp_ran" long_name="Random field for SPP" standard_name="spp_random_field" unit="0-1"     /> 
     132         <field id="sppt_ar1" long_name="Perturbation field for SPPT" standard_name="sppt_perturb_field" unit="0-1" grid_ref="grid_T_3D"/> 
     133         <field id="spp_ar1" long_name="Perturbation field for SPP" standard_name="spp_perturb_field" unit="0-1" /> 
     134         <field id="skeb_ar1" long_name="Perturbation field for SKEB" standard_name="skeb_perturb_field" unit="0-1" /> 
     135 
     136         <!-- The following ones only when ln_stopack_diags is TRUE --> 
     137 
     138         <field id="spp_par01" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     139         <field id="spp_par02" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     140         <field id="spp_par03" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     141         <field id="spp_par04" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     142         <field id="spp_par05" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     143         <field id="spp_par06" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     144         <field id="spp_par07" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     145         <field id="spp_par08" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     146         <field id="spp_par09" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     147         <field id="spp_par10" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     148         <field id="spp_par11" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     149         <field id="spp_par12" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     150         <field id="spp_par13" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     151         <field id="spp_par14" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     152         <field id="spp_par15" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     153         <field id="spp_par16" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     154         <field id="spp_par17" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     155         <field id="spp_par18" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     156         <field id="spp_par19" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     157         <field id="spp_par20" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     158         <field id="spp_par21" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     159         <field id="spp_par22" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     160         <field id="spp_par23" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     161         <field id="spp_par24" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     162         <field id="spp_par25" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     163         <field id="spp_par26" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     164         <field id="spp_par27" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     165         <field id="spp_par28" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     166         <field id="spp_par29" long_name="Sample parameter SPP" standard_name="spp_pert_paramter" unit="0-1"     /> 
     167 
     168         <field id="ustar_skeb" long_name="Sea Water X Velocity Perturbation" standard_name="sea_water_x_velocity" unit="m/s" grid_ref="grid_U_3D" /> 
     169         <field id="vstar_skeb" long_name="Sea Water Y Velocity Perturbation" standard_name="sea_water_y_velocity" unit="m/s" grid_ref="grid_V_3D" /> 
     170 
    127171      </field_group> 
    128172 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r6486 r11442  
    3030   USE wrk_nemo        ! Memory Allocation 
    3131   USE timing          ! Timing 
     32   USE stopack 
    3233 
    3334   IMPLICIT NONE 
     
    3839 
    3940   INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals) 
     41 
     42#if defined key_dynldf_c3d 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahm10, ahm20, ahm30, ahm40 
     44#endif 
     45#if defined key_dynldf_c2d 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: ahm10, ahm20, ahm30, ahm40 
     47#endif 
    4048 
    4149   !! * Substitutions 
     
    6775         ztrdv(:,:,:) = va(:,:,:)  
    6876      ENDIF 
     77 
     78#if defined key_dynldf_c3d 
     79         IF( kt == nit000 .AND. ln_stopack .AND. & 
     80            & ( (nn_spp_ahm1 + nn_spp_ahm2) > 0 ) ) THEN 
     81             ALLOCATE ( ahm10(jpi,jpj,jpk), ahm20(jpi,jpj,jpk) ) 
     82             ALLOCATE ( ahm30(jpi,jpj,jpk), ahm40(jpi,jpj,jpk) ) 
     83             ahm10 = ahm1 
     84             ahm20 = ahm2 
     85             ahm30 = ahm3 
     86             ahm40 = ahm4 
     87         ENDIF 
     88#endif 
     89#if defined key_dynldf_c2d 
     90         IF( kt == nit000 .AND. ln_stopack .AND. & 
     91            & ( (nn_spp_ahm1 + nn_spp_ahm2) > 0 ) ) THEN 
     92             ALLOCATE ( ahm10(jpi,jpj), ahm20(jpi,jpj) ) 
     93             ALLOCATE ( ahm30(jpi,jpj), ahm40(jpi,jpj) ) 
     94             ahm10 = ahm1 
     95             ahm20 = ahm2 
     96             ahm30 = ahm3 
     97             ahm40 = ahm4 
     98         ENDIF 
     99#endif 
     100 
     101#if defined key_traldf_c3d || defined key_traldf_c2d 
     102         IF( ln_stopack ) THEN 
     103            IF( nn_spp_ahm1 > 0 ) THEN 
     104               IF( ln_dynldf_lap ) THEN 
     105                  ahm1 = ahm10 
     106                  CALL spp_ahm(kt, ahm1, nn_spp_ahm1, rn_ahm1_sd, jk_spp_ahm1) 
     107               ENDIF 
     108               IF( ln_dynldf_bilap ) THEN 
     109                  ahm3 = ahm30 
     110                  CALL spp_ahm(kt, ahm3, nn_spp_ahm1, rn_ahm1_sd, jk_spp_ahm3) 
     111               ENDIF 
     112            ENDIF 
     113            IF( nn_spp_ahm2 > 0 ) THEN 
     114               IF( ln_dynldf_lap ) THEN 
     115               ahm2 = ahm20 
     116               CALL spp_ahm(kt, ahm2, nn_spp_ahm2, rn_ahm2_sd, jk_spp_ahm2) 
     117               ENDIF 
     118               IF( ln_dynldf_bilap ) THEN 
     119                  ahm4 = ahm40 
     120                  CALL spp_ahm(kt, ahm4, nn_spp_ahm2, rn_ahm2_sd, jk_spp_ahm4) 
     121               ENDIF 
     122            ENDIF 
     123         ENDIF 
     124#endif 
    69125 
    70126      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r6498 r11442  
    2222   USE wrk_nemo       ! work arrays 
    2323   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     24   USE stopack 
    2425 
    2526   IMPLICIT NONE 
     
    154155               END DO 
    155156            END DO 
     157             
     158            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 
     159               & CALL spp_gen( 1, pa_ice_cs(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl ) 
     160                         
    156161         END DO 
    157162 
     
    209214              END DO 
    210215            END DO 
     216             
     217            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 
     218               & CALL spp_gen( 1, pa_ice_os(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl ) 
     219             
    211220         END DO 
    212221         ! Effect of the clouds (2d order polynomial) 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r9288 r11442  
    5151   USE par_ice_2 
    5252#endif 
     53   USE stopack 
    5354 
    5455   IMPLICIT NONE 
     
    8990   REAL(wp) ::   rn_efac     ! multiplication factor for evaporation (clem) 
    9091   REAL(wp) ::   rn_vfac     ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 
     92   REAL(wp), ALLOCATABLE, SAVE ::   rn_vfac0(:,:) ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 
    9193   REAL(wp) ::   rn_zqt      ! z(q,t) : height of humidity and temperature measurements 
    9294   REAL(wp) ::   rn_zu       ! z(u)   : height of wind measurements 
     
    198200         sfx(:,:) = 0._wp                          ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 
    199201         ! 
     202         ALLOCATE ( rn_vfac0(jpi,jpj) ) 
     203         rn_vfac0(:,:) = rn_vfac 
     204         ! 
     205      ENDIF 
     206 
     207      IF( ln_stopack .AND. nn_spp_relw > 0 ) THEN 
     208         rn_vfac0(:,:) = rn_vfac 
     209         CALL spp_gen(kt, rn_vfac0, nn_spp_relw, rn_relw_sd, jk_spp_relw ) 
    200210      ENDIF 
    201211 
     
    291301      DO jj = 2, jpjm1 
    292302         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    293             zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    294             zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
     303            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
     304            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    295305         END DO 
    296306      END DO 
     
    467477            DO ji = 2, jpim1   ! B grid : NO vector opt 
    468478               ! ... scalar wind at I-point (fld being at T-point) 
    469                zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
    470                   &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - rn_vfac * u_ice(ji,jj) 
    471                zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
    472                   &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - rn_vfac * v_ice(ji,jj) 
     479               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)    & 
     480                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) & 
     481                  &      - rn_vfac0(ji,jj) * u_ice(ji,jj) 
     482               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)    & 
     483                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) & 
     484                  &      - rn_vfac0(ji,jj) * v_ice(ji,jj) 
    473485               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    474486               ! ... ice stress at I-point 
     
    476488               vtau_ice(ji,jj) = zwnorm_f * zwndj_f 
    477489               ! ... scalar wind at T-point (fld being at T-point) 
    478                zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   & 
    479                   &                                                    + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  ) 
    480                zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   & 
    481                   &                                                    + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  ) 
     490               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1)                                         & 
     491                  &      - rn_vfac0(ji,jj) * 0.25 * (  u_ice(ji,jj+1) + u_ice(ji+1,jj+1)   & 
     492                  &                                  + u_ice(ji,jj  ) + u_ice(ji+1,jj  )  ) 
     493               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1)                                         & 
     494                  &      - rn_vfac0(ji,jj) * 0.25 * (  v_ice(ji,jj+1) + v_ice(ji+1,jj+1)   & 
     495                  &                                  + v_ice(ji,jj  ) + v_ice(ji+1,jj  )  ) 
    482496               wndm_ice(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    483497            END DO 
     
    490504         DO jj = 2, jpj 
    491505            DO ji = fs_2, jpi   ! vect. opt. 
    492                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
    493                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
     506               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) )  ) 
     507               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac0(ji,jj) * 0.5 * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) )  ) 
    494508               wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    495509            END DO 
     
    497511         DO jj = 2, jpjm1 
    498512            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    499                utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )                          & 
    500                   &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 
    501                vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )                          & 
    502                   &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 
     513               utau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji+1,jj  ) + wndm_ice(ji,jj) )             & 
     514                  &              * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) & 
     515                  &                  - rn_vfac0(ji,jj) * u_ice(ji,jj) ) 
     516               vtau_ice(ji,jj) = zcoef_wnorm2 * ( wndm_ice(ji,jj+1  ) + wndm_ice(ji,jj) )             & 
     517                  &              * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) & 
     518                  &                  - rn_vfac0(ji,jj) * v_ice(ji,jj) ) 
    503519            END DO 
    504520         END DO 
     
    645661      DO jl = 1, jpl 
    646662         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 
    647                                    ! But we do not have Tice => consider it at 0°C => evap=0  
     663                                   ! But we do not have Tice => consider it at 0 degC => evap=0  
    648664      END DO 
    649665 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r10302 r11442  
    5454   REAL(wp)          , PUBLIC ::   rn_avt_rnf      !: runoffs, value of the additional vertical mixing coef. [m2/s] 
    5555   REAL(wp)          , PUBLIC ::   rn_rfact        !: multiplicative factor for runoff 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_avt_rnf0 
    5657 
    5758   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis 
     
    452453         !                                      !    - mixed upstream-centered (ln_traadv_cen2=T) 
    453454         ! 
     455         ALLOCATE ( rn_avt_rnf0(jpi,jpj) ) 
     456         rn_avt_rnf0(:,:) = rn_avt_rnf 
     457         ! 
    454458         IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   & 
    455459            &                                              'be spread through depth by ln_rnf_depth'               ) 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r6486 r11442  
    2525   USE timing         ! Timing 
    2626   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     27   USE stopack 
     28   USE wrk_nemo       ! Memory Allocation 
    2729 
    2830   IMPLICIT NONE 
     
    7577      REAL(wp) ::   zerp     ! local scalar for evaporation damping 
    7678      REAL(wp) ::   zqrp     ! local scalar for heat flux damping 
    77       REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor 
    7879      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 
     80      REAL(wp), POINTER, DIMENSION(:,:) :: rn_dqdt_s, zsrp 
    7981      INTEGER  ::   ierror   ! return error code 
    8082      !! 
     
    9597            ! 
    9698            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
     99 
     100               CALL wrk_alloc( jpi, jpj, rn_dqdt_s ) 
     101               rn_dqdt_s(:,:) = rn_dqdt 
     102 
     103               IF( ln_stopack .AND. nn_spp_dqdt > 0 ) & 
     104                  & CALL spp_gen( kt, rn_dqdt_s, nn_spp_dqdt, rn_dqdt_sd, jk_spp_dqdt ) 
    97105               DO jj = 1, jpj 
    98106                  DO ji = 1, jpi 
    99                      zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
     107                     zqrp = rn_dqdt_s(ji,jj) * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
    100108                     qns(ji,jj) = qns(ji,jj) + zqrp 
    101109                     qrp(ji,jj) = zqrp 
     
    103111               END DO 
    104112               CALL iom_put( "qrp", qrp )                             ! heat flux damping 
     113               CALL wrk_dealloc( jpi, jpj, rn_dqdt_s ) 
    105114            ENDIF 
    106115            ! 
    107116            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    108                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
     117               CALL wrk_alloc( jpi, jpj, zsrp) 
     118               zsrp(:,:) = rn_deds 
     119               IF( ln_stopack .AND. nn_spp_dedt > 0 ) & 
     120                  & CALL spp_gen(kt, zsrp, nn_spp_dedt, rn_dedt_sd, jk_spp_deds ) 
    109121!CDIR COLLAPSE 
    110122               DO jj = 1, jpj 
    111123                  DO ji = 1, jpi 
    112                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
     124                     zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    113125                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )  
    114126                     sfx(ji,jj) = sfx(ji,jj) + zerp                 ! salt flux 
     
    117129               END DO 
    118130               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     131               CALL wrk_dealloc( jpi,jpj, zsrp ) 
    119132               ! 
    120133            ELSEIF( nn_sssr == 2 ) THEN                               !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 
    121                zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
     134               CALL wrk_alloc( jpi, jpj, zsrp) 
     135               zsrp(:,:) = rn_deds 
     136               IF( ln_stopack .AND. nn_spp_dedt > 0 ) & 
     137                  & CALL spp_gen( kt, zsrp, nn_spp_dedt, rn_dedt_sd, jk_spp_deds ) 
    122138               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    123139!CDIR COLLAPSE 
    124140               DO jj = 1, jpj 
    125141                  DO ji = 1, jpi                             
    126                      zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
     142                     zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    127143                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    128144                        &        / MAX(  sss_m(ji,jj), 1.e-20   ) 
     
    134150               END DO 
    135151               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     152               CALL wrk_dealloc( jpi,jpj,zsrp ) 
    136153            ENDIF 
    137154            ! 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r6486 r11442  
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
     30   USE stopack 
    3031 
    3132   IMPLICIT NONE 
     
    4142 
    4243   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend 
     44   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd1   ! geothermal heating trend 
    4345   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read) 
    4446  
     
    8991      ! 
    9092      !                             !  Add the geothermal heat flux trend on temperature 
     93 
     94      IF( ln_stopack .AND. nn_spp_geot > 0) THEN 
     95          qgh_trd1(:,:) = qgh_trd0(:,:) 
     96          CALL spp_gen(kt, qgh_trd1, nn_spp_geot, rn_geot_sd, jk_spp_geot) 
     97      ENDIF 
    9198      DO jj = 2, jpjm1 
    9299         DO ji = 2, jpim1 
    93100            ik = mbkt(ji,jj) 
    94             zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) 
     101            zqgh_trd = qgh_trd1(ji,jj) / fse3t(ji,jj,ik) 
    95102            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 
    96103         END DO 
     
    163170         ! 
    164171         ALLOCATE( qgh_trd0(jpi,jpj) )    ! allocation 
     172         ALLOCATE( qgh_trd1(jpi,jpj) )    ! allocation 
    165173         ! 
    166174         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp) 
     
    192200            ! 
    193201         END SELECT 
     202         qgh_trd1(:,:) = qgh_trd0(:,:) 
    194203         ! 
    195204      ELSE 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r10302 r11442  
    3939   USE timing         ! Timing 
    4040   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     41   USE stopack 
    4142 
    4243   IMPLICIT NONE 
     
    6768   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM) 
    6869   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
     70   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   ahu_bbl_1, ahv_bbl_1   ! diffusive bbl flux coefficients at u and v-points 
    6971   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM) 
    7072 
     
    8688         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     & 
    8789         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          & 
     90         &      ahu_bbl_1(jpi,jpj) , ahv_bbl_1(jpi,jpj) ,                                          & 
    8891         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) ,                                      STAT=tra_bbl_alloc ) 
    8992         ! 
     
    195198      ALLOCATE(zptb(1:jpi, 1:jpj)) 
    196199      ! 
     200      ahu_bbl_1(:,:) = ahu_bbl(:,:) 
     201      IF( ln_stopack .AND. nn_spp_ahubbl > 0 ) THEN 
     202          CALL spp_gen(1, ahu_bbl_1, nn_spp_ahubbl, rn_ahubbl_sd, jk_spp_ahubbl ) 
     203      ENDIF 
     204      ahv_bbl_1(:,:) = ahv_bbl(:,:) 
     205      IF( ln_stopack .AND. nn_spp_ahvbbl > 0 ) THEN 
     206          CALL spp_gen(1, ahv_bbl_1, nn_spp_ahvbbl, rn_ahvbbl_sd, jk_spp_ahvbbl ) 
     207      ENDIF 
     208      ! 
    197209      DO jn = 1, kjpt                                     ! tracer loop 
    198210         !                                                ! =========== 
     
    209221               zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik) 
    210222               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & 
    211                   &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   & 
    212                   &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   & 
    213                   &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   & 
    214                   &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr 
     223                  &               + (   ahu_bbl_1(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   & 
     224                  &                   - ahu_bbl_1(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   & 
     225                  &                   + ahv_bbl_1(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   & 
     226                  &                   - ahv_bbl_1(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr 
    215227            END DO 
    216228         END DO 
     
    594606      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1) 
    595607 
    596  
    597608      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl 
    598609         ! 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r6498 r11442  
    3232   USE wrk_nemo        ! Memory allocation 
    3333   USE timing          ! Timing 
     34   USE stopack 
    3435 
    3536   IMPLICIT NONE 
     
    4344   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile 
    4445   !                                                               !  (key_traldf_ano only) 
     46#if defined key_traldf_c3d 
     47   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: ahtu0, ahtv0, ahtw0, ahtt0 
     48#endif 
     49#if defined key_traldf_c2d 
     50   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:  ) :: ahtu0, ahtv0, ahtw0, ahtt0 
     51#endif 
    4552 
    4653   !! * Substitutions 
     
    7582         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    7683      ENDIF 
     84 
     85#if defined key_traldf_c3d 
     86         IF(  ( kt == nit000 ) .AND. & 
     87            & ( ln_stopack )   .AND. & 
     88            & ( ( nn_spp_ahtu + nn_spp_ahtv + nn_spp_ahtw + nn_spp_ahtt ) > 0 ) ) THEN 
     89             ALLOCATE ( ahtu0(jpi,jpj,jpk), ahtv0(jpi,jpj,jpk) ) 
     90             ALLOCATE ( ahtt0(jpi,jpj,jpk), ahtw0(jpi,jpj,jpk) ) 
     91             ahtu0 = ahtu 
     92             ahtv0 = ahtv 
     93             ahtw0 = ahtw 
     94             ahtt0 = ahtt 
     95         ENDIF 
     96#endif 
     97#if defined key_traldf_c2d 
     98         IF(  ( kt == nit000 ) .AND. & 
     99            & ( ln_stopack )   .AND. & 
     100            & ( ( nn_spp_ahtu + nn_spp_ahtv + nn_spp_ahtw + nn_spp_ahtt ) > 0 ) ) THEN 
     101             ALLOCATE ( ahtu0(jpi,jpj), ahtv0(jpi,jpj) ) 
     102             ALLOCATE ( ahtt0(jpi,jpj), ahtw0(jpi,jpj) ) 
     103             ahtu0 = ahtu 
     104             ahtv0 = ahtv 
     105             ahtw0 = ahtw 
     106             ahtt0 = ahtt 
     107         ENDIF 
     108#endif 
     109#if defined key_traldf_c3d || defined key_traldf_c2d 
     110         IF( ln_stopack .AND. ( nn_spp_ahtu > 0 ) ) THEN 
     111             ahtu = ahtu0 
     112             CALL spp_aht(kt, ahtu, nn_spp_ahtu, rn_ahtu_sd, jk_spp_ahtu) 
     113         ENDIF 
     114         IF( ln_stopack .AND. ( nn_spp_ahtv > 0 ) ) THEN 
     115             ahtv = ahtv0 
     116             CALL spp_aht(kt, ahtv, nn_spp_ahtv, rn_ahtv_sd, jk_spp_ahtv) 
     117         ENDIF 
     118         IF( ln_stopack .AND. ( nn_spp_ahtw > 0 ) ) THEN 
     119             ahtw = ahtw0 
     120             CALL spp_aht(kt, ahtw, nn_spp_ahtw, rn_ahtw_sd, jk_spp_ahtw) 
     121         ENDIF 
     122         IF( ln_stopack .AND. ( nn_spp_ahtt > 0 ) ) THEN 
     123             ahtt = ahtt0 
     124             CALL spp_aht(kt, ahtt, nn_spp_ahtt, rn_ahtt_sd, jk_spp_ahtt) 
     125         ENDIF 
     126#endif 
    77127 
    78128      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r10302 r11442  
    3333   USE wrk_nemo       ! Memory Allocation 
    3434   USE timing         ! Timing 
     35   USE stopack 
    3536 
    3637   IMPLICIT NONE 
     
    5253  
    5354   ! Module variables 
    54    REAL(wp) ::   xsi0r                           !: inverse of rn_si0 
     55   REAL(wp), ALLOCATABLE ::   xsi0r(:,:)         !: inverse of rn_si0 
    5556   REAL(wp) ::   xsi1r                           !: inverse of rn_si1 
    5657   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
     
    182183         !                                        ! ============================================== ! 
    183184         ! 
    184          !                                                ! ------------------------- ! 
     185         !  
     186         IF( ln_stopack .AND. ( nn_spp_qsi0 > 0 ) ) THEN 
     187             xsi0r = rn_si0 
     188             CALL spp_gen(kt, xsi0r, nn_spp_qsi0, rn_qsi0_sd, jk_spp_qsi0 ) 
     189             xsi0r = 1.e0 / xsi0r 
     190         ENDIF 
     191         !                                               ! ------------------------- ! 
    185192         IF( ln_qsr_rgb) THEN                             !  R-G-B  light penetration ! 
    186193            !                                             ! ------------------------- ! 
     
    251258!CDIR NOVERRCHK    
    252259                     DO ji = 1, jpi 
    253                         zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r    ) 
     260                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r(ji,jj) ) 
    254261                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) ) 
    255262                        zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) ) 
     
    285292                  DO jj = 1, jpj 
    286293                     DO ji = 1, jpi 
    287                         zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r    ) 
     294                        zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r(ji,jj) ) 
    288295                        zc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 
    289296                        zc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
     
    310317            !                                             ! ------------------------- ! 
    311318            ! 
    312             IF( lk_vvl ) THEN                                  !* variable volume 
     319            IF( lk_vvl .OR. ( ln_stopack .AND. ( nn_spp_qsi0 > 0 ) ) ) THEN        !* variable volume 
     320 
    313321               zz0   =        rn_abs   * r1_rau0_rcp 
    314322               zz1   = ( 1. - rn_abs ) * r1_rau0_rcp 
     
    316324                  DO jj = 1, jpj 
    317325                     DO ji = 1, jpi 
    318                         zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
    319                         zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
     326                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
     327                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
    320328                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) )  
    321329                     END DO 
     
    326334                  DO jj = 1, jpj 
    327335                     DO ji = 1, jpi 
    328                         zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
    329                         zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
     336                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
     337                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
    330338                        fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
    331339                     END DO 
     
    492500         !                       ! ===================================== ! 
    493501         ! 
     502         ALLOCATE( xsi0r(jpi,jpj) ) 
    494503         xsi0r = 1.e0 / rn_si0 
    495504         xsi1r = 1.e0 / rn_si1 
     
    546555!CDIR NOVERRCHK    
    547556                        DO ji = 1, jpi 
    548                            zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r    ) 
     557                           zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r(ji,jj) ) 
    549558                           zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekb(ji,jj) ) 
    550559                           zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekg(ji,jj) ) 
     
    587596                  DO jj = 1, jpj                              ! top 400 meters 
    588597                     DO ji = 1, jpi 
    589                         zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
    590                         zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
     598                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r ) 
     599                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 
    591600                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) * tmask(ji,jj,1)  
    592601                     END DO 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90

    r6486 r11442  
    2929   USE lib_mpp        ! MPP library 
    3030   USE wrk_nemo       ! Memory allocation 
     31   USE stopack      
    3132 
    3233   IMPLICIT NONE 
     
    6869      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    6970      IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt ) 
     71      IF( ln_dyn_trd .AND. ln_stopack .AND. ln_sppt_dyn ) & 
     72         & CALL dyn_sppt_collect( putrd, pvtrd, ktrd, kt ) 
    7073          
    7174      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r10302 r11442  
    3232   USE iom            ! I/O manager library 
    3333   USE lib_mpp        ! MPP library 
     34   USE stopack 
    3435   USE wrk_nemo       ! Memory allocation 
    3536 
     
    271272      !                   ! 3D output of tracers trends using IOM interface 
    272273      IF( ln_tra_trd )   CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt ) 
    273  
    274       !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     274      IF( ln_tra_trd .AND. ln_stopack .AND. ln_sppt_tra )  & 
     275         & CALL tra_sppt_collect( ptrdx, ptrdy, ktrd, kt ) 
     276 
     277      !  Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    275278      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 
    276279 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r6486 r11442  
    2626   USE wrk_nemo        ! Memory Allocation 
    2727   USE phycst, ONLY: vkarmn 
     28   USE stopack 
    2829 
    2930   IMPLICIT NONE 
     
    5253   REAL(wp), PUBLIC ::   rn_tfrz0     ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM) 
    5354   LOGICAL , PUBLIC ::   ln_bfrimp    ! logical switch for implicit bottom friction 
    54    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d, tfrcoef2d   ! 2D bottom/top drag coefficient (PUBLIC for TAM) 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::  bfrcoef2d, tfrcoef2d,bfrcoef2d0   ! 2D bottom/top drag coefficient (PUBLIC for TAM) 
    5556 
    5657   !! * Substitutions 
     
    6869      !!                ***  FUNCTION zdf_bfr_alloc  *** 
    6970      !!---------------------------------------------------------------------- 
    70       ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), STAT=zdf_bfr_alloc ) 
     71      ALLOCATE( bfrcoef2d(jpi,jpj), tfrcoef2d(jpi,jpj), bfrcoef2d0(jpi,jpj),STAT=zdf_bfr_alloc ) 
    7172      ! 
    7273      IF( lk_mpp             )   CALL mpp_sum ( zdf_bfr_alloc ) 
     
    105106         WRITE(numout,*) 'zdf_bfr : Set bottom friction coefficient (non-linear case)' 
    106107         WRITE(numout,*) '~~~~~~~~' 
     108      ENDIF 
     109      !  
     110      IF( ln_stopack .AND. ( nn_spp_bfr > 0 ) ) THEN 
     111         bfrcoef2d = bfrcoef2d0 
     112         CALL spp_gen(kt, bfrcoef2d, nn_spp_bfr, rn_bfr_sd, jk_spp_bfr) 
    107113      ENDIF 
    108114      ! 
     
    486492      ENDIF 
    487493      ! 
     494      bfrcoef2d0(:,:) = bfrcoef2d(:,:) 
    488495      IF( nn_timing == 1 )  CALL timing_stop('zdf_bfr_init') 
    489496      ! 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r7061 r11442  
    2525   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2626   USE timing          ! Timing 
     27   USE stopack          
    2728 
    2829   IMPLICIT NONE 
     
    3031 
    3132   PUBLIC   zdf_evd    ! called by step.F90 
     33   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rn_avevd0 
    3234 
    3335   !! * Substitutions 
     
    6971         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    7072         IF(lwp) WRITE(numout,*) 
     73         ALLOCATE ( rn_avevd0(jpi,jpj) ) 
     74         rn_avevd0(:,:) = rn_avevd 
    7175      ENDIF 
    7276 
    7377      zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application 
     78 
     79      IF( ln_stopack .AND. ( nn_spp_aevd > 0 ) ) THEN 
     80         rn_avevd0(:,:) = rn_avevd 
     81         CALL spp_gen(kt, rn_avevd0, nn_spp_aevd, rn_aevd_sd, jk_spp_aevd) 
     82      ENDIF 
    7483 
    7584      SELECT CASE ( nn_evdm ) 
     
    8897                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 
    8998#endif 
    90                      avt (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk) 
    91                      avm (ji  ,jj  ,jk) = rn_avevd * tmask(ji  ,jj  ,jk) 
    92                      avmu(ji  ,jj  ,jk) = rn_avevd * umask(ji  ,jj  ,jk) 
    93                      avmu(ji-1,jj  ,jk) = rn_avevd * umask(ji-1,jj  ,jk) 
    94                      avmv(ji  ,jj  ,jk) = rn_avevd * vmask(ji  ,jj  ,jk) 
    95                      avmv(ji  ,jj-1,jk) = rn_avevd * vmask(ji  ,jj-1,jk) 
     99                     avt (ji  ,jj  ,jk) = rn_avevd0(ji,jj) * tmask(ji  ,jj  ,jk) 
     100                     avm (ji  ,jj  ,jk) = rn_avevd0(ji,jj) * tmask(ji  ,jj  ,jk) 
     101                     avmu(ji  ,jj  ,jk) = rn_avevd0(ji,jj) * umask(ji  ,jj  ,jk) 
     102                     avmu(ji-1,jj  ,jk) = rn_avevd0(ji,jj) * umask(ji-1,jj  ,jk) 
     103                     avmv(ji  ,jj  ,jk) = rn_avevd0(ji,jj) * vmask(ji  ,jj  ,jk) 
     104                     avmv(ji  ,jj-1,jk) = rn_avevd0(ji,jj) * vmask(ji  ,jj-1,jk) 
    96105                  ENDIF 
    97106               END DO 
     
    115124                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   & 
    116125#endif 
    117                      avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk) 
     126                     avt(ji,jj,jk) = rn_avevd0(ji,jj) * tmask(ji,jj,jk) 
    118127               END DO 
    119128            END DO 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r10302 r11442  
    3232   USE timing         ! Timing 
    3333   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     34   USE stopack 
    3435 
    3536   IMPLICIT NONE 
     
    806807            END DO 
    807808         END DO 
     809         IF( ln_stopack) THEN 
     810            IF( nn_spp_avt > 0 ) CALL spp_gen(kt, avt(:,:,jk), nn_spp_avt, rn_avt_sd,jk) 
     811            IF( nn_spp_avm > 0 ) CALL spp_gen(kt, avm(:,:,jk), nn_spp_avm, rn_avm_sd,jk) 
     812         ENDIF  
    808813      END DO 
    809814      ! 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r10302 r11442  
    5757   USE agrif_opa_update 
    5858#endif 
    59  
    60  
     59   USE stopack 
    6160 
    6261   IMPLICIT NONE 
     
    9493 
    9594   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau) 
    96    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_niw          !: TKE budget- near-inertial waves term 
    97    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   efr            ! surface boundary condition for nn_etau = 4 
    9895   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation 
    9996#if defined key_c1d 
     
    10299   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_pdl, e_ric   !: prandl and local Richardson numbers 
    103100#endif 
    104  
     101   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rn_lc0, rn_ediff0, rn_ediss0, rn_ebb0, rn_efr0 
     102   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e_niw          !: TKE budget- near-inertial waves term 
     103   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   efr            ! surface boundary condition for nn_etau = 4 
     104    
    105105   !! * Substitutions 
    106106#  include "domzgr_substitute.h90" 
     
    184184         avmu(:,:,:) = avmu_k(:,:,:)  
    185185         avmv(:,:,:) = avmv_k(:,:,:)  
    186       ENDIF  
     186      ENDIF 
     187      ! 
     188      IF( ln_stopack) THEN 
     189         IF( nn_spp_tkelc > 0 ) THEN 
     190             rn_lc0 = rn_lc 
     191             CALL spp_gen( kt, rn_lc0, nn_spp_tkelc, rn_tkelc_sd, jk_spp_tkelc ) 
     192         ENDIF 
     193         IF( nn_spp_tkedf > 0 ) THEN 
     194             rn_ediff0 = rn_ediff 
     195             CALL spp_gen( kt, rn_ediff0, nn_spp_tkedf, rn_tkedf_sd, jk_spp_tkedf ) 
     196         ENDIF 
     197         IF( nn_spp_tkeds > 0 ) THEN 
     198             rn_ediss0 = rn_ediss 
     199             CALL spp_gen( kt, rn_ediss0, nn_spp_tkeds, rn_tkeds_sd, jk_spp_tkeds ) 
     200         ENDIF 
     201         IF( nn_spp_tkebb > 0 ) THEN 
     202             rn_ebb0 = rn_ebb 
     203             CALL spp_gen( kt, rn_ebb0, nn_spp_tkebb, rn_tkebb_sd, jk_spp_tkebb ) 
     204        ENDIF 
     205         IF( nn_spp_tkefr > 0 ) THEN 
     206             rn_efr0 = rn_efr 
     207             CALL spp_gen( kt, rn_efr0, nn_spp_tkefr, rn_tkefr_sd, jk_spp_tkefr ) 
     208         ENDIF 
     209      ENDIF 
    187210      ! 
    188211      CALL tke_tke      ! now tke (en) 
     
    199222      IF( .NOT.Agrif_Root() )   CALL Agrif_Update_Tke( kt )      ! children only 
    200223#endif       
    201      !  
     224      IF (  kt == nitend ) THEN 
     225        DEALLOCATE ( rn_lc0, rn_ediff0, rn_ediss0, rn_ebb0, rn_efr0 ) 
     226      ENDIF 
     227      ! 
     228 
    202229   END SUBROUTINE zdf_tke 
    203230 
     
    225252      REAL(wp) ::   zrhoa  = 1.22                   ! Air density kg/m3 
    226253      REAL(wp) ::   zcdrag = 1.5e-3                 ! drag coefficient 
    227       REAL(wp) ::   zbbrau, zesh2                   ! temporary scalars 
    228       REAL(wp) ::   zfact1, zfact2, zfact3          !    -         - 
     254      REAL(wp) ::   zesh2                           ! temporary scalars 
     255      REAL(wp) ::   zfact1                          !    -         - 
    229256      REAL(wp) ::   ztx2  , zty2  , zcof            !    -         - 
    230257      REAL(wp) ::   ztau  , zdif                    !    -         - 
     
    233260!!bfr      REAL(wp) ::   zebot                           !    -         - 
    234261      INTEGER , POINTER, DIMENSION(:,:  ) :: imlc 
    235       REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc 
     262      REAL(wp), POINTER, DIMENSION(:,:  ) :: zhlc, zbbrau,zfact2,zfact3 
    236263      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw 
    237264      !!-------------------------------------------------------------------- 
     
    240267      ! 
    241268      CALL wrk_alloc( jpi,jpj, imlc )    ! integer 
    242       CALL wrk_alloc( jpi,jpj, zhlc )  
     269      CALL wrk_alloc( jpi,jpj, zhlc ) 
     270      CALL wrk_alloc( jpi,jpj, zbbrau ) 
     271      CALL wrk_alloc( jpi,jpj, zfact2 ) 
     272      CALL wrk_alloc( jpi,jpj, zfact3 ) 
    243273      CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )  
    244274      ! 
    245       zbbrau = rn_ebb / rau0       ! Local constant initialisation 
     275      zbbrau = rn_ebb0 / rau0       ! Local constant initialisation 
    246276      zfact1 = -.5_wp * rdt  
    247       zfact2 = 1.5_wp * rdt * rn_ediss 
    248       zfact3 = 0.5_wp       * rn_ediss 
     277      zfact2 = 1.5_wp * rdt * rn_ediss0 
     278      zfact3 = 0.5_wp       * rn_ediss0 
    249279      ! 
    250280      ! 
     
    261291      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    262292         DO ji = fs_2, fs_jpim1   ! vector opt. 
    263             en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 
     293            en(ji,jj,1) = MAX( rn_emin0, zbbrau(ji,jj) * taum(ji,jj) ) * tmask(ji,jj,1) 
    264294         END DO 
    265295      END DO 
     
    326356                  !                                           ! vertical velocity due to LC 
    327357                  zind = 0.5 - SIGN( 0.5, fsdepw(ji,jj,jk) - zhlc(ji,jj) ) 
    328                   zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 
     358                  zwlc = zind * rn_lc0(ji,jj) * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 
    329359                  !                                           ! TKE Langmuir circulation source term 
    330                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) /   & 
     360                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) )* ( zwlc * zwlc * zwlc ) /   & 
    331361                     &   zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     362 
    332363               END DO 
    333364            END DO 
     
    380411               zd_up(ji,jj,jk) = zzd_up            ! Matrix (zdiag, zd_up, zd_lw) 
    381412               zd_lw(ji,jj,jk) = zzd_lw 
    382                zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * tmask(ji,jj,jk) 
     413               zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2(ji,jj) * dissl(ji,jj,jk) * tmask(ji,jj,jk) 
    383414               ! 
    384415               !                                   ! right hand side in en 
    385416               en(ji,jj,jk) = en(ji,jj,jk) + rdt * (  zesh2  -   avt(ji,jj,jk) * rn2(ji,jj,jk)    & 
    386                   &                                 + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk)  ) & 
     417                  &                                 + zfact3(ji,jj) * dissl(ji,jj,jk) * en (ji,jj,jk)  ) & 
    387418                  &                                 * wmask(ji,jj,jk) 
    388419            END DO 
     
    455486            DO jj = 2, jpjm1 
    456487               DO ji = fs_2, fs_jpim1   ! vector opt. 
    457                   en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
     488                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr0(ji,jj) * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    458489                     &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    459490               END DO 
     
    464495            DO ji = fs_2, fs_jpim1   ! vector opt. 
    465496               jk = nmln(ji,jj) 
    466                en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
     497               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr0(ji,jj) * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    467498                  &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    468499            END DO 
     
    480511                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean  
    481512                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    482                   en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
     513                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau(ji,jj) * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   & 
    483514                     &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    484515               END DO 
     
    516547      CALL wrk_dealloc( jpi,jpj, imlc )    ! integer 
    517548      CALL wrk_dealloc( jpi,jpj, zhlc )  
     549      CALL wrk_dealloc( jpi,jpj, zbbrau )  
     550      CALL wrk_dealloc( jpi,jpj, zfact2 )  
     551      CALL wrk_dealloc( jpi,jpj, zfact3 )  
    518552      CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )  
    519553      ! 
     
    698732            DO ji = fs_2, fs_jpim1   ! vector opt. 
    699733               zsqen = SQRT( en(ji,jj,jk) ) 
    700                zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen 
     734               zav   = rn_ediff0(ji,jj) * zmxlm(ji,jj,jk) * zsqen 
    701735               avm  (ji,jj,jk) = MAX( zav,                  avmb(jk) ) * wmask(ji,jj,jk) 
    702736               avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 
     
    704738            END DO 
    705739         END DO 
     740         IF( ln_stopack) THEN 
     741            IF(nn_spp_avt > 0 ) CALL spp_gen( 1, avt(:,:,jk), nn_spp_avt, rn_avt_sd, jk_spp_avt, jk) 
     742            IF(nn_spp_avm > 0 ) CALL spp_gen( 1, avm(:,:,jk), nn_spp_avm, rn_avm_sd, jk_spp_avm, jk) 
     743         ENDIF 
    706744      END DO 
    707745      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
     
    840878         rn_mxl0 = rmxl_min 
    841879      ENDIF 
     880 
     881      ALLOCATE( rn_lc0   (jpi,jpj) ) ; rn_lc0    = rn_lc 
     882      ALLOCATE( rn_ediff0(jpi,jpj) ) ; rn_ediff0 = rn_ediff 
     883      ALLOCATE( rn_ediss0(jpi,jpj) ) ; rn_ediss0 = rn_ediss 
     884      ALLOCATE( rn_ebb0  (jpi,jpj) ) ; rn_ebb0   = rn_ebb 
     885      ALLOCATE( rn_efr0  (jpi,jpj) ) ; rn_efr0   = rn_efr 
    842886       
    843887      IF( nn_etau == 2  ) THEN 
     
    952996              CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation) 
    953997              ! 
    954               avt_k (:,:,:) = avt (:,:,:) 
    955               avm_k (:,:,:) = avm (:,:,:) 
    956               avmu_k(:,:,:) = avmu(:,:,:) 
    957               avmv_k(:,:,:) = avmv(:,:,:) 
    958               ! 
    959998              DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO 
    960999           ENDIF 
    9611000        ELSE                                   !* Start from rest 
    9621001           en(:,:,:) = rn_emin * tmask(:,:,:) 
    963            DO jk = 1, jpk                           ! set the Kz to the background value 
    964               avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
    965               avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 
    966               avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 
    967               avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 
    968            END DO 
    9691002        ENDIF 
    9701003        ! 
     1004        avt_k (:,:,:) = avt (:,:,:) 
     1005        avm_k (:,:,:) = avm (:,:,:) 
     1006        avmu_k(:,:,:) = avmu(:,:,:) 
     1007        avmv_k(:,:,:) = avmv(:,:,:) 
     1008         
    9711009     ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file 
    9721010        !                                   ! ------------------- 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r10302 r11442  
    8686   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    8787   USE sbc_oce, ONLY: lk_oasis 
     88   USE stopack 
    8889   USE stopar 
    8990   USE stopts 
     
    487488                            CALL dia_hsb_init   ! heat content, salt content and volume budgets 
    488489                            CALL     trd_init   ! Mixed-layer/Vorticity/Integral constraints trends 
     490                            CALL stopack_init   ! STOPACK scheme 
    489491      IF( lk_diaobs     ) THEN                  ! Observation & model comparison 
    490492                            CALL dia_obs_init            ! Initialize observational data 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/step.F90

    r10302 r11442  
    118118         CALL lbc_lnk( tsb(:,:,:,tind), 'T', 1. ) 
    119119      END DO 
    120  
     120       
     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 ( ln_stopack .AND. ( nn_spp_arnf > 0 ) ) THEN 
     156              rn_avt_rnf0 = rn_avt_rnf 
     157              CALL spp_gen( kstp, rn_avt_rnf0,nn_spp_arnf,rn_arnf_sd,jk_spp_arnf ) 
     158         ENDIF 
     159         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf0(:,:) * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
    152160      ENDIF 
    153161      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
     
    163171      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' ) 
    164172      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' ) 
     173      IF( lrst_oce .AND. ln_stopack)   CALL stopack_rst( kstp, 'WRITE' ) 
    165174      ! 
    166175      !  LATERAL  PHYSICS 
    167176      ! 
    168177      IF( lk_ldfslp ) THEN                            ! slope of lateral mixing 
    169          CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density 
     178                         CALL eos( tsb, rhd, gdept_0(:,:,:) )               ! before in situ density 
    170179         IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    171180            &            CALL zps_hde    ( kstp, jpts, tsb, gtsu, gtsv,  &  ! Partial steps: before horizontal gradient 
     
    202211          ! Note that the computation of vertical velocity above, hence "after" sea level 
    203212          ! is necessary to compute momentum advection for the rhs of barotropic loop: 
    204             CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
     213            IF(ln_sto_eos ) CALL sto_pts( tsn )                             ! Random T/S fluctuations 
     214                            CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 
    205215            IF( ln_zps .AND. .NOT. ln_isfcav)                               & 
    206216               &            CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
     
    214224                                  va(:,:,:) = 0.e0 
    215225          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) 
     226             & ln_dyninc       )  CALL dyn_asm_inc   ( kstp )   ! apply dynamics assimilation increment 
     227          IF( ln_stopack .AND. ln_sppt_dyn ) & 
     228             &                    CALL dyn_sppt_apply( kstp, 0 ) 
     229          IF( ln_neptsimp )       CALL dyn_nept_cor  ( kstp )   ! subtract Neptune velocities (simplified) 
     230          IF( lk_bdy           )  CALL bdy_dyn3d_dmp ( kstp )   ! bdy damping trends 
     231                                  CALL dyn_adv       ( kstp )   ! advection (vector or flux form) 
     232                                  CALL dyn_vor       ( kstp )   ! vorticity term including Coriolis 
     233                                  CALL dyn_ldf       ( kstp )   ! lateral mixing 
     234          IF( ln_neptsimp )       CALL dyn_nept_cor  ( kstp )   ! add Neptune velocities (simplified) 
    223235#if defined key_agrif 
    224236          IF(.NOT. Agrif_Root())  CALL Agrif_Sponge_dyn        ! momentum sponge 
     
    264276                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero 
    265277 
    266       IF(  lk_asminc .AND. ln_asmiau .AND. & 
    267          & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
     278      IF( ln_stopack .AND. ln_sppt_tra ) & 
     279         &                   CALL tra_sppt_apply ( kstp, 0 ) 
     280      IF( lk_asminc .AND. ln_asmiau .AND. & 
     281        & ln_trainc      )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
    268282                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    269283      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
     
    282296      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    283297#endif 
     298      IF( ln_stopack .AND. ln_sppt_tra ) & 
     299         &                   CALL tra_sppt_apply ( kstp, 1 ) 
    284300                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields 
    285301 
     
    287303         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    288304                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     305         IF( ln_stopack .AND. ln_sppt_tra ) & 
     306            &                CALL tra_sppt_apply ( kstp, 2 ) 
    289307                             CALL eos    ( tsa, rhd, rhop, fsdept_n(:,:,:) )  ! Time-filtered in situ density for hpg computation 
    290308            IF( ln_zps .AND. .NOT. ln_isfcav)                                & 
     
    310328                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    311329         IF( ln_bias )       CALL dyn_bias( kstp ) 
     330         IF( ln_stopack .AND. ln_sppt_tra )   THEN 
     331                                CALL tra_sppt_apply ( kstp, 2 ) 
     332                                CALL eos    ( tsn, rhd, rhop, fsdept_n(:,:,:) )  ! now in situ density for hpg computation 
     333                                IF( ln_zps .AND. .NOT. ln_isfcav)                & 
     334                                & CALL zps_hde    ( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
     335                                &                   rhd, gru , grv    )  ! of t, s, rd at the last ocean level 
     336                                IF( ln_zps .AND.       ln_isfcav)                                   &  
     337                                & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps for top cell (ISF) 
     338                                &                   rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv ,   & 
     339                                &                   gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi    ) ! of t, s, rd at the last ocean level 
     340         ENDIF 
    312341      ENDIF 
    313342 
     
    326355 
    327356                               CALL dyn_bfr( kstp )         ! bottom friction 
     357            IF( ln_stopack .AND. ln_sppt_dyn ) & 
     358               &               CALL dyn_sppt_apply ( kstp, 1 ) 
    328359                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    329360      ELSE 
     
    333364        IF(  lk_asminc .AND. ln_asmiau .AND. & 
    334365           & ln_dyninc      )  CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment 
     366        IF( ln_stopack .AND. ln_sppt_dyn ) & 
     367           &                   CALL dyn_sppt_apply ( kstp, 0 ) 
    335368        IF( ln_bkgwri )        CALL asm_bkg_wri( kstp )     ! output background fields 
    336369        IF( ln_neptsimp )      CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified) 
     
    345378                               CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure 
    346379                               CALL dyn_bfr( kstp )         ! bottom friction 
     380            IF( ln_stopack .AND. ln_sppt_dyn ) & 
     381               &               CALL dyn_sppt_apply ( kstp, 1 ) 
    347382                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    348383                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
    349384      ENDIF 
    350385                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step 
     386            IF( ln_stopack .AND. ln_sppt_dyn ) & 
     387               &               CALL dyn_sppt_apply ( kstp, 2 ) 
     388            IF( ln_stopack .AND. ln_skeb ) & 
     389               &               CALL skeb_apply ( kstp ) 
    351390 
    352391                               CALL ssh_swp( kstp )         ! swap of sea surface height 
     
    384423      ENDIF 
    385424 
    386  
    387425      IF( lrst_bias )          CALL bias_wrt     ( kstp ) 
    388426 
  • branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r8400 r11442  
    9696   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine) 
    9797   USE diaharm 
     98   USE diaprod          ! ocean model: product diagnostics 
    9899   USE flo_oce          ! floats variables 
    99100   USE floats           ! floats computation               (flo_stp routine) 
     
    113114   USE timing           ! Timing 
    114115 
     116   USE stopack          ! Stochastic physics 
     117 
    115118#if defined key_agrif 
    116119   USE agrif_opa_sponge ! Momemtum and tracers sponges 
Note: See TracChangeset for help on using the changeset viewer.