- Timestamp:
- 2020-12-03T14:55:50+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC
- Files:
-
- 21 deleted
- 109 edited
- 9 copied
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/AGRIF_DEMO/EXPREF/1_namelist_cfg
r13558 r14054 299 299 !----------------------------------------------------------------------- 300 300 ln_dynvor_een = .true. ! energy & enstrophy scheme 301 nn_een_e3f = 0 ! =0 e3f = mean masked e3t divided by 4302 301 / 303 302 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg
r13558 r14054 300 300 !----------------------------------------------------------------------- 301 301 ln_dynvor_een = .true. ! energy & enstrophy scheme 302 nn_een_e3f = 0 ! =0 e3f = mean masked e3t divided by 4303 302 / 304 303 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/AMM12/EXPREF/namelist_cfg
r13558 r14054 291 291 !----------------------------------------------------------------------- 292 292 ln_dynvor_een = .true. ! energy & enstrophy scheme 293 nn_een_e3f = 1! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)293 nn_e3f_typ = 1 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 294 294 / 295 295 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg
r14049 r14054 334 334 !----------------------------------------------------------------------- 335 335 ln_dynvor_een = .true. ! energy & enstrophy scheme 336 nn_een_e3f = 0 ! =0 e3f = mean masked e3t divided by 4337 336 / 338 337 !----------------------------------------------------------------------- … … 389 388 ! ! = 3 as =2 with distinct dissipative an mixing length scale 390 389 nn_etau = 1 ! penetration of tke below the mixed layer (ML) due to NIWs 391 392 393 390 ! ! = 0 none ; = 1 add a tke source below the ML 391 ! ! = 2 add a tke source just at the base of the ML 392 ! ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T) 394 393 ln_mxhsw = .false. ! surface mixing length scale = F(wave height) 395 394 / -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_top_cfg
r12845 r14054 20 20 ! 21 21 ln_trcdta = .true. ! Initialisation from data input file (T) or not (F) 22 ln_trcbc = . false.! Enables Boundary conditions22 ln_trcbc = .true. ! Enables Boundary conditions 23 23 ! ! ! ! ! ! 24 ! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc !25 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. 26 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .false., .true. , .false. 27 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .false., .false., .false. 28 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 29 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 30 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 31 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 32 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 33 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 34 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. 35 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 36 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 37 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 38 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 39 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 40 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 41 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 42 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 43 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .false., .false., .false. 44 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 45 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 46 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 47 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 48 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 24 ! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc ! ais 25 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. , .false. 26 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .false., .true. , .false. , .false. 27 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .false., .false., .false. , .false. 28 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 29 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false. 30 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 31 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false. 32 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 33 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 34 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. , .false. 35 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 36 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 37 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 38 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .true. 39 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 40 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 41 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 42 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 43 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .false., .false., .false. , .false. 44 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 45 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 46 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 47 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false. 48 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 49 49 / 50 50 !----------------------------------------------------------------------- … … 57 57 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 58 58 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 59 sn_trcdta(1) = 'data_DIC_nomask ' , -12. , 'DIC' , .false. , .true. , 'yearly' , '' , '' , ''60 sn_trcdta(2) = 'data_A lkalini_nomask' , -12. , 'Alkalini', .false. , .true. , 'yearly' , '' , '' , ''61 sn_trcdta(3) = 'data_O 2_nomask' , -1. , 'O2' , .true. , .true. , 'yearly' , '' , '' , ''62 sn_trcdta(5) = 'data_PO4_nomask ' , -1. , 'PO4' , .true. , .true. , 'yearly' , '' , '' , ''63 sn_trcdta(7) = 'data_S i_nomask' , -1. , 'Si' , .true. , .true. , 'yearly' , '' , '' , ''64 sn_trcdta(10) = 'data_DOC_nomask ' , -12. , 'DOC' , .false. , .true. , 'yearly' , '' , '' , ''65 sn_trcdta(14) = 'data_F er_nomask' , -12. , 'Fer' , .false. , .true. , 'yearly' , '' , '' , ''66 sn_trcdta(23) = 'data_NO3_nomask ' , -1. , 'NO3' , .true. , .true. , 'yearly' , '' , '' , ''67 rn_trfac(1) = 1.0 e-06 ! multiplicative factor68 rn_trfac(2) = 1.0 e-06 ! - - - -59 sn_trcdta(1) = 'data_DIC_nomask.nc', -12 , 'PiDIC' , .false. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 60 sn_trcdta(2) = 'data_ALK_nomask.nc', -12 , 'TALK' , .false. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 61 sn_trcdta(3) = 'data_OXY_nomask.nc', -1 , 'O2' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 62 sn_trcdta(5) = 'data_PO4_nomask.nc', -1 , 'PO4' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 63 sn_trcdta(7) = 'data_SIL_nomask.nc', -1 , 'Si' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 64 sn_trcdta(10) = 'data_DOC_nomask.nc', -1 , 'DOC' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 65 sn_trcdta(14) = 'data_FER_nomask.nc', -1 , 'Fer' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 66 sn_trcdta(23) = 'data_NO3_nomask.nc', -1 , 'NO3' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 67 rn_trfac(1) = 1.028e-06 ! multiplicative factor 68 rn_trfac(2) = 1.028e-06 ! - - - - 69 69 rn_trfac(3) = 44.6e-06 ! - - - - 70 70 rn_trfac(5) = 122.0e-06 ! - - - - 71 71 rn_trfac(7) = 1.0e-06 ! - - - - 72 rn_trfac(10) = 1.0 73 rn_trfac(14) = 1.0 72 rn_trfac(10) = 1.0e-06 ! - - - - 73 rn_trfac(14) = 1.0e-06 ! - - - - 74 74 rn_trfac(23) = 7.6e-06 ! - - - - 75 75 / … … 110 110 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 111 111 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 112 sn_trcsbc(5) = 'dust.orca.new' , -1 , 'dustpo4' , .true. , .true. , 'yearly' , ' ' , '' , ''113 sn_trcsbc(7) = 'dust.orca.new' , -1 , 'dustsi' , .true. , .true. , 'yearly' , ' ' , '' , ''114 sn_trcsbc(14) = 'dust.orca.new' , -1 , 'dustfer' , .true. , .true. , 'yearly' , ' ' , '' , ''115 sn_trcsbc(23) = 'ndeposition.orca', -12 , 'ndep ' , .false. , .true. , 'yearly' , '' , '' , ''112 sn_trcsbc(5) = 'dust.orca.new' , -1 , 'dustpo4' , .true. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 113 sn_trcsbc(7) = 'dust.orca.new' , -1 , 'dustsi' , .true. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 114 sn_trcsbc(14) = 'dust.orca.new' , -1 , 'dustfer' , .true. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 115 sn_trcsbc(23) = 'ndeposition.orca', -12 , 'ndep2' , .false. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 116 116 rn_trsfac(5) = 8.264e-02 ! ( 0.021 / 31. * 122 ) 117 117 rn_trsfac(7) = 3.313e-01 ! ( 8.8 / 28.1 ) … … 120 120 rn_sbc_time = 1. ! Time scaling factor for SBC and CBC data (seconds in a day) 121 121 ! 122 sn_trccbc(1) = 'river.orca' , 120, 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''123 sn_trccbc(2) = 'river.orca' , 120, 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''124 sn_trccbc(5) = 'river.orca' , 120, 'riverdip' , .true. , .true. , 'yearly' , '' , '' , ''125 sn_trccbc(7) = 'river.orca' , 120, 'riverdsi' , .true. , .true. , 'yearly' , '' , '' , ''126 sn_trccbc(10) = 'river.orca' , 120, 'riverdoc' , .true. , .true. , 'yearly' , '' , '' , ''127 sn_trccbc(14) = 'river.orca' , 120, 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''128 sn_trccbc(23) = 'river.orca' , 120, 'riverdin' , .true. , .true. , 'yearly' , '' , '' , ''122 sn_trccbc(1) = 'river.orca' , -12 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , '' 123 sn_trccbc(2) = 'river.orca' , -12 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , '' 124 sn_trccbc(5) = 'river.orca' , -12 , 'riverdip' , .true. , .true. , 'yearly' , '' , '' , '' 125 sn_trccbc(7) = 'river.orca' , -12 , 'riverdsi' , .true. , .true. , 'yearly' , '' , '' , '' 126 sn_trccbc(10) = 'river.orca' , -12 , 'riverdoc' , .true. , .true. , 'yearly' , '' , '' , '' 127 sn_trccbc(14) = 'river.orca' , -12 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , '' 128 sn_trccbc(23) = 'river.orca' , -12 , 'riverdin' , .true. , .true. , 'yearly' , '' , '' , '' 129 129 rn_trcfac(1) = 8.333e+01 ! ( data in Mg/m2/yr : 1e3/12/ryyss) 130 130 rn_trcfac(2) = 8.333e+01 ! ( 1e3 /12 ) … … 140 140 !----------------------------------------------------------------------- 141 141 / 142 !----------------------------------------------------------------------- 143 &namtrc_ais ! Representation of Antarctic Ice Sheet tracers supply 144 !----------------------------------------------------------------------- 145 / -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/ORCA2_OFF_PISCES/EXPREF/namelist_top_cfg
r12845 r14054 19 19 ln_c14 = .false. 20 20 ! 21 ln_trcdta = .true. 22 ln_trcbc = . false. ! Enables Boundary conditions21 ln_trcdta = .true. ! Initialisation from data input file (T) or not (F) 22 ln_trcbc = .true. ! Enables Boundary conditions 23 23 ! ! ! ! ! ! 24 ! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc !25 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. 26 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .false., .true. , .false. 27 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .false., .false., .false. 28 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 29 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 30 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 31 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 32 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 33 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 34 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. 35 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 36 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 37 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 38 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 39 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 40 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 41 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 42 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 43 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .false., .false., .false. 44 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 45 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 46 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 47 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. 48 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .false., .false., .false. 24 ! ! name ! title of the field ! units ! init ! sbc ! cbc ! obc ! ais 25 sn_tracer(1) = 'DIC ' , 'Dissolved inorganic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. , .false. 26 sn_tracer(2) = 'Alkalini' , 'Total Alkalinity Concentration ', 'eq/L ' , .true. , .false., .true. , .false. , .false. 27 sn_tracer(3) = 'O2 ' , 'Dissolved Oxygen Concentration ', 'mol-C/L' , .true. , .false., .false., .false. , .false. 28 sn_tracer(4) = 'CaCO3 ' , 'Calcite Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 29 sn_tracer(5) = 'PO4 ' , 'Phosphate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false. 30 sn_tracer(6) = 'POC ' , 'Small organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 31 sn_tracer(7) = 'Si ' , 'Silicate Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false. 32 sn_tracer(8) = 'PHY ' , 'Nanophytoplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 33 sn_tracer(9) = 'ZOO ' , 'Microzooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 34 sn_tracer(10) = 'DOC ' , 'Dissolved organic Concentration ', 'mol-C/L' , .true. , .false., .true. , .false. , .false. 35 sn_tracer(11) = 'PHY2 ' , 'Diatoms Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 36 sn_tracer(12) = 'ZOO2 ' , 'Mesozooplankton Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 37 sn_tracer(13) = 'DSi ' , 'Diatoms Silicate Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 38 sn_tracer(14) = 'Fer ' , 'Dissolved Iron Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .true. 39 sn_tracer(15) = 'BFe ' , 'Big iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 40 sn_tracer(16) = 'GOC ' , 'Big organic carbon Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 41 sn_tracer(17) = 'SFe ' , 'Small iron particles Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 42 sn_tracer(18) = 'DFe ' , 'Diatoms iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 43 sn_tracer(19) = 'GSi ' , 'Sinking biogenic Silicate Concentration', 'mol-C/L' , .false. , .false., .false., .false. , .false. 44 sn_tracer(20) = 'NFe ' , 'Nano iron Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 45 sn_tracer(21) = 'NCHL ' , 'Nano chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 46 sn_tracer(22) = 'DCHL ' , 'Diatoms chlorophyl Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 47 sn_tracer(23) = 'NO3 ' , 'Nitrates Concentration ', 'mol-C/L' , .true. , .true. , .true. , .false. , .false. 48 sn_tracer(24) = 'NH4 ' , 'Ammonium Concentration ', 'mol-C/L' , .false. , .false., .false., .false. , .false. 49 49 / 50 50 !----------------------------------------------------------------------- … … 57 57 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 58 58 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 59 sn_trcdta(1) = 'data_DIC_nomask ' , -12. , 'DIC' , .false. , .true. , 'yearly' , '' , '' , ''60 sn_trcdta(2) = 'data_A lkalini_nomask' , -12. , 'Alkalini', .false. , .true. , 'yearly' , '' , '' , ''61 sn_trcdta(3) = 'data_O 2_nomask' , -1. , 'O2' , .true. , .true. , 'yearly' , '' , '' , ''62 sn_trcdta(5) = 'data_PO4_nomask ' , -1. , 'PO4' , .true. , .true. , 'yearly' , '' , '' , ''63 sn_trcdta(7) = 'data_S i_nomask' , -1. , 'Si' , .true. , .true. , 'yearly' , '' , '' , ''64 sn_trcdta(10) = 'data_DOC_nomask ' , -12. , 'DOC' , .false. , .true. , 'yearly' , '' , '' , ''65 sn_trcdta(14) = 'data_F er_nomask' , -12. , 'Fer' , .false. , .true. , 'yearly' , '' , '' , ''66 sn_trcdta(23) = 'data_NO3_nomask ' , -1. , 'NO3' , .true. , .true. , 'yearly' , '' , '' , ''67 rn_trfac(1) = 1.0 e-06 ! multiplicative factor68 rn_trfac(2) = 1.0 e-06 ! - - - -59 sn_trcdta(1) = 'data_DIC_nomask.nc', -12 , 'PiDIC' , .false. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 60 sn_trcdta(2) = 'data_ALK_nomask.nc', -12 , 'TALK' , .false. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 61 sn_trcdta(3) = 'data_OXY_nomask.nc', -1 , 'O2' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 62 sn_trcdta(5) = 'data_PO4_nomask.nc', -1 , 'PO4' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 63 sn_trcdta(7) = 'data_SIL_nomask.nc', -1 , 'Si' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 64 sn_trcdta(10) = 'data_DOC_nomask.nc', -1 , 'DOC' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 65 sn_trcdta(14) = 'data_FER_nomask.nc', -1 , 'Fer' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 66 sn_trcdta(23) = 'data_NO3_nomask.nc', -1 , 'NO3' , .true. , .true. , 'yearly' , 'weights_3D_r360x180_bilin.nc' , '' , '' 67 rn_trfac(1) = 1.028e-06 ! multiplicative factor 68 rn_trfac(2) = 1.028e-06 ! - - - - 69 69 rn_trfac(3) = 44.6e-06 ! - - - - 70 70 rn_trfac(5) = 122.0e-06 ! - - - - 71 71 rn_trfac(7) = 1.0e-06 ! - - - - 72 rn_trfac(10) = 1.0 73 rn_trfac(14) = 1.0 72 rn_trfac(10) = 1.0e-06 ! - - - - 73 rn_trfac(14) = 1.0e-06 ! - - - - 74 74 rn_trfac(23) = 7.6e-06 ! - - - - 75 75 / … … 110 110 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 111 111 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 112 sn_trcsbc(5) = 'dust.orca.new' , -1 , 'dustpo4' , .true. , .true. , 'yearly' , ' ' , '' , ''113 sn_trcsbc(7) = 'dust.orca.new' , -1 , 'dustsi' , .true. , .true. , 'yearly' , ' ' , '' , ''114 sn_trcsbc(14) = 'dust.orca.new' , -1 , 'dustfer' , .true. , .true. , 'yearly' , ' ' , '' , ''115 sn_trcsbc(23) = 'ndeposition.orca', -12 , 'ndep ' , .false. , .true. , 'yearly' , '' , '' , ''112 sn_trcsbc(5) = 'dust.orca.new' , -1 , 'dustpo4' , .true. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 113 sn_trcsbc(7) = 'dust.orca.new' , -1 , 'dustsi' , .true. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 114 sn_trcsbc(14) = 'dust.orca.new' , -1 , 'dustfer' , .true. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 115 sn_trcsbc(23) = 'ndeposition.orca', -12 , 'ndep2' , .false. , .true. , 'yearly' , 'weights_2D_r360x180_bilin.nc' , '' , '' 116 116 rn_trsfac(5) = 8.264e-02 ! ( 0.021 / 31. * 122 ) 117 117 rn_trsfac(7) = 3.313e-01 ! ( 8.8 / 28.1 ) … … 120 120 rn_sbc_time = 1. ! Time scaling factor for SBC and CBC data (seconds in a day) 121 121 ! 122 sn_trccbc(1) = 'river.orca' , 120, 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''123 sn_trccbc(2) = 'river.orca' , 120, 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''124 sn_trccbc(5) = 'river.orca' , 120, 'riverdip' , .true. , .true. , 'yearly' , '' , '' , ''125 sn_trccbc(7) = 'river.orca' , 120, 'riverdsi' , .true. , .true. , 'yearly' , '' , '' , ''126 sn_trccbc(10) = 'river.orca' , 120, 'riverdoc' , .true. , .true. , 'yearly' , '' , '' , ''127 sn_trccbc(14) = 'river.orca' , 120, 'riverdic' , .true. , .true. , 'yearly' , '' , '' , ''128 sn_trccbc(23) = 'river.orca' , 120, 'riverdin' , .true. , .true. , 'yearly' , '' , '' , ''122 sn_trccbc(1) = 'river.orca' , -12 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , '' 123 sn_trccbc(2) = 'river.orca' , -12 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , '' 124 sn_trccbc(5) = 'river.orca' , -12 , 'riverdip' , .true. , .true. , 'yearly' , '' , '' , '' 125 sn_trccbc(7) = 'river.orca' , -12 , 'riverdsi' , .true. , .true. , 'yearly' , '' , '' , '' 126 sn_trccbc(10) = 'river.orca' , -12 , 'riverdoc' , .true. , .true. , 'yearly' , '' , '' , '' 127 sn_trccbc(14) = 'river.orca' , -12 , 'riverdic' , .true. , .true. , 'yearly' , '' , '' , '' 128 sn_trccbc(23) = 'river.orca' , -12 , 'riverdin' , .true. , .true. , 'yearly' , '' , '' , '' 129 129 rn_trcfac(1) = 8.333e+01 ! ( data in Mg/m2/yr : 1e3/12/ryyss) 130 130 rn_trcfac(2) = 8.333e+01 ! ( 1e3 /12 ) … … 140 140 !----------------------------------------------------------------------- 141 141 / 142 !----------------------------------------------------------------------- 143 &namtrc_ais ! Representation of Antarctic Ice Sheet tracers supply 144 !----------------------------------------------------------------------- 145 / -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/axis_def_nemo.xml
r12377 r14054 14 14 <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> 15 15 <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 16 <axis id="depthf" long_name="Vertical F levels" unit="m" positive="down" /> 16 17 <axis id="nfloat" long_name="Float number" unit="-" /> 17 18 <axis id="icbcla" long_name="Iceberg class" unit="1" /> -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/domain_def_nemo.xml
r12276 r14054 181 181 <domain id="EqW" domain_ref="grid_W" > <zoom_domain id="EqW"/> </domain> 182 182 183 <!-- F grid --> 184 <domain id="grid_F" long_name="grid F"/> 185 183 186 <!-- zonal mean grid --> 184 187 <domain_group id="gznl"> -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/field_def_nemo-oce.xml
r14049 r14054 171 171 <field id="tosmint_pot" long_name="vertical integral of potential temperature times density" standard_name="integral_wrt_depth_of_product_of_density_and_potential_temperature" unit="(kg m2) degree_C" /> 172 172 173 173 <field id="ht" long_name="water column height at T point" standard_name="water_column_height_T" unit="m" /> 174 174 <field id="ssh" long_name="sea surface height" standard_name="sea_surface_height_above_geoid" unit="m" /> 175 175 <field id="ssh2" long_name="square of sea surface height" standard_name="square_of_sea_surface_height_above_geoid" unit="m2" > ssh * ssh </field > … … 190 190 191 191 <!-- Energy - horizontal divergence --> 192 <field id="sKE" long_name="surface kinetic energy" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" grid_ref="grid_T_2D" /> 192 193 <field id="hdiv" long_name="horizontal divergence" unit="s-1" grid_ref="grid_T_3D" /> 193 194 … … 270 271 271 272 <field_group id="OSMOSIS_T" grid_ref="grid_T_2D"> 273 <field id="hml" long_name="mixed layr depth" unit="m" /> 274 <field id="hbl" long_name="boundary layer depth" unit="m" /> 275 <field id="dh" long_name="Pycnocline thickness" unit=" m" /> 276 <field id="ibld" long_name="index of boundary layer depth" unit="#" /> 277 <field id="imld" long_name="index of mixed layer depth" unit="#" /> 278 <field id="zhbl" long_name="boundary layer depth -grid" unit="m" /> 279 <field id="zhml" long_name="mixed layer depth - grid" unit="m" /> 280 <field id="zdh" long_name="Pycnocline depth - grid" unit=" m" /> 281 <field id="zustke" long_name="magnitude of stokes drift at T-points" unit="m/s" /> 282 <field id="us_x" long_name="i component of active Stokes drift" unit="m/s" /> 283 <field id="us_y" long_name="j component of active Stokes drift" unit="m/s" /> 284 <field id="dstokes" long_name="stokes drift depth scale" unit="m" /> 272 285 <field id="zwth0" long_name="surface non-local temperature flux" unit="deg m/s" /> 273 286 <field id="zws0" long_name="surface non-local salinity flux" unit="psu m/s" /> 274 <field id="hbl" long_name="boundary layer depth" unit="m" />275 <field id="hbli" long_name="initial boundary layer depth" unit="m" />276 <field id="dstokes" long_name="stokes drift depth scale" unit="m" />277 <field id="zustke" long_name="magnitude of stokes drift at T-points" unit="m/s" />278 287 <field id="zwstrc" long_name="convective velocity scale" unit="m/s" /> 288 <field id="zustar" long_name="friction velocity" unit="m/s" /> 279 289 <field id="zwstrl" long_name="langmuir velocity scale" unit="m/s" /> 280 <field id="zustar" long_name="friction velocity" unit="m/s" /> 281 <field id="zhbl" long_name="boundary layer depth" unit="m" /> 282 <field id="zhml" long_name="mixed layer depth" unit="m" /> 290 <field id="zvstr" long_name="mixed velocity scale" unit="m/s" /> 291 <field id="zla" long_name="langmuir number" unit="m/s" /> 283 292 <field id="wind_wave_abs_power" long_name="\rho |U_s| x u*^2" unit="mW" /> 284 293 <field id="wind_wave_power" long_name="U_s \dot tau" unit="mW" /> 285 294 <field id="wind_power" long_name="\rho u*^3" unit="mW" /> 286 295 287 <!-- extraOSMOSIS diagnostics -->296 <!-- interior BL OSMOSIS diagnostics --> 288 297 <field id="zwthav" long_name="av turb flux of T in ml" unit="deg m/s" /> 289 298 <field id="zt_ml" long_name="av T in ml" unit="deg" /> 299 <field id="zhol" long_name="Hoenekker number" unit="#" /> 300 <field id="zws_ent" long_name="entrainment turb flux of S" unit="10^-3 m/s" /> 290 301 <field id="zwth_ent" long_name="entrainment turb flux of T" unit="deg m/s" /> 291 <field id="zhol" long_name="Hoenekker number" unit="#" /> 292 <field id="zdh" long_name="Pycnocline depth - grid" unit=" m" /> 293 </field_group> 294 295 <field_group id="OSMOSIS_W" grid_ref="grid_W_3D" operation="instant" > 302 <field id="zwb_ent" long_name="entrainment turb flux of buoyancy" unit="m^2/s^-3" /> 303 304 <field id="zdt_bl" long_name="temperature jump at base of BL" unit="deg" /> 305 <field id="zds_bl" long_name="salinity jump at base of BL" unit="10^-3" /> 306 <field id="zdb_bl" long_name="buoyancy jump at base of BL" unit="m/s^2" /> 307 <field id="zdu_bl" long_name="u jump at base of BL" unit="m/s" /> 308 <field id="zdv_bl" long_name="v jump at base of BL" unit="m/s" /> 309 310 <!-- extra OSMOSIS diagnostics for debugging --> 311 <field id="zsc_uw_1_0" long_name="zsc u-momentum flux on T after Stokes" unit="m^2/s^2" /> 312 <field id="zsc_uw_1_f" long_name="zsc u-momentum flux on T after Coriolis" unit="m^2/s^2" /> 313 <field id="zsc_vw_1_f" long_name="zsc v-momentum flux on T after Coriolis" unit="m^2/s^2" /> 314 <field id="zsc_uw_2_f" long_name="2nd zsc u-momentum flux on T after Coriolis" unit="m^2/s^2" /> 315 <field id="zsc_vw_2_f" long_name="2nd zsc v-momentum flux on T after Coriolis" unit="m^2/s^2" /> 316 <field id="zuw_bse" long_name="base u-flux T-points" unit="m^2/s^2" /> 317 <field id="zvw_bse" long_name="base v-flux T-points" unit="m^2/s^2" /> 318 319 <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 320 <field id="hmle" long_name="OBL FK-layer thickness" unit="m" /> 321 <field id="mld_prof" long_name="FK-layer depth index" unit="#" /> 322 <field id="zmld" long_name="target FK-layer thickness" unit="m" /> 323 <field id="zwb_fk" long_name="FK b-flux" unit="m^2 s^-3" /> 324 <field id="zwb_fk_b" long_name="layer averaged FK b-flux" unit="m^2 s^-3" /> 325 <field id="zdiff_mle" long_name="max FK diffusivity in MLE" unit=" 10^-4 m^2 s^-1" /> 326 <field id="zvel_mle" long_name="FK velocity scale in MLE" unit=" m s^-1" /> 327 </field_group> 328 329 <field_group id="OSMOSIS_W" grid_ref="grid_W_3D" > 330 <field id="zviscos" long_name="BL viscosity" unit="m^2/s" /> 296 331 <field id="ghamt" long_name="non-local temperature flux" unit="deg m/s" /> 297 332 <field id="ghams" long_name="non-local salinity flux" unit="psu m/s" /> 298 333 <field id="zdtdz_pyc" long_name="Pycnocline temperature gradient" unit=" deg/m" /> 299 </field_group> 334 <field id="zdsdz_pyc" long_name="Pycnocline salinity gradient" unit=" 10^-3/m" /> 335 <field id="zdbdz_pyc" long_name="Pycnocline buoyancy gradient" unit=" s^-2" /> 336 <field id="zdudz_pyc" long_name="Pycnocline u gradient" unit=" s^-2" /> 337 <field id="zdvdz_pyc" long_name="Pycnocline v gradient" unit=" s^-2" /> 338 339 <!-- extra OSMOSIS diagnostics for debugging --> 340 <field id="ghamu_00" long_name="initial non-local u-momentum flux" unit="m^2/s^2" /> 341 <field id="ghamv_00" long_name="initial non-local v-momentum flux" unit="m^2/s^2" /> 342 <field id="ghamu_0" long_name="after dstokes non-local u-momentum flux" unit="m^2/s^2" /> 343 <field id="ghamu_f" long_name="after Coriolis non-local u-momentum flux" unit="m^2/s^2" /> 344 <field id="ghamv_f" long_name="after Coriolis non-local v-momentum flux" unit="m^2/s^2" /> 345 <field id="ghamu_b" long_name="after buoyancy added non-local u-momentum flux" unit="m^2/s^2" /> 346 <field id="ghamv_b" long_name="after buoyancy added non-local v-momentum flux" unit="m^2/s^2" /> 347 <field id="ghamu_1" long_name="after entrainment non-local u-momentum flux" unit="m^2/s^2" /> 348 <field id="ghamv_1" long_name="after entrainment non-local v-momentum flux" unit="m^2/s^2" /> 349 </field_group> 300 350 301 351 <field_group id="OSMOSIS_U" grid_ref="grid_U_2D" > 302 352 <field id="ghamu" long_name="non-local u-momentum flux" grid_ref="grid_U_3D" unit="m^2/s^2" /> 303 <field id="us_x" long_name="i component of Stokes drift" unit="m/s" /> 304 </field_group> 353 <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 354 <field id="zdtdx" long_name="FK T x-gradient" unit=" deg C m^-1" /> 355 <field id="zdsdx" long_name="FK S x-gradient" unit=" 10^-3 m^-1" /> 356 <field id="dbdx_mle" long_name="FK B x-gradient" unit=" s^-2" /> 357 </field_group> 305 358 306 359 <field_group id="OSMOSIS_V" grid_ref="grid_V_2D" > 307 360 <field id="ghamv" long_name="non-local v-momentum flux" grid_ref="grid_V_3D" unit="m^2/s^2" /> 308 <field id="us_y" long_name="j component of Stokes drift" unit="m/s" /> 361 <!-- FK_OSM OSMOSIS diagnostics (require also ln_osm_mle=.true.--> 362 <field id="zdtdy" long_name="FK T y-gradient" unit=" deg C m^-1" /> 363 <field id="zdsdy" long_name="FK S y-gradient" unit=" 10^-3 m^-1" /> 364 <field id="dbdy_mle" long_name="FK B y-gradient" unit=" s^-2" /> 309 365 </field_group> 310 366 … … 501 557 502 558 <field_group id="grid_U" grid_ref="grid_U_2D"> 559 <field id="hu" long_name="water column height at U point" standard_name="water_column_height_U" unit="m" /> 503 560 <field id="e2u" long_name="U-cell width in meridional direction" standard_name="cell_width" unit="m" /> 504 561 <field id="e3u" long_name="U-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_U_3D" /> … … 571 628 <field id="e3v" long_name="V-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_V_3D" /> 572 629 <field id="e3v_0" long_name="Initial V-cell thickness" standard_name="ref_cell_thickness" unit="m" grid_ref="grid_V_3D" /> 630 <field id="hv" long_name="water column height at V point" standard_name="water_column_height_V" unit="m" /> 573 631 <field id="vtau" long_name="Wind Stress along j-axis" standard_name="surface_downward_y_stress" unit="N/m2" /> 574 632 <field id="voce" long_name="ocean current along j-axis" standard_name="sea_water_y_velocity" unit="m/s" grid_ref="grid_V_3D" /> … … 679 737 680 738 <!-- F grid --> 739 <field_group id="grid_F" grid_ref="grid_F_2D"> 740 <field id="e3f" long_name="F-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_F_3D" /> 741 <field id="e3f_0" long_name="F-cell thickness" standard_name="cell_thickness" unit="m" grid_ref="grid_F_3D" /> 742 <field id="hf" long_name="water column height at F point" standard_name="water_column_height_F" unit="m" /> 743 <field id="sKEf" long_name="surface kinetic energy at F point" standard_name="specific_kinetic_energy_of_sea_water" unit="m2/s2" /> 744 <field id="relvor" long_name="relative vorticity" standard_name="relative_vorticity" unit="1/s" /> 745 <field id="plavor" long_name="planetary vorticity" standard_name="planetary_vorticity" unit="1/s" /> 746 <field id="relpotvor" long_name="relative potential vorticity" standard_name="relpot_vorticity" unit="1/m.s" /> 747 <field id="abspotvor" long_name="absolute potential vorticity" standard_name="abspot_vorticity" unit="1/m.s" /> 748 <field id="Ens" long_name="enstrophy" standard_name="enstrophy" unit="1/m2.s2" /> 749 </field_group> 750 681 751 <!-- AGRIF sponge --> 682 752 <field id="agrif_spf" long_name=" AGRIF f-sponge coefficient" unit=" " /> … … 841 911 <field id="strd_zdfp" long_name="salinity -trend: pure vert. diffusion" unit="1e-3/s" /> 842 912 843 <!-- --> 913 <!-- ln_zdfosm=T only (OSMOSIS-OBL) --> 914 <field id="ttrd_osm" long_name="temperature-trend: OSM-OSBL non-local forcing" unit="degC/s" /> 915 <field id="strd_osm" long_name="salinity -trend: OSM-OSBL non-local forcing" unit="1e-3/s" /> 916 917 918 <!-- --> 844 919 <field id="ttrd_dmp" long_name="temperature-trend: interior restoring" unit="degC/s" /> 845 920 <field id="strd_dmp" long_name="salinity -trend: interior restoring" unit="1e-3/s" /> … … 877 952 <field id="strd_zdfp_e3t" unit="1e-3/s * m" > strd_zdfp * e3t </field> 878 953 954 <!-- ln_zdfosm=T only (OSMOSIS-OBL) --> 955 <field id="ttrd_osm_e3t" long_name="temperature-trend: OSM-OSBL non-local forcing" unit="degC/s * m" > ttrd_osm * e3t </field> 956 <field id="strd_osm_e3t" long_name="salinity -trend: OSM-OSBL non-local forcing" unit="1e-3/s * m" > strd_osm * e3t </field> 957 879 958 <!-- --> 880 959 <field id="ttrd_dmp_e3t" unit="degC/s * m" > ttrd_dmp * e3t </field> … … 892 971 <field id="ttrd_totad_li" long_name="layer integrated heat-trend: total advection" unit="W/m^2" > ttrd_totad_e3t * 1026.0 * 3991.86795711963 </field> 893 972 <field id="strd_totad_li" long_name="layer integrated salt-trend: total advection" unit="kg/(m^2 s)" > strd_totad_e3t * 1026.0 * 0.001 </field> 973 <field id="ttrd_osm_li" long_name="layer integrated heat-trend: non-local OSM" unit="W/m^2" > ttrd_osm_e3t * 1026.0 * 3991.86795711963 </field> 974 <field id="strd_osm_li" long_name="layer integrated salt-trend: non-local OSM" unit="kg/(m^2 s)" > strd_osm_e3t * 1026.0 * 0.001 </field> 894 975 <field id="ttrd_evd_li" long_name="layer integrated heat-trend: EVD convection" unit="W/m^2" > ttrd_evd_e3t * 1026.0 * 3991.86795711963 </field> 895 976 <field id="strd_evd_li" long_name="layer integrated salt-trend: EVD convection" unit="kg/(m^2 s)" > strd_evd_e3t * 1026.0 * 0.001 </field> … … 1099 1180 </field_group> 1100 1181 1182 <!-- TMB diagnostic output --> 1183 <field_group id="1h_grid_T_tmb" grid_ref="grid_T_2D" operation="instant"> 1184 <field id="top_temp" name="votemper_top" unit="degC" /> 1185 <field id="mid_temp" name="votemper_mid" unit="degC" /> 1186 <field id="bot_temp" name="votemper_bot" unit="degC" /> 1187 <field id="top_sal" name="vosaline_top" unit="psu" /> 1188 <field id="mid_sal" name="vosaline_mid" unit="psu" /> 1189 <field id="bot_sal" name="vosaline_bot" unit="psu" /> 1190 <field id="sshnmasked" name="sossheig" unit="m" /> 1191 </field_group> 1192 1101 1193 <field_group id="1h_grid_U_tmb" grid_ref="grid_U_2D" operation="instant"> 1102 1194 <field id="top_u" name="vozocrtx_top" unit="m/s" /> -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/grid_def_nemo.xml
r12377 r14054 53 53 <domain domain_ref="grid_W" /> 54 54 <axis axis_ref="depthw" /> 55 </grid> 56 <!-- --> 57 <grid id="grid_F_2D" > 58 <domain domain_ref="grid_F" /> 59 </grid> 60 <!-- --> 61 <grid id="grid_F_3D" > 62 <domain domain_ref="grid_F" /> 63 <axis axis_ref="depthf" /> 55 64 </grid> 56 65 <!-- --> -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/namelist_ref
r14049 r14054 629 629 ln_use_calving = .false. ! Use calving data even when nn_test_icebergs > 0 630 630 rn_speed_limit = 0. ! CFL speed limit for a berg 631 631 ! 632 ln_M2016 = .false. ! use Merino et al. (2016) modification (use of 3d ocean data instead of only sea surface data) 633 ln_icb_grd = .false. ! ground icb when icb bottom level hit oce bottom level (need ln_M2016 to be activated) 634 ! 632 635 cn_dir = './' ! root directory for the calving data location 633 636 !___________!_________________________!___________________!___________!_____________!________!___________!__________________!__________!_______________! … … 995 998 ln_dynvor_eeT = .false. ! energy conserving scheme (een using e3t) 996 999 ln_dynvor_een = .false. ! energy & enstrophy scheme 997 nn_een_e3f = 0 ! =0 e3f = mi(mj(e3t))/4 998 ! ! =1 e3f = mi(mj(e3t))/mi(mj( tmask)) 1000 ! 999 1001 ln_dynvor_msk = .false. ! vorticity multiplied by fmask (=T) ==>>> PLEASE DO NOT ACTIVATE 1000 ! ! (f-point vorticity schemes only) 1002 ! ! (f-point vorticity schemes only) 1003 ! 1004 nn_e3f_typ = 0 ! type of e3f (EEN, ENE, ENS, MIX only) =0 e3f = mi(mj(e3t))/4 1005 ! ! =1 e3f = mi(mj(e3t))/mi(mj( tmask)) 1001 1006 / 1002 1007 !----------------------------------------------------------------------- … … 1030 1035 ! ! Type of the operator : 1031 1036 ln_dynldf_OFF = .false. ! No operator (i.e. no explicit diffusion) 1037 nn_dynldf_typ = 0 ! =0 div-rot (default) ; =1 symmetric 1032 1038 ln_dynldf_lap = .false. ! laplacian operator 1033 1039 ln_dynldf_blp = .false. ! bilaplacian operator … … 1160 1166 ln_mxl0 = .true. ! surface mixing length scale = F(wind stress) (T) or not (F) 1161 1167 nn_mxlice = 2 ! type of scaling under sea-ice 1162 1163 1164 1165 1168 ! ! = 0 no scaling under sea-ice 1169 ! ! = 1 scaling with constant sea-ice thickness 1170 ! ! = 2 scaling with mean sea-ice thickness ( only with SI3 sea-ice model ) 1171 ! ! = 3 scaling with maximum sea-ice thickness 1166 1172 rn_mxlice = 10. ! max constant ice thickness value when scaling under sea-ice ( nn_mxlice=1) 1167 1173 rn_mxl0 = 0.04 ! surface buoyancy lenght scale minimum value … … 1170 1176 rn_lc = 0.15 ! coef. associated to Langmuir cells 1171 1177 nn_etau = 1 ! penetration of tke below the mixed layer (ML) due to NIWs 1172 1173 1174 1178 ! ! = 0 none ; = 1 add a tke source below the ML 1179 ! ! = 2 add a tke source just at the base of the ML 1180 ! ! = 3 as = 1 applied on HF part of the stress (ln_cpl=T) 1175 1181 rn_efr = 0.05 ! fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2) 1176 1182 nn_htau = 1 ! type of exponential decrease of tke penetration below the ML 1177 1178 1183 ! ! = 0 constant 10 m length scale 1184 ! ! = 1 0.5m at the equator to 30m poleward of 40 degrees 1179 1185 nn_eice = 1 ! attenutaion of langmuir & surface wave breaking under ice 1180 1186 ! ! = 0 no impact of ice cover on langmuir & surface wave breaking … … 1213 1219 &namzdf_osm ! OSM vertical diffusion (ln_zdfosm =T) 1214 1220 !----------------------------------------------------------------------- 1215 ln_use_osm_la = .false. ! Use namelistrn_osm_la1221 ln_use_osm_la = .false. ! Use rn_osm_la 1216 1222 rn_osm_la = 0.3 ! Turbulent Langmuir number 1217 rn_osm_dstokes = 5. ! Depth scale of Stokes drift (m) 1223 rn_zdfosm_adjust_sd = 1.0 ! Stokes drift reduction factor 1224 rn_osm_hblfrac = 0.1 ! specify top part of hbl for nn_osm_wave = 3 or 4 1225 rn_osm_bl_thresh = 5.e-5 !Threshold buoyancy for deepening of OSBL base 1218 1226 nn_ave = 0 ! choice of horizontal averaging on avt, avmu, avmv 1219 1227 ln_dia_osm = .true. ! output OSMOSIS-OBL variables … … 1223 1231 rn_difri = 0.005 ! max Ri# diffusivity at Ri_g = 0 (m^2/s) 1224 1232 ln_convmix = .true. ! Use convective instability mixing below BL 1225 rn_difconv = 1. ! diffusivity when unstable below BL (m2/s) 1233 rn_difconv = 1. !0.01 !1. ! diffusivity when unstable below BL (m2/s) 1234 rn_osm_dstokes = 5. ! Depth scale of Stokes drift (m) 1226 1235 nn_osm_wave = 0 ! Method used to calculate Stokes drift 1227 1236 ! ! = 2: Use ECMWF wave fields 1228 1237 ! ! = 1: Pierson Moskowitz wave spectrum 1229 1238 ! ! = 0: Constant La# = 0.3 1230 / 1239 nn_osm_SD_reduce = 0 ! Method used to get active Stokes drift from surface value 1240 ! ! = 0: No reduction 1241 ! = 1: use SD avged over top 10% hbl 1242 ! = 2:use surface value of SD fit to slope at rn_osm_hblfrac*hbl below surface 1243 ln_zdfosm_ice_shelter = .true. ! reduce surface SD and depth scale under ice 1244 ln_osm_mle = .false. ! Use integrated FK-OSM model 1245 / 1246 !----------------------------------------------------------------------- 1247 &namosm_mle ! mixed layer eddy parametrisation (Fox-Kemper) (default: OFF) 1248 !----------------------------------------------------------------------- 1249 rn_osm_mle_ce = 0.06 ! magnitude of the MLE (typical value: 0.06 to 0.08) 1250 nn_osm_mle = 0 ! MLE type: =0 standard Fox-Kemper ; =1 new formulation 1251 rn_osm_mle_lf = 5.e+3 ! typical scale of mixed layer front (meters) (case rn_osm_mle=0) 1252 rn_osm_mle_time = 172800. ! time scale for mixing momentum across the mixed layer (seconds) (case rn_osm_mle=0) 1253 rn_osm_mle_lat = 20. ! reference latitude (degrees) of MLE coef. (case rn_mle=1) 1254 rn_osm_mle_rho_c = 0.01 ! delta rho criterion used to calculate MLD for FK 1255 rn_osm_mle_thresh = 0.0005 ! delta b criterion used for FK MLE criterion 1256 rn_osm_mle_tau = 172800. ! time scale for FK-OSM (seconds) (case rn_osm_mle=0) 1257 ln_osm_hmle_limit = .false. ! limit hmle to rn_osm_hmle_limit*hbl 1258 rn_osm_hmle_limit = 1.2 1259 / 1231 1260 !----------------------------------------------------------------------- 1232 1261 &namzdf_mfc ! Mass Flux Convection -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/cfgs/SHARED/namelist_top_ref
r12377 r14054 41 41 ln_trcdmp_clo = .false. ! damping term (T) or not (F) on closed seas 42 42 ln_trcbc = .false. ! Surface, Lateral or Open Boundaries conditions 43 ln_trcais = .false. ! Antarctic Ice Sheet nutrient supply 43 44 ! 44 45 jp_dia3d = 0 ! Number of 3D diagnostic variables … … 149 150 ! = 2 Damping applied to all tracers 150 151 / 152 !----------------------------------------------------------------------- 153 &namtrc_ais ! Representation of Antarctic Ice Sheet tracers supply 154 !----------------------------------------------------------------------- 155 nn_ais_tr = 1 ! tracer concentration in iceberg and ice shelf 156 ! = 0 (null concentrations) 157 ! = 1 prescribed concentrations 158 rn_icbdep = 120. ! Mean underwater depth of iceberg (m) 159 / -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/ICE/iceistate.F90
r14049 r14054 21 21 USE sbc_ice , ONLY : tn_ice, snwice_mass, snwice_mass_b 22 22 USE eosbn2 ! equation of state 23 # if defined key_qco 24 USE domqco ! Variable volume 25 # else 23 26 USE domvvl ! Variable volume 27 # endif 24 28 USE ice ! sea-ice: variables 25 29 USE ice1D ! sea-ice: thermodynamics variables … … 434 438 ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 435 439 ! 440 #if defined key_qco 441 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm ) ! interpolation scale factor, depth and water column 442 #else 436 443 IF( .NOT.ln_linssh ) CALL dom_vvl_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 437 ! !!st 438 ! IF( .NOT.ln_linssh ) THEN 439 ! ! 440 ! WHERE( ht_0(:,:) > 0 ) ; z2d(:,:) = 1._wp + ssh(:,:,Kmm)*tmask(:,:,1) / ht_0(:,:) 441 ! ELSEWHERE ; z2d(:,:) = 1._wp ; END WHERE 442 ! ! 443 ! DO jk = 1,jpkm1 ! adjust initial vertical scale factors 444 ! e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * z2d(:,:) 445 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 446 ! e3t(:,:,jk,Kaa) = e3t(:,:,jk,Kmm) 447 ! END DO 448 ! ! 449 ! ! Reconstruction of all vertical scale factors at now and before time-steps 450 ! ! ========================================================================= 451 ! ! Horizontal scale factor interpolations 452 ! ! -------------------------------------- 453 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 454 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 455 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 456 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 457 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 458 ! ! Vertical scale factor interpolations 459 ! ! ------------------------------------ 460 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 461 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 462 ! CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 463 ! CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 464 ! CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 465 ! ! t- and w- points depth 466 ! ! ---------------------- 467 ! !!gm not sure of that.... 468 ! gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 469 ! gdepw(:,:,1,Kmm) = 0.0_wp 470 ! gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 471 ! DO jk = 2, jpk 472 ! gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk ,Kmm) 473 ! gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 474 ! gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - ssh (:,:,Kmm) 475 ! END DO 476 ! ENDIF 444 #endif 445 477 446 ENDIF 478 447 -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/ICE/icerst.F90
r14049 r14054 99 99 CALL iom_swap( cxios_context ) 100 100 #else 101 clinfo = 'Can not use XIOS in rst_opn' 102 CALL ctl_stop(TRIM(clinfo)) 101 CALL ctl_stop( 'Can not use XIOS in rst_opn' ) 103 102 #endif 104 103 ENDIF -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_oce_interp.F90
r13286 r14054 28 28 USE agrif_oce 29 29 USE phycst 30 USE dynspg_ts, ONLY: un_adv, vn_adv30 !!! USE dynspg_ts, ONLY: un_adv, vn_adv 31 31 ! 32 32 USE in_out_manager … … 50 50 INTEGER :: bdy_tinterp = 0 51 51 52 !!---------------------------------------------------------------------- 52 !! * Substitutions 53 # include "domzgr_substitute.h90" 53 54 !! NEMO/NST 4.0 , NEMO Consortium (2018) 54 55 !! $Id$ … … 1192 1193 !!---------------------------------------------------------------------- 1193 1194 IF( before ) THEN 1194 IF ( ln_bt_fw ) THEN1195 ! IF ( ln_bt_fw ) THEN 1195 1196 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2) 1196 ELSE1197 ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2)1198 ENDIF1197 ! ELSE 1198 ! ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * un_adv(i1:i2,j1:j2) 1199 ! ENDIF 1199 1200 ELSE 1200 1201 zrhot = Agrif_rhot() … … 1228 1229 ! 1229 1230 IF( before ) THEN 1230 IF ( ln_bt_fw ) THEN1231 ! IF ( ln_bt_fw ) THEN 1231 1232 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2) 1232 ELSE1233 ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2)1234 ENDIF1233 ! ELSE 1234 ! ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vn_adv(i1:i2,j1:j2) 1235 ! ENDIF 1235 1236 ELSE 1236 1237 zrhot = Agrif_rhot() -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_oce_sponge.F90
r13312 r14054 32 32 33 33 !! * Substitutions 34 # include "domzgr_substitute.h90" 34 35 # include "do_loop_substitute.h90" 35 36 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_oce_update.F90
r13286 r14054 27 27 USE vremap ! Vertical remapping 28 28 USE lbclnk 29 29 #if defined key_qco 30 USE domqco 31 #endif 30 32 IMPLICIT NONE 31 33 PRIVATE … … 34 36 PUBLIC Update_Scales 35 37 38 !! * Substitutions 39 # include "domzgr_substitute.h90" 36 40 !!---------------------------------------------------------------------- 37 41 !! NEMO/NST 4.0 , NEMO Consortium (2018) … … 191 195 END SUBROUTINE Agrif_Update_Tke 192 196 193 194 197 SUBROUTINE Agrif_Update_vvl( ) 195 198 !!--------------------------------------------- … … 201 204 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() 202 205 ! 206 #if ! defined key_qco 203 207 Agrif_UseSpecialValueInUpdate = .TRUE. 204 208 Agrif_SpecialValueFineGrid = 0. … … 213 217 CALL dom_vvl_update_UVF 214 218 CALL Agrif_ParentGrid_To_ChildGrid() 219 #else 220 CALL Agrif_ChildGrid_To_ParentGrid() 221 CALL Agrif_Update_qco 222 CALL Agrif_ParentGrid_To_ChildGrid() 223 #endif 215 224 ! 216 225 END SUBROUTINE Agrif_Update_vvl 217 226 227 228 #if defined key_qco 229 SUBROUTINE Agrif_Update_qco 230 !!--------------------------------------------- 231 !! *** ROUTINE dom_Update_qco *** 232 !!--------------------------------------------- 233 ! 234 ! Save arrays prior update (needed for asselin correction) 235 r3t(:,:,Krhs_a) = r3t(:,:,Kmm_a) 236 r3u(:,:,Krhs_a) = r3u(:,:,Kmm_a) 237 r3v(:,:,Krhs_a) = r3v(:,:,Kmm_a) 238 239 ! Update r3x arrays from updated ssh 240 CALL dom_qco_zgr( Kbb_a, Kmm_a ) 241 ! 242 END SUBROUTINE Agrif_Update_qco 243 #endif 244 245 246 #if ! defined key_qco 218 247 SUBROUTINE dom_vvl_update_UVF 219 248 !!--------------------------------------------- … … 224 253 REAL(wp):: zcoef 225 254 !!--------------------------------------------- 226 227 255 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Finalize e3 on grid Number', & 228 256 & Agrif_Fixed(), 'Step', Agrif_Nb_Step() … … 290 318 ! 291 319 END SUBROUTINE dom_vvl_update_UVF 320 #endif 292 321 293 322 #if defined key_vertical … … 1332 1361 END SUBROUTINE updateAVM 1333 1362 1363 #if ! defined key_qco 1334 1364 SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before ) 1335 1365 !!--------------------------------------------- … … 1443 1473 ! 1444 1474 END SUBROUTINE updatee3t 1475 #endif 1445 1476 1446 1477 #else -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/NST/agrif_user.F90
r13546 r14054 288 288 CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 289 289 CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 290 #if ! defined key_qco 290 291 DO jk = 1, jpk 291 292 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & … … 293 294 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 294 295 END DO 296 #endif 295 297 ENDIF 296 298 -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DIA/diawri.F90
r13497 r14054 19 19 !! 3.7 ! 2014-01 (G. Madec) remove eddy induced velocity from no-IOM output 20 20 !! ! change name of output variables in dia_wri_state 21 !! 4.0 ! 2020-10 (A. Nasser, S. Techene) add diagnostic for SWE 21 22 !!---------------------------------------------------------------------- 22 23 … … 46 47 USE zdfdrg ! ocean vertical physics: top/bottom friction 47 48 USE zdfmxl ! mixed layer 49 USE zdfosm ! mixed layer 48 50 ! 49 51 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 118 120 INTEGER :: ji, jj, jk ! dummy loop indices 119 121 INTEGER :: ikbot ! local integer 120 REAL(wp):: ze3121 122 REAL(wp):: zztmp , zztmpx ! local scalar 122 123 REAL(wp):: zztmp2, zztmpy ! - - 124 REAL(wp):: ze3 123 125 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 124 126 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace … … 137 139 CALL iom_put("e3u_0", e3u_0(:,:,:) ) 138 140 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 141 CALL iom_put("e3f_0", e3f_0(:,:,:) ) 139 142 ! 140 143 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t … … 163 166 CALL iom_put( "e3w" , z3d(:,:,:) ) 164 167 ENDIF 168 IF ( iom_use("e3f") ) THEN ! time-varying e3f caution here at Kaa 169 DO jk = 1, jpk 170 z3d(:,:,jk) = e3f(:,:,jk) 171 END DO 172 CALL iom_put( "e3f" , z3d(:,:,:) ) 173 ENDIF 165 174 166 175 IF( ll_wd ) THEN ! sea surface height (brought back to the reference used for wetting and drying) 167 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)* tmask(:,:,1) )176 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*ssmask(:,:) ) 168 177 ELSE 169 178 CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height 170 179 ENDIF 171 180 172 IF( iom_use("wetdep") ) & ! wet depth 173 CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) 181 IF( iom_use("wetdep") ) CALL iom_put( "wetdep" , ht_0(:,:) + ssh(:,:,Kmm) ) ! wet depth 182 183 #if defined key_qco 184 IF( iom_use("ht") ) CALL iom_put( "ht" , ht(:,:) ) ! water column at t-point 185 IF( iom_use("hu") ) CALL iom_put( "hu" , hu(:,:,Kmm) ) ! water column at u-point 186 IF( iom_use("hv") ) CALL iom_put( "hv" , hv(:,:,Kmm) ) ! water column at v-point 187 IF( iom_use("hf") ) CALL iom_put( "hf" , hf_0(:,:)*( 1._wp + r3f(:,:) ) ) ! water column at f-point (caution here at Naa) 188 #endif 174 189 175 190 CALL iom_put( "toce", ts(:,:,:,jp_tem,Kmm) ) ! 3D temperature … … 325 340 ENDIF 326 341 ! 342 IF ( iom_use("sKE") ) THEN ! surface kinetic energy at T point 343 z2d(:,:) = 0._wp 344 DO_2D( 0, 0, 0, 0 ) 345 z2d(ji,jj) = 0.25_wp * ( uu(ji ,jj,1,Kmm) * uu(ji ,jj,1,Kmm) * e1e2u(ji ,jj) * e3u(ji ,jj,1,Kmm) & 346 & + uu(ji-1,jj,1,Kmm) * uu(ji-1,jj,1,Kmm) * e1e2u(ji-1,jj) * e3u(ji-1,jj,1,Kmm) & 347 & + vv(ji,jj ,1,Kmm) * vv(ji,jj ,1,Kmm) * e1e2v(ji,jj ) * e3v(ji,jj ,1,Kmm) & 348 & + vv(ji,jj-1,1,Kmm) * vv(ji,jj-1,1,Kmm) * e1e2v(ji,jj-1) * e3v(ji,jj-1,1,Kmm) ) & 349 & * r1_e1e2t(ji,jj) / e3t(ji,jj,1,Kmm) * ssmask(ji,jj) 350 END_2D 351 CALL lbc_lnk( 'diawri', z2d, 'T', 1. ) 352 IF ( iom_use("sKE" ) ) CALL iom_put( "sKE" , z2d ) 353 ENDIF 354 ! 355 IF ( iom_use("sKEf") ) THEN ! surface kinetic energy at F point 356 z2d(:,:) = 0._wp ! CAUTION : only valid in SWE, not with bathymetry 357 DO_2D( 0, 0, 0, 0 ) 358 z2d(ji,jj) = 0.25_wp * ( uu(ji,jj ,1,Kmm) * uu(ji,jj ,1,Kmm) * e1e2u(ji,jj ) * e3u(ji,jj ,1,Kmm) & 359 & + uu(ji,jj+1,1,Kmm) * uu(ji,jj+1,1,Kmm) * e1e2u(ji,jj+1) * e3u(ji,jj+1,1,Kmm) & 360 & + vv(ji ,jj,1,Kmm) * vv(ji,jj ,1,Kmm) * e1e2v(ji ,jj) * e3v(ji ,jj,1,Kmm) & 361 & + vv(ji+1,jj,1,Kmm) * vv(ji+1,jj,1,Kmm) * e1e2v(ji+1,jj) * e3v(ji+1,jj,1,Kmm) ) & 362 & * r1_e1e2f(ji,jj) / e3f(ji,jj,1) * ssfmask(ji,jj) 363 END_2D 364 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 365 CALL iom_put( "sKEf", z2d ) 366 ENDIF 367 ! 327 368 CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence 328 369 … … 424 465 425 466 IF (ln_dia25h) CALL dia_25h( kt, Kmm ) ! 25h averaging 467 468 ! Output of vorticity terms 469 IF ( iom_use("relvor") .OR. iom_use("plavor") .OR. & 470 & iom_use("relpotvor") .OR. iom_use("abspotvor") .OR. & 471 & iom_use("Ens") ) THEN 472 ! 473 z2d(:,:) = 0._wp 474 ze3 = 0._wp 475 DO_2D( 1, 0, 1, 0 ) 476 z2d(ji,jj) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,1,Kmm) - e2v(ji,jj) * vv(ji,jj,1,Kmm) & 477 & - e1u(ji ,jj+1) * uu(ji ,jj+1,1,Kmm) + e1u(ji,jj) * uu(ji,jj,1,Kmm) ) * r1_e1e2f(ji,jj) 478 END_2D 479 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 480 CALL iom_put( "relvor", z2d ) ! relative vorticity ( zeta ) 481 ! 482 CALL iom_put( "plavor", ff_f ) ! planetary vorticity ( f ) 483 ! 484 DO_2D( 1, 0, 1, 0 ) 485 ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) & 486 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj) 487 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 488 ELSE ; ze3 = 0._wp 489 ENDIF 490 z2d(ji,jj) = ze3 * z2d(ji,jj) 491 END_2D 492 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 493 CALL iom_put( "relpotvor", z2d ) ! relative potential vorticity (zeta/h) 494 ! 495 DO_2D( 1, 0, 1, 0 ) 496 ze3 = ( e3t(ji,jj+1,1,Kmm) * e1e2t(ji,jj+1) + e3t(ji+1,jj+1,1,Kmm) * e1e2t(ji+1,jj+1) & 497 & + e3t(ji,jj ,1,Kmm) * e1e2t(ji,jj ) + e3t(ji+1,jj ,1,Kmm) * e1e2t(ji+1,jj ) ) * r1_e1e2f(ji,jj) 498 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 499 ELSE ; ze3 = 0._wp 500 ENDIF 501 z2d(ji,jj) = ze3 * ff_f(ji,jj) + z2d(ji,jj) 502 END_2D 503 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 504 CALL iom_put( "abspotvor", z2d ) ! absolute potential vorticity ( q ) 505 ! 506 DO_2D( 1, 0, 1, 0 ) 507 z2d(ji,jj) = 0.5_wp * z2d(ji,jj) * z2d(ji,jj) 508 END_2D 509 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 510 CALL iom_put( "Ens", z2d ) ! potential enstrophy ( 1/2*q2 ) 511 ! 512 ENDIF 426 513 427 514 IF( ln_timing ) CALL timing_stop('dia_wri') … … 997 1084 !! 998 1085 INTEGER :: inum, jk 999 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace !!st patch to usesubstitution1086 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace for qco substitution 1000 1087 !!---------------------------------------------------------------------- 1001 1088 ! … … 1076 1163 CALL iom_rstput ( 0, 0, inum, "qz1_abl", tq_abl(:,:,2,nt_a,2) ) ! now first level humidity 1077 1164 ENDIF 1165 IF( ln_zdfosm ) THEN 1166 CALL iom_rstput( 0, 0, inum, 'hbl', hbl*tmask(:,:,1) ) ! now boundary-layer depth 1167 CALL iom_rstput( 0, 0, inum, 'hml', hml*tmask(:,:,1) ) ! now mixed-layer depth 1168 CALL iom_rstput( 0, 0, inum, 'avt_k', avt_k*wmask ) ! w-level diffusion 1169 CALL iom_rstput( 0, 0, inum, 'avm_k', avm_k*wmask ) ! now w-level viscosity 1170 CALL iom_rstput( 0, 0, inum, 'ghamt', ghamt*wmask ) ! non-local t forcing 1171 CALL iom_rstput( 0, 0, inum, 'ghams', ghams*wmask ) ! non-local s forcing 1172 CALL iom_rstput( 0, 0, inum, 'ghamu', ghamu*umask ) ! non-local u forcing 1173 CALL iom_rstput( 0, 0, inum, 'ghamv', ghamv*vmask ) ! non-local v forcing 1174 IF( ln_osm_mle ) THEN 1175 CALL iom_rstput( 0, 0, inum, 'hmle', hmle*tmask(:,:,1) ) ! now transition-layer depth 1176 END IF 1177 ENDIF 1078 1178 ! 1079 1179 CALL iom_close( inum ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/dom_oce.F90
r14049 r14054 131 131 ! 132 132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , e2_e1u, r1_e1e2u!: associated metrics at u-point134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , e1_e2v, r1_e1e2v!: associated metrics at v-point133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point 135 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE , DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point 136 136 ! … … 162 162 163 163 ! ! reference depths of cells 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m]165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m]166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m]164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_0 !: t- depth [m] 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m] 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m] 167 167 ! ! time-dependent depths of cells 168 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw … … 205 205 206 206 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssumask, ssvmask, ssfmask !: surface mask at T-,U-, V- and F-pts 207 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WT-, WU- and WV-pts 209 207 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts 209 #if defined key_qco 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts for qco 211 #endif 210 212 !!---------------------------------------------------------------------- 211 213 !! calendar variables … … 306 308 & e3w_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , STAT=ierr(ii) ) 307 309 ! 308 #if ! defined key_qco 310 #if defined key_qco 311 ii = ii+1 312 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 313 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 314 #else 309 315 ii = ii+1 310 316 ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) , & … … 313 319 ! 314 320 ii = ii+1 315 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , &316 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) )317 !318 ii = ii+1319 321 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & 320 322 & r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) , r1_hv_0(jpi,jpj), r1_hf_0(jpi,jpj) , STAT=ierr(ii) ) … … 323 325 ii = ii+1 324 326 ALLOCATE( ht (jpi,jpj) , hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , & 325 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , STAT=ierr(ii) )326 #else327 ii = ii+1328 ALLOCATE( hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , &329 327 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , STAT=ierr(ii) ) 330 328 #endif … … 350 348 ii = ii+1 351 349 ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 350 #if defined key_qco 351 ! 352 ii = ii+1 353 ALLOCATE( fe3mask(jpi,jpj,jpk) , STAT=ierr(ii) ) 354 #endif 352 355 ! 353 356 dom_oce_alloc = MAXVAL(ierr) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domain.F90
r14049 r14054 15 15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 16 16 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface 17 !! 4. x ! 2020-02 (G. Madec, S. Techene)introduce ssh to h0 ratio17 !! 4.1 ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 18 18 !!---------------------------------------------------------------------- 19 19 … … 28 28 USE oce ! ocean variables 29 29 USE dom_oce ! domain: ocean 30 #if defined key_qco 31 USE domqco ! quasi-eulerian 32 #else 33 USE domvvl ! variable volume 34 #endif 35 USE sshwzv , ONLY : ssh_init_rst ! set initial ssh 30 36 USE sbc_oce ! surface boundary condition: ocean 31 37 USE trc_oce ! shared ocean & passive tracers variab … … 35 41 USE dommsk ! domain: set the mask system 36 42 USE domwri ! domain: write the meshmask file 37 #if ! defined key_qco38 USE domvvl ! variable volume39 #else40 USE domqco ! variable volume41 #endif42 43 USE c1d ! 1D configuration 43 44 USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine) 44 USE wet_dry , ONLY : ll_wd45 USE closea , ONLY : dom_clo ! closed seas45 USE wet_dry , ONLY : ll_wd ! wet & drying flag 46 USE closea , ONLY : dom_clo ! closed seas routine 46 47 ! 47 48 USE prtctl ! Print control (prt_ctl_info routine) … … 50 51 USE lbclnk ! ocean lateral boundary condition (or mpp link) 51 52 USE lib_mpp ! distributed memory computing library 53 USE restart ! only for lrst_oce 52 54 53 55 IMPLICIT NONE … … 58 60 PUBLIC dom_tile ! called by step.F90 59 61 62 !! * Substitutions 63 # include "do_loop_substitute.h90" 60 64 !!------------------------------------------------------------------------- 61 65 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 84 88 INTEGER :: ji, jj, jk, jt ! dummy loop indices 85 89 INTEGER :: iconf = 0 ! local integers 90 REAL(wp):: zrdt 86 91 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 87 92 INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level … … 121 126 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 122 127 ENDIF 123 nn_wxios = 0 124 ln_xios_read = .FALSE. 128 125 129 ! 126 130 ! !== Reference coordinate system ==! … … 143 147 hv_0(:,:) = 0._wp 144 148 hf_0(:,:) = 0._wp 145 DO jk = 1, jpk 149 DO jk = 1, jpkm1 146 150 ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 147 151 hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 148 152 hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 149 hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk)150 153 END DO 154 ! 155 DO jk = 1, jpkm1 156 hf_0(1:jpim1,:) = hf_0(1:jpim1,:) + e3f_0(1:jpim1,:,jk)*vmask(1:jpim1,:,jk)*vmask(2:jpi,:,jk) 157 END DO 158 CALL lbc_lnk('domain', hf_0, 'F', 1._wp) 159 ! 160 IF( lk_SWE ) THEN ! SWE case redefine hf_0 161 hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,1) * ssfmask(:,:) 162 ENDIF 151 163 ! 152 164 r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp - ssmask (:,:) ) … … 154 166 r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 155 167 r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) ) 156 168 ! 169 IF( ll_wd ) THEN ! wet and drying (check ht_0 >= 0) 170 DO_2D( 1, 1, 1, 1 ) 171 IF( ht_0(ji,jj) < 0._wp .AND. ssmask(ji,jj) == 1._wp ) THEN 172 CALL ctl_stop( 'ssh_init_rst : ht_0 must be positive at potentially wet points' ) 173 ENDIF 174 END_2D 175 ENDIF 176 ! 177 ! !== initialisation of time varying coordinate ==! 178 ! 179 ! != ssh initialization 180 IF( .NOT.l_offline .AND. .NOT.l_SAS ) THEN 181 CALL ssh_init_rst( Kbb, Kmm, Kaa ) 182 ELSE 183 ssh(:,:,:) = 0._wp 184 ENDIF 157 185 ! 158 186 #if defined key_qco 159 ! !== initialisation of time varying coordinate ==!Quasi-Euerian coordinate case187 ! != Quasi-Euerian coordinate case 160 188 ! 161 189 IF( .NOT.l_offline ) CALL dom_qco_init( Kbb, Kmm, Kaa ) 162 !163 IF( ln_linssh ) CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible')164 !165 190 #else 166 ! !== time varying part of coordinate system ==! 167 ! 168 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 191 ! 192 IF( ln_linssh ) THEN != Fix in time : set to the reference one for all 169 193 ! 170 194 DO jt = 1, jpt ! depth of t- and w-grid-points … … 175 199 ! 176 200 DO jt = 1, jpt ! vertical scale factors 177 e3t (:,:,:,jt) = e3t_0(:,:,:)178 e3u (:,:,:,jt) = e3u_0(:,:,:)179 e3v (:,:,:,jt) = e3v_0(:,:,:)180 e3w (:,:,:,jt) = e3w_0(:,:,:)201 e3t (:,:,:,jt) = e3t_0(:,:,:) 202 e3u (:,:,:,jt) = e3u_0(:,:,:) 203 e3v (:,:,:,jt) = e3v_0(:,:,:) 204 e3w (:,:,:,jt) = e3w_0(:,:,:) 181 205 e3uw(:,:,:,jt) = e3uw_0(:,:,:) 182 206 e3vw(:,:,:,jt) = e3vw_0(:,:,:) 183 207 END DO 184 e3f (:,:,:) = e3f_0(:,:,:)208 e3f (:,:,:) = e3f_0(:,:,:) 185 209 ! 186 210 DO jt = 1, jpt ! water column thickness and its inverse 187 hu(:,:,jt)= hu_0(:,:)188 hv(:,:,jt)= hv_0(:,:)211 hu(:,:,jt) = hu_0(:,:) 212 hv(:,:,jt) = hv_0(:,:) 189 213 r1_hu(:,:,jt) = r1_hu_0(:,:) 190 214 r1_hv(:,:,jt) = r1_hv_0(:,:) 191 215 END DO 192 ht(:,:) = ht_0(:,:)193 ! 194 ELSE != time varying : initialize before/now/after variables216 ht (:,:) = ht_0(:,:) 217 ! 218 ELSE != Time varying : initialize before/now/after variables 195 219 ! 196 220 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) … … 373 397 USE ioipsl 374 398 !! 375 INTEGER :: ios ! Local integer 399 INTEGER :: ios ! Local integer 400 REAL(wp):: zrdt 401 !!---------------------------------------------------------------------- 376 402 ! 377 403 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & … … 393 419 ENDIF 394 420 ! 421 ! !=======================! 422 ! !== namelist namdom ==! 423 ! !=======================! 424 ! 425 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 426 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' ) 427 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 428 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 429 IF(lwm) WRITE( numond, namdom ) 430 ! 431 #if defined key_agrif 432 IF( .NOT. Agrif_Root() ) THEN ! AGRIF child, subdivide the Parent timestep 433 rn_Dt = Agrif_Parent (rn_Dt ) / Agrif_Rhot() 434 ENDIF 435 #endif 436 ! 437 IF(lwp) THEN 438 WRITE(numout,*) 439 WRITE(numout,*) ' Namelist : namdom --- space & time domain' 440 WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh 441 WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask 442 WRITE(numout,*) ' ocean time step rn_Dt = ', rn_Dt 443 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 444 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 445 ENDIF 446 ! 447 ! set current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 448 rDt = 2._wp * rn_Dt 449 r1_Dt = 1._wp / rDt 450 ! 451 IF( l_SAS .AND. .NOT.ln_linssh ) THEN 452 CALL ctl_warn( 'SAS requires linear ssh : force ln_linssh = T' ) 453 ln_linssh = .TRUE. 454 ENDIF 455 ! 456 #if defined key_qco 457 IF( ln_linssh ) CALL ctl_stop( 'STOP','domain: key_qco and ln_linssh = T are incompatible' ) 458 #endif 459 ! 460 ! !=======================! 461 ! !== namelist namrun ==! 462 ! !=======================! 395 463 ! 396 464 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) … … 452 520 nleapy = nn_leapy 453 521 ninist = nn_istate 522 ! 523 ! !== Set parameters for restart reading using xIOS ==! 524 ! 525 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 526 lrxios = ln_xios_read .AND. ln_rstart 527 IF( nn_wxios > 0 ) lwxios = .TRUE. !* set output file type for XIOS based on NEMO namelist 528 nxioso = nn_wxios 529 ENDIF 530 ! !== Check consistency between ln_rstart and ln_1st_euler ==! (i.e. set l_1st_euler) 454 531 l_1st_euler = ln_1st_euler 455 IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN 532 ! 533 IF( ln_rstart ) THEN !* Restart case 534 ! 535 IF(lwp) WRITE(numout,*) 536 IF(lwp) WRITE(numout,*) ' open the restart file' 537 CALL rst_read_open !- Open the restart file 538 ! 539 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN !- Check time-step consistency and force Euler restart if changed 540 CALL iom_get( numror, 'rdt', zrdt ) 541 IF( zrdt /= rn_Dt ) THEN 542 IF(lwp) WRITE( numout,*) 543 IF(lwp) WRITE( numout,*) ' rn_Dt = ', rn_Dt,' not equal to the READ one rdt = ', zrdt 544 IF(lwp) WRITE( numout,*) 545 IF(lwp) WRITE( numout,*) ' ==>>> forced euler first time-step' 546 l_1st_euler = .TRUE. 547 ENDIF 548 ENDIF 549 ! 550 IF( .NOT.l_SAS .AND. iom_varid( numror, 'sshb', ldstop = .FALSE. ) <= 0 ) THEN !- Check absence of one of the Kbb field (here sshb) 551 ! ! (any Kbb field is missing ==> all Kbb fields are missing) 552 IF( .NOT.l_1st_euler ) THEN 553 CALL ctl_warn('dom_nam : ssh at Kbb not found in restart files ', & 554 & 'l_1st_euler forced to .true. and ' , & 555 & 'ssh(Kbb) = ssh(Kmm) ' ) 556 l_1st_euler = .TRUE. 557 ENDIF 558 ENDIF 559 ELSEIF( .NOT.l_1st_euler ) THEN !* Initialization case 456 560 IF(lwp) WRITE(numout,*) 457 561 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 458 562 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. ' 459 l_1st_euler = .true. 460 ENDIF 461 ! ! control of output frequency 462 IF( .NOT. ln_rst_list ) THEN ! we use nn_stock 563 l_1st_euler = .TRUE. 564 ENDIF 565 ! 566 ! !== control of output frequency ==! 567 ! 568 IF( .NOT. ln_rst_list ) THEN ! we use nn_stock 463 569 IF( nn_stock == -1 ) CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' ) 464 570 IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN … … 479 585 IF( Agrif_Root() ) THEN 480 586 IF(lwp) WRITE(numout,*) 481 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL587 SELECT CASE ( nleapy ) !== Choose calendar for IOIPSL ==! 482 588 CASE ( 1 ) 483 589 CALL ioconf_calendar('gregorian') … … 491 597 END SELECT 492 598 ENDIF 493 494 READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 495 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' ) 496 READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 497 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' ) 498 IF(lwm) WRITE( numond, namdom ) 499 ! 500 #if defined key_agrif 501 IF( .NOT. Agrif_Root() ) THEN 502 rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot() 503 ENDIF 504 #endif 505 ! 506 IF(lwp) THEN 507 WRITE(numout,*) 508 WRITE(numout,*) ' Namelist : namdom --- space & time domain' 509 WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh 510 WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask 511 WRITE(numout,*) ' ocean time step rn_Dt = ', rn_Dt 512 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 513 WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs 514 ENDIF 515 ! 516 !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3 517 rDt = 2._wp * rn_Dt 518 r1_Dt = 1._wp / rDt 519 599 ! 600 ! !========================! 601 ! !== namelist namtile ==! 602 ! !========================! 603 ! 520 604 READ ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 ) 521 605 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtile in reference namelist' ) … … 537 621 ENDIF 538 622 ENDIF 539 540 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 541 lrxios = ln_xios_read.AND.ln_rstart 542 !set output file type for XIOS based on NEMO namelist 543 IF (nn_wxios > 0) lwxios = .TRUE. 544 nxioso = nn_wxios 545 ENDIF 546 623 ! 547 624 #if defined key_netcdf4 548 ! ! NetCDF 4 case ("key_netcdf4" defined) 625 ! !=======================! 626 ! !== namelist namnc4 ==! NetCDF 4 case ("key_netcdf4" defined) 627 ! !=======================! 628 ! 549 629 READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 550 630 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist' ) … … 555 635 IF(lwp) THEN ! control print 556 636 WRITE(numout,*) 557 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters '637 WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters ("key_netcdf4" defined)' 558 638 WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i 559 639 WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j … … 618 698 SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio ) 619 699 !!---------------------------------------------------------------------- 620 !! *** ROUTINE dom _nam***700 !! *** ROUTINE domain_cfg *** 621 701 !! 622 702 !! ** Purpose : read the domain size in domain configuration file -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/dommsk.F90
r13461 r14054 181 181 ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 182 182 ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 183 IF( lk_SWE ) THEN ! Shallow Water Eq. case : redefine ssfmask 184 DO_2D( 0,0 , 0,0 ) 185 ssfmask(ji,jj) = MAX( ssmask(ji,jj+1), ssmask(ji+1,jj+1), & 186 & ssmask(ji,jj ), ssmask(ji+1,jj ) ) 187 END_2D 188 CALL lbc_lnk( 'dommsk', ssfmask, 'F', 1.0_wp ) 189 ENDIF 190 #if defined key_qco 191 fe3mask(:,:,:) = fmask(:,:,:) 192 #endif 183 193 184 194 ! Interior domain mask (used for global sum) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domqco.F90
r14049 r14054 8 8 !! 3.3 ! 2011-10 (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping11 !! 4.x ! 2020-02 (G. Madec, S. Techene) pure z* (quasi-eulerian) coordinate12 !!---------------------------------------------------------------------- 13 14 !!---------------------------------------------------------------------- 15 !! dom_q e_init: define initial vertical scale factors, depths and column thickness16 !! dom_q e_r3c : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points17 !! qe_rst_read : read/write restart file18 !! dom_qe_ctl: Check the vvl options10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) add time level indices for prognostic variables 11 !! - ! 2020-02 (S. Techene, G. Madec) quasi-eulerian coordinate (z* or s*) 12 !!---------------------------------------------------------------------- 13 14 !!---------------------------------------------------------------------- 15 !! dom_qco_init : define initial vertical scale factors, depths and column thickness 16 !! dom_qco_zgr : Set ssh/h_0 ratio at t 17 !! dom_qco_r3c : Compute ssh/h_0 ratio at t-, u-, v-, and optionally f-points 18 !! qco_ctl : Check the vvl options 19 19 !!---------------------------------------------------------------------- 20 20 USE oce ! ocean dynamics and tracers … … 55 55 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 56 56 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport58 59 57 !! * Substitutions 60 58 # include "do_loop_substitute.h90" … … 79 77 !! 80 78 !!---------------------------------------------------------------------- 81 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 79 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! time level indices 80 !!---------------------------------------------------------------------- 82 81 ! 83 82 IF(lwp) WRITE(numout,*) … … 85 84 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 86 85 ! 87 CALL dom_qco_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 88 ! 89 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 90 CALL qe_rst_read( nit000, Kbb, Kmm ) 91 ! 92 CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 86 CALL qco_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 87 ! 88 CALL dom_qco_zgr( Kbb, Kmm ) ! interpolation scale factor, depth and water column 89 ! 90 #if defined key_agrif 91 ! We need to define r3[tuv](Kaa) for AGRIF initialisation (should not be a 92 ! problem for the restartability...) 93 r3t(:,:,Kaa) = r3t(:,:,Kmm) 94 r3u(:,:,Kaa) = r3u(:,:,Kmm) 95 r3v(:,:,Kaa) = r3v(:,:,Kmm) 96 #endif 93 97 ! 94 98 END SUBROUTINE dom_qco_init 95 99 96 100 97 SUBROUTINE dom_qco_zgr( Kbb, Kmm, Kaa)101 SUBROUTINE dom_qco_zgr( Kbb, Kmm ) 98 102 !!---------------------------------------------------------------------- 99 103 !! *** ROUTINE dom_qco_init *** 100 104 !! 101 !! ** Purpose : Initialization of all ssh. to h._0 ratio 102 !! 103 !! ** Method : - interpolate scale factors 104 !! 105 !! ** Action : - r3(t/u/v)_b 106 !! - r3(t/u/v/f)_n 107 !! 108 !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling. 109 !!---------------------------------------------------------------------- 110 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 105 !! ** Purpose : Initialization of all r3. = ssh./h._0 ratios 106 !! 107 !! ** Method : Call domqco using Kbb and Kmm 108 !! NB: dom_qco_zgr is called by dom_qco_init it uses ssh from ssh_init 109 !! 110 !! ** Action : - r3(t/u/v)(Kbb) 111 !! - r3(t/u/v/f)(Kmm) 112 !!---------------------------------------------------------------------- 113 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 111 114 !!---------------------------------------------------------------------- 112 115 ! 113 116 ! !== Set of all other vertical scale factors ==! (now and before) 114 117 ! ! Horizontal interpolation of e3t 115 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) )118 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 116 119 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 117 120 ! … … 143 146 ! !== ratio at u-,v-point ==! 144 147 ! 145 IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 148 !!st IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 149 #if ! defined key_qcoTest_FluxForm 150 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 146 151 DO_2D( 0, 0, 0, 0 ) 147 152 pr3u(ji,jj) = 0.5_wp * ( e1e2t(ji ,jj) * pssh(ji ,jj) & … … 150 155 & + e1e2t(ji,jj+1) * pssh(ji,jj+1) ) * r1_hv_0(ji,jj) * r1_e1e2v(ji,jj) 151 156 END_2D 152 ELSE !- Flux Form (simple averaging) 157 !!st ELSE !- Flux Form (simple averaging) 158 #else 153 159 DO_2D( 0, 0, 0, 0 ) 154 pr3u(ji,jj) = 0.5_wp * ( pssh(ji ,jj) + pssh(ji+1,jj) ) * r1_hu_0(ji,jj)155 pr3v(ji,jj) = 0.5_wp * ( pssh(ji,jj ) + pssh(ji,jj+1) ) * r1_hv_0(ji,jj)160 pr3u(ji,jj) = 0.5_wp * ( pssh(ji,jj) + pssh(ji+1,jj ) ) * r1_hu_0(ji,jj) 161 pr3v(ji,jj) = 0.5_wp * ( pssh(ji,jj) + pssh(ji ,jj+1) ) * r1_hv_0(ji,jj) 156 162 END_2D 157 ENDIF 163 !!st ENDIF 164 #endif 158 165 ! 159 166 IF( .NOT.PRESENT( pr3f ) ) THEN !- lbc on ratio at u-, v-points only … … 163 170 ELSE !== ratio at f-point ==! 164 171 ! 165 IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 166 DO_2D( 1, 0, 1, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 172 !!st IF( ln_dynadv_vec ) THEN !- Vector Form (thickness weighted averaging) 173 #if ! defined key_qcoTest_FluxForm 174 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 175 176 DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 167 177 pr3f(ji,jj) = 0.25_wp * ( e1e2t(ji ,jj ) * pssh(ji ,jj ) & 168 178 & + e1e2t(ji+1,jj ) * pssh(ji+1,jj ) & … … 170 180 & + e1e2t(ji+1,jj+1) * pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) * r1_e1e2f(ji,jj) 171 181 END_2D 172 ELSE !- Flux Form (simple averaging) 173 DO_2D( 1, 0, 1, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 174 pr3f(ji,jj) = 0.25_wp * ( pssh(ji ,jj ) + pssh(ji+1,jj ) & 175 & + pssh(ji ,jj+1) + pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) 182 !!st ELSE !- Flux Form (simple averaging) 183 #else 184 DO_2D( 0, 0, 0, 0 ) ! start from 1 since lbc_lnk('F') doesn't update the 1st row/line 185 pr3f(ji,jj) = 0.25_wp * ( pssh(ji,jj ) + pssh(ji+1,jj ) & 186 & + pssh(ji,jj+1) + pssh(ji+1,jj+1) ) * r1_hf_0(ji,jj) 176 187 END_2D 177 ENDIF 188 !!st ENDIF 189 #endif 178 190 ! ! lbc on ratio at u-,v-,f-points 179 191 CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) … … 184 196 185 197 186 SUBROUTINE q e_rst_read( kt, Kbb, Kmm )198 SUBROUTINE qco_ctl 187 199 !!--------------------------------------------------------------------- 188 !! *** ROUTINE qe_rst_read *** 189 !! 190 !! ** Purpose : Read ssh in restart file 191 !! 192 !! ** Method : use of IOM library 193 !! if the restart does not contain ssh, 194 !! it is set to the _0 values. 195 !!---------------------------------------------------------------------- 196 INTEGER , INTENT(in) :: kt ! ocean time-step 197 INTEGER , INTENT(in) :: Kbb, Kmm ! ocean time level indices 198 ! 199 INTEGER :: ji, jj, jk 200 INTEGER :: id1, id2 ! local integers 201 !!---------------------------------------------------------------------- 202 ! 203 IF( ln_rstart ) THEN !* Read the restart file 204 CALL rst_read_open ! open the restart file if necessary 205 ! 206 id1 = iom_varid( numror, 'sshb', ldstop = .FALSE. ) 207 id2 = iom_varid( numror, 'sshn', ldstop = .FALSE. ) 208 ! 209 ! ! --------- ! 210 ! ! all cases ! 211 ! ! --------- ! 212 ! 213 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 214 CALL iom_get( numror, jpdom_auto, 'sshb' , ssh(:,:,Kbb) ) 215 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 216 ! needed to restart if land processor not computed 217 IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 218 WHERE ( ssmask(:,:) == 0.0_wp ) !!gm/st ==> sm should not be necessary on ssh when it was required on e3 219 ssh(:,:,Kmm) = 0._wp 220 ssh(:,:,Kbb) = 0._wp 221 END WHERE 222 IF( l_1st_euler ) THEN 223 ssh(:,:,Kbb) = ssh(:,:,Kmm) 224 ENDIF 225 ELSE IF( id1 > 0 ) THEN 226 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart files' 227 IF(lwp) write(numout,*) 'sshn set equal to sshb.' 228 IF(lwp) write(numout,*) 'neuler is forced to 0' 229 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 230 ssh(:,:,Kmm) = ssh(:,:,Kbb) 231 l_1st_euler = .TRUE. 232 ELSE IF( id2 > 0 ) THEN 233 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kbb) not found in restart files' 234 IF(lwp) write(numout,*) 'sshb set equal to sshn.' 235 IF(lwp) write(numout,*) 'neuler is forced to 0' 236 CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 237 ssh(:,:,Kbb) = ssh(:,:,Kmm) 238 l_1st_euler = .TRUE. 239 ELSE 240 IF(lwp) write(numout,*) 'qe_rst_read WARNING : ssh(:,:,Kmm) not found in restart file' 241 IF(lwp) write(numout,*) 'ssh_b and ssh_n set to zero' 242 IF(lwp) write(numout,*) 'neuler is forced to 0' 243 ssh(:,:,:) = 0._wp 244 l_1st_euler = .TRUE. 245 ENDIF 246 ! 247 ELSE !* Initialize at "rest" 248 ! 249 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential 250 ! 251 IF( cn_cfg == 'wad' ) THEN ! Wetting and drying test case 252 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 253 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 254 ssh(:,: ,Kmm) = ssh(:,: ,Kbb) 255 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb) 256 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb) 257 ELSE ! if not test case 258 ssh(:,:,Kmm) = -ssh_ref 259 ssh(:,:,Kbb) = -ssh_ref 260 ! 261 DO_2D( 1, 1, 1, 1 ) 262 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 263 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 264 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 265 ENDIF 266 END_2D 267 ENDIF 268 269 DO ji = 1, jpi 270 DO jj = 1, jpj 271 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 272 CALL ctl_stop( 'qe_rst_read: ht_0 must be positive at potentially wet points' ) 273 ENDIF 274 END DO 275 END DO 276 ! 277 ELSE 278 ! 279 ! Just to read set ssh in fact, called latter once vertical grid 280 ! is set up: 281 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 282 ! ! 283 ssh(:,:,:) = 0._wp 284 ! 285 ENDIF ! end of ll_wd edits 286 ! 287 ENDIF 288 ! 289 END SUBROUTINE qe_rst_read 290 291 292 SUBROUTINE dom_qco_ctl 293 !!--------------------------------------------------------------------- 294 !! *** ROUTINE dom_qco_ctl *** 200 !! *** ROUTINE qco_ctl *** 295 201 !! 296 202 !! ** Purpose : Control the consistency between namelist options … … 312 218 IF(lwp) THEN ! Namelist print 313 219 WRITE(numout,*) 314 WRITE(numout,*) ' dom_qco_ctl : choice/control of the variable vertical coordinate'315 WRITE(numout,*) '~~~~~~~~ ~~~'220 WRITE(numout,*) 'qco_ctl : choice/control of the variable vertical coordinate' 221 WRITE(numout,*) '~~~~~~~~' 316 222 WRITE(numout,*) ' Namelist nam_vvl : chose a vertical coordinate' 317 223 WRITE(numout,*) ' zstar ln_vvl_zstar = ', ln_vvl_zstar … … 357 263 #endif 358 264 ! 359 END SUBROUTINE dom_qco_ctl265 END SUBROUTINE qco_ctl 360 266 361 267 !!====================================================================== -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domvvl.F90
r14049 r14054 9 9 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 10 10 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rename dom_vvl_sf_swp -> dom_vvl_sf_update for new timestepping 11 !! 4.x !2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio11 !! - ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 12 12 !!---------------------------------------------------------------------- 13 13 … … 766 766 !! ** Purpose : Read or write VVL file in restart file 767 767 !! 768 !! ** Method : use of IOM library 769 !! if the restart does not contain vertical scale factors, 770 !! they are set to the _0 values 771 !! if the restart does not contain vertical scale factors increments (z_tilde), 772 !! they are set to 0. 768 !! ** Method : * restart comes from a linear ssh simulation : 769 !! an attempt to read e3t_n stops simulation 770 !! * restart comes from a z-star, z-tilde, or layer : 771 !! read e3t_n and e3t_b 772 !! * restart comes from a z-star : 773 !! set tilde_e3t_n, tilde_e3t_n, and hdiv_lf to 0 774 !! * restart comes from layer : 775 !! read tilde_e3t_n and tilde_e3t_b 776 !! set hdiv_lf to 0 777 !! * restart comes from a z-tilde: 778 !! read tilde_e3t_n, tilde_e3t_b, and hdiv_lf 779 !! 780 !! NB: if l_1st_euler = T (ln_1st_euler or ssh_b not found) 781 !! Kbb fields set to Kmm ones 773 782 !!---------------------------------------------------------------------- 774 783 INTEGER , INTENT(in) :: kt ! ocean time-step … … 776 785 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 777 786 ! 778 INTEGER :: ji, jj, jk 779 INTEGER :: id 1, id2, id3, id4, id5! local integers780 !!---------------------------------------------------------------------- 781 ! 782 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise783 ! ! ===============784 IF( ln_rstart ) THEN !* Read the restart file785 CALL rst_read_open ! open the restart file if necessary786 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) )787 INTEGER :: ji, jj, jk ! dummy loop indices 788 INTEGER :: id3, id4, id5 ! local integers 789 !!---------------------------------------------------------------------- 790 ! 791 ! !=====================! 792 IF( TRIM(cdrw) == 'READ' ) THEN ! Read / initialise ! 793 ! !=====================! 794 ! 795 IF( ln_rstart ) THEN !== Read the restart file ==! 787 796 ! 788 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 789 id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 790 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 797 CALL rst_read_open !* open the restart file if necessary 798 ! ! --------- ! 799 ! ! all cases ! 800 ! ! --------- ! 801 ! 802 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) !* check presence 791 803 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 792 id5 = iom_varid( numror, 'hdiv_lf' , ldstop = .FALSE. )804 id5 = iom_varid( numror, 'hdiv_lf' , ldstop = .FALSE. ) 793 805 ! 794 ! ! --------- ! 795 ! ! all cases ! 796 ! ! --------- ! 797 ! 798 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 806 ! !* scale factors 807 IF(lwp) WRITE(numout,*) ' Kmm scale factor read in the restart file' 808 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 809 WHERE ( tmask(:,:,:) == 0.0_wp ) 810 e3t(:,:,:,Kmm) = e3t_0(:,:,:) 811 END WHERE 812 IF( l_1st_euler ) THEN ! euler 813 IF(lwp) WRITE(numout,*) ' Euler first time step : e3t(Kbb) = e3t(Kmm)' 814 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 815 ELSE ! leap frog 816 IF(lwp) WRITE(numout,*) ' Kbb scale factor read in the restart file' 799 817 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 800 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) )801 ! needed to restart if land processor not computed802 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files'803 818 WHERE ( tmask(:,:,:) == 0.0_wp ) 804 e3t(:,:,:,Kmm) = e3t_0(:,:,:)805 819 e3t(:,:,:,Kbb) = e3t_0(:,:,:) 806 820 END WHERE 807 IF( l_1st_euler ) THEN808 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)809 ENDIF810 ELSE IF( id1 > 0 ) THEN811 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart files'812 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.'813 IF(lwp) write(numout,*) 'l_1st_euler is forced to true'814 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) )815 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb)816 l_1st_euler = .true.817 ELSE IF( id2 > 0 ) THEN818 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kbb) not found in restart files'819 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.'820 IF(lwp) write(numout,*) 'l_1st_euler is forced to true'821 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) )822 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)823 l_1st_euler = .true.824 ELSE825 IF(lwp) write(numout,*) 'dom_vvl_rst WARNING : e3t(:,:,:,Kmm) not found in restart file'826 IF(lwp) write(numout,*) 'Compute scale factor from sshn'827 IF(lwp) write(numout,*) 'l_1st_euler is forced to true'828 DO jk = 1, jpk829 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) &830 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) &831 & + e3t_0(:,:,jk) * (1._wp -tmask(:,:,jk))832 END DO833 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm)834 l_1st_euler = .true.835 821 ENDIF 836 ! !----------- !837 IF( ln_vvl_zstar ) THEN !z_star case !838 ! !----------- !822 ! ! ------------ ! 823 IF( ln_vvl_zstar ) THEN ! z_star case ! 824 ! ! ------------ ! 839 825 IF( MIN( id3, id4 ) > 0 ) THEN 840 826 CALL ctl_stop( 'dom_vvl_rst: z_star cannot restart from a z_tilde or layer run' ) 841 827 ENDIF 842 ! ! ----------------------- ! 843 ELSE ! z_tilde and layer cases ! 844 ! ! ----------------------- ! 845 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 846 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 828 ! ! ------------------------ ! 829 ELSE ! z_tilde and layer cases ! 830 ! ! ------------------------ ! 831 ! 832 IF( id4 > 0 ) THEN !* scale factor increments 833 IF(lwp) WRITE(numout,*) ' Kmm scale factor increments read in the restart file' 847 834 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 848 ELSE ! one at least array is missing 835 IF( l_1st_euler ) THEN ! euler 836 IF(lwp) WRITE(numout,*) ' Euler first time step : tilde_e3t(Kbb) = tilde_e3t(Kmm)' 837 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 838 ELSE ! leap frog 839 IF(lwp) WRITE(numout,*) ' Kbb scale factor increments read in the restart file' 840 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 841 ENDIF 842 ELSE 849 843 tilde_e3t_b(:,:,:) = 0.0_wp 850 844 tilde_e3t_n(:,:,:) = 0.0_wp 851 845 ENDIF 852 ! ! ------------ !853 IF( ln_vvl_ztilde ) THEN ! z_tilde case !854 ! ! ------------ !846 ! ! ------------ ! 847 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 848 ! ! ------------ ! 855 849 IF( id5 > 0 ) THEN ! required array exists 856 850 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 857 851 ELSE ! array is missing 858 hdiv_lf(:,:,:) = 0.0_wp 852 hdiv_lf(:,:,:) = 0.0_wp 859 853 ENDIF 860 854 ENDIF 861 855 ENDIF 862 856 ! 863 ELSE ! * Initialize at "rest"857 ELSE !== Initialize at "rest" with ssh ==! 864 858 ! 865 866 IF( ll_wd ) THEN ! MJB ll_wd edits start here - these are essential 867 ! 868 IF( cn_cfg == 'wad' ) THEN 869 ! Wetting and drying test case 870 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 871 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 872 ssh (:,:,Kmm) = ssh(:,:,Kbb) 873 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 874 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 875 ELSE 876 ! if not test case 877 ssh(:,:,Kmm) = -ssh_ref 878 ssh(:,:,Kbb) = -ssh_ref 879 880 DO_2D( 1, 1, 1, 1 ) 881 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 882 ssh(ji,jj,Kbb) = rn_wdmin1 - (ht_0(ji,jj) ) 883 ssh(ji,jj,Kmm) = rn_wdmin1 - (ht_0(ji,jj) ) 884 ENDIF 885 END_2D 886 ENDIF !If test case else 887 888 ! Adjust vertical metrics for all wad 889 DO jk = 1, jpk 890 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 891 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 892 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 893 END DO 894 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 895 896 DO_2D( 1, 1, 1, 1 ) 897 IF ( ht_0(ji,jj) .LE. 0.0 .AND. NINT( ssmask(ji,jj) ) .EQ. 1) THEN 898 CALL ctl_stop( 'dom_vvl_rst: ht_0 must be positive at potentially wet points' ) 899 ENDIF 900 END_2D 901 ! 902 ELSE 903 ! 904 ! Just to read set ssh in fact, called latter once vertical grid 905 ! is set up: 906 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 907 ! ! 908 ! DO jk=1,jpk 909 ! e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 910 ! & / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 911 ! END DO 912 ! e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 913 ssh(:,:,Kmm)=0._wp 914 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 915 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 916 ! 917 END IF ! end of ll_wd edits 918 859 DO jk = 1, jpk 860 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * r1_ht_0(:,:) * tmask(:,:,jk) ) 861 END DO 862 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 863 ! 919 864 IF( ln_vvl_ztilde .OR. ln_vvl_layer) THEN 920 865 tilde_e3t_b(:,:,:) = 0._wp 921 866 tilde_e3t_n(:,:,:) = 0._wp 922 867 IF( ln_vvl_ztilde ) hdiv_lf(:,:,:) = 0._wp 923 END 868 ENDIF 924 869 ENDIF 925 ! 926 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 927 ! ! =================== 870 ! !=======================! 871 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file ! 872 ! !=======================! 873 ! 928 874 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 929 875 ! ! --------- ! -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/domzgr_substitute.h90
r13237 r14054 15 15 # define e3u(i,j,k,t) (e3u_0(i,j,k)*(1._wp+r3u(i,j,t)*umask(i,j,k))) 16 16 # define e3v(i,j,k,t) (e3v_0(i,j,k)*(1._wp+r3v(i,j,t)*vmask(i,j,k))) 17 # define e3f(i,j,k) (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fmask(i,j,k))) 17 # define e3f(i,j,k) (e3f_0(i,j,k)*(1._wp+r3f(i,j)*fe3mask(i,j,k))) 18 # define e3f_vor(i,j,k) (e3f_0vor(i,j,k)*(1._wp+r3f(i,j)*fe3mask(i,j,k))) 18 19 # define e3w(i,j,k,t) (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 19 20 # define e3uw(i,j,k,t) (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 20 21 # define e3vw(i,j,k,t) (e3vw_0(i,j,k)*(1._wp+r3v(i,j,t))) 21 # define ht(i,j) (ht_0(i,j) +ssh(i,j,Kmm))22 # define ht(i,j) (ht_0(i,j)*(1._wp+r3t(i,j,Kmm))) 22 23 # define hu(i,j,t) (hu_0(i,j)*(1._wp+r3u(i,j,t))) 23 24 # define hv(i,j,t) (hv_0(i,j)*(1._wp+r3v(i,j,t))) … … 29 30 #endif 30 31 !!---------------------------------------------------------------------- 32 !!# define e3t_f(i,j,k) (e3t_0(i,j,k)*(1._wp+r3t_f(i,j)*tmask(i,j,k))) 33 !!# define e3u_f(i,j,k) (e3u_0(i,j,k)*(1._wp+r3u_f(i,j)*umask(i,j,k))) 34 !!# define e3v_f(i,j,k) (e3v_0(i,j,k)*(1._wp+r3v_f(i,j)*vmask(i,j,k))) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/istate.F90
r13295 r14054 42 42 PRIVATE 43 43 44 PUBLIC istate_init ! routine called by step.F9044 PUBLIC istate_init ! routine called by nemogcm.F90 45 45 46 46 !! * Substitutions … … 59 59 !! 60 60 !! ** Purpose : Initialization of the dynamics and tracer fields. 61 !! 62 !! ** Method : 61 63 !!---------------------------------------------------------------------- 62 64 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! ocean time level indices 63 65 ! 64 66 INTEGER :: ji, jj, jk ! dummy loop indices 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept ! 3D table !!st patch to use gdept subtitute67 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept ! 3D table for qco substitute 66 68 !!gm see comment further down 67 69 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace … … 73 75 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 74 76 75 !!gm Why not include in the first call of dta_tsd ?76 !!gm probably associated with the use of internal damping...77 77 CALL dta_tsd_init ! Initialisation of T & S input data 78 !!gm to be moved in usrdef of C1D case 78 79 79 ! IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 80 !!gm81 80 82 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk83 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk84 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk85 rab_b(:,:,:,: ) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk81 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 82 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 83 ts (:,:,:,:,Kaa) = 0._wp ! set one for all to 0 at level jpk 84 rab_b(:,:,:,: ) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 86 85 #if defined key_agrif 87 86 uu (:,:,: ,Kaa) = 0._wp ! used in agrif_oce_sponge at initialization … … 96 95 CALL agrif_istate( Kbb, Kmm, Kaa ) ! Interp from parent 97 96 ! 98 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 99 ssh (:,:,Kmm) = ssh(:,:,Kbb) 100 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 101 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 97 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 98 !!st 99 !!st need for a recent agrif version to be displaced toward ssh_init_rst with agrif_istate_ssh 100 ssh(:,:, Kmm) = ssh(:,: ,Kbb) 101 !!st end 102 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb) 103 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb) 102 104 ELSE 103 105 #endif … … 117 119 CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 118 120 ! 119 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 120 uu (:,:,:,Kbb) = 0._wp 121 vv (:,:,:,Kbb) = 0._wp 121 uu (:,:,:,Kbb) = 0._wp 122 vv (:,:,:,Kbb) = 0._wp 122 123 ! 123 IF( ll_wd ) THEN124 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD125 !126 ! Apply minimum wetdepth criterion127 !128 DO_2D( 1, 1, 1, 1 )129 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN130 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )131 ENDIF132 END_2D133 ENDIF134 !135 124 ELSE ! user defined initial T and S 136 125 DO jk = 1, jpk 137 126 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 138 127 END DO 139 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) , ssh(:,:,Kbb) )128 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 140 129 ENDIF 141 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 142 ssh (:,:,Kmm) = ssh(:,:,Kbb) 143 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 144 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 145 146 !!gm POTENTIAL BUG : 147 !!gm ISSUE : if ssh(:,:,Kbb) /= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed 148 !! as well as gdept_ and gdepw_.... !!!!! 149 !! ===>>>> probably a call to domvvl initialisation here.... 150 130 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 131 uu (:,:,: ,Kmm) = uu (:,:,: ,Kbb) 132 vv (:,:,: ,Kmm) = vv (:,:,: ,Kbb) 151 133 152 134 ! 153 !!gm to be moved in usrdef of C1D case154 !IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000155 !ALLOCATE( zuvd(jpi,jpj,jpk,2) )156 ! CALL dta_uvd( nit000, zuvd )157 ! uu(:,:,:,Kbb) = zuvd(:,:,:,1); uu(:,:,:,Kmm) = uu(:,:,:,Kbb)158 ! vv(:,:,:,Kbb) = zuvd(:,:,:,2); vv(:,:,:,Kmm) = vv(:,:,:,Kbb)159 !DEALLOCATE( zuvd )160 !ENDIF135 !!gm ==>>> to be moved in usrdef_istate of C1D case 136 IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 137 ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 138 CALL dta_uvd( nit000, Kbb, zuvd ) 139 uu(:,:,:,Kbb) = zuvd(:,:,:,1) ; uu(:,:,:,Kmm) = uu(:,:,:,Kbb) 140 vv(:,:,:,Kbb) = zuvd(:,:,:,2) ; vv(:,:,:,Kmm) = vv(:,:,:,Kbb) 141 DEALLOCATE( zuvd ) 142 ENDIF 161 143 ! 162 !!gm This is to be changed !!!!163 ! ! - ML - ssh(:,:,Kmm) could be modified by istate_eel, so that initialization of e3t(:,:,:,Kbb) is done here164 ! IF( .NOT.ln_linssh ) THEN165 ! DO jk = 1, jpk166 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm)167 ! END DO168 ! ENDIF169 !!gm170 144 ! 171 145 ENDIF -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DOM/phycst.F90
r12489 r14054 66 66 REAL(wp), PUBLIC :: r1_rhos !: 1 / rhos 67 67 REAL(wp), PUBLIC :: r1_rcpi !: 1 / rcpi 68 68 69 !!---------------------------------------------------------------------- 69 70 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynadv.F90
r12377 r14054 127 127 IF( ioptio /= 1 ) CALL ctl_stop( 'choose ONE and only ONE advection scheme' ) 128 128 IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW ) CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 129 129 #if defined key_qcoTest_FluxForm 130 IF( ln_dynadv_vec ) THEN CALL ctl_stop( 'STOP', 'key_qcoTest_FluxForm requires flux form advection' ) 131 #endif 130 132 131 133 IF(lwp) THEN ! Print the choice -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynatf_qco.F90
r13295 r14054 1 MODULE dynatf qco1 MODULE dynatf_qco 2 2 !!========================================================================= 3 !! *** MODULE dynatf qco ***3 !! *** MODULE dynatf_qco *** 4 4 !! Ocean dynamics: time filtering 5 5 !!========================================================================= … … 50 50 USE prtctl ! Print control 51 51 USE timing ! Timing 52 #if defined key_agrif53 USE agrif_oce_interp54 #endif55 52 56 53 IMPLICIT NONE … … 199 196 ! JC: Would be more clever to swap variables than to make a full vertical 200 197 ! integration 201 ! 198 ! CAUTION : calculation need to be done in the same way than see GM 202 199 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 203 uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1)200 uu_b(:,:,Kmm) = (e3u_0(:,:,1) * ( 1._wp + r3u_f(:,:) * umask(:,:,1) )) * puu(:,:,1,Kmm) * umask(:,:,1) 204 201 vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 205 vv_b(:,:,Kmm) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1)202 vv_b(:,:,Kmm) = (e3v_0(:,:,1) * ( 1._wp + r3v_f(:,:) * vmask(:,:,1))) * pvv(:,:,1,Kmm) * vmask(:,:,1) 206 203 DO jk = 2, jpkm1 207 204 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 208 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)205 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + (e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) )) * puu(:,:,jk,Kmm) * umask(:,:,jk) 209 206 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 210 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)207 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + (e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) )) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 211 208 END DO 212 209 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) 213 210 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) * r1_hv(:,:,Kaa) 214 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm)215 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm)211 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * (r1_hu_0(:,:)/( 1._wp + r3u_f(:,:) )) 212 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * (r1_hv_0(:,:)/( 1._wp + r3v_f(:,:) )) 216 213 ! 217 214 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents … … 235 232 236 233 !!========================================================================= 237 END MODULE dynatf qco234 END MODULE dynatf_qco -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynldf_lap_blp.F90
r13497 r14054 5 5 !!====================================================================== 6 6 !! History : 3.7 ! 2014-01 (G. Madec, S. Masson) Original code, re-entrant laplacian 7 !! 4.0 ! 2020-04 (A. Nasser, G. Madec) Add symmetric mixing tensor 7 8 !!---------------------------------------------------------------------- 8 9 … … 19 20 USE in_out_manager ! I/O manager 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 22 USE lib_mpp 23 22 24 IMPLICIT NONE 23 25 PRIVATE … … 47 49 !! 48 50 !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv. 51 !! 52 !! Reference : S.Griffies, R.Hallberg 2000 Mon.Wea.Rev., DOI:/ 49 53 !!---------------------------------------------------------------------- 50 54 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 57 61 REAL(wp) :: zsign ! local scalars 58 62 REAL(wp) :: zua, zva ! local scalars 59 REAL(wp), DIMENSION(jpi,jpj) :: zcur, zdiv 63 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zcur, zdiv 64 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zten, zshe ! tension (diagonal) and shearing (anti-diagonal) terms 60 65 !!---------------------------------------------------------------------- 61 66 ! … … 70 75 ENDIF 71 76 ! 72 ! ! =============== 73 DO jk = 1, jpkm1 ! Horizontal slab 74 ! ! =============== 75 DO_2D( 0, 1, 0, 1 ) 76 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 77 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 78 & * ( e2v(ji ,jj-1) * pv(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk) & 79 & - e1u(ji-1,jj ) * pu(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk) ) 80 ! ! ahm * div (computed from 2 to jpi/jpj) 81 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb) & ! ahmt already * by tmask 82 & * ( 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) & 83 & + 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) ) 84 END_2D 77 SELECT CASE( nn_dynldf_typ ) 78 ! 79 CASE ( np_typ_rot ) !== Vorticity-Divergence operator ==! 85 80 ! 86 DO_2D( 0, 0, 0, 0 ) ! - curl( curl) + grad( div ) 87 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 88 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 89 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 81 ALLOCATE( zcur(jpi,jpj) , zdiv(jpi,jpj) ) 82 ! 83 DO jk = 1, jpkm1 ! Horizontal slab 84 ! 85 DO_2D( 0, 1, 0, 1 ) 86 ! ! ahm * e3 * curl (computed from 1 to jpim1/jpjm1) 87 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 88 & * ( e2v(ji ,jj-1) * pv(ji ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk) & 89 & - e1u(ji-1,jj ) * pu(ji-1,jj ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk) ) 90 ! ! ahm * div (computed from 2 to jpi/jpj) 91 zdiv(ji,jj) = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb) & ! ahmt already * by tmask 92 & * ( 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) & 93 & + 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) ) 94 END_2D 95 ! 96 DO_2D( 0, 0, 0, 0 ) ! - curl( curl) + grad( div ) 97 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * umask(ji,jj,jk) * ( & ! * by umask is mandatory for dyn_ldf_blp use 98 & - ( zcur(ji ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 99 & + ( zdiv(ji+1,jj) - zdiv(ji,jj ) ) * r1_e1u(ji,jj) ) 90 100 ! 91 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * ( & ! * by vmask is mandatory for dyn_ldf_blp use 92 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm) & 93 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 94 END_2D 95 ! ! =============== 96 END DO ! End of slab 97 ! ! =============== 101 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * vmask(ji,jj,jk) * ( & ! * by vmask is mandatory for dyn_ldf_blp use 102 & ( zcur(ji,jj ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm) & 103 & + ( zdiv(ji,jj+1) - zdiv(ji ,jj) ) * r1_e2v(ji,jj) ) 104 END_2D 105 ! 106 END DO ! End of slab 107 ! 108 DEALLOCATE( zcur , zdiv ) 109 ! 110 CASE ( np_typ_sym ) !== Symmetric operator ==! 111 ! 112 ALLOCATE( zten(jpi,jpj) , zshe(jpi,jpj) ) 113 ! 114 DO jk = 1, jpkm1 ! Horizontal slab 115 ! 116 DO_2D( 0, 1, 0, 1 ) 117 ! ! shearing stress component (F-point) NB : ahmf has already been multiplied by fmask 118 zshe(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) & 119 & * ( e1f(ji-1,jj-1) * r1_e2f(ji-1,jj-1) & 120 & * ( pu(ji-1,jj ,jk) * r1_e1u(ji-1,jj ) - pu(ji-1,jj-1,jk) * r1_e1u(ji-1,jj-1) ) & 121 & + e2f(ji-1,jj-1) * r1_e1f(ji-1,jj-1) & 122 & * ( pv(ji ,jj-1,jk) * r1_e2v(ji ,jj-1) - pv(ji-1,jj-1,jk) * r1_e2v(ji-1,jj-1) ) ) 123 ! ! tension stress component (T-point) NB : ahmt has already been multiplied by tmask 124 zten(ji,jj) = ahmt(ji,jj,jk) & 125 & * ( e2t(ji,jj) * r1_e1t(ji,jj) & 126 & * ( pu(ji,jj,jk) * r1_e2u(ji,jj) - pu(ji-1,jj,jk) * r1_e2u(ji-1,jj) ) & 127 & - e1t(ji,jj) * r1_e2t(ji,jj) & 128 & * ( pv(ji,jj,jk) * r1_e1v(ji,jj) - pv(ji,jj-1,jk) * r1_e1v(ji,jj-1) ) ) 129 END_2D 130 ! 131 DO_2D( 0, 0, 0, 0 ) 132 pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) & 133 & * ( ( zten(ji+1,jj ) * e2t(ji+1,jj )*e2t(ji+1,jj ) * e3t(ji+1,jj ,jk,Kmm) & 134 & - zten(ji ,jj ) * e2t(ji ,jj )*e2t(ji ,jj ) * e3t(ji ,jj ,jk,Kmm) ) * r1_e2u(ji,jj) & 135 & + ( zshe(ji ,jj ) * e1f(ji ,jj )*e1f(ji ,jj ) * e3f(ji ,jj ,jk) & 136 & - zshe(ji ,jj-1) * e1f(ji ,jj-1)*e1f(ji ,jj-1) * e3f(ji ,jj-1,jk) ) * r1_e1u(ji,jj) ) 137 ! 138 pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) & 139 & * ( ( zshe(ji ,jj ) * e2f(ji ,jj )*e2f(ji ,jj ) * e3f(ji ,jj ,jk) & 140 & - zshe(ji-1,jj ) * e2f(ji-1,jj )*e2f(ji-1,jj ) * e3f(ji-1,jj ,jk) ) * r1_e2v(ji,jj) & 141 & - ( zten(ji ,jj+1) * e1t(ji ,jj+1)*e1t(ji ,jj+1) * e3t(ji ,jj+1,jk,Kmm) & 142 & - zten(ji ,jj ) * e1t(ji ,jj )*e1t(ji ,jj ) * e3t(ji ,jj ,jk,Kmm) ) * r1_e1v(ji,jj) ) 143 ! 144 END_2D 145 ! 146 END DO 147 ! 148 DEALLOCATE( zten , zshe ) 149 ! 150 END SELECT 98 151 ! 99 152 END SUBROUTINE dyn_ldf_lap -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynspg_ts.F90
r14049 r14054 306 306 ENDIF 307 307 ! 308 ! != Add atmospheric pressureforcing =!309 ! ! ------------------ ----------------!310 IF( ln_bt_fw ) THEN ! Add wind forcing308 ! != Add wind forcing =! 309 ! ! ------------------ ! 310 IF( ln_bt_fw ) THEN 311 311 DO_2D( 0, 0, 0, 0 ) 312 312 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_rho0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) … … 386 386 ! 387 387 IF( ln_linssh ) THEN ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0) 388 zhup2_e(:,:) = hu (:,:,Kmm)389 zhvp2_e(:,:) = hv (:,:,Kmm)390 zhtp2_e(:,:) = ht (:,:)391 ENDIF 392 ! 393 IF (ln_bt_fw) THEN! FORWARD integration: start from NOW fields394 sshn_e(:,:) = pssh (:,:,Kmm)388 zhup2_e(:,:) = hu_0(:,:) 389 zhvp2_e(:,:) = hv_0(:,:) 390 zhtp2_e(:,:) = ht_0(:,:) 391 ENDIF 392 ! 393 IF( ln_bt_fw ) THEN ! FORWARD integration: start from NOW fields 394 sshn_e(:,:) = pssh (:,:,Kmm) 395 395 un_e (:,:) = puu_b(:,:,Kmm) 396 396 vn_e (:,:) = pvv_b(:,:,Kmm) … … 401 401 hvr_e (:,:) = r1_hv(:,:,Kmm) 402 402 ELSE ! CENTRED integration: start from BEFORE fields 403 sshn_e(:,:) = pssh (:,:,Kbb)403 sshn_e(:,:) = pssh (:,:,Kbb) 404 404 un_e (:,:) = puu_b(:,:,Kbb) 405 405 vn_e (:,:) = pvv_b(:,:,Kbb) … … 412 412 ! 413 413 ! Initialize sums: 414 puu_b 415 pvv_b 414 puu_b (:,:,Kaa) = 0._wp ! After barotropic velocities (or transport if flux form) 415 pvv_b (:,:,Kaa) = 0._wp 416 416 pssh (:,:,Kaa) = 0._wp ! Sum for after averaged sea level 417 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop418 vn_adv(:,:) = 0._wp417 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop 418 vn_adv(:,:) = 0._wp 419 419 ! 420 420 IF( ln_wd_dl ) THEN … … 475 475 ! 476 476 ! ! ocean u- and v-depth at mid-step (separate DO-loops remove the need of a lbc_lnk) 477 #if defined key_qcoTest_FluxForm 478 ! ! 'key_qcoTest_FluxForm' : simple ssh average 479 DO_2D( 1, 1, 1, 0 ) ! not jpi-column 480 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * ( zsshp2_e(ji,jj) + zsshp2_e(ji+1,jj ) ) * ssumask(ji,jj) 481 END_2D 482 DO_2D( 1, 0, 1, 1 ) 483 zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * ( zsshp2_e(ji,jj) + zsshp2_e(ji ,jj+1) ) * ssvmask(ji,jj) 484 END_2D 485 #else 486 ! ! no 'key_qcoTest_FluxForm' : surface weighted ssh average 477 487 DO_2D( 1, 1, 1, 0 ) ! not jpi-column 478 488 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj) & … … 485 495 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) * ssvmask(ji,jj) 486 496 END_2D 497 #endif 487 498 ! 488 499 ENDIF … … 540 551 ! 541 552 ! Sea Surface Height at u-,v-points (vvl case only) 542 IF( .NOT.ln_linssh ) THEN 553 IF( .NOT.ln_linssh ) THEN 554 #if defined key_qcoTest_FluxForm 555 ! ! 'key_qcoTest_FluxForm' : simple ssh average 556 DO_2D( 1, 1, 1, 0 ) 557 zsshu_a(ji,jj) = r1_2 * ( ssha_e(ji,jj) + ssha_e(ji+1,jj ) ) * ssumask(ji,jj) 558 END_2D 559 DO_2D( 1, 0, 1, 1 ) 560 zsshv_a(ji,jj) = r1_2 * ( ssha_e(ji,jj) + ssha_e(ji ,jj+1) ) * ssvmask(ji,jj) 561 END_2D 562 #else 543 563 DO_2D( 0, 0, 0, 0 ) 544 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 545 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 546 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 547 zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 548 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 549 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 550 END_2D 551 ENDIF 564 zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 565 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) * ssumask(ji,jj) 566 zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 567 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) * ssvmask(ji,jj) 568 END_2D 569 #endif 570 ENDIF 552 571 ! 553 572 ! Half-step back interpolation of SSH for surface pressure computation at step jit+1/2 … … 624 643 ! ! hu_e, hv_e hold depth at jn, zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 625 644 ! ! backward interpolated depth used in spg terms at jn+1/2 645 #if defined key_qcoTest_FluxForm 646 ! ! 'key_qcoTest_FluxForm' : simple ssh average 647 zhu_bck = hu_0(ji,jj) + r1_2 * ( zsshp2_e(ji,jj) + zsshp2_e(ji+1,jj ) ) * ssumask(ji,jj) 648 zhv_bck = hv_0(ji,jj) + r1_2 * ( zsshp2_e(ji,jj) + zsshp2_e(ji ,jj+1) ) * ssvmask(ji,jj) 649 #else 626 650 zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 627 651 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask(ji,jj) 628 652 zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 629 653 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) * ssvmask(ji,jj) 654 #endif 630 655 ! ! inverse depth at jn+1 631 656 z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) … … 646 671 IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 647 672 DO_2D( 0, 0, 0, 0 ) 648 ua_e(ji,jj) = ua_e(ji,jj) /(1.0 - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj))649 va_e(ji,jj) = va_e(ji,jj) /(1.0 - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj))673 ua_e(ji,jj) = ua_e(ji,jj) / ( 1._wp - rDt_e * zCdU_u(ji,jj) * hur_e(ji,jj) ) 674 va_e(ji,jj) = va_e(ji,jj) / ( 1._wp - rDt_e * zCdU_v(ji,jj) * hvr_e(ji,jj) ) 650 675 END_2D 651 676 ENDIF 652 677 653 678 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 654 hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1)655 hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1))656 hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1)657 hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1))679 hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 680 hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 681 hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 682 hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 658 683 ENDIF 659 684 ! … … 743 768 ELSE 744 769 ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 770 #if defined key_qcoTest_FluxForm 771 ! ! 'key_qcoTest_FluxForm' : simple ssh average 745 772 DO_2D( 1, 0, 1, 0 ) 746 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 747 & * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) & 748 & + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) 749 zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 750 & * ( e1e2t(ji,jj ) * pssh(ji,jj ,Kaa) & 751 & + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) 752 END_2D 773 zsshu_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji+1,jj ,Kaa) ) * ssumask(ji,jj) 774 zsshv_a(ji,jj) = r1_2 * ( pssh(ji,jj,Kaa) + pssh(ji ,jj+1,Kaa) ) * ssvmask(ji,jj) 775 END_2D 776 #else 777 DO_2D( 1, 0, 1, 0 ) 778 zsshu_a(ji,jj) = r1_2 * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * pssh(ji ,jj,Kaa) & 779 & + e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) * ssumask(ji,jj) 780 zsshv_a(ji,jj) = r1_2 * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * pssh(ji,jj ,Kaa) & 781 & + e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) * ssvmask(ji,jj) 782 END_2D 783 #endif 753 784 CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 754 785 ! 755 786 DO jk=1,jpkm1 756 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 757 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 787 puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) & 788 & * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_Dt_b 789 pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) & 790 & * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_Dt_b 758 791 END DO 759 792 ! Save barotropic velocities not transport: … … 899 932 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 900 933 ! ! --------------- 901 IF( ln_rstart .AND. ln_bt_fw .AND. (.NOT.l_1st_euler)) THEN !* Read the restart file934 IF( ln_rstart .AND. ln_bt_fw .AND. .NOT.l_1st_euler ) THEN !* Read the restart file 902 935 CALL iom_get( numror, jpdom_auto, 'ub2_b' , ub2_b (:,:), cd_type = 'U', psgn = -1._wp ) 903 936 CALL iom_get( numror, jpdom_auto, 'vb2_b' , vb2_b (:,:), cd_type = 'V', psgn = -1._wp ) … … 1060 1093 !! although they should be updated in the variable volume case. Not a big approximation. 1061 1094 !! To remove this approximation, copy lines below inside barotropic loop 1062 !! and update depths at T- F points (ht and zhf resp.) at each barotropic time step1095 !! and update depths at T- points (ht) at each barotropic time step 1063 1096 !! 1064 1097 !! Compute zwz = f / ( height of the water colomn ) … … 1067 1100 INTEGER :: ji ,jj, jk ! dummy loop indices 1068 1101 REAL(wp) :: z1_ht 1069 REAL(wp), DIMENSION(jpi,jpj) :: zhf1070 1102 !!---------------------------------------------------------------------- 1071 1103 ! 1072 1104 SELECT CASE( nvor_scheme ) 1073 CASE( np_EEN ) != EEN scheme using e3f energy & enstrophy scheme1074 SELECT CASE( nn_e en_e3f )!* ff_f/e3 at F-point1105 CASE( np_EEN, np_ENE, np_ENS , np_MIX ) != schemes using the same e3f definition 1106 SELECT CASE( nn_e3f_typ ) !* ff_f/e3 at F-point 1075 1107 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 1076 DO_2D( 1, 0, 1, 0 )1077 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) +&1078 & ht(ji ,jj ) + ht(ji+1,jj )) * 0.25_wp1108 DO_2D( 0, 0, 0, 0 ) 1109 zwz(ji,jj) = ( ht(ji,jj+1) + ht(ji+1,jj+1) & 1110 & + ht(ji,jj ) + ht(ji+1,jj ) ) * 0.25_wp 1079 1111 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 1080 1112 END_2D 1081 1113 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 1082 DO_2D( 1, 0, 1, 0 )1083 zwz(ji,jj) = ( ht (ji ,jj+1) + ht(ji+1,jj+1) &1084 & + ht (ji ,jj ) + ht(ji+1,jj ) ) &1085 & / ( MAX( 1._wp, ssmask(ji,jj+1) + ssmask(ji+1,jj+1) &1086 & + ssmask(ji ,jj ) + ssmask(ji+1,jj )) )1114 DO_2D( 0, 0, 0, 0 ) 1115 zwz(ji,jj) = ( ht(ji,jj+1) + ht(ji+1,jj+1) & 1116 & + ht(ji,jj ) + ht(ji+1,jj ) ) & 1117 & / ( MAX(ssmask(ji,jj+1) + ssmask(ji+1,jj+1) & 1118 & + ssmask(ji,jj ) + ssmask(ji+1,jj ) , 1._wp ) ) 1087 1119 IF( zwz(ji,jj) /= 0._wp ) zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 1088 1120 END_2D 1089 1121 END SELECT 1090 1122 CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp ) 1091 ! 1092 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1123 END SELECT 1124 ! 1125 SELECT CASE( nvor_scheme ) 1126 CASE( np_EEN ) 1127 ! 1128 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1093 1129 DO_2D( 0, 1, 0, 1 ) 1094 1130 ftne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 1098 1134 END_2D 1099 1135 ! 1100 CASE( np_EET ) != EEN scheme using e3t energy conserving scheme1101 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ;ftsw(1,:) = 0._wp1136 CASE( np_EET ) != EEN scheme using e3t energy conserving scheme 1137 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1102 1138 DO_2D( 0, 1, 0, 1 ) 1103 1139 z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) … … 1108 1144 END_2D 1109 1145 ! 1110 CASE( np_ENE, np_ENS , np_MIX ) != all other schemes (ENE, ENS, MIX) except ENT !1111 !1112 zwz(:,:) = 0._wp1113 zhf(:,:) = 0._wp1114 1115 !!gm assume 0 in both cases (which is almost surely WRONG ! ) as hvatf has been removed1116 !!gm A priori a better value should be something like :1117 !!gm zhf(i,j) = masked sum of ht(i,j) , ht(i+1,j) , ht(i,j+1) , (i+1,j+1)1118 !!gm divided by the sum of the corresponding mask1119 !!gm1120 !!1121 IF( .NOT.ln_sco ) THEN1122 1123 !!gm agree the JC comment : this should be done in a much clear way1124 1125 ! JC: It not clear yet what should be the depth at f-points over land in z-coordinate case1126 ! Set it to zero for the time being1127 ! IF( rn_hmin < 0._wp ) THEN ; jk = - INT( rn_hmin ) ! from a nb of level1128 ! ELSE ; jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 ) ! from a depth1129 ! ENDIF1130 ! zhf(:,:) = gdepw_0(:,:,jk+1)1131 !1132 ELSE1133 !1134 !zhf(:,:) = hbatf(:,:)1135 DO_2D( 1, 0, 1, 0 )1136 zhf(ji,jj) = ( ht_0 (ji,jj ) + ht_0 (ji+1,jj ) &1137 & + ht_0 (ji,jj+1) + ht_0 (ji+1,jj+1) ) &1138 & / MAX( ssmask(ji,jj ) + ssmask(ji+1,jj ) &1139 & + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp )1140 END_2D1141 ENDIF1142 !1143 DO jj = 1, jpjm11144 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1))1145 END DO1146 !1147 DO jk = 1, jpkm11148 DO jj = 1, jpjm11149 zhf(:,jj) = zhf(:,jj) + e3f(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)1150 END DO1151 END DO1152 CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp )1153 ! JC: TBC. hf should be greater than 01154 DO_2D( 1, 1, 1, 1 )1155 IF( zhf(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zhf(ji,jj)1156 END_2D1157 zwz(:,:) = ff_f(:,:) * zwz(:,:)1158 1146 END SELECT 1159 1147 1160 1148 END SUBROUTINE dyn_cor_2d_init 1161 1162 1149 1163 1150 … … 1353 1340 END SUBROUTINE wad_spg 1354 1341 1355 1356 1342 1357 1343 SUBROUTINE dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, pu_RHSi, pv_RHSi, pCdU_u, pCdU_v ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/dynvor.F90
r14049 r14054 21 21 !! - ! 2018-03 (G. Madec) add two new schemes (ln_dynvor_enT and ln_dynvor_eet) 22 22 !! - ! 2018-04 (G. Madec) add pre-computed gradient for metric term calculation 23 !! 4.x ! 2020-03 (G. Madec, A. Nasser) make ln_dynvor_msk truly efficient on relative vorticity 23 24 !! 4.2 ! 2020-12 (G. Madec, E. Clementi) add vortex force trends (ln_vortex_force=T) 24 25 !!---------------------------------------------------------------------- … … 26 27 !!---------------------------------------------------------------------- 27 28 !! dyn_vor : Update the momentum trend with the vorticity trend 29 !! vor_enT : energy conserving scheme at T-pt (ln_dynvor_enT=T) 30 !! vor_ene : energy conserving scheme (ln_dynvor_ene=T) 28 31 !! vor_ens : enstrophy conserving scheme (ln_dynvor_ens=T) 29 !! vor_ene : energy conserving scheme (ln_dynvor_ene=T)30 32 !! vor_een : energy and enstrophy conserving (ln_dynvor_een=T) 33 !! vor_eeT : energy conserving at T-pt (ln_dynvor_eeT=T) 31 34 !! dyn_vor_init : set and control of the different vorticity option 32 35 !!---------------------------------------------------------------------- … … 58 61 LOGICAL, PUBLIC :: ln_dynvor_eeT !: t-point energy conserving scheme (EET) 59 62 LOGICAL, PUBLIC :: ln_dynvor_een !: energy & enstrophy conserving scheme (EEN) 60 INTEGER, PUBLIC :: nn_een_e3f !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)61 63 LOGICAL, PUBLIC :: ln_dynvor_mix !: mixed scheme (MIX) 62 64 LOGICAL, PUBLIC :: ln_dynvor_msk !: vorticity multiplied by fmask (=T) or not (=F) (all vorticity schemes) 65 INTEGER, PUBLIC :: nn_e3f_typ !: e3f=masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 63 66 64 67 INTEGER, PUBLIC :: nvor_scheme !: choice of the type of advection scheme … … 81 84 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: di_e2u_2 ! = di(e2u)/2 used in T-point metric term calculation 82 85 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dj_e1v_2 ! = dj(e1v)/2 - - - - 83 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: di_e2v_2e1e2f ! = di(e2v)/(2*e1e2f) used in F-point metric term calculation 84 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dj_e1u_2e1e2f ! = dj(e1u)/(2*e1e2f) - - - - 86 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: di_e2v_2e1e2f ! = di(e2u)/(2*e1e2f) used in F-point metric term calculation 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dj_e1u_2e1e2f ! = dj(e1v)/(2*e1e2f) - - - - 88 ! 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: e3f_0vor ! e3f used in EEN, ENE and ENS cases (key_qco only) 85 90 86 91 REAL(wp) :: r1_4 = 0.250_wp ! =1/4 … … 235 240 INTEGER :: ji, jj, jk ! dummy loop indices 236 241 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars 237 REAL(wp), DIMENSION(jpi,jpj) 238 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwz! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined242 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwt ! 2D workspace 243 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwz ! 3D workspace, jpkm1 -> avoid lbc_lnk on jpk that is not defined 239 244 !!---------------------------------------------------------------------- 240 245 ! … … 246 251 ! 247 252 ! 248 SELECT CASE( kvor ) !== volume weighted vorticity considered ==! 249 CASE ( np_RVO ) !* relative vorticity 250 DO jk = 1, jpkm1 ! Horizontal slab 253 SELECT CASE( kvor ) !== relative vorticity considered ==! 254 ! 255 CASE ( np_RVO , np_CRV ) !* relative vorticity at f-point is used 256 ALLOCATE( zwz(jpi,jpj,jpk) ) 257 DO jk = 1, jpkm1 ! Horizontal slab 251 258 DO_2D( 1, 0, 1, 0 ) 252 259 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 253 260 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 254 261 END_2D 255 IF( ln_dynvor_msk ) THEN ! mask /unmaskrelative vorticity262 IF( ln_dynvor_msk ) THEN ! mask relative vorticity 256 263 DO_2D( 1, 0, 1, 0 ) 257 264 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) … … 259 266 ENDIF 260 267 END DO 261 262 268 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 263 264 CASE ( np_CRV ) !* Coriolis + relative vorticity 265 DO jk = 1, jpkm1 ! Horizontal slab 266 DO_2D( 1, 0, 1, 0 ) ! relative vorticity 267 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 268 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 269 END_2D 270 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 271 DO_2D( 1, 0, 1, 0 ) 272 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 273 END_2D 274 ENDIF 275 END DO 276 277 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 278 269 ! 279 270 END SELECT 280 271 281 272 ! ! =============== 282 273 DO jk = 1, jpkm1 ! Horizontal slab 283 !! ===============284 274 ! ! =============== 275 ! 285 276 SELECT CASE( kvor ) !== volume weighted vorticity considered ==! 277 ! 286 278 CASE ( np_COR ) !* Coriolis (planetary vorticity) 287 279 zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,Kmm) 288 280 CASE ( np_RVO ) !* relative vorticity 289 281 DO_2D( 0, 1, 0, 1 ) 290 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) &291 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )&292 & 282 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 283 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) & 284 & * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 293 285 END_2D 294 286 CASE ( np_MET ) !* metric term 295 287 DO_2D( 0, 1, 0, 1 ) 296 zwt(ji,jj) = ( ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) &297 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) &298 & 288 zwt(ji,jj) = ( ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & 289 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) & 290 & * e3t(ji,jj,jk,Kmm) 299 291 END_2D 300 292 CASE ( np_CRV ) !* Coriolis + relative vorticity 301 293 DO_2D( 0, 1, 0, 1 ) 302 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) &303 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) &304 & 294 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 295 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) & 296 & * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 305 297 END_2D 306 298 CASE ( np_CME ) !* Coriolis + metric 307 299 DO_2D( 0, 1, 0, 1 ) 308 zwt(ji,jj) = ( ff_t(ji,jj) * e1e2t(ji,jj) &309 & + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) &310 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) &311 & 300 zwt(ji,jj) = ( ff_t(ji,jj) * e1e2t(ji,jj) & 301 & + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & 302 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) & 303 & * e3t(ji,jj,jk,Kmm) 312 304 END_2D 313 305 CASE DEFAULT ! error 314 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' 306 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor') 315 307 END SELECT 316 308 ! … … 328 320 END DO ! End of slab 329 321 ! ! =============== 322 ! 323 SELECT CASE( kvor ) ! deallocate zwz if necessary 324 CASE ( np_RVO , np_CRV ) ; DEALLOCATE( zwz ) 325 END SELECT 326 ! 330 327 END SUBROUTINE vor_enT 331 328 … … 358 355 ! 359 356 INTEGER :: ji, jj, jk ! dummy loop indices 360 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars357 REAL(wp) :: zx1, zy1, zx2, zy2, ze3f, zmsk ! local scalars 361 358 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz ! 2D workspace 362 359 !!---------------------------------------------------------------------- … … 380 377 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 381 378 END_2D 379 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 380 DO_2D( 1, 0, 1, 0 ) 381 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 382 END_2D 383 ENDIF 382 384 CASE ( np_MET ) !* metric term 383 385 DO_2D( 1, 0, 1, 0 ) … … 390 392 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 391 393 END_2D 394 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity (NOT the Coriolis term) 395 DO_2D( 1, 0, 1, 0 ) 396 zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 397 END_2D 398 ENDIF 392 399 CASE ( np_CME ) !* Coriolis + metric 393 400 DO_2D( 1, 0, 1, 0 ) … … 399 406 END SELECT 400 407 ! 401 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 402 DO_2D( 1, 0, 1, 0 ) 403 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 404 END_2D 405 ENDIF 406 407 IF( ln_sco ) THEN 408 zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 409 zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 410 zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 411 ELSE 412 zwx(:,:) = e2u(:,:) * pu(:,:,jk) 413 zwy(:,:) = e1v(:,:) * pv(:,:,jk) 414 ENDIF 408 #if defined key_qco 409 DO_2D( 1, 0, 1, 0 ) !== potential vorticity ==! (key_qco) 410 zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) 411 END_2D 412 #else 413 SELECT CASE( nn_e3f_typ ) !== potential vorticity ==! 414 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 415 DO_2D( 1, 0, 1, 0 ) 416 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 417 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 418 & + e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) & 419 & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 420 IF( ze3f /= 0._wp ) THEN ; zwz(ji,jj) = zwz(ji,jj) * 4._wp / ze3f 421 ELSE ; zwz(ji,jj) = 0._wp 422 ENDIF 423 END_2D 424 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 425 DO_2D( 1, 0, 1, 0 ) 426 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 427 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 428 & + e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) & 429 & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 430 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 431 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 432 IF( ze3f /= 0._wp ) THEN ; zwz(ji,jj) = zwz(ji,jj) * zmsk / ze3f 433 ELSE ; zwz(ji,jj) = 0._wp 434 ENDIF 435 END_2D 436 END SELECT 437 #endif 438 ! !== horizontal fluxes ==! 439 zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 440 zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 441 ! 415 442 ! !== compute and add the vorticity term trend =! 416 443 DO_2D( 0, 0, 0, 0 ) … … 455 482 ! 456 483 INTEGER :: ji, jj, jk ! dummy loop indices 457 REAL(wp) :: zuav, zvau ! local scalars484 REAL(wp) :: zuav, zvau, ze3f, zmsk ! local scalars 458 485 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz, zww ! 2D workspace 459 486 !!---------------------------------------------------------------------- … … 476 503 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 477 504 END_2D 505 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 506 DO_2D( 1, 0, 1, 0 ) 507 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 508 END_2D 509 ENDIF 478 510 CASE ( np_MET ) !* metric term 479 511 DO_2D( 1, 0, 1, 0 ) … … 486 518 & - e1u(ji ,jj+1) * pu(ji ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 487 519 END_2D 520 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity (NOT the Coriolis term) 521 DO_2D( 1, 0, 1, 0 ) 522 zwz(ji,jj) = ( zwz(ji,jj) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 523 END_2D 524 ENDIF 488 525 CASE ( np_CME ) !* Coriolis + metric 489 526 DO_2D( 1, 0, 1, 0 ) … … 495 532 END SELECT 496 533 ! 497 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 498 DO_2D( 1, 0, 1, 0 ) 499 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk) 500 END_2D 501 ENDIF 502 ! 503 IF( ln_sco ) THEN !== horizontal fluxes ==! 504 zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 505 zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 506 zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 507 ELSE 508 zwx(:,:) = e2u(:,:) * pu(:,:,jk) 509 zwy(:,:) = e1v(:,:) * pv(:,:,jk) 510 ENDIF 534 ! 535 #if defined key_qco 536 DO_2D( 1, 0, 1, 0 ) !== potential vorticity ==! (key_qco) 537 zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) 538 END_2D 539 #else 540 SELECT CASE( nn_e3f_typ ) !== potential vorticity ==! 541 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 542 DO_2D( 1, 0, 1, 0 ) 543 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 544 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 545 & + e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) & 546 & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 547 IF( ze3f /= 0._wp ) THEN ; zwz(ji,jj) = zwz(ji,jj) * 4._wp / ze3f 548 ELSE ; zwz(ji,jj) = 0._wp 549 ENDIF 550 END_2D 551 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 552 DO_2D( 1, 0, 1, 0 ) 553 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 554 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 555 & + e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) & 556 & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 557 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 558 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 559 IF( ze3f /= 0._wp ) THEN ; zwz(ji,jj) = zwz(ji,jj) * zmsk / ze3f 560 ELSE ; zwz(ji,jj) = 0._wp 561 ENDIF 562 END_2D 563 END SELECT 564 #endif 565 ! !== horizontal fluxes ==! 566 zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 567 zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 568 ! 511 569 ! !== compute and add the vorticity term trend =! 512 570 DO_2D( 0, 0, 0, 0 ) … … 566 624 ! ! =============== 567 625 ! 568 SELECT CASE( nn_een_e3f ) ! == reciprocal of e3 at F-point 626 #if defined key_qco 627 DO_2D( 1, 0, 1, 0 ) ! == reciprocal of e3 at F-point (key_qco) 628 z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) 629 END_2D 630 #else 631 SELECT CASE( nn_e3f_typ ) ! == reciprocal of e3 at F-point 569 632 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 570 633 DO_2D( 1, 0, 1, 0 ) … … 590 653 END_2D 591 654 END SELECT 655 #endif 592 656 ! 593 657 SELECT CASE( kvor ) !== vorticity considered ==! 658 ! 594 659 CASE ( np_COR ) !* Coriolis (planetary vorticity) 595 660 DO_2D( 1, 0, 1, 0 ) … … 601 666 & - e1u(ji ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 602 667 END_2D 668 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 669 DO_2D( 1, 0, 1, 0 ) 670 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 671 END_2D 672 ENDIF 603 673 CASE ( np_MET ) !* metric term 604 674 DO_2D( 1, 0, 1, 0 ) … … 612 682 & * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 613 683 END_2D 684 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 685 DO_2D( 1, 0, 1, 0 ) 686 zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 687 END_2D 688 ENDIF 614 689 CASE ( np_CME ) !* Coriolis + metric 615 690 DO_2D( 1, 0, 1, 0 ) … … 620 695 CALL ctl_stop('STOP','dyn_vor: wrong value for kvor' ) 621 696 END SELECT 622 ! 623 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 624 DO_2D( 1, 0, 1, 0 ) 625 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 626 END_2D 627 ENDIF 697 ! ! =============== 628 698 END DO ! End of slab 629 ! 699 ! ! =============== 700 ! 630 701 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 631 702 ! 703 ! ! =============== 632 704 DO jk = 1, jpkm1 ! Horizontal slab 705 ! ! =============== 633 706 ! 634 707 ! !== horizontal fluxes ==! 635 708 zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 636 709 zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 637 710 ! 638 711 ! !== compute and add the vorticity term trend =! 639 jj = 2 640 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 641 DO ji = 2, jpi ! split in 2 parts due to vector opt. 642 ztne(ji,jj) = zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) 643 ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) 644 ztse(ji,jj) = zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) 645 ztsw(ji,jj) = zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) 646 END DO 647 DO jj = 3, jpj 648 DO ji = 2, jpi ! vector opt. ok because we start at jj = 3 649 ztne(ji,jj) = zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) 650 ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) 651 ztse(ji,jj) = zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) 652 ztsw(ji,jj) = zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) 653 END DO 654 END DO 712 DO_2D( 0, 1, 0, 1 ) 713 ztne(ji,jj) = zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) 714 ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) 715 ztse(ji,jj) = zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) 716 ztsw(ji,jj) = zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) 717 END_2D 718 ! 655 719 DO_2D( 0, 0, 0, 0 ) 656 720 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & … … 667 731 668 732 669 670 733 SUBROUTINE vor_eeT( kt, Kmm, kvor, pu, pv, pu_rhs, pv_rhs ) 671 734 !!---------------------------------------------------------------------- … … 685 748 !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 686 749 !!---------------------------------------------------------------------- 687 INTEGER , INTENT(in ) :: kt ! ocean time-step index750 INTEGER , INTENT(in ) :: kt ! ocean time-step index 688 751 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 689 INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric690 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities691 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs 752 INTEGER , INTENT(in ) :: kvor ! total, planetary, relative, or metric 753 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu, pv ! now velocities 754 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pu_rhs, pv_rhs ! total v-trend 692 755 ! 693 756 INTEGER :: ji, jj, jk ! dummy loop indices … … 702 765 IF( kt == nit000 ) THEN 703 766 IF(lwp) WRITE(numout,*) 704 IF(lwp) WRITE(numout,*) 'dyn:vor_ee n: vorticity term: energy and enstrophy conserving scheme'767 IF(lwp) WRITE(numout,*) 'dyn:vor_eeT : vorticity term: energy and enstrophy conserving scheme' 705 768 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 706 769 ENDIF … … 722 785 & * r1_e1e2f(ji,jj) 723 786 END_2D 787 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 788 DO_2D( 1, 0, 1, 0 ) 789 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 790 END_2D 791 ENDIF 724 792 CASE ( np_MET ) !* metric term 725 793 DO_2D( 1, 0, 1, 0 ) … … 733 801 & * r1_e1e2f(ji,jj) ) 734 802 END_2D 803 IF( ln_dynvor_msk ) THEN ! mask the relative vorticity 804 DO_2D( 1, 0, 1, 0 ) 805 zwz(ji,jj,jk) = ( zwz(ji,jj,jk) - ff_f(ji,jj) ) * fmask(ji,jj,jk) + ff_f(ji,jj) 806 END_2D 807 ENDIF 735 808 CASE ( np_CME ) !* Coriolis + metric 736 809 DO_2D( 1, 0, 1, 0 ) … … 742 815 END SELECT 743 816 ! 744 IF( ln_dynvor_msk ) THEN !== mask/unmask vorticity ==! 745 DO_2D( 1, 0, 1, 0 ) 746 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 747 END_2D 748 ENDIF 749 END DO 817 ! ! =============== 818 END DO ! End of slab 819 ! ! =============== 750 820 ! 751 821 CALL lbc_lnk( 'dynvor', zwz, 'F', 1.0_wp ) 752 822 ! 823 ! ! =============== 753 824 DO jk = 1, jpkm1 ! Horizontal slab 754 755 ! !== horizontal fluxes ==! 825 ! ! =============== 826 ! 827 ! !== horizontal fluxes ==! 756 828 zwx(:,:) = e2u(:,:) * e3u(:,:,jk,Kmm) * pu(:,:,jk) 757 829 zwy(:,:) = e1v(:,:) * e3v(:,:,jk,Kmm) * pv(:,:,jk) 758 830 ! 759 831 ! !== compute and add the vorticity term trend =! 760 jj = 2 761 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 762 DO ji = 2, jpi ! split in 2 parts due to vector opt. 763 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 764 ztne(ji,jj) = ( zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) ) * z1_e3t 765 ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) ) * z1_e3t 766 ztse(ji,jj) = ( zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 767 ztsw(ji,jj) = ( zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) ) * z1_e3t 768 END DO 769 DO jj = 3, jpj 770 DO ji = 2, jpi ! vector opt. ok because we start at jj = 3 771 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 772 ztne(ji,jj) = ( zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) ) * z1_e3t 773 ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) ) * z1_e3t 774 ztse(ji,jj) = ( zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 775 ztsw(ji,jj) = ( zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) ) * z1_e3t 776 END DO 777 END DO 832 DO_2D( 0, 1, 0, 1 ) 833 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 834 ztne(ji,jj) = ( zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) ) * z1_e3t 835 ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) ) * z1_e3t 836 ztse(ji,jj) = ( zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 837 ztsw(ji,jj) = ( zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) ) * z1_e3t 838 END_2D 839 ! 778 840 DO_2D( 0, 0, 0, 0 ) 779 841 zua = + r1_12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & … … 799 861 INTEGER :: ji, jj, jk ! dummy loop indices 800 862 INTEGER :: ioptio, ios ! local integer 863 REAL(wp) :: zmsk ! local scalars 801 864 !! 802 865 NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_enT, ln_dynvor_eeT, & 803 & ln_dynvor_een, nn_e en_e3f, ln_dynvor_mix, ln_dynvor_msk866 & ln_dynvor_een, nn_e3f_typ , ln_dynvor_mix, ln_dynvor_msk 804 867 !!---------------------------------------------------------------------- 805 868 ! … … 823 886 WRITE(numout,*) ' energy conserving scheme (een using e3t) ln_dynvor_eeT = ', ln_dynvor_eeT 824 887 WRITE(numout,*) ' enstrophy and energy conserving scheme ln_dynvor_een = ', ln_dynvor_een 825 WRITE(numout,*) ' e3f = averaging /4 (=0) or /sum(tmask) (=1) nn_e en_e3f = ', nn_een_e3f888 WRITE(numout,*) ' e3f = averaging /4 (=0) or /sum(tmask) (=1) nn_e3f_typ = ', nn_e3f_typ 826 889 WRITE(numout,*) ' mixed enstrophy/energy conserving scheme ln_dynvor_mix = ', ln_dynvor_mix 827 890 WRITE(numout,*) ' masked (=T) or unmasked(=F) vorticity ln_dynvor_msk = ', ln_dynvor_msk 828 891 ENDIF 829 830 IF( ln_dynvor_msk ) CALL ctl_stop( 'dyn_vor_init: masked vorticity is not currently not available')831 892 832 893 !!gm this should be removed when choosing a unique strategy for fmask at the coast … … 891 952 ! 892 953 END SELECT 893 954 #if defined key_qco 955 SELECT CASE( nvor_scheme ) ! qco case: pre-computed a specific e3f_0 for some vorticity schemes 956 CASE( np_ENS , np_ENE , np_EEN , np_MIX ) 957 ! 958 ALLOCATE( e3f_0vor(jpi,jpj,jpk) ) 959 ! 960 SELECT CASE( nn_e3f_typ ) 961 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 962 DO_3D( 0, 0, 0, 0, 1, jpk ) 963 e3f_0vor(ji,jj,jk) = ( e3t_0(ji ,jj+1,jk)*tmask(ji ,jj+1,jk) & 964 & + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 965 & + e3t_0(ji ,jj ,jk)*tmask(ji ,jj ,jk) & 966 & + e3t_0(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) * 0.25_wp 967 END_3D 968 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 969 DO_3D( 0, 0, 0, 0, 1, jpk ) 970 zmsk = (tmask(ji,jj+1,jk) +tmask(ji+1,jj+1,jk) & 971 & + tmask(ji,jj ,jk) +tmask(ji+1,jj ,jk) ) 972 ! 973 IF( zmsk /= 0._wp ) THEN 974 e3f_0vor(ji,jj,jk) = ( e3t_0(ji ,jj+1,jk)*tmask(ji ,jj+1,jk) & 975 & + e3t_0(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 976 & + e3t_0(ji ,jj ,jk)*tmask(ji ,jj ,jk) & 977 & + e3t_0(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) / zmsk 978 ENDIF 979 END_3D 980 END SELECT 981 ! 982 CALL lbc_lnk( 'dynvor', e3f_0vor, 'F', 1._wp ) 983 ! ! insure e3f_0vor /= 0 984 WHERE( e3f_0vor(:,:,:) == 0._wp ) e3f_0vor(:,:,:) = e3f_0(:,:,:) 985 ! 986 END SELECT 987 ! 988 #endif 894 989 IF(lwp) THEN ! Print the choice 895 990 WRITE(numout,*) … … 898 993 CASE( np_ENE ) ; WRITE(numout,*) ' ==>>> energy conserving scheme (Coriolis at F-points) (ENE)' 899 994 CASE( np_ENT ) ; WRITE(numout,*) ' ==>>> energy conserving scheme (Coriolis at T-points) (ENT)' 995 IF( ln_dynadv_vec ) CALL ctl_warn('dyn_vor_init: ENT scheme may not work in vector form') 900 996 CASE( np_EET ) ; WRITE(numout,*) ' ==>>> energy conserving scheme (EEN scheme using e3t) (EET)' 901 997 CASE( np_EEN ) ; WRITE(numout,*) ' ==>>> energy and enstrophy conserving scheme (EEN)' -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/DYN/sshwzv.F90
r13497 r14054 6 6 !! History : 3.1 ! 2009-02 (G. Madec, M. Leclair) Original code 7 7 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 8 !! - ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 9 !! - ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 10 !! 3.3 ! 2011-10 (M. Leclair) split former ssh_wzv routine and remove all vvl related work 11 !! 4.0 ! 2018-12 (A. Coward) add mixed implicit/explicit advection 12 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering. 8 !! - ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 9 !! - ! 2010-09 (D.Storkey and E.O'Dea) bug fixes for BDY module 10 !! 3.3 ! 2011-10 (M. Leclair) split former ssh_wzv routine and remove all vvl related work 11 !! 4.0 ! 2018-12 (A. Coward) add mixed implicit/explicit advection 12 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) Rename ssh_nxt -> ssh_atf. Now only does time filtering. 13 !! - ! 2020-08 (S. Techene, G. Madec) add here ssh initiatlisation 13 14 !!---------------------------------------------------------------------- 14 15 … … 17 18 !! ssh_atf : time filter the ssh arrays 18 19 !! wzv : compute now vertical velocity 20 !! ssh_init_rst : ssh set from restart or domcfg.nc file or usr_def_istat_ssh 19 21 !!---------------------------------------------------------------------- 20 22 USE oce ! ocean dynamics and tracers variables … … 40 42 USE timing ! Timing 41 43 USE wet_dry ! Wetting/Drying flux limiting 42 44 USE usrdef_istate, ONLY : usr_def_istate_ssh ! user defined ssh initial state 45 43 46 IMPLICIT NONE 44 47 PRIVATE 45 48 46 PUBLIC ssh_nxt ! called by step.F90 47 PUBLIC wzv ! called by step.F90 48 PUBLIC wAimp ! called by step.F90 49 PUBLIC ssh_atf ! called by step.F90 49 PUBLIC ssh_nxt ! called by step.F90 50 PUBLIC wzv ! called by step.F90 51 PUBLIC wAimp ! called by step.F90 52 PUBLIC ssh_atf ! called by step.F90 53 PUBLIC ssh_init_rst ! called by domain.F90 50 54 51 55 !! * Substitutions 52 56 # include "do_loop_substitute.h90" 53 57 # include "domzgr_substitute.h90" 54 55 58 !!---------------------------------------------------------------------- 56 59 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 299 302 ! ! filtered "now" field 300 303 pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) ) 304 ! 301 305 IF( .NOT.ln_linssh ) THEN ! "now" <-- with forcing removed 302 306 zcoef = rn_atfp * rn_Dt * r1_rho0 … … 307 311 308 312 ! ice sheet coupling 309 IF ( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1) pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:) 313 IF( ln_isf .AND. ln_isfcpl .AND. kt == nit000+1 ) & 314 & pssh(:,:,Kbb) = pssh(:,:,Kbb) - rn_atfp * rn_Dt * ( risfcpl_ssh(:,:) - 0.0 ) * ssmask(:,:) 310 315 311 316 ENDIF 312 317 ENDIF 313 318 ! 314 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' pssh(:,:,Kmm) -: ', mask1=tmask )319 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pssh(:,:,Kmm), clinfo1=' atf - pssh(:,:,Kmm): ', mask1=tmask ) 315 320 ! 316 321 IF( ln_timing ) CALL timing_stop('ssh_atf') … … 431 436 ! 432 437 END SUBROUTINE wAimp 438 439 440 SUBROUTINE ssh_init_rst( Kbb, Kmm, Kaa ) 441 !!--------------------------------------------------------------------- 442 !! *** ROUTINE ssh_init_rst *** 443 !! 444 !! ** Purpose : ssh initialization of the sea surface height (ssh) 445 !! 446 !! ** Method : set ssh from restart or read configuration, or user_def 447 !! * ln_rstart = T 448 !! USE of IOM library to read ssh in the restart file 449 !! Leap-Frog: Kbb and Kmm are read except for l_1st_euler=T 450 !! 451 !! * otherwise 452 !! call user defined ssh or 453 !! set to -ssh_ref in wet and drying case with domcfg.nc 454 !! 455 !! NB: ssh_b/n are written by restart.F90 456 !!---------------------------------------------------------------------- 457 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 458 ! 459 INTEGER :: ji, jj, jk 460 !!---------------------------------------------------------------------- 461 ! 462 IF(lwp) THEN 463 WRITE(numout,*) 464 WRITE(numout,*) 'ssh_init_rst : ssh initialization' 465 WRITE(numout,*) '~~~~~~~~~~~~ ' 466 ENDIF 467 ! 468 ! !=============================! 469 IF( ln_rstart ) THEN !== Read the restart file ==! 470 ! !=============================! 471 ! 472 ! !* Read ssh at Kmm 473 IF(lwp) WRITE(numout,*) 474 IF(lwp) WRITE(numout,*) ' Kmm sea surface height read in the restart file' 475 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 476 ! 477 IF( l_1st_euler ) THEN !* Euler at first time-step 478 IF(lwp) WRITE(numout,*) 479 IF(lwp) WRITE(numout,*) ' Euler first time step : ssh(Kbb) = ssh(Kmm)' 480 ssh(:,:,Kbb) = ssh(:,:,Kmm) 481 ! 482 ELSE !* read ssh at Kbb 483 IF(lwp) WRITE(numout,*) 484 IF(lwp) WRITE(numout,*) ' Kbb sea surface height read in the restart file' 485 CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 486 ENDIF 487 ! !============================! 488 ELSE !== Initialize at "rest" ==! 489 ! !============================! 490 ! 491 IF(lwp) WRITE(numout,*) 492 IF(lwp) WRITE(numout,*) ' initialization at rest' 493 ! 494 IF( ll_wd ) THEN !* wet and dry 495 ! 496 IF( ln_read_cfg ) THEN ! read configuration : ssh_ref is read in domain_cfg file 497 !!st why ssh is not masked : i.e. ssh(:,:,Kmm) = -ssh_ref*ssmask(:,:), 498 !!st since at the 1st time step lbclnk will be applied on ssh at Kaa but not initially at Kbb and Kmm 499 ssh(:,:,Kbb) = -ssh_ref 500 ! 501 DO_2D( 1, 1, 1, 1 ) 502 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 503 ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj) 504 ENDIF 505 END_2D 506 ELSE ! user define configuration case 507 CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 508 ENDIF 509 ! 510 ELSE !* user defined configuration 511 CALL usr_def_istate_ssh( tmask, ssh(:,:,Kbb) ) 512 ! 513 ENDIF 514 ! 515 ssh(:,:,Kmm) = ssh(:,:,Kbb) !* set now values from to before ones 516 ssh(:,:,Kaa) = 0._wp 517 ENDIF 518 ! 519 END SUBROUTINE ssh_init_rst 520 433 521 !!====================================================================== 434 522 END MODULE sshwzv -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icb_oce.F90
r13286 r14054 57 57 TYPE, PUBLIC :: point !: properties of an individual iceberg (position, mass, size, etc...) 58 58 INTEGER :: year 59 REAL(wp) :: xi , yj ! iceberg coordinates in the (i,j) referential (global)59 REAL(wp) :: xi , yj , zk ! iceberg coordinates in the (i,j) referential (global) and deepest level affected 60 60 REAL(wp) :: e1 , e2 ! horizontal scale factors at the iceberg position 61 61 REAL(wp) :: lon, lat, day ! geographic position 62 62 REAL(wp) :: mass, thickness, width, length, uvel, vvel ! iceberg physical properties 63 REAL(wp) :: uo, vo, ui, vi, ua, va, ssh_x, ssh_y, sst, cn, hi, sss! properties of iceberg environment63 REAL(wp) :: ssu, ssv, ui, vi, ua, va, ssh_x, ssh_y, sst, sss, cn, hi ! properties of iceberg environment 64 64 REAL(wp) :: mass_of_bits, heat_density 65 INTEGER :: kb ! icb bottom level 65 66 END TYPE point 66 67 … … 85 86 ! Extra arrays with bigger halo, needed when interpolating forcing onto iceberg position 86 87 ! particularly for MPP when iceberg can lie inside T grid but outside U, V, or f grid 87 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: uo_e, vo_e88 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ff_e, tt_e, fr_e, ss_e88 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ssu_e, ssv_e 89 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: sst_e, sss_e, fr_e 89 90 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ua_e, va_e 90 91 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ssh_e 91 92 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: tmask_e, umask_e, vmask_e 93 REAl(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: rlon_e, rlat_e, ff_e 94 REAl(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: uoce_e, voce_e, toce_e, e3t_e 95 ! 92 96 #if defined key_si3 || defined key_cice 93 97 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: hi_e, ui_e, vi_e … … 117 121 INTEGER , PUBLIC :: nn_verbose_write !: timesteps between verbose messages 118 122 REAL(wp), PUBLIC :: rn_rho_bergs !: Density of icebergs 123 REAL(wp), PUBLIC :: rho_berg_1_oce !: convertion factor (thickness to draft) (rn_rho_bergs/pp_rho_seawater) 119 124 REAL(wp), PUBLIC :: rn_LoW_ratio !: Initial ratio L/W for newly calved icebergs 120 125 REAL(wp), PUBLIC :: rn_bits_erosion_fraction !: Fraction of erosion melt flux to divert to bergy bits … … 124 129 LOGICAL , PUBLIC :: ln_time_average_weight !: Time average the weight on the ocean !!gm I don't understand that ! 125 130 REAL(wp), PUBLIC :: rn_speed_limit !: CFL speed limit for a berg 131 LOGICAL , PUBLIC :: ln_M2016, ln_icb_grd !: use Nacho's Merino 2016 work 126 132 ! 127 133 ! restart … … 135 141 REAL(wp), DIMENSION(nclasses), PUBLIC :: rn_initial_thickness ! Single instance of an icebergs type initialised in icebergs_init and updated in icebergs_run 136 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: src_calving, src_calving_hflx !: accumulate input ice 143 INTEGER , PUBLIC , SAVE :: micbkb !: deepest level affected by icebergs 137 144 INTEGER , PUBLIC , SAVE :: numicb !: iceberg IO 138 145 INTEGER , PUBLIC , SAVE, DIMENSION(nkounts) :: num_bergs !: iceberg counter … … 171 178 ! 172 179 ! expanded arrays for bilinear interpolation 173 ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) ,&174 & vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) ,&180 ALLOCATE( ssu_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) , & 181 & ssv_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) , & 175 182 #if defined key_si3 || defined key_cice 176 183 & ui_e(0:jpi+1,0:jpj+1) , & … … 178 185 & hi_e(0:jpi+1,0:jpj+1) , & 179 186 #endif 180 & f f_e(0:jpi+1,0:jpj+1) , fr_e(0:jpi+1,0:jpj+1) ,&181 & tt_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) ,&182 & ss _e(0:jpi+1,0:jpj+1) ,&187 & fr_e(0:jpi+1,0:jpj+1) , & 188 & sst_e(0:jpi+1,0:jpj+1) , ssh_e(0:jpi+1,0:jpj+1) , & 189 & sss_e(0:jpi+1,0:jpj+1) , & 183 190 & first_width(nclasses) , first_length(nclasses) , & 184 191 & src_calving (jpi,jpj) , & … … 186 193 icb_alloc = icb_alloc + ill 187 194 195 IF ( ln_M2016 ) THEN 196 ALLOCATE( uoce_e(0:jpi+1,0:jpj+1,jpk), voce_e(0:jpi+1,0:jpj+1,jpk), & 197 & toce_e(0:jpi+1,0:jpj+1,jpk), e3t_e(0:jpi+1,0:jpj+1,jpk) , STAT=ill ) 198 icb_alloc = icb_alloc + ill 199 END IF 200 ! 188 201 ALLOCATE( tmask_e(0:jpi+1,0:jpj+1), umask_e(0:jpi+1,0:jpj+1), vmask_e(0:jpi+1,0:jpj+1), & 189 & STAT=ill)202 & rlon_e(0:jpi+1,0:jpj+1) , rlat_e(0:jpi+1,0:jpj+1) , ff_e(0:jpi+1,0:jpj+1) , STAT=ill) 190 203 icb_alloc = icb_alloc + ill 191 204 -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbclv.F90
r13295 r14054 21 21 USE lbclnk ! NEMO boundary exchanges for gridded data 22 22 23 USE icb_oce ! iceberg variables24 23 USE icbdia ! iceberg diagnostics 25 24 USE icbutl ! iceberg utility routines … … 142 141 newpt%mass = rn_initial_mass (jn) 143 142 newpt%thickness = rn_initial_thickness(jn) 143 newpt%kb = 1 ! compute correctly in icbthm if needed 144 144 newpt%width = first_width (jn) 145 145 newpt%length = first_length (jn) … … 172 172 END DO 173 173 ! 174 DO jn = 1, nclasses175 CALL lbc_lnk( 'icbclv', berg_grid%stored_ice(:,:,jn), 'T', 1._wp )176 END DO177 CALL lbc_lnk( 'icbclv', berg_grid%stored_heat, 'T', 1._wp )178 !179 174 IF( nn_verbose_level > 0 .AND. icntmax > 1 ) WRITE(numicb,*) 'icb_clv: icnt=', icnt,' on', narea 180 175 ! -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbdyn.F90
r13281 r14054 14 14 USE dom_oce ! NEMO ocean domain 15 15 USE phycst ! NEMO physical constants 16 USE in_out_manager ! IO parameters 16 17 ! 17 18 USE icb_oce ! define iceberg arrays … … 97 98 zyj2 = zyj1 + zdt_2 * zv1 ; zvvel2 = zvvel1 + zdt_2 * zay1 98 99 ! 99 CALL icb_ground( zxi2, zxi1, zu1, &100 & zyj2, zyj1, zv1, ll_bounced )100 CALL icb_ground( berg, zxi2, zxi1, zu1, & 101 & zyj2, zyj1, zv1, ll_bounced ) 101 102 102 103 ! !** A2 = A(X2,V2) … … 113 114 zyj3 = zyj1 + zdt_2 * zv2 ; zvvel3 = zvvel1 + zdt_2 * zay2 114 115 ! 115 CALL icb_ground( zxi3, zxi1, zu3, &116 & zyj3, zyj1, zv3, ll_bounced )116 CALL icb_ground( berg, zxi3, zxi1, zu3, & 117 & zyj3, zyj1, zv3, ll_bounced ) 117 118 118 119 ! !** A3 = A(X3,V3) … … 129 130 zyj4 = zyj1 + zdt * zv3 ; zvvel4 = zvvel1 + zdt * zay3 130 131 131 CALL icb_ground( zxi4, zxi1, zu4, &132 & zyj4, zyj1, zv4, ll_bounced )132 CALL icb_ground( berg, zxi4, zxi1, zu4, & 133 & zyj4, zyj1, zv4, ll_bounced ) 133 134 134 135 ! !** A4 = A(X4,V4) … … 148 149 zvvel_n = pt%vvel + zdt_6 * ( zay1 + 2.*(zay2 + zay3) + zay4 ) 149 150 150 CALL icb_ground( zxi_n, zxi1, zuvel_n, &151 & zyj_n, zyj1, zvvel_n, ll_bounced )151 CALL icb_ground( berg, zxi_n, zxi1, zuvel_n, & 152 & zyj_n, zyj1, zvvel_n, ll_bounced ) 152 153 153 154 pt%uvel = zuvel_n !** save in berg structure … … 156 157 pt%yj = zyj_n 157 158 158 ! update actual position159 pt%lon = icb_utl_bilin_x(glamt, pt%xi, pt%yj )160 pt%lat = icb_utl_bilin(gphit, pt%xi, pt%yj, 'T' )161 162 159 berg => berg%next ! switch to the next berg 163 160 ! … … 167 164 168 165 169 SUBROUTINE icb_ground( pi, pi0, pu, &170 & pj, pj0, pv, ld_bounced )166 SUBROUTINE icb_ground( berg, pi, pi0, pu, & 167 & pj, pj0, pv, ld_bounced ) 171 168 !!---------------------------------------------------------------------- 172 169 !! *** ROUTINE icb_ground *** … … 177 174 !! NB two possibilities available one of which is hard-coded here 178 175 !!---------------------------------------------------------------------- 176 TYPE(iceberg ), POINTER, INTENT(in ) :: berg ! berg 177 ! 179 178 REAL(wp), INTENT(inout) :: pi , pj ! current iceberg position 180 179 REAL(wp), INTENT(in ) :: pi0, pj0 ! previous iceberg position … … 184 183 INTEGER :: ii, ii0 185 184 INTEGER :: ij, ij0 185 INTEGER :: ikb 186 186 INTEGER :: ibounce_method 187 ! 188 REAL(wp) :: zD 189 REAL(wp), DIMENSION(jpk) :: ze3t 187 190 !!---------------------------------------------------------------------- 188 191 ! … … 200 203 ij = mj1( ij ) 201 204 ! 202 IF( tmask(ii,ij,1) /= 0._wp ) RETURN ! berg reach a new t-cell, but an ocean one 205 ! assume icb is grounded if tmask(ii,ij,1) or tmask(ii,ij,ikb), depending of the option is not 0 206 IF ( ln_M2016 .AND. ln_icb_grd ) THEN 207 ! 208 ! draught (keel depth) 209 zD = rho_berg_1_oce * berg%current_point%thickness 210 ! 211 ! interpol needed data 212 CALL icb_utl_interp( pi, pj, pe3t=ze3t ) 213 ! 214 !compute bottom level 215 CALL icb_utl_getkb( ikb, ze3t, zD ) 216 ! 217 ! berg reach a new t-cell, but an ocean one 218 ! .AND. needed in case berg hit an isf (tmask(ii,ij,1) == 0 and tmask(ii,ij,ikb) /= 0) 219 IF( tmask(ii,ij,ikb) /= 0._wp .AND. tmask(ii,ij,1) /= 0._wp ) RETURN 220 ! 221 ELSE 222 IF( tmask(ii,ij,1) /= 0._wp ) RETURN ! berg reach a new t-cell, but an ocean one 223 END IF 203 224 ! 204 225 ! From here, berg have reach land: treat grounding/bouncing … … 257 278 REAL(wp), PARAMETER :: pp_Cr0 = 0.06_wp ! 258 279 ! 259 INTEGER :: itloop 260 REAL(wp) :: zuo, z ui, zua, zuwave, zssh_x, zsst, zcn, zhi, zsss261 REAL(wp) :: zvo, z vi, zva, zvwave, zssh_y280 INTEGER :: itloop, ikb, jk 281 REAL(wp) :: zuo, zssu, zui, zua, zuwave, zssh_x, zcn, zhi 282 REAL(wp) :: zvo, zssv, zvi, zva, zvwave, zssh_y 262 283 REAL(wp) :: zff, zT, zD, zW, zL, zM, zF 263 284 REAL(wp) :: zdrag_ocn, zdrag_atm, zdrag_ice, zwave_rad 264 REAL(wp) :: z_ocn, z_atm, z_ice 285 REAL(wp) :: z_ocn, z_atm, z_ice, zdep 265 286 REAL(wp) :: zampl, zwmod, zCr, zLwavelength, zLcutoff, zLtop 266 287 REAL(wp) :: zlambda, zdetA, zA11, zA12, zaxe, zaye, zD_hi 267 288 REAL(wp) :: zuveln, zvveln, zus, zvs, zspeed, zloc_dx, zspeed_new 289 REAL(wp), DIMENSION(jpk) :: zuoce, zvoce, ze3t, zdepw 268 290 !!---------------------------------------------------------------------- 269 291 270 292 ! Interpolate gridded fields to berg 271 293 nknberg = berg%number(1) 272 CALL icb_utl_interp( pxi, pe1, zuo, zui, zua, zssh_x, & 273 & pyj, pe2, zvo, zvi, zva, zssh_y, zsst, zcn, zhi, zff, zsss ) 294 CALL icb_utl_interp( pxi, pyj, pe1=pe1, pe2=pe2, & ! scale factor 295 & pssu=zssu, pui=zui, pua=zua, & ! oce/ice/atm velocities 296 & pssv=zssv, pvi=zvi, pva=zva, & ! oce/ice/atm velocities 297 & pssh_i=zssh_x, pssh_j=zssh_y, & ! ssh gradient 298 & phi=zhi, pff=zff) ! ice thickness and coriolis 274 299 275 300 zM = berg%current_point%mass 276 301 zT = berg%current_point%thickness ! total thickness 277 zD = ( rn_rho_bergs / pp_rho_seawater ) * zT! draught (keel depth)302 zD = rho_berg_1_oce * zT ! draught (keel depth) 278 303 zF = zT - zD ! freeboard 279 304 zW = berg%current_point%width … … 282 307 zhi = MIN( zhi , zD ) 283 308 zD_hi = MAX( 0._wp, zD-zhi ) 284 285 286 zuwave = zua - z uo ; zvwave = zva - zvo! Use wind speed rel. to ocean for wave model309 310 ! Wave radiation 311 zuwave = zua - zssu ; zvwave = zva - zssv ! Use wind speed rel. to ocean for wave model 287 312 zwmod = zuwave*zuwave + zvwave*zvwave ! The wave amplitude and length depend on the current; 288 313 ! ! wind speed relative to the ocean. Actually wmod is wmod**2 here. … … 309 334 IF( abs(zui) + abs(zvi) == 0._wp ) z_ice = 0._wp 310 335 336 ! lateral velocities 337 ! default ssu and ssv 338 ! ln_M2016: mean velocity along the profile 339 IF ( ln_M2016 ) THEN 340 ! interpol needed data 341 CALL icb_utl_interp( pxi, pyj, puoce=zuoce, pvoce=zvoce, pe3t=ze3t ) ! 3d velocities 342 343 !compute bottom level 344 CALL icb_utl_getkb( ikb, ze3t, zD ) 345 346 ! compute mean velocity 347 CALL icb_utl_zavg(zuo, zuoce, ze3t, zD, ikb) 348 CALL icb_utl_zavg(zvo, zvoce, ze3t, zD, ikb) 349 ELSE 350 zuo = zssu 351 zvo = zssv 352 END IF 353 311 354 zuveln = puvel ; zvveln = pvvel ! Copy starting uvel, vvel 312 355 ! … … 321 364 ! Explicit accelerations 322 365 !zaxe= zff*pvvel -grav*zssh_x +zwave_rad*zuwave & 323 ! -zdrag_ocn*(puvel-z uo) -zdrag_atm*(puvel-zua) -zdrag_ice*(puvel-zui)366 ! -zdrag_ocn*(puvel-zssu) -zdrag_atm*(puvel-zua) -zdrag_ice*(puvel-zui) 324 367 !zaye=-zff*puvel -grav*zssh_y +zwave_rad*zvwave & 325 ! -zdrag_ocn*(pvvel-z vo) -zdrag_atm*(pvvel-zva) -zdrag_ice*(pvvel-zvi)368 ! -zdrag_ocn*(pvvel-zssv) -zdrag_atm*(pvvel-zva) -zdrag_ice*(pvvel-zvi) 326 369 zaxe = -grav * zssh_x + zwave_rad * zuwave 327 370 zaye = -grav * zssh_y + zwave_rad * zvwave -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbini.F90
r13295 r14054 73 73 ! 74 74 IF( .NOT. ln_icebergs ) RETURN 75 75 ! 76 76 ! ! allocate gridded fields 77 77 IF( icb_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'icb_alloc : unable to allocate arrays' ) 78 78 ! 79 79 ! ! initialised variable with extra haloes to zero 80 uo_e(:,:) = 0._wp ; vo_e(:,:) = 0._wp ; 81 ua_e(:,:) = 0._wp ; va_e(:,:) = 0._wp ; 82 ff_e(:,:) = 0._wp ; tt_e(:,:) = 0._wp ; 83 fr_e(:,:) = 0._wp ; ss_e(:,:) = 0._wp ; 80 ssu_e(:,:) = 0._wp ; ssv_e(:,:) = 0._wp ; 81 ua_e(:,:) = 0._wp ; va_e(:,:) = 0._wp ; 82 ff_e(:,:) = 0._wp ; sst_e(:,:) = 0._wp ; 83 fr_e(:,:) = 0._wp ; sss_e(:,:) = 0._wp ; 84 ! 85 IF ( ln_M2016 ) THEN 86 toce_e(:,:,:) = 0._wp 87 uoce_e(:,:,:) = 0._wp 88 voce_e(:,:,:) = 0._wp 89 e3t_e(:,:,:) = 0._wp 90 END IF 91 ! 84 92 #if defined key_si3 85 93 hi_e(:,:) = 0._wp ; … … 100 108 first_width (:) = SQRT( rn_initial_mass(:) / ( rn_LoW_ratio * rn_rho_bergs * rn_initial_thickness(:) ) ) 101 109 first_length(:) = rn_LoW_ratio * first_width(:) 110 rho_berg_1_oce = rn_rho_bergs / pp_rho_seawater ! scale factor used for convertion thickness to draft 111 ! 112 ! deepest level affected by icebergs 113 ! can be tuned but the safest is this 114 ! (with z* and z~ the depth of each level change overtime, so the more robust micbkb is jpk) 115 micbkb = jpk 102 116 103 117 berg_grid%calving (:,:) = 0._wp … … 240 254 vmask_e(:,:) = 0._wp ; vmask_e(1:jpi,1:jpj) = vmask(:,:,1) 241 255 CALL lbc_lnk_icb( 'icbini', tmask_e, 'T', +1._wp, 1, 1 ) 242 CALL lbc_lnk_icb( 'icbini', umask_e, 'T', +1._wp, 1, 1 ) 243 CALL lbc_lnk_icb( 'icbini', vmask_e, 'T', +1._wp, 1, 1 ) 244 ! 256 CALL lbc_lnk_icb( 'icbini', umask_e, 'U', +1._wp, 1, 1 ) 257 CALL lbc_lnk_icb( 'icbini', vmask_e, 'V', +1._wp, 1, 1 ) 258 259 ! definition of extended lat/lon array needed by icb_bilin_h 260 rlon_e(:,:) = 0._wp ; rlon_e(1:jpi,1:jpj) = glamt(:,:) 261 rlat_e(:,:) = 0._wp ; rlat_e(1:jpi,1:jpj) = gphit(:,:) 262 CALL lbc_lnk_icb( 'icbini', rlon_e, 'T', +1._wp, 1, 1 ) 263 CALL lbc_lnk_icb( 'icbini', rlat_e, 'T', +1._wp, 1, 1 ) 264 ! 265 ! definnitionn of extennded ff_f array needed by icb_utl_interp 266 ff_e(:,:) = 0._wp ; ff_e(1:jpi,1:jpj) = ff_f(:,:) 267 CALL lbc_lnk_icb( 'icbini', ff_e, 'F', +1._wp, 1, 1 ) 268 245 269 ! assign each new iceberg with a unique number constructed from the processor number 246 270 ! and incremented by the total number of processors … … 338 362 localpt%xi = REAL( mig(ji), wp ) 339 363 localpt%yj = REAL( mjg(jj), wp ) 340 localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T' ) 341 localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T' ) 364 CALL icb_utl_interp( localpt%xi, localpt%yj, plat=localpt%lat, plon=localpt%lon ) 342 365 localpt%mass = rn_initial_mass (iberg) 343 366 localpt%thickness = rn_initial_thickness(iberg) … … 350 373 localpt%uvel = 0._wp 351 374 localpt%vvel = 0._wp 375 localpt%kb = 1 352 376 CALL icb_utl_incr() 353 377 localberg%number(:) = num_bergs(:) … … 383 407 & rn_bits_erosion_fraction , rn_sicn_shift , ln_passive_mode , & 384 408 & ln_time_average_weight , nn_test_icebergs , rn_test_box , & 385 & ln_use_calving , rn_speed_limit , cn_dir, sn_icb , & 386 & cn_icbrst_indir, cn_icbrst_in , cn_icbrst_outdir , cn_icbrst_out 409 & ln_use_calving , rn_speed_limit , cn_dir, sn_icb , ln_M2016 , & 410 & cn_icbrst_indir, cn_icbrst_in , cn_icbrst_outdir , cn_icbrst_out , & 411 & ln_icb_grd 387 412 !!---------------------------------------------------------------------- 388 413 … … 463 488 & 'bits_erosion_fraction = ', rn_bits_erosion_fraction 464 489 490 WRITE(numout,*) ' Use icb module modification from Merino et al. (2016) : ln_M2016 = ', ln_M2016 491 WRITE(numout,*) ' ground icebergs if icb bottom lvl hit the oce bottom level : ln_icb_grd = ', ln_icb_grd 492 465 493 WRITE(numout,*) ' Shift of sea-ice concentration in erosion flux modulation ', & 466 494 & '(0<sicn_shift<1) rn_sicn_shift = ', rn_sicn_shift -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbstp.F90
r11536 r14054 52 52 CONTAINS 53 53 54 SUBROUTINE icb_stp( kt )54 SUBROUTINE icb_stp( kt, Kmm ) 55 55 !!---------------------------------------------------------------------- 56 56 !! *** ROUTINE icb_stp *** … … 61 61 !!---------------------------------------------------------------------- 62 62 INTEGER, INTENT(in) :: kt ! time step index 63 INTEGER, INTENT(in) :: Kmm ! ocean time level index 63 64 ! 64 65 LOGICAL :: ll_sample_traj, ll_budget, ll_verbose ! local logical … … 70 71 ! 71 72 nktberg = kt 73 ! 74 !CALL test_icb_utl_getkb 75 !CALL ctl_stop('end test icb') 72 76 ! 73 77 IF( nn_test_icebergs < 0 .OR. ln_use_calving ) THEN !* read calving data … … 92 96 ! 93 97 ! !* copy nemo forcing arrays into iceberg versions with extra halo 94 CALL icb_utl_copy( ) ! only necessary for variables not on T points98 CALL icb_utl_copy( Kmm ) ! only necessary for variables not on T points 95 99 ! 96 100 ! -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbthm.F90
r13281 r14054 49 49 INTEGER, INTENT(in) :: kt ! timestep number, just passed to icb_utl_print_berg 50 50 ! 51 INTEGER :: ii, ij 52 REAL(wp) :: zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn 51 INTEGER :: ii, ij, jk, ikb 52 REAL(wp) :: zM, zT, zW, zL, zSST, zVol, zLn, zWn, zTn, znVol, zIC, zDn, zD, zvb, zub, ztb 53 REAL(wp) :: zMv, zMe, zMb, zmelt, zdvo, zdvob, zdva, zdM, zSs, zdMe, zdMb, zdMv 53 54 REAL(wp) :: zSSS, zfzpt 54 REAL(wp) :: zMv, zMe, zMb, zmelt, zdvo, zdva, zdM, zSs, zdMe, zdMb, zdMv55 55 REAL(wp) :: zMnew, zMnew1, zMnew2, zheat_hcflux, zheat_latent, z1_12 56 56 REAL(wp) :: zMbits, znMbits, zdMbitsE, zdMbitsM, zLbits, zAbits, zMbb 57 REAL(wp) :: zxi, zyj, zff, z1_rday, z1_e1e2, zdt, z1_dt, z1_dt_e1e2 57 REAL(wp) :: zxi, zyj, zff, z1_rday, z1_e1e2, zdt, z1_dt, z1_dt_e1e2, zdepw 58 REAL(wp), DIMENSION(jpk) :: ztoce, zuoce, zvoce, ze3t, zzMv 58 59 TYPE(iceberg), POINTER :: this, next 59 60 TYPE(point) , POINTER :: pt … … 85 86 pt => this%current_point 86 87 nknberg = this%number(1) 87 CALL icb_utl_interp( pt%xi, pt%e1, pt%uo, pt%ui, pt%ua, pt%ssh_x, & 88 & pt%yj, pt%e2, pt%vo, pt%vi, pt%va, pt%ssh_y, & 89 & pt%sst, pt%cn, pt%hi, zff, pt%sss ) 88 89 CALL icb_utl_interp( pt%xi, pt%yj, & ! position 90 & pssu=pt%ssu, pua=pt%ua, & ! oce/atm velocities 91 & pssv=pt%ssv, pva=pt%va, & ! oce/atm velocities 92 & psst=pt%sst, pcn=pt%cn, & 93 & psss=pt%sss ) 94 95 IF ( nn_sample_rate > 0 .AND. MOD(kt-1,nn_sample_rate) == 0 ) THEN 96 CALL icb_utl_interp( pt%xi, pt%yj, pe1=pt%e1, pe2=pt%e2, & 97 & pui=pt%ui, pssh_i=pt%ssh_x, & 98 & pvi=pt%vi, pssh_j=pt%ssh_y, & 99 & phi=pt%hi, & 100 & plat=pt%lat, plon=pt%lon ) 101 END IF 90 102 ! 91 103 zSST = pt%sst … … 95 107 zM = pt%mass 96 108 zT = pt%thickness ! total thickness 97 ! D = (rn_rho_bergs/pp_rho_seawater)*zT ! draught (keel depth) 98 ! F = zT - D ! freeboard 109 zD = rho_berg_1_oce * zT ! draught (keel depth) 99 110 zW = pt%width 100 111 zL = pt%length … … 108 119 109 120 ! Environment 110 zdvo = SQRT( (pt%uvel-pt%uo)**2 + (pt%vvel-pt%vo)**2 ) 111 zdva = SQRT( (pt%ua -pt%uo)**2 + (pt%va -pt%vo)**2 ) 112 zSs = 1.5_wp * SQRT( zdva ) + 0.1_wp * zdva ! Sea state (eqn M.A9) 113 121 ! default sst, ssu and ssv 122 ! ln_M2016: use temp, u and v profile 123 IF ( ln_M2016 ) THEN 124 125 ! load t, u, v and e3 profile at icb position 126 CALL icb_utl_interp( pt%xi, pt%yj, ptoce=ztoce, puoce=zuoce, pvoce=zvoce, pe3t=ze3t ) 127 128 !compute bottom level 129 CALL icb_utl_getkb( pt%kb, ze3t, zD ) 130 131 ikb = MIN(pt%kb,mbkt(ii,ij)) ! limit pt%kb by mbkt 132 ! => bottom temperature used to fill ztoce(mbkt:jpk) 133 ztb = ztoce(ikb) ! basal temperature 134 zub = zuoce(ikb) 135 zvb = zvoce(ikb) 136 ELSE 137 ztb = pt%sst 138 zub = pt%ssu 139 zvb = pt%ssv 140 END IF 141 142 zdvob = SQRT( (pt%uvel-zub)**2 + (pt%vvel-zvb)**2 ) ! relative basal velocity 143 zdva = SQRT( (pt%ua -pt%ssu)**2 + (pt%va -pt%ssv)**2 ) ! relative wind 144 zSs = 1.5_wp * SQRT( zdva ) + 0.1_wp * zdva ! Sea state (eqn M.A9) 145 ! 114 146 ! Melt rates in m/s (i.e. division by rday) 115 zMv = MAX( 7.62d-3*zSST+1.29d-3*(zSST**2) , 0._wp ) * z1_rday ! Buoyant convection at sides (eqn M.A10) 147 ! Buoyant convection at sides (eqn M.A10) 148 IF ( ln_M2016 ) THEN 149 ! averaging along all the iceberg draft 150 zzMv(:) = MAX( 7.62d-3*ztoce(:)+1.29d-3*(ztoce(:)**2), 0._wp ) * z1_rday 151 CALL icb_utl_zavg(zMv, zzMv, ze3t, zD, ikb ) 152 ELSE 153 zMv = MAX( 7.62d-3*zSST+1.29d-3*(zSST**2), 0._wp ) * z1_rday 154 END IF 155 ! 156 ! Basal turbulent melting (eqn M.A7 ) 116 157 IF ( zSST > zfzpt ) THEN ! Calculate basal melting only if SST above freezing point 117 zMb = MAX( 0.58_wp*(zdvo **0.8_wp)*(zSST+4.0_wp)/(zL**0.2_wp) , 0._wp ) * z1_rday ! Basal turbulent melting (eqn M.A7 )158 zMb = MAX( 0.58_wp*(zdvob**0.8_wp)*(ztb+4.0_wp)/(zL**0.2_wp) , 0._wp ) * z1_rday 118 159 ELSE 119 160 zMb = 0._wp ! No basal melting if SST below freezing point 120 161 ENDIF 121 zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3))) , 0._wp ) * z1_rday ! Wave erosion (eqn M.A8 ) 162 ! 163 ! Wave erosion (eqn M.A8 ) 164 zMe = MAX( z1_12*(zSST+2.)*zSs*(1._wp+COS(rpi*(zIC**3))) , 0._wp ) * z1_rday 122 165 123 166 IF( ln_operator_splitting ) THEN ! Operator split update of volume/mass … … 207 250 208 251 ! Rolling 209 zDn = ( rn_rho_bergs / pp_rho_seawater )* zTn ! draught (keel depth)252 zDn = rho_berg_1_oce * zTn ! draught (keel depth) 210 253 IF( zDn > 0._wp .AND. MAX(zWn,zLn) < SQRT( 0.92*(zDn**2) + 58.32*zDn ) ) THEN 211 254 zT = zTn … … 224 267 225 268 !!gm add a test to avoid over melting ? 269 !!pm I agree, over melting could break conservation (more melt than calving) 226 270 227 271 IF( zMnew <= 0._wp ) THEN ! Delete the berg if completely melted -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbtrj.F90
r13558 r14054 40 40 INTEGER :: numberid, nstepid, nscaling_id 41 41 INTEGER :: nlonid, nlatid, nxid, nyid, nuvelid, nvvelid, nmassid 42 INTEGER :: n uoid, nvoid, nuaid, nvaid, nuiid, nviid42 INTEGER :: nssuid, nssvid, nuaid, nvaid, nuiid, nviid 43 43 INTEGER :: nsshxid, nsshyid, nsstid, ncntid, nthkid 44 44 INTEGER :: nthicknessid, nwidthid, nlengthid … … 111 111 iret = NF90_DEF_VAR( ntrajid, 'uvel' , NF90_DOUBLE, n_dim , nuvelid ) 112 112 iret = NF90_DEF_VAR( ntrajid, 'vvel' , NF90_DOUBLE, n_dim , nvvelid ) 113 iret = NF90_DEF_VAR( ntrajid, ' uto' , NF90_DOUBLE, n_dim , nuoid)114 iret = NF90_DEF_VAR( ntrajid, ' vto' , NF90_DOUBLE, n_dim , nvoid)113 iret = NF90_DEF_VAR( ntrajid, 'ssu' , NF90_DOUBLE, n_dim , nssuid ) 114 iret = NF90_DEF_VAR( ntrajid, 'ssv' , NF90_DOUBLE, n_dim , nssvid ) 115 115 iret = NF90_DEF_VAR( ntrajid, 'uta' , NF90_DOUBLE, n_dim , nuaid ) 116 116 iret = NF90_DEF_VAR( ntrajid, 'vta' , NF90_DOUBLE, n_dim , nvaid ) … … 148 148 iret = NF90_PUT_ATT( ntrajid, nvvelid , 'long_name', 'meridional velocity' ) 149 149 iret = NF90_PUT_ATT( ntrajid, nvvelid , 'units' , 'm/s' ) 150 iret = NF90_PUT_ATT( ntrajid, n uoid, 'long_name', 'ocean u component' )151 iret = NF90_PUT_ATT( ntrajid, n uoid, 'units' , 'm/s' )152 iret = NF90_PUT_ATT( ntrajid, n void, 'long_name', 'ocean v component' )153 iret = NF90_PUT_ATT( ntrajid, n void, 'units' , 'm/s' )150 iret = NF90_PUT_ATT( ntrajid, nssuid , 'long_name', 'ocean u component' ) 151 iret = NF90_PUT_ATT( ntrajid, nssuid , 'units' , 'm/s' ) 152 iret = NF90_PUT_ATT( ntrajid, nssvid , 'long_name', 'ocean v component' ) 153 iret = NF90_PUT_ATT( ntrajid, nssvid , 'units' , 'm/s' ) 154 154 iret = NF90_PUT_ATT( ntrajid, nuaid , 'long_name', 'atmosphere u component' ) 155 155 iret = NF90_PUT_ATT( ntrajid, nuaid , 'units' , 'm/s' ) … … 231 231 iret = NF90_PUT_VAR( ntrajid, nuvelid , pt%uvel , (/ jn /) ) 232 232 iret = NF90_PUT_VAR( ntrajid, nvvelid , pt%vvel , (/ jn /) ) 233 iret = NF90_PUT_VAR( ntrajid, n uoid , pt%uo, (/ jn /) )234 iret = NF90_PUT_VAR( ntrajid, n void , pt%vo, (/ jn /) )233 iret = NF90_PUT_VAR( ntrajid, nssuid , pt%ssu , (/ jn /) ) 234 iret = NF90_PUT_VAR( ntrajid, nssvid , pt%ssv , (/ jn /) ) 235 235 iret = NF90_PUT_VAR( ntrajid, nuaid , pt%ua , (/ jn /) ) 236 236 iret = NF90_PUT_VAR( ntrajid, nvaid , pt%va , (/ jn /) ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ICB/icbutl.F90
r13281 r14054 8 8 !! - ! Removal of mapping from another grid 9 9 !! - ! 2011-04 (Alderson) Split into separate modules 10 !! 4.2 ! 2020-07 (P. Mathiot) simplification of interpolation routine 11 !! ! and add Nacho Merino work 10 12 !!---------------------------------------------------------------------- 11 13 12 14 !!---------------------------------------------------------------------- 13 15 !! icb_utl_interp : 14 !! icb_utl_bilin : 15 !! icb_utl_bilin_e : 16 !! icb_utl_pos : compute bottom left corner indice, weight and mask 17 !! icb_utl_bilin_h : interpolation field to icb position 18 !! icb_utl_bilin_e : interpolation of scale factor to icb position 16 19 !!---------------------------------------------------------------------- 17 20 USE par_oce ! ocean parameters 21 USE oce, ONLY: ts, uu, vv 18 22 USE dom_oce ! ocean domain 19 23 USE in_out_manager ! IO parameters … … 31 35 PRIVATE 32 36 37 INTERFACE icb_utl_bilin_h 38 MODULE PROCEDURE icb_utl_bilin_2d_h, icb_utl_bilin_3d_h 39 END INTERFACE 40 33 41 PUBLIC icb_utl_copy ! routine called in icbstp module 42 PUBLIC icb_utl_getkb ! routine called in icbdyn and icbthm modules 43 PUBLIC test_icb_utl_getkb ! routine called in icbdyn and icbthm modules 44 PUBLIC icb_utl_zavg ! routine called in icbdyn and icbthm modules 34 45 PUBLIC icb_utl_interp ! routine called in icbdyn, icbthm modules 35 PUBLIC icb_utl_bilin ! routine called in icbini, icbdyn modules 36 PUBLIC icb_utl_bilin_x ! routine called in icbdyn module 46 PUBLIC icb_utl_bilin_h ! routine called in icbdyn module 37 47 PUBLIC icb_utl_add ! routine called in icbini.F90, icbclv, icblbc and icbrst modules 38 48 PUBLIC icb_utl_delete ! routine called in icblbc, icbthm modules … … 54 64 CONTAINS 55 65 56 SUBROUTINE icb_utl_copy( )66 SUBROUTINE icb_utl_copy( Kmm ) 57 67 !!---------------------------------------------------------------------- 58 68 !! *** ROUTINE icb_utl_copy *** … … 62 72 !! ** Method : - blah blah 63 73 !!---------------------------------------------------------------------- 74 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1) :: ztmp 64 75 #if defined key_si3 65 76 REAL(wp), DIMENSION(jpi,jpj) :: zssh_lead_m ! ocean surface (ssh_m) if ice is not embedded 66 77 ! ! ocean surface in leads if ice is embedded 67 78 #endif 79 INTEGER :: jk ! vertical loop index 80 INTEGER :: Kmm ! ocean time levelindex 81 ! 68 82 ! copy nemo forcing arrays into iceberg versions with extra halo 69 83 ! only necessary for variables not on T points 70 84 ! and ssh which is used to calculate gradients 71 72 uo_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 73 vo_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 85 ! 86 ! surface forcing 87 ! 88 ssu_e(1:jpi,1:jpj) = ssu_m(:,:) * umask(:,:,1) 89 ssv_e(1:jpi,1:jpj) = ssv_m(:,:) * vmask(:,:,1) 90 sst_e(1:jpi,1:jpj) = sst_m(:,:) 91 sss_e(1:jpi,1:jpj) = sss_m(:,:) 92 fr_e (1:jpi,1:jpj) = fr_i (:,:) 93 ua_e (1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 94 va_e (1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 74 95 ff_e(1:jpi,1:jpj) = ff_f (:,:) 75 tt_e(1:jpi,1:jpj) = sst_m(:,:) 76 ss_e(1:jpi,1:jpj) = sss_m(:,:) 77 fr_e(1:jpi,1:jpj) = fr_i (:,:) 78 ua_e(1:jpi,1:jpj) = utau (:,:) * umask(:,:,1) ! maybe mask useless because mask applied in sbcblk 79 va_e(1:jpi,1:jpj) = vtau (:,:) * vmask(:,:,1) ! maybe mask useless because mask applied in sbcblk 80 ! 81 CALL lbc_lnk_icb( 'icbutl', uo_e, 'U', -1._wp, 1, 1 ) 82 CALL lbc_lnk_icb( 'icbutl', vo_e, 'V', -1._wp, 1, 1 ) 83 CALL lbc_lnk_icb( 'icbutl', ff_e, 'F', +1._wp, 1, 1 ) 84 CALL lbc_lnk_icb( 'icbutl', ua_e, 'U', -1._wp, 1, 1 ) 85 CALL lbc_lnk_icb( 'icbutl', va_e, 'V', -1._wp, 1, 1 ) 86 CALL lbc_lnk_icb( 'icbutl', fr_e, 'T', +1._wp, 1, 1 ) 87 CALL lbc_lnk_icb( 'icbutl', tt_e, 'T', +1._wp, 1, 1 ) 88 CALL lbc_lnk_icb( 'icbutl', ss_e, 'T', +1._wp, 1, 1 ) 96 ! 97 CALL lbc_lnk_icb( 'icbutl', ssu_e, 'U', -1._wp, 1, 1 ) 98 CALL lbc_lnk_icb( 'icbutl', ssv_e, 'V', -1._wp, 1, 1 ) 99 CALL lbc_lnk_icb( 'icbutl', ua_e , 'U', -1._wp, 1, 1 ) 100 CALL lbc_lnk_icb( 'icbutl', va_e , 'V', -1._wp, 1, 1 ) 89 101 #if defined key_si3 90 102 hi_e(1:jpi, 1:jpj) = hm_i (:,:) … … 96 108 ssh_e(1:jpi, 1:jpj) = zssh_lead_m(:,:) * tmask(:,:,1) 97 109 ! 98 CALL lbc_lnk_icb( 'icbutl', hi_e , 'T', +1._wp, 1, 1 )99 110 CALL lbc_lnk_icb( 'icbutl', ui_e , 'U', -1._wp, 1, 1 ) 100 111 CALL lbc_lnk_icb( 'icbutl', vi_e , 'V', -1._wp, 1, 1 ) 101 112 #else 102 ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 113 ssh_e(1:jpi, 1:jpj) = ssh_m(:,:) * tmask(:,:,1) 103 114 #endif 104 CALL lbc_lnk_icb( 'icbutl', ssh_e, 'T', +1._wp, 1, 1 ) 115 ! 116 ! (PM) could be improve with a 3d lbclnk gathering both variables 117 ! should be done once extra haloe generalised 118 IF ( ln_M2016 ) THEN 119 DO jk = 1,jpk 120 ! uoce 121 ztmp(1:jpi,1:jpj) = uu(:,:,jk,Kmm) 122 CALL lbc_lnk_icb( 'icbutl', ztmp, 'U', -1._wp, 1, 1 ) 123 uoce_e(:,:,jk) = ztmp(:,:) 124 ! 125 ! voce 126 ztmp(1:jpi,1:jpj) = vv(:,:,jk,Kmm) 127 CALL lbc_lnk_icb( 'icbutl', ztmp, 'V', -1._wp, 1, 1 ) 128 voce_e(:,:,jk) = ztmp(:,:) 129 END DO 130 toce_e(1:jpi,1:jpj,1:jpk) = ts(:,:,:,1,Kmm) 131 e3t_e (1:jpi,1:jpj,1:jpk) = e3t(:,:,:,Kmm) 132 END IF 105 133 ! 106 134 END SUBROUTINE icb_utl_copy 107 135 108 136 109 SUBROUTINE icb_utl_interp( pi, pe1, puo, pui, pua, pssh_i, & 110 & pj, pe2, pvo, pvi, pva, pssh_j, & 111 & psst, pcn, phi, pff, psss ) 137 SUBROUTINE icb_utl_interp( pi, pj, pe1 , pssu, pui, pua, pssh_i, & 138 & pe2 , pssv, pvi, pva, pssh_j, & 139 & psst, psss, pcn, phi, pff , & 140 & plon, plat, ptoce, puoce, pvoce, pe3t ) 112 141 !!---------------------------------------------------------------------- 113 142 !! *** ROUTINE icb_utl_interp *** … … 127 156 !!---------------------------------------------------------------------- 128 157 REAL(wp), INTENT(in ) :: pi , pj ! position in (i,j) referential 129 REAL(wp), INTENT( out) :: pe1, pe2 ! i- and j scale factors 130 REAL(wp), INTENT( out) :: puo, pvo, pui, pvi, pua, pva ! ocean, ice and wind speeds 131 REAL(wp), INTENT( out) :: pssh_i, pssh_j ! ssh i- & j-gradients 132 REAL(wp), INTENT( out) :: psst, pcn, phi, pff, psss ! SST, ice concentration, ice thickness, Coriolis, SSS 133 ! 158 REAL(wp), INTENT( out), OPTIONAL :: pe1, pe2 ! i- and j scale factors 159 REAL(wp), INTENT( out), OPTIONAL :: pssu, pssv, pui, pvi, pua, pva ! ocean, ice and wind speeds 160 REAL(wp), INTENT( out), OPTIONAL :: pssh_i, pssh_j ! ssh i- & j-gradients 161 REAL(wp), INTENT( out), OPTIONAL :: psst, psss, pcn, phi, pff ! SST, SSS, ice concentration, ice thickness, Coriolis 162 REAL(wp), INTENT( out), OPTIONAL :: plat, plon ! position 163 REAL(wp), DIMENSION(jpk), INTENT( out), OPTIONAL :: ptoce, puoce, pvoce, pe3t ! 3D variables 164 ! 165 REAL(wp), DIMENSION(4) :: zwT , zwU , zwV , zwF ! interpolation weight 166 REAL(wp), DIMENSION(4) :: zmskF, zmskU, zmskV, zmskT ! mask 167 REAL(wp), DIMENSION(4) :: zwTp, zmskTp, zwTm, zmskTm 168 REAL(wp), DIMENSION(4,jpk) :: zw1d 169 INTEGER :: iiT, iiU, iiV, iiF, ijT, ijU, ijV, ijF ! bottom left corner 170 INTEGER :: iiTp, iiTm, ijTp, ijTm 134 171 REAL(wp) :: zcd, zmod ! local scalars 135 172 !!---------------------------------------------------------------------- 136 137 pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) ! scale factors 138 pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 139 ! 140 puo = icb_utl_bilin_h( uo_e, pi, pj, 'U', .false. ) ! ocean velocities 141 pvo = icb_utl_bilin_h( vo_e, pi, pj, 'V', .false. ) 142 psst = icb_utl_bilin_h( tt_e, pi, pj, 'T', .true. ) ! SST 143 psss = icb_utl_bilin_h( ss_e, pi, pj, 'T', .true. ) ! SSS 144 pcn = icb_utl_bilin_h( fr_e, pi, pj, 'T', .true. ) ! ice concentration 145 pff = icb_utl_bilin_h( ff_e, pi, pj, 'F', .false. ) ! Coriolis parameter 146 ! 147 pua = icb_utl_bilin_h( ua_e, pi, pj, 'U', .true. ) ! 10m wind 148 pva = icb_utl_bilin_h( va_e, pi, pj, 'V', .true. ) ! here (ua,va) are stress => rough conversion from stress to speed 149 zcd = 1.22_wp * 1.5e-3_wp ! air density * drag coefficient 150 zmod = 1._wp / MAX( 1.e-20, SQRT( zcd * SQRT( pua*pua + pva*pva) ) ) 151 pua = pua * zmod ! note: stress module=0 necessarly implies ua=va=0 152 pva = pva * zmod 153 173 ! 174 ! get position, weight and mask 175 CALL icb_utl_pos( pi, pj, 'T', iiT, ijT, zwT, zmskT ) 176 CALL icb_utl_pos( pi, pj, 'U', iiU, ijU, zwU, zmskU ) 177 CALL icb_utl_pos( pi, pj, 'V', iiV, ijV, zwV, zmskV ) 178 CALL icb_utl_pos( pi, pj, 'F', iiF, ijF, zwF, zmskF ) 179 ! 180 ! metrics and coordinates 181 IF ( PRESENT(pe1 ) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) ! scale factors 182 IF ( PRESENT(pe2 ) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 183 IF ( PRESENT(plon) ) plon= icb_utl_bilin_h( rlon_e, iiT, ijT, zwT, .true. ) 184 IF ( PRESENT(plat) ) plat= icb_utl_bilin_h( rlat_e, iiT, ijT, zwT, .false. ) 185 ! 186 IF ( PRESENT(pssu) ) pssu = icb_utl_bilin_h( ssu_e, iiU, ijU, zwU , .false. ) ! ocean velocities 187 IF ( PRESENT(pssv) ) pssv = icb_utl_bilin_h( ssv_e, iiV, ijV, zwV , .false. ) ! 188 IF ( PRESENT(psst) ) psst = icb_utl_bilin_h( sst_e, iiT, ijT, zwT * zmskT, .false. ) ! sst 189 IF ( PRESENT(psss) ) psss = icb_utl_bilin_h( sss_e, iiT, ijT, zwT * zmskT, .false. ) ! sss 190 IF ( PRESENT(pcn ) ) pcn = icb_utl_bilin_h( fr_e , iiT, ijT, zwT * zmskT, .false. ) ! ice concentration 191 IF ( PRESENT(pff ) ) pff = icb_utl_bilin_h( ff_e , iiF, ijF, zwF , .false. ) ! Coriolis parameter 192 ! 193 IF ( PRESENT(pua) .AND. PRESENT(pva) ) THEN 194 pua = icb_utl_bilin_h( ua_e, iiU, ijU, zwU * zmskU, .false. ) ! 10m wind 195 pva = icb_utl_bilin_h( va_e, iiV, ijV, zwV * zmskV, .false. ) ! here (ua,va) are stress => rough conversion from stress to speed 196 zcd = 1.22_wp * 1.5e-3_wp ! air density * drag coefficient 197 zmod = 1._wp / MAX( 1.e-20, SQRT( zcd * SQRT( pua*pua + pva*pva) ) ) 198 pua = pua * zmod ! note: stress module=0 necessarly implies ua=va=0 199 pva = pva * zmod 200 END IF 201 ! 154 202 #if defined key_si3 155 pui = icb_utl_bilin_h( ui_e , pi, pj, 'U', .false. )! sea-ice velocities156 pvi = icb_utl_bilin_h( vi_e , pi, pj, 'V', .false. )157 phi = icb_utl_bilin_h( hi_e , pi, pj, 'T', .true. )! ice thickness203 IF ( PRESENT(pui) ) pui = icb_utl_bilin_h( ui_e , iiU, ijU, zwU , .false. ) ! sea-ice velocities 204 IF ( PRESENT(pvi) ) pvi = icb_utl_bilin_h( vi_e , iiV, ijV, zwV , .false. ) 205 IF ( PRESENT(phi) ) phi = icb_utl_bilin_h( hi_e , iiT, ijT, zwT * zmskT, .false. ) ! ice thickness 158 206 #else 159 pui = 0._wp160 pvi = 0._wp161 phi = 0._wp207 IF ( PRESENT(pui) ) pui = 0._wp 208 IF ( PRESENT(pvi) ) pvi = 0._wp 209 IF ( PRESENT(phi) ) phi = 0._wp 162 210 #endif 163 211 ! 164 212 ! Estimate SSH gradient in i- and j-direction (centred evaluation) 165 pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T', .true. ) - & 166 & icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T', .true. ) ) / ( 0.2_wp * pe1 ) 167 pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T', .true. ) - & 168 & icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T', .true. ) ) / ( 0.2_wp * pe2 ) 213 IF ( PRESENT(pssh_i) .AND. PRESENT(pssh_j) ) THEN 214 CALL icb_utl_pos( pi+0.1, pj , 'T', iiTp, ijTp, zwTp, zmskTp ) 215 CALL icb_utl_pos( pi-0.1, pj , 'T', iiTm, ijTm, zwTm, zmskTm ) 216 ! 217 IF ( .NOT. PRESENT(pe1) ) pe1 = icb_utl_bilin_e( e1t, e1u, e1v, e1f, pi, pj ) 218 pssh_i = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - & 219 & icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe1 ) 220 ! 221 CALL icb_utl_pos( pi , pj+0.1, 'T', iiTp, ijTp, zwTp, zmskTp ) 222 CALL icb_utl_pos( pi , pj-0.1, 'T', iiTm, ijTm, zwTm, zmskTm ) 223 ! 224 IF ( .NOT. PRESENT(pe2) ) pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 225 pssh_j = ( icb_utl_bilin_h( ssh_e, iiTp, ijTp, zwTp*zmskTp, .false. ) - & 226 & icb_utl_bilin_h( ssh_e, iiTm, ijTm, zwTm*zmskTm, .false. ) ) / ( 0.2_wp * pe2 ) 227 END IF 228 ! 229 ! 3d interpolation 230 IF ( PRESENT(puoce) .AND. PRESENT(pvoce) ) THEN 231 ! no need to mask as 0 is a valid data for land 232 zw1d(1,:) = zwU(1) ; zw1d(2,:) = zwU(2) ; zw1d(3,:) = zwU(3) ; zw1d(4,:) = zwU(4) ; 233 puoce(:) = icb_utl_bilin_h( uoce_e , iiU, ijU, zw1d ) 234 235 zw1d(1,:) = zwV(1) ; zw1d(2,:) = zwV(2) ; zw1d(3,:) = zwV(3) ; zw1d(4,:) = zwV(4) ; 236 pvoce(:) = icb_utl_bilin_h( voce_e , iiV, ijV, zw1d ) 237 END IF 238 239 IF ( PRESENT(ptoce) ) THEN 240 ! for temperature we need to mask the weight properly 241 ! no need of extra halo as it is a T point variable 242 zw1d(1,:) = tmask(iiT ,ijT ,:) * zwT(1) * zmskT(1) 243 zw1d(2,:) = tmask(iiT+1,ijT ,:) * zwT(2) * zmskT(2) 244 zw1d(3,:) = tmask(iiT ,ijT+1,:) * zwT(3) * zmskT(3) 245 zw1d(4,:) = tmask(iiT+1,ijT+1,:) * zwT(4) * zmskT(4) 246 ptoce(:) = icb_utl_bilin_h( toce_e , iiT, ijT, zw1d ) 247 END IF 248 ! 249 IF ( PRESENT(pe3t) ) pe3t(:) = e3t_e(iiT,ijT,:) ! as in Nacho tarball need to be fix once we are able to reproduce Nacho results 169 250 ! 170 251 END SUBROUTINE icb_utl_interp 171 252 172 173 REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type, plmask ) 253 SUBROUTINE icb_utl_pos( pi, pj, cd_type, kii, kij, pw, pmsk ) 174 254 !!---------------------------------------------------------------------- 175 255 !! *** FUNCTION icb_utl_bilin *** … … 182 262 !! 183 263 !!---------------------------------------------------------------------- 184 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) :: pfld ! field to be interpolated 185 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 186 CHARACTER(len=1) , INTENT(in) :: cd_type ! type of pfld array grid-points: = T , U , V or F points 187 LOGICAL , INTENT(in) :: plmask ! special treatment of mask point 188 ! 189 INTEGER :: ii, ij ! local integer 190 REAL(wp) :: zi, zj ! local real 191 REAL(wp) :: zw1, zw2, zw3, zw4 192 REAL(wp), DIMENSION(4) :: zmask 264 REAL(wp) , INTENT(IN) :: pi, pj ! targeted coordinates in (i,j) referential 265 CHARACTER(len=1) , INTENT(IN) :: cd_type ! point type 266 REAL(wp), DIMENSION(4), INTENT(OUT) :: pw, pmsk ! weight and mask 267 INTEGER , INTENT(OUT) :: kii, kij ! bottom left corner position in local domain 268 ! 269 REAL(wp) :: zwi, zwj ! distance to bottom left corner 270 INTEGER :: ierr 271 ! 193 272 !!---------------------------------------------------------------------- 194 273 ! … … 198 277 ! since we're looking for four T points containing quadrant we're in of 199 278 ! current T cell 200 ii = MAX(0, INT( pi))201 ij = MAX(0, INT( pj)) ! T-point202 z i = pi - REAL(ii,wp)203 z j = pj - REAL(ij,wp)279 kii = MAX(0, INT( pi )) 280 kij = MAX(0, INT( pj )) ! T-point 281 zwi = pi - REAL(kii,wp) 282 zwj = pj - REAL(kij,wp) 204 283 CASE ( 'U' ) 205 ii = MAX(0, INT( pi-0.5_wp ))206 ij = MAX(0, INT( pj)) ! U-point207 z i = pi - 0.5_wp - REAL(ii,wp)208 z j = pj - REAL(ij,wp)284 kii = MAX(0, INT( pi-0.5_wp )) 285 kij = MAX(0, INT( pj )) ! U-point 286 zwi = pi - 0.5_wp - REAL(kii,wp) 287 zwj = pj - REAL(kij,wp) 209 288 CASE ( 'V' ) 210 ii = MAX(0, INT( pi))211 ij = MAX(0, INT( pj-0.5_wp )) ! V-point212 z i = pi - REAL(ii,wp)213 z j = pj - 0.5_wp - REAL(ij,wp)289 kii = MAX(0, INT( pi )) 290 kij = MAX(0, INT( pj-0.5_wp )) ! V-point 291 zwi = pi - REAL(kii,wp) 292 zwj = pj - 0.5_wp - REAL(kij,wp) 214 293 CASE ( 'F' ) 215 ii = MAX(0, INT( pi-0.5_wp ))216 ij = MAX(0, INT( pj-0.5_wp )) ! F-point217 z i = pi - 0.5_wp - REAL(ii,wp)218 z j = pj - 0.5_wp - REAL(ij,wp)294 kii = MAX(0, INT( pi-0.5_wp )) 295 kij = MAX(0, INT( pj-0.5_wp )) ! F-point 296 zwi = pi - 0.5_wp - REAL(kii,wp) 297 zwj = pj - 0.5_wp - REAL(kij,wp) 219 298 END SELECT 299 ! 300 ! compute weight 301 pw(1) = (1._wp-zwi) * (1._wp-zwj) 302 pw(2) = zwi * (1._wp-zwj) 303 pw(3) = (1._wp-zwi) * zwj 304 pw(4) = zwi * zwj 305 ! 306 ! find position in this processor. Prevent near edge problems (see #1389) 307 ! 308 IF (TRIM(cd_type) == 'T' ) THEN 309 ierr = 0 310 IF ( kii < mig( 1 ) ) THEN ; ierr = ierr + 1 311 ELSEIF( kii >= mig(jpi) ) THEN ; ierr = ierr + 1 312 ENDIF 313 ! 314 IF ( kij < mjg( 1 ) ) THEN ; ierr = ierr + 1 315 ELSEIF( kij >= mjg(jpj) ) THEN ; ierr = ierr + 1 316 ENDIF 317 ! 318 IF ( ierr > 0 ) THEN 319 WRITE(numout,*) 'bottom left corner T point out of bound' 320 WRITE(numout,*) pi, kii, mig( 1 ), mig(jpi) 321 WRITE(numout,*) pj, kij, mjg( 1 ), mjg(jpj) 322 WRITE(numout,*) pmsk 323 CALL ctl_stop('STOP','icb_utl_bilin_h: an icebergs coordinates is out of valid range (out of bound error)') 324 END IF 325 END IF 220 326 ! 221 327 ! find position in this processor. Prevent near edge problems (see #1389) 222 328 ! (PM) will be useless if extra halo is used in NEMO 223 329 ! 224 IF ( ii <= mig(1)-1 ) THEN ;ii = 0225 ELSEIF( ii > mig(jpi) ) THEN ;ii = jpi226 ELSE ; ii = mi1(ii)330 IF ( kii <= mig(1)-1 ) THEN ; kii = 0 331 ELSEIF( kii > mig(jpi) ) THEN ; kii = jpi 332 ELSE ; kii = mi1(kii) 227 333 ENDIF 228 IF ( ij <= mjg(1)-1 ) THEN ;ij = 0229 ELSEIF( ij > mjg(jpj) ) THEN ;ij = jpj230 ELSE ; ij = mj1(ij)334 IF ( kij <= mjg(1)-1 ) THEN ; kij = 0 335 ELSEIF( kij > mjg(jpj) ) THEN ; kij = jpj 336 ELSE ; kij = mj1(kij) 231 337 ENDIF 232 338 ! 233 339 ! define mask array 234 IF (plmask) THEN 235 ! land value is not used in the interpolation 236 SELECT CASE ( cd_type ) 237 CASE ( 'T' ) 238 zmask = (/tmask_e(ii,ij), tmask_e(ii+1,ij), tmask_e(ii,ij+1), tmask_e(ii+1,ij+1)/) 239 CASE ( 'U' ) 240 zmask = (/umask_e(ii,ij), umask_e(ii+1,ij), umask_e(ii,ij+1), umask_e(ii+1,ij+1)/) 241 CASE ( 'V' ) 242 zmask = (/vmask_e(ii,ij), vmask_e(ii+1,ij), vmask_e(ii,ij+1), vmask_e(ii+1,ij+1)/) 243 CASE ( 'F' ) 244 ! F case only used for coriolis, ff_f is not mask so zmask = 1 245 zmask = 1. 246 END SELECT 247 ELSE 248 ! land value is used during interpolation 249 zmask = 1. 250 END iF 251 ! 252 ! compute weight 253 zw1 = zmask(1) * (1._wp-zi) * (1._wp-zj) 254 zw2 = zmask(2) * zi * (1._wp-zj) 255 zw3 = zmask(3) * (1._wp-zi) * zj 256 zw4 = zmask(4) * zi * zj 257 ! 258 ! compute interpolated value 259 icb_utl_bilin_h = ( pfld(ii,ij)*zw1 + pfld(ii+1,ij)*zw2 + pfld(ii,ij+1)*zw3 + pfld(ii+1,ij+1)*zw4 ) / MAX(1.e-20, zw1+zw2+zw3+zw4) 260 ! 261 END FUNCTION icb_utl_bilin_h 262 263 264 REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type ) 340 ! land value is not used in the interpolation 341 SELECT CASE ( cd_type ) 342 CASE ( 'T' ) 343 pmsk = (/tmask_e(kii,kij), tmask_e(kii+1,kij), tmask_e(kii,kij+1), tmask_e(kii+1,kij+1)/) 344 CASE ( 'U' ) 345 pmsk = (/umask_e(kii,kij), umask_e(kii+1,kij), umask_e(kii,kij+1), umask_e(kii+1,kij+1)/) 346 CASE ( 'V' ) 347 pmsk = (/vmask_e(kii,kij), vmask_e(kii+1,kij), vmask_e(kii,kij+1), vmask_e(kii+1,kij+1)/) 348 CASE ( 'F' ) 349 ! F case only used for coriolis, ff_f is not mask so zmask = 1 350 pmsk = 1. 351 END SELECT 352 END SUBROUTINE icb_utl_pos 353 354 REAL(wp) FUNCTION icb_utl_bilin_2d_h( pfld, pii, pij, pw, pllon ) 265 355 !!---------------------------------------------------------------------- 266 356 !! *** FUNCTION icb_utl_bilin *** 267 357 !! 268 358 !! ** Purpose : bilinear interpolation at berg location depending on the grid-point type 359 !! this version deals with extra halo points 269 360 !! 270 361 !! !!gm CAUTION an optional argument should be added to handle … … 272 363 !! 273 364 !!---------------------------------------------------------------------- 274 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfld ! field to be interpolated 275 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 276 CHARACTER(len=1) , INTENT(in) :: cd_type ! type of pfld array grid-points: = T , U , V or F points 277 ! 278 INTEGER :: ii, ij ! local integer 279 REAL(wp) :: zi, zj ! local real 280 !!---------------------------------------------------------------------- 281 ! 282 SELECT CASE ( cd_type ) 283 CASE ( 'T' ) 284 ! note that here there is no +0.5 added 285 ! since we're looking for four T points containing quadrant we're in of 286 ! current T cell 287 ii = MAX(1, INT( pi )) 288 ij = MAX(1, INT( pj )) ! T-point 289 zi = pi - REAL(ii,wp) 290 zj = pj - REAL(ij,wp) 291 CASE ( 'U' ) 292 ii = MAX(1, INT( pi-0.5 )) 293 ij = MAX(1, INT( pj )) ! U-point 294 zi = pi - 0.5 - REAL(ii,wp) 295 zj = pj - REAL(ij,wp) 296 CASE ( 'V' ) 297 ii = MAX(1, INT( pi )) 298 ij = MAX(1, INT( pj-0.5 )) ! V-point 299 zi = pi - REAL(ii,wp) 300 zj = pj - 0.5 - REAL(ij,wp) 301 CASE ( 'F' ) 302 ii = MAX(1, INT( pi-0.5 )) 303 ij = MAX(1, INT( pj-0.5 )) ! F-point 304 zi = pi - 0.5 - REAL(ii,wp) 305 zj = pj - 0.5 - REAL(ij,wp) 306 END SELECT 307 ! 308 ! find position in this processor. Prevent near edge problems (see #1389) 309 IF ( ii < mig( 1 ) ) THEN ; ii = 1 310 ELSEIF( ii > mig(jpi) ) THEN ; ii = jpi 311 ELSE ; ii = mi1(ii) 365 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) :: pfld ! field to be interpolated 366 REAL(wp), DIMENSION(4) , INTENT(in) :: pw ! weight 367 LOGICAL , INTENT(in) :: pllon ! input data is a longitude 368 INTEGER , INTENT(in) :: pii, pij ! bottom left corner 369 ! 370 REAL(wp), DIMENSION(4) :: zdat ! input data 371 !!---------------------------------------------------------------------- 372 ! 373 ! data 374 zdat(1) = pfld(pii ,pij ) 375 zdat(2) = pfld(pii+1,pij ) 376 zdat(3) = pfld(pii ,pij+1) 377 zdat(4) = pfld(pii+1,pij+1) 378 ! 379 IF( pllon .AND. MAXVAL(zdat) - MINVAL(zdat) > 90._wp ) THEN 380 WHERE( zdat < 0._wp ) zdat = zdat + 360._wp 312 381 ENDIF 313 IF ( ij < mjg( 1 ) ) THEN ; ij = 1 314 ELSEIF( ij > mjg(jpj) ) THEN ; ij = jpj 315 ELSE ; ij = mj1(ij) 316 ENDIF 317 ! 318 IF( ii == jpi ) ii = ii-1 319 IF( ij == jpj ) ij = ij-1 320 ! 321 icb_utl_bilin = ( pfld(ii,ij ) * (1.-zi) + pfld(ii+1,ij ) * zi ) * (1.-zj) & 322 & + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) * zj 323 ! 324 END FUNCTION icb_utl_bilin 325 326 327 REAL(wp) FUNCTION icb_utl_bilin_x( pfld, pi, pj ) 328 !!---------------------------------------------------------------------- 329 !! *** FUNCTION icb_utl_bilin_x *** 382 ! 383 ! compute interpolated value 384 icb_utl_bilin_2d_h = ( zdat(1)*pw(1) + zdat(2)*pw(2) + zdat(3)*pw(3) + zdat(4)*pw(4) ) / MAX(1.e-20, pw(1)+pw(2)+pw(3)+pw(4)) 385 ! 386 IF( pllon .AND. icb_utl_bilin_2d_h > 180._wp ) icb_utl_bilin_2d_h = icb_utl_bilin_2d_h - 360._wp 387 ! 388 END FUNCTION icb_utl_bilin_2d_h 389 390 FUNCTION icb_utl_bilin_3d_h( pfld, pii, pij, pw ) 391 !!---------------------------------------------------------------------- 392 !! *** FUNCTION icb_utl_bilin *** 330 393 !! 331 394 !! ** Purpose : bilinear interpolation at berg location depending on the grid-point type 332 !! Special case for interpolating longitude395 !! this version deals with extra halo points 333 396 !! 334 397 !! !!gm CAUTION an optional argument should be added to handle … … 336 399 !! 337 400 !!---------------------------------------------------------------------- 338 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pfld ! field to be interpolated 339 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 340 ! 341 INTEGER :: ii, ij ! local integer 342 REAL(wp) :: zi, zj ! local real 343 REAL(wp) :: zret ! local real 344 REAL(wp), DIMENSION(4) :: z4 345 !!---------------------------------------------------------------------- 346 ! 347 ! note that here there is no +0.5 added 348 ! since we're looking for four T points containing quadrant we're in of 349 ! current T cell 350 ii = MAX(1, INT( pi )) 351 ij = MAX(1, INT( pj )) ! T-point 352 zi = pi - REAL(ii,wp) 353 zj = pj - REAL(ij,wp) 354 ! 355 ! find position in this processor. Prevent near edge problems (see #1389) 356 IF ( ii < mig( 1 ) ) THEN ; ii = 1 357 ELSEIF( ii > mig(jpi) ) THEN ; ii = jpi 358 ELSE ; ii = mi1(ii) 359 ENDIF 360 IF ( ij < mjg( 1 ) ) THEN ; ij = 1 361 ELSEIF( ij > mjg(jpj) ) THEN ; ij = jpj 362 ELSE ; ij = mj1(ij) 363 ENDIF 364 ! 365 IF( ii == jpi ) ii = ii-1 366 IF( ij == jpj ) ij = ij-1 367 ! 368 z4(1) = pfld(ii ,ij ) 369 z4(2) = pfld(ii+1,ij ) 370 z4(3) = pfld(ii ,ij+1) 371 z4(4) = pfld(ii+1,ij+1) 372 IF( MAXVAL(z4) - MINVAL(z4) > 90._wp ) THEN 373 WHERE( z4 < 0._wp ) z4 = z4 + 360._wp 374 ENDIF 375 ! 376 zret = (z4(1) * (1.-zi) + z4(2) * zi) * (1.-zj) + (z4(3) * (1.-zi) + z4(4) * zi) * zj 377 IF( zret > 180._wp ) zret = zret - 360._wp 378 icb_utl_bilin_x = zret 379 ! 380 END FUNCTION icb_utl_bilin_x 381 401 REAL(wp), DIMENSION(0:jpi+1,0:jpj+1, jpk), INTENT(in) :: pfld ! field to be interpolated 402 REAL(wp), DIMENSION(4,jpk) , INTENT(in) :: pw ! weight 403 INTEGER , INTENT(in) :: pii, pij ! bottom left corner 404 REAL(wp), DIMENSION(jpk) :: icb_utl_bilin_3d_h 405 ! 406 REAL(wp), DIMENSION(4,jpk) :: zdat ! input data 407 INTEGER :: jk 408 !!---------------------------------------------------------------------- 409 ! 410 ! data 411 zdat(1,:) = pfld(pii ,pij ,:) 412 zdat(2,:) = pfld(pii+1,pij ,:) 413 zdat(3,:) = pfld(pii ,pij+1,:) 414 zdat(4,:) = pfld(pii+1,pij+1,:) 415 ! 416 ! compute interpolated value 417 DO jk=1,jpk 418 icb_utl_bilin_3d_h(jk) = ( zdat(1,jk)*pw(1,jk) + zdat(2,jk)*pw(2,jk) + zdat(3,jk)*pw(3,jk) + zdat(4,jk)*pw(4,jk) ) & 419 & / MAX(1.e-20, pw(1,jk)+pw(2,jk)+pw(3,jk)+pw(4,jk)) 420 END DO 421 ! 422 END FUNCTION icb_utl_bilin_3d_h 382 423 383 424 REAL(wp) FUNCTION icb_utl_bilin_e( pet, peu, pev, pef, pi, pj ) … … 390 431 !!---------------------------------------------------------------------- 391 432 REAL(wp), DIMENSION(:,:), INTENT(in) :: pet, peu, pev, pef ! horizontal scale factor to be interpolated at t-,u-,v- & f-pts 392 REAL(wp) , INTENT(in) :: pi, pj ! targeted coordinates in (i,j) referential 393 ! 394 INTEGER :: ii, ij, icase, ierr ! local integer 433 REAL(wp) , INTENT(IN) :: pi , pj ! iceberg position 395 434 ! 396 435 ! weights corresponding to corner points of a T cell quadrant 397 436 REAL(wp) :: zi, zj ! local real 437 INTEGER :: ii, ij ! bottom left corner coordinate in local domain 398 438 ! 399 439 ! values at corner points of a T cell quadrant … … 402 442 !!---------------------------------------------------------------------- 403 443 ! 444 ! cannot used iiT because need ii/ij reltaive to global indices not local one 404 445 ii = MAX(1, INT( pi )) ; ij = MAX(1, INT( pj )) ! left bottom T-point (i,j) indices 405 446 ! 406 447 ! fractional box spacing 407 448 ! 0 <= zi < 0.5, 0 <= zj < 0.5 --> NW quadrant of current T cell … … 413 454 zj = pj - REAL(ij,wp) 414 455 415 ! find position in this processor. Prevent near edge problems (see #1389) 416 ! 417 ierr = 0 418 IF ( ii < mig( 1 ) ) THEN ; ii = 1 ; ierr = ierr + 1 419 ELSEIF( ii > mig(jpi) ) THEN ; ii = jpi ; ierr = ierr + 1 420 ELSE ; ii = mi1(ii) 421 ENDIF 422 IF ( ij < mjg( 1 ) ) THEN ; ij = 1 ; ierr = ierr + 1 423 ELSEIF( ij > mjg(jpj) ) THEN ; ij = jpj ; ierr = ierr + 1 424 ELSE ; ij = mj1(ij) 425 ENDIF 426 ! 427 IF( ii == jpi ) THEN ; ii = ii-1 ; ierr = ierr + 1 ; END IF 428 IF( ij == jpj ) THEN ; ij = ij-1 ; ierr = ierr + 1 ; END IF 429 ! 430 IF ( ierr > 0 ) CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error)') 456 ! conversion to local domain (no need to do a sanity check already done in icbpos) 457 ii = mi1(ii) 458 ij = mj1(ij) 431 459 ! 432 460 IF( 0.0_wp <= zi .AND. zi < 0.5_wp ) THEN … … 465 493 END FUNCTION icb_utl_bilin_e 466 494 495 SUBROUTINE icb_utl_getkb( kb, pe3, pD ) 496 !!---------------------------------------------------------------------- 497 !! *** ROUTINE icb_utl_getkb *** 498 !! 499 !! ** Purpose : compute the latest level affected by icb 500 !! 501 !!---------------------------------------------------------------------- 502 INTEGER, INTENT(out):: kb 503 REAL(wp), DIMENSION(:), INTENT(in) :: pe3 504 REAL(wp), INTENT(in) :: pD 505 !! 506 INTEGER :: jk 507 REAL(wp) :: zdepw 508 !!---------------------------------------------------------------------- 509 !! 510 zdepw = pe3(1) ; kb = 2 511 DO WHILE ( zdepw < pD) 512 zdepw = zdepw + pe3(kb) 513 kb = kb + 1 514 END DO 515 kb = MIN(kb - 1,jpk) 516 END SUBROUTINE 517 518 SUBROUTINE icb_utl_zavg(pzavg, pdat, pe3, pD, kb ) 519 !!---------------------------------------------------------------------- 520 !! *** ROUTINE icb_utl_getkb *** 521 !! 522 !! ** Purpose : compute the vertical average of ocean properties affected by icb 523 !! 524 !!---------------------------------------------------------------------- 525 INTEGER, INTENT(in ) :: kb ! deepest level affected by icb 526 REAL(wp), DIMENSION(:), INTENT(in ) :: pe3, pdat ! vertical profile 527 REAL(wp), INTENT(in ) :: pD ! draft 528 REAL(wp), INTENT(out) :: pzavg ! z average 529 !!---------------------------------------------------------------------- 530 INTEGER :: jk 531 REAL(wp) :: zdep 532 !!---------------------------------------------------------------------- 533 pzavg = 0.0 ; zdep = 0.0 534 DO jk = 1,kb-1 535 pzavg = pzavg + pe3(jk)*pdat(jk) 536 zdep = zdep + pe3(jk) 537 END DO 538 ! if kb is limited by mbkt => bottom value is used between bathy and icb tail 539 ! if kb not limited by mbkt => ocean value over mask is used (ie 0.0 for u, v) 540 pzavg = ( pzavg + (pD - zdep)*pdat(kb)) / pD 541 END SUBROUTINE 467 542 468 543 SUBROUTINE icb_utl_add( bergvals, ptvals ) … … 653 728 WRITE(numicb, 9200) kt, berg%number(1), & 654 729 pt%xi, pt%yj, pt%lon, pt%lat, pt%uvel, pt%vvel, & 655 pt% uo, pt%vo, pt%ua, pt%va, pt%ui, pt%vi730 pt%ssu, pt%ssv, pt%ua, pt%va, pt%ui, pt%vi 656 731 CALL flush( numicb ) 657 732 9200 FORMAT(5x,i5,2x,i10,6(2x,2f10.4)) … … 679 754 WRITE(numicb,'(a," pe=(",i3,")")' ) cd_label, narea 680 755 WRITE(numicb,'(a8,4x,a6,12x,a5,15x,a7,19x,a3,17x,a5,17x,a5,17x,a5)' ) & 681 & 'timestep', 'number', 'xi,yj','lon,lat','u,v',' uo,vo','ua,va','ui,vi'756 & 'timestep', 'number', 'xi,yj','lon,lat','u,v','ssu,ssv','ua,va','ui,vi' 682 757 ENDIF 683 758 DO WHILE( ASSOCIATED(this) ) … … 823 898 END FUNCTION icb_utl_heat 824 899 900 SUBROUTINE test_icb_utl_getkb 901 !!---------------------------------------------------------------------- 902 !! *** FUNCTION test_icb_utl_getkb *** 903 !! 904 !! ** Purpose : Test routine icb_utl_getkb, icb_utl_zavg 905 !! ** Methode : Call each subroutine with specific input data 906 !! What should be the output is easy to determined and check 907 !! if NEMO return the correct answer. 908 !! ** Comments : not called, if needed a CALL test_icb_utl_getkb need to be added in icb_step 909 !!---------------------------------------------------------------------- 910 INTEGER :: ikb 911 REAL(wp) :: zD, zout 912 REAL(wp), DIMENSION(jpk) :: ze3, zin 913 WRITE(numout,*) 'Test icb_utl_getkb : ' 914 zD = 0.0 ; ze3= 20.0 915 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 916 CALL icb_utl_getkb(ikb, ze3, zD) 917 WRITE(numout,*) 'OUTPUT : kb = ',ikb 918 919 zD = 8000000.0 ; ze3= 20.0 920 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 921 CALL icb_utl_getkb(ikb, ze3, zD) 922 WRITE(numout,*) 'OUTPUT : kb = ',ikb 923 924 zD = 80.0 ; ze3= 20.0 925 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 926 CALL icb_utl_getkb(ikb, ze3, zD) 927 WRITE(numout,*) 'OUTPUT : kb = ',ikb 928 929 zD = 85.0 ; ze3= 20.0 930 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 931 CALL icb_utl_getkb(ikb, ze3, zD) 932 WRITE(numout,*) 'OUTPUT : kb = ',ikb 933 934 zD = 75.0 ; ze3= 20.0 935 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1) 936 CALL icb_utl_getkb(ikb, ze3, zD) 937 WRITE(numout,*) 'OUTPUT : kb = ',ikb 938 939 WRITE(numout,*) '==================================' 940 WRITE(numout,*) 'Test icb_utl_zavg' 941 zD = 0.0 ; ze3= 20.0 ; zin=1.0 942 CALL icb_utl_getkb(ikb, ze3, zD) 943 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 944 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 945 WRITE(numout,*) 'OUTPUT : zout = ',zout 946 947 zD = 50.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 948 CALL icb_utl_getkb(ikb, ze3, zD) 949 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 950 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 951 WRITE(numout,*) 'OUTPUT : zout = ',zout 952 CALL FLUSH(numout) 953 954 zD = 80.0 ; ze3= 20.0 ; zin=1.0; zin(3:jpk) = 0.0 955 CALL icb_utl_getkb(ikb, ze3, zD) 956 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 957 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 958 WRITE(numout,*) 'OUTPUT : zout = ',zout 959 960 zD = 80 ; ze3= 20.0 ; zin=1.0 ; zin(3:jpk) = 0.0 961 CALL icb_utl_getkb(ikb, ze3, zD) 962 ikb = 2 963 CALL icb_utl_zavg(zout, zin, ze3, zD, ikb) 964 WRITE(numout,*) 'INPUT : zD = ',zD,' ze3 = ',ze3(1),' zin = ', zin, ' ikb = ',ikb 965 WRITE(numout,*) 'OUTPUT : zout = ',zout 966 967 CALL FLUSH(numout) 968 969 END SUBROUTINE test_icb_utl_getkb 970 825 971 !!====================================================================== 826 972 END MODULE icbutl -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/IOM/iom.F90
r14049 r14054 29 29 USE in_out_manager ! I/O manager 30 30 USE lib_mpp ! MPP library 31 #if defined key_iomput32 31 USE sbc_oce , ONLY : nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 33 32 USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes … … 37 36 USE phycst ! physical constants 38 37 USE dianam ! build name of file 38 #if defined key_iomput 39 39 USE xios 40 40 # endif … … 174 174 CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) 175 175 CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. ) 176 CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. ) 176 177 CALL set_grid_znl( gphit ) 177 178 ! … … 180 181 CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 181 182 CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 182 CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 183 CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 184 CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp)) 183 185 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 184 186 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 185 187 CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 186 188 CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 189 CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif ) 187 190 ENDIF 188 191 ENDIF … … 191 194 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 192 195 ! 193 CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 194 CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 195 CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 196 CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 196 CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 197 CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 198 CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 199 CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 197 200 CALL set_grid_znl( gphit_crs ) 198 201 ! … … 217 220 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 218 221 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 222 CALL iom_set_axis_attr( "depthf", paxis = gdept_1d ) 219 223 220 224 ! ABL … … 238 242 CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 239 243 CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 244 CALL iom_set_axis_attr( "depthf", bounds=zw_bnds ) 240 245 241 246 ! ABL -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/IOM/restart.F90
r14049 r14054 11 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 13 !! 4.1 ! 2020-11 (S. Techene, G. Madec) move ssh initiatlisation in DYN/sshwzv:ssh_init_rst 13 14 !!---------------------------------------------------------------------- 14 15 … … 139 140 !! ** Method : Write in numrow when kt == nitrst in NetCDF 140 141 !! file, save fields which are necessary for restart 142 !! 143 !! NB: ssh is written here (rst_write) 144 !! but is read or set in DYN/sshwzv:shh_init_rst 141 145 !!---------------------------------------------------------------------- 142 146 INTEGER, INTENT(in) :: kt ! ocean time-step … … 233 237 !! *** ROUTINE rst_read *** 234 238 !! 235 !! ** Purpose : Read files for NetCDF restart 236 !! 237 !! ** Method : Read in restart.nc file fields which are necessary for restart 239 !! ** Purpose : Read velocity and T-S fields in the restart file 240 !! 241 !! ** Method : Read in restart.nc fields which are necessary for restart 242 !! 243 !! NB: restart file openned in DOM/domain.F90:dom_init 244 !! before field in restart tested in DOM/domain.F90:dom_init 245 !! (sshb) 246 !! 247 !! NB: ssh is read or set in DYN/sshwzv:shh_init_rst 248 !! but is written in IOM/restart:rst_write 238 249 !!---------------------------------------------------------------------- 239 250 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 240 REAL(wp) :: zrdt241 251 INTEGER :: jk 242 252 REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 243 253 !!---------------------------------------------------------------------- 244 245 CALL rst_read_open ! open restart for reading (if not already opened) 246 247 ! Check dynamics and tracer time-step consistency and force Euler restart if changed 248 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 249 CALL iom_get( numror, 'rdt', zrdt ) 250 IF( zrdt /= rn_Dt ) THEN 251 IF(lwp) WRITE( numout,*) 252 IF(lwp) WRITE( numout,*) 'rst_read: rdt not equal to the read one' 253 IF(lwp) WRITE( numout,*) 254 IF(lwp) WRITE( numout,*) ' ==>>> forced euler first time-step' 255 l_1st_euler = .TRUE. 256 ENDIF 257 ENDIF 258 254 ! 259 255 IF(.NOT.lrxios ) CALL iom_delay_rst( 'READ', 'OCE', numror ) ! read only ocean delayed global communication variables 260 261 ! Diurnal DSST262 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst )256 ! 257 ! !* Diurnal DSST 258 IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst ) 263 259 IF ( ln_diurnal_only ) THEN 264 260 IF(lwp) WRITE( numout, * ) & … … 269 265 RETURN 270 266 ENDIF 271 272 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 273 ! before fields 267 ! 268 ! !* Read Kmm fields 269 IF(lwp) WRITE(numout,*) ' Kmm u, v and T-S fields read in the restart file' 270 CALL iom_get( numror, jpdom_auto, 'un' , uu(:,:,: ,Kmm), cd_type = 'U', psgn = -1._wp ) 271 CALL iom_get( numror, jpdom_auto, 'vn' , vv(:,:,: ,Kmm), cd_type = 'V', psgn = -1._wp ) 272 CALL iom_get( numror, jpdom_auto, 'tn' , ts(:,:,:,jp_tem,Kmm) ) 273 CALL iom_get( numror, jpdom_auto, 'sn' , ts(:,:,:,jp_sal,Kmm) ) 274 ! 275 IF( l_1st_euler ) THEN !* Euler restart 276 IF(lwp) WRITE(numout,*) ' Kbb u, v and T-S fields set to Kmm values' 277 ts(:,:,:,:,Kbb) = ts(:,:,:,:,Kmm) ! all before fields set to now values 278 uu(:,:,: ,Kbb) = uu(:,:,: ,Kmm) 279 vv(:,:,: ,Kbb) = vv(:,:,: ,Kmm) 280 ELSE !* Leap frog restart 281 IF(lwp) WRITE(numout,*) ' Kbb u, v and T-S fields read in the restart file' 274 282 CALL iom_get( numror, jpdom_auto, 'ub' , uu(:,:,: ,Kbb), cd_type = 'U', psgn = -1._wp ) 275 283 CALL iom_get( numror, jpdom_auto, 'vb' , vv(:,:,: ,Kbb), cd_type = 'V', psgn = -1._wp ) 276 284 CALL iom_get( numror, jpdom_auto, 'tb' , ts(:,:,:,jp_tem,Kbb) ) 277 285 CALL iom_get( numror, jpdom_auto, 'sb' , ts(:,:,:,jp_sal,Kbb) ) 278 CALL iom_get( numror, jpdom_auto, 'sshb' ,ssh(:,: ,Kbb) ) 279 ELSE 280 l_1st_euler = .TRUE. ! before field not found, forced euler 1st time-step 281 ENDIF 282 ! 283 ! now fields 284 CALL iom_get( numror, jpdom_auto, 'un' , uu(:,:,: ,Kmm), cd_type = 'U', psgn = -1._wp ) 285 CALL iom_get( numror, jpdom_auto, 'vn' , vv(:,:,: ,Kmm), cd_type = 'V', psgn = -1._wp ) 286 CALL iom_get( numror, jpdom_auto, 'tn' , ts(:,:,:,jp_tem,Kmm) ) 287 CALL iom_get( numror, jpdom_auto, 'sn' , ts(:,:,:,jp_sal,Kmm) ) 288 CALL iom_get( numror, jpdom_auto, 'sshn' ,ssh(:,: ,Kmm) ) 286 ENDIF 287 ! 289 288 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 290 289 CALL iom_get( numror, jpdom_auto, 'rhop' , rhop ) ! now potential density … … 293 292 ENDIF 294 293 ! 295 IF( l_1st_euler ) THEN ! Euler restart296 ts (:,:,:,:,Kbb) = ts (:,:,:,:,Kmm) ! all before fields set to now values297 uu (:,:,: ,Kbb) = uu (:,:,: ,Kmm)298 vv (:,:,: ,Kbb) = vv (:,:,: ,Kmm)299 ssh (:,: ,Kbb) = ssh (:,: ,Kmm)300 ENDIF301 !302 294 END SUBROUTINE rst_read 303 295 -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ISF/isfcpl.F90
r14049 r14054 10 10 11 11 !!---------------------------------------------------------------------- 12 !! isfrst : read/write iceshelf variables in/from restart12 !! isfrst : read/write iceshelf variables in/from restart 13 13 !!---------------------------------------------------------------------- 14 USE isf_oce ! ice shelf variable 14 USE oce ! ocean dynamics and tracers 15 #if defined key_qco 16 USE domqco , ONLY : dom_qco_zgr ! vertical scale factor interpolation 17 #else 18 USE domvvl , ONLY : dom_vvl_zgr ! vertical scale factor interpolation 19 #endif 20 USE domutl , ONLY : dom_ngb ! find the closest grid point from a given lon/lat position 21 USE isf_oce ! ice shelf variable 15 22 USE isfutils, ONLY : debug 16 USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine17 #if ! defined key_qco18 USE domvvl , ONLY: dom_vvl_zgr ! vertical scale factor interpolation19 #else20 USE domqco , ONLY: dom_qco_zgr ! vertical scale factor interpolation21 #endif22 USE domutl , ONLY: dom_ngb ! find the closest grid point from a given lon/lat position23 23 ! 24 USE oce ! ocean dynamics and tracers25 24 USE in_out_manager ! I/O manager 26 25 USE iom ! I/O library 26 USE lib_mpp , ONLY : mpp_sum, mpp_max ! mpp routine 27 27 ! 28 28 IMPLICIT NONE … … 34 34 35 35 TYPE isfcons 36 INTEGER :: ii ! i global37 INTEGER :: jj ! j global38 INTEGER :: kk ! k level39 REAL(wp):: dvol ! volume increment40 REAL(wp):: dsal ! salt increment41 REAL(wp):: dtem ! heat increment42 REAL(wp):: lon ! lon43 REAL(wp):: lat ! lat44 INTEGER :: ngb ! 0/1 (valid location or not (ie on halo or no neigbourg))36 INTEGER :: ii ! i global 37 INTEGER :: jj ! j global 38 INTEGER :: kk ! k level 39 REAL(wp):: dvol ! volume increment 40 REAL(wp):: dsal ! salt increment 41 REAL(wp):: dtem ! heat increment 42 REAL(wp):: lon ! lon 43 REAL(wp):: lat ! lat 44 INTEGER :: ngb ! 0/1 (valid location or not (ie on halo or no neigbourg)) 45 45 END TYPE 46 46 ! … … 121 121 #endif 122 122 END SUBROUTINE isfcpl_init 123 ! 124 SUBROUTINE isfcpl_rst_write(kt, Kmm) 123 124 125 SUBROUTINE isfcpl_rst_write( kt, Kmm ) 125 126 !!--------------------------------------------------------------------- 126 127 !! *** ROUTINE iscpl_rst_write *** … … 133 134 !!---------------------------------------------------------------------- 134 135 INTEGER :: jk ! loop index 135 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw ! e3t , e3u, e3v !!st patch to usesubstitution136 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw ! for qco substitution 136 137 !!---------------------------------------------------------------------- 137 138 ! … … 153 154 END SUBROUTINE isfcpl_rst_write 154 155 156 155 157 SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa) 156 158 !!---------------------------------------------------------------------- … … 184 186 zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:) 185 187 DO_2D( 0, 0, 0, 0 ) 186 jip1=ji+1 ; jim1=ji-1;187 jjp1=jj+1 ; jjm1=jj-1;188 jip1=ji+1 ; jim1=ji-1 189 jjp1=jj+1 ; jjm1=jj-1 188 190 ! 189 191 zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1) … … 191 193 IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN 192 194 ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj) & 193 & + zssh(jim1,jj)*zssmask0(jim1,jj) &194 & + zssh(ji,jjp1)*zssmask0(ji,jjp1) &195 & + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk195 & + zssh(jim1,jj)*zssmask0(jim1,jj) & 196 & + zssh(ji,jjp1)*zssmask0(ji,jjp1) & 197 & + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk 196 198 zssmask_b(ji,jj) = 1._wp 197 199 ENDIF … … 222 224 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 223 225 #else 224 CALL dom_qco_zgr(Kbb, Kmm , Kaa)226 CALL dom_qco_zgr(Kbb, Kmm) 225 227 #endif 226 228 ! 227 229 END SUBROUTINE isfcpl_ssh 228 230 231 229 232 SUBROUTINE isfcpl_tra(Kmm) 230 233 !!---------------------------------------------------------------------- … … 375 378 ! 376 379 END SUBROUTINE isfcpl_tra 380 377 381 378 382 SUBROUTINE isfcpl_vol(Kmm) … … 466 470 risfcpl_ssh(:,:) = risfcpl_ssh(:,:) + risfcpl_vol(:,:,jk) * r1_e1e2t(:,:) 467 471 END DO 468 472 ! 469 473 END SUBROUTINE isfcpl_vol 470 474 475 471 476 SUBROUTINE isfcpl_cons(Kmm) 472 477 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ISF/isfdynatf.F90
r13237 r14054 15 15 USE phycst , ONLY: r1_rho0 ! physical constant 16 16 USE dom_oce ! time and space domain 17 USE oce, ONLY : ssh ! sea-surface height !!st needed forsubstitution17 USE oce, ONLY : ssh ! sea-surface height for qco substitution 18 18 19 19 USE in_out_manager -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ISF/isfrst.F90
r14049 r14054 28 28 !!---------------------------------------------------------------------- 29 29 CONTAINS 30 !31 SUBROUTINE isfrst_read( cdisf, ptsc, pfwf, ptsc_b, pfwf_b )30 31 SUBROUTINE isfrst_read( cdisf, ptsc, pfwf, ptsc_b, pfwf_b ) 32 32 !!--------------------------------------------------------------------- 33 33 !! … … 51 51 ! 52 52 ! read restart 53 IF( iom_varid( numror, cfwf_b, ldstop = .FALSE. ) > 0) THEN53 IF( .NOT.l_1st_euler ) THEN 54 54 IF(lwp) WRITE(numout,*) ' nit000-1 isf tracer content forcing fields read in the restart file' 55 55 CALL iom_get( numror, jpdom_auto, cfwf_b, pfwf_b(:,:) ) ! before ice shelf melt … … 62 62 ! 63 63 END SUBROUTINE isfrst_read 64 ! 65 SUBROUTINE isfrst_write(kt, cdisf, ptsc, pfwf ) 64 65 66 SUBROUTINE isfrst_write( kt, cdisf, ptsc, pfwf ) 66 67 !!--------------------------------------------------------------------- 67 68 !! … … 94 95 ! 95 96 END SUBROUTINE isfrst_write 96 ! 97 98 !!====================================================================== 97 99 END MODULE isfrst -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/LBC/mppini.F90
r14049 r14054 217 217 ! then we calculate them here now that we have our communicator size 218 218 IF(lwp) THEN 219 WRITE(numout,*) 219 220 WRITE(numout,*) 'mpp_init:' 220 221 WRITE(numout,*) '~~~~~~~~ ' 221 WRITE(numout,*)222 222 ENDIF 223 223 IF( jpni < 1 .OR. jpnj < 1 ) THEN -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/LDF/ldfdyn.F90
r13497 r14054 34 34 ! !!* Namelist namdyn_ldf : lateral mixing on momentum * 35 35 LOGICAL , PUBLIC :: ln_dynldf_OFF !: No operator (i.e. no explicit diffusion) 36 INTEGER , PUBLIC :: nn_dynldf_typ !: operator type (0: div-rot ; 1: symmetric) 36 37 LOGICAL , PUBLIC :: ln_dynldf_lap !: laplacian operator 37 38 LOGICAL , PUBLIC :: ln_dynldf_blp !: bilaplacian operator … … 52 53 53 54 ! !!* Parameter to control the type of lateral viscous operator 54 INTEGER, PARAMETER, PUBLIC :: np_ERROR =-10 !: error in setting the operator 55 INTEGER, PARAMETER, PUBLIC :: np_no_ldf = 00 !: without operator (i.e. no lateral viscous trend) 55 INTEGER, PARAMETER, PUBLIC :: np_ERROR =-10 !: error in setting the operator 56 INTEGER, PARAMETER, PUBLIC :: np_no_ldf = 00 !: without operator (i.e. no lateral viscous trend) 57 ! 58 INTEGER, PARAMETER, PUBLIC :: np_typ_rot = 0 !: div-rot operator 59 INTEGER, PARAMETER, PUBLIC :: np_typ_sym = 1 !: symmetric operator 60 ! 56 61 ! !! laplacian ! bilaplacian ! 57 62 INTEGER, PARAMETER, PUBLIC :: np_lap = 10 , np_blp = 20 !: iso-level operator … … 109 114 CHARACTER(len=5) :: cl_Units ! units (m2/s or m4/s) 110 115 !! 111 NAMELIST/namdyn_ldf/ ln_dynldf_OFF, ln_dynldf_lap, ln_dynldf_blp, & ! type of operator112 & ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso, & ! acting direction of the operator113 & nn_ahm_ijk_t , rn_Uv , rn_Lv, rn_ahm_b,& ! lateral eddy coefficient114 & rn_csmc , rn_minfac , rn_maxfac ! Smagorinsky settings116 NAMELIST/namdyn_ldf/ ln_dynldf_OFF, nn_dynldf_typ, ln_dynldf_lap, ln_dynldf_blp, & ! type of operator 117 & ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso, & ! acting direction of the operator 118 & nn_ahm_ijk_t , rn_Uv , rn_Lv , rn_ahm_b, & ! lateral eddy coefficient 119 & rn_csmc , rn_minfac , rn_maxfac ! Smagorinsky settings 115 120 !!---------------------------------------------------------------------- 116 121 ! … … 130 135 WRITE(numout,*) ' type :' 131 136 WRITE(numout,*) ' no explicit diffusion ln_dynldf_OFF = ', ln_dynldf_OFF 137 WRITE(numout,*) ' type of operator (div-rot or sym) nn_dynldf_typ = ', nn_dynldf_typ 132 138 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 133 139 WRITE(numout,*) ' bilaplacian operator ln_dynldf_blp = ', ln_dynldf_blp … … 147 153 WRITE(numout,*) ' Smagorinsky coefficient rn_csmc = ', rn_csmc 148 154 WRITE(numout,*) ' factor multiplier for eddy visc.' 149 WRITE(numout,*) ' lower limit (default 1.0) rn_minfac = ', rn_minfac150 WRITE(numout,*) ' upper limit (default 1.0) rn_maxfac = ', rn_maxfac155 WRITE(numout,*) ' lower limit (default 1.0) rn_minfac = ', rn_minfac 156 WRITE(numout,*) ' upper limit (default 1.0) rn_maxfac = ', rn_maxfac 151 157 ENDIF 152 158 … … 160 166 IF( ln_dynldf_lap ) THEN ; ioptio = ioptio + 1 ; ENDIF 161 167 IF( ln_dynldf_blp ) THEN ; ioptio = ioptio + 1 ; ENDIF 162 IF( ioptio /= 1 ) CALL ctl_stop( ' dyn_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' )168 IF( ioptio /= 1 ) CALL ctl_stop( 'ldf_dyn_init: use ONE of the 3 operator options (NONE/lap/blp)' ) 163 169 ! 164 170 IF(.NOT.ln_dynldf_OFF ) THEN !== direction ==>> type of operator ==! 171 ! 172 SELECT CASE( nn_dynldf_typ ) ! div-rot or symmetric 173 CASE( np_typ_rot ) ; IF(lwp) WRITE(numout,*) ' ==>>> use div-rot operator ' 174 CASE( np_typ_sym ) ; IF(lwp) WRITE(numout,*) ' ==>>> use symmetric operator ' 175 CASE DEFAULT ! error 176 CALL ctl_stop('ldf_dyn_init: wrong value for nn_dynldf_typ (0 or 1)' ) 177 END SELECT 178 ! 165 179 ioptio = 0 166 180 IF( ln_dynldf_lev ) ioptio = ioptio + 1 167 181 IF( ln_dynldf_hor ) ioptio = ioptio + 1 168 182 IF( ln_dynldf_iso ) ioptio = ioptio + 1 169 IF( ioptio /= 1 ) CALL ctl_stop( ' dyn_ldf_init: use ONE of the 3 direction options (level/hor/iso)' )183 IF( ioptio /= 1 ) CALL ctl_stop( 'ldf_dyn_init: use ONE of the 3 direction options (level/hor/iso)' ) 170 184 ! 171 185 ! ! Set nldf_dyn, the type of lateral diffusion, from ln_dynldf_... logicals -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcapr.F90
r14049 r14054 148 148 ! ! ---------------------------------------- ! 149 149 ! !* Restart: read in restart file 150 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0) THEN150 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN 151 151 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 152 152 CALL iom_get( numror, jpdom_auto, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcice_cice.F90
r13295 r14054 12 12 USE oce ! ocean dynamics and tracers 13 13 USE dom_oce ! ocean space and time domain 14 # if !defined key_qco15 USE dom vvl14 # if defined key_qco 15 USE domqco ! Variable volume 16 16 # else 17 USE dom qco17 USE domvvl ! Variable volume 18 18 # endif 19 19 USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi … … 238 238 !!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 239 239 #if defined key_qco 240 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm , Kaa) ! interpolation scale factor, depth and water column240 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm ) ! interpolation scale factor, depth and water column 241 241 #else 242 242 IF( .NOT.ln_linssh ) THEN -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcmod.F90
r14049 r14054 475 475 476 476 IF( ln_icebergs ) THEN 477 CALL icb_stp( kt ) ! compute icebergs477 CALL icb_stp( kt, Kmm ) ! compute icebergs 478 478 ! Icebergs do not melt over the haloes. 479 479 ! So emp values over the haloes are no more consistent with the inner domain values. … … 523 523 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 524 524 ! ! ---------------------------------------- ! 525 IF( ln_rstart .AND. & !* Restart: read in restart file 526 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 527 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 528 CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b ) ! before i-stress (U-point) 529 CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b ) ! before j-stress (V-point) 530 CALL iom_get( numror, jpdom_auto, 'qns_b', qns_b ) ! before non solar heat flux (T-point) 531 ! The 3D heat content due to qsr forcing is treated in traqsr 532 ! CALL iom_get( numror, jpdom_auto, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point) 533 CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b ) ! before freshwater flux (T-point) 525 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN !* Restart: read in restart file 526 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields read in the restart file' 527 CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b ) ! i-stress 528 CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b ) ! j-stress 529 CALL iom_get( numror, jpdom_auto, 'qns_b', qns_b ) ! non solar heat flux 530 CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b ) ! freshwater flux 531 ! NB: The 3D heat content due to qsr forcing (qsr_hc_b) is treated in traqsr 534 532 ! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6 535 533 IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN … … 566 564 ! ! ---------------------------------------- ! 567 565 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 568 CALL iom_put( "empmr" , emp 569 CALL iom_put( "empbmr" , emp_b 570 CALL iom_put( "saltflx", sfx )! downward salt flux (includes virtual salt flux beneath ice in linear free surface case)571 CALL iom_put( "fmmflx" , fmmflx )! Freezing-melting water flux572 CALL iom_put( "qt" , qns + qsr )! total heat flux573 CALL iom_put( "qns" , qns )! solar heat flux574 CALL iom_put( "qsr" , qsr )! solar heat flux566 CALL iom_put( "empmr" , emp - rnf ) ! upward water flux 567 CALL iom_put( "empbmr" , emp_b - rnf ) ! before upward water flux ( needed to recalculate the time evolution of ssh in offline ) 568 CALL iom_put( "saltflx", sfx ) ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case) 569 CALL iom_put( "fmmflx" , fmmflx ) ! Freezing-melting water flux 570 CALL iom_put( "qt" , qns + qsr ) ! total heat flux 571 CALL iom_put( "qns" , qns ) ! solar heat flux 572 CALL iom_put( "qsr" , qsr ) ! solar heat flux 575 573 IF( nn_ice > 0 .OR. ll_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 576 CALL iom_put( "taum" , taum )! wind stress module577 CALL iom_put( "wspd" , wndm )! wind speed module over free ocean or leads in presence of sea-ice578 CALL iom_put( "qrp" , qrp )! heat flux damping579 CALL iom_put( "erp" , erp )! freshwater flux damping574 CALL iom_put( "taum" , taum ) ! wind stress module 575 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice 576 CALL iom_put( "qrp" , qrp ) ! heat flux damping 577 CALL iom_put( "erp" , erp ) ! freshwater flux damping 580 578 ENDIF 581 579 ! 582 580 IF(sn_cfctl%l_prtctl) THEN ! print mean trends (used for debugging) 583 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )584 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask )585 CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask )586 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )587 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )588 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )581 CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask ) 582 CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf - : ', mask1=tmask ) 583 CALL prt_ctl(tab2d_1=(sfx-rnf) , clinfo1=' sfx-rnf - : ', mask1=tmask ) 584 CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask ) 585 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask ) 586 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk ) 589 587 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 ) 590 588 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/SBC/sbcrnf.F90
r14049 r14054 42 42 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread (ln_rnf_depth_ini =T) 43 43 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 44 LOGICAL 44 LOGICAL , PUBLIC :: ln_rnf_icb !: iceberg flux is specified in a file 45 45 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 46 46 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file … … 157 157 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 158 158 ! ! ---------------------------------------- ! 159 IF( ln_rstart .AND. & !* Restart: read in restart file 160 & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 159 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN !* Restart: read in restart file 161 160 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file', lrxios 162 CALL iom_get( numror, jpdom_auto, 'rnf_b' , rnf_b )! before runoff161 CALL iom_get( numror, jpdom_auto, 'rnf_b' , rnf_b ) ! before runoff 163 162 CALL iom_get( numror, jpdom_auto, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) ) ! before heat content of runoff 164 163 CALL iom_get( numror, jpdom_auto, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) ) ! before salinity content of runoff 165 ELSE 164 ELSE !* no restart: set from nit000 values 166 165 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' 167 166 rnf_b (:,: ) = rnf (:,: ) … … 176 175 & 'at it= ', kt,' date= ', ndastp 177 176 IF(lwp) WRITE(numout,*) '~~~~' 178 CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf)177 CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf ) 179 178 CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) ) 180 179 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/traatf.F90
r14049 r14054 117 117 IF( l_trdtra ) THEN 118 118 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 119 ztrdt(:,:, jpk) = 0._wp120 ztrds(:,:, jpk) = 0._wp119 ztrdt(:,:,:) = 0._wp 120 ztrds(:,:,:) = 0._wp 121 121 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 122 122 CALL trd_tra( kt, Kmm, Kaa, 'TRA', jp_tem, jptra_zdfp, ztrdt ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/traatf_qco.F90
r14049 r14054 1 MODULE traatf qco1 MODULE traatf_qco 2 2 !!====================================================================== 3 !! *** MODULE traatf qco ***3 !! *** MODULE traatf_qco *** 4 4 !! Ocean active tracers: Asselin time filtering for temperature and salinity 5 5 !!====================================================================== … … 45 45 USE prtctl ! Print control 46 46 USE timing ! Timing 47 #if defined key_agrif48 USE agrif_oce_interp49 #endif50 47 51 48 IMPLICIT NONE … … 149 146 ENDIF 150 147 ! 151 CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1. , pts(:,:,:,jp_sal,Kmm) , 'T', 1.)152 148 CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kmm) , 'T', 1._wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1._wp ) 149 ! 153 150 ENDIF 154 151 ! … … 370 367 371 368 !!====================================================================== 372 END MODULE traatf qco369 END MODULE traatf_qco -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/tramle.F90
r14049 r14054 20 20 USE lib_mpp ! MPP library 21 21 USE lbclnk ! lateral boundary condition / mpp link 22 23 ! where OSMOSIS_OBL is used with integrated FK 24 USE zdf_oce, ONLY : ln_zdfosm 25 USE zdfosm, ONLY : ln_osm_mle, hmle, dbdx_mle, dbdy_mle, mld_prof 22 26 23 27 IMPLICIT NONE … … 99 103 !!---------------------------------------------------------------------- 100 104 ! 101 ! !== MLD used for MLE ==! 102 ! ! compute from the 10m density to deal with the diurnal cycle 103 DO_2D( 1, 1, 1, 1 ) 104 inml_mle(ji,jj) = mbkt(ji,jj) + 1 ! init. to number of ocean w-level (T-level + 1) 105 END_2D 106 IF ( nla10 > 0 ) THEN ! avoid case where first level is thicker than 10m 107 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m) 108 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle ) inml_mle(ji,jj) = jk ! Mixed layer 105 ! 106 IF(ln_osm_mle.and.ln_zdfosm) THEN 107 ikmax = MIN( MAXVAL( mld_prof(:,:) ), jpkm1 ) ! max level of the computation 108 ! 109 ! 110 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 111 CASE ( 0 ) != min of the 2 neighbour MLDs 112 DO_2D( 1, 0, 1, 0 ) 113 zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) ) 114 zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) ) 115 END_2D 116 CASE ( 1 ) != average of the 2 neighbour MLDs 117 DO_2D( 1, 0, 1, 0 ) 118 zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 119 zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 120 END_2D 121 CASE ( 2 ) != max of the 2 neighbour MLDs 122 DO_2D( 1, 0, 1, 0 ) 123 zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) ) 124 zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) ) 125 END_2D 126 END SELECT 127 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 128 DO_2D( 1, 0, 1, 0 ) 129 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2u(ji,jj) & 130 & * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) & 131 & / ( MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) ) ) 132 ! 133 zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj) * e1v(ji,jj) & 134 & * dbdy_mle(ji,jj) * MIN( 111.e3_wp , e2v(ji,jj) ) & 135 & / ( MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) ) ) 136 END_2D 137 ! 138 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 139 DO_2D( 1, 0, 1, 0 ) 140 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2u(ji,jj) & 141 & * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) 142 ! 143 zpsim_v(ji,jj) = rc_f * zhv(ji,jj) * zhv(ji,jj) * e1v(ji,jj) & 144 & * dbdy_mle(ji,jj) * MIN( 111.e3_wp , e2v(ji,jj) ) 145 END_2D 146 ENDIF 147 148 ELSE !do not use osn_mle 149 ! !== MLD used for MLE ==! 150 ! ! compute from the 10m density to deal with the diurnal cycle 151 DO_2D( 1, 1, 1, 1 ) 152 inml_mle(ji,jj) = mbkt(ji,jj) + 1 ! init. to number of ocean w-level (T-level + 1) 153 END_2D 154 IF ( nla10 > 0 ) THEN ! avoid case where first level is thicker than 10m 155 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 (10m) 156 IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle ) inml_mle(ji,jj) = jk ! Mixed layer 157 END_3D 158 ENDIF 159 ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 ) ! max level of the computation 160 ! 161 ! 162 zmld(:,:) = 0._wp !== Horizontal shape of the MLE ==! 163 zbm (:,:) = 0._wp 164 zn2 (:,:) = 0._wp 165 DO_3D( 1, 1, 1, 1, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer 166 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 167 zmld(ji,jj) = zmld(ji,jj) + zc 168 zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0 169 zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 109 170 END_3D 110 ENDIF 111 ikmax = MIN( MAXVAL( inml_mle(:,:) ), jpkm1 ) ! max level of the computation 112 ! 113 ! 114 zmld(:,:) = 0._wp !== Horizontal shape of the MLE ==! 115 zbm (:,:) = 0._wp 116 zn2 (:,:) = 0._wp 117 DO_3D( 1, 1, 1, 1, 1, ikmax ) ! MLD and mean buoyancy and N2 over the mixed layer 118 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 119 zmld(ji,jj) = zmld(ji,jj) + zc 120 zbm (ji,jj) = zbm (ji,jj) + zc * (rho0 - rhop(ji,jj,jk) ) * r1_rho0 121 zn2 (ji,jj) = zn2 (ji,jj) + zc * (rn2(ji,jj,jk)+rn2(ji,jj,jk+1))*0.5_wp 122 END_3D 123 124 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 125 CASE ( 0 ) != min of the 2 neighbour MLDs 126 DO_2D( 1, 0, 1, 0 ) 127 zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 128 zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 171 172 SELECT CASE( nn_mld_uv ) ! MLD at u- & v-pts 173 CASE ( 0 ) != min of the 2 neighbour MLDs 174 DO_2D( 1, 0, 1, 0 ) 175 zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) ) 176 zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) ) 177 END_2D 178 CASE ( 1 ) != average of the 2 neighbour MLDs 179 DO_2D( 1, 0, 1, 0 ) 180 zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 181 zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 182 END_2D 183 CASE ( 2 ) != max of the 2 neighbour MLDs 184 DO_2D( 1, 0, 1, 0 ) 185 zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 186 zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 187 END_2D 188 END SELECT 189 ! ! convert density into buoyancy 190 DO_2D( 1, 1, 1, 1 ) 191 zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 129 192 END_2D 130 CASE ( 1 ) != average of the 2 neighbour MLDs 131 DO_2D( 1, 0, 1, 0 ) 132 zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp 133 zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp 134 END_2D 135 CASE ( 2 ) != max of the 2 neighbour MLDs 136 DO_2D( 1, 0, 1, 0 ) 137 zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) ) 138 zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) ) 139 END_2D 140 END SELECT 141 ! ! convert density into buoyancy 142 DO_2D( 1, 1, 1, 1 ) 143 zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) ) 144 END_2D 145 ! 146 ! 147 ! !== Magnitude of the MLE stream function ==! 148 ! 149 ! di[bm] Ds 150 ! Psi = Ce H^2 ---------------- e2u mu(z) where fu Lf = MAX( fu*rn_fl , (Db H)^1/2 ) 151 ! e1u Lf fu and the e2u for the "transport" 152 ! (not *e3u as divided by e3u at the end) 153 ! 154 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 155 DO_2D( 1, 0, 1, 0 ) 156 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 157 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) & 158 & / ( MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) ) ) 193 ! 194 ! 195 ! !== Magnitude of the MLE stream function ==! 196 ! 197 ! di[bm] Ds 198 ! Psi = Ce H^2 ---------------- e2u mu(z) where fu Lf = MAX( fu*rn_fl , (Db H)^1/2 ) 199 ! e1u Lf fu and the e2u for the "transport" 200 ! (not *e3u as divided by e3u at the end) 201 ! 202 IF( nn_mle == 0 ) THEN ! Fox-Kemper et al. 2010 formulation 203 DO_2D( 1, 0, 1, 0 ) 204 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 205 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) & 206 & / ( MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) ) ) 159 207 ! 160 zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj) * e1_e2v(ji,jj) &161 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) &162 & / ( MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) ) )163 END_2D164 !165 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)166 DO_2D( 1, 0, 1, 0 )167 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) &168 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )208 zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj) * e1_e2v(ji,jj) & 209 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) & 210 & / ( MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) ) ) 211 END_2D 212 ! 213 ELSEIF( nn_mle == 1 ) THEN ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat) 214 DO_2D( 1, 0, 1, 0 ) 215 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 216 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 169 217 ! 170 zpsim_v(ji,jj) = rc_f * zhv(ji,jj) * zhv(ji,jj) * e1_e2v(ji,jj) & 171 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 172 END_2D 173 ENDIF 174 ! 175 IF( nn_conv == 1 ) THEN ! No MLE in case of convection 176 DO_2D( 1, 0, 1, 0 ) 177 IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp ) zpsim_u(ji,jj) = 0._wp 178 IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp ) zpsim_v(ji,jj) = 0._wp 179 END_2D 180 ENDIF 181 ! 182 ! !== structure function value at uw- and vw-points ==! 183 DO_2D( 1, 0, 1, 0 ) 184 zhu(ji,jj) = 1._wp / zhu(ji,jj) ! hu --> 1/hu 185 zhv(ji,jj) = 1._wp / zhv(ji,jj) 186 END_2D 187 ! 188 zpsi_uw(:,:,:) = 0._wp 189 zpsi_vw(:,:,:) = 0._wp 190 ! 218 zpsim_v(ji,jj) = rc_f * zhv(ji,jj) * zhv(ji,jj) * e1_e2v(ji,jj) & 219 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 220 END_2D 221 ENDIF 222 ! 223 IF( nn_conv == 1 ) THEN ! No MLE in case of convection 224 DO_2D( 1, 0, 1, 0 ) 225 IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp ) zpsim_u(ji,jj) = 0._wp 226 IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp ) zpsim_v(ji,jj) = 0._wp 227 END_2D 228 ENDIF 229 ! 230 ENDIF ! end of ln_osm_mle conditional 231 ! !== structure function value at uw- and vw-points ==! 232 DO_2D( 1, 0, 1, 0 ) 233 zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall) ! hu --> 1/hu 234 zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall) 235 END_2D 236 ! 237 zpsi_uw(:,:,:) = 0._wp 238 zpsi_vw(:,:,:) = 0._wp 239 ! 191 240 DO_3D( 1, 0, 1, 0, 2, ikmax ) ! start from 2 : surface value = 0 192 241 zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj) … … 220 269 ENDIF 221 270 ! 222 DO_2D( 0, 0, 0, 0 ) 223 zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 224 END_2D 271 IF (ln_osm_mle.and.ln_zdfosm) THEN 272 DO_2D( 0, 0, 0, 0 ) 273 zLf_NH(ji,jj) = SQRT( rb_c * hmle(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 274 END_2D 275 ELSE 276 DO_2D( 0, 0, 0, 0 ) 277 zLf_NH(ji,jj) = SQRT( rb_c * zmld(ji,jj) ) * r1_ft(ji,jj) ! Lf = N H / f 278 END_2D 279 ENDIF 225 280 ! 226 281 ! divide by cross distance to give streamfunction with dimensions m^2/s … … 239 294 ! 240 295 END SUBROUTINE tra_mle_trp 241 242 296 243 297 SUBROUTINE tra_mle_init … … 301 355 IF( ierr /= 0 ) CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 302 356 z1_t2 = 1._wp / ( rn_time * rn_time ) 303 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls) ! "coriolis+ time^-1" at u- & v-points357 DO_2D( 0, 1, 0, 1 ) ! "coriolis+ time^-1" at u- & v-points 304 358 zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 305 359 zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp … … 307 361 rfv(ji,jj) = SQRT( zfv * zfv + z1_t2 ) 308 362 END_2D 309 IF (nn_hls.EQ.1)CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp )363 CALL lbc_lnk_multi( 'tramle', rfu, 'U', 1.0_wp , rfv, 'V', 1.0_wp ) 310 364 ! 311 365 ELSEIF( nn_mle == 1 ) THEN ! MLE array allocation & initialisation -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/traqsr.F90
r14049 r14054 144 144 145 145 IF( kt == nit000 ) THEN !== 1st time step ==! 146 IF( ln_rstart .AND. iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 .AND..NOT.l_1st_euler ) THEN ! read in restart146 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN ! read in restart 147 147 z1_2 = 0.5_wp 148 148 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile … … 150 150 CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b ) ! before heat content trend due to Qsr flux 151 151 ENDIF 152 ELSE ! No restart or restart not found: Euler forward time stepping152 ELSE ! No restart or Euler forward at 1st time step 153 153 z1_2 = 1._wp 154 154 DO_3D( isj, iej, isi, iei, 1, jpk ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRA/trasbc.F90
r14049 r14054 72 72 !! - send trends to trdtra module for further diagnostics(l_trdtra=T) 73 73 !!---------------------------------------------------------------------- 74 INTEGER, INTENT(in ) :: kt ! ocean time-step index75 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation74 INTEGER, INTENT(in ) :: kt ! ocean time-step index 75 INTEGER, INTENT(in ) :: Kmm, Krhs ! time level indices 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer Eq. 77 77 ! 78 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 117 117 ! !== Set before sbc tracer content fields ==! 118 118 IF( kt == nit000 ) THEN !* 1st time-step 119 IF( ln_rstart .AND. & ! Restart: read in restart file 120 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 119 IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN ! Restart: read in restart file 121 120 zfact = 0.5_wp 122 121 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile … … 126 125 CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 127 126 ENDIF 128 ELSE ! No restart or restart not found: Euler forward time stepping127 ELSE ! No restart or restart not found: Euler forward time stepping 129 128 zfact = 1._wp 130 129 DO_2D( isj, iej, isi, iei ) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/TRD/trd_oce.F90
r10068 r14054 33 33 # endif 34 34 ! !!!* Active tracers trends indexes 35 INTEGER, PUBLIC, PARAMETER :: jptot_tra = 2 0!: Total trend nb: change it when adding/removing one indice below35 INTEGER, PUBLIC, PARAMETER :: jptot_tra = 21 !: Total trend nb: change it when adding/removing one indice below 36 36 ! =============== ! 37 37 INTEGER, PUBLIC, PARAMETER :: jptra_xad = 1 !: x- horizontal advection … … 46 46 INTEGER, PUBLIC, PARAMETER :: jptra_bbc = 10 !: Bottom Boundary Condition (geoth. heating) 47 47 INTEGER, PUBLIC, PARAMETER :: jptra_bbl = 11 !: Bottom Boundary Layer (diffusive and/or advective) 48 INTEGER, PUBLIC, PARAMETER :: jptra_osm = 21 !: Non-local terms from OSMOSIS OBL model 48 49 INTEGER, PUBLIC, PARAMETER :: jptra_npc = 12 !: non-penetrative convection treatment 49 50 INTEGER, PUBLIC, PARAMETER :: jptra_dmp = 13 !: internal restoring (damping) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/USR/usrdef_istate.F90
r13497 r14054 7 7 !! User defined : set the initial state of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 22 23 PRIVATE 23 24 24 PUBLIC usr_def_istate ! called in istate.F90 25 PUBLIC usr_def_istate ! called in istate.F90 26 PUBLIC usr_def_istate_ssh ! called by domqco.F90 25 27 26 28 !! * Substitutions … … 33 35 CONTAINS 34 36 35 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)37 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 36 38 !!---------------------------------------------------------------------- 37 39 !! *** ROUTINE usr_def_istate *** … … 48 50 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 49 51 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 50 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height51 52 ! 52 53 INTEGER :: ji, jj, jk ! dummy loop indices … … 59 60 pu (:,:,:) = 0._wp ! ocean at rest 60 61 pv (:,:,:) = 0._wp 61 pssh(:,:) = 0._wp62 62 ! 63 63 DO_3D( 1, 1, 1, 1, 1, jpk ) ! horizontally uniform T & S profiles … … 80 80 END SUBROUTINE usr_def_istate 81 81 82 83 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 84 !!---------------------------------------------------------------------- 85 !! *** ROUTINE usr_def_istate_ssh *** 86 !! 87 !! ** Purpose : Initialization of ssh 88 !! 89 !! ** Method : Set ssh as null, ptmask is required for test cases 90 !!---------------------------------------------------------------------- 91 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 92 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 93 !!---------------------------------------------------------------------- 94 ! 95 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : GYRE configuration, analytical definition of initial state' 97 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~ Ocean at rest, ssh is zero' 98 ! 99 ! Sea level: 100 pssh(:,:) = 0._wp 101 ! 102 END SUBROUTINE usr_def_istate_ssh 103 82 104 !!====================================================================== 83 105 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ZDF/zdfddm.F90
r13497 r14054 31 31 !! * Substitutions 32 32 # include "do_loop_substitute.h90" 33 # include "domzgr_substitute.h90" 33 34 !!---------------------------------------------------------------------- 34 35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ZDF/zdfosm.F90
r14049 r14054 25 25 !! (12) Replace zwstrl with zvstr in calculation of eddy viscosity. 26 26 !! 27/09/2017 (13) Calculate Stokes drift and Stokes penetration depth from wave information 27 !! (14) B ouyancy flux due to entrainment changed to include contribution from shear turbulence (for testing commented out).27 !! (14) Buoyancy flux due to entrainment changed to include contribution from shear turbulence. 28 28 !! 28/09/2017 (15) Calculation of Stokes drift moved into separate do-loops to allow for different options for the determining the Stokes drift to be added. 29 29 !! (16) Calculation of Stokes drift from windspeed for PM spectrum (for testing, commented out) 30 30 !! (17) Modification to Langmuir velocity scale to include effects due to the Stokes penetration depth (for testing, commented out) 31 !! ??/??/2018 (18) Revision to code structure, selected using key_osmldpth1. Inline code moved into subroutines. Changes to physics made, 32 !! (a) Pycnocline temperature and salinity profies changed for unstable layers 33 !! (b) The stable OSBL depth parametrization changed. 34 !! 16/05/2019 (19) Fox-Kemper parametrization of restratification through mixed layer eddies added to revised code. 35 !! 23/05/19 (20) Old code where key_osmldpth1` is *not* set removed, together with the key key_osmldpth1 31 36 !!---------------------------------------------------------------------- 32 37 … … 40 45 !! trc_osm : compute and add to the passive tracer trend the non-local flux (TBD) 41 46 !! dyn_osm : compute and add to u & v trensd the non-local flux 47 !! 48 !! Subroutines in revised code. 42 49 !!---------------------------------------------------------------------- 43 50 USE oce ! ocean dynamics and active tracers … … 69 76 PUBLIC tra_osm ! routine called by step.F90 70 77 PUBLIC trc_osm ! routine called by trcstp.F90 71 PUBLIC dyn_osm ! routine called by 'step.F90' 78 PUBLIC dyn_osm ! routine called by step.F90 79 80 PUBLIC ln_osm_mle ! logical needed by tra_mle_init in tramle.F90 72 81 73 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghamu !: non-local u-momentum flux … … 77 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etmean !: averaging operator for avt 78 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbl !: boundary layer depth 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbli !: intial boundary layer depth for stable blayer 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh ! depth of pycnocline 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hml ! ML depth 80 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dstokes !: penetration depth of the Stokes drift. 91 92 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_ft ! inverse of the modified Coriolis parameter at t-pts 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmle ! Depth of layer affexted by mixed layer eddies in Fox-Kemper parametrization 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dbdx_mle ! zonal buoyancy gradient in ML 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dbdy_mle ! meridional buoyancy gradient in ML 96 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_prof ! level of base of MLE layer. 81 97 82 98 ! !!** Namelist namzdf_osm ** 83 99 LOGICAL :: ln_use_osm_la ! Use namelist rn_osm_la 100 101 LOGICAL :: ln_osm_mle !: flag to activate the Mixed Layer Eddy (MLE) parameterisation 102 84 103 REAL(wp) :: rn_osm_la ! Turbulent Langmuir number 85 104 REAL(wp) :: rn_osm_dstokes ! Depth scale of Stokes drift 105 REAL(wp) :: rn_zdfosm_adjust_sd = 1.0 ! factor to reduce Stokes drift by 106 REAL(wp) :: rn_osm_hblfrac = 0.1! for nn_osm_wave = 3/4 specify fraction in top of hbl 107 LOGICAL :: ln_zdfosm_ice_shelter ! flag to activate ice sheltering 86 108 REAL(wp) :: rn_osm_hbl0 = 10._wp ! Initial value of hbl for 1D runs 87 109 INTEGER :: nn_ave ! = 0/1 flag for horizontal average on avt 88 110 INTEGER :: nn_osm_wave = 0 ! = 0/1/2 flag for getting stokes drift from La# / PM wind-waves/Inputs into sbcwave 111 INTEGER :: nn_osm_SD_reduce ! = 0/1/2 flag for getting effective stokes drift from surface value 89 112 LOGICAL :: ln_dia_osm ! Use namelist rn_osm_la 90 113 … … 96 119 REAL(wp) :: rn_difconv = 1._wp ! diffusivity when unstable below BL (m2/s) 97 120 121 ! OSMOSIS mixed layer eddy parametrization constants 122 INTEGER :: nn_osm_mle ! = 0/1 flag for horizontal average on avt 123 REAL(wp) :: rn_osm_mle_ce ! MLE coefficient 124 ! ! parameters used in nn_osm_mle = 0 case 125 REAL(wp) :: rn_osm_mle_lf ! typical scale of mixed layer front 126 REAL(wp) :: rn_osm_mle_time ! time scale for mixing momentum across the mixed layer 127 ! ! parameters used in nn_osm_mle = 1 case 128 REAL(wp) :: rn_osm_mle_lat ! reference latitude for a 5 km scale of ML front 129 LOGICAL :: ln_osm_hmle_limit ! If true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 130 REAL(wp) :: rn_osm_hmle_limit ! If ln_osm_hmle_limit true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 131 REAL(wp) :: rn_osm_mle_rho_c ! Density criterion for definition of MLD used by FK 132 REAL(wp) :: r5_21 = 5.e0 / 21.e0 ! factor used in mle streamfunction computation 133 REAL(wp) :: rb_c ! ML buoyancy criteria = g rho_c /rho0 where rho_c is defined in zdfmld 134 REAL(wp) :: rc_f ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_osm_mle=1 case 135 REAL(wp) :: rn_osm_mle_thresh ! Threshold buoyancy for deepening of MLE layer below OSBL base. 136 REAL(wp) :: rn_osm_bl_thresh ! Threshold buoyancy for deepening of OSBL base. 137 REAL(wp) :: rn_osm_mle_tau ! Adjustment timescale for MLE. 138 139 98 140 ! !!! ** General constants ** 99 REAL(wp) :: epsln = 1.0e-20_wp ! a small positive number 141 REAL(wp) :: epsln = 1.0e-20_wp ! a small positive number to ensure no div by zero 142 REAL(wp) :: depth_tol = 1.0e-6_wp ! a small-ish positive number to give a hbl slightly shallower than gdepw 100 143 REAL(wp) :: pthird = 1._wp/3._wp ! 1/3 101 144 REAL(wp) :: p2third = 2._wp/3._wp ! 2/3 … … 118 161 !! *** FUNCTION zdf_osm_alloc *** 119 162 !!---------------------------------------------------------------------- 120 ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk), ghams(jpi,jpj,jpk), & 121 & hbl(jpi,jpj) , hbli(jpi,jpj) , dstokes(jpi, jpj) , & 122 & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 163 ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & 164 & hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 165 & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 166 167 ALLOCATE( hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), & 168 & mld_prof(jpi,jpj), STAT= zdf_osm_alloc ) 169 170 CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 123 171 IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 124 CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 172 125 173 END FUNCTION zdf_osm_alloc 126 174 … … 166 214 !! 167 215 INTEGER :: ji, jj, jk ! dummy loop indices 216 217 INTEGER :: jl ! dummy loop indices 218 168 219 INTEGER :: ikbot, jkmax, jkm1, jkp2 ! 169 220 … … 196 247 REAL(wp), DIMENSION(jpi,jpj) :: zwbav ! Buoyancy flux - bl average 197 248 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent ! Buoyancy entrainment flux 249 REAL(wp), DIMENSION(jpi,jpj) :: zwb_min 250 251 252 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk_b ! MLE buoyancy flux averaged over OSBL 253 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk ! max MLE buoyancy flux 254 REAL(wp), DIMENSION(jpi,jpj) :: zdiff_mle ! extra MLE vertical diff 255 REAL(wp), DIMENSION(jpi,jpj) :: zvel_mle ! velocity scale for dhdt with stable ML and FK 256 198 257 REAL(wp), DIMENSION(jpi,jpj) :: zustke ! Surface Stokes drift 199 258 REAL(wp), DIMENSION(jpi,jpj) :: zla ! Trubulent Langmuir number … … 201 260 REAL(wp), DIMENSION(jpi,jpj) :: zsin_wind ! Sin angle of surface stress 202 261 REAL(wp), DIMENSION(jpi,jpj) :: zhol ! Stability parameter for boundary layer 203 LOGICAL, DIMENSION(:,:), ALLOCATABLE :: lconv ! unstable/stable bl 262 LOGICAL, DIMENSION(jpi,jpj) :: lconv ! unstable/stable bl 263 LOGICAL, DIMENSION(jpi,jpj) :: lshear ! Shear layers 264 LOGICAL, DIMENSION(jpi,jpj) :: lpyc ! OSBL pycnocline present 265 LOGICAL, DIMENSION(jpi,jpj) :: lflux ! surface flux extends below OSBL into MLE layer. 266 LOGICAL, DIMENSION(jpi,jpj) :: lmle ! MLE layer increases in hickness. 204 267 205 268 ! mixed-layer variables … … 207 270 INTEGER, DIMENSION(jpi,jpj) :: ibld ! level of boundary layer base 208 271 INTEGER, DIMENSION(jpi,jpj) :: imld ! level of mixed-layer depth (pycnocline top) 272 INTEGER, DIMENSION(jpi,jpj) :: jp_ext, jp_ext_mle ! offset for external level 273 INTEGER, DIMENSION(jpi, jpj) :: j_ddh ! Type of shear layer 209 274 210 275 REAL(wp) :: ztgrad,zsgrad,zbgrad ! Temporary variables used to calculate pycnocline gradients … … 213 278 REAL(wp), DIMENSION(jpi,jpj) :: zhbl ! bl depth - grid 214 279 REAL(wp), DIMENSION(jpi,jpj) :: zhml ! ml depth - grid 280 281 REAL(wp), DIMENSION(jpi,jpj) :: zhmle ! MLE depth - grid 282 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! ML depth on grid 283 215 284 REAL(wp), DIMENSION(jpi,jpj) :: zdh ! pycnocline depth - grid 216 285 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! BL depth tendency 217 REAL(wp), DIMENSION(jpi,jpj) :: zt_bl,zs_bl,zu_bl,zv_bl,zrh_bl ! averages over the depth of the blayer 218 REAL(wp), DIMENSION(jpi,jpj) :: zt_ml,zs_ml,zu_ml,zv_ml,zrh_ml ! averages over the depth of the mixed layer 219 REAL(wp), DIMENSION(jpi,jpj) :: zdt_bl,zds_bl,zdu_bl,zdv_bl,zdrh_bl,zdb_bl ! difference between blayer average and parameter at base of blayer 220 REAL(wp), DIMENSION(jpi,jpj) :: zdt_ml,zds_ml,zdu_ml,zdv_ml,zdrh_ml,zdb_ml ! difference between mixed layer average and parameter at base of blayer 221 REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 222 REAL(wp), DIMENSION(jpi,jpj) :: zuw_bse,zvw_bse ! momentum fluxes at the top of the pycnocline 286 REAL(wp), DIMENSION(jpi,jpj) :: zddhdt ! correction to dhdt due to internal structure. 287 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_bl_ext,zdsdz_bl_ext,zdbdz_bl_ext ! external temperature/salinity and buoyancy gradients 288 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_mle_ext,zdsdz_mle_ext,zdbdz_mle_ext ! external temperature/salinity and buoyancy gradients 289 REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy ! horizontal gradients for Fox-Kemper parametrization. 290 291 REAL(wp), DIMENSION(jpi,jpj) :: zt_bl,zs_bl,zu_bl,zv_bl,zb_bl ! averages over the depth of the blayer 292 REAL(wp), DIMENSION(jpi,jpj) :: zt_ml,zs_ml,zu_ml,zv_ml,zb_ml ! averages over the depth of the mixed layer 293 REAL(wp), DIMENSION(jpi,jpj) :: zt_mle,zs_mle,zu_mle,zv_mle,zb_mle ! averages over the depth of the MLE layer 294 REAL(wp), DIMENSION(jpi,jpj) :: zdt_bl,zds_bl,zdu_bl,zdv_bl,zdb_bl ! difference between blayer average and parameter at base of blayer 295 REAL(wp), DIMENSION(jpi,jpj) :: zdt_ml,zds_ml,zdu_ml,zdv_ml,zdb_ml ! difference between mixed layer average and parameter at base of blayer 296 REAL(wp), DIMENSION(jpi,jpj) :: zdt_mle,zds_mle,zdu_mle,zdv_mle,zdb_mle ! difference between MLE layer average and parameter at base of blayer 297 ! REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 298 REAL(wp) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 299 REAL(wp) :: zuw_bse,zvw_bse ! momentum fluxes at the top of the pycnocline 223 300 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz_pyc ! parametrized gradient of temperature in pycnocline 224 301 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdsdz_pyc ! parametrised gradient of salinity in pycnocline … … 226 303 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz_pyc ! u-shear across the pycnocline 227 304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdvdz_pyc ! v-shear across the pycnocline 228 305 REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. 229 306 ! Flux-gradient relationship variables 307 REAL(wp), DIMENSION(jpi, jpj) :: zshear, zri_i ! Shear production and interfacial richardon number. 230 308 231 309 REAL(wp) :: zl_c,zl_l,zl_eps ! Used to calculate turbulence length scale. 232 310 233 REAL(wp) , DIMENSION(jpi,jpj) :: zdifml_sc,zvisml_sc,zdifpyc_sc,zvispyc_sc,zbeta_d_sc,zbeta_v_sc ! Scales for eddy diffusivity/viscosity311 REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline. 234 312 REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_1,zsc_ws_1 ! Temporary scales used to calculate scalar non-gradient terms. 313 REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_pyc, zsc_ws_pyc ! Scales for pycnocline transport term/ 235 314 REAL(wp), DIMENSION(jpi,jpj) :: zsc_uw_1,zsc_uw_2,zsc_vw_1,zsc_vw_2 ! Temporary scales for non-gradient momentum flux terms. 236 315 REAL(wp), DIMENSION(jpi,jpj) :: zhbl_t ! holds boundary layer depth updated by full timestep … … 243 322 ! Temporary variables 244 323 INTEGER :: inhml 245 INTEGER :: i_lconv_alloc246 324 REAL(wp) :: znd,znd_d,zznd_ml,zznd_pyc,zznd_d ! temporary non-dimensional depths used in various routines 247 325 REAL(wp) :: ztemp, zari, zpert, zzdhdt, zdb ! temporary variables 248 326 REAL(wp) :: zthick, zz0, zz1 ! temporary variables 249 327 REAL(wp) :: zvel_max, zhbl_s ! temporary variables 250 REAL(wp) :: zfac 328 REAL(wp) :: zfac, ztmp ! temporary variable 251 329 REAL(wp) :: zus_x, zus_y ! temporary Stokes drift 252 330 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity 253 331 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdiffut ! t-diffusivity 332 REAL(wp), DIMENSION(jpi,jpj) :: zalpha_pyc 333 REAL(wp), DIMENSION(jpi,jpj) :: ztau_sc_u ! dissipation timescale at baes of WML. 334 REAL(wp) :: zdelta_pyc, zwt_pyc_sc_1, zws_pyc_sc_1, zzeta_pyc 335 REAL(wp) :: zbuoy_pyc_sc, zomega, zvw_max 336 INTEGER :: ibld_ext=0 ! does not have to be zero for modified scheme 337 REAL(wp) :: zgamma_b_nd, zgamma_b, zdhoh, ztau 338 REAL(wp) :: zzeta_s = 0._wp 339 REAL(wp) :: zzeta_v = 0.46 340 REAL(wp) :: zabsstke 341 REAL(wp) :: zsqrtpi, z_two_thirds, zproportion, ztransp, zthickness 342 REAL(wp) :: z2k_times_thickness, zsqrt_depth, zexp_depth, zdstokes0, zf, zexperfc 254 343 255 344 ! For debugging … … 257 346 !!-------------------------------------------------------------------- 258 347 ! 259 ALLOCATE( lconv(jpi,jpj), STAT= i_lconv_alloc )260 IF( i_lconv_alloc /= 0 ) CALL ctl_warn('zdf_osm: failed to allocate lconv')261 262 348 ibld(:,:) = 0 ; imld(:,:) = 0 263 349 zrad0(:,:) = 0._wp ; zradh(:,:) = 0._wp ; zradav(:,:) = 0._wp ; zustar(:,:) = 0._wp … … 267 353 zustke(:,:) = 0._wp ; zla(:,:) = 0._wp ; zcos_wind(:,:) = 0._wp ; zsin_wind(:,:) = 0._wp 268 354 zhol(:,:) = 0._wp 269 lconv(:,:) = .FALSE. 355 lconv(:,:) = .FALSE.; lpyc(:,:) = .FALSE. ; lflux(:,:) = .FALSE. ; lmle(:,:) = .FALSE. 270 356 ! mixed layer 271 357 ! no initialization of zhbl or zhml (or zdh?) 272 358 zhbl(:,:) = 1._wp ; zhml(:,:) = 1._wp ; zdh(:,:) = 1._wp ; zdhdt(:,:) = 0._wp 273 zt_bl(:,:) = 0._wp ; zs_bl(:,:) = 0._wp ; zu_bl(:,:) = 0._wp ; zv_bl(:,:) = 0._wp 274 zrh_bl(:,:) = 0._wp ; zt_ml(:,:) = 0._wp ; zs_ml(:,:) = 0._wp ; zu_ml(:,:) = 0._wp 275 zv_ml(:,:) = 0._wp ; zrh_ml(:,:) = 0._wp ; zdt_bl(:,:) = 0._wp ; zds_bl(:,:) = 0._wp 276 zdu_bl(:,:) = 0._wp ; zdv_bl(:,:) = 0._wp ; zdrh_bl(:,:) = 0._wp ; zdb_bl(:,:) = 0._wp 359 zt_bl(:,:) = 0._wp ; zs_bl(:,:) = 0._wp ; zu_bl(:,:) = 0._wp 360 zv_bl(:,:) = 0._wp ; zb_bl(:,:) = 0._wp 361 zt_ml(:,:) = 0._wp ; zs_ml(:,:) = 0._wp ; zu_ml(:,:) = 0._wp 362 zt_mle(:,:) = 0._wp ; zs_mle(:,:) = 0._wp ; zu_mle(:,:) = 0._wp 363 zb_mle(:,:) = 0._wp 364 zv_ml(:,:) = 0._wp ; zdt_bl(:,:) = 0._wp ; zds_bl(:,:) = 0._wp 365 zdu_bl(:,:) = 0._wp ; zdv_bl(:,:) = 0._wp ; zdb_bl(:,:) = 0._wp 277 366 zdt_ml(:,:) = 0._wp ; zds_ml(:,:) = 0._wp ; zdu_ml(:,:) = 0._wp ; zdv_ml(:,:) = 0._wp 278 zdrh_ml(:,:) = 0._wp ; zdb_ml(:,:) = 0._wp ; zwth_ent(:,:) = 0._wp ; zws_ent(:,:) = 0._wp 279 zuw_bse(:,:) = 0._wp ; zvw_bse(:,:) = 0._wp 367 zdb_ml(:,:) = 0._wp 368 zdt_mle(:,:) = 0._wp ; zds_mle(:,:) = 0._wp ; zdu_mle(:,:) = 0._wp 369 zdv_mle(:,:) = 0._wp ; zdb_mle(:,:) = 0._wp 370 zwth_ent = 0._wp ; zws_ent = 0._wp 280 371 ! 281 372 zdtdz_pyc(:,:,:) = 0._wp ; zdsdz_pyc(:,:,:) = 0._wp ; zdbdz_pyc(:,:,:) = 0._wp 282 373 zdudz_pyc(:,:,:) = 0._wp ; zdvdz_pyc(:,:,:) = 0._wp 283 374 ! 375 zdtdz_bl_ext(:,:) = 0._wp ; zdsdz_bl_ext(:,:) = 0._wp ; zdbdz_bl_ext(:,:) = 0._wp 376 377 IF ( ln_osm_mle ) THEN ! only initialise arrays if needed 378 zdtdx(:,:) = 0._wp ; zdtdy(:,:) = 0._wp ; zdsdx(:,:) = 0._wp 379 zdsdy(:,:) = 0._wp ; dbdx_mle(:,:) = 0._wp ; dbdy_mle(:,:) = 0._wp 380 zwb_fk(:,:) = 0._wp ; zvel_mle(:,:) = 0._wp; zdiff_mle(:,:) = 0._wp 381 zhmle(:,:) = 0._wp ; zmld(:,:) = 0._wp 382 ENDIF 383 zwb_fk_b(:,:) = 0._wp ! must be initialised even with ln_osm_mle=F as used in zdf_osm_calculate_dhdt 384 284 385 ! Flux-Gradient arrays. 285 zdifml_sc(:,:) = 0._wp ; zvisml_sc(:,:) = 0._wp ; zdifpyc_sc(:,:) = 0._wp286 zvispyc_sc(:,:) = 0._wp ; zbeta_d_sc(:,:) = 0._wp ; zbeta_v_sc(:,:) = 0._wp287 386 zsc_wth_1(:,:) = 0._wp ; zsc_ws_1(:,:) = 0._wp ; zsc_uw_1(:,:) = 0._wp 288 387 zsc_uw_2(:,:) = 0._wp ; zsc_vw_1(:,:) = 0._wp ; zsc_vw_2(:,:) = 0._wp … … 292 391 ghams(:,:,:) = 0._wp ; ghamu(:,:,:) = 0._wp ; ghamv(:,:,:) = 0._wp 293 392 393 zddhdt(:,:) = 0._wp 294 394 ! hbl = MAX(hbl,epsln) 295 395 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 326 426 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - grav * zbeta * zwsav(ji,jj) 327 427 ! Surface upward velocity fluxes 328 zuw0(ji,jj) = - utau(ji,jj) * r1_rho0 * tmask(ji,jj,1)329 zvw0(ji,jj) = - vtau(ji,jj) * r1_rho0 * tmask(ji,jj,1)428 zuw0(ji,jj) = - 0.5 * (utau(ji-1,jj) + utau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) 429 zvw0(ji,jj) = - 0.5 * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rho0 * tmask(ji,jj,1) 330 430 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 331 431 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) … … 340 440 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 341 441 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 442 ! Linearly 342 443 zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 343 ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init444 dstokes(ji,jj) = rn_osm_dstokes 344 445 END_2D 345 446 ! Assume Pierson-Moskovitz wind-wave spectrum … … 347 448 DO_2D( 0, 0, 0, 0 ) 348 449 ! Use wind speed wndm included in sbc_oce module 349 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 )350 dstokes(ji,jj) = 0.12 * wndm(ji,jj)**2 / grav450 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 451 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 351 452 END_2D 352 453 ! Use ECMWF wave fields as output from SBCWAVE 353 454 CASE(2) 354 455 zfac = 2.0_wp * rpi / 16.0_wp 456 355 457 DO_2D( 0, 0, 0, 0 ) 356 ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas. 357 ! The coefficient 0.8 gives La=0.3 in this situation. 358 ! It could represent the effects of the spread of wave directions 359 ! around the mean wind. The effect of this adjustment needs to be tested. 360 zustke(ji,jj) = MAX ( 1.0 * ( zcos_wind(ji,jj) * ut0sd(ji,jj ) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), & 361 & zustar(ji,jj) / ( 0.45 * 0.45 ) ) 362 dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zustke(ji,jj)*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes ! 458 IF (hsw(ji,jj) > 1.e-4) THEN 459 ! Use wave fields 460 zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2) 461 zustke(ji,jj) = MAX ( ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), 1.0e-8) 462 dstokes(ji,jj) = MAX (zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke * wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) 463 ELSE 464 ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run) 465 ! .. so default to Pierson-Moskowitz 466 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 467 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 468 END IF 469 END_2D 470 END SELECT 471 472 IF (ln_zdfosm_ice_shelter) THEN 473 ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 474 DO_2D( 0, 0, 0, 0 ) 475 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 476 dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) 477 END_2D 478 END IF 479 480 SELECT CASE (nn_osm_SD_reduce) 481 ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van Roekel (2012) or Grant (2020). 482 CASE(0) 483 ! The Langmur number from the ECMWF model (or from PM) appears to give La<0.3 for wind-driven seas. 484 ! The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3 in this situation. 485 ! It could represent the effects of the spread of wave directions 486 ! around the mean wind. The effect of this adjustment needs to be tested. 487 IF(nn_osm_wave > 0) THEN 488 zustke(2:jpim1,2:jpjm1) = rn_zdfosm_adjust_sd * zustke(2:jpim1,2:jpjm1) 489 END IF 490 CASE(1) 491 ! van Roekel (2012): consider average SD over top 10% of boundary layer 492 ! assumes approximate depth profile of SD from Breivik (2016) 493 zsqrtpi = SQRT(rpi) 494 z_two_thirds = 2.0_wp / 3.0_wp 495 496 DO_2D( 0, 0, 0, 0 ) 497 zthickness = rn_osm_hblfrac*hbl(ji,jj) 498 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 499 zsqrt_depth = SQRT(z2k_times_thickness) 500 zexp_depth = EXP(-z2k_times_thickness) 501 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - zexp_depth & 502 & - z_two_thirds * ( zsqrtpi*zsqrt_depth*z2k_times_thickness * ERFC(zsqrt_depth) & 503 & + 1.0_wp - (1.0_wp + z2k_times_thickness)*zexp_depth ) ) / z2k_times_thickness 504 505 END_2D 506 CASE(2) 507 ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer 508 ! assumes approximate depth profile of SD from Breivik (2016) 509 zsqrtpi = SQRT(rpi) 510 511 DO_2D( 0, 0, 0, 0 ) 512 zthickness = rn_osm_hblfrac*hbl(ji,jj) 513 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 514 515 IF(z2k_times_thickness < 50._wp) THEN 516 zsqrt_depth = SQRT(z2k_times_thickness) 517 zexperfc = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP(z2k_times_thickness) 518 ELSE 519 ! asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large z2k_times_thickness 520 ! See Abramowitz and Stegun, Eq. 7.1.23 521 ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness) + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3) 522 zexperfc = ((- 1.875_wp/z2k_times_thickness + 0.75_wp)/z2k_times_thickness - 0.5_wp)/z2k_times_thickness + 1.0_wp 523 END IF 524 zf = z2k_times_thickness*(1.0_wp/zexperfc - 1.0_wp) 525 dstokes(ji,jj) = 5.97 * zf * dstokes(ji,jj) 526 zustke(ji,jj) = zustke(ji,jj) * EXP(z2k_times_thickness * ( 1.0_wp / (2. * zf) - 1.0_wp )) * ( 1.0_wp - zexperfc) 363 527 END_2D 364 528 END SELECT … … 369 533 ! Langmuir velocity scale (zwstrl), at T-point 370 534 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 371 ! Modify zwstrl to allow for small and large values of dstokes/hbl. 372 ! Intended as a possible test. Doesn't affect LES results for entrainment, 373 ! but hasn't been shown to be correct as dstokes/h becomes large or small. 374 zwstrl(ji,jj) = zwstrl(ji,jj) * & 375 & (1.12 * ( 1.0 - ( 1.0 - EXP( -hbl(ji,jj) / dstokes(ji,jj) ) ) * dstokes(ji,jj) / hbl(ji,jj) ))**pthird * & 376 & ( 1.0 - EXP( -15.0 * dstokes(ji,jj) / hbl(ji,jj) )) 377 ! define La this way so effects of Stokes penetration depth on velocity scale are included 378 zla(ji,jj) = SQRT ( zustar(ji,jj) / zwstrl(ji,jj) )**3 535 zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2) 536 IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj)) 379 537 ! Velocity scale that tends to zustar for large Langmuir numbers 380 538 zvstr(ji,jj) = ( zwstrl(ji,jj)**3 + & … … 383 541 ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 384 542 ! Note zustke and zwstrl are not amended. 385 IF ( zla(ji,jj) >= 0.45 ) zla(ji,jj) = 0.45386 543 ! 387 544 ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv … … 389 546 zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 390 547 zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 391 lconv(ji,jj) = .TRUE. 392 ELSE 548 ELSE 393 549 zhol(ji,jj) = -hbl(ji,jj) * 2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3 + epsln ) 394 lconv(ji,jj) = .FALSE.395 550 ENDIF 396 551 END_2D … … 399 554 ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 400 555 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 401 ! BL must be always 2 levels deep. 402 hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,3,Kmm) ) 403 ibld(:,:) = 3 404 DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 556 ! BL must be always 4 levels deep. 557 ! For calculation of lateral buoyancy gradients for FK in 558 ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must 559 ! previously exist for hbl also. 560 561 ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway 562 ! ########################################################################## 563 hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) ) 564 ibld(:,:) = 4 565 DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 405 566 IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 406 567 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 407 568 ENDIF 408 569 END_3D 570 ! ########################################################################## 409 571 410 572 DO_2D( 0, 0, 0, 0 ) 411 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 412 zbeta = rab_n(ji,jj,1,jp_sal) 413 zt = 0._wp 414 zs = 0._wp 415 zu = 0._wp 416 zv = 0._wp 417 ! average over depth of boundary layer 418 zthick=0._wp 419 DO jm = 2, ibld(ji,jj) 420 zthick=zthick+e3t(ji,jj,jm,Kmm) 421 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 422 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 423 zu = zu + e3t(ji,jj,jm,Kmm) & 424 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 425 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 426 zv = zv + e3t(ji,jj,jm,Kmm) & 427 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 428 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 429 END DO 430 zt_bl(ji,jj) = zt / zthick 431 zs_bl(ji,jj) = zs / zthick 432 zu_bl(ji,jj) = zu / zthick 433 zv_bl(ji,jj) = zv / zthick 434 zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 435 zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 436 zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 437 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 438 zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 439 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 440 zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 441 IF ( lconv(ji,jj) ) THEN ! Convective 442 zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 443 & + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 444 445 zvel_max = - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 446 & * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 447 ! Entrainment including component due to shear turbulence. Modified Langmuir component, but gives same result for La=0.3 For testing uncomment. 448 ! zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 449 ! & + ( 0.15 * ( 1.0 - EXP( -0.5 * zla(ji,jj) ) ) + 0.03 / zla(ji,jj)**2 ) * zustar(ji,jj)**3/hbl(ji,jj) ) 450 451 ! zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 452 ! & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 453 zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) 454 ELSE ! Stable 455 zzdhdt = 0.32 * ( hbli(ji,jj) / hbl(ji,jj) -1.0 ) * zwstrl(ji,jj)**3 / hbli(ji,jj) & 456 & + ( ( 0.32 / 3.0 ) * exp ( -2.5 * ( hbli(ji,jj) / hbl(ji,jj) - 1.0 ) ) & 457 & - ( 0.32 / 3.0 - 0.135 * zla(ji,jj) ) * exp ( -12.5 * ( hbli(ji,jj) / hbl(ji,jj) ) ) ) & 458 & * zwstrl(ji,jj)**3 / hbli(ji,jj) 459 zzdhdt = zzdhdt + zwbav(ji,jj) 460 IF ( zzdhdt < 0._wp ) THEN 461 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 462 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 463 ELSE 464 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_Dt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 465 & + MAX( zdb_bl(ji,jj), 0.0 ) 466 ENDIF 467 zzdhdt = 2.0 * zzdhdt / zpert 468 ENDIF 469 zdhdt(ji,jj) = zzdhdt 573 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 574 imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji, jj, ibld(ji,jj), Kmm )) , 1 )) 575 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 576 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 470 577 END_2D 471 472 ! Calculate averages over depth of boundary layer 473 imld = ibld ! use imld to hold previous blayer index 474 ibld(:,:) = 3 475 476 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 477 zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 478 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 578 ! Averages over well-mixed and boundary layer 579 jp_ext(:,:) = 2 580 CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl) 581 ! jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1 582 CALL zdf_osm_vertical_average(ibld, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 583 ! Velocity components in frame aligned with surface stress. 584 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 585 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 586 ! Determine the state of the OSBL, stable/unstable, shear/no shear 587 CALL zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear, zri_i ) 588 589 IF ( ln_osm_mle ) THEN 590 ! Fox-Kemper Scheme 591 mld_prof = 4 592 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 593 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 594 END_3D 595 jp_ext_mle(:,:) = 2 596 CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle) 597 598 DO_2D( 0, 0, 0, 0 ) 599 zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 600 END_2D 601 602 !! External gradient 603 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 604 CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 605 CALL zdf_osm_external_gradients( mld_prof, zdtdz_mle_ext, zdsdz_mle_ext, zdbdz_mle_ext ) 606 CALL zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 607 CALL zdf_osm_mle_parameters( mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 608 ELSE ! ln_osm_mle 609 ! FK not selected, Boundary Layer only. 610 lpyc(:,:) = .TRUE. 611 lflux(:,:) = .FALSE. 612 lmle(:,:) = .FALSE. 613 DO_2D( 0, 0, 0, 0 ) 614 IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 615 END_2D 616 ENDIF ! ln_osm_mle 617 618 ! Test if pycnocline well resolved 619 DO_2D( 0, 0, 0, 0 ) 620 IF (lconv(ji,jj) ) THEN 621 ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm) 622 IF ( ztmp > 6 ) THEN 623 ! pycnocline well resolved 624 jp_ext(ji,jj) = 1 625 ELSE 626 ! pycnocline poorly resolved 627 jp_ext(ji,jj) = 0 628 ENDIF 629 ELSE 630 ! Stable conditions 631 jp_ext(ji,jj) = 0 632 ENDIF 633 END_2D 634 635 CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 636 ! jp_ext = ibld-imld+1 637 CALL zdf_osm_vertical_average(imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 638 ! Rate of change of hbl 639 CALL zdf_osm_calculate_dhdt( zdhdt, zddhdt ) 640 DO_2D( 0, 0, 0, 0 ) 641 zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need ww here, so subtract it 642 ! adjustment to represent limiting by ocean bottom 643 IF ( zhbl_t(ji,jj) >= gdepw(ji, jj, mbkt(ji,jj) + 1, Kmm ) ) THEN 644 zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw(ji,jj, mbkt(ji,jj) + 1, Kmm) - depth_tol)! ht(:,:)) 645 lpyc(ji,jj) = .FALSE. 646 ENDIF 647 END_2D 648 649 imld(:,:) = ibld(:,:) ! use imld to hold previous blayer index 650 ibld(:,:) = 4 479 651 480 652 DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 481 653 IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 482 ibld(ji,jj) = MIN(mbkt(ji,jj), jk)654 ibld(ji,jj) = jk 483 655 ENDIF 484 656 END_3D … … 487 659 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 488 660 ! 661 CALL zdf_osm_timestep_hbl( zdhdt ) 662 ! is external level in bounds? 663 664 CALL zdf_osm_vertical_average( ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 665 ! 666 ! 667 ! Check to see if lpyc needs to be changed 668 669 CALL zdf_osm_pycnocline_thickness( dh, zdh ) 670 489 671 DO_2D( 0, 0, 0, 0 ) 490 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 672 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE. 673 END_2D 674 675 dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. ) ! Limit delta for shallow boundary layers for calculating flux-gradient terms. 491 676 ! 492 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 493 ! 494 zhbl_s = hbl(ji,jj) 495 jm = imld(ji,jj) 496 zthermal = rab_n(ji,jj,1,jp_tem) 497 zbeta = rab_n(ji,jj,1,jp_sal) 498 IF ( lconv(ji,jj) ) THEN 499 !unstable 500 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) & 501 & * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 502 503 DO jk = imld(ji,jj), ibld(ji,jj) 504 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 505 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) + zvel_max 506 507 zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_Dt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), & 508 & e3w(ji,jj,jk,Kmm) ) 509 zhbl_s = MIN(zhbl_s, ht(ji,jj)) 510 511 IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 512 END DO 513 hbl(ji,jj) = zhbl_s 514 ibld(ji,jj) = jm 515 hbli(ji,jj) = hbl(ji,jj) 516 ELSE 517 ! stable 518 DO jk = imld(ji,jj), ibld(ji,jj) 519 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 520 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) & 521 & + 2.0 * zwstrl(ji,jj)**2 / zhbl_s 522 523 zhbl_s = zhbl_s + ( & 524 & 0.32 * ( hbli(ji,jj) / zhbl_s -1.0 ) & 525 & * zwstrl(ji,jj)**3 / hbli(ji,jj) & 526 & + ( ( 0.32 / 3.0 ) * EXP( - 2.5 * ( hbli(ji,jj) / zhbl_s -1.0 ) ) & 527 & - ( 0.32 / 3.0 - 0.0485 ) * EXP( - 12.5 * ( hbli(ji,jj) / zhbl_s ) ) ) & 528 & * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w(ji,jj,jk,Kmm) / zdhdt(ji,jj) ! ALMG to investigate whether need to include ww here 529 530 zhbl_s = MIN(zhbl_s, ht(ji,jj)) 531 IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 532 END DO 533 hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,3,Kmm) ) 534 ibld(ji,jj) = MAX(jm, 3 ) 535 IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 536 ENDIF ! IF ( lconv ) 537 ELSE 538 ! change zero or one model level. 539 hbl(ji,jj) = zhbl_t(ji,jj) 540 IF ( lconv(ji,jj) ) THEN 541 hbli(ji,jj) = hbl(ji,jj) 542 ELSE 543 hbl(ji,jj) = MAX(hbl(ji,jj), gdepw(ji,jj,3,Kmm) ) 544 IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 545 ENDIF 546 ENDIF 547 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 548 END_2D 549 dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. ) ! Limit delta for shallow boundary layers for calculating flux-gradient terms. 550 551 ! Recalculate averages over boundary layer after depth updated 552 ! Consider later combining this into the loop above and looking for columns 553 ! where the index for base of the boundary layer have changed 554 DO_2D( 0, 0, 0, 0 ) 555 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 556 zbeta = rab_n(ji,jj,1,jp_sal) 557 zt = 0._wp 558 zs = 0._wp 559 zu = 0._wp 560 zv = 0._wp 561 ! average over depth of boundary layer 562 zthick=0._wp 563 DO jm = 2, ibld(ji,jj) 564 zthick=zthick+e3t(ji,jj,jm,Kmm) 565 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 566 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 567 zu = zu + e3t(ji,jj,jm,Kmm) & 568 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 569 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 570 zv = zv + e3t(ji,jj,jm,Kmm) & 571 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 572 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 573 END DO 574 zt_bl(ji,jj) = zt / zthick 575 zs_bl(ji,jj) = zs / zthick 576 zu_bl(ji,jj) = zu / zthick 577 zv_bl(ji,jj) = zv / zthick 578 zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 579 zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 580 zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 581 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 582 zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 583 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 584 zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 585 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 586 IF ( lconv(ji,jj) ) THEN 587 IF ( zdb_bl(ji,jj) > 0._wp )THEN 588 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN ! near neutral stability 589 zari = 4.5 * ( zvstr(ji,jj)**2 ) & 590 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 591 ELSE ! unstable 592 zari = 4.5 * ( zwstrc(ji,jj)**2 ) & 593 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 594 ENDIF 595 IF ( zari > 0.2 ) THEN ! This test checks for weakly stratified pycnocline 596 zari = 0.2 597 zwb_ent(ji,jj) = 0._wp 598 ENDIF 599 inhml = MAX( INT( zari * zhbl(ji,jj) & 600 & / e3t(ji,jj,ibld(ji,jj),Kmm) ), 1 ) 601 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 602 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 603 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 604 ELSE ! IF (zdb_bl) 605 imld(ji,jj) = ibld(ji,jj) - 1 606 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 607 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 608 ENDIF 609 ELSE ! IF (lconv) 610 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 611 ! boundary layer deepening 612 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 613 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 614 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 615 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 , 0.2 ) 616 inhml = MAX( INT( zari * zhbl(ji,jj) & 617 & / e3t(ji,jj,ibld(ji,jj),Kmm) ), 1 ) 618 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 619 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 620 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 621 ELSE 622 imld(ji,jj) = ibld(ji,jj) - 1 623 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 624 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 625 ENDIF ! IF (zdb_bl > 0.0) 626 ELSE ! IF(dhdt >= 0) 627 ! boundary layer collapsing. 628 imld(ji,jj) = ibld(ji,jj) 629 zhml(ji,jj) = zhbl(ji,jj) 630 zdh(ji,jj) = 0._wp 631 ENDIF ! IF (dhdt >= 0) 632 ENDIF ! IF (lconv) 633 END_2D 634 635 ! Average over the depth of the mixed layer in the convective boundary layer 636 ! Also calculate entrainment fluxes for temperature and salinity 637 DO_2D( 0, 0, 0, 0 ) 638 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 639 zbeta = rab_n(ji,jj,1,jp_sal) 640 IF ( lconv(ji,jj) ) THEN 641 zt = 0._wp 642 zs = 0._wp 643 zu = 0._wp 644 zv = 0._wp 645 ! average over depth of boundary layer 646 zthick=0._wp 647 DO jm = 2, imld(ji,jj) 648 zthick=zthick+e3t(ji,jj,jm,Kmm) 649 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 650 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 651 zu = zu + e3t(ji,jj,jm,Kmm) & 652 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 653 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 654 zv = zv + e3t(ji,jj,jm,Kmm) & 655 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 656 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 657 END DO 658 zt_ml(ji,jj) = zt / zthick 659 zs_ml(ji,jj) = zs / zthick 660 zu_ml(ji,jj) = zu / zthick 661 zv_ml(ji,jj) = zv / zthick 662 zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 663 zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 664 zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 665 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 666 zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 667 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 668 zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 669 ELSE 670 ! stable, if entraining calulate average below interface layer. 671 IF ( zdhdt(ji,jj) >= 0._wp ) THEN 672 zt = 0._wp 673 zs = 0._wp 674 zu = 0._wp 675 zv = 0._wp 676 ! average over depth of boundary layer 677 zthick=0._wp 678 DO jm = 2, imld(ji,jj) 679 zthick=zthick+e3t(ji,jj,jm,Kmm) 680 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 681 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 682 zu = zu + e3t(ji,jj,jm,Kmm) & 683 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 684 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 685 zv = zv + e3t(ji,jj,jm,Kmm) & 686 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 687 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 688 END DO 689 zt_ml(ji,jj) = zt / zthick 690 zs_ml(ji,jj) = zs / zthick 691 zu_ml(ji,jj) = zu / zthick 692 zv_ml(ji,jj) = zv / zthick 693 zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 694 zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 695 zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 696 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 697 zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 698 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 699 zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 700 ENDIF 701 ENDIF 702 END_2D 703 ! 677 ! Average over the depth of the mixed layer in the convective boundary layer 678 ! jp_ext = ibld - imld +1 679 CALL zdf_osm_vertical_average( imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml ) 704 680 ! rotate mean currents and changes onto wind align co-ordinates 705 681 ! 706 707 DO_2D( 0, 0, 0, 0 ) 708 ztemp = zu_ml(ji,jj) 709 zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj) 710 zv_ml(ji,jj) = zv_ml(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 711 ztemp = zdu_ml(ji,jj) 712 zdu_ml(ji,jj) = zdu_ml(ji,jj) * zcos_wind(ji,jj) + zdv_ml(ji,jj) * zsin_wind(ji,jj) 713 zdv_ml(ji,jj) = zdv_ml(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 714 ! 715 ztemp = zu_bl(ji,jj) 716 zu_bl = zu_bl(ji,jj) * zcos_wind(ji,jj) + zv_bl(ji,jj) * zsin_wind(ji,jj) 717 zv_bl(ji,jj) = zv_bl(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 718 ztemp = zdu_bl(ji,jj) 719 zdu_bl(ji,jj) = zdu_bl(ji,jj) * zcos_wind(ji,jj) + zdv_bl(ji,jj) * zsin_wind(ji,jj) 720 zdv_bl(ji,jj) = zdv_bl(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 721 END_2D 722 723 zuw_bse = 0._wp 724 zvw_bse = 0._wp 725 DO_2D( 0, 0, 0, 0 ) 726 727 IF ( lconv(ji,jj) ) THEN 728 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 729 zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 730 zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 731 ENDIF 732 ELSE 733 zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) ) 734 zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) ) 735 ENDIF 736 END_2D 737 682 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 683 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 738 684 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 739 685 ! Pycnocline gradients for scalars and velocity 740 686 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 741 687 742 DO_2D( 0, 0, 0, 0 ) 743 ! 744 IF ( lconv (ji,jj) ) THEN 745 ! Unstable conditions 746 IF( zdb_bl(ji,jj) > 0._wp ) THEN 747 ! calculate pycnocline profiles, no need if zdb_bl <= 0. since profile is zero and arrays have been initialized to zero 748 ztgrad = ( zdt_ml(ji,jj) / zdh(ji,jj) ) 749 zsgrad = ( zds_ml(ji,jj) / zdh(ji,jj) ) 750 zbgrad = ( zdb_ml(ji,jj) / zdh(ji,jj) ) 751 DO jk = 2 , ibld(ji,jj) 752 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 753 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 754 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 755 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 756 END DO 757 ENDIF 758 ELSE 759 ! stable conditions 760 ! if pycnocline profile only defined when depth steady of increasing. 761 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! Depth increasing, or steady. 762 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 763 IF ( zhol(ji,jj) >= 0.5 ) THEN ! Very stable - 'thick' pycnocline 764 ztgrad = zdt_bl(ji,jj) / zhbl(ji,jj) 765 zsgrad = zds_bl(ji,jj) / zhbl(ji,jj) 766 zbgrad = zdb_bl(ji,jj) / zhbl(ji,jj) 767 DO jk = 2, ibld(ji,jj) 768 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 769 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 770 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 771 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 772 END DO 773 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 774 ztgrad = zdt_bl(ji,jj) / zdh(ji,jj) 775 zsgrad = zds_bl(ji,jj) / zdh(ji,jj) 776 zbgrad = zdb_bl(ji,jj) / zdh(ji,jj) 777 DO jk = 2, ibld(ji,jj) 778 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 779 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 780 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 781 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 782 END DO 783 ENDIF ! IF (zhol >=0.5) 784 ENDIF ! IF (zdb_bl> 0.) 785 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero, profile arrays are intialized to zero 786 ENDIF ! IF (lconv) 787 ! 788 END_2D 789 ! 790 DO_2D( 0, 0, 0, 0 ) 791 ! 792 IF ( lconv (ji,jj) ) THEN 793 ! Unstable conditions 794 zugrad = ( zdu_ml(ji,jj) / zdh(ji,jj) ) + 0.275 * zustar(ji,jj)*zustar(ji,jj) / & 795 & (( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) / zla(ji,jj)**(8.0/3.0) 796 zvgrad = ( zdv_ml(ji,jj) / zdh(ji,jj) ) + 3.5 * ff_t(ji,jj) * zustke(ji,jj) / & 797 & ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 798 DO jk = 2 , ibld(ji,jj)-1 799 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 800 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 801 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 802 END DO 803 ELSE 804 ! stable conditions 805 zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 806 zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 807 DO jk = 2, ibld(ji,jj) 808 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 809 IF ( znd < 1.0 ) THEN 810 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 811 ELSE 812 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 813 ENDIF 814 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 815 END DO 816 ENDIF 817 ! 818 END_2D 688 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 689 CALL zdf_osm_pycnocline_scalar_profiles( zdtdz_pyc, zdsdz_pyc, zdbdz_pyc, zalpha_pyc ) 690 CALL zdf_osm_pycnocline_shear_profiles( zdudz_pyc, zdvdz_pyc ) 819 691 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 820 692 ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 821 693 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 822 823 ! WHERE ( lconv ) 824 ! zdifml_sc = zhml * ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird 825 ! zvisml_sc = zdifml_sc 826 ! zdifpyc_sc = 0.165 * ( zwstrl**3 + zwstrc**3 )**pthird * ( zhbl - zhml ) 827 ! zvispyc_sc = 0.142 * ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * ( zhbl - zhml ) 828 ! zbeta_d_sc = 1.0 - (0.165 / 0.8 * ( zhbl - zhml ) / zhbl )**p2third 829 ! zbeta_v_sc = 1.0 - 2.0 * (0.142 /0.375) * (zhbl - zhml ) / zhml 830 ! ELSEWHERE 831 ! zdifml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 ) 832 ! zvisml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 ) 833 ! ENDWHERE 834 DO_2D( 0, 0, 0, 0 ) 835 IF ( lconv(ji,jj) ) THEN 836 zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 837 zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 838 zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 839 zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 840 zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third 841 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * (0.142 /0.375) * zdh(ji,jj) / zhml(ji,jj) 842 ELSE 843 zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 844 zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 845 END IF 846 END_2D 847 ! 848 DO_2D( 0, 0, 0, 0 ) 849 IF ( lconv(ji,jj) ) THEN 850 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 851 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 852 ! 853 zdiffut(ji,jj,jk) = 0.8 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 854 ! 855 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 856 & * ( 1.0 - 0.5 * zznd_ml**2 ) 857 END DO 858 ! pycnocline - if present linear profile 859 IF ( zdh(ji,jj) > 0._wp ) THEN 860 DO jk = imld(ji,jj)+1 , ibld(ji,jj) 861 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 862 ! 863 zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 864 ! 865 zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 866 END DO 867 ENDIF 868 ! Temporay fix to ensure zdiffut is +ve; won't be necessary with ww taken out 869 zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj)* e3t(ji,jj,ibld(ji,jj),Kmm) 870 ! could be taken out, take account of entrainment represents as a diffusivity 871 ! should remove w from here, represents entrainment 872 ELSE 873 ! stable conditions 874 DO jk = 2, ibld(ji,jj) 875 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 876 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 877 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 878 END DO 879 ENDIF ! end if ( lconv ) 880 ! 881 END_2D 694 CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 882 695 883 696 ! … … 918 731 END_2D 919 732 920 921 733 ! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use zvstr since term needs to go to zero as zwstrl goes to zero) 922 734 WHERE ( lconv ) 923 zsc_uw_1 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / ( 1.0 - 1.0 * 6.5 * zla**(8.0/3.0))924 zsc_uw_2 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / ( zla**(8.0/3.0) + epsln)925 zsc_vw_1 = ff_t * zhml * zustke**3 * zla**(8.0/3.0) / ( ( zvstr**3 + 0.5 * zwstrc**3 )**(2.0/3.0) + epsln )735 zsc_uw_1 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MAX( ( 1.0 - 1.0 * 6.5 * zla**(8.0/3.0) ), 0.2 ) 736 zsc_uw_2 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MIN( zla**(8.0/3.0) + epsln, 0.12 ) 737 zsc_vw_1 = ff_t * zhml * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / ( ( zvstr**3 + 0.5 * zwstrc**3 )**(2.0/3.0) + epsln ) 926 738 ELSEWHERE 927 739 zsc_uw_1 = zustar**2 928 zsc_vw_1 = ff_t * zhbl * zustke**3 * zla**(8.0/3.0) / (zvstr**2 + epsln)740 zsc_vw_1 = ff_t * zhbl * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / (zvstr**2 + epsln) 929 741 ENDWHERE 930 742 IF(ln_dia_osm) THEN 743 IF ( iom_use("ghamu_00") ) CALL iom_put( "ghamu_00", wmask*ghamu ) 744 IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv ) 745 END IF 931 746 DO_2D( 0, 0, 0, 0 ) 932 747 IF ( lconv(ji,jj) ) THEN … … 970 785 zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) ) & 971 786 & * ( 1.0 - EXP ( - 5.0 * ( 1.0 - zznd_ml ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 972 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( 3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0)787 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0 / 2.0) 973 788 ! non-gradient buoyancy terms 974 789 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 975 790 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 * zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 976 791 END DO 977 ELSE 792 793 IF ( lpyc(ji,jj) ) THEN 794 ztau_sc_u(ji,jj) = zhml(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 795 ztau_sc_u(ji,jj) = ztau_sc_u(ji,jj) * ( 1.4 -0.4 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )**1.5 ) 796 zwth_ent = -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj) 797 zws_ent = -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj) 798 ! Cubic profile used for buoyancy term 799 za_cubic = 0.755 * ztau_sc_u(ji,jj) 800 zb_cubic = 0.25 * ztau_sc_u(ji,jj) 801 DO jk = 2, ibld(ji,jj) 802 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 803 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - 0.045 * ( ( zwth_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 804 805 ghams(ji,jj,jk) = ghams(ji,jj,jk) - 0.045 * ( ( zws_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 806 END DO 807 ! 808 zbuoy_pyc_sc = zalpha_pyc(ji,jj) * zdb_ml(ji,jj) / zdh(ji,jj) + zdbdz_bl_ext(ji,jj) 809 zdelta_pyc = ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird / SQRT( MAX( zbuoy_pyc_sc, ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / zdh(ji,jj)**2 ) ) 810 ! 811 zwt_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zdt_ml(ji,jj) / zdh(ji,jj) + zdtdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 812 ! 813 zws_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zds_ml(ji,jj) / zdh(ji,jj) + zdsdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 814 ! 815 zzeta_pyc = 0.15 - 0.175 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 816 DO jk = 2, ibld(ji,jj) 817 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 818 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05 * zwt_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 819 ! 820 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05 * zws_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 821 END DO 822 ENDIF ! End of pycnocline 823 ELSE ! lconv test - stable conditions 978 824 DO jk = 2, ibld(ji,jj) 979 825 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) … … 982 828 ENDIF 983 829 END_2D 984 985 830 986 831 WHERE ( lconv ) … … 1011 856 END_2D 1012 857 858 DO_2D( 0, 0, 0, 0 ) 859 IF ( lpyc(ji,jj) ) THEN 860 IF ( j_ddh(ji,jj) == 0 ) THEN 861 ! Place holding code. Parametrization needs checking for these conditions. 862 zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) )**pthird )**pthird 863 zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 864 zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 865 ELSE 866 zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) )**pthird )**pthird 867 zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 868 zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 869 ENDIF 870 zd_cubic = zdh(ji,jj) / zhbl(ji,jj) * zuw0(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zuw_bse 871 zc_cubic = zuw_bse - zd_cubic 872 ! need ztau_sc_u to be available. Change to array. 873 DO jk = imld(ji,jj), ibld(ji,jj) 874 zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 875 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.045 * ztau_sc_u(ji,jj)**2 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 876 END DO 877 zvw_max = 0.7 * ff_t(ji,jj) * ( zustke(ji,jj) * dstokes(ji,jj) + 0.75 * zustar(ji,jj) * zhml(ji,jj) ) 878 zd_cubic = zvw_max * zdh(ji,jj) / zhml(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zvw_bse 879 zc_cubic = zvw_bse - zd_cubic 880 DO jk = imld(ji,jj), ibld(ji,jj) 881 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) -zhbl(ji,jj) ) / zdh(ji,jj) 882 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.045 * ztau_sc_u(ji,jj)**2 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 883 END DO 884 ENDIF ! lpyc 885 END_2D 886 887 IF(ln_dia_osm) THEN 888 IF ( iom_use("ghamu_0") ) CALL iom_put( "ghamu_0", wmask*ghamu ) 889 IF ( iom_use("zsc_uw_1_0") ) CALL iom_put( "zsc_uw_1_0", tmask(:,:,1)*zsc_uw_1 ) 890 END IF 1013 891 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 1014 892 1015 WHERE ( lconv ) 1016 zsc_wth_1 = zwth0 1017 zsc_ws_1 = zws0 1018 ELSEWHERE 1019 zsc_wth_1 = 2.0 * zwthav 1020 zsc_ws_1 = zws0 1021 ENDWHERE 893 DO_2D( 1, 0, 1, 0 ) 894 895 IF ( lconv(ji,jj) ) THEN 896 zsc_wth_1(ji,jj) = zwth0(ji,jj) / ( 1.0 - 0.56 * EXP( zhol(ji,jj) ) ) 897 zsc_ws_1(ji,jj) = zws0(ji,jj) / (1.0 - 0.56 *EXP( zhol(ji,jj) ) ) 898 IF ( lpyc(ji,jj) ) THEN 899 ! Pycnocline scales 900 zsc_wth_pyc(ji,jj) = -0.2 * zwb0(ji,jj) * zdt_bl(ji,jj) / zdb_bl(ji,jj) 901 zsc_ws_pyc(ji,jj) = -0.2 * zwb0(ji,jj) * zds_bl(ji,jj) / zdb_bl(ji,jj) 902 ENDIF 903 ELSE 904 zsc_wth_1(ji,jj) = 2.0 * zwthav(ji,jj) 905 zsc_ws_1(ji,jj) = zws0(ji,jj) 906 ENDIF 907 END_2D 1022 908 1023 909 DO_2D( 0, 0, 0, 0 ) … … 1035 921 & * ( 1.0 - EXP ( -15.0 * ( 1.0 - zznd_ml ) ) ) 1036 922 END DO 923 ! 924 IF ( lpyc(ji,jj) ) THEN 925 ! pycnocline 926 DO jk = imld(ji,jj), ibld(ji,jj) 927 zznd_pyc = - ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zdh(ji,jj) 928 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0 * zsc_wth_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 929 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0 * zsc_ws_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 930 END DO 931 ENDIF 1037 932 ELSE 1038 DO jk = 2, ibld(ji,jj) 1039 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 1040 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1041 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1042 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 1043 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1044 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 1045 END DO 933 IF( zdhdt(ji,jj) > 0. ) THEN 934 DO jk = 2, ibld(ji,jj) 935 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 936 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 937 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 938 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 939 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 940 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 941 END DO 942 ENDIF 1046 943 ENDIF 1047 944 END_2D 1048 1049 945 1050 946 WHERE ( lconv ) … … 1090 986 ENDIF 1091 987 END_2D 988 989 IF(ln_dia_osm) THEN 990 IF ( iom_use("ghamu_f") ) CALL iom_put( "ghamu_f", wmask*ghamu ) 991 IF ( iom_use("ghamv_f") ) CALL iom_put( "ghamv_f", wmask*ghamv ) 992 IF ( iom_use("zsc_uw_1_f") ) CALL iom_put( "zsc_uw_1_f", tmask(:,:,1)*zsc_uw_1 ) 993 IF ( iom_use("zsc_vw_1_f") ) CALL iom_put( "zsc_vw_1_f", tmask(:,:,1)*zsc_vw_1 ) 994 IF ( iom_use("zsc_uw_2_f") ) CALL iom_put( "zsc_uw_2_f", tmask(:,:,1)*zsc_uw_2 ) 995 IF ( iom_use("zsc_vw_2_f") ) CALL iom_put( "zsc_vw_2_f", tmask(:,:,1)*zsc_vw_2 ) 996 END IF 1092 997 ! 1093 998 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 1094 999 1000 1001 ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 1002 1095 1003 DO_2D( 0, 0, 0, 0 ) 1096 IF ( lconv(ji,jj) ) THEN1004 IF ( .not. lconv(ji,jj) ) THEN 1097 1005 DO jk = 2, ibld(ji,jj) 1098 znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 1099 IF ( znd >= 0.0 ) THEN 1100 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 1101 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 1102 ELSE 1103 ghamu(ji,jj,jk) = 0._wp 1104 ghamv(ji,jj,jk) = 0._wp 1105 ENDIF 1106 END DO 1107 ELSE 1108 DO jk = 2, ibld(ji,jj) 1109 znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 1006 znd = ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / zhbl(ji,jj) !ALMG to think about 1110 1007 IF ( znd >= 0.0 ) THEN 1111 1008 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) … … 1120 1017 1121 1018 ! pynocline contributions 1122 ! Temporary fix to avoid instabilities when zdb_bl becomes very very small1123 zsc_uw_1 = 0._wp ! 50.0 * zla**(8.0/3.0) * zustar**2 * zhbl / ( zdb_bl + epsln )1124 1019 DO_2D( 0, 0, 0, 0 ) 1125 DO jk= 2, ibld(ji,jj) 1126 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1127 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 1128 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 1129 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 1130 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk) 1131 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 1132 END DO 1020 IF ( .not. lconv(ji,jj) ) THEN 1021 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1022 DO jk= 2, ibld(ji,jj) 1023 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1024 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 1025 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 1026 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 1027 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 1028 END DO 1029 END IF 1030 END IF 1133 1031 END_2D 1134 1135 ! Entrainment contribution. 1032 IF(ln_dia_osm) THEN 1033 IF ( iom_use("ghamu_b") ) CALL iom_put( "ghamu_b", wmask*ghamu ) 1034 IF ( iom_use("ghamv_b") ) CALL iom_put( "ghamv_b", wmask*ghamv ) 1035 END IF 1136 1036 1137 1037 DO_2D( 0, 0, 0, 0 ) 1138 IF ( lconv(ji,jj) ) THEN 1139 DO jk = 1, imld(ji,jj) - 1 1140 znd=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 1141 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd 1142 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd 1143 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd 1144 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd 1145 END DO 1146 DO jk = imld(ji,jj), ibld(ji,jj) 1147 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 1148 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd ) 1149 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd ) 1150 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd ) 1151 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd ) 1152 END DO 1153 ENDIF 1154 ghamt(ji,jj,ibld(ji,jj)) = 0._wp 1155 ghams(ji,jj,ibld(ji,jj)) = 0._wp 1156 ghamu(ji,jj,ibld(ji,jj)) = 0._wp 1157 ghamv(ji,jj,ibld(ji,jj)) = 0._wp 1038 ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 1039 ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 1040 ghamu(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 1041 ghamv(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 1158 1042 END_2D 1159 1043 1160 1044 IF(ln_dia_osm) THEN 1045 IF ( iom_use("ghamu_1") ) CALL iom_put( "ghamu_1", wmask*ghamu ) 1046 IF ( iom_use("ghamv_1") ) CALL iom_put( "ghamv_1", wmask*ghamv ) 1047 IF ( iom_use("zdudz_pyc") ) CALL iom_put( "zdudz_pyc", wmask*zdudz_pyc ) 1048 IF ( iom_use("zdvdz_pyc") ) CALL iom_put( "zdvdz_pyc", wmask*zdvdz_pyc ) 1049 IF ( iom_use("zviscos") ) CALL iom_put( "zviscos", wmask*zviscos ) 1050 END IF 1161 1051 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1162 1052 ! Need to put in code for contributions that are applied explicitly to … … 1180 1070 IF(ln_dia_osm) THEN 1181 1071 IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 1072 IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 1073 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 1182 1074 END IF 1183 1075 … … 1222 1114 END IF ! ln_convmix = .true. 1223 1115 1116 1117 1118 IF ( ln_osm_mle ) THEN ! set up diffusivity and non-gradient mixing 1119 DO_2D( 0, 0, 0, 0 ) 1120 IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 1121 ! Calculate MLE flux contribution from surface fluxes 1122 DO jk = 1, ibld(ji,jj) 1123 znd = gdepw(ji,jj,jk,Kmm) / MAX(zhbl(ji,jj),epsln) 1124 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - zwth0(ji,jj) * ( 1.0 - znd ) 1125 ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd ) 1126 END DO 1127 DO jk = 1, mld_prof(ji,jj) 1128 znd = gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 1129 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth0(ji,jj) * ( 1.0 - znd ) 1130 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd ) 1131 END DO 1132 ! Viscosity for MLEs 1133 DO jk = 1, mld_prof(ji,jj) 1134 znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 1135 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1136 END DO 1137 ELSE 1138 ! Surface transports limited to OSBL. 1139 ! Viscosity for MLEs 1140 DO jk = 1, mld_prof(ji,jj) 1141 znd = -gdepw(ji,jj,jk,Kmm) / MAX(zhmle(ji,jj),epsln) 1142 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1143 END DO 1144 ENDIF 1145 END_2D 1146 ENDIF 1147 1148 IF(ln_dia_osm) THEN 1149 IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 1150 IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 1151 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 1152 END IF 1153 1154 1224 1155 ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 1225 CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp )1156 !CALL lbc_lnk( 'zdfosm', zviscos(:,:,:), 'W', 1.0_wp ) 1226 1157 1227 1158 ! GN 25/8: need to change tmask --> wmask … … 1244 1175 ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk) 1245 1176 END_3D 1177 ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged) 1178 CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1246 1179 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1247 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign unchanged)1248 CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W',1.0_wp, &1249 & ghamu, 'U', 1.0_wp , ghamv, 'V',1.0_wp )1250 1251 1180 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign changed) 1181 CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp, & 1182 & ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 1183 1184 IF(ln_dia_osm) THEN 1252 1185 SELECT CASE (nn_osm_wave) 1253 1186 ! Stokes drift set by assumimg onstant La#=0.3(=0) or Pierson-Moskovitz spectrum (=1). … … 1257 1190 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 1258 1191 ! Stokes drift read in from sbcwave (=2). 1259 CASE(2) 1260 IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd ) ! x surface Stokes drift 1261 IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd ) ! y surface Stokes drift 1192 CASE(2:3) 1193 IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd*umask(:,:,1) ) ! x surface Stokes drift 1194 IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd*vmask(:,:,1) ) ! y surface Stokes drift 1195 IF ( iom_use("wmp") ) CALL iom_put( "wmp", wmp*tmask(:,:,1) ) ! wave mean period 1196 IF ( iom_use("hsw") ) CALL iom_put( "hsw", hsw*tmask(:,:,1) ) ! significant wave height 1197 IF ( iom_use("wmp_NP") ) CALL iom_put( "wmp_NP", (2.*rpi*1.026/(0.877*grav) )*wndm*tmask(:,:,1) ) ! wave mean period from NP spectrum 1198 IF ( iom_use("hsw_NP") ) CALL iom_put( "hsw_NP", (0.22/grav)*wndm**2*tmask(:,:,1) ) ! significant wave height from NP spectrum 1199 IF ( iom_use("wndm") ) CALL iom_put( "wndm", wndm*tmask(:,:,1) ) ! U_10 1262 1200 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rho0*tmask(:,:,1)*zustar**2* & 1263 1201 & SQRT(ut0sd**2 + vt0sd**2 ) ) … … 1270 1208 IF ( iom_use("zws0") ) CALL iom_put( "zws0", tmask(:,:,1)*zws0 ) ! <Sw_0> 1271 1209 IF ( iom_use("hbl") ) CALL iom_put( "hbl", tmask(:,:,1)*hbl ) ! boundary-layer depth 1272 IF ( iom_use("hbli") ) CALL iom_put( "hbli", tmask(:,:,1)*hbli ) ! Initial boundary-layer depth 1210 IF ( iom_use("ibld") ) CALL iom_put( "ibld", tmask(:,:,1)*ibld ) ! boundary-layer max k 1211 IF ( iom_use("zdt_bl") ) CALL iom_put( "zdt_bl", tmask(:,:,1)*zdt_bl ) ! dt at ml base 1212 IF ( iom_use("zds_bl") ) CALL iom_put( "zds_bl", tmask(:,:,1)*zds_bl ) ! ds at ml base 1213 IF ( iom_use("zdb_bl") ) CALL iom_put( "zdb_bl", tmask(:,:,1)*zdb_bl ) ! db at ml base 1214 IF ( iom_use("zdu_bl") ) CALL iom_put( "zdu_bl", tmask(:,:,1)*zdu_bl ) ! du at ml base 1215 IF ( iom_use("zdv_bl") ) CALL iom_put( "zdv_bl", tmask(:,:,1)*zdv_bl ) ! dv at ml base 1216 IF ( iom_use("dh") ) CALL iom_put( "dh", tmask(:,:,1)*dh ) ! Initial boundary-layer depth 1217 IF ( iom_use("hml") ) CALL iom_put( "hml", tmask(:,:,1)*hml ) ! Initial boundary-layer depth 1273 1218 IF ( iom_use("dstokes") ) CALL iom_put( "dstokes", tmask(:,:,1)*dstokes ) ! Stokes drift penetration depth 1274 1219 IF ( iom_use("zustke") ) CALL iom_put( "zustke", tmask(:,:,1)*zustke ) ! Stokes drift magnitude at T-points … … 1276 1221 IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl ) ! Langmuir velocity scale 1277 1222 IF ( iom_use("zustar") ) CALL iom_put( "zustar", tmask(:,:,1)*zustar ) ! friction velocity scale 1223 IF ( iom_use("zvstr") ) CALL iom_put( "zvstr", tmask(:,:,1)*zvstr ) ! mixed velocity scale 1224 IF ( iom_use("zla") ) CALL iom_put( "zla", tmask(:,:,1)*zla ) ! langmuir # 1278 1225 IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rho0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine 1279 1226 IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rho0*tmask(:,:,1)*zustar**2*zustke ) 1280 1227 IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl ) ! BL depth internal to zdf_osm routine 1281 1228 IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml ) ! ML depth internal to zdf_osm routine 1282 IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh ) ! ML depth internal to zdf_osm routine 1229 IF ( iom_use("imld") ) CALL iom_put( "imld", tmask(:,:,1)*imld ) ! index for ML depth internal to zdf_osm routine 1230 IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh ) ! pyc thicknessh internal to zdf_osm routine 1283 1231 IF ( iom_use("zhol") ) CALL iom_put( "zhol", tmask(:,:,1)*zhol ) ! ML depth internal to zdf_osm routine 1284 IF ( iom_use("zwthav") ) CALL iom_put( "zwthav", tmask(:,:,1)*zwthav ) ! ML depth internal to zdf_osm routine 1285 IF ( iom_use("zwth_ent") ) CALL iom_put( "zwth_ent", tmask(:,:,1)*zwth_ent ) ! ML depth internal to zdf_osm routine 1286 IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml ) ! average T in ML 1232 IF ( iom_use("zwthav") ) CALL iom_put( "zwthav", tmask(:,:,1)*zwthav ) ! upward BL-avged turb temp flux 1233 IF ( iom_use("zwth_ent") ) CALL iom_put( "zwth_ent", tmask(:,:,1)*zwth_ent ) ! upward turb temp entrainment flux 1234 IF ( iom_use("zwb_ent") ) CALL iom_put( "zwb_ent", tmask(:,:,1)*zwb_ent ) ! upward turb buoyancy entrainment flux 1235 IF ( iom_use("zws_ent") ) CALL iom_put( "zws_ent", tmask(:,:,1)*zws_ent ) ! upward turb salinity entrainment flux 1236 IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml ) ! average T in ML 1237 1238 IF ( iom_use("hmle") ) CALL iom_put( "hmle", tmask(:,:,1)*hmle ) ! FK layer depth 1239 IF ( iom_use("zmld") ) CALL iom_put( "zmld", tmask(:,:,1)*zmld ) ! FK target layer depth 1240 IF ( iom_use("zwb_fk") ) CALL iom_put( "zwb_fk", tmask(:,:,1)*zwb_fk ) ! FK b flux 1241 IF ( iom_use("zwb_fk_b") ) CALL iom_put( "zwb_fk_b", tmask(:,:,1)*zwb_fk_b ) ! FK b flux averaged over ML 1242 IF ( iom_use("mld_prof") ) CALL iom_put( "mld_prof", tmask(:,:,1)*mld_prof )! FK layer max k 1243 IF ( iom_use("zdtdx") ) CALL iom_put( "zdtdx", umask(:,:,1)*zdtdx ) ! FK dtdx at u-pt 1244 IF ( iom_use("zdtdy") ) CALL iom_put( "zdtdy", vmask(:,:,1)*zdtdy ) ! FK dtdy at v-pt 1245 IF ( iom_use("zdsdx") ) CALL iom_put( "zdsdx", umask(:,:,1)*zdsdx ) ! FK dtdx at u-pt 1246 IF ( iom_use("zdsdy") ) CALL iom_put( "zdsdy", vmask(:,:,1)*zdsdy ) ! FK dsdy at v-pt 1247 IF ( iom_use("dbdx_mle") ) CALL iom_put( "dbdx_mle", umask(:,:,1)*dbdx_mle ) ! FK dbdx at u-pt 1248 IF ( iom_use("dbdy_mle") ) CALL iom_put( "dbdy_mle", vmask(:,:,1)*dbdy_mle ) ! FK dbdy at v-pt 1249 IF ( iom_use("zdiff_mle") ) CALL iom_put( "zdiff_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt 1250 IF ( iom_use("zvel_mle") ) CALL iom_put( "zvel_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt 1251 1287 1252 END IF 1288 ! Lateral boundary conditions on p_avt (sign unchanged) 1289 CALL lbc_lnk( 'zdfosm', p_avt(:,:,:), 'W', 1.0_wp ) 1253 1254 CONTAINS 1255 ! subroutine code changed, needs syntax checking. 1256 SUBROUTINE zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 1257 1258 !!--------------------------------------------------------------------- 1259 !! *** ROUTINE zdf_osm_diffusivity_viscosity *** 1260 !! 1261 !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline. 1262 !! 1263 !! ** Method : 1264 !! 1265 !! !!---------------------------------------------------------------------- 1266 REAL(wp), DIMENSION(:,:,:) :: zdiffut 1267 REAL(wp), DIMENSION(:,:,:) :: zviscos 1268 ! local 1269 1270 ! Scales used to calculate eddy diffusivity and viscosity profiles 1271 REAL(wp), DIMENSION(jpi,jpj) :: zdifml_sc, zvisml_sc 1272 REAL(wp), DIMENSION(jpi,jpj) :: zdifpyc_n_sc, zdifpyc_s_sc, zdifpyc_shr 1273 REAL(wp), DIMENSION(jpi,jpj) :: zvispyc_n_sc, zvispyc_s_sc,zvispyc_shr 1274 REAL(wp), DIMENSION(jpi,jpj) :: zbeta_d_sc, zbeta_v_sc 1275 ! 1276 REAL(wp) :: zvel_sc_pyc, zvel_sc_ml, zstab_fac 1277 1278 REAL(wp), PARAMETER :: rn_dif_ml = 0.8, rn_vis_ml = 0.375 1279 REAL(wp), PARAMETER :: rn_dif_pyc = 0.15, rn_vis_pyc = 0.142 1280 REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 1281 1282 DO_2D( 0, 0, 0, 0 ) 1283 IF ( lconv(ji,jj) ) THEN 1284 1285 zvel_sc_pyc = ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.25 * zshear(ji,jj) * zhbl(ji,jj) )**pthird 1286 zvel_sc_ml = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 1287 zstab_fac = ( zhml(ji,jj) / zvel_sc_ml * ( 1.4 - 0.4 / ( 1.0 + EXP(-3.5 * LOG10(-zhol(ji,jj) ) ) )**1.25 ) )**2 1288 1289 zdifml_sc(ji,jj) = rn_dif_ml * zhml(ji,jj) * zvel_sc_ml 1290 zvisml_sc(ji,jj) = rn_vis_ml * zdifml_sc(ji,jj) 1291 1292 IF ( lpyc(ji,jj) ) THEN 1293 zdifpyc_n_sc(ji,jj) = rn_dif_pyc * zvel_sc_ml * zdh(ji,jj) 1294 1295 IF ( lshear(ji,jj) .and. j_ddh(ji,jj) == 1 ) THEN 1296 zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj) 1297 ENDIF 1298 1299 zdifpyc_s_sc(ji,jj) = zwb_ent(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) 1300 zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac 1301 zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) ) 1302 1303 zvispyc_n_sc(ji,jj) = 0.09 * zvel_sc_pyc * ( 1.0 - zhbl(ji,jj) / zdh(ji,jj) )**2 * ( 0.005 * ( zu_ml(ji,jj)-zu_bl(ji,jj) )**2 + 0.0075 * ( zv_ml(ji,jj)-zv_bl(ji,jj) )**2 ) / zdh(ji,jj) 1304 zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 1305 IF ( lshear(ji,jj) .and. j_ddh(ji,jj) == 1 ) THEN 1306 zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj) 1307 ENDIF 1308 1309 zvispyc_s_sc(ji,jj) = 0.09 * ( zwb_min(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) ) 1310 zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 1311 zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5 * zvispyc_s_sc(ji,jj) ) 1312 1313 zbeta_d_sc(ji,jj) = 1.0 - ( ( zdifpyc_n_sc(ji,jj) + 1.4 * zdifpyc_s_sc(ji,jj) ) / ( zdifml_sc(ji,jj) + epsln ) )**p2third 1314 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln ) 1315 ELSE 1316 zbeta_d_sc(ji,jj) = 1.0 1317 zbeta_v_sc(ji,jj) = 1.0 1318 ENDIF 1319 ELSE 1320 zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 1321 zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 1322 END IF 1323 END_2D 1324 ! 1325 DO_2D( 0, 0, 0, 0 ) 1326 IF ( lconv(ji,jj) ) THEN 1327 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 1328 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 1329 ! 1330 zdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 1331 ! 1332 zviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 1333 & * ( 1.0 - 0.5 * zznd_ml**2 ) 1334 END DO 1335 ! pycnocline 1336 IF ( lpyc(ji,jj) ) THEN 1337 ! Diffusivity profile in the pycnocline given by cubic polynomial. 1338 za_cubic = 0.5 1339 zb_cubic = -1.75 * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj) 1340 zd_cubic = ( zdh(ji,jj) * zdifml_sc(ji,jj) / zhml(ji,jj) * SQRT( 1.0 - zbeta_d_sc(ji,jj) ) * ( 2.5 * zbeta_d_sc(ji,jj) - 1.0 ) & 1341 & - 0.85 * zdifpyc_s_sc(ji,jj) ) / MAX(zdifpyc_n_sc(ji,jj), 1.e-8) 1342 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 1343 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1344 DO jk = imld(ji,jj) , ibld(ji,jj) 1345 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 1346 ! 1347 zdiffut(ji,jj,jk) = zdifpyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1348 1349 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdifpyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ) 1350 END DO 1351 ! viscosity profiles. 1352 za_cubic = 0.5 1353 zb_cubic = -1.75 * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj) 1354 zd_cubic = ( 0.5 * zvisml_sc(ji,jj) * zdh(ji,jj) / zhml(ji,jj) - 0.85 * zvispyc_s_sc(ji,jj) ) / MAX(zvispyc_n_sc(ji,jj), 1.e-8) 1355 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zd_cubic ) 1356 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1357 DO jk = imld(ji,jj) , ibld(ji,jj) 1358 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 1359 zviscos(ji,jj,jk) = zvispyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1360 zviscos(ji,jj,jk) = zviscos(ji,jj,jk) + zvispyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 -0.2 * zznd_pyc**3 ) 1361 END DO 1362 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1363 zdiffut(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 1364 zviscos(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w(ji,jj,ibld(ji,jj)+1,Kmm), 1.0e-6 ) 1365 ELSE 1366 zdiffut(ji,jj,ibld(ji,jj)) = 0._wp 1367 zviscos(ji,jj,ibld(ji,jj)) = 0._wp 1368 ENDIF 1369 ENDIF 1370 ELSE 1371 ! stable conditions 1372 DO jk = 2, ibld(ji,jj) 1373 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1374 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 1375 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 1376 END DO 1377 1378 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1379 zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 1380 zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w(ji, jj, ibld(ji,jj), Kmm) 1381 ENDIF 1382 ENDIF ! end if ( lconv ) 1383 ! 1384 END_2D 1385 1386 END SUBROUTINE zdf_osm_diffusivity_viscosity 1387 1388 SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear, zri_i ) 1389 1390 !!--------------------------------------------------------------------- 1391 !! *** ROUTINE zdf_osm_osbl_state *** 1392 !! 1393 !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number 1394 !! 1395 !! ** Method : 1396 !! 1397 !! !!---------------------------------------------------------------------- 1398 1399 INTEGER, DIMENSION(jpi,jpj) :: j_ddh ! j_ddh = 0, active shear layer; j_ddh=1, shear layer not active; j_ddh=2 shear production low. 1400 1401 LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear 1402 1403 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent, zwb_min ! Buoyancy fluxes at base of well-mixed layer. 1404 REAL(wp), DIMENSION(jpi,jpj) :: zshear ! production of TKE due to shear across the pycnocline 1405 REAL(wp), DIMENSION(jpi,jpj) :: zri_i ! Interfacial Richardson Number 1406 1407 ! Local Variables 1408 1409 INTEGER :: jj, ji 1410 1411 REAL(wp), DIMENSION(jpi,jpj) :: zekman 1412 REAL(wp) :: zri_p, zri_b ! Richardson numbers 1413 REAL(wp) :: zshear_u, zshear_v, zwb_shr 1414 REAL(wp) :: zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes 1415 1416 REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.1 1417 REAL, PARAMETER :: rn_ri_thres_a = 0.5, rn_ri_thresh_b = 0.59 1418 REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.04 1419 REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15 1420 REAL, PARAMETER :: rn_ri_p_thresh = 27.0 1421 REAL, PARAMETER :: zrot=0._wp ! dummy rotation rate of surface stress. 1422 1423 ! Determins stability and set flag lconv 1424 DO_2D( 0, 0, 0, 0 ) 1425 IF ( zhol(ji,jj) < 0._wp ) THEN 1426 lconv(ji,jj) = .TRUE. 1427 ELSE 1428 lconv(ji,jj) = .FALSE. 1429 ENDIF 1430 END_2D 1431 1432 zekman(:,:) = EXP( - 4.0 * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) ) 1433 1434 WHERE ( lconv ) 1435 zri_i = zdb_ml * zhml**2 / MAX( ( zvstr**3 + 0.5 * zwstrc**3 )**p2third * zdh, 1.e-12 ) 1436 END WHERE 1437 1438 zshear(:,:) = 0._wp 1439 j_ddh(:,:) = 1 1440 1441 DO_2D( 0, 0, 0, 0 ) 1442 IF ( lconv(ji,jj) ) THEN 1443 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1444 zri_p = MAX ( SQRT( zdb_bl(ji,jj) * zdh(ji,jj) / MAX( zdu_bl(ji,jj)**2 + zdv_bl(ji,jj)**2, 1.e-8) ) * ( zhbl(ji,jj) / zdh(ji,jj) ) * ( zvstr(ji,jj) / MAX( zustar(ji,jj), 1.e-6 ) )**2 & 1445 & / MAX( zekman(ji,jj), 1.e-6 ) , 5._wp ) 1446 1447 zri_b = zdb_ml(ji,jj) * zdh(ji,jj) / MAX( zdu_ml(ji,jj)**2 + zdv_ml(ji,jj)**2, 1.e-8 ) 1448 1449 zshear(ji,jj) = za_shr * zekman(ji,jj) * ( MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) + zb_shr * MAX( -ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) * zdv_ml(ji,jj) / zhbl(ji,jj), 0._wp ) ) 1450 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1451 ! Test ensures j_ddh=0 is not selected. Change to zri_p<27 when ! 1452 ! full code available ! 1453 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1454 IF ( zri_p < -rn_ri_p_thresh .and. zshear(ji,jj) > 0._wp ) THEN 1455 ! Growing shear layer 1456 j_ddh(ji,jj) = 0 1457 lshear(ji,jj) = .TRUE. 1458 ELSE 1459 j_ddh(ji,jj) = 1 1460 IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN 1461 ! shear production large enough to determine layer charcteristics, but can't maintain a shear layer. 1462 lshear(ji,jj) = .TRUE. 1463 ELSE 1464 ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline. 1465 zshear(ji,jj) = 0.5 * zshear(ji,jj) 1466 lshear(ji,jj) = .FALSE. 1467 ENDIF 1468 ENDIF 1469 ELSE ! zdb_bl test, note zshear set to zero 1470 j_ddh(ji,jj) = 2 1471 lshear(ji,jj) = .FALSE. 1472 ENDIF 1473 ENDIF 1474 END_2D 1475 1476 ! Calculate entrainment buoyancy flux due to surface fluxes. 1477 1478 DO_2D( 0, 0, 0, 0 ) 1479 IF ( lconv(ji,jj) ) THEN 1480 zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln 1481 zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 ) 1482 zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 ) 1483 zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 ) 1484 IF (nn_osm_SD_reduce > 0 ) THEN 1485 ! Effective Stokes drift already reduced from surface value 1486 zr_stokes = 1.0_wp 1487 ELSE 1488 ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd, 1489 ! requires further reduction where BL is deep 1490 zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) & 1491 & * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) ) 1492 END IF 1493 zwb_ent(ji,jj) = - 2.0 * 0.2 * zrf_conv * zwbav(ji,jj) & 1494 & - 0.15 * zrf_shear * zustar(ji,jj)**3 /zhml(ji,jj) & 1495 & + zr_stokes * ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 & 1496 & - zrf_langmuir * 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj) 1497 ! 1498 ENDIF 1499 END_2D 1500 1501 zwb_min(:,:) = 0._wp 1502 1503 DO_2D( 0, 0, 0, 0 ) 1504 IF ( lshear(ji,jj) ) THEN 1505 IF ( lconv(ji,jj) ) THEN 1506 ! Unstable OSBL 1507 zwb_shr = -za_wb_s * zshear(ji,jj) 1508 IF ( j_ddh(ji,jj) == 0 ) THEN 1509 1510 ! Developing shear layer, additional shear production possible. 1511 1512 zshear_u = MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) 1513 zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p / rn_ri_p_thresh, 1.d0 ) ) 1514 zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u ) 1515 1516 zwb_shr = -za_wb_s * zshear(ji,jj) 1517 1518 ENDIF 1519 zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 1520 zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 1521 ELSE ! IF ( lconv ) THEN - ENDIF 1522 ! Stable OSBL - shear production not coded for first attempt. 1523 ENDIF ! lconv 1524 ELSE ! lshear 1525 IF ( lconv(ji,jj) ) THEN 1526 ! Unstable OSBL 1527 zwb_shr = -za_wb_s * zshear(ji,jj) 1528 zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 1529 zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 1530 ENDIF ! lconv 1531 ENDIF ! lshear 1532 END_2D 1533 END SUBROUTINE zdf_osm_osbl_state 1534 1535 1536 SUBROUTINE zdf_osm_vertical_average( jnlev_av, jp_ext, zt, zs, zb, zu, zv, zdt, zds, zdb, zdu, zdv ) 1537 !!--------------------------------------------------------------------- 1538 !! *** ROUTINE zdf_vertical_average *** 1539 !! 1540 !! ** Purpose : Determines vertical averages from surface to jnlev. 1541 !! 1542 !! ** Method : Averages are calculated from the surface to jnlev. 1543 !! The external level used to calculate differences is ibld+ibld_ext 1544 !! 1545 !!---------------------------------------------------------------------- 1546 1547 INTEGER, DIMENSION(jpi,jpj) :: jnlev_av ! Number of levels to average over. 1548 INTEGER, DIMENSION(jpi,jpj) :: jp_ext 1549 1550 ! Alan: do we need zb? 1551 REAL(wp), DIMENSION(jpi,jpj) :: zt, zs, zb ! Average temperature and salinity 1552 REAL(wp), DIMENSION(jpi,jpj) :: zu,zv ! Average current components 1553 REAL(wp), DIMENSION(jpi,jpj) :: zdt, zds, zdb ! Difference between average and value at base of OSBL 1554 REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv ! Difference for velocity components. 1555 1556 INTEGER :: jk, ji, jj, ibld_ext 1557 REAL(wp) :: zthick, zthermal, zbeta 1558 1559 1560 zt = 0._wp 1561 zs = 0._wp 1562 zu = 0._wp 1563 zv = 0._wp 1564 DO_2D( 0, 0, 0, 0 ) 1565 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 1566 zbeta = rab_n(ji,jj,1,jp_sal) 1567 ! average over depth of boundary layer 1568 zthick = epsln 1569 DO jk = 2, jnlev_av(ji,jj) 1570 zthick = zthick + e3t(ji,jj,jk,Kmm) 1571 zt(ji,jj) = zt(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 1572 zs(ji,jj) = zs(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 1573 zu(ji,jj) = zu(ji,jj) + e3t(ji,jj,jk,Kmm) & 1574 & * ( uu(ji,jj,jk,Kbb) + uu(ji - 1,jj,jk,Kbb) ) & 1575 & / MAX( 1. , umask(ji,jj,jk) + umask(ji - 1,jj,jk) ) 1576 zv(ji,jj) = zv(ji,jj) + e3t(ji,jj,jk,Kmm) & 1577 & * ( vv(ji,jj,jk,Kbb) + vv(ji,jj - 1,jk,Kbb) ) & 1578 & / MAX( 1. , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) ) 1579 END DO 1580 zt(ji,jj) = zt(ji,jj) / zthick 1581 zs(ji,jj) = zs(ji,jj) / zthick 1582 zu(ji,jj) = zu(ji,jj) / zthick 1583 zv(ji,jj) = zv(ji,jj) / zthick 1584 zb(ji,jj) = grav * zthermal * zt(ji,jj) - grav * zbeta * zs(ji,jj) 1585 ibld_ext = jnlev_av(ji,jj) + jp_ext(ji,jj) 1586 IF ( ibld_ext < mbkt(ji,jj) ) THEN 1587 zdt(ji,jj) = zt(ji,jj) - ts(ji,jj,ibld_ext,jp_tem,Kmm) 1588 zds(ji,jj) = zs(ji,jj) - ts(ji,jj,ibld_ext,jp_sal,Kmm) 1589 zdu(ji,jj) = zu(ji,jj) - ( uu(ji,jj,ibld_ext,Kbb) + uu(ji-1,jj,ibld_ext,Kbb ) ) & 1590 & / MAX(1. , umask(ji,jj,ibld_ext ) + umask(ji-1,jj,ibld_ext ) ) 1591 zdv(ji,jj) = zv(ji,jj) - ( vv(ji,jj,ibld_ext,Kbb) + vv(ji,jj-1,ibld_ext,Kbb ) ) & 1592 & / MAX(1. , vmask(ji,jj,ibld_ext ) + vmask(ji,jj-1,ibld_ext ) ) 1593 zdb(ji,jj) = grav * zthermal * zdt(ji,jj) - grav * zbeta * zds(ji,jj) 1594 ELSE 1595 zdt(ji,jj) = 0._wp 1596 zds(ji,jj) = 0._wp 1597 zdu(ji,jj) = 0._wp 1598 zdv(ji,jj) = 0._wp 1599 zdb(ji,jj) = 0._wp 1600 ENDIF 1601 END_2D 1602 END SUBROUTINE zdf_osm_vertical_average 1603 1604 SUBROUTINE zdf_osm_velocity_rotation( zcos_w, zsin_w, zu, zv, zdu, zdv ) 1605 !!--------------------------------------------------------------------- 1606 !! *** ROUTINE zdf_velocity_rotation *** 1607 !! 1608 !! ** Purpose : Rotates frame of reference of averaged velocity components. 1609 !! 1610 !! ** Method : The velocity components are rotated into frame specified by zcos_w and zsin_w 1611 !! 1612 !!---------------------------------------------------------------------- 1613 1614 REAL(wp), DIMENSION(jpi,jpj) :: zcos_w, zsin_w ! Cos and Sin of rotation angle 1615 REAL(wp), DIMENSION(jpi,jpj) :: zu, zv ! Components of current 1616 REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv ! Change in velocity components across pycnocline 1617 1618 INTEGER :: ji, jj 1619 REAL(wp) :: ztemp 1620 1621 DO_2D( 0, 0, 0, 0 ) 1622 ztemp = zu(ji,jj) 1623 zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj) 1624 zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj) 1625 ztemp = zdu(ji,jj) 1626 zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj) 1627 zdv(ji,jj) = zdv(ji,jj) * zsin_w(ji,jj) - ztemp * zsin_w(ji,jj) 1628 END_2D 1629 END SUBROUTINE zdf_osm_velocity_rotation 1630 1631 SUBROUTINE zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 1632 !!--------------------------------------------------------------------- 1633 !! *** ROUTINE zdf_osm_osbl_state_fk *** 1634 !! 1635 !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is returned in the logicals lpyc,lflux and lmle. Used with Fox-Kemper scheme. 1636 !! lpyc :: determines whether pycnocline flux-grad relationship needs to be determined 1637 !! lflux :: determines whether effects of surface flux extend below the base of the OSBL 1638 !! lmle :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl. 1639 !! 1640 !! ** Method : 1641 !! 1642 !! 1643 !!---------------------------------------------------------------------- 1644 1645 ! Outputs 1646 LOGICAL, DIMENSION(jpi,jpj) :: lpyc, lflux, lmle 1647 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk 1648 ! 1649 REAL(wp), DIMENSION(jpi,jpj) :: znd_param 1650 REAL(wp) :: zbuoy, ztmp, zpe_mle_layer 1651 REAL(wp) :: zpe_mle_ref, zwb_ent, zdbdz_mle_int 1652 1653 znd_param(:,:) = 0._wp 1654 1655 DO_2D( 0, 0, 0, 0 ) 1656 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 1657 zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj) 1658 END_2D 1659 DO_2D( 0, 0, 0, 0 ) 1660 ! 1661 IF ( lconv(ji,jj) ) THEN 1662 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 1663 zt_mle(ji,jj) = ( zt_mle(ji,jj) * zhmle(ji,jj) - zt_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1664 zs_mle(ji,jj) = ( zs_mle(ji,jj) * zhmle(ji,jj) - zs_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1665 zb_mle(ji,jj) = ( zb_mle(ji,jj) * zhmle(ji,jj) - zb_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1666 zdbdz_mle_int = ( zb_bl(ji,jj) - ( 2.0 * zb_mle(ji,jj) -zb_bl(ji,jj) ) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 1667 ! Calculate potential energies of actual profile and reference profile. 1668 zpe_mle_layer = 0._wp 1669 zpe_mle_ref = 0._wp 1670 DO jk = ibld(ji,jj), mld_prof(ji,jj) 1671 zbuoy = grav * ( zthermal * ts(ji,jj,jk,jp_tem,Kmm) - zbeta * ts(ji,jj,jk,jp_sal,Kmm) ) 1672 zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 1673 zpe_mle_ref = zpe_mle_ref + ( zb_bl(ji,jj) - zdbdz_mle_int * ( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) ) * gdepw(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 1674 END DO 1675 ! Non-dimensional parameter to diagnose the presence of thermocline 1676 1677 znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) / ( MAX( zwb_fk(ji,jj), 1.0e-10 ) * zhmle(ji,jj) ) 1678 ENDIF 1679 ENDIF 1680 END_2D 1681 1682 ! Diagnosis 1683 DO_2D( 0, 0, 0, 0 ) 1684 IF ( lconv(ji,jj) ) THEN 1685 zwb_ent = - 2.0 * 0.2 * zwbav(ji,jj) & 1686 & - 0.15 * zustar(ji,jj)**3 /zhml(ji,jj) & 1687 & + ( 0.15 * EXP( -1.5 * zla(ji,jj) ) * zustar(ji,jj)**3 & 1688 & - 0.03 * zwstrl(ji,jj)**3 ) / zhml(ji,jj) 1689 IF ( -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 ) THEN 1690 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 1691 ! MLE layer growing 1692 IF ( znd_param (ji,jj) > 100. ) THEN 1693 ! Thermocline present 1694 lflux(ji,jj) = .FALSE. 1695 lmle(ji,jj) =.FALSE. 1696 ELSE 1697 ! Thermocline not present 1698 lflux(ji,jj) = .TRUE. 1699 lmle(ji,jj) = .TRUE. 1700 ENDIF ! znd_param > 100 1701 ! 1702 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 1703 lpyc(ji,jj) = .FALSE. 1704 ELSE 1705 lpyc = .TRUE. 1706 ENDIF 1707 ELSE 1708 ! MLE layer restricted to OSBL or just below. 1709 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 1710 ! Weak stratification MLE layer can grow. 1711 lpyc(ji,jj) = .FALSE. 1712 lflux(ji,jj) = .TRUE. 1713 lmle(ji,jj) = .TRUE. 1714 ELSE 1715 ! Strong stratification 1716 lpyc(ji,jj) = .TRUE. 1717 lflux(ji,jj) = .FALSE. 1718 lmle(ji,jj) = .FALSE. 1719 ENDIF ! zdb_bl < rn_mle_thresh_bl and 1720 ENDIF ! zhmle > 1.2 zhbl 1721 ELSE 1722 lpyc(ji,jj) = .TRUE. 1723 lflux(ji,jj) = .FALSE. 1724 lmle(ji,jj) = .FALSE. 1725 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 1726 ENDIF ! -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 1727 ELSE 1728 ! Stable Boundary Layer 1729 lpyc(ji,jj) = .FALSE. 1730 lflux(ji,jj) = .FALSE. 1731 lmle(ji,jj) = .FALSE. 1732 ENDIF ! lconv 1733 END_2D 1734 END SUBROUTINE zdf_osm_osbl_state_fk 1735 1736 SUBROUTINE zdf_osm_external_gradients(jbase, zdtdz, zdsdz, zdbdz ) 1737 !!--------------------------------------------------------------------- 1738 !! *** ROUTINE zdf_osm_external_gradients *** 1739 !! 1740 !! ** Purpose : Calculates the gradients below the OSBL 1741 !! 1742 !! ** Method : Uses ibld and ibld_ext to determine levels to calculate the gradient. 1743 !! 1744 !!---------------------------------------------------------------------- 1745 1746 INTEGER, DIMENSION(jpi,jpj) :: jbase 1747 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz ! External gradients of temperature, salinity and buoyancy. 1748 1749 INTEGER :: jj, ji, jkb, jkb1 1750 REAL(wp) :: zthermal, zbeta 1751 1752 1753 DO_2D( 0, 0, 0, 0 ) 1754 IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 1755 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 1756 zbeta = rab_n(ji,jj,1,jp_sal) 1757 jkb = jbase(ji,jj) 1758 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 1759 zdtdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_tem,Kmm) - ts(ji,jj,jkb,jp_tem,Kmm ) ) & 1760 & / e3t(ji,jj,ibld(ji,jj),Kmm) 1761 zdsdz(ji,jj) = - ( ts(ji,jj,jkb1,jp_sal,Kmm) - ts(ji,jj,jkb,jp_sal,Kmm ) ) & 1762 & / e3t(ji,jj,ibld(ji,jj),Kmm) 1763 zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj) 1764 ELSE 1765 zdtdz(ji,jj) = 0._wp 1766 zdsdz(ji,jj) = 0._wp 1767 zdbdz(ji,jj) = 0._wp 1768 END IF 1769 END_2D 1770 END SUBROUTINE zdf_osm_external_gradients 1771 1772 SUBROUTINE zdf_osm_pycnocline_scalar_profiles( zdtdz, zdsdz, zdbdz, zalpha ) 1773 1774 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz, zdsdz, zdbdz ! gradients in the pycnocline 1775 REAL(wp), DIMENSION(jpi,jpj) :: zalpha 1776 1777 INTEGER :: jk, jj, ji 1778 REAL(wp) :: ztgrad, zsgrad, zbgrad 1779 REAL(wp) :: zgamma_b_nd, znd 1780 REAL(wp) :: zzeta_m, zzeta_en, zbuoy_pyc_sc 1781 REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.15 1782 1783 DO_2D( 0, 0, 0, 0 ) 1784 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1785 IF ( lconv(ji,jj) ) THEN ! convective conditions 1786 IF ( lpyc(ji,jj) ) THEN 1787 zzeta_m = 0.1 + 0.3 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 1788 zalpha(ji,jj) = 2.0 * ( 1.0 - ( 0.80 * zzeta_m + 0.5 * SQRT( 3.14159 / zgamma_b ) ) * zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / zdb_ml(ji,jj) ) / ( 0.723 + SQRT( 3.14159 / zgamma_b ) ) 1789 zalpha(ji,jj) = MAX( zalpha(ji,jj), 0._wp ) 1790 1791 ztmp = 1._wp/MAX(zdh(ji,jj), epsln) 1792 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1793 ! Commented lines in this section are not needed in new code, once tested ! 1794 ! can be removed ! 1795 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1796 ! ztgrad = zalpha * zdt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj) 1797 ! zsgrad = zalpha * zds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj) 1798 zbgrad = zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp + zdbdz_bl_ext(ji,jj) 1799 zgamma_b_nd = zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln) 1800 DO jk = 2, ibld(ji,jj)+ibld_ext 1801 znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) * ztmp 1802 IF ( znd <= zzeta_m ) THEN 1803 ! zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * zdt_ml(ji,jj) * ztmp * & 1804 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1805 ! zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * zds_ml(ji,jj) * ztmp * & 1806 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1807 zdbdz(ji,jj,jk) = zdbdz_bl_ext(ji,jj) + zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp * & 1808 & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1809 ELSE 1810 ! zdtdz(ji,jj,jk) = ztgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1811 ! zdsdz(ji,jj,jk) = zsgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1812 zdbdz(ji,jj,jk) = zbgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1813 ENDIF 1814 END DO 1815 ENDIF ! if no pycnocline pycnocline gradients set to zero 1816 ELSE 1817 ! stable conditions 1818 ! if pycnocline profile only defined when depth steady of increasing. 1819 IF ( zdhdt(ji,jj) > 0.0 ) THEN ! Depth increasing, or steady. 1820 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1821 IF ( zhol(ji,jj) >= 0.5 ) THEN ! Very stable - 'thick' pycnocline 1822 ztmp = 1._wp/MAX(zhbl(ji,jj), epsln) 1823 ztgrad = zdt_bl(ji,jj) * ztmp 1824 zsgrad = zds_bl(ji,jj) * ztmp 1825 zbgrad = zdb_bl(ji,jj) * ztmp 1826 DO jk = 2, ibld(ji,jj) 1827 znd = gdepw(ji,jj,jk,Kmm) * ztmp 1828 zdtdz(ji,jj,jk) = ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 1829 zdbdz(ji,jj,jk) = zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 1830 zdsdz(ji,jj,jk) = zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 1831 END DO 1832 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 1833 ztmp = 1._wp/MAX(zdh(ji,jj), epsln) 1834 ztgrad = zdt_bl(ji,jj) * ztmp 1835 zsgrad = zds_bl(ji,jj) * ztmp 1836 zbgrad = zdb_bl(ji,jj) * ztmp 1837 DO jk = 2, ibld(ji,jj) 1838 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) * ztmp 1839 zdtdz(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 1840 zdbdz(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 1841 zdsdz(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 1842 END DO 1843 ENDIF ! IF (zhol >=0.5) 1844 ENDIF ! IF (zdb_bl> 0.) 1845 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero 1846 ENDIF ! IF (lconv) 1847 ENDIF ! IF ( ibld(ji,jj) < mbkt(ji,jj) ) 1848 END_2D 1849 1850 END SUBROUTINE zdf_osm_pycnocline_scalar_profiles 1851 1852 SUBROUTINE zdf_osm_pycnocline_shear_profiles( zdudz, zdvdz ) 1853 !!--------------------------------------------------------------------- 1854 !! *** ROUTINE zdf_osm_pycnocline_shear_profiles *** 1855 !! 1856 !! ** Purpose : Calculates velocity shear in the pycnocline 1857 !! 1858 !! ** Method : 1859 !! 1860 !!---------------------------------------------------------------------- 1861 1862 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz, zdvdz 1863 1864 INTEGER :: jk, jj, ji 1865 REAL(wp) :: zugrad, zvgrad, znd 1866 REAL(wp) :: zzeta_v = 0.45 1290 1867 ! 1291 END SUBROUTINE zdf_osm 1292 1293 1294 SUBROUTINE zdf_osm_init( Kmm ) 1868 DO_2D( 0, 0, 0, 0 ) 1869 ! 1870 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1871 IF ( lconv (ji,jj) ) THEN 1872 ! Unstable conditions. Shouldn;t be needed with no pycnocline code. 1873 ! zugrad = 0.7 * zdu_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / & 1874 ! & ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * & 1875 ! & MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 )) 1876 !Alan is this right? 1877 ! zvgrad = ( 0.7 * zdv_ml(ji,jj) + & 1878 ! & 2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / & 1879 ! & ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird + epsln ) & 1880 ! & )/ (zdh(ji,jj) + epsln ) 1881 ! DO jk = 2, ibld(ji,jj) - 1 + ibld_ext 1882 ! znd = -( gdepw(ji,jj,jk,Kmm) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v 1883 ! IF ( znd <= 0.0 ) THEN 1884 ! zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd ) 1885 ! zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd ) 1886 ! ELSE 1887 ! zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd ) 1888 ! zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd ) 1889 ! ENDIF 1890 ! END DO 1891 ELSE 1892 ! stable conditions 1893 zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 1894 zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 1895 DO jk = 2, ibld(ji,jj) 1896 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1897 IF ( znd < 1.0 ) THEN 1898 zdudz(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 1899 ELSE 1900 zdudz(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 1901 ENDIF 1902 zdvdz(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 1903 END DO 1904 ENDIF 1905 ! 1906 END IF ! IF ( ibld(ji,jj) + ibld_ext < mbkt(ji,jj) ) 1907 END_2D 1908 END SUBROUTINE zdf_osm_pycnocline_shear_profiles 1909 1910 SUBROUTINE zdf_osm_calculate_dhdt( zdhdt, zddhdt ) 1911 !!--------------------------------------------------------------------- 1912 !! *** ROUTINE zdf_osm_calculate_dhdt *** 1913 !! 1914 !! ** Purpose : Calculates the rate at which hbl changes. 1915 !! 1916 !! ** Method : 1917 !! 1918 !!---------------------------------------------------------------------- 1919 1920 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt, zddhdt ! Rate of change of hbl 1921 1922 INTEGER :: jj, ji 1923 REAL(wp) :: zgamma_b_nd, zgamma_dh_nd, zpert, zpsi 1924 REAL(wp) :: zvel_max!, zwb_min 1925 REAL(wp) :: zzeta_m = 0.3 1926 REAL(wp) :: zgamma_c = 2.0 1927 REAL(wp) :: zdhoh = 0.1 1928 REAL(wp) :: alpha_bc = 0.5 1929 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 1930 1931 DO_2D( 0, 0, 0, 0 ) 1932 1933 IF ( lshear(ji,jj) ) THEN 1934 IF ( lconv(ji,jj) ) THEN ! Convective 1935 1936 IF ( ln_osm_mle ) THEN 1937 1938 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 1939 ! Fox-Kemper buoyancy flux average over OSBL 1940 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 1941 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 1942 ELSE 1943 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 1944 ENDIF 1945 zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 1946 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 1947 ! OSBL is deepening, entrainment > restratification 1948 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 1949 ! *** Used for shear Needs to be changed to work stabily 1950 ! zgamma_b_nd = zdbdz_bl_ext * dh / zdb_ml 1951 ! zalpha_b = 6.7 * zgamma_b_nd / ( 1.0 + zgamma_b_nd ) 1952 ! zgamma_b = zgamma_b_nd / ( 0.12 * ( 1.25 + zgamma_b_nd ) ) 1953 ! za_1 = 1.0 / zgamma_b**2 - 0.017 1954 ! za_2 = 1.0 / zgamma_b**3 - 0.0025 1955 ! zpsi = zalpha_b * ( 1.0 + zgamma_b_nd ) * ( za_1 - 2.0 * za_2 * dh / hbl ) 1956 zpsi = 0._wp 1957 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1958 zdhdt(ji,jj) = zdhdt(ji,jj)! - zpsi * ( -1.0 / zhml(ji,jj) + 2.4 * zdbdz_bl_ext(ji,jj) / zdb_ml(ji,jj) ) * zwb_min(ji,jj) * zdh(ji,jj) / zdb_bl(ji,jj) 1959 IF ( j_ddh(ji,jj) == 1 ) THEN 1960 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 1961 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1962 ELSE 1963 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 1964 ENDIF 1965 ! Relaxation to dh_ref = zari * hbl 1966 zddhdt(ji,jj) = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 1967 1968 ELSE ! j_ddh == 0 1969 ! Growing shear layer 1970 zddhdt(ji,jj) = -a_ddh * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 1971 ENDIF ! j_ddh 1972 zdhdt(ji,jj) = zdhdt(ji,jj) ! + zpsi * zddhdt(ji,jj) 1973 ELSE ! zdb_bl >0 1974 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 1975 ENDIF 1976 ELSE ! zwb_min + 2*zwb_fk_b < 0 1977 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 1978 zdhdt(ji,jj) = - zvel_mle(ji,jj) 1979 1980 1981 ENDIF 1982 1983 ELSE 1984 ! Fox-Kemper not used. 1985 1986 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 1987 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 1988 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 1989 ! added ajgn 23 July as temporay fix 1990 1991 ENDIF ! ln_osm_mle 1992 1993 ELSE ! lconv - Stable 1994 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 1995 IF ( zdhdt(ji,jj) < 0._wp ) THEN 1996 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 1997 zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_Dt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj) 1998 ELSE 1999 zpert = MAX( 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 2000 ENDIF 2001 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 2002 ENDIF ! lconv 2003 ELSE ! lshear 2004 IF ( lconv(ji,jj) ) THEN ! Convective 2005 2006 IF ( ln_osm_mle ) THEN 2007 2008 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 2009 ! Fox-Kemper buoyancy flux average over OSBL 2010 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 2011 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 2012 ELSE 2013 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 2014 ENDIF 2015 zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2016 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 2017 ! OSBL is deepening, entrainment > restratification 2018 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 2019 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2020 ELSE 2021 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 2022 ENDIF 2023 ELSE 2024 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 2025 zdhdt(ji,jj) = - zvel_mle(ji,jj) 2026 2027 2028 ENDIF 2029 2030 ELSE 2031 ! Fox-Kemper not used. 2032 2033 zvel_max = -zwb_ent(ji,jj) / & 2034 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 2035 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2036 ! added ajgn 23 July as temporay fix 2037 2038 ENDIF ! ln_osm_mle 2039 2040 ELSE ! Stable 2041 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 2042 IF ( zdhdt(ji,jj) < 0._wp ) THEN 2043 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 2044 zpert = 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj) 2045 ELSE 2046 zpert = MAX( 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 2047 ENDIF 2048 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 2049 ENDIF ! lconv 2050 ENDIF ! lshear 2051 END_2D 2052 END SUBROUTINE zdf_osm_calculate_dhdt 2053 2054 SUBROUTINE zdf_osm_timestep_hbl( zdhdt ) 2055 !!--------------------------------------------------------------------- 2056 !! *** ROUTINE zdf_osm_timestep_hbl *** 2057 !! 2058 !! ** Purpose : Increments hbl. 2059 !! 2060 !! ** Method : If thechange in hbl exceeds one model level the change is 2061 !! is calculated by moving down the grid, changing the buoyancy 2062 !! jump. This is to ensure that the change in hbl does not 2063 !! overshoot a stable layer. 2064 !! 2065 !!---------------------------------------------------------------------- 2066 2067 2068 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! rates of change of hbl. 2069 2070 INTEGER :: jk, jj, ji, jm 2071 REAL(wp) :: zhbl_s, zvel_max, zdb 2072 REAL(wp) :: zthermal, zbeta 2073 2074 DO_2D( 0, 0, 0, 0 ) 2075 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 2076 ! 2077 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 2078 ! 2079 zhbl_s = hbl(ji,jj) 2080 jm = imld(ji,jj) 2081 zthermal = rab_n(ji,jj,1,jp_tem) 2082 zbeta = rab_n(ji,jj,1,jp_sal) 2083 2084 2085 IF ( lconv(ji,jj) ) THEN 2086 !unstable 2087 2088 IF( ln_osm_mle ) THEN 2089 zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2090 ELSE 2091 2092 zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_Dt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 2093 & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 2094 2095 ENDIF 2096 2097 DO jk = imld(ji,jj), ibld(ji,jj) 2098 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 2099 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), & 2100 & 0.0 ) + zvel_max 2101 2102 2103 IF ( ln_osm_mle ) THEN 2104 zhbl_s = zhbl_s + MIN( & 2105 & rn_Dt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2106 & e3w(ji,jj,jm,Kmm) ) 2107 ELSE 2108 zhbl_s = zhbl_s + MIN( & 2109 & rn_Dt * ( -zwb_ent(ji,jj) / zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2110 & e3w(ji,jj,jm,Kmm) ) 2111 ENDIF 2112 2113 ! zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2114 IF ( zhbl_s >= gdepw(ji,jj,mbkt(ji,jj) + 1,Kmm) ) THEN 2115 zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2116 lpyc(ji,jj) = .FALSE. 2117 ENDIF 2118 IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 2119 END DO 2120 hbl(ji,jj) = zhbl_s 2121 ibld(ji,jj) = jm 2122 ELSE 2123 ! stable 2124 DO jk = imld(ji,jj), ibld(ji,jj) 2125 zdb = MAX( & 2126 & grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) )& 2127 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ),& 2128 & 0.0 ) + & 2129 & 2.0 * zvstr(ji,jj)**2 / zhbl_s 2130 2131 ! Alan is thuis right? I have simply changed hbli to hbl 2132 zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) ) 2133 zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * & 2134 & zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) ) 2135 zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj) 2136 zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_Dt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w(ji,jj,jm,Kmm) ) 2137 2138 ! zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2139 IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN 2140 zhbl_s = MIN(zhbl_s, gdepw(ji,jj, mbkt(ji,jj) + 1,Kmm) - depth_tol) 2141 lpyc(ji,jj) = .FALSE. 2142 ENDIF 2143 IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 2144 END DO 2145 ENDIF ! IF ( lconv ) 2146 hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,4,Kmm) ) 2147 ibld(ji,jj) = MAX(jm, 4 ) 2148 ELSE 2149 ! change zero or one model level. 2150 hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw(ji,jj,4,Kmm) ) 2151 ENDIF 2152 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 2153 END_2D 2154 2155 END SUBROUTINE zdf_osm_timestep_hbl 2156 2157 SUBROUTINE zdf_osm_pycnocline_thickness( dh, zdh ) 2158 !!--------------------------------------------------------------------- 2159 !! *** ROUTINE zdf_osm_pycnocline_thickness *** 2160 !! 2161 !! ** Purpose : Calculates thickness of the pycnocline 2162 !! 2163 !! ** Method : The thickness is calculated from a prognostic equation 2164 !! that relaxes the pycnocine thickness to a diagnostic 2165 !! value. The time change is calculated assuming the 2166 !! thickness relaxes exponentially. This is done to deal 2167 !! with large timesteps. 2168 !! 2169 !!---------------------------------------------------------------------- 2170 2171 REAL(wp), DIMENSION(jpi,jpj) :: dh, zdh ! pycnocline thickness. 2172 ! 2173 INTEGER :: jj, ji 2174 INTEGER :: inhml 2175 REAL(wp) :: zari, ztau, zdh_ref 2176 REAL, PARAMETER :: a_ddh_2 = 3.5 ! also in pycnocline_depth 2177 2178 DO_2D( 0, 0, 0, 0 ) 2179 2180 IF ( lshear(ji,jj) ) THEN 2181 IF ( lconv(ji,jj) ) THEN 2182 IF ( j_ddh(ji,jj) == 0 ) THEN 2183 ! ddhdt for pycnocline determined in osm_calculate_dhdt 2184 dh(ji,jj) = dh(ji,jj) + zddhdt(ji,jj) * rn_Dt 2185 ELSE 2186 ! Temporary (probably) Recalculate dh_ref to ensure dh doesn't go negative. Can't do this using zddhdt from calculate_dhdt 2187 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 2188 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2189 ELSE 2190 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2191 ENDIF 2192 ztau = MAX( zdb_bl(ji,jj) * ( zari * hbl(ji,jj) ) / ( a_ddh_2 * MAX(-zwb_ent(ji,jj), 1.e-12) ), 2.0 * rn_Dt ) 2193 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zari * zhbl(ji,jj) * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2194 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj) 2195 ENDIF 2196 2197 ELSE ! lconv 2198 ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 2199 2200 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2201 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2202 ! boundary layer deepening 2203 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2204 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2205 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2206 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2207 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2208 ELSE 2209 zdh_ref = 0.2 * hbl(ji,jj) 2210 ENDIF 2211 ELSE ! IF(dhdt < 0) 2212 zdh_ref = 0.2 * hbl(ji,jj) 2213 ENDIF ! IF (dhdt >= 0) 2214 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2215 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2216 ! Alan: this hml is never defined or used -- do we need it? 2217 ENDIF 2218 2219 ELSE ! lshear 2220 ! for lshear = .FALSE. calculate ddhdt here 2221 2222 IF ( lconv(ji,jj) ) THEN 2223 2224 IF( ln_osm_mle ) THEN 2225 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0._wp ) THEN 2226 ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F 2227 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 2228 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 2229 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2230 ELSE ! unstable 2231 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2232 ENDIF 2233 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2234 zdh_ref = zari * hbl(ji,jj) 2235 ELSE 2236 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2237 zdh_ref = 0.2 * hbl(ji,jj) 2238 ENDIF 2239 ELSE 2240 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2241 zdh_ref = 0.2 * hbl(ji,jj) 2242 ENDIF 2243 ELSE ! ln_osm_mle 2244 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 2245 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 2246 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2247 ELSE ! unstable 2248 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2249 ENDIF 2250 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2251 zdh_ref = zari * hbl(ji,jj) 2252 ELSE 2253 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2254 zdh_ref = 0.2 * hbl(ji,jj) 2255 ENDIF 2256 2257 END IF ! ln_osm_mle 2258 2259 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2260 ! IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2261 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2262 ! Alan: this hml is never defined or used 2263 ELSE ! IF (lconv) 2264 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2265 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2266 ! boundary layer deepening 2267 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2268 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2269 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2270 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2271 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2272 ELSE 2273 zdh_ref = 0.2 * hbl(ji,jj) 2274 ENDIF 2275 ELSE ! IF(dhdt < 0) 2276 zdh_ref = 0.2 * hbl(ji,jj) 2277 ENDIF ! IF (dhdt >= 0) 2278 dh(ji,jj) = dh(ji,jj) * EXP( -rn_Dt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_Dt / ztau ) ) 2279 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2280 ENDIF ! IF (lconv) 2281 ENDIF ! lshear 2282 2283 hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 2284 inhml = MAX( INT( dh(ji,jj) / MAX(e3t(ji,jj,ibld(ji,jj),Kmm), 1.e-3) ) , 1 ) 2285 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3) 2286 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 2287 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 2288 END_2D 2289 2290 END SUBROUTINE zdf_osm_pycnocline_thickness 2291 2292 2293 SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 2294 !!---------------------------------------------------------------------- 2295 !! *** ROUTINE zdf_osm_horizontal_gradients *** 2296 !! 2297 !! ** Purpose : Calculates horizontal gradients of buoyancy for use with Fox-Kemper parametrization. 2298 !! 2299 !! ** Method : 2300 !! 2301 !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 2302 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 2303 2304 2305 REAL(wp), DIMENSION(jpi,jpj) :: dbdx_mle, dbdy_mle ! MLE horiz gradients at u & v points 2306 REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. 2307 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! == estimated FK BLD used for MLE horiz gradients == ! 2308 REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy 2309 2310 INTEGER :: ji, jj, jk ! dummy loop indices 2311 INTEGER :: ii, ij, ik, ikmax ! local integers 2312 REAL(wp) :: zc 2313 REAL(wp) :: zN2_c ! local buoyancy difference from 10m value 2314 REAL(wp), DIMENSION(jpi,jpj) :: ztm, zsm, zLf_NH, zLf_MH 2315 REAL(wp), DIMENSION(jpi,jpj,jpts):: ztsm_midu, ztsm_midv, zabu, zabv 2316 REAL(wp), DIMENSION(jpi,jpj) :: zmld_midu, zmld_midv 2317 !!---------------------------------------------------------------------- 2318 ! 2319 ! !== MLD used for MLE ==! 2320 2321 mld_prof(:,:) = nlb10 ! Initialization to the number of w ocean point 2322 zmld(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 2323 zN2_c = grav * rn_osm_mle_rho_c * r1_rho0 ! convert density criteria into N^2 criteria 2324 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 2325 ikt = mbkt(ji,jj) 2326 zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 2327 IF( zmld(ji,jj) < zN2_c ) mld_prof(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 2328 END_3D 2329 DO_2D( 1, 1, 1, 1 ) 2330 mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj)) 2331 zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 2332 END_2D 2333 ! ensure mld_prof .ge. ibld 2334 ! 2335 ikmax = MIN( MAXVAL( mld_prof(:,:) ), jpkm1 ) ! max level of the computation 2336 ! 2337 ztm(:,:) = 0._wp 2338 zsm(:,:) = 0._wp 2339 DO_3D( 1, 1, 1, 1, 1, ikmax ) 2340 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 2341 ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) 2342 zsm(ji,jj) = zsm(ji,jj) + zc * ts(ji,jj,jk,jp_sal,Kmm) 2343 END_3D 2344 ! average temperature and salinity. 2345 ztm(:,:) = ztm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 2346 zsm(:,:) = zsm(:,:) / MAX( e3t(:,:,1,Kmm), zmld(:,:) ) 2347 ! calculate horizontal gradients at u & v points 2348 2349 DO_2D( 0, 0, 1, 0 ) 2350 zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 2351 zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 2352 zmld_midu(ji,jj) = 0.25_wp * (zmld(ji+1,jj) + zmld( ji,jj)) 2353 ztsm_midu(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji+1,jj) + ztm( ji,jj) ) 2354 ztsm_midu(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji+1,jj) + zsm( ji,jj) ) 2355 END_2D 2356 2357 DO_2D( 1, 0, 0, 0 ) 2358 zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 2359 zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 2360 zmld_midv(ji,jj) = 0.25_wp * (zmld(ji,jj+1) + zmld( ji,jj)) 2361 ztsm_midv(ji,jj,jp_tem) = 0.5_wp * ( ztm(ji,jj+1) + ztm( ji,jj) ) 2362 ztsm_midv(ji,jj,jp_sal) = 0.5_wp * ( zsm(ji,jj+1) + zsm( ji,jj) ) 2363 END_2D 2364 2365 CALL eos_rab(ztsm_midu, zmld_midu, zabu, Kmm) 2366 CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm) 2367 2368 DO_2D( 0, 0, 1, 0 ) 2369 dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal)) 2370 END_2D 2371 DO_2D( 1, 0, 0, 0 ) 2372 dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal)) 2373 END_2D 2374 2375 DO_2D( 0, 0, 0, 0 ) 2376 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 2377 zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & 2378 & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) ) 2379 END_2D 2380 2381 END SUBROUTINE zdf_osm_zmld_horizontal_gradients 2382 SUBROUTINE zdf_osm_mle_parameters( mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 2383 !!---------------------------------------------------------------------- 2384 !! *** ROUTINE zdf_osm_mle_parameters *** 2385 !! 2386 !! ** Purpose : Timesteps the mixed layer eddy depth, hmle and calculates the mixed layer eddy fluxes for buoyancy, heat and salinity. 2387 !! 2388 !! ** Method : 2389 !! 2390 !! References: Fox-Kemper et al., JPO, 38, 1145-1165, 2008 2391 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 2392 2393 INTEGER, DIMENSION(jpi,jpj) :: mld_prof 2394 REAL(wp), DIMENSION(jpi,jpj) :: hmle, zhmle, zwb_fk, zvel_mle, zdiff_mle 2395 INTEGER :: ji, jj, jk ! dummy loop indices 2396 INTEGER :: ii, ij, ik, jkb, jkb1 ! local integers 2397 INTEGER , DIMENSION(jpi,jpj) :: inml_mle 2398 REAL(wp) :: ztmp, zdbdz, zdtdz, zdsdz, zthermal,zbeta, zbuoy, zdb_mle 2399 2400 ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 2401 2402 DO_2D( 0, 0, 0, 0 ) 2403 IF ( lconv(ji,jj) ) THEN 2404 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 2405 ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt. 2406 zvel_mle(ji,jj) = zdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 2407 zdiff_mle(ji,jj) = 5.e-4_wp * rn_osm_mle_ce * ztmp * zdbds_mle(ji,jj) * zhmle(ji,jj)**2 2408 ENDIF 2409 END_2D 2410 ! Timestep mixed layer eddy depth. 2411 DO_2D( 0, 0, 0, 0 ) 2412 IF ( lmle(ji,jj) ) THEN ! MLE layer growing. 2413 ! Buoyancy gradient at base of MLE layer. 2414 zthermal = rab_n(ji,jj,1,jp_tem) 2415 zbeta = rab_n(ji,jj,1,jp_sal) 2416 jkb = mld_prof(ji,jj) 2417 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 2418 ! 2419 zbuoy = grav * ( zthermal * ts(ji,jj,mld_prof(ji,jj)+2,jp_tem,Kmm) - zbeta * ts(ji,jj,mld_prof(ji,jj)+2,jp_sal,Kmm) ) 2420 zdb_mle = zb_bl(ji,jj) - zbuoy 2421 ! Timestep hmle. 2422 hmle(ji,jj) = hmle(ji,jj) + zwb0(ji,jj) * rn_Dt / zdb_mle 2423 ELSE 2424 IF ( zhmle(ji,jj) > zhbl(ji,jj) ) THEN 2425 hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt / rn_osm_mle_tau 2426 ELSE 2427 hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_Dt /rn_osm_mle_tau 2428 ENDIF 2429 ENDIF 2430 hmle(ji,jj) = MIN(hmle(ji,jj), ht(ji,jj)) 2431 IF(ln_osm_hmle_limit) hmle(ji,jj) = MIN(hmle(ji,jj), MAX(rn_osm_hmle_limit,1.2*hbl(ji,jj)) ) 2432 END_2D 2433 2434 mld_prof = 4 2435 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 2436 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 2437 END_3D 2438 DO_2D( 0, 0, 0, 0 ) 2439 zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 2440 END_2D 2441 END SUBROUTINE zdf_osm_mle_parameters 2442 2443 END SUBROUTINE zdf_osm 2444 2445 2446 SUBROUTINE zdf_osm_init( Kmm ) 1295 2447 !!---------------------------------------------------------------------- 1296 2448 !! *** ROUTINE zdf_osm_init *** … … 1304 2456 !! ** input : Namlist namosm 1305 2457 !!---------------------------------------------------------------------- 1306 INTEGER, INTENT(in) :: Kmm ! time level index (middle) 1307 ! 2458 INTEGER, INTENT(in) :: Kmm ! time level 1308 2459 INTEGER :: ios ! local integer 1309 2460 INTEGER :: ji, jj, jk ! dummy loop indices 2461 REAL z1_t2 1310 2462 !! 1311 2463 NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 1312 & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0 & 1313 & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv 2464 & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd & 2465 & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave & 2466 & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter 2467 ! Namelist for Fox-Kemper parametrization. 2468 NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat,& 2469 & rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit 2470 1314 2471 !!---------------------------------------------------------------------- 1315 2472 ! … … 1325 2482 WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation' 1326 2483 WRITE(numout,*) '~~~~~~~~~~~~' 1327 WRITE(numout,*) ' Namelist namzdf_osm : set tke mixing parameters' 1328 WRITE(numout,*) ' Use namelist rn_osm_la ln_use_osm_la = ', ln_use_osm_la 2484 WRITE(numout,*) ' Namelist namzdf_osm : set osm mixing parameters' 2485 WRITE(numout,*) ' Use rn_osm_la ln_use_osm_la = ', ln_use_osm_la 2486 WRITE(numout,*) ' Use MLE in OBL, i.e. Fox-Kemper param ln_osm_mle = ', ln_osm_mle 1329 2487 WRITE(numout,*) ' Turbulent Langmuir number rn_osm_la = ', rn_osm_la 2488 WRITE(numout,*) ' Stokes drift reduction factor rn_zdfosm_adjust_sd = ', rn_zdfosm_adjust_sd 1330 2489 WRITE(numout,*) ' Initial hbl for 1D runs rn_osm_hbl0 = ', rn_osm_hbl0 1331 WRITE(numout,*) ' Depth scale of Stokes drift rn_osm_dstokes = ', rn_osm_dstokes2490 WRITE(numout,*) ' Depth scale of Stokes drift rn_osm_dstokes = ', rn_osm_dstokes 1332 2491 WRITE(numout,*) ' horizontal average flag nn_ave = ', nn_ave 1333 2492 WRITE(numout,*) ' Stokes drift nn_osm_wave = ', nn_osm_wave … … 1339 2498 CASE(2) 1340 2499 WRITE(numout,*) ' calculated from ECMWF wave fields' 2500 END SELECT 2501 WRITE(numout,*) ' Stokes drift reduction nn_osm_SD_reduce', nn_osm_SD_reduce 2502 WRITE(numout,*) ' fraction of hbl to average SD over/fit' 2503 WRITE(numout,*) ' exponential with nn_osm_SD_reduce = 1 or 2 rn_osm_hblfrac = ', rn_osm_hblfrac 2504 SELECT CASE (nn_osm_SD_reduce) 2505 CASE(0) 2506 WRITE(numout,*) ' No reduction' 2507 CASE(1) 2508 WRITE(numout,*) ' Average SD over upper rn_osm_hblfrac of BL' 2509 CASE(2) 2510 WRITE(numout,*) ' Fit exponential to slope rn_osm_hblfrac of BL' 1341 2511 END SELECT 2512 WRITE(numout,*) ' reduce surface SD and depth scale under ice ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter 1342 2513 WRITE(numout,*) ' Output osm diagnostics ln_dia_osm = ', ln_dia_osm 2514 WRITE(numout,*) ' Threshold used to define BL rn_osm_bl_thresh = ', rn_osm_bl_thresh, 'm^2/s' 1343 2515 WRITE(numout,*) ' Use KPP-style shear instability mixing ln_kpprimix = ', ln_kpprimix 1344 2516 WRITE(numout,*) ' local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty … … 1359 2531 IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 1360 2532 1361 call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl 2533 2534 IF( ln_osm_mle ) THEN 2535 ! Initialise Fox-Kemper parametrization 2536 READ ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903) 2537 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namosm_mle in reference namelist') 2538 2539 READ ( numnam_cfg, namosm_mle, IOSTAT = ios, ERR = 904 ) 2540 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namosm_mle in configuration namelist') 2541 IF(lwm) WRITE ( numond, namosm_mle ) 2542 2543 IF(lwp) THEN ! Namelist print 2544 WRITE(numout,*) 2545 WRITE(numout,*) 'zdf_osm_init : initialise mixed layer eddy (MLE)' 2546 WRITE(numout,*) '~~~~~~~~~~~~~' 2547 WRITE(numout,*) ' Namelist namosm_mle : ' 2548 WRITE(numout,*) ' MLE type: =0 standard Fox-Kemper ; =1 new formulation nn_osm_mle = ', nn_osm_mle 2549 WRITE(numout,*) ' magnitude of the MLE (typical value: 0.06 to 0.08) rn_osm_mle_ce = ', rn_osm_mle_ce 2550 WRITE(numout,*) ' scale of ML front (ML radius of deformation) (nn_osm_mle=0) rn_osm_mle_lf = ', rn_osm_mle_lf, 'm' 2551 WRITE(numout,*) ' maximum time scale of MLE (nn_osm_mle=0) rn_osm_mle_time = ', rn_osm_mle_time, 's' 2552 WRITE(numout,*) ' reference latitude (degrees) of MLE coef. (nn_osm_mle=1) rn_osm_mle_lat = ', rn_osm_mle_lat, 'deg' 2553 WRITE(numout,*) ' Density difference used to define ML for FK rn_osm_mle_rho_c = ', rn_osm_mle_rho_c 2554 WRITE(numout,*) ' Threshold used to define MLE for FK rn_osm_mle_thresh = ', rn_osm_mle_thresh, 'm^2/s' 2555 WRITE(numout,*) ' Timescale for OSM-FK rn_osm_mle_tau = ', rn_osm_mle_tau, 's' 2556 WRITE(numout,*) ' switch to limit hmle ln_osm_hmle_limit = ', ln_osm_hmle_limit 2557 WRITE(numout,*) ' fraction of zmld to limit hmle to if ln_osm_hmle_limit =.T. rn_osm_hmle_limit = ', rn_osm_hmle_limit 2558 ENDIF ! 2559 ENDIF 2560 ! 2561 IF(lwp) THEN 2562 WRITE(numout,*) 2563 IF( ln_osm_mle ) THEN 2564 WRITE(numout,*) ' ==>>> Mixed Layer Eddy induced transport added to OSMOSIS BL calculation' 2565 IF( nn_osm_mle == 0 ) WRITE(numout,*) ' Fox-Kemper et al 2010 formulation' 2566 IF( nn_osm_mle == 1 ) WRITE(numout,*) ' New formulation' 2567 ELSE 2568 WRITE(numout,*) ' ==>>> Mixed Layer induced transport NOT added to OSMOSIS BL calculation' 2569 ENDIF 2570 ENDIF 2571 ! 2572 IF( ln_osm_mle ) THEN ! MLE initialisation 2573 ! 2574 rb_c = grav * rn_osm_mle_rho_c /rho0 ! Mixed Layer buoyancy criteria 2575 IF(lwp) WRITE(numout,*) 2576 IF(lwp) WRITE(numout,*) ' ML buoyancy criteria = ', rb_c, ' m/s2 ' 2577 IF(lwp) WRITE(numout,*) ' associated ML density criteria defined in zdfmxl = ', rn_osm_mle_rho_c, 'kg/m3' 2578 ! 2579 IF( nn_osm_mle == 0 ) THEN ! MLE array allocation & initialisation ! 2580 ! 2581 ELSEIF( nn_osm_mle == 1 ) THEN ! MLE array allocation & initialisation 2582 rc_f = rn_osm_mle_ce/ ( 5.e3_wp * 2._wp * omega * SIN( rad * rn_osm_mle_lat ) ) 2583 ! 2584 ENDIF 2585 ! ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 2586 z1_t2 = 2.e-5 2587 DO_2D( 1, 1, 1, 1 ) 2588 r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2) 2589 END_2D 2590 ! z1_t2 = 1._wp / ( rn_osm_mle_time * rn_osm_mle_timeji,jj ) 2591 ! r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 2592 ! 2593 ENDIF 2594 2595 call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl, dh, hmle 2596 1362 2597 1363 2598 IF( ln_zdfddm) THEN … … 1454 2689 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 1455 2690 1456 INTEGER :: id1, id2 ! iom enquiry index2691 INTEGER :: id1, id2, id3 ! iom enquiry index 1457 2692 INTEGER :: ji, jj, jk ! dummy loop indices 1458 2693 INTEGER :: iiki, ikt ! local integer … … 1460 2695 REAL(wp) :: zN2_c ! local scalar 1461 2696 REAL(wp) :: rho_c = 0.01_wp !: density criterion for mixed layer depth 1462 INTEGER, DIMENSION( :,:), ALLOCATABLE:: imld_rst ! level of mixed-layer depth (pycnocline top)2697 INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top) 1463 2698 !!---------------------------------------------------------------------- 1464 2699 ! … … 1470 2705 IF( id1 > 0 ) THEN ! 'wn' exists; read 1471 2706 CALL iom_get( numror, jpdom_auto, 'wn', ww ) 1472 WRITE(numout,*) ' ===>>>> : w wread from restart file'2707 WRITE(numout,*) ' ===>>>> : wn read from restart file' 1473 2708 ELSE 1474 2709 ww(:,:,:) = 0._wp 1475 WRITE(numout,*) ' ===>>>> : w wnot in restart file, set to zero initially'2710 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 1476 2711 END IF 2712 1477 2713 id1 = iom_varid( numror, 'hbl' , ldstop = .FALSE. ) 1478 id2 = iom_varid( numror, ' hbli' , ldstop = .FALSE. )2714 id2 = iom_varid( numror, 'dh' , ldstop = .FALSE. ) 1479 2715 IF( id1 > 0 .AND. id2 > 0) THEN ! 'hbl' exists; read and return 1480 2716 CALL iom_get( numror, jpdom_auto, 'hbl' , hbl ) 1481 CALL iom_get( numror, jpdom_auto, 'hbli', hbli ) 1482 WRITE(numout,*) ' ===>>>> : hbl & hbli read from restart file' 2717 CALL iom_get( numror, jpdom_auto, 'dh', dh ) 2718 WRITE(numout,*) ' ===>>>> : hbl & dh read from restart file' 2719 IF( ln_osm_mle ) THEN 2720 id3 = iom_varid( numror, 'hmle' , ldstop = .FALSE. ) 2721 IF( id3 > 0) THEN 2722 CALL iom_get( numror, jpdom_auto, 'hmle' , hmle ) 2723 WRITE(numout,*) ' ===>>>> : hmle read from restart file' 2724 ELSE 2725 WRITE(numout,*) ' ===>>>> : hmle not found, set to hbl' 2726 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 2727 END IF 2728 END IF 1483 2729 RETURN 1484 ELSE ! 'hbl' & ' hbli' not in restart file, recalculate2730 ELSE ! 'hbl' & 'dh' not in restart file, recalculate 1485 2731 WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 1486 2732 END IF … … 1490 2736 ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 1491 2737 !!----------------------------------------------------------------------------- 1492 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbli into the restart file, then return 1493 IF( ntile /= 0 .AND. ntile /= nijtile ) RETURN ! Do only on the last tile 1494 2738 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbl into the restart file, then return 1495 2739 IF(lwp) WRITE(numout,*) '---- osm-rst ----' 1496 CALL iom_rstput( kt, nitrst, numrow, 'wn' , ww ) 1497 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl ) 1498 CALL iom_rstput( kt, nitrst, numrow, 'hbli' , hbli ) 2740 CALL iom_rstput( kt, nitrst, numrow, 'wn' , ww ) 2741 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl ) 2742 CALL iom_rstput( kt, nitrst, numrow, 'dh' , dh ) 2743 IF( ln_osm_mle ) THEN 2744 CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle ) 2745 END IF 1499 2746 RETURN 1500 2747 END IF … … 1504 2751 !!----------------------------------------------------------------------------- 1505 2752 IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 1506 ALLOCATE( imld_rst(jpi,jpj) )1507 2753 ! w-level of the mixing and mixed layers 1508 2754 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) … … 1513 2759 ! 1514 2760 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 1515 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! Mixed layer level: w-level2761 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 1516 2762 ikt = mbkt(ji,jj) 1517 2763 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) … … 1520 2766 ! 1521 2767 DO_2D( 1, 1, 1, 1 ) 1522 iiki = imld_rst(ji,jj) 1523 hbl (ji,jj) = gdepw(ji,jj,iiki ,Kmm) * ssmask(ji,jj) ! Turbocline depth 2768 iiki = MAX(4,imld_rst(ji,jj)) 2769 hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm ) ! Turbocline depth 2770 dh (ji,jj) = e3t(ji,jj,iiki-1,Kmm ) ! Turbocline depth 1524 2771 END_2D 1525 hbl = MAX(hbl,epsln) 1526 hbli(:,:) = hbl(:,:) 1527 DEALLOCATE( imld_rst ) 2772 1528 2773 WRITE(numout,*) ' ===>>>> : hbl computed from stratification' 2774 2775 IF( ln_osm_mle ) THEN 2776 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 2777 WRITE(numout,*) ' ===>>>> : hmle set = to hbl' 2778 END IF 2779 2780 ww(:,:,:) = 0._wp 2781 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 1529 2782 END SUBROUTINE osm_rst 1530 2783 … … 1559 2812 ENDIF 1560 2813 1561 ! add non-local temperature and salinity flux1562 2814 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 1563 2815 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & … … 1569 2821 END_3D 1570 2822 1571 1572 ! save the non-local tracer flux trends for diagnostic 2823 ! save the non-local tracer flux trends for diagnostics 1573 2824 IF( l_trdtra ) THEN 1574 2825 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 1575 2826 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 1576 !!bug gm jpttdzdf ==> jpttosm 1577 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ zdf, ztrdt )1578 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ zdf, ztrds )2827 2828 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_osm, ztrdt ) 2829 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_osm, ztrds ) 1579 2830 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 1580 2831 ENDIF … … 1642 2893 1643 2894 !!====================================================================== 2895 1644 2896 END MODULE zdfosm -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/ZDF/zdfphy.F90
r14049 r14054 179 179 IF( ln_zdfmfc .AND. ln_zdfosm ) CALL ctl_stop( 'zdf_phy_init: chose between ln_zdfmfc and ln_zdfosm' ) 180 180 IF( lk_top .AND. ln_zdfnpc ) CALL ctl_stop( 'zdf_phy_init: npc scheme is not working with key_top' ) 181 IF( lk_top .AND. ln_zdfosm ) CALL ctl_ stop( 'zdf_phy_init: osmosis scheme is not working with key_top' )181 IF( lk_top .AND. ln_zdfosm ) CALL ctl_warn( 'zdf_phy_init: osmosis gives no non-local fluxes for TOP tracers yet' ) 182 182 IF( lk_top .AND. ln_zdfmfc ) CALL ctl_stop( 'zdf_phy_init: Mass Flux scheme is not working with key_top' ) 183 183 IF(lwp) THEN -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/nemogcm.F90
r14049 r14054 42 42 !!---------------------------------------------------------------------- 43 43 USE step_oce ! module used in the ocean time stepping module (step.F90) 44 ! 44 45 USE phycst ! physical constant (par_cst routine) 45 46 USE domain ! domain initialization (dom_init & dom_cfg routines) 46 USE closea ! treatment of closed seas (for ln_closea)47 USE usrdef_nam ! user defined configuration 48 USE tide_mod, ONLY : tide_init ! tidal components initialization (tide_init routine)49 USE bdyini 47 USE wet_dry ! Wetting and drying setting (wad_init routine) 48 USE usrdef_nam ! user defined configuration namelist 49 USE tide_mod, ONLY : tide_init ! tidal components initialization (tide_init routine) 50 USE bdyini , ONLY : bdy_init ! open boundary cond. setting (bdy_init routine) 50 51 USE istate ! initial state setting (istate_init routine) 51 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine)52 USE ldftra ! lateral diffusivity setting (ldftra_init routine)53 52 USE trdini ! dyn/tra trends initialization (trd_init routine) 54 USE asminc ! assimilation increments 55 USE asmbkg ! writing out state trajectory 56 USE diadct ! sections transports (dia_dct_init routine) 57 USE diaobs ! Observation diagnostics (dia_obs_init routine) 58 USE diacfl ! CFL diagnostics (dia_cfl_init routine) 59 USE diamlr ! IOM context management for multiple-linear-regression analysis 53 USE icbini ! handle bergs, initialisation 54 USE icbstp , ONLY : icb_end ! handle bergs, close iceberg files 55 USE cpl_oasis3 ! OASIS3 coupling 56 USE dyndmp ! Momentum damping (C1D only) 57 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 58 USE crsini ! initialise grid coarsening utility 59 USE dia25h , ONLY : dia_25h_init ! 25h mean output (initialisation) 60 USE c1d ! 1D configuration 61 USE step_c1d ! Time stepping loop for the 1D configuration 62 #if defined key_top 63 USE trcini ! passive tracer initialisation 64 #endif 65 #if defined key_nemocice_decomp 66 USE ice_domain_size, only: nx_global, ny_global 67 #endif 60 68 #if defined key_qco 61 USE st epMLF! NEMO time-stepping (stp_MLF routine)69 USE stpmlf ! NEMO time-stepping (stp_MLF routine) 62 70 #else 63 71 USE step ! NEMO time-stepping (stp routine) 64 72 #endif 65 USE isfstp ! ice shelf (isf_stp_init routine)66 USE icbini ! handle bergs, initialisation67 USE icbstp ! handle bergs, calving, themodynamics and transport68 USE cpl_oasis3 ! OASIS3 coupling69 USE c1d ! 1D configuration70 USE step_c1d ! Time stepping loop for the 1D configuration71 USE dyndmp ! Momentum damping72 USE stopar ! Stochastic param.: ???73 USE stopts ! Stochastic param.: ???74 USE diu_layers ! diurnal bulk SST and coolskin75 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline)76 USE crsini ! initialise grid coarsening utility77 USE dia25h ! 25h mean output78 USE diadetide ! Weights computation for daily detiding of model diagnostics79 USE sbc_oce , ONLY : lk_oasis80 USE wet_dry ! Wetting and drying setting (wad_init routine)81 #if defined key_top82 USE trcini ! passive tracer initialisation83 #endif84 #if defined key_nemocice_decomp85 USE ice_domain_size, only: nx_global, ny_global86 #endif87 73 ! 88 USE prtctl ! Print control89 USE in_out_manager ! I/O manager90 74 USE lib_mpp ! distributed memory computing 91 75 USE mppini ! shared/distributed memory setting (mpp_init routine) 92 76 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 93 77 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 94 #if defined key_iomput 95 USE xios ! xIOserver 96 #endif 97 #if defined key_agrif 98 USE agrif_all_update ! Master Agrif update 99 #endif 100 USE halo_mng 78 USE halo_mng ! Halo manager 101 79 102 80 IMPLICIT NONE … … 182 160 ! 183 161 DO WHILE( istp <= nitend .AND. nstop == 0 ) 184 # if defined key_qco162 # if defined key_qco 185 163 CALL stp_MLF 186 # else164 # else 187 165 CALL stp 188 # endif166 # endif 189 167 istp = istp + 1 190 168 END DO … … 195 173 ! 196 174 DO WHILE( istp <= nitend .AND. nstop == 0 ) 197 175 ! 198 176 ncom_stp = istp 199 177 IF( ln_timing ) THEN … … 202 180 IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time 203 181 ENDIF 204 205 # if defined key_qco182 ! 183 # if defined key_qco 206 184 CALL stp_MLF ( istp ) 207 # else185 # else 208 186 CALL stp ( istp ) 209 # endif187 # endif 210 188 istp = istp + 1 211 189 ! 212 190 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 213 191 ! 214 192 END DO 215 193 ! … … 279 257 INTEGER :: ios, ilocal_comm ! local integers 280 258 !! 281 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, 282 & nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle259 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, nn_isplt, nn_jsplt , nn_ictls, & 260 & nn_ictle, nn_jctls , nn_jctle 283 261 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 284 262 !!---------------------------------------------------------------------- … … 350 328 IF(lwp) THEN ! open listing units 351 329 ! 352 IF( .NOT. 330 IF( .NOT.lwm ) & ! alreay opened for narea == 1 353 331 & CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 354 332 ! … … 357 335 WRITE(numout,*) ' NEMO team' 358 336 WRITE(numout,*) ' Ocean General Circulation Model' 359 WRITE(numout,*) ' NEMO version 4.0 (20 19) '337 WRITE(numout,*) ' NEMO version 4.0 (2020) ' 360 338 WRITE(numout,*) 361 339 WRITE(numout,*) " ._ ._ ._ ._ ._ " … … 373 351 WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 374 352 WRITE(numout,*) 375 376 ! Print the working precision to ocean.output 377 IF (wp == dp) THEN 378 WRITE(numout,*) "Working precision = double-precision" 379 ELSE 380 WRITE(numout,*) "Working precision = single-precision" 353 ! 354 WRITE(numout,cform_aaa) ! Flag AAAAAAA 355 ! 356 ! ! Control print of the working precision 357 WRITE(numout,*) 358 IF( wp == dp ) THEN ; WRITE(numout,*) "par_kind : wp = Working precision = dp = double-precision" 359 ELSE ; WRITE(numout,*) "par_kind : wp = Working precision = sp = single-precision" 381 360 ENDIF 382 WRITE(numout,*) 383 ! 384 WRITE(numout,cform_aaa) ! Flag AAAAAAA 361 WRITE(numout,*) "~~~~~~~~ ****************" 362 WRITE(numout,*) 385 363 ! 386 364 ENDIF … … 415 393 416 394 ! Initialise time level indices 417 Nbb = 1 ; Nnn = 2; Naa = 3;Nrhs = Naa395 Nbb = 1 ; Nnn = 2 ; Naa = 3 ; Nrhs = Naa 418 396 #if defined key_agrif 419 Kbb_a = Nbb ; Kmm_a = Nnn;Krhs_a = Nrhs ! agrif_oce module copies of time level indices397 Kbb_a = Nbb ; Kmm_a = Nnn ; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 420 398 #endif 421 399 ! !-------------------------------! … … 423 401 ! !-------------------------------! 424 402 425 CALL nemo_ctl ! Control prints 403 CALL nemo_ctl ! Control prints of namctl and namcfg 426 404 ! 427 405 ! ! General initialization … … 437 415 CALL Agrif_Declare_Var_ini ! " " " " " DOM 438 416 #endif 439 CALL dom_init( Nbb, Nnn, Naa ) ! Domain440 IF( ln_crs ) CALL crs_init( Nnn )! coarsened grid: domain initialization417 CALL dom_init( Nbb, Nnn, Naa ) ! Domain 418 IF( ln_crs ) CALL crs_init( Nnn ) ! coarsened grid: domain initialization 441 419 IF( sn_cfctl%l_prtctl ) & 442 420 & CALL prt_ctl_init ! Print control … … 490 468 CALL dyn_spg_init ! surface pressure gradient 491 469 470 ! ! Icebergs 471 CALL icb_init( rn_Dt, nit000) ! initialise icebergs instance 472 473 ! ice shelf 474 CALL isf_init( Nbb, Nnn, Naa ) 492 475 #if defined key_top 493 476 ! ! Passive tracers … … 495 478 #endif 496 479 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 497 498 ! ! Icebergs499 CALL icb_init( rn_Dt, nit000) ! initialise icebergs instance500 501 ! ice shelf502 CALL isf_init( Nbb, Nnn, Naa )503 480 504 481 ! ! Misc. options -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/oce.F90
r13237 r14054 16 16 PRIVATE 17 17 18 PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 18 PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 19 PUBLIC oce_SWE_alloc ! routine called by nemo_init in SWE/nemogcm.F90 (Shallow Water Eq. case) 19 20 20 21 !! dynamics and tracer fields … … 68 69 INTEGER, PUBLIC, DIMENSION(2) :: noce_array !: unused array but seems to be needed to prevent agrif from creating an empty module 69 70 71 !! Shallow Water Eq. case (SWE) 72 LOGICAL, PUBLIC :: lk_SWE = .FALSE. !: shallow water flag =T in SWE configurations only 73 74 !! Stand-Alone Surface module (SAS) 75 LOGICAL, PUBLIC :: l_SAS = .FALSE. !: SAS flag =T in SAS configurations only 76 77 70 78 !!---------------------------------------------------------------------- 71 79 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 115 123 END FUNCTION oce_alloc 116 124 125 126 INTEGER FUNCTION oce_SWE_alloc() 127 !!---------------------------------------------------------------------- 128 !! *** FUNCTION oce_SWE_alloc *** 129 !!---------------------------------------------------------------------- 130 INTEGER :: ierr(2) 131 !!---------------------------------------------------------------------- 132 ! 133 lk_SWE = .TRUE. ! =T SWE case 134 ! 135 ierr(:) = 0 136 ALLOCATE( uu(jpi,jpj,jpk,jpt) , vv (jpi,jpj,jpk,jpt) , & 137 & ww(jpi,jpj,jpk) , hdiv(jpi,jpj,jpk) , ssh(jpi,jpj,jpt) , STAT=ierr(1) ) 138 ! 139 ALLOCATE( ts(jpi,jpj,jpk,jpts,jpt) , fraqsr_1lev(jpi,jpj) , & 140 & uu_b(jpi,jpj,jpt) , vv_b(jpi,jpj,jpt) , rn2(jpi,jpj,jpk) , STAT=ierr(2) ) 141 ! 142 oce_SWE_alloc = MAXVAL( ierr ) 143 IF( oce_SWE_alloc /= 0 ) CALL ctl_stop( 'STOP', 'oce_SWE_alloc: failed to allocate arrays' ) 144 ! 145 END FUNCTION oce_SWE_alloc 146 117 147 !!====================================================================== 118 148 END MODULE oce -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/step.F90
r14049 r14054 42 42 !!---------------------------------------------------------------------- 43 43 USE step_oce ! time stepping definition modules 44 !45 USE iom ! xIOs server46 44 47 45 IMPLICIT NONE -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/step_oce.F90
r14049 r14054 3 3 !! *** MODULE step_oce *** 4 4 !! Ocean time-stepping : module used in both initialisation phase and time stepping 5 !! (i.e. nemo_init and stp or stp_MLF routines) 5 6 !!====================================================================== 6 7 !! History : 3.3 ! 2010-08 (C. Ethe) Original code - reorganisation of the initial phase … … 9 10 USE oce ! ocean dynamics and tracers variables 10 11 USE dom_oce ! ocean space and time domain variables 11 USE domain, ONLY : dom_tile 12 USE zdf_oce ! ocean vertical physics variables 13 USE zdfdrg , ONLY : ln_drgimp ! implicit top/bottom friction 12 USE domain , ONLY : dom_tile 14 13 15 14 USE daymod ! calendar (day routine) … … 20 19 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 21 20 USE sbcapr ! surface boundary condition: atmospheric pressure 22 USE tide_mod, ONLY : ln_tide, tide_update23 21 USE sbcwave ! Wave intialisation 22 USE tide_mod ! tides 23 24 USE bdy_oce , ONLY : ln_bdy 25 USE bdydta ! open boundary condition data (bdy_dta routine) 26 USE bdytra ! bdy cond. for tracers (bdy_tra routine) 27 USE bdydyn3d ! bdy cond. for baroclinic vel. (bdy_dyn3d routine) 24 28 25 29 USE isf_oce ! ice shelf boundary condition 26 30 USE isfstp ! ice shelf boundary condition (isf_stp routine) 31 32 USE sshwzv ! vertical velocity and ssh (ssh_nxt routine) 33 ! (ssh_swp routine) 34 ! (wzv routine) 35 USE domvvl ! variable vertical scale factors (dom_vvl_sf_nxt routine) 36 ! (dom_vvl_sf_swp routine) 37 38 USE divhor ! horizontal divergence (div_hor routine) 39 USE dynadv ! advection (dyn_adv routine) 40 USE dynvor ! vorticity term (dyn_vor routine) 41 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine) 42 USE dynldf ! lateral momentum diffusion (dyn_ldf routine) 43 USE dynzdf ! vertical diffusion (dyn_zdf routine) 44 USE dynspg ! surface pressure gradient (dyn_spg routine) 45 USE dynatf ! time-filtering (dyn_atf routine) 27 46 28 47 USE traqsr ! solar radiation penetration (tra_qsr routine) … … 40 59 USE eosbn2 ! equation of state (eos_bn2 routine) 41 60 42 USE divhor ! horizontal divergence (div_hor routine)43 USE dynadv ! advection (dyn_adv routine)44 USE dynvor ! vorticity term (dyn_vor routine)45 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine)46 USE dynldf ! lateral momentum diffusion (dyn_ldf routine)47 USE dynzdf ! vertical diffusion (dyn_zdf routine)48 USE dynspg ! surface pressure gradient (dyn_spg routine)49 50 USE dynatf ! time-filtering (dyn_atf routine)51 52 61 USE stopar ! Stochastic parametrization (sto_par routine) 53 62 USE stopts 54 55 USE bdy_oce , ONLY : ln_bdy56 USE bdydta ! open boundary condition data (bdy_dta routine)57 USE bdytra ! bdy cond. for tracers (bdy_tra routine)58 USE bdydyn3d ! bdy cond. for baroclinic vel. (bdy_dyn3d routine)59 60 USE sshwzv ! vertical velocity and ssh (ssh_nxt routine)61 ! (ssh_swp routine)62 ! (wzv routine)63 USE domvvl ! variable vertical scale factors (dom_vvl_sf_nxt routine)64 ! (dom_vvl_sf_swp routine)65 63 66 64 USE ldfslp ! iso-neutral slopes (ldf_slp routine) … … 68 66 USE ldftra ! lateral eddy diffusive coef. (ldf_tra routine) 69 67 68 USE zdf_oce ! ocean vertical physics variables 70 69 USE zdfphy ! vertical physics manager (zdf_phy_init routine) 71 USE zdfosm , ONLY : osm_rst, dyn_osm, tra_osm ! OSMOSIS routines used in step.F90 70 USE zdfdrg , ONLY : ln_drgimp ! implicit top/bottom friction 71 USE zdfosm , ONLY : osm_rst, dyn_osm, tra_osm ! OSMOSIS routines used in step.F90 72 72 USE zdfmfc ! Mass FLux Convection routine used in step.F90 73 73 … … 83 83 USE diahth ! thermocline depth (dia_hth routine) 84 84 USE diahsb ! heat, salt and volume budgets (dia_hsb routine) 85 USE diacfl 86 USE diaobs ! Observation operator 85 USE diacfl ! CFL diagnostics (dia_cfl routine) 86 USE diaobs ! Observation operator (dia_obs routine) 87 87 USE diadetide ! Weights computation for daily detiding of model diagnostics 88 88 USE diamlr ! IOM context management for multiple-linear-regression analysis … … 94 94 USE asminc ! assimilation increments (tra_asm_inc routine) 95 95 ! (dyn_asm_inc routine) 96 USE asmbkg 96 USE asmbkg ! writing out state trajectory 97 97 USE stpctl ! time stepping control (stp_ctl routine) 98 98 USE restart ! ocean restart (rst_wri routine) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OCE/stpctl.F90
r13616 r14054 26 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 27 USE lib_mpp ! distributed memory computing 28 !29 28 USE netcdf ! NetCDF library 29 30 30 IMPLICIT NONE 31 31 PRIVATE … … 71 71 CHARACTER(len=20) :: clname 72 72 !!---------------------------------------------------------------------- 73 ! 73 74 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 74 75 ! … … 179 180 END DO 180 181 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 181 END 182 ENDIF 182 183 ! !== error handling ==! 183 184 ! !== done by all processes at every time step ==! -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OFF/dtadyn.F90
r14049 r14054 23 23 USE c1d ! 1D configuration: lk_c1d 24 24 USE dom_oce ! ocean domain: variables 25 #if !defined key_qco26 USE dom vvl! variable volume25 #if defined key_qco 26 USE domqco ! variable volume 27 27 #else 28 USE dom qco28 USE domvvl 29 29 #endif 30 30 USE zdf_oce ! ocean vertical physics: variables … … 97 97 !! * Substitutions 98 98 # include "do_loop_substitute.h90" 99 # include "domzgr_substitute.h90" 100 99 101 !!---------------------------------------------------------------------- 100 102 !! NEMO/OFF 4.0 , NEMO Consortium (2018) … … 388 390 gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 389 391 ! 390 ENDIF391 392 #endif 393 ENDIF 392 394 ! 393 395 IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN ! read depht over which runoffs are distributed … … 412 414 ENDIF 413 415 END_2D 416 ! 414 417 DO_2D( 1, 1, 1, 1 ) ! set the associated depth 415 418 h_rnf(ji,jj) = 0._wp -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/OFF/nemogcm.F90
r14049 r14054 64 64 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 65 65 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 66 USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 66 #if defined key_qco 67 USE stpmlf , ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 68 #else 69 USE step , ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 70 #endif 67 71 USE halo_mng 68 72 … … 143 147 CALL dta_dyn_atf( istp, Nbb, Nnn, Naa ) ! time filter of sea surface height and vertical scale factors 144 148 # if defined key_qco 145 CALL dom_qco_r3c( ssh(:,:, Kmm), r3t_f, r3u_f, r3v_f )149 CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) 146 150 # endif 147 151 ENDIF 148 152 CALL trc_stp ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping 149 153 # if defined key_qco 150 !r3t(:,:, Kmm) = r3t_f(:,:) ! update ssh to h0 ratio151 !r3u(:,:, Kmm) = r3u_f(:,:)152 !r3v(:,:, Kmm) = r3v_f(:,:)154 !r3t(:,:,Nnn) = r3t_f(:,:) ! update ssh to h0 ratio 155 !r3u(:,:,Nnn) = r3u_f(:,:) 156 !r3v(:,:,Nnn) = r3v_f(:,:) 153 157 # endif 154 158 #endif … … 160 164 ! 161 165 #if ! defined key_qco 162 # if ! defined key_sed_off166 # if ! defined key_sed_off 163 167 IF( .NOT.ln_linssh ) CALL dta_dyn_sf_interp( istp, Nnn ) ! calculate now grid parameters 164 # endif168 # endif 165 169 #endif 166 170 CALL stp_ctl ( istp ) ! Time loop: control and print -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SAS/nemogcm.F90
r14049 r14054 34 34 USE diu_layers ! diurnal bulk SST and coolskin 35 35 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 36 USE icb_oce ! icebergs 36 37 ! 37 38 USE prtctl ! Print control … … 215 216 !!---------------------------------------------------------------------- 216 217 ! 217 IF( lk_oasis ) THEN ; cxios_context = 'sas' 218 ELSE ; cxios_context = 'nemo' 218 IF( lk_oasis ) THEN ; cxios_context = 'sas' ! when coupling SAS to OCE 219 ELSE ; cxios_context = 'nemo' ! 219 220 ENDIF 220 221 nn_hls = 1 222 ! 223 l_SAS = .TRUE. ! used in domain:dom_nam 221 224 ! 222 225 ! !-------------------------------------------------! … … 393 396 ! ==> 394 397 CALL icb_init( rn_Dt, nit000) ! initialise icebergs instance 398 399 ! compatibility check 400 IF( ln_icebergs .AND. ln_M2016 ) THEN 401 IF( lwp ) WRITE(numout,*) ' ==>>> ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)' 402 CALL ctl_stop('ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)') 403 END IF 395 404 ! 396 405 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SAS/sbcssm.F90
r13286 r14054 21 21 USE zpshde ! z-coord. with partial steps: horizontal derivatives 22 22 USE closea ! for ln_closea 23 USE icb_oce ! for icebergs 23 24 ! 24 25 USE in_out_manager ! I/O manager … … 226 227 ln_closea = .false. 227 228 ENDIF 228 229 IF( ln_icebergs .AND. ln_M2016 ) THEN 230 IF( lwp ) WRITE(numout,*) ' ==>>> ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)' 231 CALL ctl_stop('ln_iceberg and ln_M2016 not compatible with SAS (need 3d data)') 232 END IF 229 233 ! 230 234 IF( l_sasread ) THEN ! store namelist information in an array -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SWE/domzgr_substitute.h90
r12983 r14054 16 16 # define e3v(i,j,k,t) (e3v_0(i,j,k)*(1._wp+r3v(i,j,t))) 17 17 # define e3f(i,j,k) (e3f_0(i,j,k)*(1._wp+r3f(i,j))) 18 # define e3f_vor(i,j,k) (e3f_0vor(i,j,k)*(1._wp+r3f(i,j))) 18 19 # define e3w(i,j,k,t) (e3w_0(i,j,k)*(1._wp+r3t(i,j,t))) 19 20 # define e3uw(i,j,k,t) (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SWE/nemogcm.F90
r14049 r14054 4 4 !! Ocean system : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice) 5 5 !!====================================================================== 6 !! History : OPA ! 1990-10 (C. Levy, G. Madec) Original code 7 !! 7.0 ! 1991-11 (M. Imbard, C. Levy, G. Madec) 8 !! 7.1 ! 1993-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 9 !! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 10 !! - ! 1992-06 (L.Terray) coupling implementation 11 !! - ! 1993-11 (M.A. Filiberti) IGLOO sea-ice 12 !! 8.0 ! 1996-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 13 !! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 14 !! 8.1 ! 1997-06 (M. Imbard, G. Madec) 15 !! 8.2 ! 1999-11 (M. Imbard, H. Goosse) sea-ice model 16 !! ! 1999-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 17 !! ! 2000-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) 18 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and modules 19 !! - ! 2004-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 20 !! - ! 2004-08 (C. Talandier) New trends organization 21 !! - ! 2005-06 (C. Ethe) Add the 1D configuration possibility 22 !! - ! 2005-11 (V. Garnier) Surface pressure gradient organization 23 !! - ! 2006-03 (L. Debreu, C. Mazauric) Agrif implementation 24 !! - ! 2006-04 (G. Madec, R. Benshila) Step reorganization 25 !! - ! 2007-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 26 !! 3.2 ! 2009-08 (S. Masson) open/write in the listing file in mpp 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 31 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 32 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 33 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface 6 !! History : 4.0 ! 2020-05 (A. Nasser, G. Madec) Original code from 4.0.2 7 !! - ! 2020-10 (S. Techene, G. Madec) cleanning 34 8 !!---------------------------------------------------------------------- 35 9 … … 42 16 !!---------------------------------------------------------------------- 43 17 USE step_oce ! module used in the ocean time stepping module (step.F90) 18 ! 44 19 USE phycst ! physical constant (par_cst routine) 45 20 USE domain ! domain initialization (dom_init & dom_cfg routines) 46 USE closea ! treatment of closed seas (for ln_closea)47 21 USE usrdef_nam ! user defined configuration 48 USE tide_mod, ONLY : tide_init ! tidal components initialization (tide_init routine)49 USE bdy_oce, ONLY : ln_bdy50 22 USE bdyini ! open boundary cond. setting (bdy_init routine) 51 23 USE istate ! initial state setting (istate_init routine) 52 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 53 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 54 USE trdini ! dyn/tra trends initialization (trd_init routine) 55 USE asminc ! assimilation increments 56 USE asmbkg ! writing out state trajectory 57 USE diaptr ! poleward transports (dia_ptr_init routine) 58 USE diadct ! sections transports (dia_dct_init routine) 59 USE diaobs ! Observation diagnostics (dia_obs_init routine) 60 USE diacfl ! CFL diagnostics (dia_cfl_init routine) 61 USE diamlr ! IOM context management for multiple-linear-regression analysis 24 USE trd_oce , ONLY : l_trddyn ! dynamical trend logical 62 25 #if defined key_RK3 63 USE stpRK3 64 #elif defined key_qco 65 USE stpLF 26 USE stprk3 ! NEMO time-stepping (stp_RK3 routine) 66 27 #else 67 USE step ! NEMO time-stepping (stp routine) 68 #endif 69 USE isfstp ! ice shelf (isf_stp_init routine) 70 USE icbini ! handle bergs, initialisation 71 USE icbstp ! handle bergs, calving, themodynamics and transport 72 USE cpl_oasis3 ! OASIS3 coupling 73 USE c1d ! 1D configuration 74 USE step_c1d ! Time stepping loop for the 1D configuration 75 USE dyndmp ! Momentum damping 76 USE stopar ! Stochastic param.: ??? 77 USE stopts ! Stochastic param.: ??? 78 USE diu_layers ! diurnal bulk SST and coolskin 79 USE crsini ! initialise grid coarsening utility 80 USE dia25h ! 25h mean output 81 USE diadetide ! Weights computation for daily detiding of model diagnostics 82 USE sbc_oce , ONLY : lk_oasis 83 USE wet_dry ! Wetting and drying setting (wad_init routine) 84 #if defined key_top 85 USE trcini ! passive tracer initialisation 86 #endif 87 #if defined key_nemocice_decomp 88 USE ice_domain_size, only: nx_global, ny_global 28 USE stpmlf ! NEMO time-stepping (stp_MLF routine) 89 29 #endif 90 30 ! 91 31 USE lib_mpp ! distributed memory computing 92 32 USE mppini ! shared/distributed memory setting (mpp_init routine) 93 USE lbcnfd , ONLY : isendto, nsndto , nfsloop, nfeloop! Setup of north fold exchanges33 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 94 34 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 95 #if defined key_iomput 96 USE xios ! xIOserver 97 #endif 98 #if defined key_agrif 99 USE agrif_all_update ! Master Agrif update 100 #endif 35 USE halo_mng ! Halo manager 101 36 102 37 IMPLICIT NONE … … 139 74 !!---------------------------------------------------------------------- 140 75 ! 141 #if defined key_agrif142 CALL Agrif_Init_Grids() ! AGRIF: set the meshes143 #endif144 76 ! !-----------------------! 145 77 CALL nemo_init !== Initialisations ==! 146 78 ! !-----------------------! 147 148 #if defined key_agrif149 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices150 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM151 CALL Agrif_Declare_Var ! " " " " " DYN/TRA152 # if defined key_top153 CALL Agrif_Declare_Var_top ! " " " " " TOP154 # endif155 # if defined key_si3156 CALL Agrif_Declare_Var_ice ! " " " " " Sea ice157 # endif158 #endif159 79 ! check that all process are still there... If some process have an error, 160 80 ! they will never enter in step and other processes will wait until the end of the cpu time! 81 ! 82 ! ! SWE case: only with key_qco 83 #if ! defined key_qco 84 CALL ctl_stop( 'nemo_gcm (SWE): shallow water model requires key_qco' ) 85 #endif 86 ! 161 87 CALL mpp_max( 'nemogcm', nstop ) 162 88 … … 174 100 ! 175 101 DO WHILE( istp <= nitend .AND. nstop == 0 ) 176 102 ! 177 103 ncom_stp = istp 178 104 IF( ln_timing ) THEN … … 181 107 IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time 182 108 ENDIF 109 ! 183 110 #if defined key_RK3 184 111 CALL stp_RK3 ( istp ) 185 #elif defined key_qco186 CALL stp_LF ( istp )187 112 #else 188 CALL stp 113 CALL stp_MLF ( istp ) 189 114 #endif 190 115 istp = istp + 1 191 116 ! 192 117 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 193 118 ! 194 119 END DO 195 120 ! … … 232 157 INTEGER :: ios, ilocal_comm ! local integers 233 158 !! 234 NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle, & 235 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 236 & ln_timing, ln_diacfl 159 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, nn_isplt, nn_jsplt , nn_ictls, & 160 & nn_ictle, nn_jctls , nn_jctle 237 161 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 238 162 !!---------------------------------------------------------------------- … … 246 170 ! 247 171 #if defined key_iomput 248 IF( Agrif_Root() ) THEN 249 IF( lk_oasis ) THEN 250 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 251 CALL xios_initialize( "not used" , local_comm =ilocal_comm ) ! send nemo communicator to xios 252 ELSE 253 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios 254 ENDIF 255 ENDIF 172 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios 256 173 CALL mpp_start( ilocal_comm ) 257 174 #else 258 IF( lk_oasis ) THEN 259 IF( Agrif_Root() ) THEN 260 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 261 ENDIF 262 CALL mpp_start( ilocal_comm ) 263 ELSE 264 CALL mpp_start( ) 265 ENDIF 175 CALL mpp_start( ) 266 176 #endif 267 177 ! … … 292 202 ! 293 203 ! finalize the definition of namctl variables 294 IF( sn_cfctl%l_allon ) THEN 295 ! Turn on all options. 296 CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 297 ! Ensure all processors are active 298 sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 299 ELSEIF( sn_cfctl%l_config ) THEN 300 ! Activate finer control of report outputs 301 ! optionally switch off output from selected areas (note this only 302 ! applies to output which does not involve global communications) 303 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 304 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 305 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 306 ELSE 307 ! turn off all options. 308 CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 309 ENDIF 204 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 205 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 310 206 ! 311 207 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print … … 336 232 WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 337 233 WRITE(numout,*) 234 235 ! Print the working precision to ocean.output 236 IF (wp == dp) THEN 237 WRITE(numout,*) "Working precision = double-precision" 238 ELSE 239 WRITE(numout,*) "Working precision = single-precision" 240 ENDIF 241 WRITE(numout,*) 338 242 ! 339 243 WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 353 257 ! 354 258 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 355 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )259 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 356 260 ELSE ! user-defined namelist 357 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )261 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 358 262 ENDIF 359 263 ! … … 365 269 CALL mpp_init 366 270 271 CALL halo_mng_init() 367 272 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 368 273 CALL nemo_alloc() 369 274 370 275 ! Initialise time level indices 371 Nbb = 1 ; Nnn = 2; Naa = 3;Nrhs = Naa372 276 Nbb = 1 ; Nnn = 2 ; Naa = 3 ; Nrhs = Naa 277 373 278 ! !-------------------------------! 374 279 ! ! NEMO general initialization ! … … 382 287 ! 383 288 CALL phy_cst ! Physical constants 384 289 ! 290 ! ! SWE: Set rho0 and associated variables (eosbn2 not used) 291 rho0 = 1026._wp !: volumic mass of reference [kg/m3] 292 rcp = 3991.86795711963_wp !: heat capacity [J/K] 293 rho0_rcp = rho0 * rcp 294 r1_rho0 = 1._wp / rho0 295 r1_rcp = 1._wp / rcp 296 r1_rho0_rcp = 1._wp / rho0_rcp 297 ! 385 298 CALL dom_init( Nbb, Nnn, Naa ) ! Domain 386 299 … … 391 304 392 305 ! ! external forcing 393 CALL tide_init ! tidal harmonics394 395 306 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 396 397 307 398 308 ! ! Ocean physics … … 400 310 CALL ldf_dyn_init ! Lateral ocean momentum physics 401 311 402 403 312 ! ! Dynamics 404 313 CALL dyn_adv_init ! advection (vector or flux form) 405 406 314 CALL dyn_vor_init ! vorticity term including Coriolis 407 408 315 CALL dyn_ldf_init ! lateral mixing 409 316 410 CALL dyn_spg_init ! surface pressure gradient411 412 317 ! ! Diagnostics 413 CALL flo_init( Nnn ) ! drifting Floats414 415 318 IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics 416 417 CALL trd_init( Nnn ) ! Mixed-layer/Vorticity/Integral constraints trends 418 319 ! ! Trends diag: switched off 320 l_trddyn = .FALSE. ! No trend diagnostics 419 321 420 322 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 422 324 IF( ln_timing ) CALL timing_stop( 'nemo_init') 423 325 ! 424 425 326 END SUBROUTINE nemo_init 426 327 … … 440 341 WRITE(numout,*) '~~~~~~~~' 441 342 WRITE(numout,*) ' Namelist namctl' 442 WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk443 WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon444 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config445 343 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 446 344 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat … … 454 352 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 455 353 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 456 WRITE(numout,*) ' level of print nn_print = ', nn_print457 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls458 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle459 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls460 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle461 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt462 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt463 354 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 464 355 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 465 356 ENDIF 466 357 ! 467 nprint = nn_print ! convert DOCTOR namelist names into OLD names 468 nictls = nn_ictls 469 nictle = nn_ictle 470 njctls = nn_jctls 471 njctle = nn_jctle 472 isplt = nn_isplt 473 jsplt = nn_jsplt 474 358 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 475 359 IF(lwp) THEN ! control print 476 360 WRITE(numout,*) … … 482 366 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 483 367 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 484 ENDIF485 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file486 !487 ! ! Parameter control488 !489 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints490 IF( lk_mpp .AND. jpnij > 1 ) THEN491 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain492 ELSE493 IF( isplt == 1 .AND. jsplt == 1 ) THEN494 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &495 & ' - the print control will be done over the whole domain' )496 ENDIF497 ijsplt = isplt * jsplt ! total number of processors ijsplt498 ENDIF499 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'500 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt501 !502 ! ! indices used for the SUM control503 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area504 lsp_area = .FALSE.505 ELSE ! print control done over a specific area506 lsp_area = .TRUE.507 IF( nictls < 1 .OR. nictls > jpiglo ) THEN508 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )509 nictls = 1510 ENDIF511 IF( nictle < 1 .OR. nictle > jpiglo ) THEN512 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )513 nictle = jpiglo514 ENDIF515 IF( njctls < 1 .OR. njctls > jpjglo ) THEN516 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )517 njctls = 1518 ENDIF519 IF( njctle < 1 .OR. njctle > jpjglo ) THEN520 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )521 njctle = jpjglo522 ENDIF523 ENDIF524 368 ENDIF 525 369 ! … … 571 415 USE diawri , ONLY : dia_wri_alloc 572 416 USE dom_oce , ONLY : dom_oce_alloc 573 USE trc_oce , ONLY : trc_oce_alloc574 USE bdy_oce , ONLY : bdy_oce_alloc575 417 ! 576 418 INTEGER :: ierr 577 419 !!---------------------------------------------------------------------- 578 420 ! 579 ierr = oce_ alloc() ! ocean421 ierr = oce_SWE_alloc() ! ocean 580 422 ierr = ierr + dia_wri_alloc() 581 423 ierr = ierr + dom_oce_alloc() ! ocean domain 582 424 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 583 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays584 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization)585 425 ! 586 426 CALL mpp_sum( 'nemogcm', ierr ) … … 590 430 591 431 592 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto , for_all)432 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 593 433 !!---------------------------------------------------------------------- 594 434 !! *** ROUTINE nemo_set_cfctl *** 595 435 !! 596 436 !! ** Purpose : Set elements of the output control structure to setto. 597 !! for_all should be .false. unless all areas are to be598 !! treated identically.599 437 !! 600 438 !! ** Method : Note this routine can be used to switch on/off some 601 !! types of output for selected areas but any output types 602 !! that involve global communications (e.g. mpp_max, glob_sum) 603 !! should be protected from selective switching by the 604 !! for_all argument 605 !!---------------------------------------------------------------------- 606 LOGICAL :: setto, for_all 607 TYPE(sn_ctl) :: sn_cfctl 608 !!---------------------------------------------------------------------- 609 IF( for_all ) THEN 610 sn_cfctl%l_runstat = setto 611 sn_cfctl%l_trcstat = setto 612 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 613 446 sn_cfctl%l_oceout = setto 614 447 sn_cfctl%l_layout = setto … … 620 453 !!====================================================================== 621 454 END MODULE nemogcm 622 -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/SWE/stpctl.F90
r13458 r14054 3 3 !! *** MODULE stpctl *** 4 4 !! Ocean run control : gross check of the ocean time stepping 5 !! *** Shallow Water Equation (SWE) case *** 6 !! ( No test on temperature and salinity ) 5 7 !!====================================================================== 6 !! History : OPA ! 1991-03 (G. Madec) Original code 7 !! 6.0 ! 1992-06 (M. Imbard) 8 !! 8.0 ! 1997-06 (A.M. Treguier) 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 !! 2.0 ! 2009-07 (G. Madec) Add statistic for time-spliting 11 !! 3.7 ! 2016-09 (G. Madec) Remove solver 12 !! 4.0 ! 2017-04 (G. Madec) regroup global communications 8 !! History : SWE ! 2020-09 (A. Nasser, S. Techene ) OCE/stpctl adaptated to SWE 13 9 !!---------------------------------------------------------------------- 14 10 … … 21 17 USE zdf_oce , ONLY : ln_zad_Aimp ! ocean vertical physics variables 22 18 USE wet_dry, ONLY : ll_wd, ssh_ref ! reference depth for negative bathy 23 ! 19 ! 24 20 USE diawri ! Standard run outputs (dia_wri_state routine) 25 21 USE in_out_manager ! I/O manager 26 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 23 USE lib_mpp ! distributed memory computing 28 !29 24 USE netcdf ! NetCDF library 25 30 26 IMPLICIT NONE 31 27 PRIVATE … … 35 31 INTEGER :: nrunid ! netcdf file id 36 32 INTEGER, DIMENSION(2) :: nvarid ! netcdf variable id 33 34 # include "domzgr_substitute.h90" 37 35 !!---------------------------------------------------------------------- 38 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 49 47 !! 50 48 !! ** Method : - Save the time step in numstp 49 !! - Print it each 50 time steps 51 50 !! - Stop the run IF problem encountered by setting nstop > 0 52 !! Problems checked: negative sea surface height51 !! Problems checked: e3t0+ssh minimum smaller that 0 53 52 !! |U| maximum larger than 10 m/s 53 !! ( not for SWE : negative sea surface salinity ) 54 54 !! 55 55 !! ** Actions : "time.step" file = last ocean time-step … … 63 63 INTEGER :: idtime, istatus 64 64 INTEGER , DIMENSION(3) :: iareasum, iareamin, iareamax 65 INTEGER , DIMENSION(3, 2) :: iloc ! min/max loc indices65 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 66 66 REAL(wp) :: zzz ! local real 67 67 REAL(wp), DIMENSION(3) :: zmax, zmaxlocal … … 70 70 CHARACTER(len=20) :: clname 71 71 !!---------------------------------------------------------------------- 72 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 73 ! 72 74 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 73 75 ! … … 109 111 ! !== test of local extrema ==! 110 112 ! !== done by all processes at every time step ==! 111 !112 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region113 llmsk(Nie1: jpi,:,:) = .FALSE.114 llmsk(:, 1:Njs1,:) = .FALSE.115 llmsk(:,Nje1: jpj,:) = .FALSE.116 ! 113 zmax(1) = MINVAL( e3t_0(:,:,1)+ssh(:,:,Kmm) ) ! e3t_Kmm min 114 llmsk(:,:,:) = umask(:,:,:) == 1._wp 115 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ), mask = llmsk ) ! velocity max (zonal only) 116 zmax(3) = REAL( nstop , wp ) ! stop indicator 117 ! !== get global extrema ==! 118 ! !== done by all processes if writting run.stat ==! 117 119 llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp ! define only the inner domain 118 120 zmax(1) = MAXVAL( -e3t(:,:,1,Kmm) ), mask = llmsk(:,:,1) ) ! ssh max … … 131 133 IF( ll_wrtruns ) THEN 132 134 WRITE(numrun,9500) kt, zmax(1), zmax(2) 133 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ -zmax(1)/), (/kt/), (/1/) )134 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ 135 istatus = NF90_PUT_VAR( nrunid, nvarid(1), (/ zmax(1)/), (/kt/), (/1/) ) 136 istatus = NF90_PUT_VAR( nrunid, nvarid(2), (/ zmax(2)/), (/kt/), (/1/) ) 135 137 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 136 END 138 ENDIF 137 139 ! !== error handling ==! 138 140 ! !== done by all processes at every time step ==! 139 141 ! 140 IF( zmax(1) > 0._wp .OR. & ! negative sea surface height 141 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 142 !!SWE specific : start 143 IF( zmax(1) <= 0._wp .OR. & ! negative e3t_Kmm 144 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 142 145 & ISNAN( zmax(1) + zmax(2) ) .OR. & ! NaN encounter in the tests 143 146 & ABS( zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests … … 148 151 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 149 152 ! get global loc on the min/max 150 llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp ! define only the inner domain 151 CALL mpp_maxloc( 'stpctl', -e3t(:,:,1,Kmm) , llmsk(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 152 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 153 CALL mpp_maxloc( 'stpctl', ABS(uu(:,:,:,Kmm)), llmsk(:,:,:), zzz, iloc(1:3,2) ) 153 CALL mpp_minloc( 'stpctl', e3t_0(:,:,1) + ssh(:,:,Kmm), ssmask(:,: ), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 154 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,Kmm)) , umask(:,:,:), zzz, iloc(1:3,2) ) 154 155 ! find which subdomain has the max. 155 156 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 … … 164 165 ELSE ! find local min and max locations: 165 166 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 166 llmsk(Nis0:Nie0,Njs0:Nje0,1) = tmask(Nis0:Nie0,Njs0:Nje0,1) == 1._wp ! define only the inner domain 167 iloc(1:2,1) = MAXLOC( -e3t(:,:,1,Kmm) , mask = llmsk(:,:,1) ) 168 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 169 iloc(1:3,2) = MAXLOC( ABS(uu(:,:,:,Kmm)), mask = llmsk(:,:,:) ) 170 DO ji = 1, 2 ! local domain indices ==> global domain indices, excluding halos 171 iloc(1:2,ji) = (/ mig0(iloc(1,ji)), mjg0(iloc(2,ji)) /) 172 END DO 167 iloc(1:2,1) = MINLOC( e3t_0(:,:,1) + ssh(:,:,Kmm), mask = ssmask(:,: ) == 1._wp ) + (/ nimpp - 1, njmpp - 1 /) 168 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 173 169 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 174 170 ENDIF 175 171 ! 176 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100or NaN encounter in the tests'177 CALL wrt_line( ctmp2, kt, ' |e3t| min', -zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) )178 CALL wrt_line( ctmp3, kt, '|U| max' , zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) )172 WRITE(ctmp1,*) ' stp_ctl: e3t0+ssh < 0 m or |U| > 10 m/s or NaN encounter in the tests' 173 CALL wrt_line( ctmp2, kt, 'e3t0+ssh min', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 174 CALL wrt_line( ctmp3, kt, '|U| max' , zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 179 175 IF( Agrif_Root() ) THEN 180 176 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' … … 194 190 ! 195 191 ENDIF 192 !!SWE specific : end 196 193 ! 197 194 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... … … 200 197 ENDIF 201 198 ! 202 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16)199 9500 FORMAT(' it :', i8, ' e3t_min: ', D23.16, ' |U|_max: ', D23.16) 203 200 ! 204 201 END SUBROUTINE stp_ctl -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/PISCES/SED/oce_sed.F90
r13237 r14054 13 13 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 14 14 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 15 !!st15 16 16 #if ! defined key_qco 17 17 USE dom_oce , ONLY : e3t => e3t !: latitude of t-point (degre) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/PISCES/SED/sedrst.F90
r14049 r14054 94 94 CALL iom_init( cw_sedrst_cxt, kdid = numrsw, ld_closedef = .FALSE. ) 95 95 #else 96 clinfo = 'Can not use XIOS in trc_rst_opn' 97 CALL ctl_stop(TRIM(clinfo)) 96 CALL ctl_stop( 'Can not use XIOS in trc_rst_opn' ) 98 97 #endif 99 98 ENDIF 100 99 101 100 lrst_sed = .TRUE. -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/TRP/trcatf.F90
r13295 r14054 32 32 USE trdtra 33 33 # if defined key_qco 34 USE traatf qco34 USE traatf_qco 35 35 # else 36 36 USE traatf -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/TRP/trctrp.F90
r12377 r14054 24 24 USE trcsbc ! surface boundary condition (trc_sbc routine) 25 25 USE trcbc ! Tracers boundary condtions ( trc_bc routine) 26 USE trcais ! Antarctic Ice Sheet tracers (trc_ais routine) 26 27 USE zpshde ! partial step: hor. derivative (zps_hde routine) 27 28 USE bdy_oce , ONLY: ln_bdy … … 65 66 IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 ) & 66 67 CALL trc_bc ( kt, Kmm, tr, Krhs ) ! tracers: surface and lateral Boundary Conditions 68 IF( ln_trcais ) CALL trc_ais ( kt, Kmm, tr, Krhs ) ! tracers from Antarctic Ice Sheet (icb, isf) 67 69 IF( ln_trabbl ) CALL trc_bbl ( kt, Kbb, Kmm, tr, Krhs ) ! advective (and/or diffusive) bottom boundary layer scheme 68 70 IF( ln_trcdmp ) CALL trc_dmp ( kt, Kbb, Kmm, tr, Krhs ) ! internal damping trends -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trc.F90
r14049 r14054 38 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: trc_o !: prescribed tracer concentration in ocean for SBC 39 39 INTEGER , PUBLIC :: nn_ice_tr !: handling of sea ice tracers 40 INTEGER , PUBLIC :: nn_ais_tr !: handling of Antarctic Ice Sheet tracers 40 41 41 42 !! interpolated gradient … … 63 64 LOGICAL , PUBLIC :: ln_trcdta !: Read inputs data from files 64 65 LOGICAL , PUBLIC :: ln_trcbc !: Enable surface, lateral or open boundaries conditions 66 LOGICAL , PUBLIC :: ln_trcais !: Enable Antarctic Ice Sheet nutrient supply 65 67 LOGICAL , PUBLIC :: ln_trcdmp !: internal damping flag 66 68 LOGICAL , PUBLIC :: ln_trcdmp_clo !: internal damping flag on closed seas … … 91 93 LOGICAL :: llcbc ! read in a file or not 92 94 LOGICAL :: llobc ! read in a file or not 95 LOGICAL :: llais ! read in a file or not 93 96 END TYPE PTRACER 94 97 ! … … 112 115 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_sbc !: Use surface boundary condition data 113 116 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_cbc !: Use coastal boundary condition data 117 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ln_trc_ais !: Use Antarctic Ice Sheet boundary condition data 114 118 LOGICAL , PUBLIC :: ln_rnf_ctl !: remove runoff dilution on tracers 115 119 REAL(wp), PUBLIC :: rn_sbc_time !: Time scaling factor for SBC data (seconds in a day) … … 157 161 & ln_trc_ini(jptra) , & 158 162 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & 163 & ln_trc_ais(jptra) , & 159 164 & STAT = ierr(1) ) 160 165 ! -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trcini.F90
r13286 r14054 25 25 USE trcice ! tracers in sea ice 26 26 USE trcbc ! generalized Boundary Conditions 27 USE trcais ! tracers from Antartic Ice Sheet 27 28 28 29 IMPLICIT NONE … … 166 167 ln_trc_cbc(jn) = sn_tracer(jn)%llcbc 167 168 ln_trc_obc(jn) = sn_tracer(jn)%llobc 169 ln_trc_ais(jn) = sn_tracer(jn)%llais 168 170 END DO 169 171 ! … … 188 190 WRITE(numout,*) 'trc_init_sms : Summary for selected passive tracers' 189 191 WRITE(numout,*) '~~~~~~~~~~~~' 190 WRITE(numout,*) ' ID NAME INI SBC CBC OBC '192 WRITE(numout,*) ' ID NAME INI SBC CBC OBC AIS' 191 193 DO jn = 1, jptra 192 WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn)194 WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn),ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn),ln_trc_ais(jn) 193 195 END DO 194 196 ENDIF … … 197 199 WRITE(numout,*) ' Applying tracer boundary conditions ' 198 200 ENDIF 201 ! 202 IF( lwp .AND. ln_trcais ) THEN 203 WRITE(numout,*) 204 WRITE(numout,*) ' Applying tracer from Antarctic Ice Sheet ' 205 ENDIF 199 206 200 9001 FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2 )207 9001 FORMAT(3x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2,3x,l2) 201 208 ! 202 209 END SUBROUTINE trc_ini_sms … … 248 255 ENDIF 249 256 ! 257 IF( ln_trcais ) CALL trc_ais_ini ! set tracers from Antarctic Ice Sheet 250 258 ! 251 259 IF( ln_rsttr ) THEN ! restart from a file -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trcnam.F90
r12489 r14054 136 136 !! 137 137 NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, & 138 & sn_tracer, ln_trcdta, ln_trcbc, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d 138 & sn_tracer, ln_trcdta, ln_trcbc, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d, & 139 & ln_trcais 139 140 !!--------------------------------------------------------------------- 140 141 ! Dummy settings to fill tracers data structure 141 ! ! name ! title ! unit ! init ! sbc ! cbc ! obc !142 sn_tracer = PTRACER( 'NONAME' , 'NOTITLE' , 'NOUNIT' , .false. , .false. , .false. , .false. )142 ! ! name ! title ! unit ! init ! sbc ! cbc ! obc ! ais ! 143 sn_tracer = PTRACER( 'NONAME' , 'NOTITLE' , 'NOUNIT' , .false. , .false. , .false. , .false. , .false. ) 143 144 ! 144 145 IF(lwp) WRITE(numout,*) … … 209 210 WRITE(numout,*) ' Read inputs data from file (y/n) ln_trcdta = ', ln_trcdta 210 211 WRITE(numout,*) ' Enable surface, lateral or open boundaries conditions (y/n) ln_trcbc = ', ln_trcbc 212 WRITE(numout,*) ' Enable Antarctic Ice Sheet nutrient supply ln_trcais = ', ln_trcais 211 213 WRITE(numout,*) ' Damping of passive tracer (y/n) ln_trcdmp = ', ln_trcdmp 212 214 WRITE(numout,*) ' Restoring of tracer on closed seas ln_trcdmp_clo = ', ln_trcdmp_clo -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/src/TOP/trcrst.F90
r14049 r14054 105 105 CALL iom_init( cw_toprst_cxt, kdid = numrtw, ld_closedef = .FALSE. ) 106 106 #else 107 clinfo = 'Can not use XIOS in trc_rst_opn' 108 CALL ctl_stop(TRIM(clinfo)) 107 CALL ctl_stop( 'Can not use XIOS in trc_rst_opn' ) 109 108 #endif 110 109 ENDIF 111 110 lrst_trc = .TRUE. 112 111 ENDIF -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/BENCH/EXPREF/namelist_cfg_orca025_like
r13461 r14054 178 178 !----------------------------------------------------------------------- 179 179 ln_dynvor_een = .true. ! energy & enstrophy scheme 180 nn_een_e3f = 0! =0 e3f = mi(mj(e3t))/4181 !! =1 e3f = mi(mj(e3t))/mi(mj( tmask))180 nn_e3f_typ = 0 ! =0 e3f = mi(mj(e3t))/4 181 ! ! =1 e3f = mi(mj(e3t))/mi(mj( tmask)) 182 182 / 183 183 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/BENCH/EXPREF/namelist_cfg_orca12_like
r13461 r14054 177 177 !----------------------------------------------------------------------- 178 178 ln_dynvor_een = .true. ! energy & enstrophy scheme 179 nn_e en_e3f= 0 ! =0 e3f = mi(mj(e3t))/4179 nn_e3f_typ = 0 ! =0 e3f = mi(mj(e3t))/4 180 180 ! ! =1 e3f = mi(mj(e3t))/mi(mj( tmask)) 181 181 / -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/BENCH/MY_SRC/usrdef_istate.F90
r13295 r14054 26 26 PRIVATE 27 27 28 PUBLIC usr_def_istate ! called by istate.F90 28 PUBLIC usr_def_istate ! called by istate.F90 29 PUBLIC usr_def_istate_ssh ! called by domqco.F90 29 30 30 31 !! * Substitutions … … 37 38 CONTAINS 38 39 39 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh )40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) !!st, pssh ) 40 41 !!---------------------------------------------------------------------- 41 42 !! *** ROUTINE usr_def_istate *** … … 52 53 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 53 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 54 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height55 !!st REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height 55 56 ! 56 57 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace … … 79 80 ! 80 81 ! sea level: 81 pssh(:,:) = z2d(:,:) ! +/- 0.05 m82 !!st pssh(:,:) = z2d(:,:) ! +/- 0.05 m 82 83 ! 83 84 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) … … 95 96 pv( :,:,jpk ) = 0._wp 96 97 ! 97 CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions98 !!st CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions 98 99 CALL lbc_lnk('usrdef_istate', pts, 'T', 1. ) ! apply boundary conditions 99 100 CALL lbc_lnk('usrdef_istate', pu, 'U', -1. ) ! apply boundary conditions … … 102 103 END SUBROUTINE usr_def_istate 103 104 105 106 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 107 !!---------------------------------------------------------------------- 108 !! *** ROUTINE usr_def_istate_ssh *** 109 !! 110 !! ** Purpose : Initialization of ssh 111 !! Here BENCH configuration 112 !! 113 !! ** Method : Set ssh 114 !!---------------------------------------------------------------------- 115 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 116 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 117 ! 118 INTEGER :: ji, jj 119 INTEGER :: igloi, igloj ! to be removed in the future, see usr_def_istate comment 120 !!---------------------------------------------------------------------- 121 ! 122 IF(lwp) WRITE(numout,*) 123 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh' 124 ! 125 igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 126 igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 127 ! sea level: +/- 0.05 m 128 DO_2D( 0, 0, 0, 0 ) 129 pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 130 END_2D 131 ! 132 CALL lbc_lnk('usrdef_istate', pssh, 'T', 1. ) ! apply boundary conditions 133 ! 134 END SUBROUTINE usr_def_istate_ssh 135 104 136 !!====================================================================== 105 137 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/CANAL/EXPREF/namelist_cfg
r13558 r14054 235 235 ln_dynvor_mix = .false. ! mixed scheme 236 236 ln_dynvor_een = .false. ! energy & enstrophy scheme 237 ln_dynvor_enT = .false. ! energy conserving scheme (T-point)237 r_enT = .false. ! energy conserving scheme (T-point) 238 238 ln_dynvor_eeT = .true. ! energy conserving scheme (een using e3t) 239 nn_e en_e3f= 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)239 nn_e3f_typ = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1) 240 240 / 241 241 !----------------------------------------------------------------------- … … 319 319 !! namdiu Cool skin and warm layer models (default: OFF) 320 320 !! namdiu Cool skin and warm layer models (default: OFF) 321 <<<<<<< .working322 !! namflo float parameters (default: OFF)323 !! nam_diadct transports through some sections (default: OFF)324 ||||||| .merge-left.r13465325 !! namflo float parameters (default: OFF)326 !! nam_diaharm Harmonic analysis of tidal constituents (default: OFF)327 !! nam_diadct transports through some sections (default: OFF)328 =======329 321 !! namflo float parameters ("key_float") 330 322 !! nam_diaharm Harmonic analysis of tidal constituents ("key_diaharm") 331 323 !! namdct transports through some sections ("key_diadct") 332 324 !! nam_diatmb Top Middle Bottom Output (default: OFF) 333 >>>>>>> .merge-right.r13470334 325 !! nam_dia25h 25h Mean Output (default: OFF) 335 326 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/CANAL/MY_SRC/usrdef_istate.F90
r13472 r14054 26 26 PRIVATE 27 27 28 PUBLIC usr_def_istate ! called by istate.F90 28 PUBLIC usr_def_istate ! called by istate.F90 29 PUBLIC usr_def_istate_ssh ! called by sshwzv.F90 29 30 30 31 !! * Substitutions … … 37 38 CONTAINS 38 39 39 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 40 41 !!---------------------------------------------------------------------- 41 42 !! *** ROUTINE usr_def_istate *** … … 52 53 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 53 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 54 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height55 55 ! 56 56 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 87 87 88 88 CASE(0) ! rest 89 90 ! sea level: 91 pssh(:,:) = 0. 89 ! 92 90 ! temperature: 93 91 pts(:,:,:,jp_tem) = 10._wp … … 99 97 100 98 CASE(1) ! geostrophic zonal jet from -zjety to +zjety 101 102 ! sea level: 103 SELECT CASE( nn_fcase ) 104 CASE(0) ! f = f0 105 ! sea level: ssh = - fuy / g 106 WHERE( ABS(gphit) <= zjety ) 107 pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 108 ELSEWHERE 109 pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 110 END WHERE 111 CASE(1) ! f = f0 + beta*y 112 ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 113 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 114 WHERE( ABS(gphit) <= zjety ) 115 pssh(:,:) = - rn_uzonal / grav * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 116 ELSEWHERE 117 pssh(:,:) = - rn_uzonal / grav * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 & 118 & + 0.5 * zbeta * zjety * zjety * 1.e6 ) 119 END WHERE 120 END SELECT 99 ! 121 100 ! temperature: 122 101 pts(:,:,:,jp_tem) = 10._wp … … 139 118 ! 140 119 CASE(2) ! geostrophic zonal current shear 141 142 ! sea level: 143 SELECT CASE( nn_fcase ) 144 CASE(0) ! f = f0 145 ! sea level: ssh = - fuy / g 146 WHERE( ABS(gphit) <= zjety ) 147 pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 148 ELSEWHERE 149 pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 150 END WHERE 151 CASE(1) ! f = f0 + beta*y 152 ! sea level: ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 153 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 154 WHERE( ABS(gphit) <= zjety ) 155 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 156 & * ( zf0 * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 157 ELSEWHERE 158 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 159 & * ( zf0 * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 160 END WHERE 161 END SELECT 120 ! 162 121 ! temperature: 163 122 pts(:,:,:,jp_tem) = 10._wp … … 176 135 ! 177 136 CASE(3) ! gaussian zonal currant 178 137 ! 179 138 ! zonal current 180 139 DO jk=1, jpkm1 … … 182 141 pu(:,:,jk) = rn_uzonal * EXP( - 0.5 * gphit(:,:)**2 / rn_lambda**2 ) 183 142 END DO 184 185 ! sea level:186 pssh(:,1) = - ff_t(:,1) / grav * pu(:,1,1) * e2t(:,1)187 DO jl=1, jpnj188 DO_2D( 0, 0, 0, 0 )189 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * pu(ji,jj,1) * e2t(ji,jj)190 END_2D191 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. )192 END DO193 194 143 ! temperature: 195 144 pts(:,:,:,jp_tem) = 10._wp … … 202 151 ! 203 152 CASE(4) ! geostrophic zonal pulse 204 153 ! 205 154 DO_2D( 1, 1, 1, 1 ) 206 155 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN … … 210 159 ELSE 211 160 zdu = 0. 212 END 161 ENDIF 213 162 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 214 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav215 163 pu(ji,jj,:) = zdu 216 164 pts(ji,jj,:,jp_sal) = zdu / rn_uzonal + 1. 217 165 ELSE 218 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav219 166 pu(ji,jj,:) = 0. 220 167 pts(ji,jj,:,jp_sal) = 1. 221 END 222 END_2D 223 168 ENDIF 169 END_2D 170 ! 224 171 ! temperature: 225 172 pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) 226 173 pv(:,:,:) = 0. 227 228 229 174 ! 175 CASE(5) ! vortex 176 ! 230 177 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 231 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic178 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 232 179 zlambda = SQRT(2._wp)*rn_lambda*1.e3 ! Horizontal scale in meters 233 180 zn2 = 3.e-3**2 … … 242 189 ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 243 190 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 244 ! Sea level:245 pssh(ji,jj) = 0.246 DO jl=1,5247 zdt = pssh(ji,jj)248 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z)249 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y)250 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g)251 END DO252 191 ! temperature: 253 192 DO jk=1,jpk … … 299 238 ! 300 239 END SELECT 301 240 ! 241 CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1. ) 242 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 243 244 END SUBROUTINE usr_def_istate 245 246 247 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 248 !!---------------------------------------------------------------------- 249 !! *** ROUTINE usr_def_istate_ssh *** 250 !! 251 !! ** Purpose : Initialization of the dynamics and tracers 252 !! Here CANAL configuration 253 !! 254 !! ** Method : Set ssh 255 !!---------------------------------------------------------------------- 256 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 257 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height 258 ! 259 INTEGER :: ji, jj, jk, jl ! dummy loop indices 260 REAL(wp) :: zx, zy, zP0, zumax, zlambda, zr_lambda2, zn2, zf0, zH, zrho1, za, zf, zdzF 261 REAL(wp) :: zpsurf, zdyPs, zdxPs 262 REAL(wp) :: zdt, zdu, zdv 263 REAL(wp) :: zjetx, zjety, zbeta 264 REAL(wp), DIMENSION(jpi,jpj) :: zrandom 265 !!---------------------------------------------------------------------- 266 ! 267 IF(lwp) WRITE(numout,*) 268 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : CANAL configuration, analytical definition of initial state' 269 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 270 ! 271 IF (ln_sshnoise) CALL RANDOM_NUMBER(zrandom) 272 zjetx = ABS(rn_ujetszx)/2. 273 zjety = ABS(rn_ujetszy)/2. 274 ! 275 SELECT CASE(nn_initcase) 276 CASE(0) !== rest ==! 277 ! 278 pssh(:,:) = 0. 279 ! 280 CASE(1) !== geostrophic zonal jet from -zjety to +zjety ==! 281 ! 282 SELECT CASE( nn_fcase ) 283 CASE(0) !* f = f0 : ssh = - fuy / g 284 WHERE( ABS(gphit) <= zjety ) 285 pssh(:,:) = - ff_t(:,:) * rn_uzonal * gphit(:,:) * 1.e3 / grav 286 ELSEWHERE 287 pssh(:,:) = - ff_t(:,:) * rn_uzonal * SIGN(zjety, gphit(:,:)) * 1.e3 / grav 288 END WHERE 289 CASE(1) !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 290 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 291 WHERE( ABS(gphit) <= zjety ) 292 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 293 ELSEWHERE 294 pssh(:,:) = - rn_uzonal / grav * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 & 295 & + 0.5 * zbeta * zjety * zjety * 1.e6 ) 296 END WHERE 297 END SELECT 298 ! 299 CASE(2) !== geostrophic zonal current shear ==! 300 ! 301 SELECT CASE( nn_fcase ) 302 CASE(0) !* f = f0 : ssh = - fuy / g 303 WHERE( ABS(gphit) <= zjety ) 304 pssh(:,:) = - ff_t(:,:) * rn_uzonal * ABS(gphit(:,:)) * 1.e3 / grav 305 ELSEWHERE 306 pssh(:,:) = - ff_t(:,:) * rn_uzonal * zjety * 1.e3 / grav 307 END WHERE 308 CASE(1) !* f = f0 + beta*y : ssh = - u / g * ( fy + 0.5 * beta * y^2 ) 309 zbeta = 2._wp * omega * COS( rad * rn_ppgphi0 ) / ra 310 WHERE( ABS(gphit) <= zjety ) 311 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 312 & * ( ff_t(:,:) * gphit(:,:) * 1.e3 + 0.5 * zbeta * gphit(:,:) * gphit(:,:) * 1.e6 ) 313 ELSEWHERE 314 pssh(:,:) = - SIGN(rn_uzonal, gphit(:,:)) / grav & 315 & * ( ff_t(:,:) * SIGN(zjety, gphit(:,:)) * 1.e3 + 0.5 * zbeta * zjety * zjety * 1.e6 ) 316 END WHERE 317 END SELECT 318 ! 319 CASE(3) !== gaussian zonal currant ==! 320 ! 321 pssh(:,1) = - ff_t(:,1) / grav * e2t(:,1) * rn_uzonal * EXP( - 0.5 * gphit(:,1)**2 / rn_lambda**2 ) 322 DO jl=1, jpnj 323 DO_2D( 0, 0, 0, 0 ) 324 pssh(ji,jj) = pssh(ji,jj-1) - ff_t(ji,jj) / grav * rn_uzonal * EXP( - 0.5 * gphit(ji,jj)**2 / rn_lambda**2 ) * e2t(ji,jj) 325 END_2D 326 CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1. ) 327 END DO 328 ! 329 CASE(4) !== geostrophic zonal pulse !!st need to implement a way to separate ssh properly ==! 330 ! 331 DO_2D( 1, 1, 1, 1 ) 332 IF ( ABS(glamt(ji,jj)) <= zjetx ) THEN 333 zdu = rn_uzonal 334 ELSEIF ( ABS(glamt(ji,jj)) <= zjetx + 100. ) THEN 335 zdu = rn_uzonal * ( ( zjetx-ABS(glamt(ji,jj)) )/100. + 1. ) 336 ELSE 337 zdu = 0. 338 ENDIF 339 IF ( ABS(gphit(ji,jj)) <= zjety ) THEN 340 pssh(ji,jj) = - ff_t(ji,jj) * zdu * gphit(ji,jj) * 1.e3 / grav 341 ELSE 342 pssh(ji,jj) = - ff_t(ji,jj) * zdu * SIGN(zjety,gphit(ji,jj)) * 1.e3 / grav 343 ENDIF 344 END_2D 345 ! 346 CASE(5) !== vortex ==! 347 ! 348 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 349 zumax = rn_vtxmax * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 350 zlambda = SQRT(2._wp)*rn_lambda ! Horizontal scale in meters 351 zn2 = 3.e-3**2 352 zH = 0.5_wp * 5000._wp 353 ! 354 zr_lambda2 = 1._wp / zlambda**2 355 zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 356 ! 357 DO_2D( 1, 1, 1, 1 ) 358 zx = glamt(ji,jj) * 1.e3 359 zy = gphit(ji,jj) * 1.e3 360 ! ! Surface pressure: P(x,y,z) = F(z) * Psurf(x,y) 361 zpsurf = zP0 * EXP(-(zx**2+zy**2)*zr_lambda2) - rho0 * ff_t(ji,jj) * rn_uzonal * zy 362 pssh(ji,jj) = 0. 363 DO jl=1,5 364 zdt = pssh(ji,jj) 365 zdzF = (1._wp - EXP(zdt-zH)) / (zH - 1._wp + EXP(-zH)) ! F'(z) 366 zrho1 = rho0 * (1._wp + zn2*zdt/grav) - zdzF * zpsurf / grav ! -1/g Dz(P) = -1/g * F'(z) * Psurf(x,y) 367 pssh(ji,jj) = zpsurf / (zrho1*grav) * ptmask(ji,jj,1) ! ssh = Psurf / (Rho*g) 368 END DO 369 END_2D 370 ! 371 END SELECT 372 ! !== add noise ==! 302 373 IF (ln_sshnoise) THEN 303 374 CALL RANDOM_SEED() 304 375 CALL RANDOM_NUMBER(zrandom) 305 376 pssh(:,:) = pssh(:,:) + ( 0.1 * zrandom(:,:) - 0.05 ) 306 END IF 307 CALL lbc_lnk( 'usrdef_istate', pssh, 'T', 1. ) 308 CALL lbc_lnk( 'usrdef_istate', pts , 'T', 1. ) 309 CALL lbc_lnk_multi( 'usrdef_istate', pu, 'U', -1., pv, 'V', -1. ) 310 311 END SUBROUTINE usr_def_istate 312 377 ENDIF 378 CALL lbc_lnk( 'usrdef_istate_ssh', pssh, 'T', 1. ) 379 ! 380 END SUBROUTINE usr_def_istate_ssh 381 313 382 !!====================================================================== 314 383 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/CPL_OASIS/EXPREF/namelist_cfg
r13558 r14054 367 367 !----------------------------------------------------------------------- 368 368 ln_dynvor_een = .true. ! energy & enstrophy scheme 369 nn_een_e3f = 0 ! =0 e3f = mean masked e3t divided by 4370 369 / 371 370 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/ISOMIP+/MY_SRC/istate.F90
r13583 r14054 117 117 CALL dta_tsd( nit000, 'ini', ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 118 118 ! 119 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 120 uu (:,:,:,Kbb) = 0._wp 121 vv (:,:,:,Kbb) = 0._wp 119 uu (:,:,:,Kbb) = 0._wp 120 vv (:,:,:,Kbb) = 0._wp 122 121 ! 123 IF( ll_wd ) THEN124 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD125 !126 ! Apply minimum wetdepth criterion127 !128 DO_2D( 1, 1, 1, 1 )129 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN130 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) )131 ENDIF132 END_2D133 ENDIF134 !135 122 ELSE ! user defined initial T and S 136 123 DO jk = 1, jpk 137 124 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 138 125 END DO 139 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) , ssh(:,:,Kbb))126 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb) ) 140 127 ENDIF 141 128 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 142 ssh (:,:,Kmm) = ssh(:,:,Kbb)143 129 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 144 130 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/ISOMIP/MY_SRC/usrdef_istate.F90
r10074 r14054 9 9 !! History : NEMO ! 2016-11 (S. Flavoni) Original code 10 10 !! ! 2017-02 (P. Mathiot, S. Flavoni) Adapt code to ISOMIP case 11 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 11 12 !!---------------------------------------------------------------------- 12 13 … … 24 25 PRIVATE 25 26 26 PUBLIC usr_def_istate ! called by istate.F90 27 PUBLIC usr_def_istate ! called by istate.F90 28 PUBLIC usr_def_istate_ssh ! called by domqco.F90 27 29 28 30 !!---------------------------------------------------------------------- … … 33 35 CONTAINS 34 36 35 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)37 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 36 38 !!---------------------------------------------------------------------- 37 39 !! *** ROUTINE usr_def_istate *** … … 48 50 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 49 51 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 50 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height51 !52 INTEGER :: jk ! dummy loop indices53 52 !!---------------------------------------------------------------------- 54 53 ! … … 58 57 pu (:,:,:) = 0._wp ! ocean at rest 59 58 pv (:,:,:) = 0._wp 60 pssh(:,:) = 0._wp61 !62 59 ! ! T & S profiles 63 60 pts(:,:,:,jp_tem) = - 1.9 * ptmask(:,:,:) ! ISOMIP configuration : start from constant T+S fields … … 66 63 END SUBROUTINE usr_def_istate 67 64 65 66 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 67 !!---------------------------------------------------------------------- 68 !! *** ROUTINE usr_def_istate_ssh *** 69 !! 70 !! ** Purpose : Initialization of ssh 71 !! Here ISOMIP configuration 72 !! 73 !! ** Method : set ssh to 0 74 !!---------------------------------------------------------------------- 75 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 76 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 77 !!---------------------------------------------------------------------- 78 ! 79 IF(lwp) WRITE(numout,*) 80 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : ISOMIP configuration, analytical definition of initial state' 81 ! 82 pssh(:,:) = 0._wp 83 ! 84 END SUBROUTINE usr_def_istate_ssh 85 68 86 !!====================================================================== 69 87 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_flux_ubs_cfg
r13558 r14054 201 201 ln_dynvor_mix = .false. ! mixed scheme 202 202 ln_dynvor_een = .false. ! energy & enstrophy scheme 203 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)204 203 / 205 204 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/LOCK_EXCHANGE/EXPREF/namelist_FCT2_vect_ens_cfg
r13476 r14054 129 129 ln_dynvor_mix = .false. ! mixed scheme 130 130 ln_dynvor_een = .false. ! energy & enstrophy scheme 131 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)132 131 / 133 132 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/LOCK_EXCHANGE/MY_SRC/usrdef_istate.F90
r12489 r14054 8 8 !!====================================================================== 9 9 !! History : NEMO ! 2016-03 (S. Flavoni, G. Madec) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 23 24 PRIVATE 24 25 25 PUBLIC usr_def_istate ! called by istate.F90 26 PUBLIC usr_def_istate ! called by istate.F90 27 PUBLIC usr_def_istate_ssh ! called by domqco.F90 26 28 27 29 !!---------------------------------------------------------------------- … … 32 34 CONTAINS 33 35 34 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)36 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 35 37 !!---------------------------------------------------------------------- 36 38 !! *** ROUTINE usr_def_istate *** … … 47 49 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 48 50 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 49 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height50 51 ! 51 52 INTEGER :: jk ! dummy loop indices … … 65 66 pu (:,:,:) = 0._wp ! ocean at rest 66 67 pv (:,:,:) = 0._wp 67 pssh(:,:) = 0._wp68 68 ! 69 69 ! ! T & S profiles … … 78 78 END SUBROUTINE usr_def_istate 79 79 80 81 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 82 !!---------------------------------------------------------------------- 83 !! *** ROUTINE usr_def_istate_ssh *** 84 !! 85 !! ** Purpose : Initialization of ssh 86 !! Here LOCK_EXCHANGE configuration 87 !! 88 !! ** Method : set ssh to 0 89 !!---------------------------------------------------------------------- 90 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 91 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 92 !!---------------------------------------------------------------------- 93 ! 94 IF(lwp) WRITE(numout,*) 95 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : LOCK_EXCHANGE configuration, analytical definition of initial state' 96 ! 97 pssh(:,:) = 0._wp 98 ! 99 END SUBROUTINE usr_def_istate_ssh 100 80 101 !!====================================================================== 81 102 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_cen-ahm1000_cfg
r13558 r14054 139 139 ln_dynvor_mix = .false. ! mixed scheme 140 140 ln_dynvor_een = .false. ! energy & enstrophy scheme 141 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)142 141 / 143 142 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT2_flux_ubs_cfg
r13558 r14054 139 139 ln_dynvor_mix = .false. ! mixed scheme 140 140 ln_dynvor_een = .false. ! energy & enstrophy scheme 141 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)142 141 / 143 142 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_cen-ahm1000_cfg
r13558 r14054 139 139 ln_dynvor_mix = .false. ! mixed scheme 140 140 ln_dynvor_een = .false. ! energy & enstrophy scheme 141 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)142 141 / 143 142 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_sco_FCT4_flux_ubs_cfg
r13558 r14054 139 139 ln_dynvor_mix = .false. ! mixed scheme 140 140 ln_dynvor_een = .false. ! energy & enstrophy scheme 141 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)142 141 / 143 142 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_zps_FCT2_flux_ubs_cfg
r13558 r14054 139 139 ln_dynvor_mix = .false. ! mixed scheme 140 140 ln_dynvor_een = .false. ! energy & enstrophy scheme 141 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)142 141 / 143 142 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_flux_ubs_cfg
r13558 r14054 201 201 ln_dynvor_mix = .false. ! mixed scheme 202 202 ln_dynvor_een = .false. ! energy & enstrophy scheme 203 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)204 203 / 205 204 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/EXPREF/namelist_zps_FCT4_vect_een_cfg
r13558 r14054 139 139 ln_dynvor_mix = .false. ! mixed scheme 140 140 ln_dynvor_een = .true. ! energy & enstrophy scheme 141 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)142 141 / 143 142 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/MY_SRC/usrdef_istate.F90
r12489 r14054 8 8 !!============================================================================== 9 9 !! History : NEMO ! 2016-03 (S. Flavoni, G. Madec) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 23 24 PRIVATE 24 25 25 PUBLIC usr_def_istate ! called by istate.F90 26 26 PUBLIC usr_def_istate ! called by istate.F90 27 PUBLIC usr_def_istate_ssh ! called by domqco.F90 28 27 29 !!---------------------------------------------------------------------- 28 30 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 32 34 CONTAINS 33 35 34 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)36 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 35 37 !!---------------------------------------------------------------------- 36 38 !! *** ROUTINE usr_def_istate *** … … 47 49 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 48 50 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 49 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height50 51 ! 51 52 INTEGER :: jk ! dummy loop indices … … 65 66 pu (:,:,:) = 0._wp ! ocean at rest 66 67 pv (:,:,:) = 0._wp 67 pssh(:,:) = 0._wp68 68 ! 69 69 ! ! T & S profiles … … 78 78 END SUBROUTINE usr_def_istate 79 79 80 81 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 82 !!---------------------------------------------------------------------- 83 !! *** ROUTINE usr_def_istate_ssh *** 84 !! 85 !! ** Purpose : Initialization of the ssh 86 !! Here OVERFLOW configuration 87 !! 88 !! ** Method : set ssh to 0 89 !!---------------------------------------------------------------------- 90 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 91 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 92 !!---------------------------------------------------------------------- 93 ! 94 IF(lwp) WRITE(numout,*) 95 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : OVERFLOW configuration, analytical definition of initial state' 96 ! 97 pssh(:,:) = 0._wp 98 ! 99 END SUBROUTINE usr_def_istate_ssh 100 80 101 !!====================================================================== 81 102 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90
r13295 r14054 193 193 pdept(ji,jj,ik+1) = pdepw(ji,jj,ik+1) + pe3t (ji,jj,ik+1) * 0.5_wp 194 194 pe3w (ji,jj,ik+1) = pdept(ji,jj,ik+1) - pdept(ji,jj,ik) ! = pe3t (ji,jj,ik ) 195 pe3w (ji,jj,ik ) = pdept(ji,jj,ik ) - pdept(ji,jj,ik-1) ! st caution ik > 1 195 196 END_2D 196 197 ! ! bottom scale factors and depth at U-, V-, UW and VW-points -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/EXPREF/1_namelist_cfg
r13558 r14054 195 195 ln_dynvor_mix = .false. ! mixed scheme 196 196 ln_dynvor_een = .true. ! energy & enstrophy scheme 197 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)198 197 / 199 198 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/EXPREF/namelist_cfg
r13558 r14054 188 188 ln_dynvor_mix = .false. ! mixed scheme 189 189 ln_dynvor_een = .true. ! energy & enstrophy scheme 190 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)191 190 / 192 191 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/MY_SRC/usrdef_istate.F90
r13295 r14054 8 8 !!====================================================================== 9 9 !! History : NEMO ! 2017-11 (J. Chanut) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 26 27 PRIVATE 27 28 28 PUBLIC usr_def_istate ! called by istate.F90 29 PUBLIC usr_def_istate ! called by istate.F90 30 PUBLIC usr_def_istate_ssh ! called by domqco.F90 29 31 30 32 !! * Substitutions … … 37 39 CONTAINS 38 40 39 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv , pssh)41 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 40 42 !!---------------------------------------------------------------------- 41 43 !! *** ROUTINE usr_def_istate *** … … 52 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 53 55 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 54 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height55 56 ! 56 57 INTEGER :: ji, jj, jk ! dummy loop indices … … 67 68 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 68 69 zumax = 1._wp * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 69 zlambda = SQRT(2._wp)*60.e3 ! Horizontal scale in meters 70 zlambda = SQRT(2._wp)*60.e3 ! Horizontal scale in meters 70 71 zn2 = 3.e-3**2 71 72 zH = 0.5_wp * 5000._wp 72 73 ! 73 74 zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 74 !75 ! Sea level:76 za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH)))77 DO_2D( 1, 1, 1, 1 )78 zx = glamt(ji,jj) * 1.e379 zy = gphit(ji,jj) * 1.e380 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_2D83 75 ! 84 76 ! temperature: … … 134 126 END SUBROUTINE usr_def_istate 135 127 128 129 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 130 !!---------------------------------------------------------------------- 131 !! *** ROUTINE usr_def_istate *** 132 !! 133 !! ** Purpose : Initialization of ssh 134 !! Here VORTEX configuration 135 !! 136 !! ** Method : Set ssh according to a gaussian anomaly of pressure and associated 137 !! geostrophic velocities 138 !!---------------------------------------------------------------------- 139 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 140 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height [m] 141 ! 142 INTEGER :: ji, jj ! dummy loop indices 143 REAL(wp) :: zx, zy, zP0, zumax, zlambda, zf0, zH, zrho1, za 144 !!---------------------------------------------------------------------- 145 ! 146 IF(lwp) WRITE(numout,*) 147 IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : VORTEX configuration, analytical definition of initial state' 148 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~ ' 149 ! 150 ! 151 ! 152 zf0 = 2._wp * omega * SIN( rad * rn_ppgphi0 ) 153 zumax = 1._wp * SIGN(1._wp, zf0) ! Here Anticyclonic: set zumax=-1 for cyclonic 154 zlambda = SQRT(2._wp)*60.e3 ! Horizontal scale in meters 155 zH = 0.5_wp * 5000._wp 156 ! 157 zP0 = rho0 * zf0 * zumax * zlambda * SQRT(EXP(1._wp)/2._wp) 158 ! 159 ! Sea level: 160 za = -zP0 * (1._wp-EXP(-zH)) / (grav*(zH-1._wp + EXP(-zH))) 161 DO_2D( 1, 1, 1, 1 ) 162 zx = glamt(ji,jj) * 1.e3 163 zy = gphit(ji,jj) * 1.e3 164 zrho1 = rho0 + za * EXP(-(zx**2+zy**2)/zlambda**2) 165 pssh(ji,jj) = zP0 * EXP(-(zx**2+zy**2)/zlambda**2)/(zrho1*grav) * ptmask(ji,jj,1) 166 END_2D 167 168 END SUBROUTINE usr_def_istate_ssh 169 136 170 !!====================================================================== 137 171 END MODULE usrdef_istate -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/VORTEX/cpp_VORTEX.fcm
r12208 r14054 1 bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif 1 bld::tool::fppkeys key_iomput key_mpp_mpi key_agrif -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/WAD/EXPREF/namelist_cfg
r13558 r14054 330 330 ln_dynvor_mix = .false. ! mixed scheme 331 331 ln_dynvor_een = .true. ! energy & enstrophy scheme 332 nn_een_e3f = 0 ! e3f = masked averaging of e3t divided by 4 (=0) or by the sum of mask (=1)333 332 / 334 333 !----------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/WAD/MY_SRC/usrdef_istate.F90
r13295 r14054 7 7 !! User defined : set the initial state of a user configuration 8 8 !!====================================================================== 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 9 !! History : 4.0 ! 2016-03 (S. Flavoni) Original code 10 !! ! 2020-11 (S. Techene, G. Madec) separate tsuv from ssh 10 11 !!---------------------------------------------------------------------- 11 12 … … 24 25 PRIVATE 25 26 26 PUBLIC usr_def_istate ! called in istate.F90 27 PUBLIC usr_def_istate ! called in istate.F90 28 PUBLIC usr_def_istate_ssh ! called in sshwzv.F90 27 29 28 30 !! * Substitutions … … 34 36 !!---------------------------------------------------------------------- 35 37 CONTAINS 36 37 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh ) 38 39 40 SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) 38 41 !!---------------------------------------------------------------------- 39 42 !! *** ROUTINE usr_def_istate *** … … 42 45 !! Here WAD_TEST_CASES configuration 43 46 !! 44 !! ** Method : - set temprature field47 q !! ** Method : - set temprature field 45 48 !! - set salinity field 46 49 !!---------------------------------------------------------------------- … … 50 53 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pu ! i-component of the velocity [m/s] 51 54 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pv ! j-component of the velocity [m/s] 52 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height53 55 INTEGER :: ji, jj ! dummy loop indices 54 56 REAL(wp) :: zi, zj … … 66 68 pu (:,:,:) = 0._wp ! ocean at rest 67 69 pv (:,:,:) = 0._wp 68 pssh(:,:) = 0._wp69 !70 70 ! ! T & S profiles 71 71 pts(:,:,:,jp_tem) = 10._wp * ptmask(:,:,:) … … 83 83 CASE ( 1 ) ! WAD 1 configuration 84 84 ! ! ==================== 85 !86 85 IF(lwp) WRITE(numout,*) 87 86 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 88 87 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 89 !90 do ji = 1,jpi91 pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)92 end do93 88 ! ! ==================== 94 89 CASE ( 2, 8 ) ! WAD 2 configuration 95 90 ! ! ==================== 96 !97 91 IF(lwp) WRITE(numout,*) 98 92 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 99 93 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 100 !101 do ji = 1,jpi102 pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)103 end do104 94 ! ! ==================== 105 95 CASE ( 3 ) ! WAD 3 configuration 106 96 ! ! ==================== 107 !108 97 IF(lwp) WRITE(numout,*) 109 98 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 110 99 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 111 ! 112 do ji = 1,jpi 113 pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 114 end do 100 ! ! ==================== 101 CASE ( 4 ) ! WAD 4 configuration 102 ! ! ==================== 103 IF(lwp) WRITE(numout,*) 104 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic bowl, mid-range initial ssh slope' 105 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 106 ! ! =========================== 107 CASE ( 5, 7 ) ! WAD 5 and 7 configurations 108 ! ! =========================== 109 IF(lwp) WRITE(numout,*) 110 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Double slope with shelf' 111 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 112 ! ! ==================== 113 CASE ( 6 ) ! WAD 6 configuration 114 ! ! ==================== 115 IF(lwp) WRITE(numout,*) 116 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel with gaussian ridge' 117 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 118 ! 119 DO ji = mi0(jpiglo/2), mi0(jpiglo) 120 pts(ji,:,:,jp_sal) = 30._wp 121 END DO 122 ! 123 ! 124 ! ! =========================== 125 CASE DEFAULT ! NONE existing configuration 126 ! ! =========================== 127 WRITE(ctmp1,*) 'WAD test with a ', nn_cfg,' option is not coded' 128 ! 129 CALL ctl_stop( ctmp1 ) 130 ! 131 END SELECT 132 ! 133 END SUBROUTINE usr_def_istate 134 135 136 SUBROUTINE usr_def_istate_ssh( ptmask, pssh ) 137 !!---------------------------------------------------------------------- 138 !! *** ROUTINE usr_def_istate_ssh *** 139 !! 140 !! ** Purpose : Initialization of the dynamics and tracers 141 !! Here WAD_TEST_CASES configuration 142 !! 143 !! ** Method : - set ssh 144 !!---------------------------------------------------------------------- 145 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: ptmask ! t-point ocean mask [m] 146 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pssh ! sea-surface height 147 INTEGER :: ji, jj ! dummy loop indices 148 REAL(wp) :: zi, zj 149 ! 150 INTEGER :: jk ! dummy loop indices 151 REAL(wp) :: zdam ! location of dam [Km] 152 !!---------------------------------------------------------------------- 153 ! 154 ! 155 SELECT CASE ( nn_cfg ) 156 ! ! ==================== 157 CASE ( 1 ) ! WAD 1 configuration 158 ! ! ==================== 159 ! 160 IF(lwp) WRITE(numout,*) 161 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Closed box with EW linear bottom slope' 162 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 163 ! 164 DO ji = 1,jpi 165 pssh(ji,:) = ( -5.5_wp + 7.4_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 166 END DO 167 ! ! ==================== 168 CASE ( 2, 8 ) ! WAD 2 configuration 169 ! ! ==================== 170 ! 171 IF(lwp) WRITE(numout,*) 172 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, mid-range initial ssh slope' 173 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 174 ! 175 DO ji = 1,jpi 176 pssh(ji,:) = ( -1.5_wp + 5.0_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 177 END DO 178 ! ! ==================== 179 CASE ( 3 ) ! WAD 3 configuration 180 ! ! ==================== 181 ! 182 IF(lwp) WRITE(numout,*) 183 IF(lwp) WRITE(numout,*) 'usr_def_istate : WAD Parobolic EW channel, extreme initial ssh slope' 184 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 185 ! 186 DO ji = 1,jpi 187 pssh(ji,:) = ( -4.5_wp + 6.8_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 188 END DO 115 189 116 190 ! … … 140 214 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 141 215 ! 142 doji = 1,jpi143 pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1)144 end do216 DO ji = 1,jpi 217 pssh(ji,:) = ( -2.5_wp + 5.5_wp*glamt(ji,1)/50._wp)*ptmask(ji,:,1) 218 END DO 145 219 146 220 ! … … 153 227 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 154 228 ! 155 do ji = 1,jpi 156 pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 157 end do 158 ! 159 do ji = mi0(jpiglo/2), mi0(jpiglo) 160 pts(ji,:,:,jp_sal) = 30._wp 161 pssh(ji,:) = -0.1*ptmask(ji,:,1) 162 end do 229 DO ji = 1,jpi 230 pssh(ji,:) = ( -2.5_wp + 5.5_wp*(50._wp-glamt(ji,1))/50._wp)*ptmask(ji,:,1) 231 END DO 232 ! 233 DO ji = mi0(jpiglo/2), mi0(jpiglo) 234 pssh(ji,:) = -0.1*ptmask(ji,:,1) 235 END DO 163 236 ! 164 237 ! … … 182 255 END_2D 183 256 ! 184 END SUBROUTINE usr_def_istate 257 END SUBROUTINE usr_def_istate_ssh 185 258 186 259 !!====================================================================== -
NEMO/branches/2020/dev_r13747_ENHANCE-04_dford_OBSOP_BGC/tests/demo_cfgs.txt
r14049 r14054 12 12 STATION_ASF OCE 13 13 CPL_OASIS OCE TOP ICE NST 14 SWG OCE SWE 14 15 C1D_ASICS OCE 15 16 ICE_RHEO OCE SAS ICE
Note: See TracChangeset
for help on using the changeset viewer.