Changeset 13189
- Timestamp:
- 2020-07-01T11:27:25+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback
- Files:
-
- 1 deleted
- 143 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@12931 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg
r12565 r13189 81 81 ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk ) 82 82 ! Sea-ice : 83 nn_ice = 2 ! =2 or 3 automatically for SI3 or CICE ("key_si3" or "key_cice") 84 ! except in AGRIF zoom where it has to be specified 83 nn_ice = 2 ! =0 no ice boundary condition 84 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 85 ! ! =2 or 3 for SI3 and CICE, respectively 85 86 ! Misc. options of sbc : 86 87 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/AGRIF_DEMO/EXPREF/2_namelist_cfg
r12565 r13189 78 78 ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk ) 79 79 ! Sea-ice : 80 nn_ice = 2 ! =0 Use SI3 model 80 nn_ice = 2 ! =0 no ice boundary condition 81 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 82 ! ! =2 or 3 for SI3 and CICE, respectively 81 83 ! Misc. options of sbc : 82 84 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/AGRIF_DEMO/EXPREF/3_namelist_cfg
r12495 r13189 78 78 ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk ) 79 79 ! Sea-ice : 80 nn_ice = 2 ! =0 Use SI3 model 80 nn_ice = 2 ! =0 no ice boundary condition 81 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 82 ! ! =2 or 3 for SI3 and CICE, respectively 81 83 ! Misc. options of sbc : 82 84 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
r12565 r13189 81 81 ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk ) 82 82 ! Sea-ice : 83 nn_ice = 2 ! =2 or 3 automatically for SI3 or CICE ("key_si3" or "key_cice") 84 ! except in AGRIF zoom where it has to be specified 83 nn_ice = 2 ! =0 no ice boundary condition 84 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 85 ! ! =2 or 3 for SI3 and CICE, respectively 85 86 ! Misc. options of sbc : 86 87 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/C1D_PAPA/EXPREF/file_def_nemo-oce.xml
r9799 r13189 53 53 <file id="file4" name_suffix="_grid_W" description="ocean W grid variables" > 54 54 <field field_ref="e3w" /> 55 <field field_ref="woce" name="wo" />56 55 <field field_ref="avt" name="difvho" /> 57 56 </file> -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/C1D_PAPA/EXPREF/namelist_cfg
r12495 r13189 49 49 &namdom ! time and space domain 50 50 !----------------------------------------------------------------------- 51 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 52 ! 51 53 rn_Dt = 360. ! time step for the dynamics and tracer 52 54 / … … 358 360 &namdyn_spg ! surface pressure gradient (default: NO selection) 359 361 !----------------------------------------------------------------------- 360 ln_dynspg_ts = .true. ! split-explicit free surface361 ln_bt_fw = .false. ! Forward integration of barotropic Eqs.362 ln_bt_av = .true. ! Time filtering of barotropic variables363 362 / 364 363 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/C1D_PAPA/MY_SRC/usrdef_zgr.F90
r12377 r13189 30 30 PUBLIC usr_def_zgr ! called by domzgr.F90 31 31 32 !! * Substitutions 33 # include "do_loop_substitute.h90" 32 34 !!---------------------------------------------------------------------- 33 35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 157 159 pe3vw(:,:,jk) = pe3w_1d (jk) 158 160 END DO 159 DO jj = 1, jpj ! bottom scale factors and depth at T- and W-points 160 DO ji = 1, jpi 161 ik = k_bot(ji,jj) 162 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 163 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 164 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 165 ! 166 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 167 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 168 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik ) 169 END DO 170 END DO 161 ! bottom scale factors and depth at T- and W-points 162 DO_2D_11_11 163 ik = k_bot(ji,jj) 164 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 165 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 166 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 167 ! 168 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 169 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 170 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik ) 171 END_2D 171 172 ! ! bottom scale factors and depth at U-, V-, UW and VW-points 172 173 ! ! usually Computed as the minimum of neighbooring scale factors -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/ORCA2_ICE_ABL/EXPREF/namelist_cfg
r12565 r13189 84 84 ln_abl = .true. ! ABL formulation (T => fill namsbc_abl ) 85 85 ! Sea-ice : 86 nn_ice = 2 ! =2 or 3 automatically for SI3 or CICE ("key_si3" or "key_cice") 87 ! except in AGRIF zoom where it has to be specified 86 nn_ice = 2 ! =0 no ice boundary condition 87 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 88 ! ! =2 or 3 for SI3 and CICE, respectively 88 89 ! Misc. options of sbc : 89 90 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg
r12551 r13189 80 80 ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk ) 81 81 ! Sea-ice : 82 nn_ice = 2 ! =2 or 3 automatically for SI3 or CICE ("key_si3" or "key_cice") 83 ! except in AGRIF zoom where it has to be specified 82 nn_ice = 2 ! =0 no ice boundary condition 83 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 84 ! ! =2 or 3 for SI3 and CICE, respectively 84 85 ! Misc. options of sbc : 85 86 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_top_cfg
r12377 r13189 20 20 ! 21 21 ln_trcdta = .true. ! Initialisation from data input file (T) or not (F) 22 ln_trcbc = . true.! Enables Boundary conditions22 ln_trcbc = .false. ! Enables Boundary conditions 23 23 ! ! ! ! ! ! 24 24 ! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_top_cfg
r12377 r13189 20 20 ! 21 21 ln_trcdta = .true. ! Initialisation from data input file (T) or not (F) 22 ln_trcbc = . true.! Enables Boundary conditions22 ln_trcbc = .false. ! Enables Boundary conditions 23 23 ! ! ! ! ! ! 24 24 ! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg
r12565 r13189 59 59 nn_fsbc = 1 ! frequency of SBC module call 60 60 ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk ) 61 nn_ice = 2 ! =2 sea-ice model ("key_SI3" or "key_cice") 61 nn_ice = 2 ! =0 no ice boundary condition 62 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 63 ! ! =2 or 3 for SI3 and CICE, respectively 62 64 / 63 65 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/SHARED/field_def_nemo-oce.xml
r12377 r13189 1 <?xml version="1.0"?> 1 <?xml version="1.0"?> 2 2 <!-- $id$ --> 3 3 … … 16 16 Configuration of multiple-linear-regression analysis (diamlr) 17 17 ===================================================================================================== 18 18 19 19 This field group configures diamlr for tidal harmonic analysis of field 20 20 ssh: in addition to a regressor for fitting the mean value (diamlr_r101), … … 73 73 74 74 </field_group> 75 76 <!-- 75 76 <!-- 77 77 ============================================================================================================ 78 78 = definition of all existing variables = … … 101 101 </field_group> 102 102 103 <!-- 103 <!-- 104 104 ============================================================================================================ 105 105 Physical ocean model variables … … 108 108 109 109 <!-- T grid --> 110 110 111 111 <field_group id="grid_T" grid_ref="grid_T_2D" > 112 112 <field id="e3t" long_name="T-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_T_3D" /> 113 113 <field id="e3ts" long_name="T-cell thickness" field_ref="e3t" standard_name="cell_thickness" unit="m" grid_ref="grid_T_SFC"/> 114 114 <field id="e3t_0" long_name="Initial T-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_T_3D" /> 115 <field id="e3tb" long_name="bottom T-cell thickness" standard_name="bottom_cell_thickness" unit="m" grid_ref="grid_T_2D"/> 115 <field id="e3tb" long_name="bottom T-cell thickness" standard_name="bottom_cell_thickness" unit="m" grid_ref="grid_T_2D"/> 116 116 <field id="e3t_300" field_ref="e3t" grid_ref="grid_T_zoom_300" detect_missing_value="true" /> 117 117 <field id="e3t_vsum300" field_ref="e3t_300" grid_ref="grid_T_vsum" detect_missing_value="true" /> 118 118 <field id="masscello" long_name="Sea Water Mass per unit area" standard_name="sea_water_mass_per_unit_area" unit="kg/m2" grid_ref="grid_T_3D"/> 119 <field id="volcello" long_name="Ocean Volume" standard_name="ocean_volume" unit="m3" grid_ref="grid_T_3D"/> 119 <field id="volcello" long_name="Ocean Volume" standard_name="ocean_volume" unit="m3" grid_ref="grid_T_3D"/> 120 120 <field id="toce" long_name="temperature" standard_name="sea_water_potential_temperature" unit="degC" grid_ref="grid_T_3D"/> 121 121 <field id="toce_e3t" long_name="temperature (thickness weighted)" unit="degC" grid_ref="grid_T_3D" > toce * e3t </field > … … 146 146 <field id="sst_cs" long_name="Delta SST of cool skin" unit="degC" /> 147 147 <field id="temp_3m" long_name="temperature at 3m" unit="degC" /> 148 148 149 149 <field id="sss" long_name="sea surface salinity" standard_name="sea_surface_salinity" unit="1e-3" /> 150 150 <field id="sss2" long_name="square of sea surface salinity" unit="1e-6" > sss * sss </field > … … 152 152 <field id="sssmin" long_name="min of sea surface salinity" field_ref="sss" operation="minimum" /> 153 153 <field id="sbs" long_name="sea bottom salinity" unit="0.001" /> 154 <field id="somint" long_name="vertical integral of salinity times density" standard_name="integral_wrt_depth_of_product_of_density_and_salinity" unit="(kg m2) x (1e-3)" /> 155 156 <field id="taubot" long_name="bottom stress module" unit="N/m2" /> 154 <field id="somint" long_name="vertical integral of salinity times density" standard_name="integral_wrt_depth_of_product_of_density_and_salinity" unit="(kg m2) x (1e-3)" /> 155 156 <field id="taubot" long_name="bottom stress module" unit="N/m2" /> 157 157 158 158 <!-- Case EOS = TEOS-10 : output potential temperature --> … … 295 295 <field id="us_y" long_name="j component of Stokes drift" unit="m/s" /> 296 296 </field_group> 297 297 298 298 <!-- SBC --> 299 299 <field_group id="SBC" > <!-- time step automaticaly defined based on nn_fsbc --> … … 311 311 <field id="precip" long_name="Total precipitation" standard_name="precipitation_flux" unit="kg/m2/s" /> 312 312 <field id="wclosea" long_name="closed sea empmr correction" standard_name="closea_empmr" unit="kg/m2/s" /> 313 313 314 314 <field id="qt" long_name="Net Downward Heat Flux" standard_name="surface_downward_heat_flux_in_sea_water" unit="W/m2" /> 315 315 <field id="qns" long_name="non solar Downward Heat Flux" unit="W/m2" /> … … 321 321 <field id="taum" long_name="wind stress module" standard_name="magnitude_of_surface_downward_stress" unit="N/m2" /> 322 322 <field id="wspd" long_name="wind speed module" standard_name="wind_speed" unit="m/s" /> 323 323 324 324 <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn --> 325 325 <field id="ssh_ib" long_name="Inverse barometer sea surface height" standard_name="sea_surface_height_correction_due_to_air_pressure_at_low_frequency" unit="m" /> … … 369 369 <field id="taum_oce" long_name="wind stress module over open ocean" standard_name="magnitude_of_surface_downward_stress" unit="N/m2" /> 370 370 371 <!-- variables computed by the bulk parameterization algorithms (ln_blk) --> 372 <field id="Cd_oce" long_name="Drag coefficient over open ocean" standard_name="drag_coefficient_water" unit="" /> 373 <field id="Ce_oce" long_name="Evaporaion coefficient over open ocean" standard_name="evap_coefficient_water" unit="" /> 374 <field id="Ch_oce" long_name="Sensible heat coefficient over open ocean" standard_name="sensible_heat_coefficient_water" unit="" /> 375 <field id="theta_zt" long_name="Potential air temperature at z=zt" standard_name="potential_air_temperature_at_zt" unit="degC" /> 376 <field id="q_zt" long_name="Specific air humidity at z=zt" standard_name="specific_air_humidity_at_zt" unit="kg/kg" /> 377 <field id="theta_zu" long_name="Potential air temperature at z=zu" standard_name="potential_air_temperature_at_zu" unit="degC" /> 378 <field id="q_zu" long_name="Specific air humidity at z=zu" standard_name="specific_air_humidity_at_zu" unit="kg/kg" /> 379 <field id="ssq" long_name="Saturation specific humidity of air at z=0" standard_name="surface_air_saturation_spec_humidity" unit="kg/kg" /> 380 <field id="wspd_blk" long_name="Bulk wind speed at z=zu" standard_name="bulk_wind_speed_at_zu" unit="m/s" /> 381 <!-- ln_blk + key_si3 --> 382 <field id="Cd_ice" long_name="Drag coefficient over ice" standard_name="drag_coefficient_ice" unit="" /> 383 <field id="Ce_ice" long_name="Evaporaion coefficient over ice" standard_name="evap_coefficient_ice" unit="" /> 384 <field id="Ch_ice" long_name="Sensible heat coefficient over ice" standard_name="sensible_heat_coefficient_ice" unit="" /> 385 371 386 <!-- available key_oasis3 --> 372 387 <field id="snow_ao_cea" long_name="Snow over ice-free ocean (cell average)" standard_name="snowfall_flux" unit="kg/m2/s" /> … … 405 420 <!-- ice field (nn_ice=1) --> 406 421 <field id="ice_cover" long_name="Ice fraction" standard_name="sea_ice_area_fraction" unit="1" /> 407 422 408 423 <!-- dilution --> 409 424 <field id="emp_x_sst" long_name="Concentration/Dilution term on SST" unit="kg*degC/m2/s" /> 410 <field id="emp_x_sss" long_name="Concentration/Dilution term on SSS" unit="kg*1e-3/m2/s" /> 425 <field id="emp_x_sss" long_name="Concentration/Dilution term on SSS" unit="kg*1e-3/m2/s" /> 411 426 <field id="rnf_x_sst" long_name="Runoff term on SST" unit="kg*degC/m2/s" /> 412 427 <field id="rnf_x_sss" long_name="Runoff term on SSS" unit="kg*1e-3/m2/s" /> 413 428 414 429 <!-- sbcssm variables --> 415 430 <field id="sst_m" unit="degC" /> … … 422 437 423 438 </field_group> 424 439 425 440 426 441 </field_group> <!-- SBC --> 427 442 428 443 <!-- ABL --> 429 444 <field_group id="ABL" > <!-- time step automaticaly defined based on nn_fsbc --> … … 456 471 <field id="uz1_dta" long_name="DTA i-horizontal velocity" standard_name="dta_x_velocity" unit="m/s" /> 457 472 <field id="vz1_dta" long_name="DTA j-horizontal velocity" standard_name="dta_y_velocity" unit="m/s" /> 458 <field id="uvz1_dta" long_name="DTA wind speed module" standard_name="dta_wind_speed" unit="m/s" > sqrt( uz1_dta^2 + vz1_dta^2 ) </field> 473 <field id="uvz1_dta" long_name="DTA wind speed module" standard_name="dta_wind_speed" unit="m/s" > sqrt( uz1_dta^2 + vz1_dta^2 ) </field> 459 474 <field id="tz1_dta" long_name="DTA potential temperature" standard_name="dta_theta" unit="K" /> 460 475 <field id="qz1_dta" long_name="DTA specific humidity" standard_name="dta_qspe" unit="kg/kg" /> … … 462 477 <field id="uz1_geo" long_name="GEO i-horizontal velocity" standard_name="geo_x_velocity" unit="m/s" /> 463 478 <field id="vz1_geo" long_name="GEO j-horizontal velocity" standard_name="geo_y_velocity" unit="m/s" /> 464 <field id="uvz1_geo" long_name="GEO wind speed module" standard_name="geo_wind_speed" unit="m/s" > sqrt( uz1_geo^2 + vz1_geo^2 ) </field> 479 <field id="uvz1_geo" long_name="GEO wind speed module" standard_name="geo_wind_speed" unit="m/s" > sqrt( uz1_geo^2 + vz1_geo^2 ) </field> 465 480 </field_group> 466 481 467 482 </field_group> <!-- ABL --> 468 483 469 484 470 485 <!-- U grid --> 471 486 472 487 <field_group id="grid_U" grid_ref="grid_U_2D"> 473 488 <field id="e2u" long_name="U-cell width in meridional direction" standard_name="cell_width" unit="m" /> … … 478 493 <field id="uoce_e3u" long_name="ocean current along i-axis (thickness weighted)" unit="m/s" grid_ref="grid_U_3D" > uoce * e3u </field> 479 494 <field id="uoce_e3u_vsum" long_name="ocean current along i-axis * e3u summed on the vertical" field_ref="uoce_e3u" unit="m3/s" grid_ref="grid_U_vsum"/> 480 <field id="uocetr_vsum" long_name="ocean transport along i-axis summed on the vertical" field_ref="e2u" unit="m3/s"> this * uoce_e3u_vsum </field> 495 <field id="uocetr_vsum" long_name="ocean transport along i-axis summed on the vertical" field_ref="e2u" unit="m3/s"> this * uoce_e3u_vsum </field> 481 496 482 497 <field id="uocetr_vsum_op" long_name="ocean current along i-axis * e3u * e2u summed on the vertical" read_access="true" freq_op="1mo" field_ref="e2u" unit="m3/s"> @uocetr_vsum </field> 483 <field id="uocetr_vsum_cumul" long_name="ocean current along i-axis * e3u * e2u cumulated from southwest point" freq_offset="_reset_" operation="instant" freq_op="1mo" unit="m3/s" /> 498 <field id="uocetr_vsum_cumul" long_name="ocean current along i-axis * e3u * e2u cumulated from southwest point" freq_offset="_reset_" operation="instant" freq_op="1mo" unit="m3/s" /> 484 499 <field id="msftbarot" long_name="ocean_barotropic_mass_streamfunction" unit="kg s-1" > uocetr_vsum_cumul * $rau0 </field> 485 500 … … 534 549 <field id="udiff_salttr" long_name="ocean diffusion salt transport along i-axis" standard_name="ocean_salt_x_transport_due_to_diffusion" unit="1e-3*kg/s" /> 535 550 </field_group> 536 551 537 552 <!-- V grid --> 538 553 539 554 <field_group id="grid_V" grid_ref="grid_V_2D"> 540 555 <field id="e1v" long_name="V-cell width in longitudinal direction" standard_name="cell_width" unit="m" /> … … 593 608 <field id="vdiff_salttr" long_name="ocean diffusion salt transport along j-axis" standard_name="ocean_salt_y_transport_due_to_diffusion" unit="1e-3*kg/s" /> 594 609 </field_group> 595 610 596 611 <!-- W grid --> 597 612 598 613 <field_group id="grid_W" grid_ref="grid_W_3D"> 599 614 <field id="e3w" long_name="W-cell thickness" standard_name="cell_thickness" unit="m" /> 600 615 <field id="woce" long_name="ocean vertical velocity" standard_name="upward_sea_water_velocity" unit="m/s" /> 601 <field id="woce_e3w" long_name="ocean vertical velocity * e3w" unit="m2/s" > woce * e3w </field> 616 <field id="woce_e3w" long_name="ocean vertical velocity * e3w" unit="m2/s" > woce * e3w </field> 602 617 <field id="wocetr_eff" long_name="effective ocean vertical transport" unit="m3/s" /> 603 618 … … 609 624 610 625 <field id="avt" long_name="vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" /> 611 <field id="avt_e3w" long_name="vertical heat diffusivity * e3w" unit="m3/s" > avt * e3w </field> 626 <field id="avt_e3w" long_name="vertical heat diffusivity * e3w" unit="m3/s" > avt * e3w </field> 612 627 <field id="logavt" long_name="logarithm of vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" /> 613 628 <field id="avm" long_name="vertical eddy viscosity" standard_name="ocean_vertical_momentum_diffusivity" unit="m2/s" /> 614 <field id="avm_e3w" long_name="vertical eddy viscosity * e3w" unit="m3/s" > avm * e3w </field> 629 <field id="avm_e3w" long_name="vertical eddy viscosity * e3w" unit="m3/s" > avm * e3w </field> 615 630 616 631 <!-- avs: /= avt with ln_zdfddm=T --> 617 632 <field id="avs" long_name="salt vertical eddy diffusivity" standard_name="ocean_vertical_salt_diffusivity" unit="m2/s" /> 618 <field id="avs_e3w" long_name="vertical salt diffusivity * e3w" unit="m3/s" > avs * e3w </field> 633 <field id="avs_e3w" long_name="vertical salt diffusivity * e3w" unit="m3/s" > avs * e3w </field> 619 634 <field id="logavs" long_name="logarithm of salt vertical eddy diffusivity" standard_name="ocean_vertical_heat_diffusivity" unit="m2/s" /> 620 635 621 636 <!-- avt_evd and avm_evd: available with ln_zdfevd --> 622 637 <field id="avt_evd" long_name="convective enhancement of vertical diffusivity" standard_name="ocean_vertical_tracer_diffusivity_due_to_convection" unit="m2/s" /> 623 <field id="avt_evd_e3w" long_name="convective enhancement to vertical diffusivity * e3w " unit="m3/s" > avt_evd * e3w </field> 638 <field id="avt_evd_e3w" long_name="convective enhancement to vertical diffusivity * e3w " unit="m3/s" > avt_evd * e3w </field> 624 639 <field id="avm_evd" long_name="convective enhancement of vertical viscosity" standard_name="ocean_vertical_momentum_diffusivity_due_to_convection" unit="m2/s" /> 625 640 … … 634 649 <field id="wstokes" long_name="Stokes Drift vertical velocity" standard_name="upward_StokesDrift_velocity" unit="m/s" /> 635 650 636 <!-- variables available with diaar5 --> 651 <!-- variables available with diaar5 --> 637 652 <field id="w_masstr" long_name="vertical mass transport" standard_name="upward_ocean_mass_transport" unit="kg/s" /> 638 653 <field id="w_masstr2" long_name="square of vertical mass transport" standard_name="square_of_upward_ocean_mass_transport" unit="kg2/s2" /> 639 654 640 655 </field_group> 641 656 642 657 <!-- F grid --> 643 658 <!-- AGRIF sponge --> … … 694 709 </field_group> 695 710 696 711 697 712 <!-- variables available with ln_floats --> 698 713 … … 709 724 <!-- variables available with iceberg trajectories --> 710 725 711 <field_group id="icbvar" domain_ref="grid_T" > 726 <field_group id="icbvar" domain_ref="grid_T" > 712 727 <field id="berg_melt" long_name="icb melt rate of icebergs" unit="kg/m2/s" /> 713 728 <field id="berg_melt_hcflx" long_name="icb heat flux to ocean due to melting heat content" unit="J/m2/s" /> … … 727 742 </field_group> 728 743 729 <!-- Poleward transport : ptr --> 730 <field_group id="diaptr" > 744 <!-- Poleward transport : ptr --> 745 <field_group id="diaptr" > 731 746 <field id="zomsf" long_name="Overturning Stream-Function : All basins" unit="Sv" grid_ref="grid_znl_W_3D" /> 732 747 <field id="zotem" long_name="Zonal Mean Temperature : All basins" unit="degree_C" grid_ref="grid_znl_T_3D" /> … … 736 751 <field id="sopstove" long_name="Overturning Salt Transport: All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> 737 752 <field id="sophtbtr" long_name="Barotropic Heat Transport: All basins" unit="PW" grid_ref="grid_znl_T_2D" /> 738 <field id="sopstbtr" long_name="Barotropic Salt Transport: All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> 753 <field id="sopstbtr" long_name="Barotropic Salt Transport: All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> 739 754 <field id="sophtadv" long_name="Advective Heat Transport: All basins" unit="PW" grid_ref="grid_znl_T_2D" /> 740 755 <field id="sopstadv" long_name="Advective Salt Transport: All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> … … 742 757 <field id="sopstldf" long_name="Diffusive Salt Transport: All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> 743 758 <field id="sophtvtr" long_name="Heat Transport : All basins" unit="PW" grid_ref="grid_znl_T_2D" /> 744 <field id="sopstvtr" long_name="Salt Transport : All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> 759 <field id="sopstvtr" long_name="Salt Transport : All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> 745 760 <field id="sophteiv" long_name="Heat Transport from mesoscale eddy advection: All basins" unit="PW" grid_ref="grid_znl_T_2D" /> 746 761 <field id="sopsteiv" long_name="Salt Transport from mesoscale eddy advection : All basins" unit="Giga g/s" grid_ref="grid_znl_T_2D" /> … … 758 773 759 774 760 <!-- 775 <!-- 761 776 ============================================================================================================ 762 777 Physical ocean model trend diagnostics : temperature, KE, PE, momentum … … 899 914 <field id="ketrd_zdf" long_name="ke-trend: vertical diffusion" unit="W/s^3" /> 900 915 <field id="ketrd_tau" long_name="ke-trend: wind stress " unit="W/s^3" grid_ref="grid_T_2D" /> 901 <field id="ketrd_bfr" long_name="ke-trend: bottom friction (explicit)" unit="W/s^3" /> 902 <field id="ketrd_bfri" long_name="ke-trend: bottom friction (implicit)" unit="W/s^3" /> 903 <field id="ketrd_atf" long_name="ke-trend: asselin time filter trend" unit="W/s^3" /> 916 <field id="ketrd_bfr" long_name="ke-trend: bottom friction (explicit)" unit="W/s^3" /> 917 <field id="ketrd_bfri" long_name="ke-trend: bottom friction (implicit)" unit="W/s^3" /> 918 <field id="ketrd_atf" long_name="ke-trend: asselin time filter trend" unit="W/s^3" /> 904 919 <field id="ketrd_convP2K" long_name="ke-trend: conversion (potential to kinetic)" unit="W/s^3" /> 905 <field id="KE" long_name="kinetic energy: u(n)*u(n+1)/2" unit="W/s^2" /> 920 <field id="KE" long_name="kinetic energy: u(n)*u(n+1)/2" unit="W/s^2" /> 906 921 907 922 <!-- variables available when explicit lateral mixing is used (ln_dynldf_OFF=F) --> 908 <field id="dispkexyfo" long_name="KE-trend: lateral mixing induced dissipation" standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction" unit="W/m^2" grid_ref="grid_T_2D" /> 909 <field id="dispkevfo" long_name="KE-trend: vertical mixing induced dissipation" standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction" unit="W/m^2" grid_ref="grid_T_2D" /> 923 <field id="dispkexyfo" long_name="KE-trend: lateral mixing induced dissipation" standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction" unit="W/m^2" grid_ref="grid_T_2D" /> 924 <field id="dispkevfo" long_name="KE-trend: vertical mixing induced dissipation" standard_name="ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction" unit="W/m^2" grid_ref="grid_T_2D" /> 910 925 <!-- variables available with ln_traadv_eiv=T and ln_diaeiv=T --> 911 <field id="eketrd_eiv" long_name="EKE-trend due to parameterized eddy advection" standard_name="tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection" unit="W/m^2" grid_ref="grid_T_2D" /> 926 <field id="eketrd_eiv" long_name="EKE-trend due to parameterized eddy advection" standard_name="tendency_of_ocean_eddy_kinetic_energy_content_due_to_parameterized_eddy_advection" unit="W/m^2" grid_ref="grid_T_2D" /> 912 927 913 928 <!-- variables available with ln_PE_trd --> … … 926 941 <field id="petrd_bbc" long_name="pe-trend: geothermal heating" unit="W/m^3" /> 927 942 <field id="petrd_atf" long_name="pe-trend: asselin time filter" unit="W/m^3" /> 928 <field id="PEanom" long_name="potential energy anomaly" unit="1" /> 929 <field id="alphaPE" long_name="partial deriv. of PEanom wrt T" unit="degC-1" /> 930 <field id="betaPE" long_name="partial deriv. of PEanom wrt S" unit="1e3" /> 943 <field id="PEanom" long_name="potential energy anomaly" unit="1" /> 944 <field id="alphaPE" long_name="partial deriv. of PEanom wrt T" unit="degC-1" /> 945 <field id="betaPE" long_name="partial deriv. of PEanom wrt S" unit="1e3" /> 931 946 </field_group> 932 947 … … 945 960 <field id="utrd_zdf" long_name="i-trend: vertical diffusion" unit="m/s^2" /> 946 961 <field id="utrd_tau" long_name="i-trend: wind stress " unit="m/s^2" grid_ref="grid_U_2D" /> 947 <field id="utrd_bfr" long_name="i-trend: bottom friction (explicit)" unit="m/s^2" /> 948 <field id="utrd_bfri" long_name="i-trend: bottom friction (implicit)" unit="m/s^2" /> 949 <field id="utrd_tot" long_name="i-trend: total momentum trend before atf" unit="m/s^2" /> 950 <field id="utrd_atf" long_name="i-trend: asselin time filter trend" unit="m/s^2" /> 962 <field id="utrd_bfr" long_name="i-trend: bottom friction (explicit)" unit="m/s^2" /> 963 <field id="utrd_bfri" long_name="i-trend: bottom friction (implicit)" unit="m/s^2" /> 964 <field id="utrd_tot" long_name="i-trend: total momentum trend before atf" unit="m/s^2" /> 965 <field id="utrd_atf" long_name="i-trend: asselin time filter trend" unit="m/s^2" /> 951 966 </field_group> 952 967 … … 965 980 <field id="vtrd_zdf" long_name="j-trend: vertical diffusion" unit="m/s^2" /> 966 981 <field id="vtrd_tau" long_name="j-trend: wind stress " unit="m/s^2" grid_ref="grid_V_2D" /> 967 <field id="vtrd_bfr" long_name="j-trend: bottom friction (explicit)" unit="m/s^2" /> 968 <field id="vtrd_bfri" long_name="j-trend: bottom friction (implicit)" unit="m/s^2" /> 969 <field id="vtrd_tot" long_name="j-trend: total momentum trend before atf" unit="m/s^2" /> 970 <field id="vtrd_atf" long_name="j-trend: asselin time filter trend" unit="m/s^2" /> 982 <field id="vtrd_bfr" long_name="j-trend: bottom friction (explicit)" unit="m/s^2" /> 983 <field id="vtrd_bfri" long_name="j-trend: bottom friction (implicit)" unit="m/s^2" /> 984 <field id="vtrd_tot" long_name="j-trend: total momentum trend before atf" unit="m/s^2" /> 985 <field id="vtrd_atf" long_name="j-trend: asselin time filter trend" unit="m/s^2" /> 971 986 </field_group> 972 987 973 988 974 <!-- 989 <!-- 975 990 ============================================================================================================ 976 991 Definitions for iodef_demo.xml … … 990 1005 <field field_ref="strd_zdfp_li" name="osaltdiff" /> 991 1006 </field_group> 992 1007 993 1008 <field_group id="mooring" > 994 1009 <field field_ref="toce" name="thetao" long_name="sea_water_potential_temperature" /> … … 999 1014 <field field_ref="avt" name="difvho" long_name="ocean_vertical_heat_diffusivity" /> 1000 1015 <field field_ref="avm" name="difvmo" long_name="ocean_vertical_momentum_diffusivity" /> 1001 1016 1002 1017 <field field_ref="sst" name="tos" long_name="sea_surface_temperature" /> 1003 1018 <field field_ref="sst2" name="tossq" long_name="square_of_sea_surface_temperature" /> … … 1047 1062 <field field_ref="BLT" name="blt" long_name="Barrier Layer Thickness" /> 1048 1063 </field_group> 1049 1064 1050 1065 <field_group id="groupU" > 1051 1066 <field field_ref="uoce" name="uo" long_name="sea_water_x_velocity" /> 1052 1067 <field field_ref="utau" name="tauuo" long_name="surface_downward_x_stress" /> 1053 1068 </field_group> 1054 1069 1055 1070 <field_group id="groupV" > 1056 1071 <field field_ref="voce" name="vo" long_name="sea_water_y_velocity" /> 1057 1072 <field field_ref="vtau" name="tauvo" long_name="surface_downward_y_stress" /> 1058 1073 </field_group> 1059 1074 1060 1075 <field_group id="groupW" > 1061 1076 <field field_ref="woce" name="wo" long_name="ocean vertical velocity" /> … … 1100 1115 </field_group> 1101 1116 1102 <!-- 1117 <!-- 1103 1118 ============================================================================================================ 1104 1119 --> 1105 <!-- output variables for my configuration (example) --> 1106 1120 <!-- output variables for my configuration (example) --> 1121 1107 1122 <field_group id="myvarOCE" > 1108 <!-- grid T --> 1123 <!-- grid T --> 1109 1124 <field field_ref="e3t" name="e3t" long_name="vertical scale factor" /> 1110 1125 <field field_ref="sst" name="tos" long_name="sea_surface_temperature" /> 1111 1126 <field field_ref="sss" name="sos" long_name="sea_surface_salinity" /> 1112 1127 <field field_ref="ssh" name="zos" long_name="sea_surface_height_above_geoid" /> 1113 1114 <!-- grid U --> 1128 1129 <!-- grid U --> 1115 1130 <field field_ref="e3u" name="e3u" long_name="vertical scale factor" /> 1116 1131 <field field_ref="ssu" name="uos" long_name="sea_surface_x_velocity" /> 1117 1118 <!-- grid V --> 1132 1133 <!-- grid V --> 1119 1134 <field field_ref="e3v" name="e3v" long_name="vertical scale factor" /> 1120 <field field_ref="ssv" name="vos" long_name="sea_surface_y_velocity" /> 1121 </field_group> 1135 <field field_ref="ssv" name="vos" long_name="sea_surface_y_velocity" /> 1136 </field_group> 1122 1137 1123 1138 </field_definition> -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/SHARED/namelist_pisces_ref
r12377 r13189 352 352 ! 353 353 cn_dir = './' ! root directory for the location of the dynamical files 354 ln_ironsed = . true. ! boolean for Fe input from sediments355 ln_ironice = . true. ! boolean for Fe input from sea ice356 ln_hydrofe = . true. ! boolean for from hydrothermal vents354 ln_ironsed = .false. ! boolean for Fe input from sediments 355 ln_ironice = .false. ! boolean for Fe input from sea ice 356 ln_hydrofe = .false. ! boolean for from hydrothermal vents 357 357 sedfeinput = 2.e-9 ! Coastal release of Iron 358 358 distcoast = 5.e3 ! Distance off the coast for Iron from sediments -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/SHARED/namelist_ref
r12565 r13189 1135 1135 ! ! = 3 as =2 with distinct dissipative an mixing length scale 1136 1136 ln_mxl0 = .true. ! surface mixing length scale = F(wind stress) (T) or not (F) 1137 nn_mxlice = 0 ! type of scaling under sea-ice 1138 ! = 0 no scaling under sea-ice 1139 ! = 1 scaling with constant sea-ice thickness 1140 ! = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 1141 ! = 3 scaling with maximum sea-ice thickness 1142 rn_mxlice = 10. ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 1137 1143 rn_mxl0 = 0.04 ! surface buoyancy lenght scale minimum value 1138 1144 ln_drg = .false. ! top/bottom friction added as boundary condition of TKE … … 1395 1401 &namctl ! Control prints (default: OFF) 1396 1402 !----------------------------------------------------------------------- 1397 sn_cfctl%l_glochk = .FALSE. ! Range sanity checks are local (F) or global (T). Set T for debugging only 1398 sn_cfctl%l_allon = .FALSE. ! IF T activate all options. If F deactivate all unless l_config is T 1399 sn_cfctl%l_config = .TRUE. ! IF .true. then control which reports are written with the following 1400 sn_cfctl%l_runstat = .TRUE. ! switches and which areas produce reports with the proc integer settings. 1401 sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 1402 sn_cfctl%l_oceout = .FALSE. ! that all areas report. 1403 sn_cfctl%l_layout = .FALSE. ! 1404 sn_cfctl%l_prtctl = .FALSE. ! 1405 sn_cfctl%l_prttrc = .FALSE. ! 1406 sn_cfctl%l_oasout = .FALSE. ! 1407 sn_cfctl%procmin = 0 ! Minimum area number for reporting [default:0] 1408 sn_cfctl%procmax = 1000000 ! Maximum area number for reporting [default:1000000] 1409 sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1] 1410 sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info 1411 nn_print = 0 ! level of print (0 no extra print) 1412 nn_ictls = 0 ! start i indice of control sum (use to compare mono versus 1413 nn_ictle = 0 ! end i indice of control sum multi processor runs 1414 nn_jctls = 0 ! start j indice of control over a subdomain) 1415 nn_jctle = 0 ! end j indice of control 1416 nn_isplt = 1 ! number of processors in i-direction 1417 nn_jsplt = 1 ! number of processors in j-direction 1418 ln_timing = .false. ! timing by routine write out in timing.output file 1419 ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii 1403 sn_cfctl%l_runstat = .TRUE. ! switches and which areas produce reports with the proc integer settings. 1404 sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 1405 sn_cfctl%l_oceout = .FALSE. ! that all areas report. 1406 sn_cfctl%l_layout = .FALSE. ! 1407 sn_cfctl%l_prtctl = .FALSE. ! 1408 sn_cfctl%l_prttrc = .FALSE. ! 1409 sn_cfctl%l_oasout = .FALSE. ! 1410 sn_cfctl%procmin = 0 ! Minimum area number for reporting [default:0] 1411 sn_cfctl%procmax = 1000000 ! Maximum area number for reporting [default:1000000] 1412 sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1] 1413 sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info 1414 nn_print = 0 ! level of print (0 no extra print) 1415 nn_ictls = 0 ! start i indice of control sum (use to compare mono versus 1416 nn_ictle = 0 ! end i indice of control sum multi processor runs 1417 nn_jctls = 0 ! start j indice of control over a subdomain) 1418 nn_jctle = 0 ! end j indice of control 1419 nn_isplt = 1 ! number of processors in i-direction 1420 nn_jsplt = 1 ! number of processors in j-direction 1421 ln_timing = .false. ! timing by routine write out in timing.output file 1422 ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii 1420 1423 / 1421 1424 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/WED025/EXPREF/file_def_nemo-ice.xml
r11844 r13189 78 78 </file> 79 79 80 <file id="file22" name_suffix="_SBC_scalar" description="scalar variables" enabled=".true." >81 <!-- global contents -->82 <field field_ref="ibgvol_tot" grid_ref="grid_1point" name="ibgvol_tot" />83 <field field_ref="sbgvol_tot" grid_ref="grid_1point" name="sbgvol_tot" />84 <field field_ref="ibgarea_tot" grid_ref="grid_1point" name="ibgarea_tot" />85 <field field_ref="ibgsalt_tot" grid_ref="grid_1point" name="ibgsalt_tot" />86 <field field_ref="ibgheat_tot" grid_ref="grid_1point" name="ibgheat_tot" />87 <field field_ref="sbgheat_tot" grid_ref="grid_1point" name="sbgheat_tot" />88 89 <!-- global drifts (conservation checks) -->90 <field field_ref="ibgvolume" grid_ref="grid_1point" name="ibgvolume" />91 <field field_ref="ibgsaltco" grid_ref="grid_1point" name="ibgsaltco" />92 <field field_ref="ibgheatco" grid_ref="grid_1point" name="ibgheatco" />93 <field field_ref="ibgheatfx" grid_ref="grid_1point" name="ibgheatfx" />94 95 <!-- global forcings -->96 <field field_ref="ibgfrcvoltop" grid_ref="grid_1point" name="ibgfrcvoltop" />97 <field field_ref="ibgfrcvolbot" grid_ref="grid_1point" name="ibgfrcvolbot" />98 <field field_ref="ibgfrctemtop" grid_ref="grid_1point" name="ibgfrctemtop" />99 <field field_ref="ibgfrctembot" grid_ref="grid_1point" name="ibgfrctembot" />100 <field field_ref="ibgfrcsal" grid_ref="grid_1point" name="ibgfrcsal" />101 <field field_ref="ibgfrchfxtop" grid_ref="grid_1point" name="ibgfrchfxtop" />102 <field field_ref="ibgfrchfxbot" grid_ref="grid_1point" name="ibgfrchfxbot" />103 </file>104 105 80 </file_group> 106 81 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/WED025/EXPREF/namelist_cfg
r12565 r13189 5 5 !! namelists 2 - Surface boundary (namsbc, namsbc_flx, namsbc_blk, namsbc_cpl, 6 6 !! namsbc_sas, namtra_qsr, namsbc_rnf, 7 !! nam sbc_isf, namsbc_iscpl, namsbc_apr,7 !! namisf, namsbc_apr, 8 8 !! namsbc_ssr, namsbc_wave, namberg) 9 9 !! 3 - lateral boundary (namlbc, namagrif, nambdy, nambdy_tide) … … 38 38 nn_it000 = 1 ! first time step 39 39 nn_itend = 26280 ! last time step (std 5475) 40 nn_date0 = 19760301 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1)40 nn_date0 = 20000101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 41 41 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 42 42 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T … … 61 61 ln_tsd_init = .true. ! ocean initialisation 62 62 ln_tsd_dmp = .false. ! T-S restoring (see namtra_dmp) 63 63 64 64 cn_dir = './' ! root directory for the T-S data location 65 !___________!_____________________ ____!___________________!___________!_____________!________!___________!__________________!__________!_______________!66 ! ! file name 67 ! ! 68 sn_tem = ' dta_temp_WED025' , -12 , 'votemper', .true., .true. , 'yearly' , '' , '' , ''69 sn_sal = ' dta_sal_WED025' , -12 , 'vosaline', .true., .true. , 'yearly' , '' , '' , ''65 !___________!_____________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 66 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 67 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 68 sn_tem = 'WED025_init_JRA_200001.nc', -12 , 'votemper', .false. , .true. , 'yearly' , '' , '' , '' 69 sn_sal = 'WED025_init_JRA_200001.nc', -12 , 'vosaline', .false. , .true. , 'yearly' , '' , '' , '' 70 70 / 71 71 !----------------------------------------------------------------------- … … 116 116 ln_blk = .true. ! Bulk formulation (T => fill namsbc_blk ) 117 117 ! Sea-ice : 118 nn_ice = 2 ! =0 no ice boundary condition 118 nn_ice = 2 ! =0 no ice boundary condition 119 119 ! ! =1 use observed ice-cover ( => fill namsbc_iif ) 120 ! ! =2 or 3 automatically for SI3 or CICE ("key_si3" or "key_cice") 121 ! ! except in AGRIF zoom where it has to be specified 120 ! ! =2 or 3 for SI3 and CICE, respectively 122 121 ln_ice_embd = .false. ! =T embedded sea-ice (pressure + mass and salt exchanges) 123 122 ! ! =F levitating ice (no pressure, mass and salt exchanges) 124 123 ! Misc. options of sbc : 125 124 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) 126 ln_dm2dc = . true.! daily mean to diurnal cycle on short wave125 ln_dm2dc = .false. ! daily mean to diurnal cycle on short wave 127 126 ln_ssr = .false. ! Sea Surface Restoring on T and/or S (T => fill namsbc_ssr) 128 127 nn_fwb = 0 ! FreshWater Budget: =0 unchecked … … 139 138 !----------------------------------------------------------------------- 140 139 ! ! bulk algorithm : 141 ln_NCAR = .true. 140 ln_NCAR = .true. ! "NCAR" algorithm (Large and Yeager 2008) 141 ln_COARE_3p0 = .false. ! "COARE 3.0" algorithm (Fairall et al. 2003) 142 ln_COARE_3p6 = .false. ! "COARE 3.6" algorithm (Edson et al. 2013) 143 ln_ECMWF = .false. ! "ECMWF" algorithm (IFS cycle 45r1) 142 144 ! 143 145 cn_dir = './' ! root directory for the bulk data location … … 145 147 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 146 148 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 147 sn_wndi = 'u10_ core' , 6 , 'U_10_MOD', .true. , .false. , 'yearly' , 'weights_bicubic_core.nc' , 'Uwnd' , ''148 sn_wndj = 'v10_ core' , 6 , 'V_10_MOD', .true. , .false. , 'yearly' , 'weights_bicubic_core.nc' , 'Vwnd' , ''149 sn_qsr = ' qsw_core' , 24 , 'SWDN_MOD', .false. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''150 sn_qlw = ' qlw_core' , 24 , 'LWDN_MOD', .false. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''151 sn_tair = 't10_ core' , 6 , 'T_10_MOD', .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''152 sn_humi = 'q10_ core' , 6 , 'Q_10_MOD', .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''153 sn_prec = 'precip_ core' , -1 , 'TPRECIP', .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''154 sn_snow = 'snow_ core' , -1 , 'SNOW' , .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''155 sn_slp = 'slp_ core' , 6 , 'SLP' , .true. , .false. , 'yearly' , 'weights_bilin_core.nc' , '' , ''149 sn_wndi = 'u10_JRA' , 3 , 'uas_10m' , .true. , .false. , 'yearly' , 'weights_bicubic_JRA.nc' , 'Uwnd' , '' 150 sn_wndj = 'v10_JRA' , 3 , 'vas_10m' , .true. , .false. , 'yearly' , 'weights_bicubic_JRA.nc' , 'Vwnd' , '' 151 sn_qsr = 'rsds_JRA' , 3 , 'rsds' , .true. , .false. , 'yearly' , 'weights_bilin_JRA.nc' , '' , '' 152 sn_qlw = 'rlds_JRA' , 3 , 'rlds' , .true. , .false. , 'yearly' , 'weights_bilin_JRA.nc' , '' , '' 153 sn_tair = 't10_JRA' , 3 , 'tas_10m' , .true. , .false. , 'yearly' , 'weights_bilin_JRA.nc' , '' , '' 154 sn_humi = 'q10_JRA' , 3 , 'huss_10m', .true. , .false. , 'yearly' , 'weights_bilin_JRA.nc' , '' , '' 155 sn_prec = 'precip_JRA' , 3 , 'prto' , .true. , .false. , 'yearly' , 'weights_bilin_JRA.nc' , '' , '' 156 sn_snow = 'snow_JRA' , 3 , 'prsn' , .true. , .false. , 'yearly' , 'weights_bilin_JRA.nc' , '' , '' 157 sn_slp = 'slp_JRA' , 3 , 'psl' , .true. , .false. , 'yearly' , 'weights_bilin_JRA.nc' , '' , '' 156 158 / 157 159 !----------------------------------------------------------------------- … … 198 200 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 199 201 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 200 sn_rnf = ' runoff_WED025' , -1 , 'runoff' , .true. , .false., 'yearly' , '' , '' , ''202 sn_rnf = 'WED025_icb' , -1 , 'runoff' , .true. , .false., 'yearly' , '' , '' , '' 201 203 / 202 204 !----------------------------------------------------------------------- … … 218 220 cn_isfcav_mlt = '3eq' ! ice shelf melting formulation (spe/2eq/3eq/oasis) 219 221 ! ! spe = fwfisf is read from a forcing field 220 ! ! 2eq = ISOMIP like: 2 equations formulation (Hunter et al., 2006 )221 ! ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 201 5)222 ! ! 2eq = ISOMIP like: 2 equations formulation (Hunter et al., 2006 for a short description) 223 ! ! 3eq = ISOMIP+ like: 3 equations formulation (Asay-Davis et al., 2016 for a short description) 222 224 ! ! oasis = fwfisf is given by oasis and pattern by file sn_isfcav_fwf 223 225 ! ! cn_isfcav_mlt = 2eq or 3eq cases: 224 226 cn_gammablk = 'vel' ! scheme to compute gammat/s (spe,ad15,hj99) 225 ! ! ad15 = velocity dependend Gamma (u* * gammat/s) (Jenkins et al. 2010) 226 ! ! hj99 = velocity and stability dependent Gamma (Holland et al. 1999) 227 rn_gammat0 = 1.4e-2 ! gammat coefficient used in blk formula 228 rn_gammas0 = 4.e-4 ! gammas coefficient used in blk formula 227 ! ! spe = constant transfert velocity (rn_gammat0, rn_gammas0) 228 ! ! vel = velocity dependent transfert velocity (u* * gammat/s) (Asay-Davis et al. 2016 for a short description) 229 ! ! vel_stab = velocity and stability dependent transfert coeficient (Holland et al. 1999 for a complete description) 230 rn_gammat0 = 1.4e-2 ! gammat coefficient used in spe, vel and vel_stab gamma computation method 231 rn_gammas0 = 4.0e-4 ! gammas coefficient used in spe, vel and vel_stab gamma computation method 229 232 ! 230 233 rn_htbl = 30. ! thickness of the top boundary layer (Losh et al. 2008) … … 252 255 sn_isfpar_zmin = 'isfmlt_par', -12. , 'sozisfmin' , .false. , .true. , 'yearly' , '' , '' , '' 253 256 !* 'spe' and 'oasis' case 254 sn_isfpar_fwf = 'isfmlt_par' , -12. , 257 sn_isfpar_fwf = 'isfmlt_par' , -12. ,'sofwfisf' , .false. , .true. , 'yearly' , '' , '' , '' 255 258 !* 'bg03' case 256 sn_isfpar_Leff = 'isfmlt_par', 0. , 259 sn_isfpar_Leff = 'isfmlt_par', 0. ,'Leff' , .false. , .true. , 'yearly' , '' , '' , '' 257 260 ! 258 261 ! ---------------- ice sheet coupling ------------------------------- … … 297 300 ln_tide = .true. ! Activate tides 298 301 ln_tide_pot = .false. ! use tidal potential forcing 299 clname(1) = 'M2' ! name of constituent - all tidal components must be set in namelist_cfg300 clname(2) = 'S2'301 clname(3) = 'K1'302 clname(4) = 'O1'302 sn_tide_cnames(1) = 'M2' ! name of constituent - all tidal components must be set in namelist_cfg 303 sn_tide_cnames(2) = 'S2' 304 sn_tide_cnames(3) = 'K1' 305 sn_tide_cnames(4) = 'O1' 303 306 / 304 307 !----------------------------------------------------------------------- … … 337 340 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 338 341 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! ! pairing ! filename ! 339 bn_ssh = ' bdyT_ssh_WED025' , -1 , 'sossheig' , .true. , .false., 'yearly' , '' , '' , ''340 bn_u2d = ' bdyU_u2d_WED025' , -1 , 'vobtcrtx' , .true. , .false., 'yearly' , '' , '' , ''341 bn_v2d = ' bdyV_u2d_WED025' , -1 , 'vobtcrty' , .true. , .false., 'yearly' , '' , '' , ''342 bn_u3d = ' bdyU_u3d_WED025' , -1 , 'vozocrtx' , .true. , .false., 'yearly' , '' , '' , ''343 bn_v3d = ' bdyV_u3d_WED025' , -1 , 'vomecrty' , .true. , .false., 'yearly' , '' , '' , ''344 bn_tem = ' bdyT_tra_WED025' , -1 , 'votemper' , .true. , .false., 'yearly' , '' , '' , ''345 bn_sal = ' bdyT_tra_WED025' , -1 , 'vosaline' , .true. , .false., 'yearly' , '' , '' , ''342 bn_ssh = 'WED025_bdyT_ssh' , -1 , 'sossheig' , .true. , .false., 'yearly' , '' , '' , '' 343 bn_u2d = 'WED025_bdyU_u2d' , -1 , 'vobtcrtx' , .true. , .false., 'yearly' , '' , '' , '' 344 bn_v2d = 'WED025_bdyV_u2d' , -1 , 'vobtcrty' , .true. , .false., 'yearly' , '' , '' , '' 345 bn_u3d = 'WED025_bdyU_u3d' , -1 , 'vozocrtx' , .true. , .false., 'yearly' , '' , '' , '' 346 bn_v3d = 'WED025_bdyV_u3d' , -1 , 'vomecrty' , .true. , .false., 'yearly' , '' , '' , '' 347 bn_tem = 'WED025_bdyT_tra' , -1 , 'votemper' , .true. , .false., 'yearly' , '' , '' , '' 348 bn_sal = 'WED025_bdyT_tra' , -1 , 'vosaline' , .true. , .false., 'yearly' , '' , '' , '' 346 349 !* for si3 347 bn_a_i = ' bdyT_ice_WED025' , -1 , 'ileadfra' , .true. , .false., 'yearly' , '' , '' , ''348 bn_h_i = ' bdyT_ice_WED025' , -1 , 'iicethic' , .true. , .false., 'yearly' , '' , '' , ''349 bn_h_s = ' bdyT_ice_WED025' , -1 , 'isnowthi' , .true. , .false., 'yearly' , '' , '' , ''350 bn_a_i = 'WED025_bdyT_ice' , -1 , 'ileadfra' , .true. , .false., 'yearly' , '' , '' , '' 351 bn_h_i = 'WED025_bdyT_ice' , -1 , 'iicethic' , .true. , .false., 'yearly' , '' , '' , '' 352 bn_h_s = 'WED025_bdyT_ice' , -1 , 'isnowthi' , .true. , .false., 'yearly' , '' , '' , '' 350 353 / 351 354 !----------------------------------------------------------------------- 352 355 &nambdy_tide ! tidal forcing at open boundaries (default: OFF) 353 356 !----------------------------------------------------------------------- 354 filtide = ' bdytide_WED025_' ! file name root of tidal forcing files357 filtide = 'WED025_bdytide_' ! file name root of tidal forcing files 355 358 / 356 359 … … 655 658 &namctl ! Control prints (default: OFF) 656 659 !----------------------------------------------------------------------- 657 ln_ctl = .FALSE. ! Toggle all report printing on/off (T/F); Ignored if sn_cfctl%l_config is T 658 sn_cfctl%l_config = .TRUE. ! IF .true. then control which reports are written with the following 659 sn_cfctl%l_runstat = .FALSE. ! switches and which areas produce reports with the proc integer settings. 660 sn_cfctl%l_trcstat = .FALSE. ! The default settings for the proc integers should ensure 661 sn_cfctl%l_oceout = .FALSE. ! that all areas report. 662 sn_cfctl%l_layout = .FALSE. ! 663 sn_cfctl%l_mppout = .FALSE. ! 664 sn_cfctl%l_mpptop = .FALSE. ! 665 sn_cfctl%procmin = 0 ! Minimum area number for reporting [default:0] 666 sn_cfctl%procmax = 1000000 ! Maximum area number for reporting [default:1000000] 667 sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1] 668 sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info 669 nn_print = 0 ! level of print (0 no extra print) 670 nn_ictls = 0 ! start i indice of control sum (use to compare mono versus 671 nn_ictle = 0 ! end i indice of control sum multi processor runs 672 nn_jctls = 0 ! start j indice of control over a subdomain) 673 nn_jctle = 0 ! end j indice of control 674 nn_isplt = 1 ! number of processors in i-direction 675 nn_jsplt = 1 ! number of processors in j-direction 676 ln_timing = .true. ! timing by routine write out in timing.output file 677 ln_diacfl = .false. ! CFL diagnostics write out in cfl_diagnostics.ascii 660 sn_cfctl%l_runstat = .true. ! switches and which areas produce reports with the proc integer settings. 661 ln_timing = .true. ! timing by routine write out in timing.output file 678 662 / 679 663 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/WED025/EXPREF/namelist_ice_cfg
r11487 r13189 26 26 &namitd ! Ice discretization 27 27 !------------------------------------------------------------------------------ 28 ln_cat_hfn = .true. ! ice categories are defined by a function following rn_himean**(-0.05) 29 rn_himean = 2.0 ! expected domain-average ice thickness (m) 30 rn_himin = 0.01 ! minimum ice thickness (m) used in remapping 28 31 / 29 32 !------------------------------------------------------------------------------ 30 33 &namdyn ! Ice dynamics 31 34 !------------------------------------------------------------------------------ 35 ln_landfast_L16 = .true. ! landfast: parameterization from Lemieux 2016 32 36 / 33 37 !------------------------------------------------------------------------------ … … 42 46 &namdyn_adv ! Ice advection 43 47 !------------------------------------------------------------------------------ 48 ln_adv_Pra = .false. ! Advection scheme (Prather) 49 ln_adv_UMx = .true. ! Advection scheme (Ultimate-Macho) 50 nn_UMx = 5 ! order of the scheme for UMx (1-5 ; 20=centered 2nd order) 44 51 / 45 52 !------------------------------------------------------------------------------ … … 62 69 &namthd_do ! Ice growth in open water 63 70 !------------------------------------------------------------------------------ 71 rn_hinew = 0.02 ! thickness for new ice formation in open water (m), must be larger than rn_himin 72 ln_frazil = .true. ! Frazil ice parameterization (ice collection as a function of wind) 64 73 / 65 74 !------------------------------------------------------------------------------ … … 70 79 &namthd_pnd ! Melt ponds 71 80 !------------------------------------------------------------------------------ 81 ln_pnd = .true. ! activate melt ponds or not 82 ln_pnd_H12 = .true. ! activate evolutive melt ponds (from Holland et al 2012) 83 ln_pnd_alb = .true. ! melt ponds affect albedo or not 72 84 / 85 73 86 !------------------------------------------------------------------------------ 74 87 &namini ! Ice initialization 75 88 !------------------------------------------------------------------------------ 89 ln_iceini = .true. ! activate ice initialization (T) or not (F) 90 ln_iceini_file = .true. ! netcdf file provided for initialization (T) or not (F) 91 ! -- for ln_iceini_file = T 92 sn_hti = 'WED025_init_JRA_200001.nc', -12 ,'icethic_cea', .false. , .true., 'yearly' , '' , '', '' 93 sn_hts = 'WED025_init_JRA_200001.nc', -12 ,'icesnow_cea', .false. , .true., 'yearly' , '' , '', '' 94 sn_ati = 'WED025_init_JRA_200001.nc', -12 ,'ice_cover' , .false. , .true., 'yearly' , '' , '', '' 95 sn_smi = 'NOT USED' , -12 ,'smi' , .false. , .true., 'yearly' , '' , '', '' 96 sn_tmi = 'NOT USED' , -12 ,'tmi' , .false. , .true., 'yearly' , '' , '', '' 97 sn_tsu = 'NOT USED' , -12 ,'tsu' , .false. , .true., 'yearly' , '' , '', '' 98 sn_tms = 'NOT USED' , -12 ,'tms' , .false. , .true., 'yearly' , '' , '', '' 99 ! melt ponds (be careful, sn_apd is the pond concentration (not fraction), so it differs from rn_apd) 100 sn_apd = 'NOT USED' , -12 ,'apd' , .false. , .true., 'yearly' , '' , '', '' 101 sn_hpd = 'NOT USED' , -12 ,'hpd' , .false. , .true., 'yearly' , '' , '', '' 102 cn_dir='./' 76 103 / 77 104 !------------------------------------------------------------------------------ -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/cfgs/ref_cfgs.txt
r12377 r13189 7 7 ORCA2_OFF_TRC OCE TOP OFF 8 8 ORCA2_SAS_ICE OCE ICE NST SAS 9 ORCA2_ICE_PISCES OCE TOP ICE NST 9 ORCA2_ICE_PISCES OCE TOP ICE NST ABL 10 10 ORCA2_ICE_ABL OCE ICE ABL 11 ORCA2_SAS_ICE_ABL OCE SAS ICE ABL12 ORCA2_ICE OCE ICE13 11 SPITZ12 OCE ICE 14 12 WED025 OCE ICE 15 eORCA025_ICE OCE ICE16 eORCA025_ICE_ABL OCE ICE ABL17 eORCA025_SAS_ICE_ABL OCE SAS ICE ABL -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/ABL/ablmod.F90
r12565 r13189 586 586 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 587 587 ! ! 8 *** Swap time indices for the next timestep 588 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 589 nt_n = 1 + MOD( kt, 2)590 nt_a = 1 + MOD( kt+1, 2)591 ! 588 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 589 nt_n = 1 + MOD( nt_n, 2) 590 nt_a = 1 + MOD( nt_a, 2) 591 ! 592 592 !--------------------------------------------------------------------------------------------------- 593 593 END SUBROUTINE abl_stp -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/ABL/ablrst.F90
r11945 r13189 74 74 ENDIF 75 75 ! 76 CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka )76 CALL iom_open( TRIM(clpath)//TRIM(clname), numraw, ldwrt = .TRUE., kdlev = jpka, cdcomp = 'ABL' ) 77 77 lrst_abl = .TRUE. 78 78 ENDIF … … 146 146 ENDIF 147 147 148 CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar , kdlev = jpka)148 CALL iom_open ( TRIM(cn_ablrst_indir)//'/'//cn_ablrst_in, numrar ) 149 149 150 150 ! Time info -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/ABL/par_abl.F90
r12495 r13189 29 29 LOGICAL , PUBLIC :: ln_smth_pblh !: smoothing of atmospheric PBL height 30 30 31 LOGICAL , PUBLIC :: ln_rstart_abl !: (de)activate abl restart 31 32 CHARACTER(len=256), PUBLIC :: cn_ablrst_in !: suffix of abl restart name (input) 32 33 CHARACTER(len=256), PUBLIC :: cn_ablrst_out !: suffix of abl restart name (output) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/ABL/sbcabl.F90
r12565 r13189 68 68 LOGICAL :: lluldl 69 69 NAMELIST/namsbc_abl/ cn_dir, cn_dom, cn_ablrst_in, cn_ablrst_out, & 70 & cn_ablrst_indir, cn_ablrst_outdir, 70 & cn_ablrst_indir, cn_ablrst_outdir, ln_rstart_abl, & 71 71 & ln_hpgls_frc, ln_geos_winds, nn_dyn_restore, & 72 72 & rn_ldyn_min , rn_ldyn_max, rn_ltra_min, rn_ltra_max, & … … 263 263 264 264 ! Initialize the time index for now time (nt_n) and after time (nt_a) 265 nt_n = 1 + MOD( nit000 , 2) 266 nt_a = 1 + MOD( nit000+1, 2) 265 nt_n = 1; nt_a = 2 267 266 268 267 ! initialize ABL from data or restart 269 IF( ln_rstart ) THEN268 IF( ln_rstart_abl ) THEN 270 269 CALL abl_rst_read 271 270 ELSE … … 288 287 ENDIF 289 288 290 rhoa(:,:) = rho_air( tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), sf(jp_slp)%fnow(:,:,1) ) !!GS: rhoa must be (re)computed here here to avoid division by zero in blk_ice_1 (TBI)291 292 289 END SUBROUTINE sbc_abl_init 293 290 … … 329 326 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 330 327 331 !!------------------------------------------------------------------------------------------- 332 !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 333 !!------------------------------------------------------------------------------------------- 334 335 CALL blk_oce_1( kt, u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in 336 & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in 337 & sf(jp_slp )%fnow(:,:,1), sst_m, ssu_m, ssv_m , & ! <<= in 338 & sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in 339 & sf(jp_qsr )%fnow(:,:,1), sf(jp_qlw )%fnow(:,:,1), & ! <<= in 340 & tsk_m, zssq, zcd_du, zsen, zevp ) ! =>> out 341 342 #if defined key_si3 343 CALL blk_ice_1( u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in 344 & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in 345 & sf(jp_slp)%fnow(:,:,1) , u_ice, v_ice, tm_su , & ! <<= in 346 & pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui ) ! <<= out 347 #endif 348 349 !!------------------------------------------------------------------------------------------- 350 !! 3 - Advance ABL variables from now (n) to after (n+1) 351 !!------------------------------------------------------------------------------------------- 352 353 CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq, & ! <<= in 354 & sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:), & ! <<= in 355 & sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:), & ! <<= in 356 & sf(jp_slp )%fnow(:,:,1), & ! <<= in 357 & sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:), & ! <<= in 358 & zcd_du, zsen, zevp, & ! <=> in/out 359 & wndm, utau, vtau, taum & ! =>> out 360 #if defined key_si3 361 & , tm_su, u_ice, v_ice, zssqi, zcd_dui & ! <<= in 362 & , zseni, zevpi, wndm_ice, ato_i & ! <<= in 363 & , utau_ice, vtau_ice & ! =>> out 364 #endif 365 & ) 366 !!------------------------------------------------------------------------------------------- 367 !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since 368 !! time swap is done in abl_stp 369 !!------------------------------------------------------------------------------------------- 370 371 CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta), & 372 & sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1), & 373 & sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1), & 374 & tsk_m, zsen, zevp ) 375 376 CALL abl_rst_opn( kt ) ! Open abl restart file (if necessary) 377 IF( lrst_abl ) CALL abl_rst_write( kt ) ! -- abl restart file 378 379 #if defined key_si3 380 ! Avoid a USE abl in icesbc module 381 sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta); sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) 382 #endif 328 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 329 330 !!------------------------------------------------------------------------------------------- 331 !! 2 - Compute Cd x ||U||, Ch x ||U||, Ce x ||U||, and SSQ using now fields 332 !!------------------------------------------------------------------------------------------- 333 334 CALL blk_oce_1( kt, u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in 335 & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in 336 & sf(jp_slp )%fnow(:,:,1) , sst_m, ssu_m, ssv_m , & ! <<= in 337 & sf(jp_uoatm)%fnow(:,:,1), sf(jp_voatm)%fnow(:,:,1), & ! <<= in 338 & sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1) , & ! <<= in 339 & tsk_m, zssq, zcd_du, zsen, zevp ) ! =>> out 340 341 #if defined key_si3 342 CALL blk_ice_1( u_abl(:,:,2,nt_n ), v_abl(:,:,2,nt_n ), & ! <<= in 343 & tq_abl(:,:,2,nt_n,jp_ta), tq_abl(:,:,2,nt_n,jp_qa), & ! <<= in 344 & sf(jp_slp)%fnow(:,:,1) , u_ice, v_ice, tm_su , & ! <<= in 345 & pseni=zseni, pevpi=zevpi, pssqi=zssqi, pcd_dui=zcd_dui ) ! <<= out 346 #endif 347 348 !!------------------------------------------------------------------------------------------- 349 !! 3 - Advance ABL variables from now (n) to after (n+1) 350 !!------------------------------------------------------------------------------------------- 351 352 CALL abl_stp( kt, tsk_m, ssu_m, ssv_m, zssq, & ! <<= in 353 & sf(jp_wndi)%fnow(:,:,:), sf(jp_wndj)%fnow(:,:,:), & ! <<= in 354 & sf(jp_tair)%fnow(:,:,:), sf(jp_humi)%fnow(:,:,:), & ! <<= in 355 & sf(jp_slp )%fnow(:,:,1), & ! <<= in 356 & sf(jp_hpgi)%fnow(:,:,:), sf(jp_hpgj)%fnow(:,:,:), & ! <<= in 357 & zcd_du, zsen, zevp, & ! <=> in/out 358 & wndm, utau, vtau, taum & ! =>> out 359 #if defined key_si3 360 & , tm_su, u_ice, v_ice, zssqi, zcd_dui & ! <<= in 361 & , zseni, zevpi, wndm_ice, ato_i & ! <<= in 362 & , utau_ice, vtau_ice & ! =>> out 363 #endif 364 & ) 365 !!------------------------------------------------------------------------------------------- 366 !! 4 - Finalize flux computation using ABL variables at (n+1), nt_n corresponds to (n+1) since 367 !! time swap is done in abl_stp 368 !!------------------------------------------------------------------------------------------- 369 370 CALL blk_oce_2( tq_abl(:,:,2,nt_n,jp_ta), & 371 & sf(jp_qsr )%fnow(:,:,1) , sf(jp_qlw )%fnow(:,:,1), & 372 & sf(jp_prec)%fnow(:,:,1) , sf(jp_snow)%fnow(:,:,1), & 373 & tsk_m, zsen, zevp ) 374 375 CALL abl_rst_opn( kt ) ! Open abl restart file (if necessary) 376 IF( lrst_abl ) CALL abl_rst_write( kt ) ! -- abl restart file 377 378 #if defined key_si3 379 ! Avoid a USE abl in icesbc module 380 sf(jp_tair)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_ta); sf(jp_humi)%fnow(:,:,1) = tq_abl(:,:,2,nt_n,jp_qa) 381 #endif 382 END IF 383 383 384 384 END SUBROUTINE sbc_abl -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/ICE/icectl.F90
r12551 r13189 331 331 IF(lwp) WRITE(numout,*) 332 332 333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )333 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 334 334 335 335 CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/ICE/iceistate.F90
r12495 r13189 179 179 ! 180 180 ! -- mandatory fields -- ! 181 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) 182 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) 183 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) 181 zht_i_ini(:,:) = si(jp_hti)%fnow(:,:,1) * tmask(:,:,1) 182 zht_s_ini(:,:) = si(jp_hts)%fnow(:,:,1) * tmask(:,:,1) 183 zat_i_ini(:,:) = si(jp_ati)%fnow(:,:,1) * tmask(:,:,1) 184 184 185 185 ! -- optional fields -- ! … … 219 219 & si(jp_hpd)%fnow(:,:,1) = ( rn_hpd_ini_n * zswitch + rn_hpd_ini_s * (1._wp - zswitch) ) * tmask(:,:,1) 220 220 ! 221 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) 222 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) 223 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) 224 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) 225 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) 226 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) 221 zsm_i_ini(:,:) = si(jp_smi)%fnow(:,:,1) * tmask(:,:,1) 222 ztm_i_ini(:,:) = si(jp_tmi)%fnow(:,:,1) * tmask(:,:,1) 223 zt_su_ini(:,:) = si(jp_tsu)%fnow(:,:,1) * tmask(:,:,1) 224 ztm_s_ini(:,:) = si(jp_tms)%fnow(:,:,1) * tmask(:,:,1) 225 zapnd_ini(:,:) = si(jp_apd)%fnow(:,:,1) * tmask(:,:,1) 226 zhpnd_ini(:,:) = si(jp_hpd)%fnow(:,:,1) * tmask(:,:,1) 227 227 ! 228 228 ! change the switch for the following … … 436 436 !!clem: output of initial state should be written here but it is impossible because 437 437 !! the ocean and ice are in the same file 438 !! CALL dia_wri_state( 'output.init' )438 !! CALL dia_wri_state( Kmm, 'output.init' ) 439 439 ! 440 440 END SUBROUTINE ice_istate -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/ICE/icerst.F90
r12377 r13189 80 80 ENDIF 81 81 ! 82 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl )82 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 83 83 lrst_ice = .TRUE. 84 84 ENDIF … … 185 185 ENDIF 186 186 187 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir , kdlev = jpl)187 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 188 188 189 189 ! test if v_i exists -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/ASM/asminc.F90
r12495 r13189 896 896 IF ( kt == nitdin_r ) THEN 897 897 ! 898 l_1st_euler = 0! Force Euler forward step898 l_1st_euler = .TRUE. ! Force Euler forward step 899 899 ! 900 900 ! Sea-ice : SI3 case -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/BDY/bdydta.F90
r12551 r13189 91 91 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 92 92 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 93 INTEGER, DIMENSION(jpbgrd) :: ilen194 93 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 95 94 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias … … 116 115 END DO 117 116 ENDIF 118 IF( dta_bdy(jbdy)%lneed_dyn2d) THEN117 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 119 118 igrd = 2 120 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init119 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used either over the whole bdy or only on the rim 121 120 ii = idx_bdy(jbdy)%nbi(ib,igrd) 122 121 ij = idx_bdy(jbdy)%nbj(ib,igrd) 123 122 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 124 123 END DO 124 ENDIF 125 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 125 126 igrd = 3 126 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used only on the rim except if ln_full_vel = T, see bdy_dta_init127 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used either over the whole bdy or only on the rim 127 128 ii = idx_bdy(jbdy)%nbi(ib,igrd) 128 129 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 210 211 ! 211 212 ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 212 IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN ! runoff and we read u/v2d213 IF( cn_tra(jbdy) == 'runoff' ) THEN ! runoff 213 214 ! 214 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 215 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 216 ii = idx_bdy(jbdy)%nbi(ib,igrd) 217 ij = idx_bdy(jbdy)%nbj(ib,igrd) 218 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 219 END DO 220 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 221 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 222 ii = idx_bdy(jbdy)%nbi(ib,igrd) 223 ij = idx_bdy(jbdy)%nbj(ib,igrd) 224 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 225 END DO 215 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 216 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 217 DO ib = 1, SIZE(dta_alias%u2d) ! u2d is used either over the whole bdy or only on the rim 218 ii = idx_bdy(jbdy)%nbi(ib,igrd) 219 ij = idx_bdy(jbdy)%nbj(ib,igrd) 220 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 221 END DO 222 ENDIF 223 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 224 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 225 DO ib = 1, SIZE(dta_alias%v2d) ! v2d is used either over the whole bdy or only on the rim 226 ii = idx_bdy(jbdy)%nbi(ib,igrd) 227 ij = idx_bdy(jbdy)%nbj(ib,igrd) 228 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 229 END DO 230 ENDIF 226 231 ENDIF 227 232 228 233 ! tidal harmonic forcing ONLY: initialise arrays 229 234 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 230 IF( dta_alias%lneed_ssh) dta_alias%ssh(:) = 0._wp231 IF( dta_alias%lneed_dyn2d) dta_alias%u2d(:) = 0._wp232 IF( dta_alias%lneed_dyn2d) dta_alias%v2d(:) = 0._wp235 IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 236 IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 237 IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 233 238 ENDIF 234 239 … … 237 242 ! 238 243 igrd = 2 ! zonal velocity 239 dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d240 244 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 241 245 ii = idx_bdy(jbdy)%nbi(ib,igrd) 242 246 ij = idx_bdy(jbdy)%nbj(ib,igrd) 247 dta_alias%u2d(ib) = 0._wp ! compute barotrope zonal velocity and put it in u2d 243 248 DO ik = 1, jpkm1 244 249 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) … … 250 255 END DO 251 256 igrd = 3 ! meridional velocity 252 dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d253 257 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 254 258 ii = idx_bdy(jbdy)%nbi(ib,igrd) 255 259 ij = idx_bdy(jbdy)%nbj(ib,igrd) 260 dta_alias%v2d(ib) = 0._wp ! compute barotrope meridional velocity and put it in v2d 256 261 DO ik = 1, jpkm1 257 262 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) … … 275 280 276 281 #if defined key_si3 277 IF( dta_alias%lneed_ice ) THEN282 IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 278 283 ! fill temperature and salinity arrays 279 284 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) … … 330 335 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 331 336 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 332 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=idx_bdy(jbdy)%nblen(:) 333 ELSE ; ilen1(:)=idx_bdy(jbdy)%nblenrim(:) 334 ENDIF 335 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 336 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 337 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 337 IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 338 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 339 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 338 340 ENDIF 339 341 END DO 340 342 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 341 343 ! 342 ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step343 344 CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 344 345 ENDIF … … 348 349 ! 349 350 END SUBROUTINE bdy_dta 350 351 351 352 352 353 SUBROUTINE bdy_dta_init … … 380 381 LOGICAL :: llneed ! 381 382 LOGICAL :: llread ! 383 LOGICAL :: llfullbdy ! 382 384 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 383 385 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read … … 494 496 igrd = 2 ! U point 495 497 ipk = 1 ! surface data 496 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed498 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%u2d will be needed 497 499 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 498 500 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 499 501 bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta 500 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from u3d -> need on the full bdy 501 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 502 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need u2d over the whole bdy or only over the rim? 503 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 504 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 502 505 ENDIF 503 506 ENDIF … … 506 509 igrd = 3 ! V point 507 510 ipk = 1 ! surface data 508 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed511 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%v2d will be needed 509 512 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 510 513 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 511 514 bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta 512 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from v3d -> need on the full bdy 513 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 515 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need v2d over the whole bdy or only over the rim? 516 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 517 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 514 518 ENDIF 515 519 ENDIF -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/BDY/bdyini.F90
r12377 r13189 19 19 USE oce ! ocean dynamics and tracers variables 20 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce , ONLY: nn_ice 21 22 USE bdy_oce ! unstructured open boundary conditions 22 23 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 23 24 USE bdytides ! open boundary cond. setting (bdytide_init routine) 24 25 USE tide_mod, ONLY: ln_tide ! tidal forcing 25 USE phycst 26 USE phycst , ONLY: rday 26 27 ! 27 28 USE in_out_manager ! I/O units … … 315 316 316 317 dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none' 318 319 IF( dta_bdy(ib_bdy)%lneed_ice .AND. nn_ice /= 2 ) THEN 320 WRITE(ctmp1,*) 'bdy number ', ib_bdy,', needs ice model but nn_ice = ', nn_ice 321 CALL ctl_stop( ctmp1 ) 322 ENDIF 317 323 318 324 IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/BDY/bdytides.F90
r12495 r13189 65 65 !! namelist variables 66 66 !!------------------- 67 CHARACTER(len=80) :: filtide ! :Filename root for tidal input files68 LOGICAL :: ln_bdytide_2ddta ! :If true, read 2d harmonic data67 CHARACTER(len=80) :: filtide ! Filename root for tidal input files 68 LOGICAL :: ln_bdytide_2ddta ! If true, read 2d harmonic data 69 69 !! 70 INTEGER :: ib_bdy, itide, ib ! :dummy loop indices71 INTEGER :: ii, ij ! :dummy loop indices70 INTEGER :: ib_bdy, itide, ib ! dummy loop indices 71 INTEGER :: ii, ij ! dummy loop indices 72 72 INTEGER :: inum, igrd 73 INTEGER , DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)73 INTEGER :: isz ! bdy data size 74 74 INTEGER :: ios ! Local integer output status for namelist read 75 75 INTEGER :: nbdy_rdstart, nbdy_loc 76 CHARACTER(LEN=50) :: cerrmsg ! :error string77 CHARACTER(len=80) :: clfile ! :full file name for tidal input file78 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! :work space to read in tidal harmonics data79 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! :" " " " " " " "76 CHARACTER(LEN=50) :: cerrmsg ! error string 77 CHARACTER(len=80) :: clfile ! full file name for tidal input file 78 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! work space to read in tidal harmonics data 79 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! " " " " " " " " 80 80 !! 81 TYPE(TIDES_DATA), POINTER :: td !: local short cut 81 TYPE(TIDES_DATA), POINTER :: td ! local short cut 82 TYPE( OBC_DATA), POINTER :: dta ! local short cut 82 83 !! 83 84 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta … … 93 94 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 94 95 ! 95 td => tides(ib_bdy) 96 96 td => tides(ib_bdy) 97 dta => dta_bdy(ib_bdy) 98 97 99 ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 98 100 filtide(:) = '' … … 130 132 IF(lwp) WRITE(numout,*) ' ' 131 133 132 ! Allocate space for tidal harmonics data - get size from OBC data arrays 134 ! Allocate space for tidal harmonics data - get size from BDY data arrays 135 ! Allocate also slow varying data in the case of time splitting: 136 ! Do it anyway because at this stage knowledge of free surface scheme is unknown 133 137 ! ----------------------------------------------------------------------- 134 135 ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 136 ! relaxation area 137 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = idx_bdy(ib_bdy)%nblen (:) 138 ELSE ; ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 139 ENDIF 140 141 ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) ) 142 ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) ) 143 144 ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) ) 145 ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) ) 146 147 ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) ) 148 ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) ) 149 150 td%ssh0(:,:,:) = 0._wp 151 td%ssh (:,:,:) = 0._wp 152 td%u0 (:,:,:) = 0._wp 153 td%u (:,:,:) = 0._wp 154 td%v0 (:,:,:) = 0._wp 155 td%v (:,:,:) = 0._wp 156 138 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 139 isz = SIZE(dta%ssh) 140 ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) ) 141 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp ! needed? 142 ENDIF 143 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 144 isz = SIZE(dta%u2d) 145 ALLOCATE( td%u0 ( isz, nb_harmo, 2 ), td%u ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) ) 146 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp ! needed? 147 ENDIF 148 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 149 isz = SIZE(dta%v2d) 150 ALLOCATE( td%v0 ( isz, nb_harmo, 2 ), td%v ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) ) 151 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp ! needed? 152 ENDIF 153 154 ! fill td%ssh0, td%u0, td%v0 155 ! ----------------------------------------------------------------------- 157 156 IF( ln_bdytide_2ddta ) THEN 157 ! 158 158 ! It is assumed that each data file contains all complex harmonic amplitudes 159 159 ! given on the global domain (ie global, jpiglo x jpjglo) … … 162 162 ! 163 163 ! SSH fields 164 clfile = TRIM(filtide)//'_grid_T.nc' 165 CALL iom_open( clfile , inum ) 166 igrd = 1 ! Everything is at T-points here 167 DO itide = 1, nb_harmo 168 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 169 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 170 DO ib = 1, ilen0(igrd) 171 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 172 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 173 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 174 td%ssh0(ib,itide,1) = ztr(ii,ij) 175 td%ssh0(ib,itide,2) = zti(ii,ij) 176 END DO 177 END DO 178 CALL iom_close( inum ) 164 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 165 clfile = TRIM(filtide)//'_grid_T.nc' 166 CALL iom_open( clfile , inum ) 167 igrd = 1 ! Everything is at T-points here 168 DO itide = 1, nb_harmo 169 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 170 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 171 DO ib = 1, SIZE(dta%ssh) 172 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 173 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 174 td%ssh0(ib,itide,1) = ztr(ii,ij) 175 td%ssh0(ib,itide,2) = zti(ii,ij) 176 END DO 177 END DO 178 CALL iom_close( inum ) 179 ENDIF 179 180 ! 180 181 ! U fields 181 clfile = TRIM(filtide)//'_grid_U.nc' 182 CALL iom_open( clfile , inum ) 183 igrd = 2 ! Everything is at U-points here 184 DO itide = 1, nb_harmo 185 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 186 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 187 DO ib = 1, ilen0(igrd) 188 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 189 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 190 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 191 td%u0(ib,itide,1) = ztr(ii,ij) 192 td%u0(ib,itide,2) = zti(ii,ij) 193 END DO 194 END DO 195 CALL iom_close( inum ) 182 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 183 clfile = TRIM(filtide)//'_grid_U.nc' 184 CALL iom_open( clfile , inum ) 185 igrd = 2 ! Everything is at U-points here 186 DO itide = 1, nb_harmo 187 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 188 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 189 DO ib = 1, SIZE(dta%u2d) 190 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 191 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 192 td%u0(ib,itide,1) = ztr(ii,ij) 193 td%u0(ib,itide,2) = zti(ii,ij) 194 END DO 195 END DO 196 CALL iom_close( inum ) 197 ENDIF 196 198 ! 197 199 ! V fields 198 clfile = TRIM(filtide)//'_grid_V.nc' 199 CALL iom_open( clfile , inum ) 200 igrd = 3 ! Everything is at V-points here 201 DO itide = 1, nb_harmo 202 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 203 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 204 DO ib = 1, ilen0(igrd) 205 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 206 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 207 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 208 td%v0(ib,itide,1) = ztr(ii,ij) 209 td%v0(ib,itide,2) = zti(ii,ij) 210 END DO 211 END DO 212 CALL iom_close( inum ) 200 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 201 clfile = TRIM(filtide)//'_grid_V.nc' 202 CALL iom_open( clfile , inum ) 203 igrd = 3 ! Everything is at V-points here 204 DO itide = 1, nb_harmo 205 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 206 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 207 DO ib = 1, SIZE(dta%v2d) 208 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 209 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 210 td%v0(ib,itide,1) = ztr(ii,ij) 211 td%v0(ib,itide,2) = zti(ii,ij) 212 END DO 213 END DO 214 CALL iom_close( inum ) 215 ENDIF 213 216 ! 214 217 DEALLOCATE( ztr, zti ) … … 218 221 ! Read tidal data only on bdy segments 219 222 ! 220 ALLOCATE( dta_read( MAXVAL( ilen0(1:3)), 1, 1 ) )223 ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) ) 221 224 ! 222 225 ! Open files and read in tidal forcing data … … 225 228 DO itide = 1, nb_harmo 226 229 ! ! SSH fields 227 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 228 CALL iom_open( clfile, inum ) 229 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 230 td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 231 CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 232 td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 233 CALL iom_close( inum ) 230 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 231 isz = SIZE(dta%ssh) 232 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 233 CALL iom_open( clfile, inum ) 234 CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 235 td%ssh0(:,itide,1) = dta_read(1:isz,1,1) 236 CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 237 td%ssh0(:,itide,2) = dta_read(1:isz,1,1) 238 CALL iom_close( inum ) 239 ENDIF 234 240 ! ! U fields 235 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 236 CALL iom_open( clfile, inum ) 237 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 238 td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 239 CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 240 td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 241 CALL iom_close( inum ) 241 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 242 isz = SIZE(dta%u2d) 243 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 244 CALL iom_open( clfile, inum ) 245 CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 246 td%u0(:,itide,1) = dta_read(1:isz,1,1) 247 CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 248 td%u0(:,itide,2) = dta_read(1:isz,1,1) 249 CALL iom_close( inum ) 250 ENDIF 242 251 ! ! V fields 243 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 244 CALL iom_open( clfile, inum ) 245 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 246 td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 247 CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 248 td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 249 CALL iom_close( inum ) 252 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 253 isz = SIZE(dta%v2d) 254 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 255 CALL iom_open( clfile, inum ) 256 CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 257 td%v0(:,itide,1) = dta_read(1:isz,1,1) 258 CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 259 td%v0(:,itide,2) = dta_read(1:isz,1,1) 260 CALL iom_close( inum ) 261 ENDIF 250 262 ! 251 263 END DO ! end loop on tidal components … … 254 266 ! 255 267 ENDIF ! ln_bdytide_2ddta=.true. 256 !257 ! Allocate slow varying data in the case of time splitting:258 ! Do it anyway because at this stage knowledge of free surface scheme is unknown259 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )260 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )261 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )262 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp263 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp264 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp265 268 ! 266 269 ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 … … 283 286 ! 284 287 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 285 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices 286 INTEGER, DIMENSION(jpbgrd) :: ilen0 287 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts 288 INTEGER :: itide, ib_bdy, ib ! loop indices 288 289 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset 289 290 !!---------------------------------------------------------------------- … … 310 311 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 311 312 ! 312 nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)313 nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)314 !315 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = nblen (:)316 ELSE ; ilen0(:) = nblenrim(:)317 ENDIF318 !319 313 ! We refresh nodal factors every day below 320 314 ! This should be done somewhere else … … 337 331 ! If time splitting, initialize arrays from slow varying open boundary data: 338 332 IF ( PRESENT(kit) ) THEN 339 IF ( dta_bdy(ib_bdy)%lneed_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))340 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))341 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))333 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:) 334 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:) 335 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:) 342 336 ENDIF 343 337 ! … … 349 343 z_sist = zramp * SIN( z_sarg ) 350 344 ! 351 IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 352 igrd=1 ! SSH on tracer grid 353 DO ib = 1, ilen0(igrd) 345 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN ! SSH on tracer grid 346 DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh) 354 347 dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 355 348 & ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & … … 358 351 ENDIF 359 352 ! 360 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 361 igrd=2 ! U grid 362 DO ib = 1, ilen0(igrd) 353 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN ! U grid 354 DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d) 363 355 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 364 356 & ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 365 357 & tides(ib_bdy)%u(ib,itide,2)*z_sist ) 366 358 END DO 367 igrd=3 ! V grid 368 DO ib = 1, ilen0(igrd) 359 ENDIF 360 ! 361 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN ! V grid 362 DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d) 369 363 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 370 364 & ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & … … 372 366 END DO 373 367 ENDIF 368 ! 374 369 END DO 375 END 370 ENDIF 376 371 END DO 377 372 ! … … 386 381 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 387 382 ! 388 INTEGER :: itide, igrd, ib ! dummy loop indices 389 INTEGER, DIMENSION(1) :: ilen0 ! length of boundary data (from OBC arrays) 383 INTEGER :: itide, isz, ib ! dummy loop indices 390 384 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 391 385 !!---------------------------------------------------------------------- 392 386 ! 393 igrd=1 394 ! SSH on tracer grid. 395 ilen0(1) = SIZE(td%ssh0(:,1,1)) 396 ! 397 ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 398 ! 399 DO itide = 1, nb_harmo 400 DO ib = 1, ilen0(igrd) 401 mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.) 402 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 387 IF( ASSOCIATED(td%ssh0) ) THEN ! SSH on tracer grid. 388 ! 389 isz = SIZE( td%ssh0, dim = 1 ) 390 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 391 ! 392 DO itide = 1, nb_harmo 393 DO ib = 1, isz 394 mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) ) 395 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 396 END DO 397 DO ib = 1, isz 398 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 399 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 400 END DO 401 DO ib = 1, isz 402 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 403 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 404 END DO 403 405 END DO 404 DO ib = 1 , ilen0(igrd) 405 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 406 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 407 ENDDO 408 DO ib = 1 , ilen0(igrd) 409 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 410 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 411 ENDDO 412 END DO 413 ! 414 DEALLOCATE( mod_tide, phi_tide ) 406 ! 407 DEALLOCATE( mod_tide, phi_tide ) 408 ! 409 ENDIF 415 410 ! 416 411 END SUBROUTINE tide_init_elevation … … 424 419 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 425 420 ! 426 INTEGER :: itide, igrd, ib ! dummy loop indices 427 INTEGER, DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays) 421 INTEGER :: itide, isz, ib ! dummy loop indices 428 422 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 429 423 !!---------------------------------------------------------------------- 430 424 ! 431 ilen0(2) = SIZE(td%u0(:,1,1)) 432 ilen0(3) = SIZE(td%v0(:,1,1)) 433 ! 434 igrd=2 ! U grid. 435 ! 436 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 437 ! 438 DO itide = 1, nb_harmo 439 DO ib = 1, ilen0(igrd) 440 mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.) 441 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 425 IF( ASSOCIATED(td%u0) ) THEN ! U grid. we use bdy u2d on this mpi subdomain 426 ! 427 isz = SIZE( td%u0, dim = 1 ) 428 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 429 ! 430 DO itide = 1, nb_harmo 431 DO ib = 1, isz 432 mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) ) 433 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 434 END DO 435 DO ib = 1, isz 436 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 437 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 438 END DO 439 DO ib = 1, isz 440 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 441 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 442 END DO 442 443 END DO 443 DO ib = 1, ilen0(igrd) 444 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 445 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 446 ENDDO 447 DO ib = 1, ilen0(igrd) 448 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 449 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 450 ENDDO 451 END DO 452 ! 453 DEALLOCATE( mod_tide , phi_tide ) 454 ! 455 igrd=3 ! V grid. 456 ! 457 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 458 459 DO itide = 1, nb_harmo 460 DO ib = 1, ilen0(igrd) 461 mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.) 462 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 444 ! 445 DEALLOCATE( mod_tide, phi_tide ) 446 ! 447 ENDIF 448 ! 449 IF( ASSOCIATED(td%v0) ) THEN ! V grid. we use bdy u2d on this mpi subdomain 450 ! 451 isz = SIZE( td%v0, dim = 1 ) 452 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 453 ! 454 DO itide = 1, nb_harmo 455 DO ib = 1, isz 456 mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) ) 457 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 458 END DO 459 DO ib = 1, isz 460 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 461 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 462 END DO 463 DO ib = 1, isz 464 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 465 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 466 END DO 463 467 END DO 464 DO ib = 1, ilen0(igrd) 465 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 466 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 467 ENDDO 468 DO ib = 1, ilen0(igrd) 469 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 470 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 471 ENDDO 472 END DO 473 ! 474 DEALLOCATE( mod_tide, phi_tide ) 475 ! 476 END SUBROUTINE tide_init_velocities 468 ! 469 DEALLOCATE( mod_tide, phi_tide ) 470 ! 471 ENDIF 472 ! 473 END SUBROUTINE tide_init_velocities 477 474 478 475 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/C1D/step_c1d.F90
r12377 r13189 27 27 PRIVATE 28 28 29 PUBLIC stp_c1d ! called by opa.F9029 PUBLIC stp_c1d ! called by nemogcm.F90 30 30 31 31 !!---------------------------------------------------------------------- … … 56 56 ! 57 57 INTEGER :: jk ! dummy loop indice 58 INTEGER :: indic ! error indicator if < 059 58 !! --------------------------------------------------------------------- 60 61 indic = 0 ! reset to no error condition62 59 IF( kstp == nit000 ) CALL iom_init( "nemo") ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 63 60 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) … … 88 85 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 89 86 CALL dia_wri( kstp, Nnn ) ! ocean model: outputs 90 IF( lk_diahth )CALL dia_hth( kstp, Nnn ) ! Thermocline depth (20°C)87 CALL dia_hth( kstp, Nnn ) ! Thermocline depth (20°C) 91 88 92 89 … … 111 108 CALL eos( ts(:,:,:,:,Nnn), rhd, rhop, gdept_0(:,:,:) ) ! now potential density for zdfmxl 112 109 IF( ln_zdfnpc ) CALL tra_npc( kstp, Nnn, Nrhs, ts, Naa ) ! applied non penetrative convective adjustment on (t,s) 113 CALL tra_atf( kstp, Nbb, Nnn, Nrhs, Naa, ts ) ! time filtering of "now" tracer fields 114 115 110 CALL tra_atf( kstp, Nbb, Nnn, Naa, ts ) ! time filtering of "now" tracer arrays 116 111 117 112 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 139 134 ! Control and restarts 140 135 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 141 CALL stp_ctl( kstp, Nnn , indic)136 CALL stp_ctl( kstp, Nnn ) 142 137 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 143 138 IF( lrst_oce ) CALL rst_write( kstp, Nbb, Nnn ) ! write output ocean restart file 144 139 ! 145 140 #if defined key_iomput 146 IF( kstp == nitend .OR. indic <0 ) CALL xios_context_finalize() ! needed for XIOS141 IF( kstp == nitend .OR. nstop > 0 ) CALL xios_context_finalize() ! needed for XIOS 147 142 ! 148 143 #endif -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DIA/diaar5.F90
r12495 r13189 32 32 REAL(wp) :: vol0 ! ocean volume (interior domain) 33 33 REAL(wp) :: area_tot ! total ocean surface (interior domain) 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: area ! cell surface (interior domain)35 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain) 36 35 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity … … 54 53 !!---------------------------------------------------------------------- 55 54 ! 56 ALLOCATE( area(jpi,jpj),thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc )55 ALLOCATE( thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 57 56 ! 58 57 CALL mpp_sum ( 'diaar5', dia_ar5_alloc ) … … 78 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 79 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe, z2d ! 2D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , z rhop, ztpot! 3D workspace79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , ztpot ! 3D workspace 81 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 82 81 … … 88 87 IF( l_ar5 ) THEN 89 88 ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 90 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk))89 ALLOCATE( zrhd(jpi,jpj,jpk) ) 91 90 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 92 zarea_ssh(:,:) = area(:,:) * ssh(:,:,Kmm)93 ENDIF 94 ! 95 CALL iom_put( 'e2u' , e2u (:,:) )96 CALL iom_put( 'e1v' , e1v (:,:) )97 CALL iom_put( 'areacello', area(:,:) )91 zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) 92 ENDIF 93 ! 94 CALL iom_put( 'e2u' , e2u (:,:) ) 95 CALL iom_put( 'e1v' , e1v (:,:) ) 96 CALL iom_put( 'areacello', e1e2t(:,:) ) 98 97 ! 99 98 IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN 100 99 zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace 101 100 DO jk = 1, jpkm1 102 zrhd(:,:,jk) = area(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)101 zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 103 102 END DO 104 103 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 … … 151 150 END IF 152 151 ! 153 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )152 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 154 153 zssh_steric = - zarho / area_tot 155 154 CALL iom_put( 'sshthster', zssh_steric ) 156 155 157 156 ! ! steric sea surface height 158 CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) ) ! now in situ and potential density159 zrhop(:,:,jpk) = 0._wp160 CALL iom_put( 'rhop', zrhop )161 !162 157 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 163 158 DO jk = 1, jpkm1 164 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk)159 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) 165 160 END DO 166 161 IF( ln_linssh ) THEN … … 169 164 DO jj = 1,jpj 170 165 iks = mikt(ji,jj) 171 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)166 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) 172 167 END DO 173 168 END DO 174 169 ELSE 175 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1)170 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) 176 171 END IF 177 172 END IF 178 173 ! 179 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) )174 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 180 175 zssh_steric = - zarho / area_tot 181 176 CALL iom_put( 'sshsteric', zssh_steric ) … … 191 186 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 192 187 DO_3D_11_11( 1, jpkm1 ) 193 zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm)188 zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) 194 189 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 195 190 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) … … 237 232 z2d(:,:) = 0._wp 238 233 DO jk = 1, jpkm1 239 z2d(:,:) = z2d(:,:) + area(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk)234 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 240 235 END DO 241 236 ztemp = glob_sum( 'diaar5', z2d(:,:) ) … … 244 239 ! 245 240 IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10 246 zsst = glob_sum( 'diaar5', area(:,:) * ztpot(:,:,1) )241 zsst = glob_sum( 'diaar5', e1e2t(:,:) * ztpot(:,:,1) ) 247 242 CALL iom_put( 'ssttot', zsst / area_tot ) 248 243 ENDIF … … 259 254 ELSE 260 255 IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80 261 zsst = glob_sum( 'diaar5', area(:,:) * ts(:,:,1,jp_tem,Kmm) )256 zsst = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) ) 262 257 CALL iom_put('ssttot', zsst / area_tot ) 263 258 ENDIF … … 294 289 IF( l_ar5 ) THEN 295 290 DEALLOCATE( zarea_ssh , zbotpres, z2d ) 296 DEALLOCATE( zrhd , zrhop )297 291 DEALLOCATE( ztsn ) 298 292 ENDIF … … 368 362 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & 369 363 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 370 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) L_ar5 = .TRUE. 364 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) .OR. & 365 & iom_use( 'rhop' ) ) L_ar5 = .TRUE. 371 366 372 367 IF( l_ar5 ) THEN … … 375 370 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 376 371 377 area(:,:) = e1e2t(:,:) 378 area_tot = glob_sum( 'diaar5', area(:,:) ) 372 area_tot = glob_sum( 'diaar5', e1e2t(:,:) ) 379 373 380 374 ALLOCATE( zvol0(jpi,jpj) ) … … 383 377 DO_3D_11_11( 1, jpkm1 ) 384 378 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 385 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * area(ji,jj)379 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * e1e2t(ji,jj) 386 380 thick0(ji,jj) = thick0(ji,jj) + idep 387 381 END_3D -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DIA/diamlr.F90
r12377 r13189 84 84 INTEGER :: itide ! Number of available tidal components 85 85 REAL(wp) :: ztide_phase ! Tidal-constituent phase at adatrj=0 86 CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: ctide_selected = ' 86 CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: ctide_selected = 'n/a ' 87 87 TYPE(tide_harmonic), DIMENSION(:), POINTER :: stideconst 88 88 … … 145 145 ! Retrieve information (frequency, phase, nodal correction) about all 146 146 ! available tidal constituents for placeholder substitution below 147 ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf', & 148 & 'Msqm', 'Sa', 'K1', 'O1', 'P1', & 149 & 'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', & 150 & 'K2', 'nu2', 'mu2', '2N2', 'L2', & 151 & 'T2', 'eps2', 'lam2', 'R2', 'M3', & 152 & 'MKS2', 'MN4', 'MS4', 'M4', 'N4', & 153 & 'S4', 'M6', 'M8' /) 147 ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 148 ctide_selected(1:34) = (/ 'Mf ', 'Mm ', 'Ssa ', 'Mtm ', 'Msf ', & 149 & 'Msqm', 'Sa ', 'K1 ', 'O1 ', 'P1 ', & 150 & 'Q1 ', 'J1 ', 'S1 ', 'M2 ', 'S2 ', 'N2 ', & 151 & 'K2 ', 'nu2 ', 'mu2 ', '2N2 ', 'L2 ', & 152 & 'T2 ', 'eps2', 'lam2', 'R2 ', 'M3 ', & 153 & 'MKS2', 'MN4 ', 'MS4 ', 'M4 ', 'N4 ', & 154 & 'S4 ', 'M6 ', 'M8 ' /) 154 155 CALL tide_init_harmonics(ctide_selected, stideconst) 155 156 itide = size(stideconst) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DIA/diawri.F90
r12495 r13189 171 171 CALL iom_put( "sbs", z2d ) ! bottom salinity 172 172 ENDIF 173 174 CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0) 173 175 174 176 IF ( iom_use("taubot") ) THEN ! bottom stress … … 924 926 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 925 927 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 926 927 #if defined key_si3 928 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 929 #else 930 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 931 #endif 932 928 ! 929 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 930 ! 933 931 CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature 934 932 CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity … … 943 941 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 944 942 CALL iom_rstput( 0, 0, inum, 'ht' , ht ) ! now water column height 945 943 ! 946 944 IF ( ln_isf ) THEN 947 945 IF (ln_isfcav_mlt) THEN … … 949 947 CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav ) ! now k-velocity 950 948 CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav ) ! now k-velocity 951 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav, 8)) ! now k-velocity952 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav, 8)) ! now k-velocity953 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav, 8), ktype = jp_i1 )949 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) ) ! now k-velocity 950 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) ) ! now k-velocity 951 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 954 952 END IF 955 953 IF (ln_isfpar_mlt) THEN 956 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par, 8)) ! now k-velocity954 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) ) ! now k-velocity 957 955 CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par ) ! now k-velocity 958 956 CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par ) ! now k-velocity 959 957 CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par ) ! now k-velocity 960 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par, 8)) ! now k-velocity961 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par, 8)) ! now k-velocity962 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par, 8), ktype = jp_i1 )958 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) ) ! now k-velocity 959 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) ) ! now k-velocity 960 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 963 961 END IF 964 962 END IF 965 963 ! 966 964 IF( ALLOCATED(ahtu) ) THEN 967 965 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point … … 993 991 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 994 992 ENDIF 995 993 ! 994 CALL iom_close( inum ) 995 ! 996 996 #if defined key_si3 997 997 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 998 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 998 999 CALL ice_wri_state( inum ) 999 ENDIF 1000 CALL iom_close( inum ) 1001 ENDIF 1002 ! 1000 1003 #endif 1001 !1002 CALL iom_close( inum )1003 !1004 1004 END SUBROUTINE dia_wri_state 1005 1005 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DOM/dom_oce.F90
r12495 r13189 17 17 !!---------------------------------------------------------------------- 18 18 !! Agrif_Root : dummy function used when lk_agrif=F 19 !! Agrif_Fixed : dummy function used when lk_agrif=F 19 20 !! Agrif_CFixed : dummy function used when lk_agrif=F 20 21 !! dom_oce_alloc : dynamical allocation of dom_oce arrays … … 233 234 END FUNCTION Agrif_Root 234 235 236 INTEGER FUNCTION Agrif_Fixed() 237 Agrif_Fixed = 0 238 END FUNCTION Agrif_Fixed 239 235 240 CHARACTER(len=3) FUNCTION Agrif_CFixed() 236 241 Agrif_CFixed = '0' -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DOM/dommsk.F90
r12377 r13189 259 259 ENDIF 260 260 END DO 261 #if defined key_agrif262 IF( .NOT. AGRIF_Root() ) THEN263 IF ((nbondi == 1).OR.(nbondi == 2)) fmask(nlci-1 , : ,jk) = 0.e0 ! east264 IF ((nbondi == -1).OR.(nbondi == 2)) fmask(1 , : ,jk) = 0.e0 ! west265 IF ((nbondj == 1).OR.(nbondj == 2)) fmask(: ,nlcj-1 ,jk) = 0.e0 ! north266 IF ((nbondj == -1).OR.(nbondj == 2)) fmask(: ,1 ,jk) = 0.e0 ! south267 ENDIF268 #endif269 261 END DO 270 262 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DOM/domvvl.F90
r12495 r13189 903 903 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 904 904 905 DO ji = 1, jpi 906 DO jj = 1, jpj 907 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 908 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 909 ENDIF 910 END DO 911 END DO 905 DO_2D_11_11 906 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 907 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 908 ENDIF 909 END_2D 912 910 ! 913 911 ELSE -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DOM/istate.F90
r12495 r13189 24 24 USE dom_oce ! ocean space and time domain 25 25 USE daymod ! calendar 26 USE divhor ! horizontal divergence (div_hor routine)27 26 USE dtatsd ! data temperature and salinity (dta_tsd routine) 28 27 USE dtauvd ! data: U & V current (dta_uvd routine) … … 121 120 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 122 121 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 123 hdiv(:,:,jpk) = 0._wp ! bottom divergence set one for 0 to zero at jpk level124 CALL div_hor( 0, Kbb, Kmm ) ! compute interior hdiv value125 !!gm hdiv(:,:,:) = 0._wp126 122 127 123 !!gm POTENTIAL BUG : -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DYN/divhor.F90
r12377 r13189 84 84 END_3D 85 85 ! 86 #if defined key_agrif87 IF( .NOT. Agrif_Root() ) THEN88 IF( nbondi == -1 .OR. nbondi == 2 ) hdiv( 2 , : ,:) = 0._wp ! west89 IF( nbondi == 1 .OR. nbondi == 2 ) hdiv( nlci-1, : ,:) = 0._wp ! east90 IF( nbondj == -1 .OR. nbondj == 2 ) hdiv( : , 2 ,:) = 0._wp ! south91 IF( nbondj == 1 .OR. nbondj == 2 ) hdiv( : ,nlcj-1,:) = 0._wp ! north92 ENDIF93 #endif94 !95 86 IF( ln_rnf ) CALL sbc_rnf_div( hdiv, Kmm ) !== runoffs ==! (update hdiv field) 96 87 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DYN/dynldf_lap_blp.F90
r12377 r13189 74 74 DO_2D_01_01 75 75 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 76 !!gm open question here : e3f at before or now ? probably now... 77 !!gm note that ahmf has already been multiplied by fmask 78 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & 76 zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1) & ! ahmf already * by fmask 79 77 & * ( e2v(ji ,jj-1) * pv(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk) & 80 78 & - e1u(ji-1,jj ) * pu(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk) ) 81 79 ! ! ahm * div (computed from 2 to jpi/jpj) 82 !!gm note that ahmt has already been multiplied by tmask 83 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb) & 80 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb) & ! ahmt already * by tmask 84 81 & * ( e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk) & 85 82 & + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk) ) … … 87 84 ! 88 85 DO_2D_00_00 89 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * ( &86 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 90 87 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 91 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) )88 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 92 89 ! 93 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * ( &90 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * ( & ! * by vmask is mandatory for dyn_ldf_blp use 94 91 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm) & 95 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) )92 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 96 93 END_2D 97 94 ! ! =============== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DYN/dynvor.F90
r12377 r13189 810 810 DO_3D_10_10( 1, jpk ) 811 811 IF( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 812 & + tmask(ji,jj ,jk) + tmask(ji+1,jj +1,jk) == 3._wp ) fmask(ji,jj,jk) = 1._wp812 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) == 3._wp ) fmask(ji,jj,jk) = 1._wp 813 813 END_3D 814 814 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/DYN/sshwzv.F90
r12495 r13189 202 202 #if defined key_agrif 203 203 IF( .NOT. AGRIF_Root() ) THEN 204 IF ((nbondi == 1).OR.(nbondi == 2)) pww(nlci-1 , : ,:) = 0.e0 ! east 205 IF ((nbondi == -1).OR.(nbondi == 2)) pww(2 , : ,:) = 0.e0 ! west 206 IF ((nbondj == 1).OR.(nbondj == 2)) pww(: ,nlcj-1 ,:) = 0.e0 ! north 207 IF ((nbondj == -1).OR.(nbondj == 2)) pww(: ,2 ,:) = 0.e0 ! south 204 ! Mask vertical velocity at first/last columns/row 205 ! inside computational domain (cosmetic) 206 ! --- West --- ! 207 DO ji = mi0(2), mi1(2) 208 DO jj = 1, jpj 209 pww(ji,jj,:) = 0._wp 210 ENDDO 211 ENDDO 212 ! 213 ! --- East --- ! 214 DO ji = mi0(jpiglo-1), mi1(jpiglo-1) 215 DO jj = 1, jpj 216 pww(ji,jj,:) = 0._wp 217 ENDDO 218 ENDDO 219 ! 220 ! --- South --- ! 221 DO jj = mj0(2), mj1(2) 222 DO ji = 1, jpi 223 pww(ji,jj,:) = 0._wp 224 ENDDO 225 ENDDO 226 ! 227 ! --- North --- ! 228 DO jj = mj0(jpjglo-1), mj1(jpjglo-1) 229 DO ji = 1, jpi 230 pww(ji,jj,:) = 0._wp 231 ENDDO 232 ENDDO 208 233 ENDIF 209 234 #endif -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/FLO/floblk.F90
r12495 r13189 175 175 zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl)) 176 176 IF( zufl(jfl)*zuoutfl <= 0. ) THEN 177 ztxfl(jfl) = 1.E99177 ztxfl(jfl) = HUGE(1._wp) 178 178 ELSE 179 179 IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN … … 191 191 zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl)) 192 192 IF( zvfl(jfl)*zvoutfl <= 0. ) THEN 193 ztyfl(jfl) = 1.E99193 ztyfl(jfl) = HUGE(1._wp) 194 194 ELSE 195 195 IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN … … 208 208 zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl)) 209 209 IF( zwfl(jfl)*zwoutfl <= 0. ) THEN 210 ztzfl(jfl) = 1.E99210 ztzfl(jfl) = HUGE(1._wp) 211 211 ELSE 212 212 IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/ICB/icbrst.F90
r12472 r13189 188 188 ! 189 189 INTEGER :: jn ! dummy loop index 190 INTEGER :: idg ! number of digits 190 191 INTEGER :: ix_dim, iy_dim, ik_dim, in_dim 191 192 CHARACTER(len=256) :: cl_path 192 193 CHARACTER(len=256) :: cl_filename 193 CHARACTER(len=256) :: cl_kt 194 CHARACTER(len=8 ) :: cl_kt 195 CHARACTER(LEN=12 ) :: clfmt ! writing format 194 196 TYPE(iceberg), POINTER :: this 195 197 TYPE(point) , POINTER :: pt … … 211 213 ! file name 212 214 WRITE(cl_kt, '(i8.8)') kt 213 cl_filename = TRIM(cexper)//"_"// TRIM(ADJUSTL(cl_kt))//"_"//TRIM(cn_icbrst_out)215 cl_filename = TRIM(cexper)//"_"//cl_kt//"_"//TRIM(cn_icbrst_out) 214 216 IF( lk_mpp ) THEN 215 WRITE(cl_filename,'(A,"_",I4.4,".nc")') TRIM(cl_filename), narea-1 217 idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 218 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 219 WRITE(cl_filename, clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 216 220 ELSE 217 WRITE(cl_filename,'( A,".nc")') TRIM(cl_filename)221 WRITE(cl_filename,'(a,a)') TRIM(cl_filename), '.nc' 218 222 ENDIF 219 223 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/ICB/icbtrj.F90
r12495 r13189 62 62 ! 63 63 INTEGER :: iret, iyear, imonth, iday 64 INTEGER :: idg ! number of digits 64 65 REAL(wp) :: zfjulday, zsec 65 66 CHARACTER(len=80) :: cl_filename 66 CHARACTER(LEN=20) :: cldate_ini, cldate_end 67 CHARACTER(LEN=12) :: clfmt ! writing format 68 CHARACTER(LEN=8 ) :: cldate_ini, cldate_end 67 69 TYPE(iceberg), POINTER :: this 68 70 TYPE(point) , POINTER :: pt … … 80 82 81 83 ! define trajectory output name 82 IF ( lk_mpp ) THEN ; WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A,"_",I4.4,".nc")') & 83 & TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)), narea-1 84 ELSE ; WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A ,".nc")') & 85 & TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)) 84 cl_filename = 'trajectory_icebergs_'//cldate_ini//'-'//cldate_end 85 IF ( lk_mpp ) THEN 86 idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 87 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 88 WRITE(cl_filename, clfmt) TRIM(cl_filename), '_', narea-1, '.nc' 89 ELSE 90 WRITE(cl_filename,'(a,a)') TRIM(cl_filename), '.nc' 86 91 ENDIF 87 92 IF( lwp .AND. nn_verbose_level >= 0 ) WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/IOM/in_out_manager.F90
r12377 r13189 100 100 !!---------------------------------------------------------------------- 101 101 TYPE :: sn_ctl !: structure for control over output selection 102 LOGICAL :: l_glochk = .FALSE. !: range sanity checks are local (F) or global (T)103 ! Use global setting for debugging only;104 ! local breaches will still be reported105 ! and stop the code in most cases.106 LOGICAL :: l_allon = .FALSE. !: overall control; activate all following output options107 LOGICAL :: l_config = .FALSE. !: activate/deactivate finer control108 ! Note if l_config is True then sn_cfctl%l_allon is ignored.109 ! Otherwise setting sn_cfctl%l_allon T/F is equivalent to110 ! setting all the following logicals in this structure T/F111 ! and disabling subsetting of processors112 102 LOGICAL :: l_runstat = .FALSE. !: Produce/do not produce run.stat file (T/F) 113 103 LOGICAL :: l_trcstat = .FALSE. !: Produce/do not produce tracer.stat file (T/F) … … 169 159 INTEGER :: no_print = 0 !: optional argument of fld_fill (if present, suppress some control print) 170 160 INTEGER :: nstop = 0 !: error flag (=number of reason for a premature stop run) 161 !$AGRIF_DO_NOT_TREAT 162 INTEGER :: ngrdstop = -1 !: grid number having nstop > 1 163 !$AGRIF_END_DO_NOT_TREAT 171 164 INTEGER :: nwarn = 0 !: warning flag (=number of warning found during the run) 172 165 CHARACTER(lc) :: ctmp1, ctmp2, ctmp3 !: temporary characters 1 to 3 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/IOM/iom.F90
r12495 r13189 111 111 CHARACTER(len=lc) :: clname 112 112 INTEGER :: irefyear, irefmonth, irefday 113 INTEGER :: ji , jkmin113 INTEGER :: ji 114 114 LOGICAL :: llrst_context ! is context related to restart 115 115 ! … … 220 220 221 221 ! Add vertical grid bounds 222 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 223 zt_bnds(2,: ) = gdept_1d(:) 224 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 225 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 226 zw_bnds(1,: ) = gdepw_1d(:) 227 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 228 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 222 zt_bnds(2,: ) = gdept_1d(:) 223 zt_bnds(1,2:jpk ) = gdept_1d(1:jpkm1) 224 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 225 zw_bnds(1,: ) = gdepw_1d(:) 226 zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 227 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 229 228 CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 230 229 CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) … … 665 664 666 665 667 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev )666 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 668 667 !!--------------------------------------------------------------------- 669 668 !! *** SUBROUTINE iom_open *** … … 678 677 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 679 678 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels 679 CHARACTER(len=3), INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open 680 680 ! 681 681 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] … … 823 823 ENDIF 824 824 IF( istop == nstop ) THEN ! no error within this routine 825 CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev )825 CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 826 826 ENDIF 827 827 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/IOM/iom_def.F90
r12377 r13189 33 33 INTEGER, PARAMETER, PUBLIC :: jpmax_vars = 1200 !: maximum number of variables in one file 34 34 INTEGER, PARAMETER, PUBLIC :: jpmax_dims = 4 !: maximum number of dimensions for one variable 35 INTEGER, PARAMETER, PUBLIC :: jpmax_digits = 5!: maximum number of digits for the cpu number in the file name35 INTEGER, PARAMETER, PUBLIC :: jpmax_digits = 9 !: maximum number of digits for the cpu number in the file name 36 36 37 37 … … 50 50 TYPE, PUBLIC :: file_descriptor 51 51 CHARACTER(LEN=240) :: name !: name of the file 52 CHARACTER(LEN=3 ) :: comp !: name of component opening the file ('OCE', 'ICE'...) 52 53 INTEGER :: nfid !: identifier of the file (0 if closed) 53 54 !: jpioipsl option has been removed) … … 64 65 REAL(kind=wp), DIMENSION(jpmax_vars) :: scf !: scale_factor of the variables 65 66 REAL(kind=wp), DIMENSION(jpmax_vars) :: ofs !: add_offset of the variables 66 INTEGER :: nlev ! number of vertical levels67 67 END TYPE file_descriptor 68 68 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/IOM/iom_nf90.F90
r12377 r13189 19 19 !!---------------------------------------------------------------------- 20 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce, ONLY: jpka,ght_abl ! abl vertical level number and height21 USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height 22 22 USE lbclnk ! lateal boundary condition / mpp exchanges 23 23 USE iom_def ! iom variables definitions … … 46 46 CONTAINS 47 47 48 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev )48 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 49 49 !!--------------------------------------------------------------------- 50 50 !! *** SUBROUTINE iom_open *** … … 58 58 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 59 59 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the ice/abl third dimension 60 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open 60 61 61 62 CHARACTER(LEN=256) :: clinfo ! info character 62 63 CHARACTER(LEN=256) :: cltmp ! temporary character 64 CHARACTER(LEN=12 ) :: clfmt ! writing format 65 CHARACTER(LEN=3 ) :: clcomp ! name of component calling iom_nf90_open 66 INTEGER :: idg ! number of digits 63 67 INTEGER :: iln ! lengths of character 64 68 INTEGER :: istop ! temporary storage of nstop … … 70 74 INTEGER :: ihdf5 ! local variable for retrieval of value for NF90_HDF5 71 75 LOGICAL :: llclobber ! local definition of ln_clobber 72 INTEGER :: ilevels ! vertical levels73 76 !--------------------------------------------------------------------- 74 77 ! … … 77 80 ! 78 81 ! !number of vertical levels 79 IF( PRESENT(kdlev) ) THEN ; ilevels = kdlev ! use input value (useful for sea-ice and abl) 80 ELSE ; ilevels = jpk ! by default jpk 82 IF( PRESENT(cdcomp) ) THEN 83 IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' ) 84 clcomp = cdcomp ! use input value 85 ELSE 86 clcomp = 'OCE' ! by default 81 87 ENDIF 82 88 ! … … 105 111 IF( ldwrt ) THEN !* the file should be open in write mode so we create it... 106 112 IF( jpnij > 1 ) THEN 107 WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 113 idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 114 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 115 WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 108 116 cdname = TRIM(cltmp) 109 117 ENDIF … … 125 133 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 126 134 ! define dimensions 127 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1), idmy ), clinfo) 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1), idmy ), clinfo) 129 IF( PRESENT(kdlev) ) THEN 130 IF( kdlev == jpka ) THEN 131 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', kdlev, idmy ), clinfo) 132 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 133 ELSE 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 137 ENDIF 138 ELSE 139 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 140 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 141 ENDIF 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1), idmy ), clinfo) 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1), idmy ), clinfo) 137 SELECT CASE (clcomp) 138 CASE ('OCE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk, idmy ), clinfo) 139 CASE ('ICE') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numcat', kdlev, idmy ), clinfo) 140 CASE ('ABL') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', kdlev, idmy ), clinfo) 141 CASE ('SED') ; CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'numsed', kdlev, idmy ), clinfo) 142 CASE DEFAULT ; CALL ctl_stop( 'iom_nf90_open unknown component type' ) 143 END SELECT 144 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 142 145 ! global attributes 143 146 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) … … 165 168 ENDDO 166 169 iom_file(kiomid)%name = TRIM(cdname) 170 iom_file(kiomid)%comp = clcomp 167 171 iom_file(kiomid)%nfid = if90id 168 172 iom_file(kiomid)%nvars = 0 169 173 iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode 170 iom_file(kiomid)%nlev = ilevels171 174 CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 172 175 IF( iom_file(kiomid)%iduld .GE. 0 ) THEN … … 529 532 INTEGER, DIMENSION(4) :: idimid ! dimensions id 530 533 CHARACTER(LEN=256) :: clinfo ! info character 531 CHARACTER(LEN= 12), DIMENSION(5) :: cltmp ! temporary character532 534 INTEGER :: if90id ! nf90 file identifier 533 INTEGER :: idmy ! dummy variable534 535 INTEGER :: itype ! variable type 535 536 INTEGER, DIMENSION(4) :: ichunksz ! NetCDF4 chunk sizes. Will be computed using … … 540 541 ! ! when appropriate (currently chunking is applied to 4d fields only) 541 542 INTEGER :: idlv ! local variable 542 INTEGER :: idim3 ! id of the third dimension543 543 !--------------------------------------------------------------------- 544 544 ! … … 554 554 ENDIF 555 555 ! define the dimension variables if it is not already done 556 ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 557 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter', 'numcat ' /) 558 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 559 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 560 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3 /), iom_file(kiomid)%nvid(3) ), clinfo) 561 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4 /), iom_file(kiomid)%nvid(4) ), clinfo) 556 DO jd = 1, 2 557 CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo) 558 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /), & 559 & iom_file(kiomid)%nvid(jd) ), clinfo) 560 END DO 561 iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2) ! second dim of first variable 562 iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1) ! first dim of second variable 563 DO jd = 3, 4 564 CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo) 565 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd /), & 566 & iom_file(kiomid)%nvid(jd) ), clinfo) 567 END DO 562 568 ! update informations structure related the dimension variable we just added... 563 569 iom_file(kiomid)%nvars = 4 564 570 iom_file(kiomid)%luld(1:4) = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 565 iom_file(kiomid)%cn_var(1:4) = cltmp(1:4)566 571 iom_file(kiomid)%ndims(1:4) = (/ 2, 2, 1, 1 /) 567 IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN ! add a 5th variable corresponding to the 5th dimension568 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo)569 iom_file(kiomid)%nvars = 5570 iom_file(kiomid)%luld(5) = .FALSE.571 iom_file(kiomid)%cn_var(5) = cltmp(5)572 iom_file(kiomid)%ndims(5) = 1573 ENDIF574 ! trick: defined to 0 to say that dimension variables are defined but not yet written575 iom_file(kiomid)%dimsz(1, 1) = 0576 572 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 577 573 ENDIF … … 594 590 IF( PRESENT(pv_r0d) ) THEN ; idims = 0 595 591 ELSEIF( PRESENT(pv_r1d) ) THEN 596 IF(( SIZE(pv_r1d,1) == jpk ).OR.( SIZE(pv_r1d,1) == jpka )) THEN ; idim3 = 3 597 ELSE ; idim3 = 5 598 ENDIF 599 idims = 2 ; idimid(1:idims) = (/idim3,4/) 600 ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2 ,4/) 592 idims = 2 ; idimid(1:idims) = (/3,4/) 593 ELSEIF( PRESENT(pv_r2d) ) THEN ; idims = 3 ; idimid(1:idims) = (/1,2,4/) 601 594 ELSEIF( PRESENT(pv_r3d) ) THEN 602 IF(( SIZE(pv_r3d,3) == jpk ).OR.( SIZE(pv_r3d,3) == jpka )) THEN ; idim3 = 3 603 ELSE ; idim3 = 5 604 ENDIF 605 idims = 4 ; idimid(1:idims) = (/1,2,idim3,4/) 595 idims = 4 ; idimid(1:idims) = (/1,2,3,4/) 606 596 ENDIF 607 597 IF( PRESENT(ktype) ) THEN ! variable external type … … 678 668 ! ============= 679 669 ! trick: is defined to 0 => dimension variable are defined but not yet written 680 IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 681 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon' , idmy ) , clinfo ) 682 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 683 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat' , idmy ) , clinfo ) 684 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 685 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo ) 686 IF (iom_file(kiomid)%nlev == jpka) THEN ; CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, ght_abl), clinfo ) 687 ELSE ; CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gdept_1d), clinfo ) 688 ENDIF 689 IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 690 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 691 ENDIF 692 ! +++ WRONG VALUE: to be improved but not really useful... 693 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 694 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt ), clinfo ) 695 ! update the values of the variables dimensions size 696 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 697 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 698 iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 699 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 700 iom_file(kiomid)%dimsz(1 , 4) = 1 ! unlimited dimension 670 IF( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN ! time_counter = 0 671 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 1, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 672 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 2, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 673 SELECT CASE (iom_file(kiomid)%comp) 674 CASE ('OCE') 675 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, gdept_1d ), clinfo ) 676 CASE ('ABL') 677 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, ght_abl ), clinfo ) 678 CASE DEFAULT 679 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo ) 680 END SELECT 681 ! "wrong" value: to be improved but not really useful... 682 CALL iom_nf90_check( NF90_PUT_VAR( if90id, 4, kt ), clinfo ) 683 ! update the size of the variable corresponding to the unlimited dimension 684 iom_file(kiomid)%dimsz(1, 4) = 1 ! so we don't enter this IF case any more... 701 685 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 702 686 ENDIF -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/ISF/isfdiags.F90
r12340 r13189 88 88 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac ! thickness of the tbl and fraction of last cell affected by the tbl 89 89 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d ! 2d var to map in 3d 90 CHARACTER(LEN= 256), INTENT(in) :: cdvar90 CHARACTER(LEN=*), INTENT(in) :: cdvar 91 91 !!--------------------------------------------------------------------- 92 92 INTEGER :: ji, jj, jk ! loop indices -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/LBC/lib_mpp.F90
r12551 r13189 1112 1112 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cd2, cd3, cd4, cd5 1113 1113 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cd6, cd7, cd8, cd9, cd10 1114 ! 1115 CHARACTER(LEN=8) :: clfmt ! writing format 1116 INTEGER :: inum 1114 1117 !!---------------------------------------------------------------------- 1115 1118 ! 1116 1119 nstop = nstop + 1 1117 1120 ! 1118 ! force to open ocean.output file if not already opened 1119 IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 1121 IF( cd1 == 'STOP' .AND. narea /= 1 ) THEN ! Immediate stop: add an arror message in 'ocean.output' file 1122 CALL ctl_opn( inum, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 1123 WRITE(inum,*) 1124 WRITE(inum,*) ' ==>>> Look for "E R R O R" messages in all existing *ocean.output* files' 1125 CLOSE(inum) 1126 ENDIF 1127 IF( numout == 6 ) THEN ! force to open ocean.output file if not already opened 1128 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 1129 ENDIF 1120 1130 ! 1121 1131 WRITE(numout,*) … … 1145 1155 WRITE(numout,*) 'huge E-R-R-O-R : immediate stop' 1146 1156 WRITE(numout,*) 1157 CALL FLUSH(numout) 1158 CALL SLEEP(60) ! make sure that all output and abort files are written by all cores. 60s should be enough... 1147 1159 CALL mppstop( ld_abort = .true. ) 1148 1160 ENDIF … … 1207 1219 ! 1208 1220 CHARACTER(len=80) :: clfile 1221 CHARACTER(LEN=10) :: clfmt ! writing format 1209 1222 INTEGER :: iost 1223 INTEGER :: idg ! number of digits 1210 1224 !!---------------------------------------------------------------------- 1211 1225 ! … … 1214 1228 clfile = TRIM(cdfile) 1215 1229 IF( PRESENT( karea ) ) THEN 1216 IF( karea > 1 ) WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1 1230 IF( karea > 1 ) THEN 1231 ! Warning: jpnij is maybe not already defined when calling ctl_opn -> use mppsize instead of jpnij 1232 idg = MAX( INT(LOG10(REAL(MAX(1,mppsize-1),wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 1233 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ')')") idg, idg ! '(a,a,ix.x)' 1234 WRITE(clfile, clfmt) TRIM(clfile), '_', karea-1 1235 ENDIF 1217 1236 ENDIF 1218 1237 #if defined key_agrif -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/LBC/mpp_loc_generic.h90
r10716 r13189 32 32 REAL(wp) , INTENT( out) :: pmin ! Global minimum of ptab 33 33 INDEX_TYPE(:) ! index of minimum in global frame 34 # if defined key_mpp_mpi35 34 ! 36 35 INTEGER :: ierror, ii, idim … … 56 55 ! 57 56 kindex(1) = mig( ilocs(1) ) 58 # 57 #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ 59 58 kindex(2) = mjg( ilocs(2) ) 60 # 61 # 59 #endif 60 #if defined DIM_3d /* avoid warning when kindex has 2 elements */ 62 61 kindex(3) = ilocs(3) 63 # 62 #endif 64 63 ! 65 64 DEALLOCATE (ilocs) 66 65 ! 67 66 index0 = kindex(1)-1 ! 1d index starting at 0 68 # 67 #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ 69 68 index0 = index0 + jpiglo * (kindex(2)-1) 70 # 71 # 69 #endif 70 #if defined DIM_3d /* avoid warning when kindex has 2 elements */ 72 71 index0 = index0 + jpiglo * jpjglo * (kindex(3)-1) 73 # 72 #endif 74 73 END IF 75 74 zain(1,:) = zmin … … 77 76 ! 78 77 IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 78 #if defined key_mpp_mpi 79 79 CALL MPI_ALLREDUCE( zain, zaout, 1, MPI_2DOUBLE_PRECISION, MPI_OPERATION ,MPI_COMM_OCE, ierror) 80 #else 81 zaout(:,:) = zain(:,:) 82 #endif 80 83 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 81 84 ! 82 85 pmin = zaout(1,1) 83 86 index0 = NINT( zaout(2,1) ) 84 # 87 #if defined DIM_3d /* avoid warning when kindex has 2 elements */ 85 88 kindex(3) = index0 / (jpiglo*jpjglo) 86 89 index0 = index0 - kindex(3) * (jpiglo*jpjglo) 87 # 88 # 90 #endif 91 #if defined DIM_2d || defined DIM_3d /* avoid warning when kindex has 1 element */ 89 92 kindex(2) = index0 / jpiglo 90 93 index0 = index0 - kindex(2) * jpiglo 91 # 94 #endif 92 95 kindex(1) = index0 93 96 kindex(:) = kindex(:) + 1 ! start indices at 1 94 #else95 kindex = 0 ; pmin = 0.96 WRITE(*,*) 'ROUTINE_LOC: You should not have seen this print! error?'97 #endif98 97 99 98 END SUBROUTINE ROUTINE_LOC -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/OBS/obs_grid.F90
r10068 r13189 684 684 & fhistx1, fhistx2, fhisty1, fhisty2 685 685 REAL(wp) :: histtol 686 686 CHARACTER(LEN=26) :: clfmt ! writing format 687 INTEGER :: idg ! number of digits 688 687 689 IF (ln_grid_search_lookup) THEN 688 690 … … 709 711 710 712 IF ( ln_grid_global ) THEN 711 WRITE(cfname, FMT="(A,'_',A)") & 712 & TRIM(cn_gridsearchfile), 'global.nc' 713 WRITE(cfname, FMT="(A,'_',A)") TRIM(cn_gridsearchfile), 'global.nc' 713 714 ELSE 714 WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") & 715 & TRIM(cn_gridsearchfile), nproc, jpni, jpnj 715 idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 716 ! define the following format: "(a,a,ix.x,a,ix.x,a,ix.x,a)" 717 WRITE(clfmt, "('(a,a,i', i1, '.', i1',a,i', i1, '.', i1',a,i', i1, '.', i1',a)')") idg, idg, idg, idg, idg, idg 718 WRITE(cfname, clfmt ) TRIM(cn_gridsearchfile),'_', nproc,'of', jpni,'by', jpnj,'.nc' 716 719 ENDIF 717 720 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/OBS/obs_write.F90
r12377 r13189 86 86 CHARACTER(LEN=40) :: clfname 87 87 CHARACTER(LEN=10) :: clfiletype 88 CHARACTER(LEN=12) :: clfmt ! writing format 89 INTEGER :: idg ! number of digits 88 90 INTEGER :: ilevel 89 91 INTEGER :: jvar … … 181 183 fbdata%caddname(1) = 'Hx' 182 184 183 WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 185 idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 186 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 187 WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 184 188 185 189 IF(lwp) THEN … … 326 330 CHARACTER(LEN=10) :: clfiletype 327 331 CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 332 CHARACTER(LEN=12) :: clfmt ! writing format 333 INTEGER :: idg ! number of digits 328 334 INTEGER :: jo 329 335 INTEGER :: ja … … 453 459 fbdata%caddname(1) = 'Hx' 454 460 455 WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 461 idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 462 WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg ! '(a,a,ix.x,a)' 463 WRITE(clfname,clfmt) TRIM(clfiletype), '_fdbk_', nproc, '.nc' 456 464 457 465 IF(lwp) THEN -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcblk.F90
r12565 r13189 658 658 659 659 END SELECT 660 660 661 IF( iom_use('Cd_oce') ) CALL iom_put("Cd_oce", zcd_oce * tmask(:,:,1)) 662 IF( iom_use('Ce_oce') ) CALL iom_put("Ce_oce", zce_oce * tmask(:,:,1)) 663 IF( iom_use('Ch_oce') ) CALL iom_put("Ch_oce", zch_oce * tmask(:,:,1)) 664 !! LB: mainly here for debugging purpose: 665 IF( iom_use('theta_zt') ) CALL iom_put("theta_zt", (ztpot-rt0) * tmask(:,:,1)) ! potential temperature at z=zt 666 IF( iom_use('q_zt') ) CALL iom_put("q_zt", zqair * tmask(:,:,1)) ! specific humidity " 667 IF( iom_use('theta_zu') ) CALL iom_put("theta_zu", (t_zu -rt0) * tmask(:,:,1)) ! potential temperature at z=zu 668 IF( iom_use('q_zu') ) CALL iom_put("q_zu", q_zu * tmask(:,:,1)) ! specific humidity " 669 IF( iom_use('ssq') ) CALL iom_put("ssq", pssq * tmask(:,:,1)) ! saturation specific humidity at z=0 670 IF( iom_use('wspd_blk') ) CALL iom_put("wspd_blk", zU_zu * tmask(:,:,1)) ! bulk wind speed at z=zu 671 661 672 IF( ln_skin_cs .OR. ln_skin_wl ) THEN 662 673 !! ptsk and pssq have been updated!!! … … 670 681 END IF 671 682 672 !! CALL iom_put( "Cd_oce", zcd_oce) ! output value of pure ocean-atm. transfer coef.673 !! CALL iom_put( "Ch_oce", zch_oce) ! output value of pure ocean-atm. transfer coef.674 675 IF( ABS(rn_zu - rn_zqt) < 0.1_wp ) THEN676 !! If zu == zt, then ensuring once for all that:677 t_zu(:,:) = ztpot(:,:)678 q_zu(:,:) = zqair(:,:)679 ENDIF680 681 682 683 ! Turbulent fluxes over ocean => BULK_FORMULA @ sbcblk_phy.F90 683 684 ! ------------------------------------------------------------- 684 685 685 686 IF( ln_abl ) THEN !== ABL formulation ==! multiplication by rho_air and turbulent fluxes computation done in ablstp 686 !! FL do we need this multiplication by tmask ... ???687 687 DO_2D_11_11 688 zztmp = zU_zu(ji,jj) !* tmask(ji,jj,1)688 zztmp = zU_zu(ji,jj) 689 689 wndm(ji,jj) = zztmp ! Store zU_zu in wndm to compute ustar2 in ablmod 690 690 pcd_du(ji,jj) = zztmp * zcd_oce(ji,jj) 691 691 psen(ji,jj) = zztmp * zch_oce(ji,jj) 692 692 pevp(ji,jj) = zztmp * zce_oce(ji,jj) 693 rhoa(ji,jj) = rho_air( ptair(ji,jj), phumi(ji,jj), pslp(ji,jj) ) 693 694 END_2D 694 695 ELSE !== BLK formulation ==! turbulent fluxes computation 695 696 CALL BULK_FORMULA( rn_zu, ptsk(:,:), pssq(:,:), t_zu(:,:), q_zu(:,:), & 696 & zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:), &697 & wndm(:,:), zU_zu(:,:), pslp(:,:), &698 & taum(:,:), psen(:,:), zqla(:,:), &699 & pEvap=pevp(:,:), prhoa=rhoa(:,:) )697 & zcd_oce(:,:), zch_oce(:,:), zce_oce(:,:), & 698 & wndm(:,:), zU_zu(:,:), pslp(:,:), & 699 & taum(:,:), psen(:,:), zqla(:,:), & 700 & pEvap=pevp(:,:), prhoa=rhoa(:,:), pfact_evap=rn_efac ) 700 701 701 702 zqla(:,:) = zqla(:,:) * tmask(:,:,1) … … 732 733 ! ... utau, vtau at U- and V_points, resp. 733 734 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 734 ! Note th e use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves735 ! Note that coastal wind stress is not used in the code... so this extra care has no effect 735 736 DO_2D_00_00 ! start loop at 2, in case ln_crt_fbk = T 736 737 utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( ztau_i(ji,jj) + ztau_i(ji+1,jj ) ) & … … 940 941 Ce_ice(:,:) = Ch_ice(:,:) ! sensible and latent heat transfer coef. are considered identical 941 942 ENDIF 942 943 !! IF ( iom_use("Cd_ice") ) CALL iom_put("Cd_ice", Cd_ice) ! output value of pure ice-atm. transfer coef. 944 !! IF ( iom_use("Ch_ice") ) CALL iom_put("Ch_ice", Ch_ice) ! output value of pure ice-atm. transfer coef. 945 943 944 IF( iom_use('Cd_ice') ) CALL iom_put("Cd_ice", Cd_ice) 945 IF( iom_use('Ce_ice') ) CALL iom_put("Ce_ice", Ce_ice) 946 IF( iom_use('Ch_ice') ) CALL iom_put("Ch_ice", Ch_ice) 947 946 948 ! local scalars ( place there for vector optimisation purposes) 947 !IF (ln_abl) rhoa (:,:) = rho_air( ptair(:,:), phumi(:,:), pslp(:,:) ) !!GS: rhoa must be (re)computed here with ABL to avoid division by zero after (TBI)948 949 zcd_dui(:,:) = wndm_ice(:,:) * Cd_ice(:,:) 949 950 950 951 IF( ln_blk ) THEN 951 ! ------------------------------------------------------------ ! 952 ! Wind stress relative to the moving ice ( U10m - U_ice ) ! 953 ! ------------------------------------------------------------ ! 954 ! C-grid ice dynamics : U & V-points (same as ocean) 955 DO_2D_00_00 956 putaui(ji,jj) = 0.25_wp * ( rhoa(ji+1,jj) * zcd_dui(ji+1,jj) + rhoa(ji,jj) * zcd_dui(ji,jj) ) & 957 & * ( pwndi(ji+1,jj) + pwndi(ji,jj) ) 958 pvtaui(ji,jj) = 0.25_wp * ( rhoa(ji,jj+1) * zcd_dui(ji,jj+1) + rhoa(ji,jj) * zcd_dui(ji,jj) ) & 959 & * ( pwndj(ji,jj+1) + pwndj(ji,jj) ) 952 ! ---------------------------------------------------- ! 953 ! Wind stress relative to nonmoving ice ( U10m ) ! 954 ! ---------------------------------------------------- ! 955 ! supress moving ice in wind stress computation as we don't know how to do it properly... 956 DO_2D_01_01 ! at T point 957 putaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndi(ji,jj) 958 pvtaui(ji,jj) = rhoa(ji,jj) * zcd_dui(ji,jj) * pwndj(ji,jj) 959 END_2D 960 ! 961 DO_2D_00_00 ! U & V-points (same as ocean). 962 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 963 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 964 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 965 putaui(ji,jj) = zztmp1 * ( putaui(ji,jj) + putaui(ji+1,jj ) ) 966 pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji ,jj+1) ) 960 967 END_2D 961 968 CALL lbc_lnk_multi( 'sbcblk', putaui, 'U', -1., pvtaui, 'V', -1. ) … … 1096 1103 evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_rLsub ! sublimation 1097 1104 devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_rLsub ! d(sublimation)/dT 1098 zevap (:,:) = rn_efac * ( emp(:,:) + tprecip(:,:) ) ! evaporation over ocean1105 zevap (:,:) = emp(:,:) + tprecip(:,:) ! evaporation over ocean !LB: removed rn_efac here, correct??? 1099 1106 1100 1107 ! --- evaporation minus precipitation --- ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcblk_algo_coare3p0.F90
r12377 r13189 194 194 IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P0_INIT(l_use_cs, l_use_wl) 195 195 196 l_zt_equal_zu = .FALSE. 197 IF( ABS(zu - zt) < 0.01_wp ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 196 l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 198 197 IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) ) 199 198 … … 396 395 ! 397 396 DO_2D_11_11 398 399 400 401 402 403 404 405 406 407 408 397 ! 398 zw = pwnd(ji,jj) ! wind speed 399 ! 400 ! Charnock's constant, increases with the wind : 401 zgt10 = 0.5 + SIGN(0.5_wp,(zw - 10)) ! If zw<10. --> 0, else --> 1 402 zgt18 = 0.5 + SIGN(0.5_wp,(zw - 18.)) ! If zw<18. --> 0, else --> 1 403 ! 404 alfa_charn_3p0(ji,jj) = (1. - zgt10)*0.011 & ! wind is lower than 10 m/s 405 & + zgt10*((1. - zgt18)*(0.011 + (0.018 - 0.011) & 406 & *(zw - 10.)/(18. - 10.)) + zgt18*( 0.018 ) ) ! Hare et al. (1999) 407 ! 409 408 END_2D 410 409 ! … … 432 431 ! 433 432 DO_2D_11_11 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 433 ! 434 zta = pzeta(ji,jj) 435 ! 436 zphi_m = ABS(1. - 15.*zta)**.25 !!Kansas unstable 437 ! 438 zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.) & 439 & - 2.*ATAN(zphi_m) + 0.5*rpi 440 ! 441 zphi_c = ABS(1. - 10.15*zta)**.3333 !!Convective 442 ! 443 zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 444 & - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 445 ! 446 zf = zta*zta 447 zf = zf/(1. + zf) 448 zc = MIN(50._wp, 0.35_wp*zta) 449 zstab = 0.5 + SIGN(0.5_wp, zta) 450 ! 451 psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 452 & - zstab * ( 1. + 1.*zta & ! (zta > 0) 453 & + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 ) ! " 454 ! 456 455 END_2D 457 456 ! … … 483 482 ! 484 483 DO_2D_11_11 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 484 ! 485 zta = pzeta(ji,jj) 486 ! 487 zphi_h = (ABS(1. - 15.*zta))**.5 !! Kansas unstable (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 488 ! 489 zpsi_k = 2.*LOG((1. + zphi_h)/2.) 490 ! 491 zphi_c = (ABS(1. - 34.15*zta))**.3333 !! Convective 492 ! 493 zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 494 & -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 495 ! 496 zf = zta*zta 497 zf = zf/(1. + zf) 498 zc = MIN(50._wp,0.35_wp*zta) 499 zstab = 0.5 + SIGN(0.5_wp, zta) 500 ! 501 psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 502 & - zstab * ( (ABS(1. + 2.*zta/3.))**1.5 & 503 & + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 504 ! 506 505 END_2D 507 506 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcblk_algo_coare3p6.F90
r12377 r13189 194 194 IF( kt == nit000 ) CALL SBCBLK_ALGO_COARE3P6_INIT(l_use_cs, l_use_wl) 195 195 196 l_zt_equal_zu = .FALSE. 197 IF( ABS(zu - zt) < 0.01_wp ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 196 l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 198 197 IF( .NOT. l_zt_equal_zu ) ALLOCATE( zeta_t(jpi,jpj) ) 199 198 … … 432 431 ! 433 432 DO_2D_11_11 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 433 ! 434 zta = pzeta(ji,jj) 435 ! 436 zphi_m = ABS(1. - 15.*zta)**.25 !!Kansas unstable 437 ! 438 zpsi_k = 2.*LOG((1. + zphi_m)/2.) + LOG((1. + zphi_m*zphi_m)/2.) & 439 & - 2.*ATAN(zphi_m) + 0.5*rpi 440 ! 441 zphi_c = ABS(1. - 10.15*zta)**.3333 !!Convective 442 ! 443 zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 444 & - 1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 445 ! 446 zf = zta*zta 447 zf = zf/(1. + zf) 448 zc = MIN(50._wp, 0.35_wp*zta) 449 zstab = 0.5 + SIGN(0.5_wp, zta) 450 ! 451 psi_m_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & ! (zta < 0) 452 & - zstab * ( 1. + 1.*zta & ! (zta > 0) 453 & + 0.6667*(zta - 14.28)/EXP(zc) + 8.525 ) ! " 454 ! 456 455 END_2D 457 456 ! … … 483 482 ! 484 483 DO_2D_11_11 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 484 ! 485 zta = pzeta(ji,jj) 486 ! 487 zphi_h = (ABS(1. - 15.*zta))**.5 !! Kansas unstable (zphi_h = zphi_m**2 when unstable, zphi_m when stable) 488 ! 489 zpsi_k = 2.*LOG((1. + zphi_h)/2.) 490 ! 491 zphi_c = (ABS(1. - 34.15*zta))**.3333 !! Convective 492 ! 493 zpsi_c = 1.5*LOG((1. + zphi_c + zphi_c*zphi_c)/3.) & 494 & -1.7320508*ATAN((1. + 2.*zphi_c)/1.7320508) + 1.813799447 495 ! 496 zf = zta*zta 497 zf = zf/(1. + zf) 498 zc = MIN(50._wp,0.35_wp*zta) 499 zstab = 0.5 + SIGN(0.5_wp, zta) 500 ! 501 psi_h_coare(ji,jj) = (1. - zstab) * ( (1. - zf)*zpsi_k + zf*zpsi_c ) & 502 & - zstab * ( (ABS(1. + 2.*zta/3.))**1.5 & 503 & + .6667*(zta - 14.28)/EXP(zc) + 8.525 ) 504 ! 506 505 END_2D 507 506 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcblk_algo_ecmwf.F90
r12377 r13189 98 98 & Qsw, rad_lw, slp, pdT_cs, & ! optionals for cool-skin (and warm-layer) 99 99 & pdT_wl, pHz_wl ) ! optionals for warm-layer only 100 !!---------------------------------------------------------------------- 100 !!---------------------------------------------------------------------------------- 101 101 !! *** ROUTINE turb_ecmwf *** 102 102 !! … … 184 184 LOGICAL :: l_zt_equal_zu = .FALSE. ! if q and t are given at same height as U 185 185 ! 186 REAL(wp), DIMENSION(jpi,jpj) :: 187 REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 188 REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air186 REAL(wp), DIMENSION(jpi,jpj) :: u_star, t_star, q_star 187 REAL(wp), DIMENSION(jpi,jpj) :: dt_zu, dq_zu 188 REAL(wp), DIMENSION(jpi,jpj) :: znu_a !: Nu_air, Viscosity of air 189 189 REAL(wp), DIMENSION(jpi,jpj) :: Linv !: 1/L (inverse of Monin Obukhov length... 190 190 REAL(wp), DIMENSION(jpi,jpj) :: z0, z0t, z0q … … 196 196 CHARACTER(len=40), PARAMETER :: crtnm = 'turb_ecmwf@sbcblk_algo_ecmwf.F90' 197 197 !!---------------------------------------------------------------------------------- 198 199 198 IF( kt == nit000 ) CALL SBCBLK_ALGO_ECMWF_INIT(l_use_cs, l_use_wl) 200 199 201 l_zt_equal_zu = .FALSE. 202 IF( ABS(zu - zt) < 0.01_wp ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 200 l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 203 201 204 202 !! Initializations for cool skin and warm layer: … … 413 411 !!---------------------------------------------------------------------------------- 414 412 DO_2D_11_11 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 413 ! 414 zzeta = MIN( pzeta(ji,jj) , 5._wp ) !! Very stable conditions (L positif and big!): 415 ! 416 ! Unstable (Paulson 1970): 417 ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 418 zx = SQRT(ABS(1._wp - 16._wp*zzeta)) 419 ztmp = 1._wp + SQRT(zx) 420 ztmp = ztmp*ztmp 421 psi_unst = LOG( 0.125_wp*ztmp*(1._wp + zx) ) & 422 & -2._wp*ATAN( SQRT(zx) ) + 0.5_wp*rpi 423 ! 424 ! Unstable: 425 ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 426 psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & 427 & - zzeta - 2._wp/3._wp*5._wp/0.35_wp 428 ! 429 ! Combining: 430 stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 431 ! 432 psi_m_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 433 & + stab * psi_stab ! (zzeta > 0) Stable 434 ! 437 435 END_2D 438 436 END FUNCTION psi_m_ecmwf … … 458 456 ! 459 457 DO_2D_11_11 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 458 ! 459 zzeta = MIN(pzeta(ji,jj) , 5._wp) ! Very stable conditions (L positif and big!): 460 ! 461 zx = ABS(1._wp - 16._wp*zzeta)**.25 ! this is actually (1/phi_m)**2 !!! 462 ! ! eq.3.19, Chap.3, p.33, IFS doc - Cy31r1 463 ! Unstable (Paulson 1970) : 464 psi_unst = 2._wp*LOG(0.5_wp*(1._wp + zx*zx)) ! eq.3.20, Chap.3, p.33, IFS doc - Cy31r1 465 ! 466 ! Stable: 467 psi_stab = -2._wp/3._wp*(zzeta - 5._wp/0.35_wp)*EXP(-0.35_wp*zzeta) & ! eq.3.22, Chap.3, p.33, IFS doc - Cy31r1 468 & - ABS(1._wp + 2._wp/3._wp*zzeta)**1.5_wp - 2._wp/3._wp*5._wp/0.35_wp + 1._wp 469 ! LB: added ABS() to avoid NaN values when unstable, which contaminates the unstable solution... 470 ! 471 stab = 0.5_wp + SIGN(0.5_wp, zzeta) ! zzeta > 0 => stab = 1 472 ! 473 ! 474 psi_h_ecmwf(ji,jj) = (1._wp - stab) * psi_unst & ! (zzeta < 0) Unstable 475 & + stab * psi_stab ! (zzeta > 0) Stable 476 ! 479 477 END_2D 480 478 END FUNCTION psi_h_ecmwf -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcblk_algo_ncar.F90
r12377 r13189 112 112 REAL(wp), DIMENSION(jpi,jpj) :: stab ! stability test integer 113 113 !!---------------------------------------------------------------------------------- 114 ! 115 l_zt_equal_zu = .FALSE. 116 IF( ABS(zu - zt) < 0.01_wp ) l_zt_equal_zu = .TRUE. ! testing "zu == zt" is risky with double precision 114 l_zt_equal_zu = ( ABS(zu - zt) < 0.01_wp ) ! testing "zu == zt" is risky with double precision 117 115 118 116 U_blk = MAX( 0.5_wp , U_zu ) ! relative wind speed at zu (normally 10m), we don't want to fall under 0.5 m/s … … 143 141 ENDIF 144 142 145 !! Initializing values at z_u with z_t values: 146 t_zu = t_zt ; q_zu = q_zt 143 !! First guess of temperature and humidity at height zu: 144 t_zu = MAX( t_zt , 180._wp ) ! who knows what's given on masked-continental regions... 145 q_zu = MAX( q_zt , 1.e-6_wp ) ! " 147 146 148 147 !! ITERATION BLOCK -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcblk_phy.F90
r12377 r13189 31 31 REAL(wp), PARAMETER, PUBLIC :: R_vap = 461.495_wp !: Specific gas constant for water vapor [J/K/kg] 32 32 REAL(wp), PARAMETER, PUBLIC :: reps0 = R_dry/R_vap !: ratio of gas constant for dry air and water vapor => ~ 0.622 33 REAL(wp), PARAMETER, PUBLIC :: rctv0 = R_vap/R_dry !: for virtual temperature (== (1-eps)/eps) => ~ 0.60833 REAL(wp), PARAMETER, PUBLIC :: rctv0 = R_vap/R_dry - 1._wp !: for virtual temperature (== (1-eps)/eps) => ~ 0.608 34 34 REAL(wp), PARAMETER, PUBLIC :: rCp_air = 1000.5_wp !: specific heat of air (only used for ice fluxes now...) 35 35 REAL(wp), PARAMETER, PUBLIC :: rCd_ice = 1.4e-3_wp !: transfer coefficient over ice … … 520 520 zCe = zz0*pqst(ji,jj)/zdq 521 521 522 CALL BULK_FORMULA ( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), &523 & zCd, zCh, zCe,&524 & pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj),&525 & pTau(ji,jj), zQsen, zQlat )526 522 CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 523 & zCd, zCh, zCe, & 524 & pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj), & 525 & pTau(ji,jj), zQsen, zQlat ) 526 527 527 zTs2 = pTs(ji,jj)*pTs(ji,jj) 528 528 zQlw = emiss_w*(prlw(ji,jj) - stefan*zTs2*zTs2) ! Net longwave flux … … 535 535 536 536 537 SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, & 538 & pCd, pCh, pCe, & 539 & pwnd, pUb, pslp, & 540 & pTau, pQsen, pQlat, pEvap, prhoa ) 537 SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, & 538 & pCd, pCh, pCe, & 539 & pwnd, pUb, pslp, & 540 & pTau, pQsen, pQlat, & 541 & pEvap, prhoa, pfact_evap ) 542 !!---------------------------------------------------------------------------------- 543 REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m) 544 REAL(wp), INTENT(in) :: pTs ! water temperature at the air-sea interface [K] 545 REAL(wp), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg] 546 REAL(wp), INTENT(in) :: pTa ! potential air temperature at z=pzu [K] 547 REAL(wp), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg] 548 REAL(wp), INTENT(in) :: pCd 549 REAL(wp), INTENT(in) :: pCh 550 REAL(wp), INTENT(in) :: pCe 551 REAL(wp), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s] 552 REAL(wp), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s] 553 REAL(wp), INTENT(in) :: pslp ! sea-level atmospheric pressure [Pa] 554 !! 555 REAL(wp), INTENT(out) :: pTau ! module of the wind stress [N/m^2] 556 REAL(wp), INTENT(out) :: pQsen ! [W/m^2] 557 REAL(wp), INTENT(out) :: pQlat ! [W/m^2] 558 !! 559 REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 560 REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 561 REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 562 !! 563 REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 564 INTEGER :: jq 565 !!---------------------------------------------------------------------------------- 566 zfact_evap = 1._wp 567 IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 568 569 !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 570 ztaa = pTa ! first guess... 571 DO jq = 1, 4 572 zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa ) !LOLO: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 573 ztaa = pTa - zgamma*pzu ! Absolute temp. is slightly colder... 574 END DO 575 zrho = rho_air(ztaa, pqa, pslp) 576 zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 577 578 zUrho = pUb*MAX(zrho, 1._wp) ! rho*U10 579 580 pTau = zUrho * pCd * pwnd ! Wind stress module 581 582 zevap = zUrho * pCe * (pqa - pqs) 583 pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa) 584 pQlat = L_vap(pTs) * zevap 585 586 IF( PRESENT(pEvap) ) pEvap = - zfact_evap * zevap 587 IF( PRESENT(prhoa) ) prhoa = zrho 588 589 END SUBROUTINE BULK_FORMULA_SCLR 590 591 SUBROUTINE BULK_FORMULA_VCTR( pzu, pTs, pqs, pTa, pqa, & 592 & pCd, pCh, pCe, & 593 & pwnd, pUb, pslp, & 594 & pTau, pQsen, pQlat, & 595 & pEvap, prhoa, pfact_evap ) 541 596 !!---------------------------------------------------------------------------------- 542 597 REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m) … … 558 613 REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s] 559 614 REAL(wp), DIMENSION(jpi,jpj), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3] 560 !! 561 REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap 562 INTEGER :: ji, jj, jq ! dummy loop indices 563 !!---------------------------------------------------------------------------------- 564 DO_2D_11_11 565 566 !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa") 567 ztaa = pTa(ji,jj) ! first guess... 568 DO jq = 1, 4 569 zgamma = gamma_moist( 0.5*(ztaa+pTs(ji,jj)) , pqa(ji,jj) ) 570 ztaa = pTa(ji,jj) - zgamma*pzu ! Absolute temp. is slightly colder... 571 END DO 572 zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)) 573 zrho = rho_air(ztaa, pqa(ji,jj), pslp(ji,jj)-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given! 574 575 zUrho = pUb(ji,jj)*MAX(zrho, 1._wp) ! rho*U10 576 577 pTau(ji,jj) = zUrho * pCd(ji,jj) * pwnd(ji,jj) ! Wind stress module 578 579 zevap = zUrho * pCe(ji,jj) * (pqa(ji,jj) - pqs(ji,jj)) 580 pQsen(ji,jj) = zUrho * pCh(ji,jj) * (pTa(ji,jj) - pTs(ji,jj)) * cp_air(pqa(ji,jj)) 581 pQlat(ji,jj) = L_vap(pTs(ji,jj)) * zevap 582 583 IF( PRESENT(pEvap) ) pEvap(ji,jj) = - zevap 615 REAL(wp), INTENT(in) , OPTIONAL :: pfact_evap ! ABOMINATION: corrective factor for evaporation (doing this against my will! /laurent) 616 !! 617 REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap, zfact_evap 618 INTEGER :: ji, jj 619 !!---------------------------------------------------------------------------------- 620 zfact_evap = 1._wp 621 IF( PRESENT(pfact_evap) ) zfact_evap = pfact_evap 622 623 DO_2D_11_11 624 625 CALL BULK_FORMULA_SCLR( pzu, pTs(ji,jj), pqs(ji,jj), pTa(ji,jj), pqa(ji,jj), & 626 & pCd(ji,jj), pCh(ji,jj), pCe(ji,jj), & 627 & pwnd(ji,jj), pUb(ji,jj), pslp(ji,jj), & 628 & pTau(ji,jj), pQsen(ji,jj), pQlat(ji,jj), & 629 & pEvap=zevap, prhoa=zrho, pfact_evap=zfact_evap ) 630 631 IF( PRESENT(pEvap) ) pEvap(ji,jj) = zevap 584 632 IF( PRESENT(prhoa) ) prhoa(ji,jj) = zrho 585 633 586 634 END_2D 587 635 END SUBROUTINE BULK_FORMULA_VCTR 588 589 590 SUBROUTINE BULK_FORMULA_SCLR( pzu, pTs, pqs, pTa, pqa, &591 & pCd, pCh, pCe, &592 & pwnd, pUb, pslp, &593 & pTau, pQsen, pQlat, pEvap, prhoa )594 !!----------------------------------------------------------------------------------595 REAL(wp), INTENT(in) :: pzu ! height above the sea-level where all this takes place (normally 10m)596 REAL(wp), INTENT(in) :: pTs ! water temperature at the air-sea interface [K]597 REAL(wp), INTENT(in) :: pqs ! satur. spec. hum. at T=pTs [kg/kg]598 REAL(wp), INTENT(in) :: pTa ! potential air temperature at z=pzu [K]599 REAL(wp), INTENT(in) :: pqa ! specific humidity at z=pzu [kg/kg]600 REAL(wp), INTENT(in) :: pCd601 REAL(wp), INTENT(in) :: pCh602 REAL(wp), INTENT(in) :: pCe603 REAL(wp), INTENT(in) :: pwnd ! wind speed module at z=pzu [m/s]604 REAL(wp), INTENT(in) :: pUb ! bulk wind speed at z=pzu (inc. pot. effect of gustiness etc) [m/s]605 REAL(wp), INTENT(in) :: pslp ! sea-level atmospheric pressure [Pa]606 !!607 REAL(wp), INTENT(out) :: pTau ! module of the wind stress [N/m^2]608 REAL(wp), INTENT(out) :: pQsen ! [W/m^2]609 REAL(wp), INTENT(out) :: pQlat ! [W/m^2]610 !!611 REAL(wp), INTENT(out), OPTIONAL :: pEvap ! Evaporation [kg/m^2/s]612 REAL(wp), INTENT(out), OPTIONAL :: prhoa ! Air density at z=pzu [kg/m^3]613 !!614 REAL(wp) :: ztaa, zgamma, zrho, zUrho, zevap615 INTEGER :: jq616 !!----------------------------------------------------------------------------------617 618 !! Need ztaa, absolute temperature at pzu (formula to estimate rho_air needs absolute temperature, not the potential temperature "pTa")619 ztaa = pTa ! first guess...620 DO jq = 1, 4621 zgamma = gamma_moist( 0.5*(ztaa+pTs) , pqa )622 ztaa = pTa - zgamma*pzu ! Absolute temp. is slightly colder...623 END DO624 zrho = rho_air(ztaa, pqa, pslp)625 zrho = rho_air(ztaa, pqa, pslp-zrho*grav*pzu) ! taking into account that we are pzu m above the sea level where SLP is given!626 627 zUrho = pUb*MAX(zrho, 1._wp) ! rho*U10628 629 pTau = zUrho * pCd * pwnd ! Wind stress module630 631 zevap = zUrho * pCe * (pqa - pqs)632 pQsen = zUrho * pCh * (pTa - pTs) * cp_air(pqa)633 pQlat = L_vap(pTs) * zevap634 635 IF( PRESENT(pEvap) ) pEvap = - zevap636 IF( PRESENT(prhoa) ) prhoa = zrho637 638 END SUBROUTINE BULK_FORMULA_SCLR639 640 641 636 642 637 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbccpl.F90
r12495 r13189 364 364 ! 365 365 ! Vectors: change of sign at north fold ONLY if on the local grid 366 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled 366 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & 367 .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 368 367 369 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 368 370 … … 1115 1117 IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 ) & 1116 1118 & CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 1117 ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1119 1120 IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1121 1118 1122 ENDIF 1119 1123 ! … … 1479 1483 INTEGER :: ji, jj ! dummy loop indices 1480 1484 INTEGER :: itx ! index of taux over ice 1485 REAL(wp) :: zztmp1, zztmp2 1481 1486 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1482 1487 !!---------------------------------------------------------------------- … … 1542 1547 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1543 1548 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1544 CASE( 'F' )1545 DO_2D_00_001546 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) )1547 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) )1548 END_2D1549 1549 CASE( 'T' ) 1550 1550 DO_2D_00_00 1551 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1552 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1551 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1552 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 1553 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 1554 p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1555 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1553 1556 END_2D 1554 CASE( 'I' ) 1555 DO_2D_00_00 1556 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1557 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1558 END_2D 1557 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1559 1558 END SELECT 1560 IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN1561 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. )1562 ENDIF1563 1559 1564 1560 ENDIF … … 1789 1785 ENDDO 1790 1786 ELSE 1791 qns_tot(:,:) =qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1787 zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1792 1788 DO jl = 1, jpl 1793 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1794 1789 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1795 1790 END DO … … 1932 1927 END DO 1933 1928 ELSE 1934 qsr_tot(:,: ) =qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1929 zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1935 1930 DO jl = 1, jpl 1936 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1937 1931 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1938 1932 END DO -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcmod.F90
r12495 r13189 120 120 ncom_fsbc = nn_fsbc ! make nn_fsbc available for lib_mpp 121 121 #endif 122 ! !* overwrite namelist parameter using CPP key information123 #if defined key_agrif124 IF( Agrif_Root() ) THEN ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid)125 IF( lk_si3 ) nn_ice = 2126 IF( lk_cice ) nn_ice = 3127 ENDIF128 !!GS: TBD129 !#else130 ! IF( lk_si3 ) nn_ice = 2131 ! IF( lk_cice ) nn_ice = 3132 #endif133 122 ! 134 123 IF(lwp) THEN !* Control print -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/SBC/sbcwave.F90
r12377 r13189 210 210 END_3D 211 211 ! 212 #if defined key_agrif213 IF( .NOT. Agrif_Root() ) THEN214 IF( nbondi == -1 .OR. nbondi == 2 ) ze3divh( 2:nbghostcells+1,: ,:) = 0._wp ! west215 IF( nbondi == 1 .OR. nbondi == 2 ) ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp ! east216 IF( nbondj == -1 .OR. nbondj == 2 ) ze3divh( :,2:nbghostcells+1 ,:) = 0._wp ! south217 IF( nbondj == 1 .OR. nbondj == 2 ) ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north218 ENDIF219 #endif220 !221 212 CALL lbc_lnk( 'sbcwave', ze3divh, 'T', 1. ) 222 213 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/STO/stopar.F90
r12377 r13189 684 684 !! ** Purpose : read stochastic parameters from restart file 685 685 !!---------------------------------------------------------------------- 686 INTEGER :: jsto, jseed 686 INTEGER :: jsto, jseed 687 INTEGER :: idg ! number of digits 687 688 INTEGER(KIND=8) :: ziseed(4) ! RNG seeds in integer type 688 689 REAL(KIND=8) :: zrseed(4) ! RNG seeds in real type (with same bits to save in restart) 689 690 CHARACTER(LEN=9) :: clsto2d='sto2d_000' ! stochastic parameter variable name 690 691 CHARACTER(LEN=9) :: clsto3d='sto3d_000' ! stochastic parameter variable name 691 CHARACTER(LEN=10) :: clseed='seed0_0000' ! seed variable name 692 CHARACTER(LEN=15) :: clseed='seed0_0000' ! seed variable name 693 CHARACTER(LEN=6) :: clfmt ! writing format 692 694 !!---------------------------------------------------------------------- 693 695 … … 717 719 IF (ln_rstseed) THEN 718 720 ! Get saved state of the random number generator 721 idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 722 WRITE(clfmt, "('(i', i1, '.', i1, ')')") idg, idg ! "(ix.x)" 719 723 DO jseed = 1 , 4 720 WRITE(clseed(5:5) ,'(i1.1)') jseed721 WRITE(clseed(7: 10),'(i4.4)') narea722 CALL iom_get( numstor, clseed , zrseed(jseed) )724 WRITE(clseed(5:5) ,'(i1.1)') jseed 725 WRITE(clseed(7:7+idg-1), clfmt ) narea 726 CALL iom_get( numstor, clseed(1:7+idg-1) , zrseed(jseed) ) 723 727 END DO 724 728 ziseed = TRANSFER( zrseed , ziseed) … … 742 746 INTEGER, INTENT(in) :: kt ! ocean time-step 743 747 !! 744 INTEGER :: jsto, jseed 748 INTEGER :: jsto, jseed 749 INTEGER :: idg ! number of digits 745 750 INTEGER(KIND=8) :: ziseed(4) ! RNG seeds in integer type 746 751 REAL(KIND=8) :: zrseed(4) ! RNG seeds in real type (with same bits to save in restart) … … 749 754 CHARACTER(LEN=9) :: clsto2d='sto2d_000' ! stochastic parameter variable name 750 755 CHARACTER(LEN=9) :: clsto3d='sto3d_000' ! stochastic parameter variable name 751 CHARACTER(LEN=10) :: clseed='seed0_0000' ! seed variable name 756 CHARACTER(LEN=15) :: clseed='seed0_0000' ! seed variable name 757 CHARACTER(LEN=6) :: clfmt ! writing format 752 758 !!---------------------------------------------------------------------- 753 759 … … 771 777 CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) ) 772 778 zrseed = TRANSFER( ziseed , zrseed) 779 idg = MAX( INT(LOG10(REAL(jpnij,wp))) + 1, 4 ) ! how many digits to we need to write? min=4, max=9 780 WRITE(clfmt, "('(i', i1, '.', i1, ')')") idg, idg ! "(ix.x)" 773 781 DO jseed = 1 , 4 774 WRITE(clseed(5:5) ,'(i1.1)') jseed775 WRITE(clseed(7: 10),'(i4.4)') narea776 CALL iom_rstput( kt, nitrst, numstow, clseed 782 WRITE(clseed(5:5) ,'(i1.1)') jseed 783 WRITE(clseed(7:7+idg-1), clfmt ) narea 784 CALL iom_rstput( kt, nitrst, numstow, clseed(1:7+idg-1), zrseed(jseed) ) 777 785 END DO 778 786 ! 2D stochastic parameters -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/STO/storng.F90
r12377 r13189 50 50 51 51 ! Parameters to generate real random variates 52 REAL(KIND=wp), PARAMETER :: huge64=9223372036854775808.0 ! +153 52 REAL(KIND=wp), PARAMETER :: zero=0.0, half=0.5, one=1.0, two=2.0 54 53 … … 275 274 REAL(KIND=wp) :: uran 276 275 277 uran = half * ( one + REAL(kiss(),wp) / huge64)276 uran = half * ( one + REAL(kiss(),wp) / HUGE(1._wp) ) 278 277 279 278 END SUBROUTINE kiss_uniform … … 298 297 rsq = two 299 298 DO WHILE ( (rsq.GE.one).OR. (rsq.EQ.zero) ) 300 u1 = REAL(kiss(),wp) / huge64301 u2 = REAL(kiss(),wp) / huge64299 u1 = REAL(kiss(),wp) / HUGE(1._wp) 300 u2 = REAL(kiss(),wp) / HUGE(1._wp) 302 301 rsq = u1*u1 + u2*u2 303 302 ENDDO -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/TRD/trdtra.F90
r12495 r13189 82 82 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 83 83 ! 84 INTEGER :: jk ! loop indices 84 INTEGER :: jk ! loop indices 85 INTEGER :: i01 ! 0 or 1 85 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace 86 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws, ztrdt ! 3D workspace … … 90 91 IF( trd_tra_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_tra : unable to allocate arrays' ) 91 92 ENDIF 92 93 ! 94 i01 = COUNT( (/ PRESENT(pu) .OR. ( ktrd /= jptra_xad .AND. ktrd /= jptra_yad .AND. ktrd /= jptra_zad ) /) ) 95 ! 93 96 IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN !== Temperature trend ==! 94 97 ! 95 SELECT CASE( ktrd )98 SELECT CASE( ktrd*i01 ) 96 99 ! ! advection: transform the advective flux into a trend 97 100 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm ) … … 112 115 IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN !== Salinity trends ==! 113 116 ! 114 SELECT CASE( ktrd )117 SELECT CASE( ktrd*i01 ) 115 118 ! ! advection: transform the advective flux into a trend 116 119 ! ! and send T & S trends to trd_tra_mng … … 163 166 IF( ctype == 'TRC' ) THEN !== passive tracer trend ==! 164 167 ! 165 SELECT CASE( ktrd )168 SELECT CASE( ktrd*i01 ) 166 169 ! ! advection: transform the advective flux into a masked trend 167 170 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/USR/usrdef_zgr.F90
r12377 r13189 202 202 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 203 203 ! 204 k_bot(:,:) = NINT( z2d(:,:) ) 204 k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 205 205 ! 206 206 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/ZDF/zdftke.F90
r12495 r13189 45 45 USE zdfdrg ! vertical physics: top/bottom drag coef. 46 46 USE zdfmxl ! vertical physics: mixed layer 47 #if defined key_si3 48 USE ice, ONLY: hm_i, h_i 49 #endif 50 #if defined key_cice 51 USE sbc_ice, ONLY: h_i 52 #endif 47 53 ! 48 54 USE in_out_manager ! I/O manager … … 64 70 INTEGER :: nn_mxl ! type of mixing length (=0/1/2/3) 65 71 REAL(wp) :: rn_mxl0 ! surface min value of mixing length (kappa*z_o=0.4*0.1 m) [m] 72 INTEGER :: nn_mxlice ! type of scaling under sea-ice 73 REAL(wp) :: rn_mxlice ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 66 74 INTEGER :: nn_pdl ! Prandtl number or not (ratio avt/avm) (=0/1) 67 75 REAL(wp) :: rn_ediff ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) … … 214 222 ! ! Surface/top/bottom boundary condition on tke 215 223 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 216 224 ! 217 225 DO_2D_00_00 218 226 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 219 227 END_2D 220 IF ( ln_isfcav ) THEN221 DO_2D_00_00222 en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1)223 END_2D224 ENDIF225 228 ! 226 229 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 249 252 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2 & 250 253 & + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2 ) 251 en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 254 ! (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) = 1 where ice shelves are present 255 en(ji,jj,mikt(ji,jj)) = en(ji,jj,1) * tmask(ji,jj,1) & 256 & + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) 252 257 END_2D 253 258 ENDIF … … 425 430 REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars 426 431 REAL(wp) :: zdku, zdkv, zsqen ! - - 427 REAL(wp) :: zemxl, zemlm, zemlp ! - -432 REAL(wp) :: zemxl, zemlm, zemlp, zmaxice ! - - 428 433 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxlm, zmxld ! 3D workspace 429 434 !!-------------------------------------------------------------------- … … 439 444 zmxld(:,:,:) = rmxl_min 440 445 ! 441 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 446 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rho0*g) 447 ! 442 448 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 449 #if ! defined key_si3 && ! defined key_cice 443 450 DO_2D_00_00 444 zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1))451 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 445 452 END_2D 446 ELSE 453 #else 454 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 455 ! 456 CASE( 0 ) ! No scaling under sea-ice 457 DO_2D_00_00 458 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 459 END_2D 460 ! 461 CASE( 1 ) ! scaling with constant sea-ice thickness 462 DO_2D_00_00 463 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 464 END_2D 465 ! 466 CASE( 2 ) ! scaling with mean sea-ice thickness 467 DO_2D_00_00 468 #if defined key_si3 469 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 470 #elif defined key_cice 471 zmaxice = MAXVAL( h_i(ji,jj,:) ) 472 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 473 #endif 474 END_2D 475 ! 476 CASE( 3 ) ! scaling with max sea-ice thickness 477 DO_2D_00_00 478 zmaxice = MAXVAL( h_i(ji,jj,:) ) 479 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 480 END_2D 481 ! 482 END SELECT 483 #endif 484 ! 485 DO_2D_00_00 486 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 487 END_2D 488 ! 489 ELSE 447 490 zmxlm(:,:,1) = rn_mxl0 448 491 ENDIF 492 449 493 ! 450 494 DO_3D_00_00( 2, jpkm1 ) … … 518 562 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 519 563 DO_3D_00_00( 2, jpkm1 ) 520 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)564 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 521 565 END_3D 522 566 ENDIF … … 550 594 INTEGER :: ios 551 595 !! 552 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 553 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 554 & rn_mxl0 , nn_pdl , ln_drg , ln_lc , rn_lc, & 555 & nn_etau , nn_htau , rn_efr , rn_eice 596 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 597 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 598 & rn_mxl0 , nn_mxlice, rn_mxlice, & 599 & nn_pdl , ln_drg , ln_lc , rn_lc, & 600 & nn_etau , nn_htau , rn_efr , rn_eice 556 601 !!---------------------------------------------------------------------- 557 602 ! … … 579 624 WRITE(numout,*) ' mixing length type nn_mxl = ', nn_mxl 580 625 WRITE(numout,*) ' surface mixing length = F(stress) or not ln_mxl0 = ', ln_mxl0 626 IF( ln_mxl0 ) THEN 627 WRITE(numout,*) ' type of scaling under sea-ice nn_mxlice = ', nn_mxlice 628 IF( nn_mxlice == 1 ) & 629 WRITE(numout,*) ' ice thickness when scaling under sea-ice rn_mxlice = ', rn_mxlice 630 ENDIF 581 631 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0 582 632 WRITE(numout,*) ' top/bottom friction forcing flag ln_drg = ', ln_drg -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/nemogcm.F90
r12495 r13189 84 84 #endif 85 85 ! 86 USE in_out_manager ! I/O manager 86 87 USE lib_mpp ! distributed memory computing 87 88 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 185 186 END DO 186 187 ! 187 IF( .NOT. Agrif_Root() ) THEN188 CALL Agrif_ParentGrid_To_ChildGrid()189 IF( ln_diaobs ) CALL dia_obs_wri190 IF( ln_timing ) CALL timing_finalize191 CALL Agrif_ChildGrid_To_ParentGrid()192 ENDIF193 !194 188 # else 195 189 ! … … 236 230 IF( nstop /= 0 .AND. lwp ) THEN ! error print 237 231 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 238 CALL ctl_stop( ctmp1 ) 232 IF( ngrdstop > 0 ) THEN 233 WRITE(ctmp9,'(i2)') ngrdstop 234 WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9) 235 WRITE(ctmp3,*) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 236 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 237 ELSE 238 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 239 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 240 ENDIF 239 241 ENDIF 240 242 ! … … 248 250 #else 249 251 IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS 250 ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications252 ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 251 253 ENDIF 252 254 #endif … … 317 319 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 318 320 ! open /dev/null file to be able to supress output write easily 321 IF( Agrif_Root() ) THEN 319 322 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 320 ! 323 #ifdef key_agrif 324 ELSE 325 numnul = Agrif_Parent(numnul) 326 #endif 327 ENDIF 321 328 ! !--------------------! 322 329 ! ! Open listing units ! -> need sn_cfctl from namctl to define lwp … … 329 336 ! 330 337 ! finalize the definition of namctl variables 331 IF( sn_cfctl%l_allon ) THEN 332 ! Turn on all options. 333 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 334 ! Ensure all processors are active 335 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 336 ELSEIF( sn_cfctl%l_config ) THEN 337 ! Activate finer control of report outputs 338 ! optionally switch off output from selected areas (note this only 339 ! applies to output which does not involve global communications) 340 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 341 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 342 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 343 ELSE 344 ! turn off all options. 345 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 346 ENDIF 338 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 339 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 347 340 ! 348 341 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 528 521 WRITE(numout,*) '~~~~~~~~' 529 522 WRITE(numout,*) ' Namelist namctl' 530 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk531 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon532 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config533 523 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 534 524 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 678 668 679 669 680 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)670 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 681 671 !!---------------------------------------------------------------------- 682 672 !! *** ROUTINE nemo_set_cfctl *** 683 673 !! 684 674 !! ** Purpose : Set elements of the output control structure to setto. 685 !! for_all should be .false. unless all areas are to be686 !! treated identically.687 675 !! 688 676 !! ** Method : Note this routine can be used to switch on/off some 689 !! types of output for selected areas but any output types 690 !! that involve global communications (e.g. mpp_max, glob_sum) 691 !! should be protected from selective switching by the 692 !! for_all argument 693 !!---------------------------------------------------------------------- 694 LOGICAL :: setto, for_all 695 TYPE(sn_ctl) :: sn_cfctl 696 !!---------------------------------------------------------------------- 697 IF( for_all ) THEN 698 sn_cfctl%l_runstat = setto 699 sn_cfctl%l_trcstat = setto 700 ENDIF 677 !! types of output for selected areas. 678 !!---------------------------------------------------------------------- 679 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 680 LOGICAL , INTENT(in ) :: setto 681 !!---------------------------------------------------------------------- 682 sn_cfctl%l_runstat = setto 683 sn_cfctl%l_trcstat = setto 701 684 sn_cfctl%l_oceout = setto 702 685 sn_cfctl%l_layout = setto -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/step.F90
r12495 r13189 82 82 !!---------------------------------------------------------------------- 83 83 INTEGER :: ji, jj, jk ! dummy loop indice 84 INTEGER :: indic ! error indicator if < 085 84 !!gm kcall can be removed, I guess 86 85 INTEGER :: kcall ! optional integer argument (dom_vvl_sf_nxt) 87 86 !! --------------------------------------------------------------------- 88 87 #if defined key_agrif 88 IF( nstop > 0 ) RETURN ! avoid to go further if an error was detected during previous time step (child grid) 89 89 kstp = nit000 + Agrif_Nb_Step() 90 90 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices … … 114 114 ! update I/O and calendar 115 115 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 116 indic = 0 ! reset to no error condition117 118 116 IF( kstp == nit000 ) THEN ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS) 119 CALL iom_init( cxios_context, ld_closedef=.FALSE. ) ! for model grid (including p assible AGRIF zoom)117 CALL iom_init( cxios_context, ld_closedef=.FALSE. ) ! for model grid (including possible AGRIF zoom) 120 118 IF( lk_diamlr ) CALL dia_mlr_iom_init ! with additional setup for multiple-linear-regression analysis 121 119 CALL iom_init_closedef … … 309 307 #if defined key_agrif 310 308 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 311 ! AGRIF 309 ! AGRIF recursive integration 312 310 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 313 311 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 314 312 CALL Agrif_Integrate_ChildGrids( stp ) ! allows to finish all the Child Grids before updating 315 313 316 IF( Agrif_NbStepint() == 0 ) THEN 317 CALL Agrif_update_all( ) ! Update all components 318 ENDIF 319 #endif 320 IF( ln_diaobs ) CALL dia_obs ( kstp, Nnn ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 321 314 #endif 322 315 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 323 316 ! Control 324 317 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 325 CALL stp_ctl ( kstp, Nbb, Nnn, indic ) 326 318 CALL stp_ctl ( kstp, Nnn ) 319 320 #if defined key_agrif 321 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 322 ! AGRIF update 323 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 324 IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN 325 CALL Agrif_update_all( ) ! Update all components 326 ENDIF 327 328 #endif 329 IF( ln_diaobs .AND. nstop == 0 ) CALL dia_obs( kstp, Nnn ) ! obs-minus-model (assimilation) diags (after dynamics update) 330 331 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 332 ! File manipulation at the end of the first time step 333 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 327 334 IF( kstp == nit000 ) THEN ! 1st time step only 328 335 CALL iom_close( numror ) ! close input ocean restart file … … 334 341 ! Coupled mode 335 342 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 336 !!gm why lk_oasis and not lk_cpl ???? 337 IF( lk_oasis ) CALL sbc_cpl_snd( kstp, Nbb, Nnn ) ! coupled mode : field exchanges 343 IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn ) ! coupled mode : field exchanges 338 344 ! 339 345 #if defined key_iomput 340 IF( kstp == nitend .OR. indic < 0 ) THEN 346 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 347 ! Finalize contextes if end of simulation or error detected 348 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 349 IF( kstp == nitend .OR. nstop > 0 ) THEN 341 350 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 342 IF(lrxios) CALL iom_context_finalize( crxios_context)351 IF( lrxios ) CALL iom_context_finalize( crxios_context ) 343 352 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 344 353 ENDIF -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OCE/stpctl.F90
r12377 r13189 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE c1d ! 1D vertical configuration 21 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 22 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 23 ! 21 24 USE diawri ! Standard run outputs (dia_wri_state routine) 22 !23 25 USE in_out_manager ! I/O manager 24 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 27 USE lib_mpp ! distributed memory computing 26 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 27 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 28 28 ! 29 29 USE netcdf ! NetCDF library 30 30 IMPLICIT NONE … … 33 33 PUBLIC stp_ctl ! routine called by step.F90 34 34 35 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus36 LOGICAL :: lsomeoce35 INTEGER :: nrunid ! netcdf file id 36 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 37 37 !!---------------------------------------------------------------------- 38 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 42 42 CONTAINS 43 43 44 SUBROUTINE stp_ctl( kt, K bb, Kmm, kindic)44 SUBROUTINE stp_ctl( kt, Kmm ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE stp_ctl *** … … 50 50 !! ** Method : - Save the time step in numstp 51 51 !! - Print it each 50 time steps 52 !! - Stop the run IF problem encountered by setting indic=-352 !! - Stop the run IF problem encountered by setting nstop > 0 53 53 !! Problems checked: |ssh| maximum larger than 10 m 54 54 !! |U| maximum larger than 10 m/s … … 57 57 !! ** Actions : "time.step" file = last ocean time-step 58 58 !! "run.stat" file = run statistics 59 !! nstop indicator sheared among all local domain (lk_mpp=T)59 !! nstop indicator sheared among all local domain 60 60 !!---------------------------------------------------------------------- 61 61 INTEGER, INTENT(in ) :: kt ! ocean time-step index 62 INTEGER, INTENT(in ) :: Kbb, Kmm ! ocean time level index 63 INTEGER, INTENT(inout) :: kindic ! error indicator 64 !! 65 INTEGER :: ji, jj, jk ! dummy loop indices 66 INTEGER, DIMENSION(2) :: ih ! min/max loc indices 67 INTEGER, DIMENSION(3) :: iu, is1, is2 ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 71 CHARACTER(len=20) :: clname 72 !!---------------------------------------------------------------------- 73 ! 74 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 75 ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 76 ll_wrtruns = ll_colruns .AND. lwm 77 IF( kt == nit000 .AND. lwp ) THEN 78 WRITE(numout,*) 79 WRITE(numout,*) 'stp_ctl : time-stepping control' 80 WRITE(numout,*) '~~~~~~~' 81 ! ! open time.step file 82 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 83 ! ! open run.stat file(s) at start whatever 84 ! ! the value of sn_cfctl%ptimincr 85 IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 62 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 63 !! 64 INTEGER :: ji ! dummy loop indices 65 INTEGER :: idtime, istatus 66 INTEGER , DIMENSION(9) :: iareasum, iareamin, iareamax 67 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 71 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 72 CHARACTER(len=20) :: clname 73 !!---------------------------------------------------------------------- 74 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 75 ! 76 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 77 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 78 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 79 ! 80 IF( kt == nit000 ) THEN 81 ! 82 IF( lwp ) THEN 83 WRITE(numout,*) 84 WRITE(numout,*) 'stp_ctl : time-stepping control' 85 WRITE(numout,*) '~~~~~~~' 86 ENDIF 87 ! ! open time.step ascii file, done only by 1st subdomain 88 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 89 ! 90 IF( ll_wrtruns ) THEN 91 ! ! open run.stat ascii file, done only by 1st subdomain 86 92 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 93 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 87 94 clname = 'run.stat.nc' 88 95 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 89 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun)90 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )91 istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh)92 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu)93 istatus = NF90_DEF_VAR( idrun, 's_min', NF90_DOUBLE, (/ idtime /), ids1)94 istatus = NF90_DEF_VAR( idrun, 's_max', NF90_DOUBLE, (/ idtime /), ids2)95 istatus = NF90_DEF_VAR( idrun, 't_min', NF90_DOUBLE, (/ idtime /), idt1)96 istatus = NF90_DEF_VAR( idrun, 't_max', NF90_DOUBLE, (/ idtime /), idt2)96 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 97 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 98 istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 99 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 100 istatus = NF90_DEF_VAR( nrunid, 's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 101 istatus = NF90_DEF_VAR( nrunid, 's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 102 istatus = NF90_DEF_VAR( nrunid, 't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 103 istatus = NF90_DEF_VAR( nrunid, 't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 97 104 IF( ln_zad_Aimp ) THEN 98 istatus = NF90_DEF_VAR( idrun, 'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1)99 istatus = NF90_DEF_VAR( idrun, 'Cf_max', NF90_DOUBLE, (/ idtime /), idc1)105 istatus = NF90_DEF_VAR( nrunid, 'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 106 istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 100 107 ENDIF 101 istatus = NF90_ENDDEF(idrun) 102 zmax(8:9) = 0._wp ! initialise to zero in case ln_zad_Aimp option is not in use 103 ENDIF 104 ENDIF 105 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 106 ! 107 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 108 istatus = NF90_ENDDEF(nrunid) 109 ENDIF 110 ! 111 ENDIF 112 ! 113 ! !== write current time step ==! 114 ! !== done only by 1st subdomain at writting timestep ==! 115 IF( lwm .AND. ll_wrtstp ) THEN 108 116 WRITE ( numstp, '(1x, i8)' ) kt 109 117 REWIND( numstp ) 110 118 ENDIF 111 ! 112 ! !== test of extrema ==! 113 IF( ll_wd ) THEN 114 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) ) ) ! ssh max 115 ELSE 116 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ) ) ! ssh max 117 ENDIF 118 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 119 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max 120 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! salinity max 121 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus temperature max 122 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! temperature max 123 zmax(7) = REAL( nstop , wp ) ! stop indicator 124 IF( ln_zad_Aimp ) THEN 125 zmax(8) = MAXVAL( ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 126 zmax(9) = MAXVAL( Cu_adv(:,:,:) , mask = tmask(:,:,:) == 1._wp ) ! partitioning coeff. max 127 ENDIF 128 ! 119 ! !== test of local extrema ==! 120 ! !== done by all processes at every time step ==! 121 ! 122 ! define zmax default value. needed for land processors 123 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 124 zmax(:) = -HUGE(1._wp) 125 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 126 zmax(:) = 0._wp 127 zmax(3) = -1._wp ! avoid salinity minimum at 0. 128 ENDIF 129 ! 130 llmsk(:,:,1) = ssmask(:,:) == 1._wp 131 IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN ! avoid huge values sent back for land processors... 132 IF( ll_wd ) THEN 133 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 134 ELSE 135 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 136 ENDIF 137 ENDIF 138 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 139 llmsk(:,:,:) = tmask(:,:,:) == 1._wp 140 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 141 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 142 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 143 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 144 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 145 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 146 IF( ln_zad_Aimp ) THEN 147 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 148 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 149 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 150 zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk ) ! implicit vertical vel. max 151 ENDIF 152 ENDIF 153 ENDIF 154 ENDIF 155 zmax(9) = REAL( nstop, wp ) ! stop indicator 156 ! !== get global extrema ==! 157 ! !== done by all processes if writting run.stat ==! 129 158 IF( ll_colruns ) THEN 159 zmaxlocal(:) = zmax(:) 130 160 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 131 nstop = NINT( zmax(7) ) ! nstop indicator sheared among all local domains 132 ENDIF 133 ! !== run statistics ==! ("run.stat" files) 161 nstop = NINT( zmax(9) ) ! update nstop indicator (now sheared among all local domains) 162 ENDIF 163 ! !== write "run.stat" files ==! 164 ! !== done only by 1st subdomain at writting timestep ==! 134 165 IF( ll_wrtruns ) THEN 135 166 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 136 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )137 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) )138 istatus = NF90_PUT_VAR( idrun, ids1, (/-zmax(3)/), (/kt/), (/1/) )139 istatus = NF90_PUT_VAR( idrun, ids2, (/ zmax(4)/), (/kt/), (/1/) )140 istatus = NF90_PUT_VAR( idrun, idt1, (/-zmax(5)/), (/kt/), (/1/) )141 istatus = NF90_PUT_VAR( idrun, idt2, (/ zmax(6)/), (/kt/), (/1/) )167 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 168 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 169 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 170 istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 171 istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 172 istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 142 173 IF( ln_zad_Aimp ) THEN 143 istatus = NF90_PUT_VAR( idrun, idw1, (/ zmax(8)/), (/kt/), (/1/) ) 144 istatus = NF90_PUT_VAR( idrun, idc1, (/ zmax(9)/), (/kt/), (/1/) ) 145 ENDIF 146 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 147 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 174 istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 175 istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 176 ENDIF 177 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 148 178 END IF 149 ! !== error handling ==! 150 IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. ( & ! domain contains some ocean points, check for sensible ranges 151 & zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 152 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 153 & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 154 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 155 & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 156 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 157 IF( lk_mpp .AND. sn_cfctl%l_glochk ) THEN 158 ! have use mpp_max (because sn_cfctl%l_glochk=.T. and distributed) 159 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm)) , ssmask(:,:) , zzz, ih ) 160 CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)) , umask (:,:,:), zzz, iu ) 161 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 162 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 179 ! !== error handling ==! 180 ! !== done by all processes at every time step ==! 181 ! 182 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 183 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 184 & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 185 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 186 & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 187 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 188 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 189 ! 190 iloc(:,:) = 0 191 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 192 ! first: close the netcdf file, so we can read it 193 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 194 ! get global loc on the min/max 195 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:, Kmm)), ssmask(:,: ), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 196 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:, Kmm)), umask(:,:,:), zzz, iloc(1:3,2) ) 197 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,3) ) 198 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,4) ) 199 ! find which subdomain has the max. 200 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 201 DO ji = 1, 9 202 IF( zmaxlocal(ji) == zmax(ji) ) THEN 203 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 204 ENDIF 205 END DO 206 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 207 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 208 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 209 ELSE ! find local min and max locations: 210 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 211 iloc(1:2,1) = MAXLOC( ABS( ssh(:,:, Kmm)), mask = ssmask(:,: ) == 1._wp ) + (/ nimpp - 1, njmpp - 1 /) 212 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 213 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 214 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 215 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 216 ENDIF 217 ! 218 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 219 CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 220 CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 221 CALL wrt_line( ctmp4, kt, 'Sal min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 222 CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 223 IF( Agrif_Root() ) THEN 224 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 163 225 ELSE 164 ! find local min and max locations 165 ih(:) = MAXLOC( ABS( ssh(:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1 /) 166 iu(:) = MAXLOC( ABS( uu (:,:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1, 0 /) 167 is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 168 is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 169 ENDIF 170 171 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 172 WRITE(ctmp2,9100) kt, zmax(1), ih(1) , ih(2) 173 WRITE(ctmp3,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 174 WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 175 WRITE(ctmp5,9400) kt, zmax(4), is2(1), is2(2), is2(3) 176 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 177 226 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 227 ENDIF 228 ! 178 229 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 179 180 IF( .NOT. sn_cfctl%l_glochk ) THEN181 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea182 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6)183 ELSE184 CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )185 ENDIF186 187 kindic = -3188 !189 ENDIF190 !191 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 192 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 193 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 194 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 230 ! 231 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 232 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 233 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 234 ENDIF 235 ELSE ! only mpi subdomains with errors are here -> STOP now 236 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 237 ENDIF 238 ! 239 ENDIF 240 ! 241 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 242 ngrdstop = Agrif_Fixed() ! store which grid got this error 243 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 244 ENDIF 245 ! 195 246 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 196 247 ! 197 248 END SUBROUTINE stp_ctl 249 250 251 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 252 !!---------------------------------------------------------------------- 253 !! *** ROUTINE wrt_line *** 254 !! 255 !! ** Purpose : write information line 256 !! 257 !!---------------------------------------------------------------------- 258 CHARACTER(len=*), INTENT( out) :: cdline 259 CHARACTER(len=*), INTENT(in ) :: cdprefix 260 REAL(wp), INTENT(in ) :: pval 261 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 262 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 263 ! 264 CHARACTER(len=80) :: clsuff 265 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 266 CHARACTER(len=9 ) :: cli, clj, clk 267 CHARACTER(len=1 ) :: clfmt 268 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 269 INTEGER :: ifmtk 270 !!---------------------------------------------------------------------- 271 WRITE(clkt , '(i9)') kt 272 273 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 274 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 275 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 276 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 277 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 278 WRITE(clmax, cl4) kmax-1 279 ! 280 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 281 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 282 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 283 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 284 ! 285 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 286 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 287 ENDIF 288 IF(kloc(3) == 0) THEN 289 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 290 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 291 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 292 ELSE 293 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 294 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 295 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 296 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 297 ENDIF 298 ! 299 9100 FORMAT('MPI rank ', a) 300 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 301 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 302 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 303 ! 304 END SUBROUTINE wrt_line 305 198 306 199 307 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/OFF/nemogcm.F90
r12377 r13189 28 28 USE usrdef_nam ! user defined configuration 29 29 USE eosbn2 ! equation of state (eos bn2 routine) 30 USE bdy_oce, ONLY : ln_bdy 31 USE bdyini ! open boundary cond. setting (bdy_init routine) 30 32 ! ! ocean physics 31 33 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) … … 90 92 !! Madec, 2008, internal report, IPSL. 91 93 !!---------------------------------------------------------------------- 92 INTEGER :: istp , indic! time step index94 INTEGER :: istp ! time step index 93 95 !!---------------------------------------------------------------------- 94 96 … … 130 132 IF( .NOT.ln_linssh ) CALL dta_dyn_sf_interp( istp, Nnn ) ! calculate now grid parameters 131 133 #endif 132 CALL stp_ctl ( istp , indic )! Time loop: control and print134 CALL stp_ctl ( istp ) ! Time loop: control and print 133 135 istp = istp + 1 134 136 END DO … … 145 147 IF( nstop /= 0 .AND. lwp ) THEN ! error print 146 148 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 147 CALL ctl_stop( ctmp1 ) 149 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 150 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 148 151 ENDIF 149 152 ! … … 209 212 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 210 213 ! open /dev/null file to be able to supress output write easily 214 IF( Agrif_Root() ) THEN 211 215 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 216 #ifdef key_agrif 217 ELSE 218 numnul = Agrif_Parent(numnul) 219 #endif 220 ENDIF 212 221 ! 213 222 ! !--------------------! … … 221 230 ! 222 231 ! finalize the definition of namctl variables 223 IF( sn_cfctl%l_allon ) THEN 224 ! Turn on all options. 225 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 226 ! Ensure all processors are active 227 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 228 ELSEIF( sn_cfctl%l_config ) THEN 229 ! Activate finer control of report outputs 230 ! optionally switch off output from selected areas (note this only 231 ! applies to output which does not involve global communications) 232 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 233 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 234 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 235 ELSE 236 ! turn off all options. 237 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 238 ENDIF 232 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 233 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 239 234 ! 240 235 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 301 296 ! Initialise time level indices 302 297 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 303 304 298 305 299 ! !-------------------------------! … … 323 317 324 318 CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module 319 CALL bdy_init ! Open boundaries initialisation 325 320 326 321 ! ! Tracer physics … … 365 360 WRITE(numout,*) '~~~~~~~~' 366 361 WRITE(numout,*) ' Namelist namctl' 367 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk368 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon369 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config370 362 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 371 363 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 486 478 USE zdf_oce, ONLY : zdf_oce_alloc 487 479 USE trc_oce, ONLY : trc_oce_alloc 480 USE bdy_oce, ONLY : bdy_oce_alloc 488 481 ! 489 482 INTEGER :: ierr … … 495 488 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 496 489 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays 490 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 497 491 ! 498 492 CALL mpp_sum( 'nemogcm', ierr ) … … 501 495 END SUBROUTINE nemo_alloc 502 496 503 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)497 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 504 498 !!---------------------------------------------------------------------- 505 499 !! *** ROUTINE nemo_set_cfctl *** 506 500 !! 507 501 !! ** Purpose : Set elements of the output control structure to setto. 508 !! for_all should be .false. unless all areas are to be 509 !! treated identically. 510 !! 502 !! 511 503 !! ** Method : Note this routine can be used to switch on/off some 512 !! types of output for selected areas but any output types 513 !! that involve global communications (e.g. mpp_max, glob_sum) 514 !! should be protected from selective switching by the 515 !! for_all argument 516 !!---------------------------------------------------------------------- 517 LOGICAL :: setto, for_all 518 TYPE(sn_ctl) :: sn_cfctl 519 !!---------------------------------------------------------------------- 520 IF( for_all ) THEN 521 sn_cfctl%l_runstat = setto 522 sn_cfctl%l_trcstat = setto 523 ENDIF 504 !! types of output for selected areas. 505 !!---------------------------------------------------------------------- 506 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 507 LOGICAL , INTENT(in ) :: setto 508 !!---------------------------------------------------------------------- 509 sn_cfctl%l_runstat = setto 510 sn_cfctl%l_trcstat = setto 524 511 sn_cfctl%l_oceout = setto 525 512 sn_cfctl%l_layout = setto … … 551 538 552 539 553 SUBROUTINE stp_ctl( kt , kindic)540 SUBROUTINE stp_ctl( kt ) 554 541 !!---------------------------------------------------------------------- 555 542 !! *** ROUTINE stp_ctl *** … … 562 549 !!---------------------------------------------------------------------- 563 550 INTEGER, INTENT(in ) :: kt ! ocean time-step index 564 INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence565 551 !!---------------------------------------------------------------------- 566 552 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/SAO/nemogcm.F90
r12377 r13189 29 29 USE sao_intp 30 30 ! 31 USE in_out_manager ! I/O manager 31 32 USE lib_mpp ! distributed memory computing 32 33 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 139 140 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 140 141 ! open /dev/null file to be able to supress output write easily 142 IF( Agrif_Root() ) THEN 141 143 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 144 #ifdef key_agrif 145 ELSE 146 numnul = Agrif_Parent(numnul) 147 #endif 148 ENDIF 142 149 ! 143 150 ! !--------------------! … … 151 158 ! 152 159 ! finalize the definition of namctl variables 153 IF( sn_cfctl%l_allon ) THEN 154 ! Turn on all options. 155 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 156 ! Ensure all processors are active 157 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 158 ELSEIF( sn_cfctl%l_config ) THEN 159 ! Activate finer control of report outputs 160 ! optionally switch off output from selected areas (note this only 161 ! applies to output which does not involve global communications) 162 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 163 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 164 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 165 ELSE 166 ! turn off all options. 167 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 168 ENDIF 160 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 161 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 169 162 ! 170 163 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 263 256 WRITE(numout,*) '~~~~~~~~' 264 257 WRITE(numout,*) ' Namelist namctl' 265 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk266 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon267 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config268 258 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 269 259 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 403 393 END SUBROUTINE nemo_alloc 404 394 405 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)395 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 406 396 !!---------------------------------------------------------------------- 407 397 !! *** ROUTINE nemo_set_cfctl *** 408 398 !! 409 399 !! ** Purpose : Set elements of the output control structure to setto. 410 !! for_all should be .false. unless all areas are to be411 !! treated identically.412 400 !! 413 401 !! ** Method : Note this routine can be used to switch on/off some 414 !! types of output for selected areas but any output types 415 !! that involve global communications (e.g. mpp_max, glob_sum) 416 !! should be protected from selective switching by the 417 !! for_all argument 418 !!---------------------------------------------------------------------- 419 LOGICAL :: setto, for_all 420 TYPE(sn_ctl) :: sn_cfctl 421 !!---------------------------------------------------------------------- 422 IF( for_all ) THEN 423 sn_cfctl%l_runstat = setto 424 sn_cfctl%l_trcstat = setto 425 ENDIF 402 !! types of output for selected areas. 403 !!---------------------------------------------------------------------- 404 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 405 LOGICAL , INTENT(in ) :: setto 406 !!---------------------------------------------------------------------- 407 sn_cfctl%l_runstat = setto 408 sn_cfctl%l_trcstat = setto 426 409 sn_cfctl%l_oceout = setto 427 410 sn_cfctl%l_layout = setto -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/SAS/diawri.F90
r12495 r13189 99 99 ! Output the initial state and forcings 100 100 IF( ninist == 1 ) THEN 101 CALL dia_wri_state( 'output.init', Kmm)101 CALL dia_wri_state( Kmm, 'output.init' ) 102 102 ninist = 0 103 103 ENDIF … … 126 126 END FUNCTION dia_wri_alloc_abl 127 127 128 SUBROUTINE dia_wri( kt )128 SUBROUTINE dia_wri( kt, Kmm ) 129 129 !!--------------------------------------------------------------------- 130 130 !! *** ROUTINE dia_wri *** … … 138 138 !! Each nn_write time step, output the instantaneous or mean fields 139 139 !!---------------------------------------------------------------------- 140 !!141 140 INTEGER, INTENT( in ) :: kt ! ocean time-step index 141 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 142 142 !! 143 143 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 154 154 ! Output the initial state and forcings 155 155 IF( ninist == 1 ) THEN 156 CALL dia_wri_state( 'output.init' )156 CALL dia_wri_state( Kmm, 'output.init' ) 157 157 ninist = 0 158 158 ENDIF … … 257 257 IF( ln_abl ) THEN 258 258 ! Define the ABL grid FILE ( nid_A ) 259 CALL dia_nam( clhstnam, n write, 'grid_ABL' )259 CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 260 260 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 261 261 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit … … 414 414 #endif 415 415 416 SUBROUTINE dia_wri_state( cdfile_name, Kmm)416 SUBROUTINE dia_wri_state( Kmm, cdfile_name ) 417 417 !!--------------------------------------------------------------------- 418 418 !! *** ROUTINE dia_wri_state *** … … 427 427 !! File 'output.abort.nc' is created in case of abnormal job end 428 428 !!---------------------------------------------------------------------- 429 INTEGER , INTENT( in ) :: Kmm ! ocean time levelindex 429 430 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 430 INTEGER , INTENT( in ) :: Kmm ! ocean time levelindex431 431 !! 432 432 INTEGER :: inum … … 437 437 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 438 438 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 439 440 #if defined key_si3 441 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 442 #else 443 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 444 #endif 445 439 ! 440 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 441 ! 446 442 CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) ) ! now temperature 447 443 CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) ) ! now salinity … … 456 452 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 457 453 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 458 454 ! 455 CALL iom_close( inum ) 456 ! 459 457 #if defined key_si3 460 458 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 459 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 461 460 CALL ice_wri_state( inum ) 462 ENDIF 463 #endif 464 ! 465 CALL iom_close( inum ) 466 ! 461 CALL iom_close( inum ) 462 ENDIF 463 ! 464 #endif 467 465 END SUBROUTINE dia_wri_state 468 466 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/SAS/nemogcm.F90
r12495 r13189 35 35 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 36 36 ! 37 USE in_out_manager ! I/O manager 37 38 USE lib_mpp ! distributed memory computing 38 39 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 125 126 END DO 126 127 ! 127 IF( .NOT. Agrif_Root() ) THEN128 CALL Agrif_ParentGrid_To_ChildGrid()129 IF( ln_timing ) CALL timing_finalize130 CALL Agrif_ChildGrid_To_ParentGrid()131 ENDIF132 !133 128 #else 134 129 ! … … 165 160 IF( nstop /= 0 .AND. lwp ) THEN ! error print 166 161 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 167 CALL ctl_stop( ctmp1 ) 162 IF( ngrdstop > 0 ) THEN 163 WRITE(ctmp9,'(i2)') ngrdstop 164 WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9) 165 WRITE(ctmp3,*) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 166 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 167 ELSE 168 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 169 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 170 ENDIF 168 171 ENDIF 169 172 ! … … 256 259 ENDIF 257 260 ! open /dev/null file to be able to supress output write easily 261 IF( Agrif_Root() ) THEN 258 262 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 263 #ifdef key_agrif 264 ELSE 265 numnul = Agrif_Parent(numnul) 266 #endif 267 ENDIF 259 268 ! 260 269 ! !--------------------! … … 268 277 ! 269 278 ! finalize the definition of namctl variables 270 IF( sn_cfctl%l_allon ) THEN 271 ! Turn on all options. 272 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 273 ! Ensure all processors are active 274 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 275 ELSEIF( sn_cfctl%l_config ) THEN 276 ! Activate finer control of report outputs 277 ! optionally switch off output from selected areas (note this only 278 ! applies to output which does not involve global communications) 279 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 280 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 281 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 282 ELSE 283 ! turn off all options. 284 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 285 ENDIF 279 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 280 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 286 281 ! 287 282 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 401 396 WRITE(numout,*) '~~~~~~~~' 402 397 WRITE(numout,*) ' Namelist namctl' 403 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk404 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon405 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config406 398 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 407 399 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 545 537 END SUBROUTINE nemo_alloc 546 538 547 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)539 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 548 540 !!---------------------------------------------------------------------- 549 541 !! *** ROUTINE nemo_set_cfctl *** 550 542 !! 551 543 !! ** Purpose : Set elements of the output control structure to setto. 552 !! for_all should be .false. unless all areas are to be553 !! treated identically.554 544 !! 555 545 !! ** Method : Note this routine can be used to switch on/off some 556 !! types of output for selected areas but any output types 557 !! that involve global communications (e.g. mpp_max, glob_sum) 558 !! should be protected from selective switching by the 559 !! for_all argument 560 !!---------------------------------------------------------------------- 561 LOGICAL :: setto, for_all 562 TYPE(sn_ctl) :: sn_cfctl 563 !!---------------------------------------------------------------------- 564 IF( for_all ) THEN 565 sn_cfctl%l_runstat = setto 566 sn_cfctl%l_trcstat = setto 567 ENDIF 546 !! types of output for selected areas. 547 !!---------------------------------------------------------------------- 548 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 549 LOGICAL , INTENT(in ) :: setto 550 !!---------------------------------------------------------------------- 551 sn_cfctl%l_runstat = setto 552 sn_cfctl%l_trcstat = setto 568 553 sn_cfctl%l_oceout = setto 569 554 sn_cfctl%l_layout = setto -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/SAS/sbcssm.F90
r12377 r13189 26 26 USE lib_mpp ! distributed memory computing library 27 27 USE prtctl ! print control 28 USE fldread ! read input fields 28 USE fldread ! read input fields 29 29 USE timing ! Timing 30 30 … … 38 38 LOGICAL :: ln_3d_uve ! specify whether input velocity data is 3D 39 39 LOGICAL :: ln_read_frq ! specify whether we must read frq or not 40 40 41 41 LOGICAL :: l_sasread ! Ice intilisation: =T read a file ; =F anaytical initilaistion 42 42 LOGICAL :: l_initdone = .false. … … 69 69 !! for an off-line simulation using surface processes only 70 70 !! 71 !! ** Method : calculates the position of data 71 !! ** Method : calculates the position of data 72 72 !! - interpolates data if needed 73 73 !!---------------------------------------------------------------------- 74 74 INTEGER, INTENT(in) :: kt ! ocean time-step index 75 75 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 76 76 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 77 77 ! 78 78 INTEGER :: ji, jj ! dummy loop indices … … 82 82 ! 83 83 IF( ln_timing ) CALL timing_start( 'sbc_ssm') 84 84 85 85 IF ( l_sasread ) THEN 86 86 IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d ) !== read data at kt time step ==! 87 87 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 88 ! 88 ! 89 89 IF( ln_3d_uve ) THEN 90 90 IF( .NOT. ln_linssh ) THEN 91 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 91 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 92 92 ELSE 93 93 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 94 94 ENDIF 95 95 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 96 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 96 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 97 97 ELSE 98 98 IF( .NOT. ln_linssh ) THEN 99 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 99 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 100 100 ELSE 101 101 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 102 102 ENDIF 103 103 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 104 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 104 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 105 105 ENDIF 106 106 ! … … 123 123 ssh (:,:,Kmm) = 0._wp ! - - 124 124 ENDIF 125 125 126 126 IF ( nn_ice == 1 ) THEN 127 127 ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) … … 132 132 uu (:,:,1,Kbb) = ssu_m(:,:) 133 133 vv (:,:,1,Kbb) = ssv_m(:,:) 134 134 135 135 IF(sn_cfctl%l_prtctl) THEN ! print control 136 136 CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m - : ', mask1=tmask ) … … 162 162 !! *** ROUTINE sbc_ssm_init *** 163 163 !! 164 !! ** Purpose : Initialisation of sea surface mean data 165 !!---------------------------------------------------------------------- 166 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 167 164 !! ** Purpose : Initialisation of sea surface mean data 165 !!---------------------------------------------------------------------- 166 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 167 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 168 168 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 169 169 INTEGER :: ifpr ! dummy loop indice … … 195 195 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 196 196 IF(lwm) WRITE ( numond, namsbc_sas ) 197 ! 197 ! 198 198 IF(lwp) THEN ! Control print 199 199 WRITE(numout,*) ' Namelist namsbc_sas' 200 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 200 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 201 201 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 202 202 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq … … 226 226 ln_closea = .false. 227 227 ENDIF 228 229 ! 228 229 ! 230 230 IF( l_sasread ) THEN ! store namelist information in an array 231 ! 231 ! 232 232 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 233 233 !! when we have other 3d arrays that we need to read in … … 275 275 ENDIF 276 276 ! 277 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 277 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 278 278 IF( nfld_3d > 0 ) THEN 279 279 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 282 282 ENDIF 283 283 DO ifpr = 1, nfld_3d 284 284 ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 285 285 IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 286 286 IF( ierr0 + ierr1 > 0 ) THEN … … 298 298 ENDIF 299 299 DO ifpr = 1, nfld_2d 300 300 ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 301 301 IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 302 302 IF( ierr0 + ierr1 > 0 ) THEN -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/SAS/step.F90
r12377 r13189 74 74 !! -2- Outputs and diagnostics 75 75 !!---------------------------------------------------------------------- 76 INTEGER :: indic ! error indicator if < 077 !! ---------------------------------------------------------------------78 76 79 77 #if defined key_agrif 78 IF( nstop > 0 ) RETURN ! avoid to go further if an error was detected during previous time step (child grid) 80 79 kstp = nit000 + Agrif_Nb_Step() 81 80 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 82 IF 83 IF ( Agrif_Root() .and. lwp) Write(*,*) '---'84 IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint()81 IF( lk_agrif_debug ) THEN 82 IF( Agrif_Root() .and. lwp) WRITE(*,*) '---' 83 IF(lwp) WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint() 85 84 ENDIF 86 87 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 88 85 IF( kstp == nit000 + 1 ) lk_agrif_fstep = .FALSE. 89 86 # if defined key_iomput 90 87 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 91 88 # endif 92 89 #endif 93 indic = 0 ! although indic is not changed in stp_ctl94 ! need to keep the same interface95 90 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 96 91 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) … … 109 104 #if defined key_agrif 110 105 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 111 ! AGRIF 106 ! AGRIF recursive integration 112 107 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 113 CALL Agrif_Integrate_ChildGrids( stp ) 108 CALL Agrif_Integrate_ChildGrids( stp ) 109 110 #endif 111 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 112 ! Control 113 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 114 CALL stp_ctl( kstp, Nnn ) 114 115 115 IF( Agrif_NbStepint() == 0 ) THEN ! AGRIF Update from zoom N to zoom 1 then to Parent 116 #if defined key_agrif 117 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 118 ! AGRIF update 119 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 120 IF( Agrif_NbStepint() == 0 .AND. nstop == 0 ) THEN ! AGRIF Update from zoom N to zoom 1 then to Parent 116 121 #if defined key_si3 117 122 CALL Agrif_Update_ice( ) ! update sea-ice 118 123 #endif 119 124 ENDIF 125 120 126 #endif 121 122 127 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 123 ! Control 124 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 125 CALL stp_ctl( kstp, indic ) 126 IF( indic < 0 ) THEN 127 CALL ctl_stop( 'step: indic < 0' ) 128 CALL dia_wri_state( 'output.abort', Nnn ) 129 ENDIF 130 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 128 ! File manipulation at the end of the first time step 129 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 130 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 131 131 132 132 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 133 133 ! Coupled mode 134 134 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 135 IF( lk_oasis ) CALL sbc_cpl_snd( kstp, Nbb, Nnn )! coupled mode : field exchanges if OASIS-coupled ice135 IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp, Nbb, Nnn ) ! coupled mode : field exchanges if OASIS-coupled ice 136 136 137 137 #if defined key_iomput … … 144 144 lrst_oce = .FALSE. 145 145 ENDIF 146 IF( kstp == nitend .OR. indic <0 ) THEN147 146 IF( kstp == nitend .OR. nstop > 0 ) THEN 147 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 148 148 ENDIF 149 149 #endif -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/SAS/stpctl.F90
r12377 r13189 21 21 USE ice , ONLY : vt_i, u_ice, tm_i 22 22 ! 23 USE diawri ! Standard run outputs (dia_wri_state routine) 23 24 USE in_out_manager ! I/O manager 24 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 26 USE lib_mpp ! distributed memory computing 26 27 ! 27 28 USE netcdf ! NetCDF library 28 29 IMPLICIT NONE … … 31 32 PUBLIC stp_ctl ! routine called by step.F90 32 33 33 INTEGER :: idrun, idtime, idssh, idu, ids, istatus34 LOGICAL :: lsomeoce34 INTEGER :: nrunid ! netcdf file id 35 INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 38 39 !! Software governed by the CeCILL license (see ./LICENSE) 39 40 !!---------------------------------------------------------------------- 40 41 41 CONTAINS 42 42 43 SUBROUTINE stp_ctl( kt, kindic)43 SUBROUTINE stp_ctl( kt, Kmm ) 44 44 !!---------------------------------------------------------------------- 45 45 !! *** ROUTINE stp_ctl *** … … 49 49 !! ** Method : - Save the time step in numstp 50 50 !! - Print it each 50 time steps 51 !! - Stop the run IF problem encountered by setting nstop > 0 52 !! Problems checked: ice thickness maximum > 100 m 53 !! ice velocity maximum > 10 m/s 54 !! min ice temperature < -100 degC 51 55 !! 52 56 !! ** Actions : "time.step" file = last ocean time-step 53 57 !! "run.stat" file = run statistics 54 !! 55 !!---------------------------------------------------------------------- 56 INTEGER, INTENT( in ) :: kt ! ocean time-step index 57 INTEGER, INTENT( inout ) :: kindic ! indicator of solver convergence 58 !! 59 REAL(wp), DIMENSION(3) :: zmax 60 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 61 CHARACTER(len=20) :: clname 62 !!---------------------------------------------------------------------- 63 ! 64 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 65 ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 66 ll_wrtruns = ll_colruns .AND. lwm 67 IF( kt == nit000 .AND. lwp ) THEN 68 WRITE(numout,*) 69 WRITE(numout,*) 'stp_ctl : time-stepping control' 70 WRITE(numout,*) '~~~~~~~' 71 ! ! open time.step file 72 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 73 ! ! open run.stat file(s) at start whatever 74 ! ! the value of sn_cfctl%ptimincr 75 IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 58 !! nstop indicator sheared among all local domain 59 !!---------------------------------------------------------------------- 60 INTEGER, INTENT(in ) :: kt ! ocean time-step index 61 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 62 !! 63 INTEGER :: ji ! dummy loop indices 64 INTEGER :: idtime, istatus 65 INTEGER , DIMENSION(4) :: iareasum, iareamin, iareamax 66 INTEGER , DIMENSION(3,3) :: iloc ! min/max loc indices 67 REAL(wp) :: zzz ! local real 68 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 69 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 70 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 71 CHARACTER(len=20) :: clname 72 !!---------------------------------------------------------------------- 73 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 74 ! 75 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 76 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 77 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 78 ! 79 IF( kt == nit000 ) THEN 80 ! 81 IF( lwp ) THEN 82 WRITE(numout,*) 83 WRITE(numout,*) 'stp_ctl : time-stepping control' 84 WRITE(numout,*) '~~~~~~~' 85 ENDIF 86 ! ! open time.step ascii file, done only by 1st subdomain 87 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 88 ! 89 IF( ll_wrtruns ) THEN 90 ! ! open run.stat ascii file, done only by 1st subdomain 76 91 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 92 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 77 93 clname = 'run.stat.nc' 78 94 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 79 istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 80 istatus = NF90_DEF_DIM( idrun, 'time' , NF90_UNLIMITED, idtime ) 81 istatus = NF90_DEF_VAR( idrun, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), idssh ) 82 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 83 istatus = NF90_DEF_VAR( idrun, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), ids ) 84 istatus = NF90_ENDDEF(idrun) 85 ENDIF 86 ENDIF 87 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 88 ! 89 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 95 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 96 istatus = NF90_DEF_DIM( nrunid, 'time' , NF90_UNLIMITED, idtime ) 97 istatus = NF90_DEF_VAR( nrunid, 'vt_i_max' , NF90_DOUBLE, (/ idtime /), nvarid(1) ) 98 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 99 istatus = NF90_DEF_VAR( nrunid, 'tm_i_min' , NF90_DOUBLE, (/ idtime /), nvarid(3) ) 100 istatus = NF90_ENDDEF(nrunid) 101 ENDIF 102 ! 103 ENDIF 104 ! 105 ! !== write current time step ==! 106 ! !== done only by 1st subdomain at writting timestep ==! 107 IF( lwm .AND. ll_wrtstp ) THEN 90 108 WRITE ( numstp, '(1x, i8)' ) kt 91 109 REWIND( numstp ) 92 110 ENDIF 93 ! !== test of extrema ==! 111 ! !== test of local extrema ==! 112 ! !== done by all processes at every time step ==! 113 llmsk(:,:) = tmask(:,:,1) == 1._wp 114 IF( COUNT( llmsk(:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 115 zmax(1) = MAXVAL( vt_i (:,:) , mask = llmsk ) ! max ice thickness 116 zmax(2) = MAXVAL( ABS( u_ice(:,:) ) , mask = llmsk ) ! max ice velocity (zonal only) 117 zmax(3) = MAXVAL( -tm_i (:,:) + 273.15_wp, mask = llmsk ) ! min ice temperature 118 ELSE 119 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 120 zmax(1:3) = -HUGE(1._wp) 121 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 122 zmax(1:3) = 0._wp 123 ENDIF 124 ENDIF 125 zmax(4) = REAL( nstop, wp ) ! stop indicator 126 ! !== get global extrema ==! 127 ! !== done by all processes if writting run.stat ==! 94 128 IF( ll_colruns ) THEN 95 zmax(1) = MAXVAL( vt_i (:,:) ) ! max ice thickness 96 zmax(2) = MAXVAL( ABS( u_ice(:,:) ) ) ! max ice velocity (zonal only) 97 zmax(3) = MAXVAL( -tm_i (:,:)+273.15_wp , mask = ssmask(:,:) == 1._wp ) ! min ice temperature 98 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 129 zmaxlocal(:) = zmax(:) 130 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 131 nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains) 132 ENDIF 133 ! !== write "run.stat" files ==! 134 ! !== done only by 1st subdomain at writting timestep ==! 135 IF( ll_wrtruns ) THEN 136 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3) 137 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 138 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 139 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 140 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 99 141 END IF 100 ! !== run statistics ==! ("run.stat" file) 101 IF( ll_wrtruns ) THEN 102 WRITE(numrun,9500) kt, zmax(1), zmax(2), - zmax(3) 103 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 104 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) ) 105 istatus = NF90_PUT_VAR( idrun, ids, (/-zmax(3)/), (/kt/), (/1/) ) 106 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 107 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 108 END IF 142 ! !== error handling ==! 143 ! !== done by all processes at every time step ==! 144 ! 145 IF( zmax(1) > 100._wp .OR. & ! too large ice thickness maximum ( > 100 m) 146 & zmax(2) > 10._wp .OR. & ! too large ice velocity ( > 10 m/s) 147 & zmax(3) > 101._wp .OR. & ! too cold ice temperature ( < -100 degC) 148 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 149 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 150 ! 151 iloc(:,:) = 0 152 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 153 ! first: close the netcdf file, so we can read it 154 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 155 ! get global loc on the min/max 156 CALL mpp_maxloc( 'stpctl', vt_i(:,:) , tmask(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 157 CALL mpp_maxloc( 'stpctl',ABS( u_ice(:,:) ) , tmask(:,:,1), zzz, iloc(1:2,2) ) 158 CALL mpp_minloc( 'stpctl', tm_i(:,:) - 273.15_wp, tmask(:,:,1), zzz, iloc(1:2,3) ) 159 ! find which subdomain has the max. 160 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 161 DO ji = 1, 4 162 IF( zmaxlocal(ji) == zmax(ji) ) THEN 163 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 164 ENDIF 165 END DO 166 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 167 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 168 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 169 ELSE ! find local min and max locations: 170 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 171 iloc(1:2,1) = MAXLOC( vt_i(:,:) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 172 iloc(1:2,2) = MAXLOC( ABS( u_ice(:,:) ) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 173 iloc(1:2,3) = MINLOC( tm_i(:,:) - 273.15_wp, mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 174 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 175 ENDIF 176 ! 177 WRITE(ctmp1,*) ' stp_ctl: ice_thick > 100 m or |ice_vel| > 10 m/s or ice_temp < -100 degC or NaN encounter in the tests' 178 CALL wrt_line( ctmp2, kt, 'ice_thick max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 179 CALL wrt_line( ctmp3, kt, '|ice_vel| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 180 CALL wrt_line( ctmp4, kt, 'ice_temp min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 181 IF( Agrif_Root() ) THEN 182 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 183 ELSE 184 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 185 ENDIF 186 ! 187 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 188 ! 189 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 190 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 191 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 192 ENDIF 193 ELSE ! only mpi subdomains with errors are here -> STOP now 194 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 195 ENDIF 196 ! 197 ENDIF 198 ! 199 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 200 ngrdstop = Agrif_Fixed() ! store which grid got this error 201 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 202 ENDIF 109 203 ! 110 204 9500 FORMAT(' it :', i8, ' vt_i_max: ', D23.16, ' |u|_max: ', D23.16,' tm_i_min: ', D23.16) 111 205 ! 112 206 END SUBROUTINE stp_ctl 207 208 209 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 210 !!---------------------------------------------------------------------- 211 !! *** ROUTINE wrt_line *** 212 !! 213 !! ** Purpose : write information line 214 !! 215 !!---------------------------------------------------------------------- 216 CHARACTER(len=*), INTENT( out) :: cdline 217 CHARACTER(len=*), INTENT(in ) :: cdprefix 218 REAL(wp), INTENT(in ) :: pval 219 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 220 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 221 ! 222 CHARACTER(len=80) :: clsuff 223 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 224 CHARACTER(len=9 ) :: cli, clj, clk 225 CHARACTER(len=1 ) :: clfmt 226 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 227 INTEGER :: ifmtk 228 !!---------------------------------------------------------------------- 229 WRITE(clkt , '(i9)') kt 230 231 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 232 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 233 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 234 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 235 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 236 WRITE(clmax, cl4) kmax-1 237 ! 238 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 239 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 240 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 241 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 242 ! 243 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 244 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 245 ENDIF 246 IF(kloc(3) == 0) THEN 247 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 248 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 249 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 250 ELSE 251 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 252 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 253 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 254 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 255 ENDIF 256 ! 257 9100 FORMAT('MPI rank ', a) 258 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 259 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 260 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 261 ! 262 END SUBROUTINE wrt_line 263 113 264 114 265 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/PISCES/P4Z/p4zmeso.F90
r12377 r13189 69 69 REAL(wp) :: zfact , zfood, zfoodlim, zproport, zbeta 70 70 REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 71 REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 71 REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq 72 REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 72 73 REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz, zgrasrat, zgrasratn 73 74 REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof … … 156 157 zgrazing2(ji,jj,jk) = zgraztotc 157 158 158 ! Mesozooplankton efficiency 159 ! -------------------------- 159 ! Mesozooplankton efficiency. 160 ! We adopt a formulation proposed by Mitra et al. (2007) 161 ! The gross growth efficiency is controled by the most limiting nutrient. 162 ! Growth is also further decreased when the food quality is poor. This is currently 163 ! hard coded : it can be decreased by up to 50% (zepsherq) 164 ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and 165 ! Fulton, 2012) 166 ! ----------------------------------------------------------------------------------- 160 167 zgrasrat = ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 161 168 zgrasratn = ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) … … 163 170 zbeta = MAX(0., (epsher2 - epsher2min) ) 164 171 zepsherf = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 165 zepsherv = zepsherf * zepshert 172 zepsherq = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 173 zepsherv = zepsherf * zepshert * zepsherq 166 174 167 175 zgrarem2 = zgraztotc * ( 1. - zepsherv - unass2 ) & … … 170 178 & + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 171 179 zgrapoc2 = zgraztotc * unass2 180 172 181 173 182 ! Update the arrays TRA which contain the biological sources and sinks -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/PISCES/P4Z/p4zmicro.F90
r12377 r13189 67 67 REAL(wp) :: zgraze , zdenom, zdenom2 68 68 REAL(wp) :: zfact , zfood, zfoodlim, zbeta 69 REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 69 REAL(wp) :: zepsherf, zepshert, zepsherv, zepsherq 70 REAL(wp) :: zgrarsig, zgraztotc, zgraztotn, zgraztotf 70 71 REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 71 72 REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn … … 119 120 zgrazing(ji,jj,jk) = zgraztotc 120 121 121 ! Various remineralization and excretion terms 122 ! -------------------------------------------- 122 123 ! Microzooplankton efficiency. 124 ! We adopt a formulation proposed by Mitra et al. (2007) 125 ! The gross growth efficiency is controled by the most limiting nutrient. 126 ! Growth is also further decreased when the food quality is poor. This is currently 127 ! hard coded : it can be decreased by up to 50% (zepsherq) 128 ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and 129 ! Fulton, 2012) 130 ! ----------------------------------------------------------------------------- 123 131 zgrasrat = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn ) 124 132 zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn ) … … 126 134 zbeta = MAX(0., (epsher - epshermin) ) 127 135 zepsherf = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 128 zepsherv = zepsherf * zepshert 136 zepsherq = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 137 zepsherv = zepsherf * zepshert * zepsherq 129 138 130 139 zgrafer = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/PISCES/P4Z/p4zsms.F90
r12495 r13189 206 206 IF( l_trdtrc ) THEN 207 207 DO jn = jp_pcs0, jp_pcs1 208 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfact 2r208 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr 209 209 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 210 210 END DO -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/PISCES/SED/sedchem.F90
r12377 r13189 577 577 saltprac(:) = salt(:) * 35.0 / 35.16504 578 578 ELSE 579 saltprac(:) = temp(:)579 saltprac(:) = salt(:) 580 580 ENDIF 581 581 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/PISCES/SED/sedinorg.F90
r10225 r13189 89 89 zsolcpcl = zsolcpcl + solcp(ji,jk,jsclay) * dz(jk) 90 90 END DO 91 zsolcpsi = MAX( zsolcpsi, rtrn ) 91 92 zsieq(ji) = sieqs(ji) * MAX(0.25, 1.0 - (0.045 * zsolcpcl / zsolcpsi )**0.58 ) 92 93 zsieq(ji) = MAX( rtrn, sieqs(ji) ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/PISCES/SED/sedrst.F90
r12495 r13189 80 80 IF(lwp) WRITE(numsed,*) & 81 81 ' open sed restart.output NetCDF file: ',TRIM(clpath)//clname 82 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed )82 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed, cdcomp = 'SED' ) 83 83 lrst_sed = .TRUE. 84 84 ENDIF -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/trcbc.F90
r12495 r13189 151 151 IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) /= 0 ) & 152 152 & CALL ctl_stop( 'trc_bc_ini: Use FRS OR relaxation' ) 153 IF( .NOT.( 0 < nn_trcdmp_bdy(ib) .AND. nn_trcdmp_bdy(ib) <= 2 ) ) &153 IF( .NOT.( 0 <= nn_trcdmp_bdy(ib) .AND. nn_trcdmp_bdy(ib) <= 2 ) ) & 154 154 & CALL ctl_stop( 'trc_bc_ini: Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 155 155 END DO -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/src/TOP/trcstp.F90
r12495 r13189 142 142 ! 143 143 ! Define logical parameter ton control dirunal cycle in TOP 144 l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 145 l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline 144 l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 .AND. ncpl_qsr_freq /= 0 ) 145 l_trcdm2dc = l_trcdm2dc .AND. .NOT. l_offline 146 ! 146 147 IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', & 147 148 & 'Computation of a daily mean shortwave for some biogeochemical models ' ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/BENCH/MY_SRC/usrdef_hgr.F90
r9762 r13189 24 24 PUBLIC usr_def_hgr ! called by domhgr.F90 25 25 26 !! * Substitutions 27 # include "do_loop_substitute.h90" 26 28 !!---------------------------------------------------------------------- 27 29 !! NEMO/OPA 4.0, NEMO Consortium (2016) … … 72 74 ! 73 75 ! Position coordinates (in grid points) 74 ! ========== 75 DO jj = 1, jpj 76 DO ji = 1, jpi 77 78 zti = REAL( ji - 1 + nimpp - 1, wp ) ; ztj = REAL( jj - 1 + njmpp - 1, wp ) 79 zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ; zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp 76 ! ========== 77 DO_2D_11_11 78 79 zti = REAL( ji - 1 + nimpp - 1, wp ) ; ztj = REAL( jj - 1 + njmpp - 1, wp ) 80 zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ; zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp 81 82 plamt(ji,jj) = zti 83 plamu(ji,jj) = zui 84 plamv(ji,jj) = zti 85 plamf(ji,jj) = zui 86 87 pphit(ji,jj) = ztj 88 pphiv(ji,jj) = zvj 89 pphiu(ji,jj) = ztj 90 pphif(ji,jj) = zvj 80 91 81 plamt(ji,jj) = zti 82 plamu(ji,jj) = zui 83 plamv(ji,jj) = zti 84 plamf(ji,jj) = zui 85 86 pphit(ji,jj) = ztj 87 pphiv(ji,jj) = zvj 88 pphiu(ji,jj) = ztj 89 pphif(ji,jj) = zvj 90 91 END DO 92 END DO 92 END_2D 93 93 ! 94 94 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/BENCH/MY_SRC/usrdef_istate.F90
r11536 r13189 28 28 PUBLIC usr_def_istate ! called by istate.F90 29 29 30 !! * Substitutions 31 # include "do_loop_substitute.h90" 30 32 !!---------------------------------------------------------------------- 31 33 !! NEMO/OPA 4.0 , NEMO Consortium (2016) … … 62 64 ! 63 65 ! define unique value on each point. z2d ranging from 0.05 to -0.05 64 DO jj = 1, jpj 65 DO ji = 1, jpi 66 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + mjg(jj) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 67 ENDDO 68 ENDDO 66 DO_2D_11_11 67 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + (mjg(jj)-1) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 68 END_2D 69 69 ! 70 70 ! sea level: … … 78 78 pts(:,:,jk,jp_sal) = 30._wp + 1._wp * zfact + z2d(:,:) ! 30 to 31 +/- 0.05 psu 79 79 ! velocities: 80 pu(:,:,jk) = z2d(:,:) * 0.1_wp! +/- 0.005 m/s81 pv(:,:,jk) = z2d(:,:) * 0.01_wp 80 pu(:,:,jk) = z2d(:,:) * 0.1_wp * umask(:,:,jk) ! +/- 0.005 m/s 81 pv(:,:,jk) = z2d(:,:) * 0.01_wp * vmask(:,:,jk) ! +/- 0.0005 m/s 82 82 ENDDO 83 83 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/BENCH/MY_SRC/usrdef_nam.F90
r12377 r13189 55 55 ! !!* nammpp namelist *!! 56 56 INTEGER :: jpni, jpnj 57 LOGICAL :: ln_nnogather 57 LOGICAL :: ln_nnogather, ln_listonly 58 58 !! 59 59 NAMELIST/namusr_def/ nn_isize, nn_jsize, nn_ksize, nn_perio 60 NAMELIST/nammpp/ jpni, jpnj, ln_nnogather 60 NAMELIST/nammpp/ jpni, jpnj, ln_nnogather, ln_listonly 61 61 !!---------------------------------------------------------------------- 62 62 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/BENCH/MY_SRC/usrdef_sbc.F90
r12377 r13189 34 34 PUBLIC usrdef_sbc_ice_flx ! routine called by sbcice_lim.F90 for ice thermo 35 35 36 !! * Substitutions 37 # include "do_loop_substitute.h90" 36 38 !!---------------------------------------------------------------------- 37 39 !! NEMO/OPA 4.0 , NEMO Consortium (2016) … … 102 104 ! 103 105 ! define unique value on each point. z2d ranging from 0.05 to -0.05 104 DO jj = 1, jpj 105 DO ji = 1, jpi 106 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 107 ENDDO 108 ENDDO 106 DO_2D_11_11 107 z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 108 END_2D 109 109 utau_ice(:,:) = 0.1_wp + z2d(:,:) 110 110 vtau_ice(:,:) = 0.1_wp + z2d(:,:) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/diawri.F90
r12495 r13189 26 26 !!---------------------------------------------------------------------- 27 27 USE oce ! ocean dynamics and tracers 28 USE isf_oce 29 USE isfcpl 30 USE abl ! abl variables in case ln_abl = .true. 28 31 USE dom_oce ! ocean space and time domain 29 32 USE phycst ! physical constants … … 65 68 PUBLIC dia_wri_state 66 69 PUBLIC dia_wri_alloc ! Called by nemogcm module 67 70 #if ! defined key_iomput 71 PUBLIC dia_wri_alloc_abl ! Called by sbcabl module (if ln_abl = .true.) 72 #endif 68 73 INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file 69 74 INTEGER :: nb_T , ndim_bT ! grid_T file … … 71 76 INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file 72 77 INTEGER :: nid_W, nz_W, nh_W ! grid_W file 78 INTEGER :: nid_A, nz_A, nh_A, ndim_A, ndim_hA ! grid_ABL file 73 79 INTEGER :: ndex(1) ! ??? 74 80 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 81 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 75 82 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 76 83 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 77 84 85 !! * Substitutions 86 # include "do_loop_substitute.h90" 78 87 !!---------------------------------------------------------------------- 79 88 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 147 156 CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature 148 157 IF ( iom_use("sbt") ) THEN 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 ikbot = mbkt(ji,jj) 152 z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) 153 END DO 154 END DO 158 DO_2D_11_11 159 ikbot = mbkt(ji,jj) 160 z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) 161 END_2D 155 162 CALL iom_put( "sbt", z2d ) ! bottom temperature 156 163 ENDIF … … 159 166 CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity 160 167 IF ( iom_use("sbs") ) THEN 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ikbot = mbkt(ji,jj) 164 z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) 165 END DO 166 END DO 168 DO_2D_11_11 169 ikbot = mbkt(ji,jj) 170 z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) 171 END_2D 167 172 CALL iom_put( "sbs", z2d ) ! bottom salinity 168 173 ENDIF … … 171 176 zztmp = rho0 * 0.25 172 177 z2d(:,:) = 0._wp 173 DO jj = 2, jpjm1 174 DO ji = fs_2, fs_jpim1 ! vector opt. 175 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 & 176 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 & 177 & + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vv(ji,jj ,mbkv(ji,jj ),Kmm) )**2 & 178 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm) )**2 179 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 180 ! 181 END DO 182 END DO 178 DO_2D_00_00 179 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 & 180 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 & 181 & + ( ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj ) ) * vv(ji,jj ,mbkv(ji,jj ),Kmm) )**2 & 182 & + ( ( rCdU_bot(ji,jj )+rCdU_bot(ji,jj-1) ) * vv(ji,jj-1,mbkv(ji,jj-1),Kmm) )**2 183 z2d(ji,jj) = zztmp * SQRT( zztmp2 ) * tmask(ji,jj,1) 184 ! 185 END_2D 183 186 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 184 187 CALL iom_put( "taubot", z2d ) … … 188 191 CALL iom_put( "ssu", uu(:,:,1,Kmm) ) ! surface i-current 189 192 IF ( iom_use("sbu") ) THEN 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 ikbot = mbku(ji,jj) 193 z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) 194 END DO 195 END DO 193 DO_2D_11_11 194 ikbot = mbku(ji,jj) 195 z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) 196 END_2D 196 197 CALL iom_put( "sbu", z2d ) ! bottom i-current 197 198 ENDIF … … 200 201 CALL iom_put( "ssv", vv(:,:,1,Kmm) ) ! surface j-current 201 202 IF ( iom_use("sbv") ) THEN 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 ikbot = mbkv(ji,jj) 205 z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) 206 END DO 207 END DO 203 DO_2D_11_11 204 ikbot = mbkv(ji,jj) 205 z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) 206 END_2D 208 207 CALL iom_put( "sbv", z2d ) ! bottom j-current 209 208 ENDIF 210 209 210 IF( ln_zad_Aimp ) ww = ww + wi ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 211 ! 211 212 CALL iom_put( "woce", ww ) ! vertical velocity 212 213 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value … … 219 220 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 220 221 ENDIF 222 ! 223 IF( ln_zad_Aimp ) ww = ww - wi ! Remove implicit part of vertical velocity that was added for diagnostic output 221 224 222 225 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. … … 227 230 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 228 231 229 IF ( iom_use("salgrad") .OR. iom_use("salgrad2") ) THEN230 z3d(:,:,jpk) = 0.231 DO jk = 1, jpkm1232 DO jj = 2, jpjm1 ! sal gradient233 DO ji = fs_2, fs_jpim1 ! vector opt.234 zztmp = ts(ji,jj,jk,jp_sal,Kmm)235 zztmpx = ( ts(ji+1,jj,jk,jp_sal,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,jk,jp_sal,Kmm) ) * r1_e1u(ji-1,jj)236 zztmpy = ( ts(ji,jj+1,jk,jp_sal,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji ,jj-1,jk,jp_sal,Kmm) ) * r1_e2v(ji,jj-1)237 z3d(ji,jj,jk) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) &238 & * umask(ji,jj,jk) * umask(ji-1,jj,jk) * vmask(ji,jj,jk) * umask(ji,jj-1,jk)239 END DO240 END DO241 END DO242 CALL lbc_lnk( 'diawri', z3d, 'T', 1. )243 CALL iom_put( "salgrad2", z3d ) ! square of module of sal gradient244 z3d(:,:,:) = SQRT( z3d(:,:,:) )245 CALL iom_put( "salgrad" , z3d ) ! module of sal gradient246 ENDIF247 248 232 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 249 DO jj = 2, jpjm1 ! sst gradient 250 DO ji = fs_2, fs_jpim1 ! vector opt. 251 zztmp = ts(ji,jj,1,jp_tem,Kmm) 252 zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) 253 zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1) 254 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 255 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 256 END DO 257 END DO 233 DO_2D_00_00 234 zztmp = ts(ji,jj,1,jp_tem,Kmm) 235 zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) 236 zztmpy = ( ts(ji,jj+1,1,jp_tem,Kmm) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - ts(ji ,jj-1,1,jp_tem,Kmm) ) * r1_e2v(ji,jj-1) 237 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 238 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 239 END_2D 258 240 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 259 241 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient … … 265 247 IF( iom_use("heatc") ) THEN 266 248 z2d(:,:) = 0._wp 267 DO jk = 1, jpkm1 268 DO jj = 1, jpj 269 DO ji = 1, jpi 270 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 271 END DO 272 END DO 273 END DO 249 DO_3D_11_11( 1, jpkm1 ) 250 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 251 END_3D 274 252 CALL iom_put( "heatc", rho0_rcp * z2d ) ! vertically integrated heat content (J/m2) 275 253 ENDIF … … 277 255 IF( iom_use("saltc") ) THEN 278 256 z2d(:,:) = 0._wp 279 DO jk = 1, jpkm1 280 DO jj = 1, jpj 281 DO ji = 1, jpi 282 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 283 END DO 284 END DO 285 END DO 257 DO_3D_11_11( 1, jpkm1 ) 258 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 259 END_3D 286 260 CALL iom_put( "saltc", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 287 261 ENDIF … … 289 263 IF( iom_use("salt2c") ) THEN 290 264 z2d(:,:) = 0._wp 291 DO jk = 1, jpkm1 292 DO jj = 1, jpj 293 DO ji = 1, jpi 294 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 295 END DO 296 END DO 297 END DO 265 DO_3D_11_11( 1, jpkm1 ) 266 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 267 END_3D 298 268 CALL iom_put( "salt2c", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 299 269 ENDIF … … 301 271 IF ( iom_use("eken") ) THEN 302 272 z3d(:,:,jpk) = 0._wp 303 DO jk = 1, jpkm1 304 DO jj = 2, jpjm1 305 DO ji = fs_2, fs_jpim1 ! vector opt. 306 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 307 z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 308 & + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 309 & + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 310 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 311 END DO 312 END DO 313 END DO 273 DO_3D_00_00( 1, jpkm1 ) 274 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 275 z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 276 & + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 277 & + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 278 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 279 END_3D 314 280 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 315 281 CALL iom_put( "eken", z3d ) ! kinetic energy … … 321 287 z3d(1,:, : ) = 0._wp 322 288 z3d(:,1, : ) = 0._wp 323 DO jk = 1, jpkm1 324 DO jj = 2, jpj 325 DO ji = 2, jpi 326 z3d(ji,jj,jk) = 0.25_wp * ( uu(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 327 & + uu(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 328 & + vv(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) * e1e2v(ji,jj ) * e3v(ji,jj ,jk,Kmm) & 329 & + vv(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) ) & 330 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 331 END DO 332 END DO 333 END DO 334 289 DO_3D_00_00( 1, jpkm1 ) 290 z3d(ji,jj,jk) = 0.25_wp * ( uu(ji ,jj,jk,Kmm) * uu(ji ,jj,jk,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 291 & + uu(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 292 & + vv(ji,jj ,jk,Kmm) * vv(ji,jj ,jk,Kmm) * e1e2v(ji,jj ) * e3v(ji,jj ,jk,Kmm) & 293 & + vv(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) ) & 294 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 295 END_3D 335 296 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 336 297 CALL iom_put( "ke", z3d ) ! kinetic energy 337 298 338 299 z2d(:,:) = 0._wp 339 DO jk = 1, jpkm1 340 DO jj = 1, jpj 341 DO ji = 1, jpi 342 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * tmask(ji,jj,jk) 343 END DO 344 END DO 345 END DO 300 DO_3D_11_11( 1, jpkm1 ) 301 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * tmask(ji,jj,jk) 302 END_3D 346 303 CALL iom_put( "ke_zint", z2d ) ! vertically integrated kinetic energy 347 304 … … 353 310 354 311 z3d(:,:,jpk) = 0._wp 355 DO jk = 1, jpkm1 356 DO jj = 1, jpjm1 357 DO ji = 1, fs_jpim1 ! vector opt. 358 z3d(ji,jj,jk) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm) & 359 & - e1u(ji ,jj+1) * uu(ji ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm) ) * r1_e1e2f(ji,jj) 360 END DO 361 END DO 362 END DO 312 DO_3D_00_00( 1, jpkm1 ) 313 z3d(ji,jj,jk) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm) & 314 & - e1u(ji ,jj+1) * uu(ji ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm) ) * r1_e1e2f(ji,jj) 315 END_3D 363 316 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 364 317 CALL iom_put( "relvor", z3d ) ! relative vorticity 365 318 366 DO jk = 1, jpkm1 367 DO jj = 1, jpj 368 DO ji = 1, jpi 369 z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 370 END DO 371 END DO 372 END DO 319 DO_3D_11_11( 1, jpkm1 ) 320 z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 321 END_3D 373 322 CALL iom_put( "absvor", z3d ) ! absolute vorticity 374 323 375 DO jk = 1, jpkm1 376 DO jj = 1, jpjm1 377 DO ji = 1, fs_jpim1 ! vector opt. 378 ze3 = ( e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 379 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 380 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 381 ELSE ; ze3 = 0._wp 382 ENDIF 383 z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 384 END DO 385 END DO 386 END DO 324 DO_3D_00_00( 1, jpkm1 ) 325 ze3 = ( e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 326 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 327 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 328 ELSE ; ze3 = 0._wp 329 ENDIF 330 z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 331 END_3D 387 332 CALL lbc_lnk( 'diawri', z3d, 'F', 1. ) 388 333 CALL iom_put( "potvor", z3d ) ! potential vorticity 389 334 390 335 ENDIF 391 392 336 ! 393 337 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN … … 404 348 IF( iom_use("u_heattr") ) THEN 405 349 z2d(:,:) = 0._wp 406 DO jk = 1, jpkm1 407 DO jj = 2, jpjm1 408 DO ji = fs_2, fs_jpim1 ! vector opt. 409 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 410 END DO 411 END DO 412 END DO 350 DO_3D_00_00( 1, jpkm1 ) 351 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 352 END_3D 413 353 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 414 354 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction … … 417 357 IF( iom_use("u_salttr") ) THEN 418 358 z2d(:,:) = 0.e0 419 DO jk = 1, jpkm1 420 DO jj = 2, jpjm1 421 DO ji = fs_2, fs_jpim1 ! vector opt. 422 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 423 END DO 424 END DO 425 END DO 359 DO_3D_00_00( 1, jpkm1 ) 360 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 361 END_3D 426 362 CALL lbc_lnk( 'diawri', z2d, 'U', -1. ) 427 363 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction … … 439 375 IF( iom_use("v_heattr") ) THEN 440 376 z2d(:,:) = 0.e0 441 DO jk = 1, jpkm1 442 DO jj = 2, jpjm1 443 DO ji = fs_2, fs_jpim1 ! vector opt. 444 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 445 END DO 446 END DO 447 END DO 377 DO_3D_00_00( 1, jpkm1 ) 378 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 379 END_3D 448 380 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 449 381 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction … … 452 384 IF( iom_use("v_salttr") ) THEN 453 385 z2d(:,:) = 0._wp 454 DO jk = 1, jpkm1 455 DO jj = 2, jpjm1 456 DO ji = fs_2, fs_jpim1 ! vector opt. 457 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 458 END DO 459 END DO 460 END DO 386 DO_3D_00_00( 1, jpkm1 ) 387 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 388 END_3D 461 389 CALL lbc_lnk( 'diawri', z2d, 'V', -1. ) 462 390 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction … … 465 393 IF( iom_use("tosmint") ) THEN 466 394 z2d(:,:) = 0._wp 467 DO jk = 1, jpkm1 468 DO jj = 2, jpjm1 469 DO ji = fs_2, fs_jpim1 ! vector opt. 470 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 471 END DO 472 END DO 473 END DO 395 DO_3D_00_00( 1, jpkm1 ) 396 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 397 END_3D 474 398 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 475 399 CALL iom_put( "tosmint", rho0 * z2d ) ! Vertical integral of temperature … … 477 401 IF( iom_use("somint") ) THEN 478 402 z2d(:,:)=0._wp 479 DO jk = 1, jpkm1 480 DO jj = 2, jpjm1 481 DO ji = fs_2, fs_jpim1 ! vector opt. 482 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 483 END DO 484 END DO 485 END DO 403 DO_3D_00_00( 1, jpkm1 ) 404 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 405 END_3D 486 406 CALL lbc_lnk( 'diawri', z2d, 'T', -1. ) 487 407 CALL iom_put( "somint", rho0 * z2d ) ! Vertical integral of salinity … … 490 410 CALL iom_put( "bn2", rn2 ) ! Brunt-Vaisala buoyancy frequency (N^2) 491 411 ! 492 412 493 413 IF (ln_dia25h) CALL dia_25h( kt, Kmm ) ! 25h averaging 494 414 … … 506 426 INTEGER, DIMENSION(2) :: ierr 507 427 !!---------------------------------------------------------------------- 508 ierr = 0 509 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 510 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 511 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 428 IF( nn_write == -1 ) THEN 429 dia_wri_alloc = 0 430 ELSE 431 ierr = 0 432 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 433 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 434 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 512 435 ! 513 dia_wri_alloc = MAXVAL(ierr) 514 CALL mpp_sum( 'diawri', dia_wri_alloc ) 436 dia_wri_alloc = MAXVAL(ierr) 437 CALL mpp_sum( 'diawri', dia_wri_alloc ) 438 ! 439 ENDIF 515 440 ! 516 441 END FUNCTION dia_wri_alloc 442 443 INTEGER FUNCTION dia_wri_alloc_abl() 444 !!---------------------------------------------------------------------- 445 ALLOCATE( ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 446 CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 447 ! 448 END FUNCTION dia_wri_alloc_abl 517 449 518 450 … … 538 470 INTEGER :: ierr ! error code return from allocation 539 471 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 472 INTEGER :: ipka ! ABL 540 473 INTEGER :: jn, ierror ! local integers 541 474 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars … … 543 476 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 544 477 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace 478 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 545 479 !!---------------------------------------------------------------------- 546 480 ! … … 576 510 ijmi = 1 ; ijma = jpj 577 511 ipk = jpk 512 IF(ln_abl) ipka = jpkam1 578 513 579 514 ! define time axis … … 678 613 & "m", ipk, gdepw_1d, nz_W, "down" ) 679 614 615 IF( ln_abl ) THEN 616 ! Define the ABL grid FILE ( nid_A ) 617 CALL dia_nam( clhstnam, nn_write, 'grid_ABL' ) 618 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam ! filename 619 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 620 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 621 & nit000-1, zjulian, rn_Dt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 622 CALL histvert( nid_A, "ght_abl", "Vertical T levels", & ! Vertical grid: gdept 623 & "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 624 ! ! Index of ocean points 625 ALLOCATE( zw3d_abl(jpi,jpj,ipka) ) 626 zw3d_abl(:,:,:) = 1._wp 627 CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A ) ! volume 628 CALL wheneq( jpi*jpj , zw3d_abl, 1, 1., ndex_hA, ndim_hA ) ! surface 629 DEALLOCATE(zw3d_abl) 630 ENDIF 680 631 681 632 ! Declare all the output fields as NETCDF variables … … 727 678 CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm 728 679 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 729 ! 680 ! 681 IF( ln_abl ) THEN 682 CALL histdef( nid_A, "t_abl", "Potential Temperature" , "K" , & ! t_abl 683 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 684 CALL histdef( nid_A, "q_abl", "Humidity" , "kg/kg" , & ! q_abl 685 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 686 CALL histdef( nid_A, "u_abl", "Atmospheric U-wind " , "m/s" , & ! u_abl 687 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 688 CALL histdef( nid_A, "v_abl", "Atmospheric V-wind " , "m/s" , & ! v_abl 689 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 690 CALL histdef( nid_A, "tke_abl", "Atmospheric TKE " , "m2/s2" , & ! tke_abl 691 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 692 CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s" , & ! avm_abl 693 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 694 CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2", & ! avt_abl 695 & jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 696 CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height " , "m", & ! pblh 697 & jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 698 #if defined key_si3 699 CALL histdef( nid_A, "oce_frac", "Fraction of open ocean" , " ", & ! ato_i 700 & jpi, jpj, nh_A, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 701 #endif 702 CALL histend( nid_A, snc4chunks=snc4set ) 703 ENDIF 704 ! 730 705 IF( ln_icebergs ) THEN 731 706 CALL histdef( nid_T, "calving" , "calving mass input" , "kg/s" , & … … 885 860 CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction 886 861 CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed 887 ! 862 ! 863 IF( ln_abl ) THEN 864 ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 865 IF( ln_mskland ) THEN 866 DO jk=1,jpka 867 zw3d_abl(:,:,jk) = tmask(:,:,1) 868 END DO 869 ELSE 870 zw3d_abl(:,:,:) = 1._wp 871 ENDIF 872 CALL histwrite( nid_A, "pblh" , it, pblh(:,:) *zw3d_abl(:,:,1 ), ndim_hA, ndex_hA ) ! pblh 873 CALL histwrite( nid_A, "u_abl" , it, u_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! u_abl 874 CALL histwrite( nid_A, "v_abl" , it, v_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! v_abl 875 CALL histwrite( nid_A, "t_abl" , it, tq_abl (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! t_abl 876 CALL histwrite( nid_A, "q_abl" , it, tq_abl (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! q_abl 877 CALL histwrite( nid_A, "tke_abl", it, tke_abl (:,:,2:jpka,nt_n )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! tke_abl 878 CALL histwrite( nid_A, "avm_abl", it, avm_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avm_abl 879 CALL histwrite( nid_A, "avt_abl", it, avt_abl (:,:,2:jpka )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A ) ! avt_abl 880 #if defined key_si3 881 CALL histwrite( nid_A, "oce_frac" , it, ato_i(:,:) , ndim_hA, ndex_hA ) ! ato_i 882 #endif 883 DEALLOCATE(zw3d_abl) 884 ENDIF 885 ! 888 886 IF( ln_icebergs ) THEN 889 887 ! … … 931 929 CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress 932 930 933 CALL histwrite( nid_W, "vovecrtz", it, ww , ndim_T, ndex_T ) ! vert. current 931 IF( ln_zad_Aimp ) THEN 932 CALL histwrite( nid_W, "vovecrtz", it, ww + wi , ndim_T, ndex_T ) ! vert. current 933 ELSE 934 CALL histwrite( nid_W, "vovecrtz", it, ww , ndim_T, ndex_T ) ! vert. current 935 ENDIF 934 936 CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef. 935 937 CALL histwrite( nid_W, "votkeavm", it, avm , ndim_T, ndex_T ) ! T vert. eddy visc. coef. … … 951 953 CALL histclo( nid_V ) 952 954 CALL histclo( nid_W ) 955 IF(ln_abl) CALL histclo( nid_A ) 953 956 ENDIF 954 957 ! … … 974 977 CHARACTER (len=* ), INTENT( in ) :: cdfile_name ! name of the file created 975 978 !! 976 INTEGER :: inum 979 INTEGER :: inum, jk 977 980 !!---------------------------------------------------------------------- 978 981 ! … … 981 984 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 982 985 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 983 984 #if defined key_si3 985 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl ) 986 #else 987 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 988 #endif 989 986 ! 987 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) 988 ! 990 989 CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature 991 990 CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity … … 993 992 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm) ) ! now i-velocity 994 993 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm) ) ! now j-velocity 995 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity 994 IF( ln_zad_Aimp ) THEN 995 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi ) ! now k-velocity 996 ELSE 997 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity 998 ENDIF 999 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 1000 CALL iom_rstput( 0, 0, inum, 'ht' , ht ) ! now water column height 1001 ! 1002 IF ( ln_isf ) THEN 1003 IF (ln_isfcav_mlt) THEN 1004 CALL iom_rstput( 0, 0, inum, 'fwfisf_cav', fwfisf_cav ) ! now k-velocity 1005 CALL iom_rstput( 0, 0, inum, 'rhisf_cav_tbl', rhisf_tbl_cav ) ! now k-velocity 1006 CALL iom_rstput( 0, 0, inum, 'rfrac_cav_tbl', rfrac_tbl_cav ) ! now k-velocity 1007 CALL iom_rstput( 0, 0, inum, 'misfkb_cav', REAL(misfkb_cav,wp) ) ! now k-velocity 1008 CALL iom_rstput( 0, 0, inum, 'misfkt_cav', REAL(misfkt_cav,wp) ) ! now k-velocity 1009 CALL iom_rstput( 0, 0, inum, 'mskisf_cav', REAL(mskisf_cav,wp), ktype = jp_i1 ) 1010 END IF 1011 IF (ln_isfpar_mlt) THEN 1012 CALL iom_rstput( 0, 0, inum, 'isfmsk_par', REAL(mskisf_par,wp) ) ! now k-velocity 1013 CALL iom_rstput( 0, 0, inum, 'fwfisf_par', fwfisf_par ) ! now k-velocity 1014 CALL iom_rstput( 0, 0, inum, 'rhisf_par_tbl', rhisf_tbl_par ) ! now k-velocity 1015 CALL iom_rstput( 0, 0, inum, 'rfrac_par_tbl', rfrac_tbl_par ) ! now k-velocity 1016 CALL iom_rstput( 0, 0, inum, 'misfkb_par', REAL(misfkb_par,wp) ) ! now k-velocity 1017 CALL iom_rstput( 0, 0, inum, 'misfkt_par', REAL(misfkt_par,wp) ) ! now k-velocity 1018 CALL iom_rstput( 0, 0, inum, 'mskisf_par', REAL(mskisf_par,wp), ktype = jp_i1 ) 1019 END IF 1020 END IF 1021 ! 996 1022 IF( ALLOCATED(ahtu) ) THEN 997 1023 CALL iom_rstput( 0, 0, inum, 'ahtu', ahtu ) ! aht at u-point … … 1017 1043 CALL iom_rstput( 0, 0, inum, 'sdvecrtz', wsd ) ! now StokesDrift k-velocity 1018 1044 ENDIF 1019 1045 IF ( ln_abl ) THEN 1046 CALL iom_rstput ( 0, 0, inum, "uz1_abl", u_abl(:,:,2,nt_a ) ) ! now first level i-wind 1047 CALL iom_rstput ( 0, 0, inum, "vz1_abl", v_abl(:,:,2,nt_a ) ) ! now first level j-wind 1048 CALL iom_rstput ( 0, 0, inum, "tz1_abl", tq_abl(:,:,2,nt_a,1) ) ! now first level temperature 1049 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 1050 ENDIF 1051 ! 1052 CALL iom_close( inum ) 1053 ! 1020 1054 #if defined key_si3 1021 1055 IF( nn_ice == 2 ) THEN ! condition needed in case agrif + ice-model but no-ice in child grid 1056 CALL iom_open( TRIM(cdfile_name)//'_ice', inum, ldwrt = .TRUE., kdlev = jpl, cdcomp = 'ICE' ) 1022 1057 CALL ice_wri_state( inum ) 1058 CALL iom_close( inum ) 1023 1059 ENDIF 1024 1060 #endif 1025 ! 1026 CALL iom_close( inum ) 1027 ! 1061 1028 1062 END SUBROUTINE dia_wri_state 1029 1063 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/domvvl.F90
r12495 r13189 37 37 38 38 PUBLIC dom_vvl_init ! called by domain.F90 39 PUBLIC dom_vvl_zgr ! called by isfcpl.F90 39 40 PUBLIC dom_vvl_sf_nxt ! called by step.F90 40 41 PUBLIC dom_vvl_sf_update ! called by step.F90 … … 62 63 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 63 64 65 !! * Substitutions 66 # include "do_loop_substitute.h90" 64 67 !!---------------------------------------------------------------------- 65 68 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 116 119 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 117 120 ! 121 IF(lwp) WRITE(numout,*) 122 IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated' 123 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 124 ! 125 CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 126 ! 127 ! ! Allocate module arrays 128 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' ) 129 ! 130 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 131 CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' ) 132 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 133 ! 134 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 135 ! 136 END SUBROUTINE dom_vvl_init 137 ! 138 SUBROUTINE dom_vvl_zgr(Kbb, Kmm, Kaa) 139 !!---------------------------------------------------------------------- 140 !! *** ROUTINE dom_vvl_init *** 141 !! 142 !! ** Purpose : Interpolation of all scale factors, 143 !! depths and water column heights 144 !! 145 !! ** Method : - interpolate scale factors 146 !! 147 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 148 !! - Regrid: e3(u/v)_n 149 !! e3(u/v)_b 150 !! e3w_n 151 !! e3(u/v)w_b 152 !! e3(u/v)w_n 153 !! gdept_n, gdepw_n and gde3w_n 154 !! - h(t/u/v)_0 155 !! - frq_rst_e3t and frq_rst_hdv 156 !! 157 !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling. 158 !!---------------------------------------------------------------------- 159 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 160 !!---------------------------------------------------------------------- 118 161 INTEGER :: ji, jj, jk 119 162 INTEGER :: ii0, ii1, ij0, ij1 120 163 REAL(wp):: zcoef 121 164 !!---------------------------------------------------------------------- 122 !123 IF(lwp) WRITE(numout,*)124 IF(lwp) WRITE(numout,*) 'dom_vvl_init : Variable volume activated'125 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'126 !127 CALL dom_vvl_ctl ! choose vertical coordinate (z_star, z_tilde or layer)128 !129 ! ! Allocate module arrays130 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_init : unable to allocate arrays' )131 !132 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf133 CALL dom_vvl_rst( nit000, Kbb, Kmm, 'READ' )134 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all135 165 ! 136 166 ! !== Set of all other vertical scale factors ==! (now and before) … … 160 190 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 161 191 gdepw(:,:,1,Kbb) = 0.0_wp 162 DO jk = 2, jpk ! vertical sum 163 DO jj = 1,jpj 164 DO ji = 1,jpi 165 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 166 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 167 ! ! 0.5 where jk = mikt 192 DO_3D_11_11( 2, jpk ) 193 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 194 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 195 ! ! 0.5 where jk = mikt 168 196 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 169 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 170 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 171 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 172 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 173 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 174 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 175 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 176 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 177 END DO 178 END DO 179 END DO 197 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 198 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 199 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 200 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 201 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 202 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 203 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 204 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 205 END_3D 180 206 ! 181 207 ! !== thickness of the water column !! (ocean portion only) … … 212 238 ENDIF 213 239 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 214 DO jj = 1, jpj 215 DO ji = 1, jpi 240 DO_2D_11_11 216 241 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 217 IF( ABS(gphit(ji,jj)) >= 6.) THEN 218 ! values outside the equatorial band and transition zone (ztilde) 219 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 220 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 221 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 222 ! values inside the equatorial band (ztilde as zstar) 223 frq_rst_e3t(ji,jj) = 0.0_wp 224 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 225 ELSE ! transition band (2.5 to 6 degrees N/S) 226 ! ! (linearly transition from z-tilde to z-star) 227 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 228 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 229 & * 180._wp / 3.5_wp ) ) 230 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 231 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 232 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 233 & * 180._wp / 3.5_wp ) ) 234 ENDIF 235 END DO 236 END DO 242 IF( ABS(gphit(ji,jj)) >= 6.) THEN 243 ! values outside the equatorial band and transition zone (ztilde) 244 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 245 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 246 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 247 ! values inside the equatorial band (ztilde as zstar) 248 frq_rst_e3t(ji,jj) = 0.0_wp 249 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 250 ELSE ! transition band (2.5 to 6 degrees N/S) 251 ! ! (linearly transition from z-tilde to z-star) 252 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 253 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 254 & * 180._wp / 3.5_wp ) ) 255 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 256 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 257 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 258 & * 180._wp / 3.5_wp ) ) 259 ENDIF 260 END_2D 237 261 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 238 262 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 … … 264 288 ENDIF 265 289 ! 266 END SUBROUTINE dom_vvl_ init290 END SUBROUTINE dom_vvl_zgr 267 291 268 292 … … 329 353 END DO 330 354 ! 331 IF( ln_vvl_ztilde .OR. ln_vvl_layer.AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate !332 ! ! ------baroclinic part------ !355 IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! 356 ! ! ------baroclinic part------ ! 333 357 ! I - initialization 334 358 ! ================== … … 383 407 zwu(:,:) = 0._wp 384 408 zwv(:,:) = 0._wp 385 DO jk = 1, jpkm1 ! a - first derivative: diffusive fluxes 386 DO jj = 1, jpjm1 387 DO ji = 1, fs_jpim1 ! vector opt. 388 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 389 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 390 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 391 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 392 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 393 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 394 END DO 395 END DO 396 END DO 397 DO jj = 1, jpj ! b - correction for last oceanic u-v points 398 DO ji = 1, jpi 399 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 400 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 401 END DO 402 END DO 403 DO jk = 1, jpkm1 ! c - second derivative: divergence of diffusive fluxes 404 DO jj = 2, jpjm1 405 DO ji = fs_2, fs_jpim1 ! vector opt. 406 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 407 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 408 & ) * r1_e1e2t(ji,jj) 409 END DO 410 END DO 411 END DO 409 DO_3D_10_10( 1, jpkm1 ) 410 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 411 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 412 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 413 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 414 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 415 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 416 END_3D 417 DO_2D_11_11 418 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 419 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 420 END_2D 421 DO_3D_00_00( 1, jpkm1 ) 422 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 423 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 424 & ) * r1_e1e2t(ji,jj) 425 END_3D 412 426 ! ! d - thickness diffusion transport: boundary conditions 413 427 ! (stored for tracer advction and continuity equation) … … 416 430 ! 4 - Time stepping of baroclinic scale factors 417 431 ! --------------------------------------------- 418 ! Leapfrog time stepping419 ! ~~~~~~~~~~~~~~~~~~~~~~420 432 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 421 433 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) … … 613 625 tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 614 626 ENDIF 615 gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm)616 gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm)617 618 e3t(:,:,:,Kmm) = e3t(:,:,:,Kaa)619 e3u(:,:,:,Kmm) = e3u(:,:,:,Kaa)620 e3v(:,:,:,Kmm) = e3v(:,:,:,Kaa)621 627 622 628 ! Compute all missing vertical scale factor and depths … … 641 647 gdepw(:,:,1,Kmm) = 0.0_wp 642 648 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 643 DO jk = 2, jpk 644 DO jj = 1,jpj 645 DO ji = 1,jpi 646 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 647 ! 1 for jk = mikt 648 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 649 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 650 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 651 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 652 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 653 END DO 654 END DO 655 END DO 649 DO_3D_11_11( 2, jpk ) 650 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 651 ! 1 for jk = mikt 652 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 653 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 654 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 655 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 656 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 657 END_3D 656 658 657 659 ! Local depth and Inverse of the local depth of the water … … 700 702 ! 701 703 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 702 DO jk = 1, jpk 703 DO jj = 1, jpjm1 704 DO ji = 1, fs_jpim1 ! vector opt. 705 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 706 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 707 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 708 END DO 709 END DO 710 END DO 704 DO_3D_10_10( 1, jpk ) 705 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 706 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 707 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 708 END_3D 711 709 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 712 710 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 713 711 ! 714 712 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 715 DO jk = 1, jpk 716 DO jj = 1, jpjm1 717 DO ji = 1, fs_jpim1 ! vector opt. 718 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 719 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 720 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 721 END DO 722 END DO 723 END DO 713 DO_3D_10_10( 1, jpk ) 714 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 715 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 716 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 717 END_3D 724 718 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 725 719 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 726 720 ! 727 721 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 728 DO jk = 1, jpk 729 DO jj = 1, jpjm1 730 DO ji = 1, fs_jpim1 ! vector opt. 731 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 732 & * r1_e1e2f(ji,jj) & 733 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 734 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 735 END DO 736 END DO 737 END DO 722 DO_3D_10_10( 1, jpk ) 723 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 724 & * r1_e1e2f(ji,jj) & 725 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 726 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 727 END_3D 738 728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 739 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) … … 810 800 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 811 801 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 802 ! 812 803 ! ! --------- ! 813 804 ! ! all cases ! 814 805 ! ! --------- ! 806 ! 815 807 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 816 808 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) … … 828 820 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 829 821 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 830 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'822 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 831 823 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 832 824 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) … … 835 827 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 836 828 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 837 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'829 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 838 830 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 839 831 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) … … 842 834 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 843 835 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 844 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'836 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 845 837 DO jk = 1, jpk 846 838 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & … … 895 887 ssh(:,:,Kbb) = -ssh_ref 896 888 897 DO jj = 1, jpj 898 DO ji = 1, jpi 899 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 900 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 901 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 902 ENDIF 903 ENDDO 904 ENDDO 889 DO_2D_11_11 890 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 891 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 892 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 893 ENDIF 894 END_2D 905 895 ENDIF !If test case else 906 896 … … 913 903 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 914 904 915 DO ji = 1, jpi 916 DO jj = 1, jpj 917 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 918 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 919 ENDIF 920 END DO 921 END DO 905 DO_2D_11_11 906 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 907 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 908 ENDIF 909 END_2D 922 910 ! 923 911 ELSE 924 912 ! 925 ! usr_def_istate called here only to get sshb, that is needed to initialize e3t(Kbb) and e3t(Kmm) 926 CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 927 ! usr_def_istate will be called again in istate_init to initialize ts(bn), ssh(bn), u(bn) and v(bn) 913 ! usr_def_istate called here only to get ssh(Kbb) needed to initialize e3t(Kbb) and e3t(Kmm) 914 ! 915 CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 916 ! 917 ! usr_def_istate will be called again in istate_init to initialize ts, ssh, u and v 928 918 ! 929 919 DO jk=1,jpk 930 e3t(:,:,jk,K mm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) &931 & 932 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t_b!= 0 on land points920 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 921 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 922 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) ! make sure e3t(:,:,:,Kbb) != 0 on land points 933 923 END DO 934 924 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 935 ssh(:,: ,Kmm) = ssh(:,: ,Kbb)! needed later for gde3w925 ssh(:,:,Kmm) = ssh(:,:,Kbb) ! needed later for gde3w 936 926 ! 937 927 END IF ! end of ll_wd edits … … 1025 1015 ! 1026 1016 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE vertical coordinate in namelist nam_vvl' ) 1027 IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )1028 1017 ! 1029 1018 IF(lwp) THEN ! Print the choice -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/stpctl.F90
r12377 r13189 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE c1d ! 1D vertical configuration 21 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 22 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 23 ! 21 24 USE diawri ! Standard run outputs (dia_wri_state routine) 22 !23 25 USE in_out_manager ! I/O manager 24 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 27 USE lib_mpp ! distributed memory computing 26 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 27 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 28 28 ! 29 29 USE netcdf ! NetCDF library 30 30 IMPLICIT NONE … … 33 33 PUBLIC stp_ctl ! routine called by step.F90 34 34 35 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, idt1, idt2, idc1, idw1, istatus36 LOGICAL :: lsomeoce35 INTEGER :: nrunid ! netcdf file id 36 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 37 37 !!---------------------------------------------------------------------- 38 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 42 42 CONTAINS 43 43 44 SUBROUTINE stp_ctl( kt, K bb, Kmm, kindic)44 SUBROUTINE stp_ctl( kt, Kmm ) 45 45 !!---------------------------------------------------------------------- 46 46 !! *** ROUTINE stp_ctl *** … … 50 50 !! ** Method : - Save the time step in numstp 51 51 !! - Print it each 50 time steps 52 !! - Stop the run IF problem encountered by setting indic=-352 !! - Stop the run IF problem encountered by setting nstop > 0 53 53 !! Problems checked: |ssh| maximum larger than 10 m 54 54 !! |U| maximum larger than 10 m/s … … 57 57 !! ** Actions : "time.step" file = last ocean time-step 58 58 !! "run.stat" file = run statistics 59 !! nstop indicator sheared among all local domain (lk_mpp=T)59 !! nstop indicator sheared among all local domain 60 60 !!---------------------------------------------------------------------- 61 61 INTEGER, INTENT(in ) :: kt ! ocean time-step index 62 INTEGER, INTENT(in ) :: Kbb, Kmm ! ocean time level index 63 INTEGER, INTENT(inout) :: kindic ! error indicator 64 !! 65 INTEGER :: ji, jj, jk ! dummy loop indices 66 INTEGER, DIMENSION(2) :: ih ! min/max loc indices 67 INTEGER, DIMENSION(3) :: iu, is1, is2 ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 71 CHARACTER(len=20) :: clname 72 !!---------------------------------------------------------------------- 73 ! 74 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 75 ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 76 ll_wrtruns = ll_colruns .AND. lwm 77 IF( kt == nit000 .AND. lwp ) THEN 78 WRITE(numout,*) 79 WRITE(numout,*) 'stp_ctl : time-stepping control' 80 WRITE(numout,*) '~~~~~~~' 81 ! ! open time.step file 82 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 83 ! ! open run.stat file(s) at start whatever 84 ! ! the value of sn_cfctl%ptimincr 85 IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 62 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 63 !! 64 INTEGER :: ji ! dummy loop indices 65 INTEGER :: idtime, istatus 66 INTEGER , DIMENSION(9) :: iareasum, iareamin, iareamax 67 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 68 REAL(wp) :: zzz ! local real 69 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 71 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 72 CHARACTER(len=20) :: clname 73 !!---------------------------------------------------------------------- 74 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 75 ! 76 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 77 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 78 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 79 ! 80 IF( kt == nit000 ) THEN 81 ! 82 IF( lwp ) THEN 83 WRITE(numout,*) 84 WRITE(numout,*) 'stp_ctl : time-stepping control' 85 WRITE(numout,*) '~~~~~~~' 86 ENDIF 87 ! ! open time.step ascii file, done only by 1st subdomain 88 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 89 ! 90 IF( ll_wrtruns ) THEN 91 ! ! open run.stat ascii file, done only by 1st subdomain 86 92 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 93 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 87 94 clname = 'run.stat.nc' 88 95 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 89 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun)90 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime )91 istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh)92 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu)93 istatus = NF90_DEF_VAR( idrun, 's_min', NF90_DOUBLE, (/ idtime /), ids1)94 istatus = NF90_DEF_VAR( idrun, 's_max', NF90_DOUBLE, (/ idtime /), ids2)95 istatus = NF90_DEF_VAR( idrun, 't_min', NF90_DOUBLE, (/ idtime /), idt1)96 istatus = NF90_DEF_VAR( idrun, 't_max', NF90_DOUBLE, (/ idtime /), idt2)96 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 97 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 98 istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 99 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 100 istatus = NF90_DEF_VAR( nrunid, 's_min', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 101 istatus = NF90_DEF_VAR( nrunid, 's_max', NF90_DOUBLE, (/ idtime /), nvarid(4) ) 102 istatus = NF90_DEF_VAR( nrunid, 't_min', NF90_DOUBLE, (/ idtime /), nvarid(5) ) 103 istatus = NF90_DEF_VAR( nrunid, 't_max', NF90_DOUBLE, (/ idtime /), nvarid(6) ) 97 104 IF( ln_zad_Aimp ) THEN 98 istatus = NF90_DEF_VAR( idrun, 'abs_wi_max', NF90_DOUBLE, (/ idtime /), idw1)99 istatus = NF90_DEF_VAR( idrun, 'Cu_max', NF90_DOUBLE, (/ idtime /), idc1)105 istatus = NF90_DEF_VAR( nrunid, 'Cf_max', NF90_DOUBLE, (/ idtime /), nvarid(7) ) 106 istatus = NF90_DEF_VAR( nrunid,'abs_wi_max',NF90_DOUBLE, (/ idtime /), nvarid(8) ) 100 107 ENDIF 101 istatus = NF90_ENDDEF(idrun) 102 zmax(8:9) = 0._wp ! initialise to zero in case ln_zad_Aimp option is not in use 103 ENDIF 104 ENDIF 105 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 106 ! 107 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 108 istatus = NF90_ENDDEF(nrunid) 109 ENDIF 110 ! 111 ENDIF 112 ! 113 ! !== write current time step ==! 114 ! !== done only by 1st subdomain at writting timestep ==! 115 IF( lwm .AND. ll_wrtstp ) THEN 108 116 WRITE ( numstp, '(1x, i8)' ) kt 109 117 REWIND( numstp ) 110 118 ENDIF 111 ! 112 ! !== test of extrema ==! 113 IF( ll_wd ) THEN 114 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref*tmask(:,:,1) ) ) ! ssh max 115 ELSE 116 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ) ) ! ssh max 117 ENDIF 118 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 119 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max 120 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! salinity max 121 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! minus temperature max 122 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm) , mask = tmask(:,:,:) == 1._wp ) ! temperature max 123 zmax(7) = REAL( nstop , wp ) ! stop indicator 124 IF( ln_zad_Aimp ) THEN 125 zmax(8) = MAXVAL( ABS( wi(:,:,:) ) , mask = wmask(:,:,:) == 1._wp ) ! implicit vertical vel. max 126 zmax(9) = MAXVAL( Cu_adv(:,:,:) , mask = tmask(:,:,:) == 1._wp ) ! cell Courant no. max 127 ENDIF 128 ! 119 ! !== test of local extrema ==! 120 ! !== done by all processes at every time step ==! 121 ! 122 ! define zmax default value. needed for land processors 123 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 124 zmax(:) = -HUGE(1._wp) 125 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 126 zmax(:) = 0._wp 127 zmax(3) = -1._wp ! avoid salinity minimum at 0. 128 ENDIF 129 ! 130 llmsk(:,:,1) = ssmask(:,:) == 1._wp 131 IF( COUNT( llmsk(:,:,1) ) > 0 ) THEN ! avoid huge values sent back for land processors... 132 IF( ll_wd ) THEN 133 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) + ssh_ref ), mask = llmsk(:,:,1) ) ! ssh max 134 ELSE 135 zmax(1) = MAXVAL( ABS( ssh(:,:,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max 136 ENDIF 137 ENDIF 138 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) ) ! velocity max (zonal only) 139 llmsk(:,:,:) = tmask(:,:,:) == 1._wp 140 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 141 zmax(3) = MAXVAL( -ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! minus salinity max 142 zmax(4) = MAXVAL( ts(:,:,:,jp_sal,Kmm), mask = llmsk ) ! salinity max 143 IF( ll_colruns .OR. jpnij == 1 ) THEN ! following variables are used only in the netcdf file 144 zmax(5) = MAXVAL( -ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! minus temperature max 145 zmax(6) = MAXVAL( ts(:,:,:,jp_tem,Kmm), mask = llmsk ) ! temperature max 146 IF( ln_zad_Aimp ) THEN 147 zmax(7) = MAXVAL( Cu_adv(:,:,:) , mask = llmsk ) ! partitioning coeff. max 148 llmsk(:,:,:) = wmask(:,:,:) == 1._wp 149 IF( COUNT( llmsk(:,:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 150 zmax(8) = MAXVAL(ABS( wi(:,:,:) ), mask = llmsk ) ! implicit vertical vel. max 151 ENDIF 152 ENDIF 153 ENDIF 154 ENDIF 155 zmax(9) = REAL( nstop, wp ) ! stop indicator 156 ! !== get global extrema ==! 157 ! !== done by all processes if writting run.stat ==! 129 158 IF( ll_colruns ) THEN 159 zmaxlocal(:) = zmax(:) 130 160 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 131 nstop = NINT( zmax(7) ) ! nstop indicator sheared among all local domains 132 ENDIF 133 ! !== run statistics ==! ("run.stat" files) 161 nstop = NINT( zmax(9) ) ! update nstop indicator (now sheared among all local domains) 162 ENDIF 163 ! !== write "run.stat" files ==! 164 ! !== done only by 1st subdomain at writting timestep ==! 134 165 IF( ll_wrtruns ) THEN 135 166 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 136 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) )137 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) )138 istatus = NF90_PUT_VAR( idrun, ids1, (/-zmax(3)/), (/kt/), (/1/) )139 istatus = NF90_PUT_VAR( idrun, ids2, (/ zmax(4)/), (/kt/), (/1/) )140 istatus = NF90_PUT_VAR( idrun, idt1, (/-zmax(5)/), (/kt/), (/1/) )141 istatus = NF90_PUT_VAR( idrun, idt2, (/ zmax(6)/), (/kt/), (/1/) )167 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 168 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 169 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/-zmax(3)/), (/kt/), (/1/) ) 170 istatus = NF90_PUT_VAR( nrunid, nvarid(4), (/ zmax(4)/), (/kt/), (/1/) ) 171 istatus = NF90_PUT_VAR( nrunid, nvarid(5), (/-zmax(5)/), (/kt/), (/1/) ) 172 istatus = NF90_PUT_VAR( nrunid, nvarid(6), (/ zmax(6)/), (/kt/), (/1/) ) 142 173 IF( ln_zad_Aimp ) THEN 143 istatus = NF90_PUT_VAR( idrun, idw1, (/ zmax(8)/), (/kt/), (/1/) ) 144 istatus = NF90_PUT_VAR( idrun, idc1, (/ zmax(9)/), (/kt/), (/1/) ) 145 ENDIF 146 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 147 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 174 istatus = NF90_PUT_VAR( nrunid, nvarid(7), (/ zmax(7)/), (/kt/), (/1/) ) 175 istatus = NF90_PUT_VAR( nrunid, nvarid(8), (/ zmax(8)/), (/kt/), (/1/) ) 176 ENDIF 177 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 148 178 END IF 149 ! !== error handling ==! 150 IF( ( ln_ctl .OR. lsomeoce ) .AND. ( & ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 151 & zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 152 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 153 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 154 !!$ & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 155 !!$ & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 156 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 157 IF( lk_mpp .AND. ln_ctl ) THEN 158 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:,Kmm)) , ssmask(:,:) , zzz, ih ) 159 CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)) , umask (:,:,:), zzz, iu ) 160 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is1 ) 161 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm), tmask (:,:,:), zzz, is2 ) 179 ! !== error handling ==! 180 ! !== done by all processes at every time step ==! 181 ! 182 IF( zmax(1) > 20._wp .OR. & ! too large sea surface height ( > 20 m ) 183 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 184 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 185 !!$ & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 186 !!$ & zmax(4) < 0._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 187 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 188 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 189 ! 190 iloc(:,:) = 0 191 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 192 ! first: close the netcdf file, so we can read it 193 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 194 ! get global loc on the min/max 195 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:, Kmm)), ssmask(:,: ), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 196 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:, Kmm)), umask(:,:,:), zzz, iloc(1:3,2) ) 197 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,3) ) 198 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,4) ) 199 ! find which subdomain has the max. 200 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 201 DO ji = 1, 9 202 IF( zmaxlocal(ji) == zmax(ji) ) THEN 203 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 204 ENDIF 205 END DO 206 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 207 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 208 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 209 ELSE ! find local min and max locations: 210 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 211 iloc(1:2,1) = MAXLOC( ABS( ssh(:,:, Kmm)), mask = ssmask(:,: ) == 1._wp ) + (/ nimpp - 1, njmpp - 1 /) 212 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 213 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 214 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 215 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 216 ENDIF 217 ! 218 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 219 CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 220 CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 221 CALL wrt_line( ctmp4, kt, 'Sal min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 222 CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 223 IF( Agrif_Root() ) THEN 224 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 162 225 ELSE 163 ih(:) = MAXLOC( ABS( ssh(:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1 /) 164 iu(:) = MAXLOC( ABS( uu (:,:,:,Kmm) ) ) + (/ nimpp - 1, njmpp - 1, 0 /) 165 is1(:) = MINLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 166 is2(:) = MAXLOC( ts(:,:,:,jp_sal,Kmm), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 167 ENDIF 168 169 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100 or NaN encounter in the tests' 170 WRITE(ctmp2,9100) kt, zmax(1), ih(1) , ih(2) 171 WRITE(ctmp3,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 172 WRITE(ctmp4,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 173 WRITE(ctmp5,9400) kt, zmax(4), is2(1), is2(2), is2(3) 174 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 175 226 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 227 ENDIF 228 ! 176 229 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 177 178 IF( .NOT. ln_ctl ) THEN179 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea180 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp8, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ctmp6)181 ELSE182 CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6, ' ' )183 ENDIF184 185 kindic = -3186 !187 ENDIF188 !189 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 190 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 191 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 192 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 230 ! 231 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 232 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 233 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 234 ENDIF 235 ELSE ! only mpi subdomains with errors are here -> STOP now 236 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 237 ENDIF 238 ! 239 ENDIF 240 ! 241 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 242 ngrdstop = Agrif_Fixed() ! store which grid got this error 243 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 244 ENDIF 245 ! 193 246 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 194 247 ! 195 248 END SUBROUTINE stp_ctl 249 250 251 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 252 !!---------------------------------------------------------------------- 253 !! *** ROUTINE wrt_line *** 254 !! 255 !! ** Purpose : write information line 256 !! 257 !!---------------------------------------------------------------------- 258 CHARACTER(len=*), INTENT( out) :: cdline 259 CHARACTER(len=*), INTENT(in ) :: cdprefix 260 REAL(wp), INTENT(in ) :: pval 261 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 262 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 263 ! 264 CHARACTER(len=80) :: clsuff 265 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 266 CHARACTER(len=9 ) :: cli, clj, clk 267 CHARACTER(len=1 ) :: clfmt 268 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 269 INTEGER :: ifmtk 270 !!---------------------------------------------------------------------- 271 WRITE(clkt , '(i9)') kt 272 273 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 274 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 275 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 276 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 277 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 278 WRITE(clmax, cl4) kmax-1 279 ! 280 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 281 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 282 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 283 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 284 ! 285 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 286 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 287 ENDIF 288 IF(kloc(3) == 0) THEN 289 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 290 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 291 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 292 ELSE 293 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 294 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 295 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 296 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 297 ENDIF 298 ! 299 9100 FORMAT('MPI rank ', a) 300 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 301 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 302 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 303 ! 304 END SUBROUTINE wrt_line 305 196 306 197 307 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/trazdf.F90
r12495 r13189 35 35 PUBLIC tra_zdf_imp ! called by trczdf.F90 36 36 37 !! * Substitutions 38 # include "do_loop_substitute.h90" 37 39 !!---------------------------------------------------------------------- 38 40 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 77 79 ! JMM avoid negative salinities near river outlet ! Ugly fix 78 80 ! JMM : restore negative salinities to small salinities: 79 !!$ WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp ) pts(:,:,:,jp_sal,Kaa) = 0.1_wp81 !!$ WHERE( pts(:,:,:,jp_sal,Kaa) < 0._wp ) pts(:,:,:,jp_sal,Kaa) = 0.1_wp 80 82 !!gm 81 83 … … 95 97 ENDIF 96 98 ! ! print mean trends (used for debugging) 97 IF( ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf - Ta: ', mask1=tmask, &98 & tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )99 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Kaa), clinfo1=' zdf - Ta: ', mask1=tmask, & 100 & tab3d_2=pts(:,:,:,jp_sal,Kaa), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 99 101 ! 100 102 IF( ln_timing ) CALL timing_stop('tra_zdf') … … 154 156 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 155 157 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 156 DO jk = 2, jpkm1 157 DO jj = 2, jpjm1 158 DO ji = fs_2, fs_jpim1 ! vector opt. 159 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 160 END DO 161 END DO 162 END DO 158 DO_3D_00_00( 2, jpkm1 ) 159 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 160 END_3D 163 161 ELSE ! standard or triad iso-neutral operator 164 DO jk = 2, jpkm1 165 DO jj = 2, jpjm1 166 DO ji = fs_2, fs_jpim1 ! vector opt. 167 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 168 END DO 169 END DO 170 END DO 162 DO_3D_00_00( 2, jpkm1 ) 163 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 164 END_3D 171 165 ENDIF 172 166 ENDIF … … 174 168 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 175 169 IF( ln_zad_Aimp ) THEN ! Adaptive implicit vertical advection 176 DO jk = 1, jpkm1 177 DO jj = 2, jpjm1 178 DO ji = fs_2, fs_jpim1 ! vector opt. (ensure same order of calculation as below if wi=0.) 179 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm) 180 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 181 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws & 182 & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 183 zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) 184 zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) 185 END DO 186 END DO 187 END DO 170 DO_3D_00_00( 1, jpkm1 ) 171 zzwi = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk ,Kmm) 172 zzws = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 173 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zzwi - zzws & 174 & + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) 175 zwi(ji,jj,jk) = zzwi + p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) 176 zws(ji,jj,jk) = zzws - p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) 177 END_3D 188 178 ELSE 189 DO jk = 1, jpkm1 190 DO jj = 2, jpjm1 191 DO ji = fs_2, fs_jpim1 ! vector opt. 192 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm) 193 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 194 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 195 END DO 196 END DO 197 END DO 179 DO_3D_00_00( 1, jpkm1 ) 180 zwi(ji,jj,jk) = - p2dt * zwt(ji,jj,jk ) / e3w(ji,jj,jk,Kmm) 181 zws(ji,jj,jk) = - p2dt * zwt(ji,jj,jk+1) / e3w(ji,jj,jk+1,Kmm) 182 zwd(ji,jj,jk) = e3t(ji,jj,jk,Kaa) - zwi(ji,jj,jk) - zws(ji,jj,jk) 183 END_3D 198 184 ENDIF 199 185 ! … … 217 203 ! used as a work space array: its value is modified. 218 204 ! 219 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 220 DO ji = fs_2, fs_jpim1 ! done one for all passive tracers (so included in the IF instruction) 221 zwt(ji,jj,1) = zwd(ji,jj,1) 222 END DO 223 END DO 224 DO jk = 2, jpkm1 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 227 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 228 END DO 229 END DO 230 END DO 205 DO_2D_00_00 206 zwt(ji,jj,1) = zwd(ji,jj,1) 207 END_2D 208 DO_3D_00_00( 2, jpkm1 ) 209 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 210 END_3D 231 211 ! 232 212 ENDIF 233 213 ! 234 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 235 DO ji = fs_2, fs_jpim1 236 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 237 END DO 238 END DO 239 DO jk = 2, jpkm1 240 DO jj = 2, jpjm1 241 DO ji = fs_2, fs_jpim1 242 zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side 243 pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 244 END DO 245 END DO 246 END DO 214 DO_2D_00_00 215 pt(ji,jj,1,jn,Kaa) = e3t(ji,jj,1,Kbb) * pt(ji,jj,1,jn,Kbb) + p2dt * e3t(ji,jj,1,Kmm) * pt(ji,jj,1,jn,Krhs) 216 END_2D 217 DO_3D_00_00( 2, jpkm1 ) 218 zrhs = e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk,jn,Krhs) ! zrhs=right hand side 219 pt(ji,jj,jk,jn,Kaa) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pt(ji,jj,jk-1,jn,Kaa) 220 END_3D 247 221 ! 248 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 249 DO ji = fs_2, fs_jpim1 250 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 251 END DO 252 END DO 253 DO jk = jpk-2, 1, -1 254 DO jj = 2, jpjm1 255 DO ji = fs_2, fs_jpim1 256 pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) & 257 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 258 END DO 259 END DO 260 END DO 222 DO_2D_00_00 223 pt(ji,jj,jpkm1,jn,Kaa) = pt(ji,jj,jpkm1,jn,Kaa) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 224 END_2D 225 DO_3DS_00_00( jpk-2, 1, -1 ) 226 pt(ji,jj,jk,jn,Kaa) = ( pt(ji,jj,jk,jn,Kaa) - zws(ji,jj,jk) * pt(ji,jj,jk+1,jn,Kaa) ) & 227 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 228 END_3D 261 229 ! ! ================= ! 262 230 END DO ! end tracer loop ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/usrdef_hgr.F90
r10074 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 88 90 #endif 89 91 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * zti 96 plamu(ji,jj) = zlam0 + rn_dx * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 92 DO_2D_11_11 93 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 94 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 95 96 plamt(ji,jj) = zlam0 + rn_dx * zti 97 plamu(ji,jj) = zlam0 + rn_dx * zui 98 plamv(ji,jj) = plamt(ji,jj) 99 plamf(ji,jj) = plamu(ji,jj) 100 101 pphit(ji,jj) = zphi0 + rn_dy * ztj 102 pphiv(ji,jj) = zphi0 + rn_dy * zvj 103 pphiu(ji,jj) = pphit(ji,jj) 104 pphif(ji,jj) = pphiv(ji,jj) 105 END_2D 106 106 ! 107 107 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/usrdef_istate.F90
r12495 r13189 28 28 PUBLIC usr_def_istate ! called by istate.F90 29 29 30 !! * Substitutions 31 # include "do_loop_substitute.h90" 30 32 !!---------------------------------------------------------------------- 31 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 164 166 pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1) 165 167 DO jl=1, jpnj 166 DO jj=nldj, nlej 167 DO ji=nldi, nlei 168 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 169 END DO 170 END DO 168 DO_2D_00_00 169 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj) 170 END_2D 171 171 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. ) 172 172 END DO … … 183 183 CASE(4) ! geostrophic zonal pulse 184 184 185 DO jj=1, jpj 186 DO ji=1, jpi 187 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 188 zdu = rn_uzonal 189 ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 190 zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 191 ELSE 192 zdu = 0. 193 END IF 194 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 195 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 196 pu(ji,jj,:) = zdu 197 pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 198 ELSE 199 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 200 pu(ji,jj,:) = 0. 201 pts(ji,jj,:,jp_sal) = 1. 202 END IF 203 END DO 204 END DO 185 DO_2D_11_11 186 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 187 zdu = rn_uzonal 188 ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 189 zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 190 ELSE 191 zdu = 0. 192 END IF 193 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 194 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 195 pu(ji,jj,:) = zdu 196 pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 197 ELSE 198 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 199 pu(ji,jj,:) = 0. 200 pts(ji,jj,:,jp_sal) = 1. 201 END IF 202 END_2D 205 203 206 204 ! temperature: 207 205 pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) 208 206 pv(:,:,:) = 0. 209 210 207 211 208 CASE(5) ! vortex … … 220 217 zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 221 218 ! 222 DO jj=1, jpj 223 DO ji=1, jpi 224 zx = glamt(ji,jj) * 1.e3 225 zy = gphit(ji,jj) * 1.e3 226 ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 227 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 228 ! Sea level: 229 pssh(ji,jj) = 0. 230 DO jl=1,5 231 zdt = pssh(ji,jj) 232 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z) 233 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 234 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g) 235 END DO 236 ! temperature: 237 DO jk=1,jpk 238 zdt = pdept(ji,jj,jk) 239 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 240 IF (zdt < zH) THEN 241 zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH)) ! F'(z) 242 zrho1 = zrho1 - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 243 ENDIF 244 ! pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 245 pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 246 END DO 247 END DO 248 END DO 219 DO_2D_11_11 220 zx = glamt(ji,jj) * 1.e3 221 zy = gphit(ji,jj) * 1.e3 222 ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 223 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 224 ! Sea level: 225 pssh(ji,jj) = 0. 226 DO jl=1,5 227 zdt = pssh(ji,jj) 228 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z) 229 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 230 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g) 231 END DO 232 ! temperature: 233 DO jk=1,jpk 234 zdt = pdept(ji,jj,jk) 235 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 236 IF (zdt < zH) THEN 237 zdzF = (1._wp-EXP(zdt-zH)) / (zH-1._wp + EXP(-zH)) ! F'(z) 238 zrho1 = zrho1 - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 239 ENDIF 240 ! pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 241 pts(ji,jj,jk,jp_tem) = (10._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 242 END DO 243 END_2D 249 244 ! 250 245 ! salinity: … … 253 248 ! velocities: 254 249 za = 2._wp * zP0 / zlambda**2 255 DO jj=1, jpj 256 DO ji=1, jpim1 257 zx = glamu(ji,jj) * 1.e3 258 zy = gphiu(ji,jj) * 1.e3 259 DO jk=1, jpk 260 zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk)) 261 IF (zdu < zH) THEN 262 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 263 zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal 264 pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 265 ELSE 266 pu(ji,jj,jk) = 0._wp 267 ENDIF 268 END DO 269 END DO 270 END DO 271 ! 272 DO jj=1, jpjm1 273 DO ji=1, jpi 274 zx = glamv(ji,jj) * 1.e3 275 zy = gphiv(ji,jj) * 1.e3 276 DO jk=1, jpk 277 zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk)) 278 IF (zdv < zH) THEN 279 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 280 zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2) 281 pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 282 ELSE 283 pv(ji,jj,jk) = 0._wp 284 ENDIF 285 END DO 286 END DO 287 END DO 250 DO_2D_00_00 251 zx = glamu(ji,jj) * 1.e3 252 zy = gphiu(ji,jj) * 1.e3 253 DO jk=1, jpk 254 zdu = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji+1,jj,jk)) 255 IF (zdu < zH) THEN 256 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 257 zdyPs = - za * zy * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal 258 pu(ji,jj,jk) = - zf / ( rho0 * ff_t(ji,jj) ) * zdyPs * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 259 ELSE 260 pu(ji,jj,jk) = 0._wp 261 ENDIF 262 END DO 263 END_2D 264 ! 265 DO_2D_00_00 266 zx = glamv(ji,jj) * 1.e3 267 zy = gphiv(ji,jj) * 1.e3 268 DO jk=1, jpk 269 zdv = 0.5_wp * (pdept(ji,jj,jk) + pdept(ji,jj+1,jk)) 270 IF (zdv < zH) THEN 271 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 272 zdxPs = - za * zx * EXP(-(zx**2+zy**2)*zr_lambda2) 273 pv(ji,jj,jk) = zf / ( rho0 * ff_f(ji,jj) ) * zdxPs * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 274 ELSE 275 pv(ji,jj,jk) = 0._wp 276 ENDIF 277 END DO 278 END_2D 288 279 ! 289 280 END SELECT 290 281 291 282 IF (ln_sshnoise) THEN 292 283 CALL RANDOM_NUMBER(zrandom) … … 294 285 END IF 295 286 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. ) 296 CALL lbc_lnk( 'usrdef_istate', pts, 'T', 1. ) 297 CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 298 CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 287 CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1. ) 288 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 299 289 300 290 END SUBROUTINE usr_def_istate -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/usrdef_sbc.F90
r12377 r13189 38 38 CONTAINS 39 39 40 SUBROUTINE usrdef_sbc_oce( kt, K mm, Kbb )40 SUBROUTINE usrdef_sbc_oce( kt, Kbb ) 41 41 !!--------------------------------------------------------------------- 42 42 !! *** ROUTINE usr_def_sbc *** … … 53 53 !!---------------------------------------------------------------------- 54 54 INTEGER, INTENT(in) :: kt ! ocean time step 55 INTEGER, INTENT(in) :: Kbb , Kmm! ocean time index55 INTEGER, INTENT(in) :: Kbb ! ocean time index 56 56 INTEGER :: ji, jj ! dummy loop indices 57 57 REAL(wp) :: zrhoair = 1.22 ! approximate air density [Kg/m3] … … 86 86 87 87 WHERE( ABS(gphit) <= rn_windszy/2. ) 88 zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,K mm)88 zwndrel(:,:) = rn_u10 - rn_uofac * uu(:,:,1,Kbb) 89 89 ELSEWHERE 90 zwndrel(:,:) = - rn_uofac * uu(:,:,1,K mm)90 zwndrel(:,:) = - rn_uofac * uu(:,:,1,Kbb) 91 91 END WHERE 92 92 utau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:) 93 93 94 zwndrel(:,:) = - rn_uofac * vv(:,:,1,K mm)94 zwndrel(:,:) = - rn_uofac * vv(:,:,1,Kbb) 95 95 vtau(:,:) = zrhocd * zwndrel(:,:) * zwndrel(:,:) 96 96 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/CANAL/MY_SRC/usrdef_zgr.F90
r12377 r13189 204 204 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 205 205 ! 206 k_bot(:,:) = INT( z2d(:,:) )! =jpkm1 over the ocean point, =0 elsewhere206 k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 207 207 ! 208 208 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90
r10513 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 76 78 zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 77 79 78 DO jj = 1, jpj 79 DO ji = 1, jpi 80 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 81 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 82 83 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 84 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 85 plamv(ji,jj) = plamt(ji,jj) 86 plamf(ji,jj) = plamu(ji,jj) 87 88 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 89 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 90 pphiu(ji,jj) = pphit(ji,jj) 91 pphif(ji,jj) = pphiv(ji,jj) 92 END DO 93 END DO 80 DO_2D_11_11 81 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 82 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 83 84 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 85 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 86 plamv(ji,jj) = plamt(ji,jj) 87 plamf(ji,jj) = plamu(ji,jj) 88 89 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 90 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 91 pphiu(ji,jj) = pphit(ji,jj) 92 pphif(ji,jj) = pphiv(ji,jj) 93 END_2D 94 94 95 95 ! constant scale factors -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90
r10515 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 88 90 #endif 89 91 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 96 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 92 DO_2D_11_11 93 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 94 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 95 96 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 97 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 98 plamv(ji,jj) = plamt(ji,jj) 99 plamf(ji,jj) = plamu(ji,jj) 100 101 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 102 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 103 pphiu(ji,jj) = pphit(ji,jj) 104 pphif(ji,jj) = pphiv(ji,jj) 105 END_2D 106 106 107 107 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ICE_ADV2D/MY_SRC/usrdef_nam.F90
r12377 r13189 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp , njmpp ! i- & j-indices of the local domain16 USE dom_oce , ONLY: nimpp , njmpp, Agrif_Root ! i- & j-indices of the local domain 17 17 USE par_oce ! ocean space and time domain 18 18 USE phycst ! physical constants -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90
r10516 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 88 90 #endif 89 91 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 96 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 92 DO_2D_11_11 93 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 94 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 95 96 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 97 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 98 plamv(ji,jj) = plamt(ji,jj) 99 plamf(ji,jj) = plamu(ji,jj) 100 101 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 102 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 103 pphiu(ji,jj) = pphit(ji,jj) 104 pphif(ji,jj) = pphiv(ji,jj) 105 END_2D 106 106 107 107 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90
r12377 r13189 89 89 kpj = nbcellsy + 2 + 2*nbghostcells 90 90 ENDIF 91 kpk = 191 kpk = 2 92 92 ! 93 93 !! zlx = (kpi-2)*rn_dx*1.e-3 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ICE_AGRIF/MY_SRC/usrdef_zgr.F90
r12377 r13189 89 89 ! !== z-coordinate ==! (step-like topography) 90 90 ! !* bottom ocean compute from the depth of grid-points 91 jpkm1 = jpk 91 jpkm1 = jpk-1 92 92 k_bot(:,:) = 1 ! here use k_top as a land mask 93 93 ! !* horizontally uniform coordinate (reference z-co everywhere) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/EXPREF/file_def_nemo-oce.xml
r11889 r13189 21 21 <file_group id="5d" output_freq="5d" output_level="10" enabled=".TRUE."> <!-- 5d files --> 22 22 23 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 24 <file id="file1" output_freq="1mo" name_suffix="_grid_T" description="ocean T grid variables" > 25 <field field_ref="toce" name="votemper" /> 26 <field field_ref="soce" name="vosaline" /> 27 <field field_ref="ssh" name="sossheig" /> 23 <file id="file1" output_freq="5d" name_suffix="_grid_T" description="ocean T grid variables" > 24 <field field_ref="toce" name="votemper" operation="average" freq_op="5d" > @toce_e3t / @e3t </field> 25 <field field_ref="soce" name="vosaline" operation="average" freq_op="5d" > @soce_e3t / @e3t </field> 26 <field field_ref="ssh" name="sossheig" /> 28 27 <!-- variable for ice shelf --> 29 <field field_ref="fwfisf_cav" 30 <field field_ref="isfgammat" 31 <field field_ref="isfgammas" 28 <field field_ref="fwfisf_cav" name="sowflisf" /> 29 <field field_ref="isfgammat" name="sogammat" /> 30 <field field_ref="isfgammas" name="sogammas" /> 32 31 <field field_ref="ttbl_cav" name="ttbl" /> 33 <field field_ref="stbl" name="stbl" />34 <field field_ref="utbl" name="utbl" />35 <field field_ref="vtbl" name="vtbl" />32 <field field_ref="stbl" name="stbl" /> 33 <field field_ref="utbl" name="utbl" /> 34 <field field_ref="vtbl" name="vtbl" /> 36 35 </file> 37 <file id="file2" output_freq=" 1mo" name_suffix="_grid_U" description="ocean U grid variables" >38 <field field_ref="uoce" name="vozocrtx" />36 <file id="file2" output_freq="5d" name_suffix="_grid_U" description="ocean U grid variables" > 37 <field field_ref="uoce" name="vozocrtx" operation="average" freq_op="5d" > @uoce_e3u / @e3u </field> /> 39 38 </file> 40 <file id="file3" output_freq=" 1mo" name_suffix="_grid_V" description="ocean V grid variables" >41 <field field_ref="voce" name="vomecrty" />39 <file id="file3" output_freq="5d" name_suffix="_grid_V" description="ocean V grid variables" > 40 <field field_ref="voce" name="vomecrty" operation="average" freq_op="5d" > @voce_e3v / @e3v </field> /> 42 41 </file> 43 42 </file_group> 43 44 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 44 45 <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 45 46 <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/EXPREF/namelist_cfg
r12495 r13189 114 114 115 115 ln_usr = .true. ! user defined formulation (T => check usrdef_sbc) 116 nn_fwb = 1116 nn_fwb = 4 117 117 / 118 118 !----------------------------------------------------------------------- … … 308 308 &nameos ! ocean Equation Of Seawater (default: NO selection) 309 309 !----------------------------------------------------------------------- 310 ln_teos10 = .false. ! = Use TEOS-10 311 ln_eos80 = .false. ! = Use EOS80 312 ln_leos = .true. ! = Use S-EOS (simplified Eq.) 310 ln_leos = .true. ! = Use L-EOS (linear Eq.) 313 311 ! 314 312 ! ! S-EOS coefficients (ln_seos=T): -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/MY_SRC/dtatsd.F90
r12077 r13189 36 36 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsddmp ! structure of input SST (file informations, fields read) 37 37 38 !! * Substitutions 39 # include "do_loop_substitute.h90" 38 40 !!---------------------------------------------------------------------- 39 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 67 69 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 68 70 ! 69 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :70 71 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 71 72 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in reference namelist' ) 72 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run73 73 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 74 74 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist' ) … … 191 191 ENDIF 192 192 ! 193 DO jj = 1, jpj ! vertical interpolation of T & S 194 DO ji = 1, jpi 195 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 196 zl = gdept_0(ji,jj,jk) 197 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 198 ztp(jk) = ptsd(ji,jj,1 ,jp_tem) 199 zsp(jk) = ptsd(ji,jj,1 ,jp_sal) 200 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 201 ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem) 202 zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal) 203 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 204 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 205 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 206 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 207 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 208 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 209 ENDIF 210 END DO 211 ENDIF 212 END DO 213 DO jk = 1, jpkm1 214 ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 215 ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 216 END DO 217 ptsd(ji,jj,jpk,jp_tem) = 0._wp 218 ptsd(ji,jj,jpk,jp_sal) = 0._wp 193 DO_2D_11_11 194 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 195 zl = gdept_0(ji,jj,jk) 196 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 197 ztp(jk) = ptsd(ji,jj,1 ,jp_tem) 198 zsp(jk) = ptsd(ji,jj,1 ,jp_sal) 199 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 200 ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem) 201 zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal) 202 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 203 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 204 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 205 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 206 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 207 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 208 ENDIF 209 END DO 210 ENDIF 219 211 END DO 220 END DO 212 DO jk = 1, jpkm1 213 ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 214 ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 215 END DO 216 ptsd(ji,jj,jpk,jp_tem) = 0._wp 217 ptsd(ji,jj,jpk,jp_sal) = 0._wp 218 END_2D 221 219 ! 222 220 ELSE !== z- or zps- coordinate ==! … … 226 224 ! 227 225 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 228 DO jj = 1, jpj 229 DO ji = 1, jpi 230 ik = mbkt(ji,jj) 231 IF( ik > 1 ) THEN 232 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 233 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 234 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 235 ENDIF 236 ik = mikt(ji,jj) 237 IF( ik > 1 ) THEN 238 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 239 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 240 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 241 END IF 242 END DO 243 END DO 226 DO_2D_11_11 227 ik = mbkt(ji,jj) 228 IF( ik > 1 ) THEN 229 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 230 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik-1,jp_tem) 231 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik-1,jp_sal) 232 ENDIF 233 ik = mikt(ji,jj) 234 IF( ik > 1 ) THEN 235 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 236 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 237 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) 238 END IF 239 END_2D 244 240 ENDIF 245 241 ! -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/MY_SRC/eosbn2.F90
r12495 r13189 180 180 REAL(wp) :: BPE002 181 181 182 !! * Substitutions 183 # include "do_loop_substitute.h90" 182 184 !!---------------------------------------------------------------------- 183 185 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 241 243 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 242 244 ! 243 DO jk = 1, jpkm1 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 ! 247 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 248 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 249 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 250 ztm = tmask(ji,jj,jk) ! tmask 245 DO_3D_11_11( 1, jpkm1 ) 246 ! 247 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 248 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 249 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 250 ztm = tmask(ji,jj,jk) ! tmask 251 ! 252 zn3 = EOS013*zt & 253 & + EOS103*zs+EOS003 254 ! 255 zn2 = (EOS022*zt & 256 & + EOS112*zs+EOS012)*zt & 257 & + (EOS202*zs+EOS102)*zs+EOS002 258 ! 259 zn1 = (((EOS041*zt & 260 & + EOS131*zs+EOS031)*zt & 261 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 262 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 263 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 264 ! 265 zn0 = (((((EOS060*zt & 266 & + EOS150*zs+EOS050)*zt & 267 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 268 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 269 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 270 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 271 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 272 ! 273 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 274 ! 275 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 276 ! 277 END_3D 278 ! 279 CASE( np_seos ) !== simplified EOS ==! 280 ! 281 DO_3D_11_11( 1, jpkm1 ) 282 zt = pts (ji,jj,jk,jp_tem) - 10._wp 283 zs = pts (ji,jj,jk,jp_sal) - 35._wp 284 zh = pdep (ji,jj,jk) 285 ztm = tmask(ji,jj,jk) 286 ! 287 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 288 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 289 & - rn_nu * zt * zs 290 ! 291 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 292 END_3D 293 ! 294 CASE( np_leos ) !== linear ISOMIP EOS ==! 295 ! 296 DO_3D_11_11( 1, jpkm1 ) 297 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 298 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 299 zh = pdep (ji,jj,jk) 300 ztm = tmask(ji,jj,jk) 301 ! 302 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 303 ! 304 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 305 END_3D 306 ! 307 END SELECT 308 ! 309 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk ) 310 ! 311 IF( ln_timing ) CALL timing_stop('eos-insitu') 312 ! 313 END SUBROUTINE eos_insitu 314 315 316 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 317 !!---------------------------------------------------------------------- 318 !! *** ROUTINE eos_insitu_pot *** 319 !! 320 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 321 !! potential volumic mass (Kg/m3) from potential temperature and 322 !! salinity fields using an equation of state selected in the 323 !! namelist. 324 !! 325 !! ** Action : - prd , the in situ density (no units) 326 !! - prhop, the potential volumic mass (Kg/m3) 327 !! 328 !!---------------------------------------------------------------------- 329 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 330 ! ! 2 : salinity [psu] 331 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 332 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 333 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 334 ! 335 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 336 INTEGER :: jdof 337 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 338 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 339 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 340 !!---------------------------------------------------------------------- 341 ! 342 IF( ln_timing ) CALL timing_start('eos-pot') 343 ! 344 SELECT CASE ( neos ) 345 ! 346 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 347 ! 348 ! Stochastic equation of state 349 IF ( ln_sto_eos ) THEN 350 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 351 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 352 ALLOCATE(zsign(1:2*nn_sto_eos)) 353 DO jsmp = 1, 2*nn_sto_eos, 2 354 zsign(jsmp) = 1._wp 355 zsign(jsmp+1) = -1._wp 356 END DO 357 ! 358 DO_3D_11_11( 1, jpkm1 ) 359 ! 360 ! compute density (2*nn_sto_eos) times: 361 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 362 ! (2) for t-dt, s-ds (with the opposite fluctuation) 363 DO jsmp = 1, nn_sto_eos*2 364 jdof = (jsmp + 1) / 2 365 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 366 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 367 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 368 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 369 ztm = tmask(ji,jj,jk) ! tmask 251 370 ! 252 371 zn3 = EOS013*zt & … … 263 382 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 264 383 ! 265 zn0 = (((((EOS060*zt &384 zn0_sto(jsmp) = (((((EOS060*zt & 266 385 & + EOS150*zs+EOS050)*zt & 267 386 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & … … 271 390 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 272 391 ! 273 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 392 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 393 END DO 394 ! 395 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 396 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 397 DO jsmp = 1, nn_sto_eos*2 398 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 274 399 ! 275 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 276 ! 400 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 277 401 END DO 278 END DO 279 END DO 280 ! 281 CASE( np_seos ) !== simplified EOS ==! 282 ! 283 DO jk = 1, jpkm1 284 DO jj = 1, jpj 285 DO ji = 1, jpi 286 zt = pts (ji,jj,jk,jp_tem) - 10._wp 287 zs = pts (ji,jj,jk,jp_sal) - 35._wp 288 zh = pdep (ji,jj,jk) 289 ztm = tmask(ji,jj,jk) 290 ! 291 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 292 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 293 & - rn_nu * zt * zs 294 ! 295 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 296 END DO 297 END DO 298 END DO 299 ! 300 CASE( np_leos ) !== linear ISOMIP EOS ==! 301 ! 302 DO jk = 1, jpkm1 303 DO jj = 1, jpj 304 DO ji = 1, jpi 305 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 306 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 307 zh = pdep (ji,jj,jk) 308 ztm = tmask(ji,jj,jk) 309 ! 310 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 311 ! 312 prd(ji,jj,jk) = zn * r1_rho0 * ztm ! density anomaly (masked) 313 END DO 314 END DO 315 END DO 316 ! 317 END SELECT 318 ! 319 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-insitu : ', kdim=jpk ) 320 ! 321 IF( ln_timing ) CALL timing_stop('eos-insitu') 322 ! 323 END SUBROUTINE eos_insitu 324 325 326 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 327 !!---------------------------------------------------------------------- 328 !! *** ROUTINE eos_insitu_pot *** 329 !! 330 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 331 !! potential volumic mass (Kg/m3) from potential temperature and 332 !! salinity fields using an equation of state selected in the 333 !! namelist. 334 !! 335 !! ** Action : - prd , the in situ density (no units) 336 !! - prhop, the potential volumic mass (Kg/m3) 337 !! 338 !!---------------------------------------------------------------------- 339 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 340 ! ! 2 : salinity [psu] 341 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 342 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 343 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 344 ! 345 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 346 INTEGER :: jdof 347 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 348 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 349 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 350 !!---------------------------------------------------------------------- 351 ! 352 IF( ln_timing ) CALL timing_start('eos-pot') 353 ! 354 SELECT CASE ( neos ) 355 ! 356 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 357 ! 358 ! Stochastic equation of state 359 IF ( ln_sto_eos ) THEN 360 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 361 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 362 ALLOCATE(zsign(1:2*nn_sto_eos)) 363 DO jsmp = 1, 2*nn_sto_eos, 2 364 zsign(jsmp) = 1._wp 365 zsign(jsmp+1) = -1._wp 366 END DO 367 ! 368 DO jk = 1, jpkm1 369 DO jj = 1, jpj 370 DO ji = 1, jpi 371 ! 372 ! compute density (2*nn_sto_eos) times: 373 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 374 ! (2) for t-dt, s-ds (with the opposite fluctuation) 375 DO jsmp = 1, nn_sto_eos*2 376 jdof = (jsmp + 1) / 2 377 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 378 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 379 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 380 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 381 ztm = tmask(ji,jj,jk) ! tmask 382 ! 383 zn3 = EOS013*zt & 384 & + EOS103*zs+EOS003 385 ! 386 zn2 = (EOS022*zt & 387 & + EOS112*zs+EOS012)*zt & 388 & + (EOS202*zs+EOS102)*zs+EOS002 389 ! 390 zn1 = (((EOS041*zt & 391 & + EOS131*zs+EOS031)*zt & 392 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 393 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 394 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 395 ! 396 zn0_sto(jsmp) = (((((EOS060*zt & 397 & + EOS150*zs+EOS050)*zt & 398 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 399 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 400 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 401 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 402 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 403 ! 404 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 405 END DO 406 ! 407 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 408 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 409 DO jsmp = 1, nn_sto_eos*2 410 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 411 ! 412 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rho0 - 1._wp ) ! density anomaly (masked) 413 END DO 414 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 415 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 416 END DO 417 END DO 418 END DO 402 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 403 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 404 END_3D 419 405 DEALLOCATE(zn0_sto,zn_sto,zsign) 420 406 ! Non-stochastic equation of state 421 407 ELSE 422 DO jk = 1, jpkm1 423 DO jj = 1, jpj 424 DO ji = 1, jpi 425 ! 426 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 427 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 428 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 429 ztm = tmask(ji,jj,jk) ! tmask 430 ! 431 zn3 = EOS013*zt & 432 & + EOS103*zs+EOS003 433 ! 434 zn2 = (EOS022*zt & 435 & + EOS112*zs+EOS012)*zt & 436 & + (EOS202*zs+EOS102)*zs+EOS002 437 ! 438 zn1 = (((EOS041*zt & 439 & + EOS131*zs+EOS031)*zt & 440 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 441 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 442 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 443 ! 444 zn0 = (((((EOS060*zt & 445 & + EOS150*zs+EOS050)*zt & 446 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 447 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 448 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 449 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 450 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 451 ! 452 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 453 ! 454 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 455 ! 456 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 457 END DO 458 END DO 459 END DO 460 ENDIF 461 462 CASE( np_seos ) !== simplified EOS ==! 463 ! 464 DO jk = 1, jpkm1 465 DO jj = 1, jpj 466 DO ji = 1, jpi 467 zt = pts (ji,jj,jk,jp_tem) - 10._wp 468 zs = pts (ji,jj,jk,jp_sal) - 35._wp 469 zh = pdep (ji,jj,jk) 470 ztm = tmask(ji,jj,jk) 471 ! ! potential density referenced at the surface 472 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 473 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 474 & - rn_nu * zt * zs 475 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 476 ! ! density anomaly (masked) 477 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 478 prd(ji,jj,jk) = zn * r1_rho0 * ztm 479 ! 480 END DO 481 END DO 482 END DO 483 ! 484 CASE( np_leos ) !== linear ISOMIP EOS ==! 485 ! 486 DO jk = 1, jpkm1 487 DO jj = 1, jpj 488 DO ji = 1, jpi 489 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 490 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 491 zh = pdep (ji,jj,jk) 492 ztm = tmask(ji,jj,jk) 493 ! ! potential density referenced at the surface 494 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 495 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 496 ! ! density anomaly (masked) 497 prd(ji,jj,jk) = zn * r1_rho0 * ztm 498 ! 499 END DO 500 END DO 501 END DO 502 ! 503 END SELECT 504 ! 505 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 506 ! 507 IF( ln_timing ) CALL timing_stop('eos-pot') 508 ! 509 END SUBROUTINE eos_insitu_pot 510 511 512 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 513 !!---------------------------------------------------------------------- 514 !! *** ROUTINE eos_insitu_2d *** 515 !! 516 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 517 !! potential temperature and salinity using an equation of state 518 !! selected in the nameos namelist. * 2D field case 519 !! 520 !! ** Action : - prd , the in situ density (no units) (unmasked) 521 !! 522 !!---------------------------------------------------------------------- 523 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 524 ! ! 2 : salinity [psu] 525 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 526 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 527 ! 528 INTEGER :: ji, jj, jk ! dummy loop indices 529 REAL(wp) :: zt , zh , zs ! local scalars 530 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 531 !!---------------------------------------------------------------------- 532 ! 533 IF( ln_timing ) CALL timing_start('eos2d') 534 ! 535 prd(:,:) = 0._wp 536 ! 537 SELECT CASE( neos ) 538 ! 539 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 540 ! 541 DO jj = 1, jpjm1 542 DO ji = 1, fs_jpim1 ! vector opt. 543 ! 544 zh = pdep(ji,jj) * r1_Z0 ! depth 545 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 546 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 408 DO_3D_11_11( 1, jpkm1 ) 409 ! 410 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 411 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 412 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 413 ztm = tmask(ji,jj,jk) ! tmask 547 414 ! 548 415 zn3 = EOS013*zt & … … 569 436 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 570 437 ! 571 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 572 ! 573 END DO 574 END DO 575 ! 576 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 577 ! 438 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 439 ! 440 prd(ji,jj,jk) = ( zn * r1_rho0 - 1._wp ) * ztm ! density anomaly (masked) 441 END_3D 442 ENDIF 443 578 444 CASE( np_seos ) !== simplified EOS ==! 579 445 ! 580 DO jj = 1, jpjm1 581 DO ji = 1, fs_jpim1 ! vector opt. 582 ! 583 zt = pts (ji,jj,jp_tem) - 10._wp 584 zs = pts (ji,jj,jp_sal) - 35._wp 585 zh = pdep (ji,jj) ! depth at the partial step level 586 ! 587 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 588 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 589 & - rn_nu * zt * zs 590 ! 591 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 592 ! 593 END DO 594 END DO 595 ! 596 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 446 DO_3D_11_11( 1, jpkm1 ) 447 zt = pts (ji,jj,jk,jp_tem) - 10._wp 448 zs = pts (ji,jj,jk,jp_sal) - 35._wp 449 zh = pdep (ji,jj,jk) 450 ztm = tmask(ji,jj,jk) 451 ! ! potential density referenced at the surface 452 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 453 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 454 & - rn_nu * zt * zs 455 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 456 ! ! density anomaly (masked) 457 zn = zn - ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zh 458 prd(ji,jj,jk) = zn * r1_rho0 * ztm 459 ! 460 END_3D 461 ! 462 CASE( np_leos ) !== linear ISOMIP EOS ==! 463 ! 464 DO_3D_11_11( 1, jpkm1 ) 465 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 466 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp 467 zh = pdep (ji,jj,jk) 468 ztm = tmask(ji,jj,jk) 469 ! ! potential density referenced at the surface 470 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 471 prhop(ji,jj,jk) = ( rho0 + zn ) * ztm 472 ! ! density anomaly (masked) 473 prd(ji,jj,jk) = zn * r1_rho0 * ztm 474 ! 475 END_3D 476 ! 477 END SELECT 478 ! 479 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 480 ! 481 IF( ln_timing ) CALL timing_stop('eos-pot') 482 ! 483 END SUBROUTINE eos_insitu_pot 484 485 486 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 487 !!---------------------------------------------------------------------- 488 !! *** ROUTINE eos_insitu_2d *** 489 !! 490 !! ** Purpose : Compute the in situ density (ratio rho/rho0) from 491 !! potential temperature and salinity using an equation of state 492 !! selected in the nameos namelist. * 2D field case 493 !! 494 !! ** Action : - prd , the in situ density (no units) (unmasked) 495 !! 496 !!---------------------------------------------------------------------- 497 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 498 ! ! 2 : salinity [psu] 499 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 500 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 501 ! 502 INTEGER :: ji, jj, jk ! dummy loop indices 503 REAL(wp) :: zt , zh , zs ! local scalars 504 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 505 !!---------------------------------------------------------------------- 506 ! 507 IF( ln_timing ) CALL timing_start('eos2d') 508 ! 509 prd(:,:) = 0._wp 510 ! 511 SELECT CASE( neos ) 512 ! 513 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 514 ! 515 DO_2D_11_11 516 ! 517 zh = pdep(ji,jj) * r1_Z0 ! depth 518 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 519 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 520 ! 521 zn3 = EOS013*zt & 522 & + EOS103*zs+EOS003 523 ! 524 zn2 = (EOS022*zt & 525 & + EOS112*zs+EOS012)*zt & 526 & + (EOS202*zs+EOS102)*zs+EOS002 527 ! 528 zn1 = (((EOS041*zt & 529 & + EOS131*zs+EOS031)*zt & 530 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 531 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 532 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 533 ! 534 zn0 = (((((EOS060*zt & 535 & + EOS150*zs+EOS050)*zt & 536 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 537 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 538 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 539 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 540 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 541 ! 542 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 543 ! 544 prd(ji,jj) = zn * r1_rho0 - 1._wp ! unmasked in situ density anomaly 545 ! 546 END_2D 547 ! 548 CASE( np_seos ) !== simplified EOS ==! 549 ! 550 DO_2D_11_11 551 ! 552 zt = pts (ji,jj,jp_tem) - 10._wp 553 zs = pts (ji,jj,jp_sal) - 35._wp 554 zh = pdep (ji,jj) ! depth at the partial step level 555 ! 556 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt + rn_mu1*zh ) * zt & 557 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs - rn_mu2*zh ) * zs & 558 & - rn_nu * zt * zs 559 ! 560 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 561 ! 562 END_2D 597 563 ! 598 564 CASE( np_leos ) !== ISOMIP EOS ==! 599 565 ! 600 DO jj = 1, jpjm1 601 DO ji = 1, fs_jpim1 ! vector opt. 602 ! 603 zt = pts (ji,jj,jp_tem) - (-1._wp) 604 zs = pts (ji,jj,jp_sal) - 34.2_wp 605 zh = pdep (ji,jj) ! depth at the partial step level 606 ! 607 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 608 ! 609 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 610 ! 611 END DO 612 END DO 613 ! 614 CALL lbc_lnk( 'eosbn2', prd, 'T', 1. ) ! Lateral boundary conditions 566 DO_2D_11_11 567 ! 568 zt = pts (ji,jj,jp_tem) - (-1._wp) 569 zs = pts (ji,jj,jp_sal) - 34.2_wp 570 zh = pdep (ji,jj) ! depth at the partial step level 571 ! 572 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 573 ! 574 prd(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 575 ! 576 END_2D 577 ! 615 578 ! 616 579 END SELECT 617 580 ! 618 IF( ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )581 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 619 582 ! 620 583 IF( ln_timing ) CALL timing_stop('eos2d') … … 648 611 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 649 612 ! 650 DO jk = 1, jpkm1 651 DO jj = 1, jpj 652 DO ji = 1, jpi 653 ! 654 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 655 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 656 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 657 ztm = tmask(ji,jj,jk) ! tmask 658 ! 659 ! alpha 660 zn3 = ALP003 661 ! 662 zn2 = ALP012*zt + ALP102*zs+ALP002 663 ! 664 zn1 = ((ALP031*zt & 665 & + ALP121*zs+ALP021)*zt & 666 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 667 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 668 ! 669 zn0 = ((((ALP050*zt & 670 & + ALP140*zs+ALP040)*zt & 671 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 672 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 673 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 674 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 675 ! 676 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 677 ! 678 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 679 ! 680 ! beta 681 zn3 = BET003 682 ! 683 zn2 = BET012*zt + BET102*zs+BET002 684 ! 685 zn1 = ((BET031*zt & 686 & + BET121*zs+BET021)*zt & 687 & + (BET211*zs+BET111)*zs+BET011)*zt & 688 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 689 ! 690 zn0 = ((((BET050*zt & 691 & + BET140*zs+BET040)*zt & 692 & + (BET230*zs+BET130)*zs+BET030)*zt & 693 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 694 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 695 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 696 ! 697 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 698 ! 699 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 700 ! 701 END DO 702 END DO 703 END DO 613 DO_3D_11_11( 1, jpkm1 ) 614 ! 615 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 616 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 617 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 618 ztm = tmask(ji,jj,jk) ! tmask 619 ! 620 ! alpha 621 zn3 = ALP003 622 ! 623 zn2 = ALP012*zt + ALP102*zs+ALP002 624 ! 625 zn1 = ((ALP031*zt & 626 & + ALP121*zs+ALP021)*zt & 627 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 628 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 629 ! 630 zn0 = ((((ALP050*zt & 631 & + ALP140*zs+ALP040)*zt & 632 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 633 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 634 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 635 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 636 ! 637 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 638 ! 639 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm 640 ! 641 ! beta 642 zn3 = BET003 643 ! 644 zn2 = BET012*zt + BET102*zs+BET002 645 ! 646 zn1 = ((BET031*zt & 647 & + BET121*zs+BET021)*zt & 648 & + (BET211*zs+BET111)*zs+BET011)*zt & 649 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 650 ! 651 zn0 = ((((BET050*zt & 652 & + BET140*zs+BET040)*zt & 653 & + (BET230*zs+BET130)*zs+BET030)*zt & 654 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 655 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 656 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 657 ! 658 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 659 ! 660 pab(ji,jj,jk,jp_sal) = zn / zs * r1_rho0 * ztm 661 ! 662 END_3D 704 663 ! 705 664 CASE( np_seos ) !== simplified EOS ==! 706 665 ! 707 DO jk = 1, jpkm1 708 DO jj = 1, jpj 709 DO ji = 1, jpi 710 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 711 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 712 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 713 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 714 ! 715 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 716 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 717 ! 718 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 719 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 720 ! 721 END DO 722 END DO 723 END DO 666 DO_3D_11_11( 1, jpkm1 ) 667 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 668 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 669 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 670 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 671 ! 672 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 673 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 674 ! 675 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 676 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 677 ! 678 END_3D 724 679 ! 725 680 CASE( np_leos ) !== linear ISOMIP EOS ==! 726 681 ! 727 DO jk = 1, jpkm1 728 DO jj = 1, jpj 729 DO ji = 1, jpi 730 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 731 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 732 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 733 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 734 ! 735 zn = rn_a0 * rho0 736 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 737 ! 738 zn = rn_b0 * rho0 739 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 740 ! 741 END DO 742 END DO 743 END DO 682 DO_3D_11_11( 1, jpkm1 ) 683 zt = pts (ji,jj,jk,jp_tem) - (-1._wp) 684 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 685 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 686 ztm = tmask(ji,jj,jk) ! land/sea bottom mask = surf. mask 687 ! 688 zn = rn_a0 * rho0 689 pab(ji,jj,jk,jp_tem) = zn * r1_rho0 * ztm ! alpha 690 ! 691 zn = rn_b0 * rho0 692 pab(ji,jj,jk,jp_sal) = zn * r1_rho0 * ztm ! beta 693 ! 694 END_3D 744 695 ! 745 696 CASE DEFAULT … … 749 700 END SELECT 750 701 ! 751 IF( ln_ctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', &752 & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk )702 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pab(:,:,:,jp_tem), clinfo1=' rab_3d_t: ', & 703 & tab3d_2=pab(:,:,:,jp_sal), clinfo2=' rab_3d_s : ', kdim=jpk ) 753 704 ! 754 705 IF( ln_timing ) CALL timing_stop('rab_3d') … … 783 734 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 784 735 ! 785 DO jj = 1, jpjm1 786 DO ji = 1, fs_jpim1 ! vector opt. 787 ! 788 zh = pdep(ji,jj) * r1_Z0 ! depth 789 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 790 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 791 ! 792 ! alpha 793 zn3 = ALP003 794 ! 795 zn2 = ALP012*zt + ALP102*zs+ALP002 796 ! 797 zn1 = ((ALP031*zt & 798 & + ALP121*zs+ALP021)*zt & 799 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 800 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 801 ! 802 zn0 = ((((ALP050*zt & 803 & + ALP140*zs+ALP040)*zt & 804 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 805 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 806 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 807 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 808 ! 809 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 810 ! 811 pab(ji,jj,jp_tem) = zn * r1_rho0 812 ! 813 ! beta 814 zn3 = BET003 815 ! 816 zn2 = BET012*zt + BET102*zs+BET002 817 ! 818 zn1 = ((BET031*zt & 819 & + BET121*zs+BET021)*zt & 820 & + (BET211*zs+BET111)*zs+BET011)*zt & 821 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 822 ! 823 zn0 = ((((BET050*zt & 824 & + BET140*zs+BET040)*zt & 825 & + (BET230*zs+BET130)*zs+BET030)*zt & 826 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 827 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 828 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 829 ! 830 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 831 ! 832 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 833 ! 834 ! 835 END DO 836 END DO 837 ! ! Lateral boundary conditions 838 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) 736 DO_2D_11_11 737 ! 738 zh = pdep(ji,jj) * r1_Z0 ! depth 739 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 740 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 741 ! 742 ! alpha 743 zn3 = ALP003 744 ! 745 zn2 = ALP012*zt + ALP102*zs+ALP002 746 ! 747 zn1 = ((ALP031*zt & 748 & + ALP121*zs+ALP021)*zt & 749 & + (ALP211*zs+ALP111)*zs+ALP011)*zt & 750 & + ((ALP301*zs+ALP201)*zs+ALP101)*zs+ALP001 751 ! 752 zn0 = ((((ALP050*zt & 753 & + ALP140*zs+ALP040)*zt & 754 & + (ALP230*zs+ALP130)*zs+ALP030)*zt & 755 & + ((ALP320*zs+ALP220)*zs+ALP120)*zs+ALP020)*zt & 756 & + (((ALP410*zs+ALP310)*zs+ALP210)*zs+ALP110)*zs+ALP010)*zt & 757 & + ((((ALP500*zs+ALP400)*zs+ALP300)*zs+ALP200)*zs+ALP100)*zs+ALP000 758 ! 759 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 760 ! 761 pab(ji,jj,jp_tem) = zn * r1_rho0 762 ! 763 ! beta 764 zn3 = BET003 765 ! 766 zn2 = BET012*zt + BET102*zs+BET002 767 ! 768 zn1 = ((BET031*zt & 769 & + BET121*zs+BET021)*zt & 770 & + (BET211*zs+BET111)*zs+BET011)*zt & 771 & + ((BET301*zs+BET201)*zs+BET101)*zs+BET001 772 ! 773 zn0 = ((((BET050*zt & 774 & + BET140*zs+BET040)*zt & 775 & + (BET230*zs+BET130)*zs+BET030)*zt & 776 & + ((BET320*zs+BET220)*zs+BET120)*zs+BET020)*zt & 777 & + (((BET410*zs+BET310)*zs+BET210)*zs+BET110)*zs+BET010)*zt & 778 & + ((((BET500*zs+BET400)*zs+BET300)*zs+BET200)*zs+BET100)*zs+BET000 779 ! 780 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 781 ! 782 pab(ji,jj,jp_sal) = zn / zs * r1_rho0 783 ! 784 ! 785 END_2D 839 786 ! 840 787 CASE( np_seos ) !== simplified EOS ==! 841 788 ! 842 DO jj = 1, jpjm1 843 DO ji = 1, fs_jpim1 ! vector opt. 844 ! 845 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 846 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 847 zh = pdep (ji,jj) ! depth at the partial step level 848 ! 849 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 850 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 851 ! 852 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 853 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 854 ! 855 END DO 856 END DO 857 ! ! Lateral boundary conditions 858 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) 789 DO_2D_11_11 790 ! 791 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 792 zs = pts (ji,jj,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 793 zh = pdep (ji,jj) ! depth at the partial step level 794 ! 795 zn = rn_a0 * ( 1._wp + rn_lambda1*zt + rn_mu1*zh ) + rn_nu*zs 796 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 797 ! 798 zn = rn_b0 * ( 1._wp - rn_lambda2*zs - rn_mu2*zh ) - rn_nu*zt 799 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 800 ! 801 END_2D 859 802 ! 860 803 CASE( np_leos ) !== linear ISOMIP EOS ==! 861 804 ! 862 DO jj = 1, jpjm1 863 DO ji = 1, fs_jpim1 ! vector opt. 864 ! 865 zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0) 866 zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 867 zh = pdep (ji,jj) ! depth at the partial step level 868 ! 869 zn = rn_a0 * rho0 870 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 871 ! 872 zn = rn_b0 * rho0 873 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 874 ! 875 END DO 876 END DO 877 ! 878 CALL lbc_lnk_multi( 'eosbn2', pab(:,:,jp_tem), 'T', 1. , pab(:,:,jp_sal), 'T', 1. ) ! Lateral boundary conditions 805 DO_2D_11_11 806 ! 807 zt = pts (ji,jj,jp_tem) - (-1._wp) ! pot. temperature anomaly (t-T0) 808 zs = pts (ji,jj,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 809 zh = pdep (ji,jj) ! depth at the partial step level 810 ! 811 zn = rn_a0 * rho0 812 pab(ji,jj,jp_tem) = zn * r1_rho0 ! alpha 813 ! 814 zn = rn_b0 * rho0 815 pab(ji,jj,jp_sal) = zn * r1_rho0 ! beta 816 ! 817 END_2D 879 818 ! 880 819 CASE DEFAULT … … 884 823 END SELECT 885 824 ! 886 IF( ln_ctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', &887 & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' )825 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pab(:,:,jp_tem), clinfo1=' rab_2d_t: ', & 826 & tab2d_2=pab(:,:,jp_sal), clinfo2=' rab_2d_s : ' ) 888 827 ! 889 828 IF( ln_timing ) CALL timing_stop('rab_2d') … … 1026 965 IF( ln_timing ) CALL timing_start('bn2') 1027 966 ! 1028 DO jk = 2, jpkm1 ! interior points only (2=< jk =< jpkm1 ) 1029 DO jj = 1, jpj ! surface and bottom value set to zero one for all in istate.F90 1030 DO ji = 1, jpi 1031 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 1032 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 1033 ! 1034 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 1035 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 1036 ! 1037 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 1038 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 1039 & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 1040 END DO 1041 END DO 1042 END DO 1043 ! 1044 IF(ln_ctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk ) 967 DO_3D_11_11( 2, jpkm1 ) 968 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 969 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 970 ! 971 zaw = pab(ji,jj,jk,jp_tem) * (1. - zrw) + pab(ji,jj,jk-1,jp_tem) * zrw 972 zbw = pab(ji,jj,jk,jp_sal) * (1. - zrw) + pab(ji,jj,jk-1,jp_sal) * zrw 973 ! 974 pn2(ji,jj,jk) = grav * ( zaw * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 975 & - zbw * ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ) & 976 & / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk) 977 END_3D 978 ! 979 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2 : ', kdim=jpk ) 1045 980 ! 1046 981 IF( ln_timing ) CALL timing_stop('bn2') … … 1078 1013 z1_T0 = 1._wp/40._wp 1079 1014 ! 1080 DO jj = 1, jpj 1081 DO ji = 1, jpi 1082 ! 1083 zt = ctmp (ji,jj) * z1_T0 1084 zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 1085 ztm = tmask(ji,jj,1) 1086 ! 1087 zn = ((((-2.1385727895e-01_wp*zt & 1088 & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt & 1089 & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt & 1090 & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt & 1091 & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs & 1092 & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt & 1093 & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs & 1094 & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 1095 ! 1096 zd = (2.0035003456_wp*zt & 1097 & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt & 1098 & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 1099 ! 1100 ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 1101 ! 1102 END DO 1103 END DO 1015 DO_2D_11_11 1016 ! 1017 zt = ctmp (ji,jj) * z1_T0 1018 zs = SQRT( ABS( psal(ji,jj) + zdeltaS ) * r1_S0 ) 1019 ztm = tmask(ji,jj,1) 1020 ! 1021 zn = ((((-2.1385727895e-01_wp*zt & 1022 & - 2.7674419971e-01_wp*zs+1.0728094330_wp)*zt & 1023 & + (2.6366564313_wp*zs+3.3546960647_wp)*zs-7.8012209473_wp)*zt & 1024 & + ((1.8835586562_wp*zs+7.3949191679_wp)*zs-3.3937395875_wp)*zs-5.6414948432_wp)*zt & 1025 & + (((3.5737370589_wp*zs-1.5512427389e+01_wp)*zs+2.4625741105e+01_wp)*zs & 1026 & +1.9912291000e+01_wp)*zs-3.2191146312e+01_wp)*zt & 1027 & + ((((5.7153204649e-01_wp*zs-3.0943149543_wp)*zs+9.3052495181_wp)*zs & 1028 & -9.4528934807_wp)*zs+3.1066408996_wp)*zs-4.3504021262e-01_wp 1029 ! 1030 zd = (2.0035003456_wp*zt & 1031 & -3.4570358592e-01_wp*zs+5.6471810638_wp)*zt & 1032 & + (1.5393993508_wp*zs-6.9394762624_wp)*zs+1.2750522650e+01_wp 1033 ! 1034 ptmp(ji,jj) = ( zt / z1_T0 + zn / zd ) * ztm 1035 ! 1036 END_2D 1104 1037 ! 1105 1038 IF( ln_timing ) CALL timing_stop('eos_pt_from_ct') … … 1133 1066 ! 1134 1067 z1_S0 = 1._wp / 35.16504_wp 1135 DO jj = 1, jpj 1136 DO ji = 1, jpi 1137 zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity 1138 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1139 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1140 END DO 1141 END DO 1068 DO_2D_11_11 1069 zs= SQRT( ABS( psal(ji,jj) ) * z1_S0 ) ! square root salinity 1070 ptf(ji,jj) = ((((1.46873e-03_wp*zs-9.64972e-03_wp)*zs+2.28348e-02_wp)*zs & 1071 & - 3.12775e-02_wp)*zs+2.07679e-02_wp)*zs-5.87701e-02_wp 1072 END_2D 1142 1073 ptf(:,:) = ptf(:,:) * psal(:,:) 1143 1074 ! 1144 1075 IF( PRESENT( pdep ) ) ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 1145 1076 ! 1146 CASE ( np_eos80 , np_leos) !== PT,SP (UNESCO formulation) ==!1077 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1147 1078 ! 1148 1079 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & … … 1190 1121 IF( PRESENT( pdep ) ) ptf = ptf - 7.53e-4 * pdep 1191 1122 ! 1192 CASE ( np_eos80 , np_leos) !== PT,SP (UNESCO formulation) ==!1123 CASE ( np_eos80 ) !== PT,SP (UNESCO formulation) ==! 1193 1124 ! 1194 1125 ptf = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal ) & … … 1242 1173 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 1243 1174 ! 1244 DO jk = 1, jpkm1 1245 DO jj = 1, jpj 1246 DO ji = 1, jpi 1247 ! 1248 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1249 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1250 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 1251 ztm = tmask(ji,jj,jk) ! tmask 1252 ! 1253 ! potential energy non-linear anomaly 1254 zn2 = (PEN012)*zt & 1255 & + PEN102*zs+PEN002 1256 ! 1257 zn1 = ((PEN021)*zt & 1258 & + PEN111*zs+PEN011)*zt & 1259 & + (PEN201*zs+PEN101)*zs+PEN001 1260 ! 1261 zn0 = ((((PEN040)*zt & 1262 & + PEN130*zs+PEN030)*zt & 1263 & + (PEN220*zs+PEN120)*zs+PEN020)*zt & 1264 & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt & 1265 & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 1266 ! 1267 zn = ( zn2 * zh + zn1 ) * zh + zn0 1268 ! 1269 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1270 ! 1271 ! alphaPE non-linear anomaly 1272 zn2 = APE002 1273 ! 1274 zn1 = (APE011)*zt & 1275 & + APE101*zs+APE001 1276 ! 1277 zn0 = (((APE030)*zt & 1278 & + APE120*zs+APE020)*zt & 1279 & + (APE210*zs+APE110)*zs+APE010)*zt & 1280 & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 1281 ! 1282 zn = ( zn2 * zh + zn1 ) * zh + zn0 1283 ! 1284 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1285 ! 1286 ! betaPE non-linear anomaly 1287 zn2 = BPE002 1288 ! 1289 zn1 = (BPE011)*zt & 1290 & + BPE101*zs+BPE001 1291 ! 1292 zn0 = (((BPE030)*zt & 1293 & + BPE120*zs+BPE020)*zt & 1294 & + (BPE210*zs+BPE110)*zs+BPE010)*zt & 1295 & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 1296 ! 1297 zn = ( zn2 * zh + zn1 ) * zh + zn0 1298 ! 1299 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1300 ! 1301 END DO 1302 END DO 1303 END DO 1175 DO_3D_11_11( 1, jpkm1 ) 1176 ! 1177 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth 1178 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 1179 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 1180 ztm = tmask(ji,jj,jk) ! tmask 1181 ! 1182 ! potential energy non-linear anomaly 1183 zn2 = (PEN012)*zt & 1184 & + PEN102*zs+PEN002 1185 ! 1186 zn1 = ((PEN021)*zt & 1187 & + PEN111*zs+PEN011)*zt & 1188 & + (PEN201*zs+PEN101)*zs+PEN001 1189 ! 1190 zn0 = ((((PEN040)*zt & 1191 & + PEN130*zs+PEN030)*zt & 1192 & + (PEN220*zs+PEN120)*zs+PEN020)*zt & 1193 & + ((PEN310*zs+PEN210)*zs+PEN110)*zs+PEN010)*zt & 1194 & + (((PEN400*zs+PEN300)*zs+PEN200)*zs+PEN100)*zs+PEN000 1195 ! 1196 zn = ( zn2 * zh + zn1 ) * zh + zn0 1197 ! 1198 ppen(ji,jj,jk) = zn * zh * r1_rho0 * ztm 1199 ! 1200 ! alphaPE non-linear anomaly 1201 zn2 = APE002 1202 ! 1203 zn1 = (APE011)*zt & 1204 & + APE101*zs+APE001 1205 ! 1206 zn0 = (((APE030)*zt & 1207 & + APE120*zs+APE020)*zt & 1208 & + (APE210*zs+APE110)*zs+APE010)*zt & 1209 & + ((APE300*zs+APE200)*zs+APE100)*zs+APE000 1210 ! 1211 zn = ( zn2 * zh + zn1 ) * zh + zn0 1212 ! 1213 pab_pe(ji,jj,jk,jp_tem) = zn * zh * r1_rho0 * ztm 1214 ! 1215 ! betaPE non-linear anomaly 1216 zn2 = BPE002 1217 ! 1218 zn1 = (BPE011)*zt & 1219 & + BPE101*zs+BPE001 1220 ! 1221 zn0 = (((BPE030)*zt & 1222 & + BPE120*zs+BPE020)*zt & 1223 & + (BPE210*zs+BPE110)*zs+BPE010)*zt & 1224 & + ((BPE300*zs+BPE200)*zs+BPE100)*zs+BPE000 1225 ! 1226 zn = ( zn2 * zh + zn1 ) * zh + zn0 1227 ! 1228 pab_pe(ji,jj,jk,jp_sal) = zn / zs * zh * r1_rho0 * ztm 1229 ! 1230 END_3D 1304 1231 ! 1305 1232 CASE( np_seos ) !== Vallis (2006) simplified EOS ==! 1306 1233 ! 1307 DO jk = 1, jpkm1 1308 DO jj = 1, jpj 1309 DO ji = 1, jpi 1310 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1311 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1312 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1313 ztm = tmask(ji,jj,jk) ! tmask 1314 zn = 0.5_wp * zh * r1_rho0 * ztm 1315 ! ! Potential Energy 1316 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 1317 ! ! alphaPE 1318 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 1319 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 1320 ! 1321 END DO 1322 END DO 1323 END DO 1234 DO_3D_11_11( 1, jpkm1 ) 1235 zt = pts(ji,jj,jk,jp_tem) - 10._wp ! temperature anomaly (t-T0) 1236 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) 1237 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1238 ztm = tmask(ji,jj,jk) ! tmask 1239 zn = 0.5_wp * zh * r1_rho0 * ztm 1240 ! ! Potential Energy 1241 ppen(ji,jj,jk) = ( rn_a0 * rn_mu1 * zt + rn_b0 * rn_mu2 * zs ) * zn 1242 ! ! alphaPE 1243 pab_pe(ji,jj,jk,jp_tem) = - rn_a0 * rn_mu1 * zn 1244 pab_pe(ji,jj,jk,jp_sal) = rn_b0 * rn_mu2 * zn 1245 ! 1246 END_3D 1324 1247 ! 1325 1248 CASE( np_leos ) !== linear ISOMIP EOS ==! 1326 1249 ! 1327 DO jk = 1, jpkm1 1328 DO jj = 1, jpj 1329 DO ji = 1, jpi 1330 zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0) 1331 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 1332 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1333 ztm = tmask(ji,jj,jk) ! tmask 1334 zn = 0.5_wp * zh * r1_rho0 * ztm 1335 ! ! Potential Energy 1336 ppen(ji,jj,jk) = 0. 1337 ! ! alphaPE 1338 pab_pe(ji,jj,jk,jp_tem) = 0. 1339 pab_pe(ji,jj,jk,jp_sal) = 0. 1340 ! 1341 END DO 1342 END DO 1343 END DO 1250 DO_3D_11_11( 1, jpkm1 ) 1251 zt = pts(ji,jj,jk,jp_tem) - (-1._wp) ! temperature anomaly (t-T0) 1252 zs = pts (ji,jj,jk,jp_sal) - 34.2_wp ! abs. salinity anomaly (s-S0) 1253 zh = gdept(ji,jj,jk,Kmm) ! depth in meters at t-point 1254 ztm = tmask(ji,jj,jk) ! tmask 1255 zn = 0.5_wp * zh * r1_rho0 * ztm 1256 ! ! Potential Energy 1257 ppen(ji,jj,jk) = 0. 1258 ! ! alphaPE 1259 pab_pe(ji,jj,jk,jp_tem) = 0. 1260 pab_pe(ji,jj,jk,jp_sal) = 0. 1261 ! 1262 END_3D 1344 1263 ! 1345 1264 CASE DEFAULT … … 1365 1284 INTEGER :: ioptio ! local integer 1366 1285 !! 1367 NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS , ln_LEOS, & 1368 & rn_a0 , rn_b0 , rn_lambda1, rn_mu1 , & 1369 & rn_lambda2, rn_mu2 , rn_nu 1370 !!---------------------------------------------------------------------- 1371 ! 1372 REWIND( numnam_ref ) ! Namelist nameos in reference namelist : equation of state 1286 NAMELIST/nameos/ ln_TEOS10, ln_EOS80, ln_SEOS, ln_LEOS, rn_a0, rn_b0, & 1287 & rn_lambda1, rn_mu1, rn_lambda2, rn_mu2, rn_nu 1288 !!---------------------------------------------------------------------- 1289 ! 1373 1290 READ ( numnam_ref, nameos, IOSTAT = ios, ERR = 901 ) 1374 1291 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nameos in reference namelist' ) 1375 1292 ! 1376 REWIND( numnam_cfg ) ! Namelist nameos in configuration namelist : equation of state1377 1293 READ ( numnam_cfg, nameos, IOSTAT = ios, ERR = 902 ) 1378 1294 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nameos in configuration namelist' ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/MY_SRC/isfcavgam.F90
r12077 r13189 91 91 pgs(:,:) = rn_gammas0 92 92 CASE ( 'vel' ) ! gamma is proportional to u* 93 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, r _ke0_top, pgt, pgs )93 CALL gammats_vel ( zutbl, zvtbl, rCd0_top, rn_vtide**2, pgt, pgs ) 94 94 CASE ( 'vel_stab' ) ! gamma depends of stability of boundary layer and u* 95 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, r _ke0_top, pqoce, pqfwf, pgt, pgs )95 CALL gammats_vel_stab (Kmm, pttbl, pstbl, zutbl, zvtbl, rCd0_top, rn_vtide**2, pqoce, pqfwf, pgt, pgs ) 96 96 CASE DEFAULT 97 97 CALL ctl_stop('STOP','method to compute gamma (cn_gammablk) is unknown (should not see this)') -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/MY_SRC/isfstp.F90
r12077 r13189 250 250 IF ( l_isfoasis .AND. ln_isf ) THEN 251 251 ! 252 CALL ctl_stop( ' ln_ctl and ice shelf not tested' )252 CALL ctl_stop( 'namelist combination ln_cpl and ln_isf not tested' ) 253 253 ! 254 254 ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation … … 291 291 !!---------------------------------------------------------------------- 292 292 ! 293 REWIND( numnam_ref ) ! Namelist namsbc_rnf in reference namelist : Runoffs294 293 READ ( numnam_ref, namisf, IOSTAT = ios, ERR = 901) 295 294 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namisf in reference namelist' ) 296 295 ! 297 REWIND( numnam_cfg ) ! Namelist namsbc_rnf in configuration namelist : Runoffs298 296 READ ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 ) 299 297 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namisf in configuration namelist' ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/MY_SRC/istate.F90
r12353 r13189 41 41 PUBLIC istate_init ! routine called by step.F90 42 42 43 !! * Substitutions 44 # include "do_loop_substitute.h90" 43 45 !!---------------------------------------------------------------------- 44 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 77 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 76 78 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 77 ts (:,:,:,:,Kaa) = 0._wp! set one for all to 0 at level jpk79 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk 78 80 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 79 81 #if defined key_agrif … … 90 92 ! ! --------------- 91 93 numror = 0 ! define numror = 0 -> no restart file to read 92 neuler = 0! Set time-step indicator at nit000 (euler forward)94 l_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 93 95 CALL day_init ! model calendar (using both namelist and restart infos) 94 96 ! ! Initialization of ocean to zero … … 103 105 ! Apply minimum wetdepth criterion 104 106 ! 105 DO jj = 1,jpj 106 DO ji = 1,jpi 107 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 108 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 109 ENDIF 110 END DO 111 END DO 107 DO_2D_11_11 108 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 109 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 110 ENDIF 111 END_2D 112 112 ENDIF 113 113 uu (:,:,:,Kbb) = 0._wp … … 159 159 ! 160 160 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 161 DO jk = 1, jpkm1 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 165 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 166 ! 167 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 168 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 169 END DO 170 END DO 171 END DO 161 DO_3D_11_11( 1, jpkm1 ) 162 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 163 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 164 ! 165 uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) * umask(ji,jj,jk) 166 vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) * vmask(ji,jj,jk) 167 END_3D 172 168 ! 173 169 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/MY_SRC/sbcfwb.F90
r12495 r13189 151 151 ENDIF 152 152 ! ! Update fwfold if new year start 153 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!!153 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!! 154 154 IF( MOD( kt, ikty ) == 0 ) THEN 155 155 a_fwb_b = a_fwb ! mean sea level taking into account the ice+snow -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP+/MY_SRC/tradmp.F90
r12353 r13189 51 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: resto !: restoring coeff. on T and S (s-1) 52 52 53 !! * Substitutions 54 # include "do_loop_substitute.h90" 53 55 !!---------------------------------------------------------------------- 54 56 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 110 112 CASE( 0 ) !* newtonian damping throughout the water column *! 111 113 DO jn = 1, jpts 112 DO jk = 1, jpkm1 113 DO jj = 2, jpjm1 114 DO ji = fs_2, fs_jpim1 ! vector opt. 115 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 116 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 117 END DO 118 END DO 119 END DO 114 DO_3D_00_00( 1, jpkm1 ) 115 pts(ji,jj,jk,jn,Krhs) = pts(ji,jj,jk,jn,Krhs) & 116 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - pts(ji,jj,jk,jn,Kbb) ) 117 END_3D 120 118 END DO 121 119 ! 122 120 CASE ( 1 ) !* no damping in the turbocline (avt > 5 cm2/s) *! 123 DO jk = 1, jpkm1 124 DO jj = 2, jpjm1 125 DO ji = fs_2, fs_jpim1 ! vector opt. 126 IF( avt(ji,jj,jk) <= avt_c ) THEN 127 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 128 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 129 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 130 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 131 ENDIF 132 END DO 133 END DO 134 END DO 121 DO_3D_00_00( 1, jpkm1 ) 122 IF( avt(ji,jj,jk) <= avt_c ) THEN 123 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 124 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 125 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 126 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 127 ENDIF 128 END_3D 135 129 ! 136 130 CASE ( 2 ) !* no damping in the mixed layer *! 137 DO jk = 1, jpkm1 138 DO jj = 2, jpjm1 139 DO ji = fs_2, fs_jpim1 ! vector opt. 140 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 141 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 142 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 143 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 144 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 145 ENDIF 146 END DO 147 END DO 148 END DO 131 DO_3D_00_00( 1, jpkm1 ) 132 IF( gdept(ji,jj,jk,Kmm) >= hmlp (ji,jj) ) THEN 133 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 134 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - pts(ji,jj,jk,jp_tem,Kbb) ) 135 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 136 & + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - pts(ji,jj,jk,jp_sal,Kbb) ) 137 ENDIF 138 END_3D 149 139 ! 150 140 END SELECT … … 157 147 ENDIF 158 148 ! ! Control print 159 IF( ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, &160 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )149 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' dmp - Ta: ', mask1=tmask, & 150 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 161 151 ! 162 152 IF( ln_timing ) CALL timing_stop('tra_dmp') … … 178 168 !!---------------------------------------------------------------------- 179 169 ! 180 REWIND( numnam_ref ) ! Namelist namtra_dmp in reference namelist : T & S relaxation181 170 READ ( numnam_ref, namtra_dmp, IOSTAT = ios, ERR = 901) 182 171 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist' ) 183 172 ! 184 REWIND( numnam_cfg ) ! Namelist namtra_dmp in configuration namelist : T & S relaxation185 173 READ ( numnam_cfg, namtra_dmp, IOSTAT = ios, ERR = 902 ) 186 174 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist' ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP/MY_SRC/usrdef_hgr.F90
r10074 r13189 27 27 PUBLIC usr_def_hgr ! called by domhgr.F90 28 28 29 !! * Substitutions 30 # include "do_loop_substitute.h90" 29 31 !!---------------------------------------------------------------------- 30 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 77 ! 76 78 ! !== grid point position ==! (in degrees) 77 DO jj = 1, jpj 78 DO ji = 1, jpi ! longitude (west coast at lon=0°) 79 plamt(ji,jj) = rn_e1deg * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 80 plamu(ji,jj) = rn_e1deg * ( REAL( ji-1 + nimpp-1 , wp ) ) 81 plamv(ji,jj) = plamt(ji,jj) 82 plamf(ji,jj) = plamu(ji,jj) 83 ! ! latitude (south coast at lat= 81°) 84 pphit(ji,jj) = rn_e2deg * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) - 80._wp 85 pphiu(ji,jj) = pphit(ji,jj) 86 pphiv(ji,jj) = rn_e2deg * ( REAL( jj-1 + njmpp-1 , wp ) ) - 80_wp 87 pphif(ji,jj) = pphiv(ji,jj) 88 END DO 89 END DO 79 DO_2D_11_11 80 ! ! longitude (west coast at lon=0°) 81 plamt(ji,jj) = rn_e1deg * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 82 plamu(ji,jj) = rn_e1deg * ( REAL( ji-1 + nimpp-1 , wp ) ) 83 plamv(ji,jj) = plamt(ji,jj) 84 plamf(ji,jj) = plamu(ji,jj) 85 ! ! latitude (south coast at lat= 81°) 86 pphit(ji,jj) = rn_e2deg * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) - 80._wp 87 pphiu(ji,jj) = pphit(ji,jj) 88 pphiv(ji,jj) = rn_e2deg * ( REAL( jj-1 + njmpp-1 , wp ) ) - 80_wp 89 pphif(ji,jj) = pphiv(ji,jj) 90 END_2D 90 91 ! 91 92 ! !== Horizontal scale factors ==! (in meters) 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 ! ! e1 (zonal) 95 pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg 96 pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg 97 pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg 98 pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg 99 ! ! e2 (meridional) 100 pe2t(ji,jj) = ra * rad * rn_e2deg 101 pe2u(ji,jj) = ra * rad * rn_e2deg 102 pe2v(ji,jj) = ra * rad * rn_e2deg 103 pe2f(ji,jj) = ra * rad * rn_e2deg 104 END DO 105 END DO 93 DO_2D_11_11 94 ! ! e1 (zonal) 95 pe1t(ji,jj) = ra * rad * COS( rad * pphit(ji,jj) ) * rn_e1deg 96 pe1u(ji,jj) = ra * rad * COS( rad * pphiu(ji,jj) ) * rn_e1deg 97 pe1v(ji,jj) = ra * rad * COS( rad * pphiv(ji,jj) ) * rn_e1deg 98 pe1f(ji,jj) = ra * rad * COS( rad * pphif(ji,jj) ) * rn_e1deg 99 ! ! e2 (meridional) 100 pe2t(ji,jj) = ra * rad * rn_e2deg 101 pe2u(ji,jj) = ra * rad * rn_e2deg 102 pe2v(ji,jj) = ra * rad * rn_e2deg 103 pe2f(ji,jj) = ra * rad * rn_e2deg 104 END_2D 106 105 ! ! NO reduction of grid size in some straits 107 106 ke1e2u_v = 0 ! ==>> u_ & v_surfaces will be computed in dom_ghr routine -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/ISOMIP/MY_SRC/usrdef_zgr.F90
r12377 r13189 30 30 PUBLIC usr_def_zgr ! called by domzgr.F90 31 31 32 !! * Substitutions 33 # include "do_loop_substitute.h90" 32 34 !!---------------------------------------------------------------------- 33 35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 132 134 pe3vw(:,:,jk) = pe3w_1d (jk) 133 135 END DO 134 DO jj = 1, jpj ! top scale factors and depth at T- and W-points 135 DO ji = 1, jpi 136 ik = k_top(ji,jj) 137 IF ( ik > 2 ) THEN 138 ! pdeptw at the interface 139 pdepw(ji,jj,ik ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 140 ! e3t in both side of the interface 141 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 142 ! pdept in both side of the interface (from previous e3t) 143 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 144 pdept(ji,jj,ik-1) = pdepw(ji,jj,ik ) - pe3t (ji,jj,ik ) * 0.5_wp 145 ! pe3w on both side of the interface 146 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik ) 147 pe3w (ji,jj,ik ) = pdept(ji,jj,ik ) - pdept(ji,jj,ik-1) 148 ! e3t into the ice shelf 149 pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik ) - pdepw(ji,jj,ik-1) 150 pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 151 END IF 152 END DO 153 END DO 154 DO jj = 1, jpj ! bottom scale factors and depth at T- and W-points 155 DO ji = 1, jpi 156 ik = k_bot(ji,jj) 157 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 136 ! top scale factors and depth at T- and W-points 137 DO_2D_11_11 138 ik = k_top(ji,jj) 139 IF ( ik > 2 ) THEN 140 ! pdeptw at the interface 141 pdepw(ji,jj,ik ) = MAX( zhisf(ji,jj) , pdepw(ji,jj,ik) ) 142 ! e3t in both side of the interface 158 143 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 159 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 160 ! 144 ! pdept in both side of the interface (from previous e3t) 161 145 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 162 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 163 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 164 END DO 165 END DO 146 pdept(ji,jj,ik-1) = pdepw(ji,jj,ik ) - pe3t (ji,jj,ik ) * 0.5_wp 147 ! pe3w on both side of the interface 148 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik ) 149 pe3w (ji,jj,ik ) = pdept(ji,jj,ik ) - pdept(ji,jj,ik-1) 150 ! e3t into the ice shelf 151 pe3t (ji,jj,ik-1) = pdepw(ji,jj,ik ) - pdepw(ji,jj,ik-1) 152 pe3w (ji,jj,ik-1) = pdept(ji,jj,ik-1) - pdept(ji,jj,ik-2) 153 END IF 154 END_2D 155 ! bottom scale factors and depth at T- and W-points 156 DO_2D_11_11 157 ik = k_bot(ji,jj) 158 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 159 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 160 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 161 ! 162 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 163 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 164 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) 165 END_2D 166 166 ! ! bottom scale factors and depth at U-, V-, UW and VW-points 167 167 pe3u (:,:,:) = pe3t(:,:,:) 168 168 pe3uw(:,:,:) = pe3w(:,:,:) 169 DO jk = 1, jpk ! Computed as the minimum of neighbooring scale factors 170 DO jj = 1, jpjm1 171 DO ji = 1, jpi 172 pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 173 pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 174 pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 175 END DO 176 END DO 177 END DO 169 DO_3D_00_00( 1, jpk ) 170 ! ! Computed as the minimum of neighbooring scale factors 171 pe3v (ji,jj,jk) = MIN( pe3t(ji,jj,jk), pe3t(ji,jj+1,jk) ) 172 pe3vw(ji,jj,jk) = MIN( pe3w(ji,jj,jk), pe3w(ji,jj+1,jk) ) 173 pe3f (ji,jj,jk) = pe3v(ji,jj,jk) 174 END_3D 178 175 CALL lbc_lnk( 'usrdef_zgr', pe3v , 'V', 1._wp ) ; CALL lbc_lnk( 'usrdef_zgr', pe3vw, 'V', 1._wp ) 179 176 CALL lbc_lnk( 'usrdef_zgr', pe3f , 'F', 1._wp ) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90
r10074 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 72 74 ! !== grid point position ==! (in kilometers) 73 75 zfact = rn_dx * 1.e-3 ! conversion in km 74 DO jj = 1, jpj 75 DO ji = 1, jpi ! longitude 76 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 77 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 78 plamv(ji,jj) = plamt(ji,jj) 79 plamf(ji,jj) = plamu(ji,jj) 80 ! ! latitude 81 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 82 pphiu(ji,jj) = pphit(ji,jj) 83 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 84 pphif(ji,jj) = pphiv(ji,jj) 85 END DO 86 END DO 76 DO_2D_11_11 77 ! ! longitude 78 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 79 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 80 plamv(ji,jj) = plamt(ji,jj) 81 plamf(ji,jj) = plamu(ji,jj) 82 ! ! latitude 83 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 84 pphiu(ji,jj) = pphit(ji,jj) 85 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 86 pphif(ji,jj) = pphiv(ji,jj) 87 END_2D 87 88 ! 88 89 ! !== Horizontal scale factors ==! (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90
r10074 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 72 74 ! !== grid point position ==! (in kilometers) 73 75 zfact = rn_dx * 1.e-3 ! conversion in km 74 DO jj = 1, jpj 75 DO ji = 1, jpi ! longitude 76 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 77 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 78 plamv(ji,jj) = plamt(ji,jj) 79 plamf(ji,jj) = plamu(ji,jj) 80 ! ! latitude 81 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 82 pphiu(ji,jj) = pphit(ji,jj) 83 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 84 pphif(ji,jj) = pphiv(ji,jj) 85 END DO 86 END DO 76 DO_2D_11_11 77 ! ! longitude 78 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 79 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 80 plamv(ji,jj) = plamt(ji,jj) 81 plamf(ji,jj) = plamu(ji,jj) 82 ! ! latitude 83 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 84 pphiu(ji,jj) = pphit(ji,jj) 85 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 86 pphif(ji,jj) = pphiv(ji,jj) 87 END_2D 87 88 ! 88 89 ! !== Horizontal scale factors ==! (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
r12377 r13189 29 29 PUBLIC usr_def_zgr ! called by domzgr.F90 30 30 31 !! * Substitutions 32 # include "do_loop_substitute.h90" 31 33 !!---------------------------------------------------------------------- 32 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 182 184 pe3vw(:,:,jk) = pe3w_1d (jk) 183 185 END DO 184 DO jj = 1, jpj ! bottom scale factors and depth at T- and W-points 185 DO ji = 1, jpi 186 ik = k_bot(ji,jj) 187 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 188 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 189 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 190 ! 191 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 192 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 193 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik ) 194 END DO 195 END DO 186 DO_2D_11_11 187 ik = k_bot(ji,jj) 188 pdepw(ji,jj,ik+1) = MIN( zht(ji,jj) , pdepw_1d(ik+1) ) 189 pe3t (ji,jj,ik ) = pdepw(ji,jj,ik+1) - pdepw(ji,jj,ik) 190 pe3t (ji,jj,ik+1) = pe3t (ji,jj,ik ) 191 ! 192 pdept(ji,jj,ik ) = pdepw(ji,jj,ik ) + pe3t (ji,jj,ik ) * 0.5_wp 193 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 194 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik ) 195 END_2D 196 196 ! ! bottom scale factors and depth at U-, V-, UW and VW-points 197 197 ! ! usually Computed as the minimum of neighbooring scale factors -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/file_def_nemo-oce.xml
r11930 r13189 28 28 <field field_ref="empmr" name="empmr" /> 29 29 <!-- --> 30 <field field_ref="taum" name="taum" /> 31 <field field_ref="wspd" name="windsp" /> 30 <field field_ref="taum" name="taum" /> 31 <field field_ref="wspd" name="windsp" /> 32 <!-- --> 33 <field field_ref="Cd_oce" name="Cd_oce" /> 34 <field field_ref="Ce_oce" name="Ce_oce" /> 35 <field field_ref="Ch_oce" name="Ch_oce" /> 36 <field field_ref="theta_zt" name="theta_zt" /> 37 <field field_ref="q_zt" name="q_zt" /> 38 <field field_ref="theta_zu" name="theta_zu" /> 39 <field field_ref="q_zu" name="q_zu" /> 40 <field field_ref="ssq" name="ssq" /> 41 <field field_ref="wspd_blk" name="wspd_blk" /> 32 42 </file> 33 43 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/launch_sasf.sh
r11996 r13189 1 1 #!/bin/bash 2 2 3 # NEMO directory where to fetch compiled STATION_ASF nemo.exe + setup: 4 NEMO_DIR="${HOME}/NEMO/NEMOvdev_r11085_ASINTER-05_Brodeau_Advanced_Bulk" 3 ################################################################ 4 # 5 # Script to launch a set of STATION_ASF simulations 6 # 7 # L. Brodeau, 2020 8 # 9 ################################################################ 10 11 # What directory inside "tests" actually contains the compiled "nemo.exe" for STATION_ASF ? 12 TC_DIR="STATION_ASF2" 13 14 # DATA_IN_DIR => Directory containing sea-surface + atmospheric forcings 15 # (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 16 if [ `hostname` = "merlat" ]; then 17 DATA_IN_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 18 elif [ `hostname` = "luitel" ]; then 19 DATA_IN_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 20 elif [ `hostname` = "ige-meom-cal1" ]; then 21 DATA_IN_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 22 elif [ `hostname` = "salvelinus" ]; then 23 DATA_IN_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 24 else 25 echo "Oops! We don't know `hostname` yet! Define 'DATA_IN_DIR' in the script!"; exit 26 fi 27 28 expdir=`basename ${PWD}`; # we expect "EXPREF" or "EXP00" normally... 29 30 # NEMOGCM root directory where to fetch compiled STATION_ASF nemo.exe + setup: 31 NEMO_WRK_DIR=`pwd | sed -e "s|/tests/STATION_ASF/${expdir}||g"` 5 32 6 33 # Directory where to run the simulation: 7 WORK_DIR="${HOME}/tmp/STATION_ASF"34 PROD_DIR="${HOME}/tmp/STATION_ASF" 8 35 9 36 10 # FORC_DIR => Directory containing sea-surface + atmospheric forcings 11 # (get it there https://drive.google.com/file/d/1MxNvjhRHmMrL54y6RX7WIaM9-LGl--ZP/): 12 if [ `hostname` = "merlat" ]; then 13 FORC_DIR="/MEDIA/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 14 elif [ `hostname` = "luitel" ]; then 15 FORC_DIR="/data/gcm_setup/STATION_ASF/input_data_STATION_ASF_2016-2018" 16 elif [ `hostname` = "ige-meom-cal1" ]; then 17 FORC_DIR="/mnt/meom/workdir/brodeau/STATION_ASF/input_data_STATION_ASF_2016-2018" 18 elif [ `hostname` = "salvelinus" ]; then 19 FORC_DIR="/opt/data/STATION_ASF/input_data_STATION_ASF_2016-2018" 20 else 21 echo "Boo!"; exit 22 fi 23 #====================== 24 mkdir -p ${WORK_DIR} 37 ####### End of normal user configurable section ####### 25 38 26 NEMO_EXE="${NEMO_DIR}/tests/STATION_ASF/BLD/bin/nemo.exe" 27 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled nemo.exe found into ${NEMO_DIR}/tests/STATION_ASF/BLD/bin !"; exit; fi 39 #================================================================================ 28 40 29 NEMO_EXPREF="${NEMO_DIR}/tests/STATION_ASF/EXPREF" 41 # NEMO executable to use is: 42 NEMO_EXE="${NEMO_WRK_DIR}/tests/${TC_DIR}/BLD/bin/nemo.exe" 43 44 45 echo "###########################################################" 46 echo "# S T A T I O N A i r - S e a F l u x #" 47 echo "###########################################################" 48 echo 49 echo " We shall work in here: ${STATION_ASF_DIR}/" 50 echo " NEMOGCM work depository is: ${NEMO_WRK_DIR}/" 51 echo " ==> NEMO EXE to use: ${NEMO_EXE}" 52 echo " Input forcing data into: ${DATA_IN_DIR}/" 53 echo " Production will be done into: ${PROD_DIR}/" 54 echo 55 56 mkdir -p ${PROD_DIR} 57 58 if [ ! -f ${NEMO_EXE} ]; then echo " Mhhh, no compiled 'nemo.exe' found into `dirname ${NEMO_EXE}` !"; exit; fi 59 60 echo 61 echo " *** Using the following NEMO executable:" 62 echo " ${NEMO_EXE} " 63 echo 64 65 NEMO_EXPREF="${NEMO_WRK_DIR}/tests/STATION_ASF/EXPREF" 30 66 if [ ! -d ${NEMO_EXPREF} ]; then echo " Mhhh, no EXPREF directory ${NEMO_EXPREF} !"; exit; fi 31 67 32 rsync -avP ${NEMO_EXE} ${ WORK_DIR}/68 rsync -avP ${NEMO_EXE} ${PROD_DIR}/ 33 69 34 70 for ff in "context_nemo.xml" "domain_def_nemo.xml" "field_def_nemo-oce.xml" "file_def_nemo-oce.xml" "grid_def_nemo.xml" "iodef.xml" "namelist_ref"; do 35 71 if [ ! -f ${NEMO_EXPREF}/${ff} ]; then echo " Mhhh, ${ff} not found into ${NEMO_EXPREF} !"; exit; fi 36 rsync -avPL ${NEMO_EXPREF}/${ff} ${ WORK_DIR}/72 rsync -avPL ${NEMO_EXPREF}/${ff} ${PROD_DIR}/ 37 73 done 38 74 39 75 # Copy forcing to work directory: 40 rsync -avP ${ FORC_DIR}/Station_PAPA_50N-145W*.nc ${WORK_DIR}/76 rsync -avP ${DATA_IN_DIR}/Station_PAPA_50N-145W*.nc ${PROD_DIR}/ 41 77 42 for CASE in "ECMWF -noskin" "COARE3p6-noskin" "ECMWF" "COARE3p6" "NCAR"; do78 for CASE in "ECMWF" "COARE3p6" "NCAR" "ECMWF-noskin" "COARE3p6-noskin"; do 43 79 44 80 echo ; echo … … 50 86 scase=`echo "${CASE}" | tr '[:upper:]' '[:lower:]'` 51 87 52 rm -f ${ WORK_DIR}/namelist_cfg53 rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${ WORK_DIR}/namelist_cfg88 rm -f ${PROD_DIR}/namelist_cfg 89 rsync -avPL ${NEMO_EXPREF}/namelist_${scase}_cfg ${PROD_DIR}/namelist_cfg 54 90 55 cd ${ WORK_DIR}/91 cd ${PROD_DIR}/ 56 92 echo 57 93 echo "Launching NEMO !" 58 ./nemo.exe 1> 94 ./nemo.exe 1>out_nemo.out 2>err_nemo.err 59 95 echo "Done!" 60 96 echo -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/namelist_coare3p6-noskin_cfg
r12495 r13189 29 29 cn_exp = 'STATION_ASF-COARE3p6-noskin' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/namelist_coare3p6_cfg
r12495 r13189 29 29 cn_exp = 'STATION_ASF-COARE3p6' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/namelist_ecmwf-noskin_cfg
r12495 r13189 29 29 cn_exp = 'STATION_ASF-ECMWF-noskin' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/namelist_ecmwf_cfg
r12495 r13189 29 29 cn_exp = 'STATION_ASF-ECMWF' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/namelist_ncar_cfg
r12495 r13189 29 29 cn_exp = 'STATION_ASF-NCAR' ! experience name 30 30 nn_it000 = 1 ! first time step 31 nn_itend = 26280 ! last time step (std 5840) 32 nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 31 !!! nn_itend = 26304 ! last time step => 3 years (including 1 leap!) at dt=3600s 32 !!! nn_date0 = 20160101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 nn_itend = 8760 ! last time step => 3 years (including 1 leap!) at dt=3600s 34 nn_date0 = 20180101 ! date at nit_0000 (format yyyymmdd) used if ln_rstart=F or (ln_rstart=T and nn_rstctl=0 or 1) 33 35 nn_time0 = 0 ! initial time of day in hhmm 34 nn_leapy = 0! Leap year calendar (1) or not (0)35 ln_rstart = 36 nn_euler = 1 ! = 0 : start with forward time step if ln_rstart=T36 nn_leapy = 1 ! Leap year calendar (1) or not (0) 37 ln_rstart = .false. ! start from rest (F) or from a restart file (T) 38 ln_1st_euler = .false. ! =T force a start with forward time step (ln_rstart=T) 37 39 nn_rstctl = 2 ! restart control ==> activated only if ln_rstart=T 38 40 ! ! = 0 nn_date0 read in namelist ; nn_it000 : read in namelist … … 45 47 nn_istate = 0 ! output the initial state (1) or not (0) 46 48 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 47 nn_stock = 26280 ! 1year @ dt=3600 s / frequency of creation of a restart file (modulo referenced to 1) 48 nn_write = 26280 ! 1year @ dt=3600 s / frequency of write in the output file (modulo referenced to nn_it000) 49 !! 50 !!! nn_stock = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 51 !!! nn_write = 26304 ! 3 years (including 1 leap!) at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 52 nn_stock = 8760 ! 1 year at dt=3600s / frequency of creation of a restart file (modulo referenced to 1) 53 nn_write = 8760 ! 1 year at dt=3600s / frequency of write in the output file (modulo referenced to nn_it000) 54 !! 49 55 ln_mskland = .false. ! mask land points in NetCDF outputs (costly: + ~15%) 50 56 ln_cfmeta = .false. ! output additional data to netCDF files required for compliance with the CF metadata standard … … 134 140 ln_humi_rlh = .true. ! humidity specified below in "sn_humi" is relative humidity [%] if .true. 135 141 ! 136 cn_dir = './'! root directory for the bulk data location142 cn_dir = './' ! root directory for the bulk data location 137 143 !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 138 144 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 163 169 ln_read_frq = .false. ! specify whether we must read frq or not 164 170 165 cn_dir = './' 171 cn_dir = './' ! root directory for the ocean data location 166 172 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! 167 173 ! ! file name ! frequency (hours) ! variable ! time interp.! clim ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! … … 215 221 &nameos ! ocean Equation Of Seawater (default: NO selection) 216 222 !----------------------------------------------------------------------- 217 ln_eos80 = .true. ! = Use EOS80223 ln_eos80 = .true. ! = Use EOS80 218 224 / 219 225 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/EXPREF/plot_station_asf.py
r12031 r13189 53 53 L_VARL = [ r'$Q_{lat}$', r'$Q_{sens}$' , r'$Q_{net}$' , r'$Q_{lw}$' , r'$|\tau|$' , r'$\Delta T_{skin}$' ] ; # name of variable in latex mode 54 54 L_VUNT = [ r'$W/m^2$' , r'$W/m^2$' , r'$W/m^2$' , r'$W/m^2$' , r'$N/m^2$' , 'K' ] 55 L_VMAX = [ 75. , 75. , 800. , 25. , 1.2 , -0.7 ]56 L_VMIN = [ -250. , -125. , -400. , -150. , 0. , 55 L_VMAX = [ 75. , 75. , 800. , 25. , 1.2 , 0.7 ] 56 L_VMIN = [ -250. , -125. , -400. , -150. , 0. , -0.7 ] 57 57 L_ANOM = [ True , True , True , True , True , False ] 58 58 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/diawri.F90
r12495 r13189 35 35 USE iom ! 36 36 USE ioipsl ! 37 37 38 #if defined key_si3 38 39 USE ice … … 56 57 57 58 !!---------------------------------------------------------------------- 58 !! NEMO/ SAS4.0 , NEMO Consortium (2018)59 !! $Id: diawri.F90 1 0425 2018-12-19 21:54:16Z smasson $59 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 60 !! $Id: diawri.F90 12493 2020-03-02 07:56:31Z smasson $ 60 61 !! Software governed by the CeCILL license (see ./LICENSE) 61 62 !!---------------------------------------------------------------------- … … 114 115 INTEGER, DIMENSION(2) :: ierr 115 116 !!---------------------------------------------------------------------- 116 ierr = 0 117 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 118 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 119 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 120 ! 121 dia_wri_alloc = MAXVAL(ierr) 122 CALL mpp_sum( 'diawri', dia_wri_alloc ) 117 IF( nn_write == -1 ) THEN 118 dia_wri_alloc = 0 119 ELSE 120 ierr = 0 121 ALLOCATE( ndex_hT(jpi*jpj) , ndex_T(jpi*jpj*jpk) , & 122 & ndex_hU(jpi*jpj) , ndex_U(jpi*jpj*jpk) , & 123 & ndex_hV(jpi*jpj) , ndex_V(jpi*jpj*jpk) , STAT=ierr(1) ) 124 ! 125 dia_wri_alloc = MAXVAL(ierr) 126 CALL mpp_sum( 'diawri', dia_wri_alloc ) 127 ! 128 ENDIF 123 129 ! 124 130 END FUNCTION dia_wri_alloc … … 374 380 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,:,Kmm) ) ! now i-velocity 375 381 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,:,Kmm) ) ! now j-velocity 376 382 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww ) ! now k-velocity 377 383 CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf ) ! freshwater budget 378 384 CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns ) ! total heat flux -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/nemogcm.F90
r12254 r13189 2 2 !!====================================================================== 3 3 !! *** MODULE nemogcm *** 4 !! StandAlone Surface module : surface fluxes4 !! STATION_ASF (SAS meets C1D) 5 5 !!====================================================================== 6 6 !! History : 3.6 ! 2011-11 (S. Alderson, G. Madec) original code … … 19 19 !!---------------------------------------------------------------------- 20 20 USE step_oce ! module used in the ocean time stepping module (step.F90) 21 USE sbc_oce ! surface boundary condition: ocean #LB: rm?22 21 USE phycst ! physical constant (par_cst routine) 23 22 USE domain ! domain initialization (dom_init & dom_cfg routines) 24 23 USE closea ! treatment of closed seas (for ln_closea) 25 24 USE usrdef_nam ! user defined configuration 25 USE istate ! initial state setting (istate_init routine) 26 26 USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 27 27 USE daymod ! calendar 28 28 USE restart ! open restart file 29 !LB:USE step ! NEMO time-stepping (stp routine)30 29 USE c1d ! 1D configuration 31 30 USE step_c1d ! Time stepping loop for the 1D configuration 32 USE sbcssm !33 31 ! 32 USE in_out_manager ! I/O manager 34 33 USE lib_mpp ! distributed memory computing 35 34 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 49 48 !!---------------------------------------------------------------------- 50 49 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 51 !! $Id: nemogcm.F90 1 1536 2019-09-11 13:54:18Z smasson$50 !! $Id: nemogcm.F90 12489 2020-02-28 15:55:11Z davestorkey $ 52 51 !! Software governed by the CeCILL license (see ./LICENSE) 53 52 !!---------------------------------------------------------------------- … … 84 83 ! !== time stepping ==! 85 84 ! !-----------------------! 85 ! 86 ! !== set the model time-step ==! 87 ! 86 88 istp = nit000 87 89 ! … … 98 100 IF( nstop /= 0 .AND. lwp ) THEN ! error print 99 101 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 100 CALL ctl_stop( ctmp1 ) 102 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 103 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 101 104 ENDIF 102 105 ! … … 106 109 ! 107 110 #if defined key_iomput 108 CALL xios_finalize ! end mpp communications with xios111 CALL xios_finalize ! end mpp communications with xios 109 112 #else 110 IF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 111 ENDIF 113 IF( lk_mpp ) CALL mppstop ! end mpp communications 112 114 #endif 113 115 ! … … 161 163 IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 162 164 ! open reference and configuration namelist files 163 CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm )164 CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm )165 CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm ) 166 CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm ) 165 167 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 166 168 ! open /dev/null file to be able to supress output write easily 167 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 169 IF( Agrif_Root() ) THEN 170 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 171 #ifdef key_agrif 172 ELSE 173 numnul = Agrif_Parent(numnul) 174 #endif 175 ENDIF 168 176 ! 169 177 ! !--------------------! … … 177 185 ! 178 186 ! finalize the definition of namctl variables 179 IF( sn_cfctl%l_allon ) THEN 180 ! Turn on all options. 181 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 182 ! Ensure all processors are active 183 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 184 ELSEIF( sn_cfctl%l_config ) THEN 185 ! Activate finer control of report outputs 186 ! optionally switch off output from selected areas (note this only 187 ! applies to output which does not involve global communications) 188 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 189 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 190 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 191 ELSE 192 ! turn off all options. 193 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 194 ENDIF 187 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 188 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 195 189 ! 196 190 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 235 229 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 236 230 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 237 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 231 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 238 232 ! 239 233 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file … … 266 260 IF( ln_timing ) CALL timing_start( 'nemo_init') 267 261 ! 268 CALL phy_cst ! Physical constants269 CALL eos_init ! Equation of state262 CALL phy_cst ! Physical constants 263 CALL eos_init ! Equation of state 270 264 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 271 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain265 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 272 266 IF( sn_cfctl%l_prtctl ) & 273 267 & CALL prt_ctl_init ! Print control 274 275 IF( ln_rstart ) THEN ! Restart from a file 276 ! ! ------------------- 277 CALL rst_read( Nbb, Nnn ) ! Read the restart file 278 CALL day_init ! model calendar (using both namelist and restart infos) 279 ! 280 ELSE ! Start from rest 281 ! ! --------------- 282 numror = 0 ! define numror = 0 -> no restart file to read 283 neuler = 0 ! Set time-step indicator at nit000 (euler forward) 284 CALL day_init ! model calendar (using both namelist and restart infos) 285 ENDIF 286 ! 287 288 ! ! external forcing 289 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 268 ! 269 270 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 271 272 ! ! external forcing 273 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 290 274 291 275 ! … … 311 295 WRITE(numout,*) '~~~~~~~~' 312 296 WRITE(numout,*) ' Namelist namctl' 313 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk314 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon315 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config316 297 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 317 298 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 321 302 WRITE(numout,*) ' sn_cfctl%l_prttrc = ', sn_cfctl%l_prttrc 322 303 WRITE(numout,*) ' sn_cfctl%l_oasout = ', sn_cfctl%l_oasout 323 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 324 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 325 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 326 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 304 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 305 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 306 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 307 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 327 308 WRITE(numout,*) ' level of print nn_print = ', nn_print 328 309 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls … … 439 420 !!---------------------------------------------------------------------- 440 421 ! 441 ierr = oce_alloc () ! ocean 422 ierr = oce_alloc () ! ocean 442 423 ierr = ierr + dia_wri_alloc() 443 424 ierr = ierr + dom_oce_alloc() ! ocean domain … … 448 429 END SUBROUTINE nemo_alloc 449 430 450 451 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)431 432 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 452 433 !!---------------------------------------------------------------------- 453 434 !! *** ROUTINE nemo_set_cfctl *** 454 435 !! 455 436 !! ** Purpose : Set elements of the output control structure to setto. 456 !! for_all should be .false. unless all areas are to be457 !! treated identically.458 437 !! 459 438 !! ** Method : Note this routine can be used to switch on/off some 460 !! types of output for selected areas but any output types 461 !! that involve global communications (e.g. mpp_max, glob_sum) 462 !! should be protected from selective switching by the 463 !! for_all argument 464 !!---------------------------------------------------------------------- 465 LOGICAL :: setto, for_all 466 TYPE(sn_ctl) :: sn_cfctl 467 !!---------------------------------------------------------------------- 468 IF( for_all ) THEN 469 sn_cfctl%l_runstat = setto 470 sn_cfctl%l_trcstat = setto 471 ENDIF 439 !! types of output for selected areas. 440 !!---------------------------------------------------------------------- 441 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 442 LOGICAL , INTENT(in ) :: setto 443 !!---------------------------------------------------------------------- 444 sn_cfctl%l_runstat = setto 445 sn_cfctl%l_trcstat = setto 472 446 sn_cfctl%l_oceout = setto 473 447 sn_cfctl%l_layout = setto … … 479 453 !!====================================================================== 480 454 END MODULE nemogcm 455 -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/sbcssm.F90
r12249 r13189 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/SAS 4.0 , NEMO Consortium (2018) 56 !! $Id: sbcssm.F90 1 0068 2018-08-28 14:09:04Z nicolasmartin$56 !! $Id: sbcssm.F90 12615 2020-03-26 15:18:49Z laurent $ 57 57 !! Software governed by the CeCILL license (see ./LICENSE) 58 58 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/step_c1d.F90
r12249 r13189 26 26 !!---------------------------------------------------------------------- 27 27 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 28 !! $Id: step_c1d.F90 1 0068 2018-08-28 14:09:04Z nicolasmartin$28 !! $Id: step_c1d.F90 12377 2020-02-12 14:39:06Z acc $ 29 29 !! Software governed by the CeCILL license (see ./LICENSE) 30 30 !!---------------------------------------------------------------------- … … 64 64 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice) 65 65 66 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 67 ! diagnostics and outputs 68 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 66 69 CALL dia_wri( kstp, Nnn ) ! ocean model: outputs 67 70 … … 75 78 ! Control and restarts 76 79 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 77 CALL stp_ctl( kstp, Nbb, Nnn, indic ) 80 CALL stp_ctl( kstp, Nnn ) 81 78 82 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 79 83 IF( lrst_oce ) CALL rst_write( kstp, Nbb, Nnn ) ! write output ocean restart file 80 84 ! 81 85 #if defined key_iomput 82 IF( kstp == nitend .OR. indic <0 ) CALL xios_context_finalize() ! needed for XIOS86 IF( kstp == nitend .OR. nstop > 0 ) CALL xios_context_finalize() ! needed for XIOS 83 87 ! 84 88 #endif -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/stpctl.F90
r12254 r13189 19 19 USE dom_oce ! ocean space and time domain variables 20 20 USE sbc_oce ! surface fluxes and stuff 21 ! 21 22 USE diawri ! Standard run outputs (dia_wri_state routine) 22 !23 23 USE in_out_manager ! I/O manager 24 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 25 25 USE lib_mpp ! distributed memory computing 26 26 ! 27 27 USE netcdf ! NetCDF library 28 28 IMPLICIT NONE … … 31 31 PUBLIC stp_ctl ! routine called by step.F90 32 32 33 INTEGER :: idrun, idtime, idtau, idqns, idemp, istatus34 LOGICAL :: lsomeoce33 INTEGER :: nrunid ! netcdf file id 34 INTEGER, DIMENSION(3) :: nvarid ! netcdf variable id 35 35 !!---------------------------------------------------------------------- 36 36 !! NEMO/SAS 4.0 , NEMO Consortium (2018) … … 40 40 CONTAINS 41 41 42 SUBROUTINE stp_ctl( kt, K bb, Kmm, kindic)42 SUBROUTINE stp_ctl( kt, Kmm ) 43 43 !!---------------------------------------------------------------------- 44 44 !! *** ROUTINE stp_ctl *** 45 !! 45 !! 46 46 !! ** Purpose : Control the run 47 47 !! 48 48 !! ** Method : - Save the time step in numstp 49 49 !! - Print it each 50 time steps 50 !! - Stop the run IF problem encountered by setting indic=-3 50 !! - Stop the run IF problem encountered by setting nstop > 0 51 !! Problems checked: wind stress module max larger than 5 N/m^2 52 !! non-solar heat flux max larger than 2000 W/m^2 53 !! Evaporation-Precip max larger than 1.E-3 kg/m^2/s 51 54 !! 52 55 !! ** Actions : "time.step" file = last ocean time-step 53 56 !! "run.stat" file = run statistics 54 !! nstop indicator sheared among all local domain (lk_mpp=T)57 !! nstop indicator sheared among all local domain 55 58 !!---------------------------------------------------------------------- 56 59 INTEGER, INTENT(in ) :: kt ! ocean time-step index 57 INTEGER, INTENT(in ) :: Kbb, Kmm ! ocean time level index 58 INTEGER, INTENT(inout) :: kindic ! error indicator 59 !! 60 REAL(wp), DIMENSION(3) :: zmax 61 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 62 CHARACTER(len=20) :: clname 63 !!---------------------------------------------------------------------- 64 ! 65 ll_wrtstp = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 66 ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 67 ll_wrtruns = ll_colruns .AND. lwm 68 IF( kt == nit000 .AND. lwp ) THEN 69 WRITE(numout,*) 70 WRITE(numout,*) 'stp_ctl : time-stepping control' 71 WRITE(numout,*) '~~~~~~~' 72 ! ! open time.step file 73 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 74 ! ! open run.stat file(s) at start whatever 75 ! ! the value of sn_cfctl%ptimincr 76 IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 60 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 61 !! 62 INTEGER :: ji ! dummy loop indices 63 INTEGER :: idtime, istatus 64 INTEGER , DIMENSION(4) :: iareasum, iareamin, iareamax 65 INTEGER , DIMENSION(3,3) :: iloc ! min/max loc indices 66 REAL(wp) :: zzz ! local real 67 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 68 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 69 LOGICAL, DIMENSION(jpi,jpj) :: llmsk 70 CHARACTER(len=20) :: clname 71 !!---------------------------------------------------------------------- 72 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 73 ! 74 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 75 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 76 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 77 ! 78 IF( kt == nit000 ) THEN 79 ! 80 IF( lwp ) THEN 81 WRITE(numout,*) 82 WRITE(numout,*) 'stp_ctl : time-stepping control' 83 WRITE(numout,*) '~~~~~~~' 84 ENDIF 85 ! ! open time.step ascii file, done only by 1st subdomain 86 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 87 ! 88 IF( ll_wrtruns ) THEN 89 ! ! open run.stat ascii file, done only by 1st subdomain 77 90 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 91 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 78 92 clname = 'run.stat.nc' 79 93 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 80 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 81 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 82 istatus = NF90_DEF_VAR( idrun, 'tau_max', NF90_DOUBLE, (/ idtime /), idtau ) 83 istatus = NF90_DEF_VAR( idrun, 'qns_max', NF90_DOUBLE, (/ idtime /), idqns ) 84 istatus = NF90_DEF_VAR( idrun, 'emp_max', NF90_DOUBLE, (/ idtime /), idemp ) 85 istatus = NF90_ENDDEF(idrun) 86 ENDIF 87 ENDIF 88 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 89 ! 90 IF(lwm .AND. ll_wrtstp) THEN !== current time step ==! ("time.step" file) 94 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 95 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 96 istatus = NF90_DEF_VAR( nrunid, 'tau_max', NF90_DOUBLE, (/ idtime /), nvarid(1) ) 97 istatus = NF90_DEF_VAR( nrunid, 'qns_max', NF90_DOUBLE, (/ idtime /), nvarid(2) ) 98 istatus = NF90_DEF_VAR( nrunid, 'emp_max', NF90_DOUBLE, (/ idtime /), nvarid(3) ) 99 istatus = NF90_ENDDEF(nrunid) 100 ENDIF 101 ! 102 ENDIF 103 ! 104 ! !== write current time step ==! 105 ! !== done only by 1st subdomain at writting timestep ==! 106 IF( lwm .AND. ll_wrtstp ) THEN 91 107 WRITE ( numstp, '(1x, i8)' ) kt 92 108 REWIND( numstp ) 93 109 ENDIF 94 ! 95 ! !== test of extrema ==! 96 zmax(1) = MAXVAL( taum(:,:) , mask = tmask(:,:,1) == 1._wp ) ! max wind stress module 97 zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = tmask(:,:,1) == 1._wp ) ! max non-solar heat flux 98 zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = tmask(:,:,1) == 1._wp ) ! max E-P 99 ! 110 ! !== test of local extrema ==! 111 ! !== done by all processes at every time step ==! 112 llmsk(:,:) = tmask(:,:,1) == 1._wp 113 IF( COUNT( llmsk(:,:) ) > 0 ) THEN ! avoid huge values sent back for land processors... 114 zmax(1) = MAXVAL( taum(:,:) , mask = llmsk ) ! max wind stress module 115 zmax(2) = MAXVAL( ABS( qns(:,:) ) , mask = llmsk ) ! max non-solar heat flux 116 zmax(3) = MAXVAL( ABS( emp(:,:) ) , mask = llmsk ) ! max E-P 117 ELSE 118 IF( ll_colruns ) THEN ! default value: must not be kept when calling mpp_max -> must be as small as possible 119 zmax(1:3) = -HUGE(1._wp) 120 ELSE ! default value: must not give true for any of the tests bellow (-> avoid manipulating HUGE...) 121 zmax(1:3) = 0._wp 122 ENDIF 123 ENDIF 124 zmax(4) = REAL( nstop, wp ) ! stop indicator 125 ! !== get global extrema ==! 126 ! !== done by all processes if writting run.stat ==! 100 127 IF( ll_colruns ) THEN 128 zmaxlocal(:) = zmax(:) 101 129 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 102 nstop = NINT( zmax(3) ) ! nstop indicator sheared among all local domains 103 ENDIF 104 ! !== run statistics ==! ("run.stat" files) 130 nstop = NINT( zmax(4) ) ! update nstop indicator (now sheared among all local domains) 131 ENDIF 132 ! !== write "run.stat" files ==! 133 ! !== done only by 1st subdomain at writting timestep ==! 105 134 IF( ll_wrtruns ) THEN 106 135 WRITE(numrun,9500) kt, zmax(1), zmax(2), zmax(3) 107 istatus = NF90_PUT_VAR( idrun, idtau, (/ zmax(1)/), (/kt/), (/1/) ) 108 istatus = NF90_PUT_VAR( idrun, idqns, (/ zmax(2)/), (/kt/), (/1/) ) 109 istatus = NF90_PUT_VAR( idrun, idemp, (/ zmax(3)/), (/kt/), (/1/) ) 110 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 111 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 136 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 137 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 138 istatus = NF90_PUT_VAR( nrunid, nvarid(3), (/ zmax(3)/), (/kt/), (/1/) ) 139 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 112 140 END IF 113 ! !== error handling ==! 114 IF( ( sn_cfctl%l_glochk .OR. lsomeoce ) .AND. ( & ! domain contains some ocean points, check for sensible ranges 115 & zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 ) 116 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2) 117 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( kg/m^2/s) 118 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) ) THEN ! NaN encounter in the tests 119 120 !! We are 1D so no need to find a spatial location of the rogue point. 121 141 ! !== error handling ==! 142 ! !== done by all processes at every time step ==! 143 ! 144 IF( zmax(1) > 5._wp .OR. & ! too large wind stress ( > 5 N/m^2 ) 145 & zmax(2) > 2000._wp .OR. & ! too large non-solar heat flux ( > 2000 W/m^2 ) 146 & zmax(3) > 1.E-3_wp .OR. & ! too large net freshwater flux ( > 1.E-3 kg/m^2/s ) 147 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) .OR. & ! NaN encounter in the tests 148 & ABS( zmax(1) + zmax(2) + zmax(3) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 149 ! 150 iloc(:,:) = 0 151 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 152 ! first: close the netcdf file, so we can read it 153 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 154 ! get global loc on the min/max 155 CALL mpp_maxloc( 'stpctl', taum(:,:) , tmask(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 156 CALL mpp_maxloc( 'stpctl',ABS( qns(:,:) ), tmask(:,:,1), zzz, iloc(1:2,2) ) 157 CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), tmask(:,:,1), zzz, iloc(1:2,3) ) 158 ! find which subdomain has the max. 159 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 160 DO ji = 1, 4 161 IF( zmaxlocal(ji) == zmax(ji) ) THEN 162 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 163 ENDIF 164 END DO 165 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 166 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 167 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 168 ELSE ! find local min and max locations: 169 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 170 iloc(1:2,1) = MAXLOC( taum(:,:) , mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 171 iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 172 iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 173 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 174 ENDIF 175 ! 122 176 WRITE(ctmp1,*) ' stp_ctl: |tau_mod| > 5 N/m2 or |qns| > 2000 W/m2 or |emp| > 1.E-3 or NaN encounter in the tests' 123 WRITE(ctmp2,9500) kt, zmax(1), zmax(2), zmax(3) 124 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort.nc file' 125 177 CALL wrt_line( ctmp2, kt, '|tau| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 178 CALL wrt_line( ctmp3, kt, '|qns| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 179 CALL wrt_line( ctmp4, kt, 'emp max', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 180 IF( Agrif_Root() ) THEN 181 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 182 ELSE 183 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 184 ENDIF 185 ! 126 186 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 127 128 IF( .NOT. sn_cfctl%l_glochk ) THEN 129 WRITE(ctmp8,*) 'E R R O R message from sub-domain: ', narea 130 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 131 ELSE 132 CALL ctl_stop( ctmp1, ' ', ctmp2, ' ', ctmp6, ' ' ) 133 ENDIF 134 135 kindic = -3 136 ! 187 ! 188 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 189 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 190 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 191 ENDIF 192 ELSE ! only mpi subdomains with errors are here -> STOP now 193 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 194 ENDIF 195 ! 196 ENDIF 197 ! 198 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 199 ngrdstop = Agrif_Fixed() ! store which grid got this error 200 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 137 201 ENDIF 138 202 ! … … 140 204 ! 141 205 END SUBROUTINE stp_ctl 206 207 208 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 209 !!---------------------------------------------------------------------- 210 !! *** ROUTINE wrt_line *** 211 !! 212 !! ** Purpose : write information line 213 !! 214 !!---------------------------------------------------------------------- 215 CHARACTER(len=*), INTENT( out) :: cdline 216 CHARACTER(len=*), INTENT(in ) :: cdprefix 217 REAL(wp), INTENT(in ) :: pval 218 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 219 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 220 ! 221 CHARACTER(len=80) :: clsuff 222 CHARACTER(len=9 ) :: clkt, clsum, clmin, clmax 223 CHARACTER(len=9 ) :: cli, clj, clk 224 CHARACTER(len=1 ) :: clfmt 225 CHARACTER(len=4 ) :: cl4 ! needed to be able to compile with Agrif, I don't know why 226 INTEGER :: ifmtk 227 !!---------------------------------------------------------------------- 228 WRITE(clkt , '(i9)') kt 229 230 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 231 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 232 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 233 WRITE(clfmt, '(i1)') INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 234 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 235 WRITE(clmax, cl4) kmax-1 236 ! 237 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 238 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 239 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 240 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 241 ! 242 IF( ksum == 1 ) THEN ; WRITE(clsuff,9100) TRIM(clmin) 243 ELSE ; WRITE(clsuff,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 244 ENDIF 245 IF(kloc(3) == 0) THEN 246 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 247 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 248 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(clsuff) 249 ELSE 250 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 251 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 252 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 253 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(clsuff) 254 ENDIF 255 ! 256 9100 FORMAT('MPI rank ', a) 257 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 258 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 259 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 260 ! 261 END SUBROUTINE wrt_line 262 142 263 143 264 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90
r11930 r13189 14 14 !! usr_def_hgr : initialize the horizontal mesh 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce , ONLY: nimpp, njmpp 16 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain 17 17 USE c1d , ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 18 18 USE par_oce ! ocean space and time domain … … 30 30 !!---------------------------------------------------------------------- 31 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: usrdef_hgr.F90 1 0072 2018-08-28 15:21:50Z nicolasmartin $32 !! $Id: usrdef_hgr.F90 12489 2020-02-28 15:55:11Z davestorkey $ 33 33 !! Software governed by the CeCILL license (see ./LICENSE) 34 34 !!---------------------------------------------------------------------- … … 54 54 !! 55 55 !! ** Action : - define longitude & latitude of t-, u-, v- and f-points (in degrees) 56 !! - define coriolis parameter at f-point if the domain in not on the sphere 56 !! - define coriolis parameter at f-point if the domain in not on the sphere (on beta-plane) 57 57 !! - define i- & j-scale factors at t-, u-, v- and f-points (in meters) 58 58 !! - define u- & v-surfaces (if gridsize reduction is used in some straits) (in m2) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/usrdef_nam.F90
r12249 r13189 8 8 !!====================================================================== 9 9 !! History : 4.0 ! 2016-03 (S. Flavoni, G. Madec) Original code 10 !! History :4.x ! 2019-10 (L. Brodeau) for STATION_ASF (C1D meets SAS)10 !! 4.x ! 2019-10 (L. Brodeau) for STATION_ASF (C1D meets SAS) 11 11 !!---------------------------------------------------------------------- 12 12 … … 15 15 !! usr_def_hgr : initialize the horizontal mesh 16 16 !!---------------------------------------------------------------------- 17 USE dom_oce , ONLY: nimpp, njmpp 18 USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate17 USE dom_oce , ONLY: nimpp, njmpp ! ocean space and time domain 18 !!! USE dom_oce , ONLY: ln_zco, ln_zps, ln_sco ! flag of type of coordinate 19 19 USE par_oce ! ocean space and time domain 20 20 USE phycst ! physical constants … … 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 35 !! $Id: usrdef_nam.F90 1 1536 2019-09-11 13:54:18Z smasson$35 !! $Id: usrdef_nam.F90 12377 2020-02-12 14:39:06Z acc $ 36 36 !! Software governed by the CeCILL license (see ./LICENSE) 37 37 !!---------------------------------------------------------------------- … … 68 68 kk_cfg = 0 69 69 70 ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 75or vertical levels70 ! Global Domain size: STATION_ASF domain is 3 x 3 grid-points x 2 or vertical levels 71 71 kpi = 3 72 72 kpj = 3 73 kpk = 173 kpk = 2 ! 2, rather than 1, because 1 would cause some issues... like overflow in array boundary indexes, etc... 74 74 ! 75 75 ! ! Set the lateral boundary condition of the global domain -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/MY_SRC/usrdef_zgr.F90
r12038 r13189 1 1 MODULE usrdef_zgr 2 2 !!====================================================================== 3 !! *** MODULEusrdef_zgr ***3 !! *** MODULE usrdef_zgr *** 4 4 !! 5 5 !! === STATION_ASF case === 6 6 !! 7 !! user defined :vertical coordinate system of a user configuration7 !! User defined : vertical coordinate system of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 ! 2019-10 (L. Brodeau) Original code 9 !! History : 4.0 ! 2016-06 (G. Madec) Original code 10 !! 4.x ! 2019-10 (L. Brodeau) Station ASF 10 11 !!---------------------------------------------------------------------- 11 12 12 13 !!---------------------------------------------------------------------- 13 !! usr_def_zgr : user defined vertical coordinate system (required) 14 !! usr_def_zgr : user defined vertical coordinate system 15 !! zgr_z : reference 1D z-coordinate 16 !! zgr_top_bot: ocean top and bottom level indices 17 !! zgr_zco : 3D verticl coordinate in pure z-coordinate case 14 18 !!--------------------------------------------------------------------- 15 19 USE oce ! ocean variables 16 !USE dom_oce ! ocean domain17 !USE depth_e3 ! depth <=> e318 20 USE usrdef_nam ! User defined : namelist variables 19 21 ! … … 21 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 24 USE lib_mpp ! distributed memory computing library 23 USE timing ! Timing24 25 25 26 IMPLICIT NONE 26 27 PRIVATE 27 28 28 PUBLIC usr_def_zgr ! called by domzgr.F9029 PUBLIC usr_def_zgr ! called by domzgr.F90 29 30 30 31 !!---------------------------------------------------------------------- 31 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 32 !! $Id: usrdef_zgr.F90 1 0072 2018-08-28 15:21:50Z nicolasmartin$33 !! $Id: usrdef_zgr.F90 12377 2020-02-12 14:39:06Z acc $ 33 34 !! Software governed by the CeCILL license (see ./LICENSE) 34 35 !!---------------------------------------------------------------------- … … 47 48 !! 48 49 !!---------------------------------------------------------------------- 49 LOGICAL , INTENT( out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags ( read in namusr_def )50 LOGICAL , INTENT( 51 REAL(wp), DIMENSION(:) , INTENT( 52 REAL(wp), DIMENSION(:) , INTENT( 53 REAL(wp), DIMENSION(:,:,:), INTENT( 54 REAL(wp), DIMENSION(:,:,:), INTENT( 55 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pe3w , pe3uw, pe3vw ! i-scale factors56 INTEGER , DIMENSION(:,:) , INTENT( 50 LOGICAL , INTENT(out) :: ld_zco, ld_zps, ld_sco ! vertical coordinate flags 51 LOGICAL , INTENT(out) :: ld_isfcav ! under iceshelf cavity flag 52 REAL(wp), DIMENSION(:) , INTENT(out) :: pdept_1d, pdepw_1d ! 1D grid-point depth [m] 53 REAL(wp), DIMENSION(:) , INTENT(out) :: pe3t_1d , pe3w_1d ! 1D grid-point depth [m] 54 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pdept, pdepw ! grid-point depth [m] 55 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3t , pe3u , pe3v , pe3f ! vertical scale factors [m] 56 REAL(wp), DIMENSION(:,:,:), INTENT(out) :: pe3w , pe3uw, pe3vw ! i-scale factors 57 INTEGER , DIMENSION(:,:) , INTENT(out) :: k_top, k_bot ! first & last ocean level 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 61 62 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 62 63 ! 63 64 ! 65 ! type of vertical coordinate 66 ! --------------------------- 64 67 ld_zco = .TRUE. ! z-coordinate without ocean cavities 65 68 ld_zps = .FALSE. 66 69 ld_sco = .FALSE. 67 70 ld_isfcav = .FALSE. 68 71 72 !! 1st level (the only one that matters) 69 73 pdept_1d(1) = rn_dept1 ! depth (m) at which the SST is taken/measured == depth of first T point! 70 74 pdepw_1d(1) = 0._wp … … 72 76 pe3w_1d(1) = rn_dept1 ! LB??? 73 77 74 pdept(:,:,:) = rn_dept1 75 pdepw(:,:,:) = 0._wp 76 pe3t(:,:,:) = 2._wp*rn_dept1 77 pe3u(:,:,:) = 2._wp*rn_dept1 78 pe3v(:,:,:) = 2._wp*rn_dept1 79 pe3f(:,:,:) = 2._wp*rn_dept1 80 pe3w(:,:,:) = rn_dept1 ! LB??? 81 pe3uw(:,:,:) = rn_dept1 ! LB??? 82 pe3vw(:,:,:) = rn_dept1 ! LB??? 78 pdept(:,:,1) = rn_dept1 79 pdepw(:,:,1) = 0._wp 80 pe3t(:,:,1) = 2._wp*rn_dept1 81 pe3u(:,:,1) = 2._wp*rn_dept1 82 pe3v(:,:,1) = 2._wp*rn_dept1 83 pe3f(:,:,1) = 2._wp*rn_dept1 84 pe3w(:,:,1) = rn_dept1 ! LB??? 85 pe3uw(:,:,1) = rn_dept1 ! LB??? 86 pe3vw(:,:,1) = rn_dept1 ! LB??? 87 88 !! 2nd level, technically useless (only for the sake of code stability) 89 pdept_1d(2) = 3._wp*rn_dept1 90 pdepw_1d(2) = 2._wp*rn_dept1 91 pe3t_1d(2) = 2._wp*rn_dept1 92 pe3w_1d(2) = 2._wp*rn_dept1 93 94 pdept(:,:,2) = 3._wp*rn_dept1 95 pdepw(:,:,2) = 2._wp*rn_dept1 96 pe3t(:,:,2) = 2._wp*rn_dept1 97 pe3u(:,:,2) = 2._wp*rn_dept1 98 pe3v(:,:,2) = 2._wp*rn_dept1 99 pe3f(:,:,2) = 2._wp*rn_dept1 100 pe3w(:,:,2) = 2._wp*rn_dept1 101 pe3uw(:,:,2) = 2._wp*rn_dept1 102 pe3vw(:,:,2) = 2._wp*rn_dept1 103 83 104 k_top = 1 84 105 k_bot = 1 85 ! 106 86 107 END SUBROUTINE usr_def_zgr 87 108 !!====================================================================== -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/STATION_ASF/README.md
r12031 r13189 1 1 2 2 ## WARNING: TOTALLY-ALPHA-STUFF / DOCUMENT IN THE PROCESS OF BEING WRITEN! 3 4 NOTE: if working with the trunk of NEMO, you are strongly advised to use the same test-case but on the `NEMO-examples` GitHub depo: 5 https://github.com/NEMO-ocean/NEMO-examples/tree/master/STATION_ASF 6 3 7 4 8 # *Station Air-Sea Fluxes* demonstration case -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/VORTEX/MY_SRC/domvvl.F90
r12495 r13189 63 63 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 64 64 65 !! * Substitutions 66 # include "do_loop_substitute.h90" 65 67 !!---------------------------------------------------------------------- 66 68 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 188 190 gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 189 191 gdepw(:,:,1,Kbb) = 0.0_wp 190 DO jk = 2, jpk ! vertical sum 191 DO jj = 1,jpj 192 DO ji = 1,jpi 193 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 194 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 195 ! ! 0.5 where jk = mikt 192 DO_3D_11_11( 2, jpk ) 193 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 194 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 195 ! ! 0.5 where jk = mikt 196 196 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 197 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 198 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 199 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 200 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 201 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 202 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 203 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 204 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 205 END DO 206 END DO 207 END DO 197 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 198 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 199 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 200 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 201 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 202 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 203 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 204 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 205 END_3D 208 206 ! 209 207 ! !== thickness of the water column !! (ocean portion only) … … 240 238 ENDIF 241 239 IF ( ln_vvl_zstar_at_eqtor ) THEN ! use z-star in vicinity of the Equator 242 DO jj = 1, jpj 243 DO ji = 1, jpi 240 DO_2D_11_11 244 241 !!gm case |gphi| >= 6 degrees is useless initialized just above by default 245 IF( ABS(gphit(ji,jj)) >= 6.) THEN 246 ! values outside the equatorial band and transition zone (ztilde) 247 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 248 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 249 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 250 ! values inside the equatorial band (ztilde as zstar) 251 frq_rst_e3t(ji,jj) = 0.0_wp 252 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 253 ELSE ! transition band (2.5 to 6 degrees N/S) 254 ! ! (linearly transition from z-tilde to z-star) 255 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 256 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 257 & * 180._wp / 3.5_wp ) ) 258 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 259 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 260 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 261 & * 180._wp / 3.5_wp ) ) 262 ENDIF 263 END DO 264 END DO 242 IF( ABS(gphit(ji,jj)) >= 6.) THEN 243 ! values outside the equatorial band and transition zone (ztilde) 244 frq_rst_e3t(ji,jj) = 2.0_wp * rpi / ( MAX( rn_rst_e3t , rsmall ) * 86400.e0_wp ) 245 frq_rst_hdv(ji,jj) = 2.0_wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.e0_wp ) 246 ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN ! Equator strip ==> z-star 247 ! values inside the equatorial band (ztilde as zstar) 248 frq_rst_e3t(ji,jj) = 0.0_wp 249 frq_rst_hdv(ji,jj) = 1.0_wp / rn_Dt 250 ELSE ! transition band (2.5 to 6 degrees N/S) 251 ! ! (linearly transition from z-tilde to z-star) 252 frq_rst_e3t(ji,jj) = 0.0_wp + (frq_rst_e3t(ji,jj)-0.0_wp)*0.5_wp & 253 & * ( 1.0_wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 254 & * 180._wp / 3.5_wp ) ) 255 frq_rst_hdv(ji,jj) = (1.0_wp / rn_Dt) & 256 & + ( frq_rst_hdv(ji,jj)-(1.e0_wp / rn_Dt) )*0.5_wp & 257 & * ( 1._wp - COS( rad*(ABS(gphit(ji,jj))-2.5_wp) & 258 & * 180._wp / 3.5_wp ) ) 259 ENDIF 260 END_2D 265 261 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 266 262 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 … … 357 353 END DO 358 354 ! 359 IF( ln_vvl_ztilde .OR. ln_vvl_layer.AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate !360 ! ! ------baroclinic part------ !355 IF( (ln_vvl_ztilde .OR. ln_vvl_layer) .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! 356 ! ! ------baroclinic part------ ! 361 357 ! I - initialization 362 358 ! ================== … … 411 407 zwu(:,:) = 0._wp 412 408 zwv(:,:) = 0._wp 413 DO jk = 1, jpkm1 ! a - first derivative: diffusive fluxes 414 DO jj = 1, jpjm1 415 DO ji = 1, jpim1 ! vector opt. 416 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 417 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 418 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 419 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 420 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 421 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 422 END DO 423 END DO 424 END DO 425 DO jj = 1, jpj ! b - correction for last oceanic u-v points 426 DO ji = 1, jpi 427 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 428 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 429 END DO 430 END DO 431 DO jk = 1, jpkm1 ! c - second derivative: divergence of diffusive fluxes 432 DO jj = 2, jpjm1 433 DO ji = 2, jpim1 ! vector opt. 434 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 435 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 436 & ) * r1_e1e2t(ji,jj) 437 END DO 438 END DO 439 END DO 409 DO_3D_10_10( 1, jpkm1 ) 410 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 411 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 412 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 413 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 414 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 415 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 416 END_3D 417 DO_2D_11_11 418 un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 419 vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 420 END_2D 421 DO_3D_00_00( 1, jpkm1 ) 422 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 423 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 424 & ) * r1_e1e2t(ji,jj) 425 END_3D 440 426 ! ! d - thickness diffusion transport: boundary conditions 441 427 ! (stored for tracer advction and continuity equation) … … 444 430 ! 4 - Time stepping of baroclinic scale factors 445 431 ! --------------------------------------------- 446 ! Leapfrog time stepping447 ! ~~~~~~~~~~~~~~~~~~~~~~448 432 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 449 433 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + rDt * tmask(:,:,:) * tilde_e3t_a(:,:,:) … … 646 630 ! Horizontal scale factor interpolations 647 631 ! -------------------------------------- 648 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are al lready computed in dynnxt632 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 649 633 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 650 634 … … 663 647 gdepw(:,:,1,Kmm) = 0.0_wp 664 648 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 665 DO jk = 2, jpk 666 DO jj = 1,jpj 667 DO ji = 1,jpi 668 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 669 ! 1 for jk = mikt 670 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 671 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 672 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 673 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 674 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 675 END DO 676 END DO 677 END DO 649 DO_3D_11_11( 2, jpk ) 650 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 651 ! 1 for jk = mikt 652 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 653 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 654 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 655 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 656 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 657 END_3D 678 658 679 659 ! Local depth and Inverse of the local depth of the water … … 722 702 ! 723 703 CASE( 'U' ) !* from T- to U-point : hor. surface weighted mean 724 DO jk = 1, jpk 725 DO jj = 1, jpjm1 726 DO ji = 1, jpim1 ! vector opt. 727 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 728 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 729 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 730 END DO 731 END DO 732 END DO 704 DO_3D_10_10( 1, jpk ) 705 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2u(ji,jj) & 706 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 707 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 708 END_3D 733 709 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 734 710 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 735 711 ! 736 712 CASE( 'V' ) !* from T- to V-point : hor. surface weighted mean 737 DO jk = 1, jpk 738 DO jj = 1, jpjm1 739 DO ji = 1, jpim1 ! vector opt. 740 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 741 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 742 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 743 END DO 744 END DO 745 END DO 713 DO_3D_10_10( 1, jpk ) 714 pe3_out(ji,jj,jk) = 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) * r1_e1e2v(ji,jj) & 715 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 716 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 717 END_3D 746 718 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 747 719 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 748 720 ! 749 721 CASE( 'F' ) !* from U-point to F-point : hor. surface weighted mean 750 DO jk = 1, jpk 751 DO jj = 1, jpjm1 752 DO ji = 1, jpim1 ! vector opt. 753 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 754 & * r1_e1e2f(ji,jj) & 755 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 756 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 757 END DO 758 END DO 759 END DO 722 DO_3D_10_10( 1, jpk ) 723 pe3_out(ji,jj,jk) = 0.5_wp * ( umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 724 & * r1_e1e2f(ji,jj) & 725 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 726 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 727 END_3D 760 728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 761 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) … … 832 800 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 833 801 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 802 ! 834 803 ! ! --------- ! 835 804 ! ! all cases ! 836 805 ! ! --------- ! 806 ! 837 807 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 838 808 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) … … 850 820 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files' 851 821 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 852 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'822 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 853 823 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 854 824 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) … … 857 827 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files' 858 828 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 859 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'829 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 860 830 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 861 831 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) … … 864 834 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file' 865 835 IF(lwp) write(numout,*) 'Compute scale factor from sshn' 866 IF(lwp) write(numout,*) 'l_1st_euler is forced to .true.'836 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 867 837 DO jk = 1, jpk 868 838 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & … … 917 887 ssh(:,:,Kbb) = -ssh_ref 918 888 919 DO jj = 1, jpj 920 DO ji = 1, jpi 921 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 922 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 923 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 924 ENDIF 925 ENDDO 926 ENDDO 889 DO_2D_11_11 890 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 891 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 892 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 893 ENDIF 894 END_2D 927 895 ENDIF !If test case else 928 896 … … 935 903 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 936 904 937 DO ji = 1, jpi 938 DO jj = 1, jpj 939 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 940 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 941 ENDIF 942 END DO 943 END DO 905 DO_2D_11_11 906 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 907 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 908 ENDIF 909 END_2D 944 910 ! 945 911 ELSE -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/VORTEX/MY_SRC/usrdef_hgr.F90
r10074 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 88 90 #endif 89 91 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 93 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 94 95 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 96 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 97 plamv(ji,jj) = plamt(ji,jj) 98 plamf(ji,jj) = plamu(ji,jj) 99 100 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 101 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 102 pphiu(ji,jj) = pphit(ji,jj) 103 pphif(ji,jj) = pphiv(ji,jj) 104 END DO 105 END DO 92 DO_2D_11_11 93 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 ) 94 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 95 96 plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 97 plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 98 plamv(ji,jj) = plamt(ji,jj) 99 plamf(ji,jj) = plamu(ji,jj) 100 101 pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 102 pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 103 pphiu(ji,jj) = pphit(ji,jj) 104 pphif(ji,jj) = pphiv(ji,jj) 105 END_2D 106 106 ! 107 107 ! Horizontal scale factors (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/VORTEX/MY_SRC/usrdef_istate.F90
r12495 r13189 28 28 PUBLIC usr_def_istate ! called by istate.F90 29 29 30 !! * Substitutions 31 # include "do_loop_substitute.h90" 30 32 !!---------------------------------------------------------------------- 31 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 73 75 ! Sea level: 74 76 za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 75 DO ji=1, jpi 76 DO jj=1, jpj 77 zx = glamt(ji,jj) * 1.e3 78 zy = gphit(ji,jj) * 1.e3 79 zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 80 pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 81 END DO 82 END DO 77 DO_2D_11_11 78 zx = glamt(ji,jj) * 1.e3 79 zy = gphit(ji,jj) * 1.e3 80 zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 81 pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 82 END_2D 83 83 ! 84 84 ! temperature: 85 DO ji=1, jpi 86 DO jj=1, jpj 87 zx = glamt(ji,jj) * 1.e3 88 zy = gphit(ji,jj) * 1.e3 89 DO jk=1,jpk 90 zdt = pdept(ji,jj,jk) 91 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 92 IF (zdt < zH) THEN 93 zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 94 & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + exp(-zH))); 95 ENDIF 96 pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 97 END DO 85 DO_2D_11_11 86 zx = glamt(ji,jj) * 1.e3 87 zy = gphit(ji,jj) * 1.e3 88 DO jk=1,jpk 89 zdt = pdept(ji,jj,jk) 90 zrho1 = rho0 * (1._wp + zn2*zdt/grav) 91 IF (zdt < zH) THEN 92 zrho1 = zrho1 - zP0 * (1._wp-EXP(zdt-zH)) & 93 & * EXP(-(zx**2+zy**2)/zlambda**2) / (grav*(zH -1._wp + EXP(-zH))); 94 ENDIF 95 pts(ji,jj,jk,jp_tem) = (20._wp + (rho0-zrho1) / 0.28_wp) * ptmask(ji,jj,jk) 98 96 END DO 99 END DO97 END_2D 100 98 ! 101 99 ! salinity: … … 104 102 ! velocities: 105 103 za = 2._wp * zP0 / (zf0 * rho0 * zlambda**2) 106 DO ji=1, jpim1 107 DO jj=1, jpj 108 zx = glamu(ji,jj) * 1.e3 109 zy = gphiu(ji,jj) * 1.e3 110 DO jk=1, jpk 111 zdu = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji+1,jj,jk)) 112 IF (zdu < zH) THEN 113 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 114 pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 115 ELSE 116 pu(ji,jj,jk) = 0._wp 117 ENDIF 118 END DO 104 DO_2D_00_00 105 zx = glamu(ji,jj) * 1.e3 106 zy = gphiu(ji,jj) * 1.e3 107 DO jk=1, jpk 108 zdu = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji+1,jj,jk)) 109 IF (zdu < zH) THEN 110 zf = (zH-1._wp-zdu+EXP(zdu-zH)) / (zH-1._wp+EXP(-zH)) 111 pu(ji,jj,jk) = (za * zf * zy * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji+1,jj,jk) 112 ELSE 113 pu(ji,jj,jk) = 0._wp 114 ENDIF 119 115 END DO 120 END DO116 END_2D 121 117 ! 122 DO ji=1, jpi 123 DO jj=1, jpjm1 124 zx = glamv(ji,jj) * 1.e3 125 zy = gphiv(ji,jj) * 1.e3 126 DO jk=1, jpk 127 zdv = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji,jj+1,jk)) 128 IF (zdv < zH) THEN 129 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 130 pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 131 ELSE 132 pv(ji,jj,jk) = 0._wp 133 ENDIF 134 END DO 118 DO_2D_00_00 119 zx = glamv(ji,jj) * 1.e3 120 zy = gphiv(ji,jj) * 1.e3 121 DO jk=1, jpk 122 zdv = 0.5_wp * (pdept(ji ,jj,jk) + pdept(ji,jj+1,jk)) 123 IF (zdv < zH) THEN 124 zf = (zH-1._wp-zdv+EXP(zdv-zH)) / (zH-1._wp+EXP(-zH)) 125 pv(ji,jj,jk) = -(za * zf * zx * EXP(-(zx**2+zy**2)/zlambda**2)) * ptmask(ji,jj,jk) * ptmask(ji,jj+1,jk) 126 ELSE 127 pv(ji,jj,jk) = 0._wp 128 ENDIF 135 129 END DO 136 END DO 137 138 CALL lbc_lnk( 'usrdef_istate', pu, 'U', -1. ) 139 CALL lbc_lnk( 'usrdef_istate', pv, 'V', -1. ) 130 END_2D 131 ! 132 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 140 133 ! 141 134 END SUBROUTINE usr_def_istate -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/VORTEX/MY_SRC/usrdef_zgr.F90
r12377 r13189 192 192 CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. ) ! set surrounding land to zero (here jperio=0 ==>> closed) 193 193 ! 194 k_bot(:,:) = INT( z2d(:,:) )! =jpkm1 over the ocean point, =0 elsewhere194 k_bot(:,:) = NINT( z2d(:,:) ) ! =jpkm1 over the ocean point, =0 elsewhere 195 195 ! 196 196 k_top(:,:) = MIN( 1 , k_bot(:,:) ) ! = 1 over the ocean point, =0 elsewhere -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/WAD/MY_SRC/usrdef_hgr.F90
r10074 r13189 26 26 PUBLIC usr_def_hgr ! called by domhgr.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 72 74 ! !== grid point position ==! (in kilometers) 73 75 zfact = rn_dx * 1.e-3 ! conversion in km 74 DO jj = 1, jpj 75 DO ji = 1, jpi ! longitude 76 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 77 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 78 plamv(ji,jj) = plamt(ji,jj) 79 plamf(ji,jj) = plamu(ji,jj) 80 ! ! latitude 81 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 82 pphiu(ji,jj) = pphit(ji,jj) 83 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 84 pphif(ji,jj) = pphiv(ji,jj) 85 END DO 86 END DO 76 DO_2D_11_11 77 ! ! longitude 78 plamt(ji,jj) = zfact * ( - 0.5 + REAL( ji-1 + nimpp-1 , wp ) ) 79 plamu(ji,jj) = zfact * ( REAL( ji-1 + nimpp-1 , wp ) ) 80 plamv(ji,jj) = plamt(ji,jj) 81 plamf(ji,jj) = plamu(ji,jj) 82 ! ! latitude 83 pphit(ji,jj) = zfact * ( - 0.5 + REAL( jj-1 + njmpp-1 , wp ) ) 84 pphiu(ji,jj) = pphit(ji,jj) 85 pphiv(ji,jj) = zfact * ( REAL( jj-1 + njmpp-1 , wp ) ) 86 pphif(ji,jj) = pphiv(ji,jj) 87 END_2D 87 88 ! 88 89 ! !== Horizontal scale factors ==! (in meters) -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/WAD/MY_SRC/usrdef_istate.F90
r10074 r13189 26 26 PUBLIC usr_def_istate ! called in istate.F90 27 27 28 !! * Substitutions 29 # include "do_loop_substitute.h90" 28 30 !!---------------------------------------------------------------------- 29 31 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 174 176 ! Apply minimum wetdepth criterion 175 177 ! 176 do jj = 1,jpj 177 do ji = 1,jpi 178 IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN 179 pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) ) 180 ENDIF 181 end do 182 end do 178 DO_2D_11_11 179 IF( ht_0(ji,jj) + pssh(ji,jj) < rn_wdmin1 ) THEN 180 pssh(ji,jj) = ptmask(ji,jj,1)*( rn_wdmin1 - ht_0(ji,jj) ) 181 ENDIF 182 END_2D 183 183 ! 184 184 END SUBROUTINE usr_def_istate -
NEMO/branches/2020/dev_r12472_ASINTER-05_Masson_CurrentFeedback/tests/WAD/MY_SRC/usrdef_zgr.F90
r12377 r13189 29 29 PUBLIC usr_def_zgr ! called by domzgr.F90 30 30 31 !! * Substitutions 32 # include "do_loop_substitute.h90" 31 33 !!---------------------------------------------------------------------- 32 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 242 244 ! at v-point: averaging zht 243 245 zhv = 0._wp 244 DO jj = 1, jpjm1245 zhv( :,jj) = 0.5_wp * ( zht(:,jj) + zht(:,jj+1) )246 END DO246 DO_2D_00_00 247 zhv(ji,jj) = 0.5_wp * ( zht(ji,jj) + zht(ji,jj+1) ) 248 END_2D 247 249 CALL lbc_lnk( 'usrdef_zgr', zhv, 'V', 1. ) ! boundary condition: this mask the surrounding grid-points 248 250 DO jj = mj0(1), mj1(1) ! first row of global domain only … … 279 281 ht_0 = zht 280 282 k_bot(:,:) = jpkm1 * k_top(:,:) !* bottom ocean = jpk-1 (here use k_top as a land mask) 281 DO jj = 1, jpj 282 DO ji = 1, jpi 283 IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 284 k_bot(ji,jj) = 0 285 k_top(ji,jj) = 0 286 ENDIF 287 END DO 288 END DO 283 DO_2D_11_11 284 IF( zht(ji,jj) <= -(rn_wdld - rn_wdmin2)) THEN 285 k_bot(ji,jj) = 0 286 k_top(ji,jj) = 0 287 ENDIF 288 END_2D 289 289 ! 290 290 ! !* terrain-following coordinate with e3.(k)=cst) 291 291 ! ! OVERFLOW case : identical with j-index (T=V, U=F) 292 DO jj = 1, jpjm1 293 DO ji = 1, jpim1 294 z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp) 295 DO jk = 1, jpk 296 zwet = MAX( zht(ji,jj), rn_wdmin1 ) 297 pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk , wp ) - 0.5_wp ) 298 pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp ) ) 299 pe3t (ji,jj,jk) = zwet * z1_jpkm1 300 pe3w (ji,jj,jk) = zwet * z1_jpkm1 301 zwet = MAX( zhu(ji,jj), rn_wdmin1 ) 302 pe3u (ji,jj,jk) = zwet * z1_jpkm1 303 pe3uw(ji,jj,jk) = zwet * z1_jpkm1 304 pe3f (ji,jj,jk) = zwet * z1_jpkm1 305 zwet = MAX( zhv(ji,jj), rn_wdmin1 ) 306 pe3v (ji,jj,jk) = zwet * z1_jpkm1 307 pe3vw(ji,jj,jk) = zwet * z1_jpkm1 308 END DO 309 END DO 310 END DO 292 DO_2D_00_00 293 z1_jpkm1 = 1._wp / REAL( k_bot(ji,jj) - k_top(ji,jj) + 1 , wp) 294 DO jk = 1, jpk 295 zwet = MAX( zht(ji,jj), rn_wdmin1 ) 296 pdept(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk , wp ) - 0.5_wp ) 297 pdepw(ji,jj,jk) = zwet * z1_jpkm1 * ( REAL( jk-1 , wp ) ) 298 pe3t (ji,jj,jk) = zwet * z1_jpkm1 299 pe3w (ji,jj,jk) = zwet * z1_jpkm1 300 zwet = MAX( zhu(ji,jj), rn_wdmin1 ) 301 pe3u (ji,jj,jk) = zwet * z1_jpkm1 302 pe3uw(ji,jj,jk) = zwet * z1_jpkm1 303 pe3f (ji,jj,jk) = zwet * z1_jpkm1 304 zwet = MAX( zhv(ji,jj), rn_wdmin1 ) 305 pe3v (ji,jj,jk) = zwet * z1_jpkm1 306 pe3vw(ji,jj,jk) = zwet * z1_jpkm1 307 END DO 308 END_2D 311 309 CALL lbc_lnk( 'usrdef_zgr', pdept, 'T', 1. ) 312 310 CALL lbc_lnk( 'usrdef_zgr', pdepw, 'T', 1. )
Note: See TracChangeset
for help on using the changeset viewer.