- Timestamp:
- 2019-08-16T12:32:43+02:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM
- Files:
-
- 19 edited
- 1 copied
-
CONFIG/SHARED/field_def.xml (modified) (1 diff)
-
NEMO/OPA_SRC/DYN/dynldf.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/SBC/albedo.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/SBC/sbcblk_core.F90 (modified) (9 diffs)
-
NEMO/OPA_SRC/SBC/sbcrnf.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/SBC/sbcssr.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/STO/stopack.F90 (copied) (copied from branches/UKMO/dev_r5518_GO6_package_FOAMv14_STOPACK/NEMOGCM/NEMO/OPA_SRC/STO/stopack.F90)
-
NEMO/OPA_SRC/TRA/trabbc.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/TRA/trabbl.F90 (modified) (6 diffs)
-
NEMO/OPA_SRC/TRA/traldf.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/TRA/traqsr.F90 (modified) (11 diffs)
-
NEMO/OPA_SRC/TRD/trddyn.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/TRD/trdtra.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/ZDF/zdfbfr.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/ZDF/zdfevd.F90 (modified) (5 diffs)
-
NEMO/OPA_SRC/ZDF/zdfgls.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/ZDF/zdftke.F90 (modified) (19 diffs)
-
NEMO/OPA_SRC/nemogcm.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/step.F90 (modified) (13 diffs)
-
NEMO/OPA_SRC/step_oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/CONFIG/SHARED/field_def.xml
r10302 r11442 125 125 <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" /> 126 126 <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 127 171 </field_group> 128 172 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r6486 r11442 30 30 USE wrk_nemo ! Memory Allocation 31 31 USE timing ! Timing 32 USE stopack 32 33 33 34 IMPLICIT NONE … … 38 39 39 40 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 40 48 41 49 !! * Substitutions … … 67 75 ztrdv(:,:,:) = va(:,:,:) 68 76 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 69 125 70 126 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 22 22 USE wrk_nemo ! work arrays 23 23 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 24 USE stopack 24 25 25 26 IMPLICIT NONE … … 154 155 END DO 155 156 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 156 161 END DO 157 162 … … 209 214 END DO 210 215 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 211 220 END DO 212 221 ! Effect of the clouds (2d order polynomial) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r9288 r11442 51 51 USE par_ice_2 52 52 #endif 53 USE stopack 53 54 54 55 IMPLICIT NONE … … 89 90 REAL(wp) :: rn_efac ! multiplication factor for evaporation (clem) 90 91 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) 91 93 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 92 94 REAL(wp) :: rn_zu ! z(u) : height of wind measurements … … 198 200 sfx(:,:) = 0._wp ! salt flux; zero unless ice is present (computed in limsbc(_2).F90) 199 201 ! 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 ) 200 210 ENDIF 201 211 … … 291 301 DO jj = 2, jpjm1 292 302 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) ) ) 295 305 END DO 296 306 END DO … … 467 477 DO ji = 2, jpim1 ! B grid : NO vector opt 468 478 ! ... 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) 473 485 zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 474 486 ! ... ice stress at I-point … … 476 488 vtau_ice(ji,jj) = zwnorm_f * zwndj_f 477 489 ! ... 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 ) ) 482 496 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 483 497 END DO … … 490 504 DO jj = 2, jpj 491 505 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) ) ) 494 508 wndm_ice(ji,jj) = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 495 509 END DO … … 497 511 DO jj = 2, jpjm1 498 512 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) ) 503 519 END DO 504 520 END DO … … 645 661 DO jl = 1, jpl 646 662 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=0663 ! But we do not have Tice => consider it at 0 degC => evap=0 648 664 END DO 649 665 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r10302 r11442 54 54 REAL(wp) , PUBLIC :: rn_avt_rnf !: runoffs, value of the additional vertical mixing coef. [m2/s] 55 55 REAL(wp) , PUBLIC :: rn_rfact !: multiplicative factor for runoff 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_avt_rnf0 56 57 57 58 LOGICAL , PUBLIC :: l_rnfcpl = .false. ! runoffs recieved from oasis … … 452 453 ! ! - mixed upstream-centered (ln_traadv_cen2=T) 453 454 ! 455 ALLOCATE ( rn_avt_rnf0(jpi,jpj) ) 456 rn_avt_rnf0(:,:) = rn_avt_rnf 457 ! 454 458 IF ( ln_rnf_depth ) CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already', & 455 459 & 'be spread through depth by ln_rnf_depth' ) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r6486 r11442 25 25 USE timing ! Timing 26 26 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 27 USE stopack 28 USE wrk_nemo ! Memory Allocation 27 29 28 30 IMPLICIT NONE … … 75 77 REAL(wp) :: zerp ! local scalar for evaporation damping 76 78 REAL(wp) :: zqrp ! local scalar for heat flux damping 77 REAL(wp) :: zsrp ! local scalar for unit conversion of rn_deds factor78 79 REAL(wp) :: zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 80 REAL(wp), POINTER, DIMENSION(:,:) :: rn_dqdt_s, zsrp 79 81 INTEGER :: ierror ! return error code 80 82 !! … … 95 97 ! 96 98 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 ) 97 105 DO jj = 1, jpj 98 106 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) ) 100 108 qns(ji,jj) = qns(ji,jj) + zqrp 101 109 qrp(ji,jj) = zqrp … … 103 111 END DO 104 112 CALL iom_put( "qrp", qrp ) ! heat flux damping 113 CALL wrk_dealloc( jpi, jpj, rn_dqdt_s ) 105 114 ENDIF 106 115 ! 107 116 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 ) 109 121 !CDIR COLLAPSE 110 122 DO jj = 1, jpj 111 123 DO ji = 1, jpi 112 zerp = zsrp* ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths124 zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 113 125 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) 114 126 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux … … 117 129 END DO 118 130 CALL iom_put( "erp", erp ) ! freshwater flux damping 131 CALL wrk_dealloc( jpi,jpj, zsrp ) 119 132 ! 120 133 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 ) 122 138 zerp_bnd = rn_sssr_bnd / rday ! - - 123 139 !CDIR COLLAPSE 124 140 DO jj = 1, jpj 125 141 DO ji = 1, jpi 126 zerp = zsrp* ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths142 zerp = (zsrp(ji,jj)/rday) * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 127 143 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 128 144 & / MAX( sss_m(ji,jj), 1.e-20 ) … … 134 150 END DO 135 151 CALL iom_put( "erp", erp ) ! freshwater flux damping 152 CALL wrk_dealloc( jpi,jpj,zsrp ) 136 153 ENDIF 137 154 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r6486 r11442 28 28 USE wrk_nemo ! Memory Allocation 29 29 USE timing ! Timing 30 USE stopack 30 31 31 32 IMPLICIT NONE … … 41 42 42 43 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd0 ! geothermal heating trend 44 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd1 ! geothermal heating trend 43 45 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_qgh ! structure of input qgh (file informations, fields read) 44 46 … … 89 91 ! 90 92 ! ! 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 91 98 DO jj = 2, jpjm1 92 99 DO ji = 2, jpim1 93 100 ik = mbkt(ji,jj) 94 zqgh_trd = qgh_trd 0(ji,jj) / fse3t(ji,jj,ik)101 zqgh_trd = qgh_trd1(ji,jj) / fse3t(ji,jj,ik) 95 102 tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 96 103 END DO … … 163 170 ! 164 171 ALLOCATE( qgh_trd0(jpi,jpj) ) ! allocation 172 ALLOCATE( qgh_trd1(jpi,jpj) ) ! allocation 165 173 ! 166 174 SELECT CASE ( nn_geoflx ) ! geothermal heat flux / (rauO * Cp) … … 192 200 ! 193 201 END SELECT 202 qgh_trd1(:,:) = qgh_trd0(:,:) 194 203 ! 195 204 ELSE -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r10302 r11442 39 39 USE timing ! Timing 40 40 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 41 USE stopack 41 42 42 43 IMPLICIT NONE … … 67 68 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM) 68 69 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 69 71 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) 70 72 … … 86 88 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d (jpi,jpj) , mgrhv(jpi,jpj) , & 87 89 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , & 90 & ahu_bbl_1(jpi,jpj) , ahv_bbl_1(jpi,jpj) , & 88 91 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , STAT=tra_bbl_alloc ) 89 92 ! … … 195 198 ALLOCATE(zptb(1:jpi, 1:jpj)) 196 199 ! 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 ! 197 209 DO jn = 1, kjpt ! tracer loop 198 210 ! ! =========== … … 209 221 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,ik) 210 222 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) ) ) * zbtr223 & + ( 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 215 227 END DO 216 228 END DO … … 594 606 ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:) * vmask(:,:,1) 595 607 596 597 608 IF( cp_cfg == "orca" ) THEN !* ORCA configuration : regional enhancement of ah_bbl 598 609 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r6498 r11442 32 32 USE wrk_nemo ! Memory allocation 33 33 USE timing ! Timing 34 USE stopack 34 35 35 36 IMPLICIT NONE … … 43 44 REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: t0_ldf, s0_ldf !: lateral diffusion trends of T & S for a cst profile 44 45 ! ! (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 45 52 46 53 !! * Substitutions … … 75 82 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 76 83 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 77 127 78 128 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 33 33 USE wrk_nemo ! Memory Allocation 34 34 USE timing ! Timing 35 USE stopack 35 36 36 37 IMPLICIT NONE … … 52 53 53 54 ! Module variables 54 REAL(wp) :: xsi0r!: inverse of rn_si055 REAL(wp), ALLOCATABLE :: xsi0r(:,:) !: inverse of rn_si0 55 56 REAL(wp) :: xsi1r !: inverse of rn_si1 56 57 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) … … 182 183 ! ! ============================================== ! 183 184 ! 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 ! ! ------------------------- ! 185 192 IF( ln_qsr_rgb) THEN ! R-G-B light penetration ! 186 193 ! ! ------------------------- ! … … 251 258 !CDIR NOVERRCHK 252 259 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) ) 254 261 zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) ) 255 262 zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) ) … … 285 292 DO jj = 1, jpj 286 293 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) ) 288 295 zc1 = zcoef * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 289 296 zc2 = zcoef * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) … … 310 317 ! ! ------------------------- ! 311 318 ! 312 IF( lk_vvl ) THEN !* variable volume 319 IF( lk_vvl .OR. ( ln_stopack .AND. ( nn_spp_qsi0 > 0 ) ) ) THEN !* variable volume 320 313 321 zz0 = rn_abs * r1_rau0_rcp 314 322 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp … … 316 324 DO jj = 1, jpj 317 325 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 ) 320 328 qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 321 329 END DO … … 326 334 DO jj = 1, jpj 327 335 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 ) 330 338 fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 331 339 END DO … … 492 500 ! ! ===================================== ! 493 501 ! 502 ALLOCATE( xsi0r(jpi,jpj) ) 494 503 xsi0r = 1.e0 / rn_si0 495 504 xsi1r = 1.e0 / rn_si1 … … 546 555 !CDIR NOVERRCHK 547 556 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) ) 549 558 zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekb(ji,jj) ) 550 559 zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekg(ji,jj) ) … … 587 596 DO jj = 1, jpj ! top 400 meters 588 597 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 ) 591 600 etot3(ji,jj,jk) = ( zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1) ) * tmask(ji,jj,1) 592 601 END DO -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r6486 r11442 29 29 USE lib_mpp ! MPP library 30 30 USE wrk_nemo ! Memory allocation 31 USE stopack 31 32 32 33 IMPLICIT NONE … … 68 69 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 69 70 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 ) 70 73 71 74 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r10302 r11442 32 32 USE iom ! I/O manager library 33 33 USE lib_mpp ! MPP library 34 USE stopack 34 35 USE wrk_nemo ! Memory allocation 35 36 … … 271 272 ! ! 3D output of tracers trends using IOM interface 272 273 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 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 275 278 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 276 279 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r6486 r11442 26 26 USE wrk_nemo ! Memory Allocation 27 27 USE phycst, ONLY: vkarmn 28 USE stopack 28 29 29 30 IMPLICIT NONE … … 52 53 REAL(wp), PUBLIC :: rn_tfrz0 ! bottom roughness for loglayer bfr coeff (PUBLIC for TAM) 53 54 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) 55 56 56 57 !! * Substitutions … … 68 69 !! *** FUNCTION zdf_bfr_alloc *** 69 70 !!---------------------------------------------------------------------- 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 ) 71 72 ! 72 73 IF( lk_mpp ) CALL mpp_sum ( zdf_bfr_alloc ) … … 105 106 WRITE(numout,*) 'zdf_bfr : Set bottom friction coefficient (non-linear case)' 106 107 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) 107 113 ENDIF 108 114 ! … … 486 492 ENDIF 487 493 ! 494 bfrcoef2d0(:,:) = bfrcoef2d(:,:) 488 495 IF( nn_timing == 1 ) CALL timing_stop('zdf_bfr_init') 489 496 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r7061 r11442 25 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 26 USE timing ! Timing 27 USE stopack 27 28 28 29 IMPLICIT NONE … … 30 31 31 32 PUBLIC zdf_evd ! called by step.F90 33 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rn_avevd0 32 34 33 35 !! * Substitutions … … 69 71 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 70 72 IF(lwp) WRITE(numout,*) 73 ALLOCATE ( rn_avevd0(jpi,jpj) ) 74 rn_avevd0(:,:) = rn_avevd 71 75 ENDIF 72 76 73 77 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 74 83 75 84 SELECT CASE ( nn_evdm ) … … 88 97 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 89 98 #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) 96 105 ENDIF 97 106 END DO … … 115 124 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 116 125 #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) 118 127 END DO 119 128 END DO -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r10302 r11442 32 32 USE timing ! Timing 33 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 34 USE stopack 34 35 35 36 IMPLICIT NONE … … 806 807 END DO 807 808 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 808 813 END DO 809 814 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r10302 r11442 57 57 USE agrif_opa_update 58 58 #endif 59 60 59 USE stopack 61 60 62 61 IMPLICIT NONE … … 94 93 95 94 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 term97 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: efr ! surface boundary condition for nn_etau = 498 95 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 99 96 #if defined key_c1d … … 102 99 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_pdl, e_ric !: prandl and local Richardson numbers 103 100 #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 105 105 !! * Substitutions 106 106 # include "domzgr_substitute.h90" … … 184 184 avmu(:,:,:) = avmu_k(:,:,:) 185 185 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 187 210 ! 188 211 CALL tke_tke ! now tke (en) … … 199 222 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 200 223 #endif 201 ! 224 IF ( kt == nitend ) THEN 225 DEALLOCATE ( rn_lc0, rn_ediff0, rn_ediss0, rn_ebb0, rn_efr0 ) 226 ENDIF 227 ! 228 202 229 END SUBROUTINE zdf_tke 203 230 … … 225 252 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 226 253 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 227 REAL(wp) :: z bbrau, zesh2! temporary scalars228 REAL(wp) :: zfact1 , zfact2, zfact3! - -254 REAL(wp) :: zesh2 ! temporary scalars 255 REAL(wp) :: zfact1 ! - - 229 256 REAL(wp) :: ztx2 , zty2 , zcof ! - - 230 257 REAL(wp) :: ztau , zdif ! - - … … 233 260 !!bfr REAL(wp) :: zebot ! - - 234 261 INTEGER , POINTER, DIMENSION(:,: ) :: imlc 235 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc 262 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc, zbbrau,zfact2,zfact3 236 263 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw 237 264 !!-------------------------------------------------------------------- … … 240 267 ! 241 268 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 ) 243 273 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 244 274 ! 245 zbbrau = rn_ebb / rau0 ! Local constant initialisation275 zbbrau = rn_ebb0 / rau0 ! Local constant initialisation 246 276 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 249 279 ! 250 280 ! … … 261 291 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 262 292 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) 264 294 END DO 265 295 END DO … … 326 356 ! ! vertical velocity due to LC 327 357 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) ) 329 359 ! ! TKE Langmuir circulation source term 330 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) 360 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) )* ( zwlc * zwlc * zwlc ) / & 331 361 & zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 362 332 363 END DO 333 364 END DO … … 380 411 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) 381 412 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) 383 414 ! 384 415 ! ! right hand side in en 385 416 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) ) & 387 418 & * wmask(ji,jj,jk) 388 419 END DO … … 455 486 DO jj = 2, jpjm1 456 487 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) ) & 458 489 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 459 490 END DO … … 464 495 DO ji = fs_2, fs_jpim1 ! vector opt. 465 496 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) ) & 467 498 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 468 499 END DO … … 480 511 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 481 512 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) ) & 483 514 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 484 515 END DO … … 516 547 CALL wrk_dealloc( jpi,jpj, imlc ) ! integer 517 548 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 ) 518 552 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw ) 519 553 ! … … 698 732 DO ji = fs_2, fs_jpim1 ! vector opt. 699 733 zsqen = SQRT( en(ji,jj,jk) ) 700 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen734 zav = rn_ediff0(ji,jj) * zmxlm(ji,jj,jk) * zsqen 701 735 avm (ji,jj,jk) = MAX( zav, avmb(jk) ) * wmask(ji,jj,jk) 702 736 avt (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) … … 704 738 END DO 705 739 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 706 744 END DO 707 745 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) … … 840 878 rn_mxl0 = rmxl_min 841 879 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 842 886 843 887 IF( nn_etau == 2 ) THEN … … 952 996 CALL tke_avn ! recompute avt, avm, avmu, avmv and dissl (approximation) 953 997 ! 954 avt_k (:,:,:) = avt (:,:,:)955 avm_k (:,:,:) = avm (:,:,:)956 avmu_k(:,:,:) = avmu(:,:,:)957 avmv_k(:,:,:) = avmv(:,:,:)958 !959 998 DO jit = nit000 + 1, nit000 + 10 ; CALL zdf_tke( jit ) ; END DO 960 999 ENDIF 961 1000 ELSE !* Start from rest 962 1001 en(:,:,:) = rn_emin * tmask(:,:,:) 963 DO jk = 1, jpk ! set the Kz to the background value964 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 DO969 1002 ENDIF 970 1003 ! 1004 avt_k (:,:,:) = avt (:,:,:) 1005 avm_k (:,:,:) = avm (:,:,:) 1006 avmu_k(:,:,:) = avmu(:,:,:) 1007 avmv_k(:,:,:) = avmv(:,:,:) 1008 971 1009 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 972 1010 ! ! ------------------- -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r10302 r11442 86 86 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 87 87 USE sbc_oce, ONLY: lk_oasis 88 USE stopack 88 89 USE stopar 89 90 USE stopts … … 487 488 CALL dia_hsb_init ! heat content, salt content and volume budgets 488 489 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends 490 CALL stopack_init ! STOPACK scheme 489 491 IF( lk_diaobs ) THEN ! Observation & model comparison 490 492 CALL dia_obs_init ! Initialize observational data -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/step.F90
r10302 r11442 118 118 CALL lbc_lnk( tsb(:,:,:,tind), 'T', 1. ) 119 119 END DO 120 120 121 IF( ln_stopack ) CALL stopack_pert( kstp ) 121 122 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) 122 123 ! clem: moved here for bdy ice purpose 124 123 125 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 124 126 ! Update stochastic parameters and random T/S fluctuations 125 127 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 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 128 132 129 133 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 149 153 ENDIF 150 154 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 152 160 ENDIF 153 161 IF( ln_zdfevd ) CALL zdf_evd( kstp ) ! enhanced vertical eddy diffusivity … … 163 171 IF( lrst_oce .AND. lk_zdftke ) CALL tke_rst( kstp, 'WRITE' ) 164 172 IF( lrst_oce .AND. lk_zdfgls ) CALL gls_rst( kstp, 'WRITE' ) 173 IF( lrst_oce .AND. ln_stopack) CALL stopack_rst( kstp, 'WRITE' ) 165 174 ! 166 175 ! LATERAL PHYSICS 167 176 ! 168 177 IF( lk_ldfslp ) THEN ! slope of lateral mixing 169 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density178 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 170 179 IF( ln_zps .AND. .NOT. ln_isfcav) & 171 180 & CALL zps_hde ( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient … … 202 211 ! Note that the computation of vertical velocity above, hence "after" sea level 203 212 ! 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 205 215 IF( ln_zps .AND. .NOT. ln_isfcav) & 206 216 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient … … 214 224 va(:,:,:) = 0.e0 215 225 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) 223 235 #if defined key_agrif 224 236 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn ! momentum sponge … … 264 276 tsa(:,:,:,:) = 0.e0 ! set tracer trends to zero 265 277 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 268 282 CALL tra_sbc ( kstp ) ! surface boundary condition 269 283 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr … … 282 296 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge 283 297 #endif 298 IF( ln_stopack .AND. ln_sppt_tra ) & 299 & CALL tra_sppt_apply ( kstp, 1 ) 284 300 CALL tra_zdf ( kstp ) ! vertical mixing and after tracer fields 285 301 … … 287 303 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 288 304 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 ) 289 307 CALL eos ( tsa, rhd, rhop, fsdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation 290 308 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 310 328 CALL tra_nxt( kstp ) ! tracer fields at next time step 311 329 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 312 341 ENDIF 313 342 … … 326 355 327 356 CALL dyn_bfr( kstp ) ! bottom friction 357 IF( ln_stopack .AND. ln_sppt_dyn ) & 358 & CALL dyn_sppt_apply ( kstp, 1 ) 328 359 CALL dyn_zdf( kstp ) ! vertical diffusion 329 360 ELSE … … 333 364 IF( lk_asminc .AND. ln_asmiau .AND. & 334 365 & 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 ) 335 368 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields 336 369 IF( ln_neptsimp ) CALL dyn_nept_cor( kstp ) ! subtract Neptune velocities (simplified) … … 345 378 CALL dyn_hpg( kstp ) ! horizontal gradient of Hydrostatic pressure 346 379 CALL dyn_bfr( kstp ) ! bottom friction 380 IF( ln_stopack .AND. ln_sppt_dyn ) & 381 & CALL dyn_sppt_apply ( kstp, 1 ) 347 382 CALL dyn_zdf( kstp ) ! vertical diffusion 348 383 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 349 384 ENDIF 350 385 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 ) 351 390 352 391 CALL ssh_swp( kstp ) ! swap of sea surface height … … 384 423 ENDIF 385 424 386 387 425 IF( lrst_bias ) CALL bias_wrt ( kstp ) 388 426 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r8400 r11442 96 96 USE diahsb ! heat, salt and volume budgets (dia_hsb routine) 97 97 USE diaharm 98 USE diaprod ! ocean model: product diagnostics 98 99 USE flo_oce ! floats variables 99 100 USE floats ! floats computation (flo_stp routine) … … 113 114 USE timing ! Timing 114 115 116 USE stopack ! Stochastic physics 117 115 118 #if defined key_agrif 116 119 USE agrif_opa_sponge ! Momemtum and tracers sponges
Note: See TracChangeset
for help on using the changeset viewer.
